Merge branch 'master' into httpuv_url_decode

* master: use rtools within appveyor (#381) need to set the LC_TIME to C to ensure the Date is formatted in English (#319) Require httpuv (>= 1.4.5.9000) (#357) appveyor pkg cache will bust when DESCRIPTION changes (#370) Revamp Swagger Spec to OpenAPI v3 (#365)
rstudio · Feb 7, 2019 · 73715c8 · 73715c8
2 parents 6293fca + 3f29c9b
commit 73715c8
Show file tree

Hide file tree

Showing 19 changed files with 432 additions and 283 deletions.
diff --git a/.Rbuildignore b/.Rbuildignore
@@ -1,12 +1,16 @@
 ^appveyor\.yml$
 ^.*\.Rproj$
 ^\.Rproj\.user$
-.travis.yml
-Dockerfile
-inst/analog-keys.R
-inst/examples/03-github/github-key.txt
-.httr-oauth
-docs
-scripts
+^\.travis\.yml$
+^Dockerfile
+^inst/analog-keys.R
+^inst/examples/03-github/github-key.txt
+^\.httr-oauth
+^docs
+^scripts
 ^revdep$
 ^cran-comments\.md$
+^inst/swagger_ui/.*\.map
+^yarn\.lock$
+^node_modules
+^package\.json$
diff --git a/.gitignore b/.gitignore
@@ -7,3 +7,5 @@
 .idea
 plumber.Rcheck
 plumber_*.tar.gz
+yarn.lock
+node_modules/*
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -24,7 +24,7 @@ Imports:
     R6 (>= 2.0.0),
     stringi (>= 0.3.0),
     jsonlite (>= 0.9.16),
-    httpuv (>= 1.4.0),
+    httpuv (>= 1.4.5.9000),
     crayon
 LazyData: TRUE
 ByteCompile: TRUE
@@ -36,7 +36,11 @@ Suggests:
     base64enc,
     htmlwidgets,
     visNetwork,
-    analogsea
+    analogsea,
+    swagger (> 3.20.3)
+Remotes:
+    rstudio/swagger,
+    rstudio/httpuv
 Collate:
     'content-types.R'
     'cookie-parser.R'

diff --git a/NEWS.md b/NEWS.md
@@ -1,19 +1,49 @@
-plumber 0.4.7
+plumber 0.5.0
 --------------------------------------------------------------------------------
-* Add support for swagger for mounted routers (@bradleyhd, [#274](https://github.com/trestletech/plumber/issues/274)).
-* BUGFIX: A multiline POST body is now collapsed to a single line ([#270](https://github.com/trestletech/plumber/issues/270)).
-* The source files used in plumber **must use** the UTF-8 encoding if they contain
-non-ASCII characters (@shrektan, [#312](https://github.com/trestletech/plumber/pull/312),
-  [#328](https://github.com/trestletech/plumber/pull/328)).
-* SECURITY: Wrap `jsonlite::fromJSON` to ensure that `jsonlite` never reads
+## Full changelog
+
+### Security
+
+* Wrap `jsonlite::fromJSON` to ensure that `jsonlite` never reads
   input as a remote address (such as a file path or URL) and attempts to parse
   that. The only known way to exploit this behavior in plumber unless an
   API were using encrypted cookies and an attacker knew the encryption key in
   order to craft arbitrary cookies. ([#325](https://github.com/trestletech/plumber/pull/325))
-* BUGFIX: Plumber files are now only evaluated once.  Prior plumber behavior sourced endpoint
+
+### Breaking changes
+
+* Plumber's swagger definition is now defined using
+  [OpenAPI 3](https://github.com/OAI/OpenAPI-Specification/blob/master/versions/3.0.2.md),
+  upgrading from Swagger Specification. ([#365](https://github.com/trestletech/plumber/pull/365))
+
+* The source files used in plumber **must use** the UTF-8 encoding if they contain
+  non-ASCII characters (@shrektan, [#312](https://github.com/trestletech/plumber/pull/312),
+  [#328](https://github.com/trestletech/plumber/pull/328)).
+
+### New features
+
+* Added support to a router's run method to allow the `swagger` parameter to be a function that
+  enhances the existing swagger specification before being returned to `/openapi.json`. ([#365](https://github.com/trestletech/plumber/pull/365))
+
+* Add support for swagger for mounted routers (@bradleyhd, [#274](https://github.com/trestletech/plumber/issues/274)).
+
+
+### Minor new features and improvements
+
+* Changed Swagger UI to use [swagger](https://github.com/rstudio/swagger) R package to display the
+    swagger page. ([#365](https://github.com/trestletech/plumber/pull/365))
+
+* Plumber files are now only evaluated once.  Prior plumber behavior sourced endpoint
   functions twice and non-endpoint code blocks once.
   ([#328](https://github.com/trestletech/plumber/pull/328/commits/cde0d3d2543a654fd0c5799b670767ccb0e22e35))
 
+### Bug fixes
+
+* A multiline POST body is now collapsed to a single line (@robertdj, [#270](https://github.com/trestletech/plumber/issues/270) [#297](https://github.com/trestletech/plumber/pull/297)).
+
+* Bumped version of httpuv to >= 1.4.5.9000 to address an unexpected segfault (@shapenaji, [#289](https://github.com/trestletech/plumber/issues/289))
+
+
 
 plumber 0.4.6
 --------------------------------------------------------------------------------

diff --git a/R/parse-globals.R b/R/parse-globals.R
@@ -107,15 +107,11 @@ parseGlobals <- function(lines){
   fields
 }
 
-#' The default set of Swagger API globals. Some of these properties are subject
-#' to being overridden by @api* annotations.
+#' The default set of OpenAPI specification (OAS) globals. Some of these properties
+#' are subject to being overridden by @api* annotations.
 #' @noRd
 defaultGlobals <- list(
-  swagger = "2.0",
-  info = list(description="API Description", title="API Title", version="1.0.0"),
-  host=NA,
-  schemes= I("http"),
-  produces=I("application/json")
-  #securityDefinitions = list(),
-  #definitions = list()
+  openapi = "3.0.2",
+  info = list(description = "API Description", title = "API Title", version = "1.0.0"),
+  paths = list()
 )
diff --git a/R/plumber.R b/R/plumber.R
@@ -171,7 +171,7 @@ plumber <- R6Class(
       private$serializer <- serializer_json()
       private$errorHandler <- defaultErrorHandler()
       private$notFoundHandler <- default404Handler
-      
+
       # Add in the initial filters
       for (fn in names(filters)){
         fil <- PlumberFilter$new(fn, filters[[fn]], private$envir, private$serializer, NULL)
@@ -195,8 +195,13 @@ plumber <- R6Class(
       }
 
     },
-    run = function(host='127.0.0.1', port=getOption('plumber.port'), swagger=interactive(),
-                   debug=interactive(), swaggerCallback=getOption('plumber.swagger.url', NULL)){
+    run = function(
+      host = '127.0.0.1',
+      port = getOption('plumber.port'),
+      swagger = interactive(),
+      debug = interactive(),
+      swaggerCallback = getOption('plumber.swagger.url', NULL)
+    ) {
       port <- findPort(port)
 
       message("Starting server to listen on port ", port)
@@ -211,54 +216,76 @@ plumber <- R6Class(
         setwd(dirname(private$filename))
       }
 
-      if (swagger){
-        sf <- self$swaggerFile()
-
-        if (is.na(sf$host)){
-          accessHost <- ifelse(host == "0.0.0.0", "127.0.0.1", host)
-          accessPath <- paste(accessHost, port, sep=":")
-          sf$host <- accessPath
-
-          if (!is.null(getOption("plumber.apiHost"))){
-            sf$host <- getOption("plumber.apiHost")
-          }
-
-          if (!is.null(getOption("plumber.apiScheme"))){
-            sf$schemes <- getOption("plumber.apiScheme")
-          }
-
-          if (!is.null(getOption("plumber.apiPath"))){
-            sf$basePath <- getOption("plumber.apiPath")
-          }
-        }
+      if (isTRUE(swagger) || is.function(swagger)) {
+        host <- getOption(
+          "plumber.apiHost",
+          ifelse(identical(host, "0.0.0.0"), "127.0.0.1", host)
+        )
+        spec <- self$swaggerFile()
 
         # Create a function that's hardcoded to return the swaggerfile -- regardless of env.
-        fun <- function(schemes, host, path){
-          if (!missing(schemes)){
-            sf$schemes <- I(schemes)
-          }
-
-          if (!missing(host)){
-            sf$host <- host
+        swagger_fun <- function(req, res, ..., scheme = "deprecated", host = "deprecated", path = "deprecated") {
+          if (!missing(scheme) || !missing(host) || !missing(path)) {
+            warning("`scheme`, `host`, or `path` are not supported to produce swagger.json")
           }
+          # 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)
+          spec$servers <- list(
+            list(
+              url = referrer_url,
+              description = "OpenAPI"
+            )
+          )
 
-          if (!missing(path)){
-            sf$basePath <- path
+          if (is.function(swagger)) {
+            # allow users to update the swagger file themselves
+            ret <- swagger(self, spec, ...)
+            # Since users could have added more NA or NULL values...
+            ret <- removeNaOrNulls(ret)
+          } else {
+            # NA/NULL values already removed
+            ret <- spec
           }
-          sf
+          ret
+        }
+        # https://swagger.io/specification/#document-structure
+        # "It is RECOMMENDED that the root OpenAPI document be named: openapi.json or openapi.yaml."
+        self$handle("GET", "/openapi.json", swagger_fun, serializer = serializer_unboxed_json())
+        # keeping for legacy purposes
+        self$handle("GET", "/swagger.json", swagger_fun, serializer = serializer_unboxed_json())
+
+        swagger_index <- function(...) {
+          swagger::swagger_spec(
+            'window.location.origin + window.location.pathname.replace(/\\(__swagger__\\\\/|__swagger__\\\\/index.html\\)$/, "") + "openapi.json"'
+          )
+        }
+        for (path in c("/__swagger__/index.html", "/__swagger__/")) {
+          self$handle(
+            "GET", path, swagger_index,
+            serializer = serializer_html()
+          )
+        }
+        self$mount("/__swagger__", PlumberStatic$new(swagger::swagger_path()))
+        swaggerUrl = paste0(host, ":", port, "/__swagger__/")
+        if (!grepl("^http://", swaggerUrl)) {
+          # must have http protocol for use within RStudio
+          # does not work if supplying "127.0.0.1:1234/route"
+          swaggerUrl <- paste0("http://", swaggerUrl)
         }
-        self$handle("GET", "/swagger.json", fun, serializer=serializer_unboxed_json())
+        message("Running the swagger UI at ", swaggerUrl, sep = "")
 
-        plumberFileServer <- PlumberStatic$new(system.file("swagger-ui", package = "plumber"))
-        self$mount("/__swagger__", plumberFileServer)
-        swaggerUrl = paste(sf$schemes[1], "://", sf$host, "/__swagger__/", sep="")
-        message("Running the swagger UI at ", swaggerUrl, sep="")
-        if (!is.null(swaggerCallback) && is.function(swaggerCallback)){
+        # notify swaggerCallback of plumber swagger location
+        if (!is.null(swaggerCallback) && is.function(swaggerCallback)) {
           swaggerCallback(swaggerUrl)
         }
       }
 
-      on.exit(private$runHooks("exit"), add=TRUE)
+      on.exit(private$runHooks("exit"), add = TRUE)
 
       httpuv::runServer(host, port, self)
     },
@@ -527,17 +554,24 @@ plumber <- R6Class(
       filter <- PlumberFilter$new(name, expr, private$envir, serializer)
       private$addFilterInternal(filter)
     },
-    swaggerFile = function(){ #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.
-      modifyList(defaultGlobals, def)
+      ret <- modifyList(defaultGlobals, def)
+
+      # remove NA or NULL values, which swagger doesn't like
+      ret <- removeNaOrNulls(ret)
+
+      ret
+    },
+    openAPIFile = function() {
+      self$swaggerFile()
     },
 
     ### Legacy/Deprecated
@@ -686,36 +720,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/response.R b/R/response.R
@@ -1,3 +1,26 @@
+#' HTTP Date String
+#'
+#' Given a POSIXct object, return a date string in the format required for a
+#' HTTP Date header. For example: "Wed, 21 Oct 2015 07:28:00 GMT"
+#'
+#' @noRd
+http_date_string <- function(time) {
+  weekday_names <- c("Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat")
+  weekday_num <- as.integer(strftime(time, format = "%w", tz = "GMT")) + 1L
+  weekday_name <- weekday_names[weekday_num]
+
+  month_names <- c("Jan", "Feb", "Mar", "Apr", "May", "Jun",
+                   "Jul", "Aug", "Sep", "Oct", "Nov", "Dec")
+  month_num <- as.integer(strftime(time, format = "%m", tz = "GMT"))
+  month_name <- month_names[month_num]
+
+  strftime(
+    time,
+    paste0(weekday_name, ", %d ", month_name, " %Y %H:%M:%S GMT"),
+    tz = "GMT"
+  )
+}
+
 PlumberResponse <- R6Class(
   "PlumberResponse",
   public = list(
@@ -15,8 +38,7 @@ PlumberResponse <- R6Class(
     },
     toResponse = function(){
       h <- self$headers
-      # httpuv doesn't like empty headers lists, and this is a useful field anyway...
-      h$Date <- format(Sys.time(), "%a, %d %b %Y %X %Z", tz="GMT")
+      h$Date <- http_date_string(Sys.time())
 
       body <- self$body
       if (is.null(body)){