Merge pull request #14 from Bioconductor/master

merge for CRAN release v0.1.3

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: rapiclient
 Type: Package
 Title: Dynamic OpenAPI/Swagger Client
-Version: 0.1.2.3
+Version: 0.1.3
 Authors@R: person("Darko", "Bergant", email = "[email protected]",
                   role = c("aut", "cre"))
 URL: https://github.com/bergant/rapiclient

R/operations.R

@@ -37,14 +37,14 @@ get_api <- function(url, config = NULL) {
               api <- yaml::yaml.load_file(url0)
               close(url0)
           } else {
-              yaml::yaml.load_file(url)
+              api <- yaml::yaml.load_file(url)
           }
       }, error = function(x) NULL)
   if (is.null(api))
       stop("'url' does not appear to be JSON or YAML")
 
   # swagger element is required
-  if(is.null(api$swagger)) {
+  if (is.null(api$swagger)) {
     warning("Missing Swagger Specification version")
   }
   # Info element is required
@@ -110,7 +110,8 @@ get_operation_definitions <- function(api, path = NULL) {
     path_names <- path_names[grep(path, path_names)]
   }
   for(path_name in path_names) {
-    action_types <- c("post", "get", "delete", "put")
+    action_types <-
+      c("post", "patch", "get", "head", "delete", "put")
     # parameters may be defined on the path level
 
     for(action in intersect(names(api$paths[[path_name]]), action_types)) {
@@ -169,7 +170,7 @@ get_operation_definitions <- function(api, path = NULL) {
       ret <- c(ret, stats::setNames(list(operation), operation$operationId))
     }
   }
-  ret
+  stats::setNames(ret, trimws(names(ret)))
 }
 
 
@@ -249,21 +250,49 @@ get_operations <- function(api, .headers = NULL, path = NULL,
       return(url)
     }
 
-    get_config <- function(x) {
+    get_config <- function() {
       api$config
     }
 
+    get_accept <- function(op_def) {
+      if (is.null(op_def$produces)) {
+        httr::accept_json()
+      } else {
+        httr::accept(op_def$produces)
+      }
+    }
+
     # function body
     if(op_def$action == "post") {
       tmp_fun <- function() {
         x <- eval(param_values)
         request_json <- get_message_body(op_def, x)
+        consumes <- ifelse(
+            is.null(op_def$consumes), "application/json", op_def$consumes
+        )
         result <- httr::POST(
           url = get_url(x),
           config = get_config(),
           body = request_json,
-          httr::content_type("application/json"),
-          httr::accept_json(),
+          httr::content_type(consumes),
+          get_accept(op_def),
+          httr::add_headers(.headers = .headers)
+        )
+        handle_response(result)
+      }
+    } else if(op_def$action == "patch") {
+      tmp_fun <- function() {
+        x <- eval(param_values)
+        request_json <- get_message_body(op_def, x)
+        consumes <- ifelse(
+            is.null(op_def$consumes), "application/json", op_def$consumes
+        )
+        result <- httr::PATCH(
+          url = get_url(x),
+          config = get_config(),
+          body = request_json,
+          httr::content_type(consumes),
+          get_accept(op_def),
           httr::add_headers(.headers = .headers)
         )
         handle_response(result)
@@ -272,12 +301,15 @@ get_operations <- function(api, .headers = NULL, path = NULL,
       tmp_fun <- function() {
         x <- eval(param_values)
         request_json <- get_message_body(op_def, x)
+        consumes <- ifelse(
+            is.null(op_def$consumes), "application/json", op_def$consumes
+        )
         result <- httr::PUT(
           url = get_url(x),
           config = get_config(),
           body = request_json,
-          httr::content_type("application/json"),
-          httr::accept_json(),
+          httr::content_type(consumes),
+          get_accept(op_def),
           httr::add_headers(.headers = .headers)
         )
         handle_response(result)
@@ -289,7 +321,19 @@ get_operations <- function(api, .headers = NULL, path = NULL,
           url = get_url(x),
           config = get_config(),
           httr::content_type("application/json"),
-          httr::accept_json(),
+          get_accept(op_def),
+          httr::add_headers(.headers = .headers)
+        )
+        handle_response(result)
+      }
+    } else if(op_def$action == "head") {
+      tmp_fun <- function() {
+        x <- eval(param_values)
+        result <- httr::HEAD(
+          url = get_url(x),
+          config = get_config(),
+          httr::content_type("application/json"),
+          get_accept(op_def),
           httr::add_headers(.headers = .headers)
         )
         handle_response(result)
@@ -301,7 +345,7 @@ get_operations <- function(api, .headers = NULL, path = NULL,
           url = get_url(x),
           config = get_config(),
           httr::content_type("application/json"),
-          httr::accept_json(),
+          get_accept(op_def),
           httr::add_headers(.headers = .headers)
         )
         handle_response(result)
@@ -325,25 +369,45 @@ get_operations <- function(api, .headers = NULL, path = NULL,
 
 #' Message body
 #'
-#' Transform a list to http request message body
+#' Transform a list of operation arguments to an http request message
+#' body. This method searches for parameters with swagger / openAPI
+#' specification `in: body` or `in: formData`. `body` parameters are
+#' expected to be R vectors or lists, and are transformed to JSON
+#' using `jsonlite::toJSON()`. `formData` parameters are treated as
+#' is, so must be specified (e.g., using `httr::upload_file()`) by the
+#' caller. Interpretation of `formData` parameters require that the
+#' `op_def` includes `consumes: multipart/form-data`.
+#'
+#' @param op_def A list representation of the swagger / openAPI
+#'     description of the operation.
+#'
+#' @param x A list representation of the operation arguments provided
+#'     by the user.
+#'
+#' @return A JSON character representation (for `body`) or list of
+#'     objects (for `formData`) representing the parameters `x`.
 #'
-#' @param x A list
 #' @keywords internal
 get_message_body <- function(op_def, x) {
+  formData <- identical(op_def$consumes, "multipart/form-data")
   parameters <- op_def$parameters
   parameter_names <- vapply(parameters, function(parameter) {
-      if (identical(parameter[["in"]], "body")) {
-          parameter[["name"]]
-      } else NA_character_
+    if (parameter[["in"]] %in% c("body", "formData")) {
+      parameter[["name"]]
+    } else NA_character_
   }, character(1))
   parameter_names <- parameter_names[!is.na(parameter_names)]
   x <- x[ names(x) %in% parameter_names ]
-  if (length(x) == 1L)
-    x <- x[[1]]
-  json <- jsonlite::toJSON(x, auto_unbox = TRUE, pretty = TRUE)
+  if (formData) {
+    json <- x
+  } else {
+    if (length(x) == 1L)
+      x <- x[[1]]
+    json <- jsonlite::toJSON(x, auto_unbox = TRUE, pretty = TRUE)
+  }
 
   if(getOption("rapiclient.log_request", default = FALSE)) {
-    cat(json, "\n",
+    cat(if (formData) "formData" else json, "\n",
         file = file.path(
           getOption("rapiclient.log_request_path", "rapiclient_log.json")
         ), append = FALSE

inst/extdata/sample_specs/petstore.yaml

@@ -0,0 +1,103 @@
+swagger: "2.0"
+info:
+  version: 1.0.0
+  title: Swagger Petstore
+  license:
+    name: MIT
+host: petstore.swagger.io
+basePath: /v1
+schemes:
+  - http
+consumes:
+  - application/json
+produces:
+  - application/json
+paths:
+  /pets:
+    get:
+      summary: List all pets
+      operationId: listPets
+      tags:
+        - pets
+      parameters:
+        - name: limit
+          in: query
+          description: How many items to return at one time (max 100)
+          required: false
+          type: integer
+          format: int32
+      responses:
+        "200":
+          description: A paged array of pets
+          headers:
+            x-next:
+              type: string
+              description: A link to the next page of responses
+          schema:
+            $ref: '#/definitions/Pets'
+        default:
+          description: unexpected error
+          schema:
+            $ref: '#/definitions/Error'
+    post:
+      summary: Create a pet
+      operationId: createPets
+      tags:
+        - pets
+      responses:
+        "201":
+          description: Null response
+        default:
+          description: unexpected error
+          schema:
+            $ref: '#/definitions/Error'
+  /pets/{petId}:
+    get:
+      summary: Info for a specific pet
+      operationId: showPetById
+      tags:
+        - pets
+      parameters:
+        - name: petId
+          in: path
+          required: true
+          description: The id of the pet to retrieve
+          type: string
+      responses:
+        "200":
+          description: Expected response to a valid request
+          schema:
+            $ref: '#/definitions/Pets'
+        default:
+          description: unexpected error
+          schema:
+            $ref: '#/definitions/Error'
+definitions:
+  Pet:
+    type: "object"
+    required:
+      - id
+      - name
+    properties:
+      id:
+        type: integer
+        format: int64
+      name:
+        type: string
+      tag:
+        type: string
+  Pets:
+    type: array
+    items:
+      $ref: '#/definitions/Pet'
+  Error:
+    type: "object"
+    required:
+      - code
+      - message
+    properties:
+      code:
+        type: integer
+        format: int32
+      message:
+        type: string

tests/testthat/test_external_api.R

@@ -59,3 +59,29 @@ test_that("Reads external API operations", {
     "Missing 'digraph' keyword in some dot string"
   )
 })
+
+test_that("Reads remote and local yaml", {
+    yaml_fl <- system.file("extdata/sample_specs/petstore.yaml",
+        package = "rapiclient", mustWork = TRUE)
+    local_api <- get_api(yaml_fl)
+
+    expect_true(
+        inherits(local_api, "rapi_api")
+    )
+
+    if (!interactive()) {
+      skip("Run only in interactive mode")
+    }
+    yaml <- paste0(
+        "https://raw.githubusercontent.com/OAI/OpenAPI-Specification/master/",
+        "examples/v2.0/yaml/petstore.yaml"
+    )
+    ext_api <- get_api(yaml)
+    yaml_fl <- tempfile(fileext=".yaml")
+    download.file(yaml, yaml_fl)
+    local_api <- get_api(yaml_fl)
+    expect_identical(
+        ## ext_api has host, schemes
+        ext_api[names(local_api)], local_api[]
+    )
+})

tests/testthat/test_post.R

@@ -68,3 +68,19 @@ test_that("unboxing works", {
     x <- list(param1 = list("ok", "ok"))
     expect_identical(expect, get_message_body(op_def, x))
 })
+
+test_that("formData works", {
+    op_def <- list(
+        consumes = "multipart/form-data",
+        parameters = list( list(`in` = "formData", name = "param1") )
+    )
+
+    expect_identical(list(), get_message_body(op_def, list()))
+
+    x <- list(param1 = "foo")
+    expect_identical(x, get_message_body(op_def, x))
+
+    file.create(fl <- tempfile())
+    x = list(param1 = httr::upload_file(fl))
+    expect_identical(x, get_message_body(op_def, x))
+})