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://ce8i5.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     resourceNames   <- names(methodResources)
  21
  22     methodDoc <- genMethodsDoc(methodResources, resourceNames)
  23     classDoc <- genAPIClassDoc(methodResources, resourceNames)
  24     arvadosAPIHeader <- genAPIClassHeader()
  25     arvadosProjectMethods <- genProjectMethods()
  26     arvadosClassMethods <- genClassContent(methodResources, resourceNames)
  27     arvadosAPIFooter <- genAPIClassFooter()
  28
  29     arvadosClass <- c(methodDoc,
  30                       classDoc,
  31                       arvadosAPIHeader,
  32                       arvadosProjectMethods,
  33                       arvadosClassMethods,
  34                       arvadosAPIFooter)
  35
  36     fileConn <- file("./R/Arvados.R", "w")
  37     writeLines(unlist(arvadosClass), fileConn)
  38     close(fileConn)
  39     NULL
  40 }
  41
  42 genAPIClassHeader <- function()
  43 {
  44     c("Arvados <- R6::R6Class(",
  45       "",
  46       "\t\"Arvados\",",
  47       "",
  48       "\tpublic = list(",
  49       "",
  50       "\t\tinitialize = function(authToken = NULL, hostName = NULL, numRetries = 0)",
  51       "\t\t{",
  52       "\t\t\tif(!is.null(hostName))",
  53       "\t\t\t\tSys.setenv(ARVADOS_API_HOST = hostName)",
  54       "",
  55       "\t\t\tif(!is.null(authToken))",
  56       "\t\t\t\tSys.setenv(ARVADOS_API_TOKEN = authToken)",
  57       "",
  58       "\t\t\thostName <- Sys.getenv(\"ARVADOS_API_HOST\")",
  59       "\t\t\ttoken    <- Sys.getenv(\"ARVADOS_API_TOKEN\")",
  60       "",
  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.\"))",
  65       "",
  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(),",
  71       "\t\t\t                                numRetries)",
  72       "",
  73       "\t\t},\n")
  74 }
  75
  76 genProjectMethods <- function()
  77 {
  78     c("\t\tprojects.get = function(uuid)",
  79       "\t\t{",
  80       "\t\t\tself$groups.get(uuid)",
  81       "\t\t},",
  82       "",
  83       "\t\tprojects.create = function(group, ensure_unique_name = \"false\")",
  84       "\t\t{",
  85       "\t\t\tgroup <- c(\"group_class\" = \"project\", group)",
  86       "\t\t\tself$groups.create(group, ensure_unique_name)",
  87       "\t\t},",
  88       "",
  89       "\t\tprojects.update = function(group, uuid)",
  90       "\t\t{",
  91       "\t\t\tgroup <- c(\"group_class\" = \"project\", group)",
  92       "\t\t\tself$groups.update(group, uuid)",
  93       "\t\t},",
  94       "",
  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)",
  99       "\t\t{",
 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)",
 103       "\t\t},",
 104       "",
 105       "\t\tprojects.delete = function(uuid)",
 106       "\t\t{",
 107       "\t\t\tself$groups.delete(uuid)",
 108       "\t\t},",
 109       "")
 110 }
 111
 112 genClassContent <- function(methodResources, resourceNames)
 113 {
 114     arvadosMethods <- Map(function(resource, resourceName)
 115     {
 116         methodNames <- names(resource$methods)
 117
 118         functions <- Map(function(methodMetaData, methodName)
 119         {
 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"))
 124                return(NULL)
 125
 126             methodName <- paste0(resourceName, ".", methodName)
 127             createMethod(methodName, methodMetaData)
 128
 129         }, resource$methods, methodNames)
 130
 131         unlist(unname(functions))
 132
 133     }, methodResources, resourceNames)
 134
 135     arvadosMethods
 136 }
 137
 138 genAPIClassFooter <- function()
 139 {
 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",
 144       "\t),",
 145       "",
 146       "\tprivate = list(",
 147       "",
 148       "\t\ttoken = NULL,",
 149       "\t\thost = NULL,",
 150       "\t\tREST = NULL,",
 151       "\t\tnumRetries = NULL",
 152       "\t),",
 153       "",
 154       "\tcloneable = FALSE",
 155       ")")
 156 }
 157
 158 createMethod <- function(name, methodMetaData)
 159 {
 160     args      <- getMethodArguments(methodMetaData)
 161     signature <- getMethodSignature(name, args)
 162     body      <- getMethodBody(methodMetaData)
 163
 164     c(signature,
 165       "\t\t{",
 166           body,
 167       "\t\t},\n")
 168 }
 169
 170 getMethodArguments <- function(methodMetaData)
 171 {
 172     request <- methodMetaData$request
 173     requestArgs <- NULL
 174
 175     if(!is.null(request))
 176     {
 177         resourceName <- tolower(request$properties[[1]][[1]])
 178
 179         if(request$required)
 180             requestArgs <- resourceName
 181         else
 182             requestArgs <- paste(resourceName, "=", "NULL")
 183     }
 184
 185     argNames <- names(methodMetaData$parameters)
 186
 187     args <- sapply(argNames, function(argName)
 188     {
 189         arg <- methodMetaData$parameters[[argName]]
 190
 191         if(!arg$required)
 192         {
 193             if(!is.null(arg$default))
 194                 return(paste0(argName, " = ", "\"", arg$default, "\""))
 195             else
 196                 return(paste(argName, "=", "NULL"))
 197         }
 198
 199         argName
 200     })
 201
 202     c(requestArgs, args)
 203 }
 204
 205 getMethodSignature <- function(methodName, args)
 206 {
 207     collapsedArgs <- paste0(args, collapse = ", ")
 208     lineLengthLimit <- 40
 209
 210     if(nchar(collapsedArgs) > lineLengthLimit)
 211     {
 212         return(paste0("\t\t",
 213                       formatArgs(paste(methodName, "= function("),
 214                                  "\t", args, ")", lineLengthLimit)))
 215     }
 216     else
 217     {
 218         return(paste0("\t\t", methodName, " = function(", collapsedArgs, ")"))
 219     }
 220 }
 221
 222 getMethodBody <- function(methodMetaData)
 223 {
 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()
 232
 233     body <- c(url,
 234               headers,
 235               requestQueryList, "",
 236               requestBody, "",
 237               request, response, "",
 238               errorCheck, "",
 239               returnStatement)
 240
 241     paste0("\t\t\t", body)
 242 }
 243
 244 getRequestURL <- function(methodMetaData)
 245 {
 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)"))
 250     url
 251 }
 252
 253 getRequestHeaders <- function()
 254 {
 255     c("headers <- list(Authorization = paste(\"OAuth2\", private$token), ",
 256       "                \"Content-Type\" = \"application/json\")")
 257 }
 258
 259 getRequestQueryList <- function(methodMetaData)
 260 {
 261     queryArgs <- names(Filter(function(arg) arg$location == "query",
 262                         methodMetaData$parameters))
 263
 264     if(length(queryArgs) == 0)
 265         return("queryArgs <- NULL")
 266
 267     queryArgs <- sapply(queryArgs, function(arg) paste0(arg, " = ", arg))
 268     collapsedArgs <- paste0(queryArgs, collapse = ", ")
 269
 270     lineLengthLimit <- 40
 271
 272     if(nchar(collapsedArgs) > lineLengthLimit)
 273         return(formatArgs("queryArgs <- list(", "\t\t\t\t  ", queryArgs, ")",
 274                           lineLengthLimit))
 275     else
 276         return(paste0("queryArgs <- list(", collapsedArgs, ")"))
 277 }
 278
 279 getRequestBody <- function(methodMetaData)
 280 {
 281     request <- methodMetaData$request
 282
 283     if(is.null(request) || !request$required)
 284         return("body <- NULL")
 285
 286     resourceName <- tolower(request$properties[[1]][[1]])
 287
 288     requestParameterName <- names(request$properties)[1]
 289
 290     c(paste0("if(length(", resourceName, ") > 0)"),
 291       paste0("\tbody <- jsonlite::toJSON(list(", resourceName, " = ", resourceName, "), "),
 292              "\t                         auto_unbox = TRUE)",
 293       "else",
 294       "\tbody <- NULL")
 295 }
 296
 297 getRequest <- function(methodMetaData)
 298 {
 299     method <- methodMetaData$httpMethod
 300     c(paste0("response <- private$REST$http$exec(\"", method, "\", url, headers, body,"),
 301       "                                   queryArgs, private$numRetries)")
 302 }
 303
 304 getResponse <- function(methodMetaData)
 305 {
 306     "resource <- private$REST$httpParser$parseJSONResponse(response)"
 307 }
 308
 309 getErrorCheckingCode <- function()
 310 {
 311     c("if(!is.null(resource$errors))",
 312       "\tstop(resource$errors)")
 313 }
 314
 315 getReturnObject <- function()
 316 {
 317     "resource"
 318 }
 319
 320 #NOTE: Arvados class documentation:
 321
 322 genMethodsDoc <- function(methodResources, resourceNames)
 323 {
 324     methodsDoc <- unlist(unname(Map(function(resource, resourceName)
 325     {
 326         methodNames <- names(resource$methods)
 327
 328         methodDoc <- Map(function(methodMetaData, methodName)
 329         {
 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"))
 334                return(NULL)
 335
 336             methodName <- paste0(resourceName, ".", methodName)
 337             getMethodDoc(methodName, methodMetaData)
 338
 339         }, resource$methods, methodNames)
 340
 341         unlist(unname(methodDoc))
 342
 343     }, methodResources, resourceNames)))
 344
 345     projectDoc <- genProjectMethodsDoc()
 346
 347     c(methodsDoc, projectDoc)
 348 }
 349
 350 genAPIClassDoc <- function(methodResources, resourceNames)
 351 {
 352     c("#' Arvados",
 353       "#'",
 354       "#' Arvados class gives users ability to access Arvados REST API.",
 355       "#'" ,
 356       "#' @section Usage:",
 357       "#' \\preformatted{arv = Arvados$new(authToken = NULL, hostName = NULL, numRetries = 0)}",
 358       "#'",
 359       "#' @section Arguments:",
 360       "#' \\describe{",
 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.}",
 364       "#' }",
 365       "#'",
 366       "#' @section Methods:",
 367       "#' \\describe{",
 368       getAPIClassMethodList(methodResources, resourceNames),
 369       "#' }",
 370       "#'",
 371       "#' @name Arvados",
 372       "#' @examples",
 373       "#' \\dontrun{",
 374       "#' arv <- Arvados$new(\"your Arvados token\", \"example.arvadosapi.com\")",
 375       "#'",
 376       "#' collection <- arv$collections.get(\"uuid\")",
 377       "#'",
 378       "#' collectionList <- arv$collections.list(list(list(\"name\", \"like\", \"Test%\")))",
 379       "#' collectionList <- listAll(arv$collections.list, list(list(\"name\", \"like\", \"Test%\")))",
 380       "#'",
 381       "#' deletedCollection <- arv$collections.delete(\"uuid\")",
 382       "#'",
 383       "#' updatedCollection <- arv$collections.update(list(name = \"New name\", description = \"New description\"),",
 384       "#'                                             \"uuid\")",
 385       "#'",
 386       "#' createdCollection <- arv$collections.create(list(name = \"Example\",",
 387       "#'                                                  description = \"This is a test collection\"))",
 388       "#' }",
 389       "NULL",
 390       "",
 391       "#' @export")
 392 }
 393
 394 getAPIClassMethodList <- function(methodResources, resourceNames)
 395 {
 396     methodList <- unlist(unname(Map(function(resource, resourceName)
 397     {
 398         methodNames <- names(resource$methods)
 399         paste0(resourceName,
 400                ".",
 401                methodNames[!(methodNames %in% c("index", "show", "destroy"))])
 402
 403     }, methodResources, resourceNames)))
 404
 405     hardcodedMethods <- c("projects.create", "projects.get",
 406                           "projects.list", "projects.update", "projects.delete")
 407     paste0("#' \t\\item{}{\\code{\\link{", sort(c(methodList, hardcodedMethods)), "}}}")
 408 }
 409
 410 getMethodDoc <- function(methodName, methodMetaData)
 411 {
 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.")
 417
 418     c(paste("#'", methodName),
 419       "#' ",
 420       description,
 421       "#' ",
 422       usage,
 423       params,
 424       returnValue,
 425       name,
 426       "NULL",
 427       "")
 428 }
 429
 430 getMethodUsage <- function(methodName, methodMetaData)
 431 {
 432     lineLengthLimit <- 40
 433     args <- getMethodArguments(methodMetaData)
 434     c(formatArgs(paste0("#' @usage arv$", methodName,
 435                         "("), "#' \t", args, ")", lineLengthLimit))
 436 }
 437
 438 getMethodDescription <- function(methodMetaData)
 439 {
 440     request <- methodMetaData$request
 441     requestDoc <- NULL
 442
 443     if(!is.null(request))
 444     {
 445         requestDoc <- unname(unlist(sapply(request$properties, function(prop)
 446                              {
 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.")
 451                              })))
 452     }
 453
 454     argNames <- names(methodMetaData$parameters)
 455
 456     argsDoc <- unname(unlist(sapply(argNames, function(argName)
 457     {
 458         arg <- methodMetaData$parameters[[argName]]
 459         argDescription <- arg$description
 460         paste("#' @param", argName, argDescription)
 461     })))
 462
 463     c(requestDoc, argsDoc)
 464 }
 465
 466 genProjectMethodsDoc <- function()
 467 {
 468     #TODO: Manually update this documentation to reflect changes in discovery document.
 469     c("#' project.get",
 470     "#' ",
 471     "#' projects.get is equivalent to groups.get method.",
 472     "#' ",
 473     "#' @usage arv$projects.get(uuid)",
 474     "#' @param uuid The UUID of the Group in question.",
 475     "#' @return Group object.",
 476     "#' @name projects.get",
 477     "NULL",
 478     "",
 479     "#' project.create",
 480     "#' ",
 481     "#' projects.create wrapps groups.create method by setting group_class attribute to \"project\".",
 482     "#' ",
 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",
 488     "NULL",
 489     "",
 490     "#' project.update",
 491     "#' ",
 492     "#' projects.update wrapps groups.update method by setting group_class attribute to \"project\".",
 493     "#' ",
 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",
 499     "NULL",
 500     "",
 501     "#' project.delete",
 502     "#' ",
 503     "#' projects.delete is equivalent to groups.delete method.",
 504     "#' ",
 505     "#' @usage arv$project.delete(uuid)",
 506     "#' @param uuid The UUID of the Group in question.",
 507     "#' @return Group object.",
 508     "#' @name projects.delete",
 509     "NULL",
 510     "",
 511     "#' project.list",
 512     "#' ",
 513     "#' projects.list wrapps groups.list method by setting group_class attribute to \"project\".",
 514     "#' ",
 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 ",
 520     "#' @param where ",
 521     "#' @param order ",
 522     "#' @param distinct ",
 523     "#' @param limit ",
 524     "#' @param offset ",
 525     "#' @param count ",
 526     "#' @param include_trash Include items whose is_trashed attribute is true.",
 527     "#' @param uuid ",
 528     "#' @param recursive Include contents from child groups recursively.",
 529     "#' @return Group object.",
 530     "#' @name projects.list",
 531     "NULL",
 532     "")
 533 }
 534
 535 #NOTE: Utility functions:
 536
 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)
 541 {
 542     if(length(args) > 1)
 543     {
 544         args[1:(length(args) - 1)] <- paste0(args[1:(length(args) - 1)], ",")
 545     }
 546
 547     args[1] <- paste0(prependAtStart, args[1])
 548     args[length(args)] <- paste0(args[length(args)], appendAtEnd)
 549
 550     argsLength <- length(args)
 551     argLines <- list()
 552     index <- 1
 553
 554     while(index <= argsLength)
 555     {
 556         line <- args[index]
 557         index <- index + 1
 558
 559         while(nchar(line) < lineLength && index <= argsLength)
 560         {
 561             line <- paste(line, args[index])
 562             index <- index + 1
 563         }
 564
 565         argLines <- c(argLines, line)
 566     }
 567
 568     argLines <- unlist(argLines)
 569     argLinesLen <- length(argLines)
 570
 571     if(argLinesLen > 1)
 572         argLines[2:argLinesLen] <- paste0(prependToEachSplit, argLines[2:argLinesLen])
 573
 574     argLines
 575 }