Add argument .redact to req_headers()

NEWS.md

@@ -1,5 +1,8 @@
 # httr2 (development version)
 
+* `req_headers()` gains a `.redact` argument that controls whether or not to
+  redact a header (@mgirlich, #247).
+
 * `req_body_file()` now supports "rewinding". This is occasionally needed when
   you upload a file to a URL that uses a 307 or 308 redirect to state that you 
   should have submitted the file to a different URL, and makes the "necessary 

R/headers.R

@@ -37,11 +37,14 @@ print.httr2_headers <- function(x, ..., redact = TRUE) {
   invisible(x)
 }
 
-headers_redact <- function(x, redact = TRUE) {
+headers_redact <- function(x, redact = TRUE, to_redact = NULL) {
   if (!redact) {
     x
   } else {
-    list_redact(x, "Authorization", case_sensitive = FALSE)
+    to_redact <- union(attr(x, "redact"), to_redact)
+    attr(x, "redact") <- NULL
+
+    list_redact(x, to_redact, case_sensitive = FALSE)
   }
 }
 

R/req-auth.R

@@ -30,7 +30,7 @@ req_auth_basic <- function(req, username, password = NULL) {
   password <- check_password(password)
 
   username_password <- openssl::base64_encode(paste0(username, ":", password))
-  req_headers(req, Authorization = paste0("Basic ", username_password))
+  req_headers(req, Authorization = paste0("Basic ", username_password), .redact = "Authorization")
 }
 
 #' Authenticate request with bearer token
@@ -57,5 +57,5 @@ req_auth_basic <- function(req, username, password = NULL) {
 req_auth_bearer_token <- function(req, token) {
   check_request(req)
   check_string(token)
-  req_headers(req, Authorization = paste("Bearer", token))
+  req_headers(req, Authorization = paste("Bearer", token), .redact = "Authorization")
 }

R/req-headers.R

@@ -9,6 +9,8 @@
 #'   * Use `NULL` to reset a value to httr's default
 #'   * Use `""` to remove a header
 #'   * Use a character vector to repeat a header.
+#' @param .redact Headers to redact. If `NULL`, the default, the added headers
+#'   are not redacted.
 #' @returns A modified HTTP [request].
 #' @export
 #' @examples
@@ -47,9 +49,22 @@
 #'    req_headers(!!!headers, HeaderThree = "three") %>%
 #'    req_dry_run()
 #'
-req_headers <- function(.req, ...) {
+#' # Use `.redact` to hide a header in the output
+#' req %>%
+#'   req_headers(Secret = "this-is-private", Public = "but-this-is-not", .redact = "Secret") %>%
+#'   req_dry_run()
+req_headers <- function(.req, ..., .redact = NULL) {
   check_request(.req)
 
-  .req$headers <- modify_list(.req$headers, ...)
+  headers <- list2(...)
+  header_names <- names2(headers)
+  check_character(.redact, allow_null = TRUE)
+
+  redact_out <- attr(.req$headers, "redact") %||% .redact %||% character()
+  redact_out <- union(redact_out, .redact)
+  .req$headers <- modify_list(.req$headers, !!!headers)
+
+  attr(.req$headers, "redact") <- redact_out
+
   .req
 }

R/req-options.R

@@ -165,11 +165,12 @@ req_verbose <- function(req,
                         redact_headers = TRUE) {
   check_request(req)
 
+  to_redact <- attr(req$headers, "redact")
   debug <- function(type, msg) {
     switch(type + 1,
       text =       if (info)        verbose_message("*  ", msg),
       headerOut =  if (header_resp) verbose_header("<- ", msg),
-      headerIn =   if (header_req)  verbose_header("-> ", msg, redact_headers),
+      headerIn =   if (header_req)  verbose_header("-> ", msg, redact_headers, to_redact = to_redact),
       dataOut =    if (body_resp)   verbose_message("<< ", msg),
       dataIn =     if (body_req)    verbose_message(">> ", msg)
     )
@@ -193,13 +194,13 @@ verbose_message <- function(prefix, x) {
   cli::cat_line(prefix, lines)
 }
 
-verbose_header <- function(prefix, x, redact = TRUE) {
+verbose_header <- function(prefix, x, redact = TRUE, to_redact = NULL) {
   x <- readBin(x, character())
   lines <- unlist(strsplit(x, "\r?\n", useBytes = TRUE))
 
   for (line in lines) {
     if (grepl(":", line, fixed = TRUE)) {
-      header <- headers_redact(as_headers(line), redact)
+      header <- headers_redact(as_headers(line), redact, to_redact = to_redact)
       cli::cat_line(prefix, cli::style_bold(names(header)), ": ", header)
     } else {
       cli::cat_line(prefix, line)

R/req-perform.R

@@ -212,8 +212,9 @@ req_dry_run <- function(req, quiet = FALSE, redact_headers = TRUE) {
   check_installed("httpuv")
 
   if (!quiet) {
+    to_redact <- attr(req$headers, "redact")
     debug <- function(type, msg) {
-      if (type == 2L) verbose_header("", msg, redact = redact_headers)
+      if (type == 2L) verbose_header("", msg, redact = redact_headers, to_redact = to_redact)
       if (type == 4L) verbose_message("", msg)
     }
     req <- req_options(req, debugfunction = debug, verbose = TRUE)

tests/testthat/_snaps/req-headers.md

@@ -0,0 +1,8 @@
+# can control which headers to redact
+
+    Code
+      req_headers(req, a = 1L, b = 2L, .redact = 1L)
+    Condition
+      Error in `req_headers()`:
+      ! `.redact` must be a character vector or `NULL`, not the number 1.
+

tests/testthat/test-headers.R

@@ -27,6 +27,7 @@ test_that("subsetting is case insensitive", {
 
 test_that("redaction is case-insensitive", {
   headers <- as_headers("AUTHORIZATION: SECRET")
+  attr(headers, "redact") <- "Authorization"
   redacted <- headers_redact(headers)
   expect_named(redacted, "AUTHORIZATION")
   expect_match(as.character(redacted$AUTHORIZATION), "<REDACTED>")

tests/testthat/test-oauth-client.R

@@ -36,7 +36,7 @@ test_that("can authenticate using header or body", {
 
   req <- request("http://example.com")
   req_h <- oauth_client_req_auth(req, client("header"))
-  expect_equal(req_h$headers$Authorization, "Basic aWQ6c2VjcmV0")
+  expect_equal(req_h$headers, structure(list(Authorization = "Basic aWQ6c2VjcmV0"), redact = "Authorization"))
 
   req_b <- oauth_client_req_auth(req, client("body"))
   expect_equal(req_b$body$data, list(client_id = "id", client_secret = "secret"))

tests/testthat/test-req-auth.R

@@ -10,5 +10,5 @@ test_that("can send username/password", {
 
 test_that("can send bearer token", {
   req <- req_auth_bearer_token(request_test(), "abc")
-  expect_equal(req$headers$Authorization, "Bearer abc")
+  expect_equal(req$headers, structure(list(Authorization = "Bearer abc"), redact = "Authorization"))
 })

tests/testthat/test-req-headers.R

@@ -1,15 +1,15 @@
 test_that("can add and remove headers", {
   req <- request("http://example.com")
   req <- req %>% req_headers(x = 1)
-  expect_equal(req$headers, list(x = 1))
+  expect_equal(req$headers, structure(list(x = 1), redact = character()))
   req <- req %>% req_headers(x = NULL)
-  expect_equal(req$headers, list())
+  expect_equal(req$headers, structure(list(), redact = character()))
 })
 
 test_that("can add header called req", {
   req <- request("http://example.com")
   req <- req %>% req_headers(req = 1)
-  expect_equal(req$headers, list(req = 1))
+  expect_equal(req$headers, structure(list(req = 1), redact = character()))
 })
 
 test_that("can add repeated headers", {
@@ -19,3 +19,18 @@ test_that("can add repeated headers", {
   # https://datatracker.ietf.org/doc/html/rfc7230#section-3.2.2
   expect_equal(resp$headers$a, c("a,b"))
 })
+
+test_that("can control which headers to redact", {
+  expect_redact <- function(req, expected) {
+    expect_equal(attr(req$headers, "redact"), expected)
+  }
+
+  req <- request("http://example.com")
+  expect_redact(req_headers(req, a = 1L, b = 2L), character())
+  expect_redact(req_headers(req, a = 1L, b = 2L, .redact = c("a", "b")), c("a", "b"))
+  expect_redact(req_headers(req, a = 1L, b = 2L, .redact = "a"), "a")
+
+  expect_snapshot(error = TRUE, {
+    req_headers(req, a = 1L, b = 2L, .redact = 1L)
+  })
+})

tests/testthat/test-req.R

@@ -13,12 +13,13 @@ test_that("individually prints repeated headers", {
 
 test_that("print method obfuscates Authorization header unless requested", {
   req <- request("https://example.com") %>%
-    req_headers(Authorization = "SECRET")
+    req_auth_basic("user", "SECRET")
   output <- testthat::capture_messages(print(req))
   expect_false(any(grepl("SECRET", output)))
 
   output <- testthat::capture_messages(print(req, redact_headers = FALSE))
-  expect_true(any(grepl("SECRET", output)))
+  expect_true(any(grepl("Authorization: 'Basic", output)))
+  expect_false(any(grepl("REDACTED", output)))
 })
 
 test_that("check_request() gives useful error", {