|
| 1 | + |
| 2 | +#' Show extra output when request is performed |
| 3 | +#' |
| 4 | +#' @description |
| 5 | +#' `req_verbose()` uses the following prefixes to distinguish between |
| 6 | +#' different components of the HTTP requests and responses: |
| 7 | +#' |
| 8 | +#' * `* ` informative curl messages |
| 9 | +#' * `->` request headers |
| 10 | +#' * `>>` request body |
| 11 | +#' * `<-` response headers |
| 12 | +#' * `<<` response body |
| 13 | +#' |
| 14 | +#' @inheritParams req_perform |
| 15 | +#' @param header_req,header_resp Show request/response headers? |
| 16 | +#' @param body_req,body_resp Should request/response bodies? When the response |
| 17 | +#' body is compressed, this will show the number of bytes received in |
| 18 | +#' each "chunk". |
| 19 | +#' @param info Show informational text from curl? This is mainly useful |
| 20 | +#' for debugging https and auth problems, so is disabled by default. |
| 21 | +#' @param redact_headers Redact confidential data in the headers? Currently |
| 22 | +#' redacts the contents of the Authorization header to prevent you from |
| 23 | +#' accidentally leaking credentials when debugging/reprexing. |
| 24 | +#' @seealso [req_perform()] which exposes a limited subset of these options |
| 25 | +#' through the `verbosity` argument and [with_verbosity()] which allows you |
| 26 | +#' to control the verbosity of requests deeper within the call stack. |
| 27 | +#' @returns A modified HTTP [request]. |
| 28 | +#' @export |
| 29 | +#' @examples |
| 30 | +#' # Use `req_verbose()` to see the headers that are sent back and forth when |
| 31 | +#' # making a request |
| 32 | +#' resp <- request("https://httr2.r-lib.org") |> |
| 33 | +#' req_verbose() |> |
| 34 | +#' req_perform() |
| 35 | +#' |
| 36 | +#' # Or use one of the convenient shortcuts: |
| 37 | +#' resp <- request("https://httr2.r-lib.org") |> |
| 38 | +#' req_perform(verbosity = 1) |
| 39 | +req_verbose <- function(req, |
| 40 | + header_req = TRUE, |
| 41 | + header_resp = TRUE, |
| 42 | + body_req = FALSE, |
| 43 | + body_resp = FALSE, |
| 44 | + info = FALSE, |
| 45 | + redact_headers = TRUE) { |
| 46 | + check_request(req) |
| 47 | + |
| 48 | + to_redact <- attr(req$headers, "redact") |
| 49 | + debug <- function(type, msg) { |
| 50 | + switch(type + 1, |
| 51 | + text = if (info) verbose_message("* ", msg), |
| 52 | + headerOut = if (header_resp) verbose_header("<- ", msg), |
| 53 | + headerIn = if (header_req) verbose_header("-> ", msg, redact_headers, to_redact = to_redact), |
| 54 | + dataOut = NULL, # displayed in handle_resp() |
| 55 | + dataIn = if (body_req) verbose_message(">> ", msg) |
| 56 | + ) |
| 57 | + } |
| 58 | + req <- req_policies(req, show_body = body_resp) |
| 59 | + req <- req_options(req, debugfunction = debug, verbose = TRUE) |
| 60 | + req |
| 61 | +} |
| 62 | + |
| 63 | +# helpers ----------------------------------------------------------------- |
| 64 | + |
| 65 | +verbose_message <- function(prefix, x) { |
| 66 | + if (any(x > 128)) { |
| 67 | + # This doesn't handle unicode, but it seems like most output |
| 68 | + # will be compressed in some way, so displaying bodies is unlikely |
| 69 | + # to be useful anyway. |
| 70 | + lines <- paste0(length(x), " bytes of binary data") |
| 71 | + } else { |
| 72 | + x <- readBin(x, character()) |
| 73 | + lines <- unlist(strsplit(x, "\r?\n", useBytes = TRUE)) |
| 74 | + } |
| 75 | + cli::cat_line(prefix, lines) |
| 76 | +} |
| 77 | + |
| 78 | +verbose_header <- function(prefix, x, redact = TRUE, to_redact = NULL) { |
| 79 | + x <- readBin(x, character()) |
| 80 | + lines <- unlist(strsplit(x, "\r?\n", useBytes = TRUE)) |
| 81 | + |
| 82 | + for (line in lines) { |
| 83 | + if (grepl("^[-a-zA-z0-9]+:", line)) { |
| 84 | + header <- headers_redact(as_headers(line), redact, to_redact = to_redact) |
| 85 | + cli::cat_line(prefix, cli::style_bold(names(header)), ": ", header) |
| 86 | + } else { |
| 87 | + cli::cat_line(prefix, line) |
| 88 | + } |
| 89 | + } |
| 90 | +} |
| 91 | + |
| 92 | +# Testing helpers ------------------------------------------------------------- |
| 93 | + |
| 94 | +# Reset all headers that otherwise might vary |
| 95 | +req_headers_reset <- function(req) { |
| 96 | + req_headers(req, `Accept-Encoding` = "", Host = "http://example.com", `User-Agent` = "") |
| 97 | +} |
| 98 | + |
| 99 | +transform_resp_headers <- function(lines) { |
| 100 | + lines <- gsub(example_url(), "<webfakes>", lines, fixed = TRUE) |
| 101 | + lines <- lines[!grepl("^<- (Date|ETag|Content-Length):", lines)] |
| 102 | + lines |
| 103 | +} |
0 commit comments