diff --git a/DESCRIPTION b/DESCRIPTION index ce784715c..3dd4bbce5 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -54,6 +54,7 @@ Collate: 'parse-query.R' 'plumber.R' 'default-handlers.R' + 'deprecated.R' 'digital-ocean.R' 'find-port.R' 'globals.R' diff --git a/NAMESPACE b/NAMESPACE index 9fdf3fdb5..d1a2338d7 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -3,7 +3,6 @@ export("%>%") export(PlumberEndpoint) export(PlumberStatic) -export(addParser) export(addSerializer) export(as_attachment) export(do_configure_https) @@ -19,12 +18,16 @@ export(include_html) export(include_md) export(include_rmd) export(options_plumber) +export(parser_csv) export(parser_json) export(parser_multi) +export(parser_none) export(parser_octet) export(parser_query) export(parser_rds) +export(parser_read_file) export(parser_text) +export(parser_tsv) export(parser_yaml) export(plumb) export(plumber) @@ -45,6 +48,10 @@ export(pr_set_404) export(pr_set_error) export(pr_set_serializer) export(randomCookieKey) +export(register_parser) +export(register_serializer) +export(registered_parsers) +export(registered_serializers) export(serializer_cat) export(serializer_content_type) export(serializer_csv) diff --git a/NEWS.md b/NEWS.md index b2856e8c7..774a2d879 100644 --- a/NEWS.md +++ b/NEWS.md @@ -62,6 +62,8 @@ plumber 1.0.0 * Added yaml support, serializer and parser. (@meztez, #556) +* Added parsers: `parser_csv()`, `parser_json()`, `parser_multi()`, `parser_octet()`, `parser_query()`, `parser_rds()`, `parser_text()`, `parser_tsv()`, `parser_yaml()`, `parser_none()`, and pseudo `"all"` (#584) + * Added `serializer_csv()` (@pachamaltese, #520) * Added svg image serializer (@pachamaltese, #398) diff --git a/R/content-types.R b/R/content-types.R index fb2613386..dc8c73e1c 100644 --- a/R/content-types.R +++ b/R/content-types.R @@ -42,7 +42,9 @@ knownContentTypes <- list( dotx='application/vnd.openxmlformats-officedocument.wordprocessingml.template', xlam='application/vnd.ms-excel.addin.macroEnabled.12', xlsb='application/vnd.ms-excel.sheet.binary.macroEnabled.12', - rds='application/rds') + rds='application/rds', + tsv="text/tab-separated-values", + csv="text/csv") getContentType <- function(ext, defaultType='application/octet-stream') { ct <- knownContentTypes[[tolower(ext)]] diff --git a/R/deprecated.R b/R/deprecated.R new file mode 100644 index 000000000..4437b8a4c --- /dev/null +++ b/R/deprecated.R @@ -0,0 +1,9 @@ +#' Register a Serializer +#' +#' Use [register_serializer()] in favor of addSerializer +#' +#' @export +#' @keywords internal +addSerializer <- function(name, serializer, verbose = TRUE) { + register_serializer(name = name, serializer = serializer, verbose = verbose) +} diff --git a/R/globals.R b/R/globals.R index f33915762..86c556bf9 100644 --- a/R/globals.R +++ b/R/globals.R @@ -1,4 +1,4 @@ .globals <- new.env() .globals$serializers <- list() .globals$processors <- new.env() -.globals$parsers <- list(func = list(), pattern = list()) +.globals$parsers <- list() diff --git a/R/json.R b/R/json.R index 09c256825..573386b22 100644 --- a/R/json.R +++ b/R/json.R @@ -1,5 +1,5 @@ #' @importFrom jsonlite parse_json #' @noRd -safeFromJSON <- function(txt) { - parse_json(txt, simplifyVector = TRUE) +safeFromJSON <- function(txt, simplifyVector = TRUE, ...) { + parse_json(txt, simplifyVector = simplifyVector, ...) } diff --git a/R/parse-body.R b/R/parse-body.R index b44ac09e5..925e7a433 100644 --- a/R/parse-body.R +++ b/R/parse-body.R @@ -2,11 +2,7 @@ postBodyFilter <- function(req){ handled <- req$.internal$postBodyHandled if (is.null(handled) || handled != TRUE) { # This will return raw bytes - body <- req$rook.input$read() - type <- req$HTTP_CONTENT_TYPE - args <- parseBody(body, type) - req$args <- c(req$args, args) - req$postBodyRaw <- body + req$postBodyRaw <- req$rook.input$read() if (isTRUE(getOption("plumber.postBody", TRUE))) { req$rook.input$rewind() req$postBody <- paste0(req$rook.input$read_lines(), collapse = "\n") @@ -16,230 +12,484 @@ postBodyFilter <- function(req){ forward() } -parseBody <- function(body, content_type = NULL) { +postbody_parser <- function(req, parsers = NULL) { + if (length(parsers) == 0) {return(list())} + type <- req$HTTP_CONTENT_TYPE + body <- req$postBodyRaw + if (is.null(body)) {return(list())} + parse_body(body, type, parsers) +} + +parse_body <- function(body, content_type = NULL, parsers = NULL) { if (!is.raw(body)) {body <- charToRaw(body)} - toparse <- list(value = body, content_type = content_type) - parseRaw(toparse) + toparse <- list(value = body, content_type = content_type, parsers = parsers) + parse_raw(toparse) } -parseRaw <- function(toparse) { +parse_raw <- function(toparse) { if (length(toparse$value) == 0L) return(list()) - parser <- parserPicker(toparse$content_type, toparse$value[1], toparse$filename) - do.call(parser(), toparse) -} - -parserPicker <- function(content_type, first_byte, filename = NULL) { - #fast default to json when first byte is 7b (ascii {) - if (first_byte == as.raw(123L)) { - return(.globals$parsers$func[["json"]]) - } - if (is.null(content_type)) { - return(.globals$parsers$func[["query"]]) - } - # else try to find a match - patterns <- .globals$parsers$pattern - parser <- .globals$parsers$func[stri_startswith_fixed(content_type, patterns)] - # Should we warn when multiple parsers match? - # warning("Multiple body parsers matches for content-type : ", toparse$content_type, ". Parser ", names(parser)[1L], " used.") - if (length(parser) == 0L) { - if (is.null(filename)) { - return(.globals$parsers$func[["query"]]) - } else { - return(.globals$parsers$func[["octet"]]) - } - } else { - return(parser[[1L]]) + parser <- parser_picker( + # Lower case content_type for parser matching + tolower(toparse$content_type), + toparse$value[1], + toparse$filename, + toparse$parsers + ) + if (is.null(parser)) { + message("No suitable parser found to handle request body type ", toparse$content_type, ".") + return(list()) } + do.call(parser, toparse) } +parser_picker <- function(content_type, first_byte, filename = NULL, parsers = NULL) { + # parse as a query string + if (length(content_type) == 0) { + # fast default to json when first byte is 7b (ascii {) + if (first_byte == as.raw(123L)) { + return(parsers$alias$json) + } + + return(parsers$alias$query) + } + + # remove trailing content type information + # "application/json; charset=UTF-8" + # to + # "application/json" + 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) + if (!is.null(parser)) { + return(parser) + } + + fpm <- stri_detect_regex( + content_type, + names(parsers$regex), + max_count = 1 + ) + + # return known parser (first regex pattern match) + if (any(fpm)) { + return(parsers$regex[[which(fpm)[1]]]) + } + + # query string + if (is.null(filename)) { + return(parsers$alias$query) + } + + # octet + parsers$alias$octet +} -#' Plumber Parsers -#' -#' Parsers are used in Plumber to transform the raw body content received -#' by a request to the API. -#' @name parsers -#' @rdname parsers -NULL -#' Add a Parsers +#' Manage parsers #' #' A parser is responsible for decoding the raw body content of a request into #' a list of arguments that can be mapped to endpoint function arguments. -#' For instance, the \code{parser_json} parser content-type `application/json`. -#' The list of available parsers in plumber is global. +#' For instance, [parser_json()] parse content-type `application/json`. +#' +#' @param alias An alias to map parser from the `@parser` plumber tag to the global parsers list. +#' @param parser The parser function to be added. This build the parser function. See Details for more information. +#' @param fixed A character vector of fixed string to be matched against a request `content-type` to use `parser`. +#' @param regex A character vector of [regex] string to be matched against a request `content-type` to use `parser`. +#' @param verbose Logical value which determines if a warning should be +#' displayed when alias in map are overwritten. +#' +#' @details +#' When `parser` is evaluated, it should return a parser function. +#' Parser matching is done first by `content-type` header matching on `fixed` then by using a +#' regular expressions on `regex`. Note that plumber strip the header from `; charset*` to +#' perform matching. #' -#' @param name The name of the parser (character string) -#' @param parser The parser to be added. -#' @param pattern A pattern to match against the content-type of each part of -#' the request body. +#' There is a special case when no `content-type` header is +#' provided that will use a [parser_json()] when it detects a `json` string. #' -#' @details For instance, the \code{parser_json} pattern is `application/json`. -#' If `pattern` is not provided, will be set to `application/{name}`. -#' Detection is done assuming content-type starts with pattern and is -#' case sensitive. +#' Functions signature should include `value`, `...` and +#' possibly `content_type`, `filename`. Other parameters may be provided +#' if you want to use the headers from [webutils::parse_multipart()]. #' -#' Parser function structure is something like below. Available parameters -#' to build parser are `value`, `content_type` and `filename` (only available -#' in `multipart-form` body). +#' Parser function structure is something like below. #' ```r -#' parser <- function() { -#' function(value, content_type = "ct", filename, ...) { +#' parser <- function(parser_arguments_here) { +#' # return a function to parse a raw value +#' function(value, ...) { #' # do something with raw value #' } #' } #' ``` #' -#' It should return a named list if you want values to map to -#' plumber endpoint function args. -#' #' @examples -#' parser_json <- function() { -#' function(value, content_type = "application/json", ...) { +#' # `content-type` header is mostly used to look up charset and adjust encoding +#' parser_dcf <- function(...) { +#' function(value, content_type = "text/x-dcf", ...) { #' charset <- getCharacterSet(content_type) #' value <- rawToChar(value) #' Encoding(value) <- charset -#' jsonlite::parse_json(value, simplifyVector = TRUE) +#' read.dcf(value, ...) #' } #' } -#' @md +#' +#' # Could also leverage existing parsers +#' parser_dcf <- function(...) { +#' parser_read_file(function(tmpfile) { +#' read.dcf(tmpfile, ...) +#' }) +#' } +#' +#' # Register the newly created parser +#' \dontrun{register_parser("dcf", parser_dcf, fixed = "text/x-dcf")} #' @export -addParser <- function(name, parser, pattern = NULL) { - if (is.null(.globals$parsers)) { - .globals$parsers <- list() +register_parser <- function( + alias, + parser, + fixed = NULL, + regex = NULL, + verbose = TRUE +) { + + if (!is.null(.globals$parsers[[alias]])) { + if (isTRUE(verbose)) { + warning("Overwriting parser: ", alias) + } } - if (!is.null(.globals$parsers$func[[name]])) { - stop("Already have a parser by the name of ", name) + + stopifnot(is.function(parser)) + + if (length(c(fixed, regex)) == 0) { + stop("At least one value of `fixed` and `regex` is required to register a parser") } - if (is.null(pattern)) { - pattern <- paste0("application/", name) + + # Init the parser function with outside arguments + init_parser_func <- function(...) { + parser_function <- do.call(parser, list(...)) + + parser_formals <- formals(parser_function) + if (!("..." %in% names(parser_formals))) { + stop("For parser '", alias, "', please add a `...` argument to the returned function for possible future parameter expansion") + } + + create_list <- function(names) { + stats::setNames( + replicate( + length(names), + parser_function), + names + ) + } + + parser_info <- list( + alias = create_list(alias) + ) + if (length(fixed) > 0) { + parser_info$fixed <- create_list(fixed) + } + if (length(regex) > 0) { + parser_info$regex <- create_list(regex) + } + + return(parser_info) } - .globals$parsers$func[[name]] <- parser - .globals$parsers$pattern[[name]] <- pattern + + .globals$parsers[[alias]] <- init_parser_func + invisible(.globals$parsers) } +#' @describeIn register_parser Return all registered parsers +#' @export +registered_parsers <- function() { + sort(names(.globals$parsers)) +} +# ' @describeIn register_parser Select from global parsers and create a combined parser list for programmatic use. +# ' @param aliases Can be one of: +# ' * A character vector of `alias` names. +# ' * A named `list()` whose keys are `alias` names and values are arguments to be applied with [do.call()] +# ' * A `TRUE` value, which will default to combining all parsers. This is great for seeing what is possible, but not great for security purposes. +# ' * Already combined parsers. (Will be returned immediately.) +# ' +# ' If `"all"` is found in any `alias` character value or list name, all remaining parsers will be added. When using a list, aliases already defined will maintain their existing argument values. All other parser aliases will use their default arguments. +# ' @examples +# ' # provide a character string +# ' make_parser("json") +# ' +# ' # provide a named list with no arguments +# ' make_parser(list(json = list())) +# ' +# ' # provide a named list with arguments; include `rds` +# ' make_parser(list(json = list(simplifyVector = FALSE), rds = list())) +# ' +# ' # default plumber parsers +# ' make_parser(c("json", "query", "text", "octet", "multi")) +make_parser <- function(aliases) { + if (inherits(aliases, "plumber_parsed_parsers")) { + return(aliases) + } + if (isTRUE(aliases)) { + # use all parsers + aliases <- "all" + } + if (is.character(aliases)) { + if (any(is.na(aliases))) { + stop("aliases can not be `NA` values") + } + if ("all" %in% aliases) { + # use all available parsers expect `all` and `none` + aliases <- setdiff(registered_parsers(), c("all", "none")) + } + # turn aliases into a named list with empty values + aliases <- stats::setNames( + replicate(length(aliases), {list()}), + aliases + ) + } -#' JSON -#' @rdname parsers -#' @export -parser_json <- function() { - function(value, content_type = NULL, ...) { - charset <- getCharacterSet(content_type) - value <- rawToChar(value) - Encoding(value) <- charset - safeFromJSON(value) + stopifnot(is.list(aliases)) + if (is.null(names(aliases))) { + stop("aliases must be able to convert to a named list") + } + + local({ + aliases_not_found <- !(names(aliases) %in% registered_parsers()) + if (any(aliases_not_found)) { + missing_aliases <- names(aliases)[aliases_not_found] + stop("Aliases not available: ", paste0(missing_aliases, collapse = ", "), ". See: registered_parsers()") + } + }) + + # if "all" is found, remove "all" and add all remaining registered parsers (except 'none') to the `aliases` list + if ("all" %in% names(aliases)) { + all_parser_names <- setdiff(registered_parsers(), c("all", "none")) + # remove to avoid infinite recursion + aliases$all <- NULL + names_to_add <- setdiff(all_parser_names, names(aliases)) + if (length(names_to_add)) { + aliases[names_to_add] <- replicate(length(names_to_add), list()) + } } + + # convert parser functions into initialized information + parser_infos <- + lapply( + names(aliases), + function(alias) { + # get init function + init_parser_func <- .globals$parsers[[alias]] + # call outer parser function to init the params for inner function + do.call(init_parser_func, aliases[[alias]]) + } + ) + + # combine information into a single list + combined_parser_info <- + Reduce( + function(cur_parser_info, parser_info) { + utils::modifyList(cur_parser_info, parser_info) + }, + parser_infos, + init = list() + ) + + class(combined_parser_info) <- c("plumber_parsed_parsers", class(combined_parser_info)) + combined_parser_info +} + +#' Plumber Parsers +#' +#' Parsers are used in Plumber to transform the raw body content received +#' by a request to the API. Extra parameters may be provided to parser +#' functions when adding the parser to plumber. This will allow for +#' non-default behavior. +#' +#' Parsers are optional. When unspecified, only the [parser_json()], +#' [parser_octet()], [parser_query()] and [parser_text()] are available. +#' You can use `@parser parser` tag to activate parsers per endpoint. +#' Multiple parsers can be activated for the same endpoint using multiple `@parser parser` tags. +#' +#' User should be aware that `rds` parsing should only be done from a +#' trusted source. Do not accept `rds` files blindly. +#' +#' See [registered_parsers()] for a list of registered parsers. +#' +#' @param ... parameters supplied to the appropriate internal function +#' @describeIn parsers Query string parser +#' @examples +#' \dontrun{ +#' # Overwrite `text/json` parsing behavior to not allow JSON vectors to be simplified +#' #* @parser json simplifyVector = FALSE +#' # Activate `rds` parser in a multipart request +#' #* @parser multi +#' #* @parser rds +#' pr <- plumber$new() +#' pr$handle("GET", "/upload", function(rds) {rds}, parsers = c("multi", "rds")) +#' } +#' @export +parser_query <- function() { + parser_text(parseQS) } +#' @describeIn parsers JSON parser +#' @export +parser_json <- function(...) { + parser_text(function(txt_value) { + safeFromJSON(txt_value, ...) + }) +} -#' QUERY STRING -#' @rdname parsers +#' @describeIn parsers Helper parser to parse plain text +#' @param parse_fn function to further decode a text string into an object #' @export -parser_query <- function() { +parser_text <- function(parse_fn = identity) { + stopifnot(is.function(parse_fn)) function(value, content_type = NULL, ...) { charset <- getCharacterSet(content_type) - value <- rawToChar(value) - Encoding(value) <- charset - parseQS(value) + txt_value <- rawToChar(value) + Encoding(txt_value) <- charset + parse_fn(txt_value) } } +#' @describeIn parsers YAML parser +#' @export +parser_yaml <- function(...) { + parser_text(function(val) { + if (!requireNamespace("yaml", quietly = TRUE)) { + stop("yaml must be installed for the yaml parser to work") + } + yaml::yaml.load(val, ..., eval.expr = FALSE) + }) +} - -#' TEXT -#' @rdname parsers +#' @describeIn parsers CSV parser #' @export -parser_text <- function() { - function(value, content_type = NULL, ...) { - charset <- getCharacterSet(content_type) - value <- rawToChar(value) - Encoding(value) <- charset - value +parser_csv <- function(...) { + parse_fn <- function(raw_val) { + if (!requireNamespace("readr", quietly = TRUE)) { + stop("`readr` must be installed for `parser_csv` to work") + } + readr::read_csv(raw_val, ...) + } + function(value, ...) { + parse_fn(value) } } +#' @describeIn parsers TSV parser +#' @export +parser_tsv <- function(...) { + parse_fn <- function(raw_val) { + if (!requireNamespace("readr", quietly = TRUE)) { + stop("`readr` must be installed for `parser_tsv` to work") + } + readr::read_tsv(raw_val, ...) + } + function(value, ...) { + parse_fn(value) + } +} -#" RDS -#' @rdname parsers +#' @describeIn parsers Helper parser that writes the binary post 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 -parser_rds <- function() { - function(value, filename, ...) { +parser_read_file <- function(read_fn = readLines) { + stopifnot(is.function(read_fn)) + function(value, filename = "", ...) { tmp <- tempfile("plumb", fileext = paste0("_", basename(filename))) - on.exit(file.remove(tmp), add = TRUE) + on.exit({ + if (file.exists(tmp)) { + file.remove(tmp) + } + }, add = TRUE) writeBin(value, tmp) - readRDS(tmp) + read_fn(tmp) } } +#' @describeIn parsers RDS parser +#' @export +parser_rds <- function(...) { + parser_read_file(function(tmpfile) { + # `readRDS()` does not work with `rawConnection()` + readRDS(tmpfile, ...) + }) +} + + +#' @describeIn parsers Octet stream parser. Will add a filename attribute if the filename exists +#' @export +parser_octet <- function() { + function(value, filename = NULL, ...) { + attr(value, "filename") <- filename + value + } +} -#" MULTI -#' @rdname parsers +#' @describeIn parsers Multi part parser. This parser will then parse each individual body with its respective parser #' @export #' @importFrom webutils parse_multipart parser_multi <- function() { - function(value, content_type, ...) { + function(value, content_type, parsers, ...) { if (!stri_detect_fixed(content_type, "boundary=", case_insensitive = TRUE)) 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) # content-type detection lapply(toparse, function(x) { - if (!is.null(x$filename)) { - x$content_type <- getContentType(tools::file_ext(x$filename)) + if ( + is.null(x$content_type) || + # allows for files to be shipped as octect, but parsed using the matching value in `knownContentTypes` + # (Ex: `.rds` files -> `application/rds` which has a proper RDS parser) + isTRUE(stri_detect_fixed(x$content_type, "application/octet-stream")) + ) { + if (!is.null(x$filename)) { + # Guess content-type from file extension + x$content_type <- getContentType(tools::file_ext(x$filename)) + } } - parseRaw(x) + x$parsers <- parsers + parse_raw(x) }) } } - - - -#' OCTET -#' @rdname parsers +#' @describeIn parsers No parser. Will not process the postBody. #' @export -parser_octet <- function() { - function(value, filename = NULL, ...) { - attr(value, "filename") <- filename - return(value) +parser_none <- function() { + function(value, ...) { + value } } - - - -#' YAML -#' @rdname parsers -#' @export -parser_yaml <- function() { - if (!requireNamespace("yaml", quietly = TRUE)) { - stop("yaml must be installed for the yaml parser to work") - } - function(value, content_type = NULL, ...) { - charset <- getCharacterSet(content_type) - value <- rawToChar(value) - Encoding(value) <- charset - yaml::yaml.load(value) +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("octet", parser_octet, fixed = "application/octet-stream") + register_parser("query", parser_query, fixed = "application/x-www-form-urlencoded") + register_parser("rds", parser_rds, fixed = "application/rds") + register_parser("text", parser_text, fixed = "text/plain", regex = "^text/") + register_parser("tsv", parser_tsv, fixed = c("application/tab-separated-values", "text/tab-separated-values")) + register_parser("yaml", parser_yaml, fixed = c("application/yaml", "application/x-yaml", "text/yaml", "text/x-yaml")) + register_parser("none", parser_none, regex = "*") + + parser_all <- function() { + stop("This function should never be called. It should be handled by `make_parser('all')`") } -} - - - - -addParsers_onLoad <- function() { - addParser("json", parser_json, "application/json") - addParser("query", parser_query, "application/x-www-form-urlencoded") - addParser("text", parser_text, "text/") - addParser("rds", parser_rds, "application/rds") - addParser("multi", parser_multi, "multipart/form-data") - addParser("octet", parser_octet, "application/octet") - addParser("yaml", parser_yaml, "application/x-yaml") + register_parser("all", parser_all, regex = "*") } diff --git a/R/plumb-block.R b/R/plumb-block.R index 2b0dee491..77694ee88 100644 --- a/R/plumb-block.R +++ b/R/plumb-block.R @@ -19,6 +19,7 @@ plumbBlock <- function(lineNum, file, envir = parent.frame()){ image <- NULL imageArgs<- NULL serializer <- NULL + parsers <- NULL assets <- NULL params <- NULL comments <- "" @@ -101,8 +102,8 @@ plumbBlock <- function(lineNum, file, envir = parent.frame()){ stopOnLine(lineNum, line, "Multiple @serializers specified for one function.") } - if (!s %in% names(.globals$serializers)){ - stop("No such @serializer registered: ", s) + if (!(s %in% registered_serializers())){ + stopOnLine(lineNum, line, paste0("No such @serializer registered: ", s)) } ser <- .globals$serializers[[s]] @@ -133,8 +134,8 @@ plumbBlock <- function(lineNum, file, envir = parent.frame()){ stopOnLine(lineNum, line, "Multiple @serializers specified for one function (shorthand serializers like @json count, too).") } - if (!is.na(s) && !s %in% names(.globals$serializers)){ - stop("No such @serializer registered: ", s) + if (!is.na(s) && !(s %in% registered_serializers())){ + stopOnLine(lineNum, line, paste0("No such @serializer registered: ", s)) } shortSerAttr <- trimws(shortSerMat[1,3]) if(!identical(shortSerAttr, "") && !grepl("^\\(.*\\)$", shortSerAttr)){ @@ -159,6 +160,34 @@ plumbBlock <- function(lineNum, file, envir = parent.frame()){ } + parsersMat <- stri_match(line, regex="^#['\\*]\\s*@parser(\\s+([^\\s]+)\\s*(.*)\\s*$)?") + if (!is.na(parsersMat[1,1])){ + parser_alias <- stri_trim_both(parsersMat[1,3]) + if (is.na(parser_alias) || parser_alias == ""){ + stopOnLine(lineNum, line, "No @parser specified") + } + + if (!parser_alias %in% registered_parsers()){ + stopOnLine(lineNum, line, paste0("No such @parser registered: ", parser_alias)) + } + + if (!is.na(parsersMat[1, 4]) && parsersMat[1,4] != ""){ + # We have an arg to pass in to the parser + arg_list <- tryCatch({ + eval(parse(text=parsersMat[1,4]), envir) + }, error = function(e) { + stopOnLine(lineNum, line, e) + }) + } else { + arg_list <- list() + } + if (is.null(parsers)) { + parsers <- list() + } + parsers[[parser_alias]] <- arg_list + + } + imageMat <- stri_match(line, regex="^#['\\*]\\s*@(jpeg|png|svg)([\\s\\(].*)?\\s*$") if (!is.na(imageMat[1,1])){ if (!is.null(image)){ @@ -241,6 +270,7 @@ plumbBlock <- function(lineNum, file, envir = parent.frame()){ image = image, imageArgs = imageArgs, serializer = serializer, + parsers = parsers, assets = assets, params = rev(params), comments = comments, @@ -265,7 +295,19 @@ evaluateBlock <- function(srcref, file, expr, envir, addEndpoint, addFilter, pr) # ALL if statements possibilities must eventually call eval(expr, envir) if (!is.null(block$paths)){ lapply(block$paths, function(p){ - ep <- PlumberEndpoint$new(p$verb, p$path, expr, envir, block$serializer, srcref, block$params, block$comments, block$responses, block$tags) + ep <- PlumberEndpoint$new( + verbs = p$verb, + path = p$path, + expr = expr, + envir = envir, + serializer = block$serializer, + parsers = block$parsers, + lines = srcref, + params = block$params, + comments = block$comments, + responses = block$responses, + tags = block$tags + ) if (!is.null(block$image)){ if (block$image == "png"){ diff --git a/R/plumber-step.R b/R/plumber-step.R index 316dc8940..53c985851 100644 --- a/R/plumber-step.R +++ b/R/plumber-step.R @@ -158,6 +158,8 @@ PlumberEndpoint <- R6Class( params = NA, #' @field tags endpoint tags tags = NA, + #' @field parsers step allowed parsers + parsers = NULL, #' @description ability to serve request #' @param req a request object #' @return a logical. `TRUE` when endpoint can serve request. @@ -171,20 +173,42 @@ PlumberEndpoint <- R6Class( !is.na(stri_match_first_regex(path, private$regex$regex)[1,1]) }, #' @description Create a new `PlumberEndpoint` object - #' @param verbs endpoint verb - #' @param path endpoint path - #' @param expr endpoint expr - #' @param envir endpoint environment - #' @param serializer endpoint serializer - #' @param lines endpoint block - #' @param params endpoint params - #' @param comments endpoint comments - #' @param responses endpoint responses - #' @param tags endpoint tags + #' @param verbs Endpoint verb Ex: `"GET"`, `"POST"` + #' @param path Endpoint path. Ex: `"/index.html"`, `"/foo/bar/baz"` + #' @param expr Endpoint expression or function. + #' @param envir Endpoint environment + #' @param serializer Endpoint serializer + #' @param parsers Endpoint parsers. + #' Can be one of: + #' * A `NULL` value + #' * A character vector of parser names + #' * A named `list()` whose keys are parser names names and values are arguments to be applied with [do.call()] + #' * A `TRUE` value, which will default to combining all parsers. This is great for seeing what is possible, but not great for security purposes + #' + #' If the parser name `"all"` is found in any character value or list name, all remaining parsers will be added. + #' When using a list, parser information already defined will maintain their existing argument values. All remaining parsers will use their default arguments. + #' + #' Example: + #' ``` + #' # provide a character string + #' parsers = "json" + #' + #' # provide a named list with no arguments + #' parsers = list(json = list()) + #' + #' # provide a named list with arguments; include `rds` + #' parsers = list(json = list(simplifyVector = FALSE), rds = list()) + #' + #' # default plumber parsers + #' parsers = c("json", "query", "text", "octet", "multi") + #' ``` + #' @param lines Endpoint block + #' @param params Endpoint params + #' @param comments,responses,tags Values to be used within the OpenAPI Spec #' @details Parameters values are obtained from parsing blocks of lines in a plumber file. #' They can also be provided manually for historical reasons. #' @return A new `PlumberEndpoint` object - initialize = function(verbs, path, expr, envir, serializer, lines, params, comments, responses, tags){ + initialize = function(verbs, path, expr, envir, serializer, parsers, lines, params, comments, responses, tags){ self$verbs <- verbs self$path <- path @@ -201,6 +225,9 @@ PlumberEndpoint <- R6Class( if (!missing(serializer) && !is.null(serializer)){ self$serializer <- serializer } + if (!missing(parsers) && !is.null(parsers)) { + self$parsers <- make_parser(parsers) + } if (!missing(lines)){ self$lines <- lines } diff --git a/R/plumber.R b/R/plumber.R index 693698d5f..e8ddc22da 100644 --- a/R/plumber.R +++ b/R/plumber.R @@ -102,7 +102,8 @@ defaultPlumberFilters <- list( cookieParser = cookieFilter, sharedSecret = sharedSecretFilter) -#' hookable +#' @keywords internal +#' @title hookable hookable <- R6Class( "hookable", public=list( @@ -216,6 +217,8 @@ plumber <- R6Class( # Initialize private$serializer <- serializer_json() + # Default parsers to maintain legacy features + private$default_parsers <- make_parser(c("json", "query", "text", "octet", "multi")) private$errorHandler <- defaultErrorHandler() private$notFoundHandler <- default404Handler private$maxSize <- getOption('plumber.maxRequestSize', 0) #0 Unlimited @@ -469,6 +472,7 @@ plumber <- R6Class( #' @param handler a handler function. #' @param preempt a preempt function. #' @param serializer a serializer function. + #' @param parsers a named list of parsers. #' @param endpoint a `PlumberEndpoint` object. #' @param ... additional arguments for `PlumberEndpoint` creation #' @details The “handler” functions that you define in these handle calls @@ -484,18 +488,21 @@ plumber <- R6Class( #' "

Programmatic Plumber!

" #' }, serializer=plumber::serializer_html()) #' } - handle = function(methods, path, handler, preempt, serializer, endpoint, ...){ - epdef <- !missing(methods) || !missing(path) || !missing(handler) || !missing(serializer) + handle = function(methods, path, handler, preempt, serializer, parsers, endpoint, ...) { + epdef <- !missing(methods) || !missing(path) || !missing(handler) || !missing(serializer) || !missing(parsers) if (!missing(endpoint) && epdef){ stop("You must provide either the components for an endpoint (handler and serializer) OR provide the endpoint yourself. You cannot do both.") } - if (epdef){ - if (missing(serializer)){ + if (epdef) { + if (missing(serializer)) { serializer <- private$serializer } + if (missing(parsers)) { + parsers <- private$parsers + } - endpoint <- PlumberEndpoint$new(methods, path, handler, private$envir, serializer, ...) + endpoint <- PlumberEndpoint$new(methods, path, handler, private$envir, serializer, parsers, ...) } private$addEndpointInternal(endpoint, preempt) }, @@ -733,7 +740,17 @@ plumber <- R6Class( if (!is.null(h$serializer)) { res$serializer <- h$serializer } - req$args <- c(h$getPathParams(path), req$args) + parsers <- + if (!is.null(h$parsers)) { + h$parsers + } else { + private$default_parsers + } + req$args <- c( + h$getPathParams(path), + req$args, + postbody_parser(req, parsers) + ) return(do.call(h$exec, req$args)) } } @@ -876,6 +893,35 @@ plumber <- R6Class( setSerializer = function(serializer){ private$serializer <- serializer }, + #' @details Sets the default parsers of the router. + #' @param parsers Set default endpoint parsers. Initialized to `c("json", "query", "text", "octet", "multi")` + #' + #' Can be one of: + #' * A `NULL` value + #' * A character vector of parser names + #' * A named `list()` whose keys are parser names names and values are arguments to be applied with [do.call()] + #' * A `TRUE` value, which will default to combining all parsers. This is great for seeing what is possible, but not great for security purposes + #' + #' If the parser name `"all"` is found in any character value or list name, all remaining parsers will be added. + #' When using a list, parser information already defined will maintain their existing argument values. All remaining parsers will use their default arguments. + #' + #' Example: + #' ``` + #' # provide a character string + #' parsers = "json" + #' + #' # provide a named list with no arguments + #' parsers = list(json = list()) + #' + #' # provide a named list with arguments; include `rds` + #' parsers = list(json = list(simplifyVector = FALSE), rds = list()) + #' + #' # default plumber parsers + #' parsers = c("json", "query", "text", "octet", "multi") + #' ``` + setParsers = function(parsers) { + private$default_parsers <- make_parser(parsers) + }, #' @details Sets the handler that gets called if an #' incoming request can’t be served by any filter, endpoint, or sub-router. #' @param fun a handler function. @@ -1052,6 +1098,7 @@ plumber <- R6Class( } ), private = list( serializer = NULL, # The default serializer for the router + default_parsers = NULL, # The default parsers for the router ends = list(), # List of endpoints indexed by their pre-empted filter. filts = NULL, # Array of filters diff --git a/R/serializer.R b/R/serializer.R index 554ac9386..60a7af6a9 100644 --- a/R/serializer.R +++ b/R/serializer.R @@ -1,5 +1,5 @@ -#' Add a Serializer +#' Register a Serializer #' #' A serializer is responsible for translating a generated R value into output #' that a remote user can understand. For instance, the \code{serializer_json} @@ -9,9 +9,9 @@ #' @param name The name of the serializer (character string) #' @param serializer The serializer to be added. #' @param verbose Logical value which determines if a message should be printed when overwriting serializers -#' +#' @describeIn register_serializer Register a serializer with a name #' @export -addSerializer <- function(name, serializer, verbose = TRUE) { +register_serializer <- function(name, serializer, verbose = TRUE) { if (!is.null(.globals$serializers[[name]])) { if (isTRUE(verbose)) { message("Overwriting serializer: ", name) @@ -19,6 +19,12 @@ addSerializer <- function(name, serializer, verbose = TRUE) { } .globals$serializers[[name]] <- serializer } +#' @describeIn register_serializer Return a list of all registered serializers +#' @export +registered_serializers <- function(name) { + sort(names(.globals$serializers)) +} + # internal function to use directly within this file only. (performance purposes) # Other files should use `serializer_identity()` to avoid confusion @@ -272,7 +278,9 @@ serializer_htmlwidget <- function(...) { file <- tempfile(fileext = ".html") on.exit({ # Delete the temp file - file.remove(file) + if (file.exists(file)) { + file.remove(file) + } }) # Write the widget out to a file (doesn't currently support in-memory connections - pandoc) diff --git a/R/zzz.R b/R/zzz.R index 0a955609a..27a905dc5 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -3,7 +3,7 @@ addApiInfo_onLoad() - addParsers_onLoad() + register_parsers_onLoad() add_serializers_onLoad() diff --git a/man/PlumberEndpoint.Rd b/man/PlumberEndpoint.Rd index 872c3821e..bbfb37567 100644 --- a/man/PlumberEndpoint.Rd +++ b/man/PlumberEndpoint.Rd @@ -33,6 +33,8 @@ each separate verb/path into its own endpoint, so we just do that.} \item{\code{params}}{endpoint parameters} \item{\code{tags}}{endpoint tags} + +\item{\code{parsers}}{step allowed parsers} } \if{html}{\out{}} } @@ -119,6 +121,7 @@ Create a new \code{PlumberEndpoint} object expr, envir, serializer, + parsers, lines, params, comments, @@ -130,25 +133,46 @@ Create a new \code{PlumberEndpoint} object \subsection{Arguments}{ \if{html}{\out{
}} \describe{ -\item{\code{verbs}}{endpoint verb} +\item{\code{verbs}}{Endpoint verb Ex: \code{"GET"}, \code{"POST"}} -\item{\code{path}}{endpoint path} +\item{\code{path}}{Endpoint path. Ex: \code{"/index.html"}, \code{"/foo/bar/baz"}} -\item{\code{expr}}{endpoint expr} +\item{\code{expr}}{Endpoint expression or function.} -\item{\code{envir}}{endpoint environment} +\item{\code{envir}}{Endpoint environment} -\item{\code{serializer}}{endpoint serializer} +\item{\code{serializer}}{Endpoint serializer} -\item{\code{lines}}{endpoint block} +\item{\code{parsers}}{Endpoint parsers. +Can be one of: +\itemize{ +\item A \code{NULL} value +\item A character vector of parser names +\item A named \code{list()} whose keys are parser names names and values are arguments to be applied with \code{\link[=do.call]{do.call()}} +\item A \code{TRUE} value, which will default to combining all parsers. This is great for seeing what is possible, but not great for security purposes +} -\item{\code{params}}{endpoint params} +If the parser name \code{"all"} is found in any character value or list name, all remaining parsers will be added. +When using a list, parser information already defined will maintain their existing argument values. All remaining parsers will use their default arguments. -\item{\code{comments}}{endpoint comments} +Example:\preformatted{# provide a character string +parsers = "json" -\item{\code{responses}}{endpoint responses} +# provide a named list with no arguments +parsers = list(json = list()) -\item{\code{tags}}{endpoint tags} +# provide a named list with arguments; include `rds` +parsers = list(json = list(simplifyVector = FALSE), rds = list()) + +# default plumber parsers +parsers = c("json", "query", "text", "octet", "multi") +}} + +\item{\code{lines}}{Endpoint block} + +\item{\code{params}}{Endpoint params} + +\item{\code{comments, responses, tags}}{Values to be used within the OpenAPI Spec} } \if{html}{\out{
}} } diff --git a/man/PlumberStatic.Rd b/man/PlumberStatic.Rd index 41fd31488..528967e4f 100644 --- a/man/PlumberStatic.Rd +++ b/man/PlumberStatic.Rd @@ -44,6 +44,7 @@ Creates a router that is backed by a directory of files on disk. \item \out{}\href{../../plumber/html/plumber.html#method-serve}{\code{plumber::plumber$serve()}}\out{} \item \out{}\href{../../plumber/html/plumber.html#method-set404Handler}{\code{plumber::plumber$set404Handler()}}\out{} \item \out{}\href{../../plumber/html/plumber.html#method-setErrorHandler}{\code{plumber::plumber$setErrorHandler()}}\out{} +\item \out{}\href{../../plumber/html/plumber.html#method-setParsers}{\code{plumber::plumber$setParsers()}}\out{} \item \out{}\href{../../plumber/html/plumber.html#method-setSerializer}{\code{plumber::plumber$setSerializer()}}\out{} \item \out{}\href{../../plumber/html/plumber.html#method-swaggerFile}{\code{plumber::plumber$swaggerFile()}}\out{} } diff --git a/man/addParser.Rd b/man/addParser.Rd deleted file mode 100644 index f753333cc..000000000 --- a/man/addParser.Rd +++ /dev/null @@ -1,50 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/parse-body.R -\name{addParser} -\alias{addParser} -\title{Add a Parsers} -\usage{ -addParser(name, parser, pattern = NULL) -} -\arguments{ -\item{name}{The name of the parser (character string)} - -\item{parser}{The parser to be added.} - -\item{pattern}{A pattern to match against the content-type of each part of -the request body.} -} -\description{ -A parser is responsible for decoding the raw body content of a request into -a list of arguments that can be mapped to endpoint function arguments. -For instance, the \code{parser_json} parser content-type \code{application/json}. -The list of available parsers in plumber is global. -} -\details{ -For instance, the \code{parser_json} pattern is \code{application/json}. -If \code{pattern} is not provided, will be set to \code{application/{name}}. -Detection is done assuming content-type starts with pattern and is -case sensitive. - -Parser function structure is something like below. Available parameters -to build parser are \code{value}, \code{content_type} and \code{filename} (only available -in \code{multipart-form} body).\if{html}{\out{
}}\preformatted{parser <- function() \{ - function(value, content_type = "ct", filename, ...) \{ - # do something with raw value - \} -\} -}\if{html}{\out{
}} - -It should return a named list if you want values to map to -plumber endpoint function args. -} -\examples{ -parser_json <- function() { - function(value, content_type = "application/json", ...) { - charset <- getCharacterSet(content_type) - value <- rawToChar(value) - Encoding(value) <- charset - jsonlite::parse_json(value, simplifyVector = TRUE) - } -} -} diff --git a/man/addSerializer.Rd b/man/addSerializer.Rd index bb3bb207b..d72ffc035 100644 --- a/man/addSerializer.Rd +++ b/man/addSerializer.Rd @@ -1,21 +1,12 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/serializer.R +% Please edit documentation in R/deprecated.R \name{addSerializer} \alias{addSerializer} -\title{Add a Serializer} +\title{Register a Serializer} \usage{ addSerializer(name, serializer, verbose = TRUE) } -\arguments{ -\item{name}{The name of the serializer (character string)} - -\item{serializer}{The serializer to be added.} - -\item{verbose}{Logical value which determines if a message should be printed when overwriting serializers} -} \description{ -A serializer is responsible for translating a generated R value into output -that a remote user can understand. For instance, the \code{serializer_json} -serializes R objects into JSON before returning them to the user. The list of -available serializers in plumber is global. +Use \code{\link[=register_serializer]{register_serializer()}} in favor of addSerializer } +\keyword{internal} diff --git a/man/hookable.Rd b/man/hookable.Rd index 6c2802e83..13e8ef6b6 100644 --- a/man/hookable.Rd +++ b/man/hookable.Rd @@ -8,6 +8,7 @@ hookable hookable } +\keyword{internal} \section{Methods}{ \subsection{Public methods}{ \itemize{ diff --git a/man/parsers.Rd b/man/parsers.Rd index 69ed120ad..3b0980ef1 100644 --- a/man/parsers.Rd +++ b/man/parsers.Rd @@ -1,31 +1,99 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/parse-body.R -\name{parsers} -\alias{parsers} -\alias{parser_json} +\name{parser_query} \alias{parser_query} +\alias{parser_json} \alias{parser_text} +\alias{parser_yaml} +\alias{parser_csv} +\alias{parser_tsv} +\alias{parser_read_file} \alias{parser_rds} -\alias{parser_multi} \alias{parser_octet} -\alias{parser_yaml} +\alias{parser_multi} +\alias{parser_none} \title{Plumber Parsers} \usage{ -parser_json() - parser_query() -parser_text() +parser_json(...) -parser_rds() +parser_text(parse_fn = identity) -parser_multi() +parser_yaml(...) + +parser_csv(...) + +parser_tsv(...) + +parser_read_file(read_fn = readLines) + +parser_rds(...) parser_octet() -parser_yaml() +parser_multi() + +parser_none() +} +\arguments{ +\item{...}{parameters supplied to the appropriate internal function} + +\item{parse_fn}{function to further decode a text string into an object} + +\item{read_fn}{function used to read a the content of a file. Ex: \code{\link[=readRDS]{readRDS()}}} } \description{ Parsers are used in Plumber to transform the raw body content received -by a request to the API. +by a request to the API. Extra parameters may be provided to parser +functions when adding the parser to plumber. This will allow for +non-default behavior. +} +\details{ +Parsers are optional. When unspecified, only the \code{\link[=parser_json]{parser_json()}}, +\code{\link[=parser_octet]{parser_octet()}}, \code{\link[=parser_query]{parser_query()}} and \code{\link[=parser_text]{parser_text()}} are available. +You can use \verb{@parser parser} tag to activate parsers per endpoint. +Multiple parsers can be activated for the same endpoint using multiple \verb{@parser parser} tags. + +User should be aware that \code{rds} parsing should only be done from a +trusted source. Do not accept \code{rds} files blindly. + +See \code{\link[=registered_parsers]{registered_parsers()}} for a list of registered parsers. +} +\section{Functions}{ +\itemize{ +\item \code{parser_query}: Query string parser + +\item \code{parser_json}: JSON parser + +\item \code{parser_text}: Helper parser to parse plain text + +\item \code{parser_yaml}: YAML parser + +\item \code{parser_csv}: CSV parser + +\item \code{parser_tsv}: TSV parser + +\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}. +This parser should be used when reading from a file is required. + +\item \code{parser_rds}: RDS parser + +\item \code{parser_octet}: Octet stream parser. Will add a filename attribute if the filename exists + +\item \code{parser_multi}: Multi part parser. This parser will then parse each individual body with its respective parser + +\item \code{parser_none}: No parser. Will not process the postBody. +}} + +\examples{ +\dontrun{ +# Overwrite `text/json` parsing behavior to not allow JSON vectors to be simplified +#* @parser json simplifyVector = FALSE +# Activate `rds` parser in a multipart request +#* @parser multi +#* @parser rds +pr <- plumber$new() +pr$handle("GET", "/upload", function(rds) {rds}, parsers = c("multi", "rds")) +} } diff --git a/man/plumber.Rd b/man/plumber.Rd index 485b1d529..b0e3025a7 100644 --- a/man/plumber.Rd +++ b/man/plumber.Rd @@ -144,6 +144,7 @@ pr$setErrorHandler(function(req, res) {cat(res$body)}) \item \href{#method-onHeaders}{\code{plumber$onHeaders()}} \item \href{#method-onWSOpen}{\code{plumber$onWSOpen()}} \item \href{#method-setSerializer}{\code{plumber$setSerializer()}} +\item \href{#method-setParsers}{\code{plumber$setParsers()}} \item \href{#method-set404Handler}{\code{plumber$set404Handler()}} \item \href{#method-setErrorHandler}{\code{plumber$setErrorHandler()}} \item \href{#method-filter}{\code{plumber$filter()}} @@ -382,7 +383,16 @@ pr$handle("GET", "/", function(){ 123 }) \subsection{Method \code{handle()}}{ Define endpoints \subsection{Usage}{ -\if{html}{\out{
}}\preformatted{plumber$handle(methods, path, handler, preempt, serializer, endpoint, ...)}\if{html}{\out{
}} +\if{html}{\out{
}}\preformatted{plumber$handle( + methods, + path, + handler, + preempt, + serializer, + parsers, + endpoint, + ... +)}\if{html}{\out{
}} } \subsection{Arguments}{ @@ -398,6 +408,8 @@ Define endpoints \item{\code{serializer}}{a serializer function.} +\item{\code{parsers}}{a named list of parsers.} + \item{\code{endpoint}}{a \code{PlumberEndpoint} object.} \item{\code{...}}{additional arguments for \code{PlumberEndpoint} creation} @@ -572,6 +584,50 @@ required for httpuv interface Sets the default serializer of the router. } +} +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-setParsers}{}}} +\subsection{Method \code{setParsers()}}{ +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{plumber$setParsers(parsers)}\if{html}{\out{
}} +} + +\subsection{Arguments}{ +\if{html}{\out{
}} +\describe{ +\item{\code{parsers}}{Set default endpoint parsers. Initialized to \code{c("json", "query", "text", "octet", "multi")} + +Can be one of: +\itemize{ +\item A \code{NULL} value +\item A character vector of parser names +\item A named \code{list()} whose keys are parser names names and values are arguments to be applied with \code{\link[=do.call]{do.call()}} +\item A \code{TRUE} value, which will default to combining all parsers. This is great for seeing what is possible, but not great for security purposes +} + +If the parser name \code{"all"} is found in any character value or list name, all remaining parsers will be added. +When using a list, parser information already defined will maintain their existing argument values. All remaining parsers will use their default arguments. + +Example:\preformatted{# provide a character string +parsers = "json" + +# provide a named list with no arguments +parsers = list(json = list()) + +# provide a named list with arguments; include `rds` +parsers = list(json = list(simplifyVector = FALSE), rds = list()) + +# default plumber parsers +parsers = c("json", "query", "text", "octet", "multi") +}} +} +\if{html}{\out{
}} +} +\subsection{Details}{ +Sets the default parsers of the router. +} + } \if{html}{\out{
}} \if{html}{\out{}} diff --git a/man/register_parser.Rd b/man/register_parser.Rd new file mode 100644 index 000000000..0abd01db7 --- /dev/null +++ b/man/register_parser.Rd @@ -0,0 +1,75 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/parse-body.R +\name{register_parser} +\alias{register_parser} +\alias{registered_parsers} +\title{Manage parsers} +\usage{ +register_parser(alias, parser, fixed = NULL, regex = NULL, verbose = TRUE) + +registered_parsers() +} +\arguments{ +\item{alias}{An alias to map parser from the \verb{@parser} plumber tag to the global parsers list.} + +\item{parser}{The parser function to be added. This build the parser function. See Details for more information.} + +\item{fixed}{A character vector of fixed string to be matched against a request \code{content-type} to use \code{parser}.} + +\item{regex}{A character vector of \link{regex} string to be matched against a request \code{content-type} to use \code{parser}.} + +\item{verbose}{Logical value which determines if a warning should be +displayed when alias in map are overwritten.} +} +\description{ +A parser is responsible for decoding the raw body content of a request into +a list of arguments that can be mapped to endpoint function arguments. +For instance, \code{\link[=parser_json]{parser_json()}} parse content-type \code{application/json}. +} +\details{ +When \code{parser} is evaluated, it should return a parser function. +Parser matching is done first by \code{content-type} header matching on \code{fixed} then by using a +regular expressions on \code{regex}. Note that plumber strip the header from \verb{; charset*} to +perform matching. + +There is a special case when no \code{content-type} header is +provided that will use a \code{\link[=parser_json]{parser_json()}} when it detects a \code{json} string. + +Functions signature should include \code{value}, \code{...} and +possibly \code{content_type}, \code{filename}. Other parameters may be provided +if you want to use the headers from \code{\link[webutils:parse_multipart]{webutils::parse_multipart()}}. + +Parser function structure is something like below.\if{html}{\out{
}}\preformatted{parser <- function(parser_arguments_here) \{ + # return a function to parse a raw value + function(value, ...) \{ + # do something with raw value + \} +\} +}\if{html}{\out{
}} +} +\section{Functions}{ +\itemize{ +\item \code{registered_parsers}: Return all registered parsers +}} + +\examples{ +# `content-type` header is mostly used to look up charset and adjust encoding +parser_dcf <- function(...) { + function(value, content_type = "text/x-dcf", ...) { + charset <- getCharacterSet(content_type) + value <- rawToChar(value) + Encoding(value) <- charset + read.dcf(value, ...) + } +} + +# Could also leverage existing parsers +parser_dcf <- function(...) { + parser_read_file(function(tmpfile) { + read.dcf(tmpfile, ...) + }) +} + +# Register the newly created parser +\dontrun{register_parser("dcf", parser_dcf, fixed = "text/x-dcf")} +} diff --git a/man/register_serializer.Rd b/man/register_serializer.Rd new file mode 100644 index 000000000..5e4a08d84 --- /dev/null +++ b/man/register_serializer.Rd @@ -0,0 +1,31 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/serializer.R +\name{register_serializer} +\alias{register_serializer} +\alias{registered_serializers} +\title{Register a Serializer} +\usage{ +register_serializer(name, serializer, verbose = TRUE) + +registered_serializers(name) +} +\arguments{ +\item{name}{The name of the serializer (character string)} + +\item{serializer}{The serializer to be added.} + +\item{verbose}{Logical value which determines if a message should be printed when overwriting serializers} +} +\description{ +A serializer is responsible for translating a generated R value into output +that a remote user can understand. For instance, the \code{serializer_json} +serializes R objects into JSON before returning them to the user. The list of +available serializers in plumber is global. +} +\section{Functions}{ +\itemize{ +\item \code{register_serializer}: Register a serializer with a name + +\item \code{registered_serializers}: Return a list of all registered serializers +}} + diff --git a/pkgdown/_pkgdown.yml b/pkgdown/_pkgdown.yml index f9e545d63..8b6b97a77 100644 --- a/pkgdown/_pkgdown.yml +++ b/pkgdown/_pkgdown.yml @@ -45,6 +45,8 @@ reference: - 'plumb' - 'pr' - 'pr_run' + - 'options_plumber' + - title: Router Methods contents: - 'pr_get' @@ -54,38 +56,53 @@ reference: - 'pr_head' - 'pr_handle' - 'pr_mount' + - title: Router Hooks contents: - 'pr_hook' - 'pr_hooks' - 'pr_cookie' - 'pr_filter' + - title: Router Defaults contents: - 'pr_set_serializer' - 'pr_set_404' - 'pr_set_error' -- title: All functions - # desc: description here + +- title: POST Body and Query String Parsers + contents: + - 'register_parser' + - 'parser_query' + - 'getCharacterSet' + +- title: Response + contents: + - 'as_attachment' + - 'register_serializer' + - 'serializer_json' + - 'include_file' + +- title: Cookies and Filters + contents: + - 'pr_cookie' + - 'randomCookieKey' + - 'sessionCookie' + - 'forward' + +- title: R6 Constructors contents: - 'PlumberEndpoint' - 'PlumberStatic' - 'PlumberStep' - - 'addParser' - - 'addSerializer' - - 'as_attachment' + - 'hookable' + +- title: Digital Ocean + desc: TO BE REMOVED FROM PLUMBER!!! + contents: - 'do_configure_https' - 'do_deploy_api' - 'do_forward' - 'do_provision' - 'do_remove_api' - 'do_remove_forward' - - 'forward' - - 'getCharacterSet' - - 'hookable' - - 'include_file' - - 'options_plumber' - - 'parsers' - - 'randomCookieKey' - - 'serializer_json' - - 'sessionCookie' diff --git a/tests/testthat/files/.gitattributes b/tests/testthat/files/.gitattributes new file mode 100644 index 000000000..291377b6b --- /dev/null +++ b/tests/testthat/files/.gitattributes @@ -0,0 +1 @@ +*.bin binary diff --git a/tests/testthat/files/multipart-ctype.bin b/tests/testthat/files/multipart-ctype.bin new file mode 100644 index 000000000..0b48369dd --- /dev/null +++ b/tests/testthat/files/multipart-ctype.bin @@ -0,0 +1,18 @@ +-----------------------------90908882332870323642673870272 +Content-Disposition: form-data; name="sample_name"; filename="sample.tsv" +Content-Type: text/tab-separated-values + +x y z +0.118413259 0.708780115 0.220421733 +0.7442446 0.539953502 0.02358455 +0.452216508 0.434335382 0.290591105 +0.177870351 0.329585854 0.867134948 +0.328333594 0.564684198 0.455520456 +0.680873191 0.57619709 0.015501929 +0.87209177 0.4487502 0.008787638 +0.50966466 0.958683547 0.251500478 +0.937677985 0.457557468 0.19860169 +0.352366596 0.49283506 0.161614863 +0.370598572 0.366986682 0.15623896 + +-----------------------------90908882332870323642673870272-- diff --git a/tests/testthat/files/parsers.R b/tests/testthat/files/parsers.R new file mode 100644 index 000000000..003af7d02 --- /dev/null +++ b/tests/testthat/files/parsers.R @@ -0,0 +1,32 @@ +return_inputs <- function(...) { + ret <- list(...) + ret$req <- NULL + ret$res <- NULL + ret +} + + +#* @post /default +return_inputs + +#* @post /json +#* @parser json +return_inputs + +#* @post /mixed +#* @parser query +#* @parser json +return_inputs + +#* @post /repeated +#* @parser json +#* @parser json +return_inputs + +#* @post /none +#* @parser none +return_inputs + +#* @post /all +#* @parser all +return_inputs diff --git a/tests/testthat/test-async.R b/tests/testthat/test-async.R index ebe567e5a..db7591eb7 100644 --- a/tests/testthat/test-async.R +++ b/tests/testthat/test-async.R @@ -101,7 +101,7 @@ test_that("async hooks create async execution", { # make an exhaustive matrix of T/F values of which hooks are async hooks_are_async <- do.call( expand.grid, - lapply(setNames(hooks, hooks), function(...) c(FALSE, TRUE)) + lapply(stats::setNames(hooks, hooks), function(...) c(FALSE, TRUE)) ) # remove the all FALSE row diff --git a/tests/testthat/test-parse-block.R b/tests/testthat/test-parse-block.R index 13e78b485..0dbfae539 100644 --- a/tests/testthat/test-parse-block.R +++ b/tests/testthat/test-parse-block.R @@ -160,6 +160,40 @@ test_that("@html parameters produce an error", { expect_block_error("#' @html (key = \"val\")", "unused argument") }) +test_that("@parser parameters produce an error or not", { + # due to covr changing some code, the return answer is very strange + testthat::skip_on_covr() + + expect_block_parser <- function(lines, fn) { + b <- plumbBlock(length(lines), lines) + expect_equal(b$parsers, fn) + } + expect_block_error <- function(lines, ...) { + expect_error({ + plumbBlock(length(lines), lines) + }, ...) + } + + + expected <- list(octet = list()) + expect_block_parser("#' @parser octet", expected) + + expect_block_parser("#' @parser octet list()", expected) + expect_block_parser("#' @parser octet list( )", expected) + expect_block_parser("#' @parser octet list ( ) ", expected) + + expect_error({ + evaluateBlock( + srcref = 3, # which evaluates to line 2 + file = c("#' @get /test", "#' @parser octet list(key = \"val\")"), + expr = substitute(identity), + envir = new.env(), + addEndpoint = function(a, b, ...) { stop("should not reach here")}, + addFilter = as.null, + pr = plumber$new() + ) + }, "unused argument (key = \"val\")", fixed = TRUE) +}) test_that("Plumbing block use the right environment", { expect_silent(plumb(test_path("files/plumb-envir.R"))) }) diff --git a/tests/testthat/test-parse-body.R b/tests/testthat/test-parse-body.R new file mode 100644 index 000000000..0b7cb6621 --- /dev/null +++ b/tests/testthat/test-parse-body.R @@ -0,0 +1,110 @@ +context("POST body") + +test_that("JSON is consumed on POST", { + expect_equal(parse_body('{"a":"1"}', content_type = NULL, parsers = make_parser("json")), list(a = "1")) +}) + +test_that("ending in `==` does not produce a unexpected key", { + # See https://github.com/rstudio/plumber/issues/463 + expect_equal(parse_body("randomcharshere==", content_type = NULL, parsers = make_parser("query")), list()) +}) + +test_that("Query strings on post are handled correctly", { + expect_equivalent(parse_body("a=", parsers = make_parser("query")), list()) # It's technically a named list() + expect_equal(parse_body("a=1&b=&c&d=1", content_type = NULL, make_parser("query")), list(a="1", d="1")) +}) + +test_that("Able to handle UTF-8", { + expect_equal(parse_body('{"text":"élise"}', content_type = "application/json; charset=UTF-8", parsers = make_parser("json"))$text, "élise") +}) + +#charset moved to part parsing +test_that("filter passes on content-type", { + content_type_passed <- "" + req <- list( + postBodyRaw = charToRaw("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"), + .env = "plumber" + ) +}) + +# parsers +test_that("Test text parser", { + expect_equal(parse_body("Ceci est un texte.", "text/html", make_parser("text")), "Ceci est un texte.") +}) + +test_that("Test yaml parser", { + skip_if_not_installed("yaml") + + r_object <- list(a=1,b=list(c=2,d=list(e=3,f=4:6))) + expect_equal(parse_body(charToRaw(yaml::as.yaml(r_object)), "application/x-yaml", make_parser("yaml")), r_object) +}) + +test_that("Test csv parser", { + tmp <- tempfile() + on.exit({ + file.remove(tmp) + }, add = TRUE) + + r_object <- cars + write.csv(r_object, tmp, row.names = FALSE) + val <- readBin(tmp, "raw", 1000) + + parsed <- parse_body(val, "application/csv", make_parser("csv")) + # convert from readr tibble to data.frame + parsed <- as.data.frame(parsed, stringsAsFactors = FALSE) + attr(parsed, "spec") <- NULL + + expect_equal(parsed, r_object) +}) + +test_that("Test tsv parser", { + tmp <- tempfile() + on.exit({ + file.remove(tmp) + }, add = TRUE) + + r_object <- cars + write.table(r_object, tmp, sep = "\t", row.names = FALSE) + val <- readBin(tmp, "raw", 1000) + + parsed <- parse_body(val, "application/tab-separated-values", make_parser("tsv")) + # convert from readr tibble to data.frame + parsed <- as.data.frame(parsed, stringsAsFactors = FALSE) + attr(parsed, "spec") <- NULL + + expect_equal(parsed, r_object) +}) + +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(attr(parsed_body[["img1"]], "filename"), "avatar2-small.png") + expect_equal(parsed_body[["json"]], list(a=2,b=4,c=list(w=3,t=5))) +}) + + +test_that("Test multipart respect content-type", { + 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") +}) diff --git a/tests/testthat/test-parser.R b/tests/testthat/test-parser.R new file mode 100644 index 000000000..e543f868f --- /dev/null +++ b/tests/testthat/test-parser.R @@ -0,0 +1,81 @@ +context("Parsers tag") + +test_that("parsers can be combined", { + + expect_parsers <- function(names, target_names, sort_items = TRUE) { + aliases <- names(make_parser(names)$alias) + if (sort_items) { + aliases <- sort(aliases) + target_names <- sort(target_names) + } + expect_equal(aliases, target_names) + } + + expect_parsers("json", "json") + + expect_parsers(c("query", "json"), c("query", "json"), sort_items = FALSE) + + expect_parsers("all", setdiff(registered_parsers(), c("all", "none"))) + expect_parsers(list(all = list()), setdiff(registered_parsers(), c("all", "none"))) + expect_parsers(TRUE, setdiff(registered_parsers(), c("all", "none"))) + + + + # make sure parameters are not overwritten even when including all + parsers_plain <- make_parser(list(all = list(), json = list(simplifyVector = FALSE))) + json_input <- parsers_plain$alias$json(charToRaw(jsonlite::toJSON(1:3))) + expect_equal(json_input, list(1,2,3)) + + parsers_guess <- make_parser(list(all = list(), json = list(simplifyVector = TRUE))) + json_input <- parsers_guess$alias$json(charToRaw(jsonlite::toJSON(1:3))) + expect_equal(json_input, c(1,2,3)) + + # check that parsers return already combined parsers + expect_equal(make_parser(parsers_plain), parsers_plain) +}) + +test_that("parsers work", { + r <- plumber$new(test_path("files/parsers.R")) + res <- PlumberResponse$new() + + expect_identical(r$route(make_req("POST", "/default", body='{"a":1}'), res), structure(list(1L), names = "a")) + expect_identical(r$route(make_req("POST", "/none", body='{"a":1}'), res), structure(list(), names = character())) + expect_identical(r$route(make_req("POST", "/all", body='{"a":1}'), res), structure(list(1L), names = "a")) + bin_file <- test_path("files/multipart-ctype.bin") + bin_body <- readBin(bin_file, "raw", file.info(bin_file)$size) + expect_identical(r$route(make_req("POST", "/none", body=rawToChar(bin_body)), res), structure(list(), names = character())) + expect_message(r$route(make_req("POST", "/json", body=rawToChar(bin_body)), res), "No suitable parser found") + + bin_file <- test_path("files/multipart-form.bin") + bin_body <- readBin(bin_file, "raw", file.info(bin_file)$size) + + + req <- new.env() + req$REQUEST_METHOD <- "POST" + req$PATH_INFO <- "/all" + req$QUERY_STRING <- "" + req$HTTP_CONTENT_TYPE <- "multipart/form-data; boundary=----WebKitFormBoundaryMYdShB9nBc32BUhQ" + req$rook.input <- list(read_lines = function(){ stop("should not be executed") }, + read = function(){ bin_body }, + rewind = function(){ length(bin_body) }) + + parsed_body <- + local({ + op <- options(plumber.postBody = FALSE) + on.exit({options(op)}, add = TRUE) + r$route(req, PlumberResponse$new()) + }) + expect_equal(names(parsed_body), c("json", "img1", "img2", "rds")) + expect_equal(parsed_body[["rds"]], women) + expect_equal(attr(parsed_body[["img1"]], "filename"), "avatar2-small.png") + expect_equal(parsed_body[["json"]], list(a=2,b=4,c=list(w=3,t=5))) + + + # expect parsers match + expect_equal(r$routes$none$parsers, make_parser("none")) + expect_equal(r$routes$all$parsers, make_parser("all")) + expect_equal(r$routes$default$parsers, NULL) + expect_equal(r$routes$json$parsers, make_parser("json")) + expect_equal(r$routes$mixed$parsers, make_parser(c("json", "query"))) + expect_equal(r$routes$repeated$parsers, make_parser("json")) +}) diff --git a/tests/testthat/test-plumber.R b/tests/testthat/test-plumber.R index 991d49c47..ac0e20c18 100644 --- a/tests/testthat/test-plumber.R +++ b/tests/testthat/test-plumber.R @@ -87,17 +87,17 @@ test_that("plumb accepts a directory with a `plumber.R` file", { }) test_that("plumb() a dir leverages `entrypoint.R`", { - expect_null(plumber:::.globals$serializers$fake, "This just that your Plumber environment is dirty. Restart your R session.") + expect_null(.globals$serializers$fake, "This just that your Plumber environment is dirty. Restart your R session.") r <- plumb(dir = test_path("files/entrypoint/")) expect_equal(length(r$endpoints), 1) expect_equal(length(r$endpoints[[1]]), 1) # A global serializer was added by entrypoint.R before parsing - expect_true(!is.null(plumber:::.globals$serializers$fake)) + expect_true(!is.null(.globals$serializers$fake)) # Clean up after ourselves - gl <- plumber:::.globals + gl <- .globals gl$serializers["fake"] <- NULL }) diff --git a/tests/testthat/test-postbody.R b/tests/testthat/test-postbody.R deleted file mode 100644 index 1cce315b9..000000000 --- a/tests/testthat/test-postbody.R +++ /dev/null @@ -1,69 +0,0 @@ -context("POST body") - -test_that("JSON is consumed on POST", { - expect_equal(parseBody('{"a":"1"}', content_type = NULL), list(a = "1")) -}) - -test_that("ending in `==` does not produce a unexpected key", { - # See https://github.com/rstudio/plumber/issues/463 - expect_equal(parseBody("randomcharshere==", content_type = NULL), list()) -}) - -test_that("Query strings on post are handled correctly", { - expect_equivalent(parseBody("a="), list()) # It's technically a named list() - expect_equal(parseBody("a=1&b=&c&d=1", content_type = NULL), list(a="1", d="1")) -}) - -test_that("Able to handle UTF-8", { - expect_equal(parseBody('{"text":"élise"}', content_type = "application/json; charset=UTF-8")$text, "élise") -}) - -#charset moved to part parsing -test_that("filter passes on content-type", { - content_type_passed <- "" - req <- list( - .internal = list(postBodyHandled = FALSE), - rook.input = list( - read = function() { - called <- TRUE - return(charToRaw("this is a body")) - }, - rewind = function() {}, - read_lines = function() {return("this is a body")} - ), - HTTP_CONTENT_TYPE = "text/html; charset=testset", - args = c() - ) - with_mock( - parseBody = function(body, content_type = "unknown") { - print(content_type) - body - }, - expect_output(postBodyFilter(req), "text/html; charset=testset"), - .env = "plumber" - ) -}) - -# parsers -test_that("Test text parser", { - expect_equal(parseBody("Ceci est un texte.", "text/html"), "Ceci est un texte.") -}) - -test_that("Test yaml parser", { - skip_if_not_installed("yaml") - - r_object <- list(a=1,b=list(c=2,d=list(e=3,f=4:6))) - expect_equal(parseBody(charToRaw(yaml::as.yaml(r_object)), "application/x-yaml"), r_object) -}) - -test_that("Test multipart parser", { - - bin_file <- test_path("files/multipart-form.bin") - body <- readBin(bin_file, what = "raw", n = file.info(bin_file)$size) - parsed_body <- parseBody(body, "multipart/form-data; boundary=----WebKitFormBoundaryMYdShB9nBc32BUhQ") - - expect_equal(names(parsed_body), c("json", "img1", "img2", "rds")) - expect_equal(parsed_body[["rds"]], women) - expect_equal(attr(parsed_body[["img1"]], "filename"), "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-querystring.R b/tests/testthat/test-querystring.R index 2aed69e22..76920acd6 100644 --- a/tests/testthat/test-querystring.R +++ b/tests/testthat/test-querystring.R @@ -60,7 +60,7 @@ test_that("different lengths of query string return same shape", { parseQS( paste0("?", paste0(keys, "=", vals, collapse = "&")) ), - setNames( + stats::setNames( lapply(unique(keys), function(key) { unname(unlist(vals[keys == key])) }), diff --git a/tests/testthat/test-include.R b/tests/testthat/test-zzz-include.R similarity index 100% rename from tests/testthat/test-include.R rename to tests/testthat/test-zzz-include.R