sdk/R/generateApi.R

   1 # Copyright (C) The Arvados Authors. All rights reserved.
   2 #
   3 # SPDX-License-Identifier: Apache-2.0
   4
   5 library(jsonlite)
   6
   7 getAPIDocument <- function(loc)
   8 {
   9     if (length(grep("^[a-z]+://", loc)) > 0) {
  10         library(httr)
  11         serverResponse <- httr::RETRY("GET", url = loc)
  12         httr::content(serverResponse, as = "parsed", type = "application/json")
  13     } else {
  14         jsonlite::read_json(loc)
  15     }
  16 }
  17
  18 #' generateAPI
  19 #'
  20 #' Autogenerate classes to interact with Arvados from the Arvados discovery document.
  21 #'
  22 #' @export
  23 generateAPI <- function(discoveryDocument)
  24 {
  25     methodResources <- discoveryDocument$resources
  26     resourceNames   <- names(methodResources)
  27
  28     classDoc <- genAPIClassDoc(methodResources, resourceNames)
  29     arvadosAPIHeader <- genAPIClassHeader()
  30     arvadosClassMethods <- genClassContent(methodResources, resourceNames)
  31     arvadosProjectMethods <- genProjectMethods(methodResources)
  32     arvadosAPIFooter <- genAPIClassFooter()
  33
  34     arvadosClass <- c(classDoc,
  35                       arvadosAPIHeader,
  36                       arvadosClassMethods,
  37                       arvadosProjectMethods,
  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",
  45     "",
  46     "#' Arvados",
  47     "#'",
  48     "#' This class implements a full REST client to the Arvados API.",
  49     "#'"), fileConn)
  50     writeLines(unlist(arvadosClass), fileConn)
  51     close(fileConn)
  52     NULL
  53 }
  54
  55 genAPIClassHeader <- function()
  56 {
  57     c("#' @export",
  58       "Arvados <- R6::R6Class(",
  59       "",
  60       "\t\"Arvados\",",
  61       "",
  62       "\tpublic = list(",
  63       "",
  64       "\t\t#' @description Create a new Arvados API client.",
  65       "\t\t#' @param authToken Authentification token. If not specified ARVADOS_API_TOKEN environment variable will be used.",
  66       "\t\t#' @param hostName Host name. If not specified ARVADOS_API_HOST environment variable will be used.",
  67       "\t\t#' @param numRetries Number which specifies how many times to retry failed service requests.",
  68       "\t\t#' @return A new `Arvados` object.",
  69       "\t\tinitialize = function(authToken = NULL, hostName = NULL, numRetries = 0)",
  70       "\t\t{",
  71       "\t\t\tif(!is.null(hostName))",
  72       "\t\t\t\tSys.setenv(ARVADOS_API_HOST = hostName)",
  73       "",
  74       "\t\t\tif(!is.null(authToken))",
  75       "\t\t\t\tSys.setenv(ARVADOS_API_TOKEN = authToken)",
  76       "",
  77       "\t\t\thostName <- Sys.getenv(\"ARVADOS_API_HOST\")",
  78       "\t\t\ttoken    <- Sys.getenv(\"ARVADOS_API_TOKEN\")",
  79       "",
  80       "\t\t\tif(hostName == \"\" | token == \"\")",
  81       "\t\t\t\tstop(paste(\"Please provide host name and authentification token\",",
  82       "\t\t\t\t\t\t   \"or set ARVADOS_API_HOST and ARVADOS_API_TOKEN\",",
  83       "\t\t\t\t\t\t   \"environment variables.\"))",
  84       "",
  85       "\t\t\tprivate$token <- token",
  86       "\t\t\tprivate$host  <- paste0(\"https://\", hostName, \"/arvados/v1/\")",
  87       "\t\t\tprivate$numRetries <- numRetries",
  88       "\t\t\tprivate$REST <- RESTService$new(token, hostName,",
  89       "\t\t\t                                HttpRequest$new(), HttpParser$new(),",
  90       "\t\t\t                                numRetries)",
  91       "",
  92       "\t\t},\n")
  93 }
  94
  95 genProjectMethods <- function(methodResources)
  96 {
  97     toCallArg <- function(arg) {
  98         callArg <- strsplit(arg, " *=")[[1]][1]
  99         paste(callArg, callArg, sep=" = ")
 100     }
 101     toCallArgs <- function(argList) {
 102         paste0(Map(toCallArg, argList), collapse=", ")
 103     }
 104     groupsMethods <- methodResources[["groups"]][["methods"]]
 105     getArgs <- getMethodArguments(groupsMethods[["get"]])
 106     createArgs <- getMethodArguments(groupsMethods[["create"]])
 107     updateArgs <- getMethodArguments(groupsMethods[["update"]])
 108     listArgs <- getMethodArguments(groupsMethods[["list"]])
 109     deleteArgs <- getMethodArguments(groupsMethods[["delete"]])
 110
 111     c("\t\t#' @description An alias for `groups_get`.",
 112       getMethodParams(groupsMethods[["get"]]),
 113       "\t\t#' @return A Group object.",
 114       getMethodSignature("project_get", getArgs),
 115       "\t\t{",
 116       paste("\t\t\tself$groups_get(", toCallArgs(getArgs), ")", sep=""),
 117       "\t\t},",
 118       "",
 119       "\t\t#' @description A wrapper for `groups_create` that sets `group_class=\"project\"`.",
 120       getMethodParams(groupsMethods[["create"]]),
 121       "\t\t#' @return A Group object.",
 122       getMethodSignature("project_create", createArgs),
 123       "\t\t{",
 124       "\t\t\tgroup <- c(\"group_class\" = \"project\", group)",
 125       paste("\t\t\tself$groups_create(", toCallArgs(createArgs), ")", sep=""),
 126       "\t\t},",
 127       "",
 128       "\t\t#' @description A wrapper for `groups_update` that sets `group_class=\"project\"`.",
 129       getMethodParams(groupsMethods[["update"]]),
 130       "\t\t#' @return A Group object.",
 131       getMethodSignature("project_update", updateArgs),
 132       "\t\t{",
 133       "\t\t\tgroup <- c(\"group_class\" = \"project\", group)",
 134       paste("\t\t\tself$groups_update(", toCallArgs(updateArgs), ")", sep=""),
 135       "\t\t},",
 136       "",
 137       "\t\t#' @description A wrapper for `groups_list` that adds a filter for `group_class=\"project\"`.",
 138       getMethodParams(groupsMethods[["list"]]),
 139       "\t\t#' @return A GroupList object.",
 140       getMethodSignature("project_list", listArgs),
 141       "\t\t{",
 142       "\t\t\tfilters[[length(filters) + 1]] <- list(\"group_class\", \"=\", \"project\")",
 143       paste("\t\t\tself$groups_list(", toCallArgs(listArgs), ")", sep=""),
 144       "\t\t},",
 145       "",
 146       "\t\t#' @description An alias for `groups_delete`.",
 147       getMethodParams(groupsMethods[["delete"]]),
 148       "\t\t#' @return A Group object.",
 149       getMethodSignature("project_delete", deleteArgs),
 150       "\t\t{",
 151       paste("\t\t\tself$groups_delete(", toCallArgs(deleteArgs), ")", sep=""),
 152       "\t\t},",
 153       "")
 154 }
 155
 156 genClassContent <- function(methodResources, resourceNames)
 157 {
 158     arvadosMethods <- Map(function(resource, resourceName)
 159     {
 160         methodNames <- names(resource$methods)
 161
 162         functions <- Map(function(methodMetaData, methodName)
 163         {
 164             #NOTE: Index, show and destroy are aliases for the preferred names
 165             # "list", "get" and "delete". Until they are removed from discovery
 166             # document we will filter them here.
 167             if(methodName %in% c("index", "show", "destroy"))
 168                return(NULL)
 169
 170             methodName <- paste0(resourceName, "_", methodName)
 171             unlist(c(
 172                    getMethodDoc(methodName, methodMetaData),
 173                    createMethod(methodName, methodMetaData)
 174             ))
 175
 176         }, resource$methods, methodNames)
 177
 178         unlist(unname(functions))
 179
 180     }, methodResources, resourceNames)
 181
 182     arvadosMethods
 183 }
 184
 185 genAPIClassFooter <- function()
 186 {
 187     c("\t\t#' @description Return the host name of this client's Arvados API server.",
 188       "\t\t#' @return Hostname string.",
 189       "\t\tgetHostName = function() private$host,",
 190       "",
 191       "\t\t#' @description Return the Arvados API token used by this client.",
 192       "\t\t#' @return API token string.",
 193       "\t\tgetToken = function() private$token,",
 194       "",
 195       "\t\t#' @description Set the RESTService object used by this client.",
 196       "\t\tsetRESTService = function(newREST) private$REST <- newREST,",
 197       "",
 198       "\t\t#' @description Return the RESTService object used by this client.",
 199       "\t\t#' @return RESTService object.",
 200       "\t\tgetRESTService = function() private$REST",
 201       "\t),",
 202       "",
 203       "\tprivate = list(",
 204       "",
 205       "\t\ttoken = NULL,",
 206       "\t\thost = NULL,",
 207       "\t\tREST = NULL,",
 208       "\t\tnumRetries = NULL",
 209       "\t),",
 210       "",
 211       "\tcloneable = FALSE",
 212       ")")
 213 }
 214
 215 createMethod <- function(name, methodMetaData)
 216 {
 217     args      <- getMethodArguments(methodMetaData)
 218     signature <- getMethodSignature(name, args)
 219     body      <- getMethodBody(methodMetaData)
 220
 221     c(signature,
 222       "\t\t{",
 223           body,
 224       "\t\t},\n")
 225 }
 226
 227 normalizeParamName <- function(name)
 228 {
 229     # Downcase the first letter
 230     name <- sub("^(\\w)", "\\L\\1", name, perl=TRUE)
 231     # Convert snake_case to camelCase
 232     gsub("_(uuid\\b|id\\b|\\w)", "\\U\\1", name, perl=TRUE)
 233 }
 234
 235 getMethodArguments <- function(methodMetaData)
 236 {
 237     request <- methodMetaData$request
 238     requestArgs <- NULL
 239
 240     if(!is.null(request))
 241     {
 242         resourceName <- normalizeParamName(request$properties[[1]][[1]])
 243
 244         if(request$required)
 245             requestArgs <- resourceName
 246         else
 247             requestArgs <- paste(resourceName, "=", "NULL")
 248     }
 249
 250     argNames <- names(methodMetaData$parameters)
 251
 252     args <- sapply(argNames, function(argName)
 253     {
 254         arg <- methodMetaData$parameters[[argName]]
 255         argName <- normalizeParamName(argName)
 256
 257         if(!arg$required)
 258         {
 259             return(paste(argName, "=", "NULL"))
 260         }
 261
 262         argName
 263     })
 264
 265     c(requestArgs, args)
 266 }
 267
 268 getMethodSignature <- function(methodName, args)
 269 {
 270     collapsedArgs <- paste0(args, collapse = ", ")
 271     lineLengthLimit <- 40
 272
 273     if(nchar(collapsedArgs) > lineLengthLimit)
 274     {
 275         return(paste0("\t\t",
 276                       formatArgs(paste(methodName, "= function("),
 277                                  "\t", args, ")", lineLengthLimit)))
 278     }
 279     else
 280     {
 281         return(paste0("\t\t", methodName, " = function(", collapsedArgs, ")"))
 282     }
 283 }
 284
 285 getMethodBody <- function(methodMetaData)
 286 {
 287     url              <- getRequestURL(methodMetaData)
 288     headers          <- getRequestHeaders()
 289     requestQueryList <- getRequestQueryList(methodMetaData)
 290     requestBody      <- getRequestBody(methodMetaData)
 291     request          <- getRequest(methodMetaData)
 292     response         <- getResponse(methodMetaData)
 293     errorCheck       <- getErrorCheckingCode()
 294     returnStatement  <- getReturnObject()
 295
 296     body <- c(url,
 297               headers,
 298               requestQueryList, "",
 299               requestBody, "",
 300               request, response, "",
 301               errorCheck, "",
 302               returnStatement)
 303
 304     paste0("\t\t\t", body)
 305 }
 306
 307 getRequestURL <- function(methodMetaData)
 308 {
 309     endPoint <- methodMetaData$path
 310     endPoint <- stringr::str_replace_all(endPoint, "\\{", "${")
 311     url <- c(paste0("endPoint <- stringr::str_interp(\"", endPoint, "\")"),
 312              paste0("url <- paste0(private$host, endPoint)"))
 313     url
 314 }
 315
 316 getRequestHeaders <- function()
 317 {
 318     c("headers <- list(Authorization = paste(\"Bearer\", private$token), ",
 319       "                \"Content-Type\" = \"application/json\")")
 320 }
 321
 322 getRequestQueryList <- function(methodMetaData)
 323 {
 324     queryArgs <- names(Filter(function(arg) arg$location == "query",
 325                         methodMetaData$parameters))
 326
 327     if(length(queryArgs) == 0)
 328         return("queryArgs <- NULL")
 329
 330     queryArgs <- sapply(queryArgs, function(arg) {
 331         arg <- normalizeParamName(arg)
 332         paste(arg, "=", arg)
 333     })
 334     collapsedArgs <- paste0(queryArgs, collapse = ", ")
 335
 336     lineLengthLimit <- 40
 337
 338     if(nchar(collapsedArgs) > lineLengthLimit)
 339         return(formatArgs("queryArgs <- list(", "\t\t\t\t  ", queryArgs, ")",
 340                           lineLengthLimit))
 341     else
 342         return(paste0("queryArgs <- list(", collapsedArgs, ")"))
 343 }
 344
 345 getRequestBody <- function(methodMetaData)
 346 {
 347     request <- methodMetaData$request
 348
 349     if(is.null(request) || !request$required)
 350         return("body <- NULL")
 351
 352     resourceName <- normalizeParamName(request$properties[[1]][[1]])
 353
 354     requestParameterName <- names(request$properties)[1]
 355
 356     c(paste0("if(length(", resourceName, ") > 0)"),
 357       paste0("\tbody <- jsonlite::toJSON(list(", resourceName, " = ", resourceName, "), "),
 358              "\t                         auto_unbox = TRUE)",
 359       "else",
 360       "\tbody <- NULL")
 361 }
 362
 363 getRequest <- function(methodMetaData)
 364 {
 365     method <- methodMetaData$httpMethod
 366     c(paste0("response <- private$REST$http$exec(\"", method, "\", url, headers, body,"),
 367       "                                   queryArgs, private$numRetries)")
 368 }
 369
 370 getResponse <- function(methodMetaData)
 371 {
 372     "resource <- private$REST$httpParser$parseJSONResponse(response)"
 373 }
 374
 375 getErrorCheckingCode <- function()
 376 {
 377     c("if(!is.null(resource$errors))",
 378       "\tstop(resource$errors)")
 379 }
 380
 381 getReturnObject <- function()
 382 {
 383     "resource"
 384 }
 385
 386 genAPIClassDoc <- function(methodResources, resourceNames)
 387 {
 388     c("#' @examples",
 389       "#' \\dontrun{",
 390       "#' arv <- Arvados$new(\"your Arvados token\", \"example.arvadosapi.com\")",
 391       "#'",
 392       "#' collection <- arv$collections.get(\"uuid\")",
 393       "#'",
 394       "#' collectionList <- arv$collections.list(list(list(\"name\", \"like\", \"Test%\")))",
 395       "#' collectionList <- listAll(arv$collections.list, list(list(\"name\", \"like\", \"Test%\")))",
 396       "#'",
 397       "#' deletedCollection <- arv$collections.delete(\"uuid\")",
 398       "#'",
 399       "#' updatedCollection <- arv$collections.update(list(name = \"New name\", description = \"New description\"),",
 400       "#'                                             \"uuid\")",
 401       "#'",
 402       "#' createdCollection <- arv$collections.create(list(name = \"Example\",",
 403       "#'                                                  description = \"This is a test collection\"))",
 404       "#' }",
 405       "")
 406 }
 407
 408 getAPIClassMethodList <- function(methodResources, resourceNames)
 409 {
 410     methodList <- unlist(unname(Map(function(resource, resourceName)
 411     {
 412         methodNames <- names(resource$methods)
 413         paste0(resourceName,
 414                ".",
 415                methodNames[!(methodNames %in% c("index", "show", "destroy"))])
 416
 417     }, methodResources, resourceNames)))
 418
 419     hardcodedMethods <- c("projects.create", "projects.get",
 420                           "projects.list", "projects.update", "projects.delete")
 421     paste0("#' \t\\item{}{\\code{\\link{", sort(c(methodList, hardcodedMethods)), "}}}")
 422 }
 423
 424 getMethodDoc <- function(methodName, methodMetaData)
 425 {
 426     description <- paste("\t\t#' @description", gsub("\n", "\n\t\t#' ", methodMetaData$description))
 427     params      <- getMethodParams(methodMetaData)
 428     returnValue <- paste("\t\t#' @return", methodMetaData$response[["$ref"]], "object.")
 429
 430     c(description, params, returnValue)
 431 }
 432
 433 getMethodParams <- function(methodMetaData)
 434 {
 435     request <- methodMetaData$request
 436     requestDoc <- NULL
 437
 438     if(!is.null(request))
 439     {
 440         requestDoc <- unname(unlist(sapply(request$properties, function(prop)
 441                              {
 442                                  className <- sapply(prop, function(ref) ref)
 443                                  objectName <- normalizeParamName(className)
 444                                  paste("\t\t#' @param", objectName, className, "object.")
 445                              })))
 446     }
 447
 448     argNames <- names(methodMetaData$parameters)
 449
 450     argsDoc <- unname(unlist(sapply(argNames, function(argName)
 451     {
 452         arg <- methodMetaData$parameters[[argName]]
 453         paste("\t\t#' @param",
 454               normalizeParamName(argName),
 455               gsub("\n", "\n\t\t#' ", arg$description)
 456         )
 457     })))
 458
 459     c(requestDoc, argsDoc)
 460 }
 461
 462 #NOTE: Utility functions:
 463
 464 # This function is used to split very long lines of code into smaller chunks.
 465 # This is usually the case when we pass a lot of named argumets to a function.
 466 formatArgs <- function(prependAtStart, prependToEachSplit,
 467                        args, appendAtEnd, lineLength)
 468 {
 469     if(length(args) > 1)
 470     {
 471         args[1:(length(args) - 1)] <- paste0(args[1:(length(args) - 1)], ",")
 472     }
 473
 474     args[1] <- paste0(prependAtStart, args[1])
 475     args[length(args)] <- paste0(args[length(args)], appendAtEnd)
 476
 477     argsLength <- length(args)
 478     argLines <- list()
 479     index <- 1
 480
 481     while(index <= argsLength)
 482     {
 483         line <- args[index]
 484         index <- index + 1
 485
 486         while(nchar(line) < lineLength && index <= argsLength)
 487         {
 488             line <- paste(line, args[index])
 489             index <- index + 1
 490         }
 491
 492         argLines <- c(argLines, line)
 493     }
 494
 495     argLines <- unlist(argLines)
 496     argLinesLen <- length(argLines)
 497
 498     if(argLinesLen > 1)
 499         argLines[2:argLinesLen] <- paste0(prependToEachSplit, argLines[2:argLinesLen])
 500
 501     argLines
 502 }
 503
 504 args <- commandArgs(TRUE)
 505 if (length(args) == 0) {
 506    loc <- "arvados-v1-discovery.json"
 507 } else {
 508    loc <- args[[1]]
 509 }
 510 discoveryDocument <- getAPIDocument(loc)
 511 generateAPI(discoveryDocument)