Swagger v3 params

.Rbuildignore

@@ -11,3 +11,6 @@
 ^revdep$
 ^cran-comments\.md$
 ^inst/swagger_ui/.*\.map
+^yarn\.lock$
+^node_modules
+^package\.json$

.gitignore

@@ -7,3 +7,5 @@
 .idea
 plumber.Rcheck
 plumber_*.tar.gz
+yarn.lock
+node_modules/*

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
     }
   )
 )

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
+}

package.json

@@ -0,0 +1,5 @@
+{
+  "dependencies": {
+    "swagger-cli": "^2.2.0"
+  }
+}