Also prettify requests

NEWS.md

@@ -8,7 +8,7 @@
 * Most of the limitations of `req_perform_parallel()` have been lifted. It can now refresh OAuth tokens and look at the cache for each individual requests. It also supports a simple version of `req_throttle()` and `req_retry()`, where it assumes that all requests have the same throttling and rate limits (#681).
 * `req_user_agent()` now memoises the default user agent, since it's relatively slow (300 µs) to compute because it requires looking up version numbers.
 * `req_dry_run()` drops headers that otherwise will vary in tests, and gains the ability to prettify JSON output.
-* `req_verbose()` automatically prettifies JSON responses (#668). You can disable this by setting `httr2_pretty_json`.
+* `req_verbose()` automatically prettifies JSON requests and responses (#668). You can disable this by setting `httr2_pretty_json`.
 * `req_perform_connection()` gives a better error if request fails at networking level.
 * `req_throttle()` now uses a "token bucket" which preserves the average rate limit, but allows bursts of higher requests.
 * `req_dry_run()` and `req_verbose()` now do a better job of displaying compressed bodies (#91, #656).

R/req-perform.R

@@ -137,12 +137,7 @@
 
 handle_resp <- function(req, resp, error_call = caller_env()) {
   if (resp_show_body(resp)) {
-    show_body(
-      resp$body,
-      resp$headers$`content-type`,
-      prefix = "<< ",
-      pretty_json = getOption("httr2_pretty_json", TRUE)
-    )
+    verbose_body("<< ", resp$body, resp$headers$`content-type`)
   }
 
   if (is_error(resp)) {
@@ -248,6 +243,10 @@
   req <- auth_sign(req)
   req <- req_method_apply(req)
   req <- req_body_apply(req)
+
+  # Save actually request headers so that req_verbose() can use them
+  req$state$headers <- req$headers
+
   req
 }
 req_handle <- function(req) {

R/req-verbose.R

@@ -1,4 +1,3 @@
-
 #' Show extra output when request is performed
 #'
 #' @description
@@ -48,49 +47,34 @@
   # force all arguments
   list(header_req, header_resp, body_req, body_resp, info, redact_headers)
 
-  to_redact <- attr(req$headers, "redact")
   debug <- function(type, msg) {
-    switch(verbose_enum(type),
-      text =       if (info)        verbose_message("*  ", msg),
-      header_in =  if (header_resp) verbose_header("<- ", msg),
-      header_out = if (header_req)  verbose_header("-> ", msg, redact_headers, to_redact = to_redact),
-      data_in =    NULL, # displayed in handle_resp()
-      data_out =   if (body_req)    verbose_message(">> ", msg)
-    )
+    # Set in req_prepare()
+    headers <- req$state$headers
+
+    if (info && type == 0) {
+      verbose_info("*  ", msg)
+    } else if (header_resp && type == 1) {
+      verbose_header("<- ", msg)
+    } else if (header_req && type == 2) {
+      to_redact <- attr(headers, "redact")
+      verbose_header("-> ", msg, redact_headers, to_redact = to_redact)
+    } else if (body_resp && type == 3) {
+      # handled in handle_resp()
+    } else if (body_req && type == 4) {
+      verbose_body(">> ", msg, headers$`content-type`)
+    }
   }
   req <- req_options(req, debugfunction = debug, verbose = TRUE)
   req <- req_policies(req, show_body = body_resp)
   req
 }
 
-verbose_enum <- function(i) {
-  if (i < 0 || i > 6) {
-    cli::cli_warn("Unknown verbosity level {i}")
-  }
-
-  switch(i + 1,
-    "text",
-    "header_in",
-    "header_out",
-    "data_in",
-    "data_out",
-    "ssl_data_in",
-    "ssl_data_out"
-  )
-}
-
 # helpers -----------------------------------------------------------------
 
-verbose_message <- function(prefix, x) {
-  if (any(x > 128)) {
-    # This doesn't handle unicode, but it seems like most output
-    # will be compressed in some way, so displaying bodies is unlikely
-    # to be useful anyway.
-    lines <- paste0(length(x), " bytes of binary data")
-  } else {
-    x <- readBin(x, character())
-    lines <- unlist(strsplit(x, "\r?\n", useBytes = TRUE))
-  }
+verbose_info <- function(prefix, x) {
+  x <- readBin(x, character())
+  lines <- unlist(strsplit(x, "\r?\n", useBytes = TRUE))
+
   cli::cat_line(prefix, lines)
 }
 
@@ -101,13 +85,22 @@
   for (line in lines) {
     if (grepl("^[-a-zA-z0-9]+:", line)) {
       header <- headers_redact(as_headers(line, to_redact), redact)
-      cli::cat_line(prefix, cli::style_bold(names(header)), ": ", header)
+      cli::cat_line(prefix, cli::style_bold(names(header)), ": ", format(header[[1]]))
     } else {
       cli::cat_line(prefix, line)
     }
   }
 }
 
+verbose_body <- function(prefix, x, content_type) {
+  show_body(
+    x,
+    content_type,
+    prefix = prefix,
+    pretty_json = getOption("httr2_pretty_json", TRUE)
+  )
+}
+
 # Testing helpers -------------------------------------------------------------
 
 req_verbose_test <- function(req) {

R/req.R

@@ -53,7 +53,8 @@ new_request <- function(url,
       body = body,
       fields = fields,
       options = options,
-      policies = policies
+      policies = policies,
+      state = new_environment()
     ),
     class = "httr2_request"
   )

tests/testthat/_snaps/req-verbose.md

@@ -18,10 +18,21 @@
     Output
       -> POST /test HTTP/1.1
       -> Host: http://example.com
+      -> Content-Type: text/plain
       -> Content-Length: 17
       -> 
       >> This is some text
 
+# redacts headers as needed
+
+    Code
+      . <- req_perform(req)
+    Output
+      -> GET / HTTP/1.1
+      -> Host: http://example.com
+      -> Authorization: <REDACTED>
+      -> 
+
 # can display compressed bodies
 
     Code
@@ -57,7 +68,7 @@
       <<   "gzipped": true
       << }
 
-# json is automatically prettified
+# response json is automatically prettified
 
     Code
       . <- req_perform(req)
@@ -78,11 +89,24 @@
     Output
       << {"foo":"bar","baz":[1,2,3]}
 
-# verbose_enum checks range
+# request json is automatically prettified
 
     Code
-      verbose_enum(7)
-    Condition
-      Warning:
-      Unknown verbosity level 7
+      . <- req_perform(req)
+    Output
+      >> {
+      >>   "foo": "bar",
+      >>   "baz": [
+      >>     1,
+      >>     2,
+      >>     3
+      >>   ]
+      >> }
+
+---
+
+    Code
+      . <- req_perform(req)
+    Output
+      >> {"foo":"bar","baz":[1,2,3]}
 

tests/testthat/test-req-verbose.R

@@ -4,7 +4,7 @@ test_that("can request verbose record of request", {
     res$send_json(list(x = 1), auto_unbox = TRUE)
   })
   req <- req %>%
-    req_body_raw("This is some text") %>%
+    req_body_raw("This is some text", "text/plain") %>%
     req_verbose_test()
 
   # Snapshot test of response
@@ -20,6 +20,15 @@ test_that("can request verbose record of request", {
   expect_output(. <- req_perform(verbose_info))
 })
 
+test_that("redacts headers as needed", {
+  req <- request(example_url()) %>%
+    req_verbose_test() %>%
+    req_verbose(header_req = TRUE, header_resp = FALSE) %>%
+    req_headers_redacted(Authorization = "abc")
+
+  expect_snapshot(. <- req_perform(req))
+})
+
 test_that("can display compressed bodies", {
   req <- request(example_url()) %>%
     req_url_path("gzip") %>%
@@ -29,7 +38,7 @@ test_that("can display compressed bodies", {
   expect_snapshot(. <- req_perform(req), transform = transform_verbose_response)
 })
 
-test_that("json is automatically prettified", {
+test_that("response json is automatically prettified", {
   req <- local_app_request(function(req, res) {
     res$set_header("Content-Type", "application/json")
     res$send('{"foo":"bar","baz":[1,2,3]}')
@@ -38,16 +47,21 @@ test_that("json is automatically prettified", {
   req <- req %>%
     req_verbose_test() %>%
     req_verbose(body_resp = TRUE, header_resp = FALSE, header_req = FALSE)
-
   expect_snapshot(. <- req_perform(req))
 
   # Unless we opt-out
   local_options(httr2_pretty_json = FALSE)
   expect_snapshot(. <- req_perform(req))
 })
 
-test_that("verbose_enum checks range", {
-  expect_snapshot({
-    verbose_enum(7)
-  })
+test_that("request json is automatically prettified", {
+  req <- request(example_url("/post")) %>%
+    req_verbose_test() %>%
+    req_body_json(list(foo = "bar", baz = c(1, 2, 3))) %>%
+    req_verbose(body_req = TRUE, header_resp = FALSE, header_req = FALSE)
+  expect_snapshot(. <- req_perform(req))
+
+  # Unless we opt-out
+  local_options(httr2_pretty_json = FALSE)
+  expect_snapshot(. <- req_perform(req))
 })