sdk/R/R/autoGenAPI.R

   1 # Copyright (C) The Arvados Authors. All rights reserved.
   2 #
   3 # SPDX-License-Identifier: Apache-2.0
   4
   5 getAPIDocument <- function(){
   6     url <- "https://jutro.arvadosapi.com/discovery/v1/apis/arvados/v1/rest"
   7     serverResponse <- httr::RETRY("GET", url = url)
   8
   9     httr::content(serverResponse, as = "parsed", type = "application/json")
  10 }
  11
  12 #' @export
  13 generateAPI <- function()
  14 {
  15     #TODO: Consider passing discovery document URL as parameter.
  16     #TODO: Consider passing location where to create new files.
  17     discoveryDocument <- getAPIDocument()
  18
  19     methodResources <- discoveryDocument$resources
  20
  21     # Don't emit deprecated APIs
  22     methodResources <- methodResources[!(names(methodResources) %in% c("jobs", "job_tasks", "pipeline_templates", "pipeline_instances",
  23                             "keep_disks", "nodes", "humans", "traits", "specimens"))]
  24     resourceNames   <- names(methodResources)
  25
  26     methodDoc <- genMethodsDoc(methodResources, resourceNames)
  27     classDoc <- genAPIClassDoc(methodResources, resourceNames)
  28     arvadosAPIHeader <- genAPIClassHeader()
  29     arvadosProjectMethods <- genProjectMethods()
  30     arvadosClassMethods <- genClassContent(methodResources, resourceNames)
  31     arvadosAPIFooter <- genAPIClassFooter()
  32
  33     arvadosClass <- c(methodDoc,
  34                       classDoc,
  35                       arvadosAPIHeader,
  36                       arvadosProjectMethods,
  37                       arvadosClassMethods,
  38                       arvadosAPIFooter)
  39
  40     fileConn <- file("./R/Arvados.R", "w")
  41     writeLines(c(
  42     "# Copyright (C) The Arvados Authors. All rights reserved.",
  43     "#",
  44     "# SPDX-License-Identifier: Apache-2.0", ""), fileConn)
  45     writeLines(unlist(arvadosClass), fileConn)
  46     close(fileConn)
  47     NULL
  48 }
  49
  50 genAPIClassHeader <- function()
  51 {
  52     c("Arvados <- R6::R6Class(",
  53       "",
  54       "\t\"Arvados\",",
  55       "",
  56       "\tpublic = list(",
  57       "",
  58       "\t\tinitialize = function(authToken = NULL, hostName = NULL, numRetries = 0)",
  59       "\t\t{",
  60       "\t\t\tif(!is.null(hostName))",
  61       "\t\t\t\tSys.setenv(ARVADOS_API_HOST = hostName)",
  62       "",
  63       "\t\t\tif(!is.null(authToken))",
  64       "\t\t\t\tSys.setenv(ARVADOS_API_TOKEN = authToken)",
  65       "",
  66       "\t\t\thostName <- Sys.getenv(\"ARVADOS_API_HOST\")",
  67       "\t\t\ttoken    <- Sys.getenv(\"ARVADOS_API_TOKEN\")",
  68       "",
  69       "\t\t\tif(hostName == \"\" | token == \"\")",
  70       "\t\t\t\tstop(paste(\"Please provide host name and authentification token\",",
  71       "\t\t\t\t\t\t   \"or set ARVADOS_API_HOST and ARVADOS_API_TOKEN\",",
  72       "\t\t\t\t\t\t   \"environment variables.\"))",
  73       "",
  74       "\t\t\tprivate$token <- token",
  75       "\t\t\tprivate$host  <- paste0(\"https://\", hostName, \"/arvados/v1/\")",
  76       "\t\t\tprivate$numRetries <- numRetries",
  77       "\t\t\tprivate$REST <- RESTService$new(token, hostName,",
  78       "\t\t\t                                HttpRequest$new(), HttpParser$new(),",
  79       "\t\t\t                                numRetries)",
  80       "",
  81       "\t\t},\n")
  82 }
  83
  84 genProjectMethods <- function()
  85 {
  86     c("\t\tprojects.get = function(uuid)",
  87       "\t\t{",
  88       "\t\t\tself$groups.get(uuid)",
  89       "\t\t},",
  90       "",
  91       "\t\tprojects.create = function(group, ensure_unique_name = \"false\")",
  92       "\t\t{",
  93       "\t\t\tgroup <- c(\"group_class\" = \"project\", group)",
  94       "\t\t\tself$groups.create(group, ensure_unique_name)",
  95       "\t\t},",
  96       "",
  97       "\t\tprojects.update = function(group, uuid)",
  98       "\t\t{",
  99       "\t\t\tgroup <- c(\"group_class\" = \"project\", group)",
 100       "\t\t\tself$groups.update(group, uuid)",
 101       "\t\t},",
 102       "",
 103       "\t\tprojects.list = function(filters = NULL, where = NULL,",
 104       "\t\t\torder = NULL, select = NULL, distinct = NULL,",
 105       "\t\t\tlimit = \"100\", offset = \"0\", count = \"exact\",",
 106       "\t\t\tinclude_trash = NULL)",
 107       "\t\t{",
 108       "\t\t\tfilters[[length(filters) + 1]] <- list(\"group_class\", \"=\", \"project\")",
 109       "\t\t\tself$groups.list(filters, where, order, select, distinct,",
 110       "\t\t\t                 limit, offset, count, include_trash)",
 111       "\t\t},",
 112       "",
 113       "\t\tprojects.delete = function(uuid)",
 114       "\t\t{",
 115       "\t\t\tself$groups.delete(uuid)",
 116       "\t\t},",
 117       "")
 118 }
 119
 120 genClassContent <- function(methodResources, resourceNames)
 121 {
 122     arvadosMethods <- Map(function(resource, resourceName)
 123     {
 124         methodNames <- names(resource$methods)
 125
 126         functions <- Map(function(methodMetaData, methodName)
 127         {
 128             #NOTE: Index, show and destroy are aliases for the preferred names
 129             # "list", "get" and "delete". Until they are removed from discovery
 130             # document we will filter them here.
 131             if(methodName %in% c("index", "show", "destroy"))
 132                return(NULL)
 133
 134             methodName <- paste0(resourceName, ".", methodName)
 135             createMethod(methodName, methodMetaData)
 136
 137         }, resource$methods, methodNames)
 138
 139         unlist(unname(functions))
 140
 141     }, methodResources, resourceNames)
 142
 143     arvadosMethods
 144 }
 145
 146 genAPIClassFooter <- function()
 147 {
 148     c("\t\tgetHostName = function() private$host,",
 149       "\t\tgetToken = function() private$token,",
 150       "\t\tsetRESTService = function(newREST) private$REST <- newREST,",
 151       "\t\tgetRESTService = function() private$REST",
 152       "\t),",
 153       "",
 154       "\tprivate = list(",
 155       "",
 156       "\t\ttoken = NULL,",
 157       "\t\thost = NULL,",
 158       "\t\tREST = NULL,",
 159       "\t\tnumRetries = NULL",
 160       "\t),",
 161       "",
 162       "\tcloneable = FALSE",
 163       ")")
 164 }
 165
 166 createMethod <- function(name, methodMetaData)
 167 {
 168     args      <- getMethodArguments(methodMetaData)
 169     signature <- getMethodSignature(name, args)
 170     body      <- getMethodBody(methodMetaData)
 171
 172     c(signature,
 173       "\t\t{",
 174           body,
 175       "\t\t},\n")
 176 }
 177
 178 getMethodArguments <- function(methodMetaData)
 179 {
 180     request <- methodMetaData$request
 181     requestArgs <- NULL
 182
 183     if(!is.null(request))
 184     {
 185         resourceName <- tolower(request$properties[[1]][[1]])
 186
 187         if(request$required)
 188             requestArgs <- resourceName
 189         else
 190             requestArgs <- paste(resourceName, "=", "NULL")
 191     }
 192
 193     argNames <- names(methodMetaData$parameters)
 194
 195     args <- sapply(argNames, function(argName)
 196     {
 197         arg <- methodMetaData$parameters[[argName]]
 198
 199         if(!arg$required)
 200         {
 201             if(!is.null(arg$default))
 202                 return(paste0(argName, " = ", "\"", arg$default, "\""))
 203             else
 204                 return(paste(argName, "=", "NULL"))
 205         }
 206
 207         argName
 208     })
 209
 210     c(requestArgs, args)
 211 }
 212
 213 getMethodSignature <- function(methodName, args)
 214 {
 215     collapsedArgs <- paste0(args, collapse = ", ")
 216     lineLengthLimit <- 40
 217
 218     if(nchar(collapsedArgs) > lineLengthLimit)
 219     {
 220         return(paste0("\t\t",
 221                       formatArgs(paste(methodName, "= function("),
 222                                  "\t", args, ")", lineLengthLimit)))
 223     }
 224     else
 225     {
 226         return(paste0("\t\t", methodName, " = function(", collapsedArgs, ")"))
 227     }
 228 }
 229
 230 getMethodBody <- function(methodMetaData)
 231 {
 232     url              <- getRequestURL(methodMetaData)
 233     headers          <- getRequestHeaders()
 234     requestQueryList <- getRequestQueryList(methodMetaData)
 235     requestBody      <- getRequestBody(methodMetaData)
 236     request          <- getRequest(methodMetaData)
 237     response         <- getResponse(methodMetaData)
 238     errorCheck       <- getErrorCheckingCode()
 239     returnStatement  <- getReturnObject()
 240
 241     body <- c(url,
 242               headers,
 243               requestQueryList, "",
 244               requestBody, "",
 245               request, response, "",
 246               errorCheck, "",
 247               returnStatement)
 248
 249     paste0("\t\t\t", body)
 250 }
 251
 252 getRequestURL <- function(methodMetaData)
 253 {
 254     endPoint <- methodMetaData$path
 255     endPoint <- stringr::str_replace_all(endPoint, "\\{", "${")
 256     url <- c(paste0("endPoint <- stringr::str_interp(\"", endPoint, "\")"),
 257              paste0("url <- paste0(private$host, endPoint)"))
 258     url
 259 }
 260
 261 getRequestHeaders <- function()
 262 {
 263     c("headers <- list(Authorization = paste(\"Bearer\", private$token), ",
 264       "                \"Content-Type\" = \"application/json\")")
 265 }
 266
 267 getRequestQueryList <- function(methodMetaData)
 268 {
 269     queryArgs <- names(Filter(function(arg) arg$location == "query",
 270                         methodMetaData$parameters))
 271
 272     if(length(queryArgs) == 0)
 273         return("queryArgs <- NULL")
 274
 275     queryArgs <- sapply(queryArgs, function(arg) paste0(arg, " = ", arg))
 276     collapsedArgs <- paste0(queryArgs, collapse = ", ")
 277
 278     lineLengthLimit <- 40
 279
 280     if(nchar(collapsedArgs) > lineLengthLimit)
 281         return(formatArgs("queryArgs <- list(", "\t\t\t\t  ", queryArgs, ")",
 282                           lineLengthLimit))
 283     else
 284         return(paste0("queryArgs <- list(", collapsedArgs, ")"))
 285 }
 286
 287 getRequestBody <- function(methodMetaData)
 288 {
 289     request <- methodMetaData$request
 290
 291     if(is.null(request) || !request$required)
 292         return("body <- NULL")
 293
 294     resourceName <- tolower(request$properties[[1]][[1]])
 295
 296     requestParameterName <- names(request$properties)[1]
 297
 298     c(paste0("if(length(", resourceName, ") > 0)"),
 299       paste0("\tbody <- jsonlite::toJSON(list(", resourceName, " = ", resourceName, "), "),
 300              "\t                         auto_unbox = TRUE)",
 301       "else",
 302       "\tbody <- NULL")
 303 }
 304
 305 getRequest <- function(methodMetaData)
 306 {
 307     method <- methodMetaData$httpMethod
 308     c(paste0("response <- private$REST$http$exec(\"", method, "\", url, headers, body,"),
 309       "                                   queryArgs, private$numRetries)")
 310 }
 311
 312 getResponse <- function(methodMetaData)
 313 {
 314     "resource <- private$REST$httpParser$parseJSONResponse(response)"
 315 }
 316
 317 getErrorCheckingCode <- function()
 318 {
 319     c("if(!is.null(resource$errors))",
 320       "\tstop(resource$errors)")
 321 }
 322
 323 getReturnObject <- function()
 324 {
 325     "resource"
 326 }
 327
 328 #NOTE: Arvados class documentation:
 329
 330 genMethodsDoc <- function(methodResources, resourceNames)
 331 {
 332     methodsDoc <- unlist(unname(Map(function(resource, resourceName)
 333     {
 334         methodNames <- names(resource$methods)
 335
 336         methodDoc <- Map(function(methodMetaData, methodName)
 337         {
 338             #NOTE: Index, show and destroy are aliases for the preferred names
 339             # "list", "get" and "delete". Until they are removed from discovery
 340             # document we will filter them here.
 341             if(methodName %in% c("index", "show", "destroy"))
 342                return(NULL)
 343
 344             methodName <- paste0(resourceName, ".", methodName)
 345             getMethodDoc(methodName, methodMetaData)
 346
 347         }, resource$methods, methodNames)
 348
 349         unlist(unname(methodDoc))
 350
 351     }, methodResources, resourceNames)))
 352
 353     projectDoc <- genProjectMethodsDoc()
 354
 355     c(methodsDoc, projectDoc)
 356 }
 357
 358 genAPIClassDoc <- function(methodResources, resourceNames)
 359 {
 360     c("#' Arvados",
 361       "#'",
 362       "#' Arvados class gives users ability to access Arvados REST API.",
 363       "#'" ,
 364       "#' @section Usage:",
 365       "#' \\preformatted{arv = Arvados$new(authToken = NULL, hostName = NULL, numRetries = 0)}",
 366       "#'",
 367       "#' @section Arguments:",
 368       "#' \\describe{",
 369       "#' \t\\item{authToken}{Authentification token. If not specified ARVADOS_API_TOKEN environment variable will be used.}",
 370       "#' \t\\item{hostName}{Host name. If not specified ARVADOS_API_HOST environment variable will be used.}",
 371       "#' \t\\item{numRetries}{Number which specifies how many times to retry failed service requests.}",
 372       "#' }",
 373       "#'",
 374       "#' @section Methods:",
 375       "#' \\describe{",
 376       getAPIClassMethodList(methodResources, resourceNames),
 377       "#' }",
 378       "#'",
 379       "#' @name Arvados",
 380       "#' @examples",
 381       "#' \\dontrun{",
 382       "#' arv <- Arvados$new(\"your Arvados token\", \"example.arvadosapi.com\")",
 383       "#'",
 384       "#' collection <- arv$collections.get(\"uuid\")",
 385       "#'",
 386       "#' collectionList <- arv$collections.list(list(list(\"name\", \"like\", \"Test%\")))",
 387       "#' collectionList <- listAll(arv$collections.list, list(list(\"name\", \"like\", \"Test%\")))",
 388       "#'",
 389       "#' deletedCollection <- arv$collections.delete(\"uuid\")",
 390       "#'",
 391       "#' updatedCollection <- arv$collections.update(list(name = \"New name\", description = \"New description\"),",
 392       "#'                                             \"uuid\")",
 393       "#'",
 394       "#' createdCollection <- arv$collections.create(list(name = \"Example\",",
 395       "#'                                                  description = \"This is a test collection\"))",
 396       "#' }",
 397       "NULL",
 398       "",
 399       "#' @export")
 400 }
 401
 402 getAPIClassMethodList <- function(methodResources, resourceNames)
 403 {
 404     methodList <- unlist(unname(Map(function(resource, resourceName)
 405     {
 406         methodNames <- names(resource$methods)
 407         paste0(resourceName,
 408                ".",
 409                methodNames[!(methodNames %in% c("index", "show", "destroy"))])
 410
 411     }, methodResources, resourceNames)))
 412
 413     hardcodedMethods <- c("projects.create", "projects.get",
 414                           "projects.list", "projects.update", "projects.delete")
 415     paste0("#' \t\\item{}{\\code{\\link{", sort(c(methodList, hardcodedMethods)), "}}}")
 416 }
 417
 418 getMethodDoc <- function(methodName, methodMetaData)
 419 {
 420     name        <- paste("#' @name", methodName)
 421     usage       <- getMethodUsage(methodName, methodMetaData)
 422     description <- paste("#'", methodName, "is a method defined in Arvados class.")
 423     params      <- getMethodDescription(methodMetaData)
 424     returnValue <- paste("#' @return", methodMetaData$response[["$ref"]], "object.")
 425
 426     c(paste("#'", methodName),
 427       "#' ",
 428       description,
 429       "#' ",
 430       usage,
 431       params,
 432       returnValue,
 433       name,
 434       "NULL",
 435       "")
 436 }
 437
 438 getMethodUsage <- function(methodName, methodMetaData)
 439 {
 440     lineLengthLimit <- 40
 441     args <- getMethodArguments(methodMetaData)
 442     c(formatArgs(paste0("#' @usage arv$", methodName,
 443                         "("), "#' \t", args, ")", lineLengthLimit))
 444 }
 445
 446 getMethodDescription <- function(methodMetaData)
 447 {
 448     request <- methodMetaData$request
 449     requestDoc <- NULL
 450
 451     if(!is.null(request))
 452     {
 453         requestDoc <- unname(unlist(sapply(request$properties, function(prop)
 454                              {
 455                                  className <- sapply(prop, function(ref) ref)
 456                                  objectName <- paste0(tolower(substr(className, 1, 1)),
 457                                                       substr(className, 2, nchar(className)))
 458                                  paste("#' @param", objectName, className, "object.")
 459                              })))
 460     }
 461
 462     argNames <- names(methodMetaData$parameters)
 463
 464     argsDoc <- unname(unlist(sapply(argNames, function(argName)
 465     {
 466         arg <- methodMetaData$parameters[[argName]]
 467         argDescription <- arg$description
 468         paste("#' @param", argName, argDescription)
 469     })))
 470
 471     c(requestDoc, argsDoc)
 472 }
 473
 474 genProjectMethodsDoc <- function()
 475 {
 476     #TODO: Manually update this documentation to reflect changes in discovery document.
 477     c("#' project.get",
 478     "#' ",
 479     "#' projects.get is equivalent to groups.get method.",
 480     "#' ",
 481     "#' @usage arv$projects.get(uuid)",
 482     "#' @param uuid The UUID of the Group in question.",
 483     "#' @return Group object.",
 484     "#' @name projects.get",
 485     "NULL",
 486     "",
 487     "#' project.create",
 488     "#' ",
 489     "#' projects.create wrapps groups.create method by setting group_class attribute to \"project\".",
 490     "#' ",
 491     "#' @usage arv$projects.create(group, ensure_unique_name = \"false\")",
 492     "#' @param group Group object.",
 493     "#' @param ensure_unique_name Adjust name to ensure uniqueness instead of returning an error on (owner_uuid, name) collision.",
 494     "#' @return Group object.",
 495     "#' @name projects.create",
 496     "NULL",
 497     "",
 498     "#' project.update",
 499     "#' ",
 500     "#' projects.update wrapps groups.update method by setting group_class attribute to \"project\".",
 501     "#' ",
 502     "#' @usage arv$projects.update(group, uuid)",
 503     "#' @param group Group object.",
 504     "#' @param uuid The UUID of the Group in question.",
 505     "#' @return Group object.",
 506     "#' @name projects.update",
 507     "NULL",
 508     "",
 509     "#' project.delete",
 510     "#' ",
 511     "#' projects.delete is equivalent to groups.delete method.",
 512     "#' ",
 513     "#' @usage arv$project.delete(uuid)",
 514     "#' @param uuid The UUID of the Group in question.",
 515     "#' @return Group object.",
 516     "#' @name projects.delete",
 517     "NULL",
 518     "",
 519     "#' project.list",
 520     "#' ",
 521     "#' projects.list wrapps groups.list method by setting group_class attribute to \"project\".",
 522     "#' ",
 523     "#' @usage arv$projects.list(filters = NULL,",
 524     "#'         where = NULL, order = NULL, distinct = NULL,",
 525     "#'         limit = \"100\", offset = \"0\", count = \"exact\",",
 526     "#'         include_trash = NULL, uuid = NULL, recursive = NULL)",
 527     "#' @param filters ",
 528     "#' @param where ",
 529     "#' @param order ",
 530     "#' @param distinct ",
 531     "#' @param limit ",
 532     "#' @param offset ",
 533     "#' @param count ",
 534     "#' @param include_trash Include items whose is_trashed attribute is true.",
 535     "#' @param uuid ",
 536     "#' @param recursive Include contents from child groups recursively.",
 537     "#' @return Group object.",
 538     "#' @name projects.list",
 539     "NULL",
 540     "")
 541 }
 542
 543 #NOTE: Utility functions:
 544
 545 # This function is used to split very long lines of code into smaller chunks.
 546 # This is usually the case when we pass a lot of named argumets to a function.
 547 formatArgs <- function(prependAtStart, prependToEachSplit,
 548                        args, appendAtEnd, lineLength)
 549 {
 550     if(length(args) > 1)
 551     {
 552         args[1:(length(args) - 1)] <- paste0(args[1:(length(args) - 1)], ",")
 553     }
 554
 555     args[1] <- paste0(prependAtStart, args[1])
 556     args[length(args)] <- paste0(args[length(args)], appendAtEnd)
 557
 558     argsLength <- length(args)
 559     argLines <- list()
 560     index <- 1
 561
 562     while(index <= argsLength)
 563     {
 564         line <- args[index]
 565         index <- index + 1
 566
 567         while(nchar(line) < lineLength && index <= argsLength)
 568         {
 569             line <- paste(line, args[index])
 570             index <- index + 1
 571         }
 572
 573         argLines <- c(argLines, line)
 574     }
 575
 576     argLines <- unlist(argLines)
 577     argLinesLen <- length(argLines)
 578
 579     if(argLinesLen > 1)
 580         argLines[2:argLinesLen] <- paste0(prependToEachSplit, argLines[2:argLinesLen])
 581
 582     argLines
 583 }