diff --git a/DESCRIPTION b/DESCRIPTION index 967ba4510..c2f4e2514 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -30,6 +30,7 @@ Imports: sodium, swagger (>= 3.20.3.99991), magrittr, + mime, lifecycle LazyData: TRUE ByteCompile: TRUE diff --git a/NAMESPACE b/NAMESPACE index de612ffa9..7be1facec 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -89,6 +89,7 @@ export(serializer_text) export(serializer_tiff) export(serializer_tsv) export(serializer_unboxed_json) +export(serializer_write_file) export(serializer_yaml) export(sessionCookie) export(session_cookie) diff --git a/NEWS.md b/NEWS.md index d76f0c121..53e190073 100644 --- a/NEWS.md +++ b/NEWS.md @@ -5,14 +5,14 @@ plumber 1.0.0 #### Plumber router -* Added support for promises in endpoints, filters, and hooks. (#248) +* Added support for promises in endpoints, filters, and hooks. This allows for multi-core execution when paired with `future`. See `plumb_api("plumber", "13-promises")` and `plumb_api("plumber", "14-future")` for an example implementation. (#248) * Added a Tidy API for more natural usage with magrittr's `%>%`. For example, a plumber object can now be initiated and run with `pr() %>% pr_run(port = 8080)`. For more examples, see [here](https://www.rplumber.io/articles/programmatic-usage.html) (@blairj09, #590) -* Added support for `#' @plumber` tag to gain programmatic access to the `plumber` router via `function(pr) {....}`. (@meztez and @blairj09, #568) +* Added support for `#' @plumber` tag to gain programmatic access to the `plumber` router via `function(pr) {....}`. See `system.file("plumber/06-sessions/plumber.R", package = "plumber")` and how it adds cookie support from within `plumber.R`. (@meztez and @blairj09, #568) * An error will be thrown if multiple arguments are matched to an Plumber Endpoint route definition. While it is not required, it is safer to define routes to only use `req` and `res` when there is a possiblity to have multiple arguments match a single parameter name. - Use `req$argsPath`, `req$argsQuery`, and `req$argsPostBody` to access path, query, and postBody parameters respectively. + Use `req$argsPath`, `req$argsQuery`, and `req$argsBody` to access path, query, and postBody parameters respectively. See `system.file("plumber/17-arguments/plumber.R", package = "plumber")` to view an example with expected output and `plumb_api("plumber", "17-arguments")` to retrieve the api. (#637) @@ -47,26 +47,31 @@ plumber 1.0.0 * `serializer_print()`: Return text content after calling `print()` (#585) * `serializer_format()`: Return text content after calling `format()` (#585) * `serializer_svg()`: Return an image saved as an SVG (@pachamaltese, #398) - * `serializer_headers(header_list)`: method which sets a list of static headers for each serialized value. Heavily inspired from @ycphs (#455). (#585) - -#### POST body parsing - -* Added support for POST body parsing (@meztez, #532) - -* New POST body parsers - * `parser_csv()`: Parse POST body as a commas separated value (#584) - * `parser_json()`: Parse POST body as JSON (@meztez, #532) - * `parser_multi()`: Parse multi part POST bodies (@meztez, #532) - * `parser_octet()`: Parse POST body octet stream (@meztez, #532) - * `parser_form()`: Parse POST body as form input (@meztez, #532) - * `parser_rds()`: Parse POST body as RDS file input (@meztez, #532) - * `parser_text()`: Parse POST body plain text (@meztez, #532) - * `parser_tsv()`: Parse POST body a tab separated value (#584) - * `parser_yaml()`: Parse POST body as `yaml` (#584) - * `parser_none()`: Do not parse the post body (#584) - * `parser_yaml()`: Parse POST body (@meztez, #556) - * `parser_feather()`: Parse POST body using `feather` (#626) - * pseudo parser named `"all"` to allow for using all parsers. (Not recommended in production!) (#584) + * `serializer_headers(header_list)`: Method which sets a list of static headers for each serialized value. Heavily inspired from @ycphs (#455). (#585) + * `serializer_write_file()`: Method which wraps `serializer_content_type()`, but orchestrates creating, writing serialized content to, reading from, and removing a temp file. (#660) + +#### Body parsing + +* Added support for request body parsing (@meztez, #532) + +* New request body parsers + * `parser_csv()`: Parse request body as a commas separated value (#584) + * `parser_json()`: Parse request body as JSON (@meztez, #532) + * `parser_multi()`: Parse multi part request bodies (@meztez, #532) and (#663) + * `parser_octet()`: Parse request body octet stream (@meztez, #532) + * `parser_form()`: Parse request body as form input (@meztez, #532) + * `parser_rds()`: Parse request body as RDS file input (@meztez, #532) + * `parser_text()`: Parse request body plain text (@meztez, #532) + * `parser_tsv()`: Parse request body a tab separated value (#584) + * `parser_yaml()`: Parse request body as `yaml` (#584) + * `parser_none()`: Do not parse the request body (#584) + * `parser_yaml()`: Parse request body (@meztez, #556) + * `parser_feather()`: Parse request body using `feather` (#626) + * Pseudo parser named `"all"` to allow for using all parsers. (Not recommended in production!) (#584) + +* The parsed request body values is stored at `req$body`. (#663) + +* If `multipart/*` content is parsed, `req$body` will contain named output from `webutils::parse_multipart()` and add the parsed value to each part. Look here for access to all provided information (e.g., `name`, `filename`, `content_type`, etc). In addition, `req$argsBody` (which is used for route argument matching) will contain a named reduced form of this information where `parsed` values (and `filename`s) are combined on the same `name`. (#663) #### Visual Documentation @@ -132,6 +137,8 @@ plumber 1.0.0 * Documentation is updated and now presented using `pkgdown` (#570) +* New hex logo! Thank you @allisonhorst ! (#570) + * Added helper method `is_plumber(pr)` to determine if an object is a Plumber router. (#653) * Added support for the `SameSite` Cookie attribute. (@chris-dudley, #640) @@ -160,6 +167,8 @@ plumber 1.0.0 * Improve speed of `canServe()` method of the `PlumberEndpoint` class (@atheriel, #484) +* Get more file extension content types using the `mime` package. (#660) + ### Bug fixes * Handle plus signs in URI as space characters instead of actual plus signs (@meztez, #618) @@ -175,7 +184,7 @@ plumber 1.0.0 * Fixed bug where functions defined earlier in the file could not be found when `plumb()`ing a file. (#416) -* A multiline POST body is now collapsed to a single line (@robertdj, #270 #297). +* A multiline request body is now collapsed to a single line (@robertdj, #270 #297). * Bumped version of httpuv to >= 1.4.5.9000 to address an unexpected segfault (@shapenaji, #289) diff --git a/R/content-types.R b/R/content-types.R index a2f2789f3..c60d8087f 100644 --- a/R/content-types.R +++ b/R/content-types.R @@ -1,58 +1,92 @@ # FROM Shiny # @author Shiny package authors -knownContentTypes <- list( - html='text/html; charset=UTF-8', - htm='text/html; charset=UTF-8', - js='text/javascript', - css='text/css', - png='image/png', - jpg='image/jpeg', - jpeg='image/jpeg', - gif='image/gif', - svg='image/svg+xml', - txt='text/plain', - pdf='application/pdf', - ps='application/postscript', - xml='application/xml', - m3u='audio/x-mpegurl', - m4a='audio/mp4a-latm', - m4b='audio/mp4a-latm', - m4p='audio/mp4a-latm', - mp3='audio/mpeg', - wav='audio/x-wav', - m4u='video/vnd.mpegurl', - m4v='video/x-m4v', - mp4='video/mp4', - mpeg='video/mpeg', - mpg='video/mpeg', - avi='video/x-msvideo', - mov='video/quicktime', - ogg='application/ogg', - swf='application/x-shockwave-flash', - doc='application/msword', - xls='application/vnd.ms-excel', - ppt='application/vnd.ms-powerpoint', - xlsx='application/vnd.openxmlformats-officedocument.spreadsheetml.sheet', - xltx='application/vnd.openxmlformats-officedocument.spreadsheetml.template', - potx='application/vnd.openxmlformats-officedocument.presentationml.template', - ppsx='application/vnd.openxmlformats-officedocument.presentationml.slideshow', - pptx='application/vnd.openxmlformats-officedocument.presentationml.presentation', - sldx='application/vnd.openxmlformats-officedocument.presentationml.slide', - docx='application/vnd.openxmlformats-officedocument.wordprocessingml.document', - dotx='application/vnd.openxmlformats-officedocument.wordprocessingml.template', - xlam='application/vnd.ms-excel.addin.macroEnabled.12', - xlsb='application/vnd.ms-excel.sheet.binary.macroEnabled.12', - feather='application/feather', - rds='application/rds', - tsv="text/tab-separated-values", - csv="text/csv") +knownContentTypes <- c( + html = "text/html; charset=UTF-8", + htm = "text/html; charset=UTF-8", + js = "text/javascript", + css = "text/css", + png = "image/png", + jpg = "image/jpeg", + jpeg = "image/jpeg", + gif = "image/gif", + svg = "image/svg+xml", + txt = "text/plain", + pdf = "application/pdf", + ps = "application/postscript", + xml = "application/xml", + m3u = "audio/x-mpegurl", + m4a = "audio/mp4a-latm", + m4b = "audio/mp4a-latm", + m4p = "audio/mp4a-latm", + mp3 = "audio/mpeg", + wav = "audio/x-wav", + m4u = "video/vnd.mpegurl", + m4v = "video/x-m4v", + mp4 = "video/mp4", + mpeg = "video/mpeg", + mpg = "video/mpeg", + avi = "video/x-msvideo", + mov = "video/quicktime", + ogg = "application/ogg", + swf = "application/x-shockwave-flash", + doc = "application/msword", + xls = "application/vnd.ms-excel", + ppt = "application/vnd.ms-powerpoint", + xlsx = "application/vnd.openxmlformats-officedocument.spreadsheetml.sheet", + xltx = "application/vnd.openxmlformats-officedocument.spreadsheetml.template", + potx = "application/vnd.openxmlformats-officedocument.presentationml.template", + ppsx = "application/vnd.openxmlformats-officedocument.presentationml.slideshow", + pptx = "application/vnd.openxmlformats-officedocument.presentationml.presentation", + sldx = "application/vnd.openxmlformats-officedocument.presentationml.slide", + docx = "application/vnd.openxmlformats-officedocument.wordprocessingml.document", + dotx = "application/vnd.openxmlformats-officedocument.wordprocessingml.template", + xlam = "application/vnd.ms-excel.addin.macroEnabled.12", + xlsb = "application/vnd.ms-excel.sheet.binary.macroEnabled.12", + feather = "application/feather", + rds = "application/rds", + tsv = "application/tab-separated-values", + csv = "application/csv", + json = "application/json", + yml = "application/yaml", + yaml = "application/yaml" +) -getContentType <- function(ext, defaultType='application/octet-stream') { - ct <- knownContentTypes[[tolower(ext)]] - if (is.null(ct)){ - ct <- defaultType +getContentType <- function(ext, defaultType = 'application/octet-stream') { + ext <- tolower(ext) + + ret <- + knownContentTypes[ext] %|% + mime::mimemap[ext] %|% + defaultType + + ret[[1]] +} + +cleanup_content_type <- function(type) { + if (length(type) == 0) return(type) + + type <- tolower(type) + + # remove trailing content type information + # "text/yaml; charset=UTF-8" + # to + # "text/yaml" + if (stri_detect_fixed(type, ";")) { + type <- stri_split_fixed(type, ";")[[1]][1] } - return(ct) + + type +} + +get_fileext <- function(type) { + type <- cleanup_content_type(type) + + all_content_types <- c(knownContentTypes, mime::mimemap) + + type_to_ext <- setNames(names(all_content_types), all_content_types) + + ret <- type_to_ext[type] %|% NULL + ret[[1]] } #' Request character set diff --git a/R/parse-body.R b/R/parse-body.R index a5150cf8c..8499e60b0 100644 --- a/R/parse-body.R +++ b/R/parse-body.R @@ -1,23 +1,58 @@ -postBodyFilter <- function(req){ - handled <- req$.internal$postBodyHandled +bodyFilter <- function(req){ + handled <- req$.internal$bodyHandled if (is.null(handled) || handled != TRUE) { # This will return raw bytes - req$postBodyRaw <- req$rook.input$read() + # store raw body into req$bodyRaw + req$bodyRaw <- req$rook.input$read() if (isTRUE(getOption("plumber.postBody", TRUE))) { req$rook.input$rewind() req$postBody <- paste0(req$rook.input$read_lines(), collapse = "\n") } - req$.internal$postBodyHandled <- TRUE + req$.internal$bodyHandled <- TRUE } forward() } -postbody_parser <- function(req, parsers = NULL) { - if (length(parsers) == 0) {return(list())} +req_body_parser <- function(req, parsers = NULL) { + if (length(parsers) == 0) { + return(NULL) + } type <- req$HTTP_CONTENT_TYPE - body <- req$postBodyRaw - if (is.null(body)) {return(list())} - parse_body(body, type, parsers) + bodyRaw <- req$bodyRaw + if (is.null(bodyRaw)) { + return(NULL) + } + body <- parse_body(bodyRaw, type, parsers) + # store parsed body into req$body + body +} +req_body_args <- function(req) { + + body <- req$body + if (length(body) == 0) { + return(list()) + } + + # Copy name over so that it is clearer as to the goal of the code below + # The value returned from this function is set to `ret$argsBody` + args_body <- body + + if (inherits(args_body, "plumber_multipart")) { + args_body <- combine_keys(args_body, type = "multi") + + } else if (!is.null(args_body)) { + # if it's a vector, then we should maybe bundle it as a list + # this will allow for req$args to have the single piece of information + # but it will deter from trying to formal name match against MANY false positive values + if (!is.list(args_body)) { + args_body_names <- names(args_body) + # if there are no names at all, wrap it in a unnamed list to pass it through + if (is.null(args_body_names) || all(args_body_names == "")) { + args_body <- list(args_body) + } + } + } + args_body } parse_body <- function(body, content_type = NULL, parsers = NULL) { @@ -29,8 +64,7 @@ parse_body <- function(body, content_type = NULL, parsers = NULL) { parse_raw <- function(toparse) { if (length(toparse$value) == 0L) return(list()) parser <- parser_picker( - # Lower case content_type for parser matching - tolower(toparse$content_type), + toparse$content_type, toparse$value[1], toparse$filename, toparse$parsers @@ -51,9 +85,11 @@ looks_like_json <- local({ }) parser_picker <- function(content_type, first_byte, filename = NULL, parsers = NULL) { + content_type <- cleanup_content_type(content_type) + # parse as json or a form if (length(content_type) == 0) { - # fast default to json when first byte is 7b (ascii {) + # fast default to json when first byte is 7b (ascii {) or 5b (ascii [) if (looks_like_json(first_byte)) { return(parsers$alias$json) } @@ -61,14 +97,6 @@ parser_picker <- function(content_type, first_byte, filename = NULL, parsers = N return(parsers$alias$form) } - # remove trailing content type information - # "text/yaml; charset=UTF-8" - # to - # "text/yaml" - if (stri_detect_fixed(content_type, ";")) { - content_type <- stri_split_fixed(content_type, ";")[[1]][1] - } - parser <- parsers$fixed[[content_type]] # return known parser (exact match) @@ -407,7 +435,7 @@ parser_tsv <- function(...) { } -#' @describeIn parsers Helper parser that writes the binary post body to a file and reads it back again using `read_fn`. +#' @describeIn parsers Helper parser that writes the binary body to a file and reads it back again using `read_fn`. #' This parser should be used when reading from a file is required. #' @param read_fn function used to read a the content of a file. Ex: [readRDS()] #' @export @@ -448,19 +476,16 @@ parser_feather <- function(...) { -#' @describeIn parsers Octet stream parser. Will add a filename attribute if the filename exists. -#' Returns a single item list where the value is the raw content and the key is the filename (if applicable). +#' @describeIn parsers Octet stream parser. Returns the raw content. #' @export parser_octet <- function() { - function(value, filename = NULL, ...) { - arg <- list(value) - names(arg) <- filename - return(arg) + function(value, ...) { + return(value) } } -#' @describeIn parsers Multi part parser. This parser will then parse each individual body with its respective parser +#' @describeIn parsers Multi part parser. This parser will then parse each individual body with its respective parser. When this parser is used, `req$body` will contain the updated output from [webutils::parse_multipart()] by adding the `parsed` output to each part. Each part may contain detailed information, such as `name` (required), `content_type`, `content_disposition`, `filename`, (raw, original) `value`, and `parsed` (parsed `value`). When performing Plumber route argument matching, each multipart part will match its `name` to the `parsed` content. #' @export #' @importFrom webutils parse_multipart parser_multi <- function() { @@ -469,8 +494,20 @@ parser_multi <- function() { stop("No boundary found in multipart content-type header: ", content_type) boundary <- stri_match_first_regex(content_type, "boundary=([^; ]{2,})", case_insensitive = TRUE)[,2] toparse <- parse_multipart(value, boundary) + + # set the names of the items as the `name` of each item + toparse_names <- vapply(toparse, function(x) { + name <- x$name + # null or character(0) + if (length(name) == 0) { + return("") + } + name + }, character(1)) + names(toparse) <- toparse_names + # content-type detection - parsed_items <- lapply(toparse, function(x) { + ret <- lapply(toparse, function(x) { if ( is.null(x$content_type) || # allows for files to be shipped as octect, but parsed using the matching value in `knownContentTypes` @@ -482,11 +519,19 @@ parser_multi <- function() { x$content_type <- getContentType(tools::file_ext(x$filename)) } } - x$parsers <- parsers - parse_raw(x) + # copy over to allow to return the updated `x` without `parsers` + item <- x + # add `parsers` to allow `parse_raw` to work + item$parsers <- parsers + # store the parsed information into `x` + x$parsed <- parse_raw(item) + # return the updated `webutils::parse_multipart()` output + x }) - combine_keys(parsed_items, type = "multi") + # set a class so `req$argsBody` can be reduced to a named list of values + class(ret) <- "plumber_multipart" + ret } } @@ -502,7 +547,7 @@ register_parsers_onLoad <- function() { # parser alias names for plumbing register_parser("csv", parser_csv, fixed = c("application/csv", "application/x-csv", "text/csv", "text/x-csv")) register_parser("json", parser_json, fixed = c("application/json", "text/json")) - register_parser("multi", parser_multi, fixed = "multipart/form-data") + register_parser("multi", parser_multi, fixed = "multipart/form-data", regex = "^multipart/") register_parser("octet", parser_octet, fixed = "application/octet-stream") register_parser("form", parser_form, fixed = "application/x-www-form-urlencoded") register_parser("rds", parser_rds, fixed = "application/rds") diff --git a/R/parse-query.R b/R/parse-query.R index ade461bd4..db83c71d6 100644 --- a/R/parse-query.R +++ b/R/parse-query.R @@ -160,24 +160,18 @@ combine_keys <- function(obj, type) { keys <- names(obj) unique_keys <- unique(keys) - if (length(unique_keys) == length(keys) || is.null(keys)) { + # If a query string as the same amount of unique keys as keys, + # then return it as it + # (`"multi"` type objects MUST be processed, regardless if the unique key count is the same) + if ( + length(unique_keys) == length(keys) && + identical(type, "query") + ) { return(obj) } vals <- unname(obj) - extra_args <- NULL - if (type == "multi") { - # handle unnamed args by removing them from being merged and adding them back again at the end - no_name_positions <- (keys == "") - if (any(no_name_positions)) { - extra_args <- vals[no_name_positions] - vals <- vals[!no_name_positions] - keys <- keys[!no_name_positions] - unique_keys <- setdiff(unique_keys, "") - } - } - cleanup_item <- switch( type, "query" = @@ -187,23 +181,49 @@ combine_keys <- function(obj, type) { "multi" = function(x) { if (length(x) == 1) { - # return first item only - return(x[[1]]) + part <- x[[1]] + filename <- part$filename + parsed <- part$parsed + + if (!is.null(filename)) { + # list( + # "myfile.json" = list( + # a = 1, b = 2 + # ) + # ) + return( + setNames( + list(parsed), + filename + ) + ) + } + # list( + # a = 1, b = 2 + # ) + return(parsed) } - # return list of internal named items - # aka... unlist the top layer only. Maintain the inner layer names - x_new <- lapply(unname(x), function(x_item) { - if (is.atomic(x_item)) { - # handles things like `parse_text` which returns atomic values - return(list(x_item)) - } + # length is > 1 - # handles things like `parse_octet` which returns a (possibly) named list - x_item + has_a_filename <- FALSE + filenames <- lapply(x, function(part) { + filename <- part$filename + if (is.null(filename)) return("") + has_a_filename <<- TRUE + filename }) - as.list(unlist(x_new, recursive = FALSE)) - } + + parsed_items <- lapply(unname(x), `[[`, "parsed") + + if (!has_a_filename) { + # return as is + return(parsed_items) + } + + return(setNames(parsed_items, filenames)) + }, + stop("unknown type: ", type) ) # equivalent code output, `split` is much faster with larger objects @@ -234,6 +254,5 @@ combine_keys <- function(obj, type) { } names(vals) <- unique_keys - # append any remaining unnamed arguments (for `type = multi` only) - c(vals, extra_args) + vals } diff --git a/R/plumber-options.R b/R/plumber-options.R index 0a1a011ed..ee8b6b872 100644 --- a/R/plumber-options.R +++ b/R/plumber-options.R @@ -26,7 +26,7 @@ #' OpenAPI Specification. Defaults to an empty string} #' \item{`plumber.maxRequestSize`}{Maximum length in bytes of request body. Body larger #' than maximum are rejected with http error 413. `0` means unlimited size. Defaults to `0`} -#' \item{`plumber.postBody`}{Copy post body content to `req$postBody` using system encoding. +#' \item{`plumber.postBody`}{Copy body content to `req$postBody` using system encoding. #' This should be set to `FALSE` if you do not need it. Default is `TRUE` to preserve compatibility with #' previous version behavior. Defaults to `TRUE`} #' \item{`plumber.sharedSecret`}{Shared secret used to filter incoming request. diff --git a/R/plumber-step.R b/R/plumber-step.R index 71599c646..711f150bc 100644 --- a/R/plumber-step.R +++ b/R/plumber-step.R @@ -127,7 +127,7 @@ getRelevantArgs <- function(args, plumberExpression) { # If only req and res are found in function definition... # Only call using the first matches of req and res. - # This allows for post body content to have `req` and `res` named arguments and not duplicated values cause issues. + # This allows for body content to have `req` and `res` named arguments and not duplicated values which cause issues. if (all(fargs %in% c("req", "res"))) { ret <- list() # using `$` will retrieve the 1st occurance of req,res @@ -149,14 +149,14 @@ getRelevantArgs <- function(args, plumberExpression) { # for all args, check if they are duplicated arg_names <- names(args) matched_arg_names <- arg_names[arg_names %in% fargs] - duplicated_matched_arg_names <- duplicated(matched_arg_names, fromLast = TRUE) + duplicated_matched_arg_names <- duplicated(matched_arg_names) if (any(duplicated_matched_arg_names)) { stop( "Can't call a Plumber function with duplicated matching formal arguments: ", paste0(unique(matched_arg_names[duplicated_matched_arg_names]), collapse = ", "), "\nPlumber recommends that the route's function signature be `function(req, res)`", - "\nand to access arguments via `req$args`, `req$argsPath`, `req$argsPostBody`, or `req$argsQuery`." + "\nand to access arguments via `req$args`, `req$argsPath`, `req$argsBody`, or `req$argsQuery`." ) } diff --git a/R/plumber.R b/R/plumber.R index 8f75c7ee9..46444104f 100644 --- a/R/plumber.R +++ b/R/plumber.R @@ -20,7 +20,7 @@ enumerateVerbs <- function(v) { #' @include shared-secret-filter.R defaultPlumberFilters <- list( queryString = queryStringFilter, - postBody = postBodyFilter, + body = bodyFilter, cookieParser = cookieFilter, sharedSecret = sharedSecretFilter ) @@ -609,7 +609,9 @@ Plumber <- R6Class( private$default_parsers } req$argsPath <- h$getPathParams(path) - req$argsPostBody <- postbody_parser(req, parsers) + # `req_body_parser()` will also set `req$body` with the untouched body value + req$body <- req_body_parser(req, parsers) + req$argsBody <- req_body_args(req) req$args <- c( # req, res @@ -619,8 +621,8 @@ Plumber <- R6Class( req$args, # path params req$argsPath, - # post body params - req$argsPostBody + # body params + req$argsBody ) return(do.call(h$exec, req$args)) diff --git a/R/pr.R b/R/pr.R index ae439fb45..08a4d98d0 100644 --- a/R/pr.R +++ b/R/pr.R @@ -78,10 +78,9 @@ pr <- function(file = NULL, #' pr() %>% #' pr_get("/hi", function() "Hello World") %>% #' pr_post("/echo", function(req, res) { -#' if (req$postBody == "") return("No input") -#' input <- jsonlite::fromJSON(req$postBody) +#' if (is.null(req$body)) return("No input") #' list( -#' input = input +#' input = req$body #' ) #' }) %>% #' pr_run() diff --git a/R/serializer.R b/R/serializer.R index e951413f4..eb32a65f6 100644 --- a/R/serializer.R +++ b/R/serializer.R @@ -255,17 +255,13 @@ serializer_feather <- function(type = "application/feather") { if (!requireNamespace("feather", quietly = TRUE)) { stop("`feather` must be installed for `serializer_feather` to work") } - serializer_content_type(type, function(val) { - tmpfile <- tempfile(fileext = ".feather") - on.exit({ - if (file.exists(tmpfile)) { - unlink(tmpfile) - } - }, add = TRUE) - - feather::write_feather(val, tmpfile) - readBin(tmpfile, what = "raw", n = file.info(tmpfile)$size) - }) + serializer_write_file( + fileext = ".feather", + type = type, + write_fn = function(val, tmpfile) { + feather::write_feather(val, tmpfile) + } + ) } @@ -327,6 +323,39 @@ serializer_cat <- function(..., type = "text/plain; charset=UTF-8") { ) } +#' @describeIn serializers Write output to a temp file whose contents are read back as a serialized response. `serializer_write_file()` creates (and cleans up) a temp file, calls the serializer (which should write to the temp file), and then reads the contents back as the serialized value. If the content `type` starts with `"text"`, the return result will be read into a character string, otherwise the result will be returned as a raw vector. +#' @param write_fn Function that should write serialized contnet to the temp file provided. `write_fn` should have the function signature of `function(value, tmp_file){}`. +#' @param fileext A non-empty character vector giving the file extension. This value will try to be infered from the content type provided. +#' @export +serializer_write_file <- function( + type, + write_fn, + fileext = NULL +) { + + # try to be nice and get the file extension from the + fileext <- fileext %||% get_fileext(type) %||% "" + + serializer_content_type(type, function(val) { + tmpfile <- tempfile(fileext = fileext) + on.exit({ + if (file.exists(tmpfile)) { + unlink(tmpfile) + } + }, add = TRUE) + + # write to disk + write_fn(val, tmpfile) + + # read back results + if (grepl("^text", type)) { + paste(readLines(tmpfile), collapse = "\n") + } else { + readBin(tmpfile, what = "raw", n = file.info(tmpfile)$size) + } + }) +} + @@ -338,25 +367,18 @@ serializer_htmlwidget <- function(..., type = "text/html; charset=UTF-8") { call. = FALSE) } - serializer_content_type(type, function(val) { + serializer_write_file( # Write out a temp file. htmlwidgets (or pandoc?) seems to require that this # file end in .html or the selfcontained=TRUE argument has no effect. - file <- tempfile(fileext = ".html") - on.exit({ - # Delete the temp file - if (file.exists(file)) { - file.remove(file) - } - }) - - # Write the widget out to a file (doesn't currently support in-memory connections - pandoc) - # Must write a self-contained file. We're not serving a directory of assets - # in response to this request, just one HTML file. - htmlwidgets::saveWidget(val, file, selfcontained = TRUE, ...) - - # Read the file back in as a single string and return. - paste(readLines(file), collapse = "\n") - }) + fileext = ".html", + type = type, + write_fn = function(val, tmpfile) { + # Write the widget out to a file (doesn't currently support in-memory connections - pandoc) + # Must write a self-contained file. We're not serving a directory of assets + # in response to this request, just one HTML file. + htmlwidgets::saveWidget(val, tmpfile, selfcontained = TRUE, ...) + } + ) } diff --git a/R/utils.R b/R/utils.R index 0fd227bf1..f73837670 100644 --- a/R/utils.R +++ b/R/utils.R @@ -6,3 +6,25 @@ is_available <- function (package, version = NULL) { } installed && isTRUE(utils::packageVersion(package) >= version) } + +`%||%` <- function(x, y) { + if (is.null(x)) { + y + } else { + x + } +} + +`%|%` <- function(x, y) { + if (length(x) > 1) { + stopifnot(length(y) == 1) + x[is.na(x)] <- y + return(x) + } + + if (is.na(x)) { + y + } else { + x + } +} diff --git a/inst/plumber/03-github/plumber.R b/inst/plumber/03-github/plumber.R index 894158799..290e4eb55 100644 --- a/inst/plumber/03-github/plumber.R +++ b/inst/plumber/03-github/plumber.R @@ -19,7 +19,7 @@ function(){ #* @post /update function(req, res){ secret <- readLines("./github-key.txt")[1] - hm <- digest::hmac(secret, req$postBody, algo="sha1") + hm <- digest::hmac(secret, req$body, algo="sha1") hm <- paste0("sha1=", hm) if (!identical(hm, req$HTTP_X_HUB_SIGNATURE)){ res$status <- 400 diff --git a/inst/plumber/17-arguments/plumber.R b/inst/plumber/17-arguments/plumber.R index 78696ab69..ebaaf0209 100644 --- a/inst/plumber/17-arguments/plumber.R +++ b/inst/plumber/17-arguments/plumber.R @@ -7,15 +7,17 @@ function(a, b) { -#* Since URI paths, query params, and post body arguments can have conflicting names, it's better practice to access arguments via the request object +#* Since URI paths, query params, and body arguments can have conflicting names, it's better practice to access arguments via the request object +#* If more information is needed from the body (such as filenames), inspect `req$body` for more information #* @serializer print #* @post /good-practice// function(req, res) { list( - all = req$args, - query = req$argsQuery, - path = req$argsPath, - postBody = req$argsPostBody + args = req$args, + argsQuery = req$argsQuery, + argsPath = req$argsPath, + argsBody = req$argsBody, + body = req$body ) } @@ -55,57 +57,65 @@ function(req, res) { ## Safe endpoint setup # curl --data 'a=5&b=6' '127.0.0.1:1234/good-practice/3/4?a=1&b=2&d=10' -#> $all -#> $all$req +#> $args +#> $args$req #> #> -#> $all$res +#> $args$res #> #> -#> $all$a +#> $args$a #> [1] "1" #> -#> $all$b +#> $args$b #> [1] "2" #> -#> $all$d +#> $args$d #> [1] "10" #> -#> $all$a +#> $args$a #> [1] "3" #> -#> $all$b +#> $args$b #> [1] "4" #> -#> $all$a +#> $args$a #> [1] "5" #> -#> $all$b +#> $args$b #> [1] "6" #> #> -#> $query -#> $query$a +#> $argsQuery +#> $argsQuery$a #> [1] "1" #> -#> $query$b +#> $argsQuery$b #> [1] "2" #> -#> $query$d +#> $argsQuery$d #> [1] "10" #> #> -#> $path -#> $path$a +#> $argsPath +#> $argsPath$a #> [1] "3" #> -#> $path$b +#> $argsPath$b #> [1] "4" #> #> -#> $postBody -#> $postBody$a +#> $argsBody +#> $argsBody$a #> [1] "5" #> -#> $postBody$b +#> $argsBody$b +#> [1] "6" +#> +#> +#> $body +#> $body$a +#> [1] "5" +#> +#> $body$b #> [1] "6" diff --git a/logo/plumber-hex.png b/logo/plumber-hex.png new file mode 100644 index 000000000..3c30c6145 Binary files /dev/null and b/logo/plumber-hex.png differ diff --git a/logo/plumber.png b/logo/plumber.png index 4d4b36128..770443f29 100644 Binary files a/logo/plumber.png and b/logo/plumber.png differ diff --git a/logo/plumber.svg b/logo/plumber.svg index 11238250d..a876ea787 100644 --- a/logo/plumber.svg +++ b/logo/plumber.svg @@ -1,47 +1 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + \ No newline at end of file diff --git a/man/options_plumber.Rd b/man/options_plumber.Rd index 17d24b862..f858a1c9c 100644 --- a/man/options_plumber.Rd +++ b/man/options_plumber.Rd @@ -54,7 +54,7 @@ when used outside a running router} OpenAPI Specification. Defaults to an empty string} \item{\code{plumber.maxRequestSize}}{Maximum length in bytes of request body. Body larger than maximum are rejected with http error 413. \code{0} means unlimited size. Defaults to \code{0}} -\item{\code{plumber.postBody}}{Copy post body content to \code{req$postBody} using system encoding. +\item{\code{plumber.postBody}}{Copy body content to \code{req$postBody} using system encoding. This should be set to \code{FALSE} if you do not need it. Default is \code{TRUE} to preserve compatibility with previous version behavior. Defaults to \code{TRUE}} \item{\code{plumber.sharedSecret}}{Shared secret used to filter incoming request. diff --git a/man/parsers.Rd b/man/parsers.Rd index f09a14380..06d0d03af 100644 --- a/man/parsers.Rd +++ b/man/parsers.Rd @@ -77,17 +77,16 @@ See \code{\link[=registered_parsers]{registered_parsers()}} for a list of regist \item \code{parser_tsv}: TSV parser. See \code{\link[readr:read_delim]{readr::read_tsv()}} for more details. -\item \code{parser_read_file}: Helper parser that writes the binary post body to a file and reads it back again using \code{read_fn}. +\item \code{parser_read_file}: Helper parser that writes the binary body to a file and reads it back again using \code{read_fn}. This parser should be used when reading from a file is required. \item \code{parser_rds}: RDS parser. See \code{\link[=readRDS]{readRDS()}} for more details. \item \code{parser_feather}: feather parser. See \code{\link[feather:read_feather]{feather::read_feather()}} for more details. -\item \code{parser_octet}: Octet stream parser. Will add a filename attribute if the filename exists. -Returns a single item list where the value is the raw content and the key is the filename (if applicable). +\item \code{parser_octet}: Octet stream parser. Returns the raw content. -\item \code{parser_multi}: Multi part parser. This parser will then parse each individual body with its respective parser +\item \code{parser_multi}: Multi part parser. This parser will then parse each individual body with its respective parser. When this parser is used, \code{req$body} will contain the updated output from \code{\link[webutils:parse_multipart]{webutils::parse_multipart()}} by adding the \code{parsed} output to each part. Each part may contain detailed information, such as \code{name} (required), \code{content_type}, \code{content_disposition}, \code{filename}, (raw, original) \code{value}, and \code{parsed} (parsed \code{value}). When performing Plumber route argument matching, each multipart part will match its \code{name} to the \code{parsed} content. \item \code{parser_none}: No parser. Will not process the postBody. }} diff --git a/man/pr_handle.Rd b/man/pr_handle.Rd index 342256402..309d2bb10 100644 --- a/man/pr_handle.Rd +++ b/man/pr_handle.Rd @@ -70,10 +70,9 @@ pr() \%>\% pr() \%>\% pr_get("/hi", function() "Hello World") \%>\% pr_post("/echo", function(req, res) { - if (req$postBody == "") return("No input") - input <- jsonlite::fromJSON(req$postBody) + if (is.null(req$body)) return("No input") list( - input = input + input = req$body ) }) \%>\% pr_run() diff --git a/man/serializers.Rd b/man/serializers.Rd index 8faa5dcc3..4cdf2cb3a 100644 --- a/man/serializers.Rd +++ b/man/serializers.Rd @@ -15,6 +15,7 @@ \alias{serializer_format} \alias{serializer_print} \alias{serializer_cat} +\alias{serializer_write_file} \alias{serializer_htmlwidget} \alias{serializer_device} \alias{serializer_jpeg} @@ -57,6 +58,8 @@ serializer_print(..., type = "text/plain; charset=UTF-8") serializer_cat(..., type = "text/plain; charset=UTF-8") +serializer_write_file(type, write_fn, fileext = NULL) + serializer_htmlwidget(..., type = "text/html; charset=UTF-8") serializer_device(type, dev_on, dev_off = grDevices::dev.off) @@ -93,6 +96,10 @@ An exception is that objects of class \code{AsIs} (i.e. wrapped in \code{I()}) a representation is written; otherwise (default) a binary one. See also the comments in the help for \code{\link[base]{save}}.} +\item{write_fn}{Function that should write serialized contnet to the temp file provided. \code{write_fn} should have the function signature of \code{function(value, tmp_file){}}.} + +\item{fileext}{A non-empty character vector giving the file extension. This value will try to be infered from the content type provided.} + \item{dev_on}{Function to turn on a graphics device. The graphics device \code{dev_on} function will receive any arguments supplied to the serializer in addition to \code{filename}. \code{filename} points to the temporary file name that should be used when saving content.} @@ -135,6 +142,8 @@ more details on Plumber serializers and how to customize their behavior. \item \code{serializer_cat}: Text serializer. Captures the output of \code{\link[=cat]{cat()}} +\item \code{serializer_write_file}: Write output to a temp file whose contents are read back as a serialized response. \code{serializer_write_file()} creates (and cleans up) a temp file, calls the serializer (which should write to the temp file), and then reads the contents back as the serialized value. If the content \code{type} starts with \code{"text"}, the return result will be read into a character string, otherwise the result will be returned as a raw vector. + \item \code{serializer_htmlwidget}: htmlwidget serializer. See also: \code{\link[htmlwidgets:saveWidget]{htmlwidgets::saveWidget()}} \item \code{serializer_device}: Helper method to create graphics device serializers, such as \code{\link[=serializer_png]{serializer_png()}}. See also: \code{\link[=endpoint_serializer]{endpoint_serializer()}} diff --git a/pkgdown/_pkgdown.yml b/pkgdown/_pkgdown.yml index 44f6aa570..90216b616 100644 --- a/pkgdown/_pkgdown.yml +++ b/pkgdown/_pkgdown.yml @@ -85,7 +85,7 @@ reference: - 'register_docs' - 'validate_api_spec' -- title: POST Body and Query String Parsers +- title: Body Parsers contents: - 'register_parser' - 'parser_form' diff --git a/tests/testthat/files/multipart-file-names.bin b/tests/testthat/files/multipart-file-names.bin new file mode 100644 index 000000000..b1dc11f32 Binary files /dev/null and b/tests/testthat/files/multipart-file-names.bin differ diff --git a/tests/testthat/helper-for-each-plumber-api.R b/tests/testthat/helper-for-each-plumber-api.R index 9b653f748..7503757b5 100644 --- a/tests/testthat/helper-for-each-plumber-api.R +++ b/tests/testthat/helper-for-each-plumber-api.R @@ -10,7 +10,7 @@ for_each_plumber_api <- function(fn, ...) { } pr <- - if (name == "12-entrypoint") { + if (name %in% c("06-sessions", "12-entrypoint")) { expect_warning({ plumb_api(package, name) }, "Legacy cookie secret") diff --git a/tests/testthat/helper-mock-request.R b/tests/testthat/helper-mock-request.R index 5f87885e7..affe8951c 100644 --- a/tests/testthat/helper-mock-request.R +++ b/tests/testthat/helper-mock-request.R @@ -1,11 +1,17 @@ -make_req <- function(verb, path, qs="", body=""){ - req <- new.env() +make_req <- function(verb = "GET", path = "/", qs="", body="", args = c(), ...){ + req <- as.environment(list(...)) req$REQUEST_METHOD <- toupper(verb) req$PATH_INFO <- path req$QUERY_STRING <- qs - req$rook.input <- list(read_lines = function(){ body }, - read = function(){ charToRaw(body) }, - rewind = function(){ length(charToRaw(body)) }) + + if (is.character(body)) { + body <- charToRaw(body) + } + stopifnot(is.raw(body)) + req$rook.input <- list(read_lines = function(){ rawToChar(body) }, + read = function(){ body }, + rewind = function(){ length(body) }) + req$bodyRaw <- body req } diff --git a/tests/testthat/test-combine-keys.R b/tests/testthat/test-combine-keys.R index 123d3dce3..694c08631 100644 --- a/tests/testthat/test-combine-keys.R +++ b/tests/testthat/test-combine-keys.R @@ -1,72 +1,74 @@ -context("combine keys") - -test_that("query keys with same name are combined", { - a <- list(A = 1, A = 2, B = 3, A = 4, B = 5) - expect_equal(combine_keys(a, "query"), list(A = c(1,2,4), B = c(3,5))) -}) +context("combine multipart values") test_that("multi part keys with same name are combined", { # no lists - a <- list(A = 1, A = 2, B = 3, A = 4, B = 5) + a <- list( + A = list(name = "A", parsed = 1), + A = list(name = "A", parsed = 2), + B = list(name = "B", parsed = 3), + A = list(name = "A", parsed = 4), + B = list(name = "B", parsed = 5) + ) expect_equal(combine_keys(a, "multi"), list(A = list(1,2,4), B = list(3,5))) # unnamed lists - a <- list(A = 1, A = list(11,12), B = 3, A = 4, B = 5) - expect_equal(combine_keys(a, "multi"), list(A = list(1,11,12,4), B = list(3,5))) + a <- list( + A = list(name = "A", parsed = 1), + A = list(name = "A", parsed = list(11, 12)), + B = list(name = "B", parsed = 3), + A = list(name = "A", parsed = 4), + B = list(name = "B", parsed = 5) + ) + expect_equal(combine_keys(a, "multi"), list(A = list(1,list(11,12),4), B = list(3,5))) # partial named lists - a <- list(A = 1, A = list(X = 11,12), B = 3, A = list(Y = 4), B = 5) - expect_equal(combine_keys(a, "multi"), list(A = list(1,X = 11, 12, Y = 4), B = list(3,5))) + a <- list( + A = list(name = "A", parsed = 1), + A = list(name = "A", parsed = list(X = 11, 12)), + B = list(name = "B", parsed = 3), + A = list(name = "A", parsed = list(Y = 4)), + B = list(name = "B", parsed = 5) + ) + expect_equal(combine_keys(a, "multi"), list(A = list(1,list(X = 11, 12), list(Y = 4)), B = list(3,5))) # named lists - a <- list(A = 1, A = list(X = 11, Y = 12), B = 3, A = list(Z = 4), B = 5) - expect_equal(combine_keys(a, "multi"), list(A = list(1,X = 11, Y = 12, Z = 4), B = list(3,5))) -}) - - -test_that("multi part keys with no name are left alone", { - a <- list(A = 1, 2, A = 3, B = 4, 5) - expect_equal(combine_keys(a, "multi"), list(A = list(1,3), B = 4, 2, 5)) - - a <- list(A = 1, 2, A = 3, B = 4, 5) - expect_equal(combine_keys(a, "multi"), list(A = list(1,3), B = 4, 2, 5)) - a <- list(A = 1, 2, A = 3, B = 4, 5) - expect_equal(combine_keys(a, "multi"), list(A = list(1,3), B = 4, 2, 5)) + a <- list( + A = list(name = "A", parsed = 1), + A = list(name = "A", parsed = list(X = 11, Y = 12)), + B = list(name = "B", parsed = 3), + A = list(name = "A", parsed = list(Z = 4)), + B = list(name = "B", parsed = 5) + ) + expect_equal(combine_keys(a, "multi"), list(A = list(1,list(X = 11, Y = 12), list(Z = 4)), B = list(3,5))) }) -test_that("multi part keys with no names are untouched", { - a <- list(1,2,3,4,5) - expect_equal(combine_keys(a, "multi"), a) - - a <- list(1,list(2),3,4,5) - expect_equal(combine_keys(a, "multi"), a) - - a <- list(1,list(2),3,list(4,5)) - expect_equal(combine_keys(a, "multi"), a) - - a <- list(list(1),list(2),list(3),list(4, 5)) - expect_equal(combine_keys(a, "multi"), a) -}) - test_that("multi part keys with all same name", { - a <- list(A = 1, A = 2, A = 3, A = 4, A = 5) - expect_equal(combine_keys(a, "multi"), list(A = list(1,2,3,4,5))) - - a <- list(A = 1,A = list(2),A = 3,A = 4,A = 5) - expect_equal(combine_keys(a, "multi"), list(A = list(1,2,3,4,5))) - - a <- list(A = 1,A = list(2),A = 3,A = list(4,5)) + a <- list( + A = list(name = "A", parsed = 1), + A = list(name = "A", parsed = 2), + A = list(name = "A", parsed = 3), + A = list(name = "A", parsed = 4), + A = list(name = "A", parsed = 5) + ) expect_equal(combine_keys(a, "multi"), list(A = list(1,2,3,4,5))) - a <- list(A = 1,A = list(2),A = 3,A = list(4,Y = 5)) - expect_equal(combine_keys(a, "multi"), list(A = list(1,2,3,4,Y = 5))) - - a <- list(A = 1,A = list(2),A = 3,A = list(X = 4,Y = 5)) - expect_equal(combine_keys(a, "multi"), list(A = list(1,2,3,X = 4,Y = 5))) - - a <- list(A = 1,A = list(B = 2),A = 3,A = list(X = 4,Y = 5)) - expect_equal(combine_keys(a, "multi"), list(A = list(1,B = 2,3,X = 4,Y = 5))) + a <- list( + A = list(name = "A", parsed = 1), + A = list(name = "A", parsed = list(2)), + A = list(name = "A", parsed = 3), + A = list(name = "A", parsed = 4), + A = list(name = "A", parsed = 5) + ) + expect_equal(combine_keys(a, "multi"), list(A = list(1,list(2),3,4,5))) + + a <- list( + A = list(name = "A", parsed = 1), + A = list(name = "A", parsed = list(2)), + A = list(name = "A", parsed = 3), + A = list(name = "A", parsed = list(4, 5)) + ) + expect_equal(combine_keys(a, "multi"), list(A = list(1,list(2),3,list(4,5)))) }) @@ -74,36 +76,67 @@ test_that("raw values are not combined", { x <- charToRaw("testval") y <- charToRaw("other testval") - a <- list(x,y) - expect_equal(combine_keys(a, "multi"), list(x, y)) - - a <- list(A = x,y) - expect_equal(combine_keys(a, "multi"), list(A = x, y)) - - a <- list(A = x, B = y) - expect_equal(combine_keys(a, "multi"), list(A = x, B = y)) - - a <- list(A = x, A = y) - expect_equal(combine_keys(a, "multi"), list(A = list(x, y))) - - a <- list(A = list(X = x), A = y) - a <- list(A = list(X = x), A = list(y)) - expect_equal(combine_keys(a, "multi"), list(A = list(X = x, y))) - - a <- list(A = list(x), A = list(Y = y)) - expect_equal(combine_keys(a, "multi"), list(A = list(x, Y = y))) - - a <- list(A = list(X = x), A = list(Y = y)) - expect_equal(combine_keys(a, "multi"), list(A = list(X = x, Y = y))) - - - a <- list(A = list(X = x), A = list(Y = y), A = "foobar") - expect_equal(combine_keys(a, "multi"), list(A = list(X = x, Y = y, "foobar"))) -}) - - -test_that("inner list structures are preserved", { - - a <- list(A = 1, B = 2, A = list(X = 3, Y = 4)) - expect_equal(combine_keys(a, "multi"), list(A = list(1,X = 3, Y = 4), B = 2)) + a <- list( + A = list(name = "A", parsed = x), + B = list(name = "B", parsed = 2), + A = list(name = "A", parsed = y), + A = list(name = "A", parsed = 4) + ) + expect_equal(combine_keys(a, "multi"), list(A = list(x, y, 4), B = 2)) + + a <- list( + A = list(name = "A", parsed = x, filename = "x"), + B = list(name = "B", parsed = 2), + A = list(name = "A", parsed = y), + A = list(name = "A", parsed = 4) + ) + expect_equal(combine_keys(a, "multi"), list(A = list(x = x, y, 4), B = 2)) + + a <- list( + A = list(name = "A", parsed = x, filename = "x"), + B = list(name = "B", parsed = 2, filename = "two"), + A = list(name = "A", parsed = y), + A = list(name = "A", parsed = 4) + ) + expect_equal(combine_keys(a, "multi"), list(A = list(x = x, y, 4), B = list(two = 2))) + + a <- list( + A = list(name = "A", parsed = x), + B = list(name = "B", parsed = 2, filename = "two"), + A = list(name = "A", parsed = y, filename = "y"), + A = list(name = "A", parsed = 4) + ) + expect_equal(combine_keys(a, "multi"), list(A = list(x, y = y, 4), B = list(two = 2))) + + a <- list( + A = list(name = "A", parsed = x, filename = "x"), + B = list(name = "B", parsed = 2, filename = "two"), + A = list(name = "A", parsed = y, filename = "y"), + A = list(name = "A", parsed = 4) + ) + expect_equal(combine_keys(a, "multi"), list(A = list(x = x, y = y, 4), B = list(two = 2))) + + a <- list( + A = list(name = "A", parsed = x, filename = "x"), + B = list(name = "B", parsed = 2, filename = "two"), + A = list(name = "A", parsed = y, filename = "y"), + A = list(name = "A", parsed = 4, filename = "four") + ) + expect_equal(combine_keys(a, "multi"), list(A = list(x = x, y = y, four = 4), B = list(two = 2))) + + a <- list( + A = list(name = "A", parsed = list(x), filename = "x"), + B = list(name = "B", parsed = 2, filename = "two"), + A = list(name = "A", parsed = y, filename = "y"), + A = list(name = "A", parsed = 4, filename = "four") + ) + expect_equal(combine_keys(a, "multi"), list(A = list(x = list(x), y = y, four = 4), B = list(two = 2))) + + a <- list( + A = list(name = "A", parsed = list(x), filename = "same"), + B = list(name = "B", parsed = 2, filename = "same"), + A = list(name = "A", parsed = y, filename = "same"), + A = list(name = "A", parsed = 4, filename = "same") + ) + expect_equal(combine_keys(a, "multi"), list(A = list(same = list(x), same = y, same = 4), B = list(same = 2))) }) diff --git a/tests/testthat/test-content-type.R b/tests/testthat/test-content-type.R index 18513b129..5391a762f 100644 --- a/tests/testthat/test-content-type.R +++ b/tests/testthat/test-content-type.R @@ -32,3 +32,9 @@ test_that("Defaults charset when not there", { charset <- get_character_set(NULL) expect_equal(charset, "UTF-8") }) + + +test_that("File extensions can be found from the content type", { + expect_equal(get_fileext("application/json"), "json") + expect_equal(get_fileext("not a match"), NULL) +}) diff --git a/tests/testthat/test-parse-body.R b/tests/testthat/test-parse-body.R index 077f86c78..f2054e8e8 100644 --- a/tests/testthat/test-parse-body.R +++ b/tests/testthat/test-parse-body.R @@ -1,4 +1,4 @@ -context("POST body") +context("body parsing") test_that("JSON is consumed on POST", { expect_equal(parse_body('{"a":"1"}', content_type = NULL, parsers = make_parser("json")), list(a = "1")) @@ -21,18 +21,18 @@ test_that("Able to handle UTF-8", { #charset moved to part parsing test_that("filter passes on content-type", { - content_type_passed <- "" - req <- list( - postBodyRaw = charToRaw("this is a body"), + req <- make_req( + body = "this is a body", HTTP_CONTENT_TYPE = "text/html; charset=testset", - args = c() ) with_mock( parse_body = function(body, content_type = "unknown", parsers = NULL) { print(content_type) body }, - expect_output(postbody_parser(req, make_parser("text")), "text/html; charset=testset"), + { + expect_output(req_body_parser(req, make_parser("text")), "text/html; charset=testset") + }, .env = "plumber" ) }) @@ -109,47 +109,179 @@ test_that("Test feather parser", { expect_equal(parsed, r_object) }) + +test_that("Test multipart output is reduced for argument matching", { + bin_file <- test_path("files/multipart-file-names.bin") + body <- readBin(bin_file, what = "raw", n = file.info(bin_file)$size) + req <- make_req( + body = body, + HTTP_CONTENT_TYPE = "multipart/form-data; boundary=---------------------------286326291134907228894146459692" + ) + + req$body <- req_body_parser(req, make_parser(c("multi", "octet", "json"))) + body_args <- req_body_args(req) + + expect_s3_class(req$body, "plumber_multipart") + expect_equal(names(req$body), c("files", "files", "files", "files", "dt", "namedval", "namedval", "namedval", "namedval")) + for(part in req$body) { + + expect_equal(part$content_disposition, "form-data") + expect_true(is.character(part$name)) + expect_true(is.raw(part$value)) + + if (part$name == "dt") { + expect_true(is.null(part$content_type)) + } else { + expect_true(!is.null(part$content_type)) + } + + if (part$name == "dt" || identical(part$filename, "has_name3.json")) { + expect_equal(part$parsed, jsonlite::parse_json("{}")) + } else { + expect_true(is.raw(part$parsed)) + } + } + + expect_true(!inherits(body_args, "plumber_multipart")) + expect_equal(names(body_args), c("files", "dt", "namedval")) + + expect_equal(length(body_args$files), 4) + expect_equal(names(body_args$files), c("avatar2-small.png", "text1.bin", "text2.bin", "text3.bin")) + for (parsed in body_args$files) { + expect_true(is.raw(parsed)) + } + + expect_equal(body_args$dt, jsonlite::parse_json("{}")) + + expect_equal(length(body_args$namedval), 4) + expect_equal(names(body_args$namedval), c("has_name.bin", "", "has_name2.bin", "has_name3.json")) + for (parsed in body_args$namedval[-4]) { + expect_true(is.raw(parsed)) + } + expect_equal(body_args$namedval$`has_name3.json`, jsonlite::parse_json("{}")) +}) + + test_that("Test multipart parser", { # also tests rds and the octet -> content type conversion bin_file <- test_path("files/multipart-form.bin") body <- readBin(bin_file, what = "raw", n = file.info(bin_file)$size) - parsed_body <- parse_body(body, - "multipart/form-data; boundary=----WebKitFormBoundaryMYdShB9nBc32BUhQ", - make_parser(c("multi", "json", "rds", "octet"))) - - expect_equal(names(parsed_body), c("json", "img1", "img2", "rds")) - expect_equal(parsed_body[["rds"]], women) - expect_equal(names(parsed_body[["img1"]]), c("avatar2-small.png")) - expect_true(is.raw(parsed_body[["img1"]][["avatar2-small.png"]])) - expect_true(length(parsed_body[["img1"]][["avatar2-small.png"]]) > 100) - expect_equal(parsed_body[["json"]], list(a=2,b=4,c=list(w=3,t=5))) + req <- make_req( + body = body, + HTTP_CONTENT_TYPE = "multipart/form-data; boundary=----WebKitFormBoundaryMYdShB9nBc32BUhQ" + ) + req$body <- req_body_parser(req, make_parser(c("multi", "json", "rds", "octet"))) + body_args <- req_body_args(req) + + expect_s3_class(req$body, "plumber_multipart") + expect_equal(names(req$body), c("json", "img1", "img2", "rds")) + for(part in req$body) { + expect_equal(part$content_disposition, "form-data") + expect_true(is.character(part$name)) + expect_true(is.raw(part$value)) + + if (part$name == "json") { + expect_true(is.null(part$content_type)) + } else { + expect_true(!is.null(part$content_type)) + } + + switch(part$name, + "json" = expect_equal(part$parsed, list(a=2,b=4,c=list(w=3,t=5))), + "rds" = expect_equal(part$parsed, women), + { + if (part$name == "img1") expect_equal(part$filename, "avatar2-small.png") + if (part$name == "img2") expect_equal(part$filename, "ragnarok_small.png") + expect_true(is.raw(part$parsed)) + expect_gt(length(part$parsed), 100) + } + ) + } + + expect_true(!inherits(body_args, "plumber_multipart")) + expect_equal(names(body_args), c("json", "img1", "img2", "rds")) + expect_equal(body_args[["rds"]], list("women.rds" = women)) + expect_true(is.raw(body_args[["img1"]][["avatar2-small.png"]])) + expect_gt(length(body_args[["img1"]][["avatar2-small.png"]]), 100) + expect_true(is.raw(body_args[["img2"]][["ragnarok_small.png"]])) + expect_gt(length(body_args[["img2"]][["ragnarok_small.png"]]), 100) + expect_equal(body_args[["json"]], list(a=2,b=4,c=list(w=3,t=5))) }) test_that("Test multipart respect content-type", { + skip_if_not_installed("readr") + bin_file <- test_path("files/multipart-ctype.bin") body <- readBin(bin_file, what = "raw", n = file.info(bin_file)$size) - parsed_body <- parse_body(body, - "multipart/form-data; boundary=---------------------------90908882332870323642673870272", - make_parser(c("multi", "tsv"))) - expect_s3_class(parsed_body$sample_name, "data.frame") + req <- make_req( + body = body, + HTTP_CONTENT_TYPE = "multipart/form-data; boundary=---------------------------90908882332870323642673870272" + ) + req$body <- req_body_parser(req, make_parser(c("multi", "tsv"))) + body_args <- req_body_args(req) + + expect_s3_class(req$body, "plumber_multipart") + expect_equal(length(req$body), 1) + expect_equal(names(req$body), "sample_name") + + expect_equal(req$body$sample_name$content_disposition, "form-data") + expect_true(is.character(req$body$sample_name$name)) + expect_true(is.raw(req$body$sample_name$value)) + expect_equal(req$body$sample_name$content_type, "text/tab-separated-values") + + expect_s3_class(req$body$sample_name$parsed, "data.frame") + expect_equal(colnames(req$body$sample_name$parsed), c("x", "y", "z")) + expect_equal(nrow(req$body$sample_name$parsed), 11) + + expect_true(!inherits(body_args, "plumber_multipart")) + expect_s3_class(body_args[["sample_name"]][["sample.tsv"]], "data.frame") + expect_equal(colnames(body_args[["sample_name"]][["sample.tsv"]]), c("x", "y", "z")) + expect_equal(nrow(body_args[["sample_name"]][["sample.tsv"]]), 11) }) test_that("Test an array of files upload", { bin_file <- test_path("files/multipart-files-array.bin") body <- readBin(bin_file, what = "raw", n = file.info(bin_file)$size) - parsed_body <- parse_body( - body, - "multipart/form-data; boundary=---------------------------286326291134907228894146459692", - make_parser(c("multi", "octet", "json")) + body <- readBin(bin_file, what = "raw", n = file.info(bin_file)$size) + req <- make_req( + body = body, + HTTP_CONTENT_TYPE = "multipart/form-data; boundary=---------------------------286326291134907228894146459692" ) + req$body <- req_body_parser(req, make_parser(c("multi", "octet", "json"))) + body_args <- req_body_args(req) + + expect_s3_class(req$body, "plumber_multipart") + expect_equal(names(req$body), c("files", "files", "files", "files", "dt")) + + for(i in seq_along(req$body)) { + part <- req$body[[i]] + expect_equal(part$content_disposition, "form-data") + expect_true(is.character(part$name)) + expect_true(is.raw(part$value)) + + if (i == 1) { + expect_equal(part$name, "files") + expect_equal(part$filename, "avatar2-small.png") + expect_equal(part$content_type, "image/png") + } else if (i == 5) { + expect_equal(part$name, "dt") + expect_equal(part$content_type, NULL) + expect_equal(part$parsed, jsonlite::parse_json("{}")) + } else { + expect_equal(part$name, "files") + expect_equal(part$filename, paste0("text", i - 1, ".bin")) + expect_equal(part$content_type, "application/octet-stream") + expect_equal(rawToChar(part$parsed), letters[i - 1]) + } + } - expect_equal(names(parsed_body), c("files", "dt")) - expect_length(parsed_body[["files"]], 4) - expect_equal(names(parsed_body[["files"]])[2], "text1.bin") - expect_equal(rawToChar(parsed_body[["files"]][[2]]), "a") - expect_equal(rawToChar(parsed_body[["files"]][[3]]), "b") - expect_equal(rawToChar(parsed_body[["files"]][[4]]), "c") - expect_equal(parsed_body$dt, jsonlite::parse_json("{}")) + expect_true(!inherits(body_args, "plumber_multipart")) + expect_equal(names(body_args), c("files", "dt")) + expect_equal(names(body_args$files), c("avatar2-small.png", "text1.bin", "text2.bin", "text3.bin")) + expect_equal(rawToChar(body_args$files[[2]]), "a") + expect_equal(rawToChar(body_args$files[[3]]), "b") + expect_equal(rawToChar(body_args$files[[4]]), "c") + expect_equal(body_args[["dt"]], jsonlite::parse_json("{}")) }) diff --git a/tests/testthat/test-parser.R b/tests/testthat/test-parser.R index 2480ba60c..5f7ba914f 100644 --- a/tests/testthat/test-parser.R +++ b/tests/testthat/test-parser.R @@ -66,8 +66,7 @@ test_that("parsers work", { r$route(req, PlumberResponse$new()) }) expect_equal(names(parsed_body), c("json", "img1", "img2", "rds")) - expect_equal(parsed_body[["rds"]], women) - expect_equal(names(parsed_body[["img1"]]), c("avatar2-small.png")) + expect_equal(parsed_body[["rds"]], list("women.rds" = women)) expect_true(is.raw(parsed_body[["img1"]][["avatar2-small.png"]])) expect_equal(parsed_body[["json"]], list(a=2,b=4,c=list(w=3,t=5))) diff --git a/tests/testthat/test-plumber-print.R b/tests/testthat/test-plumber-print.R index fd726d02b..2e5ddaf52 100644 --- a/tests/testthat/test-plumber-print.R +++ b/tests/testthat/test-plumber-print.R @@ -21,7 +21,7 @@ test_that("prints correctly", { "# Plumber router with 2 endpoints, 4 filters, and 2 sub-routers.", "# Call run() on this object to start the API.", "├──[queryString]", - "├──[postBody]", + "├──[body]", "├──[cookieParser]", "├──[sharedSecret]", "├──/nested", @@ -30,7 +30,7 @@ test_that("prints correctly", { "├──/mysubpath", "│ │ # Plumber router with 2 endpoints, 4 filters, and 0 sub-routers.", "│ ├──[queryString]", - "│ ├──[postBody]", + "│ ├──[body]", "│ ├──[cookieParser]", "│ ├──[sharedSecret]", "│ ├──/ (GET)", @@ -62,13 +62,13 @@ test_that("prints correctly", { "# Plumber router with 0 endpoints, 4 filters, and 1 sub-router.", "# Call run() on this object to start the API.", "├──[queryString]", - "├──[postBody]", + "├──[body]", "├──[cookieParser]", "├──[sharedSecret]", "├──/", "│ │ # Plumber router with 5 endpoints, 4 filters, and 0 sub-routers.", "│ ├──[queryString]", - "│ ├──[postBody]", + "│ ├──[body]", "│ ├──[cookieParser]", "│ ├──[sharedSecret]", "│ ├──/ (GET, POST)", diff --git a/tests/testthat/test-static.R b/tests/testthat/test-static.R index beea52a0b..3ad92054b 100644 --- a/tests/testthat/test-static.R +++ b/tests/testthat/test-static.R @@ -34,7 +34,7 @@ test_that("root requests are routed to index.html", { test_that("static binary file is served", { res <- PlumberResponse$new() pr$route(make_req("GET", "/test.txt.zip"), res) - expect_equal(res$headers$`Content-Type`, "application/octet-stream") + expect_equal(res$headers$`Content-Type`, "application/zip") bod <- res$body zipf <- file(test_path("files/static/test.txt.zip"), "rb") bin <- readBin(zipf, "raw", n=1000) diff --git a/vignettes/files/apis/03-04-body.R b/vignettes/files/apis/03-04-body.R index 48e40e9e1..de7c82a7c 100644 --- a/vignettes/files/apis/03-04-body.R +++ b/vignettes/files/apis/03-04-body.R @@ -1,8 +1,9 @@ #' @post /user -function(req, id, name){ +function(req, id, name) { list( id = id, name = name, - raw = req$postBody + body = req$body, + raw = req$bodyRaw ) } diff --git a/vignettes/files/examples/github.R b/vignettes/files/examples/github.R index 398a4174f..353d9f148 100644 --- a/vignettes/files/examples/github.R +++ b/vignettes/files/examples/github.R @@ -26,7 +26,7 @@ function(req, res) { # I stored my secret in a file at ~/.github secret <- readLines("~/.github")[1] - hm <- digest::hmac(secret, req$postBody, algo="sha1") + hm <- digest::hmac(secret, req$body, algo="sha1") hm <- paste0("sha1=", hm) if (!identical(hm, req$HTTP_X_HUB_SIGNATURE)){ # Invalid signature diff --git a/vignettes/routing-and-input.Rmd b/vignettes/routing-and-input.Rmd index af3f475f4..47af93e8d 100644 --- a/vignettes/routing-and-input.Rmd +++ b/vignettes/routing-and-input.Rmd @@ -231,12 +231,12 @@ Name | Example | Description `cookies` | `list(cook="abc")` | A list of the cookies as described in [Cookies](#read-cookies) `httpuv.version` | `"1.3.3"` | The version of the underlying [`httpuv` package](https://github.com/rstudio/httpuv) `PATH_INFO` | `"/"` | The path of the incoming HTTP request -`postBody` | `"a=1&b=2"` | The text contents of the body of the request. Despite the name, it is available for any HTTP method. To disable this parsing, see `?options_plumber`. -`postBodyRaw` | `charToRaw("a=1&b=2")` | The `raw()`, unparsed contents of the body of the request -`args` | `list(a=1,b=2)` | In a route, the combined arguments of `list(req = req, res = res)`, `argsPath`, `argsPostBody`, and `argsQuery`. In a filter, only contains `argsQuery`. -`argsPath` | `list(a=1,b=2)` | The values of the path arguments. -`argsQuery` | `list(a=1,b=2)` | The parsed query string output. -`argsPostBody` | `list(a=1,b=2)` | The parsed post boy output. +`bodyRaw` | `charToRaw("a=1&b=2")` | The `raw()`, unparsed contents of the body of the request +`body` | `list(a=1,b=2)` | This value will typically be the same as `argsBody`. However, with content type `"multipart/*"`, `req$body` may contain detailed information, such as `name`, `content_type`, `content_disposition`, `filename`, `value` (which is a `raw()` vector), and `parsed` (parsed version of `value`). +`argsBody` | `list(a=1,b=2)` | The parsed body output. Typically this is the same as `req$body` except when type is `"multipart/*"`. +`argsPath` | `list(c=3,d=4)` | The values of the path arguments. +`argsQuery` | `list(e=5,f=6)` | The parsed query string output. +`args` | `list(req=req,res=res,e=5,f=6,c=3,d=4,a=1,b=2)` | In a route, the combined arguments of `list(req = req, res = res)`, `argsQuery`, `argsPath`, and `argsBody`. In a filter, `req$args` only contains `argsQuery` as the route information will not have been processed yet. `QUERY_STRING` | `"?a=123&b=abc"` | The query-string portion of the HTTP request `REMOTE_ADDR` | `"1.2.3.4"` | The IP address of the client making the request `REMOTE_PORT` | `"62108"` | The client port from which the request originated @@ -249,6 +249,7 @@ Name | Example | Description `SERVER_NAME` | `"127.0.0.1"` | The host portion of the incoming request. You may favor `HTTP_HOST`, if available. `SERVER_PORT` | `"8000"` | The target port for the request `HTTP_*` | `"HTTP_USER_AGENT"` | Entries for all of the HTTP headers sent with this request +`postBody` | `"a=1&b=2"` | The text contents of the body of the request. Despite the name, it is available for any HTTP method. It is recommended to disable this parsing, see `?options_plumber`. ### Query Strings {#query-strings} @@ -299,14 +300,14 @@ Running `curl --data "id=123&name=Jennifer" "http://localhost:8000/user"` will r ```{r, echo=FALSE, results='asis'} r <- plumber::plumb("files/apis/03-04-body.R") e <- r$endpoints[[1]][[1]] -code_chunk(json_serialize(e$exec(req=list(postBody="id=123&name=Jennifer"), id=123, name="Jennifer")), "json") +code_chunk(json_serialize(e$exec(req=list(bodyRaw = charToRaw("id=123&name=Jennifer"), body=list(id = 123, name = "Jennifer")), id=123, name="Jennifer")), "json") ``` Alternatively, `curl --data '{"id":123, "name": "Jennifer"}' "http://localhost:8000/user"` (formatting the body as JSON) will have the same effect. -As demonstrated above, the raw request body is made available as `req$postBody` and `req$postBodyRaw`. +As demonstrated above, the raw request body is made available as `req$bodyRaw` and parsed request body is available as `req$body`. -If multiple parameters are matched to the endpoint formals, an error will be thrown. Due to the nature of how multiple values can be matched to the same argument, it is recommended that `POST` enpoints have a function definition that only accepts the formals `req`, `res`, and `...`. If the endpoint arguments are to be processed like a list, they are available at `req$argsPostBody`, with all arguments at `req$args`. `req$args` is a combination of `list(req = req, res = res)`, `req$argsPath`, `req$argsPostBody`, and `req$argsQuery`. +If multiple parameters are matched to the endpoint formals, an error will be thrown. Due to the nature of how multiple values can be matched to the same argument, it is recommended that `POST` enpoints have a function definition that only accepts the formals `req`, `res`, and `...`. If the endpoint arguments are to be processed like a list, they are available at `req$argsBody`, with all arguments at `req$args`. `req$args` is a combination of `list(req = req, res = res)`, `req$argsPath`, `req$argsBody`, and `req$argsQuery`. ### Cookies {#read-cookies}