httr2/0000755000176200001440000000000014762766512011335 5ustar liggesusershttr2/tests/0000755000176200001440000000000014762062303012462 5ustar liggesusershttr2/tests/testthat/0000755000176200001440000000000014762766512014337 5ustar liggesusershttr2/tests/testthat/test-req-body.R0000644000176200001440000001117314666312277017162 0ustar liggesuserstest_that("can send file", { path <- withr::local_tempfile() # curl requests in 64kb chunks so this will hopefully illustrate # any subtle problems x <- strrep("x", 128 * 1024) writeChar(x, path, nchar(x)) resp <- request_test("/post") %>% req_body_file(path, type = "text/plain") %>% req_perform() json <- resp_body_json(resp) expect_equal(json$headers$`Content-Type`, "text/plain") expect_equal(json$data, x) }) test_that("can send file with redirect", { str <- paste(letters, collapse = "") path <- tempfile() writeChar(str, path) resp <- request_test("/redirect-to?url=/post&status_code=307") %>% req_body_file(path, type = "text/plain") %>% req_perform() expect_equal(resp_status(resp), 200) expect_equal(url_parse(resp$url)$path, "/post") expect_equal(resp_body_json(resp)$data, str) }) test_that("errors if file doesn't exist", { expect_snapshot( req_body_file(request_test(), "doesntexist", type = "text/plain"), error = TRUE ) }) test_that("can send string", { resp <- request_test("/post") %>% req_body_raw("test", type = "text/plain") %>% req_perform() json <- resp_body_json(resp) expect_equal(json$headers$`Content-Type`, "text/plain") expect_equal(json$data, "test") }) test_that("can send any type of object as json", { req <- request_test("/post") %>% req_body_json(mtcars) expect_equal(req$body$data, mtcars) data <- list(a = "1", b = "2") resp <- request_test("/post") %>% req_body_json(data) %>% req_perform() json <- resp_body_json(resp) expect_equal(json$json, data) resp <- request_test("/post") %>% req_body_json(letters) %>% req_perform() json <- resp_body_json(resp) expect_equal(json$json, as.list(letters)) }) test_that("can use custom json type", { resp <- request_test("/post") %>% req_body_json(mtcars, type = "application/ld+json") %>% req_perform() expect_equal( resp_body_json(resp)$headers$`Content-Type`, "application/ld+json" ) }) test_that("non-json type errors", { expect_snapshot( req_body_json(request_test(), mtcars, type = "application/xml"), error = TRUE ) }) 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)) 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))) }) test_that("can send named elements as form/multipart", { data <- list(a = "1", b = "2") resp <- request_test("/post") %>% req_body_form(!!!data) %>% req_perform() json <- resp_body_json(resp) expect_equal(json$headers$`Content-Type`, "application/x-www-form-urlencoded") expect_equal(json$form, data) resp <- request_test("/post") %>% req_body_multipart(!!!data) %>% req_perform() json <- resp_body_json(resp) expect_match(json$headers$`Content-Type`, "multipart/form-data; boundary=-") expect_equal(json$form, list(a = "1", b = "2")) }) test_that("can modify body data", { req1 <- request_test() %>% req_body_form(a = 1) expect_equal(req1$body$data, list(a = I("1"))) req2 <- req1 %>% req_body_form(b = 2) expect_equal(req2$body$data, list(a = I("1"), b = I("2"))) req3 <- req1 %>% req_body_form(a = 3, a = 4) expect_equal(req3$body$data, list(a = I("3"), a = I("4"))) }) test_that("can upload file with multipart", { skip_on_os("windows") # fails due to line ending difference path <- tempfile() writeLines("this is a test", path) resp <- request_test("/post") %>% req_body_multipart(file = curl::form_file(path)) %>% req_perform() json <- resp_body_json(resp) expect_equal( json$files$file$value, paste0( "data:application/octet-stream;base64,", openssl::base64_encode("this is a test\n") ) ) }) test_that("can override body content type", { req <- request_test("/post") %>% req_body_raw('{"x":"y"}') %>% req_headers("content-type" = "application/json") resp <- req_perform(req) headers <- resp_body_json(resp)$headers expect_equal(headers$`Content-Type`, "application/json") expect_equal(headers$`content-type`, NULL) }) test_that("no issues with partial name matching", { req <- request_test("/get") %>% req_body_multipart(d = "some data") expect_named(req$body$data, "d") }) test_that("can't change body type", { req <- request("http://example.com") %>% req_body_raw(raw(1)) expect_snapshot(req %>% req_body_json(list(x = 1)), error = TRUE) }) httr2/tests/testthat/helper-webfakes.R0000644000176200001440000000076114761705464017530 0ustar liggesuserslocal_app_request <- function(fun, method = "get", frame = parent.frame()) { # Works interactively (useful for manaul coverage checking) # but not in separate process if (!interactive()) { skip_on_covr() } app <- webfakes::new_app() app[[method]]("/test", fun) server <- webfakes::local_app_process(app, .local_envir = frame) req <- request(server$url("/test")) req <- req_error(req, body = function(resp) { if (resp_has_body(resp)) resp_body_string(resp) }) req } httr2/tests/testthat/test-utils.R0000644000176200001440000000274014761701552016572 0ustar liggesuserstest_that("modify list adds, removes, and overrides", { x <- list(x = 1) expect_equal(modify_list(x), x) expect_equal(modify_list(x, x = NULL), list()) expect_equal(modify_list(x, x = 2), list(x = 2)) expect_equal(modify_list(x, y = 3), list(x = 1, y = 3)) expect_equal(modify_list(NULL, x = 2), list(x = 2)) expect_snapshot(modify_list(x, a = 1, 2), error = TRUE) }) test_that("replacement affects all components with name", { x <- list(a = 1, a = 2) expect_equal(modify_list(x, a = NULL), list()) expect_equal(modify_list(x, a = 3), list(a = 3)) expect_equal(modify_list(x, a = 3, a = 4), list(a = 3, a = 4)) }) test_that("progress bar suppressed in tests", { expect_snapshot(sys_sleep(0.1, "in test")) }) test_that("has a working slice", { x <- letters[1:5] expect_identical(slice(x), x) expect_identical(slice(x, 1, length(x) + 1), x) # start is inclusive, end is exclusive expect_identical(slice(x, 1, length(x)), head(x, -1)) # zero-length slices are fine expect_identical(slice(x, 1, 1), character()) # starting off the end is fine expect_identical(slice(x, length(x) + 1), character()) expect_identical(slice(x, length(x) + 1, length(x) + 1), character()) # slicing zero-length is fine expect_identical(slice(character()), character()) # out of bounds expect_error(slice(x, 0, 1)) expect_error(slice(x, length(x) + 2)) expect_error(slice(x, end = length(x) + 2)) # end too small relative to start expect_error(slice(x, 2, 1)) }) httr2/tests/testthat/test-req-dry-run.R0000644000176200001440000000215414761701552017616 0ustar liggesuserstest_that("req_dry_run() returns useful data", { resp <- request("http://example.com") %>% req_dry_run(quiet = TRUE, testing_headers = FALSE) expect_equal(resp$method, "GET") expect_equal(resp$path, "/") expect_match(resp$headers$`user-agent`, "libcurl") }) test_that("body is shown", { req <- request("http://example.com") # can display UTF-8 characters req_utf8 <- req_body_raw(req, "CenĂ¡rio", type = "text/plain") expect_snapshot(req_dry_run(req_utf8)) # json is prettified by default req_json <- req_body_raw(req, '{"x":1,"y":true}', type = "application/json") expect_snapshot(req_dry_run(req_json)) expect_snapshot(req_dry_run(req_json, pretty_json = FALSE)) # doesn't show binary data req_binary <- req_body_raw(req, "CenĂ¡rio") expect_snapshot(req_dry_run(req_binary)) }) test_that("authorization headers are redacted", { req <- request("http://example.com") %>% req_auth_basic("user", "password") expect_snapshot(req_dry_run(req)) }) test_that("doen't add space to urls (#567)", { req <- request("https://example.com/test:1:2") expect_output(req_dry_run(req), "test:1:2") }) httr2/tests/testthat/test-req-error.R0000644000176200001440000000170114656161723017347 0ustar liggesuserstest_that("can customise what statuses are errors", { req <- request_test() expect_equal(error_is_error(req, response(404)), TRUE) expect_equal(error_is_error(req, response(200)), FALSE) req <- req %>% req_error(is_error = ~ !resp_is_error(.x)) expect_equal(error_is_error(req, response(404)), FALSE) expect_equal(error_is_error(req, response(200)), TRUE) }) test_that("can customise error info", { req <- request_test() expect_equal(error_body(req, response(404)), NULL) req <- req %>% req_error(body = ~"Hi!") expect_equal(error_body(req, response(404)), "Hi!") }) test_that("failing callback still generates useful body", { req <- request_test() %>% req_error(body = ~ abort("This is an error!")) expect_snapshot_error(error_body(req, response(404))) out <- expect_snapshot(error = TRUE, { req <- request_test("/status/404") req <- req %>% req_error(body = ~ resp_body_json(.x)$error) req %>% req_perform() }) }) httr2/tests/testthat/test-req-perform-iterative-responses.R0000644000176200001440000000123314753125205023672 0ustar liggesuserstest_that("basic helpers work", { reqs <- list( request_test("/status/:status", status = 200), request_test("/status/:status", status = 404), request("INVALID") ) resps <- req_perform_parallel(reqs, on_error = "continue") expect_equal(resps_successes(resps), resps[1]) expect_equal(resps_failures(resps), resps[2:3]) expect_equal(resps_requests(resps), reqs) }) test_that("can extract all data", { resps <- list( response_json(body = list(data = 1)), response_json(body = list(data = 2)), response_json(body = list(data = 3)) ) expect_equal( resps_data(resps, function(resp) resp_body_json(resp)$data), 1:3 ) }) httr2/tests/testthat/test-resp.R0000644000176200001440000000137514664061415016405 0ustar liggesuserstest_that("response has basic print method", { file.create("path-empty") writeBin("sample content", "path-content") withr::defer(unlink(c("path-empty", "path-content"))) con <- file() withr::defer(close(con)) expect_snapshot({ response(200) response(200, headers = "Content-Type: text/html") response(200, body = charToRaw("abcdef")) response(200, body = new_path("path-empty")) response(200, body = new_path("path-content")) response(200, body = con) }) }) test_that("response adds date if not provided by server", { resp <- response(headers = "Test: 1") expect_named(resp_headers(resp), c("Test", "Date")) }) test_that("check_response produces helpful error", { expect_snapshot(check_response(1), error = TRUE) }) httr2/tests/testthat/test-req-retries.R0000644000176200001440000000726114737312513017675 0ustar liggesuserstest_that("has useful default (with message)", { req <- request_test() expect_snapshot(req <- req_retry(req)) expect_equal(retry_max_tries(req), 2) expect_equal(retry_max_seconds(req), Inf) }) test_that("can set define maximum retries", { req <- request_test() expect_equal(retry_max_tries(req), 1) expect_equal(retry_max_seconds(req), Inf) req <- req_retry(req, max_tries = 2) expect_equal(retry_max_tries(req), 2) expect_equal(retry_max_seconds(req), Inf) req <- req_retry(req, max_seconds = 5) expect_equal(retry_max_tries(req), Inf) expect_equal(retry_max_seconds(req), 5) req <- req_retry(req, max_tries = 2, max_seconds = 5) expect_equal(retry_max_tries(req), 2) expect_equal(retry_max_seconds(req), 5) }) test_that("can override default is_transient", { req <- request_test() expect_equal(retry_is_transient(req, response(404)), FALSE) expect_equal(retry_is_transient(req, response(429)), TRUE) req <- req_retry(req, is_transient = ~ resp_status(.x) == 404) expect_equal(retry_is_transient(req, response(404)), TRUE) expect_equal(retry_is_transient(req, response(429)), FALSE) }) test_that("can override default backoff", { withr::local_seed(1014) req <- request_test() expect_equal(retry_backoff(req, 1), 1.1) expect_equal(retry_backoff(req, 5), 26.9) expect_equal(retry_backoff(req, 10), 60) req <- req_retry(req, backoff = ~10) expect_equal(retry_backoff(req, 1), 10) expect_equal(retry_backoff(req, 5), 10) expect_equal(retry_backoff(req, 10), 10) }) test_that("can override default retry wait", { resp <- response(429, headers = c("Retry-After: 10", "Wait-For: 20")) req <- request_test() expect_equal(retry_after(req, resp, 1), 10) req <- req_retry(req, after = ~ as.numeric(resp_header(.x, "Wait-For"))) expect_equal(retry_after(req, resp, 1), 20) }) test_that("missing retry-after uses backoff", { req <- request_test() req <- req_retry(req, backoff = ~10) expect_equal(retry_after(req, response(429), 1), 10) }) test_that("useful message if `after` wrong", { req <- request_test() %>% req_retry( is_transient = function(resp) TRUE, after = function(resp) resp ) expect_snapshot(req_perform(req), error = TRUE) }) test_that("validates its inputs", { req <- new_request("http://example.com") expect_snapshot(error = TRUE, { req_retry(req, max_tries = 0) req_retry(req, max_tries = 2, max_seconds = "x") req_retry(req, max_tries = 2, retry_on_failure = "x") }) }) test_that("is_number_or_na implemented correctly", { expect_equal(is_number_or_na(1), TRUE) expect_equal(is_number_or_na(NA_real_), TRUE) expect_equal(is_number_or_na(NA), TRUE) expect_equal(is_number_or_na(1:2), FALSE) expect_equal(is_number_or_na(numeric()), FALSE) expect_equal(is_number_or_na("x"), FALSE) }) # circuit breaker -------------------------------------------------------- test_that("triggered after specified requests", { req <- request_test("/status/:status", status = 429) %>% req_retry( after = function(resp) 0, max_tries = 10, failure_threshold = 1 ) # First attempt performs, retries, then errors req_perform(req) %>% expect_condition(class = "httr2_perform") %>% expect_condition(class = "httr2_retry") %>% expect_error(class = "httr2_breaker") # Second attempt errors without performing req_perform(req) %>% expect_no_condition(class = "httr2_perform") %>% expect_error(class = "httr2_breaker") # Attempt on same realm errors without trying at all req2 <- request_test("/status/:status", status = 200) %>% req_retry() req_perform(req) %>% expect_no_condition(class = "httr2_perform") %>% expect_error(class = "httr2_breaker") }) httr2/tests/testthat/test-oauth.R0000644000176200001440000001035514711265142016546 0ustar liggesuserstest_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"') # Doesn't trigger for response if request doesn't use OAuth expect_false(resp_is_invalid_oauth_token(req, resp_invalid)) req <- req_oauth(req, "", list(), NULL) expect_false(resp_is_invalid_oauth_token(req, response(200))) expect_false(resp_is_invalid_oauth_token(req, response(401))) expect_true(resp_is_invalid_oauth_token(req, resp_invalid)) }) # auth_oauth_token_get() -------------------------------------------------- test_that("can request and cache token if not present", { client <- oauth_client("test", "http://example.org/test") cache <- cache_mem(client) token <- oauth_token("123") expect_equal(auth_oauth_token_get(cache, function(...) token), token) expect_equal(cache$get(), token) }) test_that("can re-flow to get new token", { client <- oauth_client("test", "http://example.org/test") cache <- cache_mem(client) cache$set(oauth_token("123", expires_in = -60)) token <- oauth_token("123") expect_equal(auth_oauth_token_get(cache, function(...) token), token) expect_equal(cache$get(), token) # and cache is cleared if cache$set(oauth_token("123", expires_in = -60)) expect_error(auth_oauth_token_get(cache, function(...) stop("Bad!"))) expect_equal(cache$get(), NULL) }) test_that("can refresh to get new token", { client <- oauth_client("test", "http://example.org/test") cache <- cache_mem(client) cache$set(oauth_token("123", refresh_token = "456", expires_in = -60)) local_mocked_bindings( oauth_client_get_token = function(...) oauth_token("789") ) new_token <- oauth_token("789", refresh_token = "456") expect_equal(auth_oauth_token_get(cache, function(...) NULL), new_token) expect_equal(cache$get(), new_token) }) test_that("can reflow if refresh fails", { client <- oauth_client("test", "http://example.org/test") cache <- cache_mem(client) cache$set(oauth_token("123", refresh_token = "456", expires_in = -60)) local_mocked_bindings( oauth_client_get_token = function(...) oauth_flow_abort("Nope") ) token <- oauth_token("789") expect_equal(auth_oauth_token_get(cache, function(...) token), token) expect_equal(cache$get(), token) }) test_that("can retrieve non-expired token from cache", { client <- oauth_client("test", "http://example.org/test") cache <- cache_mem(client) token <- oauth_token("123") cache$set(token) expect_equal(auth_oauth_token_get(cache, oauth_flow_refresh), token) }) # Cache ------------------------------------------------------------------- test_that("can store in memory", { client <- oauth_client( id = "x", token_url = "http://example.com", name = "httr2-test" ) cache <- cache_mem(client, NULL) withr::defer(cache$clear()) expect_equal(cache$get(), NULL) cache$set(1) expect_equal(cache$get(), 1) cache$clear() expect_equal(cache$get(), NULL) }) test_that("can store on disk", { client <- oauth_client( id = "x", token_url = "http://example.com", name = "httr2-test" ) cache <- cache_disk(client, NULL) withr::defer(cache$clear()) expect_equal(cache$get(), NULL) expect_snapshot( cache$set(1), transform = function(x) { gsub(oauth_cache_path(), "", x, fixed = TRUE) } ) expect_equal(cache$get(), 1) cache$clear() expect_equal(cache$get(), NULL) }) test_that("can explicitly clear cached value", { client <- oauth_client( id = "x", token_url = "http://example.com", name = "httr2-test" ) cache <- cache_mem(client, NULL) cache$set("abcdef") oauth_cache_clear(client) expect_equal(cache$get(), NULL) }) test_that("can prune old files", { path <- withr::local_tempdir() touch(file.path(path, "a-token.rds"), Sys.time() - 86400 * 1) touch(file.path(path, "b-token.rds"), Sys.time() - 86400 * 2) cache_disk_prune(2, path) expect_equal(dir(path), "a-token.rds") }) # cache_path -------------------------------------------------------------- test_that("can override path with env var", { withr::local_envvar("HTTR2_OAUTH_CACHE" = "/tmp") expect_equal(oauth_cache_path(), "/tmp") }) httr2/tests/testthat/test-resp-stream.R0000644000176200001440000002712214761705464017703 0ustar liggesuserstest_that("can stream bytes from a connection", { resp <- request_test("/stream-bytes/2048") %>% req_perform_connection() withr::defer(close(resp)) expect_s3_class(resp, "httr2_response") expect_true(resp_has_body(resp)) out <- resp_stream_raw(resp, 1) expect_length(out, 1024) out <- resp_stream_raw(resp, 1) expect_length(out, 1024) out <- resp_stream_raw(resp, 1) expect_length(out, 0) }) test_that("can determine if a stream is complete (blocking)", { resp <- request_test("/stream-bytes/2048") %>% req_perform_connection() withr::defer(close(resp)) expect_false(resp_stream_is_complete(resp)) expect_length(resp_stream_raw(resp, kb = 2), 2048) expect_length(resp_stream_raw(resp, kb = 1), 0) expect_true(resp_stream_is_complete(resp)) }) test_that("can determine if a stream is complete (non-blocking)", { resp <- request_test("/stream-bytes/2048") %>% req_perform_connection(blocking = FALSE) withr::defer(close(resp)) expect_false(resp_stream_is_complete(resp)) expect_length(resp_stream_raw(resp, kb = 2), 2048) expect_length(resp_stream_raw(resp, kb = 1), 0) expect_true(resp_stream_is_complete(resp)) }) test_that("can determine if incomplete data is complete", { req <- local_app_request(function(req, res) { res$send_chunk("data: 1\n\n") res$send_chunk("data: ") }) con <- req %>% req_perform_connection(blocking = TRUE) 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)) close(con) }) test_that("can't read from a closed connection", { resp <- request_test("/stream-bytes/1024") %>% req_perform_connection() close(resp) expect_false(resp_has_body(resp)) expect_snapshot(resp_stream_raw(resp, 1), error = TRUE) # and no error if we try to close it again expect_no_error(close(resp)) }) test_that("can join lines across multiple reads", { req <- local_app_request(function(req, res) { res$send_chunk("This is a ") Sys.sleep(0.2) res$send_chunk("complete sentence.\n") }) # Non-blocking returns NULL until data is ready resp1 <- req_perform_connection(req, blocking = FALSE) withr::defer(close(resp1)) out <- resp_stream_lines(resp1) expect_equal(out, character()) expect_equal(resp1$cache$push_back, charToRaw("This is a ")) while (length(out) == 0) { Sys.sleep(0.1) out <- resp_stream_lines(resp1) } expect_equal(out, "This is a complete sentence.") }) test_that("handles line endings of multiple kinds", { req <- local_app_request(function(req, res) { res$set_header("Content-Type", "text/plain; charset=Shift_JIS") res$send_chunk(as.raw(c(0x82, 0xA0, 0x0A))) Sys.sleep(0.1) res$send_chunk("crlf\r\n") Sys.sleep(0.1) res$send_chunk("lf\n") Sys.sleep(0.1) res$send_chunk("cr\r") Sys.sleep(0.1) res$send_chunk("half line/") Sys.sleep(0.1) res$send_chunk("other half\n") Sys.sleep(0.1) res$send_chunk("broken crlf\r") Sys.sleep(0.1) res$send_chunk("\nanother line\n") Sys.sleep(0.1) res$send_chunk("eof without line ending") }) resp1 <- req_perform_connection(req, blocking = TRUE) withr::defer(close(resp1)) for (expected in c("\u3042", "crlf", "lf", "cr", "half line/other half", "broken crlf", "another line")) { rlang::inject(expect_equal(resp_stream_lines(resp1), !!expected)) } expect_warning( expect_equal(resp_stream_lines(resp1), "eof without line ending"), "incomplete final line" ) expect_identical(resp_stream_lines(resp1), character(0)) # Same test, but now, non-blocking resp2 <- req_perform_connection(req, blocking = FALSE) withr::defer(close(resp2)) for (expected in c("\u3042", "crlf", "lf", "cr", "half line/other half", "broken crlf", "another line")) { repeat { out <- resp_stream_lines(resp2) if (length(out) > 0) { rlang::inject(expect_equal(out, !!expected)) break } } } expect_warning( repeat { out <- resp_stream_lines(resp2) if (length(out) > 0) { expect_equal(out, "eof without line ending") break } }, "incomplete final line" ) }) test_that("streams the specified number of lines", { req <- local_app_request(function(req, res) { res$send_chunk(paste0(letters[1:5], "\n", collapse = "")) }) resp1 <- req_perform_connection(req, blocking = TRUE) withr::defer(close(resp1)) expect_equal( resp_stream_lines(resp1, 3), c("a", "b", "c") ) expect_equal( resp_stream_lines(resp1, 3), c("d", "e") ) expect_equal( resp_stream_lines(resp1, 3), character() ) resp2 <- req_perform_connection(req, blocking = FALSE) withr::defer(close(resp2)) Sys.sleep(0.2) 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) { for (i in 1:3) { res$send_chunk(sprintf("data: %s\n\n", i)) } }) resp <- req_perform_connection(req) withr::defer(close(resp)) expect_equal( resp_stream_sse(resp), list(type = "message", data = "1", id = "") ) expect_equal( resp_stream_sse(resp), list(type = "message", data = "2", id = "") ) resp_stream_sse(resp) expect_equal(resp_stream_sse(resp), NULL) }) test_that("ignores events with no data", { req <- local_app_request(function(req, res) { res$send_chunk(": comment\n\n") res$send_chunk("data: 1\n\n") }) resp <- req_perform_connection(req) withr::defer(close(resp)) expect_equal( resp_stream_sse(resp), list(type = "message", data = "1", id = "") ) }) test_that("can join sse events across multiple reads", { req <- local_app_request(function(req, res) { res$send_chunk("data: 1\n") Sys.sleep(0.2) res$send_chunk("data") Sys.sleep(0.2) res$send_chunk(": 2\n") res$send_chunk("\ndata: 3\n\n") }) # Non-blocking returns NULL until data is ready resp1 <- req_perform_connection(req, blocking = FALSE) withr::defer(close(resp1)) out <- resp_stream_sse(resp1) expect_equal(out, NULL) expect_equal(resp1$cache$push_back, charToRaw("data: 1\n")) while (is.null(out)) { Sys.sleep(0.1) out <- resp_stream_sse(resp1) } expect_equal(out, list(type = "message", data = "1\n2", id = "")) expect_equal(resp1$cache$push_back, charToRaw("data: 3\n\n")) out <- resp_stream_sse(resp1) expect_equal(out, list(type = "message", data = "3", id = "")) # Blocking waits for a complete event resp2 <- req_perform_connection(req) withr::defer(close(resp2)) out <- resp_stream_sse(resp2) expect_equal(out, list(type = "message", data = "1\n2", id = "")) }) test_that("sse always interprets data as UTF-8", { req <- local_app_request(function(req, res) { res$send_chunk("data: \xE3\x81\x82\r\n\r\n") }) withr::with_locale(c(LC_CTYPE = "C"), { # Non-blocking returns NULL until data is ready resp1 <- req_perform_connection(req, blocking = FALSE) withr::defer(close(resp1)) out <- NULL while (is.null(out)) { Sys.sleep(0.1) out <- resp_stream_sse(resp1) } s <- "\xE3\x81\x82" Encoding(s) <- "UTF-8" expect_equal(out, list(type = "message", data = s, id = "")) expect_equal(Encoding(out$data), "UTF-8") expect_equal(resp1$cache$push_back, raw()) }) }) test_that("streaming size limits enforced", { req <- local_app_request(function(req, res) { data_size <- 1000 data <- paste(rep_len("0", data_size), collapse = "") res$send_chunk(data) }) resp1 <- req_perform_connection(req, blocking = FALSE) withr::defer(close(resp1)) expect_error( while (is.null(out)) { Sys.sleep(0.1) out <- resp_stream_sse(resp1, max_size = 999) } ) resp2 <- req_perform_connection(req, blocking = TRUE) withr::defer(close(resp2)) expect_error( out <- resp_stream_sse(resp2, max_size = 999) ) resp3 <- req_perform_connection(req, blocking = TRUE) withr::defer(close(resp3)) expect_error( out <- resp_stream_lines(resp3, max_size = 999) ) }) test_that("verbosity = 2 streams request bodies", { req <- local_app_request(function(req, res) { res$send_chunk("line 1\n") res$send_chunk("line 2\n") }) stream_all <- function(req, fun, ...) { con <- req_perform_connection(req, blocking = TRUE, verbosity = 2) on.exit(close(con)) while (!resp_stream_is_complete(con)) { fun(con, ...) } } expect_snapshot( { stream_all(req, resp_stream_lines, 1) stream_all(req, resp_stream_raw, 5 / 1024) }, transform = function(lines) lines[!grepl("^(<-|->)", lines)] ) }) test_that("verbosity = 3 shows buffer info", { req <- local_app_request(function(req, res) { res$send_chunk("line 1\n") res$send_chunk("line 2\n") }) expect_output(con <- req_perform_connection(req, blocking = TRUE, verbosity = 3)) on.exit(close(con)) expect_snapshot( { while (!resp_stream_is_complete(con)) { resp_stream_lines(con, 1) } }, transform = transform_verbose_response ) }) test_that("verbosity = 3 shows raw sse events", { req <- local_app_request(function(req, res) { res$send_chunk(": comment\n\n") res$send_chunk("data: 1\n\n") }) expect_output(resp <- req_perform_connection(req, verbosity = 3)) withr::defer(close(resp)) expect_snapshot( . <- resp_stream_sse(resp), transform = transform_verbose_response ) }) test_that("has a working find_event_boundary", { boundary_test <- function(x, matched, remaining) { buffer <- charToRaw(x) split_at <- find_event_boundary(buffer) result <- if (is.null(split_at)) { NULL } else { split_buffer(buffer, split_at) } expect_identical( result, list(matched = charToRaw(matched), remaining = charToRaw(remaining)) ) } # Basic matches boundary_test("\r\r", matched = "\r\r", remaining = "") boundary_test("\n\n", matched = "\n\n", remaining = "") boundary_test("\r\n\r\n", matched = "\r\n\r\n", remaining = "") boundary_test("a\r\r", matched = "a\r\r", remaining = "") boundary_test("a\n\n", matched = "a\n\n", remaining = "") boundary_test("a\r\n\r\n", matched = "a\r\n\r\n", remaining = "") boundary_test("\r\ra", matched = "\r\r", remaining = "a") boundary_test("\n\na", matched = "\n\n", remaining = "a") boundary_test("\r\n\r\na", matched = "\r\n\r\n", remaining = "a") # Matches the first boundary found boundary_test("\r\r\r", matched = "\r\r", remaining = "\r") boundary_test("\r\r\r\r", matched = "\r\r", remaining = "\r\r") boundary_test("\n\n\r\r", matched = "\n\n", remaining = "\r\r") boundary_test("\r\r\n\n", matched = "\r\r", remaining = "\n\n") # Non-matches expect_null(find_event_boundary(charToRaw("\n\r\n\r"))) expect_null(find_event_boundary(charToRaw("hello\ngoodbye\n"))) expect_null(find_event_boundary(charToRaw(""))) expect_null(find_event_boundary(charToRaw("1"))) expect_null(find_event_boundary(charToRaw("12"))) expect_null(find_event_boundary(charToRaw("\r\n\r"))) }) # parse_event ---------------------------------------------------------------- test_that("event with no data returns NULL", { expect_null(parse_event("")) expect_null(parse_event(":comment")) expect_null(parse_event("id: 1")) expect_equal(parse_event("data: ")$data, "") expect_equal(parse_event("data")$data, "") }) test_that("examples from spec work", { event <- parse_event("data: YHOO\ndata: +2\ndata: 10") expect_equal(event$type, "message") expect_equal(event$data, "YHOO\n+2\n10") }) httr2/tests/testthat/test-req-perform-iterative.R0000644000176200001440000000440414753125205021656 0ustar liggesuserstest_that("can perform multiple requests", { req <- request(example_url("/iris")) %>% req_url_query(limit = 5) resps <- req_perform_iterative( req, next_req = iterate_with_offset("page_index"), max_reqs = 4 ) expect_length(resps, 4) expect_equal(resp_url(resps[[4]]), paste0(example_url(), "iris?limit=5&page_index=4")) }) test_that("can save results to disk", { req <- request(example_url("/iris")) %>% req_url_query(limit = 5) dir <- withr::local_tempdir() resps <- req_perform_iterative( req, next_req = iterate_with_offset("page_index"), max_reqs = 2, path = paste0(dir, "/file-{i}") ) expect_equal(resps[[1]]$body, new_path(file.path(dir, "file-1"))) expect_equal(resps[[2]]$body, new_path(file.path(dir, "file-2"))) }) test_that("user temination still returns data", { req <- request(example_url("/iris")) %>% req_url_query(limit = 5) next_req <- function(resp, req) interrupt() expect_snapshot( resps <- req_perform_iterative(req, next_req = next_req) ) expect_length(resps, 1) }) test_that("can retrieve all pages", { req <- request(example_url("/iris")) %>% req_url_query(limit = 1) i <- 1 next_req <- function(resp, req) { i <<- i + 1 if (i <= 120) { req %>% req_url_query(page_index = 1) } } expect_condition( resps <- req_perform_iterative(req, next_req = next_req, max_reqs = Inf), class = "httr2:::doubled" ) expect_length(resps, 120) }) test_that("can choose to return on failure", { iterator <- function(resp, req) { request_test("/status/:status", status = 404) } expect_error( req_perform_iterative(request_test(), iterator), class = "httr2_http_404" ) out <- req_perform_iterative(request_test(), iterator, on_error = "return") expect_length(out, 2) expect_s3_class(out[[1]], "httr2_response") expect_s3_class(out[[2]], "httr2_http_404") }) test_that("checks its inputs", { req <- request_test() 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) }) }) httr2/tests/testthat/test-verbosity.R0000644000176200001440000000132614761701552017457 0ustar liggesuserstest_that("respects httr2 verbosity option", { expect_equal(with_verbosity(httr2_verbosity()), 1) local({ local_verbosity(2) expect_equal(httr2_verbosity(), 2) }) }) test_that("can set httr2 verbosity with env var", { withr::local_envvar(HTTR2_VERBOSITY = "1") expect_equal(httr2_verbosity(), 1) # but option has higher precedence withr::local_options(httr2_verbosity = 2) expect_equal(httr2_verbosity(), 2) }) test_that("respects httr verbose config", { expect_equal(httr2_verbosity(), 0) # Simulate effect of httr::with_verbose(httr2_verbosity()) config <- list(options = list(debugfunction = identity)) withr::local_options(httr_config = config) expect_equal(httr2_verbosity(), 1) }) httr2/tests/testthat/test-resp-stream-aws.R0000644000176200001440000000621314706472567020475 0ustar liggesusers# Tests copied from # https://github.com/lifion/lifion-aws-event-stream/blob/develop/lib/index.test.js # https://github.com/lifion/lifion-aws-event-stream/blob/develop/lib/index.test.json test_that("can parse empty object", { bytes <- hex_to_raw("000000100000000005c248eb7d98c8ff") expect_equal( parse_aws_event(bytes), list(headers = list(), body = "") ) }) test_that("can return various types of header", { bytes <- hex_to_raw("0000001500000001ba25f70d03666f6f013aa3e0d6") expect_equal(parse_aws_event(bytes)$headers, list(foo = FALSE)) bytes <- hex_to_raw("0000001500000001ba25f70d03666f6f004da4d040") expect_equal(parse_aws_event(bytes)$headers, list(foo = TRUE)) # byte bytes <- hex_to_raw("0000001600000001fd858ddd03666f6f02ffa44bfd93") expect_equal(parse_aws_event(bytes)$headers, list(foo = 255)) # short bytes <- hex_to_raw("0000001700000001c0e5a46d03666f6f03fffff3b59291") expect_equal(parse_aws_event(bytes)$headers, list(foo = 65535)) # integer bytes <- hex_to_raw("00000019000000017fd51a0c03666f6f04ffffffff853b65dd") expect_equal(parse_aws_event(bytes)$headers, list(foo = 4294967295)) # long 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") expect_equal(parse_aws_event(bytes)$headers, list(foo = as.raw(1:5))) # character bytes <- hex_to_raw("0000001a00000001387560dc03666f6f0700036261725bb3cecf") 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")) }) test_that("unknown header triggers error", { bytes <- hex_to_raw("0000001500000001ba25f70d03666f6fff60a63fcd") expect_snapshot(parse_aws_event(bytes), error = TRUE) }) test_that("json content type automatically parsed", { bytes <- hex_to_raw(" 000001c20000005bc1123f0b0b3a6576656e742d74797065070015537562736372696265546f 53686172644576656e740d3a636f6e74656e742d747970650700106170706c69636174696f6e 2f6a736f6e0d3a6d6573736167652d747970650700056576656e747b22436f6e74696e756174 696f6e53657175656e63654e756d626572223a22343935383836333037393634323435313235 3936363136333437353239313133373435393934373336323937343734373039373832353330 222c224d696c6c6973426568696e644c6174657374223a302c225265636f726473223a5b7b22 417070726f78696d6174654172726976616c54696d657374616d70223a312e35333831363032 313936333645392c2244617461223a225632567a62475635222c22456e6372797074696f6e54 797065223a6e756c6c2c22506172746974696f6e4b6579223a2231306463633930322d633839 632d343036372d623433362d303566383863306662356566222c2253657175656e63654e756d 626572223a223439353838363330373936343234353132353936363136333437353239313133 373435393934373336323937343734373039373832353330227d5d7dd84c02f3 ") parsed <- parse_aws_event(bytes) expect_type(parsed$body, "list") }) httr2/tests/testthat/test-resp-url.R0000644000176200001440000000065514752214235017203 0ustar liggesuserstest_that("can extract url components from a response", { resp <- req_perform(request_test("/get?a=1&b=2")) expect_equal(resp_url(resp), example_url("/get?a=1&b=2")) expect_equal(resp_url_path(resp), "/get") expect_equal(resp_url_queries(resp), list(a = "1", b = "2")) expect_equal(resp_url_query(resp, "a"), "1") expect_equal(resp_url_query(resp, "c"), NULL) expect_equal(resp_url_query(resp, "c", "x"), "x") }) httr2/tests/testthat/test-req-perform-iterative-helpers.R0000644000176200001440000000541514753125205023321 0ustar liggesusers# iterate_with_offset ----------------------------------------------------- test_that("iterate_with_offset checks inputs", { expect_snapshot(error = TRUE, { iterate_with_offset(1) iterate_with_offset("x", "x") iterate_with_offset("x", offset = 0) iterate_with_offset("x", offset = "x") iterate_with_offset("x", resp_complete = function(x, y) x + y) }) }) test_that("increments param_name by offset", { req_1 <- request_test() iterator <- iterate_with_offset("page") req_2 <- iterator(response(), req_1) expect_equal(url_parse(req_2$url)$query, list(page = "2")) req_3 <- iterator(response(), req_2) expect_equal(url_parse(req_3$url)$query, list(page = "3")) }) test_that("can compute total pages", { req_1 <- request_test() iterator <- iterate_with_offset("page", resp_pages = function(resp) { resp_body_json(resp)$n }) expect_no_condition( req_2 <- iterator(response_json(), req_1), class = "httr2_total_pages" ) expect_condition( req_3 <- iterator(response_json(body = list(n = 100)), req_2), class = "httr2_total_pages" ) # Only called once expect_no_condition( req_4 <- iterator(response_json(body = list(n = 200)), req_3), class = "httr2_total_pages" ) }) test_that("can terminate early", { req_1 <- request_test() iterator <- iterate_with_offset("page", resp_complete = function(resp) { resp_body_json(resp)$done }) req_2 <- iterator(response_json(body = list(done = FALSE)), req_1) expect_equal(url_parse(req_2$url)$query, list(page = "2")) req_3 <- iterator(response_json(body = list(done = TRUE)), req_2) expect_null(req_3) }) # iterate_with_cursor ----------------------------------------------------- test_that("iterate_with_cursor", { expect_snapshot(error = TRUE, { iterate_with_cursor(1) iterate_with_cursor("x", function(x, y) x + y) }) }) test_that("updates param_name with new value", { req_1 <- request_test() iterator <- iterate_with_cursor("next_cursor", function(resp) { resp_body_json(resp)$cursor }) req_2 <- iterator(response_json(body = list(cursor = 123)), req_1) expect_equal(url_parse(req_2$url)$query, list(next_cursor = "123")) req_3 <- iterator(response_json(body = list()), req_2) expect_null(req_3) }) # iterate_with_link_url ----------------------------------------------------- test_that("iterate_with_link_url checks its inputs", { expect_snapshot(error = TRUE, { iterate_with_link_url(rel = 1) }) }) test_that("updates the full url", { req_1 <- request_test() iterator <- iterate_with_link_url() resp <- response(headers = 'Link: ; rel="next"') req_2 <- iterator(resp, req_1) expect_equal(req_2$url, "https://example.com/page/2") req_3 <- iterator(response(), req_2) expect_null(req_3) }) httr2/tests/testthat/test-resp-body.R0000644000176200001440000000541514666312277017346 0ustar liggesuserstest_that("read body from disk/memory", { resp1 <- request_test("base64/:value", value = "SGk=") %>% req_perform() expect_true(resp_has_body(resp1)) 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()) expect_true(resp_has_body(resp2)) expect_equal(resp_body_string(resp2), "Hi") }) test_that("empty body generates error", { resp1 <- request_test("HEAD /get") %>% req_perform() expect_false(resp_has_body(resp1)) expect_snapshot(resp_body_raw(resp1), error = TRUE) resp2 <- request_test("HEAD /get") %>% req_perform(tempfile()) expect_false(resp_has_body(resp2)) expect_snapshot(resp_body_raw(resp2), error = TRUE) }) test_that("can retrieve parsed body", { resp <- request_test("/json") %>% req_perform() expect_type(resp_body_json(resp), "list") resp <- request_test("/html") %>% req_perform() expect_s3_class(resp_body_html(resp), "xml_document") resp <- request_test("/xml") %>% req_perform() expect_s3_class(resp_body_xml(resp), "xml_document") }) test_that("can retrieve parsed body when saved to a file", { path <- withr::local_tempfile() resp <- request_test("/json") %>% req_perform(path) expect_type(resp_body_json(resp), "list") resp <- request_test("/html") %>% req_perform(path) expect_s3_class(resp_body_html(resp), "xml_document") resp <- request_test("/xml") %>% req_perform(path) expect_s3_class(resp_body_xml(resp), "xml_document") }) test_that("resp_body_json stores parsed result", { resp <- request_test("/json") %>% req_perform() json1 <- resp_body_json(resp) # check it's saved expect_length(resp$cache, 1) # check it's not recomputed json2 <- resp_body_json(resp) expect_true(is_reference(json2, json1)) # check the arguments matter json3 <- resp_body_json(resp, simplifyVector = TRUE) expect_false(is_reference(json3, json1)) expect_length(resp$cache, 2) }) test_that("resp_body_xml stores parsed result", { resp <- request_test("/xml") %>% req_perform() xml1 <- resp_body_xml(resp) # check it's saved expect_length(resp$cache, 1) # check it's not recomputed xml2 <- resp_body_xml(resp) expect_true(is_reference(xml2, xml1)) }) test_that("check argument types before caching", { expect_snapshot(error = TRUE, { resp_body_json(1) resp_body_xml(1) }) }) test_that("content types are checked", { expect_snapshot(error = TRUE, { request_test("/xml") %>% req_perform() %>% resp_body_json() request_test("/json") %>% req_perform() %>% resp_body_xml() }) resp <- request_test("/json") %>% req_perform() resp$headers$`Content-Type` <- "application/xml" expect_error(resp_body_json(resp)) expect_no_error(resp_body_json(resp, check_type = FALSE)) }) httr2/tests/testthat/test-oauth-token.R0000644000176200001440000000156014761701552017667 0ustar liggesuserstest_that("new token computes expires_at", { withr::local_envvar(TZ = "UTC") time <- .POSIXct(1740000000) token <- oauth_token("xyz", expires_in = 10, .date = time) expect_s3_class(token, "httr2_token") expect_equal(token$expires_at, as.numeric(time + 10)) expect_snapshot(token) }) test_that("printing token redacts access, id and refresh token", { expect_snapshot({ oauth_token( access_token = "secret", refresh_token = "secret", id_token = "secret" ) }) }) test_that("can compute token expiry", { token <- oauth_token("xyz") expect_equal(token_has_expired(token), FALSE) # Respects delay token <- oauth_token("xyz", expires_in = 8, .date = Sys.time() - 10) expect_equal(token_has_expired(token), TRUE) token <- oauth_token("xyz", expires_in = 10, .date = Sys.time()) expect_equal(token_has_expired(token), FALSE) }) httr2/tests/testthat/test-headers.R0000644000176200001440000000266714761701552017055 0ustar liggesuserstest_that("as_headers parses character vector", { headers <- as_headers(c("x:1", "y:2", "a", "b:")) expect_equal(headers, new_headers(list(x = "1", y = "2", b = ""))) }) test_that("as_headers coerces list", { expect_equal(as_headers(list(x = 1)), new_headers(list(x = 1))) }) test_that("as_headers errors on invalid types", { expect_snapshot(error = TRUE, as_headers(1)) }) test_that("has nice print method", { expect_snapshot({ as_headers(c("X:1", "Y: 2", "Z:")) as_headers(list()) }) }) test_that("print and str redact headers", { x <- new_headers(list(x = 1, y = 2), redact = "x") expect_snapshot({ print(x) str(x) }) }) test_that("subsetting is case insensitive", { x <- new_headers(list(x = 1)) expect_equal(x$X, 1) expect_equal(x[["X"]], 1) expect_equal(x["X"], new_headers(list(x = 1))) }) test_that("redaction is case-insensitive", { headers <- as_headers("AUTHORIZATION: SECRET") attr(headers, "redact") <- "Authorization" redacted <- headers_redact(headers) expect_named(redacted, "AUTHORIZATION") expect_true(is_redacted(redacted$AUTHORIZATION)) }) test_that("new_headers checks inputs", { expect_snapshot(error = TRUE, { new_headers(1) new_headers(list(1)) }) }) test_that("can flatten repeated inputs", { expect_equal(headers_flatten(list()), list()) expect_equal(headers_flatten(list(x = 1)), list(x = 1)) expect_equal(headers_flatten(list(x = 1:2)), list(x = "1,2")) }) httr2/tests/testthat/helper.R0000644000176200001440000000036014752760573015740 0ustar liggesuserstestthat::set_state_inspector(function() { list( connections = getAllConnections(), the_throttle = as.list(the$throttle) ) }) expect_redacted <- function(req, expected) { expect_equal(attr(req$headers, "redact"), expected) } httr2/tests/testthat/test-req-perform-sequential.R0000644000176200001440000000343614753125205022040 0ustar liggesuserstest_that("checks its inputs", { req <- request("http://example.com") expect_snapshot(error = TRUE, { req_perform_sequential(req) req_perform_sequential(list(req), letters) }) }) test_that("can download files", { reqs <- list(request_test("/json"), request_test("/html")) paths <- c(withr::local_tempfile(), withr::local_tempfile()) resps <- req_perform_sequential(reqs, paths) expect_equal(resps[[1]]$body, new_path(paths[[1]])) expect_equal(resps[[2]]$body, new_path(paths[[2]])) # And check that something was downloaded expect_gt(file.size(paths[[1]]), 0) expect_gt(file.size(paths[[2]]), 0) }) test_that("on_error = 'return' returns error", { reqs <- list2( request_test("/status/:status", status = 200), request_test("/status/:status", status = 200), request_test("/status/:status", status = 404), request_test("/status/:status", status = 200) ) out <- req_perform_sequential(reqs, on_error = "return") expect_length(out, 4) expect_s3_class(out[[3]], "httr2_http_404") expect_equal(out[[4]], NULL) }) test_that("on_error = 'continue' captures both error types", { reqs <- list2( request_test("/status/:status", status = 404), request("INVALID"), ) out <- req_perform_sequential(reqs, on_error = "continue") expect_s3_class(out[[1]], "httr2_http_404") expect_s3_class(out[[2]], "httr2_failure") }) test_that("on_error = 'return' returns error", { reqs <- list2( request_test("/status/:status", status = 200), request_test("/status/:status", status = 200), request_test("/status/:status", status = 404), request_test("/status/:status", status = 200) ) out <- req_perform_sequential(reqs, on_error = "return") expect_length(out, 4) expect_s3_class(out[[3]], "httr2_http_404") expect_equal(out[[4]], NULL) }) httr2/tests/testthat/helper-promise.R0000644000176200001440000000103214752760573017411 0ustar liggesusers# promises package test helper extract_promise <- function(promise, timeout = 30) { promise_value <- NULL error <- NULL promises::then( promise, onFulfilled = function(value) promise_value <<- value, onRejected = function(reason) error <<- reason ) start <- Sys.time() while (!later::loop_empty()) { if (difftime(Sys.time(), start, units = "secs") > timeout) { stop("Waited too long") } later::run_now(0.01) } if (!is.null(error)) { cnd_signal(error) } else { promise_value } } httr2/tests/testthat/test-oauth-client.R0000644000176200001440000000326414761701552020030 0ustar liggesuserstest_that("can check app has needed pieces", { client <- oauth_client("id", token_url = "http://example.com") expect_snapshot(error = TRUE, { oauth_flow_check("test", NULL) oauth_flow_check("test", client, is_confidential = TRUE) oauth_flow_check("test", client, interactive = TRUE) }) }) test_that("checks auth types have needed args", { expect_snapshot(error = TRUE, { oauth_client("abc", "http://x.com", auth = "header") oauth_client("abc", "http://x.com", auth = "jwt_sig") oauth_client("abc", "http://x.com", key = "abc", auth = "jwt_sig") oauth_client("abc", "http://x.com", auth = 123) }) }) test_that("client has useful print method", { url <-"http://example.com" expect_snapshot({ oauth_client("x", url) oauth_client("x", url, secret = "SECRET") 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") expect_equal( oauth_client("x", "url", key = "key", auth_params = list(claim = list()))$auth, "oauth_client_req_auth_jwt_sig" ) }) test_that("can authenticate using header or body", { client <- function(auth) { oauth_client( id = "id", secret = "secret", token_url = "http://example.com", auth = auth ) } req <- request("http://example.com") req_h <- oauth_client_req_auth(req, client("header")) expect_equal( req_h$headers, new_headers(list(Authorization = "Basic aWQ6c2VjcmV0"), "Authorization") ) req_b <- oauth_client_req_auth(req, client("body")) expect_equal(req_b$body$data, list(client_id = I("id"), client_secret = I("secret"))) }) httr2/tests/testthat/test-req-cache.R0000644000176200001440000002266214706711034017262 0ustar liggesuserstest_that("nothing happens if cache not enabled", { req <- request("http://example.com") expect_equal(cache_pre_fetch(req), req) resp <- response() expect_equal(cache_post_fetch(req, resp), resp) }) test_that("never retrieves POST request from cache", { req <- request("http://example.com") %>% req_method("POST") %>% req_cache(tempfile()) # Fake an equivalent GET request in the cache resp <- response(200, headers = "Expires: Wed, 01 Jan 3000 00:00:00 GMT", body = charToRaw("abc") ) cache_set(req, resp) expect_equal(cache_pre_fetch(req), req) }) test_that("immutable objects retrieved directly 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") ) cache_set(req, resp) expect_equal(cache_pre_fetch(req), resp) }) test_that("cached cache header added to request", { req <- request("http://example.com") %>% req_cache(tempfile()) # If not cached, request returned as is req2 <- cache_pre_fetch(req) expect_equal(req2, req) resp <- response(200, headers = c('Etag: "abc"', "Last-Modified: Wed, 01 Jan 2020 00:00:00 GMT"), body = charToRaw("abc") ) cache_set(req, resp) # 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-None-Match`, '"abc"') }) test_that("error can use cached value", { req <- request("http://example.com") %>% req_cache(tempfile()) resp <- response(200, body = charToRaw("OK")) cache_set(req, resp) expect_equal(cache_post_fetch(req, error_cnd()), error_cnd()) req$policies$cache_use_on_error <- TRUE expect_equal(cache_post_fetch(req, error_cnd()), resp) }) test_that("304 retains headers but gets cached body", { req <- request("http://example.com") %>% req_cache(tempfile()) resp <- response(200, headers = "X: 1", body = charToRaw("OK")) cache_set(req, resp) cached <- cache_post_fetch(req, response(304, headers = "X: 2")) expect_equal(cached$headers$x, "2") expect_equal(cached$body, resp$body) cached <- cache_post_fetch(req, response(304, headers = "X: 3")) expect_equal(cached$headers$x, "3") expect_equal(cached$body, resp$body) }) test_that("automatically adds to cache", { req <- request("http://example.com") %>% req_cache(tempfile()) expect_true(is.null(cache_get(req))) resp <- response(200, headers = 'Etag: "abc"', body = charToRaw("OK")) cached <- cache_post_fetch(req, resp) expect_false(is.null(cache_get(req))) expect_equal(cache_get(req), resp) }) test_that("cache emits useful debugging info", { req <- request("http://example.com") %>% req_cache(tempfile(), debug = TRUE) resp <- response(200, headers = "Expires: Wed, 01 Jan 3000 00:00:00 GMT", body = charToRaw("abc") ) expect_snapshot({ "Immutable" invisible(cache_pre_fetch(req)) invisible(cache_post_fetch(req, resp)) invisible(cache_pre_fetch(req)) }) req <- request("http://example.com") %>% req_cache(tempfile(), debug = TRUE, use_on_error = TRUE) resp <- response(200, headers = "X: 1", body = charToRaw("OK")) cache_set(req, resp) expect_snapshot({ "freshness check" invisible(cache_pre_fetch(req)) invisible(cache_post_fetch(req, response(304))) invisible(cache_post_fetch(req, error_cnd())) }) }) # cache ------------------------------------------------------------------- test_that("can get and set from cache", { req <- request("http://example.com") %>% req_cache(tempfile()) resp <- response( 200, headers = list( Etag = "ABC", `content-type` = "application/json", other = "header" ), body = charToRaw(jsonlite::toJSON(list(a = jsonlite::unbox(1)))) ) cached_resp <- response( 304, headers = list( Etag = "DEF", other = "new" ) ) expect_true(is.null(cache_get(req))) cache_set(req, resp) expect_false(is.null(cache_get(req))) resp_from_cache <- cache_get(req) expect_equal(resp_from_cache, resp) # Uses new headers if available, otherwise cached headers out_headers <- cache_headers(resp_from_cache, cached_resp) expect_equal(out_headers$`content-type`, "application/json") expect_equal(out_headers$Etag, "DEF") expect_equal(out_headers$other, "new") # If path is null can leave resp as is expect_equal(cache_body(resp_from_cache, NULL), resp$body) expect_equal(resp_body_json(resp_from_cache), list(a = 1L)) # If path is set, need to save to path path <- tempfile() body <- cache_body(resp_from_cache, path) expect_equal(body, new_path(path)) expect_equal(readLines(path, warn = FALSE), rawToChar(resp$body)) }) test_that("handles responses with files", { req <- request("http://example.com") %>% req_cache(tempfile()) path <- local_write_lines("Hi there") resp <- response(200, headers = "Etag: ABC", body = new_path(path)) cache_set(req, resp) # File should be copied in cache directory, and response body updated body_path <- req_cache_path(req, ".body") expect_equal(readLines(body_path), "Hi there") resp_from_cache <- cache_get(req) expect_equal(resp_from_cache$body, new_path(body_path)) # If path is null, just leave body as is, since req_body() already # papers over the differences expect_equal(cache_body(resp_from_cache, NULL), new_path(body_path)) # If path is not null, copy to desired location, and update body path2 <- tempfile() body <- cache_body(resp_from_cache, path2) expect_equal(readLines(body), "Hi there") expect_equal(body, new_path(path2)) }) test_that("corrupt files are ignored", { cache_dir <- withr::local_tempdir() req <- request("http://example.com") %>% req_cache(cache_dir) writeLines(letters, req_cache_path(req)) expect_true(is.null(cache_get(req))) saveRDS(1:10, req_cache_path(req)) expect_false(is.null(cache_get(req))) }) # pruning ----------------------------------------------------------------- test_that("pruning is throttled", { path <- withr::local_tempdir() req <- req_cache(request_test(), path = path) expect_true(cache_prune_if_needed(req)) expect_false(cache_prune_if_needed(req)) expect_true(cache_prune_if_needed(req, threshold = 0)) the$cache_throttle[[path]] <- Sys.time() - 61 expect_true(cache_prune_if_needed(req, threshold = 60)) }) test_that("can prune by number", { path <- withr::local_tempdir() file.create(file.path(path, c("a.rds", "b.rds", "c.rds"))) Sys.sleep(0.1) file.create(file.path(path, c("d.rds"))) cache_prune(path, list(n = 4, age = Inf, size = Inf), debug = TRUE) expect_equal(dir(path), c("a.rds", "b.rds", "c.rds", "d.rds")) expect_snapshot( cache_prune(path, list(n = 1, age = Inf, size = Inf), debug = TRUE) ) expect_equal(dir(path), c("d.rds")) }) test_that("can prune by age", { path <- withr::local_tempdir() file.create(file.path(path, c("a.rds", "b.rds"))) Sys.setFileTime(file.path(path, "a.rds"), Sys.time() - 60) cache_prune(path, list(n = Inf, age = 120, size = Inf), debug = TRUE) expect_equal(dir(path), c("a.rds", "b.rds")) expect_snapshot({ cache_prune(path, list(n = Inf, age = 30, size = Inf), debug = TRUE) }) expect_equal(dir(path), "b.rds") }) test_that("can prune by size", { path <- withr::local_tempdir() writeChar(paste0(letters, collapse = ""), file.path(path, "a.rds")) writeChar(paste0(letters, collapse = ""), file.path(path, "b.rds")) Sys.sleep(0.1) writeChar(paste0(letters, collapse = ""), file.path(path, "c.rds")) cache_prune(path, list(n = Inf, age = Inf, size = 200), debug = TRUE) expect_equal(dir(path), c("a.rds", "b.rds", "c.rds")) expect_snapshot({ cache_prune(path, list(n = Inf, age = Inf, size = 50), debug = TRUE) }) expect_equal(dir(path), "c.rds") }) # headers ----------------------------------------------------------------- test_that("correctly determines if response is cacheable", { is_cacheable <- function(...) { resp_is_cacheable(response(...)) } 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), 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\"" )) info <- resp_cache_info(resp) expect_equal(info$expires, local_time("2020-01-01")) # passed as is back to server, so leave as string expect_equal(info$last_modified, "Wed, 01 Jan 2010 00:00:00 GMT") # quotes are part of the etag string expect_equal(info$etag, '"abc"') }) 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" )) 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" )) expect_equal(resp_cache_expires(resp2), local_time("2020-01-01 00:00")) # Returns NA if no expiry resp2 <- response() expect_equal(resp_cache_expires(resp2), NA) }) httr2/tests/testthat/test-oauth-flow.R0000644000176200001440000000345114731333064017513 0ustar liggesusers# oauth_flow_fetch -------------------------------------------------------- test_that("turns oauth errors to R errors", { req <- request("http://example.com") local_mocked_bindings(req_perform = function(...) { response_json(400L, body = list(error = "1", error_description = "abc")) }) expect_snapshot(oauth_flow_fetch(req, "test"), error = TRUE) }) # oauth_flow_parse -------------------------------------------------------- test_that("userful errors if response isn't parseable", { resp1 <- response(headers = list(`content-type` = "text/plain")) resp2 <- response_json(body = list()) expect_snapshot(error = TRUE, { oauth_flow_parse(resp1, "test") oauth_flow_parse(resp2, "test") }) }) test_that("can inspect the original response if response isn't parseable", { resp1 <- response(headers = list(`content-type` = "text/plain")) resp2 <- response_json(body = list()) tryCatch( oauth_flow_parse(resp1, "test"), httr2_oauth_parse = function(cnd) { expect_equal(cnd$resp, resp1) } ) tryCatch( oauth_flow_parse(resp2, "test"), httr2_oauth_parse = function(cnd) { expect_equal(cnd$resp, resp2) } ) }) test_that("returns body if known good structure", { resp <- response_json(body = list(access_token = "10")) expect_equal(oauth_flow_parse(resp, "test"), list(access_token = "10")) resp <- response_json(body = list(device_code = "10")) expect_equal(oauth_flow_parse(resp, "test"), list(device_code = "10")) resp <- response_json(403L, body = list(error = "10")) expect_snapshot(oauth_flow_parse(resp, "test"), error = TRUE) }) test_that("converts expires_in to numeric", { resp <- response_json(200L, body = list(access_token = "10", expires_in = "20")) body <- oauth_flow_parse(resp, "test") expect_equal(body$expires_in, 20) }) httr2/tests/testthat/test-curl.R0000644000176200001440000001552314752214235016377 0ustar liggesuserstest_that("must be call to curl", { expect_snapshot(error = TRUE, curl_translate("echo foo")) }) test_that("must have cmd argument if non-interactive", { expect_snapshot(error = TRUE, curl_translate()) }) test_that("captures key components of call", { expect_equal(curl_args("curl http://x.com"), list(`` = "http://x.com")) # Quotes are stripped expect_equal(curl_args("curl 'http://x.com'"), list(`` = "http://x.com")) expect_equal(curl_args('curl "http://x.com"'), list(`` = "http://x.com")) # Url can come before or after arguments expect_equal( curl_args("curl -H 'A: 1' 'http://example.com'"), curl_args("curl 'http://example.com' -H 'A: 1'") ) # long name and short name are equivalent expect_equal( curl_args("curl 'http://example.com' --header 'A: 1'"), curl_args("curl 'http://example.com' -H 'A: 1'") ) # can repeat args expect_equal( curl_args("curl 'http://example.com' -H 'A: 1' -H 'B: 2'")$`--header`, c("A: 1", "B: 2") ) # Captures flags expect_equal(curl_args("curl 'http://example.com' --verbose")$`--verbose`, TRUE) }) test_that("can accept multiple data arguments", { expect_equal( curl_args("curl https://example.com -d x=1 -d y=2")$`--data`, c("x=1", "y=2") ) }) test_that("can handle line breaks", { expect_equal( curl_args("curl 'http://example.com' \\\n -H 'A: 1' \\\n -H 'B: 2'")$`--header`, c("A: 1", "B: 2") ) }) test_that("headers are parsed", { expect_equal( curl_normalize("curl http://x.com -H 'A: 1'")$headers, new_headers(list(A = "1")) ) expect_equal( curl_normalize("curl http://x.com -H 'B:'")$headers, new_headers(list(B = "")) ) }) test_that("user-agent and referer become headers", { expect_equal( curl_normalize("curl http://x.com -A test")$headers, as_headers(list("user-agent" = "test")) ) expect_equal( curl_normalize("curl http://x.com -e test")$headers, as_headers(list("referer" = "test")) ) }) 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) headers <- curl_normalize(cmd)$headers expect_snapshot({ print(curl_simplify_headers(headers, simplify_headers = TRUE)) print(curl_simplify_headers(headers, simplify_headers = FALSE)) }) }) test_that("extract user name and password", { expect_equal( curl_normalize("curl http://x.com -u name:pass")$auth, list(username = "name", password = "pass") ) expect_equal( curl_normalize("curl http://x.com -u name")$auth, list(username = "name", password = "") ) }) test_that("can override default method", { expect_equal(curl_normalize("curl http://x.com")$method, NULL) expect_equal(curl_normalize("curl http://x.com --get")$method, "GET") expect_equal(curl_normalize("curl http://x.com --head")$method, "HEAD") expect_equal(curl_normalize("curl http://x.com -X PUT")$method, "PUT") }) test_that("prefers explicit url", { expect_equal(curl_normalize("curl 'http://x.com'")$url, "http://x.com") expect_equal(curl_normalize("curl --url 'http://x.com'")$url, "http://x.com") # prefers explicit expect_equal( curl_normalize("curl 'http://x.com' --url 'http://y.com'")$url, "http://y.com" ) }) test_that("can translate to httr calls", { skip_if(getRversion() < "4.1") expect_snapshot({ curl_translate("curl http://x.com") curl_translate("curl http://x.com -X DELETE") curl_translate("curl http://x.com -H A:1") curl_translate("curl http://x.com -H 'A B:1'") curl_translate("curl http://x.com -u u:p") curl_translate("curl http://x.com --verbose") }) }) test_that("can translate query", { skip_if(getRversion() < "4.1") expect_snapshot({ curl_translate("curl http://x.com?string=abcde&b=2") }) }) test_that("can translate data", { skip_if(getRversion() < "4.1") expect_snapshot({ curl_translate("curl http://example.com --data abcdef") curl_translate("curl http://example.com --data abcdef -H Content-Type:text/plain") }) }) test_that("can translate ocokies", { skip_if(getRversion() < "4.1") expect_snapshot({ curl_translate("curl 'http://test' -H 'Cookie: x=1; y=2;z=3'") }) }) 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"}'}--") }) }) test_that("content type stays in header if no data", { skip_if(getRversion() < "4.1") expect_snapshot( curl_translate("curl http://example.com -H Content-Type:text/plain") ) }) test_that("can evaluate simple calls", { request_test() # hack to start server resp <- curl_translate_eval(glue("curl {the$test_app$url()}/get -H A:1")) body <- resp_body_json(resp) expect_equal(body$headers$A, "1") resp <- curl_translate_eval(glue("curl {the$test_app$url()}/post --data A=1")) body <- resp_body_json(resp) expect_equal(body$form$A, "1") 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")) body <- resp_body_json(resp) expect_true(body$authenticated) }) test_that("can read from clipboard", { skip_on_cran() skip_if_not_installed("clipr") skip_if(getRversion() < "4.1") # pretend we're interactive and can use the clipboard withr::local_envvar(CLIPR_ALLOW = TRUE) rlang::local_interactive() skip_if_not(clipr::clipr_available()) # restore the existing clipboard to be nice to the tester old_clip <- suppressWarnings(clipr::read_clip()) if (!is.null(old_clip)) { withr::defer(clipr::write_clip(old_clip)) } clipr::write_clip("curl 'http://example.com' \\\n -H 'A: 1' \\\n -H 'B: 2'") expect_snapshot({ curl_translate() # also writes to clip writeLines(clipr::read_clip()) }) }) test_that("encode_string2() produces simple strings", { # double quotes is standard expect_equal(encode_string2("x"), encodeString("x", quote = '"')) # use single quotes if double quotes but not single quotes expect_equal(encode_string2('x"x'), encodeString('x"x', quote = "'")) skip_if_not(getRversion() >= "4.0.0") # use raw string if single and double quotes are used expect_equal(encode_string2('x"\'x'), 'r"---{x"\'x}---"') skip_if(getRversion() < "4.1") 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") expect_snapshot(curl_translate(cmd)) }) httr2/tests/testthat/test-oauth-flow-auth-code.R0000644000176200001440000001176014752214235021365 0ustar liggesuserstest_that("desktop style can't run in hosted environment", { client <- oauth_client("abc", "http://example.com") withr::local_options(rlang_interactive = TRUE) withr::local_envvar("RSTUDIO_PROGRAM_MODE" = "server") expect_snapshot( oauth_flow_auth_code(client, "http://localhost"), error = TRUE ) }) test_that("so-called 'hosted' sessions are detected correctly", { withr::with_envvar(c("RSTUDIO_PROGRAM_MODE" = "server"), { expect_true(is_hosted_session()) }) # Emulate running outside RStudio Server if we happen to be running our tests # under it. withr::with_envvar(c("RSTUDIO_PROGRAM_MODE" = NA), { expect_false(is_hosted_session()) }) }) test_that("URL embedding authorisation code and state can be input manually", { local_mocked_bindings( readline = function(prompt = "") "https://x.com?code=code&state=state" ) expect_equal(oauth_flow_auth_code_read("state"), "code") expect_error(oauth_flow_auth_code_read("invalid"), "state does not match") }) test_that("JSON-encoded authorisation codes can be input manually", { input <- list(state = "state", code = "code") encoded <- openssl::base64_encode(jsonlite::toJSON(input)) local_mocked_bindings( readline = function(prompt = "") encoded ) expect_equal(oauth_flow_auth_code_read("state"), "code") expect_error(oauth_flow_auth_code_read("invalid"), "state does not match") }) test_that("bare authorisation codes can be input manually", { state <- base64_url_rand(32) sent_code <- FALSE local_mocked_bindings( readline = function(prompt = "") { if (sent_code) { state } else { sent_code <<- TRUE "zyx987" } } ) expect_equal(oauth_flow_auth_code_read(state), "zyx987") expect_error(oauth_flow_auth_code_read("invalid"), "state does not match") }) # normalize_redirect_uri -------------------------------------------------- test_that("adds port to localhost url", { # Allow tests to run when is_hosted_session() is TRUE. local_mocked_bindings(is_hosted_session = function() FALSE) redirect <- normalize_redirect_uri("http://localhost") expect_false(is.null(url_parse(redirect$uri)$port)) redirect <- normalize_redirect_uri("http://127.0.0.1") expect_false(is.null(url_parse(redirect$uri)$port)) }) test_that("old args are deprecated", { # Allow tests to run when is_hosted_session() is TRUE. local_mocked_bindings(is_hosted_session = function() FALSE) expect_snapshot( redirect <- normalize_redirect_uri("http://localhost", port = 1234) ) expect_equal(redirect$uri, "http://localhost:1234/") expect_snapshot( redirect <- normalize_redirect_uri("http://x.com", host_name = "y.com") ) expect_equal(redirect$uri, "http://y.com/") expect_snapshot( redirect <- normalize_redirect_uri("http://x.com", host_ip = "y.com") ) }) test_that("urls left as is if not changes needed", { # Allow tests to run when is_hosted_session() is TRUE. local_mocked_bindings(is_hosted_session = function() FALSE) original_uri <- "http://localhost:8080" normalized_uri <- normalize_redirect_uri(original_uri) expect_equal(normalized_uri$uri, original_uri) }) # ouath_flow_auth_code_parse ---------------------------------------------- test_that("forwards oauth error", { query1 <- query2 <- list(error = "123", error_description = "A bad error") query2$error_uri <- "http://example.com" query3 <- list(state = "def") expect_snapshot(error = TRUE, { oauth_flow_auth_code_parse(query1, "abc") oauth_flow_auth_code_parse(query2, "abc") oauth_flow_auth_code_parse(query3, "abc") }) }) # can_fetch_auth_code ----------------------------------------------------- test_that("external auth code sources are detected correctly", { # False by default. expect_false(can_fetch_oauth_code("http://localhost:8080/redirect")) # Only true in the presence of certain environment variables. env <- c( "HTTR2_OAUTH_CODE_SOURCE_URL" = "http://localhost:8080/code", "HTTR2_OAUTH_REDIRECT_URL" = "http://localhost:8080/redirect" ) withr::with_envvar(env, { expect_true(can_fetch_oauth_code("http://localhost:8080/redirect")) # Non-matching redirect URLs should not count as external sources, either. expect_false(can_fetch_oauth_code("http://localhost:9090/redirect")) }) }) # oauth_flow_auth_code_fetch ---------------------------------------------- test_that("auth codes can be retrieved from an external source", { skip_on_cran() 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") } else { res$ set_status(200L)$ send_json(text = '{"code":"abc123"}') } }) withr::local_envvar("HTTR2_OAUTH_CODE_SOURCE_URL" = req$url) expect_equal(oauth_flow_auth_code_fetch("ignored"), "abc123") }) httr2/tests/testthat/test-req-perform-stream.R0000644000176200001440000000601314752214235021154 0ustar liggesuserstest_that("req_stream() is deprecated", { req <- request(example_url("/stream-bytes/100")) expect_snapshot( resp <- req_stream(req, identity, buffer_kb = 32) ) }) # req_perform_stream() -------------------------------------------------------- test_that("returns stream body; sets last request & response", { req <- request_test("/stream-bytes/1024") resp <- req_perform_stream(req, function(x) NULL) expect_s3_class(resp, "httr2_response") expect_false(resp_has_body(resp)) expect_equal(last_request(), req) expect_equal(last_response(), resp) }) test_that("HTTP errors become R errors", { req <- request_test("/status/404") expect_error( req_perform_stream(req, function(x) TRUE), class = "httr2_http_404" ) resp <- last_response() expect_s3_class(resp, "httr2_response") expect_equal(resp$status_code, 404) }) test_that("can override error handling", { req <- request_test("/base64/:value", value = "YWJj") %>% req_error(is_error = function(resp) TRUE) expect_error( req %>% req_perform_stream(function(x) NULL), class = "httr2_http_200" ) resp <- last_response() expect_s3_class(resp, "httr2_response") # This also allows us to check that the body is set correctly # since that httpbin error responses have empty bodies expect_equal(resp_body_string(resp), "abc") }) test_that("can buffer to lines", { lines <- character() accumulate_lines <- function(x) { lines <<- c(lines, strsplit(rawToChar(x), "\n", fixed = TRUE)[[1]]) TRUE } # Each line is 225 bytes, should should be split into ~2 pieces resp <- request_test("/stream/10") %>% req_perform_stream(accumulate_lines, buffer_kb = 0.1, round = "line") expect_equal(length(lines), 10) valid_json <- map_lgl(lines, jsonlite::validate) expect_equal(valid_json, rep(TRUE, 10)) }) test_that("can supply custom rounding", { out <- list() accumulate <- function(x) { out <<- c(out, list(x)) TRUE } resp <- request_test("/stream-bytes/1024") %>% req_perform_stream( accumulate, buffer_kb = 0.1, round = function(bytes) if (length(bytes) > 100) 100 else integer() ) expect_equal(lengths(out), c(rep(100, 10), 24)) }) test_that("eventually terminates even if never rounded", { out <- raw() accumulate <- function(x) { out <<- c(out, x) TRUE } resp <- request_test("/stream-bytes/1024") %>% req_perform_stream( accumulate, buffer_kb = 0.1, round = function(bytes) integer() ) expect_equal(length(out), 1024) }) test_that("req_perform_stream checks its inputs", { req <- request_test("/stream-bytes/1024") callback <- function(x) NULL expect_snapshot(error = TRUE, { req_perform_stream(1) req_perform_stream(req, 1) req_perform_stream(req, callback, timeout_sec = -1) req_perform_stream(req, callback, buffer_kb = "x") }) }) test_that("as_round_function checks its inputs", { expect_snapshot(error = TRUE, { as_round_function(1) as_round_function("bytes") as_round_function(function(x) 1) }) }) httr2/tests/testthat/test-req.R0000644000176200001440000000202414737043664016222 0ustar liggesuserstest_that("req has basic print method", { expect_snapshot({ req <- request("https://example.com") req req %>% req_body_raw("Test") req %>% req_body_multipart("Test" = 1) }) }) test_that("printing headers works with {}", { expect_snapshot(req_headers(request("http://test"), x = "{z}", `{z}` = "x")) }) test_that("individually prints repeated headers", { expect_snapshot(request("https://example.com") %>% req_headers(A = 1:3)) }) test_that("print method obfuscates Authorization header unless requested", { req <- request("https://example.com") %>% req_auth_basic("user", "SECRET") output <- testthat::capture_messages(print(req)) expect_false(any(grepl("SECRET", output, fixed = TRUE))) output <- testthat::capture_messages(print(req, redact_headers = FALSE)) expect_true(any(grepl("Authorization: \"Basic", output, fixed = TRUE))) expect_false(any(grepl("REDACTED", output, fixed = TRUE))) }) test_that("check_request() gives useful error", { expect_snapshot(check_request(1), error = TRUE) }) httr2/tests/testthat/test-resp-headers.R0000644000176200001440000000520414751434044020010 0ustar liggesuserstest_that("can extract headers and check for existence", { resp <- response(headers = "Content-Type: application/json") expect_type(resp_headers(resp), "list") expect_equal(resp_header(resp, "Content-Type"), "application/json") expect_equal(resp_header_exists(resp, "Content-Type"), TRUE) }) test_that("headers are case-insenstive", { resp <- response(headers = "Content-Type: application/json") expect_equal(resp_header(resp, "content-type"), "application/json") expect_equal(resp_header_exists(resp, "content-type"), TRUE) }) test_that("has tools for non-existent headers", { resp <- response() expect_equal(resp_header(resp, "non-existent"), NULL) expect_equal(resp_header(resp, "non-existent", "xyz"), "xyz") expect_equal(resp_header_exists(resp, "non-existent"), FALSE) }) test_that("can extract content type/encoding", { resp <- response(headers = "Content-Type: text/html; charset=latin1") expect_equal(resp_content_type(resp), "text/html") expect_equal(resp_encoding(resp), "latin1") }) test_that("can parse date header", { resp <- response(headers = "Date: Mon, 18 Jul 2016 16:06:00 GMT") expect_equal(resp_date(resp), local_time('2016-07-18 16:06:06')) }) 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" )) expect_equal(resp_retry_after(resp_abs), 10) resp_rel <- response(headers = c( "Retry-After: 20" )) expect_equal(resp_retry_after(resp_rel), 20) resp_rel <- response() expect_equal(resp_retry_after(resp_rel), NA) }) # resp_link_url() -------------------------------------------------------------- test_that("can extract specified link url", { 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") # Falling back to NULL if not found expect_equal(resp_link_url(resp, "first"), NULL) expect_equal(resp_link_url(response(), "first"), NULL) }) test_that("can extract from multiple link headers", { 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") }) test_that("is case insensitive", { resp <- response(headers = 'LINK: ; rel="next"') expect_equal(resp_link_url(resp, "next"), "https://example.com/1") }) httr2/tests/testthat/test-req-headers.R0000644000176200001440000000473214761701552017635 0ustar liggesuserstest_that("can add and remove headers", { req <- request("http://example.com") req <- req %>% req_headers(x = 1) expect_equal(req$headers, new_headers(list(x = 1))) req <- req %>% req_headers(x = NULL) expect_equal(req$headers, new_headers(list())) }) test_that("can add header called req", { req <- request("http://example.com") req <- req %>% req_headers(req = 1) expect_equal(req$headers, new_headers(list(req = 1))) }) test_that("can add repeated headers", { resp <- request_test() %>% req_headers(a = c("a", "b")) %>% req_dry_run(quiet = TRUE) # https://datatracker.ietf.org/doc/html/rfc7230#section-3.2.2 expect_equal(resp$headers$a, c("a,b")) }) test_that("replacing headers is case-insensitive", { req <- request("http://example.com") req <- req %>% req_headers(A = 1) req <- req %>% req_headers(a = 2) expect_equal(req$headers, new_headers(list(a = 2))) }) # redaction --------------------------------------------------------------- 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")) }) test_that("only redacts supplied headers", { req <- request("http://example.com") expect_redacted(req_headers(req, a = 1L, b = 2L, .redact = "d"), character()) }) test_that("redaction preserved across calls", { req <- request("http://example.com") req <- req_headers(req, a = 1L, .redact = "a") req <- req_headers(req, a = 2) expect_redacted(req, "a") }) test_that("req_headers_redacted redacts all headers", { req <- request("http://example.com") expect_redacted(req_headers_redacted(req, a = 1L, b = 2L), c("a", "b")) }) test_that("is case insensitive", { req <- request("http://example.com") req <- req_headers(req, a = 1L, .redact = "A") expect_redacted(req, "A") expect_snapshot(req) # Test the other direction too, just to be safe req <- request("http://example.com") req <- req_headers(req, A = 1L, .redact = "a") expect_redacted(req, "a") }) test_that("authorization is always redacted", { req <- request("http://example.com") expect_redacted(req_headers(req, Authorization = "X"), "Authorization") }) test_that("checks input types", { req <- request("http://example.com") expect_snapshot(error = TRUE, { req_headers(req, a = 1L, b = 2L, .redact = 1L) }) }) httr2/tests/testthat/test-req-method.R0000644000176200001440000000075114063720625017474 0ustar liggesuserstest_that("can override default method", { req <- request("http://example.com") expect_equal(req$method, NULL) req <- req_method(req, "patch") expect_equal(req$method, "PATCH") }) test_that("correctly guesses default method", { req <- request("http://example.com") expect_equal(req_method_get(req), "GET") req <- req_body_raw(req, "abc") expect_equal(req_method_get(req), "POST") req <- req_options(req, nobody = TRUE) expect_equal(req_method_get(req), "HEAD") }) httr2/tests/testthat/test-oauth-flow-jwt.R0000644000176200001440000000251214556444037020322 0ustar liggesusers# 1. Create service account # 2. Add key and download json # 3. json <- jsonlite::read_json(path) # 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") client <- oauth_client( id = secrets$client_id, key = secrets$private_key, token_url = secrets$token_uri, auth = "body" ) claim <- list( iss = secrets$client_email, scope = "https://www.googleapis.com/auth/userinfo.email", aud = "https://oauth2.googleapis.com/token" ) # Can generate token token <- oauth_flow_bearer_jwt(client, claim) expect_s3_class(token, "httr2_token") # Can use it in request resp <- request("https://openidconnect.googleapis.com/v1/userinfo") %>% req_oauth_bearer_jwt(client, claim) %>% req_perform() %>% resp_body_json() expect_type(resp, "list") expect_equal(resp$email_verified, TRUE) }) 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")) expect_snapshot(oauth_flow_bearer_jwt(client2, claim = NULL), error = TRUE) }) httr2/tests/testthat/test-secret.R0000644000176200001440000000353614656157441016730 0ustar liggesuserstest_that("encryption and decryption of string is symmetric", { key <- secret_make_key() x <- "Testing 1...2...3..." enc <- secret_encrypt(x, key) dec <- secret_decrypt(enc, key) expect_equal(dec, x) }) test_that("encryption and decryption of object is symmetric", { key <- secret_make_key() path <- withr::local_tempfile() x1 <- list(1:10, letters) secret_write_rds(x1, path, key) x2 <- secret_read_rds(path, key) expect_equal(x1, x2) }) test_that("encryption and decryption of file is symmetric", { key <- secret_make_key() path <- withr::local_tempfile(lines = letters) secret_encrypt_file(path, key) local({ path_dec <<- secret_decrypt_file(path, key) expect_equal(readLines(path_dec, warn = FALSE), letters) }) expect_false(file.exists(path_dec)) }) test_that("can unobfuscate obfuscated string", { x <- obfuscated("qw6Ua_n2LR_xzuk2uqp2dhb5OaE") expect_equal(unobfuscate(x), "test") }) test_that("obfuscated strings are hidden", { expect_snapshot({ x <- obfuscated("abcdef") x str(x) }) }) 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"))) }) test_that("secret_has_key returns FALSE/TRUE", { withr::local_envvar(ENVVAR_THAT_DOES_EXIST = "1") expect_equal(secret_has_key("ENVVAR_THAT_DOESNT_EXIST"), FALSE) expect_equal(secret_has_key("ENVVAR_THAT_DOES_EXIST"), TRUE) }) test_that("can coerce to a key", { expect_equal(as_key(I("YWJj")), charToRaw("abc")) expect_equal(as_key(as.raw(c(1, 2, 3))), as.raw(c(1, 2, 3))) withr::local_envvar(KEY = "YWJj", TESTTHAT = "false") expect_equal(as_key("KEY"), charToRaw("abc")) expect_snapshot(error = TRUE, { as_key("ENVVAR_THAT_DOESNT_EXIST") as_key(1) }) }) httr2/tests/testthat/test-req-auth.R0000644000176200001440000000101214761701552017147 0ustar liggesuserstest_that("can send username/password", { user <- "u" password <- "p" req1 <- request_test("/basic-auth/:user/:password") req2 <- req1 %>% req_auth_basic(user, password) expect_redacted(req2, "Authorization") expect_error(req_perform(req1), class = "httr2_http_401") expect_error(req_perform(req2), NA) }) test_that("can send bearer token", { req <- req_auth_bearer_token(request_test(), "abc") expect_equal( req$headers, new_headers(list(Authorization = "Bearer abc"), "Authorization") ) }) httr2/tests/testthat/test-parse.R0000644000176200001440000000474014656161723016551 0ustar liggesuserstest_that("can parse media type", { # no params expect_equal(parse_media("text/plain"), list(type = "text/plain")) # single param expect_equal( parse_media("text/plain; charset=utf-8"), list(type = "text/plain", charset = "utf-8") ) # single param with quotes expect_equal( parse_media("text/plain; charset=\"utf-8\""), list(type = "text/plain", charset = "utf-8") ) # quoted param containing ; expect_equal( parse_media("text/plain; charset=\";\""), list(type = "text/plain", charset = ";") ) expect_equal(parse_media(""), list(type = NA_character_)) }) test_that("can parse authenticate header", { header <- paste0( 'Bearer realm="example",', 'error="invalid_token",', 'error_description="The access token expired"' ) out <- parse_www_authenticate(header) expect_equal(out$scheme, "Bearer") expect_equal(out$realm, "example") expect_equal(out$error_description, "The access token expired") }) test_that("can parse links", { header <- paste0( '; rel="next",', '; rel="last"' ) expect_equal( parse_link(header), list( list(url = "https://example.com/1", rel = "next"), list(url = "https://example.com/2", rel = "last") ) ) }) # Helpers ----------------------------------------------------------------- test_that("parse_in_half handles common cases", { parsed <- parse_in_half(c("a=b", "c=d", "e", "=f", "g=", "h=i=j"), "=") expect_equal(parsed$left, c("a", "c", "e", "", "g", "h")) expect_equal(parsed$right, c("b", "d", "", "f", "", "i=j")) }) test_that("parse_in_half handles problematic inputs", { expect_equal( parse_in_half(character(0), "="), list(left = character(0), right = character(0)) ) expect_equal( parse_in_half("", "="), list(left = "", right = "") ) expect_equal( parse_in_half(NA, "="), list(left = NA_character_, right = NA_character_) ) }) test_that("parse_in_half always returns two pieces", { expect_equal(parse_in_half("a", " "), list(left = "a", right = "")) expect_equal(parse_in_half("a b", " "), list(left = "a", right = "b")) expect_equal(parse_in_half("a b c", " "), list(left = "a", right = "b c")) }) test_that("parse_name_equals_value handles empty values", { expect_equal(parse_name_equals_value("a"), c(a = "")) }) test_that("parse_match converts missing matches to NULL", { expect_equal( parse_match("abbbd", "(a)(b+)(c*)(d)"), list("a", "bbb", NULL, "d" )) }) httr2/tests/testthat/test-req-perform-connection.R0000644000176200001440000000405714761705464022037 0ustar liggesuserstest_that("validates inputs", { expect_snapshot(error = TRUE, { req_perform_connection(1) req_perform_connection(request_test(), 1) }) }) test_that("correctly prepares request", { req <- request_test("/post") %>% req_method("POST") expect_no_error(resp <- req_perform_connection(req)) close(resp) }) test_that("can read all data from a connection", { resp <- request_test("/stream-bytes/2048") %>% req_perform_connection() withr::defer(close(resp)) out <- resp_body_raw(resp) expect_length(out, 2048) expect_false(resp_has_body(resp)) }) test_that("reads body on error", { req <- local_app_request(function(req, res) { res$set_status(404L)$send_json(list(status = 404), auto_unbox = TRUE) }) expect_error(req_perform_connection(req), class = "httr2_http_404") resp <- last_response() expect_equal(resp_body_json(resp), list(status = 404)) }) test_that("can retry a transient error", { req <- local_app_request(function(req, res) { i <- res$app$locals$i %||% 1 if (i == 1) { res$app$locals$i <- 2 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) } }) req <- req_retry(req, max_tries = 2) cnd <- expect_condition( resp <- req_perform_connection(req), class = "httr2_retry" ) expect_s3_class(cnd, "httr2_retry") expect_equal(cnd$tries, 1) expect_equal(cnd$delay, 0) expect_equal(last_response(), resp) expect_equal(resp_body_json(resp), list(status = "done")) }) test_that("curl errors become errors", { local_mocked_bindings(open = function(...) abort("Failed to connect")) req <- request("http://127.0.0.1") expect_snapshot(req_perform_connection(req), error = TRUE) expect_error(req_perform_connection(req), class = "httr2_failure") # and captures request cnd <- catch_cnd(req_perform_connection(req), classes = "error") expect_equal(cnd$request, req) # But last_response() is NULL expect_null(last_response()) }) httr2/tests/testthat/test-req-mock.R0000644000176200001440000000215114740237660017145 0ustar liggesuserstest_that("can override requests through mocking", { resp <- response() req <- request("https://google.com") expect_equal(with_mocked_responses(~resp, req_perform(req)), resp) local_mocked_responses(function(req) resp) expect_equal(req_perform(req), resp) }) test_that("can generate errors with mocking", { local_mocked_responses(~ response(404)) req <- request("https://google.com") expect_error(req_perform(req), class = "httr2_http_404") }) test_that("local_mock and with_mock are deprecated", { expect_snapshot(error = TRUE, { local_mock(~ response(404)) . <- with_mock(NULL, ~ response(404)) }) }) test_that("mocked_response_sequence returns responses then errors", { local_mocked_responses(list( response(200), response(201) )) req <- request("https://google.com") expect_equal(req_perform(req), response(200)) expect_equal(req_perform(req), response(201)) expect_error(req_perform(req), class = "httr2_http_503") }) test_that("validates inputs", { expect_snapshot(error = TRUE, { local_mocked_responses(function(foo) {}) local_mocked_responses(10) }) }) httr2/tests/testthat/test-req-perform-parallel.R0000644000176200001440000002354614761705464021500 0ustar liggesuserstest_that("request and paths must match", { req <- request("http://example.com") expect_snapshot(req_perform_parallel(req, letters), error = TRUE) }) test_that("can perform zero requests", { expect_equal(req_perform_parallel(list()), list()) }) test_that("can perform a single request", { reqs <- list(request_test("/get")) resps <- req_perform_parallel(reqs) expect_type(resps, "list") expect_length(resps, 1) }) test_that("requests happen in parallel", { # test works best if webfakes has ample threads and keepalive reqs <- list2( request_test("/delay/:secs", secs = 0), request_test("/delay/:secs", secs = 0.25), request_test("/delay/:secs", secs = 0.25), request_test("/delay/:secs", secs = 0.25), request_test("/delay/:secs", secs = 0.25), request_test("/delay/:secs", secs = 0.25), ) time <- system.time(req_perform_parallel(reqs)) expect_lt(time[[3]], 1) }) test_that("can perform >128 file uploads in parallel", { temp <- withr::local_tempfile(lines = letters) req <- request(example_url()) %>% req_body_file(temp) reqs <- rep(list(req), 130) expect_no_error(req_perform_parallel(reqs, on_error = "continue")) }) test_that("can download files", { reqs <- list(request_test("/json"), request_test("/html")) paths <- c(withr::local_tempfile(), withr::local_tempfile()) resps <- req_perform_parallel(reqs, paths) expect_equal(resps[[1]]$body, new_path(paths[[1]])) expect_equal(resps[[2]]$body, new_path(paths[[2]])) # And check that something was downloaded expect_gt(file.size(paths[[1]]), 0) expect_gt(file.size(paths[[2]]), 0) }) test_that("can download 0 byte file", { reqs <- list(request_test("/bytes/0")) paths <- withr::local_tempfile() resps <- req_perform_parallel(reqs, paths = paths) expect_equal(file.size(paths[[1]]), 0) }) test_that("objects are cached", { temp <- withr::local_tempdir() req <- request_test("etag/:etag", etag = "abcd") %>% req_cache(temp) expect_condition( resps1 <- req_perform_parallel(list(req)), class = "httr2_cache_save" ) expect_condition( resps2 <- req_perform_parallel(list(req)), class = "httr2_cache_not_modified" ) }) test_that("immutable objects retrieved 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") ) cache_set(req, resp) expect_condition( resps <- req_perform_parallel(list(req)), class = "httr2_cache_cached" ) expect_equal(resps[[1]], resp) }) test_that("errors by default", { req <- request_test("/status/:status", status = 404) err <- expect_error(req_perform_parallel(list(req))) expect_s3_class(err, "httr2_http_404") # Wraps and forwards curl errors req <- request("INVALID") err <- expect_error(req_perform_parallel(list(req))) expect_s3_class(err, "httr2_failure") expect_s3_class(err$parent, "curl_error_couldnt_resolve_host") }) test_that("both curl and HTTP errors become errors on continue", { reqs <- list2( request_test("/status/:status", status = 404), request("INVALID"), ) out <- req_perform_parallel(reqs, on_error = "continue") expect_s3_class(out[[1]], "httr2_http_404") expect_s3_class(out[[2]], "httr2_failure") # and contain the responses expect_equal(out[[1]]$request, reqs[[1]]) expect_equal(out[[2]]$request, reqs[[2]]) }) test_that("errors can cancel outstanding requests", { reqs <- list2( request_test("/status/:status", status = 404), request_test("/delay/:secs", secs = 1), request_test("/delay/:secs", secs = 1), ) out <- req_perform_parallel(reqs, on_error = "return", max_active = 1) expect_s3_class(out[[1]], "httr2_http_404") # second request might succeed or fail depend on the timing, but the # third request should definitely fail expect_null(out[[3]]) }) test_that("req_perform_parallel resspects http_error() error override", { reqs <- list2( req_error(request_test("/status/:status", status = 404), is_error = ~FALSE), req_error(request_test("/status/:status", status = 500), is_error = ~FALSE) ) resps <- req_perform_parallel(reqs) expect_equal(resp_status(resps[[1]]), 404) expect_equal(resp_status(resps[[2]]), 500) }) test_that("req_perform_parallel respects http_error() body message", { reqs <- list2( req_error(request_test("/status/:status", status = 404), body = ~"hello") ) expect_snapshot(req_perform_parallel(reqs), error = TRUE) }) test_that("requests are throttled", { withr::defer(throttle_reset()) mock_time <- 0 local_mocked_bindings( unix_time = function() mock_time, Sys.sleep = function(seconds) mock_time <<- mock_time + seconds ) req <- request_test("/status/:status", status = 200) req <- req %>% req_throttle(capacity = 1, fill_time_s = 1) reqs <- rep(list(req), 5) queue <- RequestQueue$new(reqs, progress = FALSE) queue$process() expect_equal(mock_time, 4) }) # Tests of lower-level operation ----------------------------------------------- test_that("can retry an OAuth failure", { req <- local_app_request(function(req, res) { i <- res$app$locals$i %||% 1 if (i == 1) { res$app$locals$i <- 2 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) } }) req <- req_policies(req, auth_oauth = TRUE) reset <- 0 local_mocked_bindings(req_auth_clear_cache = function(...) reset <<- reset + 1) queue <- RequestQueue$new(list(req), progress = FALSE) queue$process() expect_equal(reset, 1) expect_equal(resp_body_json(queue$resps[[1]]), list(status = "done")) }) 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) }) req <- req_policies(req, auth_oauth = TRUE) queue <- RequestQueue$new(list(req), progress = FALSE) queue$process() expect_s3_class(queue$resps[[1]], "httr2_http_401") }) test_that("can retry a transient error", { req <- local_app_request(function(req, res) { i <- res$app$locals$i %||% 1 if (i == 1) { res$app$locals$i <- 2 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) } }) req <- req_retry(req, max_tries = 2) mock_time <- 1 local_mocked_bindings( unix_time = function() mock_time, Sys.sleep = function(seconds) mock_time <<- mock_time + seconds ) queue <- RequestQueue$new(list(req), progress = FALSE) # submit the request expect_null(queue$process1()) expect_equal(queue$queue_status, "working") expect_equal(queue$n_active, 1) expect_equal(queue$n_pending, 0) expect_equal(queue$status[[1]], "active") # process the response and capture the retry expect_null(queue$process1()) expect_equal(queue$queue_status, "waiting") expect_equal(queue$rate_limit_deadline, mock_time + 2) expect_equal(queue$n_pending, 1) expect_s3_class(queue$resps[[1]], "httr2_http_429") expect_equal(resp_body_json(queue$resps[[1]]$resp), list(status = "waiting")) # Starting waiting expect_null(queue$process1()) expect_equal(queue$queue_status, "waiting") expect_equal(mock_time, 3) # Finishing waiting expect_null(queue$process1()) expect_equal(queue$queue_status, "working") expect_equal(queue$n_active, 0) expect_equal(queue$n_pending, 1) # Resubmit expect_null(queue$process1()) expect_equal(queue$queue_status, "working") expect_equal(queue$n_active, 1) expect_equal(queue$n_pending, 0) # Process the response expect_null(queue$process1()) expect_equal(queue$queue_status, "working") expect_equal(queue$n_active, 0) expect_equal(queue$n_pending, 0) expect_s3_class(queue$resps[[1]], "httr2_response") expect_equal(resp_body_json(queue$resps[[1]]), list(status = "done")) # So we're finally done expect_null(queue$process1()) expect_equal(queue$queue_status, "done") expect_false(queue$process1()) }) test_that("throttling is limited by deadline", { withr::defer(throttle_reset("test")) mock_time <- 0 local_mocked_bindings( unix_time = function() mock_time, Sys.sleep = function(seconds) mock_time <<- mock_time + seconds ) req <- request_test("/status/:status", status = 200) req <- req_throttle(req, capacity = 1, fill_time_s = 1, realm = "test") queue <- RequestQueue$new(list(req), progress = FALSE) # Check time only advances by one second, and token is returned to bucket local_mocked_bindings(throttle_deadline = function(...) mock_time + 2) queue$process1(1) expect_equal(queue$queue_status, "waiting") queue$process1(1) expect_equal(mock_time, 1) expect_equal(the$throttle[["test"]]$tokens, 1) local_mocked_bindings(throttle_deadline = function(...) mock_time) queue$rate_limit_deadline <- mock_time + 2 expect_equal(mock_time, 1) expect_equal(the$throttle[["test"]]$tokens, 1) }) # Pool helpers ---------------------------------------------------------------- test_that("wait for deadline waits after pool complete", { pool <- curl::new_pool() deadline <- unix_time() + 1 slept <- 0 local_mocked_bindings( unix_time = function() 0, Sys.sleep = function(seconds) mock_time <<- slept <<- seconds ) expect_true(pool_wait_for_deadline(pool, deadline = 1)) expect_equal(slept, 1) }) # Deprecations ---------------------------------------------------------------- test_that("multi_req_perform is deprecated", { expect_snapshot(multi_req_perform(list())) }) test_that("pool argument is deprecated", { expect_snapshot(. <- req_perform_parallel(list(), pool = curl::new_pool())) }) httr2/tests/testthat/_snaps/0000755000176200001440000000000014761707310015610 5ustar liggesusershttr2/tests/testthat/_snaps/resp-status.md0000644000176200001440000000056214761701422020425 0ustar liggesusers# get some useful output from WWW-Authenticate header HTTP 401 Unauthorized. * OAuth error: invalid_token - The access token expired * realm: example --- HTTP 403 Forbidden. * OAuth error: insufficient_scope * realm: https://accounts.google.com/ * scope: https://www.googleapis.com/auth/iam https://www.googleapis.com/auth/cloud-platform httr2/tests/testthat/_snaps/req-error.md0000644000176200001440000000110714761701420020043 0ustar liggesusers# failing callback still generates useful body Failed to parse error body with method defined in `req_error()`. Caused by error: ! This is an error! --- Code req <- request_test("/status/404") req <- req %>% req_error(body = ~ resp_body_json(.x)$error) req %>% req_perform() Condition Error in `req_perform()`: ! Failed to parse error body with method defined in `req_error()`. Caused by error in `resp_body_json()`: ! Unexpected content type "text/plain". * Expecting type "application/json" or suffix "json". httr2/tests/testthat/_snaps/oauth.md0000644000176200001440000000025314761701417017254 0ustar liggesusers# can store on disk Code cache$set(1) Message Caching httr2 token in '/httr2-test/ae743e0fbd718c21f2cca632e77bd180-token.rds.enc'. httr2/tests/testthat/_snaps/req-options.md0000644000176200001440000000133614761701420020411 0ustar liggesusers# validates inputs Code request_test() %>% req_timeout("x") Condition Error in `req_timeout()`: ! `seconds` must be a number, not the string "x". Code request_test() %>% req_timeout(0) Condition Error in `req_timeout()`: ! `seconds` must be >1 ms. # req_proxy gives helpful errors Code req %>% req_proxy(port = "abc") Condition Error in `req_proxy()`: ! `port` must be a whole number or `NULL`, not the string "abc". Code req %>% req_proxy("abc", auth = "bsc") Condition Error in `req_proxy()`: ! `auth` must be one of "basic", "digest", "gssnegotiate", "ntlm", "digest_ie", or "any", not "bsc". i Did you mean "basic"? httr2/tests/testthat/_snaps/utils-multi.md0000644000176200001440000000110214761701423020413 0ustar liggesusers# checks its inputs Code multi_dots(1) Condition Error: ! All components of `...` must be named. Code multi_dots(x = I(1)) Condition Error: ! Escaped query value `x` must be a single string, not the number 1. Code multi_dots(x = 1:2) Condition Error: ! All vector elements of `...` must be length 1. i Use `.multi` to choose a strategy for handling vectors. Code multi_dots(x = mean) Condition Error: ! All elements of `...` must be either an atomic vector or NULL. httr2/tests/testthat/_snaps/oauth-flow-auth-code.md0000644000176200001440000000304514761701420022064 0ustar liggesusers# desktop style can't run in hosted environment Code oauth_flow_auth_code(client, "http://localhost") Condition Error in `oauth_flow_auth_code()`: ! Can't use localhost `redirect_uri` in a hosted environment. # old args are deprecated Code redirect <- normalize_redirect_uri("http://localhost", port = 1234) Condition Warning: The `port` argument of `oauth_flow_auth_code()` is deprecated as of httr2 1.0.0. i Please use the `redirect_uri` argument instead. --- Code redirect <- normalize_redirect_uri("http://x.com", host_name = "y.com") Condition Warning: The `host_name` argument of `oauth_flow_auth_code()` is deprecated as of httr2 1.0.0. i Please use the `redirect_uri` argument instead. --- Code redirect <- normalize_redirect_uri("http://x.com", host_ip = "y.com") Condition Warning: The `host_ip` argument of `oauth_flow_auth_code()` is deprecated as of httr2 1.0.0. # forwards oauth error Code oauth_flow_auth_code_parse(query1, "abc") Condition Error in `oauth_flow_auth_code_parse()`: ! OAuth failure [123] * A bad error Code oauth_flow_auth_code_parse(query2, "abc") Condition Error in `oauth_flow_auth_code_parse()`: ! OAuth failure [123] * A bad error i Learn more at . Code oauth_flow_auth_code_parse(query3, "abc") Condition Error in `oauth_flow_auth_code_parse()`: ! Authentication failure: state does not match. httr2/tests/testthat/_snaps/req-policy.md0000644000176200001440000000024014761701421020207 0ustar liggesusers# as_callback validates inputs Code as_callback(function(x) 2, 2, "foo") Condition Error: ! Callback `name()` must have 2 arguments httr2/tests/testthat/_snaps/req-auth-aws.md0000644000176200001440000000327114761701417020455 0ustar liggesusers# aws_v4_signature calculates correct signature Code signature Output $CanonicalRequest [1] "POST\n/v0/\n\nhost:example.execute-api.us-east-1.amazonaws.com\n\nhost\ne3b0c44298fc1c149afbf4c8996fb92427ae41e4649b934ca495991b7852b855" $string_to_sign [1] "AWS4-HMAC-SHA256\n20250121T182222Z\n20250121/us-east-1/execute-api/aws4_request\n40b845bd8e6a316382ca9f73516e236075e4af2e04ebcb5f0d8eff12a040f6a4" $SigningKey sha256 hmac 56:b5:cd:6c:f3:27:c6:2c:ba:96:96:4c:45:3b:10:aa:97:11:7f:3d:dc:20:c0:58:d9:c4:07:7e:07:eb:63:58 $Authorization [1] "AWS4-HMAC-SHA256 Credential=AKIAIOSFODNN7EXAMPLE/20250121/us-east-1/execute-api/aws4_request,SignedHeaders=host,Signature=db2ef1ec9fd9efa801b8eb6b3e754d9d2d5d46189833a947c5427dd706f9534c" # validates its inputs Code req_auth_aws_v4(1) Condition Error in `req_auth_aws_v4()`: ! `req` must be an HTTP request object, not the number 1. Code req_auth_aws_v4(req, 1) Condition Error in `req_auth_aws_v4()`: ! `aws_access_key_id` must be a single string, not the number 1. Code req_auth_aws_v4(req, "", "", aws_session_token = 1) Condition Error in `req_auth_aws_v4()`: ! `aws_session_token` must be a single string or `NULL`, not the number 1. Code req_auth_aws_v4(req, "", "", aws_service = 1) Condition Error in `req_auth_aws_v4()`: ! `aws_service` must be a single string or `NULL`, not the number 1. Code req_auth_aws_v4(req, "", "", aws_region = 1) Condition Error in `req_auth_aws_v4()`: ! `aws_region` must be a single string or `NULL`, not the number 1. httr2/tests/testthat/_snaps/req-perform-connection.md0000644000176200001440000000112014761701423022517 0ustar liggesusers# validates inputs Code req_perform_connection(1) Condition Error in `req_perform_connection()`: ! `req` must be an HTTP request object, not the number 1. Code req_perform_connection(request_test(), 1) Condition Error in `req_perform_connection()`: ! `blocking` must be `TRUE` or `FALSE`, not the number 1. # curl errors become errors Code req_perform_connection(req) Condition Error in `req_perform_connection()`: ! Failed to perform HTTP request. Caused by error in `open()`: ! Failed to connect httr2/tests/testthat/_snaps/resp-stream.md0000644000176200001440000000502314761704777020412 0ustar liggesusers# can determine if incomplete data is complete Code expect_equal(resp_stream_sse(con), NULL) Condition Warning: Premature end of input; ignoring final partial chunk # can't read from a closed connection Code resp_stream_raw(resp, 1) Condition Error in `resp_stream_raw()`: ! `resp` has already been closed. # verbosity = 2 streams request bodies Code stream_all(req, resp_stream_lines, 1) Output << line 1 << line 2 Code stream_all(req, resp_stream_raw, 5 / 1024) Output << Streamed 5 bytes << Streamed 5 bytes << Streamed 4 bytes # verbosity = 3 shows buffer info Code while (!resp_stream_is_complete(con)) { resp_stream_lines(con, 1) } Output * -- Buffer ---------------------------------------------------------------------- * Buffer to parse: * Received chunk: 6c 69 6e 65 20 31 0a 6c 69 6e 65 20 32 0a * Combined buffer: 6c 69 6e 65 20 31 0a 6c 69 6e 65 20 32 0a * Buffer to parse: 6c 69 6e 65 20 31 0a 6c 69 6e 65 20 32 0a * Matched data: 6c 69 6e 65 20 31 0a * Remaining buffer: 6c 69 6e 65 20 32 0a << line 1 * -- Buffer ---------------------------------------------------------------------- * Buffer to parse: 6c 69 6e 65 20 32 0a * Matched data: 6c 69 6e 65 20 32 0a * Remaining buffer: << line 2 # verbosity = 3 shows raw sse events Code . <- resp_stream_sse(resp) Output * -- Buffer ---------------------------------------------------------------------- * Buffer to parse: * Received chunk: 3a 20 63 6f 6d 6d 65 6e 74 0a 0a 64 61 74 61 3a 20 31 0a 0a * Combined buffer: 3a 20 63 6f 6d 6d 65 6e 74 0a 0a 64 61 74 61 3a 20 31 0a 0a * Buffer to parse: 3a 20 63 6f 6d 6d 65 6e 74 0a 0a 64 61 74 61 3a 20 31 0a 0a * Matched data: 3a 20 63 6f 6d 6d 65 6e 74 0a 0a * Remaining buffer: 64 61 74 61 3a 20 31 0a 0a * -- Raw server sent event ------------------------------------------------------- * : comment * * * -- Buffer ---------------------------------------------------------------------- * Buffer to parse: 64 61 74 61 3a 20 31 0a 0a * Matched data: 64 61 74 61 3a 20 31 0a 0a * Remaining buffer: * -- Raw server sent event ------------------------------------------------------- * data: 1 * * << type: message << data: 1 << id: httr2/tests/testthat/_snaps/req.md0000644000176200001440000000207114761701552016723 0ustar liggesusers# req has basic print method Code req <- request("https://example.com") req Message GET https://example.com Body: empty Code req %>% req_body_raw("Test") Message POST https://example.com Body: a string Code req %>% req_body_multipart(Test = 1) Message POST https://example.com Body: multipart encoded data # printing headers works with {} Code req_headers(request("http://test"), x = "{z}", `{z}` = "x") Message GET http://test Headers: * x : "{z}" * {z}: "x" Body: empty # individually prints repeated headers Code request("https://example.com") %>% req_headers(A = 1:3) Message GET https://example.com Headers: * A: "1,2,3" Body: empty # check_request() gives useful error Code check_request(1) Condition Error: ! `1` must be an HTTP request object, not the number 1. httr2/tests/testthat/_snaps/req-body.md0000644000176200001440000000131014761701420017643 0ustar liggesusers# errors if file doesn't exist Code req_body_file(request_test(), "doesntexist", type = "text/plain") Condition Error in `req_body_file()`: ! `path` ('doesntexist') does not exist. # non-json type errors Code req_body_json(request_test(), mtcars, type = "application/xml") Condition Error in `req_body_json()`: ! Unexpected content type "application/xml". * Expecting type "application/json" or suffix "json". # can't change body type Code req %>% req_body_json(list(x = 1)) Condition Error in `req_body_json()`: ! Can't change body type from raw to json. i You must use only one type of `req_body_*()` per request. httr2/tests/testthat/_snaps/resp-body.md0000644000176200001440000000214114761701422020032 0ustar liggesusers# empty body generates error Code resp_body_raw(resp1) Condition Error in `resp_body_raw()`: ! Can't retrieve empty body. --- Code resp_body_raw(resp2) Condition Error in `resp_body_raw()`: ! Can't retrieve empty body. # check argument types before caching Code resp_body_json(1) Condition Error in `resp_body_json()`: ! `resp` must be an HTTP response object, not the number 1. Code resp_body_xml(1) Condition Error in `resp_body_xml()`: ! `resp` must be an HTTP response object, not the number 1. # content types are checked Code request_test("/xml") %>% req_perform() %>% resp_body_json() Condition Error in `resp_body_json()`: ! Unexpected content type "application/xml". * Expecting type "application/json" or suffix "json". Code request_test("/json") %>% req_perform() %>% resp_body_xml() Condition Error in `resp_body_xml()`: ! Unexpected content type "application/json". * Expecting type "application/xml" or "text/xml" or suffix "xml". httr2/tests/testthat/_snaps/curl.md0000644000176200001440000001041714761701552017104 0ustar liggesusers# must be call to curl Code curl_translate("echo foo") Condition Error in `curl_translate()`: ! Expecting call to "curl" not to "echo". # must have cmd argument if non-interactive Code curl_translate() Condition Error in `curl_translate()`: ! Must supply `cmd`. # common headers can be removed Code print(curl_simplify_headers(headers, simplify_headers = TRUE)) Output Accept: application/vnd.api+json user-agent: agent Code print(curl_simplify_headers(headers, simplify_headers = FALSE)) Output Sec-Fetch-Dest: empty Sec-Fetch-Mode: cors sec-ch-ua-mobile: ?0 Accept: application/vnd.api+json referer: ref user-agent: agent # can translate to httr calls Code curl_translate("curl http://x.com") Output request("http://x.com/") |> req_perform() Code curl_translate("curl http://x.com -X DELETE") Output request("http://x.com/") |> req_method("DELETE") |> req_perform() Code curl_translate("curl http://x.com -H A:1") Output request("http://x.com/") |> req_headers( A = "1", ) |> req_perform() Code curl_translate("curl http://x.com -H 'A B:1'") Output request("http://x.com/") |> req_headers( `A B` = "1", ) |> req_perform() Code curl_translate("curl http://x.com -u u:p") Output request("http://x.com/") |> req_auth_basic("u", "p") |> req_perform() Code curl_translate("curl http://x.com --verbose") Output request("http://x.com/") |> req_perform(verbosity = 1) # can translate query Code curl_translate("curl http://x.com?string=abcde&b=2") Output request("http://x.com/") |> req_url_query( string = "abcde", b = "2", ) |> req_perform() # can translate data Code curl_translate("curl http://example.com --data abcdef") Output request("http://example.com/") |> req_body_raw("abcdef", "application/x-www-form-urlencoded") |> req_perform() Code curl_translate( "curl http://example.com --data abcdef -H Content-Type:text/plain") Output request("http://example.com/") |> req_body_raw("abcdef", "text/plain") |> req_perform() # can translate ocokies Code curl_translate("curl 'http://test' -H 'Cookie: x=1; y=2;z=3'") Output request("http://test/") |> req_cookies_set( x = "1", y = "2", z = "3", ) |> req_perform() # can translate json Code curl_translate( "curl http://example.com --data-raw '{\"a\": 1, \"b\": \"text\"}' -H Content-Type:application/json") Output request("http://example.com/") |> req_body_json( data = list(a = 1L, b = "text"), ) |> req_perform() Code curl_translate("curl http://example.com --json '{\"a\": 1, \"b\": \"text\"}'") Output request("http://example.com/") |> req_body_json( data = list(a = 1L, b = "text"), ) |> req_perform() # content type stays in header if no data Code curl_translate("curl http://example.com -H Content-Type:text/plain") Output request("http://example.com/") |> req_headers( `Content-Type` = "text/plain", ) |> req_perform() # can read from clipboard Code curl_translate() Message v Copying to clipboard: Output request("http://example.com/") |> req_headers( A = "1", B = "2", ) |> req_perform() Code writeLines(clipr::read_clip()) Output request("http://example.com/") |> req_headers( A = "1", B = "2", ) |> req_perform() # encode_string2() produces simple strings Code curl_translate(cmd) Output request("http://example.com/") |> req_method("PATCH") |> req_body_json( data = list(data = list(x = 1L, y = "a", nested = list(z = list(1L, 2L, 3L)))), ) |> req_perform() httr2/tests/testthat/_snaps/oauth-flow-refresh.md0000644000176200001440000000026214761701417021655 0ustar liggesusers# warns if refresh token changes Code . <- oauth_flow_refresh(client, "abc") Condition Warning: Refresh token has changed! Please update stored value httr2/tests/testthat/_snaps/req-perform-iterative.md0000644000176200001440000000227114761701421022362 0ustar liggesusers# user temination still returns data Code resps <- req_perform_iterative(req, next_req = next_req) Message ! Terminating iteration; returning 1 response. # checks its inputs Code req_perform_iterative(1) Condition Error in `req_perform_iterative()`: ! `req` must be an HTTP request object, not the number 1. Code req_perform_iterative(req, function(x, y) x + y) Condition Error in `req_perform_iterative()`: ! `next_req` must have the arguments `resp` and `req`; it currently has `x` and `y`. Code req_perform_iterative(req, function(resp, req) { }, path = 1) Condition Error in `req_perform_iterative()`: ! `path` must be a single string or `NULL`, not the number 1. Code req_perform_iterative(req, function(resp, req) { }, max_reqs = -1) Condition Error in `req_perform_iterative()`: ! `max_reqs` must be a whole number larger than or equal to 1, not the number -1. Code req_perform_iterative(req, function(resp, req) { }, progress = -1) Condition Error in `req_perform_iterative()`: ! `progress` must be a bool, a string, or a list, not the number -1. httr2/tests/testthat/_snaps/req-perform-stream.md0000644000176200001440000000264414761701421021665 0ustar liggesusers# req_stream() is deprecated Code resp <- req_stream(req, identity, buffer_kb = 32) Condition Warning: `req_stream()` was deprecated in httr2 1.0.0. i Please use `req_perform_stream()` instead. # req_perform_stream checks its inputs Code req_perform_stream(1) Condition Error in `req_perform_stream()`: ! `req` must be an HTTP request object, not the number 1. Code req_perform_stream(req, 1) Condition Error in `req_perform_stream()`: ! `callback` must be a function, not the number 1. Code req_perform_stream(req, callback, timeout_sec = -1) Condition Error in `req_perform_stream()`: ! `timeout_sec` must be a number larger than or equal to 0, not the number -1. Code req_perform_stream(req, callback, buffer_kb = "x") Condition Error in `req_perform_stream()`: ! `buffer_kb` must be a number, not the string "x". # as_round_function checks its inputs Code as_round_function(1) Condition Error: ! `round` must be "byte", "line" or a function. Code as_round_function("bytes") Condition Error: ! `round` must be one of "byte" or "line", not "bytes". i Did you mean "byte"? Code as_round_function(function(x) 1) Condition Error in `as_round_function()`: ! `round` must have the argument `bytes`; it currently has `x`. httr2/tests/testthat/_snaps/req-cache.md0000644000176200001440000000256014761701420017761 0ustar liggesusers# cache emits useful debugging info Code # Immutable invisible(cache_pre_fetch(req)) Message Pruning cache Code invisible(cache_post_fetch(req, resp)) Message Saving response to cache "f3805db63ff822b4743f247cfdde10a3" Code invisible(cache_pre_fetch(req)) Message Found url in cache "f3805db63ff822b4743f247cfdde10a3" Cached value is fresh; using response from cache --- Code # freshness check invisible(cache_pre_fetch(req)) Message Pruning cache Found url in cache "f3805db63ff822b4743f247cfdde10a3" Cached value is stale; checking for updates Code invisible(cache_post_fetch(req, response(304))) Message Cached value still ok; retrieving body from cache Code invisible(cache_post_fetch(req, error_cnd())) Message Request errored; retrieving response from cache # can prune by number Code cache_prune(path, list(n = 1, age = Inf, size = Inf), debug = TRUE) Message Deleted 3 files that are too numerous # can prune by age Code cache_prune(path, list(n = Inf, age = 30, size = Inf), debug = TRUE) Message Deleted 1 file that is too old # can prune by size Code cache_prune(path, list(n = Inf, age = Inf, size = 50), debug = TRUE) Message Deleted 2 files that are too big httr2/tests/testthat/_snaps/req-dry-run.md0000644000176200001440000000145014761701420020313 0ustar liggesusers# body is shown Code req_dry_run(req_utf8) Output POST / HTTP/1.1 accept: */* content-type: text/plain CenĂ¡rio --- Code req_dry_run(req_json) Output POST / HTTP/1.1 accept: */* content-type: application/json { "x": 1, "y": true } --- Code req_dry_run(req_json, pretty_json = FALSE) Output POST / HTTP/1.1 accept: */* content-type: application/json {"x":1,"y":true} --- Code req_dry_run(req_binary) Output POST / HTTP/1.1 accept: */* <8 bytes> # authorization headers are redacted Code req_dry_run(req) Output GET / HTTP/1.1 accept: */* authorization: httr2/tests/testthat/_snaps/req-throttle.md0000644000176200001440000000023414761701422020561 0ustar liggesusers# throttling affects request performance Code time <- system.time(req_perform(req))[[3]] Message > Waiting 0.15s for throttling delay httr2/tests/testthat/_snaps/req-perform-iterative-helpers.md0000644000176200001440000000275514761701420024030 0ustar liggesusers# iterate_with_offset checks inputs Code iterate_with_offset(1) Condition Error in `iterate_with_offset()`: ! `param_name` must be a single string, not the number 1. Code iterate_with_offset("x", "x") Condition Error in `iterate_with_offset()`: ! `start` must be a whole number, not the string "x". Code iterate_with_offset("x", offset = 0) Condition Error in `iterate_with_offset()`: ! `offset` must be a whole number larger than or equal to 1, not the number 0. Code iterate_with_offset("x", offset = "x") Condition Error in `iterate_with_offset()`: ! `offset` must be a whole number, not the string "x". Code iterate_with_offset("x", resp_complete = function(x, y) x + y) Condition Error in `iterate_with_offset()`: ! `resp_complete` must have the argument `resp`; it currently has `x` and `y`. # iterate_with_cursor Code iterate_with_cursor(1) Condition Error in `iterate_with_cursor()`: ! `param_name` must be a single string, not the number 1. Code iterate_with_cursor("x", function(x, y) x + y) Condition Error in `iterate_with_cursor()`: ! `resp_param_value` must have the argument `resp`; it currently has `x` and `y`. # iterate_with_link_url checks its inputs Code iterate_with_link_url(rel = 1) Condition Error in `iterate_with_link_url()`: ! `rel` must be a single string, not the number 1. httr2/tests/testthat/_snaps/secret.md0000644000176200001440000000104714761701423017420 0ustar liggesusers# obfuscated strings are hidden Code x <- obfuscated("abcdef") x Output obfuscated("abcdef") Code str(x) Output obfuscated("abcdef") # can coerce to a key Code as_key("ENVVAR_THAT_DOESNT_EXIST") Condition Error: ! Can't find envvar ENVVAR_THAT_DOESNT_EXIST Code as_key(1) Condition Error: ! `key` must be a raw vector containing the key, a string giving the name of an env var, or a string wrapped in `I()` that contains the base64url encoded key. httr2/tests/testthat/_snaps/content-type.md0000644000176200001440000000242714761701417020572 0ustar liggesusers# can check type of response Code resp_check_content_type(resp1, "application/xml") Condition Error: ! Unexpected content type "application/json". * Expecting type "application/xml" Code resp_check_content_type(resp2, "application/xml") Condition Error: ! Unexpected content type "xxxxx". * Expecting type "application/xml" # useful error even if no content type Code resp_check_content_type(resp, "application/xml") Condition Error: ! Unexpected content type "NA". * Expecting type "application/xml" # check_content_type() can consult suffixes Code check_content_type("application/json", "application/xml") Condition Error: ! Unexpected content type "application/json". * Expecting type "application/xml" --- Code check_content_type("application/test+json", "application/xml", "xml") Condition Error: ! Unexpected content type "application/test+json". * Expecting type "application/xml" or suffix "xml". --- Code check_content_type("application/xml", c("text/html", "application/json")) Condition Error: ! Unexpected content type "application/xml". * Expecting type "text/html" or "application/json" httr2/tests/testthat/_snaps/req-headers.md0000644000176200001440000000055614761701420020334 0ustar liggesusers# is case insensitive Code req Message GET http://example.com Headers: * a: Body: empty # checks input types Code req_headers(req, a = 1L, b = 2L, .redact = 1L) Condition Error in `req_headers()`: ! `.redact` must be a character vector or `NULL`, not the number 1. httr2/tests/testthat/_snaps/req-template.md0000644000176200001440000000140714761701421020531 0ustar liggesusers# generates useful errors Code req_template(req, 1) Condition Error in `req_template()`: ! `template` must be a single string, not the number 1. Code req_template(req, "x", 1) Condition Error in `req_template()`: ! All elements of `...` must be named. Code req_template(req, "A B C") Condition Error in `req_template()`: ! Can't parse template `template`. i Should have form like 'GET /a/b/c' or 'a/b/c/'. # template produces useful errors Code template_process(":b") Condition Error: ! Can't find template variable "b". Code template_process(":b", list(b = sum)) Condition Error: ! Template variable "b" is not a simple scalar value. httr2/tests/testthat/_snaps/req-retries.md0000644000176200001440000000163714761701421020400 0ustar liggesusers# has useful default (with message) Code req <- req_retry(req) Message Setting `max_tries = 2`. # useful message if `after` wrong Code req_perform(req) Condition Error in `req_perform()`: ! The `after` callback to `req_retry()` must return a single number or NA, not a object. # validates its inputs Code req_retry(req, max_tries = 0) Condition Error in `req_retry()`: ! `max_tries` must be a whole number larger than or equal to 1 or `NULL`, not the number 0. Code req_retry(req, max_tries = 2, max_seconds = "x") Condition Error in `req_retry()`: ! `max_seconds` must be a whole number or `NULL`, not the string "x". Code req_retry(req, max_tries = 2, retry_on_failure = "x") Condition Error in `req_retry()`: ! `retry_on_failure` must be `TRUE` or `FALSE`, not the string "x". httr2/tests/testthat/_snaps/req-cookies.md0000644000176200001440000000033214761701420020345 0ustar liggesusers# can read/write cookies Code readLines(cookie_path)[-(1:4)] Output [1] "127.0.0.1\tFALSE\t/\tFALSE\t0\tz\tc" "127.0.0.1\tFALSE\t/\tFALSE\t0\tx\ta" [3] "127.0.0.1\tFALSE\t/\tFALSE\t0\ty\tb" httr2/tests/testthat/_snaps/req-perform.md0000644000176200001440000000201614761701422020366 0ustar liggesusers# curl errors become errors Code req_perform(req) Condition Error in `req_perform()`: ! Failed to perform HTTP request. Caused by error in `curl_fetch()`: ! Failed to connect # http errors become errors Code req_perform(req) Condition Error in `req_perform()`: ! HTTP 404 Not Found. --- Code req_perform(req) Condition Error in `req_perform()`: ! HTTP 429 Too Many Requests. --- Code req_perform(req) Condition Error in `req_perform()`: ! HTTP 599. # checks input types Code req_perform(req, path = 1) Condition Error in `req_perform()`: ! `path` must be a single string or `NULL`, not the number 1. Code req_perform(req, verbosity = 1.5) Condition Error in `req_perform()`: ! `verbosity` must 0, 1, 2, or 3. Code req_perform(req, mock = 7) Condition Error in `req_perform()`: ! `mock` must be a function or `NULL`, not the number 7. httr2/tests/testthat/_snaps/url.md0000644000176200001440000000720014761701423016732 0ustar liggesusers# can print all url details Code url_parse("http://user:pass@example.com:80/path?a=1&b=2&c={1{2}3}#frag") Message http://user:pass@example.com:80/path?a=1&b=2&c=%7B1%7B2%7D3%7D#frag * scheme: http * hostname: example.com * username: user * password: pass * port: 80 * path: /path * query: * a: 1 * b: 2 * c: {1{2}3} * fragment: frag # password also requires username Code url_build(url) Condition Error in `url_build()`: ! Cannot set url `password` without `username`. # url_build validates its input Code url_build("abc") Condition Error in `url_build()`: ! `url` must be a parsed URL, not the string "abc". # url_modify checks its inputs Code url_modify(1) Condition Error in `url_modify()`: ! `url` must be a string or parsed URL, not the number 1. Code url_modify(url, scheme = 1) Condition Error in `url_modify()`: ! `scheme` must be a single string or `NULL`, not the number 1. Code url_modify(url, hostname = 1) Condition Error in `url_modify()`: ! `hostname` must be a single string or `NULL`, not the number 1. Code url_modify(url, port = "x") Condition Error in `url_modify()`: ! `port` must be a whole number or `NULL`, not the string "x". Code url_modify(url, username = 1) Condition Error in `url_modify()`: ! `username` must be a single string or `NULL`, not the number 1. Code url_modify(url, password = 1) Condition Error in `url_modify()`: ! `password` must be a single string or `NULL`, not the number 1. Code url_modify(url, path = 1) Condition Error in `url_modify()`: ! `path` must be a single string or `NULL`, not the number 1. Code url_modify(url, fragment = 1) Condition Error in `url_modify()`: ! `fragment` must be a single string or `NULL`, not the number 1. # checks various query formats Code url_modify(url, query = 1) Condition Error in `url_modify()`: ! `query` must be a character vector, named list, or NULL, not the number 1. Code url_modify(url, query = list(1)) Condition Error in `url_modify()`: ! `query` must be a character vector, named list, or NULL, not a list. Code url_modify(url, query = list(x = 1:2)) Condition Error in `url_modify()`: ! Query value `query$x` must be a length-1 atomic vector, not an integer vector. # validates inputs Code url_modify_query(1) Condition Error in `url_modify_query()`: ! `.url` must be a string or parsed URL, not the number 1. Code url_modify_query(url, 1) Condition Error in `url_modify_query()`: ! All components of `...` must be named. Code url_modify_query(url, x = 1:2) Condition Error in `url_modify_query()`: ! All vector elements of `...` must be length 1. i Use `.multi` to choose a strategy for handling vectors. --- Code url_query_build(1:3) Condition Error in `url_query_build()`: ! `query` must be a named list, not an integer vector. Code url_query_build(list(x = 1:2, y = 1:3)) Condition Error in `url_query_build()`: ! All vector elements of `query` must be length 1. i Use `.multi` to choose a strategy for handling vectors. # can't opt out of escaping non strings Code format_query_param(I(1), "x") Condition Error: ! Escaped query value `x` must be a single string, not the number 1. httr2/tests/testthat/_snaps/resp.md0000644000176200001440000000231014761701422017075 0ustar liggesusers# response has basic print method Code response(200) Message GET https://example.com Status: 200 OK Body: None Code response(200, headers = "Content-Type: text/html") Message GET https://example.com Status: 200 OK Content-Type: text/html Body: None Code response(200, body = charToRaw("abcdef")) Message GET https://example.com Status: 200 OK Body: In memory (6 bytes) Code response(200, body = new_path("path-empty")) Message GET https://example.com Status: 200 OK Body: None Code response(200, body = new_path("path-content")) Message GET https://example.com Status: 200 OK Body: On disk 'path-content' (15 bytes) Code response(200, body = con) Message GET https://example.com Status: 200 OK Body: Streaming connection # check_response produces helpful error Code check_response(1) Condition Error: ! `1` must be an HTTP response object, not the number 1. httr2/tests/testthat/_snaps/oauth-flow-jwt.md0000644000176200001440000000052014761701417021020 0ustar liggesusers# validates inputs Code oauth_flow_bearer_jwt(client1) Condition Error in `oauth_flow_bearer_jwt()`: ! JWT flow requires `client` with a key. --- Code oauth_flow_bearer_jwt(client2, claim = NULL) Condition Error in `oauth_flow_bearer_jwt()`: ! `claim` must be a list or function. httr2/tests/testthat/_snaps/req-verbose.md0000644000176200001440000000362414761707310020371 0ustar liggesusers# can request verbose record of request Code . <- req_perform(verbose_resp) Output <- HTTP/1.1 200 OK <- Connection: close <- Content-Type: application/json <- << { << "x": 1 << } --- Code . <- req_perform(verbose_req) Output -> POST /test HTTP/1.1 -> Host: http://example.com -> Content-Type: text/plain -> Content-Length: 17 -> >> This is some text # redacts headers as needed Code . <- req_perform(req) Output -> GET / HTTP/1.1 -> Host: http://example.com -> Authorization: -> # can display compressed bodies Code . <- req_perform(req) Output <- HTTP/1.1 200 OK <- Content-Type: application/json <- Content-Encoding: gzip <- << { << "args": { << << }, << "data": { << << }, << "files": { << << }, << "form": { << << }, << "headers": { << "Host": "http://example.com" << }, << "json": { << << }, << "method": "get", << "path": "/gzip", << "origin": "127.0.0.1", << "url": "/gzip", << "gzipped": true << } # response json is automatically prettified Code . <- req_perform(req) Output << { << "foo": "bar", << "baz": [ << 1, << 2, << 3 << ] << } --- Code . <- req_perform(req) Output << {"foo":"bar","baz":[1,2,3]} # request json is automatically prettified Code . <- req_perform(req) Output >> { >> "foo": "bar", >> "baz": [ >> 1, >> 2, >> 3 >> ] >> } --- Code . <- req_perform(req) Output >> {"foo":"bar","baz":[1,2,3]} httr2/tests/testthat/_snaps/req-mock.md0000644000176200001440000000142514761701420017646 0ustar liggesusers# local_mock and with_mock are deprecated Code local_mock(~ response(404)) Condition Warning: `local_mock()` was deprecated in httr2 1.1.0. i Please use `local_mocked_responses()` instead. Code . <- with_mock(NULL, ~ response(404)) Condition Error: ! `with_mock()` was deprecated in httr2 1.1.0 and is now defunct. i Please use `with_mocked_responses()` instead. # validates inputs Code local_mocked_responses(function(foo) { }) Condition Error in `local_mocked_responses()`: ! `mock` must have the argument `req`; it currently has `foo`. Code local_mocked_responses(10) Condition Error in `local_mocked_responses()`: ! `mock` must be a function or list, not a number. httr2/tests/testthat/_snaps/resp-stream-aws.md0000644000176200001440000000054614761701422021167 0ustar liggesusers# unknown header triggers error Code parse_aws_event(bytes) Condition Error in `type_enum()`: ! Unsupported type 255. i This is an internal error that was detected in the httr2 package. Please report it at with a reprex () and the full backtrace. httr2/tests/testthat/_snaps/req-promise.md0000644000176200001440000000257514761701422020404 0ustar liggesusers# checks its inputs Code req_perform_promise(1) Condition Error in `req_perform_promise()`: ! `req` must be an HTTP request object, not the number 1. Code req_perform_promise(req, path = 1) Condition Error in `req_perform_promise()`: ! `path` must be a single string or `NULL`, not the number 1. Code req_perform_promise(req, pool = "INVALID") Condition Error in `req_perform_promise()`: ! `pool` must be a {curl} pool or `NULL`, not the string "INVALID". Code req_perform_promise(req, verbosity = "INVALID") Condition Error in `req_perform_promise()`: ! `verbosity` must 0, 1, 2, or 3. # correctly prepares request Code . <- extract_promise(req_perform_promise(req, verbosity = 1)) Output -> GET /get HTTP/1.1 -> Host: -> User-Agent: -> Accept: */* -> Accept-Encoding: -> <- HTTP/1.1 200 OK <- Date: <- Content-Type: application/json <- Content-Length: <- ETag: <- # req_perform_promise uses the default loop Code p4 <- req_perform_promise(request_test("/get")) Condition Error in `req_perform_promise()`: ! Must supply `pool` when calling `later::with_temp_loop()`. i Do you need `pool = curl::new_pool()`? httr2/tests/testthat/_snaps/req-perform-sequential.md0000644000176200001440000000055114761701420022536 0ustar liggesusers# checks its inputs Code req_perform_sequential(req) Condition Error in `req_perform_sequential()`: ! `reqs` must be a list, not a object. Code req_perform_sequential(list(req), letters) Condition Error in `req_perform_sequential()`: ! If supplied, `paths` must be the same length as `req`. httr2/tests/testthat/_snaps/oauth-flow.md0000644000176200001440000000146114761701417020223 0ustar liggesusers# turns oauth errors to R errors Code oauth_flow_fetch(req, "test") Condition Error: ! OAuth failure [1] * abc # userful errors if response isn't parseable Code oauth_flow_parse(resp1, "test") Condition Error: ! Failed to parse response from `test` OAuth url. Caused by error in `resp_body_json()`: ! Unexpected content type "text/plain". * Expecting type "application/json" or suffix "json". Code oauth_flow_parse(resp2, "test") Condition Error: ! Failed to parse response from `test` OAuth url. * Did not contain `access_token`, `device_code`, or `error` field. # returns body if known good structure Code oauth_flow_parse(resp, "test") Condition Error: ! OAuth failure [10] httr2/tests/testthat/_snaps/oauth-client.md0000644000176200001440000000412214761701417020527 0ustar liggesusers# can check app has needed pieces Code oauth_flow_check("test", NULL) Condition Error: ! `client` must be an OAuth client created with `oauth_client()`. Code oauth_flow_check("test", client, is_confidential = TRUE) Condition Error: ! Can't use this `app` with OAuth 2.0 test flow. i `app` must have a confidential client (i.e. `client_secret` is required). Code oauth_flow_check("test", client, interactive = TRUE) Condition Error: ! OAuth 2.0 test flow requires an interactive session # checks auth types have needed args Code oauth_client("abc", "http://x.com", auth = "header") Condition Error in `oauth_client()`: ! `auth = 'header'` requires a `secret`. Code oauth_client("abc", "http://x.com", auth = "jwt_sig") Condition Error in `oauth_client()`: ! `auth = 'jwt_sig'` requires a `key`. Code oauth_client("abc", "http://x.com", key = "abc", auth = "jwt_sig") Condition Error in `oauth_client()`: ! `auth = 'jwt_sig'` requires a claim specification in `auth_params`. Code oauth_client("abc", "http://x.com", auth = 123) Condition Error in `oauth_client()`: ! `auth` must be a string or function. # client has useful print method Code oauth_client("x", url) Message * name : "bf27508f7925b06bf28a10f3805351ab" * id : "x" * token_url: "http://example.com" * auth : "oauth_client_req_auth_body" Code oauth_client("x", url, secret = "SECRET") Message * name : "bf27508f7925b06bf28a10f3805351ab" * id : "x" * secret : * token_url: "http://example.com" * auth : "oauth_client_req_auth_body" Code oauth_client("x", url, auth = function(...) { xxx }) Message * name : "bf27508f7925b06bf28a10f3805351ab" * id : "x" * token_url: "http://example.com" * auth : httr2/tests/testthat/_snaps/req-url.md0000644000176200001440000000223214761701422017516 0ustar liggesusers# can control space handling Code req_url_query(req, a = " ", .space = "bar") Condition Error in `multi_dots()`: ! `.space` must be one of "percent" or "form", not "bar". # can handle multi query params Code req_url_query_multi("error") Condition Error in `url_modify_query()`: ! All vector elements of `...` must be length 1. i Use `.multi` to choose a strategy for handling vectors. # errors are forwarded correctly Code req %>% req_url_query(1) Condition Error in `url_modify_query()`: ! All components of `...` must be named. Code req %>% req_url_query(a = I(1)) Condition Error in `url_modify_query()`: ! Escaped query value `a` must be a single string, not the number 1. Code req %>% req_url_query(a = 1:2) Condition Error in `url_modify_query()`: ! All vector elements of `...` must be length 1. i Use `.multi` to choose a strategy for handling vectors. Code req %>% req_url_query(a = mean) Condition Error in `url_modify_query()`: ! All elements of `...` must be either an atomic vector or NULL. httr2/tests/testthat/_snaps/oauth-token.md0000644000176200001440000000100414761701552020365 0ustar liggesusers# new token computes expires_at Code token Message * token_type : "bearer" * access_token: * expires_at : "2025-02-19 21:20:10" # printing token redacts access, id and refresh token Code oauth_token(access_token = "secret", refresh_token = "secret", id_token = "secret") Message * token_type : "bearer" * access_token : * refresh_token: * id_token : httr2/tests/testthat/_snaps/req-perform-parallel.md0000644000176200001440000000154014761704173022167 0ustar liggesusers# request and paths must match Code req_perform_parallel(req, letters) Condition Error in `req_perform_parallel()`: ! If supplied, `paths` must be the same length as `req`. # req_perform_parallel respects http_error() body message Code req_perform_parallel(reqs) Condition Error in `req_perform_parallel()`: ! HTTP 404 Not Found. * hello # multi_req_perform is deprecated Code multi_req_perform(list()) Condition Warning: `multi_req_perform()` was deprecated in httr2 1.0.0. i Please use `req_perform_parallel()` instead. Output list() # pool argument is deprecated Code . <- req_perform_parallel(list(), pool = curl::new_pool()) Condition Warning: The `pool` argument of `req_perform_parallel()` is deprecated as of httr2 1.1.0. httr2/tests/testthat/_snaps/headers.md0000644000176200001440000000144214761701552017550 0ustar liggesusers# as_headers errors on invalid types Code as_headers(1) Condition Error: ! `headers` must be a list, character vector, or raw. # has nice print method Code as_headers(c("X:1", "Y: 2", "Z:")) Output X: 1 Y: 2 Z: Code as_headers(list()) Output # print and str redact headers Code print(x) Output x: y: 2 Code str(x) Output $ x: $ y: num 2 # new_headers checks inputs Code new_headers(1) Condition Error: ! `x` must be a list. Code new_headers(list(1)) Condition Error: ! All elements of `x` must be named. httr2/tests/testthat/_snaps/utils.md0000644000176200001440000000042614761701423017273 0ustar liggesusers# modify list adds, removes, and overrides Code modify_list(x, a = 1, 2) Condition Error: ! All components of `...` must be named. # progress bar suppressed in tests Code sys_sleep(0.1, "in test") Message > Waiting 0.1s in test httr2/tests/testthat/test-req-auth-aws.R0000644000176200001440000000513514746456350017757 0ustar liggesuserstest_that("can correctly sign a request", { skip_if_not(has_paws_credentials()) creds <- paws.common::locate_credentials() # https://docs.aws.amazon.com/STS/latest/APIReference/API_GetCallerIdentity.html req <- request("https://sts.amazonaws.com/") 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, aws_region = creds$region ) req <- req_body_form( req, Action = "GetCallerIdentity", Version = "2011-06-15" ) expect_no_error(req_perform(req)) }) test_that('aws_v4_signature calculates correct signature', { req <- request("https://example.execute-api.us-east-1.amazonaws.com/v0/") %>% req_method('POST') body_sha256 <- openssl::sha256(req_body_get(req)) current_time <- as.POSIXct(1737483742, origin = "1970-01-01", tz = "EST") signature <- aws_v4_signature( method = req_method_get(req), url = url_parse(req$url), headers = req$headers, body_sha256 = body_sha256, current_time = current_time, aws_service = 'execute-api', aws_region = 'us-east-1', aws_access_key_id = 'AKIAIOSFODNN7EXAMPLE', aws_secret_access_key = 'wJalrXUtnFEMI/K7MDENG/bPxRfiCYEXAMPLEKEY' ) expect_snapshot(signature) }) test_that("signing agrees with glacier example", { # Example from # https://docs.aws.amazon.com/amazonglacier/latest/dev/amazon-glacier-signing-requests.html signature <- aws_v4_signature( method = "PUT", 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" ), body_sha256 = "e3b0c44298fc1c149afbf4c8996fb92427ae41e4649b934ca495991b7852b855", current_time = as.POSIXct("2012-05-25 00:24:53", tz = "UTC"), aws_access_key_id = "AKIAIOSFODNN7EXAMPLE", aws_secret_access_key = "wJalrXUtnFEMI/K7MDENG/bPxRfiCYEXAMPLEKEY" ) expected <- paste0( "AWS4-HMAC-SHA256 ", "Credential=AKIAIOSFODNN7EXAMPLE/20120525/us-east-1/glacier/aws4_request,", "SignedHeaders=host;x-amz-date;x-amz-glacier-version,", "Signature=3ce5b2f2fffac9262b4da9256f8d086b4aaf42eba5f111c21681a65a127b7c2a" ) expect_equal(signature$Authorization, expected) }) test_that("validates its inputs", { req <- request("https://sts.amazonaws.com/") expect_snapshot(error = TRUE, { req_auth_aws_v4(1) req_auth_aws_v4(req, 1) req_auth_aws_v4(req, "", "", aws_session_token = 1) req_auth_aws_v4(req, "", "", aws_service = 1) req_auth_aws_v4(req, "", "", aws_region = 1) }) }) httr2/tests/testthat/test-req-template.R0000644000176200001440000000324214737047606020036 0ustar liggesuserstest_that("can set path", { req <- request("http://test.com") %>% req_template("/x") expect_equal(req$url, "http://test.com/x") }) test_that("can set method and path", { req <- request("http://test.com") %>% req_template("PATCH /x") expect_equal(req$url, "http://test.com/x") expect_equal(req$method, "PATCH") }) test_that("can use args or env", { x <- "x" req <- request("http://test.com") %>% req_template("/:x") expect_equal(req$url, "http://test.com/x") req <- request("http://test.com") %>% req_template("/:x", x = "y") expect_equal(req$url, "http://test.com/y") }) test_that("will append rather than replace path", { req <- request("http://test.com/x") %>% req_template("PATCH /y") expect_equal(req$url, "http://test.com/x/y") }) test_that("generates useful errors", { req <- request("http://test.com") expect_snapshot(error = TRUE, { req_template(req, 1) req_template(req, "x", 1) req_template(req, "A B C") }) }) # templating -------------------------------------------------------------- test_that("template_process looks in args & env", { a <- 1 expect_equal(template_process(":a"), "1") expect_equal(template_process(":a", list(a = 2)), "2") }) test_that("template produces useful errors", { expect_snapshot(error = TRUE, { template_process(":b") template_process(":b", list(b = sum)) }) }) test_that("supports three template styles", { x <- "x" expect_equal(template_process("/:x/"), "/x/") expect_equal(template_process("/{x}/"), "/x/") expect_equal(template_process("/constant"), "/constant") }) test_that("can use colon in uri style", { x <- "x" expect_equal(template_process("/:{x}:/"), "/:x:/") }) httr2/tests/testthat/test-req-verbose.R0000644000176200001440000000436614761707310017670 0ustar liggesusers 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) }) req <- req %>% req_body_raw("This is some text", "text/plain") %>% 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) # Snapshot test of request 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) expect_output(. <- req_perform(verbose_info)) }) test_that("redacts headers as needed", { req <- request(example_url()) %>% req_verbose_test() %>% req_verbose(header_req = TRUE, header_resp = FALSE) %>% req_headers_redacted(Authorization = "abc") expect_snapshot(. <- req_perform(req)) }) test_that("can display compressed bodies", { req <- request(example_url()) %>% req_url_path("gzip") %>% req_verbose_test() %>% req_verbose(header_req = FALSE, header_resp = TRUE, body_resp = TRUE) expect_snapshot(. <- req_perform(req), transform = transform_verbose_response) }) test_that("response json is automatically prettified", { req <- local_app_request(function(req, res) { res$set_header("Content-Type", "application/json") res$send('{"foo":"bar","baz":[1,2,3]}') }) req <- req %>% req_verbose_test() %>% req_verbose(body_resp = TRUE, header_resp = FALSE, header_req = FALSE) expect_snapshot(. <- req_perform(req)) # Unless we opt-out local_options(httr2_pretty_json = FALSE) expect_snapshot(. <- req_perform(req)) }) test_that("request json is automatically prettified", { req <- request(example_url("/post")) %>% req_verbose_test() %>% req_body_json(list(foo = "bar", baz = c(1, 2, 3))) %>% req_verbose(body_req = TRUE, header_resp = FALSE, header_req = FALSE) expect_snapshot(. <- req_perform(req)) # Unless we opt-out local_options(httr2_pretty_json = FALSE) expect_snapshot(. <- req_perform(req)) }) httr2/tests/testthat/test-req-cookies.R0000644000176200001440000000206514752214235017650 0ustar liggesuserstest_that("can read/write cookies", { cookie_path <- withr::local_tempfile() set_cookie <- function(req, name, value) { request_test("/cookies/set/:name/:value", name = name, value = value) %>% req_cookie_preserve(cookie_path) %>% req_perform() } set_cookie(req, "x", "a") set_cookie(req, "y", "b") set_cookie(req, "z", "c") expect_snapshot(readLines(cookie_path)[-(1:4)]) cookies <- request_test("/cookies") %>% req_cookie_preserve(cookie_path) %>% req_perform() %>% resp_body_json() %>% .$cookies expect_mapequal(cookies, list(x = "a", y = "b", z = "c")) }) test_that("can set cookies", { resp <- request(example_url("/cookies")) %>% req_cookies_set(a = 1, b = 1) %>% req_perform() expect_equal(resp_body_json(resp), list(cookies = list(a = "1", b = "1"))) }) test_that("cookie values are usually escaped", { resp <- request(example_url("/cookies")) %>% req_cookies_set(a = I("%20"), b = "%") %>% req_perform() expect_equal(resp_body_json(resp), list(cookies = list(a = "%20", b = "%25"))) }) httr2/tests/testthat/test-req-url.R0000644000176200001440000001202514737047606017024 0ustar liggesuserstest_that("can override url", { req <- request("http://example.com/") expect_equal(req_url(req, "http://foo.com:10")$url, "http://foo.com:10") }) 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") }) 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") }) test_that("can handle empty path", { req <- request("http://example.com/x") expect_equal(req_url_path(req)$url, "http://example.com/") expect_equal(req_url_path_append(req)$url, "http://example.com/x") expect_equal(req_url_path(req, NULL)$url, "http://example.com/") expect_equal(req_url_path_append(req, NULL)$url, "http://example.com/x") expect_equal(req_url_path(req, "")$url, "http://example.com/") expect_equal(req_url_path_append(req, "")$url, "http://example.com/x") }) 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") }) 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, 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_snapshot( req_url_query(req, a = " ", .space = "bar"), error = TRUE ) }) test_that("can handle multi query params", { req <- request("http://example.com/") req_url_query_multi <- function(multi) { req_url_query(req, a = 1:2, .multi = multi)$url } expect_snapshot(req_url_query_multi("error"), error = TRUE) expect_equal(req_url_query_multi("explode"), "http://example.com/?a=1&a=2") expect_equal(req_url_query_multi("comma"), "http://example.com/?a=1,2") expect_equal(req_url_query_multi("pipe"), "http://example.com/?a=1|2") expect_equal(req_url_query_multi(function(x) "X"), "http://example.com/?a=X") }) test_that("errors are forwarded correctly", { req <- request("http://example.com/") expect_snapshot(error = TRUE, { req %>% req_url_query(1) req %>% req_url_query(a = I(1)) req %>% req_url_query(a = 1:2) req %>% req_url_query(a = mean) }) }) test_that("empty query doesn't affect url", { req <- request("http://example.com/") expect_equal(req_url_query(req)$url, "http://example.com/") expect_equal(req_url_query(req, a = NULL)$url, "http://example.com/") }) 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, b = NULL)$url, "http://example.com/?a=1") }) test_that("can opt-out of query escaping", { req <- request("http://example.com/") expect_equal(req_url_query(req, a = I(","))$url, "http://example.com/?a=,") }) test_that("can construct relative urls", { req <- request("http://example.com/a/b/c.html") expect_equal(req_url_relative(req, ".")$url, "http://example.com/a/b/") expect_equal(req_url_relative(req, "..")$url, "http://example.com/a/") expect_equal(req_url_relative(req, "/d/e/f")$url, "http://example.com/d/e/f") }) # explode ----------------------------------------------------------------- test_that("explode handles expected inputs", { expect_equal( explode(list(a = NULL, b = 1, c = 2:3)), list(a = NULL, b = 1, c = 2, c = 3) ) }) httr2/tests/testthat/test-url.R0000644000176200001440000001544414741230341016230 0ustar liggesuserstest_that("can parse special cases", { url <- url_parse("file:///tmp") expect_equal(url$scheme, "file") expect_equal(url$path, "/tmp") }) test_that("can round trip urls", { urls <- list( "http://google.com/", "http://google.com/path", "http://google.com/path?a=1&b=2", "http://google.com:80/path?a=1&b=2", "http://google.com:80/path?a=1&b=2#frag", "http://google.com:80/path?a=1&b=2&c=%7B1%7B2%7D3%7D#frag", "http://user@google.com:80/path?a=1&b=2", "http://user:pass@google.com:80/path?a=1&b=2", "svn+ssh://my.svn.server/repo/trunk" ) expect_equal(map(urls, ~ url_build(url_parse(.x))), urls) }) test_that("can parse relative urls", { base <- "http://example.com/a/b/c/" expect_equal(url_parse("d", base)$path, "/a/b/c/d") expect_equal(url_parse("..", base)$path, "/a/b/") expect_equal(url_parse("//archive.org", base)$scheme, "http") }) test_that("can print all url details", { expect_snapshot( url_parse("http://user:pass@example.com:80/path?a=1&b=2&c={1{2}3}#frag") ) }) test_that("password also requires username", { url <- url_parse("http://username:pwd@example.com") url$username <- NULL expect_snapshot(url_build(url), error = TRUE) }) test_that("url_build validates its input", { expect_snapshot(url_build("abc"), error = TRUE) }) test_that("decodes query params but not paths", { url <- url_parse("http://example.com/a%20b?q=a%20b") expect_equal(url$path, "/a%20b") expect_equal(url$query$q, "a b") }) # modify url ------------------------------------------------------------- test_that("url_modify checks its inputs", { url <- "http://example.com" expect_snapshot(error = TRUE, { url_modify(1) url_modify(url, scheme = 1) url_modify(url, hostname = 1) url_modify(url, port = "x") url_modify(url, username = 1) url_modify(url, password = 1) url_modify(url, path = 1) url_modify(url, fragment = 1) }) }) test_that("no arguments is idempotent", { string <- "http://example.com/" url <- url_parse(string) expect_equal(url_modify(string), string) expect_equal(url_modify(url), url) }) test_that("can round-trip escaped components", { url <- "https://example.com/a%20b" expect_equal(url_modify(url), url) url <- "https://example.com/?q=a%20b" expect_equal(url_modify(url), url) }) 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 = ""), "http://test/") expect_equal(url_modify(url, query = list()), "http://test/") }) test_that("automatically escapes query components", { expect_equal( url_modify("https://example.com", query = list(q = "a b")), "https://example.com/?q=a%20b" ) }) test_that("checks various query formats", { url <- "http://example.com" expect_snapshot(error = TRUE, { url_modify(url, query = 1) url_modify(url, query = list(1)) url_modify(url, query = list(x = 1:2)) }) }) 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 = ""), "https://x.com/") expect_equal(url_modify("https://x.com/abc", path = NULL), "https://x.com/") }) # relative url ------------------------------------------------------------ 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/") }) test_that("is idempotent", { string <- "http://example.com/" url <- url_parse(string) expect_equal(url_modify_relative(string, "."), string) expect_equal(url_modify_relative(url, "."), url) }) # modify query ------------------------------------------------------------- test_that("can add, modify, and delete query components", { expect_equal( url_modify_query("http://test/path", new = "value"), "http://test/path?new=value" ) expect_equal( url_modify_query("http://test/path", new = "one", new = "two"), "http://test/path?new=one&new=two" ) expect_equal( url_modify_query("http://test/path?a=old&b=old", a = "new"), "http://test/path?b=old&a=new" ) expect_equal( url_modify_query("http://test/path?remove=me&keep=this", remove = NULL), "http://test/path?keep=this" ) }) test_that("can control space formatting", { expect_equal( url_modify_query("http://test/path", new = "a b"), "http://test/path?new=a%20b" ) expect_equal( url_modify_query("http://test/path", new = "a b", .space = "form"), "http://test/path?new=a+b" ) }) test_that("is idempotent", { string <- "http://example.com/" url <- url_parse(string) expect_equal(url_modify_query(string), string) expect_equal(url_modify_query(url), url) }) test_that("validates inputs", { url <- "http://example.com/" expect_snapshot(error = TRUE, { url_modify_query(1) url_modify_query(url, 1) url_modify_query(url, x = 1:2) }) }) # query ------------------------------------------------------------------- test_that("missing query values become empty strings", { expect_equal(url_query_parse("?q="), list(q = "")) expect_equal(url_query_parse("?q"), list(q = "")) expect_equal(url_query_parse("?a&q"), list(a = "", q = "")) }) test_that("handles equals in values", { expect_equal(url_query_parse("?x==&y=="), list(x = "=", y = "=")) }) test_that("empty queries become NULL", { expect_equal(url_query_parse("?"), NULL) expect_equal(url_query_parse(""), NULL) }) test_that("validates inputs", { expect_snapshot(error = TRUE, { url_query_build(1:3) url_query_build(list(x = 1:2, y = 1:3)) }) }) # format_query_param ------------------------------------------------------ test_that("handles all atomic vectors", { expect_equal(format_query_param(NA, "x"), "NA") expect_equal(format_query_param(TRUE, "x"), "TRUE") expect_equal(format_query_param(1L, "x"), "1") expect_equal(format_query_param(1.3, "x"), "1.3") expect_equal(format_query_param("x", "x"), "x") expect_equal(format_query_param(" ", "x"), "%20") }) test_that("doesn't add extra spaces", { expect_equal( format_query_param(c(1, 1000), "x", multi = TRUE), c("1", "1000") ) expect_equal( format_query_param(c("a", "bcdef"), multi = TRUE, "x"), c("a", "bcdef") ) }) test_that("formats numbers nicely", { expect_equal(format_query_param(1e9, "x"), "1000000000") }) test_that("can opt out of escaping", { expect_equal(format_query_param(I(","), "x"), ",") }) test_that("can't opt out of escaping non strings", { expect_snapshot(format_query_param(I(1), "x"), error = TRUE) }) httr2/tests/testthat/test-oauth-flow-jwt-google.rds0000644000176200001440000000355514752760023022165 0ustar liggesusersgº¨ùY{.N$Ï6nơrØKôǺ¥_Δ Ú•£6$TËep8 ¶»R‚ñë:,\IăÁågâ‘}ªnà”Ù:l“>S^ñ¢–}-ó…RƠOÛkÎ;á²æ4…¦Q[ BZơürv”´§@¸hp„̉Ư,Üí”2l»µíÔ)‹a5¯1÷œ d@3zwDư/%c+/¡ÜË ÚÏ–KyL,*¨À×$(C1³đâơc¥ñ6nÆäa†xLeÚèË=•Î*7dzܫlÉÁHdÁî 5üÅCÄÏUôm;CpÂÛk1ƒ£Zˆ  ³r=~Ëâ4pÅ̃ƠŸÊ¿>ÆfGç0̉>ûûÛ]¬±NCÛÄ3+(„`̣âBi₫•KØBà,÷@ˆ¢é|j0^[‘ Ws,$# ZDä,©pMiä@…æÛÁ4Ë :R¶mSxèØwƒg] ©"|=‡µ̉đ7”e‚?9´âSS&PWÔ^yÁfN¥jỴ̈ €¥ÿ\0Y/£$8MºêL¬ á́V€•Ôw[oơQẰ´Œeºˆ|á|f¢Æßï¯vGµ4À”B7Ư/ô!¯=L¥y’ƯlP´]H`…â@¸»Kçgíʶë™̃1Û'ßxo6YÑb\7íùÏ!üKƠņ³5T]¡'̃ßdAÛhƯ×%íÚ̀Â#‘ÎÑÓ-8n†MW½<ˆb˼D°è[Ÿ”å2H#M»§ă?dÈtåâ~½ˆ‚eu•!¶»"ÀFFë`KzÇŒ\–¬?ÂÎÛI€P& jƒ 1´ƒ—§ÖÄ'át—¿dz­94Z©¬®{sqª\½o{Ê¥“U†Îº…M7fƠ]öˆ}©…`GH¼Æت´&Í*kÛ»„BAáÍäÈ[Py¿Ë/KCQÎS3h •z¸¸–8^³S¦ßߘĶ©H:[¡X¸-„¬(ÖI\́„÷yn˜Í ÷Kăn¥ßLZô¦¬-n¸Wس:₫ß›•:Đ»¨0N«Á{Øâè ³™»…KƠhœH̀Bß>»ë́GË0) Ë] "AøÍbyvªÎ;`!Wh ́ø¯{5‘²Đ´§°̣!VĐ>4ÓôÜu^3 ºá2 q ‰ñËÚ$¶!Ú2EØspX(¨áï® >vŸCg}úkÉ#—÷ £ÔW—‡áæË´ăÈ‹ƒH,”2Æ36A¿ID₫¢_ ÇP‡{ö ( ÔäÅ×oͪº.F×)KPT$§µª³ÂRóRUÆè•aMQ ₫wûà¯e±₫GÇ´˜\úsÿl q¾í›X°¾='vĂ“XøƯÇeŒ˜&¬¡ñ—èà6¸¼óëÑ|ÚÇƠU@xú~?”l¡£LF‰¶¿ÆÄ*Eѧ:^FXARîk”»DkèêówtÆf0æX4̃àqƯ¼Îâ|Zö.eaÍ–p ùë`FÁĉ©ĐRr.DâƯeE‰-5|‰æÙFlÎWư™8²È)n>¥,Û’wW²"èmw0øî«Æt¿nVˆf16wLOÿU3gM[/Ø"†"1ZWm'R(@ñ³YG³K*M{'C~dèIw¢ YÛøô»íßç[î>4C/ôaTb)W 1"ù°uó>ºùí@ '?™úuáj³ÑtîuÔöE˜‹çÄv•¦ô 1¼áÚzæ”Y₫^§ÿĂ·µflˆÍúm¡`׌ºM̃üø)ÅÖ™cVL₫(sv(FÏwâ]wƯv̉ ÔîçnŸÊ_6›U`PAª‹đl0vFBΒصHk”Rÿ%̃ï_ˆưùÙp/b Pù§6JMMIơ!<kÄ«BưÏí Sn¥/¯÷—¤qxwq”z;Á¡ẹ̈¶‡ø¼>ûUŒH̃ /‰øăuƯù?p!ŸoÖq‡#ÀêE%r 9ˆ* êü”«~q5!˜:̀…Ư€J­ (t}ÙK—Àˆzø̣_L 6~[¬îÿ¥$™%}>ÉAư¢ó ơ0«G˜́0óäbἇè~̃mÊln­‹gƠ[æ‘ísú,HBQOôÈwÁù,àîºSÚzg7}½ÿt´Î1?•Wl<‡ƒ+¾g„Óm¨ƒä ŒZ$£zÚÀ:‘PăzÂM)…ÑeG¦AΗ}X¼×ƒ£ñës`…#èr‘vC’3Â-°È¢E°đkØÅ·₫đÖW×)u Ẃq7́E¼blí‚_ÔË,FCZyúd†dåÔ‡Ư]]Q/¾^.¸å~Œ˜$&~˜Ưư´Ñ}°¦#Ö p&ÅmßXJ^ûWÙK昬•ÙØùÿ1/‘Å^3* êáe(̃́–₫₫V!̃vŒ¥è¶Đ†̉ꢴI÷=†ÆÓAº—}C­.Oå‡VÛđ¸Ä«Lº!ƒhq:W gË9îfhttr2/tests/testthat/test-req-policy.R0000644000176200001440000000016514556444037017521 0ustar liggesuserstest_that("as_callback validates inputs", { expect_snapshot(as_callback(function(x) 2, 2, "foo"), error = TRUE) }) httr2/tests/testthat/test-oauth-flow-refresh.R0000644000176200001440000000230414753125205021143 0ustar liggesuserstest_that("cache considers refresh_token", { client <- oauth_client("example", "https://example.com/get_token") req <- request("https://example.com") # create 2 requests with different refresh token req1 <- req %>% req_oauth_refresh(client, refresh_token = "rt1") req2 <- req %>% req_oauth_refresh(client, refresh_token = "rt2") # cache must be empty expect_equal(req1$policies$auth_sign$cache$get(), NULL) expect_equal(req2$policies$auth_sign$cache$get(), NULL) # simulate that we made a request and got back a token token <- oauth_token( access_token = "a", token_type = "bearer", expires_in = NULL, refresh_token = "rt1", .date = Sys.time() ) # ... that is now cached req1$policies$auth_sign$cache$set(token) # req1 cache must be filled, but req2 cache still be empty expect_equal(req1$policies$auth_sign$cache$get(), token) expect_equal(req2$policies$auth_sign$cache$get(), NULL) }) test_that("warns if refresh token changes", { client <- oauth_client("example", "https://example.com/get_token") local_mocked_bindings( token_refresh = function(...) list(refresh_token = "def") ) expect_snapshot(. <- oauth_flow_refresh(client, "abc")) }) httr2/tests/testthat/test-resp-status.R0000644000176200001440000000102314656157441017722 0ustar liggesuserstest_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"') 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"') expect_snapshot_error(resp_check_status(resp)) }) httr2/tests/testthat/test-req-perform.R0000644000176200001440000001265214761705464017702 0ustar liggesuserstest_that("success request returns response", { req <- request_test() resp <- req_perform(req) expect_s3_class(resp, "httr2_response") expect_equal(resp$request, req) }) test_that("curl errors become errors", { local_mocked_bindings(curl_fetch = function(...) abort("Failed to connect")) req <- request("http://127.0.0.1") expect_snapshot(req_perform(req), error = TRUE) expect_error(req_perform(req), class = "httr2_failure") # and captures request cnd <- catch_cnd(req_perform(req), classes = "error") expect_equal(cnd$request, req) # But last_response() is NULL expect_null(last_response()) }) test_that("http errors become errors", { req <- request_test("/status/:status", status = 404) expect_error(req_perform(req), class = "httr2_http_404") expect_snapshot(req_perform(req), error = TRUE) # and captures request cnd <- catch_cnd(req_perform(req), classes = "error") expect_equal(cnd$request, req) # including transient errors req <- request_test("/status/:status", status = 429) expect_snapshot(req_perform(req), error = TRUE) req_perform(req) %>% expect_error(class = "httr2_http_429") %>% expect_no_condition(class = "httr2_sleep") # non-standard status codes don't get descriptions req <- request_test("/status/:status", status = 599) expect_snapshot(req_perform(req), error = TRUE) }) test_that("can force successful HTTP statuses to error", { req <- request_test("/status/:status", status = 200) %>% req_error(is_error = function(resp) TRUE) expect_error(req_perform(req), class = "httr2_http_200") }) test_that("persistent HTTP errors only get single attempt", { req <- request_test("/status/:status", status = 404) %>% req_retry(max_tries = 5) cnd <- req_perform(req) %>% expect_error(class = "httr2_http_404") %>% catch_cnd("httr2_fetch") expect_equal(cnd$n, 1) }) test_that("don't retry curl errors by default", { req <- request("") %>% req_retry(max_tries = 2, failure_realm = "x") 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") cnd <- catch_cnd(req_perform(req), "httr2_retry") expect_equal(cnd$tries, 1) }) test_that("can retry a transient error", { req <- local_app_request(function(req, res) { i <- res$app$locals$i %||% 1 if (i == 1) { res$app$locals$i <- 2 res$ set_status(429)$ set_header("retry-after", 0)$ send_json(list(status = "waiting")) } else { res$send_json(list(status = "done")) } }) req <- req_retry(req, max_tries = 2) cnd <- catch_cnd(resp <- req_perform(req), "httr2_retry") expect_s3_class(cnd, "httr2_retry") expect_equal(cnd$tries, 1) expect_equal(cnd$delay, 0) }) test_that("repeated transient errors still fail", { req <- request_test("/status/:status", status = 429) %>% req_retry(max_tries = 3, backoff = ~0) cnd <- req_perform(req) %>% expect_error(class = "httr2_http_429") %>% catch_cnd("httr2_fetch") expect_equal(cnd$n, 3) }) test_that("can download 0 byte file", { path <- withr::local_tempfile() resps <- req_perform(request_test("/bytes/0"), path = path) expect_equal(file.size(path[[1]]), 0) }) test_that("can cache requests with etags", { req <- request_test("/etag/:etag", etag = "abc") %>% req_cache(tempfile()) resp1 <- req_perform(req) expect_condition( expect_condition(resp2 <- req_perform(req), class = "httr2_cache_not_modified"), class = "httr2_cache_save" ) }) test_that("can cache requests with paths (cache-control)", { req <- request(example_url("/cache/2")) %>% req_cache(withr::local_tempfile()) path1 <- withr::local_tempfile() expect_condition( resp1 <- req %>% req_perform(path = path1), class = "httr2_cache_save" ) expect_equal(resp1$body[[1]], path1) path2 <- withr::local_tempfile() expect_condition( resp2 <- req %>% req_perform(path = path2), class = "httr2_cache_cached" ) expect_equal(resp2$body[[1]], path2) # Wait until cache expires cached_resp <- cache_get(req) info <- resp_cache_info(cached_resp) Sys.sleep(max(as.double(info$expires - Sys.time()), 0)) path3 <- withr::local_tempfile() expect_condition( resp3 <- req %>% req_perform(path = path3), class = "httr2_cache_save" ) expect_equal(resp3$body[[1]], path3) }) test_that("can cache requests with paths (if-modified-since)", { req <- request(example_url("/cache")) %>% req_cache(tempfile()) path1 <- tempfile() expect_condition( resp1 <- req %>% req_perform(path = path1), class = "httr2_cache_save" ) expect_equal(resp1$body[[1]], path1) path2 <- tempfile() expect_condition( expect_condition( resp2 <- req %>% req_perform(path = path2), class = "httr2_cache_not_modified" ), class = "httr2_cache_save" ) expect_equal(resp2$body[[1]], path2) }) test_that("can retrieve last request and response", { req <- request_test() resp <- req_perform(req) expect_equal(last_request(), req) expect_equal(last_response(), resp) }) test_that("last response is NULL if it fails", { req <- request("") try(req_perform(req), silent = TRUE) expect_equal(last_request(), req) expect_equal(last_response(), NULL) }) test_that("checks input types", { req <- request_test() expect_snapshot(error = TRUE, { req_perform(req, path = 1) req_perform(req, verbosity = 1.5) req_perform(req, mock = 7) }) }) httr2/tests/testthat/test-utils-multi.R0000644000176200001440000000216414643732273017725 0ustar liggesuserstest_that("can handle multi query params", { expect_equal( multi_dots(a = 1:2, .multi = "explode"), list(a = I("1"), a = I("2")) ) expect_equal( multi_dots(a = 1:2, .multi = "comma"), list(a = I("1,2")) ) expect_equal( multi_dots(a = 1:2, .multi = "pipe"), list(a = I("1|2")) ) expect_equal( multi_dots(a = 1:2, .multi = function(x) "X"), list(a = I("X")) ) }) test_that("can opt-out of escaping for' vectors", { expect_equal( multi_dots(a = I(c(" ", " ")), .multi = "comma"), list(a = I(" , ")) ) }) test_that("can handle empty dots", { expect_equal(multi_dots(), list()) }) test_that("preserves NULL values", { expect_equal(multi_dots(x = NULL), list(x = NULL)) }) test_that("preserves duplicates values", { expect_equal(multi_dots(x = 1, x = 2), list(x = I("1"), x = I("2"))) }) test_that("leaves already escaped values alone", { x <- I("1 + 2") expect_equal(multi_dots(x = x), list(x = x)) }) test_that("checks its inputs", { expect_snapshot(error = TRUE, { multi_dots(1) multi_dots(x = I(1)) multi_dots(x = 1:2) multi_dots(x = mean) }) }) httr2/tests/testthat/test-resp-request.R0000644000176200001440000000020114737043664020065 0ustar liggesuserstest_that("can extract request", { req <- request_test() resp <- req_perform(req) expect_equal(resp_request(resp), req) }) httr2/tests/testthat/test-req-options.R0000644000176200001440000000324114753374623017715 0ustar liggesuserstest_that("can add and remove options", { req <- request("http://example.com") req <- req %>% req_options(x = 1) expect_equal(req$options, list(x = 1)) req <- req %>% req_options(x = NULL) expect_equal(req$options, list()) }) test_that("can add header called req", { req <- request("http://example.com") req <- req %>% req_options(req = 1) expect_equal(req$options, list(req = 1)) }) test_that("default user agent includes httr2 + libcurl versions", { req <- request("http://example.com") %>% req_user_agent() expect_match(req$options$useragent, "httr2") expect_match(req$options$useragent, "libcurl") }) test_that("can override default user agent", { req <- request("http://example.com") %>% req_user_agent("abc") expect_equal(req$options$useragent, "abc") }) test_that("default user agent works with dev curl", { # non-R-ish library version for curl, #416 local_mocked_bindings(curl_system_version = function(...) "8.4.0-DEV") expect_match(default_user_agent(), "libcurl/8.4.0-DEV") }) test_that("can set timeout", { req <- request_test("/delay/:secs", secs = 1) %>% req_timeout(0.1) expect_error(req_perform(req), "timed out") }) test_that("validates inputs", { expect_snapshot(error = TRUE, { request_test() %>% req_timeout("x") request_test() %>% req_timeout(0) }) }) test_that("req_proxy gives helpful errors", { req <- request_test("/get") expect_snapshot(error = TRUE, { req %>% req_proxy(port = "abc") req %>% req_proxy("abc", auth = "bsc") }) }) test_that("auth_flags gives correct constant", { expect_equal(auth_flags("digest"), 2) expect_equal(auth_flags("ntlm"), 8) expect_equal(auth_flags("any"), -17) }) httr2/tests/testthat/test-content-type.R0000644000176200001440000000436614752214235020066 0ustar liggesuserstest_that("valid arguments are optional", { resp <- response_json() expect_no_error(resp_check_content_type(resp)) }) test_that("can check type of response", { resp1 <- response(headers = c("Content-type: application/json")) resp2 <- response(headers = c("Content-type: xxxxx")) expect_no_error( resp_check_content_type(resp1, "application/json") ) expect_no_error( resp_check_content_type(resp1, "application/xml", check_type = FALSE) ) expect_snapshot(error = TRUE, { resp_check_content_type(resp1, "application/xml") resp_check_content_type(resp2, "application/xml") }) }) test_that("useful error even if no content type", { resp <- response() expect_snapshot(resp_check_content_type(resp, "application/xml"), error = TRUE) }) test_that("can parse content type", { expect_equal( parse_content_type("application/json"), list(type = "application", subtype = "json", suffix = "") ) # can parse suffix expect_equal( parse_content_type("text/html+xml"), list(type = "text", subtype = "html", suffix = "xml") ) # parameters don't matter expect_equal( parse_content_type("text/html+xml;charset=UTF-8"), list(type = "text", subtype = "html", suffix = "xml") ) }) test_that("invalid type returns empty strings", { expect_equal( parse_content_type(""), list(type = "", subtype = "", suffix = "") ) }) 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) # works with suffixes 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 ) # can use multiple valid types expect_no_error( check_content_type("application/test+json", c("text/html", "application/json"), "json") ) expect_snapshot( check_content_type("application/xml", c("text/html", "application/json")), error = TRUE ) }) test_that("can detect text types", { expect_true(is_text_type("text/html")) expect_true(is_text_type("application/json")) expect_false(is_text_type("image/png")) }) httr2/tests/testthat/test-req-promise.R0000644000176200001440000001132114752760573017700 0ustar liggesuserstest_that("checks its inputs", { req <- request_test("/status/:status", status = 200) expect_snapshot(error = TRUE, { req_perform_promise(1) req_perform_promise(req, path = 1) req_perform_promise(req, pool = "INVALID") req_perform_promise(req, verbosity = "INVALID") }) }) test_that("returns a promise that resolves", { p1 <- req_perform_promise(request_test("/delay/:secs", secs = 0.25)) p2 <- req_perform_promise(request_test("/delay/:secs", secs = 0.25)) expect_s3_class(p1, "promise") expect_s3_class(p2, "promise") p1_value <- extract_promise(p1) expect_equal(resp_status(p1_value), 200) p2_value <- extract_promise(p2) expect_equal(resp_status(p2_value), 200) }) test_that("correctly prepares request", { req <- request_test("/post") %>% req_method("POST") prom <- req_perform_promise(req) expect_no_error(extract_promise(prom)) }) test_that("correctly prepares request", { req <- request_test("/get") 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) } ) }) test_that("can promise to download files", { req <- request_test("/json") path <- withr::local_tempfile() p <- req_perform_promise(req, path) expect_s3_class(p, "promise") p_value <- extract_promise(p) expect_equal(p_value$body, new_path(path)) # And check that something was downloaded expect_gt(file.size(path), 0) }) 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") ) cache_set(req, resp) p <- req_perform_promise(req) expect_s3_class(p, "promise") p_value <- extract_promise(p) expect_equal(p_value, resp) }) test_that("both curl and HTTP errors in promises are rejected", { expect_error( extract_promise( req_perform_promise(request_test("/status/:status", status = 404)) ), class = "httr2_http_404" ) expect_error( extract_promise( req_perform_promise(request("INVALID")) ), class = "httr2_failure" ) }) test_that("req_perform_promise doesn't leave behind poller", { 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()) p_value <- extract_promise(p) # But now that that our promise is resolved, we shouldn't still be polling the pool expect_true(later::loop_empty()) }) 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) expect_equal(length(curl::multi_list(custom_pool)), 1) p1_value <- extract_promise(p1) expect_equal(resp_status(p1_value), 200) p2_value <- extract_promise(p2) expect_equal(resp_status(p2_value), 200) }) test_that("req_perform_promise uses the default loop", { # The main reason for temp loops is to allow an asynchronous operation to be # created, waited on, and resolved/rejected inside of a synchronous function, # all without affecting any asynchronous operations that existed before the # temp loop was created. # This can't proceed within the temp loop p1 <- req_perform_promise(request_test("/delay/:secs", secs = 0.25)) later::with_temp_loop({ # You can create an async response with explicit pool=NULL, but it can't # proceed until the temp loop is over p2 <- req_perform_promise(request_test("/get"), pool = NULL) # You can create an async response with explicit pool=pool, and it can # proceed as long as that pool was first used inside of the temp loop p3 <- req_perform_promise(request_test("/get"), pool = curl::new_pool()) # 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) # Like I said, you can create this, but it won't work until we get back # outside the temp loop expect_null(extract_promise(p2, timeout = 1)) # This works fine inside the temp loop, because its pool was first used # inside expect_equal(resp_status(extract_promise(p3, timeout = 1)), 200) }) # These work fine now that we're back outside the temp loop expect_equal(resp_status(extract_promise(p1, timeout = 1)), 200) expect_equal(resp_status(extract_promise(p2, timeout = 1)), 200) }) httr2/tests/testthat/test-req-throttle.R0000644000176200001440000000424214753653643020073 0ustar liggesuserstest_that("throttling affects request performance", { skip_on_cran() on.exit(throttle_reset()) local_mocked_bindings(unix_time = function() 0) req <- request_test() %>% req_throttle(capacity = 4, fill_time_s = 1) . <- replicate(4, req_perform(req)) local_mocked_bindings(unix_time = function() 0.1) expect_snapshot(time <- system.time(req_perform(req))[[3]]) expect_gte(time, 1/4 - 0.1) }) test_that("first request isn't throttled", { on.exit(throttle_reset()) mock_time <- 0 local_mocked_bindings(unix_time = function() mock_time) req <- request_test() %>% req_throttle(rate = 1, fill_time_s = 1) expect_equal(throttle_delay(req), 0) mock_time <- 0.1 expect_equal(throttle_delay(req), 0.9) mock_time <- 1.5 expect_equal(throttle_delay(req), 0.5) }) test_that("realm defaults to hostname but can be overridden", { on.exit(throttle_reset()) expect_named(the$throttle, character()) request_test() %>% req_throttle(100 / 1) expect_named(the$throttle, "127.0.0.1") throttle_reset() request_test() %>% req_throttle(100 / 1, realm = "custom") expect_named(the$throttle, "custom") }) # token bucket ---------------------------------------------------------------- test_that("token bucket respects capacity limits", { mock_time <- 0 local_mocked_bindings(unix_time = function() mock_time) bucket <- TokenBucket$new(capacity = 2, fill_time_s = 1) expect_equal(bucket$take_token(), 0) expect_equal(bucket$tokens, 1) expect_equal(bucket$take_token(), 0) expect_equal(bucket$tokens, 0) expect_equal(bucket$take_token(), 0.5) mock_time <- 0.5 expect_equal(bucket$take_token(), 0.5) }) test_that("token bucket handles fractions correctly", { mock_time <- 0 local_mocked_bindings(unix_time = function() mock_time) bucket <- TokenBucket$new(capacity = 2, fill_time_s = 1) bucket$tokens <- 0 expect_equal(bucket$take_token(), 0.5) expect_equal(bucket$tokens, -1) mock_time <- 0.5 expect_equal(bucket$refill(), 0) bucket$last_fill <- 0 bucket$tokens <- 0 mock_time <- 0.4 expect_equal(bucket$refill(), 0.80) expect_equal(bucket$take_token(), 0.1) mock_time <- mock_time + 0.1 expect_equal(bucket$refill(), 0) }) httr2/tests/testthat.R0000644000176200001440000000006614053164547014455 0ustar liggesuserslibrary(testthat) library(httr2) test_check("httr2") httr2/MD50000644000176200001440000003751114762766512011654 0ustar liggesusersc502a193a88d1bbbab5c43d51ebfd2c3 *DESCRIPTION 67c32986371e772e798cc5d9f2dcc504 *LICENSE 8134cead9816ff25033d839df63f9b18 *NAMESPACE 7b06d048c95da50017f31c937f50e5c5 *NEWS.md ba1b76eb3a2f75d3f9bc4dedcaedebb4 *R/content-type.R df0aa18deab8fa396113e2ffc2f3d018 *R/curl.R 35558e7db8d017640d09c4891a12e581 *R/headers.R 9b5361f924696844cd4d5bf7d099479d *R/httr2-package.R c80a9eb1427c585807cecf618b6f3870 *R/import-standalone-obj-type.R 17bb123964057b839a42eda1c3da214b *R/import-standalone-purrr.R c40f882046a958444c6058a9e2cb9a3b *R/import-standalone-types-check.R 507abe6ac4547126f8fa5d727bed378e *R/is-online.R 9b30eaec39a5108b8d433a20f9634c02 *R/iterate-helpers.R e27a45dc3c3644ad419b94e9c0ea12de *R/iterate-responses.R b9d534f99dcda91551c3fcd746e2a445 *R/jwt.R 88afeafa5ace568ba36a8c729e66dd15 *R/oauth-client.R dcbda6eb63ab381f661533144b4a9f6f *R/oauth-flow-auth-code.R a83498a469807c9f97bb6ccc4ea35a1a *R/oauth-flow-client-credentials.R 8fb1c52ebc692107974ec313bde9dcdb *R/oauth-flow-device.R 5c091bad88025c39d795d0c50a69997a *R/oauth-flow-jwt.R c7d09f1525f2f600e9b55631e34e8cbe *R/oauth-flow-password.R 4861c984d0dfe47cb1a0db1ce21b4b71 *R/oauth-flow-refresh.R 947401cd8e1d67a790685757392fb50c *R/oauth-flow-token-exchange.R 304974c85e1a0dec4738a95e9548fa6b *R/oauth-flow.R 8f45f50f6749f6b79852f82780d355f6 *R/oauth-token.R 568ea18c887001469972c7ce96db5ae1 *R/oauth.R 750539f93e92d55bcccfcf9960f78b8d *R/parse.R 48f83843a8da239d16f457c2f7424138 *R/pooled-request.R 3019a5a632f44a7a0035cb59d5b206ca *R/progress-bars.R 9d445d01e4991232f2bf3ebcd6e35fda *R/req-auth-aws.R 4bc3d5d29cf2e0686137b0991abf4913 *R/req-auth-sign.R 5482a6f1b4c8306e475ec266c0bf68c1 *R/req-auth.R c70563cd2f402a195ae514e4d9122e55 *R/req-body.R 7a07dd3c82521309d3804c00be243060 *R/req-cache.R fc33319973b4af684d277c84f6b05613 *R/req-cookies.R 18e3464ea9b9a27beea8f7a3dba2559d *R/req-dry-run.R f21ecde5f4a481dc0d72a61983e7a2c0 *R/req-error.R 92cf56fd037a30c0419ccab45ce48425 *R/req-headers.R c64e21ca81ec2590c380e74b89a9119f *R/req-method.R c892d24ea5aea680b8d203a2a5718e3b *R/req-mock.R 223e0d3dc29b7fd4672a6bbad39e293d *R/req-options.R 5c8cf094a1389857b243b7584aaeb6dd *R/req-perform-connection.R 2d943bdad354e34cbd4a45100b0d1e6b *R/req-perform-iterative.R d6967b601a8513b339efaa14c2deb414 *R/req-perform-parallel.R 183ec18e4598f326f56eb7f312e3b205 *R/req-perform-sequential.R c3169dc84805a1e40510761aa2718c6f *R/req-perform-stream.R 3f216a53eb7f7b0b0ad2460d87be11bb *R/req-perform.R 06612e2c3c9ca2995093c9174a3761ed *R/req-policy.R ce08586490a871eff3cc5154fb92f8f1 *R/req-progress.R 61b8144090a2d71822f9ddb397eb4270 *R/req-promise.R 5f8e4063ee130b4a9c1d5589d97e671f *R/req-retries.R 55ed14b760ba2f18d64d4c69ba064611 *R/req-template.R a4232e47ecc4af5e9cff0cae5a2dab63 *R/req-throttle.R 39df0c5d2c8b0fa179e421a49d7d95fc *R/req-url.R 6a5f52690bad245828cf9bb330708556 *R/req-verbose.R 4f4ab071baa0920f1fe3c963ebb3f0e1 *R/req.R a3998f317ba316c845455ce58a73951c *R/resp-body.R 9e8d4e3bcd40550f2d3ce8e8a413c2ee *R/resp-headers.R e3273082cbfdb95d21e7d3090a286d54 *R/resp-request.R e0d2536dd8466ff1a2e546d5258ec209 *R/resp-status.R e27e6ab7f9057f0ba630715fd6b28114 *R/resp-stream-aws.R 27e8ea2de50950188cd86c544383be65 *R/resp-stream.R 4de6118af4838858409a4f91bf6294b6 *R/resp-url.R c96afea8e7dbf7e4812bea3067abc995 *R/resp.R 8f02cbe77f0b346ddaf3a7e5158e387c *R/roxygen2.R c50272978398261ca3af6973a716f457 *R/secret.R 18fbe8fc2497eef4d6f13c7e45f5508f *R/sysdata.rda 73b79fd92ed0af7dfcd99689e9af5efc *R/test.R 9e85d6175d0dec3b64f93d5d538b74a9 *R/url.R 46898a02a6ba2dfeb06d0dd363279b06 *R/utils-multi.R b56ff2b193ecba52f9ec7f3b10cca008 *R/utils-pipe.R 49fb2f4f23f0c49a6402f9d682718320 *R/utils.R bc41593abd2a492a7bba4e42a21d57e8 *R/verbosity.R 059a3c630cbf1d8cba089f78486fa4d9 *R/zzz.R 3622e03a29dc8973321c4684372cfb8c *README.md 0b5ad3550ad96845f4ca697d3740ea09 *build/vignette.rds de3fc7fc6d5f0ec1ddf799c84d04a63e *cleanup b547518249e0da4528616c8ed2382036 *configure 757ef8281ef2a1ebcbcc8235aeee2d0e *configure.win 62d1743a605c7aa827b5742a25950087 *inst/doc/httr2.R 756aa5ef5610e930e40777f72f68523b *inst/doc/httr2.Rmd d7cb60cd778108e90d3b06d71a82d68a *inst/doc/httr2.html 8ac6a7b7aac968e8a0e93c58049261ef *man/curl_translate.Rd 1b8a5c50c6bdd9235e70186f9c3aeb70 *man/example_url.Rd a1cbaf3f328e8d74e747faacf640c7fc *man/figures/lifecycle-archived.svg 6f521fb1819410630e279d1abf88685a *man/figures/lifecycle-defunct.svg 391f696f961e28914508628a7af31b74 *man/figures/lifecycle-deprecated.svg 691b1eb2aec9e1bec96b79d11ba5e631 *man/figures/lifecycle-experimental.svg 405e252e54a79b33522e9699e4e9051c *man/figures/lifecycle-maturing.svg f41ed996be135fb35afe00641621da61 *man/figures/lifecycle-questioning.svg 306bef67d1c636f209024cf2403846fd *man/figures/lifecycle-soft-deprecated.svg ed42e3fbd7cc30bc6ca8fa9b658e24a8 *man/figures/lifecycle-stable.svg bf2f1ad432ecccee3400afe533404113 *man/figures/lifecycle-superseded.svg 5533c65601c00e2027a5b4f2f11d460c *man/figures/logo.png ebab256683f284e8b780f139c2c0f0cc *man/httr2-package.Rd 49d626df322d7cf662377e1c01b06f2d *man/is_online.Rd a6b2fc640f68348bb1df1e055a55710a *man/iterate_with_offset.Rd 36e14f11e9656c1a80e51c6f137ea052 *man/jwt_claim.Rd bbdae5dea29b21d47d7c7069c0d46ab1 *man/last_response.Rd 7ef52959ce2a78b06a308647fbf7f42e *man/multi_req_perform.Rd 04804ae5afb484f583664a8ef5bf51e4 *man/oauth_cache_clear.Rd 9b54af46994b24405f4751fd1086c06f *man/oauth_cache_path.Rd 28127c166aacb0222ee462c49822f29e *man/oauth_client.Rd b8caa0db13e56df3169c2cbeed177a3c *man/oauth_client_req_auth.Rd f85799546535b14ffae03ac4238623f5 *man/oauth_flow_auth_code_url.Rd 14e969a9f7635123e06e5296f680c3aa *man/oauth_redirect_uri.Rd e8432ee09c99bc777397e20e6181d444 *man/oauth_token.Rd 2af58cfe96d548ef9086a791d1570a91 *man/oauth_token_cached.Rd 622607c5f5df647186110c9b1ce435b5 *man/obfuscate.Rd 8f4aad003a999fae004ba9361f9a99d6 *man/pipe.Rd e68629ab3d3b207dcf7346a6385b0393 *man/progress_bars.Rd a785e57eddb1cd148bc0b0070bace521 *man/req_auth_aws_v4.Rd b9258b3b58269decb6e84b3d0e9d544b *man/req_auth_basic.Rd e62ad6ff1724af6693421e1722d323ee *man/req_auth_bearer_token.Rd 3921f52aec7ba33f0f5c91151ecdc70a *man/req_body.Rd 58ddbc800a0f9676c146ff3a9cfb964c *man/req_cache.Rd 9ff896ff8069ceb86a9dd115d454aedc *man/req_cookie_preserve.Rd 8db98f731f48e9c8f038b85730eb295f *man/req_dry_run.Rd 20f4b9126f19b176e452de860a8f427c *man/req_error.Rd d6075d59676d959e2f808ac8665f2084 *man/req_headers.Rd 016775046384c8579f22ad7b8cd54f6a *man/req_method.Rd bb00e2e79745986b4cef04e6b8e56e5c *man/req_oauth.Rd ee2167ae16d025385e6eb9f09204dd39 *man/req_oauth_auth_code.Rd c474b629b73cde26b2184c763aef00ae *man/req_oauth_bearer_jwt.Rd c537e872c7e8daa6e9d2aeae0c1cf119 *man/req_oauth_client_credentials.Rd f625f409275c2bd63080bb856cb37d0e *man/req_oauth_device.Rd 9ee09168c57126cd537ab66e3328b2f4 *man/req_oauth_password.Rd 74b982010cb6f5505de3888f7dd79461 *man/req_oauth_refresh.Rd 551e3d4aead599d0f7794a73cc52368d *man/req_oauth_token_exchange.Rd d0bfcfa3163dd92ba9dc87393077fda3 *man/req_options.Rd 538e1b1c5a396431a6ab35259e5c7af6 *man/req_perform.Rd 7e4b21dccdca795d936fa11b00a43ecc *man/req_perform_connection.Rd b7248ace708c871c68956afaf5a9c5b3 *man/req_perform_iterative.Rd a4e26f1ea13b0c721bfe1d2b43e9f7e7 *man/req_perform_parallel.Rd a4c4dcc9a7f8ca23403a8cdf2c27415e *man/req_perform_promise.Rd 699c12df137c22440d7bab1a7ba449ee *man/req_perform_sequential.Rd f702b9e086842784d3d5d682f31b9840 *man/req_perform_stream.Rd 9d5177e09fa693cbf42e143fc0d648b5 *man/req_progress.Rd 01cf8fa1cbbe0443d56be0b3ca48dfb4 *man/req_proxy.Rd de20dee6cc2aec1e82d723789e9eb9d8 *man/req_retry.Rd e99c0b063c7a0493acd4000fa7de6690 *man/req_template.Rd 0764ec72ce83a9b0965d40402320e983 *man/req_throttle.Rd 00f3f81313e9c0587e9449a7973fa117 *man/req_timeout.Rd 6881d56f9d08c5819d3855fb87a0abdd *man/req_url.Rd 04f71709a8a1f84dc93cc18cad22363e *man/req_user_agent.Rd 0aa51eb7131da0ed742b0829493c3bea *man/req_verbose.Rd da6d32cfb889bd0cf0857b565ccd2594 *man/request.Rd bbc8d04cacdca895f816ae655f6345af *man/resp_body_raw.Rd b92eb50223cb3f14ad15445b5cc6caba *man/resp_check_content_type.Rd b1e970bb213f65f465fd739275860e60 *man/resp_content_type.Rd eda7b85b891d9d84c032fd47b7700129 *man/resp_date.Rd fedeb826affa2bceabef362c4e25d9e3 *man/resp_headers.Rd 1c66073d260f82878bb3c2f342717def *man/resp_link_url.Rd db26222bc778e6cedf51a806c65ab392 *man/resp_raw.Rd affdd5eba3a4b5d5aa1727b6a0998faa *man/resp_request.Rd 2ce94385e1e1652829a0f366f9631189 *man/resp_retry_after.Rd 2b0209c459a4595d3624cbcd2e23618f *man/resp_status.Rd 686d25d0003a14617c4f598e5eae17bf *man/resp_stream_raw.Rd 38f37482fa2a5fac8a3e743e342336fd *man/resp_url.Rd 712d1929f961ef8b93224aab5238fd30 *man/response.Rd 2b10262b289e5556af9332f3bbd281a3 *man/resps_successes.Rd 06114c024f153dea1dfdb3b2d373eadf *man/secrets.Rd ddef6b65c32aabc60f757ed193a88134 *man/signal_total_pages.Rd be6ed95a22fc8757cc6babc123c91e6e *man/throttle_status.Rd 56d8688106b975ba2be8a09c3682adc8 *man/url_build.Rd 73b86e58e8d148fd4f962884890fd271 *man/url_modify.Rd 6ba9eb8f20eadbe80eecc2e479ba2133 *man/url_parse.Rd 6ede730cfcced60bbcfbdd87b60cd00f *man/url_query_parse.Rd 1db5ba24b3f55a0ab371859f591c26ba *man/with_mocked_responses.Rd ddd9c740249c455d303311af0e39d073 *man/with_verbosity.Rd c2b2cef37a5921be7c43b192f6ab8cae *tests/testthat.R 2abbb09e4412155bb8c71d2f5d01f842 *tests/testthat/_snaps/content-type.md 1e67767a8e40d903eb2a02df3ac31322 *tests/testthat/_snaps/curl.md 40c612cbc3e0f37a04e76e0192b1f47e *tests/testthat/_snaps/headers.md 9cddfa35811dca8745c8e13b0b925d82 *tests/testthat/_snaps/oauth-client.md 6da6e06f5fbdf2015542f7dda5012915 *tests/testthat/_snaps/oauth-flow-auth-code.md c4d63253b0649f86f0973071d3c9e5bc *tests/testthat/_snaps/oauth-flow-jwt.md 75cc212337fc242cb14f05bf7bb1dbd0 *tests/testthat/_snaps/oauth-flow-refresh.md 3cc24b4852d1b14ad0b0dc28612f5fec *tests/testthat/_snaps/oauth-flow.md 829f38ead01f12f9731b316b46b1117e *tests/testthat/_snaps/oauth-token.md ec27f758dc64156a63a37151654938ac *tests/testthat/_snaps/oauth.md 582a1dc9c6967141efd303bdc8373448 *tests/testthat/_snaps/req-auth-aws.md 104013ab5b5e41cdb9d996441ef274fb *tests/testthat/_snaps/req-body.md e69cb8912ae3ebe10d09c87ed1a286a9 *tests/testthat/_snaps/req-cache.md 3e31359c6520222447d6233f39f415b9 *tests/testthat/_snaps/req-cookies.md b32f7e709495bd08a4ef46e164920911 *tests/testthat/_snaps/req-dry-run.md f9c831a6fd93a36222a2f8b026dcb933 *tests/testthat/_snaps/req-error.md 84a68f2966471ceb1b9cecdab104fd84 *tests/testthat/_snaps/req-headers.md ec8a652884a6bd3a561f705a2cb1f57f *tests/testthat/_snaps/req-mock.md 95cf9b51920c14804645b50015d69157 *tests/testthat/_snaps/req-options.md a088717528b0183afde372698ccd480f *tests/testthat/_snaps/req-perform-connection.md 80f7f8dd80eaec7d4dd7dcbf843b5522 *tests/testthat/_snaps/req-perform-iterative-helpers.md 7fed77e81c3f22fa048ff542e406e40d *tests/testthat/_snaps/req-perform-iterative.md d5770fdb41d3060223fdcc6083a7c3cf *tests/testthat/_snaps/req-perform-parallel.md 23197b884a9489a8ba9f505cf7502382 *tests/testthat/_snaps/req-perform-sequential.md 304742dbf0ddb5549a47bddcb27b8b6b *tests/testthat/_snaps/req-perform-stream.md 4bc2671666f973f3984f7f740b2fa4bc *tests/testthat/_snaps/req-perform.md 9b07d019e4eab37f0f6d97245e61535f *tests/testthat/_snaps/req-policy.md 709f80c1ac1823018b98f2f6416afe4c *tests/testthat/_snaps/req-promise.md 2e1a950eef2130c8e6f55831779589be *tests/testthat/_snaps/req-retries.md a6aa2b17597e91ded969ff83d8ae1aa7 *tests/testthat/_snaps/req-template.md 439620ce2c92050f8a20764e26f998c6 *tests/testthat/_snaps/req-throttle.md 90f8f6da1dae21b0bc53afbb60bfe02f *tests/testthat/_snaps/req-url.md bccdbdc063320f35b97ca7bb18329520 *tests/testthat/_snaps/req-verbose.md 130e706fc062eebfedf8999c46130c34 *tests/testthat/_snaps/req.md 60e6374c33a9a6251ee9662ec1eab2cb *tests/testthat/_snaps/resp-body.md dd83ab51d56154baedd0fce1794d4b78 *tests/testthat/_snaps/resp-status.md 5d9dcaab39402b44c55500061ecadb10 *tests/testthat/_snaps/resp-stream-aws.md 0e4f6c26703ab38317146744413423a0 *tests/testthat/_snaps/resp-stream.md 2f39783d8d60a0b9e37069ea62beb1b5 *tests/testthat/_snaps/resp.md 9a2997f35ff08553b17ad7ffd5445ee2 *tests/testthat/_snaps/secret.md 14e117a66571f3c4ae385b0f8e1e368b *tests/testthat/_snaps/url.md 44c5d6d7c37249a3c71939b83eafa622 *tests/testthat/_snaps/utils-multi.md b8731d2c8ce4d88c9682f9c767871a0b *tests/testthat/_snaps/utils.md 2b394425fbc4d7b868536e7c69f4a8b5 *tests/testthat/helper-promise.R 389f7c79063740d6b268e3fc30e0fbe9 *tests/testthat/helper-webfakes.R 801ae3d296056531d4e5afbc147d8422 *tests/testthat/helper.R 4866fcf0f25189e96d99075702008aae *tests/testthat/test-content-type.R 2fa0415544ee4d075ed483de8975363b *tests/testthat/test-curl.R 19db246b212556cc904992d809121a99 *tests/testthat/test-headers.R 6be0809c2693eec9f295cf26c6babd50 *tests/testthat/test-oauth-client.R 49e7849e8a02f07faee6bbac95d5fbbe *tests/testthat/test-oauth-flow-auth-code.R 29b4f80b4448eb91aa5e19966bd890b6 *tests/testthat/test-oauth-flow-jwt-google.rds bca4aa0a15213a62d6a70f6f8597ae75 *tests/testthat/test-oauth-flow-jwt.R d9481547626f41e9e77422529dbd70ab *tests/testthat/test-oauth-flow-refresh.R fa281ad7b70b8987d371d1dc08faeb7c *tests/testthat/test-oauth-flow.R fdcf858f29e5353c00a4e8f9b804aa7b *tests/testthat/test-oauth-token.R b4eb40ea8f3923f2a17c426b1accb683 *tests/testthat/test-oauth.R 7aafd3f87651aad2096256f730ca3f96 *tests/testthat/test-parse.R 091ff258bca617a00455ed8ad910d18b *tests/testthat/test-req-auth-aws.R 13433e56d76dd753c1c25458354d4918 *tests/testthat/test-req-auth.R fec6f6bf4456ce1452a73f9050a0d409 *tests/testthat/test-req-body.R 7b77b91744d179da2e77f6961e3bfe79 *tests/testthat/test-req-cache.R 237cf040a37f15b32a85f973db1739d0 *tests/testthat/test-req-cookies.R 1f91256644bad68ddee324c36324a79b *tests/testthat/test-req-dry-run.R 94aad378e2187ab554ee0b46cf005ac3 *tests/testthat/test-req-error.R a0b8e798679d990b4963205de7a837b2 *tests/testthat/test-req-headers.R abe3ec676219640db627c485562b04c3 *tests/testthat/test-req-method.R a0b363b87327500f0d924478f5043d85 *tests/testthat/test-req-mock.R 9bc69e4c9d061026e0adefdc0c2c116a *tests/testthat/test-req-options.R 56990f9007b2e5bfc7df94c036b80641 *tests/testthat/test-req-perform-connection.R 5be02d74f062de3487e54c8d4bfa25d7 *tests/testthat/test-req-perform-iterative-helpers.R 6d3ec8a9144133090eb42a027c84d50b *tests/testthat/test-req-perform-iterative-responses.R eb629448a42df16f9d2617aec82648f9 *tests/testthat/test-req-perform-iterative.R 17224a4e9ad5527b423a928d7dde1f71 *tests/testthat/test-req-perform-parallel.R 57013c2bbff9e24e5d76e5f86b163217 *tests/testthat/test-req-perform-sequential.R 0076ba539fec0fec5d1e8467b480128a *tests/testthat/test-req-perform-stream.R ea027186fa47e70e66f5f330eb680fe3 *tests/testthat/test-req-perform.R 8e5b70954049fa379b900743857d68d0 *tests/testthat/test-req-policy.R 4fc59db924b26be4d47fd00f70e9d075 *tests/testthat/test-req-promise.R 8d441c2ab83574236eb2a380b33e46da *tests/testthat/test-req-retries.R d8ebf8812ec156c0c00443c71d6e65e8 *tests/testthat/test-req-template.R d40dfd4aad6589dae12f08a885c4ea04 *tests/testthat/test-req-throttle.R 986d06bf1e471a3c14eb7b30f3a1517f *tests/testthat/test-req-url.R 60eff10613e762d7e6c203c77fcf0cf6 *tests/testthat/test-req-verbose.R 75cd4425b038e917ec04921e5dd051e5 *tests/testthat/test-req.R df705107d13e79dfb0401bd655df7f65 *tests/testthat/test-resp-body.R c8eda7962f7c440d9b28fb816cdcbc4f *tests/testthat/test-resp-headers.R f0c4119da95f8859efd0a6580f240750 *tests/testthat/test-resp-request.R 306705998dbf3b108cbeb46449a01ec5 *tests/testthat/test-resp-status.R 8823fcea7255ac7e0f69b26413435c82 *tests/testthat/test-resp-stream-aws.R c5bec090a504894eca6ce6a0e18a9259 *tests/testthat/test-resp-stream.R 05aaad84797442d092cc0738b2af5bac *tests/testthat/test-resp-url.R 73c6a817d1876b11d5e1f972837f3c54 *tests/testthat/test-resp.R 6e1cf597de2078da4f7cad93112d6b9e *tests/testthat/test-secret.R 4872fc4a9ef74c2161da4f7d4abcb10a *tests/testthat/test-url.R 2f68cfd0571464f93d4e04e46824605a *tests/testthat/test-utils-multi.R f22275174236f295431faf89e3ab922c *tests/testthat/test-utils.R 43810e81ac3b56c54c7b18f59186ba85 *tests/testthat/test-verbosity.R 04b0a09ebe1847f15c2b36527ba834ca *tools/examples.R 756aa5ef5610e930e40777f72f68523b *vignettes/httr2.Rmd httr2/configure.win0000644000176200001440000000004314556444037014026 0ustar liggesusers#! /usr/bin/env sh sh ./configure httr2/R/0000755000176200001440000000000014762062303011521 5ustar liggesusershttr2/R/req-perform-sequential.R0000644000176200001440000000755014753653643016277 0ustar liggesusers#' Perform multiple requests in sequence #' #' Given a list of requests, this function performs each in turn, returning #' a list of responses. It's the serial equivalent of [req_perform_parallel()]. #' #' @param reqs A list of [request]s. #' @param paths An optional character vector of paths, if you want to download #' the response bodies to disk. If supplied, must be the same length as #' `reqs`. #' @param on_error What should happen if one of the requests fails? #' #' * `stop`, the default: stop iterating with an error. #' * `return`: stop iterating, returning all the successful responses #' received so far, as well as an error object for the failed request. #' * `continue`: continue iterating, recording errors in the result. #' @param progress Display a progress bar for the status of all requests? Use #' `TRUE` to turn on a basic progress bar, use a string to give it a name, #' or see [progress_bars] to customize it in other ways. Not compatible with #' [req_progress()], as httr2 can only display a single progress bar at a #' time. #' @return #' A list, the same length as `reqs`, containing [response]s and possibly #' error objects, if `on_error` is `"return"` or `"continue"` and one of the #' responses errors. If `on_error` is `"return"` and it errors on the ith #' request, the ith element of the result will be an error object, and the #' remaining elements will be `NULL`. If `on_error` is `"continue"`, it will #' be a mix of requests and error objects. #' #' Only httr2 errors are captured; see [req_error()] for more details. #' @export #' @examples #' # One use of req_perform_sequential() is if the API allows you to request #' # data for multiple objects, you want data for more objects than can fit #' # in one request. #' req <- request("https://api.restful-api.dev/objects") #' #' # Imagine we have 50 ids: #' ids <- sort(sample(100, 50)) #' #' # But the API only allows us to request 10 at time. So we first use split #' # and some modulo arithmetic magic to generate chunks of length 10 #' chunks <- unname(split(ids, (seq_along(ids) - 1) %/% 10)) #' #' # Then we use lapply to generate one request for each chunk: #' reqs <- chunks |> lapply(\(idx) req |> req_url_query(id = idx, .multi = "comma")) #' #' # Then we can perform them all and get the results #' \dontrun{ #' 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) { if (!is_bare_list(reqs)) { stop_input_type(reqs, "a list") } check_paths(paths, reqs) on_error <- arg_match(on_error) err_catch <- on_error != "stop" err_return <- on_error == "return" progress <- create_progress_bar( total = length(reqs), name = "Iterating", config = progress ) resps <- rep_along(reqs, list()) 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_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}.") }) progress$done() resps } check_paths <- function(paths, reqs, error_call = caller_env()) { if (!is.null(paths)) { check_character(paths) if (length(reqs) != length(paths)) { cli::cli_abort( "If supplied, {.arg paths} must be the same length as {.arg req}.", call = error_call ) } } } httr2/R/oauth-token.R0000644000176200001440000000514514761701552014114 0ustar liggesusers#' Create an OAuth token #' #' Creates a S3 object of class `` representing an OAuth token #' returned from the access token endpoint. #' #' @param access_token The access token used to authenticate request #' @param token_type Type of token; only `"bearer"` is currently supported. #' @param expires_in Number of seconds until token expires. #' @param refresh_token Optional refresh token; if supplied, this can be #' used to cheaply get a new access token when this one expires. #' @param ... Additional components returned by the endpoint #' @param .date Date the request was made; used to convert the relative #' `expires_in` to an absolute `expires_at`. #' @seealso [oauth_token_cached()] to use the token cache with a specified #' OAuth flow. #' @return An OAuth token: an S3 list with class `httr2_token`. #' @export #' @examples #' oauth_token("abcdef") #' 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() ) { check_string(access_token) check_string(token_type) check_number_whole(expires_in, allow_null = TRUE) # TODO: should tokens always store their scope? if (!is.null(expires_in)) { # Store as unix time to avoid worrying about type coercions in cache expires_at <- as.numeric(.date) + expires_in } else { expires_at <- NULL } structure( compact(list2( token_type = token_type, access_token = access_token, expires_at = expires_at, refresh_token = refresh_token, ... )), class = "httr2_token" ) } #' @export print.httr2_token <- function(x, ...) { cli::cli_text(cli::style_bold("<", paste(class(x), collapse = "/"), ">")) if (has_name(x, "expires_at")) { x$expires_at <- format(.POSIXct(x$expires_at)) } redacted <- list_redact(compact(x), c("access_token", "refresh_token", "id_token")) bullets(redacted) invisible(x) } token_has_expired <- function(token, delay = 5) { if (is.null(token$expires_at)) { FALSE } else { (unix_time() + delay) > token$expires_at } } token_refresh <- function(client, refresh_token, scope = NULL, token_params = list()) { out <- oauth_client_get_token( client, grant_type = "refresh_token", refresh_token = refresh_token, scope = scope, !!!token_params ) out$refresh_token <- out[["refresh_token"]] %||% refresh_token out } httr2/R/req-mock.R0000644000176200001440000000525414740237660013376 0ustar liggesusers#' Temporarily mock requests #' #' Mocking allows you to selectively and temporarily replace the response #' you would typically receive from a request with your own code. It's #' primarily used for testing. #' #' @param mock A function, a list, or `NULL`. #' #' * `NULL` disables mocking and returns httr2 to regular operation. #' #' * A list of responses will be returned in sequence. After all responses #' have been used up, will return 503 server errors. #' #' * For maximum flexibility, you can supply a function that that takes a #' single argument, `req`, and returns either `NULL` (if it doesn't want to #' handle the request) or a [response] (if it does). #' #' @param code Code to execute in the temporary environment. #' @param env Environment to use for scoping changes. #' @returns `with_mock()` returns the result of evaluating `code`. #' @export #' @examples #' # This function should perform a response against google.com: #' google <- function() { #' request("http://google.com") |> #' req_perform() #' } #' #' # But I can use a mock to instead return my own made up response: #' my_mock <- function(req) { #' response(status_code = 403) #' } #' try(with_mock(my_mock, google())) with_mocked_responses <- function(mock, code) { mock <- as_mock_function(mock) withr::with_options(list(httr2_mock = mock), code) } #' @export #' @rdname with_mocked_responses #' @usage NULL with_mock <- function(mock, code) { lifecycle::deprecate_stop("1.1.0", "with_mock()", "with_mocked_responses()") with_mocked_responses(mock, code) } #' @export #' @rdname with_mocked_responses local_mocked_responses <- function(mock, env = caller_env()) { mock <- as_mock_function(mock) withr::local_options(httr2_mock = mock, .local_envir = env) } #' @export #' @rdname with_mocked_responses #' @usage NULL local_mock <- function(mock, env = caller_env()) { lifecycle::deprecate_warn("1.1.0", "local_mock()", "local_mocked_responses()") local_mocked_responses(mock, env) } as_mock_function <- function(mock, error_call = caller_env()) { if (is.null(mock)) { mock } else if (is.function(mock)) { check_function2(mock, args = "req", call = error_call) mock } else if (is_formula(mock)) { mock <- as_function(mock, call = error_call) } else if (is.list(mock)) { mocked_response_sequence(!!!mock) } else { cli::cli_abort( "{.arg mock} must be a function or list, not {.obj_type_friendly {mock}}.", call = error_call ) } } mocked_response_sequence <- function(...) { responses <- list2(...) n <- length(responses) i <- 0 function(req) { if (i >= n) { response(503) } else { i <<- i + 1 responses[[i]] } } } httr2/R/req-perform-parallel.R0000644000176200001440000003031714761701552015706 0ustar liggesusers#' Perform a list of requests in parallel #' #' @description #' This variation on [req_perform_sequential()] performs multiple requests in #' parallel. Never use it without [req_throttle()]; otherwise it's too easy to #' pummel a server with a very large number of simultaneous requests. #' #' While running, you'll get a progress bar that looks like: #' `[working] (1 + 4) -> 5 -> 5`. The string tells you the current status of #' the queue (e.g. working, waiting, errored) followed by (the #' number of pending requests + pending retried requests) -> the number of #' active requests -> the number of complete requests. #' #' ## Limitations #' #' The main limitation of `req_perform_parallel()` is that it assumes applies #' [req_throttle()] and [req_retry()] are across all requests. This means, #' for example, that if request 1 is throttled, but request 2 is not, #' `req_perform_parallel()` will wait for request 1 before performing request 2. #' This makes it most suitable for performing many parallel requests to the same #' host, rather than a mix of different hosts. It's probably possible to remove #' these limitation, but it's enough work that I'm unlikely to do it unless #' I know that people would fine it useful: so please let me know! #' #' Additionally, it does not respect the `max_tries` argument to `req_retry()` #' because if you have five requests in flight and the first one gets rate #' limited, it's likely that all the others do too. This also means that #' the circuit breaker is never triggered. #' #' @inherit req_perform_sequential params return #' @param pool `r lifecycle::badge("deprecated")`. No longer supported; #' to control the maximum number of concurrent requests, set `max_active`. #' @param max_active Maximum number of concurrent requests. #' @export #' @examples #' # Requesting these 4 pages one at a time would take 2 seconds: #' request_base <- request(example_url()) |> #' req_throttle(capacity = 100, fill_time_s = 60) #' reqs <- list( #' request_base |> req_url_path("/delay/0.5"), #' request_base |> req_url_path("/delay/0.5"), #' request_base |> req_url_path("/delay/0.5"), #' request_base |> req_url_path("/delay/0.5") #' ) #' # But it's much faster if you request in parallel #' system.time(resps <- req_perform_parallel(reqs)) #' #' # req_perform_parallel() will fail on error #' reqs <- list( #' request_base |> req_url_path("/status/200"), #' request_base |> req_url_path("/status/400"), #' request("FAILURE") #' ) #' try(resps <- req_perform_parallel(reqs)) #' #' # but can use on_error to capture all successful results #' resps <- req_perform_parallel(reqs, on_error = "continue") #' #' # Inspect the successful responses #' resps |> resps_successes() #' #' # And the failed responses #' resps |> resps_failures() |> resps_requests() req_perform_parallel <- function( reqs, paths = NULL, pool = deprecated(), on_error = c("stop", "return", "continue"), progress = TRUE, max_active = 10 ) { check_paths(paths, reqs) if (lifecycle::is_present(pool)) { lifecycle::deprecate_warn( when = "1.1.0", what = "req_perform_parallel(pool)" ) } on_error <- arg_match(on_error) check_number_whole(max_active, min = 1) queue <- RequestQueue$new( reqs = reqs, paths = paths, max_active = max_active, on_error = on_error, progress = progress, error_call = environment() ) tryCatch( queue$process(), interrupt = function(cnd) { queue$queue_status <- "errored" queue$process() n <- sum(!map_lgl(queue$resps, is.null)) cli::cli_alert_warning("Terminating iteration; returning {n} response{?s}.") } ) if (on_error == "stop") { is_error <- map_lgl(queue$resps, is_error) if (any(is_error)) { i <- which(is_error)[[1]] the$last_response <- queue$resps[[i]]$resp %||% queue$resps[[i]] the$last_request <- queue$reqs[[i]] cnd_signal(queue$resps[[i]]) } } queue$resps } RequestQueue <- R6::R6Class( "RequestQueue", public = list( pool = NULL, rate_limit_deadline = 0, token_deadline = 0, max_active = NULL, # Overall status for the queue queue_status = NULL, n_pending = 0, n_active = 0, n_complete = 0, n_retries = 0, on_error = "stop", progress = NULL, # Vectorised along reqs reqs = list(), pooled_reqs = list(), resps = list(), status = character(), tries = integer(), # Requests that have failed due to OAuth expiration; used to ensure that we # don't retry repeatedly, but still allow all active requests to retry once oauth_failed = integer(), initialize = function( reqs, paths = NULL, max_active = 10, on_error = "stop", progress = FALSE, error_call = caller_env() ) { n <- length(reqs) if (isTRUE(progress)) { self$progress <- cli::cli_progress_bar( total = n, format = paste0( "[{self$queue_status}] ", "({self$n_pending} + {self$n_retries}) -> {self$n_active} -> {self$n_complete} | ", "{cli::pb_bar} {cli::pb_percent}" ), .envir = error_call ) } # goal is for pool to not do any queueing; i.e. the curl pool will # only ever contain requests that we actually want to process. Any # throttling is done by `req_throttle()` self$max_active <- max_active self$pool <- curl::new_pool( total_con = 100, host_con = 100, max_streams = 100 ) self$on_error <- on_error self$queue_status <- "working" self$n_pending <- n self$n_active <- 0 self$n_complete <- 0 self$reqs <- reqs self$pooled_reqs <- map(seq_along(reqs), function(i) { pooled_request( req = reqs[[i]], path = paths[[i]], on_success = function(resp) self$done_success(i, resp), on_failure = function(error) self$done_failure(i, error), on_error = function(error) self$done_error(i, error), error_call = error_call ) }) self$resps <- vector("list", n) self$status <- rep("pending", n) self$tries <- rep(0L, n) }, process = function(timeout = Inf) { deadline <- unix_time() + timeout while (unix_time() <= deadline) { out <- self$process1(deadline) if (!is.null(out)) { return(out) } } TRUE }, # Exposed for testing, so we can manaully work through one step at a time process1 = function(deadline = Inf) { if (self$queue_status == "done") { return(FALSE) } if (!is.null(self$progress)) { cli::cli_progress_update(id = self$progress, set = self$n_complete) } if (self$queue_status == "waiting") { request_deadline <- max(self$token_deadline, self$rate_limit_deadline) if (request_deadline <= unix_time()) { self$queue_status <- "working" return() } if (self$rate_limit_deadline > self$token_deadline) { waiting <- "for rate limit" } else { waiting <- "for throttling" } 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) { self$queue_status <- "done" } else if (self$n_pending > 0 && self$n_active <= self$max_active) { if (!self$submit_next(deadline)) { self$queue_status <- "waiting" } } else { pool_wait_for_one(self$pool, deadline) } NULL } else if (self$queue_status == "errored") { # Finish out any active requests but don't add any more if (self$n_active > 0) { pool_wait_for_one(self$pool, deadline) } else { self$queue_status <- "done" } NULL } }, submit_next = function(deadline) { i <- which(self$status == "pending")[[1]] self$token_deadline <- throttle_deadline(self$reqs[[i]]) if (self$token_deadline > unix_time()) { throttle_return_token(self$reqs[[i]]) return(FALSE) } self$set_status(i, "active") self$resps[i] <- list(NULL) self$tries[[i]] <- self$tries[[i]] + 1 self$pooled_reqs[[i]]$submit(self$pool) TRUE }, done_success = function(i, resp) { self$set_status(i, "complete") self$resps[[i]] <- resp self$oauth_failed <- NULL }, done_error = function(i, error) { self$resps[[i]] <- error self$set_status(i, "complete") if (self$on_error != "continue") { self$queue_status <- "errored" } }, done_failure = function(i, error) { req <- self$reqs[[i]] resp <- error$resp self$resps[[i]] <- error tries <- self$tries[[i]] if (retry_is_transient(req, resp) && self$can_retry(i)) { delay <- retry_after(req, resp, tries) self$rate_limit_deadline <- unix_time() + delay self$set_status(i, "pending") self$n_retries <- self$n_retries + 1 self$queue_status <- "waiting" } else if (resp_is_invalid_oauth_token(req, resp) && self$can_reauth(i)) { # This isn't quite right, because if there are (e.g.) four requests in # the queue and the first one fails, we'll clear the cache for all four, # causing a token refresh more often than necessary. This shouldn't # affect correctness, but it does make it slower than necessary. self$oauth_failed <- c(self$oauth_failed, i) req_auth_clear_cache(self$reqs[[i]]) self$set_status(i, "pending") self$n_retries <- self$n_retries + 1 } else { self$set_status(i, "complete") if (self$on_error != "continue") { self$queue_status <- "errored" } } }, set_status = function(i, status) { switch( # old status self$status[[i]], pending = self$n_pending <- self$n_pending - 1, active = self$n_active <- self$n_active - 1 ) switch( # new status 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 ) self$status[[i]] <- status }, can_retry = function(i) { TRUE # self$tries[[i]] < retry_max_tries(self$reqs[[i]]) }, can_reauth = function(i) { !i %in% self$oauth_failed } ) ) pool_wait_for_one <- function(pool, deadline) { timeout <- deadline - unix_time() pool_wait(pool, poll = TRUE, timeout = timeout) } pool_wait_for_deadline <- function(pool, deadline, waiting_for) { now <- unix_time() timeout <- deadline - now if (timeout <= 0) { return(TRUE) } complete <- pool_wait(pool, poll = FALSE, timeout = timeout) # pool might finish early; we still want to wait out the full time remaining <- timeout - (unix_time() - now) if (remaining > 2) { # Use a progress bar sys_sleep(remaining, waiting_for) } else if (remaining > 0) { Sys.sleep(remaining) } complete } pool_wait <- function(pool, poll, timeout) { signal("", class = "httr2_pool_wait", timeout = timeout) done <- curl::multi_run(pool = pool, poll = poll, timeout = timeout) (done$success + done$error) > 0 || done$pending == 0 } #' Perform a list of requests in parallel #' #' @description #' `r lifecycle::badge("deprecated")` #' #' Please use [req_perform_parallel()] instead, and note: #' #' * `cancel_on_error = FALSE` is now `on_error = "continue"` #' * `cancel_on_error = TRUE` is now `on_error = "return"` #' #' @export #' @param cancel_on_error Should all pending requests be cancelled when you #' hit an error? Set this to `TRUE` to stop all requests as soon as you #' hit an error. Responses that were never performed be `NULL` in the result. #' @inheritParams req_perform_parallel #' @keywords internal multi_req_perform <- function( reqs, paths = NULL, pool = deprecated(), cancel_on_error = FALSE ) { lifecycle::deprecate_warn( "1.0.0", "multi_req_perform()", "req_perform_parallel()" ) check_bool(cancel_on_error) req_perform_parallel( reqs = reqs, paths = paths, pool = pool, on_error = if (cancel_on_error) "continue" else "return" ) } httr2/R/import-standalone-types-check.R0000644000176200001440000002761614556444037017546 0ustar liggesusers# Standalone file: do not edit by hand # Source: # ---------------------------------------------------------------------- # # --- # repo: r-lib/rlang # file: standalone-types-check.R # last-updated: 2023-03-13 # license: https://unlicense.org # dependencies: standalone-obj-type.R # imports: rlang (>= 1.1.0) # --- # # ## Changelog # # 2023-03-13: # - Improved error messages of number checkers (@teunbrand) # - Added `allow_infinite` argument to `check_number_whole()` (@mgirlich). # - Added `check_data_frame()` (@mgirlich). # # 2023-03-07: # - Added dependency on rlang (>= 1.1.0). # # 2023-02-15: # - Added `check_logical()`. # # - `check_bool()`, `check_number_whole()`, and # `check_number_decimal()` are now implemented in C. # # - For efficiency, `check_number_whole()` and # `check_number_decimal()` now take a `NULL` default for `min` and # `max`. This makes it possible to bypass unnecessary type-checking # and comparisons in the default case of no bounds checks. # # 2022-10-07: # - `check_number_whole()` and `_decimal()` no longer treat # non-numeric types such as factors or dates as numbers. Numeric # types are detected with `is.numeric()`. # # 2022-10-04: # - Added `check_name()` that forbids the empty string. # `check_string()` allows the empty string by default. # # 2022-09-28: # - Removed `what` arguments. # - Added `allow_na` and `allow_null` arguments. # - Added `allow_decimal` and `allow_infinite` arguments. # - Improved errors with absent arguments. # # # 2022-09-16: # - Unprefixed usage of rlang functions with `rlang::` to # avoid onLoad issues when called from rlang (#1482). # # 2022-08-11: # - Added changelog. # # nocov start # Scalars ----------------------------------------------------------------- .standalone_types_check_dot_call <- .Call check_bool <- function(x, ..., allow_na = FALSE, allow_null = FALSE, arg = caller_arg(x), call = caller_env()) { if (!missing(x) && .standalone_types_check_dot_call(ffi_standalone_is_bool_1.0.7, x, allow_na, allow_null)) { return(invisible(NULL)) } stop_input_type( x, c("`TRUE`", "`FALSE`"), ..., allow_na = allow_na, allow_null = allow_null, arg = arg, call = call ) } check_string <- function(x, ..., allow_empty = TRUE, allow_na = FALSE, allow_null = FALSE, arg = caller_arg(x), call = caller_env()) { if (!missing(x)) { is_string <- .rlang_check_is_string( x, allow_empty = allow_empty, allow_na = allow_na, allow_null = allow_null ) if (is_string) { return(invisible(NULL)) } } stop_input_type( x, "a single string", ..., allow_na = allow_na, allow_null = allow_null, arg = arg, call = call ) } .rlang_check_is_string <- function(x, allow_empty, allow_na, allow_null) { if (is_string(x)) { if (allow_empty || !is_string(x, "")) { return(TRUE) } } if (allow_null && is_null(x)) { return(TRUE) } if (allow_na && (identical(x, NA) || identical(x, na_chr))) { return(TRUE) } FALSE } check_name <- function(x, ..., allow_null = FALSE, arg = caller_arg(x), call = caller_env()) { if (!missing(x)) { is_string <- .rlang_check_is_string( x, allow_empty = FALSE, allow_na = FALSE, allow_null = allow_null ) if (is_string) { return(invisible(NULL)) } } stop_input_type( x, "a valid name", ..., allow_na = FALSE, allow_null = allow_null, arg = arg, call = call ) } IS_NUMBER_true <- 0 IS_NUMBER_false <- 1 IS_NUMBER_oob <- 2 check_number_decimal <- function(x, ..., min = NULL, max = NULL, allow_infinite = TRUE, allow_na = FALSE, allow_null = FALSE, arg = caller_arg(x), call = caller_env()) { if (missing(x)) { exit_code <- IS_NUMBER_false } else if (0 == (exit_code <- .standalone_types_check_dot_call( ffi_standalone_check_number_1.0.7, x, allow_decimal = TRUE, min, max, allow_infinite, allow_na, allow_null ))) { return(invisible(NULL)) } .stop_not_number( x, ..., exit_code = exit_code, allow_decimal = TRUE, min = min, max = max, allow_na = allow_na, allow_null = allow_null, arg = arg, call = call ) } check_number_whole <- function(x, ..., min = NULL, max = NULL, allow_infinite = FALSE, allow_na = FALSE, allow_null = FALSE, arg = caller_arg(x), call = caller_env()) { if (missing(x)) { exit_code <- IS_NUMBER_false } else if (0 == (exit_code <- .standalone_types_check_dot_call( ffi_standalone_check_number_1.0.7, x, allow_decimal = FALSE, min, max, allow_infinite, allow_na, allow_null ))) { return(invisible(NULL)) } .stop_not_number( x, ..., exit_code = exit_code, allow_decimal = FALSE, min = min, max = max, allow_na = allow_na, allow_null = allow_null, arg = arg, call = call ) } .stop_not_number <- function(x, ..., exit_code, allow_decimal, min, max, allow_na, allow_null, arg, call) { if (allow_decimal) { what <- "a number" } else { what <- "a whole number" } if (exit_code == IS_NUMBER_oob) { min <- min %||% -Inf max <- max %||% Inf if (min > -Inf && max < Inf) { what <- sprintf("%s between %s and %s", what, min, max) } else if (x < min) { what <- sprintf("%s larger than or equal to %s", what, min) } else if (x > max) { what <- sprintf("%s smaller than or equal to %s", what, max) } else { abort("Unexpected state in OOB check", .internal = TRUE) } } stop_input_type( x, what, ..., allow_na = allow_na, allow_null = allow_null, arg = arg, call = call ) } check_symbol <- function(x, ..., allow_null = FALSE, arg = caller_arg(x), call = caller_env()) { if (!missing(x)) { if (is_symbol(x)) { return(invisible(NULL)) } if (allow_null && is_null(x)) { return(invisible(NULL)) } } stop_input_type( x, "a symbol", ..., allow_na = FALSE, allow_null = allow_null, arg = arg, call = call ) } check_arg <- function(x, ..., allow_null = FALSE, arg = caller_arg(x), call = caller_env()) { if (!missing(x)) { if (is_symbol(x)) { return(invisible(NULL)) } if (allow_null && is_null(x)) { return(invisible(NULL)) } } stop_input_type( x, "an argument name", ..., allow_na = FALSE, allow_null = allow_null, arg = arg, call = call ) } check_call <- function(x, ..., allow_null = FALSE, arg = caller_arg(x), call = caller_env()) { if (!missing(x)) { if (is_call(x)) { return(invisible(NULL)) } if (allow_null && is_null(x)) { return(invisible(NULL)) } } stop_input_type( x, "a defused call", ..., allow_na = FALSE, allow_null = allow_null, arg = arg, call = call ) } check_environment <- function(x, ..., allow_null = FALSE, arg = caller_arg(x), call = caller_env()) { if (!missing(x)) { if (is_environment(x)) { return(invisible(NULL)) } if (allow_null && is_null(x)) { return(invisible(NULL)) } } stop_input_type( x, "an environment", ..., allow_na = FALSE, allow_null = allow_null, arg = arg, call = call ) } check_function <- function(x, ..., allow_null = FALSE, arg = caller_arg(x), call = caller_env()) { if (!missing(x)) { if (is_function(x)) { return(invisible(NULL)) } if (allow_null && is_null(x)) { return(invisible(NULL)) } } stop_input_type( x, "a function", ..., allow_na = FALSE, allow_null = allow_null, arg = arg, call = call ) } check_closure <- function(x, ..., allow_null = FALSE, arg = caller_arg(x), call = caller_env()) { if (!missing(x)) { if (is_closure(x)) { return(invisible(NULL)) } if (allow_null && is_null(x)) { return(invisible(NULL)) } } stop_input_type( x, "an R function", ..., allow_na = FALSE, allow_null = allow_null, arg = arg, call = call ) } check_formula <- function(x, ..., allow_null = FALSE, arg = caller_arg(x), call = caller_env()) { if (!missing(x)) { if (is_formula(x)) { return(invisible(NULL)) } if (allow_null && is_null(x)) { return(invisible(NULL)) } } stop_input_type( x, "a formula", ..., allow_na = FALSE, allow_null = allow_null, arg = arg, call = call ) } # Vectors ----------------------------------------------------------------- check_character <- function(x, ..., allow_null = FALSE, arg = caller_arg(x), call = caller_env()) { if (!missing(x)) { if (is_character(x)) { return(invisible(NULL)) } if (allow_null && is_null(x)) { return(invisible(NULL)) } } stop_input_type( x, "a character vector", ..., allow_na = FALSE, allow_null = allow_null, arg = arg, call = call ) } check_logical <- function(x, ..., allow_null = FALSE, arg = caller_arg(x), call = caller_env()) { if (!missing(x)) { if (is_logical(x)) { return(invisible(NULL)) } if (allow_null && is_null(x)) { return(invisible(NULL)) } } stop_input_type( x, "a logical vector", ..., allow_na = FALSE, allow_null = allow_null, arg = arg, call = call ) } check_data_frame <- function(x, ..., allow_null = FALSE, arg = caller_arg(x), call = caller_env()) { if (!missing(x)) { if (is.data.frame(x)) { return(invisible(NULL)) } if (allow_null && is_null(x)) { return(invisible(NULL)) } } stop_input_type( x, "a data frame", ..., allow_null = allow_null, arg = arg, call = call ) } # nocov end httr2/R/pooled-request.R0000644000176200001440000000603414761701552014624 0ustar liggesuserspooled_request <- function( req, path = NULL, on_success = NULL, on_failure = NULL, 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) check_function2(on_failure, args = "error", allow_null = TRUE) check_function2(on_error, args = "error", allow_null = TRUE) PooledRequest$new( req = req, path = path, error_call = error_call, on_success = on_success, on_failure = on_failure, on_error = on_error ) } # Wrap up all components of request -> response in a single object PooledRequest <- R6Class( "Performance", public = list( req = NULL, resp = NULL, initialize = function( req, path = NULL, error_call = NULL, on_success = NULL, on_failure = NULL, on_error = NULL ) { self$req <- req private$path <- path private$error_call <- error_call private$on_success <- on_success private$on_failure <- on_failure private$on_error <- on_error }, submit = function(pool) { req <- cache_pre_fetch(self$req, private$path) if (is_response(req)) { private$on_success(req) return() } private$req_prep <- req_prepare(req) private$handle <- req_handle(private$req_prep) curl::multi_add( handle = private$handle, pool = pool, data = private$path, done = private$succeed, fail = private$fail ) invisible(self) }, cancel = function() { # No handle if response was cached if (!is.null(private$handle)) { curl::multi_cancel(private$handle) } } ), private = list( path = NULL, error_call = NULL, pool = NULL, req_prep = NULL, handle = NULL, on_success = NULL, on_failure = NULL, on_error = NULL, # curl success could be httr2 success or httr2 failure succeed = function(curl_data) { private$handle <- NULL req_completed(private$req_prep) if (is.null(private$path)) { body <- curl_data$content } else { # Only needed with curl::multi_run() if (!file.exists(private$path)) { file.create(private$path) } body <- new_path(private$path) } resp <- create_response(self$req, curl_data, body) resp <- cache_post_fetch(self$req, resp, path = private$path) if (error_is_error(self$req, resp)) { cnd <- resp_failure_cnd(self$req, resp, error_call = private$error_call) private$on_failure(cnd) } else { private$on_success(resp) } }, # curl failure = httr2 error fail = function(msg) { private$handle <- NULL req_completed(private$req_prep) error_class <- setdiff(class(msg), "character") curl_error <- error_cnd(message = msg, class = error_class, call = NULL) error <- curl_cnd(curl_error, call = private$error_call) error$request <- self$req private$on_error(error) } ) ) httr2/R/parse.R0000644000176200001440000000437714565167154013004 0ustar liggesusersparse_media <- function(x) { # https://datatracker.ietf.org/doc/html/rfc2616#section-3.7 pieces <- parse_delim(x, ";") if (is_empty(pieces)) { list(type = NA_character_) } else { params <- parse_name_equals_value(pieces[-1]) c(list(type = pieces[[1]]), params) } } parse_www_authenticate <- function(x) { # Seems little general support for multiple schemes in one header # https://stackoverflow.com/questions/10239970 pieces <- parse_in_half(x, " ") params <- parse_name_equals_value(parse_delim(pieces$right, ",")) c(list(scheme = pieces$left), params) } parse_link <- function(x) { links <- parse_delim(x, ",") parse_one <- function(x) { pieces <- parse_delim(x, ";") url <- gsub("^<|>$", "", pieces[[1]]) params <- parse_name_equals_value(pieces[-1]) c(list(url = url), params) } lapply(links, parse_one) } # Helpers ----------------------------------------------------------------- parse_delim <- function(x, delim, quote = "\"", ...) { # Use scan to deal with quoted strings. It loses the quotes, but it's # ok because the field name can't be a quoted string so there's no ambiguity # about who the = belongs to. scan( text = x, what = character(), sep = delim, quote = quote, quiet = TRUE, strip.white = TRUE, ... ) } parse_name_equals_value <- function(x) { halves <- parse_in_half(x, "=") set_names(halves$right, halves$left) } parse_in_half <- function(x, char = "=") { match <- regexpr(char, x, fixed = TRUE) match_loc <- as.vector(match) match_len <- attr(match, "match.length") left_start <- 1 left_end <- match_loc - 1 right_start <- match_loc + match_len right_end <- nchar(x) no_match <- match_loc == -1 left_end[no_match] <- right_end[no_match] right_start[no_match] <- 0 right_end[no_match] <- 0 list( left = substr(x, left_start, left_end), right = substr(x, right_start, right_end) ) } parse_match <- function(x, pattern) { match_loc <- regexpr(pattern, x, perl = TRUE) cap_start <- attr(match_loc, "capture.start") cap_len <- attr(match_loc, "capture.length") cap_end <- cap_start + cap_len - 1 cap_end[cap_end == -1] <- 0 pieces <- as.list(substring(x, cap_start, cap_end)) pieces[pieces == ""] <- list(NULL) pieces } httr2/R/resp-request.R0000644000176200001440000000062514737043664014321 0ustar liggesusers#' Find the request responsible for a response #' #' To make debugging easier, httr2 includes the request that was used to #' generate every response. You can use this function to access it. #' #' @inheritParams resp_header #' @export #' @examples #' req <- request(example_url()) #' resp <- req_perform(req) #' resp_request(resp) resp_request <- function(resp) { check_response(resp) resp$request } httr2/R/iterate-helpers.R0000644000176200001440000001025214751443447014753 0ustar liggesusers#' Iteration helpers #' #' @description #' These functions are intended for use with the `next_req` argument to #' [req_perform_iterative()]. Each implements iteration for a common #' pagination pattern: #' #' * `iterate_with_offset()` increments a query parameter, e.g. `?page=1`, #' `?page=2`, or `?offset=1`, `offset=21`. #' * `iterate_with_cursor()` updates a query parameter with the value of a #' cursor found somewhere in the response. #' * `iterate_with_link_url()` follows the url found in the `Link` header. #' See `resp_link_url()` for more details. #' #' @param param_name Name of query parameter. #' @param start Starting value. #' @param offset Offset for each page. The default is set to `1` so you get #' (e.g.) `?page=1`, `?page=2`, ... If `param_name` refers to an element #' index (rather than a page index) you'll want to set this to a larger number #' so you get (e.g.) `?items=20`, `?items=40`, ... #' @param resp_complete A callback function that takes a response (`resp`) #' and returns `TRUE` if there are no further pages. #' @param resp_pages A callback function that takes a response (`resp`) and #' returns the total number of pages, or `NULL` if unknown. It will only #' be called once. #' @export #' @examples #' req <- request(example_url()) |> #' req_url_path("/iris") |> #' req_throttle(10) |> #' req_url_query(limit = 50) #' #' # If you don't know the total number of pages in advance, you can #' # provide a `resp_complete()` callback #' is_complete <- function(resp) { #' length(resp_body_json(resp)$data) == 0 #' } #' resps <- req_perform_iterative( #' req, #' next_req = iterate_with_offset("page_index", resp_complete = is_complete), #' max_reqs = Inf #' ) #' #' \dontrun{ #' # Alternatively, if the response returns the total number of pages (or you #' # can easily calculate it), you can use the `resp_pages()` callback which #' # will generate a better progress bar. #' #' resps <- req_perform_iterative( #' req |> req_url_query(limit = 1), #' next_req = iterate_with_offset( #' "page_index", #' resp_pages = function(resp) resp_body_json(resp)$pages #' ), #' max_reqs = Inf #' ) #' } 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) check_function2(resp_pages, args = "resp", allow_null = TRUE) check_function2(resp_complete, args = "resp", allow_null = TRUE) resp_complete <- resp_complete %||% function(resp) FALSE known_total <- FALSE i <- start # assume already fetched first page function(resp, req) { if (!is.null(resp_pages) && !known_total) { n <- resp_pages(resp) if (!is.null(n)) { known_total <<- TRUE signal_total_pages(n) } } if (!isTRUE(resp_complete(resp))) { i <<- i + offset req %>% req_url_query(!!param_name := i) } } } #' @rdname iterate_with_offset #' @export #' @param resp_param_value A callback function that takes a response (`resp`) #' and returns the next cursor value. Return `NULL` if there are no further #' pages. iterate_with_cursor <- function(param_name, resp_param_value) { check_string(param_name) check_function2(resp_param_value, args = "resp") function(resp, req) { value <- resp_param_value(resp) if (!is.null(value)) { req %>% req_url_query(!!param_name := value) } } } #' @rdname iterate_with_offset #' @export #' @param rel The "link relation type" to use to retrieve the next page. iterate_with_link_url <- function(rel = "next") { check_string(rel) function(resp, req) { url <- resp_link_url(resp, rel) if (!is.null(url)) { req %>% req_url(url) } } } #' Signal total number pages #' #' To be called within a `next_req` callback function used with #' [req_perform_iterative()] #' #' @param n Total number of pages. #' @export #' @keywords internal signal_total_pages <- function(n) { if (is.null(n)) { return() } check_number_whole(n, min = 1) signal("", class = "httr2_total_pages", n = n) } httr2/R/oauth-flow-refresh.R0000644000176200001440000000525414666617042015404 0ustar liggesusers#' OAuth with a refresh token #' #' @description #' Authenticate using a **refresh token**, following the process described in #' `r rfc(6749, 6)`. #' #' This technique is primarily useful for testing: you can manually retrieve #' a OAuth token using another OAuth flow (e.g. with [oauth_flow_auth_code()]), #' extract the refresh token from the result, and then save in an environment #' variable for use in automated tests. #' #' When requesting an access token, the server may also return a new refresh #' token. If this happens, `oauth_flow_refresh()` will warn, and you'll have #' retrieve a new update refresh token and update the stored value. If you find #' this happening a lot, it's a sign that you should be using a different flow #' in your automated tests. #' #' Learn more about the overall OAuth authentication flow in #' . #' #' @inheritParams req_oauth_auth_code #' @param refresh_token A refresh token. This is equivalent to a password #' so shouldn't be typed into the console or stored in a script. Instead, #' we recommend placing in an environment variable; the default behaviour #' is to look in `HTTR2_REFRESH_TOKEN`. #' @returns `req_oauth_refresh()` returns a modified HTTP [request] that will #' use OAuth; `oauth_flow_refresh()` returns an [oauth_token]. #' @family OAuth flows #' @export #' @examples #' 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()) { params <- list( client = client, refresh_token = refresh_token, scope = scope, token_params = token_params ) cache <- cache_mem(client, refresh_token) req_oauth(req, "oauth_flow_refresh", params, cache = cache) } #' @export #' @rdname req_oauth_refresh 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, refresh_token = refresh_token, scope = scope, token_params = token_params ) # Should generally do this automatically, but in this workflow the token will # often be stored in an env var or similar if (!is.null(token$refresh_token) && token$refresh_token != refresh_token) { warn("Refresh token has changed! Please update stored value") } token } httr2/R/req-error.R0000644000176200001440000001044614753377565013612 0ustar liggesusers#' Control handling of HTTP errors #' #' `req_perform()` will automatically convert HTTP errors (i.e. any 4xx or 5xx #' status code) into R errors. Use `req_error()` to either override the #' defaults, or extract additional information from the response that would #' be useful to expose to the user. #' #' # Error handling #' #' `req_perform()` is designed to succeed if and only if you get a valid HTTP #' response. There are two ways a request can fail: #' #' * The HTTP request might fail, for example if the connection is dropped #' or the server doesn't exist. This type of error will have class #' `c("httr2_failure", "httr2_error")`. #' #' * The HTTP request might succeed, but return an HTTP status code that #' represents an error, e.g. a `404 Not Found` if the specified resource is #' not found. This type of error will have (e.g.) class #' `c("httr2_http_404", "httr2_http", "httr2_error")`. #' #' These error classes are designed to be used in conjunction with R's #' condition handling tools (). #' For example, if you want to return a default value when the server returns #' a 404, use `tryCatch()`: #' #' ``` #' tryCatch( #' req |> req_perform() |> resp_body_json(), #' httr2_http_404 = function(cnd) NULL #' ) #' ``` #' #' Or if you want to re-throw the error with some additional context, use #' `withCallingHandlers()`, e.g.: #' #' ```R #' withCallingHandlers( #' req |> req_perform() |> resp_body_json(), #' httr2_http_404 = function(cnd) { #' rlang::abort("Couldn't find user", parent = cnd) #' } #' ) #' ``` #' #' Learn more about error chaining at [rlang::topic-error-chaining]. #' #' @seealso [req_retry()] to control when errors are automatically retried. #' @inheritParams req_perform #' @param is_error A predicate function that takes a single argument (the #' response) and returns `TRUE` or `FALSE` indicating whether or not an #' R error should be signalled. #' @param body A callback function that takes a single argument (the response) #' and returns a character vector of additional information to include in the #' body of the error. This vector is passed along to the `message` argument #' of [rlang::abort()] so you can use any formatting that it supports. #' @returns A modified HTTP [request]. #' @export #' @examples #' # Performing this request usually generates an error because httr2 #' # converts HTTP errors into R errors: #' req <- request(example_url()) |> #' req_url_path("/status/404") #' try(req |> req_perform()) #' # You can still retrieve it with last_response() #' last_response() #' #' # But you might want to suppress this behaviour: #' resp <- req |> #' req_error(is_error = \(resp) FALSE) |> #' req_perform() #' resp #' #' # Or perhaps you're working with a server that routinely uses the #' # wrong HTTP error codes only 500s are really errors #' request("http://example.com") |> #' req_error(is_error = \(resp) resp_status(resp) == 500) #' #' # Most typically you'll use req_error() to add additional information #' # extracted from the response body (or sometimes header): #' error_body <- function(resp) { #' resp_body_json(resp)$error #' } #' 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) { check_request(req) req_policies( req, error_is_error = as_callback(is_error, 1, "is_error"), error_body = as_callback(body, 1, "body") ) } error_is_error <- function(req, resp) { req_policy_call(req, "error_is_error", list(resp), default = resp_is_error) } error_body <- function(req, resp, call = caller_env()) { try_fetch( req_policy_call(req, "error_body", list(resp), default = NULL), error = function(cnd) { cli::cli_abort( "Failed to parse error body with method defined in {.fn req_error}.", parent = cnd, call = call ) } ) } capture_curl_error <- function(code, call = caller_env()) { resp <- tryCatch( code, error = function(err) curl_cnd(err, call = call) ) } curl_cnd <- function(err, call = caller_env()) { error_cnd( message = "Failed to perform HTTP request.", class = c("httr2_failure", "httr2_error"), parent = err, call = call ) } httr2/R/resp-url.R0000644000176200001440000000213514737047606013431 0ustar liggesusers#' Get URL/components from the response #' #' * `resp_url()` returns the complete url. #' * `resp_url_path()` returns the path component. #' * `resp_url_query()` returns a single query component. #' * `resp_url_queries()` returns the query component as a named list. #' #' @inheritParams resp_header #' @export #' @examples #' resp <- request(example_url()) |> #' req_url_path("/get?hello=world") |> #' req_perform() #' #' resp |> resp_url() #' resp |> resp_url_path() #' resp |> resp_url_queries() #' resp |> resp_url_query("hello") resp_url <- function(resp) { check_response(resp) resp$url } #' @export #' @rdname resp_url resp_url_path <- function(resp) { check_response(resp) url_parse(resp$url)$path } #' @export #' @rdname resp_url #' @param name Query parameter name. #' @param default Default value to use if query parameter doesn't exist. resp_url_query <- function(resp, name, default = NULL) { check_response(resp) resp_url_queries(resp)[[name]] %||% default } #' @export #' @rdname resp_url resp_url_queries <- function(resp) { check_response(resp) url_parse(resp$url)$query } httr2/R/req-cookies.R0000644000176200001440000000433214737047606014102 0ustar liggesusers#' Set and preserve cookies #' #' @description #' Use `req_cookie_set()` to set client side cookies that are sent to the #' server. #' #' By default, httr2 uses a clean slate for every request meaning that cookies #' are not automatically preserved across requests. To preserve cookies, use #' `req_cookie_preserve()` along with the path to cookie file that will be #' read before and updated after each request. #' #' @inheritParams req_perform #' @param path A path to a file where cookies will be read from before and updated after the request. #' @export #' @examples #' # Use `req_cookies_set()` to set client-side cookies #' request(example_url()) |> #' req_cookies_set(a = 1, b = 1) |> #' req_dry_run() #' #' # Use `req_cookie_preserve()` to preserve server-side cookies across requests #' path <- tempfile() #' #' # Set a server-side cookie #' request(example_url()) |> #' req_cookie_preserve(path) |> #' req_template("/cookies/set/:name/:value", name = "chocolate", value = "chip") |> #' req_perform() |> #' resp_body_json() #' #' # Set another sever-side cookie #' request(example_url()) |> #' req_cookie_preserve(path) |> #' req_template("/cookies/set/:name/:value", name = "oatmeal", value = "raisin") |> #' req_perform() |> #' resp_body_json() #' #' # Add a client side cookie #' request(example_url()) |> #' req_url_path("/cookies/set") |> #' req_cookie_preserve(path) |> #' req_cookies_set(snicker = "doodle") |> #' req_perform() |> #' resp_body_json() #' #' # The cookie path has a straightforward format #' cat(readChar(path, nchars = 1e4)) req_cookie_preserve <- function(req, path) { check_request(req) check_string(path, allow_empty = FALSE) req_options(req, cookiejar = path, cookiefile = path) } #' @export #' @rdname req_cookie_preserve #' @param ... <[`dynamic-dots`][rlang::dyn-dots]> #' Name-value pairs that define query parameters. Each value must be #' an atomic vector, which is automatically escaped. To opt-out of escaping, #' wrap strings in `I()`. req_cookies_set <- function(req, ...) { check_request(req) req_options(req, cookie = cookies_build(list2(...))) } cookies_build <- function(x, error_call = caller_env()) { elements_build(x, "Cookies", ";", error_call = error_call) } httr2/R/utils-pipe.R0000644000176200001440000000055314513302030013726 0ustar liggesusers#' Pipe operator #' #' See \code{magrittr::\link[magrittr:pipe]{\%>\%}} for details. #' #' @name %>% #' @rdname pipe #' @keywords internal #' @export #' @importFrom magrittr %>% #' @usage lhs \%>\% rhs #' @param lhs A value or the magrittr placeholder. #' @param rhs A function call using the magrittr semantics. #' @return The result of calling `rhs(lhs)`. NULL httr2/R/iterate-responses.R0000644000176200001440000000430114737312513015321 0ustar liggesusers#' Tools for working with lists of responses #' #' @description #' These function provide a basic toolkit for operating with lists of #' responses and possibly errors, as returned by [req_perform_parallel()], #' [req_perform_sequential()] and [req_perform_iterative()]. #' #' * `resps_successes()` returns a list successful responses. #' * `resps_failures()` returns a list failed responses (i.e. errors). #' * `resps_requests()` returns the list of requests that corresponds to #' each request. #' * `resps_data()` returns all the data in a single vector or data frame. #' It requires the vctrs package to be installed. #' #' @export #' @param resps A list of responses (possibly including errors). #' @param resp_data A function that takes a response (`resp`) and #' returns the data found inside that response as a vector or data frame. #' #' NB: If you're using [resp_body_raw()], you're likely to want to wrap its #' output in `list()` to avoid combining all the bodies into a single raw #' vector, e.g. `resps |> resps_data(\(resp) list(resp_body_raw(resp)))`. #' #' @examples #' reqs <- list( #' request(example_url()) |> req_url_path("/ip"), #' request(example_url()) |> req_url_path("/user-agent"), #' request(example_url()) |> req_template("/status/:status", status = 404), #' request("INVALID") #' ) #' resps <- req_perform_parallel(reqs, on_error = "continue") #' #' # find successful responses #' resps |> resps_successes() #' #' # collect all their data #' resps |> #' resps_successes() |> #' resps_data(\(resp) resp_body_json(resp)) #' #' # find requests corresponding to failure responses #' resps |> #' resps_failures() |> #' resps_requests() resps_successes <- function(resps) { resps[resps_ok(resps)] } #' @export #' @rdname resps_successes resps_failures <- function(resps) { resps[!resps_ok(resps)] } resps_ok <- function(resps) { vapply(resps, is_response, logical(1)) } #' @export #' @rdname resps_successes resps_requests <- function(resps) { lapply(resps, function(x) x$request) } #' @export #' @rdname resps_successes resps_data <- function(resps, resp_data) { check_installed("vctrs") check_function2(resp_data, "resp") vctrs::list_unchop(lapply(resps, resp_data)) } httr2/R/is-online.R0000644000176200001440000000050414737312513013543 0ustar liggesusers#' Is your computer currently online? #' #' This function uses some cheap heuristics to determine if your computer is #' currently online. It's a simple wrapper around [curl::has_internet()] #' exported from httr2 for convenience. #' #' @export #' @examples #' is_online() is_online <- function() { curl::has_internet() } httr2/R/oauth-flow-token-exchange.R0000644000176200001440000001152214715443111016626 0ustar liggesusers#' OAuth token exchange #' #' @description #' Authenticate by exchanging one security token for another, as defined by #' `r rfc(8693, 2)`. It is typically used for advanced authorization flows that #' involve "delegation" or "impersonation" semantics, such as when a client #' accesses a resource on behalf of another party, or when a client's identity #' is federated from another provider. #' #' Learn more about the overall OAuth authentication flow in #' . #' #' @export #' @family OAuth flows #' @inheritParams req_perform #' @inheritParams req_oauth_auth_code #' @param subject_token The security token to exchange. This is usually an #' OpenID Connect ID token or a SAML2 assertion. #' @param subject_token_type A URI that describes the type of the security #' token. Usually one of the options in `r rfc(8693, 3)`. #' @param resource The URI that identifies the resource that the client is #' trying to access, if applicable. #' @param audience The logical name that identifies the resource that the client #' is trying to access, if applicable. Usually one of `resource` or `audience` #' must be supplied. #' @param requested_token_type An optional URI that describes the type of the #' security token being requested. Usually one of the options in #' `r rfc(8693, 3)`. #' @param actor_token An optional security token that represents the client, #' rather than the identity behind the subject token. #' @param actor_token_type When `actor_token` is not `NULL`, this must be the #' URI that describes the type of the security token being requested. Usually #' one of the options in `r rfc(8693, 3)`. #' @returns `req_oauth_token_exchange()` returns a modified HTTP [request] that #' will exchange one security token for another; `oauth_flow_token_exchange()` #' returns the resulting [oauth_token] directly. #' #' @examples #' # List Google Cloud storage buckets using an OIDC token obtained #' # from e.g. Microsoft Entra ID or Okta and federated to Google. (A real #' # project ID and workforce pool would be required for this in practice.) #' # #' # See: https://cloud.google.com/iam/docs/workforce-obtaining-short-lived-credentials #' oidc_token <- "an ID token from Okta" #' request("https://storage.googleapis.com/storage/v1/b?project=123456") |> #' req_oauth_token_exchange( #' client = oauth_client("gcp", "https://sts.googleapis.com/v1/token"), #' subject_token = oidc_token, #' subject_token_type = "urn:ietf:params:oauth:token-type:id_token", #' scope = "https://www.googleapis.com/auth/cloud-platform", #' requested_token_type = "urn:ietf:params:oauth:token-type:access_token", #' audience = "//iam.googleapis.com/locations/global/workforcePools/123/providers/456", #' token_params = list( #' 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()) { params <- list( client = client, subject_token = subject_token, subject_token_type = subject_token_type, resource = resource, audience = audience, scope = scope, requested_token_type = requested_token_type, actor_token = actor_token, actor_token_type = actor_token_type, token_params = token_params ) cache <- cache_mem(client, NULL) req_oauth(req, "oauth_flow_token_exchange", params, cache = cache) } #' @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_client_get_token( client, grant_type = "urn:ietf:params:oauth:grant-type:token-exchange", subject_token = subject_token, subject_token_type = subject_token_type, resource = resource, audience = audience, scope = scope, requested_token_type = requested_token_type, actor_token = actor_token, actor_token_type = actor_token_type, !!!token_params ) } httr2/R/import-standalone-obj-type.R0000644000176200001440000002072714556444037017054 0ustar liggesusers# Standalone file: do not edit by hand # Source: # ---------------------------------------------------------------------- # # --- # repo: r-lib/rlang # file: standalone-obj-type.R # last-updated: 2023-05-01 # license: https://unlicense.org # imports: rlang (>= 1.1.0) # --- # # ## Changelog # # 2023-05-01: # - `obj_type_friendly()` now only displays the first class of S3 objects. # # 2023-03-30: # - `stop_input_type()` now handles `I()` input literally in `arg`. # # 2022-10-04: # - `obj_type_friendly(value = TRUE)` now shows numeric scalars # literally. # - `stop_friendly_type()` now takes `show_value`, passed to # `obj_type_friendly()` as the `value` argument. # # 2022-10-03: # - Added `allow_na` and `allow_null` arguments. # - `NULL` is now backticked. # - Better friendly type for infinities and `NaN`. # # 2022-09-16: # - Unprefixed usage of rlang functions with `rlang::` to # avoid onLoad issues when called from rlang (#1482). # # 2022-08-11: # - Prefixed usage of rlang functions with `rlang::`. # # 2022-06-22: # - `friendly_type_of()` is now `obj_type_friendly()`. # - Added `obj_type_oo()`. # # 2021-12-20: # - Added support for scalar values and empty vectors. # - Added `stop_input_type()` # # 2021-06-30: # - Added support for missing arguments. # # 2021-04-19: # - Added support for matrices and arrays (#141). # - Added documentation. # - Added changelog. # # nocov start #' Return English-friendly type #' @param x Any R object. #' @param value Whether to describe the value of `x`. Special values #' like `NA` or `""` are always described. #' @param length Whether to mention the length of vectors and lists. #' @return A string describing the type. Starts with an indefinite #' article, e.g. "an integer vector". #' @noRd obj_type_friendly <- function(x, value = TRUE) { if (is_missing(x)) { return("absent") } if (is.object(x)) { if (inherits(x, "quosure")) { type <- "quosure" } else { type <- class(x)[[1L]] } return(sprintf("a <%s> object", type)) } if (!is_vector(x)) { return(.rlang_as_friendly_type(typeof(x))) } n_dim <- length(dim(x)) if (!n_dim) { if (!is_list(x) && length(x) == 1) { if (is_na(x)) { return(switch( typeof(x), logical = "`NA`", integer = "an integer `NA`", double = if (is.nan(x)) { "`NaN`" } else { "a numeric `NA`" }, complex = "a complex `NA`", character = "a character `NA`", .rlang_stop_unexpected_typeof(x) )) } show_infinites <- function(x) { if (x > 0) { "`Inf`" } else { "`-Inf`" } } str_encode <- function(x, width = 30, ...) { if (nchar(x) > width) { x <- substr(x, 1, width - 3) x <- paste0(x, "...") } encodeString(x, ...) } if (value) { if (is.numeric(x) && is.infinite(x)) { return(show_infinites(x)) } if (is.numeric(x) || is.complex(x)) { number <- as.character(round(x, 2)) what <- if (is.complex(x)) "the complex number" else "the number" return(paste(what, number)) } return(switch( typeof(x), logical = if (x) "`TRUE`" else "`FALSE`", character = { what <- if (nzchar(x)) "the string" else "the empty string" paste(what, str_encode(x, quote = "\"")) }, raw = paste("the raw value", as.character(x)), .rlang_stop_unexpected_typeof(x) )) } return(switch( typeof(x), logical = "a logical value", integer = "an integer", double = if (is.infinite(x)) show_infinites(x) else "a number", complex = "a complex number", character = if (nzchar(x)) "a string" else "\"\"", raw = "a raw value", .rlang_stop_unexpected_typeof(x) )) } if (length(x) == 0) { return(switch( typeof(x), logical = "an empty logical vector", integer = "an empty integer vector", double = "an empty numeric vector", complex = "an empty complex vector", character = "an empty character vector", raw = "an empty raw vector", list = "an empty list", .rlang_stop_unexpected_typeof(x) )) } } vec_type_friendly(x) } vec_type_friendly <- function(x, length = FALSE) { if (!is_vector(x)) { abort("`x` must be a vector.") } type <- typeof(x) n_dim <- length(dim(x)) add_length <- function(type) { if (length && !n_dim) { paste0(type, sprintf(" of length %s", length(x))) } else { type } } if (type == "list") { if (n_dim < 2) { return(add_length("a list")) } else if (is.data.frame(x)) { return("a data frame") } else if (n_dim == 2) { return("a list matrix") } else { return("a list array") } } type <- switch( type, logical = "a logical %s", integer = "an integer %s", numeric = , double = "a double %s", complex = "a complex %s", character = "a character %s", raw = "a raw %s", type = paste0("a ", type, " %s") ) if (n_dim < 2) { kind <- "vector" } else if (n_dim == 2) { kind <- "matrix" } else { kind <- "array" } out <- sprintf(type, kind) if (n_dim >= 2) { out } else { add_length(out) } } .rlang_as_friendly_type <- function(type) { switch( type, list = "a list", NULL = "`NULL`", environment = "an environment", externalptr = "a pointer", weakref = "a weak reference", S4 = "an S4 object", name = , symbol = "a symbol", language = "a call", pairlist = "a pairlist node", expression = "an expression vector", char = "an internal string", promise = "an internal promise", ... = "an internal dots object", any = "an internal `any` object", bytecode = "an internal bytecode object", primitive = , builtin = , special = "a primitive function", closure = "a function", type ) } .rlang_stop_unexpected_typeof <- function(x, call = caller_env()) { abort( sprintf("Unexpected type <%s>.", typeof(x)), call = call ) } #' Return OO type #' @param x Any R object. #' @return One of `"bare"` (for non-OO objects), `"S3"`, `"S4"`, #' `"R6"`, or `"R7"`. #' @noRd obj_type_oo <- function(x) { if (!is.object(x)) { return("bare") } class <- inherits(x, c("R6", "R7_object"), which = TRUE) if (class[[1]]) { "R6" } else if (class[[2]]) { "R7" } else if (isS4(x)) { "S4" } else { "S3" } } #' @param x The object type which does not conform to `what`. Its #' `obj_type_friendly()` is taken and mentioned in the error message. #' @param what The friendly expected type as a string. Can be a #' character vector of expected types, in which case the error #' message mentions all of them in an "or" enumeration. #' @param show_value Passed to `value` argument of `obj_type_friendly()`. #' @param ... Arguments passed to [abort()]. #' @inheritParams args_error_context #' @noRd stop_input_type <- function(x, what, ..., allow_na = FALSE, allow_null = FALSE, show_value = TRUE, arg = caller_arg(x), call = caller_env()) { # From standalone-cli.R cli <- env_get_list( nms = c("format_arg", "format_code"), last = topenv(), default = function(x) sprintf("`%s`", x), inherit = TRUE ) if (allow_na) { what <- c(what, cli$format_code("NA")) } if (allow_null) { what <- c(what, cli$format_code("NULL")) } if (length(what)) { what <- oxford_comma(what) } if (inherits(arg, "AsIs")) { format_arg <- identity } else { format_arg <- cli$format_arg } message <- sprintf( "%s must be %s, not %s.", format_arg(arg), what, obj_type_friendly(x, value = show_value) ) abort(message, ..., call = call, arg = arg) } oxford_comma <- function(chr, sep = ", ", final = "or") { n <- length(chr) if (n < 2) { return(chr) } head <- chr[seq_len(n - 1)] last <- chr[n] head <- paste(head, collapse = sep) # Write a or b. But a, b, or c. if (n > 2) { paste0(head, sep, final, " ", last) } else { paste0(head, " ", final, " ", last) } } # nocov end httr2/R/resp-status.R0000644000176200001440000001135114752760573014154 0ustar liggesusers#' Extract HTTP status from response #' #' @description #' * `resp_status()` retrieves the numeric HTTP status code #' * `resp_status_desc()` retrieves the brief textual description. #' * `resp_is_error()` returns `TRUE` if the status code represents an error #' (i.e. a 4xx or 5xx status). #' * `resp_check_status()` turns HTTPs errors into R errors. #' #' These functions are mostly for internal use because in most cases you #' will only ever see a 200 response: #' #' * 1xx are handled internally by curl. #' * 3xx redirects are automatically followed. You will only see them if you #' have deliberately suppressed redirects with #' `req |> req_options(followlocation = FALSE)`. #' * 4xx client and 5xx server errors are automatically turned into R errors. #' You can stop them from being turned into R errors with [req_error()], #' e.g. `req |> req_error(is_error = ~ FALSE)`. #' #' @return #' * `resp_status()` returns a scalar integer #' * `resp_status_desc()` returns a string #' * `resp_is_error()` returns `TRUE` or `FALSE` #' * `resp_check_status()` invisibly returns the response if it's ok; #' otherwise it throws an error with class `httr2_http_{status}`. #' @inheritParams resp_headers #' @export #' @examples #' # An HTTP status code you're unlikely to see in the wild: #' resp <- response(418) #' resp |> resp_is_error() #' resp |> resp_status() #' resp |> resp_status_desc() resp_status <- function(resp) { check_response(resp) resp$status_code } #' @export #' @rdname resp_status resp_status_desc <- function(resp) { check_response(resp) status <- resp_status(resp) if (status %in% names(http_statuses)) { http_statuses[[as.character(status)]] } else { NA_character_ } } #' @export #' @rdname resp_status resp_is_error <- function(resp) { check_response(resp) resp_status(resp) >= 400 } #' @export #' @param info A character vector of additional information to include in #' the error message. Passed to [rlang::abort()]. #' @inheritParams rlang::args_error_context #' @rdname resp_status resp_check_status <- function(resp, info = NULL, error_call = caller_env()) { check_response(resp) if (!resp_is_error(resp)) { invisible(resp) } else { cnd <- resp_failure_cnd(resp$request, resp, error_call = error_call) cnd_signal(cnd) } } # https://developer.mozilla.org/en-US/docs/Web/HTTP/Status http_statuses <- c( "100" = "Continue", "101" = "Switching Protocols", "102" = "Processing", "103" = "Early Hints", "200" = "OK", "201" = "Created", "202" = "Accepted", "203" = "Non-Authoritative Information", "204" = "No Content", "205" = "Reset Content", "206" = "Partial Content", "207" = "Multi-Status", "208" = "Already Reported", "226" = "IM Used", "300" = "Multiple Choice", "301" = "Moved Permanently", "302" = "Found", "303" = "See Other", "304" = "Not Modified", "305" = "Use Proxy", "307" = "Temporary Redirect", "308" = "Permanent Redirect", "400" = "Bad Request", "401" = "Unauthorized", "402" = "Payment Required", "403" = "Forbidden", "404" = "Not Found", "405" = "Method Not Allowed", "406" = "Not Acceptable", "407" = "Proxy Authentication Required", "408" = "Request Timeout", "409" = "Conflict", "410" = "Gone", "411" = "Length Required", "412" = "Precondition Failed", "413" = "Payload Too Large", "414" = "URI Too Long", "415" = "Unsupported Media Type", "416" = "Range Not Satisfiable", "417" = "Expectation Failed", "418" = "I'm a teapot", "421" = "Misdirected Request", "422" = "Unprocessable Entity", "423" = "Locked", "424" = "Failed Dependency", "425" = "Too Early", "426" = "Upgrade Required", "428" = "Precondition Required", "429" = "Too Many Requests", "451" = "Unavailable For Legal Reasons", "500" = "Internal Server Error", "501" = "Not Implemented", "502" = "Bad Gateway", "503" = "Service Unavailable", "504" = "Gateway Timeout", "505" = "HTTP Version Not Supported", "506" = "Variant Also Negotiates", "507" = "Insufficient Storage", "508" = "Loop Detected", "510" = "Not Extended", "511" = "Network Authentication Required" ) resp_auth_message <- function(resp) { # https://datatracker.ietf.org/doc/html/rfc6750#page-9 www_auth <- resp_header(resp, "WWW-Authenticate") if (is.null(www_auth)) { return(NULL) } www_auth <- parse_www_authenticate(www_auth) if (www_auth$scheme != "Bearer") { return(NULL) } if (has_name(www_auth, "error")) { msg <- glue("OAuth error: {www_auth$error}") if (has_name(www_auth, "error_description")) { msg <- paste0(msg, " - ", www_auth$error_description) } } else { msg <- "OAuth error" } non_error <- www_auth[!grepl("^error|^scheme$", names(www_auth))] msg <- c(msg, paste0(names(non_error), ": ", non_error)) msg } httr2/R/resp-body.R0000644000176200001440000001042014666312277013560 0ustar liggesusers#' Extract body from response #' #' @description #' * `resp_body_raw()` returns the raw bytes. #' * `resp_body_string()` returns a UTF-8 string. #' * `resp_body_json()` returns parsed JSON. #' * `resp_body_html()` returns parsed HTML. #' * `resp_body_xml()` returns parsed XML. #' * `resp_has_body()` returns `TRUE` if the response has a body. #' #' `resp_body_json()` and `resp_body_xml()` check that the content-type header #' is correct; if the server returns an incorrect type you can suppress the #' check with `check_type = FALSE`. These two functions also cache the parsed #' object so the second and subsequent calls are low-cost. #' #' @inheritParams resp_headers #' @returns #' * `resp_body_raw()` returns a raw vector. #' * `resp_body_string()` returns a string. #' * `resp_body_json()` returns NULL, an atomic vector, or list. #' * `resp_body_html()` and `resp_body_xml()` return an `xml2::xml_document` #' @export #' @examples #' resp <- request("https://httr2.r-lib.org") |> req_perform() #' resp #' #' resp |> resp_has_body() #' resp |> resp_body_raw() #' resp |> resp_body_string() #' #' if (requireNamespace("xml2", quietly = TRUE)) { #' resp |> resp_body_html() #' } resp_body_raw <- function(resp) { check_response(resp) if (!resp_has_body(resp)) { cli::cli_abort("Can't retrieve empty body.") } switch(resp_body_type(resp), disk = readBin(resp$body, "raw", file.size(resp$body)), memory = resp$body, stream = { out <- read_con(resp$body) close(resp) out } ) } #' @rdname resp_body_raw #' @export resp_has_body <- function(resp) { check_response(resp) switch(resp_body_type(resp), disk = file.size(resp$body) > 0, memory = length(resp$body) > 0, stream = isValid(resp$body) ) } resp_body_type <- function(resp) { if (is_path(resp$body)) { "disk" } else if (inherits(resp$body, "connection")) { "stream" } else { "memory" } } #' @param encoding Character encoding of the body text. If not specified, #' will use the encoding specified by the content-type, falling back to #' UTF-8 with a warning if it cannot be found. The resulting string is #' always re-encoded to UTF-8. #' @rdname resp_body_raw #' @export resp_body_string <- function(resp, encoding = NULL) { check_response(resp) encoding <- encoding %||% resp_encoding(resp) body <- resp_body_raw(resp) iconv(readBin(body, character()), from = encoding, to = "UTF-8") } #' @param check_type Check that response has expected content type? Set to #' `FALSE` to suppress the automated check #' @param simplifyVector Should JSON arrays containing only primitives (i.e. #' booleans, numbers, and strings) be caused to atomic vectors? #' @param ... Other arguments passed on to [jsonlite::fromJSON()] and #' [xml2::read_xml()] respectively. #' @rdname resp_body_raw #' @export resp_body_json <- function(resp, check_type = TRUE, simplifyVector = FALSE, ...) { check_response(resp) check_installed("jsonlite") key <- body_cache_key("json", simplifyVector = simplifyVector, ...) if (env_has(resp$cache, key)) { return(resp$cache[[key]]) } resp_check_content_type( resp, valid_types = "application/json", valid_suffix = "json", check_type = check_type ) text <- resp_body_string(resp, "UTF-8") resp$cache[[key]] <- jsonlite::fromJSON(text, simplifyVector = simplifyVector, ...) resp$cache[[key]] } #' @rdname resp_body_raw #' @export resp_body_html <- function(resp, check_type = TRUE, ...) { check_response(resp) check_installed("xml2") resp_check_content_type( resp, valid_types = c("text/html", "application/xhtml+xml"), check_type = check_type ) body <- resp_body_raw(resp) xml2::read_html(body, ...) } #' @rdname resp_body_raw #' @export resp_body_xml <- function(resp, check_type = TRUE, ...) { check_response(resp) check_installed("xml2") key <- body_cache_key("xml", ...) if (env_has(resp$cache, key)) { return(resp$cache[[key]]) } resp_check_content_type( resp, valid_types = c("application/xml", "text/xml"), valid_suffix = "xml", check_type = check_type ) body <- resp_body_raw(resp) resp$cache[[key]] <- xml2::read_xml(body, ...) resp$cache[[key]] } body_cache_key <- function(prefix, ...) { key <- hash(list(...)) paste0(prefix, "-", substr(key, 1, 10)) } httr2/R/oauth-client.R0000644000176200001440000002060514753737343014260 0ustar liggesusers#' Create an OAuth client #' #' An OAuth app is the combination of a client, a set of endpoints #' (i.e. urls where various requests should be sent), and an authentication #' mechanism. A client consists of at least a `client_id`, and also often #' a `client_secret`. You'll get these values when you create the client on #' the API's website. #' #' @param id Client identifier. #' @param token_url Url to retrieve an access token. #' @param secret Client secret. For most apps, this is technically confidential #' so in principle you should avoid storing it in source code. However, many #' APIs require it in order to provide a user friendly authentication #' experience, and the risks of including it are usually low. To make things #' a little safer, I recommend using [obfuscate()] when recording the client #' secret in public code. #' @param key Client key. As an alternative to using a `secret`, you can #' instead supply a confidential private key. This should never be included #' in a package. #' @param auth Authentication mechanism used by the client to prove itself to #' the API. Can be one of three built-in methods ("body", "header", or "jwt"), #' or a function that will be called with arguments `req`, `client`, and #' the contents of `auth_params`. #' #' The most common mechanism in the wild is `"body"` where the `client_id` and #' (optionally) `client_secret` are added to the body. `"header"` sends the #' `client_id` and `client_secret` in HTTP Authorization header. `"jwt_sig"` #' will generate a JWT, and include it in a `client_assertion` field in the #' body. #' #' See [oauth_client_req_auth()] for more details. #' @param auth_params Additional parameters passed to the function specified #' by `auth`. #' @param name Optional name for the client. Used when generating the cache #' directory. If `NULL`, generated from hash of `client_id`. If you're #' defining a client for use in a package, I recommend that you use #' the package name. #' @return An OAuth client: An S3 list with class `httr2_oauth_client`. #' @export #' @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) ) { check_string(id) check_string(token_url) check_string(secret, allow_null = TRUE) if (is.character(auth)) { if (missing(auth)) { auth <- if (is.null(key)) "body" else "jwt_sig" } auth <- arg_match(auth) if (auth == "header" && is.null(secret)) { cli::cli_abort("{.code auth = 'header'} requires a {.arg secret}.") } else if (auth == "jwt_sig") { if (is.null(key)) { 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}.") } } auth <- paste0("oauth_client_req_auth_", auth) } else if (!is_function(auth)) { cli::cli_abort("{.arg auth} must be a string or function.") } structure( list( name = name, id = id, secret = secret, key = key, token_url = token_url, auth = auth, auth_params = auth_params ), class = "httr2_oauth_client" ) } #' @export print.httr2_oauth_client <- function(x, ...) { cli::cli_text(cli::style_bold("<", paste(class(x), collapse = "/"), ">")) redacted <- list_redact(compact(x), c("secret", "key")) bullets(redacted) invisible(x) } #' OAuth client authentication #' #' @description #' `oauth_client_req_auth()` authenticates a request using the authentication #' strategy defined by the `auth` and `auth_param` arguments to [oauth_client()]. #' This is used to authenticate the client as part of the OAuth flow, **not** #' to authenticate a request on behalf of a user. #' #' There are three built-in strategies: #' #' * `oauth_client_req_body()` adds the client id and (optionally) the secret #' to the request body, as described in `r rfc(6749, "2.3.1")`. #' #' * `oauth_client_req_header()` adds the client id and secret using HTTP #' basic authentication with the `Authorization` header, as described #' in `r rfc(6749, "2.3.1")`. #' #' * `oauth_client_jwt_rs256()` adds a client assertion to the body using a #' JWT signed with `jwt_sign_rs256()` using a private key, as described #' in `r rfc(7523, 2.2)`. #' #' You will generally not call these functions directly but will instead #' specify them through the `auth` argument to [oauth_client()]. The `req` and #' `client` parameters are automatically filled in; other parameters come from #' the `auth_params` argument. #' @inheritParams req_perform #' @param client An [oauth_client]. #' @return A modified HTTP [request]. #' @export #' @examples #' # Show what the various forms of client authentication look like #' req <- request("https://example.com/whoami") #' #' client1 <- oauth_client( #' id = "12345", #' secret = "56789", #' token_url = "https://example.com/oauth/access_token", #' name = "oauth-example", #' auth = "body" # the default #' ) #' # calls oauth_client_req_auth_body() #' req_dry_run(oauth_client_req_auth(req, client1)) #' #' client2 <- oauth_client( #' id = "12345", #' secret = "56789", #' token_url = "https://example.com/oauth/access_token", #' name = "oauth-example", #' auth = "header" #' ) #' # calls oauth_client_req_auth_header() #' req_dry_run(oauth_client_req_auth(req, client2)) #' #' client3 <- oauth_client( #' id = "12345", #' key = openssl::rsa_keygen(), #' token_url = "https://example.com/oauth/access_token", #' name = "oauth-example", #' auth = "jwt_sig", #' auth_params = list(claim = jwt_claim()) #' ) #' # calls oauth_client_req_auth_header_jwt_sig() #' req_dry_run(oauth_client_req_auth(req, client3)) oauth_client_req_auth <- function(req, client) { exec(client$auth, req = req, client = client, !!!client$auth_params) } #' @export #' @rdname oauth_client_req_auth oauth_client_req_auth_header <- function(req, client) { req_auth_basic(req, username = client$id, password = unobfuscate(client$secret) ) } #' @export #' @rdname oauth_client_req_auth oauth_client_req_auth_body <- function(req, client) { req_body_form(req, client_id = client$id, client_secret = unobfuscate(client$secret) # might be NULL ) } #' @inheritParams jwt_claim #' @export #' @rdname oauth_client_req_auth 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, client_assertion = jwt, client_assertion_type = "urn:ietf:params:oauth:client-assertion-type:jwt-bearer" ) } # Helpers ----------------------------------------------------------------- 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}.", call = error_call ) } if (is_confidential && is.null(client$secret) && is.null(client$key)) { cli::cli_abort( c( "Can't use this {.arg app} with OAuth 2.0 {flow} flow.", i = "{.arg app} must have a confidential client (i.e. {.arg client_secret} is required)." ), call = error_call ) } if (interactive && !is_interactive()) { cli::cli_abort( "OAuth 2.0 {flow} flow requires an interactive session", call = error_call ) } } 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) req <- req_headers(req, Accept = "application/json") resp <- oauth_flow_fetch(req, "client$token_url", error_call = error_call) exec(oauth_token, !!!resp) } httr2/R/oauth-flow.R0000644000176200001440000000437514731333064013743 0ustar liggesusersoauth_flow_fetch <- function(req, source, error_call = caller_env()) { req <- req_error(req, is_error = ~FALSE) resp <- req_perform(req, error_call = current_call()) oauth_flow_parse(resp, source, error_call = error_call) } oauth_flow_parse <- function(resp, source, error_call = caller_env()) { withCallingHandlers( body <- oauth_flow_body(resp), error = function(err) { cli::cli_abort( "Failed to parse response from {.arg {source}} OAuth url.", parent = err, resp = resp, class = "httr2_oauth_parse", call = error_call ) } ) if (has_name(body, "expires_in")) { body$expires_in <- as.numeric(body$expires_in) } # This is rather more flexible than what the spec requires, and should # hopefully be general enough to handle most token endpoints. However, # it would still be nice to figure out how to make user extensible, # especially since you might be able to give better errors. if (has_name(body, "access_token") || has_name(body, "device_code")) { body } else if (has_name(body, "error")) { oauth_flow_abort( body$error, body$error_description, body$error_uri, error_call = error_call ) } else { cli::cli_abort( c( "Failed to parse response from {.arg {source}} OAuth url.", "*" = "Did not contain {.code access_token}, {.code device_code}, or {.code error} field." ), resp = resp, class = "httr2_oauth_parse", call = error_call ) } } oauth_flow_body <- function(resp) { resp_body_json(resp, check_type = NA) } # https://datatracker.ietf.org/doc/html/rfc6749#section-4.1.2.1 # https://datatracker.ietf.org/doc/html/rfc6749#section-4.2.2.1 # 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()) { cli::cli_abort( c( "OAuth failure [{error}]", "*" = description, i = if (!is.null(uri)) "Learn more at {.url {uri}}." ), code = error, class = c(glue("httr2_oauth_{error}"), "httr2_oauth"), call = error_call ) } httr2/R/progress-bars.R0000644000176200001440000000427514731335417014452 0ustar liggesusers#' Progress bars in httr2 #' #' @description #' Some of httr2's perform functions have a `progress` argument that you can use #' to create a progress bar. `progress` can be: #' #' * `FALSE`, the default: does not create a progress bar. #' * `TRUE`: creates a basic unnamed progress bar. #' * A string: creates a basic progress bar with the given name. #' * A named list of progress bar parameters, as described below. #' #' It's good practice to name your progress bars, to make it clear what #' calculation or process they belong to. We recommend keeping the names #' under 20 characters, so the whole progress bar fits comfortably even on #' on narrower displays. #' #' ## Progress bar parameters #' #' * `clear`: whether to remove the progress bar from the screen after #' termination. Defaults to `TRUE`. #' * `format`: format string. This overrides the default format string of #' the progress bar type. It must be given for the `custom` type. #' Format strings may contain R expressions to evaluate in braces. #' They support cli [pluralization][cli::pluralization], and #' [styling][cli::inline-markup] and they can contain special #' [progress variables][cli::progress-variables]. #' * `format_done`: format string for successful termination. By default #' the same as `format`. #' * `format_failed`: format string for unsuccessful termination. #' By default the same as `format`. #' * `name`: progress bar name. This is by default the empty string and it #' is displayed at the beginning of the progress bar. #' * `type`: progress bar type. Currently supported types are: #' * `iterator`: the default, a for loop or a mapping function, #' * `tasks`: a (typically small) number of tasks, #' * `download`: download of one file, #' * `custom`: custom type, `format` must not be `NULL` for this type. #' The default display is different for each progress bar type. #' #' ## Further documentation #' #' purrr's progress bars are powered by cli, so see #' [Introduction to progress bars in cli](https://cli.r-lib.org/articles/progress.html) #' and [Advanced cli progress bars](https://cli.r-lib.org/articles/progress-advanced.html) #' for more details. #' #' @keywords internal #' @name progress_bars NULL httr2/R/req-perform.R0000644000176200001440000002070214761707310014107 0ustar liggesusers#' Perform a request to get a response #' #' @description #' After preparing a [request], call `req_perform()` to perform it, fetching #' the results back to R as a [response]. #' #' The default HTTP method is `GET` unless a body (set by [req_body_json] and #' friends) is present, in which case it will be `POST`. You can override #' these defaults with [req_method()]. #' #' # Requests #' Note that one call to `req_perform()` may perform multiple HTTP requests: #' #' * If the `url` is redirected with a 301, 302, 303, or 307, curl will #' automatically follow the `Location` header to the new location. #' #' * If you have configured retries with [req_retry()] and the request #' fails with a transient problem, `req_perform()` will try again after #' waiting a bit. See [req_retry()] for details. #' #' * If you are using OAuth, and the cached token has expired, `req_perform()` #' will get a new token either using the refresh token (if available) #' or by running the OAuth flow. #' #' # Progress bar #' #' `req_perform()` will automatically add a progress bar if it needs to wait #' between requests for [req_throttle()] or [req_retry()]. You can turn the #' progress bar off (and just show the total time to wait) by setting #' `options(httr2_progress = FALSE)`. #' #' @param req A httr2 [request] object. #' @param path Optionally, path to save body of the response. This is useful #' for large responses since it avoids storing the response in memory. #' @param mock A mocking function. If supplied, this function is called #' with the request. It should return either `NULL` (if it doesn't want to #' handle the request) or a [response] (if it does). See [with_mock()]/ #' `local_mock()` for more details. #' @param verbosity How much information to print? This is a wrapper #' around [req_verbose()] that uses an integer to control verbosity: #' #' * `0`: no output #' * `1`: show headers #' * `2`: show headers and bodies #' * `3`: show headers, bodies, and curl status messages. #' #' Use [with_verbosity()] to control the verbosity of requests that #' you can't affect directly. #' @inheritParams rlang::args_error_context #' @returns #' * If the HTTP request succeeds, and the status code is ok (e.g. 200), #' an HTTP [response]. #' #' * If the HTTP request succeeds, but the status code is an error #' (e.g a 404), an error with class `c("httr2_http_404", "httr2_http")`. #' By default, all 400 and 500 status codes will be treated as an error, #' but you can customise this with [req_error()]. #' #' * If the HTTP request fails (e.g. the connection is dropped or the #' server doesn't exist), an error with class `"httr2_failure"`. #' @export #' @seealso [req_perform_parallel()] to perform multiple requests in parallel. #' [req_perform_iterative()] to perform multiple requests iteratively. #' @examples #' request("https://google.com") |> #' req_perform() req_perform <- function( 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 check_function(mock, allow_null = TRUE) verbosity <- verbosity %||% httr2_verbosity() if (!is.null(mock)) { mock <- as_function(mock) mock_resp <- mock(req) if (!is.null(mock_resp)) { return(handle_resp(req, mock_resp, error_call = error_call)) } } req <- req_verbosity(req, verbosity) req <- cache_pre_fetch(req, path) if (is_response(req)) { return(req) } req_prep <- req_prepare(req) handle <- req_handle(req_prep) max_tries <- retry_max_tries(req) deadline <- Sys.time() + retry_max_seconds(req) n <- 0 tries <- 0 reauthed <- FALSE # only ever re-authenticate once sys_sleep(throttle_delay(req), "for throttling delay") delay <- 0 while (tries < max_tries && Sys.time() < deadline) { retry_check_breaker(req, tries, error_call = error_call) sys_sleep(delay, "for retry backoff") n <- n + 1 resp <- req_perform1(req, path = path, handle = handle) req_completed(req_prep) if (retry_is_transient(req, resp)) { tries <- tries + 1 delay <- retry_after(req, resp, tries) signal(class = "httr2_retry", tries = tries, delay = delay) } else if (!reauthed && resp_is_invalid_oauth_token(req, resp)) { reauthed <- TRUE req_auth_clear_cache(req) req_prep <- req_prepare(req) handle <- req_handle(req_prep) delay <- 0 } else { # done break } } # Used for testing signal(class = "httr2_fetch", n = n, tries = tries, reauth = reauthed) resp <- cache_post_fetch(req, resp, path = path) handle_resp(req, resp, error_call = error_call) } handle_resp <- function(req, resp, error_call = caller_env()) { if (resp_show_body(resp)) { verbose_body("<< ", resp$body, resp$headers$`content-type`) } if (is_error(resp)) { resp$request <- req resp$call <- error_call cnd_signal(resp) } else if (error_is_error(req, resp)) { cnd <- resp_failure_cnd(req, resp, error_call = error_call) cnd_signal(cnd) } else { resp } } resp_failure_cnd <- function(req, resp, error_call = caller_env()) { status <- resp_status(resp) desc <- resp_status_desc(resp) message <- paste0("HTTP ", status, if (!is.na(desc)) paste0(" ", desc), ".") info <- error_body(req, resp, error_call) catch_cnd(abort( c(message, resp_auth_message(resp), info), status = status, resp = resp, class = c(glue("httr2_http_{status}"), "httr2_http", "httr2_error", "rlang_error"), request = req, call = error_call )) } req_perform1 <- function(req, path = NULL, handle = NULL) { the$last_request <- req the$last_response <- NULL signal(class = "httr2_perform") err <- capture_curl_error({ fetch <- curl_fetch(handle, req$url, path) }) if (is_error(err)) { return(err) } # Ensure cookies are saved to disk now, not when request is finalised curl::handle_setopt(handle, cookielist = "FLUSH") curl::handle_setopt(handle, cookiefile = NULL, cookiejar = NULL) the$last_response <- create_response(req, fetch$curl_data, fetch$body) the$last_response } curl_fetch <- function(handle, url, path) { if (!is.null(path)) { curl_data <- curl::curl_fetch_disk(url, path, handle) body <- new_path(path) } else { curl_data <- curl::curl_fetch_memory(url, handle) body <- curl_data$content } list(curl_data = curl_data, body = body) } req_verbosity <- 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) } switch(verbosity + 1, req, req_verbose(req), req_verbose(req, body_req = TRUE, body_resp = TRUE), req_verbose(req, body_req = TRUE, body_resp = TRUE, info = TRUE) ) } #' Retrieve most recent request/response #' #' These functions retrieve the most recent request made by httr2 and #' the response it received, to facilitate debugging problems _after_ they #' occur. If the request did not succeed (or no requests have been made) #' `last_response()` will be `NULL`. #' #' @returns An HTTP [response]/[request]. #' @export #' @examples #' invisible(request("http://httr2.r-lib.org") |> req_perform()) #' last_request() #' last_response() last_response <- function() { the$last_response } #' @export #' @rdname last_response last_request <- function() { the$last_request } # Must call req_prepare(), then req_handle(), then after the request has been # performed, req_completed() (on the prepared requests) req_prepare <- function(req) { req <- auth_sign(req) req <- req_method_apply(req) req <- req_body_apply(req) # Save actually request headers so that req_verbose() can use them req$state$headers <- req$headers req } req_handle <- function(req) { if (!req_has_user_agent(req)) { req <- req_user_agent(req) } handle <- curl::new_handle() curl::handle_setopt(handle, url = req$url) curl::handle_setheaders(handle, .list = headers_flatten(req$headers)) curl::handle_setopt(handle, .list = req$options) if (length(req$fields) > 0) { curl::handle_setform(handle, .list = req$fields) } handle } req_completed <- function(req) { req_policy_call(req, "done", list(), NULL) } new_path <- function(x) structure(x, class = "httr2_path") is_path <- function(x) inherits(x, "httr2_path") resp_show_body <- function(resp) { resp$request$policies$show_body %||% FALSE } httr2/R/req-policy.R0000644000176200001440000000147714556444037013752 0ustar liggesusersreq_policies <- function(.req, ..., error_call = caller_env()) { check_request(.req, call = error_call) .req$policies <- modify_list(.req$policies, ..., error_call = error_call) .req } req_policy_exists <- function(req, name) { has_name(req$policies, name) } req_policy_call <- function(req, name, args, default) { if (req_policy_exists(req, name)) { exec(req$policies[[name]], !!!args) } else { if (is_function(default)) { exec(default, !!!args) } else { default } } } as_callback <- function(x, n, name, error_call = caller_env()) { if (is.null(x)) { return(x) } x <- as_function(x) if (!inherits(x, "rlang_lambda_function") && length(formals(x)) != n) { cli::cli_abort( "Callback {.fn name} must have {n} argument{?s}", call = error_call ) } x } httr2/R/req-perform-stream.R0000644000176200001440000000774014737312513015407 0ustar liggesusers#' Perform a request and handle data as it streams back #' #' @description #' `r lifecycle::badge("superseded")` #' #' We now recommend [req_perform_connection()] since it has a considerably more #' flexible interface. Unless I hear compelling reasons otherwise, I'm likely #' to deprecate `req_perform_stream()` in a future release. #' #' After preparing a request, call `req_perform_stream()` to perform the request #' and handle the result with a streaming callback. This is useful for #' streaming HTTP APIs where potentially the stream never ends. #' #' The `callback` will only be called if the result is successful. If you need #' to stream an error response, you can use [req_error()] to suppress error #' handling so that the body is streamed to you. #' #' @inheritParams req_perform #' @param callback A single argument callback function. It will be called #' repeatedly with a raw vector whenever there is at least `buffer_kb` #' worth of data to process. It must return `TRUE` to continue streaming. #' @param timeout_sec Number of seconds to process stream for. #' @param buffer_kb Buffer size, in kilobytes. #' @param round How should the raw vector sent to `callback` be rounded? #' Choose `"byte"`, `"line"`, or supply your own function that takes a #' raw vector of `bytes` and returns the locations of possible cut points #' (or `integer()` if there are none). #' @returns An HTTP [response]. The body will be empty if the request was #' successful (since the `callback` function will have handled it). The body #' will contain the HTTP response body if the request was unsuccessful. #' @export #' @examples #' show_bytes <- function(x) { #' cat("Got ", length(x), " bytes\n", sep = "") #' TRUE #' } #' resp <- request(example_url()) |> #' 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")) { check_request(req) check_function(callback) check_number_decimal(timeout_sec, min = 0) check_number_decimal(buffer_kb, min = 0) cut_points <- as_round_function(round) stop_time <- Sys.time() + timeout_sec resp <- req_perform_connection(req) stream <- resp$body withr::defer(close(stream)) continue <- TRUE incomplete <- TRUE buf <- raw() while (continue && isIncomplete(stream) && Sys.time() < stop_time) { buf <- c(buf, readBin(stream, raw(), buffer_kb * 1024)) if (length(buf) > 0) { cut <- cut_points(buf) n <- length(cut) if (n) { continue <- isTRUE(callback(utils::head(buf, n = cut[n]))) buf <- utils::tail(buf, n = -cut[n]) } } } # if there are leftover bytes and none of the callback() # returned FALSE. if (continue && length(buf)) { callback(buf) } # We're done streaming so convert to bodiless response resp$body <- raw() the$last_response <- resp resp } # Helpers ---------------------------------------------------------------------- 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, byte = function(bytes) length(bytes), line = function(bytes) which(bytes == charToRaw("\n")) ) } else { cli::cli_abort( '{.arg round} must be "byte", "line" or a function.', call = error_call ) } } #' @export #' @rdname req_perform_stream #' @usage NULL req_stream <- function(req, callback, timeout_sec = Inf, buffer_kb = 64) { lifecycle::deprecate_warn( "1.0.0", "req_stream()", "req_perform_stream()" ) req_perform_stream( req = req, callback = callback, timeout_sec = timeout_sec, buffer_kb = buffer_kb ) } httr2/R/req-cache.R0000644000176200001440000002474214761701552013512 0ustar liggesusers#' Automatically cache requests #' #' @description #' Use `req_perform()` to automatically cache HTTP requests. Most API requests #' are not cacheable, but static files often are. #' #' `req_cache()` caches responses to GET requests that have status code 200 and #' at least one of the standard caching headers (e.g. `Expires`, #' `Etag`, `Last-Modified`, `Cache-Control`), unless caching has been expressly #' prohibited with `Cache-Control: no-store`. Typically, a request will still #' be sent to the server to check that the cached value is still up-to-date, #' but it will not need to re-download the body value. #' #' To learn more about HTTP caching, I recommend the MDN article #' [HTTP caching](https://developer.mozilla.org/en-US/docs/Web/HTTP/Caching). #' #' @inheritParams req_perform #' @param path Path to cache directory. Will be created automatically if it #' does not exist. #' #' For quick and easy caching within a session, you can use `tempfile()`. #' To cache requests within a package, you can use something like #' `file.path(tools::R_user_dir("pkgdown", "cache"), "httr2")`. #' #' httr2 doesn't provide helpers to manage the cache, but if you want to #' empty it, you can use something like #' `unlink(dir(cache_path, full.names = TRUE))`. #' @param use_on_error If the request errors, and there's a cache response, #' should `req_perform()` return that instead of generating an error? #' @param debug When `TRUE` will emit useful messages telling you about #' cache hits and misses. This can be helpful to understand whether or #' not caching is actually doing anything for your use case. #' @param max_n,max_age,max_size Automatically prune the cache by specifying #' one or more of: #' #' * `max_age`: to delete files older than this number of seconds. #' * `max_n`: to delete files (from oldest to newest) to preserve at #' most this many files. #' * `max_size`: to delete files (from oldest to newest) to preserve at #' most this many bytes. #' #' The cache pruning is performed at most once per minute. #' @returns A modified HTTP [request]. #' @export #' @examples #' # GitHub uses HTTP caching for all raw files. #' url <- paste0( #' "https://raw.githubusercontent.com/allisonhorst/palmerpenguins/", #' "master/inst/extdata/penguins.csv" #' ) #' # Here I set debug = TRUE so you can see what's happening #' req <- request(url) |> req_cache(tempdir(), debug = TRUE) #' #' # First request downloads the data #' resp <- req |> req_perform() #' #' # 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) { 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, cache_path = path, cache_use_on_error = use_on_error, cache_debug = debug, cache_max = list(age = max_age, n = max_n, size = max_size) ) } # Do I need to worry about hash collisions? # No - even if the user stores a billion urls, the probably of a collision # is ~ 1e-20: https://preshing.com/20110504/hash-collision-probabilities/ req_cache_path <- function(req, ext = ".rds") { file.path(req$policies$cache_path, paste0(hash(req$url), ext)) } cache_use_on_error <- function(req) { req$policies$cache_use_on_error %||% FALSE } cache_debug <- function(req) { req$policies$cache_debug %||% FALSE } # Cache management -------------------------------------------------------- cache_active <- function(req) { req_policy_exists(req, "cache_path") } cache_get <- function(req) { # This check should be redudant but we keep it in for safety if (!cache_active(req)) { return(req) } path <- req_cache_path(req) if (!file.exists(path)) { return(NULL) } tryCatch( { rds <- readRDS(path) # Update file time if read successfully Sys.setFileTime(path, Sys.time()) rds }, error = function(e) NULL ) } cache_set <- function(req, resp) { signal("", "httr2_cache_save") if (resp_body_type(resp) == "disk") { body_path <- req_cache_path(req, ".body") file.copy(resp$body, body_path, overwrite = TRUE) resp$body <- new_path(body_path) } saveRDS(resp, req_cache_path(req, ".rds")) invisible() } cache_prune_if_needed <- function(req, threshold = 60, debug = FALSE) { path <- req$policies$cache_path last_prune <- the$cache_throttle[[path]] if (is.null(last_prune) || last_prune + threshold <= Sys.time()) { if (debug) cli::cli_text("Pruning cache") cache_prune(path, max = req$policies$cache_max, debug = debug) the$cache_throttle[[path]] <- Sys.time() invisible(TRUE) } else { invisible(FALSE) } } # Adapted from # https://github.com/r-lib/cachem/blob/main/R/cache-disk.R#L396-L467 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) invisible() } cache_info <- function(path, pattern = "\\.rds$") { filenames <- dir(path, pattern, full.names = TRUE) info <- file.info(filenames, extra_cols = FALSE) info <- info[info$isdir == FALSE, ] info$name <- rownames(info) rownames(info) <- NULL info[order(info$mtime, decreasing = TRUE), c("name", "size", "mtime")] } 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}") file.remove(info$name[to_remove]) info[!to_remove, ] } else { info } } # Hooks for req_perform ----------------------------------------------------- # Can return request or response cache_pre_fetch <- function(req, path = NULL) { if (!cache_active(req)) { return(req) } # Only GET requests should be retrieved from cache. It's not sufficient to # only save GET requests, because the method is not part of the cache key if (req_method_get(req) != "GET") { return(req) } debug <- cache_debug(req) cache_prune_if_needed(req, debug = debug) cached_resp <- cache_get(req) if (is.null(cached_resp)) { return(req) } if (debug) cli::cli_text("Found url in cache {.val {hash(req$url)}}") info <- resp_cache_info(cached_resp) if (!is.na(info$expires) && info$expires >= Sys.time()) { signal("", "httr2_cache_cached") if (debug) cli::cli_text("Cached value is fresh; using response from cache") resp <- cached_resp resp$body <- cache_body(cached_resp, path) resp } else { if (debug) cli::cli_text("Cached value is stale; checking for updates") req_headers(req, `If-Modified-Since` = info$last_modified, `If-None-Match` = info$etag ) } } # Always returns response cache_post_fetch <- function(req, resp, path = NULL) { if (!cache_active(req)) { return(resp) } debug <- cache_debug(req) cached_resp <- cache_get(req) 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") 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") # Combine headers resp$headers <- cache_headers(cached_resp, resp) # Replace body with cached result resp$body <- cache_body(cached_resp, path) # Re-cache, so we get any new headers cache_set(req, resp) resp } else if (resp_is_cacheable(resp)) { if (debug) cli::cli_text("Saving response to cache {.val {hash(req$url)}}") cache_set(req, resp) resp } else { resp } } cache_body <- function(cached_resp, path = NULL) { check_response(cached_resp) body <- cached_resp$body if (is.null(path)) { return(body) } 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) ) new_path(path) } # https://www.rfc-editor.org/rfc/rfc7232#section-4.1 cache_headers <- function(cached_resp, resp) { check_response(cached_resp) headers <- modify_list(cached_resp$headers, !!!resp$headers, .ignore_case = TRUE) as_headers(headers) } # Caching headers --------------------------------------------------------- resp_is_cacheable <- function(resp, control = NULL) { if (resp$method != "GET") { return(FALSE) } if (resp_status(resp) != 200L) { return(FALSE) } if (resp_body_type(resp) == "stream") { return(FALSE) } control <- control %||% resp_cache_control(resp) if ("no-store" %in% control$flags) { return(FALSE) } if (has_name(control, "max-age")) { return(TRUE) } if (!any(resp_header_exists(resp, c("Etag", "Last-Modified", "Expires")))) { return(FALSE) } TRUE } resp_cache_info <- function(resp, control = NULL) { list( expires = resp_cache_expires(resp, control), last_modified = resp_header(resp, "Last-Modified"), etag = resp_header(resp, "Etag") ) } resp_cache_expires <- function(resp, control = NULL) { control <- control %||% resp_cache_control(resp) # Prefer max-age parameter if it exists, otherwise use Expires header if (has_name(control, "max-age") && resp_header_exists(resp, "Date")) { resp_date(resp) + as.integer(control[["max-age"]]) } else if (resp_header_exists(resp, "Expires")) { parse_http_date(resp_header(resp, "Expires")) } else { NA } } # https://developer.mozilla.org/en-US/docs/Web/HTTP/Headers/Cache-Control resp_cache_control <- function(resp) { x <- resp_header(resp, "Cache-Control") if (is.null(x)) { return(NULL) } pieces <- strsplit(x, ",", fixed = TRUE)[[1]] pieces <- gsub("^\\s+|\\s+$", "", pieces) pieces <- tolower(pieces) is_value <- grepl("=", pieces, fixed = TRUE) flags <- pieces[!is_value] keyvalues <- strsplit(pieces[is_value], "\\s*=\\s*") keys <- c(rep("flags", length(flags)), lapply(keyvalues, "[[", 1)) values <- c(flags, lapply(keyvalues, "[[", 2)) stats::setNames(values, keys) } httr2/R/req-auth.R0000644000176200001440000000454114751434044013401 0ustar liggesusers#' Authenticate request with HTTP basic authentication #' #' This sets the Authorization header. See details at #' . #' #' @inheritParams req_perform #' @param username User name. #' @param password Password. You should avoid entering the password directly #' when calling this function as it will be captured by `.Rhistory`. Instead, #' leave it unset and the default behaviour will prompt you for it #' interactively. #' @returns A modified HTTP [request]. #' @export #' @examples #' req <- request("http://example.com") |> req_auth_basic("hadley", "SECRET") #' req #' req |> req_dry_run() #' #' # httr2 does its best to redact the Authorization header so that you don't #' # accidentally reveal confidential data. Use `redact_headers` to reveal it: #' print(req, redact_headers = FALSE) #' req |> req_dry_run(redact_headers = FALSE) #' #' # We do this because the authorization header is not encrypted and the #' # so password can easily be discovered: #' rawToChar(jsonlite::base64_dec("aGFkbGV5OlNFQ1JFVA==")) req_auth_basic <- function(req, username, password = NULL) { check_request(req) check_string(username) password <- check_password(password) username_password <- openssl::base64_encode(paste0(username, ":", password)) req_headers(req, Authorization = paste0("Basic ", username_password)) } #' Authenticate request with bearer token #' #' A bearer token gives the bearer access to confidential resources #' (so you should keep them secure like you would with a user name and #' password). They are usually produced by some large authentication scheme #' (like the various OAuth 2.0 flows), but you are sometimes given then #' directly. #' #' @seealso See `r rfc(6750)` for more details about bearer token usage #' with OAuth 2.0. #' @inheritParams req_perform #' @param token A bearer token #' @returns A modified HTTP [request]. #' @export #' @examples #' req <- request("http://example.com") |> req_auth_bearer_token("sdaljsdf093lkfs") #' req #' #' # httr2 does its best to redact the Authorization header so that you don't #' # accidentally reveal confidential data. Use `redact_headers` to reveal it: #' print(req, redact_headers = FALSE) req_auth_bearer_token <- function(req, token) { check_request(req) check_string(token) req_headers(req, Authorization = paste("Bearer", token)) } httr2/R/zzz.R0000644000176200001440000000006214063722633012502 0ustar liggesusers.onLoad <- function(...) { cache_disk_prune() } httr2/R/req-retries.R0000644000176200001440000001770214754713634014130 0ustar liggesusers#' Automatically retry a request on failure #' #' @description #' `req_retry()` allows [req_perform()] to automatically retry failing #' requests. It's particularly important for APIs with rate limiting, but can #' also be useful when dealing with flaky servers. #' #' By default, `req_perform()` will retry if the response is a 429 #' ("too many requests", often used for rate limiting) or 503 #' ("service unavailable"). If the API you are wrapping has other transient #' status codes (or conveys transience with some other property of the #' response), you can override the default with `is_transient`. And #' if you set `retry_on_failure = TRUE`, the request will retry #' if either the HTTP request or HTTP response doesn't complete successfully, #' leading to an error from curl, the lower-level library that httr2 uses to #' perform HTTP requests. This occurs, for example, if your Wi-Fi is down. #' #' ## Delay #' #' It's a bad idea to immediately retry a request, so `req_perform()` will #' wait a little before trying again: #' #' * If the response contains the `Retry-After` header, httr2 will wait the #' amount of time it specifies. If the API you are wrapping conveys this #' information with a different header (or other property of the response), #' you can override the default behavior with `retry_after`. #' #' * Otherwise, httr2 will use "truncated exponential backoff with full #' jitter", i.e., it will wait a random amount of time between one second and #' `2 ^ tries` seconds, capped at a maximum of 60 seconds. In other words, it #' waits `runif(1, 1, 2)` seconds after the first failure, `runif(1, 1, 4)` #' after the second, `runif(1, 1, 8)` after the third, and so on. If you'd #' prefer a different strategy, you can override the default with `backoff`. #' #' @inheritParams req_perform #' @param max_tries,max_seconds Cap the maximum number of attempts #' (`max_tries`), the total elapsed time from the first request #' (`max_seconds`), or both. #' #' `max_tries` is the total number of attempts made, so this should always #' be greater than one. #' @param is_transient A predicate function that takes a single argument #' (the response) and returns `TRUE` or `FALSE` specifying whether or not #' the response represents a transient error. #' @param retry_on_failure Treat low-level failures as if they are #' transient errors that can be retried. #' @param backoff A function that takes a single argument (the number of failed #' attempts so far) and returns the number of seconds to wait. #' @param after A function that takes a single argument (the response) and #' returns either a number of seconds to wait or `NA`. `NA` indicates #' that a precise wait time is not available and that the `backoff` strategy #' should be used instead. #' @param failure_threshold,failure_timeout,failure_realm #' Set `failure_threshold` to activate "circuit breaking" where if a request #' continues to fail after `failure_threshold` times, cause the request to #' error until a timeout of `failure_timeout` seconds has elapsed. This #' timeout will persist across all requests with the same `failure_realm` #' (which defaults to the hostname of the request) and is intended to detect #' failing servers without needing to wait each time. #' @returns A modified HTTP [request]. #' @export #' @seealso [req_throttle()] if the API has a rate-limit but doesn't expose #' the limits in the response. #' @examples #' # google APIs assume that a 500 is also a transient error #' request("http://google.com") |> #' req_retry(is_transient = \(resp) resp_status(resp) %in% c(429, 500, 503)) #' #' # use a constant 10s delay after every failure #' request("http://example.com") |> #' req_retry(backoff = \(resp) 10) #' #' # When rate-limited, GitHub's API returns a 403 with #' # `X-RateLimit-Remaining: 0` and an Unix time stored in the #' # `X-RateLimit-Reset` header. This takes a bit more work to handle: #' github_is_transient <- function(resp) { #' resp_status(resp) == 403 && #' identical(resp_header(resp, "X-RateLimit-Remaining"), "0") #' } #' github_after <- function(resp) { #' time <- as.numeric(resp_header(resp, "X-RateLimit-Reset")) #' time - unclass(Sys.time()) #' } #' request("http://api.github.com") |> #' req_retry( #' 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) { check_request(req) check_number_whole(max_tries, min = 1, allow_null = TRUE) check_number_whole(max_seconds, min = 0, allow_null = TRUE) check_number_whole(failure_threshold, min = 1, allow_infinite = TRUE) check_number_whole(failure_timeout, min = 1) if (is.null(max_tries) && is.null(max_seconds)) { max_tries <- 2 cli::cli_inform("Setting {.code max_tries = 2}.") } check_bool(retry_on_failure) req_policies(req, retry_max_tries = max_tries, retry_max_wait = max_seconds, retry_on_failure = retry_on_failure, retry_is_transient = as_callback(is_transient, 1, "is_transient"), retry_backoff = as_callback(backoff, 1, "backoff"), retry_after = as_callback(after, 1, "after"), retry_failure_threshold = failure_threshold, retry_failure_timeout = failure_timeout, retry_realm = failure_realm %||% url_parse(req$url)$hostname ) } retry_max_tries <- function(req) { has_max_wait <- !is.null(req$policies$retry_max_wait) req$policies$retry_max_tries %||% if (has_max_wait) Inf else 1 } retry_max_seconds <- function(req) { req$policies$retry_max_wait %||% Inf } retry_check_breaker <- function(req, i, error_call = caller_env()) { realm <- req$policies$retry_realm if (is.null(realm)) { return(invisible()) } now <- unix_time() if (env_has(the$breaker, realm)) { triggered <- the$breaker[[realm]] } else if (i > req$policies$retry_failure_threshold) { the$breaker[[realm]] <- triggered <- now } else { return(invisible()) } remaining <- req$policies$retry_failure_timeout - (now - triggered) if (remaining <= 0) { env_unbind(the$breaker, realm) } else { cli::cli_abort( c( "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" ) } } retry_is_transient <- function(req, resp) { if (is_error(resp)) { return(req$policies$retry_on_failure %||% FALSE) } req_policy_call(req, "retry_is_transient", list(resp), default = function(resp) resp_status(resp) %in% c(429, 503) ) } retry_backoff <- function(req, i) { req_policy_call(req, "retry_backoff", list(i), default = backoff_default) } retry_after <- function(req, resp, i, error_call = caller_env()) { if (is_error(resp)) { return(retry_backoff(req, i)) } 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)) { not <- obj_type_friendly(after) cli::cli_abort( "The {.code after} callback to {.fn req_retry} must return a single number or NA, not {not}.", call = error_call ) } if (is.na(after)) { retry_backoff(req, i) } else { after } } is_number_or_na <- function(x) { (is.numeric(x) && length(x) == 1) || identical(x, NA) } # Helpers ----------------------------------------------------------------- # Exponential backoff with full-jitter, capped to 60s wait # https://aws.amazon.com/blogs/architecture/exponential-backoff-and-jitter/ backoff_default <- function(i) { round(min(stats::runif(1, min = 1, max = 2^i), 60), 1) } httr2/R/req-promise.R0000644000176200001440000001130014753377565014125 0ustar liggesusers#' Perform request asynchronously using the promises package #' #' @description #' `r lifecycle::badge("experimental")` #' #' This variation on [req_perform()] returns a [promises::promise()] object immediately #' and then performs the request in the background, returning program control before the request #' is finished. See the #' [promises package documentation](https://rstudio.github.io/promises/articles/promises_01_motivation.html) #' for more details on how to work with the resulting promise object. #' #' If using together with [later::with_temp_loop()] or other private event loops, #' a new curl pool made by [curl::new_pool()] should be created for requests made #' within the loop to ensure that only these requests are being polled by the loop. #' #' Like with [req_perform_parallel()], exercise caution when using this function; #' it's easy to pummel a server with many simultaneous requests. Also, not all servers #' can handle more than 1 request at a time, so the responses may still return #' sequentially. #' #' `req_perform_promise()` also has similar limitations to the #' [req_perform_parallel()] function, it: #' #' * Will not retrieve a new OAuth token if it expires after the promised request #' is created but before it is actually requested. #' * Does not perform throttling with [req_throttle()]. #' * Does not attempt retries as described by [req_retry()]. #' * Only consults the cache set by [req_cache()] when the request is promised. #' #' @inheritParams req_perform #' @inheritParams req_perform_parallel #' #' @return a [promises::promise()] object which resolves to a [response] if #' successful or rejects on the same errors thrown by [req_perform()]. #' @export #' #' @examples #' \dontrun{ #' library(promises) #' request_base <- request(example_url()) |> req_url_path_append("delay") #' #' p <- request_base |> req_url_path_append(2) |> req_perform_promise() #' #' # A promise object, not particularly useful on its own #' p #' #' # Use promise chaining functions to access results #' p %...>% #' resp_body_json() %...>% #' print() #' #' #' # Can run two requests at the same time #' p1 <- request_base |> req_url_path_append(2) |> req_perform_promise() #' p2 <- request_base |> req_url_path_append(1) |> req_perform_promise() #' #' p1 %...>% #' resp_url_path %...>% #' paste0(., " finished") %...>% #' print() #' #' p2 %...>% #' resp_url_path %...>% #' paste0(., " finished") %...>% #' print() #' #' # 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) { check_installed(c("promises", "later")) check_request(req) check_string(path, allow_null = TRUE) verbosity <- verbosity %||% httr2_verbosity() if (missing(pool)) { if (!identical(later::current_loop(), later::global_loop())) { cli::cli_abort(c( "Must supply {.arg pool} when calling {.code later::with_temp_loop()}.", i = "Do you need {.code pool = curl::new_pool()}?" )) } } else { if (!is.null(pool) && !inherits(pool, "curl_multi")) { stop_input_type(pool, "a {curl} pool", allow_null = TRUE) } } # verbosity checked by req_verbosity req <- req_verbosity(req, verbosity) promises::promise(function(resolve, reject) { pooled_req <- pooled_request( req = req, path = path, on_success = function(resp) resolve(resp), on_failure = function(error) reject(error), on_error = function(error) reject(error) ) pooled_req$submit(pool) ensure_pool_poller(pool, reject) }) } ensure_pool_poller <- function(pool, reject) { monitor <- pool_poller_monitor(pool) if (monitor$already_going()) return() poll_pool <- function(ready) { tryCatch( { status <- curl::multi_run(0, pool = pool) if (status$pending > 0) { fds <- curl::multi_fdset(pool = pool) later::later_fd( func = poll_pool, readfds = fds$reads, writefds = fds$writes, exceptfds = fds$exceptions, timeout = fds$timeout ) } else { monitor$ending() } }, error = function(cnd) { monitor$ending() reject(cnd) } ) } monitor$starting() poll_pool() } pool_poller_monitor <- function(pool) { pool_address <- obj_address(pool) list( 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) ) } httr2/R/secret.R0000644000176200001440000002116114736754325013147 0ustar liggesusers#' Secret management #' #' @description #' httr2 provides a handful of functions designed for working with confidential #' data. These are useful because testing packages that use httr2 often #' requires some confidential data that needs to be available for testing, #' but should not be available to package users. #' #' * `secret_encrypt()` and `secret_decrypt()` work with individual strings #' * `secret_encrypt_file()` encrypts a file in place and #' `secret_decrypt_file()` decrypts a file in a temporary location. #' * `secret_write_rds()` and `secret_read_rds()` work with `.rds` files #' * `secret_make_key()` generates a random string to use as a key. #' * `secret_has_key()` returns `TRUE` if the key is available; you can #' use it in examples and vignettes that you want to evaluate on your CI, #' but not for CRAN/package users. #' #' These all look for the key in an environment variable. When used inside of #' testthat, they will automatically [testthat::skip()] the test if the env var #' isn't found. (Outside of testthat, they'll error if the env var isn't #' found.) #' #' # Basic workflow #' #' 1. Use `secret_make_key()` to generate a password. Make this available #' as an env var (e.g. `{MYPACKAGE}_KEY`) by adding a line to your #' `.Renviron`. #' #' 2. Encrypt strings with `secret_encrypt()`, files with #' `secret_encrypt_file()`, and other data with `secret_write_rds()`, #' setting `key = "{MYPACKAGE}_KEY"`. #' #' 3. In your tests, decrypt the data with `secret_decrypt()`, #' `secret_decrypt_file()`, or `secret_read_rds()` to match how you encrypt #' it. #' #' 4. If you push this code to your CI server, it will already "work" because #' all functions automatically skip tests when your `{MYPACKAGE}_KEY` #' env var isn't set. To make the tests actually run, you'll need to set #' the env var using whatever tool your CI system provides for setting #' env vars. Make sure to carefully inspect the test output to check that #' the skips have actually gone away. #' #' @name secrets #' @returns #' * `secret_decrypt()` and `secret_encrypt()` return strings. #' * `secret_decrypt_file()` returns a path to a temporary file; #' `secret_encrypt_file()` encrypts the file in place. #' * `secret_write_rds()` returns `x` invisibly; `secret_read_rds()` #' returns the saved object. #' * `secret_make_key()` returns a string with class `AsIs`. #' * `secret_has_key()` returns `TRUE` or `FALSE`. #' @aliases NULL #' @examples #' key <- secret_make_key() #' #' path <- tempfile() #' secret_write_rds(mtcars, path, key = key) #' secret_read_rds(path, key) #' #' # While you can manage the key explicitly in a variable, it's much #' # easier to store in an environment variable. In real life, you should #' # NEVER use `Sys.setenv()` to create this env var because you will #' # also store the secret in your `.Rhistory`. Instead add it to your #' # .Renviron using `usethis::edit_r_environ()` or similar. #' Sys.setenv("MY_KEY" = key) #' #' x <- secret_encrypt("This is a secret", "MY_KEY") #' x #' secret_decrypt(x, "MY_KEY") NULL #' @export #' @rdname secrets secret_make_key <- function() { I(base64_url_rand(16)) } #' @export #' @rdname secrets #' @param x Object to encrypt. Must be a string for `secret_encrypt()`. #' @param key Encryption key; this is the password that allows you to "lock" #' and "unlock" the secret. The easiest way to specify this is as the #' name of an environment variable. Alternatively, if you already have #' a base64url encoded string, you can wrap it in `I()`, or you can pass #' the raw vector in directly. secret_encrypt <- function(x, key) { check_string(x) enc <- secret_encrypt_raw(charToRaw(x), key) base64_url_encode(enc) } #' @export #' @rdname secrets #' @param encrypted String to decrypt secret_decrypt <- function(encrypted, key) { check_string(encrypted) enc <- base64_url_decode(encrypted) dec <- secret_decrypt_raw(enc, key) rawToChar(dec) } #' @export #' @rdname secrets secret_write_rds <- function(x, path, key) { x <- serialize(x, NULL, version = 2) x_cmp <- memCompress(x, "bzip2") enc <- secret_encrypt_raw(x_cmp, key) writeBin(enc, path) invisible(x) } #' @export #' @rdname secrets #' @param path Path to file to encrypted file to read or write. For #' `secret_write_rds()` and `secret_read_rds()` this should be an `.rds` #' file. secret_read_rds <- function(path, key) { enc <- readBin(path, "raw", file.size(path)) dec_cmp <- secret_decrypt_raw(enc, key) dec <- memDecompress(dec_cmp, "bzip2") unserialize(dec) } #' @export #' @param envir The decrypted file will be automatically deleted when #' this environment exits. You should only need to set this argument if you #' want to pass the unencrypted file to another function. #' @rdname secrets secret_decrypt_file <- function(path, key, envir = parent.frame()) { enc <- readBin(path, "raw", file.size(path)) dec <- secret_decrypt_raw(enc, key = key) path <- tempfile() withr::defer(unlink(path), envir) writeBin(dec, path) Sys.chmod(path, 400) path } #' @export #' @rdname secrets secret_encrypt_file <- function(path, key) { dec <- readBin(path, "raw", file.info(path)$size) enc <- secret_encrypt_raw(dec, key = key) writeBin(enc, path) invisible(path) } #' @export #' @rdname secrets secret_has_key <- function(key) { check_string(key) key <- Sys.getenv(key) !identical(key, "") } secret_get_key <- function(envvar, call = caller_env()) { key <- Sys.getenv(envvar) if (identical(key, "")) { msg <- glue("Can't find envvar {envvar}") if (is_testing()) { testthat::skip(msg) } else { abort(msg, call = call) } } base64_url_decode(key) } #' Obfuscate mildly secret information #' #' @description #' Use `obfuscate("value")` to generate a call to `obfuscated()`, which will #' unobfuscate the value at the last possible moment. Obfuscated values only #' work in limited locations: #' #' * The `secret` argument to [oauth_client()] #' * Elements of the `data` argument to [req_body_form()], `req_body_json()`, #' and `req_body_multipart()`. #' #' Working together this pair of functions provides a way to obfuscate mildly #' confidential information, like OAuth client secrets. The secret can not be #' revealed from your inspecting source code, but a skilled R programmer could #' figure it out with some effort. The main goal is to protect against scraping; #' there's no way for an automated tool to grab your obfuscated secrets. #' #' @param x A string to `obfuscate`, or mark as `obfuscated`. #' @returns `obfuscate()` prints the `obfuscated()` call to include in your #' code. `obfuscated()` returns an S3 class marking the string as obfuscated #' so it can be unobfuscated when needed. #' @export #' @examples #' obfuscate("good morning") #' #' # Every time you obfuscate you'll get a different value because it #' # includes 16 bytes of random data which protects against certain types of #' # brute force attack #' obfuscate("good morning") obfuscate <- function(x) { check_string(x) enc <- secret_encrypt(x, obfuscate_key()) glue('obfuscated("{enc}")') } attr(obfuscate, "srcref") <- "function(x) {}" #' @export #' @rdname obfuscate obfuscated <- function(x) { structure(x, class = "httr2_obfuscated") } #' @export str.httr2_obfuscated <- function(object, ...) { cat(" ", glue('obfuscated("{object}")\n'), sep = "") } #' @export print.httr2_obfuscated <- function(x, ...) { cat(glue('obfuscated("{x}")\n')) invisible(x) } unobfuscate <- function(x) { if (inherits(x, "httr2_obfuscated")) { secret_decrypt(x, obfuscate_key()) } else if (is.list(x)) { x[] <- lapply(x, unobfuscate) x } else { x } } attr(unobfuscate, "srcref") <- "function(x) {}" # Helpers ----------------------------------------------------------------- secret_encrypt_raw <- function(dec, key, error_call = caller_env()) { key <- as_key(key, error_call = error_call) enc <- openssl::aes_ctr_encrypt(dec, key) c(attr(enc, "iv"), enc) } secret_decrypt_raw <- function(enc, key, error_call = caller_env()) { key <- as_key(key, error_call = error_call) iv <- enc[1:16] value <- enc[-(1:16)] openssl::aes_ctr_decrypt(value, key, iv = iv) } as_key <- function(x, error_call = caller_env()) { if (inherits(x, "AsIs") && is_string(x)) { base64_url_decode(x) } else if (is.raw(x)) { x } else if (is_string(x)) { secret_get_key(x, call = error_call) } else { cli::cli_abort( paste0( "{.arg key} must be a raw vector containing the key, ", "a string giving the name of an env var, ", "or a string wrapped in {.fn I} that contains the base64url encoded key." ), call = error_call ) } } httr2/R/req-verbose.R0000644000176200001440000001004014761707310014074 0ustar liggesusers#' Show extra output when request is performed #' #' @description #' `req_verbose()` uses the following prefixes to distinguish between #' different components of the HTTP requests and responses: #' #' * `* ` informative curl messages #' * `->` request headers #' * `>>` request body #' * `<-` response headers #' * `<<` response body #' #' @inheritParams req_perform #' @param header_req,header_resp Show request/response headers? #' @param body_req,body_resp Should request/response bodies? When the response #' body is compressed, this will show the number of bytes received in #' each "chunk". #' @param info Show informational text from curl? This is mainly useful #' for debugging https and auth problems, so is disabled by default. #' @param redact_headers Redact confidential data in the headers? Currently #' redacts the contents of the Authorization header to prevent you from #' accidentally leaking credentials when debugging/reprexing. #' @seealso [req_perform()] which exposes a limited subset of these options #' through the `verbosity` argument and [with_verbosity()] which allows you #' to control the verbosity of requests deeper within the call stack. #' @returns A modified HTTP [request]. #' @export #' @examples #' # Use `req_verbose()` to see the headers that are sent back and forth when #' # making a request #' resp <- request("https://httr2.r-lib.org") |> #' req_verbose() |> #' req_perform() #' #' # 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) { check_request(req) # force all arguments list(header_req, header_resp, body_req, body_resp, info, redact_headers) debug <- function(type, msg) { # Set in req_prepare() headers <- req$state$headers if (info && type == 0) { verbose_info("* ", msg) } else if (header_resp && type == 1) { verbose_header("<- ", msg) } else if (header_req && type == 2) { to_redact <- attr(headers, "redact") verbose_header("-> ", msg, redact_headers, to_redact = to_redact) } else if (body_resp && type == 3) { # handled in handle_resp() } else if (body_req && type == 4) { verbose_body(">> ", msg, headers$`content-type`) } } req <- req_options(req, debugfunction = debug, verbose = TRUE) req <- req_policies(req, show_body = body_resp) req } # helpers ----------------------------------------------------------------- verbose_info <- function(prefix, x) { x <- readBin(x, character()) lines <- unlist(strsplit(x, "\r?\n", useBytes = TRUE)) cli::cat_line(prefix, lines) } verbose_header <- function(prefix, x, redact = TRUE, to_redact = NULL) { x <- readBin(x, character()) lines <- unlist(strsplit(x, "\r?\n", useBytes = TRUE)) 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]])) } else { cli::cat_line(prefix, line) } } } verbose_body <- function(prefix, x, content_type) { show_body( x, content_type, prefix = prefix, pretty_json = getOption("httr2_pretty_json", TRUE) ) } # Testing helpers ------------------------------------------------------------- req_verbose_test <- function(req) { # Reset all headers that otherwise might vary req <- req_headers( req, `Accept-Encoding` = "", Accept = "", Host = "http://example.com", `User-Agent` = "" ) req <- req_options(req, forbid_reuse = TRUE) req } transform_verbose_response <- function(lines) { lines <- gsub(example_url(), "/", lines, fixed = TRUE) lines <- lines[!grepl("^<- (Date|ETag|Content-Length):", lines)] lines <- lines[!grepl("\\* Closing connection", lines)] lines } httr2/R/oauth-flow-jwt.R0000644000176200001440000000600414666617033014544 0ustar liggesusers#' OAuth with a bearer JWT (JSON web token) #' #' @description #' Authenticate using a **Bearer JWT** (JSON web token) as an authorization #' grant to get an access token, as defined by `r rfc(7523, 2.1)`. #' It is often used for service accounts, accounts that are used primarily in #' automated environments. #' #' Learn more about the overall OAuth authentication flow in #' . #' #' @export #' @family OAuth flows #' @inheritParams req_perform #' @inheritParams req_oauth_auth_code #' @param claim A list of claims. If all elements of the claim set are static #' apart from `iat`, `nbf`, `exp`, or `jti`, provide a list and #' [jwt_claim()] will automatically fill in the dynamic components. #' If other components need to vary, you can instead provide a zero-argument #' callback function which should call `jwt_claim()`. #' @param signature Function use to sign `claim`, e.g. [jwt_encode_sig()]. #' @param signature_params Additional arguments passed to `signature`, e.g. #' `size`, `header`. #' @returns `req_oauth_bearer_jwt()` returns a modified HTTP [request] that will #' use OAuth; `oauth_flow_bearer_jwt()` returns an [oauth_token]. #' @examples #' req_auth <- function(req) { #' req_oauth_bearer_jwt( #' req, #' client = oauth_client("example", "https://example.com/get_token"), #' claim = jwt_claim() #' ) #' } #' #' 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()) { params <- list( client = client, claim = claim, signature = signature, signature_params = signature_params, scope = scope, token_params = token_params ) cache <- cache_mem(client, claim) req_oauth(req, "oauth_flow_bearer_jwt", params, cache = cache) } #' @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()) { check_installed("jose") if (is.null(client$key)) { cli::cli_abort("JWT flow requires {.arg client} with a key.") } if (is_list(claim)) { claim <- exec("jwt_claim", !!!claim) } else if (is.function(claim)) { claim <- claim() } else { cli::cli_abort("{.arg claim} must be a list or function.") } 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, grant_type = "urn:ietf:params:oauth:grant-type:jwt-bearer", assertion = jwt, scope = scope, !!!token_params ) } httr2/R/req-perform-iterative.R0000644000176200001440000001463614753125205016110 0ustar liggesusers#' Perform requests iteratively, generating new requests from previous responses #' #' @description #' `req_perform_iterative()` iteratively generates and performs requests, #' using a callback function, `next_req`, to define the next request based on #' the current request and response. You will probably want to pair it with an #' [iteration helper][iterate_with_offset] and use a #' [multi-response handler][resps_successes] to process the result. #' #' # `next_req()` #' #' The key piece that makes `req_perform_iterative()` work is the `next_req()` #' argument. For most common cases, you can use one of the canned helpers, #' like [iterate_with_offset()]. If, however, the API you're wrapping uses a #' different pagination system, you'll need to write your own. This section #' gives some advice. #' #' Generally, your function needs to inspect the response, extract some data #' from it, then use that to modify the previous request. For example, imagine #' that the response returns a cursor, which needs to be added to the body of #' the request. The simplest version of this function might look like this: #' #' ```R #' next_req <- function(resp, req) { #' cursor <- resp_body_json(resp)$next_cursor #' req |> req_body_json_modify(cursor = cursor) #' } #' ``` #' #' There's one problem here: if there are no more pages to return, then #' `cursor` will be `NULL`, but `req_body_json_modify()` will still generate #' a meaningful request. So we need to handle this specifically by #' returning `NULL`: #' #' ```R #' next_req <- function(resp, req) { #' cursor <- resp_body_json(resp)$next_cursor #' if (is.null(cursor)) #' return(NULL) #' req |> req_body_json_modify(cursor = cursor) #' } #' ``` #' #' A value of `NULL` lets `req_perform_iterative()` know there are no more #' pages remaining. #' #' There's one last feature you might want to add to your iterator: if you #' know the total number of pages, then it's nice to let #' `req_perform_iterative()` know so it can adjust the progress bar. #' (This will only ever decrease the number of pages, not increase it.) #' You can signal the total number of pages by calling [signal_total_pages()], #' like this: #' #' ```R #' next_req <- function(resp, req) { #' body <- resp_body_json(resp) #' cursor <- body$next_cursor #' if (is.null(cursor)) #' return(NULL) #' #' signal_total_pages(body$pages) #' req |> req_body_json_modify(cursor = cursor) #' } #' ``` #' #' @inheritParams req_perform_sequential #' @param req The first [request] to perform. #' @param next_req A function that takes the previous response (`resp`) and #' request (`req`) and returns a [request] for the next page or `NULL` if #' the iteration should terminate. See below for more details. #' @param max_reqs The maximum number of requests to perform. Use `Inf` to #' perform all requests until `next_req()` returns `NULL`. #' @param on_error What should happen if a request fails? #' #' * `"stop"`, the default: stop iterating with an error. #' * `"return"`: stop iterating, returning all the successful responses so #' far, as well as an error object for the failed request. #' @param path Optionally, path to save the body of request. This should be #' a glue string that uses `{i}` to distinguish different requests. #' Useful for large responses because it avoids storing the response in #' memory. #' @return #' A list, at most length `max_reqs`, containing [response]s and possibly one #' error object, if `on_error` is `"return"` and one of the requests errors. #' If present, the error object will always be the last element in the list. #' #' Only httr2 errors are captured; see [req_error()] for more details. #' @export #' @examples #' req <- request(example_url()) |> #' req_url_path("/iris") |> #' req_throttle(10) |> #' req_url_query(limit = 5) #' #' resps <- req_perform_iterative(req, iterate_with_offset("page_index")) #' #' data <- resps |> resps_data(function(resp) { #' data <- resp_body_json(resp)$data #' data.frame( #' Sepal.Length = sapply(data, `[[`, "Sepal.Length"), #' Sepal.Width = sapply(data, `[[`, "Sepal.Width"), #' Petal.Length = sapply(data, `[[`, "Petal.Length"), #' Petal.Width = sapply(data, `[[`, "Petal.Width"), #' Species = sapply(data, `[[`, "Species") #' ) #' }) #' str(data) 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) check_string(path, allow_empty = FALSE, allow_null = TRUE) on_error <- arg_match(on_error) get_path <- function(i) { if (is.null(path)) { NULL } else { glue::glue(path) } } progress <- create_progress_bar( total = max_reqs, name = "Iterating", config = progress ) resps <- vector("list", length = if (is.finite(max_reqs)) max_reqs else 100) i <- 1L tryCatch({ repeat { httr2_error <- switch(on_error, stop = function(cnd) zap(), return = function(cnd) cnd ) resp <- try_fetch( req_perform(req, path = get_path(i)), httr2_error = httr2_error ) resps[[i]] <- resp if (on_error == "return" && is_error(resp)) { break } progress$update() withCallingHandlers( { req <- next_req(resp = resp, req = req) }, httr2_total_pages = function(cnd) { # Allow next_req() to shrink the number of pages remaining # Most important in max_req = Inf case if (cnd$n < max_reqs) { max_reqs <<- cnd$n progress$update(total = max_reqs, inc = 0) } } ) if (is.null(req) || i >= max_reqs) { break } check_request(req, arg = "next_req()") i <- i + 1L if (i > length(resps)) { 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}." ) }) progress$done() if (i < length(resps)) { resps <- resps[seq_len(i)] } resps } httr2/R/req-template.R0000644000176200001440000000723114737047606014262 0ustar liggesusers#' Set request method/path from a template #' #' @description #' Many APIs document their methods with a lightweight template mechanism #' that looks like `GET /user/{user}` or `POST /organisation/:org`. This #' function makes it easy to copy and paste such snippets and retrieve template #' variables either from function arguments or the current environment. #' #' `req_template()` will append to the existing path so that you can set a #' base url in the initial [request()]. This means that you'll generally want #' to avoid multiple `req_template()` calls on the same request. #' #' @inheritParams req_perform #' @param template A template string which consists of a optional HTTP method #' and a path containing variables labelled like either `:foo` or `{foo}`. #' @param ... Template variables. #' @param .env Environment in which to look for template variables not found #' in `...`. Expert use only. #' @returns A modified HTTP [request]. #' @export #' @examples #' httpbin <- request(example_url()) #' #' # You can supply template parameters in `...` #' httpbin |> req_template("GET /bytes/{n}", n = 100) #' #' # or you retrieve from the current environment #' n <- 200 #' httpbin |> req_template("GET /bytes/{n}") #' #' # Existing path is preserved: #' httpbin_test <- request(example_url()) |> req_url_path("/test") #' name <- "id" #' value <- "a3fWa" #' httpbin_test |> req_template("GET /set/{name}/{value}") req_template <- function(req, template, ..., .env = parent.frame()) { check_request(req) check_string(template) pieces <- strsplit(template, " ", fixed = TRUE)[[1]] if (length(pieces) == 1) { template <- pieces[[1]] } else if (length(pieces) == 2) { req <- req_method(req, pieces[[1]]) template <- pieces[[2]] } else { cli::cli_abort(c( "Can't parse template {.arg template}.", i = "Should have form like 'GET /a/b/c' or 'a/b/c/'." )) } dots <- list2(...) if (length(dots) > 0 && !is_named(dots)) { cli::cli_abort("All elements of {.arg ...} must be named.") } path <- template_process(template, dots, .env) req_url_path_append(req, path) } 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) for (i in seq_along(vars)) { pattern <- switch(type, colon = paste0(":", vars[[i]]), uri = paste0("{", vars[[i]], "}") ) template <- gsub(pattern, vals[[i]], template, fixed = TRUE) } template } template_val <- function(name, dots, env, error_call = caller_env()) { if (has_name(dots, name)) { val <- dots[[name]] } else if (env_has(env, name, inherit = TRUE)) { val <- env_get(env, name, inherit = TRUE) } else { cli::cli_abort( "Can't find template variable {.str {name}}.", call = error_call ) } if (!is.atomic(val) || length(val) != 1) { cli::cli_abort( "Template variable {.str {name}} is not a simple scalar value.", call = error_call ) } as.character(val) } template_vars <- function(x, type) { if (type == "none") return(character()) pattern <- switch(type, colon = ":([a-zA-Z0-9_]+)", uri = "\\{(\\w+?)\\}" ) loc <- gregexpr(pattern, x, perl = TRUE)[[1]] start <- attr(loc, "capture.start") end <- start + attr(loc, "capture.length") - 1 substring(x, start, end) } template_type <- function(x) { if (grepl("\\{\\w+?\\}", x)) { "uri" } else if (grepl(":", x, fixed = TRUE)) { "colon" } else { "none" } } httr2/R/resp-stream.R0000644000176200001440000003517314761705464014132 0ustar liggesusers#' Read a streaming body a chunk at a time #' #' @description #' * `resp_stream_raw()` retrieves bytes (`raw` vectors). #' * `resp_stream_lines()` retrieves lines of text (`character` vectors). #' * `resp_stream_sse()` retrieves a single [server-sent #' event](https://developer.mozilla.org/en-US/docs/Web/API/Server-sent_events/Using_server-sent_events). #' * `resp_stream_aws()` retrieves a single event from an AWS stream #' (i.e. mime type `application/vnd.amazon.eventstream``). #' #' Use `resp_stream_is_complete()` to determine if there is further data #' waiting on the stream. #' #' @returns #' * `resp_stream_raw()`: a raw vector. #' * `resp_stream_lines()`: a character vector. #' * `resp_stream_sse()`: a list with components `type`, `data`, and `id`. #' `type`, `data`, and `id` are always strings; `data` and `id` may be empty #' strings. #' * `resp_stream_aws()`: a list with components `headers` and `body`. #' `body` will be automatically parsed if the event contents a `:content-type` #' header with `application/json`. #' #' `resp_stream_sse()` and `resp_stream_aws()` will return `NULL` to signal that #' the end of the stream has been reached or, if in nonblocking mode, that #' no event is currently available. #' @export #' @param resp,con A streaming [response] created by [req_perform_connection()]. #' @param kb How many kilobytes (1024 bytes) of data to read. #' @order 1 #' @examples #' req <- request(example_url()) |> #' req_template("GET /stream/:n", n = 5) #' #' con <- req |> req_perform_connection() #' while (!resp_stream_is_complete(con)) { #' lines <- con |> resp_stream_lines(2) #' cat(length(lines), " lines received\n", sep = "") #' } #' close(con) #' #' # You can also see what's happening by setting verbosity #' con <- req |> req_perform_connection(verbosity = 2) #' while (!resp_stream_is_complete(con)) { #' lines <- con |> resp_stream_lines(2) #' } #' close(con) resp_stream_raw <- function(resp, kb = 32) { check_streaming_response(resp) conn <- resp$body out <- readBin(conn, raw(), kb * 1024) if (resp_stream_show_body(resp)) { log_stream("Streamed ", length(out), " bytes") cli::cat_line() } out } #' @export #' @rdname resp_stream_raw #' @param lines The maximum number of lines to return at once. #' @param warn Like [readLines()]: warn if the connection ends without a final #' EOL. #' @order 1 resp_stream_lines <- function(resp, lines = 1, max_size = Inf, warn = TRUE) { check_streaming_response(resp) check_number_whole(lines, min = 0, allow_infinite = TRUE) check_number_whole(max_size, min = 1, allow_infinite = TRUE) check_logical(warn) if (lines == 0) { # If you want to do that, who am I to judge? return(character()) } encoding <- resp_encoding(resp) lines_read <- character(0) while (lines > 0) { line <- resp_stream_oneline(resp, max_size, warn, encoding) if (length(line) == 0) { # No more data, either because EOF or req_perform_connection(blocking=FALSE). # Either way we're done break } lines_read <- c(lines_read, line) lines <- lines - 1 } if (resp_stream_show_body(resp)) { log_stream(lines_read) } lines_read } #' @param max_size The maximum number of bytes to buffer; once this number of #' bytes has been exceeded without a line/event boundary, an error is thrown. #' @export #' @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) if (is.null(event_bytes)) { return() } if (resp_stream_show_buffer(resp)) { log_stream( cli::rule("Raw server sent event"), "\n", rawToChar(event_bytes), prefix = "* " ) } event <- parse_event(event_bytes) if (!is.null(event)) break } if (resp_stream_show_body(resp)) { for (key in names(event)) { log_stream(cli::style_bold(key), ": ", pretty_json(event[[key]])) } cli::cat_line() } event } #' @export #' @rdname resp_stream_raw resp_stream_is_complete <- function(resp) { check_response(resp) length(resp$cache$push_back) == 0 && !isIncomplete(resp$body) } #' @export #' @param ... Not used; included for compatibility with generic. #' @rdname resp_stream_raw #' @order 3 close.httr2_response <- function(con, ...) { check_response(con) if (inherits(con$body, "connection") && isValid(con$body)) { close(con$body) } invisible() } resp_stream_oneline <- function(resp, max_size, warn, encoding) { repeat { line_bytes <- resp_boundary_pushback(resp, max_size, find_line_boundary, include_trailer = TRUE) if (is.null(line_bytes)) { return(character()) } eat_next_lf <- resp$cache$resp_stream_oneline_eat_next_lf resp$cache$resp_stream_oneline_eat_next_lf <- FALSE if (identical(line_bytes, as.raw(0x0A)) && isTRUE(eat_next_lf)) { # We hit that special edge case, see below next } # If ending on \r, there's a special edge case here where if the # next line begins with \n, that byte should be eaten. if (utils::tail(line_bytes, 1) == 0x0D) { resp$cache$resp_stream_oneline_eat_next_lf <- TRUE } # Use `resp$body` as the variable name so that if warn=TRUE, you get # "incomplete final line found on 'resp$body'" as the warning message `resp$body` <- line_bytes line_con <- rawConnection(`resp$body`) on.exit(close(line_con)) # readLines chomps the trailing newline. I assume this is desirable. raw_text <- readLines(line_con, n = 1, warn = warn) # Use iconv to convert from whatever encoding is specified in the # response header, to UTF-8 return(iconv(raw_text, encoding, "UTF-8")) } } find_line_boundary <- function(buffer) { if (length(buffer) == 0) { return(NULL) } # Look left 1 byte right1 <- c(utils::tail(buffer, -1), 0x00) crlf <- buffer == 0x0D & right1 == 0x0A cr <- buffer == 0x0D lf <- buffer == 0x0A all <- which(crlf | cr | lf) if (length(all) == 0) { return(NULL) } first <- all[[1]] if (crlf[first]) { return(first + 2) } else { return(first + 1) } } # Function to find the first double line ending in a buffer, or NULL if no # double line ending is found # # Example: # find_event_boundary(charToRaw("data: 1\n\nid: 12345")) # Returns: # list( # matched = charToRaw("data: 1\n\n"), # remaining = charToRaw("id: 12345") # ) find_event_boundary <- function(buffer) { if (length(buffer) < 2) { return(NULL) } # leftX means look behind by X bytes. For example, left1[2] equals buffer[1]. # Any attempt to read past the beginning of the buffer results in 0x00. left1 <- c(0x00, utils::head(buffer, -1)) left2 <- c(0x00, utils::head(left1, -1)) left3 <- c(0x00, utils::head(left2, -1)) boundary_end <- which( (left1 == 0x0A & buffer == 0x0A) | # \n\n (left1 == 0x0D & buffer == 0x0D) | # \r\r (left3 == 0x0D & left2 == 0x0A & left1 == 0x0D & buffer == 0x0A) # \r\n\r\n ) if (length(boundary_end) == 0) { return(NULL) # No event boundary found } boundary_end <- boundary_end[1] # Take the first occurrence split_at <- boundary_end + 1 # Split at one after the boundary split_at } # Splits a buffer into the part before `split_at`, and the part starting at # `split_at`. It's possible for either of the returned parts to be zero-length # (i.e. if `split_at` is 1 or length(buffer)+1). split_buffer <- function(buffer, split_at) { # Return a list with the event data and the remaining buffer list( matched = slice(buffer, end = split_at), remaining = slice(buffer, start = split_at) ) } # @param max_size Maximum number of bytes to look for a boundary before throwing an error # @param boundary_func A function that takes a raw vector and returns NULL if no # boundary was detected, or one position PAST the end of the first boundary in # the vector # @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) { check_streaming_response(resp) check_number_whole(max_size, min = 1, allow_infinite = TRUE) chunk_size <- min(max_size + 1, 1024) # Grab data left over from last resp_stream_sse() call (if any) buffer <- resp$cache$push_back %||% raw() resp$cache$push_back <- raw() 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 = "* ") } } else { print_buffer <- function(buf, label) {} } # Read chunks until we find an event or reach the end of input repeat { # Try to find an event boundary using the data we have print_buffer(buffer, "Buffer to parse") split_at <- boundary_func(buffer) if (!is.null(split_at)) { result <- split_buffer(buffer, split_at) # We found a complete event print_buffer(result$matched, "Matched data") print_buffer(result$remaining, "Remaining buffer") resp$cache$push_back <- result$remaining return(result$matched) } if (length(buffer) > max_size) { # Keep the buffer in place, so that if the user tries resp_stream_sse # again, they'll get the same error rather than reading the stream # having missed a bunch of bytes. resp$cache$push_back <- buffer cli::cli_abort("Streaming read exceeded size limit of {max_size}") } # We didn't have enough data. Attempt to read more 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) ) print_buffer(chunk, "Received chunk") if (length(chunk) == 0) { if (!isIncomplete(resp$body)) { # We've truly reached the end of the connection; no more data is coming if (length(buffer) == 0) { return(NULL) } else { if (include_trailer) { return(buffer) } else { cli::cli_warn("Premature end of input; ignoring final partial chunk") return(NULL) } } } else { # More data might come later; store the buffer and return NULL print_buffer(buffer, "Storing incomplete buffer") resp$cache$push_back <- buffer return(NULL) } } # More data was received; combine it with existing buffer and continue the # loop to try parsing again buffer <- c(buffer, chunk) print_buffer(buffer, "Combined buffer") } } # 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) Encoding(str_data) <- "UTF-8" } else { # for testing str_data <- event_data } # The stream must then be parsed by reading everything line by line, with a # U+000D CARRIAGE RETURN U+000A LINE FEED (CRLF) character pair, a single # U+000A LINE FEED (LF) character not preceded by a U+000D CARRIAGE RETURN # (CR) character, and a single U+000D CARRIAGE RETURN (CR) character not # followed by a U+000A LINE FEED (LF) character being the ways in # which a line can end. lines <- strsplit(str_data, "\r\n|\r|\n")[[1]] # When a stream is parsed, a data buffer, an event type buffer, and a # last event ID buffer must be associated with it. They must be initialized # to the empty string. data <- "" type <- "" last_id <- "" # If the line starts with a U+003A COLON character (:) - Ignore the line. lines <- lines[!grepl("^:", lines)] # If the line contains a U+003A COLON character (:) # * Collect the characters on the line before the first U+003A COLON # character (:), and let field be that string. # * Collect the characters on the line after the first U+003A COLON character # (:), and let value be that string. If value starts with a U+0020 SPACE # character, remove it from value. m <- regexec("([^:]*)(: ?)?(.*)", lines) matches <- regmatches(lines, m) keys <- c("event", vapply(matches, function(x) x[2], character(1))) values <- c("message", vapply(matches, function(x) x[4], character(1))) for (i in seq_along(matches)) { key <- matches[[i]][2] value <- matches[[i]][4] if (key == "event") { # Set the event type buffer to field value. type <- value } else if (key == "data") { # Append the field value to the data buffer, then append a single # U+000A LINE FEED (LF) character to the data buffer. data <- paste0(data, value, "\n") } else if (key == "id") { # If the field value does not contain U+0000 NULL, then set the last # event ID buffer to the field value. Otherwise, ignore the field. last_id <- value } } # If the data buffer is an empty string, set the data buffer and the event # type buffer to the empty string and return. if (data == "") { return() } # If the data buffer's last character is a U+000A LINE FEED (LF) character, # then remove the last character from the data buffer. if (grepl("\n$", data)) { data <- substr(data, 1, nchar(data) - 1) } if (type == "") { type <- "message" } list( type = type, data = data, id = last_id ) } # Helpers ---------------------------------------------------- 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") { stop_input_type( resp, "a streaming HTTP response object", allow_null = FALSE, arg = arg, call = call ) } if (!isValid(resp$body)) { cli::cli_abort("{.arg {arg}} has already been closed.", call = call) } } # isOpen doesn't work for two reasons: # 1. It errors if con has been closed, rather than returning FALSE # 2. If returns TRUE if con has been closed and a new connection opened # # So instead we retrieve the connection from its number and compare to the # original connection. This works because connections have an undocumented # external pointer. isValid <- function(con) { tryCatch( identical(getConnection(con), con), error = function(cnd) FALSE ) } resp_stream_show_body <- function(resp) { resp$request$policies$show_streaming_body %||% FALSE } resp_stream_show_buffer <- function(resp) { resp$request$policies$show_streaming_buffer %||% FALSE } httr2/R/req-progress.R0000644000176200001440000000326114753125205014300 0ustar liggesusers#' Add a progress bar to long downloads or uploads #' #' When uploading or downloading a large file, it's often useful to #' provide a progress bar so that you know how long you have to wait. #' #' @inheritParams req_headers #' @param type Type of progress to display: either number of bytes uploaded #' or downloaded. #' @export #' @examples #' req <- request("https://r4ds.s3.us-west-2.amazonaws.com/seattle-library-checkouts.csv") |> #' req_progress() #' #' \dontrun{ #' path <- tempfile() #' req |> req_perform(path = path) #' } 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) ) } make_progress <- function(type, frame = caller_env()) { force(type) init <- FALSE function(down, up) { if (type == "down") { total <- down[[1]] now <- down[[2]] verb <- "Downloading" } else { total <- up[[1]] now <- up[[2]] verb <- "Uploading" } if (total == 0 && now == 0) { init <<- FALSE return(TRUE) } if (!init) { init <<- TRUE if (total == 0) { cli::cli_progress_bar( format = paste0(verb, " {cli::pb_spin}"), .envir = frame ) } else { cli::cli_progress_bar( format = paste0(verb, " {cli::pb_percent} {cli::pb_bar} {cli::pb_eta}"), total = total, .envir = frame ) } } if (now < total && total > 0) { cli::cli_progress_update(set = now, .envir = frame) } else { cli::cli_progress_done(.envir = frame) } TRUE } } httr2/R/req-auth-aws.R0000644000176200001440000001626314753125205014173 0ustar liggesusers#' Sign a request with the AWS SigV4 signing protocol #' #' This is a custom auth protocol implemented by AWS. #' #' @inheritParams req_perform #' @param aws_access_key_id,aws_secret_access_key AWS key and secret. #' @param aws_session_token AWS session token, if required. #' @param aws_service,aws_region The AWS service and region to use for the #' request. If not supplied, will be automatically parsed from the URL #' hostname. #' @export #' @examplesIf httr2:::has_paws_credentials() #' creds <- paws.common::locate_credentials() #' model_id <- "anthropic.claude-3-5-sonnet-20240620-v1:0" #' req <- request("https://bedrock-runtime.us-east-1.amazonaws.com") #' # https://docs.aws.amazon.com/bedrock/latest/APIReference/API_runtime_Converse.html #' req <- req_url_path_append(req, "model", model_id, "converse") #' req <- req_body_json(req, list( #' messages = list(list( #' role = "user", #' content = list(list(text = "What's your name?")) #' )) #' )) #' 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 #' ) #' 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) { check_request(req) check_string(aws_access_key_id) check_string(aws_secret_access_key) check_string(aws_session_token, allow_null = TRUE) check_string(aws_service, allow_null = TRUE) check_string(aws_region, allow_null = TRUE) req_auth_sign(req, fun = auth_aws_sign, params = list( aws_access_key_id = aws_access_key_id, aws_secret_access_key = aws_secret_access_key, aws_session_token = aws_session_token, aws_service = aws_service, aws_region = aws_region ) ) } auth_aws_sign <- function(req, aws_access_key_id, aws_secret_access_key, aws_session_token = NULL, aws_service = NULL, aws_region = NULL) { 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, current_time = current_time, aws_session_token = aws_session_token, body_sha256 = body_sha256 ) signature <- aws_v4_signature( method = req_method_get(req), url = url_parse(req$url), headers = req$headers, body_sha256 = body_sha256, current_time = current_time, aws_service = aws_service, aws_region = aws_region, aws_access_key_id = aws_access_key_id, aws_secret_access_key = aws_secret_access_key ) req_headers(req, Authorization = signature$Authorization) } req_aws_headers <- function(req, current_time, aws_session_token, body_sha256) { RequestDateTime <- format(current_time, "%Y%m%dT%H%M%SZ", tz = "UTC") req_headers( req, "x-amz-date" = RequestDateTime, "x-amz-security-token" = aws_session_token, .redact = "x-amz-security-token" ) } # 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) { 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_region <- aws_region %||% host[[2]] } # 1. Create a canonical request # https://docs.aws.amazon.com/IAM/latest/UserGuide/reference_sigv-create-signed-request.html#create-canonical-request HTTPMethod <- method CanonicalURI <- curl::curl_escape(url$path %||% "/") # AWS does not want / to be encoded here CanonicalURI <- gsub("%2F", "/", CanonicalURI, fixed = TRUE) if (is.null(url$query)) { CanonicalQueryString <- "" } else { sorted_query <- url$query[order(names(url$query))] CanonicalQueryString <- url_query_build(sorted_query) } headers$host <- url$hostname names(headers) <- tolower(names(headers)) headers <- headers[order(names(headers))] headers[] <- trimws(headers) headers[] <- gsub(" {2,}", " ", headers) CanonicalHeaders <- paste0(names(headers), ":", headers, "\n", collapse = "") SignedHeaders <- paste0(names(headers), collapse = ";") CanonicalRequest <- paste0( HTTPMethod, "\n", CanonicalURI, "\n", CanonicalQueryString, "\n", CanonicalHeaders, "\n", SignedHeaders, "\n", body_sha256 ) # 2. Create the hash of the canonical request # https://docs.aws.amazon.com/IAM/latest/UserGuide/reference_sigv-create-signed-request.html HashedCanonicalRequest <- openssl::sha256(CanonicalRequest) # 3. Create the string to sign # https://docs.aws.amazon.com/IAM/latest/UserGuide/reference_sigv-create-signed-request.html#create-string-to-sign Algorithm <- "AWS4-HMAC-SHA256" RequestDateTime <- format(current_time, "%Y%m%dT%H%M%SZ", tz = "UTC") 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", HashedCanonicalRequest ) # 4. Derive a signing key # https://docs.aws.amazon.com/IAM/latest/UserGuide/reference_sigv-create-signed-request.html#derive-signing-key DateKey <- hmac_sha256(paste0("AWS4", aws_secret_access_key), Date) DateRegionKey <- hmac_sha256(DateKey, aws_region) DateRegionServiceKey <- hmac_sha256(DateRegionKey, aws_service) SigningKey <- hmac_sha256(DateRegionServiceKey, "aws4_request") # 5. Calculate signature # https://docs.aws.amazon.com/IAM/latest/UserGuide/reference_sigv-create-signed-request.html#calculate-signature signature <- hmac_sha256(SigningKey, string_to_sign) signature <- paste0(as.character(signature), collapse = "") # 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) Authorization <- paste0( Algorithm, " ", "Credential=", credential, ",", "SignedHeaders=", SignedHeaders, ",", "Signature=", signature ) list( CanonicalRequest = CanonicalRequest, string_to_sign = string_to_sign, SigningKey = SigningKey, Authorization = Authorization ) } hmac_sha256 <- function(key, value) { openssl::sha256(charToRaw(value), key) } has_paws_credentials <- function() { tryCatch( { paws.common::locate_credentials() TRUE }, error = function(e) { FALSE } ) } httr2/R/req-throttle.R0000644000176200001440000001206014753653643014312 0ustar liggesusers#' Rate limit a request by automatically adding a delay #' #' @description #' Use `req_throttle()` to ensure that repeated calls to [req_perform()] never #' exceed a specified rate. #' #' Throttling is implemented using a "token bucket", which steadily fills up to #' a maximum of `capacity` tokens over `fill_time_s`. Each time you make a #' request, it takes a token out of the bucket, and if the bucket is empty, #' the request will wait until the bucket refills. This ensures that you never #' make more than `capacity` requests in `fill_time_s`, but you can make #' requests more quickly if the bucket is full. For example, if you have #' `capacity = 10` and `fill_time_s = 60`, you can make 10 requests #' without waiting, but the next request will wait 60 seconds. This gives the #' same average throttling rate as the previous approach, but gives you much #' better performance if you're only making a small number of requests. #' #' @inheritParams req_perform #' @param capacity The size of the bucket, i.e. the maximum number of #' tokens that can accumulate. #' @param rate For backwards compatibility, you can still specify the `rate`, #' which is converted to `capacity` by multiplying by `fill_time_s`. #' However, we recommend using `capacity` and `fill_time_s` as it gives more #' control. #' @param fill_time_s Time in seconds to fill the capacity. Defaults to 60s. #' @param realm A string that uniquely identifies the throttle pool to use #' (throttling limits always apply *per pool*). If not supplied, defaults #' to the hostname of the request. #' @returns A modified HTTP [request]. #' @seealso [req_retry()] for another way of handling rate-limited APIs. #' @export #' @examples #' # Ensure we never send more than 30 requests a minute #' req <- request(example_url()) |> #' req_throttle(capacity = 30, fill_time_s = 60) #' #' resp <- req_perform(req) #' throttle_status() #' resp <- req_perform(req) #' throttle_status() #' #' \dontshow{httr2:::throttle_reset()} req_throttle <- function(req, rate, capacity, fill_time_s = 60, realm = NULL) { check_request(req) check_exclusive(rate, capacity) if (missing(capacity)) { check_number_decimal(rate, min = 0) capacity <- rate * fill_time_s } else { check_number_whole(capacity, min = 0) } check_number_decimal(fill_time_s, min = 0) check_string(realm, allow_null = TRUE) realm <- realm %||% url_parse(req$url)$hostname the$throttle[[realm]] <- TokenBucket$new(capacity, fill_time_s) req_policies(req, throttle_realm = realm) } #' Display internal throttle status #' #' Sometimes useful for debugging. #' #' @return A data frame with three columns: #' * The `realm`. #' * Number of `tokens` remaining in the bucket. #' * Time `to_wait` in seconds for next token. #' @export #' @keywords internal throttle_status <- function() { # Trigger refill before displaying status walk(the$throttle, function(x) x$refill()) df <- data.frame( realm = env_names(the$throttle), tokens = floor(map_dbl(the$throttle, function(x) x$tokens)), to_wait = map_dbl(the$throttle, function(x) x$token_wait_time()), row.names = NULL, check.names = FALSE ) df[order(df$realm), , drop = FALSE] } throttle_reset <- function(realm = NULL) { if (is.null(realm)) { the$throttle <- new_environment() } else { env_unbind(the$throttle, realm) } invisible() } throttle_delay <- function(req) { if (!req_policy_exists(req, "throttle_realm")) { 0 } else { the$throttle[[req$policies$throttle_realm]]$take_token() } } throttle_deadline <- function(req) { unix_time() + throttle_delay(req) } throttle_return_token <- function(req) { the$throttle[[req$policies$throttle_realm]]$return_token() } TokenBucket <- R6::R6Class( "TokenBucket", public = list( capacity = NULL, fill_rate = NULL, last_fill = NULL, tokens = NULL, initialize = function(capacity, fill_time_s) { self$capacity <- capacity self$tokens <- capacity self$fill_rate <- capacity / fill_time_s self$last_fill <- unix_time() }, refill = function() { now <- unix_time() # Ensure if we call rapidly we don't accumulate FP errors if (now - self$last_fill < 1e-6) { return(self$tokens) } new_tokens <- (now - self$last_fill) * self$fill_rate self$tokens <- min(self$capacity, self$tokens + new_tokens) self$last_fill <- now self$tokens }, token_wait_time = function() { if (self$tokens >= 1) { 0 } else { self$refill() (1 - self$tokens) / self$fill_rate } }, # Returns the number of seconds that you need to wait to get it # Might cause tokens to drop below 0 temporarily so if you don't end up # waiting this long, you need to return the token take_token = function() { wait <- self$token_wait_time() self$tokens <- self$tokens - 1 wait }, return_token = function() { self$tokens <- min(self$tokens + 1, self$capacity) } ) ) httr2/R/url.R0000644000176200001440000002776114741230341012457 0ustar liggesusers#' Parse a URL into its component pieces #' #' `url_parse()` parses a URL into its component parts, powered by #' [curl::curl_parse_url()]. The parsing algorithm follows the specifications #' detailed in `r rfc(3986)`. #' #' @param url A string containing the URL to parse. #' @param base_url Use this as a parent, if `url` is a relative URL. #' @returns An S3 object of class `httr2_url` with the following components: #' `scheme`, `hostname`, `username`, `password`, `port`, `path`, `query`, and #' `fragment`. #' @export #' @family URL manipulation #' @examples #' url_parse("http://google.com/") #' url_parse("http://google.com:80/") #' url_parse("http://google.com:80/?a=1&b=2") #' url_parse("http://username@google.com:80/path;test?a=1&b=2#40") #' #' # You can parse a relative URL if you also provide a base url #' url_parse("foo", "http://google.com/bar/") #' url_parse("..", "http://google.com/bar/") url_parse <- function(url, base_url = NULL) { check_string(url) check_string(base_url, allow_null = TRUE) curl <- curl::curl_parse_url(url, baseurl = base_url, decode = FALSE) parsed <- list( scheme = curl$scheme, hostname = curl$host, username = curl$user, password = curl$password, port = curl$port, path = curl$path, query = if (length(curl$params)) as.list(curl$params), fragment = curl$fragment ) class(parsed) <- "httr2_url" parsed } #' Modify a URL #' #' @description #' Use `url_modify()` to modify any component of the URL, #' `url_modify_relative()` to modify with a relative URL, #' or `url_modify_query()` to modify individual query parameters. #' #' For `url_modify()`, components that aren't specified in the #' function call will be left as is; components set to `NULL` will be removed, #' and all other values will be updated. Note that removing `scheme` or #' `hostname` will create a relative URL. #' #' @param url,.url A string or [parsed URL][url_parse()]. #' @param scheme The scheme, typically either `http` or `https`. #' @param hostname The hostname, e.g., `www.google.com` or `posit.co`. #' @param username,password Username and password to embed in the URL. #' Not generally recommended but needed for some legacy applications. #' @param port An integer port number. #' @param path The path, e.g., `/search`. Paths must start with `/`, so this #' will be automatically added if omitted. #' @param query Either a query string or a named list of query components. #' @param fragment The fragment, e.g., `#section-1`. #' @return An object of the same type as `url`. #' @export #' @family URL manipulation #' @examples #' url_modify("http://hadley.nz", path = "about") #' url_modify("http://hadley.nz", scheme = "https") #' url_modify("http://hadley.nz/abc", path = "/cde") #' url_modify("http://hadley.nz/abc", path = "") #' url_modify("http://hadley.nz?a=1", query = "b=2") #' url_modify("http://hadley.nz?a=1", query = list(c = 3)) #' #' url_modify_query("http://hadley.nz?a=1&b=2", c = 3) #' url_modify_query("http://hadley.nz?a=1&b=2", b = NULL) #' url_modify_query("http://hadley.nz?a=1&b=2", a = 100) #' #' 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) { if (!is_string(url) && !is_url(url)) { stop_input_type(url, "a string or parsed URL") } string_url <- is_string(url) if (string_url) { url <- url_parse(url) } if (!leave_as_is(scheme)) check_string(scheme, allow_null = TRUE) if (!leave_as_is(hostname)) check_string(hostname, allow_null = TRUE) if (!leave_as_is(username)) check_string(username, allow_null = TRUE) if (!leave_as_is(password)) check_string(password, allow_null = TRUE) if (!leave_as_is(port)) check_number_whole(port, min = 1, allow_null = TRUE) if (!leave_as_is(path)) check_string(path, allow_null = TRUE) if (!leave_as_is(fragment)) check_string(fragment, allow_null = TRUE) if (is_string(query)) { query <- url_query_parse(query) } else if (is_named_list(query)) { for (nm in names(query)) { check_query_param(query[[nm]], paste0("query$", nm)) } } else if (!is.null(query) && !leave_as_is(query)) { stop_input_type(query, "a character vector, named list, or NULL") } new <- list( scheme = scheme, hostname = hostname, username = username, password = password, port = port, path = path, query = query, fragment = fragment ) new <- new[!map_lgl(new, leave_as_is)] url[names(new)] <- new if (string_url) { url_build(url) } else { url } } as_is <- quote(as_is) leave_as_is <- function(x) identical(x, as_is) #' @export #' @rdname url_modify #' @param relative_url A relative URL to append to the base URL. url_modify_relative <- function(url, relative_url) { string_url <- is_string(url) if (!string_url) { url <- url_build(url) } new_url <- url_parse(relative_url, base_url = url) if (string_url) { url_build(new_url) } else { new_url } } #' @export #' @rdname url_modify #' @param ... <[`dynamic-dots`][rlang::dyn-dots]> #' Name-value pairs that define query parameters. Each value must be either #' an atomic vector or `NULL` (which removes the corresponding parameters). #' If you want to opt out of escaping, wrap strings in `I()`. #' @param .multi Controls what happens when a value is a vector: #' #' * `"error"`, the default, throws an error. #' * `"comma"`, separates values with a `,`, e.g. `?x=1,2`. #' * `"pipe"`, separates values with a `|`, e.g. `?x=1|2`. #' * `"explode"`, turns each element into its own parameter, e.g. `?x=1&x=2` #' #' If none of these options work for your needs, you can instead supply a #' function that takes a character vector of argument values and returns a #' a single string. #' @param .space How should spaces in query params be escaped? The default, #' "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")) { if (!is_string(.url) && !is_url(.url)) { stop_input_type(.url, "a string or parsed URL") } string_url <- is_string(.url) if (string_url) { .url <- url_parse(.url) } new_query <- multi_dots(..., .multi = .multi, .space = .space) if (length(new_query) > 0) { .url$query <- modify_list(.url$query, !!!new_query) } if (string_url) { url_build(.url) } else { .url } } is_url <- function(x) inherits(x, "httr2_url") #' @export print.httr2_url <- function(x, ...) { cli::cli_text("{.cls {class(x)}} {url_build(x)}") if (!is.null(x$scheme)) { cli::cli_li("{.field scheme}: {x$scheme}") } if (!is.null(x$hostname)) { cli::cli_li("{.field hostname}: {x$hostname}") } if (!is.null(x$username)) { cli::cli_li("{.field username}: {x$username}") } if (!is.null(x$password)) { cli::cli_li("{.field password}: {x$password}") } if (!is.null(x$port)) { cli::cli_li("{.field port}: {x$port}") } if (!is.null(x$path)) { cli::cli_li("{.field path}: {x$path}") } if (!is.null(x$query)) { 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) cli::cli_li(paste0(" {.field ", names(x$query), "}: ", query_vals)) cli::cli_end(id) } if (!is.null(x$fragment)) { cli::cli_li("{.field fragment}: {x$fragment}") } invisible(x) } #' Build a string from a URL object #' #' This is the inverse of [url_parse()], taking a parsed URL object and #' turning it back into a string. #' #' @param url An URL object created by [url_parse]. #' @family URL manipulation #' @export url_build <- function(url) { if (!is_url(url)) { stop_input_type(url, "a parsed URL") } if (!is.null(url$query)) { query <- url_query_build(url$query) } else { query <- NULL } if (is.null(url$username) && is.null(url$password)) { user_pass <- NULL } else if (is.null(url$username) && !is.null(url$password)) { cli::cli_abort("Cannot set url {.arg password} without {.arg username}.") } else if (!is.null(url$username) && is.null(url$password)) { user_pass <- paste0(url$username, "@") } else { user_pass <- paste0(url$username, ":", url$password, "@") } if (!is.null(user_pass) || !is.null(url$hostname) || !is.null(url$port)) { authority <- paste0(user_pass, url$hostname) if (!is.null(url$port)) { authority <- paste0(authority, ":", url$port) } } else { authority <- NULL } if (is.null(url$path) || !startsWith(url$path, "/")) { url$path <- paste0("/", url$path) } prefix <- function(prefix, x) if (!is.null(x)) paste0(prefix, x) paste0( url$scheme, if (!is.null(url$scheme)) ":", if (!is.null(url$scheme) || !is.null(authority)) "//", authority, url$path, prefix("?", query), prefix("#", url$fragment) ) } #' Parse query parameters and/or build a string #' #' `url_query_parse()` parses a query string into a named list; #' `url_query_build()` builds a query string from a named list. #' #' @param query A string, when parsing; a named list when building. #' @export #' @examples #' str(url_query_parse("a=1&b=2")) #' #' url_query_build(list(x = 1, y = "z")) #' url_query_build(list(x = 1, y = 1:2), .multi = "explode") url_query_parse <- function(query) { check_string(query) query <- gsub("^\\?", "", query) # strip leading ?, if present params <- parse_name_equals_value(parse_delim(query, "&")) if (length(params) == 0) { return(NULL) } out <- as.list(curl::curl_unescape(params)) names(out) <- curl::curl_unescape(names(params)) out } #' @export #' @rdname url_query_parse #' @inheritParams url_modify_query url_query_build <- function(query, .multi = c("error", "comma", "pipe", "explode")) { if (!is_named_list(query)) { stop_input_type(query, "a named list") } query <- multi_dots(!!!query, .multi = .multi, error_arg = "query") elements_build(query, "Query", "&") } elements_build <- function(x, name, collapse, error_call = caller_env()) { if (!is_named_list(x)) { cli::cli_abort("{name} must be a named list.", call = error_call) } x <- compact(x) if (length(x) == 0) { return(NULL) } values <- map2_chr(x, names(x), format_query_param, error_call = error_call) names <- curl::curl_escape(names(x)) paste0(names, "=", values, collapse = collapse) } 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")) { unclass(x) } else { x <- format(x, scientific = FALSE, trim = TRUE, justify = "none") x <- curl::curl_escape(x) if (form) { x <- gsub("%20", "+", x, fixed = TRUE) } x } } check_query_param <- function(x, name, multi = FALSE, error_call = caller_env()) { if (inherits(x, "AsIs")) { if (multi) { ok <- is.character(x) expected <- "a character vector" } else { ok <- is.character(x) && length(x) == 1 expected <- "a single string" } arg <- paste0("Escaped query value `", name, "`") x <- unclass(x) } else { if (multi) { ok <- is.atomic(x) expected <- "an atomic vector" } else { ok <- is.atomic(x) && length(x) == 1 expected <- "a length-1 atomic vector" } arg <- paste0("Query value `", name, "`") } if (ok) { invisible() } else { stop_input_type(x, expected, arg = I(arg), call = error_call) } } httr2/R/req.R0000644000176200001440000000460514761707310012443 0ustar liggesusers#' Create a new HTTP request #' #' @description #' There are three steps needed to perform a HTTP request with httr2: #' #' 1. Create a request object with `request(url)` (this function). #' 2. Define its behaviour with `req_` functions, e.g.: #' * [req_headers()] to set header values. #' * [req_url_path()] and friends to modify the url. #' * [req_body_json()] and friends to add a body. #' * [req_auth_basic()] to perform basic HTTP authentication. #' * [req_oauth_auth_code()] to use the OAuth auth code flow. #' 3. Perform the request and fetch the response with [req_perform()]. #' #' @param base_url Base URL for request. #' @returns An HTTP request: an S3 list with class `httr2_request`. #' @export #' @examples #' request("http://r-project.org") request <- function(base_url) { new_request(base_url) } #' @export print.httr2_request <- function(x, ..., redact_headers = TRUE) { cli::cli_text("{.cls {class(x)}}") 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))) cli::cli_text("{.strong Body}: {req_body_info(x)}") bullets_with_header("Options:", x$options) bullets_with_header("Policies:", x$policies) invisible(x) } 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( list( url = url, method = method, headers = headers, body = body, fields = fields, options = options, policies = policies, state = new_environment() ), class = "httr2_request" ) } is_request <- function(x) { inherits(x, "httr2_request") } check_request <- function(req, arg = caller_arg(req), call = caller_env(), allow_null = FALSE) { if (!missing(req)) { if (is_request(req)) { return(invisible(NULL)) } if (allow_null && is.null(req)) { return(invisible(NULL)) } } stop_input_type( req, "an HTTP request object", allow_null = allow_null, arg = arg, call = call ) } httr2/R/req-headers.R0000644000176200001440000000507314761701552014056 0ustar liggesusers#' Modify request headers #' #' @description #' `req_headers()` allows you to set the value of any header. #' #' `req_headers_redacted()` is a variation that adds "redacted" headers, which #' httr2 avoids printing on the console. This is good practice for #' authentication headers to avoid accidentally leaking them in log files. #' #' @param .req A [request]. #' @param ... <[`dynamic-dots`][rlang::dyn-dots]> Name-value pairs of headers #' and their values. #' #' * Use `NULL` to reset a value to httr2's default #' * Use `""` to remove a header #' * Use a character vector to repeat a header. #' @param .redact A character vector of headers to redact. The Authorization #' header is always redacted. #' @returns A modified HTTP [request]. #' @export #' @examples #' req <- request("http://example.com") #' #' # Use req_headers() to add arbitrary additional headers to the request #' req |> #' req_headers(MyHeader = "MyValue") |> #' req_dry_run() #' #' # Repeated use overrides the previous value: #' req |> #' req_headers(MyHeader = "Old value") |> #' req_headers(MyHeader = "New value") |> #' req_dry_run() #' #' # Setting Accept to NULL uses curl's default: #' req |> #' req_headers(Accept = NULL) |> #' req_dry_run() #' #' # Setting it to "" removes it: #' req |> #' req_headers(Accept = "") |> #' req_dry_run() #' #' # If you need to repeat a header, provide a vector of values #' # (this is rarely needed, but is important in a handful of cases) #' req |> #' req_headers(HeaderName = c("Value 1", "Value 2", "Value 3")) |> #' req_dry_run() #' #' # If you have headers in a list, use !!! #' headers <- list(HeaderOne = "one", HeaderTwo = "two") #' req |> #' req_headers(!!!headers, HeaderThree = "three") |> #' req_dry_run() #' #' # Use `req_headers_redacted()`` to hide a header in the output #' req_secret <- req |> #' req_headers_redacted(Secret = "this-is-private") |> #' req_headers(Public = "but-this-is-not") #' #' req_secret #' req_secret |> req_dry_run() req_headers <- function(.req, ..., .redact = NULL) { check_request(.req) check_character(.redact, allow_null = TRUE) headers <- modify_list(.req$headers, ..., .ignore_case = TRUE) redact <- union(.redact, "Authorization") redact <- redact[tolower(redact) %in% tolower(names(headers))] redact <- sort(union(redact, attr(.req$headers, "redact"))) .req$headers <- new_headers(headers, redact) .req } #' @export #' @rdname req_headers req_headers_redacted <- function(.req, ...) { check_request(.req) headers <- list2(...) req_headers(.req, !!!headers, .redact = names(headers)) } httr2/R/verbosity.R0000644000176200001440000000323414761701552013701 0ustar liggesusers#' Temporarily set verbosity for all requests #' #' @description #' `with_verbosity()` and `local_verbosity()` are useful for debugging httr2 #' code buried deep inside another package, because they allow you to change #' the verbosity even when you don't have access to the request. #' #' Both functions work by temporarily setting the `httr2_verbosity` option. You #' can also control verbosity by setting the `HTTR2_VERBOSITY` environment #' variable. This has lower precedence than the option, but can be more easily #' changed outside of R. #' #' @inheritParams req_perform #' @param code Code to execture #' @returns `with_verbosity()` returns the result of evaluating `code`. #' `local_verbosity()` is called for its side-effect and invisibly returns #' the previous value of the option. #' @export #' @examples #' fun <- function() { #' request("https://httr2.r-lib.org") |> req_perform() #' } #' with_verbosity(fun()) #' #' fun <- function() { #' local_verbosity(2) #' # someotherpackage::fun() #' } with_verbosity <- function(code, verbosity = 1) { withr::local_options(httr2_verbosity = verbosity) code } #' @export #' @rdname with_verbosity #' @inheritParams local_mocked_responses local_verbosity <- function(verbosity, env = caller_env()) { withr::local_options(httr2_verbosity = verbosity, .local_envir = env) } httr2_verbosity <- function() { x <- getOption("httr2_verbosity") if (!is.null(x)) { return(x) } x <- Sys.getenv("HTTR2_VERBOSITY") if (nzchar(x)) { return(as.integer(x)) } # Hackish fallback for httr::with_verbose old <- getOption("httr_config") if (!is.null(old$options$debugfunction)) { 1 } else { 0 } } httr2/R/test.R0000644000176200001440000000400114753653643012633 0ustar liggesusersrequest_test <- function(template = "/get", ...) { req <- request(example_url()) req <- req_template(req, template, ..., .env = caller_env()) req } #' Code for examples #' #' @description #' `example_url()` runs a simple websever using the webfakes package with the #' following endpoints: #' #' * all the ones from the [webfakes::httpbin_app()] #' * `/iris`: paginate through the iris dataset. It has the query parameters #' `page` and `limit` to control the pagination. #' #' `example_github_client()` is an OAuth client for GitHub. #' #' @keywords internal #' @export example_url <- function(path = "/") { check_installed("webfakes") if (is_testing() && !interactive()) { testthat::skip_on_covr() } env_cache(the, "test_app", example_app()) the$test_app$url(path) } example_app <- function() { app <- webfakes::httpbin_app() # paginated iris endpoint app$get("/iris", function(req, res) { page <- req$query$page if (is.null(page)) page <- 1L page <- as.integer(page) page_size <- req$query$limit if (is.null(page_size)) page_size <- 20L page_size <- as.integer(page_size) n <- nrow(datasets::iris) start <- (page - 1L) * page_size + 1L end <- start + page_size - 1L ids <- rlang::seq2(start, end) data <- vctrs::vec_slice(datasets::iris, intersect(ids, seq_len(n))) res$set_status(200L)$send_json( object = list(data = data, count = n, pages = ceiling(n / page_size)), auto_unbox = TRUE, pretty = TRUE ) }) webfakes::new_app_process( app, opts = webfakes::server_opts(num_threads = 20, enable_keep_alive = TRUE) ) } #' @export #' @rdname example_url example_github_client <- function() { # oauth_client( id = "28acfec0674bb3da9f38", secret = obfuscated(paste0( "J9iiGmyelHltyxqrHXW41ZZPZamyUNxSX1_uKnv", "PeinhhxET_7FfUs2X0LLKotXY2bpgOMoHRCo" )), token_url = "https://github.com/login/oauth/access_token", name = "hadley-oauth-test" ) } httr2/R/req-perform-connection.R0000644000176200001440000001067614752760573016267 0ustar liggesusers#' Perform a request and return a streaming connection #' #' @description #' Use `req_perform_connection()` to perform a request if you want to stream the #' response body. A response returned by `req_perform_connection()` includes a #' connection as the body. You can then use [resp_stream_raw()], #' [resp_stream_lines()], or [resp_stream_sse()] to retrieve data a chunk at a #' time. Always finish up by closing the connection by calling #' `close(response)`. #' #' This is an alternative interface to [req_perform_stream()] that returns a #' [connection][base::connections] that you can use to pull the data, rather #' than providing callbacks that the data is pushed to. This is useful if you #' want to do other work in between handling inputs from the stream. #' #' @inheritParams req_perform #' @param blocking When retrieving data, should the connection block and wait #' for the desired information or immediately return what it has (possibly #' nothing)? #' @param verbosity How much information to print? This is a wrapper #' around [req_verbose()] that uses an integer to control verbosity: #' #' * `0`: no output #' * `1`: show headers #' * `2`: show headers and bodies as they're streamed #' * `3`: show headers, bodies, curl status messages, raw SSEs, and stream #' buffer management #' #' Use [with_verbosity()] to control the verbosity of requests that #' you can't affect directly. #' @export #' @examples #' req <- request(example_url()) |> #' req_url_path("/stream-bytes/32768") #' resp <- req_perform_connection(req) #' #' length(resp_stream_raw(resp, kb = 16)) #' length(resp_stream_raw(resp, kb = 16)) #' # When the stream has no more data, you'll get an empty result: #' length(resp_stream_raw(resp, kb = 16)) #' #' # Always close the response when you're done #' close(resp) #' #' # You can loop until complete with resp_stream_is_complete() #' resp <- req_perform_connection(req) #' while (!resp_stream_is_complete(resp)) { #' print(length(resp_stream_raw(resp, kb = 12))) #' } #' close(resp) req_perform_connection <- function(req, blocking = TRUE, verbosity = NULL) { check_request(req) check_bool(blocking) # verbosity checked in req_verbosity_connection req <- req_verbosity_connection(req, verbosity %||% httr2_verbosity()) req_prep <- req_prepare(req) handle <- req_handle(req_prep) the$last_request <- req the$last_response <- NULL tries <- 0 delay <- 0 max_tries <- retry_max_tries(req) deadline <- Sys.time() + retry_max_seconds(req) resp <- NULL while (tries < max_tries && Sys.time() < deadline) { retry_check_breaker(req, tries) sys_sleep(delay, "for retry backoff") if (!is.null(resp)) { close(resp) } resp <- req_perform_connection1(req, handle, blocking = blocking) if (retry_is_transient(req, resp)) { tries <- tries + 1 delay <- retry_after(req, resp, tries) signal(class = "httr2_retry", tries = tries, delay = delay) } else { break } } req_completed(req) if (!is_error(resp) && error_is_error(req, resp)) { # Read full body if there's an error conn <- resp$body resp$body <- read_con(conn) the$last_response <- resp close(conn) } handle_resp(req, resp) resp } # 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()) { 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, req_verbose(req), req_verbose(req, body_req = TRUE), req_verbose(req, body_req = TRUE, info = TRUE) ) if (verbosity > 1) { req <- req_policies( req, show_streaming_body = verbosity >= 2, show_streaming_buffer = verbosity >= 3 ) } req } req_perform_connection1 <- function(req, handle, blocking = TRUE) { the$last_request <- req the$last_response <- NULL signal(class = "httr2_perform_connection") err <- capture_curl_error({ body <- curl::curl(req$url, handle = handle) # Must open the stream in order to initiate the connection suppressWarnings(open(body, "rbf", blocking = blocking)) }) if (is_error(err)) { close(body) return(err) } curl_data <- curl::handle_data(handle) the$last_response <- create_response(req, curl_data, body) the$last_response } # Make open mockable open <- NULL httr2/R/req-method.R0000644000176200001440000000226014556444037013722 0ustar liggesusers#' Set HTTP method in request #' #' Use this function to use a custom HTTP method like `HEAD`, #' `DELETE`, `PATCH`, `UPDATE`, or `OPTIONS`. The default method is #' `GET` for requests without a body, and `POST` for requests with a body. #' #' @inheritParams req_perform #' @param method Custom HTTP method #' @returns A modified HTTP [request]. #' @export #' @examples #' request(example_url()) |> req_method("PATCH") #' request(example_url()) |> req_method("PUT") #' request(example_url()) |> req_method("HEAD") req_method <- function(req, method) { check_request(req) check_string(method) req$method <- toupper(method) req } # Used in req_handle req_method_apply <- function(req) { if (is.null(req$method)) { return(req) } switch(req$method, HEAD = req_options(req, nobody = TRUE), req_options(req, customrequest = req$method) ) } # Guess the method that curl will used based on options # https://everything.curl.dev/libcurl-http/requests#request-method req_method_get <- function(req) { if (!is.null(req$method)) { req$method } else if (has_name(req$options, "nobody")) { "HEAD" } else if (!is.null(req$body)) { "POST" } else { "GET" } } httr2/R/req-options.R0000644000176200001440000001034014753374623014135 0ustar liggesusers#' Set arbitrary curl options in request #' #' `req_options()` is for expert use only; it allows you to directly set #' libcurl options to access features that are otherwise not available in #' httr2. #' #' @inheritParams req_headers #' @param ... <[`dynamic-dots`][rlang::dyn-dots]> Name-value pairs. The name #' should be a valid curl option, as found in [curl::curl_options()]. #' @returns A modified HTTP [request]. #' @export #' @examples #' # req_options() allows you to access curl options that are not otherwise #' # exposed by httr2. For example, in very special cases you may need to #' # turn off SSL verification. This is generally a bad idea so httr2 doesn't #' # provide a convenient wrapper, but if you really know what you're doing #' # you can still access this libcurl option: #' req <- request("https://example.com") |> #' req_options(ssl_verifypeer = 0) req_options <- function(.req, ...) { check_request(.req) .req$options <- modify_list(.req$options, ...) .req } #' Set user-agent for a request #' #' This overrides the default user-agent set by httr2 which includes the #' version numbers of httr2, the curl package, and libcurl. #' #' @inheritParams req_perform #' @param string String to be sent in the `User-Agent` header. If `NULL`, #' will user default. #' @returns A modified HTTP [request]. #' @export #' @examples #' # Default user-agent: #' request("http://example.com") |> req_dry_run() #' #' request("http://example.com") |> req_user_agent("MyString") |> req_dry_run() #' #' # If you're wrapping in an API in a package, it's polite to set the #' # user agent to identify your package. #' request("http://example.com") |> #' req_user_agent("MyPackage (http://mypackage.com)") |> #' req_dry_run() req_user_agent <- function(req, string = NULL) { check_request(req) if (is.null(string)) { string <- env_cache(the, "user_agent", default_user_agent()) } else { check_string(string) } req_options(req, useragent = string) } default_user_agent <- function() { versions <- c( httr2 = as.character(utils::packageVersion("httr2")), `r-curl` = as.character(utils::packageVersion("curl")), libcurl = curl_system_version() ) paste0(names(versions), "/", versions, collapse = " ") } req_has_user_agent <- function(req) { has_name(req$options, "useragent") } curl_system_version <- function() curl::curl_version()$version #' Set time limit for a request #' #' An error will be thrown if the request does not complete in the time limit. #' #' @inheritParams req_perform #' @param seconds Maximum number of seconds to wait #' @returns A modified HTTP [request]. #' @export #' @examples #' # Give up after at most 10 seconds #' request("http://example.com") |> req_timeout(10) req_timeout <- function(req, seconds) { check_request(req) check_number_decimal(seconds) if (seconds < 0.001) { cli::cli_abort("{.arg seconds} must be >1 ms.") } req_options( req, timeout_ms = seconds * 1000, # reset value set by curl # https://github.com/jeroen/curl/blob/1bcf1ab3/src/handle.c#L159 connecttimeout = 0 ) } #' Use a proxy for a request #' #' @inheritParams req_perform #' @param url,port Location of proxy. #' @param username,password Login details for proxy, if needed. #' @param auth Type of HTTP authentication to use. Should be one of the #' following: `basic`, `digest`, `digest_ie`, `gssnegotiate`, `ntlm`, `any`. #' @examples #' # Proxy from https://www.proxynova.com/proxy-server-list/ #' \dontrun{ #' request("http://hadley.nz") |> #' req_proxy("20.116.130.70", 3128) |> #' req_perform() #' } #' @export req_proxy <- function(req, url, port = NULL, username = NULL, password = NULL, auth = "basic") { if (!is.null(username) || !is.null(password)) { proxyuserpwd <- paste0(username, ":", password) } else { proxyuserpwd <- NULL } check_number_whole(port, allow_null = TRUE) req_options( req, proxy = url, proxyport = port, proxyuserpwd = proxyuserpwd, proxyauth = auth_flags(auth) ) } auth_flags <- function(x = "basic") { constants <- c( basic = 1, digest = 2, gssnegotiate = 4, ntlm = 8, digest_ie = 16, any = -17 ) idx <- arg_match0(x, names(constants), arg_nm = "auth", error_call = caller_env()) constants[[idx]] } httr2/R/utils.R0000644000176200001440000001701114761701552013011 0ustar liggesusersbullets_with_header <- function(header, x) { if (length(x) == 0) { return() } cli::cli_text("{.strong {header}}") bullets(x) } bullets <- function(x) { as_simple <- function(x) { if (is.atomic(x) && length(x) == 1) { if (is.character(x)) { paste0('"', x, '"') } else { format(x) } } else { if (is_redacted(x)) { format(x) } else { paste0("<", class(x)[[1L]], ">") } } } vals <- map_chr(x, as_simple) names <- format(names(x)) names <- gsub(" ", "\u00a0", names, fixed = TRUE) for (i in seq_along(x)) { cli::cli_li("{.field {names[[i]]}}: {vals[[i]]}") } } modify_list <- function(.x, ..., .ignore_case = FALSE, error_call = caller_env()) { dots <- list2(...) if (length(dots) == 0) return(.x) if (!is_named(dots)) { cli::cli_abort( "All components of {.arg ...} must be named.", call = error_call ) } if (.ignore_case) { out <- .x[!tolower(names(.x)) %in% tolower(names(dots))] } else { out <- .x[!names(.x) %in% names(dots)] } out <- c(out, compact(dots)) if (length(out) == 0) { names(out) <- NULL } out } sys_sleep <- function(seconds, task, fps = 10, progress = NULL) { check_number_decimal(seconds) check_string(task) check_number_decimal(fps) progress <- progress %||% getOption("httr2_progress", !is_testing()) check_bool(progress, allow_null = TRUE) if (seconds == 0) { return(invisible()) } if (!progress) { cli::cli_alert("Waiting {round(seconds, 2)}s {task}") Sys.sleep(seconds) return(invisible()) } start <- cur_time() signal("", class = "httr2_sleep", seconds = seconds) cli::cli_progress_bar( format = "Waiting {ceiling(seconds)}s {task} {cli::pb_bar}", total = seconds * fps ) while ({left <- start + seconds - cur_time(); left > 0}) { Sys.sleep(min(1 / fps, left)) cli::cli_progress_update(set = (seconds - left) * fps) } cli::cli_progress_done() invisible() } # allow mocking Sys.sleep <- NULL cur_time <- function() proc.time()[[3]] is_error <- function(x) inherits(x, "error") unix_time <- function() as.integer(Sys.time()) is_testing <- function() { identical(Sys.getenv("TESTTHAT"), "true") } # https://datatracker.ietf.org/doc/html/rfc7636#appendix-A base64_url_encode <- function(x) { x <- openssl::base64_encode(x) x <- gsub("=+$", "", x) x <- gsub("+", "-", x, fixed = TRUE) x <- gsub("/", "_", x, fixed = TRUE) x } base64_url_decode <- function(x) { mod4 <- nchar(x) %% 4 if (mod4 > 0) { x <- paste0(x, strrep("=", 4 - mod4)) } x <- gsub("_", "/", x, fixed = TRUE) x <- gsub("-", "+", x, fixed = TRUE) # x <- gsub("=+$", "", x) openssl::base64_decode(x) } base64_url_rand <- function(bytes = 32) { base64_url_encode(openssl::rand_bytes(bytes)) } local_time <- function(x, tz = "UTC") { out <- as.POSIXct(x, tz = tz) attr(out, "tzone") <- NULL out } http_date <- function(x = Sys.time()) { withr::local_locale(LC_TIME = "C") strftime(x, "%a, %d %b %Y %H:%M:%S", tz = "UTC", usetz = TRUE) } parse_http_date <- function(x) { check_string(x) withr::local_locale(LC_TIME = "C") # https://datatracker.ietf.org/doc/html/rfc7231#section-7.1.1.1 out <- as.POSIXct(strptime(x, "%a, %d %b %Y %H:%M:%S", tz = "UTC")) attr(out, "tzone") <- NULL out } touch <- function(path, time = Sys.time()) { if (!file.exists(path)) { file.create(path) } Sys.setFileTime(path, time) } local_write_lines <- function(..., .env = caller_env()) { path <- withr::local_tempfile(.local_envir = .env) writeLines(c(...), path) path } check_function2 <- function(x, ..., args = NULL, allow_null = FALSE, arg = caller_arg(x), call = caller_env()) { check_function( x = x, allow_null = allow_null, arg = arg, call = call ) if (!is.null(x)) { .check_function_args( f = x, expected_args = args, arg = arg, call = call ) } } # 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) { if (is_null(expected_args)) { return(invisible(NULL)) } actual_args <- fn_fmls_names(f) %||% character() missing_args <- setdiff(expected_args, actual_args) if (is_empty(missing_args)) { return(invisible(NULL)) } n_expected_args <- length(expected_args) n_actual_args <- length(actual_args) if (n_actual_args == 0) { arg_info <- "instead it has no arguments" } else { arg_info <- paste0("it currently has {.arg {actual_args}}") } cli::cli_abort( paste0("{.arg {arg}} must have the {cli::qty(n_expected_args)}argument{?s} {.arg {expected_args}}; ", arg_info, "."), call = call, arg = arg ) } # 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()) { if (is_false(config)) { return(list( update = function(...) {}, done = function() {} )) } if (is.null(config) || is_bool(config)) { args <- list() } else if (is_scalar_character(config)) { args <- list(name = config) } else if (is.list(config)) { args <- config } else { stop_input_type( config, what = c("a bool", "a string", "a list"), arg = config_arg, call = error_call ) } args$name <- args[["name"]] %||% name # Can be removed if https://github.com/r-lib/cli/issues/630 is fixed if (is.infinite(total)) { total <- NA } args$total <- total args$.envir <- env id <- exec(cli::cli_progress_bar, !!!args) list( update = function(...) cli::cli_progress_update(..., id = id), done = function() cli::cli_progress_done(id = id) ) } imap <- function(.x, .f, ...) { map2(.x, names(.x), .f, ...) } read_con <- function(con, buffer = 32 * 1024) { bytes <- raw() repeat { new <- readBin(con, "raw", n = buffer) if (length(new) == 0) break bytes <- c(bytes, new) } if (length(bytes) == 0) { NULL } else { bytes } } # Slices the vector using the only sane semantics: start inclusive, end # exclusive. # # * Allows start == end, which means return no elements. # * Allows start == length(vector) + 1, which means return no elements. # * Allows zero-length vectors. # # Otherwise, slice() is quite strict about what it allows start/end to be: no # negatives, no reversed order. slice <- function(vector, start = 1, end = length(vector) + 1) { stopifnot(start > 0) stopifnot(start <= length(vector) + 1) stopifnot(end > 0) stopifnot(end <= length(vector) + 1) stopifnot(end >= start) if (start == end) { vector[FALSE] # Return an empty vector of the same type } else { vector[start:(end - 1)] } } is_named_list <- function(x) { is_list(x) && (is_named(x) || length(x) == 0) } pretty_json <- function(x) { tryCatch( gsub("\n$", "", jsonlite::prettify(x, indent = 2)), error = function(e) x ) } log_stream <- function(..., prefix = "<< ") { out <- gsub("\n", paste0("\n", prefix), paste0(prefix, ..., collapse = "")) cli::cat_line(out) } httr2/R/req-auth-sign.R0000644000176200001440000000105714753653643014350 0ustar liggesusers req_auth_sign <- function(req, fun, params, cache) { req_policies(req, auth_sign = list( fun = fun, params = params, cache = cache ) ) } auth_sign <- function(req) { if (!req_policy_exists(req, "auth_sign")) { return(req) } exec(req$policies$auth_sign$fun, req = req, cache = req$policies$auth_sign$cache, !!!req$policies$auth_sign$params ) } req_auth_clear_cache <- function(req) { cache <- req$policies$auth_sign$cache if (!is.null(cache)) { cache$clear() TRUE } else { FALSE } } httr2/R/resp-headers.R0000644000176200001440000001323614761701552014240 0ustar liggesusers#' Extract headers from a response #' #' @description #' * `resp_headers()` retrieves a list of all headers. #' * `resp_header()` retrieves a single header. #' * `resp_header_exists()` checks if a header is present. #' #' @param resp A httr2 [response] object, created by [req_perform()]. #' @param filter A regular expression used to filter the header names. #' `NULL`, the default, returns all headers. #' @return #' * `resp_headers()` returns a list. #' * `resp_header()` returns a string if the header exists and `NULL` otherwise. #' * `resp_header_exists()` returns `TRUE` or `FALSE`. #' @export #' @examples #' resp <- request("https://httr2.r-lib.org") |> req_perform() #' resp |> resp_headers() #' resp |> resp_headers("x-") #' #' resp |> resp_header_exists("server") #' resp |> resp_header("server") #' # Headers are case insensitive #' resp |> resp_header("SERVER") #' #' # Returns NULL if header doesn't exist #' resp |> resp_header("this-header-doesnt-exist") resp_headers <- function(resp, filter = NULL) { check_response(resp) if (is.null(filter)) { resp$headers } else { resp$headers[grepl(filter, names(resp$headers), perl = TRUE, ignore.case = TRUE)] } } #' @export #' @param header Header name (case insensitive) #' @param default Default value to use if header doesn't exist. #' @rdname resp_headers resp_header <- function(resp, header, default = NULL) { check_response(resp) resp$headers[[header]] %||% default } #' @export #' @rdname resp_headers resp_header_exists <- function(resp, header) { check_response(resp) tolower(header) %in% tolower(names(resp$headers)) } #' Extract request date from response #' #' All responses contain a request date in the `Date` header; if not provided #' by the server will be automatically added by httr2. #' #' @export #' @inheritParams resp_headers #' @returns A `POSIXct` date-time. #' @examples #' resp <- response(headers = "Date: Wed, 01 Jan 2020 09:23:15 UTC") #' resp |> resp_date() #' #' # If server doesn't add header (unusual), you get the time the request #' # was created: #' resp <- response() #' resp |> resp_date() resp_date <- function(resp) { parse_http_date(resp_header(resp, "Date")) } #' Extract response content type and encoding #' #' @description #' `resp_content_type()` returns the just the type and subtype of the #' from the `Content-Type` header. If `Content-Type` is not provided; it #' returns `NA`. Used by [resp_body_json()], [resp_body_html()], and #' [resp_body_xml()]. #' #' `resp_encoding()` returns the likely character encoding of text #' types, as parsed from the `charset` parameter of the `Content-Type` #' header. If that header is not found, not valid, or no charset parameter #' is found, returns `UTF-8`. Used by [resp_body_string()]. #' #' @export #' @returns A string. If no content type is specified `resp_content_type()` #' will return a character `NA`; if no encoding is specified, #' `resp_encoding()` will return `"UTF-8"`. #' @inheritParams resp_headers #' @examples #' resp <- response(headers = "Content-type: text/html; charset=utf-8") #' resp |> resp_content_type() #' resp |> resp_encoding() #' #' # No Content-Type header #' resp <- response() #' resp |> resp_content_type() #' resp |> resp_encoding() resp_content_type <- function(resp) { if (resp_header_exists(resp, "content-type")) { parse_media(resp_header(resp, "content-type"))$type } else { NA_character_ } } #' @export #' @rdname resp_content_type resp_encoding <- function(resp) { if (resp_header_exists(resp, "content-type")) { parse_media(resp_header(resp, "content-type"))$charset %||% "UTF-8" } else { "UTF-8" } } #' Extract wait time from a response #' #' Computes how many seconds you should wait before retrying a request by #' inspecting the `Retry-After` header. It parses both forms (absolute and #' relative) and returns the number of seconds to wait. If the heading is not #' found, it will return `NA`. #' #' @export #' @returns Scalar double giving the number of seconds to wait before retrying #' a request. #' @inheritParams resp_headers #' @examples #' resp <- response(headers = "Retry-After: 30") #' resp |> resp_retry_after() #' #' resp <- response(headers = "Retry-After: Mon, 20 Sep 2025 21:44:05 UTC") #' resp |> resp_retry_after() resp_retry_after <- function(resp) { check_response(resp) # https://developer.mozilla.org/en-US/docs/Web/HTTP/Headers/Retry-After val <- resp_header(resp, "Retry-After") if (is.null(val)) { NA } else if (grepl(" ", val, fixed = TRUE)) { diff <- difftime(parse_http_date(val), resp_date(resp), units = "secs") as.numeric(diff) } else { as.numeric(val) } } #' Parse link URL from a response #' #' Parses URLs out of the the `Link` header as defined by `r rfc(8288)`. #' #' @export #' @inheritParams resp_headers #' @returns Either a string providing a URL, if the specified `rel` exists, or #' `NULL` if not. #' @param rel The "link relation type" value for which to retrieve a URL. #' @export #' @examples #' # Simulate response from GitHub code search #' resp <- response(headers = paste0("Link: ", #' '; rel="next",', #' '; rel="last"' #' )) #' #' resp_link_url(resp, "next") #' resp_link_url(resp, "last") #' resp_link_url(resp, "prev") resp_link_url <- function(resp, rel) { if (!resp_header_exists(resp, "Link")) { return() } headers <- resp_headers(resp) link_headers <- headers[tolower(names(headers)) == "link"] links <- unlist(lapply(link_headers, parse_link), recursive = FALSE) sel <- map_lgl(links, ~ .$rel == rel) if (sum(sel) != 1L) { return() } links[[which(sel)]]$url } httr2/R/oauth.R0000644000176200001440000001411114753125205012763 0ustar liggesusers#' OAuth authentication #' #' This is a low-level helper for automatically authenticating a request with #' an OAuth flow, caching the access token and refreshing it where possible. #' You should only need to use this function if you're implementing your own #' OAuth flow. #' #' @inheritParams req_perform #' @param cache An object that controls how the token is cached. This should #' be a list containing three functions: #' * `get()` retrieves the token from the cache, returning `NULL` if not #' cached yet. #' * `set()` saves the token to the cache. #' * `clear()` removes the token from the cache #' @param flow An `oauth_flow_` function used to generate the access token. #' @param flow_params Parameters for the flow. This should be a named list #' whose names match the argument names of `flow`. #' @returns An [oauth_token]. #' @keywords internal #' @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, fun = auth_oauth_sign, params = list(flow = flow, flow_params = flow_params), cache = cache ) req <- req_policies(req, auth_oauth = TRUE) req } auth_oauth_sign <- function(req, cache, flow, flow_params) { token <- auth_oauth_token_get( cache = cache, flow = flow, flow_params = flow_params ) req_auth_bearer_token(req, token$access_token) } auth_oauth_token_get <- function(cache, flow, flow_params = list()) { token <- cache$get() if (is.null(token)) { token <- exec(flow, !!!flow_params) cache$set(token) } else if (token_has_expired(token)) { cache$clear() if (is.null(token$refresh_token)) { token <- exec(flow, !!!flow_params) } else { token <- tryCatch( token_refresh(flow_params$client, token$refresh_token), httr2_oauth = function(cnd) { # If refresh fails, try to auth from scratch exec(flow, !!!flow_params) } ) } cache$set(token) } token } #' Retrieve an OAuth token using the cache #' #' This function wraps around a `oauth_flow_` function to retrieve a token #' from the cache, or to generate and cache a token if needed. Use this for #' manual token management that still takes advantage of httr2's caching #' system. You should only need to use this function if you're passing #' the token #' #' @keywords internal #' @inheritParams req_oauth #' @inheritParams req_oauth_auth_code #' @param reauth Set to `TRUE` to force re-authentication via flow, regardless #' of whether or not token is expired. #' @export #' @examples #' \dontrun{ #' token <- oauth_token_cached( #' client = example_github_client(), #' flow = oauth_flow_auth_code, #' flow_params = list( #' auth_url = "https://github.com/login/oauth/authorize" #' ), #' cache_disk = TRUE #' ) #' token #' } 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) { cache$clear() } flow_params$client <- client auth_oauth_token_get( cache = cache, flow = flow, flow_params = flow_params ) } resp_is_invalid_oauth_token <- function(req, resp) { if (!req_policy_exists(req, "auth_oauth")) { return(FALSE) } if (is_error(resp) || resp_status(resp) != 401) { return(FALSE) } auth <- resp_header(resp, "WWW-Authenticate") if (is.null(auth)) { return(FALSE) } # https://datatracker.ietf.org/doc/html/rfc6750#section-3.1 # invalid_token: # The access token provided is expired, revoked, malformed, or # invalid for other reasons. The resource SHOULD respond with # the HTTP 401 (Unauthorized) status code. The client MAY # request a new access token and retry the protected resource # request. grepl('error="invalid_token"', auth, fixed = TRUE) } # Caches ------------------------------------------------------------------- cache_choose <- function(client, cache_disk = FALSE, cache_key = NULL) { if (cache_disk) { cache_disk(client, cache_key) } else { cache_mem(client, cache_key) } } cache_mem <- function(client, key = NULL) { key <- hash(c(client$name, key)) list( get = function() env_get(the$token_cache, key, default = NULL), set = function(token) env_poke(the$token_cache, key, token), clear = function() env_unbind(the$token_cache, key) ) } cache_disk <- function(client, key = NULL) { app_path <- file.path(oauth_cache_path(), client$name) dir.create(app_path, showWarnings = FALSE, recursive = TRUE) 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, set = function(token) { cli::cli_inform("Caching httr2 token in {.path {path}}.") secret_write_rds(token, path, obfuscate_key()) }, clear = function() if (file.exists(path)) file.remove(path) ) } # 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$") mtime <- file.mtime(files) old <- mtime < (Sys.time() - days * 86400) unlink(files[old]) } #' httr2 OAuth cache location #' #' When opted-in to, httr2 caches OAuth tokens in this directory. By default, #' it uses a OS-standard cache directory, but, if needed, you can override the #' location by setting the `HTTR2_OAUTH_CACHE` env var. #' #' @export oauth_cache_path <- function() { path <- Sys.getenv("HTTR2_OAUTH_CACHE") if (path != "") { return(path) } rappdirs::user_cache_dir("httr2") } #' Clear OAuth cache #' #' Use this function to clear cached credentials. #' #' @export #' @inheritParams req_oauth_auth_code oauth_cache_clear <- function(client, cache_disk = FALSE, cache_key = NULL) { cache <- cache_choose(client, cache_disk, cache_key) cache$clear() invisible() } httr2/R/sysdata.rda0000644000176200001440000000067214064455702013672 0ustar liggesusersBZh91AY&SYÄ6»ÿơÿûH@gÄÔ€8jÿÿ̃ê@@@@@P°£%#"f“Ó" ©§¤Èbi 1 €z A¡IˆĐĐ (SF 4 @ĐhĐi¦Qʆ+’‹+eeƯ]ÖđUÆëÎ6Ä1Z X„z,—­Y©Fm íÔ²âåÉ â–²aKưwà—&k2>.´CtFíp(Œ‘·̀Bz°!w<¢Â@±4¦L@*  ipa%Y L@À cId4E& RchƒlLT\̀H ‹ÓđđféóqS&LIe °:‚H…̉Ι¯íw3ßüy'àÉmæ9–éNÊ€¹[eN÷ăl†Ô…¥UåûÎÄDB—îrhp}FÛK%çôÎ5•¡„ÔU¶ÙS Ạu-Kev =Ÿ¬yè@™aÍ\èYA²”mêV°̉ ¤ç³M±Â‹ÚHÑ%q Æ̉)Oë`â:D µˆŒËr3-í§lÓMŔÙƯ ‰]=}”–1w$S… A£`httr2/R/utils-multi.R0000644000176200001440000000506614737043664014156 0ustar liggesusersmulti_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 { .multi <- arg_match(.multi, error_arg = ".multi", error_call = error_call) } .space <- arg_match(.space, call = error_call) form <- .space == "form" dots <- list2(...) if (length(dots) == 0) { return(list()) } if (!is_named(dots)) { cli::cli_abort( "All components of {.arg {error_arg}} must be named.", call = error_call ) } type_ok <- map_lgl(dots, function(x) is_atomic(x) || is.null(x)) if (any(!type_ok)) { cli::cli_abort( "All elements of {.arg {error_arg}} must be either an atomic vector or NULL.", call = error_call ) } 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] <- 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] <- 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] <- 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] <- lapply(dots[n > 1], I) } else if (.multi == "error") { cli::cli_abort( c( "All vector elements of {.arg {error_arg}} must be length 1.", i = "Use {.arg .multi} to choose a strategy for handling vectors." ), call = error_call ) } } # Format other params dots[n == 1] <- imap( dots[n == 1], format_query_param, form = form, error_call = error_call ) dots[n == 1] <- lapply(dots[n == 1], I) dots } explode <- function(x) { expanded <- map(x, function(x) { if (is.null(x)) { list(NULL) } else { map(seq_along(x), function(i) x[i]) } }) stats::setNames( unlist(expanded, recursive = FALSE, use.names = FALSE), rep(names(x), lengths(expanded)) ) } httr2/R/curl.R0000644000176200001440000002503114752214235012614 0ustar liggesusers#' Translate curl syntax to httr2 #' #' @description #' The curl command line tool is commonly used to demonstrate HTTP APIs and can #' easily be generated from #' [browser developer tools](https://everything.curl.dev/cmdline/copyas.html). #' `curl_translate()` saves you the pain of manually translating these calls #' by implementing a partial, but frequently used, subset of curl options. #' Use `curl_help()` to see the supported options, and `curl_translate()` #' to translate a curl invocation copy and pasted from elsewhere. #' #' Inspired by [curlconverter](https://github.com/hrbrmstr/curlconverter) #' written by [Bob Rudis](https://rud.is/b/). #' #' @param cmd Call to curl. If omitted and the clipr package is installed, #' will be retrieved from the clipboard. #' @param simplify_headers Remove typically unimportant headers included when #' copying a curl command from the browser. This includes: #' #' * `sec-fetch-*` #' * `sec-ch-ua*` #' * `referer`, `pragma`, `connection` #' @returns A string containing the translated httr2 code. If the input #' was copied from the clipboard, the translation will be copied back #' to the clipboard. #' @export #' @examples #' curl_translate("curl http://example.com") #' curl_translate("curl http://example.com -X DELETE") #' curl_translate("curl http://example.com --header A:1 --header B:2") #' curl_translate("curl http://example.com --verbose") curl_translate <- function(cmd, simplify_headers = TRUE) { if (missing(cmd)) { if (is_interactive() && is_installed("clipr") && clipr::clipr_available()) { clip <- TRUE cmd <- clipr::read_clip() cmd <- paste0(cmd, collapse = "\n") } else { cli::cli_abort("Must supply {.arg cmd}.") } } else { check_string(cmd) clip <- FALSE } data <- curl_normalize(cmd) url_pieces <- httr2::url_parse(data$url) query <- url_pieces$query url_pieces$query <- NULL url <- url_build(url_pieces) steps <- glue('request("{url}")') steps <- add_curl_step(steps, "req_method", main_args = data$method) steps <- add_curl_step(steps, "req_url_query", dots = query) # Cookies cookies <- data$headers$`Cookie` data$headers$`Cookie` <- NULL if (!is.null(cookies)) { steps <- add_curl_step(steps, "req_cookies_set", dots = cookies_parse(cookies)) } # Content type set with data type <- data$headers$`Content-Type` if (!identical(data$data, "")) { data$headers$`Content-Type` <- NULL } headers <- curl_simplify_headers(data$headers, simplify_headers) steps <- add_curl_step(steps, "req_headers", dots = headers) if (!identical(data$data, "")) { type <- type %||% "application/x-www-form-urlencoded" if (type == "application/json" && idempotent_json(data$data)) { json <- jsonlite::parse_json(data$data) args <- list(data = I(deparse1(json))) steps <- add_curl_step(steps, "req_body_json", dots = args) } else { body <- data$data steps <- add_curl_step(steps, "req_body_raw", main_args = c(body, type)) } } steps <- add_curl_step(steps, "req_auth_basic", main_args = unname(data$auth)) perform_args <- list() if (data$verbose) { perform_args$verbosity <- 1 } steps <- add_curl_step(steps, "req_perform", main_args = perform_args, keep_if_empty = TRUE) out <- paste0(steps, collapse = paste0(pipe(), "\n ")) if (clip) { cli::cli_alert_success("Copying to clipboard:") clipr::write_clip(out) } out <- paste0(out, "\n") structure(out, class = "httr2_cmd") } pipe <- function() { if (getRversion() >= "4.1.0") " |> " else " %>% " } #' @export print.httr2_cmd <- function(x, ...) { cat(x) invisible(x) } #' @rdname curl_translate #' @export curl_help <- function() { cat(curl_opts) } curl_translate_eval <- function(cmd, env = caller_env()) { code <- curl_translate(cmd) eval(parse_expr(code), envir = env) } curl_normalize <- function(cmd, error_call = caller_env()) { args <- curl_args(cmd, error_call = error_call) url <- args[["--url"]] %||% args[[""]] %||% cli::cli_abort("Must supply url.", call = error_call) if (has_name(args, "--header")) { headers <- as_headers(args[["--header"]]) } else { headers <- as_headers(list()) } if (has_name(args, "--referer")) { headers[["referer"]] <- args[["--referer"]] } if (has_name(args, "--user-agent")) { headers[["user-agent"]] <- args[["--user-agent"]] } if (has_name(args, "--user")) { pieces <- parse_in_half(args[["--user"]], ":") auth <- list( username = pieces$left, password = pieces$right ) } else { auth <- NULL } if (has_name(args, "--request")) { method <- args[["--request"]] } else if (has_name(args, "--head")) { method <- "HEAD" } else if (has_name(args, "--get")) { method <- "GET" } else { method <- NULL } if (has_name(args, "--json")) { args <- c(args, list(`--data-raw` = args[["--json"]])) headers[["Content-Type"]] <- "application/json" } # https://curl.se/docs/manpage.html#-d # --data-ascii, --data # * if first element is @, treat as path to read from, stripping CRLF # * if multiple, combine with & # --data-raw - like data, but don't handle @ specially # --data-binary - like data, but don't strip CRLF # --data-urlencode - not supported for now data <- unlist(c( lapply(args[["--data"]], curl_data), lapply(args[["--data-ascii"]], curl_data), lapply(args[["--data-raw"]], curl_data, raw = TRUE), lapply(args[["--data-binary"]], curl_data, binary = TRUE) )) data <- paste0(data, collapse = "&") list( method = method, url = url, headers = headers, auth = auth, verbose = isTRUE(args[["--verbose"]]), data = data ) } curl_simplify_headers <- function(headers, simplify_headers) { if (simplify_headers) { header_names <- tolower(names(headers)) to_drop <- startsWith(header_names, "sec-fetch") | startsWith(header_names, "sec-ch-ua") | header_names %in% c("referer", "pragma", "connection") headers <- headers[!to_drop] } headers } curl_data <- function(x, binary = FALSE, raw = FALSE) { if (!raw && grepl("^@", x)) { path <- sub("^@", "", x) if (binary) { x <- readBin(path, "character", n = file.size(path)) } else { x <- paste(readLines(path, warn = FALSE)) } } else { x } } # Format described at curl_opts <- "Usage: curl [] [-H
...] [-d ...] [options] [] --basic (IGNORED) --compressed (IGNORED) --digest (IGNORED) -d, --data HTTP POST data --data-raw HTTP POST data, '@' allowed --data-ascii HTTP POST ASCII data --data-binary HTTP POST binary data --data-urlencode HTTP POST data url encoded --json HTTP POST JSON -G, --get Put the post data in the URL and use GET -I, --head Show document info only -H, --header
Pass custom header(s) to server -i, --include (IGNORED) -k, --insecure (IGNORED) -L, --location (IGNORED) -m, --max-time Maximum time allowed for the transfer -u, --user Server user and password -A, --user-agent Send User-Agent STRING to server -#, --progress-bar Display transfer progress as a progress bar -e, --referer Referer URL -X, --request Specify request command to use --url URL to work with -v, --verbose Make the operation more talkative " curl_args <- function(cmd, error_call = caller_env()) { check_installed("docopt") pieces <- parse_in_half(cmd, " ") if (pieces$left != "curl") { cli::cli_abort( "Expecting call to {.str curl} not to {.str {pieces[[1]]}}.", call = error_call ) } if (grepl("'", cmd, fixed = TRUE)) { args <- parse_delim(pieces$right, " ", quote = "'") } else { args <- parse_delim(pieces$right, " ", quote = '"') } args <- args[args != "" & args != "\\"] parsed <- docopt::docopt(curl_opts, args = args, help = FALSE, strict = TRUE) # Drop default options parsed <- compact(parsed) is_false <- map_lgl(parsed, identical, FALSE) parsed <- parsed[!is_false] parsed } # Helpers ----------------------------------------------------------------- is_syntactic <- function(x) { x == "" | x == make.names(x) } 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) { args <- c(main_args, dots) if (is_empty(args) && !keep_if_empty) { return(steps) } names <- quote_name(names2(args)) string <- map_lgl(args, function(x) is.character(x) && !inherits(x, "AsIs")) values <- unlist(args) values <- ifelse(string, encode_string2(values), values) args_named <- ifelse( names == "", paste0(values), paste0(names, " = ", values) ) if (is_empty(dots)) { args_string <- paste0(args_named, collapse = ", ") new_step <- paste0(f, "(", args_string, ")") } else { args_string <- paste0(" ", args_named, ",\n", collapse = "") new_step <- paste0(f, "(\n", args_string, " )") } c(steps, new_step) } encode_string2 <- function(x) { supports_raw_string <- getRversion() >= "4.0.0" has_double_quote <- grepl('"', x, fixed = TRUE) has_single_quote <- grepl("'", x, fixed = TRUE) use_double <- !has_double_quote | has_single_quote out <- ifelse( use_double, encodeString(x, quote = '"'), encodeString(x, quote = "'") ) if (supports_raw_string) { has_unprintable <- grepl("[^[[:cntrl:]]]", x) x_encoded <- encodeString(x) has_both_quotes <- has_double_quote & has_single_quote use_raw_string <- !has_unprintable & (x != x_encoded | has_both_quotes) out[use_raw_string] <- paste0('r"---{', x[use_raw_string], '}---"') } names(out) <- names(x) out } cookies_parse <- function(x) { pairs <- strsplit(x, "; ?")[[1]] cookies <- parse_name_equals_value(pairs) if (length(cookies) == 0) { return(NULL) } out <- as.list(curl::curl_unescape(cookies)) names(out) <- curl::curl_unescape(names(cookies)) out } idempotent_json <- function(old) { args <- formals(req_body_json)[c("auto_unbox", "null", "digits")] new <- exec(jsonlite::toJSON, jsonlite::parse_json(old), !!!args) jsonlite::minify(old) == jsonlite::minify(new) } httr2/R/req-url.R0000644000176200001440000000625314737312513013244 0ustar liggesusers#' Modify request URL #' #' @description #' * `req_url()` replaces the entire URL. #' * `req_url_relative()` navigates to a relative URL. #' * `req_url_query()` modifies individual query components. #' * `req_url_path()` modifies just the path. #' * `req_url_path_append()` adds to the path. #' #' @seealso #' * To modify a URL without creating a request, see [url_modify()] and #' friends. #' * To use a template like `GET /user/{user}`, see [req_template()]. #' @inheritParams req_perform #' @param url A new URL; either an absolute URL for `req_url()` or a #' relative URL for `req_url_relative()`. #' @param ... For `req_url_query()`: <[`dynamic-dots`][rlang::dyn-dots]> #' Name-value pairs that define query parameters. Each value must be either #' an atomic vector or `NULL` (which removes the corresponding parameters). #' If you want to opt out of escaping, wrap strings in `I()`. #' #' For `req_url_path()` and `req_url_path_append()`: A sequence of path #' components that will be combined with `/`. #' @returns A modified HTTP [request]. #' @export #' @examples #' # Change complete url #' req <- request("http://example.com") #' req |> req_url("http://google.com") #' #' # Use a relative url #' req <- request("http://example.com/a/b/c") #' req |> req_url_relative("..") #' req |> req_url_relative("/d/e/f") #' #' # Change url components #' req |> #' req_url_path_append("a") |> #' req_url_path_append("b") |> #' req_url_path_append("search.html") |> #' req_url_query(q = "the cool ice") #' #' # Modify individual query parameters #' req <- request("http://example.com?a=1&b=2") #' req |> req_url_query(a = 10) #' req |> req_url_query(a = NULL) #' req |> req_url_query(c = 3) #' #' # Use .multi to control what happens with vector parameters: #' req |> req_url_query(id = 100:105, .multi = "comma") #' req |> req_url_query(id = 100:105, .multi = "explode") #' #' # If you have query parameters in a list, use !!! #' params <- list(a = "1", b = "2") #' req |> #' req_url_query(!!!params, c = "3") req_url <- function(req, url) { check_request(req) check_string(url) req$url <- url req } #' @export #' @rdname req_url req_url_relative <- function(req, url) { check_request(req) req_url(req, url_modify_relative(req$url, url)) } #' @export #' @rdname req_url #' @inheritParams url_modify_query 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) } #' @export #' @rdname req_url req_url_path <- function(req, ...) { check_request(req) path <- dots_to_path(...) req_url(req, url_modify(req$url, path = path)) } #' @export #' @rdname req_url req_url_path_append <- function(req, ...) { check_request(req) path <- dots_to_path(...) url <- url_parse(req$url) url$path <- paste0(sub("/$", "", url$path), path) req_url(req, url_build(url)) } dots_to_path <- function(...) { path <- paste(c(...), collapse = "/") # Ensure we don't add duplicate /s # NB: also keeps "" unchanged. sub("^([^/])", "/\\1", path) } httr2/R/req-dry-run.R0000644000176200001440000000670314761701552014044 0ustar liggesusers#' Perform a dry run #' #' This shows you exactly what httr2 will send to the server, without #' actually sending anything. It requires the httpuv package because it #' works by sending the real HTTP request to a local webserver, thanks to #' the magic of [curl::curl_echo()]. #' #' ## Limitations #' #' * The HTTP version is always `HTTP/1.1` (since you can't determine what it #' will actually be without connecting to the real server). #' #' @inheritParams req_verbose #' @param quiet If `TRUE` doesn't print anything. #' @param testing_headers If `TRUE`, removes headers that httr2 would otherwise #' be automatically added, which are likely to change across test runs. This #' currently includes: #' #' * The default `User-Agent`, which varies based on libcurl, curl, and #' httr2 versions. #' * The `Host`` header, which is often set to a testing server. #' * The `Content-Length` header, which will often vary by platform because #' of varying newline encodings. (And is also not correct if you have #' `pretty_json = TRUE`.) #' * The `Accept-Encoding` header, which varies based on how libcurl was #' built. #' @param pretty_json If `TRUE`, automatically prettify JSON bodies. #' @returns Invisibly, a list containing information about the request, #' including `method`, `path`, and `headers`. #' @export #' @examples #' # httr2 adds default User-Agent, Accept, and Accept-Encoding headers #' request("http://example.com") |> req_dry_run() #' #' # the Authorization header is automatically redacted to avoid leaking #' # credentials on the console #' req <- request("http://example.com") |> req_auth_basic("user", "password") #' req |> req_dry_run() #' #' # 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)) { check_request(req) check_bool(quiet) check_bool(redact_headers) check_bool(testing_headers) check_installed("httpuv") if (testing_headers) { if (!req_has_user_agent(req)) { req <- req_headers(req, `user-agent` = "") } req <- req_headers(req, `accept-encoding` = "") } req <- req_prepare(req) handle <- req_handle(req) curl::handle_setopt(handle, url = req$url) resp <- curl::curl_echo(handle, progress = FALSE) if (!quiet) { cli::cat_line(resp$method, " ", resp$path, " HTTP/1.1") headers <- new_headers(as.list(resp$headers), attr(req$headers, "redact")) if (testing_headers) { # curl::curl_echo() overrides headers$host <- NULL headers$`content-length` <- NULL } show_headers(headers) cli::cat_line() show_body(resp$body, headers$`content-type`, pretty_json = pretty_json) } invisible(list( method = resp$method, path = resp$path, headers = as.list(resp$headers) )) } show_body <- function(body, content_type, prefix = "", pretty_json = FALSE) { if (!is.raw(body)) { return(invisible()) } if (is_text_type(content_type)) { body <- rawToChar(body) Encoding(body) <- "UTF-8" if (pretty_json && content_type == "application/json") { body <- pretty_json(body) } body <- gsub("\n", paste0("\n", prefix), body) cli::cat_line(prefix, body) } else { cli::cat_line(prefix, "<", length(body), " bytes>") } invisible() } httr2/R/httr2-package.R0000644000176200001440000000066114753403735014313 0ustar liggesusers#' @keywords internal "_PACKAGE" ## usethis namespace: start #' @import R6 #' @import rlang #' @importFrom glue glue #' @importFrom lifecycle deprecated ## usethis namespace: end NULL the <- new_environment() the$throttle <- new_environment() the$breaker <- new_environment() the$cache_throttle <- list() the$token_cache <- new_environment() the$last_response <- NULL the$last_request <- NULL the$pool_pollers <- new_environment() httr2/R/oauth-flow-password.R0000644000176200001440000000451514666617037015613 0ustar liggesusers#' OAuth with username and password #' #' @description #' This function implements the OAuth **resource owner password flow**, as #' defined by `r rfc(6749, 4.3)`. It allows the user to supply their password #' once, exchanging it for an access token that can be cached locally. #' #' Learn more about the overall OAuth authentication flow in #' #' #' @export #' @family OAuth flows #' @inheritParams req_oauth_auth_code #' @inheritParams req_auth_basic #' @returns `req_oauth_password()` returns a modified HTTP [request] that will #' use OAuth; `oauth_flow_password()` returns an [oauth_token]. #' @examples #' req_auth <- function(req) { #' req_oauth_password(req, #' client = oauth_client("example", "https://example.com/get_token"), #' username = "username" #' ) #' } #' if (interactive()) { #' 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) { params <- list( client = client, username = username, password = password, scope = scope, token_params = token_params ) cache <- cache_choose(client, cache_disk = cache_disk, cache_key = cache_key) req_oauth(req, "oauth_flow_password", params, cache = cache) } #' @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, interactive = is.null(password) ) check_string(username) oauth_client_get_token(client, grant_type = "password", username = username, password = check_password(password), scope = scope, !!!token_params ) } check_password <- function(password, call = caller_env()) { if (is.null(password)) { check_installed("askpass", call = call) password <- askpass::askpass() } check_string(password, call = call) password } httr2/R/resp.R0000644000176200001440000001224614752760573012637 0ustar liggesusers#' Create a new HTTP response #' #' @description #' Generally, you should not need to call this function directly; you'll #' get a real HTTP response by calling [req_perform()] and friends. This #' function is provided primarily for testing, and a place to describe #' the key components of a response. #' #' `response()` creates a generic response; `response_json()` creates a #' response with a JSON body, automatically adding the correct Content-Type #' header. #' #' @keywords internal #' @param status_code HTTP status code. Must be a single integer. #' @param url URL response came from; might not be the same as the URL in #' the request if there were any redirects. #' @param method HTTP method used to retrieve the response. #' @param headers HTTP headers. Can be supplied as a raw or character vector #' which will be parsed using the standard rules, or a named list. #' @param body Response, if any, contained in the response body. #' For `response_json()`, a R data structure to serialize to JSON. #' @returns An HTTP response: an S3 list with class `httr2_response`. #' @export #' @examples #' 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()) { check_number_whole(status_code, min = 100, max = 700) check_string(url) check_string(method) headers <- as_headers(headers) new_response( method = method, url = url, status_code = as.integer(status_code), headers = headers, body = body ) } #' @export #' @rdname response 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" body <- charToRaw(jsonlite::toJSON(body, auto_unbox = TRUE)) new_response( method = method, url = url, status_code = as.integer(status_code), headers = headers, body = body ) } 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) check_request(request, allow_null = TRUE) headers <- as_headers(headers, error_call = error_call) # ensure we always have a date field if (!"date" %in% tolower(names(headers))) { headers$Date <- "Wed, 01 Jan 2020 00:00:00 UTC" } structure( list( method = method, url = url, status_code = status_code, headers = headers, body = body, request = request, cache = new_environment() ), class = "httr2_response" ) } create_response <- function(req, curl_data, body) { the$last_response <- new_response( method = req_method_get(req), url = curl_data$url, status_code = curl_data$status_code, headers = as_headers(curl_data$headers), body = body, request = req ) the$last_response } #' @export print.httr2_response <- function(x, ...) { cli::cli_text("{.cls {class(x)}}") cli::cli_text("{.strong {x$method}} {x$url}") cli::cli_text("{.field Status}: {x$status_code} {resp_status_desc(x)}") if (resp_header_exists(x, "Content-Type")) { cli::cli_text("{.field Content-Type}: {resp_content_type(x)}") } body <- x$body 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)"), memory = cli::cli_text("{.field Body}: In memory ({length(body)} bytes)"), stream = cli::cli_text("{.field Body}: Streaming connection") ) } invisible(x) } #' Show the raw response #' #' This function reconstructs the HTTP message that httr2 received from the #' server. It's unlikely to be exactly byte-for-byte identical (because most #' servers compress at least the body, and HTTP/2 can also compress the #' headers), but it conveys the same information. #' #' @inheritParams resp_headers #' @returns `resp` (invisibly). #' @export #' @examples #' resp <- request(example_url()) |> #' req_url_path("/json") |> #' req_perform() #' resp |> resp_raw() resp_raw <- function(resp) { cli::cat_line("HTTP/1.1 ", resp$status_code, " ", resp_status_desc(resp)) cli::cat_line(cli::style_bold(names(resp$headers)), ": ", resp$headers) cli::cat_line() if (!is.null(resp$body)) { cli::cat_line(resp_body_string(resp)) } invisible(resp) } is_response <- function(x) { inherits(x, "httr2_response") } check_response <- function(resp, arg = caller_arg(resp), call = caller_env()) { if (!missing(resp) && is_response(resp)) { return(invisible(NULL)) } stop_input_type( resp, "an HTTP response object", allow_null = FALSE, arg = arg, call = call ) } httr2/R/import-standalone-purrr.R0000644000176200001440000001302014556444037016461 0ustar liggesusers# Standalone file: do not edit by hand # Source: # ---------------------------------------------------------------------- # # --- # repo: r-lib/rlang # file: standalone-purrr.R # last-updated: 2023-02-23 # license: https://unlicense.org # imports: rlang # --- # # This file provides a minimal shim to provide a purrr-like API on top of # base R functions. They are not drop-in replacements but allow a similar style # of programming. # # ## Changelog # # 2023-02-23: # * Added `list_c()` # # 2022-06-07: # * `transpose()` is now more consistent with purrr when inner names # are not congruent (#1346). # # 2021-12-15: # * `transpose()` now supports empty lists. # # 2021-05-21: # * Fixed "object `x` not found" error in `imap()` (@mgirlich) # # 2020-04-14: # * Removed `pluck*()` functions # * Removed `*_cpl()` functions # * Used `as_function()` to allow use of `~` # * Used `.` prefix for helpers # # nocov start map <- function(.x, .f, ...) { .f <- as_function(.f, env = global_env()) lapply(.x, .f, ...) } walk <- function(.x, .f, ...) { map(.x, .f, ...) invisible(.x) } map_lgl <- function(.x, .f, ...) { .rlang_purrr_map_mold(.x, .f, logical(1), ...) } map_int <- function(.x, .f, ...) { .rlang_purrr_map_mold(.x, .f, integer(1), ...) } map_dbl <- function(.x, .f, ...) { .rlang_purrr_map_mold(.x, .f, double(1), ...) } map_chr <- function(.x, .f, ...) { .rlang_purrr_map_mold(.x, .f, character(1), ...) } .rlang_purrr_map_mold <- function(.x, .f, .mold, ...) { .f <- as_function(.f, env = global_env()) out <- vapply(.x, .f, .mold, ..., USE.NAMES = FALSE) names(out) <- names(.x) out } map2 <- function(.x, .y, .f, ...) { .f <- as_function(.f, env = global_env()) out <- mapply(.f, .x, .y, MoreArgs = list(...), SIMPLIFY = FALSE) if (length(out) == length(.x)) { set_names(out, names(.x)) } else { set_names(out, NULL) } } map2_lgl <- function(.x, .y, .f, ...) { as.vector(map2(.x, .y, .f, ...), "logical") } map2_int <- function(.x, .y, .f, ...) { as.vector(map2(.x, .y, .f, ...), "integer") } map2_dbl <- function(.x, .y, .f, ...) { as.vector(map2(.x, .y, .f, ...), "double") } map2_chr <- function(.x, .y, .f, ...) { as.vector(map2(.x, .y, .f, ...), "character") } imap <- function(.x, .f, ...) { map2(.x, names(.x) %||% seq_along(.x), .f, ...) } pmap <- function(.l, .f, ...) { .f <- as.function(.f) args <- .rlang_purrr_args_recycle(.l) do.call("mapply", c( FUN = list(quote(.f)), args, MoreArgs = quote(list(...)), SIMPLIFY = FALSE, USE.NAMES = FALSE )) } .rlang_purrr_args_recycle <- function(args) { lengths <- map_int(args, length) n <- max(lengths) stopifnot(all(lengths == 1L | lengths == n)) to_recycle <- lengths == 1L args[to_recycle] <- map(args[to_recycle], function(x) rep.int(x, n)) args } keep <- function(.x, .f, ...) { .x[.rlang_purrr_probe(.x, .f, ...)] } discard <- function(.x, .p, ...) { sel <- .rlang_purrr_probe(.x, .p, ...) .x[is.na(sel) | !sel] } map_if <- function(.x, .p, .f, ...) { matches <- .rlang_purrr_probe(.x, .p) .x[matches] <- map(.x[matches], .f, ...) .x } .rlang_purrr_probe <- function(.x, .p, ...) { if (is_logical(.p)) { stopifnot(length(.p) == length(.x)) .p } else { .p <- as_function(.p, env = global_env()) map_lgl(.x, .p, ...) } } compact <- function(.x) { Filter(length, .x) } transpose <- function(.l) { if (!length(.l)) { return(.l) } inner_names <- names(.l[[1]]) if (is.null(inner_names)) { fields <- seq_along(.l[[1]]) } else { fields <- set_names(inner_names) .l <- map(.l, function(x) { if (is.null(names(x))) { set_names(x, inner_names) } else { x } }) } # This way missing fields are subsetted as `NULL` instead of causing # an error .l <- map(.l, as.list) map(fields, function(i) { map(.l, .subset2, i) }) } every <- function(.x, .p, ...) { .p <- as_function(.p, env = global_env()) for (i in seq_along(.x)) { if (!rlang::is_true(.p(.x[[i]], ...))) return(FALSE) } TRUE } some <- function(.x, .p, ...) { .p <- as_function(.p, env = global_env()) for (i in seq_along(.x)) { if (rlang::is_true(.p(.x[[i]], ...))) return(TRUE) } FALSE } negate <- function(.p) { .p <- as_function(.p, env = global_env()) function(...) !.p(...) } reduce <- function(.x, .f, ..., .init) { f <- function(x, y) .f(x, y, ...) Reduce(f, .x, init = .init) } reduce_right <- function(.x, .f, ..., .init) { f <- function(x, y) .f(y, x, ...) Reduce(f, .x, init = .init, right = TRUE) } accumulate <- function(.x, .f, ..., .init) { f <- function(x, y) .f(x, y, ...) Reduce(f, .x, init = .init, accumulate = TRUE) } accumulate_right <- function(.x, .f, ..., .init) { f <- function(x, y) .f(y, x, ...) Reduce(f, .x, init = .init, right = TRUE, accumulate = TRUE) } detect <- function(.x, .f, ..., .right = FALSE, .p = is_true) { .p <- as_function(.p, env = global_env()) .f <- as_function(.f, env = global_env()) for (i in .rlang_purrr_index(.x, .right)) { if (.p(.f(.x[[i]], ...))) { return(.x[[i]]) } } NULL } detect_index <- function(.x, .f, ..., .right = FALSE, .p = is_true) { .p <- as_function(.p, env = global_env()) .f <- as_function(.f, env = global_env()) for (i in .rlang_purrr_index(.x, .right)) { if (.p(.f(.x[[i]], ...))) { return(i) } } 0L } .rlang_purrr_index <- function(x, right = FALSE) { idx <- seq_along(x) if (right) { idx <- rev(idx) } idx } list_c <- function(x) { inject(c(!!!x)) } # nocov end httr2/R/oauth-flow-client-credentials.R0000644000176200001440000000325314666617023017513 0ustar liggesusers#' OAuth with client credentials #' #' @description #' Authenticate using OAuth **client credentials flow**, as defined by #' `r rfc(6749, 4.4)`. It is used to allow the client to access resources that #' it controls directly, not on behalf of an user. #' #' Learn more about the overall OAuth authentication flow in #' . #' #' @export #' @family OAuth flows #' @inheritParams req_perform #' @inheritParams req_oauth_auth_code #' @returns `req_oauth_client_credentials()` returns a modified HTTP [request] that will #' use OAuth; `oauth_flow_client_credentials()` returns an [oauth_token]. #' @examples #' req_auth <- function(req) { #' req_oauth_client_credentials( #' req, #' client = oauth_client("example", "https://example.com/get_token") #' ) #' } #' #' request("https://example.com") |> #' req_auth() req_oauth_client_credentials <- function(req, client, scope = NULL, token_params = list()) { params <- list( client = client, scope = scope, token_params = token_params ) cache <- cache_mem(client, NULL) req_oauth(req, "oauth_flow_client_credentials", params, cache = cache) } #' @export #' @rdname req_oauth_client_credentials 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, grant_type = "client_credentials", scope = scope, !!!token_params ) } httr2/R/oauth-flow-device.R0000644000176200001440000001143014666617027015201 0ustar liggesusers#' OAuth with device flow #' #' @description #' Authenticate using the OAuth **device flow**, as defined by `r rfc(8628)`. #' It's designed for devices that don't have access to a web browser (if you've #' ever authenticated an app on your TV, this is probably the flow you've used), #' but it also works well from within R. #' #' Learn more about the overall OAuth authentication flow in #' . #' #' @export #' @inheritParams oauth_flow_password #' @inheritParams req_oauth_auth_code #' @returns `req_oauth_device()` returns a modified HTTP [request] that will #' use OAuth; `oauth_flow_device()` returns an [oauth_token]. #' @examples #' req_auth_github <- function(req) { #' req_oauth_device( #' req, #' client = example_github_client(), #' auth_url = "https://github.com/login/device/code" #' ) #' } #' #' 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) { params <- list( client = client, auth_url = auth_url, scope = scope, auth_params = auth_params, token_params = token_params ) cache <- cache_choose(client, cache_disk, cache_key) req_oauth(req, "oauth_flow_device", params, cache = cache) } #' @export #' @rdname req_oauth_device 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) { code <- oauth_flow_auth_code_pkce() auth_params$code_challenge <- code$challenge auth_params$code_challenge_method <- code$method token_params$code_verifier <- code$verifier } request <- oauth_flow_device_request(client, auth_url, scope, auth_params) # User interaction # https://datatracker.ietf.org/doc/html/rfc8628#section-3.3 # Azure provides a message that we might want to print? # 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 if (is_interactive()) { cli::cli_alert("Copy {.strong {request$user_code}} and paste when requested by the browser") readline("Press to proceed:") utils::browseURL(url) } else { inform(glue("Visit <{url}> and enter code {request$user_code}")) } token <- oauth_flow_device_poll(client, request, token_params) if (is.null(token)) { cli::cli_abort("Expired without user confirmation; please try again.") } exec(oauth_token, !!!token) } # 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()) { req <- request(auth_url) req <- req_body_form(req, scope = scope, !!!auth_params) req <- oauth_client_req_auth(req, client) req <- req_headers(req, Accept = "application/json") oauth_flow_fetch(req, "auth_url", error_call = error_call) } # 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()) { cli::cli_progress_step("Waiting for response from server", spinner = TRUE) delay <- request$interval %||% 5 deadline <- Sys.time() + request$expires_in token <- NULL while (Sys.time() < deadline) { for (i in 1:20) { cli::cli_progress_update() Sys.sleep(delay / 20) } tryCatch( { token <- oauth_client_get_token(client, grant_type = "urn:ietf:params:oauth:grant-type:device_code", device_code = request$device_code, !!!token_params, error_call = error_call ) break }, httr2_oauth_authorization_pending = function(err) {}, httr2_oauth_slow_down = function(err) { delay <<- delay + 5 } ) } cli::cli_progress_done() token } httr2/R/content-type.R0000644000176200001440000001054514752214235014304 0ustar liggesusers#' Check the content type of a response #' #' A different content type than expected often leads to an error in parsing #' the response body. This function checks that the content type of the response #' is as expected and fails otherwise. #' #' @param valid_types A character vector of valid MIME types. Should only #' be specified with `type/subtype`. #' @param valid_suffix A string given an "structured media type" suffix. #' @param check_type Should the type actually be checked? Provided as a #' convenience for when using this function inside `resp_body_*` helpers. #' @inheritParams resp_headers #' @inheritParams rlang::args_error_context #' @return Called for its side-effect; erroring if the response does not #' have the expected content type. #' @export #' @examples #' resp <- response(headers = list(`content-type` = "application/json")) #' resp_check_content_type(resp, "application/json") #' try(resp_check_content_type(resp, "application/xml")) #' #' # `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()) { check_response(resp) check_character(valid_types, allow_null = TRUE) check_string(valid_suffix, allow_null = TRUE) check_bool(check_type, allow_na = TRUE) if (isFALSE(check_type)) { return(invisible()) } check_content_type( resp_content_type(resp), valid_types = valid_types, valid_suffix = valid_suffix, inform_check_type = !is.na(check_type), call = call ) invisible() } parse_content_type <- function(x) { # Create regex with {rex} package # # ``` # library(rex) # # see https://developer.mozilla.org/en-US/docs/Web/HTTP/Basics_of_HTTP/MIME_types for the # # possible types # types <- c("application", "audio", "font", "example", "image", "message", "model", "multipart", "text", "video") # regex <- rex( # start, # capture(regex(paste0(types, collapse = "|")), name = "type"), # "/", # capture( # maybe(or("vnd", "prs", "x"), "."), # one_or_more(none_of("+;")), # name = "subtype" # ), # maybe("+", capture(one_or_more(none_of(";")), name = "suffix")), # maybe(";", capture(one_or_more(any), name = "parameters")), # end # ) # unclass(regex) # ``` stopifnot(length(x) == 1) regex <- "^(?application|audio|font|example|image|message|model|multipart|text|video)/(?(?:(?:vnd|prs|x)\\.)?(?:[^+;])+)(?:\\+(?(?:[^;])+))?(?:;(?(?:.)+))?$" if (!grepl(regex, x, perl = TRUE)) { out <- list( type = "", subtype = "", suffix = "" ) return(out) } match_object <- regexec(regex, x, perl = TRUE) match <- regmatches(x, match_object)[[1]] list( type = match[[2]], subtype = match[[3]], suffix = if (match[[4]] != "") match[[4]] else "" ) } 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) if (is.null(valid_types) || base_type %in% valid_types) { return() } if (!is.null(valid_suffix) && parsed$suffix == valid_suffix) { return() } msg <- "Expecting type {.or {.str {valid_types}}}" if (!is.null(valid_suffix)) { msg <- paste0(msg, " or suffix {.str {valid_suffix}}.") } cli::cli_abort( c("Unexpected content type {.str {content_type}}.", "*" = msg), i = if (inform_check_type) "Override check with `check_type = FALSE`.", call = call ) } is_text_type <- function(content_type) { if (is.null(content_type)) { return(FALSE) } parsed <- parse_content_type(content_type) if (parsed$type == "text") { return(TRUE) } special_cases <- c( "application/xml", "application/x-www-form-urlencoded", "application/json", "application/ld+json", "multipart/form-data" ) base_type <- paste0(parsed$type, "/", parsed$subtype) if (base_type %in% special_cases) { return(TRUE) } FALSE } httr2/R/oauth-flow-auth-code.R0000644000176200001440000004242714752214235015613 0ustar liggesusers#' OAuth with authorization code #' #' @description #' Authenticate using the OAuth **authorization code flow**, as defined #' by `r rfc(6749, 4.1)`. #' #' This flow is the most commonly used OAuth flow where the user #' opens a page in their browser, approves the access, and then returns to R. #' When possible, it redirects the browser back to a temporary local webserver #' to capture the authorization code. When this is not possible (e.g., when #' running on a hosted platform like RStudio Server), provide a custom #' `redirect_uri` and httr2 will prompt the user to enter the code manually. #' #' Learn more about the overall OAuth authentication flow in #' , and more about the motivations #' behind this flow in #' . #' #' # Security considerations #' #' The authorization code flow is used for both web applications and native #' applications (which are equivalent to R packages). `r rfc(8252)` spells out #' important considerations for native apps. Most importantly there's no way #' for native apps to keep secrets from their users. This means that the #' server should either not require a `client_secret` (i.e. it should be a #' public client and not a confidential client) or ensure that possession of #' the `client_secret` doesn't grant any significant privileges. #' #' Only modern APIs from major providers (like Azure and Google) explicitly #' support native apps. However, in most cases, even for older APIs, possessing #' the `client_secret` provides limited ability to perform harmful actions. #' Therefore, our general principle is that it's acceptable to include it in an #' R package, as long as it's mildly obfuscated to protect against credential #' scraping attacks (which aim to acquire large numbers of client secrets by #' scanning public sites like GitHub). The goal is to ensure that obtaining your #' client credentials is more work than just creating a new client. #' #' @export #' @family OAuth flows #' @seealso [oauth_flow_auth_code_url()] for the components necessary to #' write your own auth code flow, if the API you are wrapping does not adhere #' closely to the standard. #' @inheritParams req_perform #' @param client An [oauth_client()]. #' @param auth_url Authorization url; you'll need to discover this by reading #' the documentation. #' @param scope Scopes to be requested from the resource owner. #' @param pkce Use "Proof Key for Code Exchange"? This adds an extra layer of #' security and should always be used if supported by the server. #' @param auth_params A list containing additional parameters passed to #' [oauth_flow_auth_code_url()]. #' @param token_params List containing additional parameters passed to the #' `token_url`. #' @param host_name,host_ip,port `r lifecycle::badge("deprecated")` #' Now use `redirect_uri` instead. #' @param redirect_uri URL to redirect back to after authorization is complete. #' Often this must be registered with the API in advance. #' #' httr2 supports three forms of redirect. Firstly, you can use a `localhost` #' url (the default), where httr2 will set up a temporary webserver to listen #' for the OAuth redirect. In this case, httr2 will automatically append a #' random port. If you need to set it to a fixed port because the API requires #' it, then specify it with (e.g.) `"http://localhost:1011"`. This technique #' works well when you are working on your own computer. #' #' Secondly, you can provide a URL to a website that uses Javascript to #' give the user a code to copy and paste back into the R session (see #' and #' #' for examples). This is less convenient (because it requires more #' user interaction) but also works in hosted environments like RStudio #' Server. #' #' Finally, hosted platforms might set the `HTTR2_OAUTH_REDIRECT_URL` and #' `HTTR2_OAUTH_CODE_SOURCE_URL` environment variables. In this case, httr2 #' will use `HTTR2_OAUTH_REDIRECT_URL` for redirects by default, and poll the #' `HTTR2_OAUTH_CODE_SOURCE_URL` endpoint with the state parameter until it #' receives a code in the response (or encounters an error). This delegates #' completion of the authorization flow to the hosted platform. #' @param cache_disk Should the access token be cached on disk? This reduces #' the number of times that you need to re-authenticate at the cost of #' storing access credentials on disk. #' #' Learn more in . #' @param cache_key If you want to cache multiple tokens per app, use this #' key to disambiguate them. #' @returns `req_oauth_auth_code()` returns a modified HTTP [request] that will #' use OAuth; `oauth_flow_auth_code()` returns an [oauth_token]. #' @examples #' req_auth_github <- function(req) { #' req_oauth_auth_code( #' req, #' client = example_github_client(), #' auth_url = "https://github.com/login/oauth/authorize" #' ) #' } #' #' 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()) { redirect <- normalize_redirect_uri( redirect_uri = redirect_uri, host_name = host_name, host_ip = host_ip, port = port ) params <- list( client = client, auth_url = auth_url, scope = scope, pkce = pkce, auth_params = auth_params, token_params = token_params, redirect_uri = redirect$uri ) cache <- cache_choose(client, cache_disk, cache_key) req_oauth(req, "oauth_flow_auth_code", params, cache = cache) } #' @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_check("authorization code", client, interactive = TRUE) redirect <- normalize_redirect_uri( redirect_uri = redirect_uri, host_name = host_name, host_ip = host_ip, port = port ) if (pkce) { code <- oauth_flow_auth_code_pkce() auth_params$code_challenge <- code$challenge auth_params$code_challenge_method <- code$method token_params$code_verifier <- code$verifier } state <- base64_url_rand(32) # Redirect user to authorisation url. user_url <- oauth_flow_auth_code_url(client, auth_url = auth_url, redirect_uri = redirect$uri, scope = scope, state = state, auth_params = auth_params ) utils::browseURL(user_url) if (redirect$can_fetch_code) { # Wait a bit to give the user a chance to click through the authorisation # process. if (!is_testing()) { sys_sleep(2, "for browser-based authentication", progress = FALSE) } code <- oauth_flow_auth_code_fetch(state) } else if (redirect$localhost) { # Listen on localhost for the result result <- oauth_flow_auth_code_listen(redirect$uri) code <- oauth_flow_auth_code_parse(result, state) } else { # Allow the user to retrieve the token out of band manually and enter it # into the console. This is what {gargle} terms the "pseudo out-of-band" # flow. code <- oauth_flow_auth_code_read(state) } # Get access/refresh token from authorisation code # https://datatracker.ietf.org/doc/html/rfc6749#section-4.1.3 oauth_client_get_token(client, grant_type = "authorization_code", code = code, redirect_uri = redirect_uri, !!!token_params ) } 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)) { lifecycle::deprecate_warn( when = "1.0.0", what = "oauth_flow_auth_code(host_name)", with = "oauth_flow_auth_code(redirect_uri)" ) parsed$hostname <- host_name } if (lifecycle::is_present(port)) { lifecycle::deprecate_warn( when = "1.0.0", what = "oauth_flow_auth_code(port)", with = "oauth_flow_auth_code(redirect_uri)" ) parsed$port <- port } if (lifecycle::is_present(host_ip)) { lifecycle::deprecate_warn("1.0.0", "oauth_flow_auth_code(host_ip)") } localhost <- parsed$hostname %in% c("localhost", "127.0.0.1") if (localhost) { check_installed("httpuv", "desktop OAuth") if (is_hosted_session()) { cli::cli_abort( "Can't use localhost {.arg redirect_uri} in a hosted environment.", call = error_call ) } if (is.null(parsed$port)) { parsed$port <- httpuv::randomPort() } } list( uri = if (identical(old, parsed)) redirect_uri else url_build(parsed), localhost = localhost, can_fetch_code = can_fetch_oauth_code(redirect_uri) ) } #' Default redirect url for OAuth #' #' The default redirect uri used by [req_oauth_auth_code()]. Defaults to #' `http://localhost` unless the `HTTR2_OAUTH_REDIRECT_URL` envvar is set. #' #' @export oauth_redirect_uri <- function() { Sys.getenv("HTTR2_OAUTH_REDIRECT_URL", "http://localhost") } # Authorisation request: make a url that the user navigates to # https://datatracker.ietf.org/doc/html/rfc6749#section-4.1.1 #' OAuth authorization code components #' #' @description #' These low-level functions can be used to assemble a custom flow for #' APIs that are further from the spec: #' #' * `oauth_flow_auth_code_url()` generates the url that should be opened in a #' browser. #' * `oauth_flow_auth_code_listen()` starts a temporary local webserver that #' listens for the response from the resource server. #' * `oauth_flow_auth_code_parse()` parses the query parameters returned from #' the server redirect, verifying that the `state` is correct, and returning #' the authorisation code. #' * `oauth_flow_auth_code_pkce()` generates code verifier, method, and challenge #' components as needed for PKCE, as defined in `r rfc(7636)`. #' #' @export #' @keywords internal #' @param state Random state generated by `oauth_flow_auth_code()`. Used to #' 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()) { url <- url_parse(auth_url) url$query <- modify_list(url$query, response_type = "code", client_id = client$id, redirect_uri = redirect_uri, scope = scope, state = state, !!!auth_params ) url_build(url) } #' @export #' @rdname oauth_flow_auth_code_url oauth_flow_auth_code_listen <- function(redirect_uri = "http://localhost:1410") { parsed <- url_parse(redirect_uri) port <- as.integer(parsed$port) path <- parsed$path %||% "/" complete <- FALSE info <- NULL listen <- function(env) { if (!identical(env$PATH_INFO, path)) { return(list( status = 404L, headers = list("Content-Type" = "text/plain"), body = "Not found" )) } query <- env$QUERY_STRING if (!is.character(query) || identical(query, "")) { complete <<- TRUE } else { complete <<- TRUE info <<- parse_form_urlencoded(query) } list( status = 200L, headers = list("Content-Type" = "text/plain"), body = "Authentication complete. Please close this page and return to R." ) } server <- httpuv::startServer("127.0.0.1", port, list(call = listen)) withr::defer(httpuv::stopServer(server)) # TODO: make this a progress bar inform("Waiting for authentication in browser...") inform("Press Esc/Ctrl + C to abort") while (!complete) { httpuv::service() } httpuv::service() # send data back to client if (is.null(info)) { cli::cli_abort("Authentication failed; invalid url from server.") } info } # application/x-www-form-urlencoded defined in # https://www.w3.org/TR/html401/interact/forms.html#h-17.13.4.1 # Spaces are first replaced by + parse_form_urlencoded <- function(query) { query <- url_query_parse(query) query[] <- gsub("+", " ", query, fixed = TRUE) query } # Authorisation response: get query params back from redirect # https://datatracker.ietf.org/doc/html/rfc6749#section-4.1.2 #' @export #' @rdname oauth_flow_auth_code_url #' @param query List of query parameters returned by `oauth_flow_auth_code_listen()`. oauth_flow_auth_code_parse <- function(query, state) { if (has_name(query, "error")) { # https://datatracker.ietf.org/doc/html/rfc6749#section-4.1.2.1 # Never see problems with redirect_uri oauth_flow_abort(query$error, query$error_description, query$error_uri) } if (query$state != state) { cli::cli_abort("Authentication failure: state does not match.") } query$code } #' @export #' @rdname oauth_flow_auth_code_url oauth_flow_auth_code_pkce <- function() { # https://datatracker.ietf.org/doc/html/rfc7636#section-4.1 # # It is RECOMMENDED that the output of a suitable random number generator # be used to create a 32-octet sequence. The octet sequence is then # base64url-encoded to produce a 43-octet URL safe string to use as the # code verifier. verifier <- base64_url_rand(32) list( verifier = verifier, method = "S256", challenge = base64_url_encode(openssl::sha256(charToRaw(verifier))) ) } # Try to determine whether we can redirect the user's browser to a server on # localhost, which isn't possible if we are running on a hosted platform. # # Currently this detects RStudio Server, Posit Workbench, and Google Colab. It # is based on the strategy pioneered by the {gargle} package. is_hosted_session <- function() { if (nzchar(Sys.getenv("COLAB_RELEASE_TAG"))) { return(TRUE) } # If RStudio Server or Posit Workbench is running locally (which is possible, # though unusual), it's not acting as a hosted environment. Sys.getenv("RSTUDIO_PROGRAM_MODE") == "server" && !grepl("localhost", Sys.getenv("RSTUDIO_HTTP_REFERER"), fixed = TRUE) } oauth_flow_auth_code_read <- function(state) { code <- trimws(readline("Enter authorization code or URL: ")) if (is_string_url(code)) { # minimal setup where user copy & pastes a URL parsed <- url_parse(code) code <- parsed$query$code new_state <- parsed$query$state } else if (is_base64_json(code)) { # {gargle} style, where the user copy & pastes a base64-encoded JSON # object with both the code and state. This is used on # https://www.tidyverse.org/google-callback/ json <- jsonlite::fromJSON(rawToChar(openssl::base64_decode(code))) code <- json$code new_state <- json$state } else { # Full manual approach, where the code and state are entered # independently. new_state <- trimws(readline("Enter state parameter: ")) } if (!identical(state, new_state)) { abort("Authentication failure: state does not match") } code } is_string_url <- function(x) grepl("^https?://", x) is_base64_json <- function(x) { tryCatch( { jsonlite::fromJSON(rawToChar(openssl::base64_decode(x))) TRUE }, error = function(err) FALSE ) } # Determine whether we can fetch the OAuth authorization code from an external # source without user interaction. can_fetch_oauth_code <- function(redirect_url) { nchar(Sys.getenv("HTTR2_OAUTH_CODE_SOURCE_URL")) && Sys.getenv("HTTR2_OAUTH_REDIRECT_URL") == redirect_url } # Fetch the authorization code from an external source that is serving as a # redirect URL. This assumes a very simple API that takes the state parameter in # the query string and returns a JSON object with a `code` key. oauth_flow_auth_code_fetch <- function(state) { req <- request(Sys.getenv("HTTR2_OAUTH_CODE_SOURCE_URL")) req <- req_url_query(req, state = state) req <- req_retry( req, max_seconds = 60, # The endpoint may temporarily return a 404 when no code is found for a # given state because the user hasn't finished clicking through yet. is_transient = ~ resp_status(.x) %in% c(404, 429, 503) ) resp <- req_perform(req) body <- resp_body_json(resp) body$code } # Make base::readline() mockable readline <- NULL httr2/R/jwt.R0000644000176200001440000000551714656154404012466 0ustar liggesusers#' Create and encode a JWT #' #' `jwt_claim()` is a wrapper around [jose::jwt_claim()] that creates a JWT #' claim set with a few extra default values. `jwt_encode_sig()` and #' `jwt_encode_hmac()` are thin wrappers around [jose::jwt_encode_sig()] and #' [jose::jwt_encode_hmac()] that exist primarily to make specification #' in other functions a little simpler. #' #' @param iss Issuer claim. Identifies the principal that issued the JWT. #' @param sub Subject claim. Identifies the principal that is the subject of #' the JWT (i.e. the entity that the claims apply to). #' @param aud Audience claim. Identifies the recipients that the JWT is #' intended. Each principle intended to process the JWT must be identified #' with a unique value. #' @param exp Expiration claim. Identifies the expiration time on or after which #' the JWT MUST NOT be accepted for processing. Defaults to 5 minutes. #' @param nbf Not before claim. Identifies the time before which the JWT #' MUST NOT be accepted for processing. Defaults to current time. #' @param iat Issued at claim. Identifies the time at which the JWT was #' issued. Defaults to current time. #' @param jti JWT ID claim. Provides a unique identifier for the JWT. #' If omitted, uses a random 32-byte sequence encoded with base64url. #' @param ... Any additional claims to include in the claim set. #' @returns An S3 list with class `jwt_claim`. #' @keywords internal #' @export #' @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, ...) { # https://datatracker.ietf.org/doc/html/rfc7519 jose::jwt_claim( iss = iss, sub = sub, aud = aud, exp = exp, iat = iat, nbf = nbf, jti = jti %||% base64_url_rand(32), ... ) } #' @export #' @rdname jwt_claim #' @param claim Claim set produced by [jwt_claim()]. #' @param key RSA or EC private key either specified as a path to a file, #' a connection, or a string (PEM/SSH format), or a raw vector (DER format). #' @param size Size, in bits, of sha2 signature, i.e. 256, 384 or 512. #' Only for HMAC/RSA, not applicable for ECDSA keys. #' @param header A named list giving additional fields to include in the #' JWT header. jwt_encode_sig <- function(claim, key, size = 256, header = list()) { check_installed("jose") jose::jwt_encode_sig(claim, key, size = size, header = header) } #' @export #' @rdname jwt_claim #' @param secret String or raw vector with a secret passphrase. jwt_encode_hmac <- function(claim, secret, size = 256, header = list()) { check_installed("jose") jose::jwt_encode_hmac(claim, secret, size = size, header = header) } httr2/R/headers.R0000644000176200001440000000546514761701552013276 0ustar liggesusersas_headers <- function(x, redact = character(), error_call = caller_env()) { if (is.character(x) || is.raw(x)) { parsed <- curl::parse_headers(x) valid <- parsed[grepl(":", parsed, fixed = TRUE)] halves <- parse_in_half(valid, ":") headers <- set_names(trimws(halves$right), halves$left) new_headers(as.list(headers), redact = redact, error_call = error_call) } else if (is.list(x)) { new_headers(x, redact = redact, error_call = error_call) } else { cli::cli_abort( "{.arg headers} must be a list, character vector, or raw.", call = error_call ) } } new_headers <- function(x, redact = character(), error_call = caller_env()) { if (!is_list(x)) { cli::cli_abort("{.arg x} must be a list.", call = error_call) } if (length(x) > 0 && !is_named(x)) { cli::cli_abort("All elements of {.arg x} must be named.", call = error_call) } structure(x, redact = redact, class = "httr2_headers") } #' @export print.httr2_headers <- function(x, ..., redact = TRUE) { cli::cat_line(cli::format_inline("{.cls {class(x)}}")) show_headers(x, redact = redact) invisible(x) } show_headers <- function(x, redact = TRUE) { if (length(x) > 0) { vals <- lapply(headers_redact(x, redact), format) cli::cat_line(cli::style_bold(names(x)), ": ", vals) } } #' @export str.httr2_headers <- function(object, ..., no.list = FALSE) { object <- unclass(headers_redact(object)) cat(" \n") utils::str(object, ..., no.list = TRUE) } headers_redact <- function(x, redact = TRUE) { if (!redact) { x } else { to_redact <- attr(x, "redact") attr(x, "redact") <- NULL list_redact(x, to_redact, case_sensitive = FALSE) } } # https://datatracker.ietf.org/doc/html/rfc7230#section-3.2.2 headers_flatten <- function(x) { n <- lengths(x) x[n > 1] <- lapply(x[n > 1], paste, collapse = ",") x } list_redact <- function(x, names, case_sensitive = TRUE) { if (case_sensitive) { i <- match(names, names(x)) } else { i <- match(tolower(names), tolower(names(x))) } x[i] <- list(redacted()) x } redacted <- function() { structure(list(NULL), class = "httr2_redacted") } #' @export format.httr2_redacted <- function(x, ...) { cli::col_grey("") } #' @export str.httr2_redacted <- function(object, ...) { cat(" ", cli::col_grey(""), "\n", sep = "") } is_redacted <- function(x) { inherits(x, "httr2_redacted") } #' @export `[.httr2_headers` <- function(x, i, ...) { if (is.character(i)) { i <- match(tolower(i), tolower(names(x))) } new_headers(NextMethod()) } #' @export `[[.httr2_headers` <- function(x, i) { if (is.character(i)) { i <- match(tolower(i), tolower(names(x))) } NextMethod() } #' @export "$.httr2_headers" <- function(x, name) { i <- match(tolower(name), tolower(names(x))) x[[i]] } httr2/R/req-body.R0000644000176200001440000001723514737047606013411 0ustar liggesusers#' Send data in request body #' #' @description #' * `req_body_file()` sends a local file. #' * `req_body_raw()` sends a string or raw vector. #' * `req_body_json()` sends JSON encoded data. Named components of this data #' can later be modified with `req_body_json_modify()`. #' * `req_body_form()` sends form encoded data. #' * `req_body_multipart()` creates a multi-part body. #' #' Adding a body to a request will automatically switch the method to POST. #' #' @inheritParams req_perform #' @param type MIME content type. Will be ignored if you have manually set #' a `Content-Type` header. #' @returns A modified HTTP [request]. #' @examples #' req <- request(example_url()) |> #' req_url_path("/post") #' #' # Most APIs expect small amounts of data in either form or json encoded: #' req |> #' req_body_form(x = "A simple text string") |> #' req_dry_run() #' #' req |> #' req_body_json(list(x = "A simple text string")) |> #' req_dry_run() #' #' # For total control over the body, send a string or raw vector #' req |> #' req_body_raw("A simple text string") |> #' req_dry_run() #' #' # There are two main ways that APIs expect entire files #' path <- tempfile() #' writeLines(letters[1:6], path) #' #' # You can send a single file as the body: #' req |> #' req_body_file(path) |> #' req_dry_run() #' #' # You can send multiple files, or a mix of files and data #' # with multipart encoding #' req |> #' req_body_multipart(a = curl::form_file(path), b = "some data") |> #' req_dry_run() #' @name req_body #' @aliases NULL NULL #' @export #' @rdname req_body #' @param body A literal string or raw vector to send as body. req_body_raw <- function(req, body, type = NULL) { check_request(req) if (!is.raw(body) && !is_string(body)) { cli::cli_abort("{.arg body} must be a raw vector or string.") } req_body( req, data = body, type = "raw", content_type = type %||% "" ) } #' @export #' @rdname req_body #' @param path Path to file to upload. req_body_file <- function(req, path, type = NULL) { check_request(req) if (!file.exists(path)) { cli::cli_abort("{.arg path} ({.path {path}}) does not exist.") } # Need to override default content-type "application/x-www-form-urlencoded" req_body( req, data = new_path(path), type = "raw-file", content_type = type %||% "" ) } #' @export #' @rdname req_body #' @param data Data to include in body. #' @param auto_unbox Should length-1 vectors be automatically "unboxed" to #' JSON scalars? #' @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", ...) { check_request(req) check_installed("jsonlite") check_string(type) check_content_type(type, "application/json", "json") params <- list2( auto_unbox = auto_unbox, digits = digits, null = null, ... ) req_body( req, data = data, type = "json", content_type = type, params = params ) } #' @export #' @rdname req_body req_body_json_modify <- function(req, ...) { check_request(req) if (req$body$type != "json") { cli::cli_abort("Can only be used after {.fn req_body_json") } req$body$data <- utils::modifyList(req$body$data, list2(...)) req } #' @export #' @rdname req_body #' @param ... <[`dynamic-dots`][rlang::dyn-dots]> Name-data pairs used to send #' data in the body. #' #' * For `req_body_form()`, the values must be strings (or things easily #' coerced to strings). Vectors are convertd to strings using the #' value of `.multi`. #' * For `req_body_multipart()` the values must be strings or objects #' produced by [curl::form_file()]/[curl::form_data()]. #' * For `req_body_json_modify()`, any simple data made from atomic vectors #' and lists. #' #' `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")) { check_request(.req) dots <- multi_dots(..., .multi = .multi) data <- modify_list(.req$body$data, !!!dots) req_body( .req, data = data, type = "form", content_type = "application/x-www-form-urlencoded" ) } #' @export #' @rdname req_body req_body_multipart <- function(.req, ...) { check_request(.req) data <- modify_list(.req$body$data, ...) # data must be character, raw, curl::form_file, or curl::form_data req_body( .req, data = data, type = "multipart", content_type = NULL ) } # General structure ------------------------------------------------------- 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( "Can't change body type from {req$body$type} to {type}.", i = "You must use only one type of `req_body_*()` per request." ), call = error_call ) } req$body <- list( data = data, type = type, content_type = content_type, params = params ) req } req_body_info <- function(req) { if (is.null(req$body)) { "empty" } else { data <- req$body$data if (is.raw(data)) { glue("{length(data)} bytes of raw data") } else if (is_string(data)) { glue("a string") } else if (is_path(data)) { glue("path '{data}'") } else if (is.list(data)) { glue("{req$body$type} encoded data") } else { "invalid" } } } req_body_get <- function(req) { if (is.null(req$body)) { return("") } switch( req$body$type, raw = req$body$data, form = { data <- unobfuscate(req$body$data) url_query_build(data) }, json = exec(jsonlite::toJSON, req$body$data, !!!req$body$params), cli::cli_abort("Unsupported request body type {.str {req$body$type}}.") ) } req_body_apply <- function(req) { if (is.null(req$body)) { return(req) } data <- req$body$data type <- req$body$type if (type == "raw-file") { size <- file.info(data)$size # Only open connection if needed delayedAssign("con", file(data, "rb")) req <- req_policies( req, done = function() close(con) ) req <- req_options(req, post = TRUE, readfunction = function(nbytes, ...) readBin(con, "raw", nbytes), seekfunction = function(offset, ...) seek(con, where = offset), postfieldsize_large = size ) } else if (type == "raw") { req <- req_body_apply_raw(req, data) } else if (type == "json") { req <- req_body_apply_raw(req, req_body_get(req)) } else if (type == "multipart") { data <- unobfuscate(data) req$fields <- data } else if (type == "form") { req <- req_body_apply_raw(req, req_body_get(req)) } else { cli::cli_abort("Unsupported request body {.arg type}.", .internal = TRUE) } # Respect existing Content-Type if set type_idx <- match("content-type", tolower(names(req$headers))) if (!is.na(type_idx)) { content_type <- req$headers[[type_idx]] req$headers <- req$headers[-type_idx] } else { content_type <- req$body$content_type } req <- req_headers(req, `Content-Type` = content_type) req } 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 ) } httr2/R/roxygen2.R0000644000176200001440000000037214556444037013434 0ustar liggesusersrfc <- 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), ")" ) } httr2/R/resp-stream-aws.R0000644000176200001440000000671114757136670014720 0ustar liggesusers#' @export #' @rdname resp_stream_raw #' @order 2 resp_stream_aws <- function(resp, max_size = Inf) { event_bytes <- resp_boundary_pushback( resp = resp, max_size = max_size, boundary_func = find_aws_event_boundary, include_trailer = FALSE ) if (is.null(event_bytes)) { return() } event <- parse_aws_event(event_bytes) if (resp_stream_show_body(resp)) { # Emit header for (key in names(event$headers)) { log_stream(cli::style_bold(key), ": ", event$headers[[key]]) } # Emit body log_stream(jsonlite::toJSON(event$body, auto_unbox = TRUE, pretty = TRUE)) cli::cat_line() } event } find_aws_event_boundary <- function(buffer) { # No valid AWS event message is less than 16 bytes if (length(buffer) < 16) { return(NULL) } # Read first 4 bytes as a big endian number event_size <- parse_int(buffer[1:4]) if (event_size > length(buffer)) { return(NULL) } event_size + 1 } # Implementation from https://github.com/lifion/lifion-aws-event-stream/blob/develop/lib/index.js # This is technically buggy because it takes the header_length as a lower bound # but this shouldn't cause problems in practive parse_aws_event <- function(bytes) { i <- 1 read_bytes <- function(n) { if (n == 0) { return(raw()) } out <- bytes[i:(i + n - 1)] i <<- i + n out } # 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) } header_length <- parse_int(read_bytes(4)) prelude_crc <- read_bytes(4) # TODO: use this value to check prelude lengths # headers headers <- list() while (i <= 12 + header_length) { name_length <- as.integer(read_bytes(1)) name <- rawToChar(read_bytes(name_length)) type <- as.integer(read_bytes(1)) delayedAssign("length", parse_int(read_bytes(2))) value <- switch(type_enum(type), "TRUE" = TRUE, "FALSE" = FALSE, BYTE = parse_int(read_bytes(1)), SHORT = parse_int(read_bytes(2)), INTEGER = parse_int(read_bytes(4)), LONG = parse_int64(read_bytes(8)), BYTE_ARRAY = read_bytes(length), CHARACTER = rawToChar(read_bytes(length)), TIMESTAMP = parse_int64(read_bytes(8)), UUID = raw_to_hex(read_bytes(16)), ) headers[[name]] <- value } # body body_raw <- read_bytes(total_length - i - 4 + 1) crc_raw <- read_bytes(4) # TODO: use this value to check data body <- rawToChar(body_raw) if (identical(headers$`:content-type`, "application/json")) { body <- jsonlite::parse_json(body) } list(headers = headers, body = body) } # Helpers ---------------------------------------------------------------- parse_int <- function(x) { sum(as.integer(x) * 256^rev(seq_along(x) - 1)) } parse_int64 <- function(x) { y <- readBin(x, "double", n = 1, size = length(x), endian = "big") class(y) <- "integer64" y } type_enum <- function(value) { if (value < 0 || value > 10) { cli::cli_abort("Unsupported type {value}.", .internal = TRUE) } switch(value + 1, "TRUE", "FALSE", "BYTE", "SHORT", "INTEGER", "LONG", "BYTE_ARRAY", "CHARACTER", "TIMESTAMP", "UUID" ) } hex_to_raw <- function(x) { x <- gsub("(\\s|\n)+", "", x) pairs <- substring(x, seq(1, nchar(x), by = 2), seq(2, nchar(x), by = 2)) as.raw(strtoi(pairs, 16L)) } raw_to_hex <- function(x) { paste(as.character(x), collapse = "") } httr2/cleanup0000755000176200001440000000006114762062312012672 0ustar liggesusers#! /usr/bin/env sh rm -f man/macros/examples.Rd httr2/vignettes/0000755000176200001440000000000014762062312013330 5ustar liggesusershttr2/vignettes/httr2.Rmd0000644000176200001440000001540114761701552015045 0ustar liggesusers--- title: "httr2" output: rmarkdown::html_vignette vignette: > %\VignetteIndexEntry{httr2} %\VignetteEngine{knitr::rmarkdown} %\VignetteEncoding{UTF-8} --- ```{r, include = FALSE} # needs pipe & avoids error = TRUE problem in 4.3.0 run_code <- getRversion() >= "4.4.0" knitr::opts_chunk$set( collapse = TRUE, comment = "#>", eval = run_code, purl = run_code ) ``` The goal of this document is show you the basics of httr2. You'll learn how to create and submit HTTP requests and work with the HTTP responses that you get back. httr2 is designed to map closely to the underlying HTTP protocol, which I'll explain as we go along. For more details, I also recommend "[An overview of HTTP](https://developer.mozilla.org/en-US/docs/Web/HTTP/Overview)" from MDN. ```{r setup} #| eval: true library(httr2) ``` ## Create a request In httr2, you start by creating a request. If you're familiar with httr, this a big change: with httr you could only submit a request, immediately receiving a response. Having an explicit request object makes it easier to build up a complex request piece by piece and works well with the pipe. Every request starts with a URL: ```{r} req <- request(example_url()) req ``` Here, instead of an external website, we use a test server that's built-in to httr2 itself. That ensures that this vignette will work regardless of when or where you run it. We can see exactly what this request will send to the server with a dry run: ```{r} req |> req_dry_run() ``` ```{r} #| include: FALSE #| eval: true port <- if (run_code) paste0("`", url_parse(example_url())$port, "`") else "e.g. `1234`" ``` The first line of the request contains three important pieces of information: - The HTTP **method**, which is a verb that tells the server what you want to do. Here it's GET, the most common verb, indicating that we want to *get* a resource. Other verbs include POST, to create a new resource, PUT, to replace an existing resource, and DELETE, to delete a resource. - The **path**, which is the URL stripped of details that the server already knows, i.e. the protocol (`http` or `https`), the host (`localhost`), and the port (`r port`). - The version of the HTTP protocol. This is unimportant for our purposes because it's handled at a lower level. The following lines specify the HTTP **headers**, a series of name-value pairs separated by `:`. The headers in this request were automatically added by httr2, but you can override them or add your own with `req_headers()`: ```{r} req |> req_headers( Name = "Hadley", `Shoe-Size` = "11", Accept = "application/json" ) |> req_dry_run() ``` Header names are case-insensitive, and servers will ignore headers that they don't understand. The headers finish with a blank line which is followed by the **body**. The requests above (like all GET requests) don't have a body, so let's add one to see what happens. The `req_body_*()` functions provide a variety of ways to add data to the body. Here we'll use `req_body_json()` to add some data encoded as JSON: ```{r} req |> req_body_json(list(x = 1, y = "a")) |> req_dry_run() ``` What's changed? - The method has changed from GET to POST. POST is the standard method for sending data to a website, and is automatically used whenever you add a body. Use `req_method()` to use a different method. - There are two new headers: `Content-Type` and `Content-Length`. They tell the server how to interpret the body --- it's encoded as JSON and is 15 bytes long. - We have a body, consisting of some JSON. Different servers want data encoded differently so httr2 provides a selection of common formats. For example, `req_body_form()` uses the encoding used when you submit a form from a web browser: ```{r} req |> req_body_form(x = "1", y = "a") |> req_dry_run() ``` And `req_body_multipart()` uses the multipart encoding which is particularly important when you need to send larger amounts of data or complete files: ```{r} req |> req_body_multipart(x = "1", y = "a") |> req_dry_run() ``` If you need to send data encoded in a different form, you can use `req_body_raw()` to add the data to the body and set the `Content-Type` header. ## Perform a request and fetch the response To actually perform a request and fetch the response back from the server, call `req_perform()`: ```{r} req <- request(example_url()) |> req_url_path("/json") resp <- req |> req_perform() resp ``` You can see a simulation of what httr2 actually received with `resp_raw()`: ```{r} resp |> resp_raw() ``` An HTTP response has a very similar structure to an HTTP request. The first line gives the version of HTTP used, and a status code that's optionally followed by a short description. Then we have the headers, followed by a blank line, followed by a body. The majority of responses will have a body, unlike requests. You can extract data from the response using the `resp_()` functions: - `resp_status()` returns the status code and `resp_status_desc()` returns the description: ```{r} resp |> resp_status() resp |> resp_status_desc() ``` - You can extract all headers with `resp_headers()` or a specific header with `resp_header()`: ```{r} resp |> resp_headers() resp |> resp_header("Content-Length") ``` Headers are case insensitive: ```{r} resp |> resp_header("ConTEnT-LeNgTH") ``` - You can extract the body in various forms using the `resp_body_*()` family of functions. Since this response returns JSON we can use `resp_body_json()`: ```{r} resp |> resp_body_json() |> str() ``` Responses with status codes 4xx and 5xx are HTTP errors. httr2 automatically turns these into R errors: ```{r, error = TRUE} request(example_url()) |> req_url_path("/status/404") |> req_perform() request(example_url()) |> req_url_path("/status/500") |> req_perform() ``` This is another important difference to httr, which required that you explicitly call `httr::stop_for_status()` to turn HTTP errors into R errors. You can revert to the httr behaviour with `req_error(req, is_error = ~ FALSE)`. ## Control the request process A number of `req_` functions don't directly affect the HTTP request but instead control the overall process of submitting a request and handling the response. These include: - `req_cache()` sets up a cache so if repeated requests return the same results, you can avoid a trip to the server. - `req_throttle()` will automatically add a small delay before each request so you can avoid hammering a server with many requests. - `req_retry()` sets up a retry strategy so that if the request either fails or you get a transient HTTP error, it'll automatically retry after a short delay. For more details see their documentation, as well as examples of the usage in real APIs in `vignette("wrapping-apis")`. httr2/NAMESPACE0000644000176200001440000001010414761701552012540 0ustar liggesusers# Generated by roxygen2: do not edit by hand S3method("$",httr2_headers) S3method("[",httr2_headers) S3method("[[",httr2_headers) S3method(close,httr2_response) S3method(format,httr2_redacted) S3method(print,httr2_cmd) S3method(print,httr2_headers) S3method(print,httr2_oauth_client) S3method(print,httr2_obfuscated) S3method(print,httr2_request) S3method(print,httr2_response) S3method(print,httr2_token) S3method(print,httr2_url) S3method(str,httr2_headers) S3method(str,httr2_obfuscated) S3method(str,httr2_redacted) export("%>%") export(curl_help) export(curl_translate) export(example_github_client) export(example_url) export(is_online) export(iterate_with_cursor) export(iterate_with_link_url) export(iterate_with_offset) export(jwt_claim) export(jwt_encode_hmac) export(jwt_encode_sig) export(last_request) export(last_response) export(local_mock) export(local_mocked_responses) export(local_verbosity) export(multi_req_perform) export(oauth_cache_clear) export(oauth_cache_path) export(oauth_client) export(oauth_client_req_auth) export(oauth_client_req_auth_body) export(oauth_client_req_auth_header) export(oauth_client_req_auth_jwt_sig) export(oauth_flow_auth_code) export(oauth_flow_auth_code_listen) export(oauth_flow_auth_code_parse) export(oauth_flow_auth_code_pkce) export(oauth_flow_auth_code_url) export(oauth_flow_bearer_jwt) export(oauth_flow_client_credentials) export(oauth_flow_device) export(oauth_flow_password) export(oauth_flow_refresh) export(oauth_flow_token_exchange) export(oauth_redirect_uri) export(oauth_token) export(oauth_token_cached) export(obfuscate) export(obfuscated) export(req_auth_aws_v4) export(req_auth_basic) export(req_auth_bearer_token) export(req_body_file) export(req_body_form) export(req_body_json) export(req_body_json_modify) export(req_body_multipart) export(req_body_raw) export(req_cache) export(req_cookie_preserve) export(req_cookies_set) export(req_dry_run) export(req_error) export(req_headers) export(req_headers_redacted) export(req_method) export(req_oauth) export(req_oauth_auth_code) export(req_oauth_bearer_jwt) export(req_oauth_client_credentials) export(req_oauth_device) export(req_oauth_password) export(req_oauth_refresh) export(req_oauth_token_exchange) export(req_options) export(req_perform) export(req_perform_connection) export(req_perform_iterative) export(req_perform_parallel) export(req_perform_promise) export(req_perform_sequential) export(req_perform_stream) export(req_progress) export(req_proxy) export(req_retry) export(req_stream) export(req_template) export(req_throttle) export(req_timeout) export(req_url) export(req_url_path) export(req_url_path_append) export(req_url_query) export(req_url_relative) export(req_user_agent) export(req_verbose) export(request) export(resp_body_html) export(resp_body_json) export(resp_body_raw) export(resp_body_string) export(resp_body_xml) export(resp_check_content_type) export(resp_check_status) export(resp_content_type) export(resp_date) export(resp_encoding) export(resp_has_body) export(resp_header) export(resp_header_exists) export(resp_headers) export(resp_is_error) export(resp_link_url) export(resp_raw) export(resp_request) export(resp_retry_after) export(resp_status) export(resp_status_desc) export(resp_stream_aws) export(resp_stream_is_complete) export(resp_stream_lines) export(resp_stream_raw) export(resp_stream_sse) export(resp_url) export(resp_url_path) export(resp_url_queries) export(resp_url_query) export(response) export(response_json) export(resps_data) export(resps_failures) export(resps_requests) export(resps_successes) export(secret_decrypt) export(secret_decrypt_file) export(secret_encrypt) export(secret_encrypt_file) export(secret_has_key) export(secret_make_key) export(secret_read_rds) export(secret_write_rds) export(signal_total_pages) export(throttle_status) export(url_build) export(url_modify) export(url_modify_query) export(url_modify_relative) export(url_parse) export(url_query_build) export(url_query_parse) export(with_mock) export(with_mocked_responses) export(with_verbosity) import(R6) import(rlang) importFrom(glue,glue) importFrom(lifecycle,deprecated) importFrom(magrittr,"%>%") httr2/LICENSE0000644000176200001440000000005314052737620012326 0ustar liggesusersYEAR: 2021 COPYRIGHT HOLDER: httr2 authors httr2/NEWS.md0000644000176200001440000004632614762062272012436 0ustar liggesusers# httr2 1.1.1 ## New features * `req_perform_parallel()` lifts many of the previous restrictions. It supports simplified versions of `req_throttle()` and `req_retry()`, can refresh OAuth tokens, and checks the cache before/after each request. (#681). * Default verbosity can be controlled by the `HTTR2_VERBOSITY` environment variable (#687). * `local_verbosity()` matches the existing `with_verbosity()` and allows for local control of verbosity (#687). * `req_dry_run()` and `req_verbose()` display compressed correctly (#91, #656) and automatically prettify JSON bodies (#668). You can suppress prettification with `options(httr2_pretty_json = FALSE)` (#668). * `req_throttle()` implements a new "token bucket" algorithm that maintains average rate limits while allowing bursts of higher request rates. ## Minor improvements and bug fixes * `aws_v4_signature()` correctly processes URLs containing query parameters (@jeffreyzuber, #645). * `oauth_client()` and `oauth_token()` implement improved print methods with bulleted lists, similar to other httr2 objects, and `oauth_client()` with custom `auth` functions no longer produces errors (#648). * `req_dry_run()` omits headers that would vary in tests and can prettify JSON output. * `req_headers()` automatically redacts `Authorization` headers (#649) and correctly implements case-insensitive modification of existing headers (#682). * `req_headers_redacted()` now supports dynamic dots (#647). * `req_oauth_auth_code()` no longer adds trailing "/" characters to properly formed `redirect_uri` values (@jonthegeek, #646). * `req_perform_connection()` produces more helpful error messages when requests fail at the networking level. * `req_perform_parallel(pool)` now is deprecated in favour of a new `max_active` argument (#681). * `req_user_agent()` memoizes the default user agent to improve performance, as computing version numbers is relatively slow (300 µs). * `resp_link_url()` once again respects the case insensitivity for header names (@DavidRLovell, #655). * `resp_stream_sse()` automatically retrieves the next event when the current event contains no data, and returns data as a single string (#650). * `str()` correctly redacts redacted headers (#682). # httr2 1.1.0 ## Lifecycle changes * `req_perform_stream()` is superseded in favor of `req_perform_connection()`, which is no longer experimental (#625). * `with_mock()` and `local_mock()` are defunct and will be removed in the next release. ## New features * `is_online()` wraps `curl::has_internet()`, making it easy to tell if you're currently online (#512). * `req_headers_redacted()` makes it easier to redact sensitive headers (#561). * `req_retry()` implements "circuit breaking", which immediatelys error after multiple failures to the same server (e.g. because the server is down) (#370). * `req_url_relative()` navigates to a relative URL (#449). * `resp_request()` returns the request associated with a response; this can be useful when debugging (#604). * `resp_stream_is_complete()` checks if data remains in the stream (#559). * `url_modify()`, `url_modify_query()`, and `url_modify_relative()` modify URLs (#464); `url_query_parse()` and `url_query_build()` parse and build query strings (#425). ## Bug fixes and minor improvements * OAuth response parsing errors now have a dedicated `httr2_oauth_parse` error class that includes the original response object (@atheriel, #596). * `curl_translate()` converts cookie headers to `req_cookies_set()` (#431) and JSON data to `req_body_json_modify()` calls (#258). * `print.request()` escapes `{}` in headers (#586). * `req_auth_aws_v4()` formats the AWS Authorization header correctly (#627). * `req_retry()` defaults to `max_tries = 2` when nethier `max_tries` nor `max_seconds` is set. If you want to disable retries, set `max_tries = 1`. * `req_perform_connection()` gains a `verbosity` argument, which is useful for understanding exactly how data is streamed back to you (#599). `req_perform_promise()` also gains a `verbosity` argument. * `req_url_query()` can control how spaces are encoded with `.space` (#432). * `resp_link_url()` handles multiple `Link` headers (#587). * `resp_stream_sse()` will warn if it recieves a partial event. * `url_parse()` parses relative URLs with new `base_url` argument (#449) and the uses faster and more correct `curl::curl_parse_url()` (#577). # httr2 1.0.7 * `req_perform_promise()` upgraded to use event-driven async based on waiting efficiently on curl socket activity (#579). * New `req_oauth_token_exchange()` and `oauth_flow_token_exchange()` functions implement the OAuth token exchange protocol from RFC 8693 (@atheriel, #460). # httr2 1.0.6 * Fix stochastic test failure, particularly on CRAN (#572) * New `oauth_cache_clear()` is an exported end point to clear the OAuth cache. * New `req_auth_aws_v4()` signs request using AWS's special format (#562, #566). * `req_cache()` no longer retrieves anything but `GET` requests from the cache. * New `resp_stream_aws()` to retrieve AWS's special streaming format. With thanks to for a simple reference implementation. # httr2 1.0.5 * `req_perform_parallel()` and `req_perform_promise()` now correctly set up the method and body (#549). # httr2 1.0.4 * `req_body_file()` now works with files >64kb once more (#524) and no longer leaks a connection if the response doesn't complete succesfully (#534). * `req_body_*()` now give informative error if you attempt to change the body type (#451). * `req_cache()` now re-caches the response if the body is hasn't been modified but the headers have changed (#442). It also works better when `req_perform()` sets a path (#442). * New `req_cookie_set()` allows you to set client side cookies (#369). * `req_perform()` no longer displays a progress bar when sleeping during tests. You can override this behaviour by setting the option `httr2_progress`. * `req_perform_iterative()` is no longer experimental. * New `req_perform_connection()` for working with streaming data. Unlike `req_perform_stream()` which uses callbacks, `req_perform_connection()` returns a regular response object with a connection as the body. Unlike `req_perform_stream()` it supports `req_retry()` (with @jcheng5, #519). * `req_retry()` no longer treates low-level HTTP failures the same way as transient errors by default. You can return to the previous behaviour with `retry_on_error = TRUE`. * `resp_body_html()` and `resp_body_xml()` now work when `req_perform()` is given a path (#448). * New `resp_stream_bytes()`, `resp_stream_lines()`, and `resp_stream_sse()` for streaming chunk from a connection response (#519). # httr2 1.0.3 * `jwt_encode_hmac()` now calls correct underlying function `jose::jwt_encode_hmac()` and has correct default size parameter value (@denskh, #508). * `req_cache()` now prunes cache _before_ checking if a given key exists, eliminating the occassional error about reading from an invalid RDS file. It also no longer tests for existence then later reads the cache, avoiding potential race conditions. * New `req_perform_promise()` creates a `promises::promise` so a request can run in the background (#501, @gergness). * `req_perform_parallel()` now respects error handling in `req_error()`. # httr2 1.0.2 * `req_body_file()` now only opens a connection when the request actually needs data. In particular, this makes it work better with `req_perform_parallel()` (#487). * `req_cache()` no longer fails if the `rds` files are somehow corrupted and now defaults the `debug` argument to the `httr2_cache_debug` option to make it easier to debug caching buried in other people's code (#486). * `req_oauth_password()` now only asks for your password once (#498). * `req_perform_parallel()` now works correctly with `req_cache()` (#447) and now works when downloading 0 byte files (#478) * `req_perform_stream()` no longer applies the `callback` to unsuccessful responses, instead creating a regular response. It also now sets `last_request()` and `last_response()` (#479). * `req_url_query()` now allows you to opt out of escaping for multi-value parameters (#404). # httr2 1.0.1 * `req_perform_stream()` gains a `round = c("byte", "line")` argument to control how the stream is rounded (#437). * `req_retry()` gives a clearer error if `after` returns the wrong type of value (#385). * `req_template()` now works when you have a bare `:` in a template that uses "uri" style (#389). * `req_timeout()` now resets the value of `connecttimeout` set by curl. This ensures that you can use `req_timeout()` to increase the connection timeout past 10s (#395). * `url_parse()` is considerably faster thanks to performance optimisations by and discussion with @DyfanJones (#429). # httr2 1.0.0 ## Function lifecycle * `local_mock()` and `with_mock()` have been deprecated in favour of `local_mocked_responses()` and `with_mocked_responses()` (#301). * `multi_req_perform()` is deprecated in favour of `req_perform_parallel()`. `req_stream()` is deprecated in favour of `req_perform_stream()` (#314). * `oauth_flow_auth_code()` deprecates `host_name` and `port` arguments in favour of using `redirect_uri`. It also deprecates `host_ip` since it seems unlikely that changing this is ever useful. * `oauth_flow_auth_code_listen()` now takes a single `redirect_uri` argument instead of separate `host_ip` and `port` arguments. This is a breaking change but I don't expect anyone to call this function directly (which was confirmed by a GitHub search) so I made the change without deprecation. * `req_body_form()` and `req_body_multipart()` now require data `...`; they no longer accept a single list for compatibility with the 0.1.0 API. ## Multiple requests * New `req_perform_sequential()` performs a known set of requests sequentially. It has an interface similar to `req_perform_parallel()` but with no limitations, and the cost of being slower (#361). * New `req_perform_iterative()` performs multiple requests, where each request is derived from the previous response (@mgirlich, #8). * `req_perform_parallel()` replaces `multi_req_perform()` to match the new naming scheme (#314). It gains a `progress` argument. * `req_perform_iterative()`, `req_perform_parallel()`, and `req_perform_sequential()` share a new error handling strategy. By default, errors will be bubbled up, but you can choose an alternative strategy with the `on_error` argument (#372). * A new family of functions `resps_successes()`, `resps_failures()`, `resps_requests()` and `resps_data()` make it easier to work with lists of responses (#357). Behind the scenes, these work because the request is now stored in the response (or error) object (#357). * `resp_body_json()` and `resp_body_xml()` now cache the parsed values so that you can use them repeatedly without worrying about the performance cost. This supports the design `req_perform_iterative()` by avoiding the need to carefully pass around a parsed object. ## OAuth features * A new `vignette("oauth")` gives many more details about how OAuth works and how to use it with httr2 (#234), and the OAuth docs have been overhauled to make it more clear that you should use `req_oauth_*()`, not `oauth_*()` (#330). * If you are using an OAuth token with a refresh token, and that refresh token has expired, then httr2 will now re-run the entire flow to get you a new token (#349). * New `oauth_cache_path()` returns the path that httr2 uses for caching OAuth tokens. Additionally, you can now change the cache location by setting the `HTTR2_OAUTH_CACHE` env var. This is now more obvious to the user, because httr2 now informs the user whenever a token is cached. * `oauth_flow_auth_code()` gains a `redirect_uri` argument rather than deriving this URL automatically from the `host_name` and `port` (#248). It uses this argument to automatically choose which strategy to use to get the auth code, either launching a temporary web server or, new, allowing you to manually enter the details with the help of a custom JS/HTML page hosted elsewhere, or by copying and pasting the URL you're redirected to (@fh-mthomson, #326). The temporary web server now also respects the path component of `redirect_uri`, if the API needs a specific path (#149). * New `oauth_token_cached()` allows you to get an OAuth token while still taking advantage of httr2's caching and auto-renewal features. For expert use only (#328). ## Other new features * @mgirlich is now a httr2 contributor in recognition of his many contributions. * `req_cache()` gains `max_n`, `max_size`, and `max_age` arguments to automatically prune the cache. By default, the cache will stay under 1 GB (#207). * New `req_body_json_modify()` allows you to iteratively modify a JSON body of a request. * New `req_cookie_preserve()` lets you use a file to share cookies across requests (#223). * New `req_progress()` adds a progress bar to long downloads or uploads (#20). * New `resp_check_content_type()` to check response content types (#190). `resp_body_json()` and friends give better errors if no `Content-Type` header is present in the response (#284). * New `resp_has_body()` returns a `TRUE` or `FALSE` depending on whether or not the response has a body (#205). * New `resp_url()`, `resp_url_path()`, `resp_url_queries()` and `resp_url_query()` to extract various part of the response url (#57). * `req_url_query()` gains a `.multi` parameter that controls what happens when you supply multiple values in a vector. The default will continue to error but you can use `.multi = "comma"` to separate with commas, `"pipe"` to separate with `|`, and `"explode"` to generate one parameter for each value (e.g. `?a=1&a=2`) (#350). * New `secret_encrypt_file()` and `secret_decrypt_file()` for encrypting and decrypting files (#237). ## Minor improvements and bug fixes * The httr2 examples now only run on R 4.2 and later so that we can use the base pipe and lambda syntax (#345). * OAuth errors containing a url now correctly display that URL (instead of the string "uri"). * `curl_translate()` now uses the base pipe, and produces escapes with single quotes or raw strings in case double quotes can't be used (@mgirlich, #264). It gains the argument `simplify_headers` that removes some common but unimportant headers, like `Sec-Fetch-Dest` or `sec-ch-ua-mobile` (@mgirlich, #256). It also parses the query components of the url (@mgirlich, #259) and works with multiline commands from the clipboard (@mgirlich, #254). * `local_mocked_responses()` and `with_mocked_responses()` now accept a list of responses which will be returned in sequence. They also now correctly trigger errors when the mocked response represents an HTTP failure (#252). * `oauth_flow_refresh()` now only warns, not errors, if the `refresh_token` changes, making it a little easier to use in manual workflows (#186). * `obfuscated()` values now display their original call when printed. * `req_body_json()` gains custom content `type` argument and respects custom content-type set in header (@mgirlich, #189). * `req_cache()` now combine the headers of the new response with the headers of the cached response. In particular, this fixes `resp_body_json/xml/html()` on cached responses (@mgirlich, #277). * `req_perform()` now throws error with class `httr2_failure/httr2_error` if the request fails, and that error now captures the curl error as the parent. If the request succeeds, but the response is an HTTP error, that error now also has super class `httr2_error`. This means that all errors thrown by httr2 now inherit from the `httr2_error` class. See new docs in `?req_error()` for more details. * `req_perform()`'s progress bar can be suppressed by setting `options(httr2_progress = FALSE)` (#251). Progress bars displayed while waiting for some time to pass now tell you why they're waiting (#206). * `req_oauth_bearer_jwt()` now includes the claim in the cache key (#192). * `req_oauth_device()` now takes a `auth_url` parameter making it usable (#331, @taerwin). * `req_url_query()` gains a `.multi` parameter that controls what happens when you supply multiple values in a vector. The default will continue to error but you can use `.multi = "comma"` to separate with commas, `"pipe"` to separate with `|`, and `"explode"` to generate one parameter for each value (e.g. `?a=1&a=2`) (#350). # httr2 0.2.3 * New `example_url()` to launch a local server, making tests and examples more robust. * New `throttle_status()` to make it a little easier to verify what's happening with throttling. * `req_oauth_refresh()` now respects the `refresh_token` for caching (@mgirlich, #178). * `req_perform()` now always sleeps before a request, rather than after it. It also gains an `error_call` argument and communicates more clearly where the error occurred (@mgirlich, #187). * `req_url_path()` and `req_url_path_append()` can now handle `NULL` or empty `...` and the elements of `...` can also have length > 1 (@mgirlich, #177). * `sys_sleep()` (used by `req_retry()` and `req_throttle()`) gains a progress bar (#202). # httr2 0.2.2 * `curl_translate()` can now handle curl copied from Chrome developer tools (@mgirlich, #161). * `req_oauth_*()` can now refresh OAuth tokens. One, two, or even more times! (@jennybc, #166) * `req_oauth_device()` can now work in non-interactive environments, as intendend (@flahn, #170) * `req_oauth_refresh()` and `oauth_flow_refresh()` now use the envvar `HTTR2_REFRESH_TOKEN`, not `HTTR_REFRESH_TOKEN` (@jennybc, #169). * `req_proxy()` now uses the appropriate authentication option (@jl5000). * `req_url_query()` can now opt out of escaping with `I()` (@boshek, #152). * Can now print responses where content type is the empty string (@mgirlich, #163). # httr2 0.2.1 * "Wrapping APIs" is now an article, not a vignette. * `req_template()` now appends the path instead of replacing it (@jchrom, #133) # httr2 0.2.0 ## New features * `req_body_form()`, `req_body_multipart()`, and `req_url_query()` now support multiple arguments with the same name (#97, #107). * `req_body_form()`, `req_body_multipart()`, now match the interface of `req_url_query()`, taking name-value pairs in `...`. Supplying a single `list()` is now deprecated and will be removed in a future version. * `req_body_json()` now overrides the existing JSON body, rather than attempting to merge with the previous value (#95, #115). * Implement `req_proxy()` (owenjonesuob, #77). ## Minor improvements and bug fixes * `httr_path` class renamed to `httr2_path` to correctly match package name (#99). * `oauth_flow_device()` gains PKCE support (@flahn, #92), and the interactive flow is a little more user friendly. * `req_error()` can now correct force successful HTTP statuses to fail (#98). * `req_headers()` will now override `Content-Type` set by `req_body_*()` (#116). * `req_throttle()` correctly sets throttle rate (@jchrom, #101). * `req_url_query()` never uses scientific notation for queries (#93). * `req_perform()` now respects `httr::with_verbose()` (#85). * `response()` now defaults `body` to `raw(0)` for consistency with real responses (#100). * `req_stream()` no longer throws an error for non 200 http status codes (@DMerch, #137) # httr2 0.1.1 * Fix R CMD check failures on CRAN * Added a `NEWS.md` file to track changes to the package. httr2/inst/0000755000176200001440000000000014762062312012275 5ustar liggesusershttr2/inst/doc/0000755000176200001440000000000014762062312013042 5ustar liggesusershttr2/inst/doc/httr2.html0000644000176200001440000010510214762062312014772 0ustar liggesusers httr2

httr2

The goal of this document is show you the basics of httr2. You’ll learn how to create and submit HTTP requests and work with the HTTP responses that you get back. httr2 is designed to map closely to the underlying HTTP protocol, which I’ll explain as we go along. For more details, I also recommend “An overview of HTTP†from MDN.

library(httr2)

Create a request

In httr2, you start by creating a request. If you’re familiar with httr, this a big change: with httr you could only submit a request, immediately receiving a response. Having an explicit request object makes it easier to build up a complex request piece by piece and works well with the pipe.

Every request starts with a URL:

req <- request(example_url())
req
#> <httr2_request>
#> GET http://127.0.0.1:57420/
#> Body: empty

Here, instead of an external website, we use a test server that’s built-in to httr2 itself. That ensures that this vignette will work regardless of when or where you run it.

We can see exactly what this request will send to the server with a dry run:

req |> req_dry_run()
#> GET / HTTP/1.1
#> accept: */*
#> accept-encoding: deflate, gzip
#> host: 127.0.0.1:57420
#> user-agent: httr2/1.1.1 r-curl/6.2.1 libcurl/8.11.1

The first line of the request contains three important pieces of information:

  • The HTTP method, which is a verb that tells the server what you want to do. Here it’s GET, the most common verb, indicating that we want to get a resource. Other verbs include POST, to create a new resource, PUT, to replace an existing resource, and DELETE, to delete a resource.

  • The path, which is the URL stripped of details that the server already knows, i.e. the protocol (http or https), the host (localhost), and the port (57420).

  • The version of the HTTP protocol. This is unimportant for our purposes because it’s handled at a lower level.

The following lines specify the HTTP headers, a series of name-value pairs separated by :. The headers in this request were automatically added by httr2, but you can override them or add your own with req_headers():

req |>
  req_headers(
    Name = "Hadley",
    `Shoe-Size` = "11",
    Accept = "application/json"
  ) |>
  req_dry_run()
#> GET / HTTP/1.1
#> accept: application/json
#> accept-encoding: deflate, gzip
#> host: 127.0.0.1:57420
#> name: Hadley
#> shoe-size: 11
#> user-agent: httr2/1.1.1 r-curl/6.2.1 libcurl/8.11.1

Header names are case-insensitive, and servers will ignore headers that they don’t understand.

The headers finish with a blank line which is followed by the body. The requests above (like all GET requests) don’t have a body, so let’s add one to see what happens. The req_body_*() functions provide a variety of ways to add data to the body. Here we’ll use req_body_json() to add some data encoded as JSON:

req |>
  req_body_json(list(x = 1, y = "a")) |>
  req_dry_run()
#> POST / HTTP/1.1
#> accept: */*
#> accept-encoding: deflate, gzip
#> content-length: 15
#> content-type: application/json
#> host: 127.0.0.1:57420
#> user-agent: httr2/1.1.1 r-curl/6.2.1 libcurl/8.11.1
#> 
#> {
#>   "x": 1,
#>   "y": "a"
#> }

What’s changed?

  • The method has changed from GET to POST. POST is the standard method for sending data to a website, and is automatically used whenever you add a body. Use req_method() to use a different method.

  • There are two new headers: Content-Type and Content-Length. They tell the server how to interpret the body — it’s encoded as JSON and is 15 bytes long.

  • We have a body, consisting of some JSON.

Different servers want data encoded differently so httr2 provides a selection of common formats. For example, req_body_form() uses the encoding used when you submit a form from a web browser:

req |>
  req_body_form(x = "1", y = "a") |>
  req_dry_run()
#> POST / HTTP/1.1
#> accept: */*
#> accept-encoding: deflate, gzip
#> content-length: 7
#> content-type: application/x-www-form-urlencoded
#> host: 127.0.0.1:57420
#> user-agent: httr2/1.1.1 r-curl/6.2.1 libcurl/8.11.1
#> 
#> x=1&y=a

And req_body_multipart() uses the multipart encoding which is particularly important when you need to send larger amounts of data or complete files:

req |>
  req_body_multipart(x = "1", y = "a") |>
  req_dry_run()
#> POST / HTTP/1.1
#> accept: */*
#> accept-encoding: deflate, gzip
#> content-length: 246
#> content-type: multipart/form-data; boundary=------------------------X8ERKp7EAyDW8aBoV5KxZS
#> host: 127.0.0.1:57420
#> user-agent: httr2/1.1.1 r-curl/6.2.1 libcurl/8.11.1
#> 
#> --------------------------X8ERKp7EAyDW8aBoV5KxZS
#> Content-Disposition: form-data; name="x"
#> 
#> 1
#> --------------------------X8ERKp7EAyDW8aBoV5KxZS
#> Content-Disposition: form-data; name="y"
#> 
#> a
#> --------------------------X8ERKp7EAyDW8aBoV5KxZS--

If you need to send data encoded in a different form, you can use req_body_raw() to add the data to the body and set the Content-Type header.

Perform a request and fetch the response

To actually perform a request and fetch the response back from the server, call req_perform():

req <- request(example_url()) |> req_url_path("/json")
resp <- req |> req_perform()
resp
#> <httr2_response>
#> GET http://127.0.0.1:57420/json
#> Status: 200 OK
#> Content-Type: application/json
#> Body: In memory (407 bytes)

You can see a simulation of what httr2 actually received with resp_raw():

resp |> resp_raw()
#> HTTP/1.1 200 OK
#> Date: Wed, 05 Mar 2025 14:50:49 GMT
#> Content-Type: application/json
#> Content-Length: 407
#> ETag: "de760e6d"
#> 
#> {
#>   "firstName": "John",
#>   "lastName": "Smith",
#>   "isAlive": true,
#>   "age": 27,
#>   "address": {
#>     "streetAddress": "21 2nd Street",
#>     "city": "New York",
#>     "state": "NY",
#>     "postalCode": "10021-3100"
#>   },
#>   "phoneNumbers": [
#>     {
#>       "type": "home",
#>       "number": "212 555-1234"
#>     },
#>     {
#>       "type": "office",
#>       "number": "646 555-4567"
#>     }
#>   ],
#>   "children": [],
#>   "spouse": null
#> }

An HTTP response has a very similar structure to an HTTP request. The first line gives the version of HTTP used, and a status code that’s optionally followed by a short description. Then we have the headers, followed by a blank line, followed by a body. The majority of responses will have a body, unlike requests.

You can extract data from the response using the resp_() functions:

  • resp_status() returns the status code and resp_status_desc() returns the description:

    resp |> resp_status()
#> [1] 200
resp |> resp_status_desc()
#> [1] "OK"

  • You can extract all headers with resp_headers() or a specific header with resp_header():

    resp |> resp_headers()
#> <httr2_headers>
#> Date: Wed, 05 Mar 2025 14:50:49 GMT
#> Content-Type: application/json
#> Content-Length: 407
#> ETag: "de760e6d"
resp |> resp_header("Content-Length")
#> [1] "407"

    Headers are case insensitive:

    resp |> resp_header("ConTEnT-LeNgTH")
#> [1] "407"

  • You can extract the body in various forms using the resp_body_*() family of functions. Since this response returns JSON we can use resp_body_json():

    resp |> resp_body_json() |> str()
#> List of 8
#>  $ firstName   : chr "John"
#>  $ lastName    : chr "Smith"
#>  $ isAlive     : logi TRUE
#>  $ age         : int 27
#>  $ address     :List of 4
#>   ..$ streetAddress: chr "21 2nd Street"
#>   ..$ city         : chr "New York"
#>   ..$ state        : chr "NY"
#>   ..$ postalCode   : chr "10021-3100"
#>  $ phoneNumbers:List of 2
#>   ..$ :List of 2
#>   .. ..$ type  : chr "home"
#>   .. ..$ number: chr "212 555-1234"
#>   ..$ :List of 2
#>   .. ..$ type  : chr "office"
#>   .. ..$ number: chr "646 555-4567"
#>  $ children    : list()
#>  $ spouse      : NULL

Responses with status codes 4xx and 5xx are HTTP errors. httr2 automatically turns these into R errors:

request(example_url()) |>
  req_url_path("/status/404") |>
  req_perform()
#> Error in `req_perform()`:
#> ! HTTP 404 Not Found.

request(example_url()) |>
  req_url_path("/status/500") |>
  req_perform()
#> Error in `req_perform()`:
#> ! HTTP 500 Internal Server Error.

This is another important difference to httr, which required that you explicitly call httr::stop_for_status() to turn HTTP errors into R errors. You can revert to the httr behaviour with req_error(req, is_error = ~ FALSE).

Control the request process

A number of req_ functions don’t directly affect the HTTP request but instead control the overall process of submitting a request and handling the response. These include:

  • req_cache() sets up a cache so if repeated requests return the same results, you can avoid a trip to the server.

  • req_throttle() will automatically add a small delay before each request so you can avoid hammering a server with many requests.

  • req_retry() sets up a retry strategy so that if the request either fails or you get a transient HTTP error, it’ll automatically retry after a short delay.

For more details see their documentation, as well as examples of the usage in real APIs in vignette("wrapping-apis").

httr2/inst/doc/httr2.Rmd0000644000176200001440000001540114761701552014557 0ustar liggesusers--- title: "httr2" output: rmarkdown::html_vignette vignette: > %\VignetteIndexEntry{httr2} %\VignetteEngine{knitr::rmarkdown} %\VignetteEncoding{UTF-8} --- ```{r, include = FALSE} # needs pipe & avoids error = TRUE problem in 4.3.0 run_code <- getRversion() >= "4.4.0" knitr::opts_chunk$set( collapse = TRUE, comment = "#>", eval = run_code, purl = run_code ) ``` The goal of this document is show you the basics of httr2. You'll learn how to create and submit HTTP requests and work with the HTTP responses that you get back. httr2 is designed to map closely to the underlying HTTP protocol, which I'll explain as we go along. For more details, I also recommend "[An overview of HTTP](https://developer.mozilla.org/en-US/docs/Web/HTTP/Overview)" from MDN. ```{r setup} #| eval: true library(httr2) ``` ## Create a request In httr2, you start by creating a request. If you're familiar with httr, this a big change: with httr you could only submit a request, immediately receiving a response. Having an explicit request object makes it easier to build up a complex request piece by piece and works well with the pipe. Every request starts with a URL: ```{r} req <- request(example_url()) req ``` Here, instead of an external website, we use a test server that's built-in to httr2 itself. That ensures that this vignette will work regardless of when or where you run it. We can see exactly what this request will send to the server with a dry run: ```{r} req |> req_dry_run() ``` ```{r} #| include: FALSE #| eval: true port <- if (run_code) paste0("`", url_parse(example_url())$port, "`") else "e.g. `1234`" ``` The first line of the request contains three important pieces of information: - The HTTP **method**, which is a verb that tells the server what you want to do. Here it's GET, the most common verb, indicating that we want to *get* a resource. Other verbs include POST, to create a new resource, PUT, to replace an existing resource, and DELETE, to delete a resource. - The **path**, which is the URL stripped of details that the server already knows, i.e. the protocol (`http` or `https`), the host (`localhost`), and the port (`r port`). - The version of the HTTP protocol. This is unimportant for our purposes because it's handled at a lower level. The following lines specify the HTTP **headers**, a series of name-value pairs separated by `:`. The headers in this request were automatically added by httr2, but you can override them or add your own with `req_headers()`: ```{r} req |> req_headers( Name = "Hadley", `Shoe-Size` = "11", Accept = "application/json" ) |> req_dry_run() ``` Header names are case-insensitive, and servers will ignore headers that they don't understand. The headers finish with a blank line which is followed by the **body**. The requests above (like all GET requests) don't have a body, so let's add one to see what happens. The `req_body_*()` functions provide a variety of ways to add data to the body. Here we'll use `req_body_json()` to add some data encoded as JSON: ```{r} req |> req_body_json(list(x = 1, y = "a")) |> req_dry_run() ``` What's changed? - The method has changed from GET to POST. POST is the standard method for sending data to a website, and is automatically used whenever you add a body. Use `req_method()` to use a different method. - There are two new headers: `Content-Type` and `Content-Length`. They tell the server how to interpret the body --- it's encoded as JSON and is 15 bytes long. - We have a body, consisting of some JSON. Different servers want data encoded differently so httr2 provides a selection of common formats. For example, `req_body_form()` uses the encoding used when you submit a form from a web browser: ```{r} req |> req_body_form(x = "1", y = "a") |> req_dry_run() ``` And `req_body_multipart()` uses the multipart encoding which is particularly important when you need to send larger amounts of data or complete files: ```{r} req |> req_body_multipart(x = "1", y = "a") |> req_dry_run() ``` If you need to send data encoded in a different form, you can use `req_body_raw()` to add the data to the body and set the `Content-Type` header. ## Perform a request and fetch the response To actually perform a request and fetch the response back from the server, call `req_perform()`: ```{r} req <- request(example_url()) |> req_url_path("/json") resp <- req |> req_perform() resp ``` You can see a simulation of what httr2 actually received with `resp_raw()`: ```{r} resp |> resp_raw() ``` An HTTP response has a very similar structure to an HTTP request. The first line gives the version of HTTP used, and a status code that's optionally followed by a short description. Then we have the headers, followed by a blank line, followed by a body. The majority of responses will have a body, unlike requests. You can extract data from the response using the `resp_()` functions: - `resp_status()` returns the status code and `resp_status_desc()` returns the description: ```{r} resp |> resp_status() resp |> resp_status_desc() ``` - You can extract all headers with `resp_headers()` or a specific header with `resp_header()`: ```{r} resp |> resp_headers() resp |> resp_header("Content-Length") ``` Headers are case insensitive: ```{r} resp |> resp_header("ConTEnT-LeNgTH") ``` - You can extract the body in various forms using the `resp_body_*()` family of functions. Since this response returns JSON we can use `resp_body_json()`: ```{r} resp |> resp_body_json() |> str() ``` Responses with status codes 4xx and 5xx are HTTP errors. httr2 automatically turns these into R errors: ```{r, error = TRUE} request(example_url()) |> req_url_path("/status/404") |> req_perform() request(example_url()) |> req_url_path("/status/500") |> req_perform() ``` This is another important difference to httr, which required that you explicitly call `httr::stop_for_status()` to turn HTTP errors into R errors. You can revert to the httr behaviour with `req_error(req, is_error = ~ FALSE)`. ## Control the request process A number of `req_` functions don't directly affect the HTTP request but instead control the overall process of submitting a request and handling the response. These include: - `req_cache()` sets up a cache so if repeated requests return the same results, you can avoid a trip to the server. - `req_throttle()` will automatically add a small delay before each request so you can avoid hammering a server with many requests. - `req_retry()` sets up a retry strategy so that if the request either fails or you get a transient HTTP error, it'll automatically retry after a short delay. For more details see their documentation, as well as examples of the usage in real APIs in `vignette("wrapping-apis")`. httr2/inst/doc/httr2.R0000644000176200001440000000456514762062311014241 0ustar liggesusers## ----include = FALSE---------------------------------------------------------- # needs pipe & avoids error = TRUE problem in 4.3.0 run_code <- getRversion() >= "4.4.0" knitr::opts_chunk$set( collapse = TRUE, comment = "#>", eval = run_code, purl = run_code ) ## ----setup-------------------------------------------------------------------- library(httr2) ## ----------------------------------------------------------------------------- req <- request(example_url()) req ## ----------------------------------------------------------------------------- req |> req_dry_run() ## ----------------------------------------------------------------------------- port <- if (run_code) paste0("`", url_parse(example_url())$port, "`") else "e.g. `1234`" ## ----------------------------------------------------------------------------- req |> req_headers( Name = "Hadley", `Shoe-Size` = "11", Accept = "application/json" ) |> req_dry_run() ## ----------------------------------------------------------------------------- req |> req_body_json(list(x = 1, y = "a")) |> req_dry_run() ## ----------------------------------------------------------------------------- req |> req_body_form(x = "1", y = "a") |> req_dry_run() ## ----------------------------------------------------------------------------- req |> req_body_multipart(x = "1", y = "a") |> req_dry_run() ## ----------------------------------------------------------------------------- req <- request(example_url()) |> req_url_path("/json") resp <- req |> req_perform() resp ## ----------------------------------------------------------------------------- resp |> resp_raw() ## ----------------------------------------------------------------------------- resp |> resp_status() resp |> resp_status_desc() ## ----------------------------------------------------------------------------- resp |> resp_headers() resp |> resp_header("Content-Length") ## ----------------------------------------------------------------------------- resp |> resp_header("ConTEnT-LeNgTH") ## ----------------------------------------------------------------------------- resp |> resp_body_json() |> str() ## ----error = TRUE------------------------------------------------------------- try({ request(example_url()) |> req_url_path("/status/404") |> req_perform() request(example_url()) |> req_url_path("/status/500") |> req_perform() }) httr2/tools/0000755000176200001440000000000014556444037012471 5ustar liggesusershttr2/tools/examples.R0000644000176200001440000000104014556444037014425 0ustar liggesusersif (getRversion() < "4.1") { dir.create("man/macros", showWarnings = FALSE, recursive = TRUE) cat( paste( "\\renewcommand{\\examples}{\\section{Examples}{", "These examples are designed to work in R >= 4.1 so that we can take", "advantage of modern syntax like the base pipe (\\verb{|>}) and the ", "function shorthand (\\verb{\\(x) x + 1}). They might not work on the ", "version of R that you're using.", "\\preformatted{#1}}}", collapse = "" ), file = "man/macros/examples.Rd" ) } httr2/README.md0000644000176200001440000001151614762054401012603 0ustar liggesusers # httr2 httr2 website [![R-CMD-check](https://github.com/r-lib/httr2/actions/workflows/R-CMD-check.yaml/badge.svg)](https://github.com/r-lib/httr2/actions/workflows/R-CMD-check.yaml) [![Codecov test coverage](https://codecov.io/gh/r-lib/httr2/branch/main/graph/badge.svg)](https://app.codecov.io/gh/r-lib/httr2?branch=main) httr2 (pronounced “hitter2â€) is a comprehensive HTTP client that provides a modern, pipeable API for working with web APIs. It builds on top of [{curl}](https://jeroen.r-universe.dev/curl) to provide features like explicit request objects, built-in rate limiting & retry tooling, comprehensive OAuth support, and secure handling of secrets and credentials. ## Installation You can install httr2 from CRAN with: ``` r install.packages("httr2") ``` ## Usage To use httr2, start by creating a **request**: ``` r library(httr2) req <- request("https://r-project.org") req #> #> GET https://r-project.org #> Body: empty ``` You can tailor this request with the `req_` family of functions: ``` r # Add custom headers req |> req_headers("Accept" = "application/json") #> #> GET https://r-project.org #> Headers: #> • Accept: "application/json" #> Body: empty # Add a body, turning it into a POST req |> req_body_json(list(x = 1, y = 2)) #> #> POST https://r-project.org #> Body: json encoded data # Modify the path in the url req |> req_url_path(path = "path/to/my/file") #> #> GET https://r-project.org/path/to/my/file #> Body: empty # Automatically retry if the request fails req |> req_retry(max_tries = 5) #> #> GET https://r-project.org #> Body: empty #> Policies: #> • retry_max_tries : 5 #> • retry_on_failure : FALSE #> • retry_failure_threshold: Inf #> • retry_failure_timeout : 30 #> • retry_realm : "r-project.org" # Change the HTTP method req |> req_method("PATCH") #> #> PATCH https://r-project.org #> Body: empty ``` And see exactly what httr2 will send to the server with `req_dry_run()`: ``` r req |> req_dry_run() #> GET / HTTP/1.1 #> accept: */* #> accept-encoding: deflate, gzip #> host: r-project.org #> user-agent: httr2/1.1.0.9000 r-curl/6.2.1 libcurl/8.11.1 ``` Use `req_perform()` to perform the request, retrieving a **response**: ``` r resp <- req_perform(req) resp #> #> GET https://www.r-project.org/ #> Status: 200 OK #> Content-Type: text/html #> Body: In memory (6963 bytes) ``` The `resp_` functions help you extract various useful components of the response: ``` r resp |> resp_content_type() #> [1] "text/html" resp |> resp_status_desc() #> [1] "OK" resp |> resp_body_html() #> {html_document} #> #> [1] \n\n
\n ... ``` ## Major differences to httr - You can now create and modify a request without performing it. This means that there’s now a single function to perform the request and fetch the result: `req_perform()`. `req_perform()` replaces `httr::GET()`, `httr::POST()`, `httr::DELETE()`, and more. - HTTP errors are automatically converted into R errors. Use `req_error()` to override the defaults (which turn all 4xx and 5xx responses into errors) or to add additional details to the error message. - You can automatically retry if the request fails or encounters a transient HTTP error (e.g. a 429 rate limit request). `req_retry()` defines the maximum number of retries, which errors are transient, and how long to wait between tries. - OAuth support has been totally overhauled to directly support many more flows and to make it much easier to both customise the built-in flows and to create your own. - You can manage secrets (often needed for testing) with `secret_encrypt()` and friends. You can obfuscate mildly confidential data with `obfuscate()`, preventing it from being scraped from published code. - You can automatically cache all cacheable results with `req_cache()`. Relatively few API responses are cacheable, but when they are it typically makes a big difference. ## Acknowledgements httr2 wouldn’t be possible without [curl](https://cran.dev/curl/), [openssl](https://cran.dev/openssl/), [jsonlite](https://cran.dev/jsonlite/), and [jose](https://github.com/r-lib/jose/), which are all maintained by [Jeroen Ooms](https://github.com/jeroen). A big thanks also go to [Jenny Bryan](https://jennybryan.org) and [Craig Citro](https://www.craigcitro.org) who have given me much useful feedback on both the design of the internals and the user facing API. httr2/build/0000755000176200001440000000000014762062312012417 5ustar liggesusershttr2/build/vignette.rds0000644000176200001440000000030014762062312014747 0ustar liggesusers‹‹àb```b`aab`b2™… 1# 'æ̀())2̉ ÊMA“`K  rATg”äæ É°CÍÚ( †HĐz$SósS‹Ñơº¤¤æ¥€„ÿa×ÏøM ‡wjey~L6¨·̀œT˜½!™%ps€‹”É„î óQÜÏY”_®ó/(|€Ä @÷hrNb1ºG¹RKở€úAîÁ ›d¡httr2/configure0000755000176200001440000000075114762062312013232 0ustar liggesusers#! /usr/bin/env sh # Check that this is not just ./configure. We need to run this # from R CMD INSTALL, to have the R env vars set. if [ -z "$R_HOME" ]; then echo >&2 R_HOME is not set, are you running R CMD INSTALL? exit 1 fi # Find the R binary we need to use. This is a bit trickier on # Windows, because it has two architectures. On windows R_ARCH_BIN # is set, so this should work everywhere. RBIN="${R_HOME}/bin${R_ARCH_BIN}/R" "$RBIN" --vanilla --slave -f tools/examples.R httr2/man/0000755000176200001440000000000014761701552012100 5ustar liggesusershttr2/man/pipe.Rd0000644000176200001440000000066014052735202013316 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/utils-pipe.R \name{\%>\%} \alias{\%>\%} \title{Pipe operator} \usage{ lhs \%>\% rhs } \arguments{ \item{lhs}{A value or the magrittr placeholder.} \item{rhs}{A function call using the magrittr semantics.} } \value{ The result of calling \code{rhs(lhs)}. } \description{ See \code{magrittr::\link[magrittr:pipe]{\%>\%}} for details. } \keyword{internal} httr2/man/req_dry_run.Rd0000644000176200001440000000445114761701552014724 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/req-dry-run.R \name{req_dry_run} \alias{req_dry_run} \title{Perform a dry run} \usage{ req_dry_run( req, quiet = FALSE, redact_headers = TRUE, testing_headers = is_testing(), pretty_json = getOption("httr2_pretty_json", TRUE) ) } \arguments{ \item{req}{A httr2 \link{request} object.} \item{quiet}{If \code{TRUE} doesn't print anything.} \item{redact_headers}{Redact confidential data in the headers? Currently redacts the contents of the Authorization header to prevent you from accidentally leaking credentials when debugging/reprexing.} \item{testing_headers}{If \code{TRUE}, removes headers that httr2 would otherwise be automatically added, which are likely to change across test runs. This currently includes: \itemize{ \item The default \code{User-Agent}, which varies based on libcurl, curl, and httr2 versions. \item The `Host`` header, which is often set to a testing server. \item The \code{Content-Length} header, which will often vary by platform because of varying newline encodings. (And is also not correct if you have \code{pretty_json = TRUE}.) \item The \code{Accept-Encoding} header, which varies based on how libcurl was built. }} \item{pretty_json}{If \code{TRUE}, automatically prettify JSON bodies.} } \value{ Invisibly, a list containing information about the request, including \code{method}, \code{path}, and \code{headers}. } \description{ This shows you exactly what httr2 will send to the server, without actually sending anything. It requires the httpuv package because it works by sending the real HTTP request to a local webserver, thanks to the magic of \code{\link[curl:curl_echo]{curl::curl_echo()}}. } \details{ \subsection{Limitations}{ \itemize{ \item The HTTP version is always \code{HTTP/1.1} (since you can't determine what it will actually be without connecting to the real server). } } } \examples{ # httr2 adds default User-Agent, Accept, and Accept-Encoding headers request("http://example.com") |> req_dry_run() # the Authorization header is automatically redacted to avoid leaking # credentials on the console req <- request("http://example.com") |> req_auth_basic("user", "password") req |> req_dry_run() # if you need to see it, use redact_headers = FALSE req |> req_dry_run(redact_headers = FALSE) } httr2/man/req_oauth_client_credentials.Rd0000644000176200001440000000326714715443111020272 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/oauth-flow-client-credentials.R \name{req_oauth_client_credentials} \alias{req_oauth_client_credentials} \alias{oauth_flow_client_credentials} \title{OAuth with client credentials} \usage{ req_oauth_client_credentials(req, client, scope = NULL, token_params = list()) oauth_flow_client_credentials(client, scope = NULL, token_params = list()) } \arguments{ \item{req}{A httr2 \link{request} object.} \item{client}{An \code{\link[=oauth_client]{oauth_client()}}.} \item{scope}{Scopes to be requested from the resource owner.} \item{token_params}{List containing additional parameters passed to the \code{token_url}.} } \value{ \code{req_oauth_client_credentials()} returns a modified HTTP \link{request} that will use OAuth; \code{oauth_flow_client_credentials()} returns an \link{oauth_token}. } \description{ Authenticate using OAuth \strong{client credentials flow}, as defined by \href{https://datatracker.ietf.org/doc/html/rfc6749#section-4.4}{Section 4.4 of RFC 6749}. It is used to allow the client to access resources that it controls directly, not on behalf of an user. Learn more about the overall OAuth authentication flow in \url{https://httr2.r-lib.org/articles/oauth.html}. } \examples{ req_auth <- function(req) { req_oauth_client_credentials( req, client = oauth_client("example", "https://example.com/get_token") ) } request("https://example.com") |> req_auth() } \seealso{ Other OAuth flows: \code{\link{req_oauth_auth_code}()}, \code{\link{req_oauth_bearer_jwt}()}, \code{\link{req_oauth_password}()}, \code{\link{req_oauth_refresh}()}, \code{\link{req_oauth_token_exchange}()} } \concept{OAuth flows} httr2/man/req_auth_bearer_token.Rd0000644000176200001440000000210314666312277016721 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/req-auth.R \name{req_auth_bearer_token} \alias{req_auth_bearer_token} \title{Authenticate request with bearer token} \usage{ req_auth_bearer_token(req, token) } \arguments{ \item{req}{A httr2 \link{request} object.} \item{token}{A bearer token} } \value{ A modified HTTP \link{request}. } \description{ A bearer token gives the bearer access to confidential resources (so you should keep them secure like you would with a user name and password). They are usually produced by some large authentication scheme (like the various OAuth 2.0 flows), but you are sometimes given then directly. } \examples{ req <- request("http://example.com") |> req_auth_bearer_token("sdaljsdf093lkfs") req # httr2 does its best to redact the Authorization header so that you don't # accidentally reveal confidential data. Use `redact_headers` to reveal it: print(req, redact_headers = FALSE) } \seealso{ See \href{https://datatracker.ietf.org/doc/html/rfc6750}{RFC 6750} for more details about bearer token usage with OAuth 2.0. } httr2/man/with_verbosity.Rd0000644000176200001440000000327214761701552015454 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/verbosity.R \name{with_verbosity} \alias{with_verbosity} \alias{local_verbosity} \title{Temporarily set verbosity for all requests} \usage{ with_verbosity(code, verbosity = 1) local_verbosity(verbosity, env = caller_env()) } \arguments{ \item{code}{Code to execture} \item{verbosity}{How much information to print? This is a wrapper around \code{\link[=req_verbose]{req_verbose()}} that uses an integer to control verbosity: \itemize{ \item \code{0}: no output \item \code{1}: show headers \item \code{2}: show headers and bodies \item \code{3}: show headers, bodies, and curl status messages. } Use \code{\link[=with_verbosity]{with_verbosity()}} to control the verbosity of requests that you can't affect directly.} \item{env}{Environment to use for scoping changes.} } \value{ \code{with_verbosity()} returns the result of evaluating \code{code}. \code{local_verbosity()} is called for its side-effect and invisibly returns the previous value of the option. } \description{ \code{with_verbosity()} and \code{local_verbosity()} are useful for debugging httr2 code buried deep inside another package, because they allow you to change the verbosity even when you don't have access to the request. Both functions work by temporarily setting the \code{httr2_verbosity} option. You can also control verbosity by setting the \code{HTTR2_VERBOSITY} environment variable. This has lower precedence than the option, but can be more easily changed outside of R. } \examples{ fun <- function() { request("https://httr2.r-lib.org") |> req_perform() } with_verbosity(fun()) fun <- function() { local_verbosity(2) # someotherpackage::fun() } } httr2/man/response.Rd0000644000176200001440000000311614556444037014232 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/resp.R \name{response} \alias{response} \alias{response_json} \title{Create a new HTTP response} \usage{ response( status_code = 200, url = "https://example.com", method = "GET", headers = list(), body = raw() ) response_json( status_code = 200, url = "https://example.com", method = "GET", headers = list(), body = list() ) } \arguments{ \item{status_code}{HTTP status code. Must be a single integer.} \item{url}{URL response came from; might not be the same as the URL in the request if there were any redirects.} \item{method}{HTTP method used to retrieve the response.} \item{headers}{HTTP headers. Can be supplied as a raw or character vector which will be parsed using the standard rules, or a named list.} \item{body}{Response, if any, contained in the response body. For \code{response_json()}, a R data structure to serialize to JSON.} } \value{ An HTTP response: an S3 list with class \code{httr2_response}. } \description{ Generally, you should not need to call this function directly; you'll get a real HTTP response by calling \code{\link[=req_perform]{req_perform()}} and friends. This function is provided primarily for testing, and a place to describe the key components of a response. \code{response()} creates a generic response; \code{response_json()} creates a response with a JSON body, automatically adding the correct Content-Type header. } \examples{ response() response(404, method = "POST") response(headers = c("Content-Type: text/html", "Content-Length: 300")) } \keyword{internal} httr2/man/req_oauth.Rd0000644000176200001440000000210514666312277014362 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/oauth.R \name{req_oauth} \alias{req_oauth} \title{OAuth authentication} \usage{ req_oauth(req, flow, flow_params, cache) } \arguments{ \item{req}{A httr2 \link{request} object.} \item{flow}{An \code{oauth_flow_} function used to generate the access token.} \item{flow_params}{Parameters for the flow. This should be a named list whose names match the argument names of \code{flow}.} \item{cache}{An object that controls how the token is cached. This should be a list containing three functions: \itemize{ \item \code{get()} retrieves the token from the cache, returning \code{NULL} if not cached yet. \item \code{set()} saves the token to the cache. \item \code{clear()} removes the token from the cache }} } \value{ An \link{oauth_token}. } \description{ This is a low-level helper for automatically authenticating a request with an OAuth flow, caching the access token and refreshing it where possible. You should only need to use this function if you're implementing your own OAuth flow. } \keyword{internal} httr2/man/httr2-package.Rd0000644000176200001440000000172314645463055015032 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/httr2-package.R \docType{package} \name{httr2-package} \alias{httr2} \alias{httr2-package} \title{httr2: Perform HTTP Requests and Process the Responses} \description{ \if{html}{\figure{logo.png}{options: style='float: right' alt='logo' width='120'}} Tools for creating and modifying HTTP requests, then performing them and processing the results. 'httr2' is a modern re-imagining of 'httr' that uses a pipe-based interface and solves more of the problems that API wrapping packages face. } \seealso{ Useful links: \itemize{ \item \url{https://httr2.r-lib.org} \item \url{https://github.com/r-lib/httr2} \item Report bugs at \url{https://github.com/r-lib/httr2/issues} } } \author{ \strong{Maintainer}: Hadley Wickham \email{hadley@posit.co} Other contributors: \itemize{ \item Posit Software, PBC [copyright holder, funder] \item Maximilian Girlich [contributor] } } \keyword{internal} httr2/man/req_proxy.Rd0000644000176200001440000000145414666312277014431 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/req-options.R \name{req_proxy} \alias{req_proxy} \title{Use a proxy for a request} \usage{ req_proxy( req, url, port = NULL, username = NULL, password = NULL, auth = "basic" ) } \arguments{ \item{req}{A httr2 \link{request} object.} \item{url, port}{Location of proxy.} \item{username, password}{Login details for proxy, if needed.} \item{auth}{Type of HTTP authentication to use. Should be one of the following: \code{basic}, \code{digest}, \code{digest_ie}, \code{gssnegotiate}, \code{ntlm}, \code{any}.} } \description{ Use a proxy for a request } \examples{ # Proxy from https://www.proxynova.com/proxy-server-list/ \dontrun{ request("http://hadley.nz") |> req_proxy("20.116.130.70", 3128) |> req_perform() } } httr2/man/multi_req_perform.Rd0000644000176200001440000000270614753653643016137 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/req-perform-parallel.R \name{multi_req_perform} \alias{multi_req_perform} \title{Perform a list of requests in parallel} \usage{ multi_req_perform( reqs, paths = NULL, pool = deprecated(), cancel_on_error = FALSE ) } \arguments{ \item{reqs}{A list of \link{request}s.} \item{paths}{An optional character vector of paths, if you want to download the response bodies to disk. If supplied, must be the same length as \code{reqs}.} \item{pool}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}}. No longer supported; to control the maximum number of concurrent requests, set \code{max_active}.} \item{cancel_on_error}{Should all pending requests be cancelled when you hit an error? Set this to \code{TRUE} to stop all requests as soon as you hit an error. Responses that were never performed be \code{NULL} in the result.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} Please use \code{\link[=req_perform_parallel]{req_perform_parallel()}} instead, and note: \itemize{ \item \code{cancel_on_error = FALSE} is now \code{on_error = "continue"} \item \code{cancel_on_error = TRUE} is now \code{on_error = "return"} } } \keyword{internal} httr2/man/oauth_cache_clear.Rd0000644000176200001440000000132314711265142015772 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/oauth.R \name{oauth_cache_clear} \alias{oauth_cache_clear} \title{Clear OAuth cache} \usage{ oauth_cache_clear(client, cache_disk = FALSE, cache_key = NULL) } \arguments{ \item{client}{An \code{\link[=oauth_client]{oauth_client()}}.} \item{cache_disk}{Should the access token be cached on disk? This reduces the number of times that you need to re-authenticate at the cost of storing access credentials on disk. Learn more in \url{https://httr2.r-lib.org/articles/oauth.html}.} \item{cache_key}{If you want to cache multiple tokens per app, use this key to disambiguate them.} } \description{ Use this function to clear cached credentials. } httr2/man/last_response.Rd0000644000176200001440000000124214556444037015253 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/req-perform.R \name{last_response} \alias{last_response} \alias{last_request} \title{Retrieve most recent request/response} \usage{ last_response() last_request() } \value{ An HTTP \link{response}/\link{request}. } \description{ These functions retrieve the most recent request made by httr2 and the response it received, to facilitate debugging problems \emph{after} they occur. If the request did not succeed (or no requests have been made) \code{last_response()} will be \code{NULL}. } \examples{ invisible(request("http://httr2.r-lib.org") |> req_perform()) last_request() last_response() } httr2/man/req_oauth_device.Rd0000644000176200001440000000443314666617063015710 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/oauth-flow-device.R \name{req_oauth_device} \alias{req_oauth_device} \alias{oauth_flow_device} \title{OAuth with device flow} \usage{ req_oauth_device( req, client, auth_url, scope = NULL, auth_params = list(), token_params = list(), cache_disk = FALSE, cache_key = NULL ) oauth_flow_device( client, auth_url, pkce = FALSE, scope = NULL, auth_params = list(), token_params = list() ) } \arguments{ \item{req}{A httr2 \link{request} object.} \item{client}{An \code{\link[=oauth_client]{oauth_client()}}.} \item{auth_url}{Authorization url; you'll need to discover this by reading the documentation.} \item{scope}{Scopes to be requested from the resource owner.} \item{auth_params}{A list containing additional parameters passed to \code{\link[=oauth_flow_auth_code_url]{oauth_flow_auth_code_url()}}.} \item{token_params}{List containing additional parameters passed to the \code{token_url}.} \item{cache_disk}{Should the access token be cached on disk? This reduces the number of times that you need to re-authenticate at the cost of storing access credentials on disk. Learn more in \url{https://httr2.r-lib.org/articles/oauth.html}.} \item{cache_key}{If you want to cache multiple tokens per app, use this key to disambiguate them.} \item{pkce}{Use "Proof Key for Code Exchange"? This adds an extra layer of security and should always be used if supported by the server.} } \value{ \code{req_oauth_device()} returns a modified HTTP \link{request} that will use OAuth; \code{oauth_flow_device()} returns an \link{oauth_token}. } \description{ Authenticate using the OAuth \strong{device flow}, as defined by \href{https://datatracker.ietf.org/doc/html/rfc8628}{RFC 8628}. It's designed for devices that don't have access to a web browser (if you've ever authenticated an app on your TV, this is probably the flow you've used), but it also works well from within R. Learn more about the overall OAuth authentication flow in \url{https://httr2.r-lib.org/articles/oauth.html}. } \examples{ req_auth_github <- function(req) { req_oauth_device( req, client = example_github_client(), auth_url = "https://github.com/login/device/code" ) } request("https://api.github.com/user") |> req_auth_github() } httr2/man/req_perform_iterative.Rd0000644000176200001440000001200614753125205016757 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/req-perform-iterative.R \name{req_perform_iterative} \alias{req_perform_iterative} \title{Perform requests iteratively, generating new requests from previous responses} \usage{ req_perform_iterative( req, next_req, path = NULL, max_reqs = 20, on_error = c("stop", "return"), progress = TRUE ) } \arguments{ \item{req}{The first \link{request} to perform.} \item{next_req}{A function that takes the previous response (\code{resp}) and request (\code{req}) and returns a \link{request} for the next page or \code{NULL} if the iteration should terminate. See below for more details.} \item{path}{Optionally, path to save the body of request. This should be a glue string that uses \code{{i}} to distinguish different requests. Useful for large responses because it avoids storing the response in memory.} \item{max_reqs}{The maximum number of requests to perform. Use \code{Inf} to perform all requests until \code{next_req()} returns \code{NULL}.} \item{on_error}{What should happen if a request fails? \itemize{ \item \code{"stop"}, the default: stop iterating with an error. \item \code{"return"}: stop iterating, returning all the successful responses so far, as well as an error object for the failed request. }} \item{progress}{Display a progress bar for the status of all requests? Use \code{TRUE} to turn on a basic progress bar, use a string to give it a name, or see \link{progress_bars} to customize it in other ways. Not compatible with \code{\link[=req_progress]{req_progress()}}, as httr2 can only display a single progress bar at a time.} } \value{ A list, at most length \code{max_reqs}, containing \link{response}s and possibly one error object, if \code{on_error} is \code{"return"} and one of the requests errors. If present, the error object will always be the last element in the list. Only httr2 errors are captured; see \code{\link[=req_error]{req_error()}} for more details. } \description{ \code{req_perform_iterative()} iteratively generates and performs requests, using a callback function, \code{next_req}, to define the next request based on the current request and response. You will probably want to pair it with an \link[=iterate_with_offset]{iteration helper} and use a \link[=resps_successes]{multi-response handler} to process the result. } \section{\code{next_req()}}{ The key piece that makes \code{req_perform_iterative()} work is the \code{next_req()} argument. For most common cases, you can use one of the canned helpers, like \code{\link[=iterate_with_offset]{iterate_with_offset()}}. If, however, the API you're wrapping uses a different pagination system, you'll need to write your own. This section gives some advice. Generally, your function needs to inspect the response, extract some data from it, then use that to modify the previous request. For example, imagine that the response returns a cursor, which needs to be added to the body of the request. The simplest version of this function might look like this: \if{html}{\out{
}}\preformatted{next_req <- function(resp, req) \{ cursor <- resp_body_json(resp)$next_cursor req |> req_body_json_modify(cursor = cursor) \} }\if{html}{\out{
}} There's one problem here: if there are no more pages to return, then \code{cursor} will be \code{NULL}, but \code{req_body_json_modify()} will still generate a meaningful request. So we need to handle this specifically by returning \code{NULL}: \if{html}{\out{
}}\preformatted{next_req <- function(resp, req) \{ cursor <- resp_body_json(resp)$next_cursor if (is.null(cursor)) return(NULL) req |> req_body_json_modify(cursor = cursor) \} }\if{html}{\out{
}} A value of \code{NULL} lets \code{req_perform_iterative()} know there are no more pages remaining. There's one last feature you might want to add to your iterator: if you know the total number of pages, then it's nice to let \code{req_perform_iterative()} know so it can adjust the progress bar. (This will only ever decrease the number of pages, not increase it.) You can signal the total number of pages by calling \code{\link[=signal_total_pages]{signal_total_pages()}}, like this: \if{html}{\out{
}}\preformatted{next_req <- function(resp, req) \{ body <- resp_body_json(resp) cursor <- body$next_cursor if (is.null(cursor)) return(NULL) signal_total_pages(body$pages) req |> req_body_json_modify(cursor = cursor) \} }\if{html}{\out{
}} } \examples{ req <- request(example_url()) |> req_url_path("/iris") |> req_throttle(10) |> req_url_query(limit = 5) resps <- req_perform_iterative(req, iterate_with_offset("page_index")) data <- resps |> resps_data(function(resp) { data <- resp_body_json(resp)$data data.frame( Sepal.Length = sapply(data, `[[`, "Sepal.Length"), Sepal.Width = sapply(data, `[[`, "Sepal.Width"), Petal.Length = sapply(data, `[[`, "Petal.Length"), Petal.Width = sapply(data, `[[`, "Petal.Width"), Species = sapply(data, `[[`, "Species") ) }) str(data) } httr2/man/progress_bars.Rd0000644000176200001440000000457714731335456015262 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/progress-bars.R \name{progress_bars} \alias{progress_bars} \title{Progress bars in httr2} \description{ Some of httr2's perform functions have a \code{progress} argument that you can use to create a progress bar. \code{progress} can be: \itemize{ \item \code{FALSE}, the default: does not create a progress bar. \item \code{TRUE}: creates a basic unnamed progress bar. \item A string: creates a basic progress bar with the given name. \item A named list of progress bar parameters, as described below. } It's good practice to name your progress bars, to make it clear what calculation or process they belong to. We recommend keeping the names under 20 characters, so the whole progress bar fits comfortably even on on narrower displays. \subsection{Progress bar parameters}{ \itemize{ \item \code{clear}: whether to remove the progress bar from the screen after termination. Defaults to \code{TRUE}. \item \code{format}: format string. This overrides the default format string of the progress bar type. It must be given for the \code{custom} type. Format strings may contain R expressions to evaluate in braces. They support cli \link[cli:pluralization]{pluralization}, and \link[cli:inline-markup]{styling} and they can contain special \link[cli:progress-variables]{progress variables}. \item \code{format_done}: format string for successful termination. By default the same as \code{format}. \item \code{format_failed}: format string for unsuccessful termination. By default the same as \code{format}. \item \code{name}: progress bar name. This is by default the empty string and it is displayed at the beginning of the progress bar. \item \code{type}: progress bar type. Currently supported types are: \itemize{ \item \code{iterator}: the default, a for loop or a mapping function, \item \code{tasks}: a (typically small) number of tasks, \item \code{download}: download of one file, \item \code{custom}: custom type, \code{format} must not be \code{NULL} for this type. The default display is different for each progress bar type. } } } \subsection{Further documentation}{ purrr's progress bars are powered by cli, so see \href{https://cli.r-lib.org/articles/progress.html}{Introduction to progress bars in cli} and \href{https://cli.r-lib.org/articles/progress-advanced.html}{Advanced cli progress bars} for more details. } } \keyword{internal} httr2/man/resp_content_type.Rd0000644000176200001440000000267314666312277016151 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/resp-headers.R \name{resp_content_type} \alias{resp_content_type} \alias{resp_encoding} \title{Extract response content type and encoding} \usage{ resp_content_type(resp) resp_encoding(resp) } \arguments{ \item{resp}{A httr2 \link{response} object, created by \code{\link[=req_perform]{req_perform()}}.} } \value{ A string. If no content type is specified \code{resp_content_type()} will return a character \code{NA}; if no encoding is specified, \code{resp_encoding()} will return \code{"UTF-8"}. } \description{ \code{resp_content_type()} returns the just the type and subtype of the from the \code{Content-Type} header. If \code{Content-Type} is not provided; it returns \code{NA}. Used by \code{\link[=resp_body_json]{resp_body_json()}}, \code{\link[=resp_body_html]{resp_body_html()}}, and \code{\link[=resp_body_xml]{resp_body_xml()}}. \code{resp_encoding()} returns the likely character encoding of text types, as parsed from the \code{charset} parameter of the \code{Content-Type} header. If that header is not found, not valid, or no charset parameter is found, returns \code{UTF-8}. Used by \code{\link[=resp_body_string]{resp_body_string()}}. } \examples{ resp <- response(headers = "Content-type: text/html; charset=utf-8") resp |> resp_content_type() resp |> resp_encoding() # No Content-Type header resp <- response() resp |> resp_content_type() resp |> resp_encoding() } httr2/man/throttle_status.Rd0000644000176200001440000000071714752760573015654 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/req-throttle.R \name{throttle_status} \alias{throttle_status} \title{Display internal throttle status} \usage{ throttle_status() } \value{ A data frame with three columns: \itemize{ \item The \code{realm}. \item Number of \code{tokens} remaining in the bucket. \item Time \code{to_wait} in seconds for next token. } } \description{ Sometimes useful for debugging. } \keyword{internal} httr2/man/signal_total_pages.Rd0000644000176200001440000000065114556444037016234 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/iterate-helpers.R \name{signal_total_pages} \alias{signal_total_pages} \title{Signal total number pages} \usage{ signal_total_pages(n) } \arguments{ \item{n}{Total number of pages.} } \description{ To be called within a \code{next_req} callback function used with \code{\link[=req_perform_iterative]{req_perform_iterative()}} } \keyword{internal} httr2/man/oauth_flow_auth_code_url.Rd0000644000176200001440000000330514556444037017440 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/oauth-flow-auth-code.R \name{oauth_flow_auth_code_url} \alias{oauth_flow_auth_code_url} \alias{oauth_flow_auth_code_listen} \alias{oauth_flow_auth_code_parse} \alias{oauth_flow_auth_code_pkce} \title{OAuth authorization code components} \usage{ oauth_flow_auth_code_url( client, auth_url, redirect_uri = NULL, scope = NULL, state = NULL, auth_params = list() ) oauth_flow_auth_code_listen(redirect_uri = "http://localhost:1410") oauth_flow_auth_code_parse(query, state) oauth_flow_auth_code_pkce() } \arguments{ \item{state}{Random state generated by \code{oauth_flow_auth_code()}. Used to 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.)} \item{query}{List of query parameters returned by \code{oauth_flow_auth_code_listen()}.} } \description{ These low-level functions can be used to assemble a custom flow for APIs that are further from the spec: \itemize{ \item \code{oauth_flow_auth_code_url()} generates the url that should be opened in a browser. \item \code{oauth_flow_auth_code_listen()} starts a temporary local webserver that listens for the response from the resource server. \item \code{oauth_flow_auth_code_parse()} parses the query parameters returned from the server redirect, verifying that the \code{state} is correct, and returning the authorisation code. \item \code{oauth_flow_auth_code_pkce()} generates code verifier, method, and challenge components as needed for PKCE, as defined in \href{https://datatracker.ietf.org/doc/html/rfc7636}{RFC 7636}. } } \keyword{internal} httr2/man/req_oauth_auth_code.Rd0000644000176200001440000001430214731336632016371 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/oauth-flow-auth-code.R \name{req_oauth_auth_code} \alias{req_oauth_auth_code} \alias{oauth_flow_auth_code} \title{OAuth with authorization code} \usage{ req_oauth_auth_code( 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() ) oauth_flow_auth_code( 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() ) } \arguments{ \item{req}{A httr2 \link{request} object.} \item{client}{An \code{\link[=oauth_client]{oauth_client()}}.} \item{auth_url}{Authorization url; you'll need to discover this by reading the documentation.} \item{scope}{Scopes to be requested from the resource owner.} \item{pkce}{Use "Proof Key for Code Exchange"? This adds an extra layer of security and should always be used if supported by the server.} \item{auth_params}{A list containing additional parameters passed to \code{\link[=oauth_flow_auth_code_url]{oauth_flow_auth_code_url()}}.} \item{token_params}{List containing additional parameters passed to the \code{token_url}.} \item{redirect_uri}{URL to redirect back to after authorization is complete. Often this must be registered with the API in advance. httr2 supports three forms of redirect. Firstly, you can use a \code{localhost} url (the default), where httr2 will set up a temporary webserver to listen for the OAuth redirect. In this case, httr2 will automatically append a random port. If you need to set it to a fixed port because the API requires it, then specify it with (e.g.) \code{"http://localhost:1011"}. This technique works well when you are working on your own computer. Secondly, you can provide a URL to a website that uses Javascript to give the user a code to copy and paste back into the R session (see \url{https://www.tidyverse.org/google-callback/} and \url{https://github.com/r-lib/gargle/blob/main/inst/pseudo-oob/google-callback/index.html} for examples). This is less convenient (because it requires more user interaction) but also works in hosted environments like RStudio Server. Finally, hosted platforms might set the \code{HTTR2_OAUTH_REDIRECT_URL} and \code{HTTR2_OAUTH_CODE_SOURCE_URL} environment variables. In this case, httr2 will use \code{HTTR2_OAUTH_REDIRECT_URL} for redirects by default, and poll the \code{HTTR2_OAUTH_CODE_SOURCE_URL} endpoint with the state parameter until it receives a code in the response (or encounters an error). This delegates completion of the authorization flow to the hosted platform.} \item{cache_disk}{Should the access token be cached on disk? This reduces the number of times that you need to re-authenticate at the cost of storing access credentials on disk. Learn more in \url{https://httr2.r-lib.org/articles/oauth.html}.} \item{cache_key}{If you want to cache multiple tokens per app, use this key to disambiguate them.} \item{host_name, host_ip, port}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} Now use \code{redirect_uri} instead.} } \value{ \code{req_oauth_auth_code()} returns a modified HTTP \link{request} that will use OAuth; \code{oauth_flow_auth_code()} returns an \link{oauth_token}. } \description{ Authenticate using the OAuth \strong{authorization code flow}, as defined by \href{https://datatracker.ietf.org/doc/html/rfc6749#section-4.1}{Section 4.1 of RFC 6749}. This flow is the most commonly used OAuth flow where the user opens a page in their browser, approves the access, and then returns to R. When possible, it redirects the browser back to a temporary local webserver to capture the authorization code. When this is not possible (e.g., when running on a hosted platform like RStudio Server), provide a custom \code{redirect_uri} and httr2 will prompt the user to enter the code manually. Learn more about the overall OAuth authentication flow in \url{https://httr2.r-lib.org/articles/oauth.html}, and more about the motivations behind this flow in \url{https://stack-auth.com/blog/oauth-from-first-principles}. } \section{Security considerations}{ The authorization code flow is used for both web applications and native applications (which are equivalent to R packages). \href{https://datatracker.ietf.org/doc/html/rfc8252}{RFC 8252} spells out important considerations for native apps. Most importantly there's no way for native apps to keep secrets from their users. This means that the server should either not require a \code{client_secret} (i.e. it should be a public client and not a confidential client) or ensure that possession of the \code{client_secret} doesn't grant any significant privileges. Only modern APIs from major providers (like Azure and Google) explicitly support native apps. However, in most cases, even for older APIs, possessing the \code{client_secret} provides limited ability to perform harmful actions. Therefore, our general principle is that it's acceptable to include it in an R package, as long as it's mildly obfuscated to protect against credential scraping attacks (which aim to acquire large numbers of client secrets by scanning public sites like GitHub). The goal is to ensure that obtaining your client credentials is more work than just creating a new client. } \examples{ req_auth_github <- function(req) { req_oauth_auth_code( req, client = example_github_client(), auth_url = "https://github.com/login/oauth/authorize" ) } request("https://api.github.com/user") |> req_auth_github() } \seealso{ \code{\link[=oauth_flow_auth_code_url]{oauth_flow_auth_code_url()}} for the components necessary to write your own auth code flow, if the API you are wrapping does not adhere closely to the standard. Other OAuth flows: \code{\link{req_oauth_bearer_jwt}()}, \code{\link{req_oauth_client_credentials}()}, \code{\link{req_oauth_password}()}, \code{\link{req_oauth_refresh}()}, \code{\link{req_oauth_token_exchange}()} } \concept{OAuth flows} httr2/man/req_oauth_token_exchange.Rd0000644000176200001440000001007414715443111017413 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/oauth-flow-token-exchange.R \name{req_oauth_token_exchange} \alias{req_oauth_token_exchange} \alias{oauth_flow_token_exchange} \title{OAuth token exchange} \usage{ req_oauth_token_exchange( 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() ) oauth_flow_token_exchange( 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() ) } \arguments{ \item{req}{A httr2 \link{request} object.} \item{client}{An \code{\link[=oauth_client]{oauth_client()}}.} \item{subject_token}{The security token to exchange. This is usually an OpenID Connect ID token or a SAML2 assertion.} \item{subject_token_type}{A URI that describes the type of the security token. Usually one of the options in \href{https://datatracker.ietf.org/doc/html/rfc8693#section-3}{Section 3 of RFC 8693}.} \item{resource}{The URI that identifies the resource that the client is trying to access, if applicable.} \item{audience}{The logical name that identifies the resource that the client is trying to access, if applicable. Usually one of \code{resource} or \code{audience} must be supplied.} \item{scope}{Scopes to be requested from the resource owner.} \item{requested_token_type}{An optional URI that describes the type of the security token being requested. Usually one of the options in \href{https://datatracker.ietf.org/doc/html/rfc8693#section-3}{Section 3 of RFC 8693}.} \item{actor_token}{An optional security token that represents the client, rather than the identity behind the subject token.} \item{actor_token_type}{When \code{actor_token} is not \code{NULL}, this must be the URI that describes the type of the security token being requested. Usually one of the options in \href{https://datatracker.ietf.org/doc/html/rfc8693#section-3}{Section 3 of RFC 8693}.} \item{token_params}{List containing additional parameters passed to the \code{token_url}.} } \value{ \code{req_oauth_token_exchange()} returns a modified HTTP \link{request} that will exchange one security token for another; \code{oauth_flow_token_exchange()} returns the resulting \link{oauth_token} directly. } \description{ Authenticate by exchanging one security token for another, as defined by \href{https://datatracker.ietf.org/doc/html/rfc8693#section-2}{Section 2 of RFC 8693}. It is typically used for advanced authorization flows that involve "delegation" or "impersonation" semantics, such as when a client accesses a resource on behalf of another party, or when a client's identity is federated from another provider. Learn more about the overall OAuth authentication flow in \url{https://httr2.r-lib.org/articles/oauth.html}. } \examples{ # List Google Cloud storage buckets using an OIDC token obtained # from e.g. Microsoft Entra ID or Okta and federated to Google. (A real # project ID and workforce pool would be required for this in practice.) # # See: https://cloud.google.com/iam/docs/workforce-obtaining-short-lived-credentials oidc_token <- "an ID token from Okta" request("https://storage.googleapis.com/storage/v1/b?project=123456") |> req_oauth_token_exchange( client = oauth_client("gcp", "https://sts.googleapis.com/v1/token"), subject_token = oidc_token, subject_token_type = "urn:ietf:params:oauth:token-type:id_token", scope = "https://www.googleapis.com/auth/cloud-platform", requested_token_type = "urn:ietf:params:oauth:token-type:access_token", audience = "//iam.googleapis.com/locations/global/workforcePools/123/providers/456", token_params = list( options = '{"userProject":"123456"}' ) ) } \seealso{ Other OAuth flows: \code{\link{req_oauth_auth_code}()}, \code{\link{req_oauth_bearer_jwt}()}, \code{\link{req_oauth_client_credentials}()}, \code{\link{req_oauth_password}()}, \code{\link{req_oauth_refresh}()} } \concept{OAuth flows} httr2/man/curl_translate.Rd0000644000176200001440000000313614602572300015403 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/curl.R \name{curl_translate} \alias{curl_translate} \alias{curl_help} \title{Translate curl syntax to httr2} \usage{ curl_translate(cmd, simplify_headers = TRUE) curl_help() } \arguments{ \item{cmd}{Call to curl. If omitted and the clipr package is installed, will be retrieved from the clipboard.} \item{simplify_headers}{Remove typically unimportant headers included when copying a curl command from the browser. This includes: \itemize{ \item \verb{sec-fetch-*} \item \verb{sec-ch-ua*} \item \code{referer}, \code{pragma}, \code{connection} }} } \value{ A string containing the translated httr2 code. If the input was copied from the clipboard, the translation will be copied back to the clipboard. } \description{ The curl command line tool is commonly used to demonstrate HTTP APIs and can easily be generated from \href{https://everything.curl.dev/cmdline/copyas.html}{browser developer tools}. \code{curl_translate()} saves you the pain of manually translating these calls by implementing a partial, but frequently used, subset of curl options. Use \code{curl_help()} to see the supported options, and \code{curl_translate()} to translate a curl invocation copy and pasted from elsewhere. Inspired by \href{https://github.com/hrbrmstr/curlconverter}{curlconverter} written by \href{https://rud.is/b/}{Bob Rudis}. } \examples{ curl_translate("curl http://example.com") curl_translate("curl http://example.com -X DELETE") curl_translate("curl http://example.com --header A:1 --header B:2") curl_translate("curl http://example.com --verbose") } httr2/man/url_parse.Rd0000644000176200001440000000237114737023431014362 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/url.R \name{url_parse} \alias{url_parse} \title{Parse a URL into its component pieces} \usage{ url_parse(url, base_url = NULL) } \arguments{ \item{url}{A string containing the URL to parse.} \item{base_url}{Use this as a parent, if \code{url} is a relative URL.} } \value{ An S3 object of class \code{httr2_url} with the following components: \code{scheme}, \code{hostname}, \code{username}, \code{password}, \code{port}, \code{path}, \code{query}, and \code{fragment}. } \description{ \code{url_parse()} parses a URL into its component parts, powered by \code{\link[curl:curl_parse_url]{curl::curl_parse_url()}}. The parsing algorithm follows the specifications detailed in \href{https://datatracker.ietf.org/doc/html/rfc3986}{RFC 3986}. } \examples{ url_parse("http://google.com/") url_parse("http://google.com:80/") url_parse("http://google.com:80/?a=1&b=2") url_parse("http://username@google.com:80/path;test?a=1&b=2#40") # You can parse a relative URL if you also provide a base url url_parse("foo", "http://google.com/bar/") url_parse("..", "http://google.com/bar/") } \seealso{ Other URL manipulation: \code{\link{url_build}()}, \code{\link{url_modify}()} } \concept{URL manipulation} httr2/man/example_url.Rd0000644000176200001440000000124514752214235014703 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/test.R \name{example_url} \alias{example_url} \alias{example_github_client} \title{Code for examples} \usage{ example_url(path = "/") example_github_client() } \description{ \code{example_url()} runs a simple websever using the webfakes package with the following endpoints: \itemize{ \item all the ones from the \code{\link[webfakes:httpbin_app]{webfakes::httpbin_app()}} \item \verb{/iris}: paginate through the iris dataset. It has the query parameters \code{page} and \code{limit} to control the pagination. } \code{example_github_client()} is an OAuth client for GitHub. } \keyword{internal} httr2/man/req_oauth_password.Rd0000644000176200001440000000462014731333511016273 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/oauth-flow-password.R \name{req_oauth_password} \alias{req_oauth_password} \alias{oauth_flow_password} \title{OAuth with username and password} \usage{ req_oauth_password( req, client, username, password = NULL, scope = NULL, token_params = list(), cache_disk = FALSE, cache_key = username ) oauth_flow_password( client, username, password = NULL, scope = NULL, token_params = list() ) } \arguments{ \item{req}{A httr2 \link{request} object.} \item{client}{An \code{\link[=oauth_client]{oauth_client()}}.} \item{username}{User name.} \item{password}{Password. You should avoid entering the password directly when calling this function as it will be captured by \code{.Rhistory}. Instead, leave it unset and the default behaviour will prompt you for it interactively.} \item{scope}{Scopes to be requested from the resource owner.} \item{token_params}{List containing additional parameters passed to the \code{token_url}.} \item{cache_disk}{Should the access token be cached on disk? This reduces the number of times that you need to re-authenticate at the cost of storing access credentials on disk. Learn more in \url{https://httr2.r-lib.org/articles/oauth.html}.} \item{cache_key}{If you want to cache multiple tokens per app, use this key to disambiguate them.} } \value{ \code{req_oauth_password()} returns a modified HTTP \link{request} that will use OAuth; \code{oauth_flow_password()} returns an \link{oauth_token}. } \description{ This function implements the OAuth \strong{resource owner password flow}, as defined by \href{https://datatracker.ietf.org/doc/html/rfc6749#section-4.3}{Section 4.3 of RFC 6749}. It allows the user to supply their password once, exchanging it for an access token that can be cached locally. Learn more about the overall OAuth authentication flow in \url{https://httr2.r-lib.org/articles/oauth.html} } \examples{ req_auth <- function(req) { req_oauth_password(req, client = oauth_client("example", "https://example.com/get_token"), username = "username" ) } if (interactive()) { request("https://example.com") |> req_auth() } } \seealso{ Other OAuth flows: \code{\link{req_oauth_auth_code}()}, \code{\link{req_oauth_bearer_jwt}()}, \code{\link{req_oauth_client_credentials}()}, \code{\link{req_oauth_refresh}()}, \code{\link{req_oauth_token_exchange}()} } \concept{OAuth flows} httr2/man/req_oauth_refresh.Rd0000644000176200001440000000467714715443111016103 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/oauth-flow-refresh.R \name{req_oauth_refresh} \alias{req_oauth_refresh} \alias{oauth_flow_refresh} \title{OAuth with a refresh token} \usage{ req_oauth_refresh( req, client, refresh_token = Sys.getenv("HTTR2_REFRESH_TOKEN"), scope = NULL, token_params = list() ) oauth_flow_refresh( client, refresh_token = Sys.getenv("HTTR2_REFRESH_TOKEN"), scope = NULL, token_params = list() ) } \arguments{ \item{req}{A httr2 \link{request} object.} \item{client}{An \code{\link[=oauth_client]{oauth_client()}}.} \item{refresh_token}{A refresh token. This is equivalent to a password so shouldn't be typed into the console or stored in a script. Instead, we recommend placing in an environment variable; the default behaviour is to look in \code{HTTR2_REFRESH_TOKEN}.} \item{scope}{Scopes to be requested from the resource owner.} \item{token_params}{List containing additional parameters passed to the \code{token_url}.} } \value{ \code{req_oauth_refresh()} returns a modified HTTP \link{request} that will use OAuth; \code{oauth_flow_refresh()} returns an \link{oauth_token}. } \description{ Authenticate using a \strong{refresh token}, following the process described in \href{https://datatracker.ietf.org/doc/html/rfc6749#section-6}{Section 6 of RFC 6749}. This technique is primarily useful for testing: you can manually retrieve a OAuth token using another OAuth flow (e.g. with \code{\link[=oauth_flow_auth_code]{oauth_flow_auth_code()}}), extract the refresh token from the result, and then save in an environment variable for use in automated tests. When requesting an access token, the server may also return a new refresh token. If this happens, \code{oauth_flow_refresh()} will warn, and you'll have retrieve a new update refresh token and update the stored value. If you find this happening a lot, it's a sign that you should be using a different flow in your automated tests. Learn more about the overall OAuth authentication flow in \url{https://httr2.r-lib.org/articles/oauth.html}. } \examples{ client <- oauth_client("example", "https://example.com/get_token") req <- request("https://example.com") req |> req_oauth_refresh(client) } \seealso{ Other OAuth flows: \code{\link{req_oauth_auth_code}()}, \code{\link{req_oauth_bearer_jwt}()}, \code{\link{req_oauth_client_credentials}()}, \code{\link{req_oauth_password}()}, \code{\link{req_oauth_token_exchange}()} } \concept{OAuth flows} httr2/man/req_verbose.Rd0000644000176200001440000000356314752214235014707 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/req-verbose.R \name{req_verbose} \alias{req_verbose} \title{Show extra output when request is performed} \usage{ req_verbose( req, header_req = TRUE, header_resp = TRUE, body_req = FALSE, body_resp = FALSE, info = FALSE, redact_headers = TRUE ) } \arguments{ \item{req}{A httr2 \link{request} object.} \item{header_req, header_resp}{Show request/response headers?} \item{body_req, body_resp}{Should request/response bodies? When the response body is compressed, this will show the number of bytes received in each "chunk".} \item{info}{Show informational text from curl? This is mainly useful for debugging https and auth problems, so is disabled by default.} \item{redact_headers}{Redact confidential data in the headers? Currently redacts the contents of the Authorization header to prevent you from accidentally leaking credentials when debugging/reprexing.} } \value{ A modified HTTP \link{request}. } \description{ \code{req_verbose()} uses the following prefixes to distinguish between different components of the HTTP requests and responses: \itemize{ \item \verb{* } informative curl messages \item \verb{->} request headers \item \verb{>>} request body \item \verb{<-} response headers \item \verb{<<} response body } } \examples{ # Use `req_verbose()` to see the headers that are sent back and forth when # making a request resp <- request("https://httr2.r-lib.org") |> req_verbose() |> req_perform() # Or use one of the convenient shortcuts: resp <- request("https://httr2.r-lib.org") |> req_perform(verbosity = 1) } \seealso{ \code{\link[=req_perform]{req_perform()}} which exposes a limited subset of these options through the \code{verbosity} argument and \code{\link[=with_verbosity]{with_verbosity()}} which allows you to control the verbosity of requests deeper within the call stack. } httr2/man/req_cookie_preserve.Rd0000644000176200001440000000365614666550774016450 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/req-cookies.R \name{req_cookie_preserve} \alias{req_cookie_preserve} \alias{req_cookies_set} \title{Set and preserve cookies} \usage{ req_cookie_preserve(req, path) req_cookies_set(req, ...) } \arguments{ \item{req}{A httr2 \link{request} object.} \item{path}{A path to a file where cookies will be read from before and updated after the request.} \item{...}{<\code{\link[rlang:dyn-dots]{dynamic-dots}}> Name-value pairs that define query parameters. Each value must be an atomic vector, which is automatically escaped. To opt-out of escaping, wrap strings in \code{I()}.} } \description{ Use \code{req_cookie_set()} to set client side cookies that are sent to the server. By default, httr2 uses a clean slate for every request meaning that cookies are not automatically preserved across requests. To preserve cookies, use \code{req_cookie_preserve()} along with the path to cookie file that will be read before and updated after each request. } \examples{ # Use `req_cookies_set()` to set client-side cookies request(example_url()) |> req_cookies_set(a = 1, b = 1) |> req_dry_run() # Use `req_cookie_preserve()` to preserve server-side cookies across requests path <- tempfile() # Set a server-side cookie request(example_url()) |> req_cookie_preserve(path) |> req_template("/cookies/set/:name/:value", name = "chocolate", value = "chip") |> req_perform() |> resp_body_json() # Set another sever-side cookie request(example_url()) |> req_cookie_preserve(path) |> req_template("/cookies/set/:name/:value", name = "oatmeal", value = "raisin") |> req_perform() |> resp_body_json() # Add a client side cookie request(example_url()) |> req_url_path("/cookies/set") |> req_cookie_preserve(path) |> req_cookies_set(snicker = "doodle") |> req_perform() |> resp_body_json() # The cookie path has a straightforward format cat(readChar(path, nchars = 1e4)) } httr2/man/req_throttle.Rd0000644000176200001440000000430514753653640015112 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/req-throttle.R \name{req_throttle} \alias{req_throttle} \title{Rate limit a request by automatically adding a delay} \usage{ req_throttle(req, rate, capacity, fill_time_s = 60, realm = NULL) } \arguments{ \item{req}{A httr2 \link{request} object.} \item{rate}{For backwards compatibility, you can still specify the \code{rate}, which is converted to \code{capacity} by multiplying by \code{fill_time_s}. However, we recommend using \code{capacity} and \code{fill_time_s} as it gives more control.} \item{capacity}{The size of the bucket, i.e. the maximum number of tokens that can accumulate.} \item{fill_time_s}{Time in seconds to fill the capacity. Defaults to 60s.} \item{realm}{A string that uniquely identifies the throttle pool to use (throttling limits always apply \emph{per pool}). If not supplied, defaults to the hostname of the request.} } \value{ A modified HTTP \link{request}. } \description{ Use \code{req_throttle()} to ensure that repeated calls to \code{\link[=req_perform]{req_perform()}} never exceed a specified rate. Throttling is implemented using a "token bucket", which steadily fills up to a maximum of \code{capacity} tokens over \code{fill_time_s}. Each time you make a request, it takes a token out of the bucket, and if the bucket is empty, the request will wait until the bucket refills. This ensures that you never make more than \code{capacity} requests in \code{fill_time_s}, but you can make requests more quickly if the bucket is full. For example, if you have \code{capacity = 10} and \code{fill_time_s = 60}, you can make 10 requests without waiting, but the next request will wait 60 seconds. This gives the same average throttling rate as the previous approach, but gives you much better performance if you're only making a small number of requests. } \examples{ # Ensure we never send more than 30 requests a minute req <- request(example_url()) |> req_throttle(capacity = 30, fill_time_s = 60) resp <- req_perform(req) throttle_status() resp <- req_perform(req) throttle_status() \dontshow{httr2:::throttle_reset()} } \seealso{ \code{\link[=req_retry]{req_retry()}} for another way of handling rate-limited APIs. } httr2/man/with_mocked_responses.Rd0000644000176200001440000000275414556444037017001 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/req-mock.R \name{with_mocked_responses} \alias{with_mocked_responses} \alias{with_mock} \alias{local_mocked_responses} \alias{local_mock} \title{Temporarily mock requests} \usage{ with_mocked_responses(mock, code) local_mocked_responses(mock, env = caller_env()) } \arguments{ \item{mock}{A function, a list, or \code{NULL}. \itemize{ \item \code{NULL} disables mocking and returns httr2 to regular operation. \item A list of responses will be returned in sequence. After all responses have been used up, will return 503 server errors. \item For maximum flexibility, you can supply a function that that takes a single argument, \code{req}, and returns either \code{NULL} (if it doesn't want to handle the request) or a \link{response} (if it does). }} \item{code}{Code to execute in the temporary environment.} \item{env}{Environment to use for scoping changes.} } \value{ \code{with_mock()} returns the result of evaluating \code{code}. } \description{ Mocking allows you to selectively and temporarily replace the response you would typically receive from a request with your own code. It's primarily used for testing. } \examples{ # This function should perform a response against google.com: google <- function() { request("http://google.com") |> req_perform() } # But I can use a mock to instead return my own made up response: my_mock <- function(req) { response(status_code = 403) } try(with_mock(my_mock, google())) } httr2/man/oauth_redirect_uri.Rd0000644000176200001440000000065214556444037016256 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/oauth-flow-auth-code.R \name{oauth_redirect_uri} \alias{oauth_redirect_uri} \title{Default redirect url for OAuth} \usage{ oauth_redirect_uri() } \description{ The default redirect uri used by \code{\link[=req_oauth_auth_code]{req_oauth_auth_code()}}. Defaults to \verb{http://localhost} unless the \code{HTTR2_OAUTH_REDIRECT_URL} envvar is set. } httr2/man/url_modify.Rd0000644000176200001440000000675214740237660014553 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/url.R \name{url_modify} \alias{url_modify} \alias{url_modify_relative} \alias{url_modify_query} \title{Modify a URL} \usage{ url_modify( 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_relative(url, relative_url) url_modify_query( .url, ..., .multi = c("error", "comma", "pipe", "explode"), .space = c("percent", "form") ) } \arguments{ \item{url, .url}{A string or \link[=url_parse]{parsed URL}.} \item{scheme}{The scheme, typically either \code{http} or \code{https}.} \item{hostname}{The hostname, e.g., \code{www.google.com} or \code{posit.co}.} \item{username, password}{Username and password to embed in the URL. Not generally recommended but needed for some legacy applications.} \item{port}{An integer port number.} \item{path}{The path, e.g., \verb{/search}. Paths must start with \code{/}, so this will be automatically added if omitted.} \item{query}{Either a query string or a named list of query components.} \item{fragment}{The fragment, e.g., \verb{#section-1}.} \item{relative_url}{A relative URL to append to the base URL.} \item{...}{<\code{\link[rlang:dyn-dots]{dynamic-dots}}> Name-value pairs that define query parameters. Each value must be either an atomic vector or \code{NULL} (which removes the corresponding parameters). If you want to opt out of escaping, wrap strings in \code{I()}.} \item{.multi}{Controls what happens when a value is a vector: \itemize{ \item \code{"error"}, the default, throws an error. \item \code{"comma"}, separates values with a \verb{,}, e.g. \verb{?x=1,2}. \item \code{"pipe"}, separates values with a \code{|}, e.g. \code{?x=1|2}. \item \code{"explode"}, turns each element into its own parameter, e.g. \code{?x=1&x=2} } If none of these options work for your needs, you can instead supply a function that takes a character vector of argument values and returns a a single string.} \item{.space}{How should spaces in query params be escaped? The default, "percent", uses standard percent encoding (i.e. \verb{\%20}), but you can opt-in to "form" encoding, which uses \code{+} instead.} } \value{ An object of the same type as \code{url}. } \description{ Use \code{url_modify()} to modify any component of the URL, \code{url_modify_relative()} to modify with a relative URL, or \code{url_modify_query()} to modify individual query parameters. For \code{url_modify()}, components that aren't specified in the function call will be left as is; components set to \code{NULL} will be removed, and all other values will be updated. Note that removing \code{scheme} or \code{hostname} will create a relative URL. } \examples{ url_modify("http://hadley.nz", path = "about") url_modify("http://hadley.nz", scheme = "https") url_modify("http://hadley.nz/abc", path = "/cde") url_modify("http://hadley.nz/abc", path = "") url_modify("http://hadley.nz?a=1", query = "b=2") url_modify("http://hadley.nz?a=1", query = list(c = 3)) url_modify_query("http://hadley.nz?a=1&b=2", c = 3) url_modify_query("http://hadley.nz?a=1&b=2", b = NULL) url_modify_query("http://hadley.nz?a=1&b=2", a = 100) 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") } \seealso{ Other URL manipulation: \code{\link{url_build}()}, \code{\link{url_parse}()} } \concept{URL manipulation} httr2/man/secrets.Rd0000644000176200001440000001057514666312277014055 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/secret.R \name{secrets} \alias{secret_make_key} \alias{secret_encrypt} \alias{secret_decrypt} \alias{secret_write_rds} \alias{secret_read_rds} \alias{secret_decrypt_file} \alias{secret_encrypt_file} \alias{secret_has_key} \title{Secret management} \usage{ secret_make_key() secret_encrypt(x, key) secret_decrypt(encrypted, key) secret_write_rds(x, path, key) secret_read_rds(path, key) secret_decrypt_file(path, key, envir = parent.frame()) secret_encrypt_file(path, key) secret_has_key(key) } \arguments{ \item{x}{Object to encrypt. Must be a string for \code{secret_encrypt()}.} \item{key}{Encryption key; this is the password that allows you to "lock" and "unlock" the secret. The easiest way to specify this is as the name of an environment variable. Alternatively, if you already have a base64url encoded string, you can wrap it in \code{I()}, or you can pass the raw vector in directly.} \item{encrypted}{String to decrypt} \item{path}{Path to file to encrypted file to read or write. For \code{secret_write_rds()} and \code{secret_read_rds()} this should be an \code{.rds} file.} \item{envir}{The decrypted file will be automatically deleted when this environment exits. You should only need to set this argument if you want to pass the unencrypted file to another function.} } \value{ \itemize{ \item \code{secret_decrypt()} and \code{secret_encrypt()} return strings. \item \code{secret_decrypt_file()} returns a path to a temporary file; \code{secret_encrypt_file()} encrypts the file in place. \item \code{secret_write_rds()} returns \code{x} invisibly; \code{secret_read_rds()} returns the saved object. \item \code{secret_make_key()} returns a string with class \code{AsIs}. \item \code{secret_has_key()} returns \code{TRUE} or \code{FALSE}. } } \description{ httr2 provides a handful of functions designed for working with confidential data. These are useful because testing packages that use httr2 often requires some confidential data that needs to be available for testing, but should not be available to package users. \itemize{ \item \code{secret_encrypt()} and \code{secret_decrypt()} work with individual strings \item \code{secret_encrypt_file()} encrypts a file in place and \code{secret_decrypt_file()} decrypts a file in a temporary location. \item \code{secret_write_rds()} and \code{secret_read_rds()} work with \code{.rds} files \item \code{secret_make_key()} generates a random string to use as a key. \item \code{secret_has_key()} returns \code{TRUE} if the key is available; you can use it in examples and vignettes that you want to evaluate on your CI, but not for CRAN/package users. } These all look for the key in an environment variable. When used inside of testthat, they will automatically \code{\link[testthat:skip]{testthat::skip()}} the test if the env var isn't found. (Outside of testthat, they'll error if the env var isn't found.) } \section{Basic workflow}{ \enumerate{ \item Use \code{secret_make_key()} to generate a password. Make this available as an env var (e.g. \verb{\{MYPACKAGE\}_KEY}) by adding a line to your \code{.Renviron}. \item Encrypt strings with \code{secret_encrypt()}, files with \code{secret_encrypt_file()}, and other data with \code{secret_write_rds()}, setting \code{key = "{MYPACKAGE}_KEY"}. \item In your tests, decrypt the data with \code{secret_decrypt()}, \code{secret_decrypt_file()}, or \code{secret_read_rds()} to match how you encrypt it. \item If you push this code to your CI server, it will already "work" because all functions automatically skip tests when your \verb{\{MYPACKAGE\}_KEY} env var isn't set. To make the tests actually run, you'll need to set the env var using whatever tool your CI system provides for setting env vars. Make sure to carefully inspect the test output to check that the skips have actually gone away. } } \examples{ key <- secret_make_key() path <- tempfile() secret_write_rds(mtcars, path, key = key) secret_read_rds(path, key) # While you can manage the key explicitly in a variable, it's much # easier to store in an environment variable. In real life, you should # NEVER use `Sys.setenv()` to create this env var because you will # also store the secret in your `.Rhistory`. Instead add it to your # .Renviron using `usethis::edit_r_environ()` or similar. Sys.setenv("MY_KEY" = key) x <- secret_encrypt("This is a secret", "MY_KEY") x secret_decrypt(x, "MY_KEY") } httr2/man/req_perform_promise.Rd0000644000176200001440000000766414753653643016473 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/req-promise.R \name{req_perform_promise} \alias{req_perform_promise} \title{Perform request asynchronously using the promises package} \usage{ req_perform_promise(req, path = NULL, pool = NULL, verbosity = NULL) } \arguments{ \item{req}{A httr2 \link{request} object.} \item{path}{Optionally, path to save body of the response. This is useful for large responses since it avoids storing the response in memory.} \item{pool}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}}. No longer supported; to control the maximum number of concurrent requests, set \code{max_active}.} \item{verbosity}{How much information to print? This is a wrapper around \code{\link[=req_verbose]{req_verbose()}} that uses an integer to control verbosity: \itemize{ \item \code{0}: no output \item \code{1}: show headers \item \code{2}: show headers and bodies \item \code{3}: show headers, bodies, and curl status messages. } Use \code{\link[=with_verbosity]{with_verbosity()}} to control the verbosity of requests that you can't affect directly.} } \value{ a \code{\link[promises:promise]{promises::promise()}} object which resolves to a \link{response} if successful or rejects on the same errors thrown by \code{\link[=req_perform]{req_perform()}}. } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} This variation on \code{\link[=req_perform]{req_perform()}} returns a \code{\link[promises:promise]{promises::promise()}} object immediately and then performs the request in the background, returning program control before the request is finished. See the \href{https://rstudio.github.io/promises/articles/promises_01_motivation.html}{promises package documentation} for more details on how to work with the resulting promise object. If using together with \code{\link[later:create_loop]{later::with_temp_loop()}} or other private event loops, a new curl pool made by \code{\link[curl:multi]{curl::new_pool()}} should be created for requests made within the loop to ensure that only these requests are being polled by the loop. Like with \code{\link[=req_perform_parallel]{req_perform_parallel()}}, exercise caution when using this function; it's easy to pummel a server with many simultaneous requests. Also, not all servers can handle more than 1 request at a time, so the responses may still return sequentially. \code{req_perform_promise()} also has similar limitations to the \code{\link[=req_perform_parallel]{req_perform_parallel()}} function, it: \itemize{ \item Will not retrieve a new OAuth token if it expires after the promised request is created but before it is actually requested. \item Does not perform throttling with \code{\link[=req_throttle]{req_throttle()}}. \item Does not attempt retries as described by \code{\link[=req_retry]{req_retry()}}. \item Only consults the cache set by \code{\link[=req_cache]{req_cache()}} when the request is promised. } } \examples{ \dontrun{ library(promises) request_base <- request(example_url()) |> req_url_path_append("delay") p <- request_base |> req_url_path_append(2) |> req_perform_promise() # A promise object, not particularly useful on its own p # Use promise chaining functions to access results p \%...>\% resp_body_json() \%...>\% print() # Can run two requests at the same time p1 <- request_base |> req_url_path_append(2) |> req_perform_promise() p2 <- request_base |> req_url_path_append(1) |> req_perform_promise() p1 \%...>\% resp_url_path \%...>\% paste0(., " finished") \%...>\% print() p2 \%...>\% resp_url_path \%...>\% paste0(., " finished") \%...>\% print() # See the [promises package documentation](https://rstudio.github.io/promises/) # for more information on working with promises } } httr2/man/resp_body_raw.Rd0000644000176200001440000000466214666312277015244 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/resp-body.R \name{resp_body_raw} \alias{resp_body_raw} \alias{resp_has_body} \alias{resp_body_string} \alias{resp_body_json} \alias{resp_body_html} \alias{resp_body_xml} \title{Extract body from response} \usage{ resp_body_raw(resp) resp_has_body(resp) resp_body_string(resp, encoding = NULL) resp_body_json(resp, check_type = TRUE, simplifyVector = FALSE, ...) resp_body_html(resp, check_type = TRUE, ...) resp_body_xml(resp, check_type = TRUE, ...) } \arguments{ \item{resp}{A httr2 \link{response} object, created by \code{\link[=req_perform]{req_perform()}}.} \item{encoding}{Character encoding of the body text. If not specified, will use the encoding specified by the content-type, falling back to UTF-8 with a warning if it cannot be found. The resulting string is always re-encoded to UTF-8.} \item{check_type}{Check that response has expected content type? Set to \code{FALSE} to suppress the automated check} \item{simplifyVector}{Should JSON arrays containing only primitives (i.e. booleans, numbers, and strings) be caused to atomic vectors?} \item{...}{Other arguments passed on to \code{\link[jsonlite:fromJSON]{jsonlite::fromJSON()}} and \code{\link[xml2:read_xml]{xml2::read_xml()}} respectively.} } \value{ \itemize{ \item \code{resp_body_raw()} returns a raw vector. \item \code{resp_body_string()} returns a string. \item \code{resp_body_json()} returns NULL, an atomic vector, or list. \item \code{resp_body_html()} and \code{resp_body_xml()} return an \code{xml2::xml_document} } } \description{ \itemize{ \item \code{resp_body_raw()} returns the raw bytes. \item \code{resp_body_string()} returns a UTF-8 string. \item \code{resp_body_json()} returns parsed JSON. \item \code{resp_body_html()} returns parsed HTML. \item \code{resp_body_xml()} returns parsed XML. \item \code{resp_has_body()} returns \code{TRUE} if the response has a body. } \code{resp_body_json()} and \code{resp_body_xml()} check that the content-type header is correct; if the server returns an incorrect type you can suppress the check with \code{check_type = FALSE}. These two functions also cache the parsed object so the second and subsequent calls are low-cost. } \examples{ resp <- request("https://httr2.r-lib.org") |> req_perform() resp resp |> resp_has_body() resp |> resp_body_raw() resp |> resp_body_string() if (requireNamespace("xml2", quietly = TRUE)) { resp |> resp_body_html() } } httr2/man/oauth_token_cached.Rd0000644000176200001440000000314414732312362016173 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/oauth.R \name{oauth_token_cached} \alias{oauth_token_cached} \title{Retrieve an OAuth token using the cache} \usage{ oauth_token_cached( client, flow, flow_params = list(), cache_disk = FALSE, cache_key = NULL, reauth = FALSE ) } \arguments{ \item{client}{An \code{\link[=oauth_client]{oauth_client()}}.} \item{flow}{An \code{oauth_flow_} function used to generate the access token.} \item{flow_params}{Parameters for the flow. This should be a named list whose names match the argument names of \code{flow}.} \item{cache_disk}{Should the access token be cached on disk? This reduces the number of times that you need to re-authenticate at the cost of storing access credentials on disk. Learn more in \url{https://httr2.r-lib.org/articles/oauth.html}.} \item{cache_key}{If you want to cache multiple tokens per app, use this key to disambiguate them.} \item{reauth}{Set to \code{TRUE} to force re-authentication via flow, regardless of whether or not token is expired.} } \description{ This function wraps around a \code{oauth_flow_} function to retrieve a token from the cache, or to generate and cache a token if needed. Use this for manual token management that still takes advantage of httr2's caching system. You should only need to use this function if you're passing the token } \examples{ \dontrun{ token <- oauth_token_cached( client = example_github_client(), flow = oauth_flow_auth_code, flow_params = list( auth_url = "https://github.com/login/oauth/authorize" ), cache_disk = TRUE ) token } } \keyword{internal} httr2/man/resp_check_content_type.Rd0000644000176200001440000000317314666312277017302 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/content-type.R \name{resp_check_content_type} \alias{resp_check_content_type} \title{Check the content type of a response} \usage{ resp_check_content_type( resp, valid_types = NULL, valid_suffix = NULL, check_type = TRUE, call = caller_env() ) } \arguments{ \item{resp}{A httr2 \link{response} object, created by \code{\link[=req_perform]{req_perform()}}.} \item{valid_types}{A character vector of valid MIME types. Should only be specified with \code{type/subtype}.} \item{valid_suffix}{A string given an "structured media type" suffix.} \item{check_type}{Should the type actually be checked? Provided as a convenience for when using this function inside \verb{resp_body_*} helpers.} \item{call}{The execution environment of a currently running function, e.g. \code{caller_env()}. The function will be mentioned in error messages as the source of the error. See the \code{call} argument of \code{\link[rlang:abort]{abort()}} for more information.} } \value{ Called for its side-effect; erroring if the response does not have the expected content type. } \description{ A different content type than expected often leads to an error in parsing the response body. This function checks that the content type of the response is as expected and fails otherwise. } \examples{ resp <- response(headers = list(`content-type` = "application/json")) resp_check_content_type(resp, "application/json") try(resp_check_content_type(resp, "application/xml")) # `types` can also specify multiple valid types resp_check_content_type(resp, c("application/xml", "application/json")) } httr2/man/resps_successes.Rd0000644000176200001440000000405214737312513015602 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/iterate-responses.R \name{resps_successes} \alias{resps_successes} \alias{resps_failures} \alias{resps_requests} \alias{resps_data} \title{Tools for working with lists of responses} \usage{ resps_successes(resps) resps_failures(resps) resps_requests(resps) resps_data(resps, resp_data) } \arguments{ \item{resps}{A list of responses (possibly including errors).} \item{resp_data}{A function that takes a response (\code{resp}) and returns the data found inside that response as a vector or data frame. NB: If you're using \code{\link[=resp_body_raw]{resp_body_raw()}}, you're likely to want to wrap its output in \code{list()} to avoid combining all the bodies into a single raw vector, e.g. \verb{resps |> resps_data(\\(resp) list(resp_body_raw(resp)))}.} } \description{ These function provide a basic toolkit for operating with lists of responses and possibly errors, as returned by \code{\link[=req_perform_parallel]{req_perform_parallel()}}, \code{\link[=req_perform_sequential]{req_perform_sequential()}} and \code{\link[=req_perform_iterative]{req_perform_iterative()}}. \itemize{ \item \code{resps_successes()} returns a list successful responses. \item \code{resps_failures()} returns a list failed responses (i.e. errors). \item \code{resps_requests()} returns the list of requests that corresponds to each request. \item \code{resps_data()} returns all the data in a single vector or data frame. It requires the vctrs package to be installed. } } \examples{ reqs <- list( request(example_url()) |> req_url_path("/ip"), request(example_url()) |> req_url_path("/user-agent"), request(example_url()) |> req_template("/status/:status", status = 404), request("INVALID") ) resps <- req_perform_parallel(reqs, on_error = "continue") # find successful responses resps |> resps_successes() # collect all their data resps |> resps_successes() |> resps_data(\(resp) resp_body_json(resp)) # find requests corresponding to failure responses resps |> resps_failures() |> resps_requests() } httr2/man/oauth_client_req_auth.Rd0000644000176200001440000000632114666312277016745 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/oauth-client.R \name{oauth_client_req_auth} \alias{oauth_client_req_auth} \alias{oauth_client_req_auth_header} \alias{oauth_client_req_auth_body} \alias{oauth_client_req_auth_jwt_sig} \title{OAuth client authentication} \usage{ oauth_client_req_auth(req, client) oauth_client_req_auth_header(req, client) oauth_client_req_auth_body(req, client) oauth_client_req_auth_jwt_sig(req, client, claim, size = 256, header = list()) } \arguments{ \item{req}{A httr2 \link{request} object.} \item{client}{An \link{oauth_client}.} \item{claim}{Claim set produced by \code{\link[=jwt_claim]{jwt_claim()}}.} \item{size}{Size, in bits, of sha2 signature, i.e. 256, 384 or 512. Only for HMAC/RSA, not applicable for ECDSA keys.} \item{header}{A named list giving additional fields to include in the JWT header.} } \value{ A modified HTTP \link{request}. } \description{ \code{oauth_client_req_auth()} authenticates a request using the authentication strategy defined by the \code{auth} and \code{auth_param} arguments to \code{\link[=oauth_client]{oauth_client()}}. This is used to authenticate the client as part of the OAuth flow, \strong{not} to authenticate a request on behalf of a user. There are three built-in strategies: \itemize{ \item \code{oauth_client_req_body()} adds the client id and (optionally) the secret to the request body, as described in \href{https://datatracker.ietf.org/doc/html/rfc6749#section-2.3.1}{Section 2.3.1 of RFC 6749}. \item \code{oauth_client_req_header()} adds the client id and secret using HTTP basic authentication with the \code{Authorization} header, as described in \href{https://datatracker.ietf.org/doc/html/rfc6749#section-2.3.1}{Section 2.3.1 of RFC 6749}. \item \code{oauth_client_jwt_rs256()} adds a client assertion to the body using a JWT signed with \code{jwt_sign_rs256()} using a private key, as described in \href{https://datatracker.ietf.org/doc/html/rfc7523#section-2.2}{Section 2.2 of RFC 7523}. } You will generally not call these functions directly but will instead specify them through the \code{auth} argument to \code{\link[=oauth_client]{oauth_client()}}. The \code{req} and \code{client} parameters are automatically filled in; other parameters come from the \code{auth_params} argument. } \examples{ # Show what the various forms of client authentication look like req <- request("https://example.com/whoami") client1 <- oauth_client( id = "12345", secret = "56789", token_url = "https://example.com/oauth/access_token", name = "oauth-example", auth = "body" # the default ) # calls oauth_client_req_auth_body() req_dry_run(oauth_client_req_auth(req, client1)) client2 <- oauth_client( id = "12345", secret = "56789", token_url = "https://example.com/oauth/access_token", name = "oauth-example", auth = "header" ) # calls oauth_client_req_auth_header() req_dry_run(oauth_client_req_auth(req, client2)) client3 <- oauth_client( id = "12345", key = openssl::rsa_keygen(), token_url = "https://example.com/oauth/access_token", name = "oauth-example", auth = "jwt_sig", auth_params = list(claim = jwt_claim()) ) # calls oauth_client_req_auth_header_jwt_sig() req_dry_run(oauth_client_req_auth(req, client3)) } httr2/man/req_oauth_bearer_jwt.Rd0000644000176200001440000000465614715443111016566 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/oauth-flow-jwt.R \name{req_oauth_bearer_jwt} \alias{req_oauth_bearer_jwt} \alias{oauth_flow_bearer_jwt} \title{OAuth with a bearer JWT (JSON web token)} \usage{ req_oauth_bearer_jwt( req, client, claim, signature = "jwt_encode_sig", signature_params = list(), scope = NULL, token_params = list() ) oauth_flow_bearer_jwt( client, claim, signature = "jwt_encode_sig", signature_params = list(), scope = NULL, token_params = list() ) } \arguments{ \item{req}{A httr2 \link{request} object.} \item{client}{An \code{\link[=oauth_client]{oauth_client()}}.} \item{claim}{A list of claims. If all elements of the claim set are static apart from \code{iat}, \code{nbf}, \code{exp}, or \code{jti}, provide a list and \code{\link[=jwt_claim]{jwt_claim()}} will automatically fill in the dynamic components. If other components need to vary, you can instead provide a zero-argument callback function which should call \code{jwt_claim()}.} \item{signature}{Function use to sign \code{claim}, e.g. \code{\link[=jwt_encode_sig]{jwt_encode_sig()}}.} \item{signature_params}{Additional arguments passed to \code{signature}, e.g. \code{size}, \code{header}.} \item{scope}{Scopes to be requested from the resource owner.} \item{token_params}{List containing additional parameters passed to the \code{token_url}.} } \value{ \code{req_oauth_bearer_jwt()} returns a modified HTTP \link{request} that will use OAuth; \code{oauth_flow_bearer_jwt()} returns an \link{oauth_token}. } \description{ Authenticate using a \strong{Bearer JWT} (JSON web token) as an authorization grant to get an access token, as defined by \href{https://datatracker.ietf.org/doc/html/rfc7523#section-2.1}{Section 2.1 of RFC 7523}. It is often used for service accounts, accounts that are used primarily in automated environments. Learn more about the overall OAuth authentication flow in \url{https://httr2.r-lib.org/articles/oauth.html}. } \examples{ req_auth <- function(req) { req_oauth_bearer_jwt( req, client = oauth_client("example", "https://example.com/get_token"), claim = jwt_claim() ) } request("https://example.com") |> req_auth() } \seealso{ Other OAuth flows: \code{\link{req_oauth_auth_code}()}, \code{\link{req_oauth_client_credentials}()}, \code{\link{req_oauth_password}()}, \code{\link{req_oauth_refresh}()}, \code{\link{req_oauth_token_exchange}()} } \concept{OAuth flows} httr2/man/resp_raw.Rd0000644000176200001440000000130514666312277014216 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/resp.R \name{resp_raw} \alias{resp_raw} \title{Show the raw response} \usage{ resp_raw(resp) } \arguments{ \item{resp}{A httr2 \link{response} object, created by \code{\link[=req_perform]{req_perform()}}.} } \value{ \code{resp} (invisibly). } \description{ This function reconstructs the HTTP message that httr2 received from the server. It's unlikely to be exactly byte-for-byte identical (because most servers compress at least the body, and HTTP/2 can also compress the headers), but it conveys the same information. } \examples{ resp <- request(example_url()) |> req_url_path("/json") |> req_perform() resp |> resp_raw() } httr2/man/resp_headers.Rd0000644000176200001440000000266314666312277015050 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/resp-headers.R \name{resp_headers} \alias{resp_headers} \alias{resp_header} \alias{resp_header_exists} \title{Extract headers from a response} \usage{ resp_headers(resp, filter = NULL) resp_header(resp, header, default = NULL) resp_header_exists(resp, header) } \arguments{ \item{resp}{A httr2 \link{response} object, created by \code{\link[=req_perform]{req_perform()}}.} \item{filter}{A regular expression used to filter the header names. \code{NULL}, the default, returns all headers.} \item{header}{Header name (case insensitive)} \item{default}{Default value to use if header doesn't exist.} } \value{ \itemize{ \item \code{resp_headers()} returns a list. \item \code{resp_header()} returns a string if the header exists and \code{NULL} otherwise. \item \code{resp_header_exists()} returns \code{TRUE} or \code{FALSE}. } } \description{ \itemize{ \item \code{resp_headers()} retrieves a list of all headers. \item \code{resp_header()} retrieves a single header. \item \code{resp_header_exists()} checks if a header is present. } } \examples{ resp <- request("https://httr2.r-lib.org") |> req_perform() resp |> resp_headers() resp |> resp_headers("x-") resp |> resp_header_exists("server") resp |> resp_header("server") # Headers are case insensitive resp |> resp_header("SERVER") # Returns NULL if header doesn't exist resp |> resp_header("this-header-doesnt-exist") } httr2/man/resp_request.Rd0000644000176200001440000000106614737043664015121 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/resp-request.R \name{resp_request} \alias{resp_request} \title{Find the request responsible for a response} \usage{ resp_request(resp) } \arguments{ \item{resp}{A httr2 \link{response} object, created by \code{\link[=req_perform]{req_perform()}}.} } \description{ To make debugging easier, httr2 includes the request that was used to generate every response. You can use this function to access it. } \examples{ req <- request(example_url()) resp <- req_perform(req) resp_request(resp) } httr2/man/req_error.Rd0000644000176200001440000000704614666312277014404 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/req-error.R \name{req_error} \alias{req_error} \title{Control handling of HTTP errors} \usage{ req_error(req, is_error = NULL, body = NULL) } \arguments{ \item{req}{A httr2 \link{request} object.} \item{is_error}{A predicate function that takes a single argument (the response) and returns \code{TRUE} or \code{FALSE} indicating whether or not an R error should be signalled.} \item{body}{A callback function that takes a single argument (the response) and returns a character vector of additional information to include in the body of the error. This vector is passed along to the \code{message} argument of \code{\link[rlang:abort]{rlang::abort()}} so you can use any formatting that it supports.} } \value{ A modified HTTP \link{request}. } \description{ \code{req_perform()} will automatically convert HTTP errors (i.e. any 4xx or 5xx status code) into R errors. Use \code{req_error()} to either override the defaults, or extract additional information from the response that would be useful to expose to the user. } \section{Error handling}{ \code{req_perform()} is designed to succeed if and only if you get a valid HTTP response. There are two ways a request can fail: \itemize{ \item The HTTP request might fail, for example if the connection is dropped or the server doesn't exist. This type of error will have class \code{c("httr2_failure", "httr2_error")}. \item The HTTP request might succeed, but return an HTTP status code that represents an error, e.g. a \verb{404 Not Found} if the specified resource is not found. This type of error will have (e.g.) class \code{c("httr2_http_404", "httr2_http", "httr2_error")}. } These error classes are designed to be used in conjunction with R's condition handling tools (\url{https://adv-r.hadley.nz/conditions.html}). For example, if you want to return a default value when the server returns a 404, use \code{tryCatch()}: \if{html}{\out{
}}\preformatted{tryCatch( req |> req_perform() |> resp_body_json(), httr2_http_404 = function(cnd) NULL ) }\if{html}{\out{
}} Or if you want to re-throw the error with some additional context, use \code{withCallingHandlers()}, e.g.: \if{html}{\out{
}}\preformatted{withCallingHandlers( req |> req_perform() |> resp_body_json(), httr2_http_404 = function(cnd) \{ rlang::abort("Couldn't find user", parent = cnd) \} ) }\if{html}{\out{
}} Learn more about error chaining at \link[rlang:topic-error-chaining]{rlang::topic-error-chaining}. } \examples{ # Performing this request usually generates an error because httr2 # converts HTTP errors into R errors: req <- request(example_url()) |> req_url_path("/status/404") try(req |> req_perform()) # You can still retrieve it with last_response() last_response() # But you might want to suppress this behaviour: resp <- req |> req_error(is_error = \(resp) FALSE) |> req_perform() resp # Or perhaps you're working with a server that routinely uses the # wrong HTTP error codes only 500s are really errors request("http://example.com") |> req_error(is_error = \(resp) resp_status(resp) == 500) # Most typically you'll use req_error() to add additional information # extracted from the response body (or sometimes header): error_body <- function(resp) { resp_body_json(resp)$error } request("http://example.com") |> req_error(body = error_body) # Learn more in https://httr2.r-lib.org/articles/wrapping-apis.html } \seealso{ \code{\link[=req_retry]{req_retry()}} to control when errors are automatically retried. } httr2/man/obfuscate.Rd0000644000176200001440000000302414556444037014345 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/secret.R \name{obfuscate} \alias{obfuscate} \alias{obfuscated} \title{Obfuscate mildly secret information} \usage{ obfuscate(x) obfuscated(x) } \arguments{ \item{x}{A string to \code{obfuscate}, or mark as \code{obfuscated}.} } \value{ \code{obfuscate()} prints the \code{obfuscated()} call to include in your code. \code{obfuscated()} returns an S3 class marking the string as obfuscated so it can be unobfuscated when needed. } \description{ Use \code{obfuscate("value")} to generate a call to \code{obfuscated()}, which will unobfuscate the value at the last possible moment. Obfuscated values only work in limited locations: \itemize{ \item The \code{secret} argument to \code{\link[=oauth_client]{oauth_client()}} \item Elements of the \code{data} argument to \code{\link[=req_body_form]{req_body_form()}}, \code{req_body_json()}, and \code{req_body_multipart()}. } Working together this pair of functions provides a way to obfuscate mildly confidential information, like OAuth client secrets. The secret can not be revealed from your inspecting source code, but a skilled R programmer could figure it out with some effort. The main goal is to protect against scraping; there's no way for an automated tool to grab your obfuscated secrets. } \examples{ obfuscate("good morning") # Every time you obfuscate you'll get a different value because it # includes 16 bytes of random data which protects against certain types of # brute force attack obfuscate("good morning") } httr2/man/is_online.Rd0000644000176200001440000000066714737312513014355 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/is-online.R \name{is_online} \alias{is_online} \title{Is your computer currently online?} \usage{ is_online() } \description{ This function uses some cheap heuristics to determine if your computer is currently online. It's a simple wrapper around \code{\link[curl:nslookup]{curl::has_internet()}} exported from httr2 for convenience. } \examples{ is_online() } httr2/man/resp_link_url.Rd0000644000176200001440000000175414666312277015254 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/resp-headers.R \name{resp_link_url} \alias{resp_link_url} \title{Parse link URL from a response} \usage{ resp_link_url(resp, rel) } \arguments{ \item{resp}{A httr2 \link{response} object, created by \code{\link[=req_perform]{req_perform()}}.} \item{rel}{The "link relation type" value for which to retrieve a URL.} } \value{ Either a string providing a URL, if the specified \code{rel} exists, or \code{NULL} if not. } \description{ Parses URLs out of the the \code{Link} header as defined by \href{https://datatracker.ietf.org/doc/html/rfc8288}{RFC 8288}. } \examples{ # Simulate response from GitHub code search resp <- response(headers = paste0("Link: ", '; rel="next",', '; rel="last"' )) resp_link_url(resp, "next") resp_link_url(resp, "last") resp_link_url(resp, "prev") } httr2/man/figures/0000755000176200001440000000000014556444037013550 5ustar liggesusershttr2/man/figures/lifecycle-questioning.svg0000644000176200001440000000244414556444037020577 0ustar liggesusers lifecycle: questioning lifecycle questioning httr2/man/figures/lifecycle-stable.svg0000644000176200001440000000247214556444037017505 0ustar liggesusers lifecycle: stable lifecycle stable httr2/man/figures/lifecycle-experimental.svg0000644000176200001440000000245014556444037020724 0ustar liggesusers lifecycle: experimental lifecycle experimental httr2/man/figures/lifecycle-deprecated.svg0000644000176200001440000000244014556444037020326 0ustar liggesusers lifecycle: deprecated lifecycle deprecated httr2/man/figures/lifecycle-superseded.svg0000644000176200001440000000244014556444037020371 0ustar liggesusers lifecycle: superseded lifecycle superseded httr2/man/figures/logo.png0000644000176200001440000011103214556444037015214 0ustar liggesusers‰PNG  IHDRđ̃«h cHRMz&€„ú€èu0ê`:˜pœºQ<bKGDÿÿÿ ½§“tIMEç (‡w @€IDATxÚ́½w|ÇyđÿƯ½̃`{ïU¢(Q½[î–[;q́ôÄѼyŃÄvl'.r‰mY.²%«Y½Q…"Å̃{/ Aôr}wæ÷ÇÜî€ ‚ x>¢p8ÜÎÎÎíwŸ™g"”+F 'Üâ¾Àà+@!đÿ¯6@Ó₫úº«ƒ̉K"úºƒrñ’.ÀpàÀ'‘É÷j_?ö¹yàË À\̉àÍî¾̀îâăĐ?†y Ë ÀT̉ÀơK/«ïy•À»À·ç B ”^¦.´¾ l ‚Üeà~$À->| q_È)à§ÉÇƯ7Aî?böuEK¼ô:÷ÛÀ§¹|Z7›ä×+€8ÚÈó—Œ'Z°»5(® jà>–4p `>đÀhƒU’đ*z}¼:ùû 6îc¸¤Ăt¹ ø đqôQ–&àwÀÿ;Ro‚Ü'2đe–àï₫ í”1ä(đ#àçÀi÷ÍA/¯ |% ^/pÚưq`ơußz( ؈^¯?´Á Ä—S¾ ̉!̀o&:àà>´‘èJ(đ"z}¼p`äË!ƒ_BÉæ÷Éä¿}Ư·K$ơÀ¯€ï3¶xYdàK$ÂüîA[—g÷¸Á%ƒa‹—IîeI×Bï¡v7̀ïJ“Á°ÅË ƒ÷’ôb˜ß•&a´ë; †-öº |‘’%̀ï£è0¿1}Ư·~&5è-§J [|±¯û5 eà‹,a~,dp\Ï%»Aưđ˜”:lQh>0rOdđFëtó[Œó»Kæw‰°•âMà¿”âU!tØâ Ä.ƒ_€t˜.§=̀¯¬¯û60Déÿ+÷µh@‡-nu?0r÷eànH–0¿¢Ăü&öußt‚¥ôô8I{Øâ ÷ˆAÏ/ƒá„ç‘4xưÀího£O3¨u/@Î /è½̣eÀr2ÂÇk [<— jà.¤ƒûă<´ênú_˜_?—óÂÛQâ´‡-¾ *Đ|ॾ¾~)ƒwÓåÑhmû0¬¯û6đä‚áM—&t‚½ÿg——¹£ œ”àïC‡ùMïë¾ L¹(xÓÛ8B{Øâ÷/ƒ k˜Na~+ÑÛB+¸a~},½¯ûZXöæzFJBB@ËÁAˆ¯j€;hƯ™ÀŸpå„ùơô:¼¤Ư¦Q¥xí_ư.É°Å«ä«ààV¢«ù}öj~ƒ̉#¹¤đ&Û¥¨‚GÑOûƯ¿_ _Uw7æ÷`n_÷màËeƒ7½ÍưèØă_uú˜8-W÷ơ`\6¹jî淽νđơuß¾ô ¼®Htÿ^h9ør_Êe‘+àZw2:̀ï@q_÷íÊLx•n{í¯» oúq!àPß±dØâ•̣ ppËióÛ×}»r¤ßÀ›₫ËRa‹qß¼RA¾"Nƒ7ˆvü"°èJ½̃¾^÷g€7£èÜƠ¿•̉mµ¾²@¾¢nèa~‹hó ôuß®,I‡·'ëƯö6Ú_÷*¼®Øè*ÿ¼ªq€ÖCWÄWÀ¦Ëă€Ï†ôuß®<0đ¦·Ù<¡ß‚mîÁWÈàà–Đæ7©¯ûveÊ€„7]N [”'ơ[‚ÖC¯\æq́=°wó» =]¾ÁÉK$̃ÎmªÍÀwA= ¢Å}w ‚<àîæ7—ö0¿Ü¾îÛ•+W¼î‹8¨—A|x½^p€;L—GÑæWÑ×}»²å„7½FRa‹́vÿ:P@§Á[Ü:˜Ñ×ưº̣å‡7]¶ØßAî×wó[®r°đôuß®|¹ªàMÿă{èh§?*E ípÿ…¸_Üaº<ƒö0¿‚¾îÛƠ!W%¼éWokA9 h;üZ/ŒmïJ¿¸¸è5î§Ñk̃Aé ®”è&]J)¤T(¥B`"˱ư ̃óC×Ëđ¦·Y«”ú¥ü]° €¶Ă¯^è€\2é7§Á›Ü…¶.Ïëë~O”RíÿCh(º UOÎ'¥D)0 a) ÏwLN0À¨áC™0v$†<÷Ú»$vÚ±ƒđ¦·™ÖÆ>Pßñk Î}³?€Üçwó[‚^ç̃D?ósµ™i”•R^VŒ×ă¡¦¶SgjÏ UÏÎ')ÈËeܘL?€ßÇoŸz•P8̉幤”~n¼~ܾ‚i“Æ øùê·Î#ëcúØAxÓÛÔÁn» đz}ü"º¨yŸCÜg9Ÿ:L—'¡Ăü>Èós§®³§Mà;V°xî4†”a™&µơMüïoÿÈ/Çqzb)%Á€Ÿ[W^Ăûï\É” Uƒ~₫ă{DÏy\iI!÷ùsÏ-×đû^_³‰?<¿„7[›Yàí t=zVø:?×ÆÜ17(è;/;ÀÀ‚öY₫,Ú‡¹ß‹”€ßËG¸…Ï|ø.†) ‰‘HØŒYÁ—>ó ;öbĂÖƯ˜æÅ9†I)))*àïÿ́#Ü{ë2ü>/X¿e7=ư*RJ ĂètœRÜœ_₫ÂǸÿö(¥pI"aóØ3¯̉ܲLú ¼úü™Ë‘T³:Ú©ư(.'¼é’|½̣3àÇÀÑÜ17—äË p‡0¿Ûhó3zØäe©Á€¿ú́yèư·áñXH©8}¶ÿî/|ü¿¿ù %…ù,œ3•ơ[w_Ôù”Rü>₫ösâÁ»Wi¥DJÉă|ƒºÆf¬,wz×MK¹ûæ¥)(LÓd÷₫#¬Y¿= }ß«”B*…’ Ó~ ós),È#/7ˆÏëA*E,§µ-Lcs+M-mD"1”r\â¼ư8ÿ8·wxÓeđ誔ɰEƠ”;fåeµV_€ÓÀ5Đå7¿˜¼đ槔Â2 >ûÑ{øă·cÚx‰Æøúÿü’ß=û:‹æL%° ø}”bqQka)%7.[È}·-OƒĐàÀ‘j^_³ £‹v•‚’â¼û<Oj*¯”â¥ƠïQßØ‚aˆÔu]nx¥ÔëyŸÏĂÈrfNÏÜé™8vCË(̀ÏÅçơ`˜R*lÛ!ÓỔÆÉê¶î:À›k·°uç~"Ñx̉½çÿ^Û»xÓe:đ=à>tØâë9U+ăJAøè¥ù’Üaº<ăc °0?WSܽj Ÿùđ]X–‘2`=ụ̂;<ụ̂;† bh)~Ÿ…"‹ơösæåæđà]7ø°mw=-xcÍFNŸ­?§ájñÜiL_…”2i‡º†&V¿»P) /'¼®!®´¸kçÏà拘7s2CËñù¼(©hhn¡®¾‰„­„E…ùä柤´¨€ñUĂYvÍ\zÿí¼öξ÷³'صÿ0"5>Ưăö₫÷^W,P7‹”â÷ÀÛrªV:ré@¾$w·ƒêóèœTN¤TL™0¿ü“›ÀqôôítM=?{́9bñ8¦a0mâ¼ Ç‘œ<íZ¢{¶:p¤dÎô ̀6Ç‘)X[ÛB¼öÎ&¤”]NŸư~/·¯º¿ß‹m;˜¦ÉÖ8xô$†!hϤ‘§»{ʯăḤsƒÜqă>xïMLX¥vÉ™Å=‡øĂó«Y³~gjë±mŸÏË°!%,Y0“îXIƠÈ ¤#“· ÷Ư¶œ“ÇñÏÿù#̃X³éúß«đ¦G>¨O‚X%%?‚ÿN]J{à4x}è¬_Bga~J)r‚~₫́÷S5²"5{í]ö8aäừ>„Âö>ÑăM:¥Ë䶕ג—ÄNÓ0 vï?Ê=‡@‘‚Ó0 !RbÛS'añœi)í ú³o®ƯB<‘ÀcYíö̃äzYJ™q₫®A¸0xƯöÇU çï>ÿan\¶¯Çƒ”)ơä7O¾̀Ă¿|’Ơ5iTq̣ôY6lƯĂËo®çk_₫ógNÆIȶÆUàk_₫<_øÊ7Y·i¦y₫A¿Dđ¦ÏhF Á¿¢ư¾ < ´æT­́uˆ{ àa~sĐù–ïe€‡ùI)¹iÙBnº~ạ&×đÖÖ7ñäóoâ8¢Ñ#*˜0fÇOƠpøØ)Œ Ô¾®6tIƠˆJ–.…LƒIkªƒ”—3q́ḤórÈÏÍaÓö½œ¨®¡¼¬„ cFđÀ+(.ÊÏf—Rrûªk¹f₫t,ÓLµéH‡H4F4çȉÓ<̣ûh …»êa‡×ç×¼R*¦OĂ|åÏôlBJÇÁ0 ZZCüçåÑÇ_$–H`FƃC))ôuïÜ{ˆ¯~ççüøÿ@iqẠ<Çq5|(ơÙñ™¿ùwZÚº´ ¤÷ó›~ưsÑÉơîG¯ßΩZiCïi㋸Ăty$ºÂÁ'Đ´H©(+)âăï¿ ¿ß—‚Ơ0L̃Y¿Ư`”,3•âB]‘å½-»¨olîÖº2Ư½Ñ0 ~/¹9Aî¼i)å¥)¨u$w̃twÜx¿€ßËÖ]ÙµÿŸ₫đ]¼ï•Œ1Lo5Ñ®I] ô¢¹Ó²öIA"aóƠïüœP8̉UO;¼v*é×̉^ɨáå|ơï?›‚×íS8åëßû%ü₫yƯ¿[a™ilÚ¶—7×ná;Và82ƠwÇ‘,˜=…% f̣̀KocXÙ'{—^W|hƒíµÀoĐ¯=9U+y½çn—ÜÜÚĂüf^Tú‘(%¹yù"fN—1Db<÷êb±¦i—då’y˜¦A[(ÂëooÂébÚ̃¶k‰ơ2fdÓ'cÚ¤1Œ¯NEyĂÊKRđ¹çBPVRˆ{Ă5·´ñë'_â3Ix-ËLM…ddL“Ư>¸nŸ¿}úUùư ]LŸ/^¥^‡?{èæÏ‚#ÛSJñóÇăÑ'^̀z¾lÚ\A<‘`ư–]Ü{ë²N×á÷yY²`&Ͻºæ[O"aăñ´ßºî5W¬ÀïóÅ»hSơx»©óxôx n,¨¯£Ëú|ø#ΩZÑ#ˆ/àZw:º~îûĐöW”8̃™1yl†öE)^{g#uÍBà1-îºy)¹9Ø¶Ă³/¿CsKk—X.”ܱ‚¿ûüG(/+JM¡Û·´d3$ †ađÊ›ëihjá/>ù¾ŒÏ«Œ5ó¹o,Ă0ؼ}/ÿç?¡¦¶Ó́xƯ>¬Zº€¢‚¼” ‹ó‹ß=ÏÙÚÆÔ+½­́mf.#Tf"÷Ô19Á•p?ƒ×mC‹Yh€¿#k£VH! |´û w à,a~>ĂæçNÉîXµ$cV M-¼¾f(…T0uâ(V.™ =É«om8çV†”›–/àËñq ̣2 Ív\ú4Wi¶í>ÈoŸy•úâÇÉÉ OØ8¶ƒiM$ @®µÚmCG1 vî=Ä?üû9xäD–Nv¿äóÁëJ0àgÆä±Ú 2ù!ĂSKM]#µơM<ü˧0Mƒ­;đÛ§^åä™Z¼‹¿ùÓ1tHIFœđñSgøÚÿü’P8DzđxL¼–e²}÷AöŒ†w@„ùơ–H)™9e<Ḉ0}6غk?GOœA¡˜5u.¨o¬ÙD,Ï ¡ăHÆU gÑÜ©H©2Ö›GŸfËÎưÖ›Ù¥w4¯+¡p„ç_{—³¦h‹±Cäå&³ˆtƠfç̃‘×̀›Á‡î½9ă¡ª×3›ư‡O°yǾ´ %™m\¸ô ¼é’ |Ô H¸a‹Ç‚£—¤@¶ ̃ía~‹ a~½%®CẠ́kç té͵[ˆD£~zÿm”•'xäñ8u¦6k\®+BZÛÂlÚ¾7µ~¶,ưy)%#*ʹ~ñ́ Ï+!Ơgjyoó.„‘}ZpĂuó)+)ʘ> ÖlÜÁÙºÆnøw´6»íg¾în0¾{¾Ç~Ÿ×Ë×/D)ņm»ùƯ3¯£Í,đ:’Q•CùÇ/|Œ̣²âNI\ Ÿ|~uêZ¯xÓÛ¨¾L{Øâï&d+ ¯æ÷É{pƠ^”R”•±x̃t™ ­kä½Í»‘J±lñlnX:€µ›vñÇWÖ :¸f×£¨£H¥Xºh#+Ë;­a7nÛˉê³YƯ’¢|V]¿ Ót?‰²zÍ&Ggú|qÖæ®Úp½­~øÈøåăÚA$‰j3at ^)%Å…ù|å‹1oæä̀í<Úµïæ{ỵù7“ç¥S_.đ.Èh¿áMocía‹ß^â0íúø1t!́«V¤TLŸ4–ª‘ĂR†¤í{rôäi†”ñéƯE^nMÍ­üèѧhln=§×Ơ¹D)E^N[–/Â2Í ­Û¼¾f±x" „ éHæÍĤq£2nnĂ08tô$Ûö<ç¬àRÁë»üpƯ3ơ¸ûđææùû?ÿ(·Ư°$µ”>u6 ƒ¦–V¾óăßqúl]Ú>öÅÁ«¯¿_Áë₫âAç‹[„®{ü# )1 ĂüzSÜbÉ‚ư₫ G²fưv‘ßm̀›9¥$O½økÖo?§×ƠùÄ‘’iÇ0+é+œ®ơO>ˆm{²¬aµaÇ뵸eùb‚ñÂZ̃Y¿ú†æs̀ .-¼®¤;•do³³³ˆ›Aóo?ÿa>xÏ©ứLë²À¶m~ø‹'yơí iª+̃t)>­w\¡Î=‘¢‚\̀’éG 46·²nóN¦ŒÍÇßw+^ÅĂ'ùéo%nÛƯXcfwÍ}Ó²…äçf¼o‚÷¶î¦úL]‡öơ,¥¤jD×Ο‘a¼h …YưîæŒơt‡3§ư¼tđvl÷ÜđjĂ™”’ü¼₫ñ ăă�SÚÜôG~ÿ?zô)éôoó7½Ír ”Œ¯Á˜QNÿ†a°÷à1ªkêù§/>ĨáC Gc<ü˧8tôdÆ–Nú1Ư±ü*¥¨(/eÙµs2èB‹ÅycÍf ;múÜ>­WJ±́Ú¹î¹÷:ÎÎ}‡»˜dB£Û̉ëi#‡Û7đj‹ziq_₫‹‡xß+³¸†ê›m;<̣ûøúÿü’p$ë«^”êĂ´²ưQæÍL^nN X»q'×̀›Îí7\^|cO¾đ&–eR9´ŒñU#>l^¯ÅÉÓµlغ‡º†¦ó¬?ơûù3¨QL‡Pªaóö½i‚tx¡ ?—›®_ˆi¾Æ xë½m46·f1|eƒWQZRH~NÇ«ÏbŸwFÑûđº‘Y#+‡̣/ư)n^¾8u­™ÛE:Úë‡<É÷ñáđƠ /  è›#è÷±`ö”ä>3…Íé:₫ôc÷’›äà‘“|ÿçO0m̉̃× \;:åeÅø¼‚¸mó̃æ]üă¿ÿ#Ç«»„X)ạ́–å‹đz­ÔV)…0 ÖmÚəڲåmv¤Ă¬©˜6iLƺ ¥5Ä[k·èv2Î »Î¼ÿöå|đ›đXŸü«ăбS˜BĐÑY¢}…êBƠ»đΘ2ư›Ï°hÎÔŒH,÷§e9QÍ7~đkzñ­d$ÓƠ ¯Ûæ Àèmœ̣R&Ơi=™°mî¹ơz¦OC$ă©ßâΛ®ăw­¢´¤ IäNC-ÓäúE³ùè·đ¯ßúß.âkơvâØQ̀›9)Ă‚,„ ‰ñÆ»›±m'µWܾ¥¡Ïqọ́…évÜ÷÷8ÊG;LŸ;Ă[œ̀5ưÀ+ ø}¼ó̃6jë›tÎ)©!LÓÄc™x½< ´†Âʱt– `Ơơ ùç/}‚ñcF¦|Á]1MƒxÂæÅ7Öñ­‡Ă½‡0’W;¼00J*¦NCYiQæôY) óó¸v₫Œ¤÷̃ºŒC0M3 ̃̀©Ty3&‘—›Ck[¨óù’Ÿ¿aé|J 2§Ï†àȉÓlMó JßTJ1¢¢œ¥‹:;}(¥xsíV[C¦̃éđäạ̊O_zˆûoÓỊ̂îć¨J†–—0´¬˜¡e% )+¢´¨€‚ü\‚?¦ađîÆí|ư{¿¤-”½œKwá•Râ÷yùĐ}7óÅO?HiqA*æZƒ@û7ÿä×ÏđÄsoĐ̉J:Á´·Óƒo;­Ÿ^XFLƒy3'áóz²†÷¹z=£G ¥8[×@$§rhi‡>J‘Ÿ—CÀ便µ-kvˆ̉âBV.™B ̉\6ïnØNm}Sê½ô›̀qKÎdDEy§incs+o½·í Ơ¸=]ăy<₫́“pß­ËÓú ŸüÀ|₫ă÷đûđx̀´¤é*ùŸB ¨UÁ;ë·ñükk{Ï«Hé0tH _üôƒ­¡p n.èƠ5´µE²f«đz-n^¾ˆ€?ÓĂ0 9Éö”UæM&¥ḍøÑ̀>éd‚/•bơ»›i …³j*¥U#‡ñg=@NĐŸ‘kZÿưüc密‚Dz’¨îƯhRJ<÷̃ºŒ¿ú“0¢rhj»Î2MZxiơ:ưĂKlÛµŸDÂβ7oÇ6®z€•‚é“ÆP˜Ÿ›5˜ÎZ³~;_₫ÚẮ?rÓ0† ¸ âÂü í«}’¶î!ëœcJ*ÅØĂ’É:¸̃Y¿-đ₫å¹’•×ͧ¸0/#&V¨ohæơÛÓ¯Œtx…|àî“QV=+÷¢§øÅRëöî¬yơ₫n!ö‰øèư· ø‘RbÍ­m¼úöF~ùøólÚ¾—x<‘×́Ơ¨¢öïèÊÄƠ °Ị̂`¦²Ä%ót¯„ ñÖº-üü±çX·i'‘X 3 nûyÓÛ»Xx»=î^ÙúÑ×đÂU>…V@a~.Ó&é´₫uoØÚú&₫í»¿à@:¼I ¹3&á÷ù:yn>VÍ#'³d\Ô «–ÎÏpÀPJo—́;xŒ{t‚ôtîôIŒÓyỨ8’7Öl"‰`™éû’ëY©˜6i,•ĂÊ:%OOéăn9ÛC8Ų,|^O2‚H{‡}÷§¿ç5›̉,ä]Ă«,¿v.ÿü¥O2yBUj ¼eû^~ô)^}k=má¦a`™fÚÍ;owà…«`)YYΈÊ!r&»Zç—¿È»wtrK̀ÏËaÑœ©™í%o¼Í;öÑÜ̉Öé|RJ¦L¨bÆäqo®ÛJcKg*·ÔÊ Kçw \Bpæl=k6èL!Y}›•¢¨ O—TÉX« ¢±8 M-œ­käÔé³=qƒGOđûøâ§ßOyY1$T~đÈøßß<£û~ú¼2iT{ß+ùÛϘ̣2̀¥¾¡™_>₫¿øưsœ>[Ÿ7½¯W;¼í÷C÷Ú¸ºV0uBù¹9̃×SçƯụ̂Û§^IicW¤”Œ=œñU#2À×>̀ ÖoÙƯ)×fŵs)ÈÏíôÀhniă͵[ “•>vèĐ2Í–t²Èt/ܶûÇNÉ0ød̃‚ư‡OĐØÜJqa¾.m"Í­!₫Ï7~Â{›wÑÜ̉J(%SRTÀw₫ơK”—i?kÇ‘üøѧùïŸ₫XÜî´>O156Á€ŸÏ~ô^₫ôc÷’—Ä‘’µ›vđ_ÿ†µ›vv*̀Ö[đºSöv«ơÀ‚÷B4¯+W-ÀîúwæÔñÖ¿®!êϯÎiCófN¦ ?·“«¦¶{wN› æsƯ™úbœäÀáY]/¥T,;‘C2œ>Üéó»v‰ÆÚç}ïJ%ó?ïØÇ?ÿÇøüC÷3q́H„!xú¥·ùĂó«ÓÜ!à÷ñ—̣V^7?ÔïŸ}ïüä1¢±Ø9ăy¥”äåù›Ï}˜½ï6|^MÍmüâwÏñă_=ÍÙúÆä:×ÈèŸû}ô^Ü‚‹³~‹Î¨èú>»âHÉÜéY0{J§ÀĂ08zâ4GŸÎH§Ï™¹…RÜûrî¼q M­|ă¿æđ±S©rœR*¦MĂ_|êưư>PWßÄ7đkªkê0“F¦® V©·‰¸Ë2Y·iÿôơ¦ö´».¡̉sxÇ¡¼¬˜/~úÃ×*rsH©˜1y#*†p¶®îWµxđÂU °RIăFéipÚûî:öµw6ÛÜ¥TL¨Ayiq–m ›wîït.)“Ç亅³:íÁ !8]SÇ®ưG²T+Pø¼¸cy9Ú×½ñẃ=Dsk[‡ă2á•RrƯÂYüơŸ~˲øæĂ¿á¥Ơë’ç)¯/|̣}T–zP<ö̀+¬Û¼3«æuÛu×ö÷ƯºœOè.,ËbíÆüå¿|‡CÇNf”2Mï_ú5$£»đ*¥p¤d̉ØQüË_å×Î%½4¶]]Ùו«`×(5c̣X<+ÓJNT×°iû¾¬@ Ó'Åïï¸}$¨®©MÖÜ~õ -+ÎXĂºÇíÚw˜Tè`»8R²pÆTV.™×)¡››HÀu7LO” ¯âº…³øÚ—?GyY1ỵ̈I₫÷7Ïf́K)¹eÅbV]¿ ï‘ăƠüúÉ—qÙÙEʤư`…ù¹´…"|ñÓ’ ĐØÜÊoŸ~Çq(+)¢µ-D<@A%_ô^™Œ”Z~Í\₫éKŸ`Ú¤±!tY4ëf›^¸JÈÍñ3uâH[ÿº±¸·ïÍ €×ëaêÄ1¾P·:Ccsk§5ó¨áC¹mUv' ¥;÷Ö‰ë:L»s’ék‹ ó;­}"чJ;¦3¼Ë¯Ă×₫ñsT+ă'¿~†o=ü› ±ŒÈÉ=m!à¹W×pøXu§¾ệ0ĂøÔ‡îä̃[—ÑÚæä鳌>GJ_₫‹‡H$46·ŕä¶ï>ÀÆm{Øsà M-(•₫Pè̃ÍêjƯâ‚|>|ÿÍüÉG¤¨S)ĐÙ0u´Tº?XæÏäÜ#ơúâáU©V»¾†®Ú́¼p•,•bØRFÖɪ›H8¬Û´³C*-JéLU#†u>+{K¹ê÷ôgî¾y)UÉsu„0‘p8zütÆwè‚rọ́Ŭ\2¯ÓÚ×íkk[˜ÚºFÑÔ^¥7-[ÈWÿ₫O().ä;?~Lg±ˆD3·Ä”då’ỳ˜<>5£hm óúMz?7™“JJ…Ïçáæå‹øÂ'ßÇ´Ichm ³{ÿ–,˜™:§Ç²(+)•Ă†0}̣Xn»áZÛÂ8|‚×̃ÙÈ«o­gß¡c„#1„!p':]’¸~ÔK̀äs¿ëÎÂ4ÍTè3“æ–6ZCa¤€O)̣%ä*đ*W6 E@›P8B ̉vÑ{ï9>y àUê*XIÅ„±#;¹A Í-́Ü{¸‹›IR^Z¬ă†;Ôç±m›CÇNeX´¥”Œ3‚îXAÇ®Äâqjë›2¾7)%ăªFđgŸ¸@ÀŸ±¿™ê+Z‡#ÑTÅ"˲¸ÿöåüĂŸ”¼Ü ÿùưGùɯ&‘æ₫¨¯GkùÛV]›Ê bºLI]CsJë¡`ü˜á|ö#÷p÷-ד›$ óƯŸüqUĂÉËÍɈåR™Y#'`Ό̙>‘‡¼ [wóÊ›ëyoË.N>K$Ëp¼pÅçơ0ẹ8>|ßÍܾj‰̃Ç–2ëXºçª®­ÇE˜‘P̀NH&ÙrG‘+–ÔÅIc 8b ¶øL¶{ơF̣AÈÀ€®B€]7ÈSÆáóxR•ă„08~²&¹÷› `¨(/%7èøÅ9s¶>ơ¸–çO¯—’Â|HFJ¹}BPR”Ï­+¯aỞ…ÔÔÖ³çÀQvî=ÄáăƠÔ76cÛ6Á€Ÿáå̀1‰ÅsuÚ"%eFºßß«0 œX ó½]üe}”é E®”`È€'?Y”‡,ÊÇ̀ OPuª–e§j8ózÀàuŸA]Ú¬ ‹»(ígßÁ W!À¬];ilÆ{®Qeï¡c´¶…»É#'˜:q ¼}gÿû7´4´₫‹´Ă›”Àêø6ïEDb°1Z’_¶̃ ¶NƠ&µŸ# –H$hi s¢º† [wóâkÙ¼cñx‚Ü`€Ï}â}”;ĂÁ?¾Eô¾8C1ZÚÀ²0Î6`&§ÅFK[;Mé¦å”ßGÚ{†@8C'QB  ÅŒ„b­WœÓ«º/à…« `%“Ǧ´¤°Ó2³m÷okuQEÁ₫Ă'ˆg-÷ÙDù¯ư–Wßj¯w¶®‘wÖocÂØ)„œä_¿ơS^{gc²µö`‡P8Êơ S'VQ1´,eÉÅâ¼₫ÎF₫ăû²cÏ¡ ‚7}[K§È±¹çÖe~ö́?³¯¼Ă–û“Ù1³ôôppêôYNœªÉ̀êáV7«[°́бSüçå¿1£*RR„×ë!ÓØÜJÍÙÎÔ6Đ̉Jyo !xà•Ü¹lg₫ê›Äƒ~â3'€”ø¶îC₫5Ûᨆ÷B+GjKB)”ø•bq\±ÁRd×Á}/\E»ë¨93²ç®olaÿáˆsl†`ó}́;tŒSÆá8™†Ë2ihjå;?~ŒG’E­Ư¿9Ṛ‹ß=ÏÜ“˜9uîÆxư­|ă‡¿fûƒö~ëó¾³~öåoqÿmË©ZÊÙºFV¿»™Wß̃@sK[à%uíăđÔ‹oñÂk1 ƒh,®S½f‰"Jw–`é çw)tuK¸œ­käLmCÚ]Û̃†«Ñ…ĐÓ́å×Îă¯?ÿ8QCë»Û°§Ă)ÊǬmÄÿæfŒæ6̀º&÷$=»YÜû"Ù“I¶¢@ Dç«êKxá* ?7‡ÙÓÆgø? t>ªƠg©©mèÚ€E{À₫·₫-ỵ̈ןddåĐ”!&°uç~ôèSYK{†Á#'øó¯|“{oYFƠÈ [[ygưṽZ»%­B&¼n<¯R5ë·ó̃¦x¼ ›„mc¢“q+›œëFB?$ ›„Ûßn,ÏUtaâjnăip\CƯ’…³ø·üS†–s⇓hh&1qđ¿½Ï¡“ïùÍ’(•Pî@}‡a¾”đ¶ÏĐÎƯÆU°”’‘Ç2fd Û&a;ضM"ac;’MÛ÷DÏÙ† ä«o¯çØÉÓ,7âÂ|ZÚØ{đ;÷JjC#«6tó>ÿÇ÷Å4µFq’Æ+Tß₫Ù7…k’J‹Å’ ́ç“óßhf¶7ây;ö£³+¥öÁ¶L“»nZÊW₫̣“Œ¨(§áÙ7©ÿơ ¨Ü öˆr¼»xc£;P=8ÿ¹DàWP.»º́Đ;đvwL¯€…Ô54ñ¯ÿơ3¢±m¡¡p”H4F$K§Îw#+w‰Ä̃CÇÙsàXû|ßÍTIAí×Nă3«‰ÅÄLÅ0’à3oaªÅ1嵶DçÛ́¹p@°Ă¶?À WÀ ƒơ «»)V̉%̃î–½_̀Ơ ¯̃“IA~^IăF³jénZ¾ˆ±•Ci~âU~÷7Dꛈ/˜FtÙ\£†a6µ"â rư"¡»®'|ÇR¯­Çh _‚i4x:ŒC€®2€{&ƒđf¶™nmæ‚Úq§ÅR“‹×kQRT„1#Y8g*×̀›Á” UäRœyø÷TígÄF%üç’˜0Rû5+…²L”߇ú4y?–Ää*GăƯq‹÷:Ä^Eʺ¿À ƒŸGáÍlS×*yœJ%@€×ă¡¤(Ÿª‘LŸ<–9Ó&2eâ†BN0€@o·I¥Hœm ₫7/âHIøåħÇAH‰å±PAŸ^₫„£ø6́Fy,è†QïBEt¥té4¦>®½5›¸K„7³Í®áíXƯÖïơRZRÈØQ•LŸ<™SÇ3í(*†–’›LôT*\0½¿Â0–†̣z@É”s…°Œ¶vå¬#Ơˆ„ ¦p“ ô¢öM*^Nßb‡O]~xaà.d̃̀6;›$ní#m™7đxL‚?Å…ùŒ¨(gæÔñ̀6‘IăF1tH Á€?XÿÜÙ¥Tû?ÅùØó§À΃ø¶îĂS‰Úêh­Æÿîv¼ÛöCºozoN›“×jµ†`£'½pMÿ€—«-©{råĂ›541Ù@ê§Jw&ĐQ…ßç%/'HQa>CJ‹¨ZƈÊrFUeø°!”—ST˜ß¬lO­c;*ăJ:盦A$c×¾Ă<ù̉[¬ß°‘‡¼^߀SVDdé̀ºf|[÷ăÙw£©µ]ëêQ†qñVè´áÀ¯àÙÿà…A ÜAú^•₫¡Œv2_«̀ÿµÇ¨'ÿ§2>®̉~qƯFÛ½ŸÜ}kÇÄëñàóy üäæÈÏÍ¥¨ ’¢|JK RRDYi¥Å…æ‘Ÿ—KNÀ×ëIz‚‰ŒưÛ¬Àv¸fí&iOØTŸ©eƯ¦¼đúZ̃Û¼“úÆfCà͵øÛ–¹½ŒQׄ3|"%1eŒ^‹d”Ÿ”XÇÎà9t‚Ô…^Ä} ¼œ’¼§ë ’ ̣ú¼0pô¼*ƒ öß]¦2à‚l` F& ‰»ơ„LSçVơ3-Ë4±,eáñXx=^¯×ƒßçÁïóâ÷ûø}~‚¿{ ÈÉÉü ø ||>¼^…eÚ½4é@’̉̀®¶Gf́Àj­D9Y}–-;÷ñö{Ûظm7'«ÏO®g=†Ád[q]Lb)mr~gh ‰‰£°G Eưˆx£©³¶ê:̉‹D–ÏÇX½‘9gj)÷ jL0”rºW\’½sưz`àBàíh°I_ )à,Kk5¿Ï«5›ßO0à# đ“ô§^>‚~?¿¿ß«ñj¨aÔPººÀ¦ClFê§ »~ˆ”k§p£i2n@å₫—‚²ă5:Y¦Üç’ơ†¶C[(̀™Úz>Á¶Ưغs?ûŸ ®¡‰D"Y\MLˤÊVÜq¸.êPhYØåÅć# rQB`6¶³~"p;‰2My£7¦Đ Y”GëƯËưÓ§y0’à‡9‚¸¸0G‘K ïUĐßY²Ă›2ØJªÔï†!đX€¼œ …y”PV\HYi!¥Å…”PTGA~.¹9IÍ–®Ơ,3¥U;‡á‰N}ëđƒ èRo)Î…Y{B¹‹·¿‚tͬ“̣E¢qZÚÚ¨­oâdu ‡âÀá:z“§Ï̉ØÜB,Ơ®‘]çáâƈỊ́¨CINØ¢q4Í›‚=º™ŸƒˆÅ¡(F$JÎo_Æ>ÿ››‘ÅùÄfM đêz„”½b̀Rb´†ˆ,›GäÀ V½²c–ài÷ñ»Ôđ*uƠO¡ÛáƠkI…JË~èơZäåæPV\HåĐRFVeäđ¡ VÆĐ!%”å“Ÿ›C àĂëÑkA7Ä®²̀it§ô"X#é@”†V)¿mÇ‘$́ÑX‚p$Jk[ˆÆæVê©©màtMƠ5µœ®©çl]Í-´…"Äă6JÉ´•êwWç æ(VD%+#6C}>b §Ñ¸bvUÊăI|wƒí`´†ˆ-˜ÑÆ= ÑÆV†3¤ëtƯÅ,H‰ÑÂ<Û@øÆ…<Áûœä€i²Ó#Î[2írÀ{U&µK IÊÉ@ëñ˜äçåRQ^ÊØÑ•L;ñcF0²²œ!¥Eäçæàóz0L·êBçµ v ́{³IúÛ…SJ…mÛÄâ "‘­¡0-­!ZZihj¡¡±…úÆfê›iln¥©¹•æ–6ZÚB´…"D¢1bñ¶m·_»{䪵lZ¦IÀ]1s×Ç$+£’Ja`OKóª…ħEy­dn+©§ÊRáƯ}˜ǾIx7́"ºx̃u;ˆÍDγoâÛ¼‡Äø‘à̃¹A0ÚÂø¶î'6gm·/¡øá?p_Ôæ±sL¥/¼p•ܾ©“Ëj¯ i“Æ2sÊ8&EåĐṚórụ:á‚*SÖ̃® 6ưE:NÉGÅi …ilj¥¶¡‘3g8s¶Ógë©©m ¾¡‰ÆæVZÚB„ĂQ¢±8 ÛÆqœ”Ûc²ơÔƒÀ}íÓ²Ú#‰:ÆóB;¸¦RŒpàú˜diLRé(„Ç¢ơåD¯Ÿ‹̀ñƒTG¦œ6<‡Nj«æ6Œ¦VŒ†<û¢<&f]#"Ă:RMüæk¹AŒP¤w¦Ñ¡(¦Ó€gß1b‹¦>9w3Ío²Á“½péå„®€SZĐN;ŒcÁ́)©:²¹9ÁT<®J~Ö‘ưÔỖ)h%¡×éÑxœæ–6ÎÔ6pâT GNTsôÄiN&“¸ÓÚXË₫Ă'Øsà(ûçøÉ3ÔÖ7êơgB¯?µ¶̀T·sa¾Í]ô.ƠÇtW•„7W*¦'+b’Y E¾#IT¡m̃ŒÖ̃ªi đÆF́‘Ăˆ.̃¾Á&%¾µ;P=G°ÇTâÙ³7³̣Z˜gêSkVóL=ñYñî<ˆ=Ú̀BÀ BQ́ª ̣́b¦V×P῭Œ;}/\A§;Îûư^ÆŒªäº…3Y~ͦMCQa~ªLGz1hWú¼=”¤”4·„8r¢í»²eç>vï?ÊÉÓgii ‘HØ©ëpk u\êvÓÛ‡̃„7Ư0U,óâÜI E@im+…@´† ›Ẹ̀ù8CK¼´–ÜÇ_%øÔj́áC°‡ëæé:¼»cWUè©s}3FS p†–`mÔ‘G†¡µơÑÓDV̀Ç)/Áª®½8€…ÀhlÛÁQ®û1º‚DEe'Î0,-ÅN_Á WÀ.´BÀ̉bÏ›Æ-Ë1ÖdÊJtΪd€tßÛ₫¬{-®¦4MÛv¨©m`ûƒ¼»a·ïåđ±S4·´&SÓ&§Đ5KfçöÓϽ ¯»àê(®‰I–Gªl…¥@&=™r£5Dđùwđ½·ƒÄøQxöƠ©#çÉ7hưä]ÈÜ Ư‡1ZBXGª1ZĂx÷MN¯ØÖ‘Síư³¦ëøSÆh€{æ“l̀†f½•´j!¾ »ù9ÈÜ ~Ă$́ oá… °›½Á뱘<~$·¬X̀MË2nôp|>O»¦uœ~ ­{-®¦EA]c3›·ïăµw6²nÓN:C$C@J»vØ̀s¤Ÿ z ^™´7°ËbK#’ Ë‚’b́‚\l!0ZC˜ -zRw¤Yß‚Y·ŒöBb̃­û¼¶đ­Kđ>…E0£1íó́–H`;­an/.Œ°rMO¯ £}-Ưă/b ¦eáƯ~Ää*D8 ”Èôésïg'é®7à€Ø7è÷3gÆDî½ơz–]3‡¡¥Å HnôhƯkq÷E㉻÷ç¥ƠëxùÍớ?tB×₫MN‰-óÂ*Úg'ư|=k#­µ”aʪlÅÊ¨Ă’¨CYNøµi^0{ÄPđz-!¼ûá_½Ï‘êöfD*Ÿ©ÿ ÀËë°+‡ B nÚ́ö:œJŒP£-́î›ơô‹ĐÓùa%Ÿy#Ƴë0ÖéZ„ä(J\x;[đÏ% `¥>Ÿ—ë̀äÁ»o`É‚™äç&#^dªèvz”K”tpĂ‘(·íáñç̃à͵›©©mÄMß®e{'$đbáUIx ¥kĂ Q‡%‡¿ŸØ¢i4-›‹S^ŒÙĐoÛ~<c©Æ¬o×íñ|¹«“;çéƠ(ËêÄ,ï¥[¯{CŒ¦Vry+µÎöm?¶Xî4·á…0äå¨ZÊ=‡Øsà¹9 ó)/-¦¼¬˜̉ậrƒX–™̣"r‡©¯qN¯°‹ÅykÓN}âẼ~o+Í-mí9’3¶nú^m˜̉‘E£lÅQÉ̉ˆM‰é!6kÍËæ¡ü^|[öâÙs³¶#×­±}Ăø¼çr5±y¢,óü•Ü‹L&P>/ÊïCÄăˆh¼ÛçÍ́D̉èß ‡$’é|³Đå‡À†!¨khæç=—ºPŸ×C~nCË‹™P5‚™SÇ3sêxÆŒ¬$?O—́¼Đ’–½)®VUJ±m×~~ú›gyiơ{©<̉¦iö‹48™h(†9UQɰÉq£h^1§´ÿºøÖïÂhnÓ§p/¢Éá³H–MØç*I]¤̀ b,Ç©(Óa…'j°Nuëù—–¾K‘₫»RØ"efêá9.^PˆÂ ·´¹=¿Ê¾•ÎÑA©tæ‚<&Éu g²́9L7`À‡td§Ê —²®V­khâÑ'^ä‘ß?OuM¦¡ăhơçú¼zy‡¤byÔáæˆẮÊ2Â+æ“?߶ưøßܤK™\̀óB/N)”aàT”›=‰øôq˜­øßÚŒçđÉk̃n¡? ~8¿Ot—̀ÅĂ |€»·ª¼[交(Ÿ³¦p×M×±dá,J ó‘É”¦— äôm¡ơ[vó₫µw¤êơ§tég–€_)Äw‡l&&$”¾n6±ùS±NÖxi­6J¹Í_x¥DöÈ¡D—̀">gNqßæ½äứ= 0Œ4÷Ï̉.–Jñ½ àIOÂùz^¸">ÿ̃™m$¥Äï÷2sÊx̃×JnZ¶’ÂœK0µv§̀±xœÇ~•ïüø1ªÏj­ëÖvûƯàUiŸ—ÜvXuđæåY8Èơsñ—ÖáÛºO\­«H§”̉iu–Í#vÍ œâ|=Ơ'đnƯOÎ^×ÓæäĂDF̉ÁĂ½8©½³ÜúÁé ¹†ä́ä?ƒđïBî]x¯€)tæô¹;{g®o´ÇăãŒI<ôàí¬¼n.¿/µw|± »đ6·´ñíŸ<Æ#¿{h,¡uơçú̃tÏ)S)*Xu¸1lSđ™=‘ÈÈüüoo!đÖf픶o{±ßH>xƯ*Oé%<ÚRy,bs§¾íŹ‘Ă´ïv4çÈ)üooÁ»óÊçÅR„SV”̉Ê"a£|^ ²”ˆX£%„ÑĐ‚YׄÑØ‚ˆD/̀íR)Bđ¯¹đ^7 ;~·½ /ˆ đ…{­dÜOÎ ú¹yÙ">ûÑ{˜:qLÊ%³§+¥0 ƒ³ơMü¿ÿú_|auª½₫o:´¥(•0>!™“̀;”$¦%¼b>vẽ­û ¾¼ëdÖ>YºÄƠ¨nP£Z ÁQrŒ±Ư(ˆ¤Ö-)$|çR¢×̀Ly[yÔ±8vEö˜á8C‘¹¤c‡À¨oÂsàFs«†6AÄ°¶“+6ëÚgỨüć±º đ¥́úâàMoÇƠÈ#+‡̣ÙƯË·¯ 'àÇ‘̣‚!v5o]C_ùúĂ<ụ̂Û©­¡>…7Í(e%5í´„dV\2>îP‚U”Otú8"×̀À5 ÏáS_Xƒg÷„m÷xºÜQË$„ ̃€C¦`»G°Ó#đ(øRÈa¤Ư_Ÿ4đKQ?}G±ŸÓ$QUAbüHœ̣b”Ç̉&Ê2±ÎÔáƯv£¾¹}ÛG £œâ ̀ÚF<‡Oé©´qáSh¡g ÁßæAµ)èFa×Ô÷ÓÛđ€¸÷àMGJ|w̃tù'`Ôđa´íäÂÛÚâŸÿăGüîÙ×SÛ\} ¯k” (Å”„âúˆĂ¬˜C‰0y9$F#:c<ñicq†c©'đÊ:|ïíÄh‹ô|ºÜAˆ Aµû, ́KPk@T¥â¯Ú$ ăR‡‰q#±Ç ס„Mm$Æ'6*‰1•© F[ÿÛ[­a0 ’hYO`Ö7cV×b®Åh ë}b×£«‡~̉†R°Ÿ«gç_¤\xƯï~@í_*xAo;%l›ß=û:œäŸỵ̈,˜=5y¾sĆ₫=aÛ|ïgóÄsoô xƯú™ Å!›Jà/-">f8m“F“;Y˜§ư†£1‚/¾Kà˜g´!È4̉’™Ÿ¿Cîg̀Z›‚=–`Ÿ%8eê›^¦µY(Ÿ Kæ'áPæÙ̀†fbs&}ß*œÊ!(ÓĐ4–À:uëÈ)íck§ÇÁˆÄ0[1êt’;¾Å•¡÷–Sà^„£Î€Èy¿´×•đ¥ƒ·½]!`ó}üù—¿Å?}éÜvĂ5çuÍÔƠϼô6?ưíq”Âè+xÓ¦ËCÅ]‡•‡àÈa„nXHĂ”*œ¢|ŒH ߆]x·íÇhjCDc˜5ơ§Ư{Jœ§épÇ’ÓâcIX÷YpÂ4pÓë$?kĐ¾Çü‰°deLe„×Clîd¢×ÏÁ®̉¾&NZ½;’óÔ˜§juAÏL<¦1¸kƯôá½XăḍçiC/Äy>y©àMßÁ@_jxƯAÖ]'ªỊ̈ÿö}ZÛB¼ÿ®º„X)…í=pŒÿúÑo…"©́éí_.x¥ĐëÜkâĂcăvå>}öÈ¡ Ö©³ä₫ö%<;%+ˆöm•®‹©mœäY\ Îă¦`¿û=‚ăI`c©iªnĂTíº—*[Ă;?éꪄ@æ1"Q/¯ËQKh?iËl\¥RK©MLô¥û~ÂLÚÎq]xHR»Ë¡y;²i44µđ¯ÿơ¿ØÇî½)+ÄB¢Ñ8ßÿÅ>v*å™̃₫å€WoÁè@úûÂ7G$9É úè¢é8ĂJuö G’÷³gđ́?®8Ü;Z‰! À~²-ÁISĐ`@̀µ%ÿYî?·9J±4¦¸?"ak8#¹w+æé:mơ–2mßVdF0‰´‡\´ví®D…à¤q.ÿåƒú=À}¯+†aĐ̉âß¿û~Ÿ—ûo_‘±R Ë4Y½v3Ï¿₫nŸíóºÛB’‡B3bvP'ˆ‹O…uü 9½ GÊÈ\*´Æl!hÚÊzÄ̉À3¡ÆÔï'„V§X…AÚ̃­jo\_jÈ— Å-1Å̀¸Ạ̈zˆ—âT”a+Eç#ƒđXÚé"–Àh ë=Û³ ˜gơ¾m8Vẹ́ú´ M†àLV€/?¼Đ¯î[x]1 ƒ¦Ö6¾úŸST˜Ïª¥óqóƯ !hn ñ‹ß=G[(¢ó_f+̃…1ÉgZT(Al̀pbó§àÙw ëL²(ŸàßÆ»û0#Ăˆăj\8k 6z vY‚ĂI+qØh϶ájX³Ăµ¤ï-ËäOÈ‘Jf%$ £’qÂ' ‹gĐví,́Ê2T^e™™c’îÉ¡Âv‘(fC3æñ<Oà9rJ§Ô‰ÆÜ/#óç%TºÔhg[ÿå‡ú-ÀÙàƠï¥{ÂçÙâ¹8xƯăMCp¶®ưÖO6¤„i“Æâ8–i²fĂ6̃Û²³/|›“kÊ™qÉçZ”åÓrÓb3yë~¼»ă )&đæ&üëw¶¯oÓ—Éẹ́&¯ÁÏrL[íVb÷S'Ù*ơS¤®̀§ù†80ÂQŒµăÅp)ÈÉÍÁ©‚´Lœ=GEyħÀsä½G‰¬˜Ÿ²‘(…gÿ1|›÷j]ïµ¹dAñăˆÏ™„h c8ƒçđ)̀ÓuZ;'Ă /ÈÍ9¡û^è—gÂ+•¾U|B/àa¥ˆ(]º̉ Ƚ¯ûÚ4M9Á¿}÷ç|÷ÿû+J ˆÆâ<ơ›„ĂQ̀äẒrnI¡-¹i³))/¡ùăwŸ\…u¤œ§WkÇ…Óuªk³»»r›Ç໹&5IÇ„¬ù!Đ/Ÿ‚©eët±cJ[R¬Ào˜˜Jă`)¦éS÷`WU÷Èñ­ÛItÉĺáCôÔ₫É7ù9D¯‰ˆÛŸZU]‹]QoͶ̀)³(ËD¼È‚<œ’́a¥ØCK1›Z0ktÙÑd’¿^YA\hëºÂµ¨÷-¼Đïn_@¹%I†™ ,‹–E¹!đ ­ AIöÙï%l:Një&sPz̃ô½â7×n᧿~†¿ưüG8xô$ë6ïJå©ê 'Å1ÉDảvÛăF 6ÁW̃ìm̉û¸R¶’Ü8[7¹œRÔ‚ŸçÔ˜¢ƯZœÖswú́Qb©å(&%‘ I¡ǃ*̀#QYF¼ª’ÖR°üooÑY9ÎÔ‘˜< ƒøÔ±øßƯoưŃÊå:Ce$FđÙ·°G Ă:|ÀêˆXÏÁăí–ñ´X\á8ˆ¶FkëD¾6ËÔ~Ï–©:lqñ9±̉D h‚#ê÷%¼Đ¯n‡W¢đ(Xéơp§×K…i¤œƯ“£ÉpLf˜&7ü¼eh S‹§¼ăz^ĐZ^JÉ#¿Àu g±çÀQjë›È¾>¿ôđú”b~ÔA”•âó‡×‰.œ†gÿ1ƯßäbƯ).À]çÀqD›.Á)”B ÁÓ~ƒ=äøöµ¬äIÅpG1ÑVL‰KÆ$$¥¼–…*È#QQFlL%¡1•ØÇh§¯GDăºLèá“^^‡3¤£±߆Ư ¾÷´6ZC À:SÕÏƠ†ªxB?|bỶđtñZ8RçqN—^̉¾îx± Ö µpèkx¡ß”mŸ6ëé²Á''Œâî’Bhl!!ă‰ä )¦0M̀ ŸÊ¢|>^ZÄä†&₫cưNÇ]ˆ{^W Ă ¡±…¯ưÏ#؃”*Yà:[;—^÷Ư< •Â ú1ÚB^]YÓ +ùÅÈ‚\⓪°GĂ·a"™"&5u¶/û´^¥"aBB1-!™ ³AĂ@äIŒ.!>f8áq#°GEå§|‘æV<{j©5˜Ơµ:VÂÆ<]G₫ÿ<†ˆÆơtX¬ÓuøÖïÔ'ÅƠ¸©¡BÄ¥4^)=>;,½efrià=÷Fö6úÀ™k^¡à¾2>8c"¯§2r$2‘@%lưAÓ@†e¡'a3GÁ§ óù¯ÚzB©›¿wáuÅ0 6nÛ Đkđf~yƯ ô"Å:qVÇÆnÙ‹3¬T;ûå!"QrZ­Ư#7]M«!ø}Đ ,`´­—Lˆëu¬đăT¯F˸‘ØU8¥…`ˆp³¶ï#XÇÏhXÏ6b´†´ÖLVƒH›µkG×&%₫··‚™fïy²ÿˆ¢MvZíßÏÅĂë₫́9¼ư@gÂë(˜b™Ü¦¡]S_®á&7“R'³m”#Q i;8Ñ2g®m³Âëå™XŒ”‰ö‚Ä}}.¿çä°‹̀Aï8°— ^w«Æ ¤Â-xvÔư’ ëd-Ö©ÚÔ6LG§1#Åm‡ qI¡0EyÄG#2¦{h (0ZÚp†aV×â[·Ck׌æÖváXƯ²óLƯ%µ÷–À1›`Đ[đv!v¯Í̀6úàLx` Á ^/y¡áP$ûQ9ëêB°̉ëáD‚)µk̃%€W¿½²æí¼Ég‘D{2°µơwyÔ!ÇQâ9v:™̉Đ/¹ßæ$¤‹&$$S`äç›:œĐ„QÈâD[ëøi‚÷`m@Äă(ŸO'e·Ư™ô`€‹M\§è÷ƒ`‹Ú„Bt[)t”̃‡úl }Ÿ·ÔL·̀v¨Ư=½ä &ÍÓ™Îéªư=G)†ăM“µLn/ug@:l§Os /-¼Rèơé¸âæ°Íø¸$h™PO|| ²(‹£LÏÁ˜u8CA*̀ú¦̀Î*†Y˜G|́ṕa¥ˆh ƠµÍm©ujJcG’Ó_óüѯ$ư\=₫­6{’mú¼Đ'gƒW¿j £µQ¥¼”ø鳯‰bø|xJ ‰×ÔaưØ -X¹˜y¹$0s‚„ẃ£Ê0X ça©ÿĂ«Đđ–;„l–E¼ùyÄæVÑ:{öÈrD(‚oĂn mï[Eđ¹wÀ4±‡•xsf]# *àCå°ŸÆ»}¿¶+Ú׬=ƠªW˜¸Æ¾CvÓkơ#xᲜ^W‘TxÊK(\<«(ŸDC3mÛ÷;}–̉[®ÇÊÏ%ÑÔBäđ Ú¶í¡ô•˜9́Öñ:"ÛöPhçÉ”0@àEOu?Ó`?Hä†é4,ƒS^ŒU]KàƠơx7ïÁ¬m"²j!* 6*¾-ûÈùĂk˜­¶]I£W[„Ôt¸[5€¯>q£̃³ Mè ₫/\V€»†7C AäĐqʸ•Ö-»ÈŸ?ƒÚ'_&^Û€wH m»?g ¯¬!ẓ V^‘ăƠäNO˺­¨”×Îù¤ëAé̃@_ZxErÊü©6›¡cF̉xÿJ́ÑXGªÉ{ä9¼Û÷c4‡4” §´ß»Û2̣W¥[]n' Á…ôûjÀÚè鉭í̉Ă — àóĂ+€&©3₫™µœ~äIbgj í=BôT *çô¯&QÛ@h÷!‡!cqÎ<övs+mÛö̃we4ÈDªøVö9÷ œ /-¼ XW|®%ApÊ?p3FC ù?~Ï®Ăºä‡!ô4Ù¹ÀêMÚ Â­f`œ£_}½öT*Ơï̃ÈnyIºˆ¾¶[p¸ĐGƯå. ÀƯÓ¼8-% RQaÛ´lØB;q:5ÅkƯ´„ z¼:UmÛöè÷D àp2KC¶ˆ‘î JŸ¬’b(ؤÈ0i+-"çñ×đî9ŒˆÄÛÁM œ@H‰y¶1¹…“ư±å-tư ]ˆœ¿%‘姻,P†S9£N×PJ9nô#J;m¼í„à‚ÓÇ^xá’ÜÍis²› J±Ư¶©ôy–…H&æi¾°Â4´uZ)T̉ÏWI•´:w$#K?º3(} or»(¨´áJI…ÿíÍ[v7cđDÖî¸àè üF¡oJƒä?•ö:ÙCµoçfûçÂWà6ú<9¬@)*nó́æƯ¬NVïxƒơGxƯ)¥ q³â’¥Q‡é¶Ầ àư:Ƶ£“₫9FƯ7,;<‚7ü[<‚¦T T·SY*Û$8s8GéïˆU@±̉áNY!*Lj'°G #ºtÁÖôdæ’ˆÎđ®'sæqî‘O}íï^bx/‘î¼@*MÍS'Ï»n÷ư˜-mر8Êv̉<¯´”0M¬`Oq>k£1~T]C’a…ư^\RŒqK¢’k¢J J I”£¢1̀3ơàn  B¯B°É+xÎo°Ó#ˆ‘¦5»¾ÑÜ=Nă¼—Ø³M (’zy`+Cy<ˆXÿ[[H$J¬êÚ~đZξџá½Iízojđ„ .%>Îa‡»}^F™&¦h÷‚Ñ«-…²NGb¼z¦–g£1ZR1Áư^ ¯ *S»,ê07êPlYØ#†5 á9t³¡’†§sMµÖƠS̃SđÛ ÉjŸ ,:çŸûFë̃÷ÔóM¡s@[† VQª-Đ>/ñ)UøßÛI|ÖDưÀêk-¬ô´ù /8ç5^ơ-¼Đ«_<¼n;B€­àD‚ĂÜd@ÿPĂ ÔKÉÛaCÂæ˜ÔÙ û¼®jsmâER1'.Yq˜—>âÓªh;#Ƴó0fM=†T(¡“ ÇäJ ½JơJ¤T¦»=d Î5ÙîÑÆ 3£Û} ¯+¹ ¯G»y¢í‰ñ#ơ«¶»ªÏ¡“}°k¼ÚhéÔ9Ưsê;x¡×î x3ÁsPuṚb<ΫñÀ#´¥3¢1Ơ₫´¿Á«PH¡+#T:°8.¹.â0Ú–˜yDç¡eÜHŒ†f|wcV×"¤Ä‚Údœî:¯AÈĐ Úçdz’rG‡Ji˲ïy œ4Eû­ŸÁ+P¥B8Åùˆ„uê,öĐR¢‹gûÛ—°+‡`©ÇGûb¡´Ơüe/ÄÏ©}û¼ôN8aïĂë^ûTh#9%M~̉È’\¬;ƒr)áƠë[…OÁX[r}T²0ê0D*/!2g"‰Ñ•Ụ́µơ)p…؆Á{^ÁcA“ưöär§  S$ †;JC¬-†à¨©K–8BœĂq¥oáuÛJ…ÊÏ…y¦ÀskˆÏ€HØD¯™Iî¯_l/Hv™ÅƠ¾[=°ëœ[Gư^¸h |éàíÜùt¨»ßFWr®Aé ¼®a*O*¦'$Ë£3cy¦E¢ª’¶ùS±+Êđ>IÎSo`®KuÀ‚3¦à©€É«~ƒ6ĂƯ§Ơư0’Ưi0ơ†@yÚÏÚ¿írLú^÷h¿J,9¿ª# Z‘ñÉUÄgM đʺn{oPº̃Ñ‹^ˆv©}û¼©/'¼=k£«9ß t^•vT‰£X—,‹ÚLˆK¼~±™ăh^0Y˜‡w÷ạ}^{L%ƒ„$„ĐZ7Çäe P)[̉ûy”‹Ó îÜhÑØ‚²L¢×Í»ï(ÇQB¨®%>kNEÖ‰³—ƠM;¥}-ØÖ¥öíđ̉ó€₫«^WÛJ1ÂQ\•\uaKDA.Ñ…ăi7åµđñ‡oÓ̀†f}¬ôt÷”)øCĐä ¿‘´'­Îª§cÚơµô%¼ ƒ÷}B`¬%çÙ·Ư·‚Ẹ̀ù_X“ ́Wx·îס†Đu•.Ä®ö}̃§P:kß₫ /ôh }ơÂë‚ëU:̣²¨ĂˆC™YVDd₫b3' â üïíÔ•ÿ’Cî?C)âB°Ægđû ÁQ˵k‹ơ•/€m…V(üonB´…‰ÏHbä0<ǪÁĐ)pƯÄ{—ˈ•®}·Z¾é̃¸^1… øê„×7¨ÓâQ‡ÙQ›|Ă$1b(­‹¦“˜T…ÑÔBđ•÷đ́:„¦ü—¤jÓ°Ṃ̃© ÿ‚+^w™±"Óâ:¿p¤~Àí<¤k!¹á}dy x.«öíßđÂ|uÁ«̉₫$÷oWD¦Æ±‰U4_3ƒÄèa˜gñ¯̃ˆgß1GJ©4pµßqṬ̃<09a‰v#•pûwåÁë¾*w÷F%¾̉B9¬3ơˆhLo¹̉đºÚw“'›öíÿđB·¾zàM7L;…qɈÎCåñûˆÍOăµ3q†c®Åÿ̃.̀z¬5ơ͕ܾ#–.¿ë3ˆ'·{\­«ûweÂë₫6Ù†J[Y4È̉9˜gđn?@àÍM`ëJ"̃!‰ûeÚƯ÷ư£W¯»ëµÖ½q½ôđB·¾:àMwˆ£¸6æ°<â0:!1rƒDç§mñtd~.Vu-̃1Ú"xÀ:zZçC¤Ê—¸¯û ₫4©6E*ú'UùoOÇ`”£°<8’Ü_½@è}«ˆ-NàÍÍÄgO"6g"̃Ư‡1OÖb©ƒXâ’»TºÚw­G'l72₫̉ơ˜vo\/¼p^€¯$x³·‘î0G±4ê°,¢-Êä™3‰Ø¢i(ŸóäỲÚF„#ñ:‰gÏ‘”×JF¸Z÷€Çà± Éz¯̃*J=Ư¯x]1€b đmÜQßLtùÏị́®Ç´{ăzyá….¸đº?»‚7½¦m:¸•D–^8Øü©`;XÇΠ|da=Gđ­ß©£„„ÈH˜îÛïñü6h²É+p2´nf?® x•N‰;BÂh¤T(Ÿ{ø0M̀ÚFâÓÆi`­C考'0[z•ßvc¢nö¤ ?óë€ưÔ.À9Æ´{ăzùá…¬lx³ˆ~-“m”;ºªÁ¸E„O': "nă9pôăT”áÙ ÿ3obÖ4è>¤çœJ®u› ÁK~ƒg&uf{üm¶~\Mđ–KÅŸ†#$ĦTY¹€Ä¤Ñ(…QßDbÂ(ŒH#vY1ç §W’ȧƒë8kè±Ïùà¨9đá…N_đ*’eI¥âú˜Ăª°^ăª̉BB‹g?UÛ}™ 1¦ÏáS_xëÔÙöÆEûdËPº<çvÁƯæH!:„ñe^ËƠoT|&¤˜cCxéB÷®@äệ/@äÆÅ`D!´›é#£’ĤфîO›Լ À00ZÚđ́?,ÈEy=ø6ïÅ:qY˜O|r‰QĂđmÜu¦₫‚FK(…Sœ3¬ ï®C¼îƠđfN5¯ x¬+ ^•„×Té Åa›9Q_0@dá$"Ëç#sxwBDc$&ŒBD¢Ÿ{;ù^2ïrp]­[k ˜¼ä7héRëf^ËU/úwOî((Ê§í¾•8%ùˆdn%"ÇG‘A?Êë!ø̣:̀3ơÈüŒ¦V|›ö‚!Aê¸ ©ˆOK|Î$<û¡£EûÊW©d8ဇ79uiKn ;\±ÉóxˆÎ@ă ±‡•âƯ{Ïî&́±ĂÑƠ 6âƯ¼7å·Ü±§{SÚnÈ_Đd¿GĂmvÙÍ«^€›bđˆÄ‚¶• HŒ¡ËœºiRaDb^Z‹ÑÂSIäºÙX'Îàg+ÖéúT Ư”›å… \̉5Ơ©(#1f8”1®î,¦O¤mv=¦6®}¯`µW€đ¦­s‹¤dEÔáÖÍ0ñ £hZµˆÄ¤ÑX'jđ¿»§²ŒÄ¤Ñø̃Û‰ÿ½Ímàô^$µîiSđTĐä5ŸA›!Ús"Ÿgœ®&xpm\ññ°$à(⣇»v& ­kố;‚u¤ǿI˜§kñ¿½…àÙFœ²"đz’a„=°Lq$² ‡øø‘̀¯>Ë0?T›n&—+^PXé x“Ÿ–B§–™—ÜJ09®P¥´¬\@lÁTŒ¶¾»‘¹A“FáƯºÿ­˜ơͺcÉ­LpuđA\Ö&C₫[ÙÅu}-W ¼ £´f$Ÿ Ị½^¤ă»f&NQ>B)”›IEJœầÓuŸ} YœOtù|̀z|v%pqđ Rêô´Jo]U¼³…k’ß›$½®x¬‹»É:wærÀënŒMHîÛ\±ñçç¾a‘åóPA?Ö¡“:qøˆ¡xö#ç‰×°N' "i[B=HºA°OḶ̃©¼ÊçÖºW!¼ÉeË(GñÙd¨ÏOË=Ëñ8FlÖ„Œ1UB1³ªÏb4µ]<ïî#ÿđ:ÎĐâ“Çà ïÁh _è€u!đ8y¶Äب’B××ó‚ON·— xxuÖ@×ư˜ƒÎî¿*âp[(A™i7…Æ›¯Á]Qß„u´•ăǬk"çÙ·±ŸnïTà@$̣÷D2äïüZ7óZ®xÑK—<©ødX1^´̃¼˜Øµ3q†– K S'1Û0Ï6Ÿ8øLÀ.đÊ{8å%ÄLĂ»ó ưÇ3;u1"tuKÿ;[ ß½ŒØ„‘Œ~»á́µH¦+:×ơwï{9׸^.x¡‡ưÙ:sI5/ú†ñ(—{_ÈfrB"G¥ù¦ÅÄæNÓÔå5cqŒÆVooÆ:x²}ïñè̃µ\MđºPkb#?—đ-×"ƒ~*eEVB¯sDÂÆ:zà3oÑö‘[ñnÙ‡oăư mnĂh̉†Ä^<`Ö·àƯv€ø´±A?Ă¡̀†+^¸À€₫l¹”7äJppWȦAlú8n»Ä„‘(ËÔ¾Ëx}̃í‘XÖ-¡ô3Jïị̈ü.h²Ù+°;tïZ®Fx0ÔѶ"6¦{äPiơ‡“1Ñ ˆÆ@)|›vcNäÆE8C ¾´£¹-åàÑ«"HëH5±ÙQ^10Tr#é .  ?[g.Ơæ~zjBrÈfnÔÆ()¤ơÆ…D—̀F涃çĐIüolÄ·y/Fk8ë–PÆYÓÜ _<0©7²tïZ®FxƯOδ¡H Ú&ŒDy-½]ä₫]€Yׄuª8á8^Xƒ=j(f]“!™FÊ7º÷E`´…ôy’ß»{‰W ¼ĐÍ€₫l¹”đú”ⶰĂ=áÅ 2w á;®#QU ¬“5øßܬ÷r[Ï.ín›<‚ßMvw|Đ½k¹áÍQÅ1 yA“«2»ÚTߌú4NqAʧÜlh!ø̀[DV.ĐÚ7¸´…½M‰!bq"B Î›«v`Á ƯèÏÖ™K ¯¥†lî Ùy94ß¹”è’Y(¿O'[³MïåÖ6êö:́åv<»h_tƒ|ÍoĐzN7Èó_ËƠ /hăƠÔLN(b3FbWÉbAˆ¶ØN2T0yrCàƯ}{ô0"+|ju{ÀH¯‹Â))Àlj…hœZo2—÷yÇuàÀ ç èïØ™YđÎß·] ̀‰ëà Ă)©‹~Ơ7“ÿĂ'đ:¡?,º ¥O—ĂBđÏàAƒcƯrÈ8÷µ\Íđº³£›b€×Căâ(ŸGû,§…Z­a½% "Ơÿ››‰¬˜̀ÏÑ€ơ¶(†=jÖ‰âĂóỂ¼®tĐ®Î\*k³©‹b’`̉ÿØh ‘óØËxw"t÷2œ̉<Oti rÛqT{<OM6xÅl u}-W3¼(mTœ—€¹1ItÚSǤ|Ư“i/9…Ñ̉kßp4s …ÀE¾°æ®Á)̀Ă®B`íj 8lvuµ^è" ?[g.µ‡BOod{1,×éƯvÑ!6 r×aŒP䜵¦à¿ÉK£ƯHuácË ¼íí( W)î*‚>/M+æ·G ¹Á ¶ƒçÈ)ăGb´„4¬ÑXF[îY…í$_\‚é³T$&FÄâxŸa›GP'Èp£¼ĐñèđB–€₫l¹đÍ=¾›î‘Bá -Ä"½B€Ă'1B”×nù 2ÁÁ:ŸÁ““ƒ‘̉ê$÷$/LáMoS×ÅaV\]8‘ø´±™Ú‰æ©Zc†#ZCÔÛz妋E)”ßKl₫|[ö‰Dy;Wà…Ù°ÂsÁ¥…— n:ôgëLÏá½°è·;¼‚•Q‘¬Zà₫Qÿt³*Ñ₫,uSÛ́±OMÖ{ ¢"Yóü~ç¹–AxAĂ;T*îH¬‚>/{ص̃oƒ·GÓC - ?[g.¼î±Øâ58d &&Nzkië,÷§Ô˜‚&/ûƯ=]•4RơtPáÍè'ú!y{T1ÆĐu³t¬mG˳:!{4HØ¡2ƠÖèËů̉™/có§x{ ±æVË„3´ï•/tB÷¼ Ÿ’†.¹ù…VEPjí*:œÁT¡+ü=09liÓeá=O?ÎÛû´6%©N‘c('²l^¿ Pfæ¤ÔˆÆñ„₫ăÛ~@ª.唹CÇíј§ëlÜĂ«^ÁF Œ+^Hià̀ơj_Àë¾è8ÜRị`È!?iÔRhÀÉLOM¶z âªC̣ôAx{^…¯à(&Í+à”â9V=´̀´]U"E$l­…£q=}N†^r„Ó‚'‚«7qJ9<æ‡hJû^yđ™ưçî|§.ơ‴·#”^ ?09n¬Œ:Œ´ơôúŒ©Të|ÉœTª}Ëh̃ó÷ă¼½W™¿Hó…1Ilâh$¡©³º{ÄĐG D( £ºÑE—^H €§¦ˆ€GpØTIí{e ¶‘ú^Đ? …`£O°Í+ti $HU÷3Ṭ¸”ỹsơă¼½ÏhSk®R܃€ÇCÓyÈ‚\üooi:’*£ #F8Jÿ´í À‹×́a x̀«=zÛH\ÁđBq®_À›&½/́A‹!h6tÄáΧQi7Ư ¼çêÇy{ß^!’^q ˜—D'">¹ Ï₫cø6ïA–äǵn´†AIư³'%{(ÚжP<îƒßû’^|W8¼¬1ƯßàM‘ö•ÙÆÅ Ê ¼ÛTÉ=y…_)nˆ)|>/‘åóù9øWoÂ:v§¤0u B¯{ă mqV Ѻ4a‚]Œ¡ ,¿̣Á/}¤êU]ÉđBÚº?›­MWóÂ{₫~tL3o4‰`ª­˜WDgWŸ2ÏÁ“)‘yATN ư”B`¬F82éF©h÷¾âN™Mऩx$9m–"©•ºy dxö¼Đ^w@á=?º;¦éăªu¯H,ư>–ÍCåñ́=oíbs'£|ö3‹¤ñJ€hÓrFK¨Ăơơ¤ƒ5ø­˜ª}Í{•À I€¼ÓF¶~ỗ®û1ĐáE ¤€i6,ˆ)¢óÇŸ4Ï₫c¨\]Eå¡LSO•m ©+Z˜†\0 D(̃ĂïçÜ#æ‚<ë…ÄD¼Ư+^èv@ÿ æ=ßµ xx(¡ “ƯUääh\1ôăÛ´Ï®Ă(ËDæ%Ï₫cˆX"™]Cè$u"Ô»̃W.¼»-Å^XïĐÛDWúVѹ¤ưữ´‘­ƒđ¶CÇM 07®ˆ,œ„̀ÏÁsđ² Ï‘S(ÓÔ%B“Ÿ7BQí¬a;ºTh4ˆ%ÚË¢ô‚´o)÷Âo|Pkh7Ú+Ơ=̣B¤‹tPƒđvƠÆ• o©TÜQx rSio¯¼(=m6 mÀrÛq·î#±dê"ÓSê^pŸL‡÷1üÈu†ö¬ƒđZ×U=¹˜Ax»º₫î·ÑƠơgo÷̉À뾺5mExÑtœâ(ÊĂhj%øÜ!ẻ2‘_æù•JF¶YÛˆˆ%.d€»‘´G½œÔ¼1¡0”H»ô«^ Íîáíº+^T2Ï•­¸=*‘å%DV.À»ư¾ơ»up~S›₫¨i¢|̃—¤Q]2TØF(̉^_ù"Äíá!S ÂÛYbÀ3À°øsPï^•„÷Ü×rÅÀ‹̃7-F ƒđyÈâœ!E_Y‡ÑỒ êÆ,<̀&Ré(¤¶H»÷U/LŸµO¼â9/œ6’>̓đl> |xÑư6 ^ùˆû€/3{6 ~Aƒđf¾¾\đ*´Ó1˜“D§T½f&¾ơ;Q^±¹“ ¼±1•»J†!”2Ù-Ro#‰p´Ws\  Ú€÷<¯úª…÷8đcàgÀ)÷M«åàKä»ÍÀÿ¯Ÿ>Tv@.ü‚áÍ|}¹àEií;ÏVÜU$|×ơ˜5 X'kđn?Hô$ÆÀ»ó >Ö0tßx̉̉,@8B·&+ ö’ñÊv™P+¸Ú VÍÀïÿ¶»oÚƠïiè–ƒ/Órđe÷×ăÀÿîZáíêú»ßFWן½ƯKï0Gññ*¯˜¯µk$†u¢³º–àsï€@¯{]'"Đ ơ…["B̀3ui₫Ç'®åy«¥§Ñí¦¶îÇox xøe H‰ÍV0晆̀'í¤Ê‚H ·At]\®'bÇ 8i&óz_¹đv¤zˆƯ7}¼.XZ½â¾Œ÷́̃€\̀  ›̃fæ¸vƯ†û—ù È“È53IL…oằúf“Ç|îḿÑĂPæÙÆTåGWÜ-#å±tXü’̀(wX:̉è …÷,đMàôÖP=toºœMz0hˆÓ@> |«c§²ÈÅ Ê ¼émfëùÛđ)Åx[ÏK|Æ8TÀGøækđ́?†ÑÜJbêXüooEư(ËÊ<茓á(X–.\齨#w"B±ƯTç¼ oº²û;’Ê®§àº̉c€]ẹ́^à/IN ”"–9 3(ƒđ¦·™9®ƯkĂ« @‚ôy1Ï6’ûØˈxœĐƯËñnÙ‡G‰Ouè8N§ă…£Ö)ÓĐèP´×¶H^ÁésVđ*`-đqÚ—›ÎÅ‚ëÊÉJÈ6í óO)¥6ÂÛ³6ºjS¿îÙ¦ ™À»y/ß|Ïá“ÄæMÁ·q7"ÇR¬SƦw\m}niÓ¹®„Àhë¶ư²[ưÀ^2¼¯ºº₫ï!´¶½ø† _çKz `W̉´q(×4₫PÇáí;xéÁß {x9¡ûV`„¢ä<ù¾íP¦‰wÇÀÚǼÍ*¥÷…Ùî>Ù âz_m³T÷UW×ßïám¾‡^R&·\/~ºœMz`H×Æ!¨ñUîæts÷[„7½Mưºgđ\‡Q¶"1¬!%* ²l.J̀zU¤Tj«(›- 2àÇhjɼ¬‹4dx_uuưữđ,đđE`\p]¹$»̉vøÚ¿˜”{ØûĐîaç‰ú„7½Mưº7Z̉1b‚­x ª°‚Â7_ƒSV„wÇAD<=jX{{™Ô™"Fc+"n#‹̣1«ë²®•{"hĐhd^Ù‚wđàCÀëè¥ä%×ëâ›8¿hˆ!ẁ àeà=´¡ë ÀŒÎG¸đºƒ:o×¼̣”âCQê@Û’YħŒÁÿæ&dŸÀÚíZ¢Á£%„Ep†•êÀyÁ_L—#]¬ LB‹ &TÎú5¼ÇŸ £øRa~—\Ẁ‹o¢ûo<Œ·h è©Æày Œ̣ô§:ÂÛĐ:Ê ¼ég¿+·G$ö¨a´}đfdA5Û¬̃„HăĐ­AJ›5YV„Ăîä^pïX¢ƒJP¬àˆ ád›¥=„t/82©«qíx[€_¡§Ê¿ZAƒ+[OôÊxtG.+À !N¹m±^ @¼ƒđ¦¿îá¦tÈàT[ñ'!EĐç£ơ7aWU`Ö7ă )·efS›.TÖƯA–{ü“«đk˜&¾msÑZXàB¬Ès#0åơ3Ñô°0®X• Q‚ÍBW!Ô wÓ×;đî₫%ùo'Ú—ù²M—³IŸ́JÄ6°ÔAœR*!(ë~Kƒđ¦ŸƠPbpcTbWỦö¡[Q¦çđ)ăGX½ óL=öè ¬ÓuƯ‡P)TŸǾI8¥E-xÖ»ˆzz®Lƒø„QD®A|́pB·-!>s"ù–‡µ-\Ûf3F â„HE,‰n}W=ÓÓhmû7hí›̣[î ­›.}0tÔÆ"¬B2£×Ç9çnãôÓJ¡˜cç _0@Û‡nÁQYׄwç!|;[0 ï̃#xœ@HuZT¡„AbÆxüëv`O‰bmĐî!ÄB)d^ص³pF”ă9| gD9‰ñ£0$=+_IDAT‰ÍHtÁT ›ñg›¹6́0Y ”ÔÚ3È oÎæ‹èp¿&èàº̉/v%̃x„DÓW#7¢Ÿvk€|` àé|Ô ¼é"…¢LŸ‡#• tË5D—ÎA´E>¿{x9FC w¶3³±£%¤­Đçí¨î’pâ³&âƯ}ˆÀ››‰ÏBh¸pˆ•Î9íTÁ<Û€wûAc*Á²đ¿µ Mà”ëÆ„Cdñt,a0ª¶™Å‡é@P›²J«”tácêï‹öñ?ư \WúÀ®$R +àđ° `¯’Ô·sïv”+^…ÂRđá(,*bÓÇzß*”σçèiT^ÿÛ[°'ŒB$l|ëw鬒¶s^#–Û£¨Ëv°«*±G Ăÿæf¬#ƠºH¬ÛÖ́l'0[1›Zu4Tc F8‚3´#%đÆF¼»‘˜0 {üHâs&?+¥²¾…1ÉtÇÀFpÆ€X²ÇâÂÇtđÿ¡ë7s™ös{*ư`W̉´qÊç@-0Tqû'³9^×Yåbá•À̉|4,1J‹hưØmȲ"̀ú¬ÓuxwÄ®ªÀÿî6ăG‚ëtƯ¹7’=26Ïxaj\bäå]6ÏÑj¬ê³á‹€W$A”a`$lª6Àsđ#Ơ¡2?«¦ï₫c8Cp*JILE|́p¬–m,Œ+Æ(A€Z¡É1íÆü¢ø:ç̉ü–û›ÖM—~ 0dhcĐk’wWĐ÷Ơ8P>m¾XxQ %`”_+J-mÜ@lö$¬ăgđ8w×a<‡N`Ö4à -Á·q‰q# [û4w1XÚ M†â¿°Í×' WAtñ œ̣b<ûaD¢·”|ˆ¸áæÛ’J§³£¥ £9Ï̃£xwB–èô·SÇb—ái SƠbQ œ1-‚´í§N=Œ¢ê¿„vƨƒ₫®+ư`W:€\êà=EÀh¥Ú½Êºo»§W—Ÿ́çÓfmT‚ ‚φ3^:‡đmK0›[1kñî<„ÊËÁsà8fm#FC«N{¦^§Éé"£¤¶ CB(~æ‡×½‚Ù¶`DLg̣đ8®-Ù5 Ѹ>°7;ÜYA‡ˆ(¡"Å)/&1i4"×ûÙgê‰ÏŸBôºÙØ%…ä4µ1½1Äü¸"A«€$Ü:¥%´Gà?_GG©®+`W4Äc$ˆ£èơñ`$Pqáđă“—^•ÖîEÀ›|uo îŒ(ăG̉öá[ÁZûî>¦‰çÀqdqf}³^¯’̀°‘̀gƠ)€R5yŸơÁc>½·œP¨ó¢¾Í{1ë›…y-mÚ³c„³00ZCxwÁª®C–àTÁˆ%0ZQ¹DMĂ®(£¨5Ấ¦K¢’é`´2ÈWâp½Áׂ֑ôËï¯ëÜsE_wàb$§j€›á±xH>†9‹\Yđ‚6—.HÀ߶)̣̣siúÓ°Ç G´†ñ¯ƯYߌÑÔú´Î™°Ư<¥¡`­çÿoḯƒ£(ï8₫yv÷.{— ‰¼̣bAE¬â¨£EÑú6ÅiƠª­VúZ_ªNu:¶Óv¦ÚvÆßµTí´3ÚÑÚÚÖQë€ÅQP)!€!Á—KîeŸ_ÿxv/g árI.ÙïLvoïÙg7ù̀ïyù½Æ̀Ú…VÂx­¸¿&‰…AiA,Ó`¿œ7„Ç1eO#̃¨J²Ơ‡‘™>‰̀Œ)ˆE¥38[j)[¿…²Í;¾ŒÔÖ½`iyô´™Íë¦Tj)‚¨¤T>å¬ü4­³[1!]•W 1x}WÉ p_ Læé{ç’=,EtơgH"»xÎöƯf¯7UØ7X´Úl Äa›-ؾ¯£˜'à”â–vpcÁségûñOÊ¿§X́” xăF™E°öxotmç‚7æ4~ÓÙ¹ç¡̣¿¿½Ôùp}¶^ÁåMËú¯¯ERÉ ¡»RÇüx ˜àé70á]‡‡ƒøÏ9DàŸƵpSœ˜ÚN›Mr₫™8µuD7nC¥28µuXíiœÚ:”§ hÀk 4XÂÂ8¬wLAí\´¡ÿo Giϵ€¶û\¹û™0ÇHÍ."[w‚¼ĂÇ!#X_6„ư¹®(¿ß̃]¿¡lƠF}NÍ¿x)ơyÿöµX¯` ;Đ×O>+ÿ° äRLùÔYC^̀PợvÅUIwÄD~|Øu D×nAµ¶]¿‰¹Ø;¾0 Ùë“Pưñ¼5Û/_û–˜í™r+R‹RP. MGPB¿+x¹"fX­Ôv•É,²Zư/»zGâo‹¸́²o Dï¦!p ¯‚¬«A]Éc=¾«ë‹ ooÛèÜ´ßL+îjƠÄ++h¼ùRô¨J¬†}¸ï­ÁSEÙơ8Û ¸fˆÛưmxE /–ÁóeAa1Ơe?đ¯µÅD]œR̀ôÀơ= „ƒ¹ ‘—…g¶,[½¤b®(æµ”₫p¹+ Y€Å'ÏËÖ9˜$‰àƒR±¼Ó<Å}-ÂDË¡ésI< •l'₫úrT[ÈæíHÔÁ©ƯSøœTLÏG……1hQ~Qíưô#x–À¤B³²pFF1; £œ|˜ƒß@ñ$S\€)›˜×üߢ̃t 5䔲 œ‡Ù¸?]Ĭ vË Æ̣¢÷$…9ih=k-WOtí¢k6¡ÆỦjjEyºăv.Z­v„ßÇá Å™¼äˆ(Æk8& G{j c5Œ(cÏu^k}d¥×a¢…₫ñ¡†>¼0Œ†¯@ 0JLÙÔ[D˜Q đFEqC\Ô¦IÍœBÓßE¬Äji¥âéWˆnØf|›Si$Abe¨Ö¶n·vxklá·qØ”·âÜ›÷!"9@mQÄ€Q&h˜ªáêÑÚ̀›mÿÚ .Õ <‡qÜœàVÊYk¦)ÅÍÀUÀ˜Á¯ˆ (æ§àúVuèHn¹”́„C‰l؆ûÎ*¢ŸlÆJ¶ăAfz5™é“pv7à.Y¹ß¬`Ź̃2{½+"fجöÓB]NƒKÅŸ6H^+1Öø0 SµâHÏ@=Ǹªv0́>Đ­À«ÀĂÀạ̀án a p Xud8ä'À·1é},đz(ă¬Ñ*Tº.Í—œ®Jà.ưÈX]K‘9b"éÙG≽«èª D¶îôk÷̣5€x÷YÂ#.¼Ưåsïàí.]₫œX0À&0Ắib†Ó=3 Oø:7ä6 Ưïb湯cÊ• Kp k€u€,qàB;@Bï§(ơŸü†³(¦xp_+LÍ ™±#Ñ#ʱwîAª$uüQd™(EtífÊ>Ü€½«̃̀-Ơ­åmV“1x3ê‡̃uÑBeÿđ¸àiH ñ̀•íéZ1A³ÉA= ¬¯¾?œá…àœ Ä¹?¸±ÀƠÀM˜DûU±àƠ"ÄEqd®nf¥m[è1‡1™ô 3ȃưEîûkͺ±Ù4ÓMx`o‹Áëéºàíî h ,4ơƠ?ß”²8ѳ6× wp…wR¬ú̀üĂ™˜dô—#;_[,x]-̀K+ÎJ Gd„xyŒÔ´I¤æ̀$sô°-"ŸnÅ]¾†Èæí¨¶”±¶pÀ¸̃Ạ̀>ƒ×#f/÷«ø¼ÚlGä5Q<ä¹ÙåÏ6”y“µ Áí¤àư(d˜‹É‹t…âÁá6Åü6“ˆ“<ùXÚO=ΤÂil¦låzÜÖa×Ö™(–*h¯7€·É·¼o^xø@„‡•âUV²;ßëÅ{ú >€̣@®ÀT™»C„ oáă¤qZFñ³Á©ª ùû>n:NÍ.Ü÷>!ºzö̃}Ä褑ïS¹9/ƒ̃­ÀÓ"<́œ_J9Z¨Ø .@†ƠD¸äz`’9ƠÓ9^‡₫7E%»“¹Y‹æ‹Î ;aŒ&o܆ỞæCK"~̣W›Ÿtá­\°êF"¼<ªë‚]¯́Îw{̉Æ°Tp€)½ ÑË |,Ë"ƒ̃U÷Ç—&‘ĐâöF!À½”{øù‡U˜²©·Çv¾6pZ¸!)\ª¢¤ Év́Æf¬†}ԋDzˆqb8:k,ơÁübx÷ø‰è–GúÇI£À^ïù?¹äS™Ú̃̃(ø Ơ äɘ±×‡åàW%5WE´œw*º*Êd‰ÿûœº½(eåUáë½ßæƯ–‰*z¿hđöØ̣6c¬íBàă ܃Sp)d ¶x0_ Ü¤4.HÁí­‚ˆmCÄ69ª¼Û¢Ạ̀ÖYÂC1ø`pÀ›–̉æ—‚ܾRp+d8?&rçœ §”Á•Æê.^z¥¢Q{-aÀ$£ë x¿êªGđ®^Àó Áí[…AùĂêk“2z~+ăJƯâÅÊ’öTŸYÜβ^-ÆúfÁê b¤wÏcÂü¶'Cxû^C"©Ư`Sv_ Ù}5Ø•“96K2!¼_1₫Đ7ÚO:&ëlÿbÊzåÅXK£°ÆÁ$¢Ë©ßàMbæ¹wö‚·”’¥—’B€‹(o_ %k¸+R ̃+¶ư–³sÏr•(5•n¶z#lr`•c bưoæw/đ ° Üâ+B÷£̃zÖF”©w|!f¡ëdúè÷` ¼~*Ø÷ ¼ŸA˜ßàd8\î…÷³–T̀Í?ü¸˜r°m+Ïmá§åÆĂÊ}Rxë¿`àƯœ Áí_…:| a‹‡ôºQ?Î÷̃l´ưl}}o;&Æ̀°ÙƒÜRđ+ä&lñNàü°ÅIL%Á_Ç…÷"‚s€ q=„W0ù§Æä£jÜVđ QÈ#€ï`̣W£§í(– O¹BJí¿°uáƯ†ÙzØ|Â;đ Dê4¬\üˆ\ØbÈ*a‘+¼TÖui”ÀÛ¼< ¬ > Á< „ệñ˜ ‰K0Ö¹[¾Đ«áåB²“.̃4¨·0óÜ¥øơsCpŸB€±̣@a‹‚cuó=4*á„đ™-9§á]*æœ áœ .å\\Ö äÖ‹YA*VEGÈbđÿ,°ÈÖùåA €wÈ@ư‘0̀¯d\" „bL®Ö\?ÍăZW8̀Á„@?JŒ#Çă®đ©ă×9b¿đ6/ƒ<êăàdni(¸Ä´$1—ûăÂê"jeyvΗ–ܾÅæâvHt”»† r…zܼY` đˆ_ÍO…à–˜B€KTE₫U\»ŸÙœ×¢¸SĂéø₫í剮,/kA%WÍÏ ¾CxKO!À%¬%syÄƠ¬s`£-£"˜j‹ÀŒ ˜P'xwÏÏ€l3§„Lm˜¶µT<xz₫á4n~ Â8̃fà˜t6+ÉÍsß讇:H…! k œ¡¿F÷¯àWó Á:ú?l U7Åâ‘tEXtSoftwareAdobe ImageReadyqÉe<IEND®B`‚httr2/man/figures/lifecycle-archived.svg0000644000176200001440000000243014556444037020012 0ustar liggesusers lifecycle: archived lifecycle archived httr2/man/figures/lifecycle-defunct.svg0000644000176200001440000000242414556444037017660 0ustar liggesusers lifecycle: defunct lifecycle defunct httr2/man/figures/lifecycle-soft-deprecated.svg0000644000176200001440000000246614556444037021307 0ustar liggesusers lifecycle: soft-deprecated lifecycle soft-deprecated httr2/man/figures/lifecycle-maturing.svg0000644000176200001440000000243014556444037020053 0ustar liggesusers lifecycle: maturing lifecycle maturing httr2/man/req_url.Rd0000644000176200001440000000630514737312513014042 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/req-url.R \name{req_url} \alias{req_url} \alias{req_url_relative} \alias{req_url_query} \alias{req_url_path} \alias{req_url_path_append} \title{Modify request URL} \usage{ req_url(req, url) req_url_relative(req, url) req_url_query( .req, ..., .multi = c("error", "comma", "pipe", "explode"), .space = c("percent", "form") ) req_url_path(req, ...) req_url_path_append(req, ...) } \arguments{ \item{req, .req}{A httr2 \link{request} object.} \item{url}{A new URL; either an absolute URL for \code{req_url()} or a relative URL for \code{req_url_relative()}.} \item{...}{For \code{req_url_query()}: <\code{\link[rlang:dyn-dots]{dynamic-dots}}> Name-value pairs that define query parameters. Each value must be either an atomic vector or \code{NULL} (which removes the corresponding parameters). If you want to opt out of escaping, wrap strings in \code{I()}. For \code{req_url_path()} and \code{req_url_path_append()}: A sequence of path components that will be combined with \code{/}.} \item{.multi}{Controls what happens when a value is a vector: \itemize{ \item \code{"error"}, the default, throws an error. \item \code{"comma"}, separates values with a \verb{,}, e.g. \verb{?x=1,2}. \item \code{"pipe"}, separates values with a \code{|}, e.g. \code{?x=1|2}. \item \code{"explode"}, turns each element into its own parameter, e.g. \code{?x=1&x=2} } If none of these options work for your needs, you can instead supply a function that takes a character vector of argument values and returns a a single string.} \item{.space}{How should spaces in query params be escaped? The default, "percent", uses standard percent encoding (i.e. \verb{\%20}), but you can opt-in to "form" encoding, which uses \code{+} instead.} } \value{ A modified HTTP \link{request}. } \description{ \itemize{ \item \code{req_url()} replaces the entire URL. \item \code{req_url_relative()} navigates to a relative URL. \item \code{req_url_query()} modifies individual query components. \item \code{req_url_path()} modifies just the path. \item \code{req_url_path_append()} adds to the path. } } \examples{ # Change complete url req <- request("http://example.com") req |> req_url("http://google.com") # Use a relative url req <- request("http://example.com/a/b/c") req |> req_url_relative("..") req |> req_url_relative("/d/e/f") # Change url components req |> req_url_path_append("a") |> req_url_path_append("b") |> req_url_path_append("search.html") |> req_url_query(q = "the cool ice") # Modify individual query parameters req <- request("http://example.com?a=1&b=2") req |> req_url_query(a = 10) req |> req_url_query(a = NULL) req |> req_url_query(c = 3) # Use .multi to control what happens with vector parameters: req |> req_url_query(id = 100:105, .multi = "comma") req |> req_url_query(id = 100:105, .multi = "explode") # If you have query parameters in a list, use !!! params <- list(a = "1", b = "2") req |> req_url_query(!!!params, c = "3") } \seealso{ \itemize{ \item To modify a URL without creating a request, see \code{\link[=url_modify]{url_modify()}} and friends. \item To use a template like \code{GET /user/{user}}, see \code{\link[=req_template]{req_template()}}. } } httr2/man/req_auth_aws_v4.Rd0000644000176200001440000000307314706235753015471 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/req-auth-aws.R \name{req_auth_aws_v4} \alias{req_auth_aws_v4} \title{Sign a request with the AWS SigV4 signing protocol} \usage{ req_auth_aws_v4( req, aws_access_key_id, aws_secret_access_key, aws_session_token = NULL, aws_service = NULL, aws_region = NULL ) } \arguments{ \item{req}{A httr2 \link{request} object.} \item{aws_access_key_id, aws_secret_access_key}{AWS key and secret.} \item{aws_session_token}{AWS session token, if required.} \item{aws_service, aws_region}{The AWS service and region to use for the request. If not supplied, will be automatically parsed from the URL hostname.} } \description{ This is a custom auth protocol implemented by AWS. } \examples{ \dontshow{if (httr2:::has_paws_credentials()) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} creds <- paws.common::locate_credentials() model_id <- "anthropic.claude-3-5-sonnet-20240620-v1:0" req <- request("https://bedrock-runtime.us-east-1.amazonaws.com") # https://docs.aws.amazon.com/bedrock/latest/APIReference/API_runtime_Converse.html req <- req_url_path_append(req, "model", model_id, "converse") req <- req_body_json(req, list( messages = list(list( role = "user", content = list(list(text = "What's your name?")) )) )) 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 ) resp <- req_perform_connection(req) str(resp_body_json(resp)) \dontshow{\}) # examplesIf} } httr2/man/resp_status.Rd0000644000176200001440000000441714666312277014757 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/resp-status.R \name{resp_status} \alias{resp_status} \alias{resp_status_desc} \alias{resp_is_error} \alias{resp_check_status} \title{Extract HTTP status from response} \usage{ resp_status(resp) resp_status_desc(resp) resp_is_error(resp) resp_check_status(resp, info = NULL, error_call = caller_env()) } \arguments{ \item{resp}{A httr2 \link{response} object, created by \code{\link[=req_perform]{req_perform()}}.} \item{info}{A character vector of additional information to include in the error message. Passed to \code{\link[rlang:abort]{rlang::abort()}}.} \item{error_call}{The execution environment of a currently running function, e.g. \code{caller_env()}. The function will be mentioned in error messages as the source of the error. See the \code{call} argument of \code{\link[rlang:abort]{abort()}} for more information.} } \value{ \itemize{ \item \code{resp_status()} returns a scalar integer \item \code{resp_status_desc()} returns a string \item \code{resp_is_error()} returns \code{TRUE} or \code{FALSE} \item \code{resp_check_status()} invisibly returns the response if it's ok; otherwise it throws an error with class \verb{httr2_http_\{status\}}. } } \description{ \itemize{ \item \code{resp_status()} retrieves the numeric HTTP status code \item \code{resp_status_desc()} retrieves the brief textual description. \item \code{resp_is_error()} returns \code{TRUE} if the status code represents an error (i.e. a 4xx or 5xx status). \item \code{resp_check_status()} turns HTTPs errors into R errors. } These functions are mostly for internal use because in most cases you will only ever see a 200 response: \itemize{ \item 1xx are handled internally by curl. \item 3xx redirects are automatically followed. You will only see them if you have deliberately suppressed redirects with \code{req |> req_options(followlocation = FALSE)}. \item 4xx client and 5xx server errors are automatically turned into R errors. You can stop them from being turned into R errors with \code{\link[=req_error]{req_error()}}, e.g. \code{req |> req_error(is_error = ~ FALSE)}. } } \examples{ # An HTTP status code you're unlikely to see in the wild: resp <- response(418) resp |> resp_is_error() resp |> resp_status() resp |> resp_status_desc() } httr2/man/request.Rd0000644000176200001440000000212014666312277014060 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/req.R \name{request} \alias{request} \title{Create a new HTTP request} \usage{ request(base_url) } \arguments{ \item{base_url}{Base URL for request.} } \value{ An HTTP request: an S3 list with class \code{httr2_request}. } \description{ There are three steps needed to perform a HTTP request with httr2: \enumerate{ \item Create a request object with \code{request(url)} (this function). \item Define its behaviour with \code{req_} functions, e.g.: \itemize{ \item \code{\link[=req_headers]{req_headers()}} to set header values. \item \code{\link[=req_url_path]{req_url_path()}} and friends to modify the url. \item \code{\link[=req_body_json]{req_body_json()}} and friends to add a body. \item \code{\link[=req_auth_basic]{req_auth_basic()}} to perform basic HTTP authentication. \item \code{\link[=req_oauth_auth_code]{req_oauth_auth_code()}} to use the OAuth auth code flow. } \item Perform the request and fetch the response with \code{\link[=req_perform]{req_perform()}}. } } \examples{ request("http://r-project.org") } httr2/man/req_perform_connection.Rd0000644000176200001440000000454314746456350017143 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/req-perform-connection.R \name{req_perform_connection} \alias{req_perform_connection} \title{Perform a request and return a streaming connection} \usage{ req_perform_connection(req, blocking = TRUE, verbosity = NULL) } \arguments{ \item{req}{A httr2 \link{request} object.} \item{blocking}{When retrieving data, should the connection block and wait for the desired information or immediately return what it has (possibly nothing)?} \item{verbosity}{How much information to print? This is a wrapper around \code{\link[=req_verbose]{req_verbose()}} that uses an integer to control verbosity: \itemize{ \item \code{0}: no output \item \code{1}: show headers \item \code{2}: show headers and bodies as they're streamed \item \code{3}: show headers, bodies, curl status messages, raw SSEs, and stream buffer management } Use \code{\link[=with_verbosity]{with_verbosity()}} to control the verbosity of requests that you can't affect directly.} } \description{ Use \code{req_perform_connection()} to perform a request if you want to stream the response body. A response returned by \code{req_perform_connection()} includes a connection as the body. You can then use \code{\link[=resp_stream_raw]{resp_stream_raw()}}, \code{\link[=resp_stream_lines]{resp_stream_lines()}}, or \code{\link[=resp_stream_sse]{resp_stream_sse()}} to retrieve data a chunk at a time. Always finish up by closing the connection by calling \code{close(response)}. This is an alternative interface to \code{\link[=req_perform_stream]{req_perform_stream()}} that returns a \link[base:connections]{connection} that you can use to pull the data, rather than providing callbacks that the data is pushed to. This is useful if you want to do other work in between handling inputs from the stream. } \examples{ req <- request(example_url()) |> req_url_path("/stream-bytes/32768") resp <- req_perform_connection(req) length(resp_stream_raw(resp, kb = 16)) length(resp_stream_raw(resp, kb = 16)) # When the stream has no more data, you'll get an empty result: length(resp_stream_raw(resp, kb = 16)) # Always close the response when you're done close(resp) # You can loop until complete with resp_stream_is_complete() resp <- req_perform_connection(req) while (!resp_stream_is_complete(resp)) { print(length(resp_stream_raw(resp, kb = 12))) } close(resp) } httr2/man/req_perform_stream.Rd0000644000176200001440000000444014737312513016263 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/req-perform-stream.R \name{req_perform_stream} \alias{req_perform_stream} \alias{req_stream} \title{Perform a request and handle data as it streams back} \usage{ req_perform_stream( req, callback, timeout_sec = Inf, buffer_kb = 64, round = c("byte", "line") ) } \arguments{ \item{req}{A httr2 \link{request} object.} \item{callback}{A single argument callback function. It will be called repeatedly with a raw vector whenever there is at least \code{buffer_kb} worth of data to process. It must return \code{TRUE} to continue streaming.} \item{timeout_sec}{Number of seconds to process stream for.} \item{buffer_kb}{Buffer size, in kilobytes.} \item{round}{How should the raw vector sent to \code{callback} be rounded? Choose \code{"byte"}, \code{"line"}, or supply your own function that takes a raw vector of \code{bytes} and returns the locations of possible cut points (or \code{integer()} if there are none).} } \value{ An HTTP \link{response}. The body will be empty if the request was successful (since the \code{callback} function will have handled it). The body will contain the HTTP response body if the request was unsuccessful. } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#superseded}{\figure{lifecycle-superseded.svg}{options: alt='[Superseded]'}}}{\strong{[Superseded]}} We now recommend \code{\link[=req_perform_connection]{req_perform_connection()}} since it has a considerably more flexible interface. Unless I hear compelling reasons otherwise, I'm likely to deprecate \code{req_perform_stream()} in a future release. After preparing a request, call \code{req_perform_stream()} to perform the request and handle the result with a streaming callback. This is useful for streaming HTTP APIs where potentially the stream never ends. The \code{callback} will only be called if the result is successful. If you need to stream an error response, you can use \code{\link[=req_error]{req_error()}} to suppress error handling so that the body is streamed to you. } \examples{ show_bytes <- function(x) { cat("Got ", length(x), " bytes\n", sep = "") TRUE } resp <- request(example_url()) |> req_url_path("/stream-bytes/100000") |> req_perform_stream(show_bytes, buffer_kb = 32) resp } httr2/man/req_method.Rd0000644000176200001440000000132614666312277014526 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/req-method.R \name{req_method} \alias{req_method} \title{Set HTTP method in request} \usage{ req_method(req, method) } \arguments{ \item{req}{A httr2 \link{request} object.} \item{method}{Custom HTTP method} } \value{ A modified HTTP \link{request}. } \description{ Use this function to use a custom HTTP method like \code{HEAD}, \code{DELETE}, \code{PATCH}, \code{UPDATE}, or \code{OPTIONS}. The default method is \code{GET} for requests without a body, and \code{POST} for requests with a body. } \examples{ request(example_url()) |> req_method("PATCH") request(example_url()) |> req_method("PUT") request(example_url()) |> req_method("HEAD") } httr2/man/req_perform_sequential.Rd0000644000176200001440000000534514753653643017161 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/req-perform-sequential.R \name{req_perform_sequential} \alias{req_perform_sequential} \title{Perform multiple requests in sequence} \usage{ req_perform_sequential( reqs, paths = NULL, on_error = c("stop", "return", "continue"), progress = TRUE ) } \arguments{ \item{reqs}{A list of \link{request}s.} \item{paths}{An optional character vector of paths, if you want to download the response bodies to disk. If supplied, must be the same length as \code{reqs}.} \item{on_error}{What should happen if one of the requests fails? \itemize{ \item \code{stop}, the default: stop iterating with an error. \item \code{return}: stop iterating, returning all the successful responses received so far, as well as an error object for the failed request. \item \code{continue}: continue iterating, recording errors in the result. }} \item{progress}{Display a progress bar for the status of all requests? Use \code{TRUE} to turn on a basic progress bar, use a string to give it a name, or see \link{progress_bars} to customize it in other ways. Not compatible with \code{\link[=req_progress]{req_progress()}}, as httr2 can only display a single progress bar at a time.} } \value{ A list, the same length as \code{reqs}, containing \link{response}s and possibly error objects, if \code{on_error} is \code{"return"} or \code{"continue"} and one of the responses errors. If \code{on_error} is \code{"return"} and it errors on the ith request, the ith element of the result will be an error object, and the remaining elements will be \code{NULL}. If \code{on_error} is \code{"continue"}, it will be a mix of requests and error objects. Only httr2 errors are captured; see \code{\link[=req_error]{req_error()}} for more details. } \description{ Given a list of requests, this function performs each in turn, returning a list of responses. It's the serial equivalent of \code{\link[=req_perform_parallel]{req_perform_parallel()}}. } \examples{ # One use of req_perform_sequential() is if the API allows you to request # data for multiple objects, you want data for more objects than can fit # in one request. req <- request("https://api.restful-api.dev/objects") # Imagine we have 50 ids: ids <- sort(sample(100, 50)) # But the API only allows us to request 10 at time. So we first use split # and some modulo arithmetic magic to generate chunks of length 10 chunks <- unname(split(ids, (seq_along(ids) - 1) \%/\% 10)) # Then we use lapply to generate one request for each chunk: reqs <- chunks |> lapply(\(idx) req |> req_url_query(id = idx, .multi = "comma")) # Then we can perform them all and get the results \dontrun{ resps <- reqs |> req_perform_sequential() resps_data(resps, \(resp) resp_body_json(resp)) } } httr2/man/oauth_token.Rd0000644000176200001440000000240414556444037014713 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/oauth-token.R \name{oauth_token} \alias{oauth_token} \title{Create an OAuth token} \usage{ oauth_token( access_token, token_type = "bearer", expires_in = NULL, refresh_token = NULL, ..., .date = Sys.time() ) } \arguments{ \item{access_token}{The access token used to authenticate request} \item{token_type}{Type of token; only \code{"bearer"} is currently supported.} \item{expires_in}{Number of seconds until token expires.} \item{refresh_token}{Optional refresh token; if supplied, this can be used to cheaply get a new access token when this one expires.} \item{...}{Additional components returned by the endpoint} \item{.date}{Date the request was made; used to convert the relative \code{expires_in} to an absolute \code{expires_at}.} } \value{ An OAuth token: an S3 list with class \code{httr2_token}. } \description{ Creates a S3 object of class \verb{} representing an OAuth token returned from the access token endpoint. } \examples{ oauth_token("abcdef") oauth_token("abcdef", expires_in = 3600) oauth_token("abcdef", refresh_token = "ghijkl") } \seealso{ \code{\link[=oauth_token_cached]{oauth_token_cached()}} to use the token cache with a specified OAuth flow. } httr2/man/req_auth_basic.Rd0000644000176200001440000000236714731333511015341 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/req-auth.R \name{req_auth_basic} \alias{req_auth_basic} \title{Authenticate request with HTTP basic authentication} \usage{ req_auth_basic(req, username, password = NULL) } \arguments{ \item{req}{A httr2 \link{request} object.} \item{username}{User name.} \item{password}{Password. You should avoid entering the password directly when calling this function as it will be captured by \code{.Rhistory}. Instead, leave it unset and the default behaviour will prompt you for it interactively.} } \value{ A modified HTTP \link{request}. } \description{ This sets the Authorization header. See details at \url{https://developer.mozilla.org/en-US/docs/Web/HTTP/Headers/Authorization}. } \examples{ req <- request("http://example.com") |> req_auth_basic("hadley", "SECRET") req req |> req_dry_run() # httr2 does its best to redact the Authorization header so that you don't # accidentally reveal confidential data. Use `redact_headers` to reveal it: print(req, redact_headers = FALSE) req |> req_dry_run(redact_headers = FALSE) # We do this because the authorization header is not encrypted and the # so password can easily be discovered: rawToChar(jsonlite::base64_dec("aGFkbGV5OlNFQ1JFVA==")) } httr2/man/iterate_with_offset.Rd0000644000176200001440000000542114556444037016433 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/iterate-helpers.R \name{iterate_with_offset} \alias{iterate_with_offset} \alias{iterate_with_cursor} \alias{iterate_with_link_url} \title{Iteration helpers} \usage{ iterate_with_offset( param_name, start = 1, offset = 1, resp_pages = NULL, resp_complete = NULL ) iterate_with_cursor(param_name, resp_param_value) iterate_with_link_url(rel = "next") } \arguments{ \item{param_name}{Name of query parameter.} \item{start}{Starting value.} \item{offset}{Offset for each page. The default is set to \code{1} so you get (e.g.) \code{?page=1}, \code{?page=2}, ... If \code{param_name} refers to an element index (rather than a page index) you'll want to set this to a larger number so you get (e.g.) \code{?items=20}, \code{?items=40}, ...} \item{resp_pages}{A callback function that takes a response (\code{resp}) and returns the total number of pages, or \code{NULL} if unknown. It will only be called once.} \item{resp_complete}{A callback function that takes a response (\code{resp}) and returns \code{TRUE} if there are no further pages.} \item{resp_param_value}{A callback function that takes a response (\code{resp}) and returns the next cursor value. Return \code{NULL} if there are no further pages.} \item{rel}{The "link relation type" to use to retrieve the next page.} } \description{ These functions are intended for use with the \code{next_req} argument to \code{\link[=req_perform_iterative]{req_perform_iterative()}}. Each implements iteration for a common pagination pattern: \itemize{ \item \code{iterate_with_offset()} increments a query parameter, e.g. \code{?page=1}, \code{?page=2}, or \code{?offset=1}, \code{offset=21}. \item \code{iterate_with_cursor()} updates a query parameter with the value of a cursor found somewhere in the response. \item \code{iterate_with_link_url()} follows the url found in the \code{Link} header. See \code{resp_link_url()} for more details. } } \examples{ req <- request(example_url()) |> req_url_path("/iris") |> req_throttle(10) |> req_url_query(limit = 50) # If you don't know the total number of pages in advance, you can # provide a `resp_complete()` callback is_complete <- function(resp) { length(resp_body_json(resp)$data) == 0 } resps <- req_perform_iterative( req, next_req = iterate_with_offset("page_index", resp_complete = is_complete), max_reqs = Inf ) \dontrun{ # Alternatively, if the response returns the total number of pages (or you # can easily calculate it), you can use the `resp_pages()` callback which # will generate a better progress bar. resps <- req_perform_iterative( req |> req_url_query(limit = 1), next_req = iterate_with_offset( "page_index", resp_pages = function(resp) resp_body_json(resp)$pages ), max_reqs = Inf ) } } httr2/man/req_retry.Rd0000644000176200001440000001114214737312513014400 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/req-retries.R \name{req_retry} \alias{req_retry} \title{Automatically retry a request on failure} \usage{ req_retry( 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 ) } \arguments{ \item{req}{A httr2 \link{request} object.} \item{max_tries, max_seconds}{Cap the maximum number of attempts (\code{max_tries}), the total elapsed time from the first request (\code{max_seconds}), or both. \code{max_tries} is the total number of attempts made, so this should always be greater than one.} \item{retry_on_failure}{Treat low-level failures as if they are transient errors that can be retried.} \item{is_transient}{A predicate function that takes a single argument (the response) and returns \code{TRUE} or \code{FALSE} specifying whether or not the response represents a transient error.} \item{backoff}{A function that takes a single argument (the number of failed attempts so far) and returns the number of seconds to wait.} \item{after}{A function that takes a single argument (the response) and returns either a number of seconds to wait or \code{NA}. \code{NA} indicates that a precise wait time is not available and that the \code{backoff} strategy should be used instead.} \item{failure_threshold, failure_timeout, failure_realm}{Set \code{failure_threshold} to activate "circuit breaking" where if a request continues to fail after \code{failure_threshold} times, cause the request to error until a timeout of \code{failure_timeout} seconds has elapsed. This timeout will persist across all requests with the same \code{failure_realm} (which defaults to the hostname of the request) and is intended to detect failing servers without needing to wait each time.} } \value{ A modified HTTP \link{request}. } \description{ \code{req_retry()} allows \code{\link[=req_perform]{req_perform()}} to automatically retry failing requests. It's particularly important for APIs with rate limiting, but can also be useful when dealing with flaky servers. By default, \code{req_perform()} will retry if the response is a 429 ("too many requests", often used for rate limiting) or 503 ("service unavailable"). If the API you are wrapping has other transient status codes (or conveys transience with some other property of the response), you can override the default with \code{is_transient}. And if you set \code{retry_on_failure = TRUE}, the request will retry if either the HTTP request or HTTP response doesn't complete successfully, leading to an error from curl, the lower-level library that httr2 uses to perform HTTP requests. This occurs, for example, if your Wi-Fi is down. \subsection{Delay}{ It's a bad idea to immediately retry a request, so \code{req_perform()} will wait a little before trying again: \itemize{ \item If the response contains the \code{Retry-After} header, httr2 will wait the amount of time it specifies. If the API you are wrapping conveys this information with a different header (or other property of the response), you can override the default behavior with \code{retry_after}. \item Otherwise, httr2 will use "truncated exponential backoff with full jitter", i.e., it will wait a random amount of time between one second and \code{2 ^ tries} seconds, capped at a maximum of 60 seconds. In other words, it waits \code{runif(1, 1, 2)} seconds after the first failure, \code{runif(1, 1, 4)} after the second, \code{runif(1, 1, 8)} after the third, and so on. If you'd prefer a different strategy, you can override the default with \code{backoff}. } } } \examples{ # google APIs assume that a 500 is also a transient error request("http://google.com") |> req_retry(is_transient = \(resp) resp_status(resp) \%in\% c(429, 500, 503)) # use a constant 10s delay after every failure request("http://example.com") |> req_retry(backoff = \(resp) 10) # When rate-limited, GitHub's API returns a 403 with # `X-RateLimit-Remaining: 0` and an Unix time stored in the # `X-RateLimit-Reset` header. This takes a bit more work to handle: github_is_transient <- function(resp) { resp_status(resp) == 403 && identical(resp_header(resp, "X-RateLimit-Remaining"), "0") } github_after <- function(resp) { time <- as.numeric(resp_header(resp, "X-RateLimit-Reset")) time - unclass(Sys.time()) } request("http://api.github.com") |> req_retry( is_transient = github_is_transient, after = github_after ) } \seealso{ \code{\link[=req_throttle]{req_throttle()}} if the API has a rate-limit but doesn't expose the limits in the response. } httr2/man/req_timeout.Rd0000644000176200001440000000103714666312277014733 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/req-options.R \name{req_timeout} \alias{req_timeout} \title{Set time limit for a request} \usage{ req_timeout(req, seconds) } \arguments{ \item{req}{A httr2 \link{request} object.} \item{seconds}{Maximum number of seconds to wait} } \value{ A modified HTTP \link{request}. } \description{ An error will be thrown if the request does not complete in the time limit. } \examples{ # Give up after at most 10 seconds request("http://example.com") |> req_timeout(10) } httr2/man/resp_date.Rd0000644000176200001440000000132114666312277014340 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/resp-headers.R \name{resp_date} \alias{resp_date} \title{Extract request date from response} \usage{ resp_date(resp) } \arguments{ \item{resp}{A httr2 \link{response} object, created by \code{\link[=req_perform]{req_perform()}}.} } \value{ A \code{POSIXct} date-time. } \description{ All responses contain a request date in the \code{Date} header; if not provided by the server will be automatically added by httr2. } \examples{ resp <- response(headers = "Date: Wed, 01 Jan 2020 09:23:15 UTC") resp |> resp_date() # If server doesn't add header (unusual), you get the time the request # was created: resp <- response() resp |> resp_date() } httr2/man/url_build.Rd0000644000176200001440000000100014737023431014333 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/url.R \name{url_build} \alias{url_build} \title{Build a string from a URL object} \usage{ url_build(url) } \arguments{ \item{url}{An URL object created by \link{url_parse}.} } \description{ This is the inverse of \code{\link[=url_parse]{url_parse()}}, taking a parsed URL object and turning it back into a string. } \seealso{ Other URL manipulation: \code{\link{url_modify}()}, \code{\link{url_parse}()} } \concept{URL manipulation} httr2/man/req_headers.Rd0000644000176200001440000000415214751434044014651 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/req-headers.R \name{req_headers} \alias{req_headers} \alias{req_headers_redacted} \title{Modify request headers} \usage{ req_headers(.req, ..., .redact = NULL) req_headers_redacted(.req, ...) } \arguments{ \item{.req}{A \link{request}.} \item{...}{<\code{\link[rlang:dyn-dots]{dynamic-dots}}> Name-value pairs of headers and their values. \itemize{ \item Use \code{NULL} to reset a value to httr2's default \item Use \code{""} to remove a header \item Use a character vector to repeat a header. }} \item{.redact}{A character vector of headers to redact. The Authorization header is always redacted.} } \value{ A modified HTTP \link{request}. } \description{ \code{req_headers()} allows you to set the value of any header. \code{req_headers_redacted()} is a variation that adds "redacted" headers, which httr2 avoids printing on the console. This is good practice for authentication headers to avoid accidentally leaking them in log files. } \examples{ req <- request("http://example.com") # Use req_headers() to add arbitrary additional headers to the request req |> req_headers(MyHeader = "MyValue") |> req_dry_run() # Repeated use overrides the previous value: req |> req_headers(MyHeader = "Old value") |> req_headers(MyHeader = "New value") |> req_dry_run() # Setting Accept to NULL uses curl's default: req |> req_headers(Accept = NULL) |> req_dry_run() # Setting it to "" removes it: req |> req_headers(Accept = "") |> req_dry_run() # If you need to repeat a header, provide a vector of values # (this is rarely needed, but is important in a handful of cases) req |> req_headers(HeaderName = c("Value 1", "Value 2", "Value 3")) |> req_dry_run() # If you have headers in a list, use !!! headers <- list(HeaderOne = "one", HeaderTwo = "two") req |> req_headers(!!!headers, HeaderThree = "three") |> req_dry_run() # Use `req_headers_redacted()`` to hide a header in the output req_secret <- req |> req_headers_redacted(Secret = "this-is-private") |> req_headers(Public = "but-this-is-not") req_secret req_secret |> req_dry_run() } httr2/man/resp_retry_after.Rd0000644000176200001440000000155514666312277015762 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/resp-headers.R \name{resp_retry_after} \alias{resp_retry_after} \title{Extract wait time from a response} \usage{ resp_retry_after(resp) } \arguments{ \item{resp}{A httr2 \link{response} object, created by \code{\link[=req_perform]{req_perform()}}.} } \value{ Scalar double giving the number of seconds to wait before retrying a request. } \description{ Computes how many seconds you should wait before retrying a request by inspecting the \code{Retry-After} header. It parses both forms (absolute and relative) and returns the number of seconds to wait. If the heading is not found, it will return \code{NA}. } \examples{ resp <- response(headers = "Retry-After: 30") resp |> resp_retry_after() resp <- response(headers = "Retry-After: Mon, 20 Sep 2025 21:44:05 UTC") resp |> resp_retry_after() } httr2/man/jwt_claim.Rd0000644000176200001440000000466214656154404014351 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/jwt.R \name{jwt_claim} \alias{jwt_claim} \alias{jwt_encode_sig} \alias{jwt_encode_hmac} \title{Create and encode a JWT} \usage{ jwt_claim( iss = NULL, sub = NULL, aud = NULL, exp = unix_time() + 5L * 60L, nbf = unix_time(), iat = unix_time(), jti = NULL, ... ) jwt_encode_sig(claim, key, size = 256, header = list()) jwt_encode_hmac(claim, secret, size = 256, header = list()) } \arguments{ \item{iss}{Issuer claim. Identifies the principal that issued the JWT.} \item{sub}{Subject claim. Identifies the principal that is the subject of the JWT (i.e. the entity that the claims apply to).} \item{aud}{Audience claim. Identifies the recipients that the JWT is intended. Each principle intended to process the JWT must be identified with a unique value.} \item{exp}{Expiration claim. Identifies the expiration time on or after which the JWT MUST NOT be accepted for processing. Defaults to 5 minutes.} \item{nbf}{Not before claim. Identifies the time before which the JWT MUST NOT be accepted for processing. Defaults to current time.} \item{iat}{Issued at claim. Identifies the time at which the JWT was issued. Defaults to current time.} \item{jti}{JWT ID claim. Provides a unique identifier for the JWT. If omitted, uses a random 32-byte sequence encoded with base64url.} \item{...}{Any additional claims to include in the claim set.} \item{claim}{Claim set produced by \code{\link[=jwt_claim]{jwt_claim()}}.} \item{key}{RSA or EC private key either specified as a path to a file, a connection, or a string (PEM/SSH format), or a raw vector (DER format).} \item{size}{Size, in bits, of sha2 signature, i.e. 256, 384 or 512. Only for HMAC/RSA, not applicable for ECDSA keys.} \item{header}{A named list giving additional fields to include in the JWT header.} \item{secret}{String or raw vector with a secret passphrase.} } \value{ An S3 list with class \code{jwt_claim}. } \description{ \code{jwt_claim()} is a wrapper around \code{\link[jose:jwt_claim]{jose::jwt_claim()}} that creates a JWT claim set with a few extra default values. \code{jwt_encode_sig()} and \code{jwt_encode_hmac()} are thin wrappers around \code{\link[jose:jwt_encode]{jose::jwt_encode_sig()}} and \code{\link[jose:jwt_encode]{jose::jwt_encode_hmac()}} that exist primarily to make specification in other functions a little simpler. } \examples{ claim <- jwt_claim() str(claim) } \keyword{internal} httr2/man/oauth_client.Rd0000644000176200001440000000472514556444037015061 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/oauth-client.R \name{oauth_client} \alias{oauth_client} \title{Create an OAuth client} \usage{ oauth_client( id, token_url, secret = NULL, key = NULL, auth = c("body", "header", "jwt_sig"), auth_params = list(), name = hash(id) ) } \arguments{ \item{id}{Client identifier.} \item{token_url}{Url to retrieve an access token.} \item{secret}{Client secret. For most apps, this is technically confidential so in principle you should avoid storing it in source code. However, many APIs require it in order to provide a user friendly authentication experience, and the risks of including it are usually low. To make things a little safer, I recommend using \code{\link[=obfuscate]{obfuscate()}} when recording the client secret in public code.} \item{key}{Client key. As an alternative to using a \code{secret}, you can instead supply a confidential private key. This should never be included in a package.} \item{auth}{Authentication mechanism used by the client to prove itself to the API. Can be one of three built-in methods ("body", "header", or "jwt"), or a function that will be called with arguments \code{req}, \code{client}, and the contents of \code{auth_params}. The most common mechanism in the wild is \code{"body"} where the \code{client_id} and (optionally) \code{client_secret} are added to the body. \code{"header"} sends the \code{client_id} and \code{client_secret} in HTTP Authorization header. \code{"jwt_sig"} will generate a JWT, and include it in a \code{client_assertion} field in the body. See \code{\link[=oauth_client_req_auth]{oauth_client_req_auth()}} for more details.} \item{auth_params}{Additional parameters passed to the function specified by \code{auth}.} \item{name}{Optional name for the client. Used when generating the cache directory. If \code{NULL}, generated from hash of \code{client_id}. If you're defining a client for use in a package, I recommend that you use the package name.} } \value{ An OAuth client: An S3 list with class \code{httr2_oauth_client}. } \description{ An OAuth app is the combination of a client, a set of endpoints (i.e. urls where various requests should be sent), and an authentication mechanism. A client consists of at least a \code{client_id}, and also often a \code{client_secret}. You'll get these values when you create the client on the API's website. } \examples{ oauth_client("myclient", "http://example.com/token_url", secret = "DONTLOOK") } httr2/man/req_user_agent.Rd0000644000176200001440000000165014666312277015402 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/req-options.R \name{req_user_agent} \alias{req_user_agent} \title{Set user-agent for a request} \usage{ req_user_agent(req, string = NULL) } \arguments{ \item{req}{A httr2 \link{request} object.} \item{string}{String to be sent in the \code{User-Agent} header. If \code{NULL}, will user default.} } \value{ A modified HTTP \link{request}. } \description{ This overrides the default user-agent set by httr2 which includes the version numbers of httr2, the curl package, and libcurl. } \examples{ # Default user-agent: request("http://example.com") |> req_dry_run() request("http://example.com") |> req_user_agent("MyString") |> req_dry_run() # If you're wrapping in an API in a package, it's polite to set the # user agent to identify your package. request("http://example.com") |> req_user_agent("MyPackage (http://mypackage.com)") |> req_dry_run() } httr2/man/resp_stream_raw.Rd0000644000176200001440000000563314746456350015601 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/resp-stream.R, R/resp-stream-aws.R \name{resp_stream_raw} \alias{resp_stream_raw} \alias{resp_stream_lines} \alias{resp_stream_sse} \alias{resp_stream_aws} \alias{close.httr2_response} \alias{resp_stream_is_complete} \title{Read a streaming body a chunk at a time} \usage{ resp_stream_raw(resp, kb = 32) resp_stream_lines(resp, lines = 1, max_size = Inf, warn = TRUE) resp_stream_sse(resp, max_size = Inf) resp_stream_aws(resp, max_size = Inf) \method{close}{httr2_response}(con, ...) resp_stream_is_complete(resp) } \arguments{ \item{resp, con}{A streaming \link{response} created by \code{\link[=req_perform_connection]{req_perform_connection()}}.} \item{kb}{How many kilobytes (1024 bytes) of data to read.} \item{lines}{The maximum number of lines to return at once.} \item{max_size}{The maximum number of bytes to buffer; once this number of bytes has been exceeded without a line/event boundary, an error is thrown.} \item{warn}{Like \code{\link[=readLines]{readLines()}}: warn if the connection ends without a final EOL.} \item{...}{Not used; included for compatibility with generic.} } \value{ \itemize{ \item \code{resp_stream_raw()}: a raw vector. \item \code{resp_stream_lines()}: a character vector. \item \code{resp_stream_sse()}: a list with components \code{type}, \code{data}, and \code{id}. \code{type}, \code{data}, and \code{id} are always strings; \code{data} and \code{id} may be empty strings. \item \code{resp_stream_aws()}: a list with components \code{headers} and \code{body}. \code{body} will be automatically parsed if the event contents a \verb{:content-type} header with \code{application/json}. } \code{resp_stream_sse()} and \code{resp_stream_aws()} will return \code{NULL} to signal that the end of the stream has been reached or, if in nonblocking mode, that no event is currently available. } \description{ \itemize{ \item \code{resp_stream_raw()} retrieves bytes (\code{raw} vectors). \item \code{resp_stream_lines()} retrieves lines of text (\code{character} vectors). \item \code{resp_stream_sse()} retrieves a single \href{https://developer.mozilla.org/en-US/docs/Web/API/Server-sent_events/Using_server-sent_events}{server-sent event}. \item \code{resp_stream_aws()} retrieves a single event from an AWS stream (i.e. mime type `application/vnd.amazon.eventstream``). } Use \code{resp_stream_is_complete()} to determine if there is further data waiting on the stream. } \examples{ req <- request(example_url()) |> req_template("GET /stream/:n", n = 5) con <- req |> req_perform_connection() while (!resp_stream_is_complete(con)) { lines <- con |> resp_stream_lines(2) cat(length(lines), " lines received\n", sep = "") } close(con) # You can also see what's happening by setting verbosity con <- req |> req_perform_connection(verbosity = 2) while (!resp_stream_is_complete(con)) { lines <- con |> resp_stream_lines(2) } close(con) } httr2/man/url_query_parse.Rd0000644000176200001440000000227414737043664015623 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/url.R \name{url_query_parse} \alias{url_query_parse} \alias{url_query_build} \title{Parse query parameters and/or build a string} \usage{ url_query_parse(query) url_query_build(query, .multi = c("error", "comma", "pipe", "explode")) } \arguments{ \item{query}{A string, when parsing; a named list when building.} \item{.multi}{Controls what happens when a value is a vector: \itemize{ \item \code{"error"}, the default, throws an error. \item \code{"comma"}, separates values with a \verb{,}, e.g. \verb{?x=1,2}. \item \code{"pipe"}, separates values with a \code{|}, e.g. \code{?x=1|2}. \item \code{"explode"}, turns each element into its own parameter, e.g. \code{?x=1&x=2} } If none of these options work for your needs, you can instead supply a function that takes a character vector of argument values and returns a a single string.} } \description{ \code{url_query_parse()} parses a query string into a named list; \code{url_query_build()} builds a query string from a named list. } \examples{ str(url_query_parse("a=1&b=2")) url_query_build(list(x = 1, y = "z")) url_query_build(list(x = 1, y = 1:2), .multi = "explode") } httr2/man/req_body.Rd0000644000176200001440000000724614737043664014212 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/req-body.R \name{req_body} \alias{req_body_raw} \alias{req_body_file} \alias{req_body_json} \alias{req_body_json_modify} \alias{req_body_form} \alias{req_body_multipart} \title{Send data in request body} \usage{ req_body_raw(req, body, type = NULL) req_body_file(req, path, type = NULL) req_body_json( req, data, auto_unbox = TRUE, digits = 22, null = "null", type = "application/json", ... ) req_body_json_modify(req, ...) req_body_form(.req, ..., .multi = c("error", "comma", "pipe", "explode")) req_body_multipart(.req, ...) } \arguments{ \item{req, .req}{A httr2 \link{request} object.} \item{body}{A literal string or raw vector to send as body.} \item{type}{MIME content type. Will be ignored if you have manually set a \code{Content-Type} header.} \item{path}{Path to file to upload.} \item{data}{Data to include in body.} \item{auto_unbox}{Should length-1 vectors be automatically "unboxed" to JSON scalars?} \item{digits}{How many digits of precision should numbers use in JSON?} \item{null}{Should \code{NULL} be translated to JSON's null (\code{"null"}) or an empty list (\code{"list"}).} \item{...}{<\code{\link[rlang:dyn-dots]{dynamic-dots}}> Name-data pairs used to send data in the body. \itemize{ \item For \code{req_body_form()}, the values must be strings (or things easily coerced to strings). Vectors are convertd to strings using the value of \code{.multi}. \item For \code{req_body_multipart()} the values must be strings or objects produced by \code{\link[curl:multipart]{curl::form_file()}}/\code{\link[curl:multipart]{curl::form_data()}}. \item For \code{req_body_json_modify()}, any simple data made from atomic vectors and lists. } \code{req_body_json()} uses this argument differently; it takes additional arguments passed on to \code{\link[jsonlite:fromJSON]{jsonlite::toJSON()}}.} \item{.multi}{Controls what happens when a value is a vector: \itemize{ \item \code{"error"}, the default, throws an error. \item \code{"comma"}, separates values with a \verb{,}, e.g. \verb{?x=1,2}. \item \code{"pipe"}, separates values with a \code{|}, e.g. \code{?x=1|2}. \item \code{"explode"}, turns each element into its own parameter, e.g. \code{?x=1&x=2} } If none of these options work for your needs, you can instead supply a function that takes a character vector of argument values and returns a a single string.} } \value{ A modified HTTP \link{request}. } \description{ \itemize{ \item \code{req_body_file()} sends a local file. \item \code{req_body_raw()} sends a string or raw vector. \item \code{req_body_json()} sends JSON encoded data. Named components of this data can later be modified with \code{req_body_json_modify()}. \item \code{req_body_form()} sends form encoded data. \item \code{req_body_multipart()} creates a multi-part body. } Adding a body to a request will automatically switch the method to POST. } \examples{ req <- request(example_url()) |> req_url_path("/post") # Most APIs expect small amounts of data in either form or json encoded: req |> req_body_form(x = "A simple text string") |> req_dry_run() req |> req_body_json(list(x = "A simple text string")) |> req_dry_run() # For total control over the body, send a string or raw vector req |> req_body_raw("A simple text string") |> req_dry_run() # There are two main ways that APIs expect entire files path <- tempfile() writeLines(letters[1:6], path) # You can send a single file as the body: req |> req_body_file(path) |> req_dry_run() # You can send multiple files, or a mix of files and data # with multipart encoding req |> req_body_multipart(a = curl::form_file(path), b = "some data") |> req_dry_run() } httr2/man/req_cache.Rd0000644000176200001440000000542214666312277014312 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/req-cache.R \name{req_cache} \alias{req_cache} \title{Automatically cache requests} \usage{ req_cache( req, path, use_on_error = FALSE, debug = getOption("httr2_cache_debug", FALSE), max_age = Inf, max_n = Inf, max_size = 1024^3 ) } \arguments{ \item{req}{A httr2 \link{request} object.} \item{path}{Path to cache directory. Will be created automatically if it does not exist. For quick and easy caching within a session, you can use \code{tempfile()}. To cache requests within a package, you can use something like \code{file.path(tools::R_user_dir("pkgdown", "cache"), "httr2")}. httr2 doesn't provide helpers to manage the cache, but if you want to empty it, you can use something like \code{unlink(dir(cache_path, full.names = TRUE))}.} \item{use_on_error}{If the request errors, and there's a cache response, should \code{req_perform()} return that instead of generating an error?} \item{debug}{When \code{TRUE} will emit useful messages telling you about cache hits and misses. This can be helpful to understand whether or not caching is actually doing anything for your use case.} \item{max_n, max_age, max_size}{Automatically prune the cache by specifying one or more of: \itemize{ \item \code{max_age}: to delete files older than this number of seconds. \item \code{max_n}: to delete files (from oldest to newest) to preserve at most this many files. \item \code{max_size}: to delete files (from oldest to newest) to preserve at most this many bytes. } The cache pruning is performed at most once per minute.} } \value{ A modified HTTP \link{request}. } \description{ Use \code{req_perform()} to automatically cache HTTP requests. Most API requests are not cacheable, but static files often are. \code{req_cache()} caches responses to GET requests that have status code 200 and at least one of the standard caching headers (e.g. \code{Expires}, \code{Etag}, \code{Last-Modified}, \code{Cache-Control}), unless caching has been expressly prohibited with \code{Cache-Control: no-store}. Typically, a request will still be sent to the server to check that the cached value is still up-to-date, but it will not need to re-download the body value. To learn more about HTTP caching, I recommend the MDN article \href{https://developer.mozilla.org/en-US/docs/Web/HTTP/Caching}{HTTP caching}. } \examples{ # GitHub uses HTTP caching for all raw files. url <- paste0( "https://raw.githubusercontent.com/allisonhorst/palmerpenguins/", "master/inst/extdata/penguins.csv" ) # Here I set debug = TRUE so you can see what's happening req <- request(url) |> req_cache(tempdir(), debug = TRUE) # First request downloads the data resp <- req |> req_perform() # Second request retrieves it from the cache resp <- req |> req_perform() } httr2/man/resp_url.Rd0000644000176200001440000000203414666312277014227 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/resp-url.R \name{resp_url} \alias{resp_url} \alias{resp_url_path} \alias{resp_url_query} \alias{resp_url_queries} \title{Get URL/components from the response} \usage{ resp_url(resp) resp_url_path(resp) resp_url_query(resp, name, default = NULL) resp_url_queries(resp) } \arguments{ \item{resp}{A httr2 \link{response} object, created by \code{\link[=req_perform]{req_perform()}}.} \item{name}{Query parameter name.} \item{default}{Default value to use if query parameter doesn't exist.} } \description{ \itemize{ \item \code{resp_url()} returns the complete url. \item \code{resp_url_path()} returns the path component. \item \code{resp_url_query()} returns a single query component. \item \code{resp_url_queries()} returns the query component as a named list. } } \examples{ resp <- request(example_url()) |> req_url_path("/get?hello=world") |> req_perform() resp |> resp_url() resp |> resp_url_path() resp |> resp_url_queries() resp |> resp_url_query("hello") } httr2/man/req_perform_parallel.Rd0000644000176200001440000001110314761701552016560 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/req-perform-parallel.R \name{req_perform_parallel} \alias{req_perform_parallel} \title{Perform a list of requests in parallel} \usage{ req_perform_parallel( reqs, paths = NULL, pool = deprecated(), on_error = c("stop", "return", "continue"), progress = TRUE, max_active = 10 ) } \arguments{ \item{reqs}{A list of \link{request}s.} \item{paths}{An optional character vector of paths, if you want to download the response bodies to disk. If supplied, must be the same length as \code{reqs}.} \item{pool}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}}. No longer supported; to control the maximum number of concurrent requests, set \code{max_active}.} \item{on_error}{What should happen if one of the requests fails? \itemize{ \item \code{stop}, the default: stop iterating with an error. \item \code{return}: stop iterating, returning all the successful responses received so far, as well as an error object for the failed request. \item \code{continue}: continue iterating, recording errors in the result. }} \item{progress}{Display a progress bar for the status of all requests? Use \code{TRUE} to turn on a basic progress bar, use a string to give it a name, or see \link{progress_bars} to customize it in other ways. Not compatible with \code{\link[=req_progress]{req_progress()}}, as httr2 can only display a single progress bar at a time.} \item{max_active}{Maximum number of concurrent requests.} } \value{ A list, the same length as \code{reqs}, containing \link{response}s and possibly error objects, if \code{on_error} is \code{"return"} or \code{"continue"} and one of the responses errors. If \code{on_error} is \code{"return"} and it errors on the ith request, the ith element of the result will be an error object, and the remaining elements will be \code{NULL}. If \code{on_error} is \code{"continue"}, it will be a mix of requests and error objects. Only httr2 errors are captured; see \code{\link[=req_error]{req_error()}} for more details. } \description{ This variation on \code{\link[=req_perform_sequential]{req_perform_sequential()}} performs multiple requests in parallel. Never use it without \code{\link[=req_throttle]{req_throttle()}}; otherwise it's too easy to pummel a server with a very large number of simultaneous requests. While running, you'll get a progress bar that looks like: \verb{[working] (1 + 4) -> 5 -> 5}. The string tells you the current status of the queue (e.g. working, waiting, errored) followed by (the number of pending requests + pending retried requests) -> the number of active requests -> the number of complete requests. \subsection{Limitations}{ The main limitation of \code{req_perform_parallel()} is that it assumes applies \code{\link[=req_throttle]{req_throttle()}} and \code{\link[=req_retry]{req_retry()}} are across all requests. This means, for example, that if request 1 is throttled, but request 2 is not, \code{req_perform_parallel()} will wait for request 1 before performing request 2. This makes it most suitable for performing many parallel requests to the same host, rather than a mix of different hosts. It's probably possible to remove these limitation, but it's enough work that I'm unlikely to do it unless I know that people would fine it useful: so please let me know! Additionally, it does not respect the \code{max_tries} argument to \code{req_retry()} because if you have five requests in flight and the first one gets rate limited, it's likely that all the others do too. This also means that the circuit breaker is never triggered. } } \examples{ # Requesting these 4 pages one at a time would take 2 seconds: request_base <- request(example_url()) |> req_throttle(capacity = 100, fill_time_s = 60) reqs <- list( request_base |> req_url_path("/delay/0.5"), request_base |> req_url_path("/delay/0.5"), request_base |> req_url_path("/delay/0.5"), request_base |> req_url_path("/delay/0.5") ) # But it's much faster if you request in parallel system.time(resps <- req_perform_parallel(reqs)) # req_perform_parallel() will fail on error reqs <- list( request_base |> req_url_path("/status/200"), request_base |> req_url_path("/status/400"), request("FAILURE") ) try(resps <- req_perform_parallel(reqs)) # but can use on_error to capture all successful results resps <- req_perform_parallel(reqs, on_error = "continue") # Inspect the successful responses resps |> resps_successes() # And the failed responses resps |> resps_failures() |> resps_requests() } httr2/man/oauth_cache_path.Rd0000644000176200001440000000065014556444037015653 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/oauth.R \name{oauth_cache_path} \alias{oauth_cache_path} \title{httr2 OAuth cache location} \usage{ oauth_cache_path() } \description{ When opted-in to, httr2 caches OAuth tokens in this directory. By default, it uses a OS-standard cache directory, but, if needed, you can override the location by setting the \code{HTTR2_OAUTH_CACHE} env var. } httr2/man/req_perform.Rd0000644000176200001440000000722214666312277014721 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/req-perform.R \name{req_perform} \alias{req_perform} \title{Perform a request to get a response} \usage{ req_perform( req, path = NULL, verbosity = NULL, mock = getOption("httr2_mock", NULL), error_call = current_env() ) } \arguments{ \item{req}{A httr2 \link{request} object.} \item{path}{Optionally, path to save body of the response. This is useful for large responses since it avoids storing the response in memory.} \item{verbosity}{How much information to print? This is a wrapper around \code{\link[=req_verbose]{req_verbose()}} that uses an integer to control verbosity: \itemize{ \item \code{0}: no output \item \code{1}: show headers \item \code{2}: show headers and bodies \item \code{3}: show headers, bodies, and curl status messages. } Use \code{\link[=with_verbosity]{with_verbosity()}} to control the verbosity of requests that you can't affect directly.} \item{mock}{A mocking function. If supplied, this function is called with the request. It should return either \code{NULL} (if it doesn't want to handle the request) or a \link{response} (if it does). See \code{\link[=with_mock]{with_mock()}}/ \code{local_mock()} for more details.} \item{error_call}{The execution environment of a currently running function, e.g. \code{caller_env()}. The function will be mentioned in error messages as the source of the error. See the \code{call} argument of \code{\link[rlang:abort]{abort()}} for more information.} } \value{ \itemize{ \item If the HTTP request succeeds, and the status code is ok (e.g. 200), an HTTP \link{response}. \item If the HTTP request succeeds, but the status code is an error (e.g a 404), an error with class \code{c("httr2_http_404", "httr2_http")}. By default, all 400 and 500 status codes will be treated as an error, but you can customise this with \code{\link[=req_error]{req_error()}}. \item If the HTTP request fails (e.g. the connection is dropped or the server doesn't exist), an error with class \code{"httr2_failure"}. } } \description{ After preparing a \link{request}, call \code{req_perform()} to perform it, fetching the results back to R as a \link{response}. The default HTTP method is \code{GET} unless a body (set by \link{req_body_json} and friends) is present, in which case it will be \code{POST}. You can override these defaults with \code{\link[=req_method]{req_method()}}. } \section{Requests}{ Note that one call to \code{req_perform()} may perform multiple HTTP requests: \itemize{ \item If the \code{url} is redirected with a 301, 302, 303, or 307, curl will automatically follow the \code{Location} header to the new location. \item If you have configured retries with \code{\link[=req_retry]{req_retry()}} and the request fails with a transient problem, \code{req_perform()} will try again after waiting a bit. See \code{\link[=req_retry]{req_retry()}} for details. \item If you are using OAuth, and the cached token has expired, \code{req_perform()} will get a new token either using the refresh token (if available) or by running the OAuth flow. } } \section{Progress bar}{ \code{req_perform()} will automatically add a progress bar if it needs to wait between requests for \code{\link[=req_throttle]{req_throttle()}} or \code{\link[=req_retry]{req_retry()}}. You can turn the progress bar off (and just show the total time to wait) by setting \code{options(httr2_progress = FALSE)}. } \examples{ request("https://google.com") |> req_perform() } \seealso{ \code{\link[=req_perform_parallel]{req_perform_parallel()}} to perform multiple requests in parallel. \code{\link[=req_perform_iterative]{req_perform_iterative()}} to perform multiple requests iteratively. } httr2/man/req_options.Rd0000644000176200001440000000206114556444037014734 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/req-options.R \name{req_options} \alias{req_options} \title{Set arbitrary curl options in request} \usage{ req_options(.req, ...) } \arguments{ \item{.req}{A \link{request}.} \item{...}{<\code{\link[rlang:dyn-dots]{dynamic-dots}}> Name-value pairs. The name should be a valid curl option, as found in \code{\link[curl:curl_options]{curl::curl_options()}}.} } \value{ A modified HTTP \link{request}. } \description{ \code{req_options()} is for expert use only; it allows you to directly set libcurl options to access features that are otherwise not available in httr2. } \examples{ # req_options() allows you to access curl options that are not otherwise # exposed by httr2. For example, in very special cases you may need to # turn off SSL verification. This is generally a bad idea so httr2 doesn't # provide a convenient wrapper, but if you really know what you're doing # you can still access this libcurl option: req <- request("https://example.com") |> req_options(ssl_verifypeer = 0) } httr2/man/req_template.Rd0000644000176200001440000000313314666312277015057 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/req-template.R \name{req_template} \alias{req_template} \title{Set request method/path from a template} \usage{ req_template(req, template, ..., .env = parent.frame()) } \arguments{ \item{req}{A httr2 \link{request} object.} \item{template}{A template string which consists of a optional HTTP method and a path containing variables labelled like either \verb{:foo} or \code{{foo}}.} \item{...}{Template variables.} \item{.env}{Environment in which to look for template variables not found in \code{...}. Expert use only.} } \value{ A modified HTTP \link{request}. } \description{ Many APIs document their methods with a lightweight template mechanism that looks like \code{GET /user/{user}} or \verb{POST /organisation/:org}. This function makes it easy to copy and paste such snippets and retrieve template variables either from function arguments or the current environment. \code{req_template()} will append to the existing path so that you can set a base url in the initial \code{\link[=request]{request()}}. This means that you'll generally want to avoid multiple \code{req_template()} calls on the same request. } \examples{ httpbin <- request(example_url()) # You can supply template parameters in `...` httpbin |> req_template("GET /bytes/{n}", n = 100) # or you retrieve from the current environment n <- 200 httpbin |> req_template("GET /bytes/{n}") # Existing path is preserved: httpbin_test <- request(example_url()) |> req_url_path("/test") name <- "id" value <- "a3fWa" httpbin_test |> req_template("GET /set/{name}/{value}") } httr2/man/req_progress.Rd0000644000176200001440000000130514753125205015075 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/req-progress.R \name{req_progress} \alias{req_progress} \title{Add a progress bar to long downloads or uploads} \usage{ req_progress(req, type = c("down", "up")) } \arguments{ \item{req}{A \link{request}.} \item{type}{Type of progress to display: either number of bytes uploaded or downloaded.} } \description{ When uploading or downloading a large file, it's often useful to provide a progress bar so that you know how long you have to wait. } \examples{ req <- request("https://r4ds.s3.us-west-2.amazonaws.com/seattle-library-checkouts.csv") |> req_progress() \dontrun{ path <- tempfile() req |> req_perform(path = path) } } httr2/DESCRIPTION0000644000176200001440000000301414762766512013041 0ustar liggesusersPackage: httr2 Title: Perform HTTP Requests and Process the Responses Version: 1.1.1 Authors@R: c( person("Hadley", "Wickham", , "hadley@posit.co", role = c("aut", "cre")), person("Posit Software, PBC", role = c("cph", "fnd")), person("Maximilian", "Girlich", role = "ctb") ) Description: Tools for creating and modifying HTTP requests, then performing them and processing the results. 'httr2' is a modern re-imagining of 'httr' that uses a pipe-based interface and solves more of the problems that API wrapping packages face. License: MIT + file LICENSE URL: https://httr2.r-lib.org, https://github.com/r-lib/httr2 BugReports: https://github.com/r-lib/httr2/issues Depends: R (>= 4.0) Imports: cli (>= 3.0.0), curl (>= 6.2.1), glue, lifecycle, magrittr, openssl, R6, rappdirs, rlang (>= 1.1.0), vctrs (>= 0.6.3), withr Suggests: askpass, bench, clipr, covr, docopt, httpuv, jose, jsonlite, knitr, later (>= 1.4.0), paws.common, promises, rmarkdown, testthat (>= 3.1.8), tibble, webfakes, xml2 VignetteBuilder: knitr Config/Needs/website: tidyverse/tidytemplate Config/testthat/edition: 3 Config/testthat/parallel: true Config/testthat/start-first: multi-req, resp-stream, req-perform Encoding: UTF-8 RoxygenNote: 7.3.2 NeedsCompilation: no Packaged: 2025-03-05 14:50:50 UTC; hadleywickham Author: Hadley Wickham [aut, cre], Posit Software, PBC [cph, fnd], Maximilian Girlich [ctb] Maintainer: Hadley Wickham Repository: CRAN Date/Publication: 2025-03-08 07:10:02 UTC