1 # Copyright (C) The Arvados Authors. All rights reserved.
3 # SPDX-License-Identifier: Apache-2.0
5 getAPIDocument <- function(){
6 url <- "https://4xphq.arvadosapi.com/discovery/v1/apis/arvados/v1/rest"
7 serverResponse <- httr::RETRY("GET", url = url)
9 httr::content(serverResponse, as = "parsed", type = "application/json")
13 generateAPI <- function()
15 #TODO: Consider passing discovery document URL as parameter.
16 #TODO: Consider passing location where to create new files.
17 discoveryDocument <- getAPIDocument()
19 methodResources <- discoveryDocument$resources
20 resourceNames <- names(methodResources)
22 methodDoc <- genMethodsDoc(methodResources, resourceNames)
23 classDoc <- genAPIClassDoc(methodResources, resourceNames)
24 arvadosAPIHeader <- genAPIClassHeader()
25 arvadosProjectMethods <- genProjectMethods()
26 arvadosClassMethods <- genClassContent(methodResources, resourceNames)
27 arvadosAPIFooter <- genAPIClassFooter()
29 arvadosClass <- c(methodDoc,
32 arvadosProjectMethods,
36 fileConn <- file("./R/Arvados.R", "w")
37 writeLines(unlist(arvadosClass), fileConn)
42 genAPIClassHeader <- function()
44 c("Arvados <- R6::R6Class(",
50 "\t\tinitialize = function(authToken = NULL, hostName = NULL, numRetries = 0)",
52 "\t\t\tif(!is.null(hostName))",
53 "\t\t\t\tSys.setenv(ARVADOS_API_HOST = hostName)",
55 "\t\t\tif(!is.null(authToken))",
56 "\t\t\t\tSys.setenv(ARVADOS_API_TOKEN = authToken)",
58 "\t\t\thostName <- Sys.getenv(\"ARVADOS_API_HOST\")",
59 "\t\t\ttoken <- Sys.getenv(\"ARVADOS_API_TOKEN\")",
61 "\t\t\tif(hostName == \"\" | token == \"\")",
62 "\t\t\t\tstop(paste(\"Please provide host name and authentification token\",",
63 "\t\t\t\t\t\t \"or set ARVADOS_API_HOST and ARVADOS_API_TOKEN\",",
64 "\t\t\t\t\t\t \"environment variables.\"))",
66 "\t\t\tprivate$token <- token",
67 "\t\t\tprivate$host <- paste0(\"https://\", hostName, \"/arvados/v1/\")",
68 "\t\t\tprivate$numRetries <- numRetries",
69 "\t\t\tprivate$REST <- RESTService$new(token, hostName,",
70 "\t\t\t HttpRequest$new(), HttpParser$new(),",
76 genProjectMethods <- function()
78 c("\t\tprojects.get = function(uuid)",
80 "\t\t\tself$groups.get(uuid)",
83 "\t\tprojects.create = function(group, ensure_unique_name = \"false\")",
85 "\t\t\tgroup <- c(\"group_class\" = \"project\", group)",
86 "\t\t\tself$groups.create(group, ensure_unique_name)",
89 "\t\tprojects.update = function(group, uuid)",
91 "\t\t\tgroup <- c(\"group_class\" = \"project\", group)",
92 "\t\t\tself$groups.update(group, uuid)",
95 "\t\tprojects.list = function(filters = NULL, where = NULL,",
96 "\t\t\torder = NULL, select = NULL, distinct = NULL,",
97 "\t\t\tlimit = \"100\", offset = \"0\", count = \"exact\",",
98 "\t\t\tinclude_trash = NULL)",
100 "\t\t\tfilters[[length(filters) + 1]] <- list(\"group_class\", \"=\", \"project\")",
101 "\t\t\tself$groups.list(filters, where, order, select, distinct,",
102 "\t\t\t limit, offset, count, include_trash)",
105 "\t\tprojects.delete = function(uuid)",
107 "\t\t\tself$groups.delete(uuid)",
112 genClassContent <- function(methodResources, resourceNames)
114 arvadosMethods <- Map(function(resource, resourceName)
116 methodNames <- names(resource$methods)
118 functions <- Map(function(methodMetaData, methodName)
120 #NOTE: Index, show and destroy are aliases for the preferred names
121 # "list", "get" and "delete". Until they are removed from discovery
122 # document we will filter them here.
123 if(methodName %in% c("index", "show", "destroy"))
126 methodName <- paste0(resourceName, ".", methodName)
127 createMethod(methodName, methodMetaData)
129 }, resource$methods, methodNames)
131 unlist(unname(functions))
133 }, methodResources, resourceNames)
138 genAPIClassFooter <- function()
140 c("\t\tgetHostName = function() private$host,",
141 "\t\tgetToken = function() private$token,",
142 "\t\tsetRESTService = function(newREST) private$REST <- newREST,",
143 "\t\tgetRESTService = function() private$REST",
151 "\t\tnumRetries = NULL",
154 "\tcloneable = FALSE",
158 createMethod <- function(name, methodMetaData)
160 args <- getMethodArguments(methodMetaData)
161 signature <- getMethodSignature(name, args)
162 body <- getMethodBody(methodMetaData)
170 getMethodArguments <- function(methodMetaData)
172 request <- methodMetaData$request
175 if(!is.null(request))
177 resourceName <- tolower(request$properties[[1]][[1]])
180 requestArgs <- resourceName
182 requestArgs <- paste(resourceName, "=", "NULL")
185 argNames <- names(methodMetaData$parameters)
187 args <- sapply(argNames, function(argName)
189 arg <- methodMetaData$parameters[[argName]]
193 if(!is.null(arg$default))
194 return(paste0(argName, " = ", "\"", arg$default, "\""))
196 return(paste(argName, "=", "NULL"))
205 getMethodSignature <- function(methodName, args)
207 collapsedArgs <- paste0(args, collapse = ", ")
208 lineLengthLimit <- 40
210 if(nchar(collapsedArgs) > lineLengthLimit)
212 return(paste0("\t\t",
213 formatArgs(paste(methodName, "= function("),
214 "\t", args, ")", lineLengthLimit)))
218 return(paste0("\t\t", methodName, " = function(", collapsedArgs, ")"))
222 getMethodBody <- function(methodMetaData)
224 url <- getRequestURL(methodMetaData)
225 headers <- getRequestHeaders()
226 requestQueryList <- getRequestQueryList(methodMetaData)
227 requestBody <- getRequestBody(methodMetaData)
228 request <- getRequest(methodMetaData)
229 response <- getResponse(methodMetaData)
230 errorCheck <- getErrorCheckingCode()
231 returnStatement <- getReturnObject()
235 requestQueryList, "",
237 request, response, "",
241 paste0("\t\t\t", body)
244 getRequestURL <- function(methodMetaData)
246 endPoint <- methodMetaData$path
247 endPoint <- stringr::str_replace_all(endPoint, "\\{", "${")
248 url <- c(paste0("endPoint <- stringr::str_interp(\"", endPoint, "\")"),
249 paste0("url <- paste0(private$host, endPoint)"))
253 getRequestHeaders <- function()
255 c("headers <- list(Authorization = paste(\"OAuth2\", private$token), ",
256 " \"Content-Type\" = \"application/json\")")
259 getRequestQueryList <- function(methodMetaData)
261 queryArgs <- names(Filter(function(arg) arg$location == "query",
262 methodMetaData$parameters))
264 if(length(queryArgs) == 0)
265 return("queryArgs <- NULL")
267 queryArgs <- sapply(queryArgs, function(arg) paste0(arg, " = ", arg))
268 collapsedArgs <- paste0(queryArgs, collapse = ", ")
270 lineLengthLimit <- 40
272 if(nchar(collapsedArgs) > lineLengthLimit)
273 return(formatArgs("queryArgs <- list(", "\t\t\t\t ", queryArgs, ")",
276 return(paste0("queryArgs <- list(", collapsedArgs, ")"))
279 getRequestBody <- function(methodMetaData)
281 request <- methodMetaData$request
283 if(is.null(request) || !request$required)
284 return("body <- NULL")
286 resourceName <- tolower(request$properties[[1]][[1]])
288 requestParameterName <- names(request$properties)[1]
290 c(paste0("if(length(", resourceName, ") > 0)"),
291 paste0("\tbody <- jsonlite::toJSON(list(", resourceName, " = ", resourceName, "), "),
292 "\t auto_unbox = TRUE)",
297 getRequest <- function(methodMetaData)
299 method <- methodMetaData$httpMethod
300 c(paste0("response <- private$REST$http$exec(\"", method, "\", url, headers, body,"),
301 " queryArgs, private$numRetries)")
304 getResponse <- function(methodMetaData)
306 "resource <- private$REST$httpParser$parseJSONResponse(response)"
309 getErrorCheckingCode <- function()
311 c("if(!is.null(resource$errors))",
312 "\tstop(resource$errors)")
315 getReturnObject <- function()
320 #NOTE: Arvados class documentation:
322 genMethodsDoc <- function(methodResources, resourceNames)
324 methodsDoc <- unlist(unname(Map(function(resource, resourceName)
326 methodNames <- names(resource$methods)
328 methodDoc <- Map(function(methodMetaData, methodName)
330 #NOTE: Index, show and destroy are aliases for the preferred names
331 # "list", "get" and "delete". Until they are removed from discovery
332 # document we will filter them here.
333 if(methodName %in% c("index", "show", "destroy"))
336 methodName <- paste0(resourceName, ".", methodName)
337 getMethodDoc(methodName, methodMetaData)
339 }, resource$methods, methodNames)
341 unlist(unname(methodDoc))
343 }, methodResources, resourceNames)))
345 projectDoc <- genProjectMethodsDoc()
347 c(methodsDoc, projectDoc)
350 genAPIClassDoc <- function(methodResources, resourceNames)
354 "#' Arvados class gives users ability to access Arvados REST API.",
356 "#' @section Usage:",
357 "#' \\preformatted{arv = Arvados$new(authToken = NULL, hostName = NULL, numRetries = 0)}",
359 "#' @section Arguments:",
361 "#' \t\\item{authToken}{Authentification token. If not specified ARVADOS_API_TOKEN environment variable will be used.}",
362 "#' \t\\item{hostName}{Host name. If not specified ARVADOS_API_HOST environment variable will be used.}",
363 "#' \t\\item{numRetries}{Number which specifies how many times to retry failed service requests.}",
366 "#' @section Methods:",
368 getAPIClassMethodList(methodResources, resourceNames),
374 "#' arv <- Arvados$new(\"your Arvados token\", \"example.arvadosapi.com\")",
376 "#' collection <- arv$collections.get(\"uuid\")",
378 "#' collectionList <- arv$collections.list(list(list(\"name\", \"like\", \"Test%\")))",
379 "#' collectionList <- listAll(arv$collections.list, list(list(\"name\", \"like\", \"Test%\")))",
381 "#' deletedCollection <- arv$collections.delete(\"uuid\")",
383 "#' updatedCollection <- arv$collections.update(list(name = \"New name\", description = \"New description\"),",
386 "#' createdCollection <- arv$collections.create(list(name = \"Example\",",
387 "#' description = \"This is a test collection\"))",
394 getAPIClassMethodList <- function(methodResources, resourceNames)
396 methodList <- unlist(unname(Map(function(resource, resourceName)
398 methodNames <- names(resource$methods)
401 methodNames[!(methodNames %in% c("index", "show", "destroy"))])
403 }, methodResources, resourceNames)))
405 hardcodedMethods <- c("projects.create", "projects.get",
406 "projects.list", "projects.update", "projects.delete")
407 paste0("#' \t\\item{}{\\code{\\link{", sort(c(methodList, hardcodedMethods)), "}}}")
410 getMethodDoc <- function(methodName, methodMetaData)
412 name <- paste("#' @name", methodName)
413 usage <- getMethodUsage(methodName, methodMetaData)
414 description <- paste("#'", methodName, "is a method defined in Arvados class.")
415 params <- getMethodDescription(methodMetaData)
416 returnValue <- paste("#' @return", methodMetaData$response[["$ref"]], "object.")
418 c(paste("#'", methodName),
430 getMethodUsage <- function(methodName, methodMetaData)
432 lineLengthLimit <- 40
433 args <- getMethodArguments(methodMetaData)
434 c(formatArgs(paste0("#' @usage arv$", methodName,
435 "("), "#' \t", args, ")", lineLengthLimit))
438 getMethodDescription <- function(methodMetaData)
440 request <- methodMetaData$request
443 if(!is.null(request))
445 requestDoc <- unname(unlist(sapply(request$properties, function(prop)
447 className <- sapply(prop, function(ref) ref)
448 objectName <- paste0(tolower(substr(className, 1, 1)),
449 substr(className, 2, nchar(className)))
450 paste("#' @param", objectName, className, "object.")
454 argNames <- names(methodMetaData$parameters)
456 argsDoc <- unname(unlist(sapply(argNames, function(argName)
458 arg <- methodMetaData$parameters[[argName]]
459 argDescription <- arg$description
460 paste("#' @param", argName, argDescription)
463 c(requestDoc, argsDoc)
466 genProjectMethodsDoc <- function()
468 #TODO: Manually update this documentation to reflect changes in discovery document.
471 "#' projects.get is equivalent to groups.get method.",
473 "#' @usage arv$projects.get(uuid)",
474 "#' @param uuid The UUID of the Group in question.",
475 "#' @return Group object.",
476 "#' @name projects.get",
481 "#' projects.create wrapps groups.create method by setting group_class attribute to \"project\".",
483 "#' @usage arv$projects.create(group, ensure_unique_name = \"false\")",
484 "#' @param group Group object.",
485 "#' @param ensure_unique_name Adjust name to ensure uniqueness instead of returning an error on (owner_uuid, name) collision.",
486 "#' @return Group object.",
487 "#' @name projects.create",
492 "#' projects.update wrapps groups.update method by setting group_class attribute to \"project\".",
494 "#' @usage arv$projects.update(group, uuid)",
495 "#' @param group Group object.",
496 "#' @param uuid The UUID of the Group in question.",
497 "#' @return Group object.",
498 "#' @name projects.update",
503 "#' projects.delete is equivalent to groups.delete method.",
505 "#' @usage arv$project.delete(uuid)",
506 "#' @param uuid The UUID of the Group in question.",
507 "#' @return Group object.",
508 "#' @name projects.delete",
513 "#' projects.list wrapps groups.list method by setting group_class attribute to \"project\".",
515 "#' @usage arv$projects.list(filters = NULL,",
516 "#' where = NULL, order = NULL, distinct = NULL,",
517 "#' limit = \"100\", offset = \"0\", count = \"exact\",",
518 "#' include_trash = NULL, uuid = NULL, recursive = NULL)",
519 "#' @param filters ",
522 "#' @param distinct ",
526 "#' @param include_trash Include items whose is_trashed attribute is true.",
528 "#' @param recursive Include contents from child groups recursively.",
529 "#' @return Group object.",
530 "#' @name projects.list",
535 #NOTE: Utility functions:
537 # This function is used to split very long lines of code into smaller chunks.
538 # This is usually the case when we pass a lot of named argumets to a function.
539 formatArgs <- function(prependAtStart, prependToEachSplit,
540 args, appendAtEnd, lineLength)
544 args[1:(length(args) - 1)] <- paste0(args[1:(length(args) - 1)], ",")
547 args[1] <- paste0(prependAtStart, args[1])
548 args[length(args)] <- paste0(args[length(args)], appendAtEnd)
550 argsLength <- length(args)
554 while(index <= argsLength)
559 while(nchar(line) < lineLength && index <= argsLength)
561 line <- paste(line, args[index])
565 argLines <- c(argLines, line)
568 argLines <- unlist(argLines)
569 argLinesLen <- length(argLines)
572 argLines[2:argLinesLen] <- paste0(prependToEachSplit, argLines[2:argLinesLen])