Add request ID to logger filter in plumber filter

So that the request ID is available to logs whilst endpoint is being run

R/filter.R

@@ -1,6 +1,6 @@
-porcelain_filters <- function(req, res) {
+porcelain_filters <- function(logger) {
   list(query_string = porcelain_filter_query_string,
-       request_id = porcelain_filter_request_id,
+       request_id = porcelain_filter_request_id(logger),
        post_body = porcelain_filter_post_body,
        metadata = porcelain_filter_metadata)
 }
@@ -35,13 +35,21 @@ porcelain_filter_metadata <- function(req, res) {
   plumber::forward()
 }
 
-porcelain_filter_request_id <- function(req, res) {
-  if ("x-request-id" %in% names(req$HEADERS)) {
-    request_id <- req$HEADERS[["x-request-id"]]
-  } else {
-    request_id <- ids::uuid()
+
+porcelain_filter_request_id <- function(logger) {
+  force(logger)
+  function(req, res) {
+    if ("x-request-id" %in% names(req$HEADERS)) {
+      request_id <- req$HEADERS[["x-request-id"]]
+    } else {
+      request_id <- ids::uuid()
+    }
+    req$REQUEST_ID <- request_id
+    res$setHeader("x-request-id", request_id)
+    if (!is.null(logger)) {
+      logger$add_filter(lgr::FilterInject$new(request_id = request_id),
+                        name = LOG_FILTER_REQUEST_ID_NAME)
+    }
+    plumber::forward()
   }
-  req$REQUEST_ID <- request_id
-  res$setHeader("x-request-id", request_id)
-  plumber::forward()
 }

R/logging.R

@@ -1,3 +1,5 @@
+LOG_FILTER_REQUEST_ID_NAME <- "request_id"
+
 ##' Create a json-emitting logger, using the 'lgr' package.
 ##'
 ##' @title Create logger
@@ -36,7 +38,6 @@ porcelain_logger <- function(log_level = "info", name = NULL, path = NULL) {
   logger
 }
 
-
 ## Plumber has stages preroute -> postroute -> preserialize -> postserialize
 ##
 ## We hook up the first bit of logging up against postroute as by that
@@ -51,7 +52,7 @@ porcelain_log_postroute <- function(logger) {
   force(logger)
   function(data, req, res) {
     logger$info("request %s %s", req$REQUEST_METHOD, req$PATH_INFO,
-                caller = "postroute", request_id = req$REQUEST_ID)
+                caller = "postroute")
     logger_detailed(logger, "trace", req, "postroute", "request")
   }
 }
@@ -75,7 +76,6 @@ porcelain_log_postserialize <- function(logger) {
     logger$info(sprintf("response %s %s => %d (%d bytes)",
                         req$REQUEST_METHOD, req$PATH_INFO, res$status, size),
                 caller = "postserialize",
-                request_id = req$REQUEST_ID,
                 endpoint = req$porcelain_endpoint,
                 request_received = req$received_time,
                 elapsed_ms = format_difftime_ms(now, req$received_time),
@@ -90,6 +90,7 @@ porcelain_log_postserialize <- function(logger) {
     logger_detailed(logger, "trace", req, "postserialize", "response",
                     body = describe_body(value$body))
 
+    logger$remove_filter(LOG_FILTER_REQUEST_ID_NAME)
     value
   }
 }
@@ -105,7 +106,6 @@ logger_detailed <- function(logger, level, req, caller, ...) {
     caller = caller,
     method = req$REQUEST_METHOD,
     path = req$PATH_INFO,
-    request_id = req$REQUEST_ID,
     endpoint = req$porcelain_endpoint,
     query = req$porcelain_query,
     headers = as.list(req$HEADERS),
@@ -119,3 +119,4 @@ describe_body <- function(body) {
   }
   body
 }
+

R/porcelain.R

@@ -33,7 +33,7 @@ porcelain <- R6::R6Class(
     initialize = function(..., validate = FALSE, logger = NULL) {
       ## NOTE: it's not totally clear what the correct environment
       ## here is.
-      super$initialize(NULL, porcelain_filters(), new.env(parent = .GlobalEnv))
+      super$initialize(NULL, porcelain_filters(logger), new.env(parent = .GlobalEnv))
       private$validate <- porcelain_validate_default(validate)
       self$setErrorHandler(porcelain_error_handler)
       self$set404Handler(porcelain_404_handler)

inst/examples/add_chatty/DESCRIPTION → inst/examples/add.chatty/DESCRIPTION

@@ -1,9 +1,9 @@
-Package: add
-Title: Adds Numbers
+Package: add.chatty
+Title: Chattily 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.
+Description: Adds numbers as an HTTP API with lots of logging.
 License: CC0
 Encoding: UTF-8
 Imports: porcelain

inst/examples/add_chatty/R/api.R → inst/examples/add.chatty/R/api.R

@@ -1,4 +1,6 @@
 add <- function(a, b) {
+  logger <- lgr::get_logger("add.chatty")
+  logger$info("Adding numbers :D")
   jsonlite::unbox(a + b)
 }
 
@@ -9,8 +11,8 @@ endpoint_add <- function() {
     returning = porcelain::porcelain_returning_json("numeric"))
 }
 
-api <- function(validate = FALSE, log_path = tempfile()) {
-  logger <- porcelain::porcelain_logger("info", path = log_path)
+api <- function(validate = FALSE) {
+  logger <- porcelain::porcelain_logger("info")
   api <- porcelain::porcelain$new(validate = validate, logger = logger)
   api$handle(endpoint_add())
   api

inst/examples/add/R/api.R

@@ -9,7 +9,7 @@ endpoint_add <- function() {
     returning = porcelain::porcelain_returning_json("numeric"))
 }
 
-api <- function(validate = FALSE, log_path = tempfile()) {
+api <- function(validate = FALSE) {
   api <- porcelain::porcelain$new(validate = validate)
   api$handle(endpoint_add())
   api

tests/testthat/test-endpoint.R

@@ -33,10 +33,10 @@ test_that("Can serve endpoint directly", {
     porcelain_input_query(n = "numeric"),
     validate = TRUE)
 
-  cmp <- porcelain$new()$handle(endpoint)$request("GET", "/square", list(n = 3))
-  res <- endpoint$request(list(n = 3))
+  cmp <- porcelain$new()$handle(endpoint)$request("GET", "/square", list(n = 3),
+                                                  request_id = "123")
+  res <- endpoint$request(list(n = 3), request_id = "123")
   res$headers[["Date"]] <- cmp$headers[["Date"]]
-  res$headers[["x-request-id"]] <- cmp$headers[["x-request-id"]]
   expect_equal(cmp, res)
 })
 

tests/testthat/test-integration.R

@@ -5,8 +5,7 @@ test_that("Can run add package", {
   pkg <- pkgload::load_all(path_pkg, export_all = FALSE, quiet = TRUE)
   on.exit(pkgload::unload("add"))
 
-  log_path <- tempfile()
-  api <- pkg$env$api(TRUE, log_path)
+  api <- pkg$env$api(TRUE)
   res <- api$request("GET", "/", c(a = 1, b = 2))
   expect_equal(res$headers[["X-Porcelain-Validated"]], "true")
   expect_equal(from_json(res$body)$status, "success")
@@ -18,15 +17,14 @@ test_that("can get logs from server", {
   skip_on_os("windows")
   skip_if_not_installed("pkgload")
 
-  path_add_chatty <- system_file("examples/add_chatty", package = "porcelain")
+  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)
 
   msgs <- testthat::capture_messages(
     bg <- porcelain_background$new(pkg$env$api,
-                                   # Set log_path to NULL to log to stdout
-                                   list(validate = TRUE, log_path = NULL),
+                                   list(validate = TRUE),
                                    verbose = TRUE))
 
   expect_equal(bg$status(), "stopped")
@@ -44,22 +42,27 @@ test_that("can get logs from server", {
   expect_equal(r$headers$`x-request-id`, "id123")
 
   logs <- readLines(bg$log)
+  add_log <- jsonlite::fromJSON(logs[[length(logs) - 2]])
   postroute_log <- jsonlite::fromJSON(logs[[length(logs) - 1]])
   postserialize_log <- jsonlite::fromJSON(logs[[length(logs)]])
+  expect_equal(add_log$request_id, "id123")
   expect_equal(postroute_log$caller, "postroute")
   expect_equal(postroute_log$request_id, "id123")
   expect_equal(postserialize_log$caller, "postserialize")
   expect_equal(postserialize_log$request_id, "id123")
+  expect_equal(r$headers$`x-request-id`, "id123")
 
   ## Without a request ID
   r <- bg$request("GET", "/", query = list(a = 1, b = 2))
 
   logs <- readLines(bg$log)
+  add_log <- jsonlite::fromJSON(logs[[length(logs) - 2]])
   postroute_log <- jsonlite::fromJSON(logs[[length(logs) - 1]])
   postserialize_log <- jsonlite::fromJSON(logs[[length(logs)]])
+  expect_match(add_log$request_id, uuid_regex)
   expect_equal(postroute_log$caller, "postroute")
-  expect_match(postroute_log$request_id, uuid_regex)
+  expect_match(postroute_log$request_id, add_log$request_id)
   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)
+  expect_equal(postserialize_log$request_id, add_log$request_id)
+  expect_equal(r$headers$`x-request-id`, add_log$request_id)
 })