Add request ID into response header

R/filter.R

@@ -42,5 +42,6 @@ porcelain_filter_request_id <- function(req, res) {
     request_id <- ids::uuid()
   }
   req$REQUEST_ID <- request_id
+  res$setHeader("x-request-id", request_id)
   plumber::forward()
 }

inst/examples/add/R/api.R

@@ -10,8 +10,7 @@ endpoint_add <- function() {
 }
 
 api <- function(validate = FALSE, log_path = tempfile()) {
-  logger <- porcelain::porcelain_logger("info", path = log_path)
-  api <- porcelain::porcelain$new(validate = validate, logger = logger)
+  api <- porcelain::porcelain$new(validate = validate)
   api$handle(endpoint_add())
   api
 }

inst/examples/add_chatty/DESCRIPTION

@@ -0,0 +1,12 @@
+Package: add
+Title: Adds Numbers
+Version: 1.0.0
+Authors@R: c(person("Rich", "FitzJohn", role = c("aut", "cre"),
+                    email = "[email protected]"))
+Description: Adds numbers as an HTTP API.
+License: CC0
+Encoding: UTF-8
+Imports: porcelain
+Suggests:
+    testthat (>= 3.0.0)
+Config/testthat/edition: 3

inst/examples/add_chatty/NAMESPACE

@@ -0,0 +1 @@
+export(api)

inst/examples/add_chatty/R/api.R

@@ -0,0 +1,17 @@
+add <- function(a, b) {
+  jsonlite::unbox(a + b)
+}
+
+endpoint_add <- function() {
+  porcelain::porcelain_endpoint$new(
+    "GET", "/", add,
+    porcelain::porcelain_input_query(a = "numeric", b = "numeric"),
+    returning = porcelain::porcelain_returning_json("numeric"))
+}
+
+api <- function(validate = FALSE, log_path = tempfile()) {
+  logger <- porcelain::porcelain_logger("info", path = log_path)
+  api <- porcelain::porcelain$new(validate = validate, logger = logger)
+  api$handle(endpoint_add())
+  api
+}

inst/examples/add_chatty/inst/schema/numeric.json

@@ -0,0 +1,5 @@
+{
+    "$schema": "http://json-schema.org/draft-04/schema#",
+    "id": "numeric",
+    "type": "number"
+}

inst/examples/add_chatty/tests/testthat.R

@@ -0,0 +1,4 @@
+library(testthat)
+library(add)
+
+test_check("add")

inst/examples/add_chatty/tests/testthat/test-api.R

@@ -0,0 +1,26 @@
+test_that("can add two numbers", {
+  expect_equal(add(1, 2), jsonlite::unbox(3))
+  expect_equal(add(3.14, 1.23), jsonlite::unbox(4.37))
+})
+
+test_that("add endpoint", {
+  endpoint <- endpoint_add()
+  res <- endpoint$run(1, 2)
+  expect_equal(res$data, add(1, 2))
+  expect_equal(res$status_code, 200)
+  expect_equal(res$content_type, "application/json")
+
+  obj <- api(validate = TRUE)
+  res_api <- obj$request("GET", "/", list(a = 1, b = 2))
+  expect_equal(res_api$body, res$body)
+  expect_equal(res_api$headers[["X-Porcelain-Validated"]], "true")
+})
+
+test_that("api fails gracefully when given non-numeric input", {
+  obj <- api(validate = TRUE)
+  res <- obj$request("GET", "/", list(a = 1, b = "x"))
+  expect_equal(res$status, 400)
+  body <- jsonlite::fromJSON(res$body, simplifyDataFrame = FALSE)
+  expect_equal(body$status, "failure")
+  expect_equal(body$errors[[1]]$error, "INVALID_INPUT")
+})

tests/testthat/test-endpoint.R

@@ -36,6 +36,7 @@ test_that("Can serve endpoint directly", {
   cmp <- porcelain$new()$handle(endpoint)$request("GET", "/square", list(n = 3))
   res <- endpoint$request(list(n = 3))
   res$headers[["Date"]] <- cmp$headers[["Date"]]
+  res$headers[["x-request-id"]] <- cmp$headers[["x-request-id"]]
   expect_equal(cmp, res)
 })
 

tests/testthat/test-input.R

@@ -648,9 +648,10 @@ test_that("destructure body", {
   json <- '{"a": 3, "b": 2}'
   res <- pr$request("POST", "/multiply", body = json)
   expect_equal(res$status, 200)
-  expect_equal(res$headers,
+  expect_equal(res$headers[c("Content-Type", "X-Porcelain-Validated")],
                list("Content-Type" = "application/json",
                     "X-Porcelain-Validated" = "true"))
+  expect_match(res$headers[["x-request-id"]], uuid_regex)
   expect_equal(res$body, endpoint$run("3", "2")$body)
 })
 
@@ -667,9 +668,10 @@ test_that("destructure body failure returns input error", {
   pr <- porcelain$new(validate = TRUE)$handle(endpoint)
   res <- pr$request("POST", "/multiply", body = "{}")
   expect_equal(res$status, 400)
-  expect_equal(res$headers,
+  expect_equal(res$headers[c("Content-Type", "X-Porcelain-Validated")],
                list("Content-Type" = "application/json",
                     "X-Porcelain-Validated" = "false"))
+  expect_match(res$headers[["x-request-id"]], uuid_regex)
   err <- jsonlite::fromJSON(res$body, simplifyDataFrame = FALSE)
   expect_equal(
     err,

tests/testthat/test-integration.R

@@ -18,8 +18,8 @@ test_that("can get logs from server", {
   skip_on_os("windows")
   skip_if_not_installed("pkgload")
 
-  path_add <- system_file("examples/add", package = "porcelain")
-  pkg <- pkgload::load_all(path_add,
+  path_add_chatty <- system_file("examples/add_chatty", package = "porcelain")
+  pkg <- pkgload::load_all(path_add_chatty,
                            export_all = FALSE, attach_testthat = FALSE,
                            warn_conflicts = FALSE, quiet = TRUE)
 
@@ -41,6 +41,8 @@ test_that("can get logs from server", {
     from_json(httr::content(r, encoding = "UTF-8", as = "text")),
     list(status = "success", errors = NULL, data = 3))
 
+  expect_equal(r$headers$`x-request-id`, "id123")
+
   logs <- readLines(bg$log)
   postroute_log <- jsonlite::fromJSON(logs[[length(logs) - 1]])
   postserialize_log <- jsonlite::fromJSON(logs[[length(logs)]])
@@ -51,11 +53,13 @@ test_that("can get logs from server", {
 
   ## Without a request ID
   r <- bg$request("GET", "/", query = list(a = 1, b = 2))
+
   logs <- readLines(bg$log)
   postroute_log <- jsonlite::fromJSON(logs[[length(logs) - 1]])
   postserialize_log <- jsonlite::fromJSON(logs[[length(logs)]])
   expect_equal(postroute_log$caller, "postroute")
   expect_match(postroute_log$request_id, uuid_regex)
   expect_equal(postserialize_log$caller, "postserialize")
   expect_equal(postserialize_log$request_id, postroute_log$request_id)
+  expect_equal(r$headers$`x-request-id`, postroute_log$request_id)
 })