diff --git a/.Rbuildignore b/.Rbuildignore index 5e42ff8c7..4596c8704 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -11,3 +11,6 @@ ^revdep$ ^cran-comments\.md$ ^inst/swagger_ui/.*\.map +^yarn\.lock$ +^node_modules +^package\.json$ diff --git a/.gitignore b/.gitignore index f569d5c87..70dde63b6 100644 --- a/.gitignore +++ b/.gitignore @@ -7,3 +7,5 @@ .idea plumber.Rcheck plumber_*.tar.gz +yarn.lock +node_modules/* diff --git a/R/plumber.R b/R/plumber.R index f7ca0a9b8..232027075 100644 --- a/R/plumber.R +++ b/R/plumber.R @@ -230,6 +230,8 @@ plumber <- R6Class( } # allows swagger-ui to provide proper callback location given the referrer location # ex: rstudio cloud + # use the HTTP_REFERER so RSC can find the swagger location to ask + ## (can't directly ask for 127.0.0.1) referrer_url <- req$HTTP_REFERER referrer_url <- sub("index\\.html$", "", referrer_url) referrer_url <- sub("__swagger__/$", "", referrer_url) @@ -242,7 +244,10 @@ plumber <- R6Class( if (is.function(swagger)) { # allow users to update the swagger file themselves ret <- swagger(self, sf, ...) + # Since users could have added more NA or NULL values... + ret <- removeNaOrNulls(ret) } else { + # NA/NULL values already removed ret <- sf } ret @@ -543,22 +548,25 @@ plumber <- R6Class( filter <- PlumberFilter$new(name, expr, private$envir, serializer) private$addFilterInternal(filter) }, - swaggerFile = function(..., asJSON = FALSE) { #FIXME: test + swaggerFile = function(...) { #FIXME: test - endpoints <- private$swaggerFileWalkMountsInternal(self) - endpoints <- prepareSwaggerEndpoints(endpoints) + swaggerPaths <- private$swaggerFileWalkMountsInternal(self) # Extend the previously parsed settings with the endpoints - def <- modifyList(private$globalSettings, list(paths=endpoints)) + def <- modifyList(private$globalSettings, list(paths = swaggerPaths)) # Lay those over the default globals so we ensure that the required fields # (like API version) are satisfied. ret <- modifyList(defaultGlobals, def) - if (isTRUE(asJSON)) { - ret <- jsonlite::toJSON(ret, auto_unbox = TRUE) - } + + # remove NA or NULL values, which swagger doesn't like + ret <- removeNaOrNulls(ret) + ret }, + openAPIFile = function(...) { + self$swaggerFile(...) + }, ### Legacy/Deprecated addEndpoint = function(verbs, path, expr, serializer, processors, preempt=NULL, params=NULL, comments){ @@ -706,36 +714,32 @@ plumber <- R6Class( paste(x, y, sep = "/") } - endpoints <- lapply(router$endpoints, function(endpoint) { - # clone and make path a full path - endpointEntries <- lapply(endpoint, function(endpointEntry) { - endpointEntry <- endpointEntry$clone() - endpointEntry$path <- join_paths(parentPath, endpointEntry$path) - endpointEntry - }) + # make sure to use the full path + endpointList <- list() - endpointEntries - }) + for (endpoint in router$endpoints) { + for (endpointEntry in endpoint) { + swaggerEndpoint <- prepareSwaggerEndpoint( + endpointEntry, + join_paths(parentPath, endpointEntry$path) + ) + endpointList <- modifyList(endpointList, swaggerEndpoint) + } + } # recursively gather mounted enpoint entries - mountedEndpoints <- mapply( - names(router$mounts), - router$mounts, - FUN = function(mountPath, mountedSubrouter) { - private$swaggerFileWalkMountsInternal( - mountedSubrouter, + if (length(router$mounts) > 0) { + for (mountPath in names(router$mounts)) { + mountEndpoints <- private$swaggerFileWalkMountsInternal( + router$mounts[[mountPath]], join_paths(parentPath, mountPath) ) + endpointList <- modifyList(endpointList, mountEndpoints) } - ) - - # returning a single list of entries, - # not nested entries using the filter / `__no-preempt__` as names within the list - # (the filter name is not required when making swagger docs and do not want to misrepresent the endpoints) - unname(append( - unlist(endpoints), - unlist(mountedEndpoints) - )) + } + + # returning a single list of swagger entries + endpointList } ) ) diff --git a/R/swagger.R b/R/swagger.R index 5607989d0..faef87bfd 100644 --- a/R/swagger.R +++ b/R/swagger.R @@ -20,40 +20,42 @@ plumberToSwaggerType <- function(type){ #' Convert the endpoints as they exist on the router to a list which can #' be converted into a swagger definition for these endpoints #' @noRd -prepareSwaggerEndpoints <- function(routerEndpointEntries){ - endpoints <- list() - - for (e in routerEndpointEntries){ - # We are sensitive to trailing slashes. Should we be? - # Yes - 12/2018 - cleanedPath <- gsub("<([^:>]+)(:[^>]+)?>", "{\\1}", e$path) - if (is.null(endpoints[[cleanedPath]])){ - endpoints[[cleanedPath]] <- list() - } +prepareSwaggerEndpoint <- function(routerEndpointEntry, path = routerEndpointEntry$path) { + ret <- list() - # Get the params from the path - pathParams <- e$getTypedParams() - for (verb in e$verbs){ - params <- extractSwaggerParams(e$params, pathParams) + # We are sensitive to trailing slashes. Should we be? + # Yes - 12/2018 + cleanedPath <- gsub("<([^:>]+)(:[^>]+)?>", "{\\1}", path) + ret[[cleanedPath]] <- list() - # If we haven't already documented a path param, we should add it here. - # FIXME: warning("Undocumented path parameters: ", paste0()) + # Get the params from the path + pathParams <- routerEndpointEntry$getTypedParams() + for (verb in routerEndpointEntry$verbs) { + params <- extractSwaggerParams(routerEndpointEntry$params, pathParams) - resps <- extractResponses(e$responses) + # If we haven't already documented a path param, we should add it here. + # FIXME: warning("Undocumented path parameters: ", paste0()) - endptSwag <- list(summary=e$comments, - responses=resps, - parameters=params, - tags=e$tags) + resps <- extractResponses(routerEndpointEntry$responses) - endpoints[[cleanedPath]][[tolower(verb)]] <- endptSwag - } + endptSwag <- list( + summary = routerEndpointEntry$comments, + responses = resps, + parameters = params, + tags = routerEndpointEntry$tags + ) + + ret[[cleanedPath]][[tolower(verb)]] <- endptSwag } - endpoints + ret } -defaultResp <- list("default"=list(description="Default response.")) +defaultResp <- list( + "default" = list( + description = "Default response." + ) +) extractResponses <- function(resps){ if (is.null(resps) || is.na(resps)){ resps <- defaultResp @@ -67,41 +69,71 @@ extractResponses <- function(resps){ #' paramters. #' @noRd extractSwaggerParams <- function(endpointParams, pathParams){ - params <- data.frame(name=character(0), - description=character(0), - `in`=character(0), - required=logical(0), - type=character(0), - check.names = FALSE, - stringsAsFactors = FALSE) - for (p in names(endpointParams)){ + + params <- list() + for (p in names(endpointParams)) { location <- "query" - if (p %in% pathParams$name){ + if (p %in% pathParams$name) { location <- "path" } type <- endpointParams[[p]]$type - if (is.null(type) || is.na(type)){ + if (isNaOrNull(type)){ if (location == "path") { - type <- plumberToSwaggerType(pathParams[pathParams$name == p,"type"]) + type <- plumberToSwaggerType(pathParams$type[pathParams$name == p]) } else { type <- "string" # Default to string } } - parDocs <- data.frame(name = p, - description = endpointParams[[p]]$desc, - `in`=location, - required=endpointParams[[p]]$required, - type=type, - check.names = FALSE, - stringsAsFactors = FALSE) + paramList <- list( + name = p, + description = endpointParams[[p]]$desc, + `in` = location, + required = endpointParams[[p]]$required, + schema = list( + type = type + ) + ) if (location == "path"){ - parDocs$required <- TRUE + paramList$required <- TRUE } - params <- rbind(params, parDocs) + params[[length(params) + 1]] <- paramList + } params } + + +isNa <- function(x) { + if (is.list(x)) { + return(FALSE) + } + is.na(x) +} +isNaOrNull <- function(x) { + isNa(x) || is.null(x) +} +removeNaOrNulls <- function(x) { + # preemptively stop + if (!is.list(x)) { + return(x) + } + if (length(x) == 0) { + return(x) + } + + # remove any `NA` or `NULL` elements + toRemove <- vapply(x, isNaOrNull, logical(1)) + if (any(toRemove)) { + x[toRemove] <- NULL + } + + # recurse through list + ret <- lapply(x, removeNaOrNulls) + class(ret) <- class(x) + + ret +} diff --git a/package.json b/package.json new file mode 100644 index 000000000..0382fec38 --- /dev/null +++ b/package.json @@ -0,0 +1,5 @@ +{ + "dependencies": { + "swagger-cli": "^2.2.0" + } +} diff --git a/tests/testthat/test-swagger.R b/tests/testthat/test-swagger.R index d91154a6b..6123acfe1 100644 --- a/tests/testthat/test-swagger.R +++ b/tests/testthat/test-swagger.R @@ -108,6 +108,8 @@ test_that("swaggerFile works with mounted routers", { "/sub2/", "/sub2/sub3/else", "/sub2/sub3/", "/sub4/completely", "/sub4/trailing_slash/" )) + + pr <<- pr }) test_that("extractResponses works", { @@ -134,31 +136,104 @@ test_that("extractSwaggerParams works", { pp <- data.frame(name=c("id", "id2"), type=c("int", "int")) params <- extractSwaggerParams(ep, pp) - expect_equal(as.list(params[1,]), + expect_equal(params[[1]], list(name="id", description="Description", `in`="path", required=TRUE, # Made required b/c path arg - type="integer")) - expect_equal(as.list(params[2,]), + schema = list( + type="integer"))) + expect_equal(params[[2]], list(name="id2", description="Description2", `in`="path", required=TRUE, # Made required b/c path arg - type="integer")) - expect_equal(as.list(params[3,]), + schema = list( + type="integer"))) + expect_equal(params[[3]], list(name="make", description="Make description", `in`="query", required=FALSE, - type="string")) + schema = list( + type="string"))) # If id were not a path param it should not be promoted to required params <- extractSwaggerParams(ep, NULL) - expect_equal(params$required[params$name=="id"], FALSE) - expect_equal(params$type[params$name=="id"], "integer") + idParam <- params[[which(vapply(params, `[[`, character(1), "name") == "id")]] + expect_equal(idParam$required, FALSE) + expect_equal(idParam$schema$type, "integer") + + for (param in params) { + expect_equal(length(param), 5) + } params <- extractSwaggerParams(NULL, NULL) - expect_equal(nrow(params), 0) - expect_equal(ncol(params), 5) + expect_equal(length(params), 0) +}) + + + + +test_that("api kitchen sink", { + + skip_on_cran() + skip_on_travis() + skip_on_appveyor() + skip_on_bioc() + skip_on_os(setdiff(c("windows", "mac", "linux", "solaris"), "mac")) + + ## install brew - https://brew.sh/ + # /usr/bin/ruby -e "$(curl -fsSL https://raw.githubusercontent.com/Homebrew/install/master/install)" + ## install yarn + # brew install yarn + ## install yarn + # yarn add swagger-ui + swagger_cli_path <- "../../node_modules/.bin/swagger-cli" + skip_if_not(file.exists(swagger_cli_path)) + swagger_cli_path <- normalizePath(swagger_cli_path) + + with_dir <- function(dir, x) { + old_wd <- getwd() + on.exit({ + setwd(old_wd) + }) + setwd(folder) + + force(x) + } + + validate_spec <- function(pr) { + spec <- jsonlite::toJSON(pr$swaggerFile(), auto_unbox = TRUE) + tmpfile <- tempfile(fileext = ".json") + on.exit({ + unlink(tmpfile) + }) + cat(spec, file = tmpfile) + + output <- system2( + swagger_cli_path, + c( + "validate", + tmpfile + ), + stdout = TRUE, + stderr = TRUE + ) + + output <- paste0(output, collapse = "\n") + + # using expect_equal vs a regex test to have a better error message + expect_equal(sub(tmpfile, "", output, fixed = TRUE), " is valid") + } + + folder <- system.file("examples/11-car-inventory/", package = "plumber") + with_dir(folder, { + pr <- plumb("plumber.R") + validate_spec(pr) + }) + + # TODO test more situations + + })