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