allow plumber request to be used in endpoint handlers

R/endpoint.R

@@ -172,6 +172,10 @@ porcelain_endpoint <- R6::R6Class(
           query = req$porcelain_query,
           body = req$porcelain_body)
         args <- self$inputs$validate(given)
+        run_args <- rlang::fn_fmls_names(self$target)
+        if ("req" %in% run_args) {
+          args$req <- req
+        }
         do.call(self$run, args)
       }, error = porcelain_process_error)
     },

R/input.R

@@ -251,6 +251,7 @@ porcelain_inputs <- R6::R6Class(
 
       nms <- vcapply(self$inputs, "[[", "name")
       msg <- setdiff(formals_required(target), nms)
+      msg <- setdiff(msg, "req")
       if (length(msg) > 0L) {
         stop("Required arguments to target function missing from inputs: ",
              paste(squote(msg), collapse = ", "),

tests/testthat/test-input.R

@@ -614,6 +614,24 @@ test_that("Must provide all non-optional args", {
 })
 
 
+test_that("'req' arg always accepted", {
+  expect_error(
+    porcelain_endpoint$new(
+      "GET", "/add", function(a, b, req) jsonlite::unbox(a + b),
+      returning = porcelain_returning_json("Number", "schema"),
+      input_query = porcelain_input_query(a = "numeric"),
+      validate = TRUE),
+    "Required arguments to target function missing from inputs: 'b'")
+  expect_error(
+    porcelain_endpoint$new(
+      "GET", "/add", function(a, req, b = 1) jsonlite::unbox(a + b),
+      returning = porcelain_returning_json("Number", "schema"),
+      input_query = porcelain_input_query(a = "numeric"),
+      validate = TRUE),
+    NA)
+})
+
+
 test_that("default parameters", {
   endpoint <- porcelain_endpoint$new(
     "GET", "/multiply", function(a, b = 2) jsonlite::unbox(a * b),

tests/testthat/test-porcelain.R

@@ -248,3 +248,26 @@ test_that("build api - text endpoint", {
   expect_equal(res_api$headers[["Content-Type"]], "text/plain")
   expect_equal(res_api$body, "some text")
 })
+
+
+test_that("build api - endpoint using 'req'", {
+  handler <- function(req) {
+    req$REQUEST_METHOD
+  }
+  endpoint <- porcelain_endpoint$new(
+    "GET", "/text", handler,
+    returning = porcelain_returning_text(),
+    validate = TRUE)
+
+  mock_request <- as.environment(list(REQUEST_METHOD = "GET"))
+  res <- endpoint$run(mock_request)
+  expect_equal(res$status_code, 200)
+  expect_equal(res$content_type, "text/plain")
+  expect_null(res$headers)
+  expect_true(res$validated)
+  expect_equal(res$data, "GET")
+
+  res_api <- endpoint$request()
+  expect_equal(res_api$status, 200)
+  expect_equal(res_api$body, "GET")
+})