From 711cfb1551544bd775af0fb71cf4ef9226c4ee5e Mon Sep 17 00:00:00 2001 From: Hadley Wickham Date: Thu, 27 Mar 2025 11:20:54 -0500 Subject: [PATCH] Use air for formatting --- .Rbuildignore | 2 + .vscode/extensions.json | 3 + .vscode/settings.json | 6 ++ R/content-type.R | 25 +++--- R/curl.R | 25 ++++-- R/iterate-helpers.R | 12 +-- R/jwt.R | 18 ++-- R/oauth-client.R | 60 ++++++++----- R/oauth-flow-auth-code.R | 92 ++++++++++--------- R/oauth-flow-client-credentials.R | 22 +++-- R/oauth-flow-device.R | 69 ++++++++------ R/oauth-flow-jwt.R | 34 +++---- R/oauth-flow-password.R | 38 ++++---- R/oauth-flow-refresh.R | 26 +++--- R/oauth-flow-token-exchange.R | 46 +++++----- R/oauth-flow.R | 10 ++- R/oauth-token.R | 27 +++--- R/oauth.R | 31 ++++--- R/pooled-request.R | 2 - R/req-auth-aws.R | 94 +++++++++++--------- R/req-auth-sign.R | 7 +- R/req-body.R | 41 +++++---- R/req-cache.R | 62 +++++++++---- R/req-dry-run.R | 12 +-- R/req-error.R | 4 +- R/req-headers.R | 4 +- R/req-method.R | 3 +- R/req-options.R | 17 +++- R/req-perform-connection.R | 9 +- R/req-perform-iterative.R | 38 ++++---- R/req-perform-parallel.R | 18 ++-- R/req-perform-sequential.R | 51 ++++++----- R/req-perform-stream.R | 21 +++-- R/req-perform.R | 22 +++-- R/req-progress.R | 10 +-- R/req-promise.R | 16 ++-- R/req-retries.R | 41 +++++---- R/req-template.R | 24 +++-- R/req-throttle.R | 6 +- R/req-url.R | 10 ++- R/req-verbose.R | 23 +++-- R/req.R | 33 ++++--- R/resp-body.R | 19 +++- R/resp-headers.R | 9 +- R/resp-stream-aws.R | 11 ++- R/resp-stream.R | 56 ++++++++---- R/resp.R | 49 +++++----- R/roxygen2.R | 21 +++-- R/test.R | 4 +- R/url.R | 66 +++++++++----- R/utils-multi.R | 40 +++++++-- R/utils.R | 63 ++++++++----- air.toml | 0 tests/testthat/helper-sync.R | 20 ++++- tests/testthat/test-content-type.R | 22 ++++- tests/testthat/test-curl.R | 46 +++++++--- tests/testthat/test-headers.R | 2 +- tests/testthat/test-oauth-client.R | 21 +++-- tests/testthat/test-oauth-flow-auth-code.R | 13 +-- tests/testthat/test-oauth-flow-jwt.R | 12 ++- tests/testthat/test-oauth-flow.R | 5 +- tests/testthat/test-oauth.R | 5 +- tests/testthat/test-parse.R | 4 +- tests/testthat/test-req-auth-aws.R | 16 +++- tests/testthat/test-req-body.R | 6 +- tests/testthat/test-req-cache.R | 54 +++++++---- tests/testthat/test-req-cookies.R | 1 - tests/testthat/test-req-headers.R | 5 +- tests/testthat/test-req-mock.R | 3 +- tests/testthat/test-req-perform-connection.R | 8 +- tests/testthat/test-req-perform-iterative.R | 26 +++++- tests/testthat/test-req-perform-parallel.R | 31 ++++--- tests/testthat/test-req-perform.R | 15 ++-- tests/testthat/test-req-promise.R | 28 ++++-- tests/testthat/test-req-retries.R | 2 +- tests/testthat/test-req-throttle.R | 2 +- tests/testthat/test-req-url.R | 92 +++++++++++++++---- tests/testthat/test-req-verbose.R | 17 ++-- tests/testthat/test-req.R | 2 +- tests/testthat/test-resp-body.R | 3 +- tests/testthat/test-resp-headers.R | 36 ++++---- tests/testthat/test-resp-status.R | 10 ++- tests/testthat/test-resp-stream-aws.R | 28 ++++-- tests/testthat/test-resp-stream.R | 31 +++++-- tests/testthat/test-resp.R | 1 - tests/testthat/test-secret.R | 6 +- tests/testthat/test-url.R | 15 +++- 87 files changed, 1316 insertions(+), 724 deletions(-) create mode 100644 .vscode/extensions.json create mode 100644 .vscode/settings.json create mode 100644 air.toml diff --git a/.Rbuildignore b/.Rbuildignore index d74d59274..8bb142692 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -12,3 +12,5 @@ ^CRAN-RELEASE$ ^revdep$ ^CRAN-SUBMISSION$ +^[\.]?air\.toml$ +^\.vscode$ diff --git a/.vscode/extensions.json b/.vscode/extensions.json new file mode 100644 index 000000000..62febe27a --- /dev/null +++ b/.vscode/extensions.json @@ -0,0 +1,3 @@ +{ + "recommendations": ["Posit.air-vscode"] +} diff --git a/.vscode/settings.json b/.vscode/settings.json new file mode 100644 index 000000000..4898cd918 --- /dev/null +++ b/.vscode/settings.json @@ -0,0 +1,6 @@ +{ + "[r]": { + "editor.formatOnSave": true, + "editor.defaultFormatter": "Posit.air-vscode" + } +} diff --git a/R/content-type.R b/R/content-type.R index 274c6e215..690dffe12 100644 --- a/R/content-type.R +++ b/R/content-type.R @@ -21,12 +21,13 @@ #' #' # `types` can also specify multiple valid types #' resp_check_content_type(resp, c("application/xml", "application/json")) -resp_check_content_type <- function(resp, - valid_types = NULL, - valid_suffix = NULL, - check_type = TRUE, - call = caller_env()) { - +resp_check_content_type <- function( + resp, + valid_types = NULL, + valid_suffix = NULL, + check_type = TRUE, + call = caller_env() +) { check_response(resp) check_character(valid_types, allow_null = TRUE) check_string(valid_suffix, allow_null = TRUE) @@ -89,11 +90,13 @@ parse_content_type <- function(x) { ) } -check_content_type <- function(content_type, - valid_types = NULL, - valid_suffix = NULL, - inform_check_type = FALSE, - call = caller_env()) { +check_content_type <- function( + content_type, + valid_types = NULL, + valid_suffix = NULL, + inform_check_type = FALSE, + call = caller_env() +) { parsed <- parse_content_type(content_type) base_type <- paste0(parsed$type, "/", parsed$subtype) diff --git a/R/curl.R b/R/curl.R index 3d6a7ff5b..f63f4c0e9 100644 --- a/R/curl.R +++ b/R/curl.R @@ -58,7 +58,11 @@ curl_translate <- function(cmd, simplify_headers = TRUE) { cookies <- data$headers$`Cookie` data$headers$`Cookie` <- NULL if (!is.null(cookies)) { - steps <- add_curl_step(steps, "req_cookies_set", dots = cookies_parse(cookies)) + steps <- add_curl_step( + steps, + "req_cookies_set", + dots = cookies_parse(cookies) + ) } # Content type set with data @@ -88,7 +92,12 @@ curl_translate <- function(cmd, simplify_headers = TRUE) { if (data$verbose) { perform_args$verbosity <- 1 } - steps <- add_curl_step(steps, "req_perform", main_args = perform_args, keep_if_empty = TRUE) + steps <- add_curl_step( + steps, + "req_perform", + main_args = perform_args, + keep_if_empty = TRUE + ) out <- paste0(steps, collapse = paste0(pipe(), "\n ")) if (clip) { @@ -280,11 +289,13 @@ quote_name <- function(x) { ifelse(is_syntactic(x), x, encodeString(x, quote = "`")) } -add_curl_step <- function(steps, - f, - main_args = NULL, - dots = NULL, - keep_if_empty = FALSE) { +add_curl_step <- function( + steps, + f, + main_args = NULL, + dots = NULL, + keep_if_empty = FALSE +) { args <- c(main_args, dots) if (is_empty(args) && !keep_if_empty) { diff --git a/R/iterate-helpers.R b/R/iterate-helpers.R index 95a55a999..f8a076974 100644 --- a/R/iterate-helpers.R +++ b/R/iterate-helpers.R @@ -55,11 +55,13 @@ #' max_reqs = Inf #' ) #' } -iterate_with_offset <- function(param_name, - start = 1, - offset = 1, - resp_pages = NULL, - resp_complete = NULL) { +iterate_with_offset <- function( + param_name, + start = 1, + offset = 1, + resp_pages = NULL, + resp_complete = NULL +) { check_string(param_name) check_number_whole(start) check_number_whole(offset, min = 1) diff --git a/R/jwt.R b/R/jwt.R index 40b95a553..faa4b27d0 100644 --- a/R/jwt.R +++ b/R/jwt.R @@ -27,14 +27,16 @@ #' @examples #' claim <- jwt_claim() #' str(claim) -jwt_claim <- function(iss = NULL, - sub = NULL, - aud = NULL, - exp = unix_time() + 5L * 60L, - nbf = unix_time(), - iat = unix_time(), - jti = NULL, - ...) { +jwt_claim <- function( + iss = NULL, + sub = NULL, + aud = NULL, + exp = unix_time() + 5L * 60L, + nbf = unix_time(), + iat = unix_time(), + jti = NULL, + ... +) { # https://datatracker.ietf.org/doc/html/rfc7519 jose::jwt_claim( iss = iss, diff --git a/R/oauth-client.R b/R/oauth-client.R index b657e4d9d..7b63d8bd3 100644 --- a/R/oauth-client.R +++ b/R/oauth-client.R @@ -40,15 +40,14 @@ #' @examples #' oauth_client("myclient", "http://example.com/token_url", secret = "DONTLOOK") oauth_client <- function( - id, - token_url, - secret = NULL, - key = NULL, - auth = c("body", "header", "jwt_sig"), - auth_params = list(), - name = hash(id) - ) { - + id, + token_url, + secret = NULL, + key = NULL, + auth = c("body", "header", "jwt_sig"), + auth_params = list(), + name = hash(id) +) { check_string(id) check_string(token_url) check_string(secret, allow_null = TRUE) @@ -66,7 +65,9 @@ oauth_client <- function( cli::cli_abort("{.code auth = 'jwt_sig'} requires a {.arg key}.") } if (!has_name(auth_params, "claim")) { - cli::cli_abort("{.code auth = 'jwt_sig'} requires a claim specification in {.arg auth_params}.") + cli::cli_abort( + "{.code auth = 'jwt_sig'} requires a claim specification in {.arg auth_params}." + ) } } @@ -167,7 +168,8 @@ oauth_client_req_auth <- function(req, client) { #' @export #' @rdname oauth_client_req_auth oauth_client_req_auth_header <- function(req, client) { - req_auth_basic(req, + req_auth_basic( + req, username = client$id, password = unobfuscate(client$secret) ) @@ -176,7 +178,8 @@ oauth_client_req_auth_header <- function(req, client) { #' @export #' @rdname oauth_client_req_auth oauth_client_req_auth_body <- function(req, client) { - req_body_form(req, + req_body_form( + req, client_id = client$id, client_secret = unobfuscate(client$secret) # might be NULL ) @@ -185,12 +188,19 @@ oauth_client_req_auth_body <- function(req, client) { #' @inheritParams jwt_claim #' @export #' @rdname oauth_client_req_auth -oauth_client_req_auth_jwt_sig <- function(req, client, claim, size = 256, header = list()) { +oauth_client_req_auth_jwt_sig <- function( + req, + client, + claim, + size = 256, + header = list() +) { claim <- exec("jwt_claim", !!!claim) jwt <- jwt_encode_sig(claim, key = client$key, size = size, header = header) # https://datatracker.ietf.org/doc/html/rfc7523#section-2.2 - req_body_form(req, + req_body_form( + req, client_assertion = jwt, client_assertion_type = "urn:ietf:params:oauth:client-assertion-type:jwt-bearer" ) @@ -198,11 +208,13 @@ oauth_client_req_auth_jwt_sig <- function(req, client, claim, size = 256, header # Helpers ----------------------------------------------------------------- -oauth_flow_check <- function(flow, client, - is_confidential = FALSE, - interactive = FALSE, - error_call = caller_env()) { - +oauth_flow_check <- function( + flow, + client, + is_confidential = FALSE, + interactive = FALSE, + error_call = caller_env() +) { if (!inherits(client, "httr2_oauth_client")) { cli::cli_abort( "{.arg client} must be an OAuth client created with {.fn oauth_client}.", @@ -228,10 +240,12 @@ oauth_flow_check <- function(flow, client, } } -oauth_client_get_token <- function(client, - grant_type, - ..., - error_call = caller_env()) { +oauth_client_get_token <- function( + client, + grant_type, + ..., + error_call = caller_env() +) { req <- request(client$token_url) req <- req_body_form(req, grant_type = grant_type, ...) req <- oauth_client_req_auth(req, client) diff --git a/R/oauth-flow-auth-code.R b/R/oauth-flow-auth-code.R index a381b0279..5aec478fc 100644 --- a/R/oauth-flow-auth-code.R +++ b/R/oauth-flow-auth-code.R @@ -97,20 +97,21 @@ #' #' request("https://api.github.com/user") |> #' req_auth_github() -req_oauth_auth_code <- function(req, - client, - auth_url, - scope = NULL, - pkce = TRUE, - auth_params = list(), - token_params = list(), - redirect_uri = oauth_redirect_uri(), - cache_disk = FALSE, - cache_key = NULL, - host_name = deprecated(), - host_ip = deprecated(), - port = deprecated()) { - +req_oauth_auth_code <- function( + req, + client, + auth_url, + scope = NULL, + pkce = TRUE, + auth_params = list(), + token_params = list(), + redirect_uri = oauth_redirect_uri(), + cache_disk = FALSE, + cache_key = NULL, + host_name = deprecated(), + host_ip = deprecated(), + port = deprecated() +) { redirect <- normalize_redirect_uri( redirect_uri = redirect_uri, host_name = host_name, @@ -134,18 +135,18 @@ req_oauth_auth_code <- function(req, #' @export #' @rdname req_oauth_auth_code -oauth_flow_auth_code <- function(client, - auth_url, - scope = NULL, - pkce = TRUE, - auth_params = list(), - token_params = list(), - redirect_uri = oauth_redirect_uri(), - host_name = deprecated(), - host_ip = deprecated(), - port = deprecated() +oauth_flow_auth_code <- function( + client, + auth_url, + scope = NULL, + pkce = TRUE, + auth_params = list(), + token_params = list(), + redirect_uri = oauth_redirect_uri(), + host_name = deprecated(), + host_ip = deprecated(), + port = deprecated() ) { - oauth_flow_check("authorization code", client, interactive = TRUE) redirect <- normalize_redirect_uri( @@ -165,7 +166,8 @@ oauth_flow_auth_code <- function(client, state <- base64_url_rand(32) # Redirect user to authorisation url. - user_url <- oauth_flow_auth_code_url(client, + user_url <- oauth_flow_auth_code_url( + client, auth_url = auth_url, redirect_uri = redirect$uri, scope = scope, @@ -195,7 +197,8 @@ oauth_flow_auth_code <- function(client, # Get access/refresh token from authorisation code # https://datatracker.ietf.org/doc/html/rfc6749#section-4.1.3 - oauth_client_get_token(client, + oauth_client_get_token( + client, grant_type = "authorization_code", code = code, redirect_uri = redirect_uri, @@ -203,12 +206,13 @@ oauth_flow_auth_code <- function(client, ) } -normalize_redirect_uri <- function(redirect_uri, - host_name = deprecated(), - host_ip = deprecated(), - port = deprecated(), - error_call = caller_env()) { - +normalize_redirect_uri <- function( + redirect_uri, + host_name = deprecated(), + host_ip = deprecated(), + port = deprecated(), + error_call = caller_env() +) { old <- parsed <- url_parse(redirect_uri) if (lifecycle::is_present(host_name)) { @@ -254,7 +258,6 @@ normalize_redirect_uri <- function(redirect_uri, localhost = localhost, can_fetch_code = can_fetch_oauth_code(redirect_uri) ) - } @@ -293,14 +296,17 @@ oauth_redirect_uri <- function() { #' verify that we're working with an authentication request that we created. #' (This is an unlikely threat for R packages since the webserver that #' listens for authorization responses is transient.) -oauth_flow_auth_code_url <- function(client, - auth_url, - redirect_uri = NULL, - scope = NULL, - state = NULL, - auth_params = list()) { +oauth_flow_auth_code_url <- function( + client, + auth_url, + redirect_uri = NULL, + scope = NULL, + state = NULL, + auth_params = list() +) { url <- url_parse(auth_url) - url$query <- modify_list(url$query, + url$query <- modify_list( + url$query, response_type = "code", client_id = client$id, redirect_uri = redirect_uri, @@ -313,7 +319,9 @@ oauth_flow_auth_code_url <- function(client, #' @export #' @rdname oauth_flow_auth_code_url -oauth_flow_auth_code_listen <- function(redirect_uri = "http://localhost:1410") { +oauth_flow_auth_code_listen <- function( + redirect_uri = "http://localhost:1410" +) { parsed <- url_parse(redirect_uri) port <- as.integer(parsed$port) path <- parsed$path %||% "/" diff --git a/R/oauth-flow-client-credentials.R b/R/oauth-flow-client-credentials.R index dbca970e0..9a6bfe740 100644 --- a/R/oauth-flow-client-credentials.R +++ b/R/oauth-flow-client-credentials.R @@ -24,11 +24,12 @@ #' #' request("https://example.com") |> #' req_auth() -req_oauth_client_credentials <- function(req, - client, - scope = NULL, - token_params = list()) { - +req_oauth_client_credentials <- function( + req, + client, + scope = NULL, + token_params = list() +) { params <- list( client = client, scope = scope, @@ -41,12 +42,15 @@ req_oauth_client_credentials <- function(req, #' @export #' @rdname req_oauth_client_credentials -oauth_flow_client_credentials <- function(client, - scope = NULL, - token_params = list()) { +oauth_flow_client_credentials <- function( + client, + scope = NULL, + token_params = list() +) { oauth_flow_check("client credentials", client, is_confidential = TRUE) - oauth_client_get_token(client, + oauth_client_get_token( + client, grant_type = "client_credentials", scope = scope, !!!token_params diff --git a/R/oauth-flow-device.R b/R/oauth-flow-device.R index a64a52ad7..5c7da5d6e 100644 --- a/R/oauth-flow-device.R +++ b/R/oauth-flow-device.R @@ -25,15 +25,16 @@ #' #' request("https://api.github.com/user") |> #' req_auth_github() -req_oauth_device <- function(req, - client, - auth_url, - scope = NULL, - auth_params = list(), - token_params = list(), - cache_disk = FALSE, - cache_key = NULL) { - +req_oauth_device <- function( + req, + client, + auth_url, + scope = NULL, + auth_params = list(), + token_params = list(), + cache_disk = FALSE, + cache_key = NULL +) { params <- list( client = client, auth_url = auth_url, @@ -47,12 +48,14 @@ req_oauth_device <- function(req, #' @export #' @rdname req_oauth_device -oauth_flow_device <- function(client, - auth_url, - pkce = FALSE, - scope = NULL, - auth_params = list(), - token_params = list()) { +oauth_flow_device <- function( + client, + auth_url, + pkce = FALSE, + scope = NULL, + auth_params = list(), + token_params = list() +) { oauth_flow_check("device", client, interactive = is_interactive()) if (pkce) { @@ -70,10 +73,14 @@ oauth_flow_device <- function(client, # Google uses verification_url instead of verification_uri # verification_uri_complete is optional, it would ship the user # code in the uri https://datatracker.ietf.org/doc/html/rfc8628#section-3.2 - url <- request$verification_uri_complete %||% request$verification_uri %||% request$verification_url + url <- request$verification_uri_complete %||% + request$verification_uri %||% + request$verification_url if (is_interactive()) { - cli::cli_alert("Copy {.strong {request$user_code}} and paste when requested by the browser") + cli::cli_alert( + "Copy {.strong {request$user_code}} and paste when requested by the browser" + ) readline("Press to proceed:") utils::browseURL(url) } else { @@ -91,11 +98,13 @@ oauth_flow_device <- function(client, # Device authorization request and response # https://datatracker.ietf.org/doc/html/rfc8628#section-3.1 # https://datatracker.ietf.org/doc/html/rfc8628#section-3.2 -oauth_flow_device_request <- function(client, - auth_url, - scope, - auth_params, - error_call = caller_env()) { +oauth_flow_device_request <- function( + client, + auth_url, + scope, + auth_params, + error_call = caller_env() +) { req <- request(auth_url) req <- req_body_form(req, scope = scope, !!!auth_params) req <- oauth_client_req_auth(req, client) @@ -106,10 +115,12 @@ oauth_flow_device_request <- function(client, # Device Access Token Request # https://datatracker.ietf.org/doc/html/rfc8628#section-3.4 -oauth_flow_device_poll <- function(client, - request, - token_params, - error_call = caller_env()) { +oauth_flow_device_poll <- function( + client, + request, + token_params, + error_call = caller_env() +) { cli::cli_progress_step("Waiting for response from server", spinner = TRUE) delay <- request$interval %||% 5 @@ -124,7 +135,8 @@ oauth_flow_device_poll <- function(client, tryCatch( { - token <- oauth_client_get_token(client, + token <- oauth_client_get_token( + client, grant_type = "urn:ietf:params:oauth:grant-type:device_code", device_code = request$device_code, !!!token_params, @@ -132,7 +144,8 @@ oauth_flow_device_poll <- function(client, ) break }, - httr2_oauth_authorization_pending = function(err) {}, + httr2_oauth_authorization_pending = function(err) { + }, httr2_oauth_slow_down = function(err) { delay <<- delay + 5 } diff --git a/R/oauth-flow-jwt.R b/R/oauth-flow-jwt.R index b37871451..edfb2576e 100644 --- a/R/oauth-flow-jwt.R +++ b/R/oauth-flow-jwt.R @@ -34,14 +34,15 @@ #' #' request("https://example.com") |> #' req_auth() -req_oauth_bearer_jwt <- function(req, - client, - claim, - signature = "jwt_encode_sig", - signature_params = list(), - scope = NULL, - token_params = list()) { - +req_oauth_bearer_jwt <- function( + req, + client, + claim, + signature = "jwt_encode_sig", + signature_params = list(), + scope = NULL, + token_params = list() +) { params <- list( client = client, claim = claim, @@ -57,12 +58,14 @@ req_oauth_bearer_jwt <- function(req, #' @export #' @rdname req_oauth_bearer_jwt -oauth_flow_bearer_jwt <- function(client, - claim, - signature = "jwt_encode_sig", - signature_params = list(), - scope = NULL, - token_params = list()) { +oauth_flow_bearer_jwt <- function( + client, + claim, + signature = "jwt_encode_sig", + signature_params = list(), + scope = NULL, + token_params = list() +) { check_installed("jose") if (is.null(client$key)) { cli::cli_abort("JWT flow requires {.arg client} with a key.") @@ -79,7 +82,8 @@ oauth_flow_bearer_jwt <- function(client, jwt <- exec(signature, claim = claim, key = client$key, !!!signature_params) # https://datatracker.ietf.org/doc/html/rfc7523#section-2.1 - oauth_client_get_token(client, + oauth_client_get_token( + client, grant_type = "urn:ietf:params:oauth:grant-type:jwt-bearer", assertion = jwt, scope = scope, diff --git a/R/oauth-flow-password.R b/R/oauth-flow-password.R index d8b54d21c..1d28b143a 100644 --- a/R/oauth-flow-password.R +++ b/R/oauth-flow-password.R @@ -25,15 +25,16 @@ #' request("https://example.com") |> #' req_auth() #' } -req_oauth_password <- function(req, - client, - username, - password = NULL, - scope = NULL, - token_params = list(), - cache_disk = FALSE, - cache_key = username) { - +req_oauth_password <- function( + req, + client, + username, + password = NULL, + scope = NULL, + token_params = list(), + cache_disk = FALSE, + cache_key = username +) { params <- list( client = client, username = username, @@ -47,17 +48,22 @@ req_oauth_password <- function(req, #' @export #' @rdname req_oauth_password -oauth_flow_password <- function(client, - username, - password = NULL, - scope = NULL, - token_params = list()) { - oauth_flow_check("resource owner password credentials", client, +oauth_flow_password <- function( + client, + username, + password = NULL, + scope = NULL, + token_params = list() +) { + oauth_flow_check( + "resource owner password credentials", + client, interactive = is.null(password) ) check_string(username) - oauth_client_get_token(client, + oauth_client_get_token( + client, grant_type = "password", username = username, password = check_password(password), diff --git a/R/oauth-flow-refresh.R b/R/oauth-flow-refresh.R index 47b78eee0..c3d7d8ff1 100644 --- a/R/oauth-flow-refresh.R +++ b/R/oauth-flow-refresh.R @@ -31,12 +31,13 @@ #' client <- oauth_client("example", "https://example.com/get_token") #' req <- request("https://example.com") #' req |> req_oauth_refresh(client) -req_oauth_refresh <- function(req, - client, - refresh_token = Sys.getenv("HTTR2_REFRESH_TOKEN"), - scope = NULL, - token_params = list()) { - +req_oauth_refresh <- function( + req, + client, + refresh_token = Sys.getenv("HTTR2_REFRESH_TOKEN"), + scope = NULL, + token_params = list() +) { params <- list( client = client, refresh_token = refresh_token, @@ -50,12 +51,15 @@ req_oauth_refresh <- function(req, #' @export #' @rdname req_oauth_refresh -oauth_flow_refresh <- function(client, - refresh_token = Sys.getenv("HTTR2_REFRESH_TOKEN"), - scope = NULL, - token_params = list()) { +oauth_flow_refresh <- function( + client, + refresh_token = Sys.getenv("HTTR2_REFRESH_TOKEN"), + scope = NULL, + token_params = list() +) { oauth_flow_check("refresh", client) - token <- token_refresh(client, + token <- token_refresh( + client, refresh_token = refresh_token, scope = scope, token_params = token_params diff --git a/R/oauth-flow-token-exchange.R b/R/oauth-flow-token-exchange.R index bd9d3d86e..7858ec133 100644 --- a/R/oauth-flow-token-exchange.R +++ b/R/oauth-flow-token-exchange.R @@ -54,17 +54,19 @@ #' options = '{"userProject":"123456"}' #' ) #' ) -req_oauth_token_exchange <- function(req, - client, - subject_token, - subject_token_type, - resource = NULL, - audience = NULL, - scope = NULL, - requested_token_type = NULL, - actor_token = NULL, - actor_token_type = NULL, - token_params = list()) { +req_oauth_token_exchange <- function( + req, + client, + subject_token, + subject_token_type, + resource = NULL, + audience = NULL, + scope = NULL, + requested_token_type = NULL, + actor_token = NULL, + actor_token_type = NULL, + token_params = list() +) { params <- list( client = client, subject_token = subject_token, @@ -83,16 +85,18 @@ req_oauth_token_exchange <- function(req, #' @export #' @rdname req_oauth_token_exchange -oauth_flow_token_exchange <- function(client, - subject_token, - subject_token_type, - resource = NULL, - audience = NULL, - scope = NULL, - requested_token_type = NULL, - actor_token = NULL, - actor_token_type = NULL, - token_params = list()) { +oauth_flow_token_exchange <- function( + client, + subject_token, + subject_token_type, + resource = NULL, + audience = NULL, + scope = NULL, + requested_token_type = NULL, + actor_token = NULL, + actor_token_type = NULL, + token_params = list() +) { oauth_client_get_token( client, grant_type = "urn:ietf:params:oauth:grant-type:token-exchange", diff --git a/R/oauth-flow.R b/R/oauth-flow.R index 4fcdcd4ca..7680e6884 100644 --- a/R/oauth-flow.R +++ b/R/oauth-flow.R @@ -58,10 +58,12 @@ oauth_flow_body <- function(resp) { # https://datatracker.ietf.org/doc/html/rfc6749#section-5.2 # # TODO: automatically fill in description from text in RFC? -oauth_flow_abort <- function(error, - description = NULL, - uri = NULL, - error_call = caller_env()) { +oauth_flow_abort <- function( + error, + description = NULL, + uri = NULL, + error_call = caller_env() +) { cli::cli_abort( c( "OAuth failure [{error}]", diff --git a/R/oauth-token.R b/R/oauth-token.R index 3b685a1bf..017bc22a4 100644 --- a/R/oauth-token.R +++ b/R/oauth-token.R @@ -20,14 +20,13 @@ #' oauth_token("abcdef", expires_in = 3600) #' oauth_token("abcdef", refresh_token = "ghijkl") oauth_token <- function( - access_token, - token_type = "bearer", - expires_in = NULL, - refresh_token = NULL, - ..., - .date = Sys.time() - ) { - + access_token, + token_type = "bearer", + expires_in = NULL, + refresh_token = NULL, + ..., + .date = Sys.time() +) { check_string(access_token) check_string(token_type) check_number_whole(expires_in, allow_null = TRUE) @@ -59,7 +58,10 @@ print.httr2_token <- function(x, ...) { x$expires_at <- format(.POSIXct(x$expires_at)) } - redacted <- list_redact(compact(x), c("access_token", "refresh_token", "id_token")) + redacted <- list_redact( + compact(x), + c("access_token", "refresh_token", "id_token") + ) bullets(redacted) invisible(x) } @@ -72,7 +74,12 @@ token_has_expired <- function(token, delay = 5) { } } -token_refresh <- function(client, refresh_token, scope = NULL, token_params = list()) { +token_refresh <- function( + client, + refresh_token, + scope = NULL, + token_params = list() +) { out <- oauth_client_get_token( client, grant_type = "refresh_token", diff --git a/R/oauth.R b/R/oauth.R index 287efd43c..69c374895 100644 --- a/R/oauth.R +++ b/R/oauth.R @@ -20,7 +20,8 @@ #' @export req_oauth <- function(req, flow, flow_params, cache) { # Want req object to contain meaningful objects, not just a closure - req <- req_auth_sign(req, + req <- req_auth_sign( + req, fun = auth_oauth_sign, params = list(flow = flow, flow_params = flow_params), cache = cache @@ -88,12 +89,14 @@ auth_oauth_token_get <- function(cache, flow, flow_params = list()) { #' ) #' token #' } -oauth_token_cached <- function(client, - flow, - flow_params = list(), - cache_disk = FALSE, - cache_key = NULL, - reauth = FALSE) { +oauth_token_cached <- function( + client, + flow, + flow_params = list(), + cache_disk = FALSE, + cache_key = NULL, + reauth = FALSE +) { check_bool(reauth) cache <- cache_choose(client, cache_disk, cache_key) if (reauth) { @@ -153,7 +156,8 @@ cache_noop <- function() { abort("set() was called on cache_noop") invisible() }, - clear = function() {} + clear = function() { + } ) } cache_mem <- function(client, key = NULL) { @@ -170,7 +174,9 @@ cache_disk <- function(client, key = NULL) { path <- file.path(app_path, paste0(hash(key), "-token.rds.enc")) list( - get = function() if (file.exists(path)) secret_read_rds(path, obfuscate_key()) else NULL, + get = function() { + if (file.exists(path)) secret_read_rds(path, obfuscate_key()) else NULL + }, set = function(token) { cli::cli_inform("Caching httr2 token in {.path {path}}.") secret_write_rds(token, path, obfuscate_key()) @@ -181,7 +187,12 @@ cache_disk <- function(client, key = NULL) { # Update req_oauth_auth_code() docs if change default from 30 cache_disk_prune <- function(days = 30, path = oauth_cache_path()) { - files <- dir(path, recursive = TRUE, full.names = TRUE, pattern = "-token\\.rds$") + files <- dir( + path, + recursive = TRUE, + full.names = TRUE, + pattern = "-token\\.rds$" + ) mtime <- file.mtime(files) old <- mtime < (Sys.time() - days * 86400) diff --git a/R/pooled-request.R b/R/pooled-request.R index 8df6a71eb..b8ff4eda6 100644 --- a/R/pooled-request.R +++ b/R/pooled-request.R @@ -6,7 +6,6 @@ pooled_request <- function( on_error = NULL, error_call = caller_env() ) { - check_request(req) check_string(path, allow_null = TRUE) check_function2(on_success, args = "resp", allow_null = TRUE) @@ -73,7 +72,6 @@ PooledRequest <- R6Class( curl::multi_cancel(private$handle) } } - ), private = list( path = NULL, diff --git a/R/req-auth-aws.R b/R/req-auth-aws.R index c5a5940e6..54781e159 100644 --- a/R/req-auth-aws.R +++ b/R/req-auth-aws.R @@ -29,13 +29,14 @@ #' ) #' resp <- req_perform_connection(req) #' str(resp_body_json(resp)) -req_auth_aws_v4 <- function(req, - aws_access_key_id, - aws_secret_access_key, - aws_session_token = NULL, - aws_service = NULL, - aws_region = NULL) { - +req_auth_aws_v4 <- function( + req, + aws_access_key_id, + aws_secret_access_key, + aws_session_token = NULL, + aws_service = NULL, + aws_region = NULL +) { check_request(req) check_string(aws_access_key_id) check_string(aws_secret_access_key) @@ -43,7 +44,8 @@ req_auth_aws_v4 <- function(req, check_string(aws_service, allow_null = TRUE) check_string(aws_region, allow_null = TRUE) - req_auth_sign(req, + req_auth_sign( + req, fun = auth_aws_sign, params = list( aws_access_key_id = aws_access_key_id, @@ -58,21 +60,23 @@ req_auth_aws_v4 <- function(req, ) } -auth_aws_sign <- function(req, - aws_access_key_id, - aws_secret_access_key, - aws_session_token = NULL, - aws_service = NULL, - aws_region = NULL, - cache) { - +auth_aws_sign <- function( + req, + aws_access_key_id, + aws_secret_access_key, + aws_session_token = NULL, + aws_service = NULL, + aws_region = NULL, + cache +) { current_time <- Sys.time() body_sha256 <- openssl::sha256(req_body_get(req)) # We begin by adding some necessary headers that must be added before # canoncalization even thought they aren't documented until later - req <- req_aws_headers(req, + req <- req_aws_headers( + req, current_time = current_time, aws_session_token = aws_session_token, body_sha256 = body_sha256 @@ -105,19 +109,21 @@ req_aws_headers <- function(req, current_time, aws_session_token, body_sha256) { } # https://docs.aws.amazon.com/IAM/latest/UserGuide/reference_sigv-create-signed-request.html -aws_v4_signature <- function(method, - url, - headers, - body_sha256, - aws_access_key_id, - aws_secret_access_key, - current_time = Sys.time(), - aws_service = NULL, - aws_region = NULL) { - +aws_v4_signature <- function( + method, + url, + headers, + body_sha256, + aws_access_key_id, + aws_secret_access_key, + current_time = Sys.time(), + aws_service = NULL, + aws_region = NULL +) { if (is.null(aws_service) || is.null(aws_region)) { host <- strsplit(url$hostname, ".", fixed = TRUE)[[1]] - aws_service <- aws_service %||% strsplit(host[[1]], "-", fixed = TRUE)[[1]][[1]] + aws_service <- aws_service %||% + strsplit(host[[1]], "-", fixed = TRUE)[[1]][[1]] aws_region <- aws_region %||% host[[2]] } @@ -143,12 +149,12 @@ aws_v4_signature <- function(method, CanonicalHeaders <- paste0(names(headers), ":", headers, "\n", collapse = "") SignedHeaders <- paste0(names(headers), collapse = ";") - CanonicalRequest <- paste0( - HTTPMethod, "\n", - CanonicalURI, "\n", - CanonicalQueryString, "\n", - CanonicalHeaders, "\n", - SignedHeaders, "\n", + CanonicalRequest <- paste_c( + c(HTTPMethod, "\n"), + c(CanonicalURI, "\n"), + c(CanonicalQueryString, "\n"), + c(CanonicalHeaders, "\n"), + c(SignedHeaders, "\n"), body_sha256 ) # 2. Create the hash of the canonical request @@ -163,10 +169,10 @@ aws_v4_signature <- function(method, Date <- format(current_time, "%Y%m%d", tz = "UTC") CredentialScope <- file.path(Date, aws_region, aws_service, "aws4_request") - string_to_sign <- paste0( - Algorithm, "\n", - RequestDateTime, "\n", - CredentialScope, "\n", + string_to_sign <- paste_c( + c(Algorithm, "\n"), + c(RequestDateTime, "\n"), + c(CredentialScope, "\n"), HashedCanonicalRequest ) @@ -186,13 +192,13 @@ aws_v4_signature <- function(method, # 6. Add the signature to the request # https://docs.aws.amazon.com/IAM/latest/UserGuide/reference_sigv-create-signed-request.html#calculate-signature - credential <- file.path(aws_access_key_id, CredentialScope) + credential <- file.path(aws_access_key_id, CredentialScope) - Authorization <- paste0( - Algorithm, " ", - "Credential=", credential, ",", - "SignedHeaders=", SignedHeaders, ",", - "Signature=", signature + Authorization <- paste_c( + c(Algorithm, " "), + c("Credential=", credential, ","), + c("SignedHeaders=", SignedHeaders, ","), + c("Signature=", signature) ) list( diff --git a/R/req-auth-sign.R b/R/req-auth-sign.R index 400e72092..5e67e0b7d 100644 --- a/R/req-auth-sign.R +++ b/R/req-auth-sign.R @@ -1,6 +1,6 @@ - req_auth_sign <- function(req, fun, params, cache) { - req_policies(req, + req_policies( + req, auth_sign = list( fun = fun, params = params, @@ -13,7 +13,8 @@ auth_sign <- function(req) { return(req) } - exec(req$policies$auth_sign$fun, + exec( + req$policies$auth_sign$fun, req = req, cache = req$policies$auth_sign$cache, !!!req$policies$auth_sign$params diff --git a/R/req-body.R b/R/req-body.R index 6f63e675a..cb0446c35 100644 --- a/R/req-body.R +++ b/R/req-body.R @@ -93,12 +93,15 @@ req_body_file <- function(req, path, type = NULL) { #' @param digits How many digits of precision should numbers use in JSON? #' @param null Should `NULL` be translated to JSON's null (`"null"`) #' or an empty list (`"list"`). -req_body_json <- function(req, data, - auto_unbox = TRUE, - digits = 22, - null = "null", - type = "application/json", - ...) { +req_body_json <- function( + req, + data, + auto_unbox = TRUE, + digits = 22, + null = "null", + type = "application/json", + ... +) { check_request(req) check_installed("jsonlite") check_string(type) @@ -147,9 +150,11 @@ req_body_json_modify <- function(req, ...) { #' `req_body_json()` uses this argument differently; it takes additional #' arguments passed on to [jsonlite::toJSON()]. #' @inheritParams req_url_query -req_body_form <- function(.req, - ..., - .multi = c("error", "comma", "pipe", "explode")) { +req_body_form <- function( + .req, + ..., + .multi = c("error", "comma", "pipe", "explode") +) { check_request(.req) dots <- multi_dots(..., .multi = .multi) @@ -179,7 +184,14 @@ req_body_multipart <- function(.req, ...) { # General structure ------------------------------------------------------- -req_body <- function(req, data, type, content_type, params = list(), error_call = parent.frame()) { +req_body <- function( + req, + data, + type, + content_type, + params = list(), + error_call = parent.frame() +) { if (!is.null(req$body) && req$body$type != type) { cli::cli_abort( c( @@ -251,7 +263,8 @@ req_body_apply <- function(req) { req, done = function() close(con) ) - req <- req_options(req, + req <- req_options( + req, post = TRUE, readfunction = function(nbytes, ...) readBin(con, "raw", nbytes), seekfunction = function(offset, ...) seek(con, where = offset), @@ -287,9 +300,5 @@ req_body_apply_raw <- function(req, body) { if (is_string(body)) { body <- charToRaw(enc2utf8(body)) } - req_options(req, - post = TRUE, - postfieldsize = length(body), - postfields = body - ) + req_options(req, post = TRUE, postfieldsize = length(body), postfields = body) } diff --git a/R/req-cache.R b/R/req-cache.R index 7512d521a..82fd05161 100644 --- a/R/req-cache.R +++ b/R/req-cache.R @@ -56,20 +56,22 @@ #' #' # Second request retrieves it from the cache #' resp <- req |> req_perform() -req_cache <- function(req, - path, - use_on_error = FALSE, - debug = getOption("httr2_cache_debug", FALSE), - max_age = Inf, - max_n = Inf, - max_size = 1024^3) { - +req_cache <- function( + req, + path, + use_on_error = FALSE, + debug = getOption("httr2_cache_debug", FALSE), + max_age = Inf, + max_n = Inf, + max_size = 1024^3 +) { check_number_whole(max_age, min = 0, allow_infinite = TRUE) check_number_whole(max_n, min = 0, allow_infinite = TRUE) check_number_decimal(max_size, min = 1, allow_infinite = TRUE) dir.create(path, showWarnings = FALSE, recursive = TRUE) - req_policies(req, + req_policies( + req, cache_path = path, cache_use_on_error = use_on_error, cache_debug = debug, @@ -151,9 +153,24 @@ cache_prune_if_needed <- function(req, threshold = 60, debug = FALSE) { cache_prune <- function(path, max, debug = TRUE) { info <- cache_info(path) - info <- cache_prune_files(info, info$mtime + max$age < Sys.time(), "too old", debug) - info <- cache_prune_files(info, seq_len(nrow(info)) > max$n, "too numerous", debug) - info <- cache_prune_files(info, cumsum(info$size) > max$size, "too big", debug) + info <- cache_prune_files( + info, + info$mtime + max$age < Sys.time(), + "too old", + debug + ) + info <- cache_prune_files( + info, + seq_len(nrow(info)) > max$n, + "too numerous", + debug + ) + info <- cache_prune_files( + info, + cumsum(info$size) > max$size, + "too big", + debug + ) invisible() } @@ -169,7 +186,8 @@ cache_info <- function(path, pattern = "\\.rds$") { cache_prune_files <- function(info, to_remove, why, debug = TRUE) { if (any(to_remove)) { - if (debug) cli::cli_text("Deleted {sum(to_remove)} file{?s} that {?is/are} {why}") + if (debug) + cli::cli_text("Deleted {sum(to_remove)} file{?s} that {?is/are} {why}") file.remove(info$name[to_remove]) info[!to_remove, ] @@ -211,7 +229,8 @@ cache_pre_fetch <- function(req, path = NULL) { resp } else { if (debug) cli::cli_text("Cached value is stale; checking for updates") - req_headers(req, + req_headers( + req, `If-Modified-Since` = info$last_modified, `If-None-Match` = info$etag ) @@ -229,14 +248,16 @@ cache_post_fetch <- function(req, resp, path = NULL) { if (is_error(resp)) { if (cache_use_on_error(req) && !is.null(cached_resp)) { - if (debug) cli::cli_text("Request errored; retrieving response from cache") + if (debug) + cli::cli_text("Request errored; retrieving response from cache") cached_resp } else { resp } } else if (resp_status(resp) == 304 && !is.null(cached_resp)) { signal("", "httr2_cache_not_modified") - if (debug) cli::cli_text("Cached value still ok; retrieving body from cache") + if (debug) + cli::cli_text("Cached value still ok; retrieving body from cache") # Combine headers resp$headers <- cache_headers(cached_resp, resp) @@ -264,7 +285,8 @@ cache_body <- function(cached_resp, path = NULL) { return(body) } - switch(resp_body_type(cached_resp), + switch( + resp_body_type(cached_resp), disk = file.copy(body, path, overwrite = TRUE), memory = writeBin(body, path), stream = cli::cli_abort("Invalid body type", .internal = TRUE) @@ -277,7 +299,11 @@ cache_body <- function(cached_resp, path = NULL) { cache_headers <- function(cached_resp, resp) { check_response(cached_resp) - headers <- modify_list(cached_resp$headers, !!!resp$headers, .ignore_case = TRUE) + headers <- modify_list( + cached_resp$headers, + !!!resp$headers, + .ignore_case = TRUE + ) as_headers(headers) } diff --git a/R/req-dry-run.R b/R/req-dry-run.R index 67160f8fc..ec7d8b530 100644 --- a/R/req-dry-run.R +++ b/R/req-dry-run.R @@ -39,11 +39,13 @@ #' #' # if you need to see it, use redact_headers = FALSE #' req |> req_dry_run(redact_headers = FALSE) -req_dry_run <- function(req, - quiet = FALSE, - redact_headers = TRUE, - testing_headers = is_testing(), - pretty_json = getOption("httr2_pretty_json", TRUE)) { +req_dry_run <- function( + req, + quiet = FALSE, + redact_headers = TRUE, + testing_headers = is_testing(), + pretty_json = getOption("httr2_pretty_json", TRUE) +) { check_request(req) check_bool(quiet) check_bool(redact_headers) diff --git a/R/req-error.R b/R/req-error.R index 3160250d6..9387fd96b 100644 --- a/R/req-error.R +++ b/R/req-error.R @@ -84,9 +84,7 @@ #' request("http://example.com") |> #' req_error(body = error_body) #' # Learn more in https://httr2.r-lib.org/articles/wrapping-apis.html -req_error <- function(req, - is_error = NULL, - body = NULL) { +req_error <- function(req, is_error = NULL, body = NULL) { check_request(req) req_policies( diff --git a/R/req-headers.R b/R/req-headers.R index 6e1c6d983..837666ebd 100644 --- a/R/req-headers.R +++ b/R/req-headers.R @@ -66,7 +66,7 @@ req_headers <- function(.req, ..., .redact = NULL) { check_character(.redact, allow_null = TRUE) check_header_values(...) - headers <- modify_list(.req$headers, ..., .ignore_case = TRUE) + headers <- modify_list(.req$headers, ..., .ignore_case = TRUE) redact <- union(.redact, "Authorization") redact <- redact[tolower(redact) %in% tolower(names(headers))] @@ -88,7 +88,7 @@ req_headers_redacted <- function(.req, ...) { 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( diff --git a/R/req-method.R b/R/req-method.R index b73bbb72b..affb8f594 100644 --- a/R/req-method.R +++ b/R/req-method.R @@ -26,7 +26,8 @@ req_method_apply <- function(req) { return(req) } - switch(req$method, + switch( + req$method, HEAD = req_options(req, nobody = TRUE), req_options(req, customrequest = req$method) ) diff --git a/R/req-options.R b/R/req-options.R index 1012e20be..7549665fc 100644 --- a/R/req-options.R +++ b/R/req-options.R @@ -115,8 +115,14 @@ req_timeout <- function(req, seconds) { #' req_perform() #' } #' @export -req_proxy <- function(req, url, port = NULL, username = NULL, password = NULL, auth = "basic") { - +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 { @@ -143,6 +149,11 @@ auth_flags <- function(x = "basic") { digest_ie = 16, any = -17 ) - idx <- arg_match0(x, names(constants), arg_nm = "auth", error_call = caller_env()) + idx <- arg_match0( + x, + names(constants), + arg_nm = "auth", + error_call = caller_env() + ) constants[[idx]] } diff --git a/R/req-perform-connection.R b/R/req-perform-connection.R index cad843e42..c172b3b75 100644 --- a/R/req-perform-connection.R +++ b/R/req-perform-connection.R @@ -98,12 +98,17 @@ req_perform_connection <- function(req, blocking = TRUE, verbosity = NULL) { # Like req_verbosity() but we want to print the streaming body when it's # requested not when curl actually receives it -req_verbosity_connection <- function(req, verbosity, error_call = caller_env()) { +req_verbosity_connection <- function( + req, + verbosity, + error_call = caller_env() +) { if (!is_integerish(verbosity, n = 1) || verbosity < 0 || verbosity > 3) { cli::cli_abort("{.arg verbosity} must 0, 1, 2, or 3.", call = error_call) } - req <- switch(verbosity + 1, + req <- switch( + verbosity + 1, req, req_verbose(req), req_verbose(req, body_req = TRUE), diff --git a/R/req-perform-iterative.R b/R/req-perform-iterative.R index b61037a5b..9c4cae39e 100644 --- a/R/req-perform-iterative.R +++ b/R/req-perform-iterative.R @@ -105,12 +105,14 @@ #' ) #' }) #' str(data) -req_perform_iterative <- function(req, - next_req, - path = NULL, - max_reqs = 20, - on_error = c("stop", "return"), - progress = TRUE) { +req_perform_iterative <- function( + req, + next_req, + path = NULL, + max_reqs = 20, + on_error = c("stop", "return"), + progress = TRUE +) { check_request(req) check_function2(next_req, args = c("resp", "req")) check_number_whole(max_reqs, allow_infinite = TRUE, min = 1) @@ -134,9 +136,10 @@ req_perform_iterative <- function(req, resps <- vector("list", length = if (is.finite(max_reqs)) max_reqs else 100) i <- 1L - tryCatch({ + tryCatch( repeat { - httr2_error <- switch(on_error, + httr2_error <- switch( + on_error, stop = function(cnd) zap(), return = function(cnd) cnd ) @@ -176,16 +179,17 @@ req_perform_iterative <- function(req, signal("", class = "httr2:::doubled") length(resps) <- length(resps) * 2 } + }, + interrupt = function(cnd) { + # interrupt might occur after i was incremented + if (is.null(resps[[i]])) { + i <<- i - 1 + } + cli::cli_alert_warning( + "Terminating iteration; returning {i} response{?s}." + ) } - }, interrupt = function(cnd) { - # interrupt might occur after i was incremented - if (is.null(resps[[i]])) { - i <<- i - 1 - } - cli::cli_alert_warning( - "Terminating iteration; returning {i} response{?s}." - ) - }) + ) progress$done() if (i < length(resps)) { diff --git a/R/req-perform-parallel.R b/R/req-perform-parallel.R index fc3e67ad7..88fda1438 100644 --- a/R/req-perform-parallel.R +++ b/R/req-perform-parallel.R @@ -95,7 +95,9 @@ req_perform_parallel <- function( queue$process() n <- sum(!map_lgl(queue$resps, is.null)) - cli::cli_alert_warning("Terminating iteration; returning {n} response{?s}.") + cli::cli_alert_warning( + "Terminating iteration; returning {n} response{?s}." + ) } ) @@ -229,7 +231,11 @@ RequestQueue <- R6::R6Class( } else { waiting <- "for throttling" } - pool_wait_for_deadline(self$pool, min(request_deadline, deadline), waiting) + pool_wait_for_deadline( + self$pool, + min(request_deadline, deadline), + waiting + ) NULL } else if (self$queue_status == "working") { if (self$n_pending == 0 && self$n_active == 0) { @@ -316,13 +322,13 @@ RequestQueue <- R6::R6Class( }, set_status = function(i, status) { - switch( # old status - self$status[[i]], + switch( + self$status[[i]], # old status pending = self$n_pending <- self$n_pending - 1, active = self$n_active <- self$n_active - 1 ) - switch( # new status - status, + switch( + status, # new status pending = self$n_pending <- self$n_pending + 1, active = self$n_active <- self$n_active + 1, complete = self$n_complete <- self$n_complete + 1 diff --git a/R/req-perform-sequential.R b/R/req-perform-sequential.R index df37df447..f5607ba27 100644 --- a/R/req-perform-sequential.R +++ b/R/req-perform-sequential.R @@ -49,10 +49,12 @@ #' resps <- reqs |> req_perform_sequential() #' resps_data(resps, \(resp) resp_body_json(resp)) #' } -req_perform_sequential <- function(reqs, - paths = NULL, - on_error = c("stop", "return", "continue"), - progress = TRUE) { +req_perform_sequential <- function( + reqs, + paths = NULL, + on_error = c("stop", "return", "continue"), + progress = TRUE +) { if (!is_bare_list(reqs)) { stop_input_type(reqs, "a list") } @@ -70,27 +72,32 @@ req_perform_sequential <- function(reqs, resps <- rep_along(reqs, list()) - tryCatch({ - for (i in seq_along(reqs)) { - check_request(reqs[[i]], arg = glue::glue("req[[{i}]]")) + tryCatch( + { + for (i in seq_along(reqs)) { + check_request(reqs[[i]], arg = glue::glue("req[[{i}]]")) - if (err_catch) { - resps[[i]] <- tryCatch( - req_perform(reqs[[i]], path = paths[[i]]), - httr2_error = function(err) err - ) - } else { - resps[[i]] <- req_perform(reqs[[i]], path = paths[[i]]) + if (err_catch) { + resps[[i]] <- tryCatch( + req_perform(reqs[[i]], path = paths[[i]]), + httr2_error = function(err) err + ) + } else { + resps[[i]] <- req_perform(reqs[[i]], path = paths[[i]]) + } + if (err_return && is_error(resps[[i]])) { + break + } + progress$update() } - if (err_return && is_error(resps[[i]])) { - break - } - progress$update() + }, + interrupt = function(cnd) { + resps <- resps[seq_len(i)] + cli::cli_alert_warning( + "Terminating iteration; returning {i} response{?s}." + ) } - }, interrupt = function(cnd) { - resps <- resps[seq_len(i)] - cli::cli_alert_warning("Terminating iteration; returning {i} response{?s}.") - }) + ) progress$done() resps diff --git a/R/req-perform-stream.R b/R/req-perform-stream.R index 9c6aa6df1..279aefd19 100644 --- a/R/req-perform-stream.R +++ b/R/req-perform-stream.R @@ -38,11 +38,13 @@ #' req_url_path("/stream-bytes/100000") |> #' req_perform_stream(show_bytes, buffer_kb = 32) #' resp -req_perform_stream <- function(req, - callback, - timeout_sec = Inf, - buffer_kb = 64, - round = c("byte", "line")) { +req_perform_stream <- function( + req, + callback, + timeout_sec = Inf, + buffer_kb = 64, + round = c("byte", "line") +) { check_request(req) check_function(callback) @@ -87,14 +89,17 @@ req_perform_stream <- function(req, # Helpers ---------------------------------------------------------------------- -as_round_function <- function(round = c("byte", "line"), - error_call = caller_env()) { +as_round_function <- function( + round = c("byte", "line"), + error_call = caller_env() +) { if (is.function(round)) { check_function2(round, args = "bytes") round } else if (is.character(round)) { round <- arg_match(round, error_call = error_call) - switch(round, + switch( + round, byte = function(bytes) length(bytes), line = function(bytes) which(bytes == charToRaw("\n")) ) diff --git a/R/req-perform.R b/R/req-perform.R index 6a8c31ca7..a89b69c92 100644 --- a/R/req-perform.R +++ b/R/req-perform.R @@ -65,12 +65,12 @@ #' request("https://google.com") |> #' req_perform() req_perform <- function( - req, - path = NULL, - verbosity = NULL, - mock = getOption("httr2_mock", NULL), - error_call = current_env() - ) { + req, + path = NULL, + verbosity = NULL, + mock = getOption("httr2_mock", NULL), + error_call = current_env() +) { check_request(req) check_string(path, allow_null = TRUE) # verbosity checked by req_verbosity @@ -163,7 +163,12 @@ resp_failure_cnd <- function(req, resp, error_call = caller_env()) { c(message, resp_auth_message(resp), info), status = status, resp = resp, - class = c(glue("httr2_http_{status}"), "httr2_http", "httr2_error", "rlang_error"), + class = c( + glue("httr2_http_{status}"), + "httr2_http", + "httr2_error", + "rlang_error" + ), request = req, call = error_call )) @@ -206,7 +211,8 @@ req_verbosity <- function(req, verbosity, error_call = caller_env()) { cli::cli_abort("{.arg verbosity} must 0, 1, 2, or 3.", call = error_call) } - switch(verbosity + 1, + switch( + verbosity + 1, req, req_verbose(req), req_verbose(req, body_req = TRUE, body_resp = TRUE), diff --git a/R/req-progress.R b/R/req-progress.R index 084e74b9a..5e0858b95 100644 --- a/R/req-progress.R +++ b/R/req-progress.R @@ -19,10 +19,7 @@ req_progress <- function(req, type = c("down", "up")) { type <- arg_match(type) # https://curl.se/libcurl/c/CURLOPT_XFERINFOFUNCTION.html - req_options(req, - noprogress = FALSE, - xferinfofunction = make_progress(type) - ) + req_options(req, noprogress = FALSE, xferinfofunction = make_progress(type)) } make_progress <- function(type, frame = caller_env()) { @@ -54,7 +51,10 @@ make_progress <- function(type, frame = caller_env()) { ) } else { cli::cli_progress_bar( - format = paste0(verb, " {cli::pb_percent} {cli::pb_bar} {cli::pb_eta}"), + format = paste0( + verb, + " {cli::pb_percent} {cli::pb_bar} {cli::pb_eta}" + ), total = total, .envir = frame ) diff --git a/R/req-promise.R b/R/req-promise.R index e7c2f82cb..3bb82370c 100644 --- a/R/req-promise.R +++ b/R/req-promise.R @@ -67,10 +67,12 @@ #' # See the [promises package documentation](https://rstudio.github.io/promises/) #' # for more information on working with promises #' } -req_perform_promise <- function(req, - path = NULL, - pool = NULL, - verbosity = NULL) { +req_perform_promise <- function( + req, + path = NULL, + pool = NULL, + verbosity = NULL +) { check_installed(c("promises", "later")) check_request(req) @@ -125,7 +127,8 @@ ensure_pool_poller <- function(pool, reject) { } else { monitor$ending() } - }, error = function(cnd) { + }, + error = function(cnd) { monitor$ending() reject(cnd) } @@ -139,7 +142,8 @@ ensure_pool_poller <- function(pool, reject) { pool_poller_monitor <- function(pool) { pool_address <- obj_address(pool) list( - already_going = function() env_get(the$pool_pollers, pool_address, default = FALSE), + already_going = function() + env_get(the$pool_pollers, pool_address, default = FALSE), starting = function() env_poke(the$pool_pollers, pool_address, TRUE), ending = function() env_unbind(the$pool_pollers, pool_address) ) diff --git a/R/req-retries.R b/R/req-retries.R index 3049cd9d3..2962b8f26 100644 --- a/R/req-retries.R +++ b/R/req-retries.R @@ -86,17 +86,18 @@ #' is_transient = github_is_transient, #' after = github_after #' ) -req_retry <- function(req, - max_tries = NULL, - max_seconds = NULL, - retry_on_failure = FALSE, - is_transient = NULL, - backoff = NULL, - after = NULL, - failure_threshold = Inf, - failure_timeout = 30, - failure_realm = NULL) { - +req_retry <- function( + req, + max_tries = NULL, + max_seconds = NULL, + retry_on_failure = FALSE, + is_transient = NULL, + backoff = NULL, + after = NULL, + failure_threshold = Inf, + failure_timeout = 30, + failure_realm = NULL +) { check_request(req) check_number_whole(max_tries, min = 1, allow_null = TRUE) check_number_whole(max_seconds, min = 0, allow_null = TRUE) @@ -110,7 +111,8 @@ req_retry <- function(req, check_bool(retry_on_failure) - req_policies(req, + req_policies( + req, retry_max_tries = max_tries, retry_max_wait = max_seconds, retry_on_failure = retry_on_failure, @@ -153,10 +155,9 @@ retry_check_breaker <- function(req, i, error_call = caller_env()) { } else { cli::cli_abort( c( - "Request failures have exceeded the threshold for realm {.str {realm}}.", + "Request failures have exceeded the threshold for realm {.str {realm}}.", i = "The server behind {.str {realm}} is likely still overloaded or down.", i = "Wait {remaining} seconds before retrying." - ), call = error_call, class = "httr2_breaker" @@ -169,7 +170,10 @@ retry_is_transient <- function(req, resp) { return(req$policies$retry_on_failure %||% FALSE) } - req_policy_call(req, "retry_is_transient", list(resp), + req_policy_call( + req, + "retry_is_transient", + list(resp), default = function(resp) resp_status(resp) %in% c(429, 503) ) } @@ -183,7 +187,12 @@ retry_after <- function(req, resp, i, error_call = caller_env()) { return(retry_backoff(req, i)) } - after <- req_policy_call(req, "retry_after", list(resp), default = resp_retry_after) + after <- req_policy_call( + req, + "retry_after", + list(resp), + default = resp_retry_after + ) # TODO: apply this idea to all callbacks if (!is_number_or_na(after)) { diff --git a/R/req-template.R b/R/req-template.R index a16c2a94e..e7e99f68e 100644 --- a/R/req-template.R +++ b/R/req-template.R @@ -59,16 +59,25 @@ req_template <- function(req, template, ..., .env = parent.frame()) { req_url_path_append(req, path) } -template_process <- function(template, - dots = list(), - env = parent.frame(), - error_call = caller_env()) { +template_process <- function( + template, + dots = list(), + env = parent.frame(), + error_call = caller_env() +) { type <- template_type(template) vars <- template_vars(template, type) - vals <- map_chr(vars, template_val, dots = dots, env = env, error_call = error_call) + vals <- map_chr( + vars, + template_val, + dots = dots, + env = env, + error_call = error_call + ) for (i in seq_along(vars)) { - pattern <- switch(type, + pattern <- switch( + type, colon = paste0(":", vars[[i]]), uri = paste0("{", vars[[i]], "}") ) @@ -101,7 +110,8 @@ template_val <- function(name, dots, env, error_call = caller_env()) { template_vars <- function(x, type) { if (type == "none") return(character()) - pattern <- switch(type, + pattern <- switch( + type, colon = ":([a-zA-Z0-9_]+)", uri = "\\{(\\w+?)\\}" ) diff --git a/R/req-throttle.R b/R/req-throttle.R index fa410b6c9..b816c4de4 100644 --- a/R/req-throttle.R +++ b/R/req-throttle.R @@ -40,11 +40,7 @@ #' throttle_status() #' #' \dontshow{httr2:::throttle_reset()} -req_throttle <- function(req, - rate, - capacity, - fill_time_s = 60, - realm = NULL) { +req_throttle <- function(req, rate, capacity, fill_time_s = 60, realm = NULL) { check_request(req) check_exclusive(rate, capacity) if (missing(capacity)) { diff --git a/R/req-url.R b/R/req-url.R index d060ee816..59ff7f38f 100644 --- a/R/req-url.R +++ b/R/req-url.R @@ -72,10 +72,12 @@ req_url_relative <- function(req, url) { #' @export #' @rdname req_url #' @inheritParams url_modify_query -req_url_query <- function(.req, - ..., - .multi = c("error", "comma", "pipe", "explode"), - .space = c("percent", "form")) { +req_url_query <- function( + .req, + ..., + .multi = c("error", "comma", "pipe", "explode"), + .space = c("percent", "form") +) { check_request(.req) url <- url_modify_query(.req$url, ..., .multi = .multi, .space = .space) req_url(.req, url) diff --git a/R/req-verbose.R b/R/req-verbose.R index 6dec22e6f..57948e855 100644 --- a/R/req-verbose.R +++ b/R/req-verbose.R @@ -35,13 +35,15 @@ #' # Or use one of the convenient shortcuts: #' resp <- request("https://httr2.r-lib.org") |> #' req_perform(verbosity = 1) -req_verbose <- function(req, - header_req = TRUE, - header_resp = TRUE, - body_req = FALSE, - body_resp = FALSE, - info = FALSE, - redact_headers = TRUE) { +req_verbose <- function( + req, + header_req = TRUE, + header_resp = TRUE, + body_req = FALSE, + body_resp = FALSE, + info = FALSE, + redact_headers = TRUE +) { check_request(req) # force all arguments @@ -85,7 +87,12 @@ verbose_header <- function(prefix, x, redact = TRUE, to_redact = NULL) { 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)), ": ", format(header[[1]])) + cli::cat_line( + prefix, + cli::style_bold(names(header)), + ": ", + format(header[[1]]) + ) } else { cli::cat_line(prefix, line) } diff --git a/R/req.R b/R/req.R index 65f9382e9..da8be14c5 100644 --- a/R/req.R +++ b/R/req.R @@ -27,7 +27,10 @@ print.httr2_request <- function(x, ..., redact_headers = TRUE) { method <- toupper(req_method_get(x)) cli::cli_text("{.strong {method}} {x$url}") - bullets_with_header("Headers:", headers_flatten(headers_redact(x$headers, redact_headers))) + bullets_with_header( + "Headers:", + headers_flatten(headers_redact(x$headers, redact_headers)) + ) cli::cli_text("{.strong Body}: {req_body_info(x)}") bullets_with_header("Options:", x$options) bullets_with_header("Policies:", x$policies) @@ -35,14 +38,16 @@ print.httr2_request <- function(x, ..., redact_headers = TRUE) { invisible(x) } -new_request <- function(url, - method = NULL, - headers = list(), - body = NULL, - fields = list(), - options = list(), - policies = list(), - error_call = caller_env()) { +new_request <- function( + url, + method = NULL, + headers = list(), + body = NULL, + fields = list(), + options = list(), + policies = list(), + error_call = caller_env() +) { check_string(url, call = error_call) structure( @@ -64,10 +69,12 @@ is_request <- function(x) { inherits(x, "httr2_request") } -check_request <- function(req, - arg = caller_arg(req), - call = caller_env(), - allow_null = FALSE) { +check_request <- function( + req, + arg = caller_arg(req), + call = caller_env(), + allow_null = FALSE +) { if (!missing(req)) { if (is_request(req)) { return(invisible(NULL)) diff --git a/R/resp-body.R b/R/resp-body.R index ac03f2e4b..a21e25253 100644 --- a/R/resp-body.R +++ b/R/resp-body.R @@ -38,7 +38,8 @@ resp_body_raw <- function(resp) { cli::cli_abort("Can't retrieve empty body.") } - switch(resp_body_type(resp), + switch( + resp_body_type(resp), disk = readBin(resp$body, "raw", file.size(resp$body)), memory = resp$body, stream = { @@ -54,7 +55,8 @@ resp_body_raw <- function(resp) { resp_has_body <- function(resp) { check_response(resp) - switch(resp_body_type(resp), + switch( + resp_body_type(resp), disk = file.size(resp$body) > 0, memory = length(resp$body) > 0, stream = isValid(resp$body) @@ -93,7 +95,12 @@ resp_body_string <- function(resp, encoding = NULL) { #' [xml2::read_xml()] respectively. #' @rdname resp_body_raw #' @export -resp_body_json <- function(resp, check_type = TRUE, simplifyVector = FALSE, ...) { +resp_body_json <- function( + resp, + check_type = TRUE, + simplifyVector = FALSE, + ... +) { check_response(resp) check_installed("jsonlite") @@ -110,7 +117,11 @@ resp_body_json <- function(resp, check_type = TRUE, simplifyVector = FALSE, ...) ) text <- resp_body_string(resp, "UTF-8") - resp$cache[[key]] <- jsonlite::fromJSON(text, simplifyVector = simplifyVector, ...) + resp$cache[[key]] <- jsonlite::fromJSON( + text, + simplifyVector = simplifyVector, + ... + ) resp$cache[[key]] } diff --git a/R/resp-headers.R b/R/resp-headers.R index 3983886f8..6e826df59 100644 --- a/R/resp-headers.R +++ b/R/resp-headers.R @@ -31,7 +31,12 @@ resp_headers <- function(resp, filter = NULL) { if (is.null(filter)) { resp$headers } else { - resp$headers[grepl(filter, names(resp$headers), perl = TRUE, ignore.case = TRUE)] + resp$headers[grepl( + filter, + names(resp$headers), + perl = TRUE, + ignore.case = TRUE + )] } } @@ -169,7 +174,7 @@ resp_retry_after <- function(resp) { #' resp_link_url(resp, "last") #' resp_link_url(resp, "prev") resp_link_url <- function(resp, rel) { -if (!resp_header_exists(resp, "Link")) { + if (!resp_header_exists(resp, "Link")) { return() } diff --git a/R/resp-stream-aws.R b/R/resp-stream-aws.R index 3c09d91d6..2163e65af 100644 --- a/R/resp-stream-aws.R +++ b/R/resp-stream-aws.R @@ -58,7 +58,10 @@ parse_aws_event <- function(bytes) { # prelude total_length <- parse_int(read_bytes(4)) if (total_length != length(bytes)) { - cli::cli_abort("AWS event metadata doesn't match supplied bytes", .internal = TRUE) + cli::cli_abort( + "AWS event metadata doesn't match supplied bytes", + .internal = TRUE + ) } header_length <- parse_int(read_bytes(4)) @@ -73,7 +76,8 @@ parse_aws_event <- function(bytes) { type <- as.integer(read_bytes(1)) delayedAssign("length", parse_int(read_bytes(2))) - value <- switch(type_enum(type), + value <- switch( + type_enum(type), "TRUE" = TRUE, "FALSE" = FALSE, BYTE = parse_int(read_bytes(1)), @@ -119,7 +123,8 @@ type_enum <- function(value) { cli::cli_abort("Unsupported type {value}.", .internal = TRUE) } - switch(value + 1, + switch( + value + 1, "TRUE", "FALSE", "BYTE", diff --git a/R/resp-stream.R b/R/resp-stream.R index 3e2f7895c..716060388 100644 --- a/R/resp-stream.R +++ b/R/resp-stream.R @@ -102,24 +102,28 @@ resp_stream_lines <- function(resp, lines = 1, max_size = Inf, warn = TRUE) { #' @rdname resp_stream_raw #' @order 1 resp_stream_sse <- function(resp, max_size = Inf) { - repeat { - event_bytes <- resp_boundary_pushback(resp, max_size, find_event_boundary, include_trailer = FALSE) + event_bytes <- resp_boundary_pushback( + resp, + max_size, + find_event_boundary, + include_trailer = FALSE + ) if (is.null(event_bytes)) { return() } if (resp_stream_show_buffer(resp)) { log_stream( - cli::rule("Raw server sent event"), "\n", + cli::rule("Raw server sent event"), + "\n", rawToChar(event_bytes), prefix = "* " ) } event <- parse_event(event_bytes) - if (!is.null(event)) - break + if (!is.null(event)) break } if (resp_stream_show_body(resp)) { @@ -154,7 +158,12 @@ close.httr2_response <- function(con, ...) { resp_stream_oneline <- function(resp, max_size, warn, encoding) { repeat { - line_bytes <- resp_boundary_pushback(resp, max_size, find_line_boundary, include_trailer = TRUE) + line_bytes <- resp_boundary_pushback( + resp, + max_size, + find_line_boundary, + include_trailer = TRUE + ) if (is.null(line_bytes)) { return(character()) } @@ -267,7 +276,12 @@ split_buffer <- function(buffer, split_at) { # @param include_trailer If TRUE, at the end of the response, if there are # bytes after the last boundary, then return those bytes; if FALSE, then those # bytes are discarded with a warning. -resp_boundary_pushback <- function(resp, max_size, boundary_func, include_trailer) { +resp_boundary_pushback <- function( + resp, + max_size, + boundary_func, + include_trailer +) { check_streaming_response(resp) check_number_whole(max_size, min = 1, allow_infinite = TRUE) @@ -280,10 +294,16 @@ resp_boundary_pushback <- function(resp, max_size, boundary_func, include_traile if (resp_stream_show_buffer(resp)) { log_stream(cli::rule("Buffer"), prefix = "* ") print_buffer <- function(buf, label) { - log_stream(label, ": ", paste(as.character(buf), collapse = " "), prefix = "* ") + log_stream( + label, + ": ", + paste(as.character(buf), collapse = " "), + prefix = "* " + ) } } else { - print_buffer <- function(buf, label) {} + print_buffer <- function(buf, label) { + } } # Read chunks until we find an event or reach the end of input @@ -313,7 +333,9 @@ resp_boundary_pushback <- function(resp, max_size, boundary_func, include_traile } # We didn't have enough data. Attempt to read more - chunk <- readBin(resp$body, raw(), + chunk <- readBin( + resp$body, + raw(), # Don't let us exceed the max size by more than one byte; we do allow the # one extra byte so we know to error. n = min(chunk_size, max_size - length(buffer) + 1) @@ -329,7 +351,9 @@ resp_boundary_pushback <- function(resp, max_size, boundary_func, include_traile if (include_trailer) { return(buffer) } else { - cli::cli_warn("Premature end of input; ignoring final partial chunk") + cli::cli_warn( + "Premature end of input; ignoring final partial chunk" + ) return(NULL) } } @@ -350,7 +374,6 @@ resp_boundary_pushback <- function(resp, max_size, boundary_func, include_traile # https://html.spec.whatwg.org/multipage/server-sent-events.html#event-stream-interpretation parse_event <- function(event_data) { - if (is.raw(event_data)) { # Streams must be decoded using the UTF-8 decode algorithm. str_data <- rawToChar(event_data) @@ -431,10 +454,11 @@ parse_event <- function(event_data) { # Helpers ---------------------------------------------------- - -check_streaming_response <- function(resp, - arg = caller_arg(resp), - call = caller_env()) { +check_streaming_response <- function( + resp, + arg = caller_arg(resp), + call = caller_env() +) { check_response(resp, arg = arg, call = call) if (resp_body_type(resp) != "stream") { diff --git a/R/resp.R b/R/resp.R index 461bce3d9..92f52ad83 100644 --- a/R/resp.R +++ b/R/resp.R @@ -25,12 +25,13 @@ #' response() #' response(404, method = "POST") #' response(headers = c("Content-Type: text/html", "Content-Length: 300")) -response <- function(status_code = 200, - url = "https://example.com", - method = "GET", - headers = list(), - body = raw()) { - +response <- function( + status_code = 200, + url = "https://example.com", + method = "GET", + headers = list(), + body = raw() +) { check_number_whole(status_code, min = 100, max = 700) check_string(url) check_string(method) @@ -48,12 +49,13 @@ response <- function(status_code = 200, #' @export #' @rdname response -response_json <- function(status_code = 200, - url = "https://example.com", - method = "GET", - headers = list(), - body = list()) { - +response_json <- function( + status_code = 200, + url = "https://example.com", + method = "GET", + headers = list(), + body = list() +) { headers <- as_headers(headers) headers$`Content-Type` <- "application/json" @@ -68,13 +70,15 @@ response_json <- function(status_code = 200, ) } -new_response <- function(method, - url, - status_code, - headers, - body, - request = NULL, - error_call = caller_env()) { +new_response <- function( + method, + url, + status_code, + headers, + body, + request = NULL, + error_call = caller_env() +) { check_string(method, call = error_call) check_string(url, call = error_call) check_number_whole(status_code, call = error_call) @@ -127,8 +131,11 @@ print.httr2_response <- function(x, ...) { if (!resp_has_body(x)) { cli::cli_text("{.field Body}: None") } else { - switch(resp_body_type(x), - disk = cli::cli_text("{.field Body}: On disk {.path {body}} ({file.size(body)} bytes)"), + switch( + resp_body_type(x), + disk = cli::cli_text( + "{.field Body}: On disk {.path {body}} ({file.size(body)} bytes)" + ), memory = cli::cli_text("{.field Body}: In memory ({length(body)} bytes)"), stream = cli::cli_text("{.field Body}: Streaming connection") ) diff --git a/R/roxygen2.R b/R/roxygen2.R index fcf6c0bad..b30932a46 100644 --- a/R/roxygen2.R +++ b/R/roxygen2.R @@ -1,10 +1,17 @@ rfc <- function(num, sec = NULL) { - paste0( - "[", - if (!is.null(sec)) paste0("Section ", sec, " of "), - "RFC ", num, "]", - "(https://datatracker.ietf.org/doc/html/rfc", num, - if (!is.null(sec)) paste0("#section-", sec), - ")" + paste_c( + c( + "[", + if (!is.null(sec)) paste0("Section ", sec, " of "), + "RFC ", + num, + "]" + ), + c( + "(https://datatracker.ietf.org/doc/html/rfc", + num, + if (!is.null(sec)) paste0("#section-", sec), + ")" + ) ) } diff --git a/R/test.R b/R/test.R index 213ee2436..0e9288cb7 100644 --- a/R/test.R +++ b/R/test.R @@ -64,8 +64,8 @@ example_github_client <- function() { oauth_client( id = "28acfec0674bb3da9f38", secret = obfuscated(paste0( - "J9iiGmyelHltyxqrHXW41ZZPZamyUNxSX1_uKnv", - "PeinhhxET_7FfUs2X0LLKotXY2bpgOMoHRCo" + "J9iiGmyelHltyxqrHXW41ZZPZamyUNxSX1_uKnv", + "PeinhhxET_7FfUs2X0LLKotXY2bpgOMoHRCo" )), token_url = "https://github.com/login/oauth/access_token", name = "hadley-oauth-test" diff --git a/R/url.R b/R/url.R index bf2f8acb0..e686d606c 100644 --- a/R/url.R +++ b/R/url.R @@ -80,15 +80,17 @@ url_parse <- function(url, base_url = NULL) { #' url_modify_relative("http://hadley.nz/a/b/c.html", "/d.html") #' url_modify_relative("http://hadley.nz/a/b/c.html", "d.html") #' url_modify_relative("http://hadley.nz/a/b/c.html", "../d.html") -url_modify <- function(url, - scheme = as_is, - hostname = as_is, - username = as_is, - password = as_is, - port = as_is, - path = as_is, - query = as_is, - fragment = as_is) { +url_modify <- function( + url, + scheme = as_is, + hostname = as_is, + username = as_is, + password = as_is, + port = as_is, + path = as_is, + query = as_is, + fragment = as_is +) { if (!is_string(url) && !is_url(url)) { stop_input_type(url, "a string or parsed URL") } @@ -176,10 +178,11 @@ url_modify_relative <- function(url, relative_url) { #' "percent", uses standard percent encoding (i.e. `%20`), but you can opt-in #' to "form" encoding, which uses `+` instead. url_modify_query <- function( - .url, - ..., - .multi = c("error", "comma", "pipe", "explode"), - .space = c("percent", "form")) { + .url, + ..., + .multi = c("error", "comma", "pipe", "explode"), + .space = c("percent", "form") +) { if (!is_string(.url) && !is_url(.url)) { stop_input_type(.url, "a string or parsed URL") } @@ -227,7 +230,12 @@ print.httr2_url <- function(x, ...) { cli::cli_li("{.field query}: ") id <- cli::cli_ul() # escape curly brackets for cli by replacing single with double brackets - query_vals <- gsub("{", "{{", gsub("}", "}}", x$query, fixed = TRUE), fixed = TRUE) + query_vals <- gsub( + "{", + "{{", + gsub("}", "}}", x$query, fixed = TRUE), + fixed = TRUE + ) cli::cli_li(paste0(" {.field ", names(x$query), "}: ", query_vals)) cli::cli_end(id) } @@ -281,9 +289,11 @@ url_build <- function(url) { prefix <- function(prefix, x) if (!is.null(x)) paste0(prefix, x) paste0( - url$scheme, if (!is.null(url$scheme)) ":", + url$scheme, + if (!is.null(url$scheme)) ":", if (!is.null(url$scheme) || !is.null(authority)) "//", - authority, url$path, + authority, + url$path, prefix("?", query), prefix("#", url$fragment) ) @@ -319,7 +329,10 @@ url_query_parse <- function(query) { #' @export #' @rdname url_query_parse #' @inheritParams url_modify_query -url_query_build <- function(query, .multi = c("error", "comma", "pipe", "explode")) { +url_query_build <- function( + query, + .multi = c("error", "comma", "pipe", "explode") +) { if (!is_named_list(query)) { stop_input_type(query, "a named list") } @@ -344,11 +357,13 @@ elements_build <- function(x, name, collapse, error_call = caller_env()) { paste0(names, "=", values, collapse = collapse) } -format_query_param <- function(x, - name, - multi = FALSE, - form = FALSE, - error_call = caller_env()) { +format_query_param <- function( + x, + name, + multi = FALSE, + form = FALSE, + error_call = caller_env() +) { check_query_param(x, name, multi = multi, error_call = error_call) if (inherits(x, "AsIs")) { @@ -362,7 +377,12 @@ format_query_param <- function(x, x } } -check_query_param <- function(x, name, multi = FALSE, error_call = caller_env()) { +check_query_param <- function( + x, + name, + multi = FALSE, + error_call = caller_env() +) { if (inherits(x, "AsIs")) { if (multi) { ok <- is.character(x) diff --git a/R/utils-multi.R b/R/utils-multi.R index 3fd851fe4..2e1b2b78b 100644 --- a/R/utils-multi.R +++ b/R/utils-multi.R @@ -1,8 +1,10 @@ -multi_dots <- function(..., - .multi = c("error", "comma", "pipe", "explode"), - .space = c("percent", "form"), - error_arg = "...", - error_call = caller_env()) { +multi_dots <- function( + ..., + .multi = c("error", "comma", "pipe", "explode"), + .space = c("percent", "form"), + error_arg = "...", + error_call = caller_env() +) { if (is.function(.multi)) { check_function2(.multi, call = error_call, arg = ".multi") } else { @@ -34,20 +36,40 @@ multi_dots <- function(..., n <- lengths(dots) if (any(n > 1)) { if (is.function(.multi)) { - dots[n > 1] <- imap(dots[n > 1], format_query_param, multi = TRUE, form = form) + dots[n > 1] <- imap( + dots[n > 1], + format_query_param, + multi = TRUE, + form = form + ) dots[n > 1] <- lapply(dots[n > 1], .multi) dots[n > 1] <- lapply(dots[n > 1], I) } else if (.multi == "comma") { - dots[n > 1] <- imap(dots[n > 1], format_query_param, multi = TRUE, form = form) + dots[n > 1] <- imap( + dots[n > 1], + format_query_param, + multi = TRUE, + form = form + ) dots[n > 1] <- lapply(dots[n > 1], paste0, collapse = ",") dots[n > 1] <- lapply(dots[n > 1], I) } else if (.multi == "pipe") { - dots[n > 1] <- imap(dots[n > 1], format_query_param, multi = TRUE, form = form) + dots[n > 1] <- imap( + dots[n > 1], + format_query_param, + multi = TRUE, + form = form + ) dots[n > 1] <- lapply(dots[n > 1], paste0, collapse = "|") dots[n > 1] <- lapply(dots[n > 1], I) } else if (.multi == "explode") { dots <- explode(dots) - dots[n > 1] <- imap(dots[n > 1], format_query_param, multi = TRUE, form = form) + dots[n > 1] <- imap( + dots[n > 1], + format_query_param, + multi = TRUE, + form = form + ) dots[n > 1] <- lapply(dots[n > 1], I) } else if (.multi == "error") { cli::cli_abort( diff --git a/R/utils.R b/R/utils.R index a98bd8f4f..c589d7df7 100644 --- a/R/utils.R +++ b/R/utils.R @@ -32,7 +32,12 @@ bullets <- function(x) { } } -modify_list <- function(.x, ..., .ignore_case = FALSE, error_call = caller_env()) { +modify_list <- function( + .x, + ..., + .ignore_case = FALSE, + error_call = caller_env() +) { dots <- list2(...) if (length(dots) == 0) return(.x) @@ -84,7 +89,12 @@ sys_sleep <- function(seconds, task, fps = 10, progress = NULL) { total = seconds * fps ) - while ({left <- start + seconds - cur_time(); left > 0}) { + while ( + { + left <- start + seconds - cur_time() + left > 0 + } + ) { Sys.sleep(min(1 / fps, left)) cli::cli_progress_update(set = (seconds - left) * fps) } @@ -166,12 +176,14 @@ local_write_lines <- function(..., .env = caller_env()) { path } -check_function2 <- function(x, - ..., - args = NULL, - allow_null = FALSE, - arg = caller_arg(x), - call = caller_env()) { +check_function2 <- function( + x, + ..., + args = NULL, + allow_null = FALSE, + arg = caller_arg(x), + call = caller_env() +) { check_function( x = x, allow_null = allow_null, @@ -191,10 +203,7 @@ check_function2 <- function(x, # Basically copied from rlang. Can be removed when https://github.com/r-lib/rlang/pull/1652 # is merged -.check_function_args <- function(f, - expected_args, - arg, - call) { +.check_function_args <- function(f, expected_args, arg, call) { if (is_null(expected_args)) { return(invisible(NULL)) } @@ -215,7 +224,11 @@ check_function2 <- function(x, } cli::cli_abort( - paste0("{.arg {arg}} must have the {cli::qty(n_expected_args)}argument{?s} {.arg {expected_args}}; ", arg_info, "."), + paste0( + "{.arg {arg}} must have the {cli::qty(n_expected_args)}argument{?s} {.arg {expected_args}}; ", + arg_info, + "." + ), call = call, arg = arg ) @@ -223,16 +236,20 @@ check_function2 <- function(x, # This is inspired by the C interface of `cli_progress_bar()` which has just # 2 arguments: `total` and `config` -create_progress_bar <- function(total, - name, - config, - env = caller_env(), - config_arg = caller_arg(config), - error_call = caller_env()) { +create_progress_bar <- function( + total, + name, + config, + env = caller_env(), + config_arg = caller_arg(config), + error_call = caller_env() +) { if (is_false(config)) { return(list( - update = function(...) {}, - done = function() {} + update = function(...) { + }, + done = function() { + } )) } @@ -324,3 +341,7 @@ log_stream <- function(..., prefix = "<< ") { out <- gsub("\n", paste0("\n", prefix), paste0(prefix, ..., collapse = "")) cli::cat_line(out) } + +paste_c <- function(..., collapse = "") { + paste0(c(...), collapse = collapse) +} diff --git a/air.toml b/air.toml new file mode 100644 index 000000000..e69de29bb diff --git a/tests/testthat/helper-sync.R b/tests/testthat/helper-sync.R index 2839995b5..53b051c8f 100644 --- a/tests/testthat/helper-sync.R +++ b/tests/testthat/helper-sync.R @@ -3,7 +3,9 @@ sync_req <- function(name, .env = parent.frame()) { skip_if_not_installed("nanonext") if (missing(name) || !is.character(name)) { - cli::cli_abort("Use unique (character) name for each sync_req() / sync_rep() pair") + cli::cli_abort( + "Use unique (character) name for each sync_req() / sync_rep() pair" + ) } connected <- FALSE cv <- nanonext::cv() @@ -12,7 +14,11 @@ sync_req <- function(name, .env = parent.frame()) { nanonext::pipe_notify(sock, cv, add = TRUE) nanonext::listen(sock, url = sprintf("ipc:///tmp/nanonext%s", name)) - function(expr = {}, timeout = 1000L) { + function( + expr = { + }, + timeout = 1000L + ) { if (!connected) { nanonext::until(cv, timeout) connected <<- TRUE @@ -27,7 +33,9 @@ sync_req <- function(name, .env = parent.frame()) { sync_rep <- function(name, .env = parent.frame()) { if (missing(name) || !is.character(name)) { - cli::cli_abort("Use unique (character) name for each sync_req() / sync_rep() pair") + cli::cli_abort( + "Use unique (character) name for each sync_req() / sync_rep() pair" + ) } connected <- FALSE @@ -37,7 +45,11 @@ sync_rep <- function(name, .env = parent.frame()) { nanonext::pipe_notify(sock, cv, add = TRUE) nanonext::dial(sock, url = sprintf("ipc:///tmp/nanonext%s", name)) - function(expr = {}, timeout = 1000L) { + function( + expr = { + }, + timeout = 1000L + ) { if (!connected) { nanonext::until(cv, timeout) connected <<- TRUE diff --git a/tests/testthat/test-content-type.R b/tests/testthat/test-content-type.R index 8b1b30bf6..cebe30d59 100644 --- a/tests/testthat/test-content-type.R +++ b/tests/testthat/test-content-type.R @@ -21,7 +21,10 @@ test_that("can check type of response", { test_that("useful error even if no content type", { resp <- response() - expect_snapshot(resp_check_content_type(resp, "application/xml"), error = TRUE) + expect_snapshot( + resp_check_content_type(resp, "application/xml"), + error = TRUE + ) }) test_that("can parse content type", { @@ -52,10 +55,17 @@ test_that("invalid type returns empty strings", { test_that("check_content_type() can consult suffixes", { expect_no_error(check_content_type("application/json", "application/json")) - expect_snapshot(check_content_type("application/json", "application/xml"), error = TRUE) + expect_snapshot( + check_content_type("application/json", "application/xml"), + error = TRUE + ) # works with suffixes - expect_no_error(check_content_type("application/test+json", "application/json", "json")) + expect_no_error(check_content_type( + "application/test+json", + "application/json", + "json" + )) expect_snapshot( check_content_type("application/test+json", "application/xml", "xml"), error = TRUE @@ -63,7 +73,11 @@ test_that("check_content_type() can consult suffixes", { # can use multiple valid types expect_no_error( - check_content_type("application/test+json", c("text/html", "application/json"), "json") + check_content_type( + "application/test+json", + c("text/html", "application/json"), + "json" + ) ) expect_snapshot( check_content_type("application/xml", c("text/html", "application/json")), diff --git a/tests/testthat/test-curl.R b/tests/testthat/test-curl.R index 621b7f193..8fd98dc12 100644 --- a/tests/testthat/test-curl.R +++ b/tests/testthat/test-curl.R @@ -31,7 +31,10 @@ test_that("captures key components of call", { ) # Captures flags - expect_equal(curl_args("curl 'http://example.com' --verbose")$`--verbose`, TRUE) + expect_equal( + curl_args("curl 'http://example.com' --verbose")$`--verbose`, + TRUE + ) }) test_that("can accept multiple data arguments", { @@ -43,7 +46,9 @@ test_that("can accept multiple data arguments", { test_that("can handle line breaks", { expect_equal( - curl_args("curl 'http://example.com' \\\n -H 'A: 1' \\\n -H 'B: 2'")$`--header`, + curl_args( + "curl 'http://example.com' \\\n -H 'A: 1' \\\n -H 'B: 2'" + )$`--header`, c("A: 1", "B: 2") ) }) @@ -75,7 +80,12 @@ test_that("common headers can be removed", { sec_fetch_headers <- "-H 'Sec-Fetch-Dest: empty' -H 'Sec-Fetch-Mode: cors'" sec_ch_ua_headers <- "-H 'sec-ch-ua-mobile: ?0'" other_headers <- "-H 'Accept: application/vnd.api+json'" - cmd <- paste("curl http://x.com -A agent -e ref", sec_fetch_headers, sec_ch_ua_headers, other_headers) + cmd <- paste( + "curl http://x.com -A agent -e ref", + sec_fetch_headers, + sec_ch_ua_headers, + other_headers + ) headers <- curl_normalize(cmd)$headers expect_snapshot({ print(curl_simplify_headers(headers, simplify_headers = TRUE)) @@ -138,7 +148,9 @@ test_that("can translate data", { expect_snapshot({ curl_translate("curl http://example.com --data abcdef") - curl_translate("curl http://example.com --data abcdef -H Content-Type:text/plain") + curl_translate( + "curl http://example.com --data abcdef -H Content-Type:text/plain" + ) }) }) @@ -154,8 +166,12 @@ test_that("can translate json", { skip_if(getRversion() < "4.1") expect_snapshot({ - curl_translate(r"--{curl http://example.com --data-raw '{"a": 1, "b": "text"}' -H Content-Type:application/json}--") - curl_translate(r"--{curl http://example.com --json '{"a": 1, "b": "text"}'}--") + curl_translate( + r"--{curl http://example.com --data-raw '{"a": 1, "b": "text"}' -H Content-Type:application/json}--" + ) + curl_translate( + r"--{curl http://example.com --json '{"a": 1, "b": "text"}'}--" + ) }) }) @@ -178,11 +194,15 @@ test_that("can evaluate simple calls", { body <- resp_body_json(resp) expect_equal(body$form$A, "1") - resp <- curl_translate_eval(glue("curl {the$test_app$url()}/delete -X delete")) + resp <- curl_translate_eval(glue( + "curl {the$test_app$url()}/delete -X delete" + )) body <- resp_body_json(resp) expect_equal(body$method, "delete") - resp <- curl_translate_eval(glue("curl {the$test_app$url()}//basic-auth/u/p -u u:p")) + resp <- curl_translate_eval(glue( + "curl {the$test_app$url()}//basic-auth/u/p -u u:p" + )) body <- resp_body_json(resp) expect_true(body$authenticated) }) @@ -222,10 +242,14 @@ test_that("encode_string2() produces simple strings", { expect_equal(encode_string2('x"\'x'), 'r"---{x"\'x}---"') skip_if(getRversion() < "4.1") - cmd <- paste0("curl 'http://example.com' \ + cmd <- paste0( + "curl 'http://example.com' \ -X 'PATCH' \ -H 'Content-Type: application/json' \ - --data-raw ", '{"data":{"x":1,"y":"a","nested":{"z":[1,2,3]}}}', "\ - --compressed") + --data-raw ", + '{"data":{"x":1,"y":"a","nested":{"z":[1,2,3]}}}', + "\ + --compressed" + ) expect_snapshot(curl_translate(cmd)) }) diff --git a/tests/testthat/test-headers.R b/tests/testthat/test-headers.R index 983fb5a20..a54f7df5f 100644 --- a/tests/testthat/test-headers.R +++ b/tests/testthat/test-headers.R @@ -56,5 +56,5 @@ test_that("can flatten repeated inputs", { test_that("redacted inputs are preserved", { x <- new_headers(list(x = "x"), redact = "x") - expect_equal(headers_flatten(x), x) + expect_equal(headers_flatten(x), x) }) diff --git a/tests/testthat/test-oauth-client.R b/tests/testthat/test-oauth-client.R index 89463ca56..79e71a15c 100644 --- a/tests/testthat/test-oauth-client.R +++ b/tests/testthat/test-oauth-client.R @@ -17,21 +17,29 @@ test_that("checks auth types have needed args", { }) test_that("client has useful print method", { - url <-"http://example.com" + url <- "http://example.com" expect_snapshot({ oauth_client("x", url) oauth_client("x", url, secret = "SECRET") - oauth_client("x", url, auth = function(...) {xxx}) + oauth_client("x", url, auth = function(...) { + xxx + }) }) }) test_that("picks default auth", { expect_equal( oauth_client("x", "url", key = NULL)$auth, - "oauth_client_req_auth_body") + "oauth_client_req_auth_body" + ) expect_equal( - oauth_client("x", "url", key = "key", auth_params = list(claim = list()))$auth, + oauth_client( + "x", + "url", + key = "key", + auth_params = list(claim = list()) + )$auth, "oauth_client_req_auth_jwt_sig" ) }) @@ -55,5 +63,8 @@ test_that("can authenticate using header or body", { ) req_b <- oauth_client_req_auth(req, client("body")) - expect_equal(req_b$body$data, list(client_id = I("id"), client_secret = I("secret"))) + expect_equal( + req_b$body$data, + list(client_id = I("id"), client_secret = I("secret")) + ) }) diff --git a/tests/testthat/test-oauth-flow-auth-code.R b/tests/testthat/test-oauth-flow-auth-code.R index 5a5afc4cf..110250e4c 100644 --- a/tests/testthat/test-oauth-flow-auth-code.R +++ b/tests/testthat/test-oauth-flow-auth-code.R @@ -85,7 +85,6 @@ test_that("old args are deprecated", { expect_snapshot( redirect <- normalize_redirect_uri("http://x.com", host_ip = "y.com") ) - }) test_that("urls left as is if not changes needed", { @@ -134,21 +133,17 @@ test_that("external auth code sources are detected correctly", { test_that("auth codes can be retrieved from an external source", { skip_on_cran() - local_mocked_bindings(sys_sleep = function(...) {}) + local_mocked_bindings(sys_sleep = function(...) { + }) req <- local_app_request(function(req, res) { # Error on first, and then respond on second authorized <- res$app$locals$authorized %||% FALSE if (!authorized) { res$app$locals$authorized <- TRUE - res$ - set_status(404L)$ - set_type("text/plain")$ - send("Not found") + res$set_status(404L)$set_type("text/plain")$send("Not found") } else { - res$ - set_status(200L)$ - send_json(text = '{"code":"abc123"}') + res$set_status(200L)$send_json(text = '{"code":"abc123"}') } }) diff --git a/tests/testthat/test-oauth-flow-jwt.R b/tests/testthat/test-oauth-flow-jwt.R index 661182d36..37e7959db 100644 --- a/tests/testthat/test-oauth-flow-jwt.R +++ b/tests/testthat/test-oauth-flow-jwt.R @@ -4,7 +4,10 @@ # 4. secret_write_rds(json, "tests/testthat/test-oauth-flow-jwt-google.rds", "HTTR2_KEY") test_that("can generate token and use it automatically", { - secrets <- secret_read_rds(test_path("test-oauth-flow-jwt-google.rds"), "HTTR2_KEY") + secrets <- secret_read_rds( + test_path("test-oauth-flow-jwt-google.rds"), + "HTTR2_KEY" + ) client <- oauth_client( id = secrets$client_id, @@ -36,6 +39,11 @@ test_that("validates inputs", { client1 <- oauth_client("test", "http://example.com") expect_snapshot(oauth_flow_bearer_jwt(client1), error = TRUE) - client2 <- oauth_client("test", "http://example.com", key = "abc", auth_params = list(claim = "123")) + client2 <- oauth_client( + "test", + "http://example.com", + key = "abc", + auth_params = list(claim = "123") + ) expect_snapshot(oauth_flow_bearer_jwt(client2, claim = NULL), error = TRUE) }) diff --git a/tests/testthat/test-oauth-flow.R b/tests/testthat/test-oauth-flow.R index a3222f5b9..e1bb578e1 100644 --- a/tests/testthat/test-oauth-flow.R +++ b/tests/testthat/test-oauth-flow.R @@ -51,7 +51,10 @@ test_that("returns body if known good structure", { }) test_that("converts expires_in to numeric", { - resp <- response_json(200L, body = list(access_token = "10", expires_in = "20")) + resp <- response_json( + 200L, + body = list(access_token = "10", expires_in = "20") + ) body <- oauth_flow_parse(resp, "test") expect_equal(body$expires_in, 20) }) diff --git a/tests/testthat/test-oauth.R b/tests/testthat/test-oauth.R index f899083b7..e9f721871 100644 --- a/tests/testthat/test-oauth.R +++ b/tests/testthat/test-oauth.R @@ -1,6 +1,9 @@ test_that("invalid token test is specific", { req <- request("https://example.com") - resp_invalid <- response(401, headers = 'WWW-Authenticate: Bearer realm="example", error="invalid_token", error_description="The access token expired"') + resp_invalid <- response( + 401, + headers = 'WWW-Authenticate: Bearer realm="example", error="invalid_token", error_description="The access token expired"' + ) # Doesn't trigger for response if request doesn't use OAuth expect_false(resp_is_invalid_oauth_token(req, resp_invalid)) diff --git a/tests/testthat/test-parse.R b/tests/testthat/test-parse.R index ab42b9a2b..7d402bfb8 100644 --- a/tests/testthat/test-parse.R +++ b/tests/testthat/test-parse.R @@ -85,6 +85,6 @@ test_that("parse_name_equals_value handles empty values", { test_that("parse_match converts missing matches to NULL", { expect_equal( parse_match("abbbd", "(a)(b+)(c*)(d)"), - list("a", "bbb", NULL, "d" - )) + list("a", "bbb", NULL, "d") + ) }) diff --git a/tests/testthat/test-req-auth-aws.R b/tests/testthat/test-req-auth-aws.R index 002c6ec6e..836f85cc8 100644 --- a/tests/testthat/test-req-auth-aws.R +++ b/tests/testthat/test-req-auth-aws.R @@ -1,10 +1,15 @@ test_that("can correctly sign a request with dummy credentials", { req <- request("https://sts.amazonaws.com/") - req <- req_auth_aws_v4(req, + req <- req_auth_aws_v4( + req, aws_access_key_id = "AKIAIOSFODNN7EXAMPLE", aws_secret_access_key = "wJalrXUtnFEMI/K7MDENG/bPxRfiCYEXAMPLEKEY" ) - req <- req_body_form(req, Action = "GetCallerIdentity", Version = "2011-06-15") + req <- req_body_form( + req, + Action = "GetCallerIdentity", + Version = "2011-06-15" + ) expect_error(req_perform(req), class = "httr2_http_403") # And can clear non-existant cache @@ -17,7 +22,8 @@ test_that("can correctly sign a request with live credentials", { # https://docs.aws.amazon.com/STS/latest/APIReference/API_GetCallerIdentity.html req <- request("https://sts.amazonaws.com/") - req <- req_auth_aws_v4(req, + req <- req_auth_aws_v4( + req, aws_access_key_id = creds$access_key_id, aws_secret_access_key = creds$secret_access_key, aws_session_token = creds$session_token, @@ -58,7 +64,9 @@ test_that("signing agrees with glacier example", { signature <- aws_v4_signature( method = "PUT", - url = url_parse("https://glacier.us-east-1.amazonaws.com/-/vaults/examplevault"), + url = url_parse( + "https://glacier.us-east-1.amazonaws.com/-/vaults/examplevault" + ), headers = list( "x-amz-date" = "20120525T002453Z", "x-amz-glacier-version" = "2012-06-01" diff --git a/tests/testthat/test-req-body.R b/tests/testthat/test-req-body.R index 696ff98cf..d1d754a0d 100644 --- a/tests/testthat/test-req-body.R +++ b/tests/testthat/test-req-body.R @@ -15,7 +15,6 @@ test_that("can send file", { }) test_that("can send file with redirect", { - str <- paste(letters, collapse = "") path <- tempfile() writeChar(str, path) @@ -86,13 +85,12 @@ test_that("can modify json data", { req <- request_test() %>% req_body_json(data = list(a = 1, b = 2, d = 4)) %>% req_body_json_modify(a = 10, b = NULL, c = 3) - expect_equal(req$body$data, list(a = 10, d = 4, c = 3)) + expect_equal(req$body$data, list(a = 10, d = 4, c = 3)) req <- request_test() %>% req_body_json(data = list(a = list(b = list(c = 1, d = 2), e = 3))) %>% req_body_json_modify(a = list(b = list(c = 101), e = 103)) - expect_equal(req$body$data, list(a = list(b = list(c = 101, d = 2), e = 103))) - + expect_equal(req$body$data, list(a = list(b = list(c = 101, d = 2), e = 103))) }) test_that("can send named elements as form/multipart", { diff --git a/tests/testthat/test-req-cache.R b/tests/testthat/test-req-cache.R index 9dc1a74f3..127799168 100644 --- a/tests/testthat/test-req-cache.R +++ b/tests/testthat/test-req-cache.R @@ -12,7 +12,8 @@ test_that("never retrieves POST request from cache", { req_cache(tempfile()) # Fake an equivalent GET request in the cache - resp <- response(200, + resp <- response( + 200, headers = "Expires: Wed, 01 Jan 3000 00:00:00 GMT", body = charToRaw("abc") ) @@ -23,7 +24,8 @@ test_that("never retrieves POST request from cache", { test_that("immutable objects retrieved directly from cache", { req <- request("http://example.com") %>% req_cache(tempfile()) - resp <- response(200, + resp <- response( + 200, headers = "Expires: Wed, 01 Jan 3000 00:00:00 GMT", body = charToRaw("abc") ) @@ -38,7 +40,8 @@ test_that("cached cache header added to request", { req2 <- cache_pre_fetch(req) expect_equal(req2, req) - resp <- response(200, + resp <- response( + 200, headers = c('Etag: "abc"', "Last-Modified: Wed, 01 Jan 2020 00:00:00 GMT"), body = charToRaw("abc") ) @@ -46,7 +49,10 @@ test_that("cached cache header added to request", { # After caching adds caching headers req3 <- cache_pre_fetch(req) - expect_equal(req3$headers$`If-Modified-Since`, "Wed, 01 Jan 2020 00:00:00 GMT") + expect_equal( + req3$headers$`If-Modified-Since`, + "Wed, 01 Jan 2020 00:00:00 GMT" + ) expect_equal(req3$headers$`If-None-Match`, '"abc"') }) @@ -87,7 +93,8 @@ test_that("automatically adds to cache", { test_that("cache emits useful debugging info", { req <- request("http://example.com") %>% req_cache(tempfile(), debug = TRUE) - resp <- response(200, + resp <- response( + 200, headers = "Expires: Wed, 01 Jan 3000 00:00:00 GMT", body = charToRaw("abc") ) @@ -261,18 +268,23 @@ test_that("correctly determines if response is cacheable", { expect_equal(is_cacheable(200, headers = "Expires: ABC"), TRUE) expect_equal(is_cacheable(200, headers = "Cache-Control: max-age=10"), TRUE) expect_equal(is_cacheable(200, headers = "Etag: ABC"), TRUE) - expect_equal(is_cacheable(200, headers = c("Etag: ABC", "Cache-Control: no-store")), FALSE) + expect_equal( + is_cacheable(200, headers = c("Etag: ABC", "Cache-Control: no-store")), + FALSE + ) expect_equal(is_cacheable(200), FALSE) expect_equal(is_cacheable(404), FALSE) expect_equal(is_cacheable(method = "POST"), FALSE) }) test_that("can extract cache info with correct types", { - resp <- response(headers = c( - "Expires: Wed, 01 Jan 2020 00:00:00 GMT", - "Last-Modified: Wed, 01 Jan 2010 00:00:00 GMT", - "Etag: \"abc\"" - )) + resp <- response( + headers = c( + "Expires: Wed, 01 Jan 2020 00:00:00 GMT", + "Last-Modified: Wed, 01 Jan 2010 00:00:00 GMT", + "Etag: \"abc\"" + ) + ) info <- resp_cache_info(resp) expect_equal(info$expires, local_time("2020-01-01")) @@ -284,17 +296,21 @@ test_that("can extract cache info with correct types", { test_that("can extract various expiry values", { # Prefer Date + max-age - resp1 <- response(headers = c( - "Date: Wed, 01 Jan 2020 00:00:00 GMT", - "Cache-Control: max-age=3600", - "Expiry: Wed, 01 Jan 2020 00:00:00 GMT" - )) + resp1 <- response( + headers = c( + "Date: Wed, 01 Jan 2020 00:00:00 GMT", + "Cache-Control: max-age=3600", + "Expiry: Wed, 01 Jan 2020 00:00:00 GMT" + ) + ) expect_equal(resp_cache_expires(resp1), local_time("2020-01-01 01:00")) # Fall back to Expires - resp2 <- response(headers = c( - "Expires: Wed, 01 Jan 2020 00:00:00 GMT" - )) + resp2 <- response( + headers = c( + "Expires: Wed, 01 Jan 2020 00:00:00 GMT" + ) + ) expect_equal(resp_cache_expires(resp2), local_time("2020-01-01 00:00")) # Returns NA if no expiry diff --git a/tests/testthat/test-req-cookies.R b/tests/testthat/test-req-cookies.R index 8fc103587..f77e3c1e2 100644 --- a/tests/testthat/test-req-cookies.R +++ b/tests/testthat/test-req-cookies.R @@ -18,7 +18,6 @@ test_that("can read/write cookies", { resp_body_json() %>% .$cookies expect_mapequal(cookies, list(x = "a", y = "b", z = "c")) - }) test_that("can set cookies", { diff --git a/tests/testthat/test-req-headers.R b/tests/testthat/test-req-headers.R index 9652e18e0..195046c02 100644 --- a/tests/testthat/test-req-headers.R +++ b/tests/testthat/test-req-headers.R @@ -52,7 +52,10 @@ test_that("can control which headers to redact", { req <- request("http://example.com") expect_redacted(req_headers(req, a = 1L, b = 2L), character()) expect_redacted(req_headers(req, a = 1L, b = 2L, .redact = "a"), "a") - expect_redacted(req_headers(req, a = 1L, b = 2L, .redact = c("a", "b")), c("a", "b")) + expect_redacted( + req_headers(req, a = 1L, b = 2L, .redact = c("a", "b")), + c("a", "b") + ) }) test_that("only redacts supplied headers", { diff --git a/tests/testthat/test-req-mock.R b/tests/testthat/test-req-mock.R index 453caecda..026b6ab87 100644 --- a/tests/testthat/test-req-mock.R +++ b/tests/testthat/test-req-mock.R @@ -36,7 +36,8 @@ test_that("mocked_response_sequence returns responses then errors", { test_that("validates inputs", { expect_snapshot(error = TRUE, { - local_mocked_responses(function(foo) {}) + local_mocked_responses(function(foo) { + }) local_mocked_responses(10) }) }) diff --git a/tests/testthat/test-req-perform-connection.R b/tests/testthat/test-req-perform-connection.R index e8bd5902d..2f0e56d04 100644 --- a/tests/testthat/test-req-perform-connection.R +++ b/tests/testthat/test-req-perform-connection.R @@ -33,10 +33,10 @@ test_that("reads body on error", { test_that("can retry a transient error", { req <- local_app_request(function(req, res) { if (res$app$locals$i == 1) { - res$ - set_status(429)$ - set_header("retry-after", 0)$ - send_json(list(status = "waiting"), auto_unbox = TRUE) + res$set_status(429)$set_header("retry-after", 0)$send_json( + list(status = "waiting"), + auto_unbox = TRUE + ) } else { res$send_json(list(status = "done"), auto_unbox = TRUE) } diff --git a/tests/testthat/test-req-perform-iterative.R b/tests/testthat/test-req-perform-iterative.R index 4ec118541..53dd5707f 100644 --- a/tests/testthat/test-req-perform-iterative.R +++ b/tests/testthat/test-req-perform-iterative.R @@ -9,7 +9,10 @@ test_that("can perform multiple requests", { ) expect_length(resps, 4) - expect_equal(resp_url(resps[[4]]), paste0(example_url(), "iris?limit=5&page_index=4")) + expect_equal( + resp_url(resps[[4]]), + paste0(example_url(), "iris?limit=5&page_index=4") + ) }) test_that("can save results to disk", { @@ -79,8 +82,23 @@ test_that("checks its inputs", { expect_snapshot(error = TRUE, { req_perform_iterative(1) req_perform_iterative(req, function(x, y) x + y) - req_perform_iterative(req, function(resp, req) {}, path = 1) - req_perform_iterative(req, function(resp, req) {}, max_reqs = -1) - req_perform_iterative(req, function(resp, req) {}, progress = -1) + req_perform_iterative( + req, + function(resp, req) { + }, + path = 1 + ) + req_perform_iterative( + req, + function(resp, req) { + }, + max_reqs = -1 + ) + req_perform_iterative( + req, + function(resp, req) { + }, + progress = -1 + ) }) }) diff --git a/tests/testthat/test-req-perform-parallel.R b/tests/testthat/test-req-perform-parallel.R index 9cf296fee..9e5689924 100644 --- a/tests/testthat/test-req-perform-parallel.R +++ b/tests/testthat/test-req-perform-parallel.R @@ -74,7 +74,8 @@ test_that("objects are cached", { test_that("immutable objects retrieved from cache", { req <- request("http://example.com") %>% req_cache(tempfile()) - resp <- response(200, + resp <- response( + 200, headers = "Expires: Wed, 01 Jan 3000 00:00:00 GMT", body = charToRaw("abc") ) @@ -168,10 +169,10 @@ test_that("requests are throttled", { test_that("can retry an OAuth failure", { req <- local_app_request(function(req, res) { if (res$app$locals$i == 1) { - res$ - set_status(401)$ - set_header("WWW-Authenticate", 'Bearer realm="example", error="invalid_token"')$ - send_json(list(status = "failed"), auto_unbox = TRUE) + res$set_status(401)$set_header( + "WWW-Authenticate", + 'Bearer realm="example", error="invalid_token"' + )$send_json(list(status = "failed"), auto_unbox = TRUE) } else { res$send_json(list(status = "done"), auto_unbox = TRUE) } @@ -179,7 +180,9 @@ test_that("can retry an OAuth failure", { req <- req_policies(req, auth_oauth = TRUE) reset <- 0 - local_mocked_bindings(req_auth_clear_cache = function(...) reset <<- reset + 1) + local_mocked_bindings( + req_auth_clear_cache = function(...) reset <<- reset + 1 + ) queue <- RequestQueue$new(list(req), progress = FALSE) queue$process() @@ -190,10 +193,10 @@ test_that("can retry an OAuth failure", { test_that("but multiple failures causes an error", { req <- local_app_request(function(req, res) { - res$ - set_status(401)$ - set_header("WWW-Authenticate", 'Bearer realm="example", error="invalid_token"')$ - send_json(list(status = "failed"), auto_unbox = TRUE) + res$set_status(401)$set_header( + "WWW-Authenticate", + 'Bearer realm="example", error="invalid_token"' + )$send_json(list(status = "failed"), auto_unbox = TRUE) }) req <- req_policies(req, auth_oauth = TRUE) @@ -205,10 +208,10 @@ test_that("but multiple failures causes an error", { test_that("can retry a transient error", { req <- local_app_request(function(req, res) { if (res$app$locals$i == 1) { - res$ - set_status(429)$ - set_header("retry-after", 2)$ - send_json(list(status = "waiting"), auto_unbox = TRUE) + res$set_status(429)$set_header("retry-after", 2)$send_json( + list(status = "waiting"), + auto_unbox = TRUE + ) } else { res$send_json(list(status = "done"), auto_unbox = TRUE) } diff --git a/tests/testthat/test-req-perform.R b/tests/testthat/test-req-perform.R index 0120a69c1..c796d61f2 100644 --- a/tests/testthat/test-req-perform.R +++ b/tests/testthat/test-req-perform.R @@ -64,7 +64,8 @@ test_that("don't retry curl errors by default", { expect_error(req_perform(req), class = "httr2_failure") # But can opt-in to it - req <- request("") %>% req_retry(max_tries = 2, retry_on_failure = TRUE, failure_realm = "x") + req <- request("") %>% + req_retry(max_tries = 2, retry_on_failure = TRUE, failure_realm = "x") cnd <- catch_cnd(req_perform(req), "httr2_retry") expect_equal(cnd$tries, 1) }) @@ -72,10 +73,9 @@ test_that("don't retry curl errors by default", { test_that("can retry a transient error", { req <- local_app_request(function(req, res) { if (res$app$locals$i == 1) { - res$ - set_status(429)$ - set_header("retry-after", 0)$ - send_json(list(status = "waiting")) + res$set_status(429)$set_header("retry-after", 0)$send_json(list( + status = "waiting" + )) } else { res$send_json(list(status = "done")) } @@ -111,7 +111,10 @@ test_that("can cache requests with etags", { resp1 <- req_perform(req) expect_condition( - expect_condition(resp2 <- req_perform(req), class = "httr2_cache_not_modified"), + expect_condition( + resp2 <- req_perform(req), + class = "httr2_cache_not_modified" + ), class = "httr2_cache_save" ) }) diff --git a/tests/testthat/test-req-promise.R b/tests/testthat/test-req-promise.R index d8d72a893..52f3171ed 100644 --- a/tests/testthat/test-req-promise.R +++ b/tests/testthat/test-req-promise.R @@ -31,7 +31,11 @@ test_that("correctly prepares request", { expect_snapshot( . <- extract_promise(req_perform_promise(req, verbosity = 1)), transform = function(x) { - gsub("(Date|Host|User-Agent|ETag|Content-Length|Accept-Encoding): .*", "\\1: ", x) + gsub( + "(Date|Host|User-Agent|ETag|Content-Length|Accept-Encoding): .*", + "\\1: ", + x + ) } ) }) @@ -50,9 +54,10 @@ test_that("can promise to download files", { test_that("promises can retrieve from cache", { req <- request("http://example.com") %>% req_cache(tempfile()) - resp <- response(200, - headers = "Expires: Wed, 01 Jan 3000 00:00:00 GMT", - body = charToRaw("abc") + resp <- response( + 200, + headers = "Expires: Wed, 01 Jan 3000 00:00:00 GMT", + body = charToRaw("abc") ) cache_set(req, resp) @@ -78,7 +83,10 @@ test_that("both curl and HTTP errors in promises are rejected", { }) test_that("req_perform_promise doesn't leave behind poller", { - skip_if_not(later::loop_empty(), "later::global_loop not empty when test started") + skip_if_not( + later::loop_empty(), + "later::global_loop not empty when test started" + ) p <- req_perform_promise(request_test("/delay/:secs", secs = 0.25)) # Before promise is resolved, there should be an operation in our later loop expect_false(later::loop_empty()) @@ -91,7 +99,10 @@ test_that("req_perform_promise doesn't leave behind poller", { test_that("req_perform_promise can use non-default pool", { custom_pool <- curl::new_pool() p1 <- req_perform_promise(request_test("/delay/:secs", secs = 0.25)) - p2 <- req_perform_promise(request_test("/delay/:secs", secs = 0.25), pool = custom_pool) + p2 <- req_perform_promise( + request_test("/delay/:secs", secs = 0.25), + pool = custom_pool + ) expect_equal(length(curl::multi_list(custom_pool)), 1) p1_value <- extract_promise(p1) expect_equal(resp_status(p1_value), 200) @@ -119,7 +130,10 @@ test_that("req_perform_promise uses the default loop", { # You can't create an async response in the temp loop without explicitly # specifying a pool - expect_snapshot(p4 <- req_perform_promise(request_test("/get")), error = TRUE) + expect_snapshot( + p4 <- req_perform_promise(request_test("/get")), + error = TRUE + ) # Like I said, you can create this, but it won't work until we get back # outside the temp loop diff --git a/tests/testthat/test-req-retries.R b/tests/testthat/test-req-retries.R index 5dc2200be..82190ca56 100644 --- a/tests/testthat/test-req-retries.R +++ b/tests/testthat/test-req-retries.R @@ -71,7 +71,7 @@ test_that("useful message if `after` wrong", { req <- request_test() %>% req_retry( is_transient = function(resp) TRUE, - after = function(resp) resp, + after = function(resp) resp, max_tries = 2 ) diff --git a/tests/testthat/test-req-throttle.R b/tests/testthat/test-req-throttle.R index 43a980b2f..cfc346eee 100644 --- a/tests/testthat/test-req-throttle.R +++ b/tests/testthat/test-req-throttle.R @@ -8,7 +8,7 @@ test_that("throttling affects request performance", { local_mocked_bindings(unix_time = function() 0.1) expect_snapshot(time <- system.time(req_perform(req))[[3]]) - expect_gte(time, 1/4 - 0.1) + expect_gte(time, 1 / 4 - 0.1) }) test_that("first request isn't throttled", { diff --git a/tests/testthat/test-req-url.R b/tests/testthat/test-req-url.R index 759c33a86..20e1a259a 100644 --- a/tests/testthat/test-req-url.R +++ b/tests/testthat/test-req-url.R @@ -7,21 +7,48 @@ test_that("automatically adds /", { req1 <- request("http://example.com") req2 <- request("http://example.com/") - expect_equal(req_url_path(req1, "/index.html")$url, "http://example.com/index.html") - expect_equal(req_url_path(req1, "index.html")$url, "http://example.com/index.html") - expect_equal(req_url_path(req2, "/index.html")$url, "http://example.com/index.html") - expect_equal(req_url_path(req2, "index.html")$url, "http://example.com/index.html") - - expect_equal(req_url_path_append(req1, "index.html")$url, "http://example.com/index.html") - expect_equal(req_url_path_append(req1, "/index.html")$url, "http://example.com/index.html") - expect_equal(req_url_path_append(req2, "index.html")$url, "http://example.com/index.html") - expect_equal(req_url_path_append(req2, "/index.html")$url, "http://example.com/index.html") + expect_equal( + req_url_path(req1, "/index.html")$url, + "http://example.com/index.html" + ) + expect_equal( + req_url_path(req1, "index.html")$url, + "http://example.com/index.html" + ) + expect_equal( + req_url_path(req2, "/index.html")$url, + "http://example.com/index.html" + ) + expect_equal( + req_url_path(req2, "index.html")$url, + "http://example.com/index.html" + ) + + expect_equal( + req_url_path_append(req1, "index.html")$url, + "http://example.com/index.html" + ) + expect_equal( + req_url_path_append(req1, "/index.html")$url, + "http://example.com/index.html" + ) + expect_equal( + req_url_path_append(req2, "index.html")$url, + "http://example.com/index.html" + ) + expect_equal( + req_url_path_append(req2, "/index.html")$url, + "http://example.com/index.html" + ) }) test_that("can append multiple components", { req <- request("http://example.com/x") expect_equal(req_url_path(req, "a", "b")$url, "http://example.com/a/b") - expect_equal(req_url_path_append(req, "a", "b")$url, "http://example.com/x/a/b") + expect_equal( + req_url_path_append(req, "a", "b")$url, + "http://example.com/x/a/b" + ) }) test_that("can handle empty path", { @@ -38,24 +65,48 @@ test_that("can handle empty path", { test_that("can handle path vector", { req <- request("http://example.com/x") expect_equal(req_url_path(req, c("a", "b"))$url, "http://example.com/a/b") - expect_equal(req_url_path_append(req, c("a", "b"))$url, "http://example.com/x/a/b") - expect_equal(req_url_path_append(req, c("a", "b"), NULL)$url, "http://example.com/x/a/b") + expect_equal( + req_url_path_append(req, c("a", "b"))$url, + "http://example.com/x/a/b" + ) + expect_equal( + req_url_path_append(req, c("a", "b"), NULL)$url, + "http://example.com/x/a/b" + ) }) test_that("can set query params", { req <- request("http://example.com/") - expect_equal(req_url_query(req, a = 1, b = 2)$url, "http://example.com/?a=1&b=2") - expect_equal(req_url_query(req, a = 1, b = 2, c = NULL)$url, "http://example.com/?a=1&b=2") - expect_equal(req_url_query(req, !!!list(a = 1, b = 2))$url, "http://example.com/?a=1&b=2") + expect_equal( + req_url_query(req, a = 1, b = 2)$url, + "http://example.com/?a=1&b=2" + ) + expect_equal( + req_url_query(req, a = 1, b = 2, c = NULL)$url, + "http://example.com/?a=1&b=2" + ) + expect_equal( + req_url_query(req, !!!list(a = 1, b = 2))$url, + "http://example.com/?a=1&b=2" + ) - expect_equal(req_url_query(req, a = 1, a = 2)$url, "http://example.com/?a=1&a=2") - expect_equal(req_url_query(req, !!!list(a = 1, a = 2))$url, "http://example.com/?a=1&a=2") + expect_equal( + req_url_query(req, a = 1, a = 2)$url, + "http://example.com/?a=1&a=2" + ) + expect_equal( + req_url_query(req, !!!list(a = 1, a = 2))$url, + "http://example.com/?a=1&a=2" + ) }) test_that("can control space handling", { req <- request("http://example.com/") expect_equal(req_url_query(req, a = " ")$url, "http://example.com/?a=%20") - expect_equal(req_url_query(req, a = " ", .space = "form")$url, "http://example.com/?a=+") + expect_equal( + req_url_query(req, a = " ", .space = "form")$url, + "http://example.com/?a=+" + ) expect_snapshot( req_url_query(req, a = " ", .space = "bar"), @@ -98,7 +149,10 @@ test_that("can modify query params iteratively", { req <- request("http://example.com/?a=1&b=2") expect_equal(req_url_query(req, c = 3)$url, "http://example.com/?a=1&b=2&c=3") expect_equal(req_url_query(req, a = 2)$url, "http://example.com/?b=2&a=2") - expect_equal(req_url_query(req, a = 1, a = 2)$url, "http://example.com/?b=2&a=1&a=2") + expect_equal( + req_url_query(req, a = 1, a = 2)$url, + "http://example.com/?b=2&a=1&a=2" + ) expect_equal(req_url_query(req, b = NULL)$url, "http://example.com/?a=1") }) diff --git a/tests/testthat/test-req-verbose.R b/tests/testthat/test-req-verbose.R index 691ed0b48..7fb665901 100644 --- a/tests/testthat/test-req-verbose.R +++ b/tests/testthat/test-req-verbose.R @@ -1,4 +1,3 @@ - test_that("can request verbose record of request", { req <- local_app_request(method = "post", function(req, res) { res$send_json(list(x = 1), auto_unbox = TRUE) @@ -8,15 +7,21 @@ test_that("can request verbose record of request", { req_verbose_test() # Snapshot test of response - verbose_resp <- req %>% req_verbose(header_resp = TRUE, body_resp = TRUE, header_req = FALSE) - expect_snapshot(. <- req_perform(verbose_resp), transform = transform_verbose_response) + verbose_resp <- req %>% + req_verbose(header_resp = TRUE, body_resp = TRUE, header_req = FALSE) + expect_snapshot( + . <- req_perform(verbose_resp), + transform = transform_verbose_response + ) # Snapshot test of request - verbose_req <- req %>% req_verbose(header_req = TRUE, body_req = TRUE, header_resp = FALSE) + verbose_req <- req %>% + req_verbose(header_req = TRUE, body_req = TRUE, header_resp = FALSE) expect_snapshot(. <- req_perform(verbose_req)) # Lightweight test for everything else - verbose_info <- req %>% req_verbose(info = TRUE, header_req = FALSE, header_resp = FALSE) + verbose_info <- req %>% + req_verbose(info = TRUE, header_req = FALSE, header_resp = FALSE) expect_output(. <- req_perform(verbose_info)) }) @@ -32,7 +37,7 @@ test_that("redacts headers as needed", { test_that("can display compressed bodies", { req <- request(example_url()) %>% req_url_path("gzip") %>% - req_verbose_test() %>% + req_verbose_test() %>% req_verbose(header_req = FALSE, header_resp = TRUE, body_resp = TRUE) expect_snapshot(. <- req_perform(req), transform = transform_verbose_response) diff --git a/tests/testthat/test-req.R b/tests/testthat/test-req.R index 600d6b12a..e002dcb86 100644 --- a/tests/testthat/test-req.R +++ b/tests/testthat/test-req.R @@ -8,7 +8,7 @@ test_that("req has basic print method", { }) test_that("printing headers works with {}", { - expect_snapshot(req_headers(request("http://test"), x = "{z}", `{z}` = "x")) + expect_snapshot(req_headers(request("http://test"), x = "{z}", `{z}` = "x")) }) test_that("individually prints repeated headers", { diff --git a/tests/testthat/test-resp-body.R b/tests/testthat/test-resp-body.R index f725702de..3a00681ab 100644 --- a/tests/testthat/test-resp-body.R +++ b/tests/testthat/test-resp-body.R @@ -4,7 +4,8 @@ test_that("read body from disk/memory", { expect_equal(resp_body_raw(resp1), charToRaw("Hi")) expect_equal(resp_body_string(resp1), "Hi") - resp2 <- request_test("base64/:value", value = "SGk=") %>% req_perform(tempfile()) + resp2 <- request_test("base64/:value", value = "SGk=") %>% + req_perform(tempfile()) expect_true(resp_has_body(resp2)) expect_equal(resp_body_string(resp2), "Hi") }) diff --git a/tests/testthat/test-resp-headers.R b/tests/testthat/test-resp-headers.R index bfb36f9a7..755899898 100644 --- a/tests/testthat/test-resp-headers.R +++ b/tests/testthat/test-resp-headers.R @@ -31,15 +31,17 @@ test_that("can parse date header", { }) test_that("can parse both forms of retry-after header", { - resp_abs <- response(headers = c( - "Retry-After: Mon, 18 Jul 2016 16:06:10 GMT", - "Date: Mon, 18 Jul 2016 16:06:00 GMT" - )) + resp_abs <- response( + headers = c( + "Retry-After: Mon, 18 Jul 2016 16:06:10 GMT", + "Date: Mon, 18 Jul 2016 16:06:00 GMT" + ) + ) expect_equal(resp_retry_after(resp_abs), 10) - resp_rel <- response(headers = c( - "Retry-After: 20" - )) + resp_rel <- response( + headers = "Retry-After: 20" + ) expect_equal(resp_retry_after(resp_rel), 20) resp_rel <- response() @@ -49,10 +51,12 @@ test_that("can parse both forms of retry-after header", { # resp_link_url() -------------------------------------------------------------- test_that("can extract specified link url", { - resp <- response(headers = paste0( - 'Link: ; rel="next",', - '; rel="last"' - )) + resp <- response( + headers = paste0( + 'Link: ; rel="next",', + '; rel="last"' + ) + ) expect_equal(resp_link_url(resp, "next"), "https://example.com/1") expect_equal(resp_link_url(resp, "last"), "https://example.com/2") @@ -62,10 +66,12 @@ test_that("can extract specified link url", { }) test_that("can extract from multiple link headers", { - resp <- response(headers = c( - 'Link: ; rel="next"', - 'Link: ; rel="last"' - )) + resp <- response( + headers = c( + 'Link: ; rel="next"', + 'Link: ; rel="last"' + ) + ) expect_equal(resp_link_url(resp, "next"), "https://example.com/1") expect_equal(resp_link_url(resp, "last"), "https://example.com/2") }) diff --git a/tests/testthat/test-resp-status.R b/tests/testthat/test-resp-status.R index e33b57039..de608aa71 100644 --- a/tests/testthat/test-resp-status.R +++ b/tests/testthat/test-resp-status.R @@ -1,7 +1,13 @@ test_that("get some useful output from WWW-Authenticate header", { - resp <- response(401, headers = 'WWW-Authenticate: Bearer realm="example",error="invalid_token",error_description="The access token expired"') + resp <- response( + 401, + headers = 'WWW-Authenticate: Bearer realm="example",error="invalid_token",error_description="The access token expired"' + ) expect_snapshot_error(resp_check_status(resp)) -resp <- response(403, headers = 'WWW-Authenticate: Bearer realm="https://accounts.google.com/", error="insufficient_scope", scope="https://www.googleapis.com/auth/iam https://www.googleapis.com/auth/cloud-platform"') + resp <- response( + 403, + headers = 'WWW-Authenticate: Bearer realm="https://accounts.google.com/", error="insufficient_scope", scope="https://www.googleapis.com/auth/iam https://www.googleapis.com/auth/cloud-platform"' + ) expect_snapshot_error(resp_check_status(resp)) }) diff --git a/tests/testthat/test-resp-stream-aws.R b/tests/testthat/test-resp-stream-aws.R index f55fc64a6..e932f1015 100644 --- a/tests/testthat/test-resp-stream-aws.R +++ b/tests/testthat/test-resp-stream-aws.R @@ -30,12 +30,16 @@ test_that("can return various types of header", { expect_equal(parse_aws_event(bytes)$headers, list(foo = 4294967295)) # long - bytes <- hex_to_raw("0000001d000000018a55bccc03666f6f050000ffffffffffff6b03c255") + bytes <- hex_to_raw( + "0000001d000000018a55bccc03666f6f050000ffffffffffff6b03c255" + ) expected <- structure(1.390671161567e-309, class = "integer64") expect_equal(parse_aws_event(bytes)$headers, list(foo = expected)) # byte array - bytes <- hex_to_raw("0000001c00000001b735957c03666f6f0600050102030405cdda4038") + bytes <- hex_to_raw( + "0000001c00000001b735957c03666f6f0600050102030405cdda4038" + ) expect_equal(parse_aws_event(bytes)$headers, list(foo = as.raw(1:5))) # character @@ -43,11 +47,15 @@ test_that("can return various types of header", { expect_equal(parse_aws_event(bytes)$headers, list(foo = "bar")) # UUID - bytes <- hex_to_raw("00000025000000011b044f8b03666f6f093bfdac5cfe6c402983bfc1de7819f5316056148a") - expect_equal(parse_aws_event( - bytes - )$headers, list(foo = "3bfdac5cfe6c402983bfc1de7819f531")) - + bytes <- hex_to_raw( + "00000025000000011b044f8b03666f6f093bfdac5cfe6c402983bfc1de7819f5316056148a" + ) + expect_equal( + parse_aws_event( + bytes + )$headers, + list(foo = "3bfdac5cfe6c402983bfc1de7819f531") + ) }) test_that("unknown header triggers error", { @@ -56,7 +64,8 @@ test_that("unknown header triggers error", { }) test_that("json content type automatically parsed", { - bytes <- hex_to_raw(" + bytes <- hex_to_raw( + " 000001c20000005bc1123f0b0b3a6576656e742d74797065070015537562736372696265546f 53686172644576656e740d3a636f6e74656e742d747970650700106170706c69636174696f6e 2f6a736f6e0d3a6d6573736167652d747970650700056576656e747b22436f6e74696e756174 @@ -69,7 +78,8 @@ test_that("json content type automatically parsed", { 632d343036372d623433362d303566383863306662356566222c2253657175656e63654e756d 626572223a223439353838363330373936343234353132353936363136333437353239313133 373435393934373336323937343734373039373832353330227d5d7dd84c02f3 - ") + " + ) parsed <- parse_aws_event(bytes) expect_type(parsed$body, "list") }) diff --git a/tests/testthat/test-resp-stream.R b/tests/testthat/test-resp-stream.R index 1c338e159..9e72046b9 100644 --- a/tests/testthat/test-resp-stream.R +++ b/tests/testthat/test-resp-stream.R @@ -26,7 +26,8 @@ test_that("can determine if a stream is complete (blocking)", { }) test_that("can determine if a stream is complete (non-blocking)", { - resp <- request_test("/stream-bytes/2048") %>% req_perform_connection(blocking = FALSE) + resp <- request_test("/stream-bytes/2048") %>% + req_perform_connection(blocking = FALSE) withr::defer(close(resp)) expect_false(resp_stream_is_complete(resp)) @@ -44,7 +45,10 @@ test_that("can determine if incomplete data is complete", { con <- req %>% req_perform_connection(blocking = TRUE) withr::defer(close(con)) - expect_equal(resp_stream_sse(con, 10), list(type = "message", data = "1", id = "")) + expect_equal( + resp_stream_sse(con, 10), + list(type = "message", data = "1", id = "") + ) expect_snapshot(expect_equal(resp_stream_sse(con), NULL)) expect_true(resp_stream_is_complete(con)) }) @@ -105,7 +109,14 @@ test_that("handles line endings of multiple kinds", { withr::defer(close(resp1)) expected_values <- list( - "\u3042", "crlf", "lf", "cr", character(0), "half line/other half", "broken crlf", "another line" + "\u3042", + "crlf", + "lf", + "cr", + character(0), + "half line/other half", + "broken crlf", + "another line" ) for (expected in expected_values) { @@ -133,7 +144,13 @@ test_that("handles line endings of multiple kinds", { withr::defer(close(resp2)) expected_values <- c( - "\u3042", "crlf", "lf", "cr", "half line/other half", "broken crlf", "another line" + "\u3042", + "crlf", + "lf", + "cr", + "half line/other half", + "broken crlf", + "another line" ) for (expected in expected_values) { @@ -159,7 +176,7 @@ test_that("streams the specified number of lines", { expect_equal(resp_stream_lines(resp2, 3), c("a", "b", "c")) expect_equal(resp_stream_lines(resp2, 3), c("d", "e")) expect_equal(resp_stream_lines(resp2, 3), character()) - }) +}) test_that("can feed sse events one at a time", { req <- local_app_request(function(req, res) { @@ -311,7 +328,9 @@ test_that("verbosity = 3 shows buffer info", { res$send_chunk("line 2\n") }) - expect_output(con <- req_perform_connection(req, blocking = TRUE, verbosity = 3)) + expect_output( + con <- req_perform_connection(req, blocking = TRUE, verbosity = 3) + ) on.exit(close(con)) expect_snapshot( { diff --git a/tests/testthat/test-resp.R b/tests/testthat/test-resp.R index e699de3fa..2c2030b5d 100644 --- a/tests/testthat/test-resp.R +++ b/tests/testthat/test-resp.R @@ -1,5 +1,4 @@ test_that("response has basic print method", { - file.create("path-empty") writeBin("sample content", "path-content") diff --git a/tests/testthat/test-secret.R b/tests/testthat/test-secret.R index 3902a35c9..93d4be543 100644 --- a/tests/testthat/test-secret.R +++ b/tests/testthat/test-secret.R @@ -28,7 +28,6 @@ test_that("encryption and decryption of file is symmetric", { expect_equal(readLines(path_dec, warn = FALSE), letters) }) expect_false(file.exists(path_dec)) - }) test_that("can unobfuscate obfuscated string", { @@ -47,7 +46,10 @@ test_that("obfuscated strings are hidden", { test_that("unobfuscate operates recursively", { expect_equal(unobfuscate(NULL), NULL) expect_equal(unobfuscate("x"), "x") - expect_equal(unobfuscate(list(list(obfuscated("qw6Ua_n2LR_xzuk2uqp2dhb5OaE")))), list(list("test"))) + expect_equal( + unobfuscate(list(list(obfuscated("qw6Ua_n2LR_xzuk2uqp2dhb5OaE")))), + list(list("test")) + ) }) test_that("secret_has_key returns FALSE/TRUE", { diff --git a/tests/testthat/test-url.R b/tests/testthat/test-url.R index 153309d6b..4dd995bc8 100644 --- a/tests/testthat/test-url.R +++ b/tests/testthat/test-url.R @@ -87,7 +87,10 @@ test_that("can accept query as a string or list", { url <- "http://test/" expect_equal(url_modify(url, query = "a=1&b=2"), "http://test/?a=1&b=2") - expect_equal(url_modify(url, query = list(a = 1, b = 2)), "http://test/?a=1&b=2") + expect_equal( + url_modify(url, query = list(a = 1, b = 2)), + "http://test/?a=1&b=2" + ) expect_equal(url_modify(url, query = ""), "http://test/") expect_equal(url_modify(url, query = list()), "http://test/") @@ -111,7 +114,10 @@ test_that("checks various query formats", { }) test_that("path always starts with /", { - expect_equal(url_modify("https://x.com/abc", path = "def"), "https://x.com/def") + expect_equal( + url_modify("https://x.com/abc", path = "def"), + "https://x.com/def" + ) expect_equal(url_modify("https://x.com/abc", path = ""), "https://x.com/") expect_equal(url_modify("https://x.com/abc", path = NULL), "https://x.com/") }) @@ -122,7 +128,10 @@ test_that("can set relative urls", { base <- "http://example.com/a/b/c/" expect_equal(url_modify_relative(base, "d"), "http://example.com/a/b/c/d") expect_equal(url_modify_relative(base, ".."), "http://example.com/a/b/") - expect_equal(url_modify_relative(base, "//archive.org"), "http://archive.org/") + expect_equal( + url_modify_relative(base, "//archive.org"), + "http://archive.org/" + ) }) test_that("is idempotent", {