diff --git a/DESCRIPTION b/DESCRIPTION
index 3d6625a66..957dbd65e 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -33,7 +33,8 @@ Imports:
mime,
lifecycle (>= 0.2.0),
ellipsis (>= 0.3.0),
- rlang
+ rlang,
+ httpproblems
ByteCompile: TRUE
Suggests:
testthat (>= 0.11.0),
@@ -85,6 +86,7 @@ Collate:
'plumber-step.R'
'pr.R'
'pr_set.R'
+ 'reexport-httpproblems.R'
'serializer.R'
'session-cookie.R'
'ui.R'
diff --git a/NAMESPACE b/NAMESPACE
index e0773c28e..a658e1b56 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -9,6 +9,8 @@ export(PlumberStatic)
export(addSerializer)
export(as_attachment)
export(available_apis)
+export(bad_request)
+export(conflict)
export(do_configure_https)
export(do_deploy_api)
export(do_forward)
@@ -16,15 +18,20 @@ export(do_provision)
export(do_remove_api)
export(do_remove_forward)
export(endpoint_serializer)
+export(forbidden)
export(forward)
export(getCharacterSet)
export(get_character_set)
export(get_option_or_env)
+export(http_problem)
+export(http_problem_types)
export(include_file)
export(include_html)
export(include_md)
export(include_rmd)
+export(internal_server_error)
export(is_plumber)
+export(not_found)
export(options_plumber)
export(parser_csv)
export(parser_feather)
@@ -100,12 +107,35 @@ export(serializer_write_file)
export(serializer_yaml)
export(sessionCookie)
export(session_cookie)
+export(stop_for_bad_request)
+export(stop_for_conflict)
+export(stop_for_forbidden)
+export(stop_for_http_problem)
+export(stop_for_internal_server_error)
+export(stop_for_not_found)
+export(stop_for_unauthorized)
+export(unauthorized)
export(validate_api_spec)
import(R6)
import(promises)
import(stringi)
importFrom(grDevices,dev.cur)
importFrom(grDevices,dev.set)
+importFrom(httpproblems,bad_request)
+importFrom(httpproblems,conflict)
+importFrom(httpproblems,forbidden)
+importFrom(httpproblems,http_problem)
+importFrom(httpproblems,http_problem_types)
+importFrom(httpproblems,internal_server_error)
+importFrom(httpproblems,not_found)
+importFrom(httpproblems,stop_for_bad_request)
+importFrom(httpproblems,stop_for_conflict)
+importFrom(httpproblems,stop_for_forbidden)
+importFrom(httpproblems,stop_for_http_problem)
+importFrom(httpproblems,stop_for_internal_server_error)
+importFrom(httpproblems,stop_for_not_found)
+importFrom(httpproblems,stop_for_unauthorized)
+importFrom(httpproblems,unauthorized)
importFrom(jsonlite,parse_json)
importFrom(jsonlite,toJSON)
importFrom(lifecycle,deprecated)
diff --git a/R/default-handlers.R b/R/default-handlers.R
index 3ea03b21f..d0c795fe5 100644
--- a/R/default-handlers.R
+++ b/R/default-handlers.R
@@ -4,6 +4,9 @@ default404Handler <- function(req, res) {
list(error="404 - Resource Not Found")
}
+# This do not need to be a function that returns a function
+# since it does not take a debug arg anymore. Do something?
+# https://github.com/rstudio/plumber/commit/813f1b656784729eefeca2e7bb32c061e7af33d1
defaultErrorHandler <- function(){
function(req, res, err){
print(err)
@@ -25,7 +28,10 @@ defaultErrorHandler <- function(){
# Don't overly leak data unless they opt-in
- if (is.function(req$pr$getDebug) && isTRUE(req$pr$getDebug())) {
+ # Simplified condition since debug is not an arg anymore.
+ # Unless private$debug unlocked and replaced, can only be logical from isTRUE
+ # in setDebug (plumber.R)
+ if (req$pr$getDebug()) {
li["message"] <- as.character(err)
}
diff --git a/R/plumber-static.R b/R/plumber-static.R
index 8d8073d5c..8d37ed674 100644
--- a/R/plumber-static.R
+++ b/R/plumber-static.R
@@ -38,8 +38,9 @@ PlumberStatic <- R6Class(
}
badRequest <- function(res) {
- res$body <- "
Bad Request
"
+ res$setHeader("Content-Type" = "application/problem+json")
res$status <- 400
+ res$body <- jsonlite::toJSON(bad_request(), auto_unbox = TRUE)
res
}
diff --git a/R/plumber.R b/R/plumber.R
index 9050b46a2..154a9b00b 100644
--- a/R/plumber.R
+++ b/R/plumber.R
@@ -90,8 +90,8 @@ Plumber <- R6Class(
self$setSerializer(serializer_json())
# Default parsers to maintain legacy features
self$setParsers(c("json", "form", "text", "octet", "multi"))
- self$setErrorHandler(defaultErrorHandler())
- self$set404Handler(default404Handler)
+ self$setErrorHandler(http_problem_response)
+ self$set404Handler(not_found_response)
self$setDocs(TRUE)
private$docs_info$has_not_been_set <- TRUE # set to know if `$setDocs()` has been called before `$run()`
private$docs_callback <- rlang::missing_arg()
@@ -816,11 +816,9 @@ Plumber <- R6Class(
if (isTRUE(get_option_or_env("plumber.methodNotAllowed", TRUE))) {
# Notify about allowed verbs
if (is_405(req$pr, req$PATH_INFO, req$REQUEST_METHOD)) {
- res$status <- 405L
# https://developer.mozilla.org/en-US/docs/Web/HTTP/Headers/Allow
res$setHeader("Allow", paste(req$verbsAllowed, collapse = ", "))
- res$serializer <- serializer_unboxed_json()
- return(list(error = "405 - Method Not Allowed"))
+ return(http_problem_response(req, res, 405L))
}
}
diff --git a/R/pr_set.R b/R/pr_set.R
index a62c81585..ef0eefaec 100644
--- a/R/pr_set.R
+++ b/R/pr_set.R
@@ -49,7 +49,8 @@ pr_set_parsers <- function(pr, parsers) {
#' \dontrun{
#' handler_404 <- function(req, res) {
#' res$status <- 404
-#' res$body <- "Oops"
+#' res$serializer <- serializer_unboxed_json(type = "application/problem+json")
+#' not_found("Oops")
#' }
#'
#' pr() %>%
@@ -77,7 +78,8 @@ pr_set_404 <- function(pr, fun) {
#' \dontrun{
#' handler_error <- function(req, res, err){
#' res$status <- 500
-#' list(error = "Custom Error Message")
+#' res$serializer <- serializer_unboxed_json(type = "application/problem+json")
+#' internal_server_error("Custom Error Message")
#' }
#'
#' pr() %>%
diff --git a/R/reexport-httpproblems.R b/R/reexport-httpproblems.R
new file mode 100644
index 000000000..5ea824174
--- /dev/null
+++ b/R/reexport-httpproblems.R
@@ -0,0 +1,125 @@
+#' @importFrom httpproblems http_problem_types
+#' @export
+httpproblems::http_problem_types
+
+#' @importFrom httpproblems http_problem
+#' @export
+httpproblems::http_problem
+
+#' @importFrom httpproblems bad_request
+#' @export
+httpproblems::bad_request
+
+#' @importFrom httpproblems conflict
+#' @export
+httpproblems::conflict
+
+#' @importFrom httpproblems forbidden
+#' @export
+httpproblems::forbidden
+
+#' @importFrom httpproblems not_found
+#' @export
+httpproblems::not_found
+
+#' @importFrom httpproblems unauthorized
+#' @export
+httpproblems::unauthorized
+
+#' @importFrom httpproblems internal_server_error
+#' @export
+httpproblems::internal_server_error
+
+#' @importFrom httpproblems stop_for_http_problem
+#' @export
+httpproblems::stop_for_http_problem
+
+#' @importFrom httpproblems stop_for_bad_request
+#' @export
+httpproblems::stop_for_bad_request
+
+#' @importFrom httpproblems stop_for_conflict
+#' @export
+httpproblems::stop_for_conflict
+
+#' @importFrom httpproblems stop_for_forbidden
+#' @export
+httpproblems::stop_for_forbidden
+
+#' @importFrom httpproblems stop_for_not_found
+#' @export
+httpproblems::stop_for_not_found
+
+#' @importFrom httpproblems stop_for_unauthorized
+#' @export
+httpproblems::stop_for_unauthorized
+
+#' @importFrom httpproblems stop_for_internal_server_error
+#' @export
+httpproblems::stop_for_internal_server_error
+
+http_problem_response <- function(req, res, problem) {
+ # The default is a 200. If that's still set, then we should probably override with a 500.
+ if (res$status == 200L) {
+ res$status = 500L
+ }
+ res$serializer <- serializer_unboxed_json(type = "application/problem+json")
+ problem <- to_http_problem(req, res, problem)
+ log_problem(req, res, problem)
+ # Don't leak
+ # dropped is function and isTRUE, already done within setDebug
+ # getDebug binding is locked
+ if (!req$pr$getDebug()) problem$detail <- NULL
+ return(problem)
+}
+
+not_found_response <- function(req, res) {
+ http_problem_response(req, res, 404L)
+}
+
+to_http_problem <- function(req, res, problem) {
+ UseMethod("to_http_problem", problem)
+}
+
+to_http_problem.default <- function(req, res, problem) {
+ http_problem(status = res$status)
+}
+
+to_http_problem.character <- function(req, res, problem) {
+ http_problem(detail = problem, status = res$status)
+}
+
+to_http_problem.numeric <- function(req, res, problem) {
+ problem <- http_problem(status = problem)
+ # set status after in case problem is invalid
+ res$status <- problem$status
+ return(problem)
+}
+
+to_http_problem.http_problem <- function(req, res, problem) {
+ res$status <- problem$status
+ return(problem)
+}
+
+to_http_problem.http_problem_error <- function(req, res, problem) {
+ res$status <- problem$body$status
+ return(problem$body)
+}
+
+to_http_problem.condition <- function(req, res, problem) {
+ http_problem(detail = conditionMessage(problem), status = res$status)
+}
+
+
+
+log_problem <- function(req, res, problem) {
+ # Fixed log format, bring in customization?
+ cat(
+ req$REMOTE_ADDR, " - ", "[", format(Sys.time(), "%F %T %z"), "] ",
+ '"', req$REQUEST_METHOD, " ", req$PATH_INFO, '" ',
+ problem$title, " (HTTP ", res$status, ") (", length(req$bodyRaw), " bytes sent) (",
+ problem$detail ,") ",
+ '"', req$HTTP_REFERER, " ", req$HTTP_USER_AGENT, '"',
+ "\n", file = stderr(), sep = ""
+ )
+}
diff --git a/R/shared-secret-filter.R b/R/shared-secret-filter.R
index 9e3f72eed..520187589 100644
--- a/R/shared-secret-filter.R
+++ b/R/shared-secret-filter.R
@@ -4,17 +4,10 @@ sharedSecretFilter <- function(req, res){
if (!is.null(secret)){
supplied <- req$HTTP_PLUMBER_SHARED_SECRET
if (!identical(supplied, secret)){
- res$status <- 400
- # Force the route to return as unboxed json
- res$serializer <- serializer_unboxed_json()
- # Using output similar to `defaultErrorHandler()`
- li <- list(error = "400 - Bad request")
-
# Don't overly leak data unless they opt-in
- if (is.function(req$pr$getDebug) && isTRUE(req$pr$getDebug())) {
- li$message <- "Shared secret mismatch"
- }
- return(li)
+ msg <- if (req$pr$getDebug()) "Shared secret mismatch"
+
+ return(http_problem_response(req, res, bad_request(msg)))
}
}
diff --git a/inst/plumber/01-append/plumber.R b/inst/plumber/01-append/plumber.R
index 2df08f11e..cf967b8cd 100644
--- a/inst/plumber/01-append/plumber.R
+++ b/inst/plumber/01-append/plumber.R
@@ -4,11 +4,10 @@ MAX_VALS <- 50
#* Append to our values
#* @post /append
-function(val, res){
+function(val){
v <- as.numeric(val)
if (is.na(v)){
- res$status <- 400
- res$body <- "val parameter must be a number"
+ stop_for_bad_request("val parameter must be a number")
}
values <<- c(values, val)
@@ -21,11 +20,10 @@ function(val, res){
#* Get the last few values
#* @get /tail
-function(n="10", res){
+function(n="10"){
n <- as.numeric(n)
if (is.na(n) || n < 1 || n > MAX_VALS){
- res$status <- 400
- res$body <- "parameter 'n' must be a number between 1 and 100"
+ stop_for_bad_request("parameter 'n' must be a number between 1 and 100")
}
list(val=tail(values, n=n))
diff --git a/inst/plumber/02-filters/plumber.R b/inst/plumber/02-filters/plumber.R
index 29983954f..455c1e6d0 100644
--- a/inst/plumber/02-filters/plumber.R
+++ b/inst/plumber/02-filters/plumber.R
@@ -37,12 +37,10 @@ function(req, username=""){
#* Now require that all users must be authenticated.
#* @filter require-auth
-function(req, res){
+function(req){
if (is.null(req$user)){
# User isn't logged in
-
- res$status <- 401 # Unauthorized
- list(error="You must login to access this resource.")
+ stop_for_unauthorized("You must login to access this resource.")
} else {
# user is logged in. Move on...
forward()
diff --git a/inst/plumber/03-github/plumber.R b/inst/plumber/03-github/plumber.R
index 290e4eb55..bcb14ac03 100644
--- a/inst/plumber/03-github/plumber.R
+++ b/inst/plumber/03-github/plumber.R
@@ -17,14 +17,12 @@ function(){
#* Give GitHub Webhook a way to alert us about new pushes to the repo
#* https://developer.github.com/webhooks/
#* @post /update
-function(req, res){
+function(req){
secret <- readLines("./github-key.txt")[1]
hm <- digest::hmac(secret, req$body, algo="sha1")
hm <- paste0("sha1=", hm)
if (!identical(hm, req$HTTP_X_HUB_SIGNATURE)){
- res$status <- 400
- res$body <- "invalid GitHub signature."
- return(res)
+ stop_for_bad_request("invalid GitHub signature.")
}
# DO...
diff --git a/inst/plumber/11-car-inventory/plumber.R b/inst/plumber/11-car-inventory/plumber.R
index 15e2d2924..9a4ec54f7 100644
--- a/inst/plumber/11-car-inventory/plumber.R
+++ b/inst/plumber/11-car-inventory/plumber.R
@@ -18,10 +18,10 @@ listCars <- function(){
#* @get /car/
#* @response 404 No car with the given ID was found in the inventory.
#* @tag cars
-getCar <- function(id, res){
+getCar <- function(id){
car <- inventory[inventory$id == id,]
if (nrow(car) == 0){
- res$status <- 404
+ stop_for_not_found()
}
car
}
@@ -49,13 +49,12 @@ validateCar <- function(make, model, year){
#* @param price:numeric The price of the car in USD
#* @response 400 Invalid user input provided
#* @tag cars
-addCar <- function(make, model, edition, year, miles, price, res){
+addCar <- function(make, model, edition, year, miles, price){
newId <- max(inventory$id) + 1
valid <- validateCar(make, model, year)
if (!is.null(valid)){
- res$status <- 400
- return(list(errors=paste0("Invalid car: ", valid)))
+ stop_for_bad_request(paste0("Invalid car: ", valid))
}
car <- list(
@@ -82,12 +81,11 @@ addCar <- function(make, model, edition, year, miles, price, res){
#* @param price:numeric The price of the car in USD
#* @put /car/
#* @tag cars
-updateCar <- function(id, make, model, edition, year, miles, price, res){
+updateCar <- function(id, make, model, edition, year, miles, price){
valid <- validateCar(make, model, year)
if (!is.null(valid)){
- res$status <- 400
- return(list(errors=paste0("Invalid car: ", valid)))
+ stop_for_bad_request(paste0("Invalid car: ", valid))
}
updated <- list(
@@ -101,7 +99,7 @@ updateCar <- function(id, make, model, edition, year, miles, price, res){
)
if (!(id %in% inventory$id)){
- stop("No such ID: ", id)
+ stop_for_bad_request(paste0("No such ID: ", id))
}
inventory[inventory$id == id, ] <<- updated
@@ -112,10 +110,9 @@ updateCar <- function(id, make, model, edition, year, miles, price, res){
#* @param id:int The ID of the car to delete
#* @delete /car/
#* @tag cars
-deleteCar <- function(id, res){
+deleteCar <- function(id){
if (!(id %in% inventory$id)){
- res$status <- 400
- return(list(errors=paste0("No such ID: ", id)))
+ stop_for_bad_request(paste0("No such ID: ", id))
}
inventory <<- inventory[inventory$id != id,]
}
diff --git a/man/pr_set_404.Rd b/man/pr_set_404.Rd
index 1d16ae242..8cfa3b1f9 100644
--- a/man/pr_set_404.Rd
+++ b/man/pr_set_404.Rd
@@ -22,7 +22,8 @@ cannot be served by an existing endpoint or filter.
\dontrun{
handler_404 <- function(req, res) {
res$status <- 404
- res$body <- "Oops"
+ res$serializer <- serializer_unboxed_json(type = "application/problem+json")
+ not_found("Oops")
}
pr() \%>\%
diff --git a/man/pr_set_error.Rd b/man/pr_set_error.Rd
index 9453165e8..6b1a64c4e 100644
--- a/man/pr_set_error.Rd
+++ b/man/pr_set_error.Rd
@@ -23,7 +23,8 @@ error
\dontrun{
handler_error <- function(req, res, err){
res$status <- 500
- list(error = "Custom Error Message")
+ res$serializer <- serializer_unboxed_json(type = "application/problem+json")
+ internal_server_error("Custom Error Message")
}
pr() \%>\%
diff --git a/man/reexports.Rd b/man/reexports.Rd
new file mode 100644
index 000000000..be6fc099d
--- /dev/null
+++ b/man/reexports.Rd
@@ -0,0 +1,30 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/reexport-httpproblems.R
+\docType{import}
+\name{reexports}
+\alias{reexports}
+\alias{http_problem_types}
+\alias{http_problem}
+\alias{bad_request}
+\alias{conflict}
+\alias{forbidden}
+\alias{not_found}
+\alias{unauthorized}
+\alias{internal_server_error}
+\alias{stop_for_http_problem}
+\alias{stop_for_bad_request}
+\alias{stop_for_conflict}
+\alias{stop_for_forbidden}
+\alias{stop_for_not_found}
+\alias{stop_for_unauthorized}
+\alias{stop_for_internal_server_error}
+\title{Objects exported from other packages}
+\keyword{internal}
+\description{
+These objects are imported from other packages. Follow the links
+below to see their documentation.
+
+\describe{
+ \item{httpproblems}{\code{\link[httpproblems:http_problem]{bad_request}}, \code{\link[httpproblems:http_problem]{conflict}}, \code{\link[httpproblems:http_problem]{forbidden}}, \code{\link[httpproblems]{http_problem}}, \code{\link[httpproblems]{http_problem_types}}, \code{\link[httpproblems:http_problem]{internal_server_error}}, \code{\link[httpproblems:http_problem]{not_found}}, \code{\link[httpproblems:stop_for_http_problem]{stop_for_bad_request}}, \code{\link[httpproblems:stop_for_http_problem]{stop_for_conflict}}, \code{\link[httpproblems:stop_for_http_problem]{stop_for_forbidden}}, \code{\link[httpproblems]{stop_for_http_problem}}, \code{\link[httpproblems:stop_for_http_problem]{stop_for_internal_server_error}}, \code{\link[httpproblems:stop_for_http_problem]{stop_for_not_found}}, \code{\link[httpproblems:stop_for_http_problem]{stop_for_unauthorized}}, \code{\link[httpproblems:http_problem]{unauthorized}}}
+}}
+