File: req-headers.R

package info (click to toggle)
r-cran-httr2 1.2.2-1
  • links: PTS, VCS
  • area: main
  • in suites: sid
  • size: 1,684 kB
  • sloc: sh: 13; makefile: 2
file content (131 lines) | stat: -rw-r--r-- 3,949 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
#' Modify request headers
#'
#' @description
#' `req_headers()` allows you to set the value of any header.
#'
#' `req_headers_redacted()` is a variation that adds "redacted" headers, which
#' httr2 avoids printing on the console. This is good practice for
#' authentication headers to avoid accidentally leaking them in log files.
#'
#' @param .req A [request].
#' @param ... <[`dynamic-dots`][rlang::dyn-dots]> Name-value pairs of headers
#'   and their values.
#'
#'   * Use `NULL` to reset a value to httr2's default.
#'   * Use `""` to remove a header.
#'   * Use a character vector to repeat a header.
#' @param .redact A character vector of headers to redact. The Authorization
#'   header is always redacted.
#' @returns A modified HTTP [request].
#' @export
#' @examples
#' req <- request("http://example.com")
#'
#' # Use req_headers() to add arbitrary additional headers to the request
#' req |>
#'   req_headers(MyHeader = "MyValue") |>
#'   req_dry_run()
#'
#' # Repeated use overrides the previous value:
#' req |>
#'   req_headers(MyHeader = "Old value") |>
#'   req_headers(MyHeader = "New value") |>
#'   req_dry_run()
#'
#' # Setting Accept to NULL uses curl's default:
#' req |>
#'   req_headers(Accept = NULL) |>
#'   req_dry_run()
#'
#' # Setting it to "" removes it:
#' req |>
#'   req_headers(Accept = "") |>
#'   req_dry_run()
#'
#' # If you need to repeat a header, provide a vector of values
#' # (this is rarely needed, but is important in a handful of cases)
#' req |>
#'   req_headers(HeaderName = c("Value 1", "Value 2", "Value 3")) |>
#'   req_dry_run()
#'
#' # If you have headers in a list, use !!!
#' headers <- list(HeaderOne = "one", HeaderTwo = "two")
#' req |>
#'   req_headers(!!!headers, HeaderThree = "three") |>
#'   req_dry_run()
#'
#' # Use `req_headers_redacted()`` to hide a header in the output
#' req_secret <- req |>
#'   req_headers_redacted(Secret = "this-is-private") |>
#'   req_headers(Public = "but-this-is-not")
#'
#' req_secret
#' req_secret |> req_dry_run()
req_headers <- function(.req, ..., .redact = NULL) {
  check_request(.req)
  check_character(.redact, allow_null = TRUE)
  check_header_values(...)

  headers <- modify_list(.req$headers, ..., .ignore_case = TRUE)
  redact <- c("Authorization", .redact, which_redacted(.req$headers))
  .req$headers <- new_headers(headers, redact, lifespan = .req$state)

  .req
}

#' @export
#' @rdname req_headers
req_headers_redacted <- function(.req, ...) {
  check_request(.req)

  headers <- list2(...)
  req_headers(.req, !!!headers, .redact = names(headers))
}

check_header_values <- function(..., error_call = caller_env()) {
  dots <- list2(...)

  type_ok <- map_lgl(dots, function(x) is_atomic(x) || is.null(x))
  if (any(!type_ok)) {
    cli::cli_abort(
      "All elements of {.arg ...} must be either an atomic vector or NULL.",
      call = error_call
    )
  }

  invisible()
}

#' Get request headers
#'
#' Retrieve custom headers set on the request. Use [req_dry_run()] to get all
#' headers, including those automatically generated by curl.
#'
#' @inheritParams req_perform
#' @param redacted What to do with redacted headers?
#'   * `"drop"` (the default) drops them.
#'   * `"redact"` replaces them with `<REDACTED>`.
#'   * `"reveal"` leaves them in place.
#' @returns A named list.
#' @export
#' @examples
#' req <- request("http://example.com")
#' req <- req_headers(req, a = 1L, b = 2L, .redact = "a")
#'
#' req_get_headers(req, "drop")
#' req_get_headers(req, "redact")
#' req_get_headers(req, "reveal")
req_get_headers <- function(req, redacted = c("drop", "redact", "reveal")) {
  check_request(req)
  redacted <- arg_match(redacted)

  headers <- req$headers
  headers <- headers[!is_redacted_empty(headers)]

  if (redacted == "drop") {
    headers <- headers[!is_redacted(headers)]
  } else if (redacted == "redact") {
    headers[is_redacted(headers)] <- "<REDACTED>"
  }
  headers_flatten(headers, redact = FALSE)
}