File: req-options.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 (159 lines) | stat: -rw-r--r-- 4,353 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
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
#' Set arbitrary curl options in request
#'
#' `req_options()` is for expert use only; it allows you to directly set
#' libcurl options to access features that are otherwise not available in
#' httr2.
#'
#' @inheritParams req_headers
#' @param ... <[`dynamic-dots`][rlang::dyn-dots]> Name-value pairs. The name
#'   should be a valid curl option, as found in [curl::curl_options()].
#' @returns A modified HTTP [request].
#' @export
#' @examples
#' # req_options() allows you to access curl options that are not otherwise
#' # exposed by httr2. For example, in very special cases you may need to
#' # turn off SSL verification. This is generally a bad idea so httr2 doesn't
#' # provide a convenient wrapper, but if you really know what you're doing
#' # you can still access this libcurl option:
#' req <- request("https://example.com") |>
#'   req_options(ssl_verifypeer = 0)
req_options <- function(.req, ...) {
  check_request(.req)

  .req$options <- modify_list(.req$options, ...)
  .req
}

#' Set user-agent for a request
#'
#' This overrides the default user-agent set by httr2 which includes the
#' version numbers of httr2, the curl package, and libcurl.
#'
#' @inheritParams req_perform
#' @param string String to be sent in the `User-Agent` header. If `NULL`,
#'   will user default.
#' @returns A modified HTTP [request].
#' @export
#' @examples
#' # Default user-agent:
#' request("http://example.com") |> req_dry_run()
#'
#' request("http://example.com") |> req_user_agent("MyString") |> req_dry_run()
#'
#' # If you're wrapping in an API in a package, it's polite to set the
#' # user agent to identify your package.
#' request("http://example.com") |>
#'   req_user_agent("MyPackage (http://mypackage.com)") |>
#'   req_dry_run()
req_user_agent <- function(req, string = NULL) {
  check_request(req)

  if (is.null(string)) {
    string <- env_cache(the, "user_agent", default_user_agent())
  } else {
    check_string(string)
  }

  req_options(req, useragent = string)
}

default_user_agent <- function() {
  versions <- c(
    httr2 = as.character(utils::packageVersion("httr2")),
    `r-curl` = as.character(utils::packageVersion("curl")),
    libcurl = curl_system_version()
  )
  paste0(names(versions), "/", versions, collapse = " ")
}

req_has_user_agent <- function(req) {
  has_name(req$options, "useragent")
}

curl_system_version <- function() curl::curl_version()$version

#' Set time limit for a request
#'
#' An error will be thrown if the request does not complete in the time limit.
#'
#' @inheritParams req_perform
#' @param seconds Maximum number of seconds to wait
#' @returns A modified HTTP [request].
#' @export
#' @examples
#' # Give up after at most 10 seconds
#' request("http://example.com") |> req_timeout(10)
req_timeout <- function(req, seconds) {
  check_request(req)
  check_number_decimal(seconds)
  if (seconds < 0.001) {
    cli::cli_abort("{.arg seconds} must be >1 ms.")
  }

  req_options(
    req,
    timeout_ms = seconds * 1000,
    # reset value set by curl
    # https://github.com/jeroen/curl/blob/1bcf1ab3/src/handle.c#L159
    connecttimeout = 0
  )
}


#' Use a proxy for a request
#'
#' @inheritParams req_perform
#' @param url,port Location of proxy.
#' @param username,password Login details for proxy, if needed.
#' @param auth Type of HTTP authentication to use. Should be one of the
#'   following: `basic`, `digest`, `digest_ie`, `gssnegotiate`, `ntlm`, `any`.
#' @examples
#' # Proxy from https://www.proxynova.com/proxy-server-list/
#' \dontrun{
#' request("http://hadley.nz") |>
#'   req_proxy("20.116.130.70", 3128) |>
#'   req_perform()
#' }
#' @export
req_proxy <- function(
  req,
  url,
  port = NULL,
  username = NULL,
  password = NULL,
  auth = "basic"
) {
  if (!is.null(username) || !is.null(password)) {
    proxyuserpwd <- paste0(username, ":", password)
  } else {
    proxyuserpwd <- NULL
  }

  check_number_whole(port, allow_null = TRUE)

  req_options(
    req,
    proxy = url,
    proxyport = port,
    proxyuserpwd = proxyuserpwd,
    proxyauth = auth_flags(auth)
  )
}

auth_flags <- function(x = "basic") {
  constants <- c(
    basic = 1,
    digest = 2,
    gssnegotiate = 4,
    ntlm = 8,
    digest_ie = 16,
    any = -17
  )
  idx <- arg_match0(
    x,
    names(constants),
    arg_nm = "auth",
    error_call = caller_env()
  )
  constants[[idx]]
}