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       "\t\t#' @description Test whether or not a project exists.",
 155       getMethodParams(groupsMethods[["get"]]),
 156       getMethodSignature("project_exist", getArgs),
 157       "\t\t{",
 158       paste("\t\t\tresult <- try(self$groups_get(", toCallArgs(getArgs), "))", sep=""),
 159       "\t\t\tif(inherits(result, \"try-error\"))",
 160       "\t\t\t\texists <- FALSE",
 161       "\t\t\telse",
 162       "\t\t\t\texists <- result['group_class'] == \"project\"",
 163       "\t\t\tcat(format(exists))",
 164       "\t\t},",
 165       "")
 166 }
 167
 168 genClassContent <- function(methodResources, resourceNames)
 169 {
 170     arvadosMethods <- Map(function(resource, resourceName)
 171     {
 172         methodNames <- names(resource$methods)
 173
 174         functions <- Map(function(methodMetaData, methodName)
 175         {
 176             #NOTE: Index, show and destroy are aliases for the preferred names
 177             # "list", "get" and "delete". Until they are removed from discovery
 178             # document we will filter them here.
 179             if(methodName %in% c("index", "show", "destroy"))
 180                return(NULL)
 181
 182             methodName <- paste0(resourceName, "_", methodName)
 183             unlist(c(
 184                    getMethodDoc(methodName, methodMetaData),
 185                    createMethod(methodName, methodMetaData)
 186             ))
 187
 188         }, resource$methods, methodNames)
 189
 190         unlist(unname(functions))
 191
 192     }, methodResources, resourceNames)
 193
 194     arvadosMethods
 195 }
 196
 197 genAPIClassFooter <- function()
 198 {
 199     c("\t\t#' @description Return the host name of this client's Arvados API server.",
 200       "\t\t#' @return Hostname string.",
 201       "\t\tgetHostName = function() private$host,",
 202       "",
 203       "\t\t#' @description Return the Arvados API token used by this client.",
 204       "\t\t#' @return API token string.",
 205       "\t\tgetToken = function() private$token,",
 206       "",
 207       "\t\t#' @description Set the RESTService object used by this client.",
 208       "\t\tsetRESTService = function(newREST) private$REST <- newREST,",
 209       "",
 210       "\t\t#' @description Return the RESTService object used by this client.",
 211       "\t\t#' @return RESTService object.",
 212       "\t\tgetRESTService = function() private$REST",
 213       "\t),",
 214       "",
 215       "\tprivate = list(",
 216       "",
 217       "\t\ttoken = NULL,",
 218       "\t\thost = NULL,",
 219       "\t\tREST = NULL,",
 220       "\t\tnumRetries = NULL",
 221       "\t),",
 222       "",
 223       "\tcloneable = FALSE",
 224       ")")
 225 }
 226
 227 createMethod <- function(name, methodMetaData)
 228 {
 229     args      <- getMethodArguments(methodMetaData)
 230     signature <- getMethodSignature(name, args)
 231     body      <- getMethodBody(methodMetaData)
 232
 233     c(signature,
 234       "\t\t{",
 235           body,
 236       "\t\t},\n")
 237 }
 238
 239 normalizeParamName <- function(name)
 240 {
 241     # Downcase the first letter
 242     name <- sub("^(\\w)", "\\L\\1", name, perl=TRUE)
 243     # Convert snake_case to camelCase
 244     gsub("_(uuid\\b|id\\b|\\w)", "\\U\\1", name, perl=TRUE)
 245 }
 246
 247 getMethodArguments <- function(methodMetaData)
 248 {
 249     request <- methodMetaData$request
 250     requestArgs <- NULL
 251
 252     if(!is.null(request))
 253     {
 254         resourceName <- normalizeParamName(request$properties[[1]][[1]])
 255
 256         if(request$required)
 257             requestArgs <- resourceName
 258         else
 259             requestArgs <- paste(resourceName, "=", "NULL")
 260     }
 261
 262     argNames <- names(methodMetaData$parameters)
 263
 264     args <- sapply(argNames, function(argName)
 265     {
 266         arg <- methodMetaData$parameters[[argName]]
 267         argName <- normalizeParamName(argName)
 268
 269         if(!arg$required)
 270         {
 271             return(paste(argName, "=", "NULL"))
 272         }
 273
 274         argName
 275     })
 276
 277     c(requestArgs, args)
 278 }
 279
 280 getMethodSignature <- function(methodName, args)
 281 {
 282     collapsedArgs <- paste0(args, collapse = ", ")
 283     lineLengthLimit <- 40
 284
 285     if(nchar(collapsedArgs) > lineLengthLimit)
 286     {
 287         return(paste0("\t\t",
 288                       formatArgs(paste(methodName, "= function("),
 289                                  "\t", args, ")", lineLengthLimit)))
 290     }
 291     else
 292     {
 293         return(paste0("\t\t", methodName, " = function(", collapsedArgs, ")"))
 294     }
 295 }
 296
 297 getMethodBody <- function(methodMetaData)
 298 {
 299     url              <- getRequestURL(methodMetaData)
 300     headers          <- getRequestHeaders()
 301     requestQueryList <- getRequestQueryList(methodMetaData)
 302     requestBody      <- getRequestBody(methodMetaData)
 303     request          <- getRequest(methodMetaData)
 304     response         <- getResponse(methodMetaData)
 305     errorCheck       <- getErrorCheckingCode()
 306     returnStatement  <- getReturnObject()
 307
 308     body <- c(url,
 309               headers,
 310               requestQueryList, "",
 311               requestBody, "",
 312               request, response, "",
 313               errorCheck, "",
 314               returnStatement)
 315
 316     paste0("\t\t\t", body)
 317 }
 318
 319 getRequestURL <- function(methodMetaData)
 320 {
 321     endPoint <- methodMetaData$path
 322     endPoint <- stringr::str_replace_all(endPoint, "\\{", "${")
 323     url <- c(paste0("endPoint <- stringr::str_interp(\"", endPoint, "\")"),
 324              paste0("url <- paste0(private$host, endPoint)"))
 325     url
 326 }
 327
 328 getRequestHeaders <- function()
 329 {
 330     c("headers <- list(Authorization = paste(\"Bearer\", private$token), ",
 331       "                \"Content-Type\" = \"application/json\")")
 332 }
 333
 334 getRequestQueryList <- function(methodMetaData)
 335 {
 336     queryArgs <- names(Filter(function(arg) arg$location == "query",
 337                         methodMetaData$parameters))
 338
 339     if(length(queryArgs) == 0)
 340         return("queryArgs <- NULL")
 341
 342     queryArgs <- sapply(queryArgs, function(arg) {
 343         arg <- normalizeParamName(arg)
 344         paste(arg, "=", arg)
 345     })
 346     collapsedArgs <- paste0(queryArgs, collapse = ", ")
 347
 348     lineLengthLimit <- 40
 349
 350     if(nchar(collapsedArgs) > lineLengthLimit)
 351         return(formatArgs("queryArgs <- list(", "\t\t\t\t  ", queryArgs, ")",
 352                           lineLengthLimit))
 353     else
 354         return(paste0("queryArgs <- list(", collapsedArgs, ")"))
 355 }
 356
 357 getRequestBody <- function(methodMetaData)
 358 {
 359     request <- methodMetaData$request
 360
 361     if(is.null(request) || !request$required)
 362         return("body <- NULL")
 363
 364     resourceName <- normalizeParamName(request$properties[[1]][[1]])
 365
 366     requestParameterName <- names(request$properties)[1]
 367
 368     c(paste0("if(length(", resourceName, ") > 0)"),
 369       paste0("\tbody <- jsonlite::toJSON(list(", resourceName, " = ", resourceName, "), "),
 370              "\t                         auto_unbox = TRUE)",
 371       "else",
 372       "\tbody <- NULL")
 373 }
 374
 375 getRequest <- function(methodMetaData)
 376 {
 377     method <- methodMetaData$httpMethod
 378     c(paste0("response <- private$REST$http$exec(\"", method, "\", url, headers, body,"),
 379       "                                   queryArgs, private$numRetries)")
 380 }
 381
 382 getResponse <- function(methodMetaData)
 383 {
 384     "resource <- private$REST$httpParser$parseJSONResponse(response)"
 385 }
 386
 387 getErrorCheckingCode <- function()
 388 {
 389     c("if(!is.null(resource$errors))",
 390       "\tstop(resource$errors)")
 391 }
 392
 393 getReturnObject <- function()
 394 {
 395     "resource"
 396 }
 397
 398 genAPIClassDoc <- function(methodResources, resourceNames)
 399 {
 400     c("#' @examples",
 401       "#' \\dontrun{",
 402       "#' arv <- Arvados$new(\"your Arvados token\", \"example.arvadosapi.com\")",
 403       "#'",
 404       "#' collection <- arv$collections.get(\"uuid\")",
 405       "#'",
 406       "#' collectionList <- arv$collections.list(list(list(\"name\", \"like\", \"Test%\")))",
 407       "#' collectionList <- listAll(arv$collections.list, list(list(\"name\", \"like\", \"Test%\")))",
 408       "#'",
 409       "#' deletedCollection <- arv$collections.delete(\"uuid\")",
 410       "#'",
 411       "#' updatedCollection <- arv$collections.update(list(name = \"New name\", description = \"New description\"),",
 412       "#'                                             \"uuid\")",
 413       "#'",
 414       "#' createdCollection <- arv$collections.create(list(name = \"Example\",",
 415       "#'                                                  description = \"This is a test collection\"))",
 416       "#' }",
 417       "")
 418 }
 419
 420 getAPIClassMethodList <- function(methodResources, resourceNames)
 421 {
 422     methodList <- unlist(unname(Map(function(resource, resourceName)
 423     {
 424         methodNames <- names(resource$methods)
 425         paste0(resourceName,
 426                ".",
 427                methodNames[!(methodNames %in% c("index", "show", "destroy"))])
 428
 429     }, methodResources, resourceNames)))
 430
 431     hardcodedMethods <- c("projects.create", "projects.get",
 432                           "projects.list", "projects.update", "projects.delete")
 433     paste0("#' \t\\item{}{\\code{\\link{", sort(c(methodList, hardcodedMethods)), "}}}")
 434 }
 435
 436 getMethodDoc <- function(methodName, methodMetaData)
 437 {
 438     description <- paste("\t\t#' @description", gsub("\n", "\n\t\t#' ", methodMetaData$description))
 439     params      <- getMethodParams(methodMetaData)
 440     returnValue <- paste("\t\t#' @return", methodMetaData$response[["$ref"]], "object.")
 441
 442     c(description, params, returnValue)
 443 }
 444
 445 getMethodParams <- function(methodMetaData)
 446 {
 447     request <- methodMetaData$request
 448     requestDoc <- NULL
 449
 450     if(!is.null(request))
 451     {
 452         requestDoc <- unname(unlist(sapply(request$properties, function(prop)
 453                              {
 454                                  className <- sapply(prop, function(ref) ref)
 455                                  objectName <- normalizeParamName(className)
 456                                  paste("\t\t#' @param", objectName, className, "object.")
 457                              })))
 458     }
 459
 460     argNames <- names(methodMetaData$parameters)
 461
 462     argsDoc <- unname(unlist(sapply(argNames, function(argName)
 463     {
 464         arg <- methodMetaData$parameters[[argName]]
 465         paste("\t\t#' @param",
 466               normalizeParamName(argName),
 467               gsub("\n", "\n\t\t#' ", arg$description)
 468         )
 469     })))
 470
 471     c(requestDoc, argsDoc)
 472 }
 473
 474 #NOTE: Utility functions:
 475
 476 # This function is used to split very long lines of code into smaller chunks.
 477 # This is usually the case when we pass a lot of named argumets to a function.
 478 formatArgs <- function(prependAtStart, prependToEachSplit,
 479                        args, appendAtEnd, lineLength)
 480 {
 481     if(length(args) > 1)
 482     {
 483         args[1:(length(args) - 1)] <- paste0(args[1:(length(args) - 1)], ",")
 484     }
 485
 486     args[1] <- paste0(prependAtStart, args[1])
 487     args[length(args)] <- paste0(args[length(args)], appendAtEnd)
 488
 489     argsLength <- length(args)
 490     argLines <- list()
 491     index <- 1
 492
 493     while(index <= argsLength)
 494     {
 495         line <- args[index]
 496         index <- index + 1
 497
 498         while(nchar(line) < lineLength && index <= argsLength)
 499         {
 500             line <- paste(line, args[index])
 501             index <- index + 1
 502         }
 503
 504         argLines <- c(argLines, line)
 505     }
 506
 507     argLines <- unlist(argLines)
 508     argLinesLen <- length(argLines)
 509
 510     if(argLinesLen > 1)
 511         argLines[2:argLinesLen] <- paste0(prependToEachSplit, argLines[2:argLinesLen])
 512
 513     argLines
 514 }
 515
 516 args <- commandArgs(TRUE)
 517 if (length(args) == 0) {
 518    loc <- "arvados-v1-discovery.json"
 519 } else {
 520    loc <- args[[1]]
 521 }
 522 discoveryDocument <- getAPIDocument(loc)
 523 generateAPI(discoveryDocument)