httr2/0000755000176200001440000000000014645436632011332 5ustar liggesusershttr2/tests/0000755000176200001440000000000014645305454012471 5ustar liggesusershttr2/tests/testthat/0000755000176200001440000000000014645436632014334 5ustar liggesusershttr2/tests/testthat/test-req-body.R0000644000176200001440000001063614556444037017163 0ustar liggesuserstest_that("can send file", { skip_on_os("windows") # fails due to line ending difference path <- tempfile() writeLines("this is a test", path) 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, "this is a test\n") }) 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") }) httr2/tests/testthat/test-iterate-helpers.R0000644000176200001440000000541514556444037020535 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-utils.R0000644000176200001440000000222014556444037016567 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("respects httr2 verbosity option", { expect_equal(with_verbosity(httr2_verbosity()), 1) }) 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) }) test_that("can suppress progress bar", { withr::local_options(httr2_progress = FALSE) expect_snapshot(sys_sleep(0.1, "for test")) }) httr2/tests/testthat/test-req-error.R0000644000176200001440000000170214556444037017351 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-resp.R0000644000176200001440000000126414556444037016407 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"))) 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")) }) }) 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.R0000644000176200001440000000450514556444037017701 0ustar liggesuserstest_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("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) }) httr2/tests/testthat/azure-cert.rds0000644000176200001440000000307314070400763017116 0ustar liggesusersAXjVgmh⃎!Zf8kŃϕ:^#v&xYR6ؑw<`$AWQtFRE{2 {0bBhY &gou_ȔK-]֘ҌcˈddV+;Ĕ9þjWV_r;f;:K=i/wΜrߦ^1aZGuNNm%SY mE\z|ENcr'O i+I jI""=2A>= :PRHEt}'D29%T$dhMa,g2ٮuB{w(}:97/Cd>P0T"W(Ơx+`̹oDJ=@bUԥ sYbo;=C@\VkCsTW܊x0$IWǤb+hBÁ'Lw;6O_~wOu%%^DFV|MD'R|Ш`'6L^;0IiT74.ዘueQ"KI}Ƿzm\.}{؁3eϕL7`XJF@Qvݡj7":\DL%,R2jR&e,krݭnNCZOfW= ꬒyTIpᆼZ9Y`>4},߰'bYY#o. @rSmռ.Ҁ F_ TO4 a2[aD0[aK >Nzw :6n-gWfˋgb ףaL[0hĕjV ^ U*i4ڱ[D Ȧ1kNЛ0b&G b I|bb_H.r(%T_DžKFĎ vYƚŹQ[3=xk̫;?u͊ȍ,qn 5_I>t_-l_~5-cz}_V'uf*[5HgY:kxLa_5s)K9ӵ w|ע)h-ҍ/@4e~9&a)R).dSE#1f[1Ş> 6ьuM]"7P8(ug_M^=.F-cU.K0R`"C=>W=IN,bp^K=J;I'sꡜ,W()Hr%l+'Lkc)nyn D% S nz"o*/Ζi|zIVf4(aJ/@#Ν(q?zˣ7yKBۍ \[\B3AYprbv2PJ"&Ns>_@O`TO[حs$у_ 1gFh 64#fgKEl Pbc/I^F/=ݭeP2:׸S@&?1u~+R{Rhttr2/tests/testthat/test-oauth.R0000644000176200001440000000772614556444037016567 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 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-url.R0000644000176200001440000000066614556444037017214 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), paste0(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-resp-body.R0000644000176200001440000000455414556444037017347 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("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.R0000644000176200001440000000145214643705123017664 0ustar liggesuserstest_that("new token computes expires_at", { time <- Sys.time() token <- oauth_token("xyz", expires_in = 10, .date = time) expect_s3_class(token, "httr2_token") expect_equal(token$expires_at, as.numeric(time + 10)) }) 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.R0000644000176200001440000000247114556444037017052 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("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_match(as.character(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()), character()) expect_equal(headers_flatten(list(x = 1)), c(x = "1")) expect_equal(headers_flatten(list(x = 1:2)), c(x = "1", x = "2")) }) httr2/tests/testthat/test-oauth-client.R0000644000176200001440000000576114643705123020031 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", { expect_snapshot({ oauth_client("x", token_url = "http://example.com") oauth_client("x", secret = "SECRET", token_url = "http://example.com") }) }) 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, structure(list(Authorization = "Basic aWQ6c2VjcmV0"), redact = "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"))) }) test_that("can authenticate with client certificate", { if (FALSE) { ## To create a certificate: # openssl req -x509 -newkey rsa:4096 -keyout key.pem -out cert.pem -days 3650 # pem phrase - abcd # email address: h.wickham@gmail.com ## Upload to https://portal.azure.com/#blade/Microsoft_AAD_RegisteredApps/ApplicationsListBlade cert <- openssl::read_cert("cert.pem") secret_write_rds(cert, test_path("azure-cert.rds"), "HTTR2_KEY") key <- openssl::read_key("key.pem") secret_write_rds(key, test_path("azure-key.rds"), "HTTR2_KEY") unlink(c("cert.pem", "key.pem")) } client_id <- "b7f5efee-1367-4302-a89a-048af3ba821a" cert <- secret_read_rds(test_path("azure-cert.rds"), "HTTR2_KEY") cert_x5t <- base64_url_encode(openssl::sha1(cert)) key <- secret_read_rds(test_path("azure-key.rds"), "HTTR2_KEY") claim <- list( aud = "https://login.microsoftonline.com/common/v2.0", iss = client_id, sub = client_id ) client <- oauth_client( id = client_id, key = key, token_url = "https://login.microsoftonline.com/common/oauth2/v2.0/token", name = "azure", auth_params = list(claim = claim, header = list(x5t = cert_x5t)) ) token <- oauth_flow_client_credentials( client = client, scope = "https://management.azure.com/.default" ) expect_s3_class(token, "httr2_token") }) httr2/tests/testthat/test-req-cache.R0000644000176200001440000002143114643437760017266 0ustar liggesuserstest_that("nothing happens if cache not enabled", { req <- request("http://example.com") expect_false(cache_exists(req)) expect_equal(cache_pre_fetch(req), req) resp <- response() expect_equal(cache_post_fetch(req, resp), resp) }) 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) }) test_that("automatically adds to cache", { req <- request("http://example.com") %>% req_cache(tempfile()) expect_false(cache_exists(req)) resp <- response(200, headers = 'Etag: "abc"', body = charToRaw("OK")) cached <- cache_post_fetch(req, resp) expect_true(cache_exists(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_false(cache_exists(req)) cache_set(req, resp) expect_true(cache_exists(req)) expect_equal(cache_get(req), resp) # Uses new headers if available, otherwise cached headers out_headers <- cache_headers(req, 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(req, NULL), resp$body) expect_equal(resp_body_json(cache_get(req)), list(a = 1L)) # If path is set, need to save to path path <- tempfile() body <- cache_body(req, 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") expect_equal(cache_get(req)$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(req, NULL), new_path(body_path)) # If path is not null, copy to desired location, and update body path2 <- tempfile() body <- cache_body(req, 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_false(cache_exists(req)) saveRDS(1:10, req_cache_path(req)) expect_true(cache_exists(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.R0000644000176200001440000000253714556444037017527 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("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.R0000644000176200001440000001402414556444037016401 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 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, as_headers("A: 1") ) }) 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 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", { # need to skip on remote environment (CI or Workbench) and CRAN as can't read from clipboard there skip_on_ci() skip_on_cran() skip_if_not_installed("clipr") skip_if(getRversion() < "4.1") skip_if(is_hosted_session()) # need to set env var so that `read/write_clip()` works in non-interactive mode withr::local_envvar(CLIPR_ALLOW = TRUE) # suppress warning because the clipboard might contain no readable text old_clip <- suppressWarnings(clipr::read_clip()) withr::defer(clipr::write_clip(old_clip)) rlang::local_interactive() clipr::write_clip("curl 'http://example.com' \\\n -H 'A: 1' \\\n -H 'B: 2'") expect_snapshot({ curl_translate() # also writes to clip 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-iterate-responses.R0000644000176200001440000000123314556444037021106 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-oauth-flow-auth-code.R0000644000176200001440000001124214643437760021371 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") ) }) # 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() skip_on_covr() app <- webfakes::new_app() authorized <- FALSE # Error on first, and then respond on second app$get("/code", function(req, res) { if (!authorized) { authorized <<- TRUE res$ set_status(404L)$ set_type("text/plain")$ send("Not found") } else { res$ set_status(200L)$ send_json(text = '{"code":"abc123"}') } }) server <- webfakes::local_app_process(app) withr::local_envvar("HTTR2_OAUTH_CODE_SOURCE_URL" = server$url("/code")) expect_equal(oauth_flow_auth_code_fetch("ignored"), "abc123") }) httr2/tests/testthat/test-req-perform-stream.R0000644000176200001440000000570414645244703021166 0ustar liggesuserstest_that("req_stream() is deprecated", { req <- request(example_url()) %>% req_url_path("/stream-bytes/100") expect_snapshot( resp <- req_stream(req, identity, buffer_kb = 32) ) }) test_that("returns empty 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")[[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.R0000644000176200001440000000154714556444037016231 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("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))) output <- testthat::capture_messages(print(req, redact_headers = FALSE)) expect_true(any(grepl("Authorization: 'Basic", output))) expect_false(any(grepl("REDACTED", output))) }) test_that("check_request() gives useful error", { expect_snapshot(check_request(1), error = TRUE) }) httr2/tests/testthat/test-resp-headers.R0000644000176200001440000000406214556444037020017 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) }) 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) }) httr2/tests/testthat/test-req-headers.R0000644000176200001440000000234714556444037017641 0ustar liggesuserstest_that("can add and remove headers", { req <- request("http://example.com") req <- req %>% req_headers(x = 1) expect_equal(req$headers, structure(list(x = 1), redact = character())) req <- req %>% req_headers(x = NULL) expect_equal(req$headers, structure(list(), redact = character())) }) test_that("can add header called req", { req <- request("http://example.com") req <- req %>% req_headers(req = 1) expect_equal(req$headers, structure(list(req = 1), redact = character())) }) 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("can control which headers to redact", { expect_redact <- function(req, expected) { expect_equal(attr(req$headers, "redact"), expected) } req <- request("http://example.com") expect_redact(req_headers(req, a = 1L, b = 2L), character()) expect_redact(req_headers(req, a = 1L, b = 2L, .redact = c("a", "b")), c("a", "b")) expect_redact(req_headers(req, a = 1L, b = 2L, .redact = "a"), "a") 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.R0000644000176200001440000000353614556444037016727 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.R0000644000176200001440000000073414556444037017165 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_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, structure(list(Authorization = "Bearer abc"), redact = "Authorization")) }) httr2/tests/testthat/test-parse.R0000644000176200001440000000474014556453673016560 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-iterate.R0000644000176200001440000000453714556444037017101 0ustar liggesuserstest_that("can perform multiple requests", { req <- request(example_url()) %>% req_url_path("/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()) %>% req_url_path("/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()) %>% req_url_path("/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()) %>% req_url_path("/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-req-mock.R0000644000176200001440000000213414556444037017151 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({ 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/_snaps/0000755000176200001440000000000014643732273015615 5ustar liggesusershttr2/tests/testthat/_snaps/resp-status.md0000644000176200001440000000056214643751146020434 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.md0000644000176200001440000000110714643751144020052 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.md0000644000176200001440000000025314643751144017255 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.md0000644000176200001440000000171114643751145020416 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. # can request verbose record of request -> POST /post HTTP/1.1 -> Host: http://example.com -> User-Agent: verbose -> Accept: */* -> Accept-Encoding: gzip -> Content-Length: 17 -> >> This is some text # 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.md0000644000176200001440000000110214643751146020421 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.md0000644000176200001440000000304514643751146022075 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.md0000644000176200001440000000024014643751145020216 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.md0000644000176200001440000000155014643751146016727 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 # individually prints repeated headers Code request("https://example.com") %>% req_headers(A = 1:3) Message GET https://example.com Headers: * A: '1' * A: '2' * A: '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.md0000644000176200001440000000073014643751145017660 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". httr2/tests/testthat/_snaps/resp-body.md0000644000176200001440000000214114643751146020041 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.md0000644000176200001440000000642514643751144017111 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)) Message Output Accept: application/vnd.api+json user-agent: agent Code print(curl_simplify_headers(headers, simplify_headers = FALSE)) Message 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 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 clipr::read_clip() Output [1] "request(\"http://example.com\") |> " " req_headers(" [3] " A = \"1\"," " B = \"2\"," [5] " ) |> " " req_perform()" # encode_string2() produces simple strings Code curl_translate(cmd) Output request("http://example.com") |> req_method("PATCH") |> req_body_raw('{"data":{"x":1,"y":"a","nested":{"z":[1,2,3]}}}', "application/json") |> req_perform() httr2/tests/testthat/_snaps/oauth-flow-refresh.md0000644000176200001440000000026214643751144021656 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-stream.md0000644000176200001440000000264414643751145021674 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.md0000644000176200001440000000254014643751145017767 0ustar liggesusers# cache emits useful debugging info Code # Immutable invisible(cache_pre_fetch(req)) invisible(cache_post_fetch(req, resp)) Message Saving response to cache "f3805db63ff822b4743f247cfdde10a3" Code invisible(cache_pre_fetch(req)) Message Pruning cache Found url in cache "f3805db63ff822b4743f247cfdde10a3" Cached value is fresh; retrieving 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/iterate-helpers.md0000644000176200001440000000275514643751143021242 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.md0000644000176200001440000000104714643751146017426 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.md0000644000176200001440000000242714643751142020571 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.md0000644000176200001440000000033614643751147020342 0ustar liggesusers# can control which headers to redact 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.md0000644000176200001440000000140714643751146020541 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.md0000644000176200001440000000034214643751145020377 0ustar liggesusers# 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. httr2/tests/testthat/_snaps/req-cookies.md0000644000176200001440000000033214643751144020354 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.md0000644000176200001440000000336114643751146020401 0ustar liggesusers# curl errors become errors Code req_perform(req) Condition Error in `req_perform()`: ! Failed to perform HTTP request. Caused by error in `req_perform1()`: ! 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. # 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. # req_dry_run() shows body Code request("http://example.com") %>% req_headers(`Accept-Encoding` = "gzip") %>% req_body_json(list(x = 1, y = TRUE, z = "c")) %>% req_user_agent("test") %>% req_dry_run() Output POST / HTTP/1.1 Host: example.com User-Agent: test Accept: */* Accept-Encoding: gzip Content-Type: application/json Content-Length: 24 {"x":1,"y":true,"z":"c"} # authorization headers are redacted Code request("http://example.com") %>% req_headers(`Accept-Encoding` = "gzip") %>% req_auth_basic("user", "password") %>% req_user_agent("test") %>% req_dry_run() Output GET / HTTP/1.1 Host: example.com User-Agent: test Accept: */* Accept-Encoding: gzip Authorization: httr2/tests/testthat/_snaps/url.md0000644000176200001440000000205314643751147016742 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`. # validates inputs Code query_build(1:3) Condition Error: ! Query must be a named list. Code query_build(list(x = 1:2, y = 1:3)) Condition Error: ! Query value `x` must be a length-1 atomic vector, not an integer vector. # 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.md0000644000176200001440000000205014643751146017105 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) # 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.md0000644000176200001440000000052014643751143021020 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-mock.md0000644000176200001440000000140214643751145017651 0ustar liggesusers# local_mock and with_mock are deprecated Code local_mock(~ response(404)) Condition Warning: `local_mock()` was deprecated in httr2 1.0.0. i Please use `local_mocked_responses()` instead. Code . <- with_mock(NULL, ~ response(404)) Condition Warning: `with_mock()` was deprecated in httr2 1.0.0. 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/iterate.md0000644000176200001440000000227114643751144017574 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/oauth-flow.md0000644000176200001440000000146114643751144020224 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.md0000644000176200001440000000347114643751144020536 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", token_url = "http://example.com") Message name: bf27508f7925b06bf28a10f3805351ab id: x token_url: http://example.com auth: oauth_client_req_auth_body Code oauth_client("x", secret = "SECRET", token_url = "http://example.com") Message name: bf27508f7925b06bf28a10f3805351ab id: x secret: token_url: http://example.com auth: oauth_client_req_auth_body httr2/tests/testthat/_snaps/req-url.md0000644000176200001440000000170414643751146017530 0ustar liggesusers# can handle multi query params Code req_url_query_multi("error") Condition Error in `req_url_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 `req_url_query()`: ! All components of `...` must be named. Code req %>% req_url_query(a = I(1)) Condition Error in `req_url_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 `req_url_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 `req_url_query()`: ! All elements of `...` must be either an atomic vector or NULL. httr2/tests/testthat/_snaps/oauth-token.md0000644000176200001440000000045614643751144020400 0ustar liggesusers# 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/sequential.md0000644000176200001440000000055114643751146020312 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/headers.md0000644000176200001440000000112514643751142017545 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:")) Message Output X: 1 Y: 2 Z: Code as_headers(list()) Message # 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.md0000644000176200001440000000041714643751147017302 0ustar liggesusers# modify list adds, removes, and overrides Code modify_list(x, a = 1, 2) Condition Error: ! All components of `...` must be named. # can suppress progress bar Code sys_sleep(0.1, "for test") Message > Waiting 1s for test httr2/tests/testthat/_snaps/multi-req.md0000644000176200001440000000133514643751146020060 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`. # errors by default Code req_perform_parallel(reqs[1]) Condition Error in `req_perform_parallel()`: ! HTTP 404 Not Found. Code req_perform_parallel(reqs[2]) Condition Error in `req_perform_parallel()`: ! Could not resolve host: INVALID # 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() httr2/tests/testthat/test-req-template.R0000644000176200001440000000324314556444037020035 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-cookies.R0000644000176200001440000000114614556444037017656 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")) }) httr2/tests/testthat/test-req-url.R0000644000176200001440000001057114556444037017026 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 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=,") }) # 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.R0000644000176200001440000000571314643732273016242 0ustar liggesuserstest_that("can parse special cases", { url <- url_parse("//google.com") expect_equal(url$scheme, NULL) expect_equal(url$hostname, "google.com") url <- url_parse("file:///tmp") expect_equal(url$scheme, "file") expect_equal(url$path, "/tmp") url <- url_parse("/") expect_equal(url$scheme, NULL) expect_equal(url$path, "/") }) test_that("can round trip urls", { urls <- list( "/", "//google.com", "file:///", "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 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("ensures path always starts with /", { expect_equal( url_modify("https://example.com/abc", path = "def"), "https://example.com/def" ) }) test_that("password also requires username", { url <- url_parse("http://username:pwd@example.com") url$username <- NULL expect_snapshot(url_build(url), error = TRUE) }) # query ------------------------------------------------------------------- test_that("missing query values become empty strings", { expect_equal(query_parse("?q="), list(q = "")) expect_equal(query_parse("?q"), list(q = "")) expect_equal(query_parse("?a&q"), list(a = "", q = "")) }) test_that("handles equals in values", { expect_equal(query_parse("?x==&y=="), list(x = "=", y = "=")) }) test_that("empty queries become NULL", { expect_equal(query_parse("?"), NULL) expect_equal(query_parse(""), NULL) }) test_that("validates inputs", { expect_snapshot(error = TRUE, { query_build(1:3) 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-multi-req.R0000644000176200001440000000654714643732273017365 0ustar liggesuserstest_that("request and paths must match", { req <- request("http://example.com") expect_snapshot(req_perform_parallel(req, letters), error = TRUE) }) test_that("requests happen in parallel", { # GHA MacOS builder seems to be very slow skip_if( isTRUE(as.logical(Sys.getenv("CI", "false"))) && Sys.info()[["sysname"]] == "Darwin" ) reqs <- list2( 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), 150) 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", { reqs <- list2( request_test("/status/:status", status = 404), request("INVALID") ) expect_snapshot(error = TRUE, { req_perform_parallel(reqs[1]) req_perform_parallel(reqs[2]) }) }) 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 = 2), ) out <- req_perform_parallel(reqs, on_error = "return") expect_s3_class(out[[1]], "httr2_http_404") expect_null(out[[2]]) }) test_that("multi_req_perform is deprecated", { expect_snapshot(multi_req_perform(list())) }) httr2/tests/testthat/test-oauth-flow-jwt-google.rds0000644000176200001440000000355514070400763022160 0ustar liggesusersgY{.N$6nrK_Δ ڕ6$Tep8 R:,\Ig}n:l>S^}-RO۞k;4Q[ BZrv@hp,2l)a51d@3zwD/%c+/ ϖKyL,*א$(C1c6nÆaxLe=*7dzܫlHd 5CUm;Cpk1Z r=~4p՟ʿ>fG0>]NC3+(`BiKB,@|j0^[ Ws,$# ZD,pMi@4ˏ :RmSxwg] "|=7e?9SS&PW^yfNj \0Y/$8ML Vw[oQ̴e||fvG4B7/!=LylP]H`@Kgʍ1'xo6Yb\7!Kņ5T]'ߝdAh%#-8nMWG0) ] "Abyv;`!Wh {5д!VО>4u^3 2q $!2EspX( >vCg}k# W˴ȋH,236AID_ P{( oI.F)KPT$RRUaMQ weGǴ\sl qX='vÓXe&—6|U@x~?lLF*Eѧ:^FXARkDkwtf0X4qݼ|Z.eap `FAĉRr.DeE-5|FlW8)n>,ےwW"mw0tnVf16wLOU3gM[/""1ZWm'R(@YGK*M{'C~dIw Y[>4C/aTb)W 1"u>@ '?ujtuEv 1zY^÷flm`M)֙cVL(sv(Fw]wvҠn_6U`PAl0vFBΒصHkR%_p/b P6JMMI!<kīB Sn/qxwqz;>UH /u?p!oq#E%r 9* ~q5!:̅݀J (t}Kz_L6~[$%}>A 0G0bἇ~mlng[s,HBQOw,Szg7}t1?Wl<+gm Z$z:PzM)eGAΗ}X׃s`#rvC3-ȢEkŷW)u Wq7Ebl_,FCZyddԇ]]Q/^.~$&~}# p&mXJ^WK昬ف1/^3* e(V!vІꢴI=A}C.OVīL!hq:W g9fhttr2/tests/testthat/azure-key.rds0000644000176200001440000000550514070400763016753 0ustar liggesuserșv(9/AKAzFa^Pac uaʚI*U,.?3Xar-+E`M`{Y;ʹ3'Hzm MDVN{:V='XXBT~q7|rLkDfҴs͊'/-gz/mAoy0R!pM*N\yGݘ U]L9*Y< M= uE|J7>|kAK ޢHڍjr%xAAHj_] 369yzJ6W筫F?} $?tಏ'O) 0ߚDш'3T@ l#oomk~PGfʯP]fheJsz+iuM!1S 53-KO×dQq<H, {_unV NO4y`֊l)tf[R X>qn~)B:Rי{D&$e 3Je[&r\ Qo#F0bQعʍ98T"`s]m)j;ByIL{܊jurBH"$i!3$B; aوX˲Ջ _FhWv'8͒7] .>Ň4j\~鏠Q[ ?PNٽ狊78?u{k;ts,S /2N#3Y&.R`t F}'za/ .W:?A!t#+~F)0^DOÒ隶ЋB0Kcؗm.3uGT*Ba:.oVtFէQS4}oo" 0FTFBє685-g)McDI7MvճWsG{Ӵ(@eo5:JN;L۝۫8z &cgu[|$yYsZm9W&W 9i></r)aCx"2FCGM51_DgKVG9Ju\/A-{a詛 3^滳˜vjՃvʶaS}$~Y5C+IfV{u'k  9#=y%W'STTmO yԕpVdۗ:E{RN6"#zcQj8غvI(w@̬LX-,3W٧H!n7&@(OÝX, s4 qݮL=Q^P.^(b|lm9d'>| %tn#ؿJ/yI M;4l^.Ys@Aذ}r],RIW//-X3lHU hdW~ Z% F>9}L&Ȉ~=xQ*D9 CI[ٙUL s. >4UJ#䏁 ~ݎ!1zvM| ~3 ƕݹeMxT~"tH NBYɝ$6jYPBaIh2׍yPt%􀯡>昇E͠%B6hTzȥ*7tzd}0f*\)&`jr`M=Ou*(k&@,5 4YHgoY'򞑼U)|,uVE"yR b9 t^͑Ӷ7BV^ZJG=񁃅qz1J0r&>8#:P]aw2&E›_ڱ_#Q{g>P/Th2N*ȸD_4b5&"K9v\Yhd,1YMlA)&o[kXԇB&}xYY"]IB– .RjDBi&•Q`&)n-~5)&vXWxwFFV=%|gaӱp_K~uiߺҘl7=O%/P6 h?2ǁQ=2$!O햆 3? ApFW% 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_oauth$cache$get(), NULL) expect_equal(req2$policies$auth_oauth$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_oauth$cache$set(token) # req1 cache must be filled, but req2 cache still be empty expect_equal(req1$policies$auth_oauth$cache$get(), token) expect_equal(req2$policies$auth_oauth$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-sequential.R0000644000176200001440000000343614556444037017613 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/test-resp-status.R0000644000176200001440000000102314060043547017710 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.R0000644000176200001440000000751214643705565017702 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( req_perform1 = 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) }) 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") }) 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("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(resp2 <- req_perform(req), class = "httr2_cache_not_modified") }) 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("can last response is NULL if it fails", { req <- request("frooble") 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) }) }) # dry run ----------------------------------------------------------------- test_that("req_dry_run() returns useful data", { resp <- request("http://example.com") %>% req_dry_run(quiet = TRUE) expect_equal(resp$method, "GET") expect_equal(resp$path, "/") expect_match(resp$headers$`user-agent`, "libcurl") }) test_that("req_dry_run() shows body", { # For reasons I don't understand, returns binary data in R 3.4 skip_if_not(getRversion() >= "3.5") expect_snapshot({ request("http://example.com") %>% req_headers(`Accept-Encoding` = "gzip") %>% req_body_json(list(x = 1, y = TRUE, z = "c")) %>% req_user_agent("test") %>% req_dry_run() }) }) test_that("authorization headers are redacted", { expect_snapshot({ request("http://example.com") %>% req_headers(`Accept-Encoding` = "gzip") %>% req_auth_basic("user", "password") %>% req_user_agent("test") %>% req_dry_run() }) }) 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-req-options.R0000644000176200001440000000402114556444037017710 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("can set user agent", { ua <- function(...) { request("http://example.com") %>% req_user_agent(...) %>% .$options %>% .$useragent } expect_match(ua(), "libcurl") expect_equal(ua("abc"), "abc") # non-R-ish library version for curl, #416 with_mocked_bindings( curl_system_version = function(...) "8.4.0-DEV", code = expect_match(ua(), "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("can request verbose record of request", { req <- request_test("/post") %>% req_body_raw("This is some text") # Snapshot test of what can be made reproducible req1 <- req %>% req_headers("Host" = "http://example.com") %>% req_headers(`Accept-Encoding` = "gzip") %>% req_user_agent("verbose") %>% req_verbose(header_resp = FALSE, body_req = TRUE) expect_snapshot_output(invisible(req_perform(req1))) # Lightweight test for everything else req2 <- req %>% req_verbose(info = TRUE, body_resp = TRUE) expect_output(req_perform(req2)) }) 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.R0000644000176200001440000000411214556444037020062 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 ) }) httr2/tests/testthat/test-req-throttle.R0000644000176200001440000000162014643752277020071 0ustar liggesuserstest_that("first request isn't throttled", { skip_on_cran() throttle_reset() req <- request_test() %>% req_throttle(50 / 1) expect_equal(throttle_delay(req), 0) expect_true(throttle_delay(req) > 0) }) test_that("throttling causes expected average request rate", { skip_on_cran() skip_on_ci() throttle_reset() nps <- 20 req <- request_test() %>% req_throttle(nps) times <- replicate(20, bench::system_time(req_perform(req)))["real", ] trimmed <- mean(times, trim = 0.2) expect_equal(trimmed, 1/nps, tolerance = 0.1) }) test_that("realm defaults to hostname but can be overridden", { throttle_reset() expect_equal(the$throttle, list()) request_test() %>% req_throttle(100 / 1) %>% throttle_delay() expect_named(the$throttle, "127.0.0.1") throttle_reset() request_test() %>% req_throttle(100 / 1, "custom") %>% throttle_delay() expect_named(the$throttle, "custom") }) httr2/tests/testthat.R0000644000176200001440000000006614053164547014455 0ustar liggesuserslibrary(testthat) library(httr2) test_check("httr2") httr2/MD50000644000176200001440000003222114645436632011642 0ustar liggesusers99b0355fb1c5b18c15a68defe0a9a09f *DESCRIPTION 67c32986371e772e798cc5d9f2dcc504 *LICENSE b9c15237262005b2b4b107c3e47db558 *NAMESPACE 2819437cbd45e9c8693962de68059963 *NEWS.md c1041d3e5f2c78fe8a21428122366ced *R/content-type.R c278fb8592472e79e10bc23f297f3f93 *R/curl.R 3dd7ea652be40280bb2f0727674c88b3 *R/headers.R afbf873cadbcb08f4780e287227f9f95 *R/httr2-package.R c80a9eb1427c585807cecf618b6f3870 *R/import-standalone-obj-type.R 17bb123964057b839a42eda1c3da214b *R/import-standalone-purrr.R c40f882046a958444c6058a9e2cb9a3b *R/import-standalone-types-check.R 9b30eaec39a5108b8d433a20f9634c02 *R/iterate-helpers.R 6a481f63dd4378d148d3fead8e0f170e *R/iterate-responses.R 8cba43d51e052109fde790e9373b0fb4 *R/iterate.R f43f49a4b4eb026b75bb9ef5d83fed82 *R/jwt.R 6e137fc5ade07d83b179046fe2f630be *R/multi-req.R 79d90da9b180fcd73a639576a84eac75 *R/oauth-client.R f12d195a3dea191330d44e9033fa4a66 *R/oauth-flow-auth-code.R c3ce5dfe46ffb7653b56cb5775727801 *R/oauth-flow-client-credentials.R cefe8f9c276bc7c56d587569721b549d *R/oauth-flow-device.R 01bf1e60268112e99fef17aa25769a91 *R/oauth-flow-jwt.R a360f6bb6ab0e30d04367a682be44375 *R/oauth-flow-password.R 337a827f3d46c456e243282e1ac839fa *R/oauth-flow-refresh.R ee4f023060bba5377c255f390578459b *R/oauth-flow.R e61af568972d4a7c08105046de860163 *R/oauth-token.R 3a8d6c828cb08b45a24a0ebafcbb0d60 *R/oauth.R 750539f93e92d55bcccfcf9960f78b8d *R/parse.R 9b92feda3bc2daee5fd60f5d1418fe03 *R/progress-bars.R ce08586490a871eff3cc5154fb92f8f1 *R/progress.R 0ad8a12bf7f3993e45e4e4df582f5bea *R/req-auth.R d2811542de5de440a13254167d0f8c53 *R/req-body.R fd391b36c9ec78e78f7c05e21a751137 *R/req-cache.R edfe01cacb7b2b3ec0dc39b15936310e *R/req-cookies.R 57cdca5cee4acb32444edc8f31dcb308 *R/req-error.R f541ab8aed99da114e2587ea95740268 *R/req-headers.R c64e21ca81ec2590c380e74b89a9119f *R/req-method.R b2d2fbde7e21f1998a435a1030a9e6d8 *R/req-mock.R dce27be3c1df189d13ce46c0ae34ed5b *R/req-options.R 24bc9ca752c2167dc1b52571954aacc2 *R/req-perform-stream.R d202eac31f2a46995f5be21c2202cb16 *R/req-perform.R 06612e2c3c9ca2995093c9174a3761ed *R/req-policy.R a79bab5c6953da46018526206e68538d *R/req-retries.R 7bb3ae0b8e81f01c95fe3ed31fdb5ad5 *R/req-template.R 9f4e7ddd91153539e0d0de50cec4e134 *R/req-throttle.R 09e8a5d0e0b1ea1bf62d8cc7ec66b8ed *R/req-url.R 821d72eec992114b1f4742f90ef9009b *R/req.R 01e33646406600ff472df700064d180f *R/resp-body.R f68a50b99510fb65fe7820e54fb67670 *R/resp-headers.R 458cc0a7eb6a6f17289bb64f5ba3be5e *R/resp-status.R 39d5f298764933e96f387286bc493803 *R/resp-url.R 4655a61f080c92cd0edc7c7412abdb9b *R/resp.R 8f02cbe77f0b346ddaf3a7e5158e387c *R/roxygen2.R 408bf7f07d0afed779052517cfd8a385 *R/secret.R 8611225eaae018886d7b065ce4adf77f *R/sequential.R 18fbe8fc2497eef4d6f13c7e45f5508f *R/sysdata.rda 6881874c333e437635f727d738b95dc9 *R/test.R 3d7e9eb9a493e7fa15f5da01751697a9 *R/url.R 3e468224dbe2421903303c28f1912a4f *R/utils-multi.R b56ff2b193ecba52f9ec7f3b10cca008 *R/utils-pipe.R 4dc0966277b5e67299b4404a9dd97380 *R/utils.R 059a3c630cbf1d8cba089f78486fa4d9 *R/zzz.R 2cd50727a3047e2aad0fd9ba1877987e *README.md ed7097e327faf147198f31bb3553c326 *build/vignette.rds de3fc7fc6d5f0ec1ddf799c84d04a63e *cleanup b547518249e0da4528616c8ed2382036 *configure 757ef8281ef2a1ebcbcc8235aeee2d0e *configure.win 4c016f11271a67f3da4aa0690edaf025 *inst/doc/httr2.R 9249b39665759aeaa85e75a450706103 *inst/doc/httr2.Rmd bf2acb7d9a059969f040336b9f06f204 *inst/doc/httr2.html 8ac6a7b7aac968e8a0e93c58049261ef *man/curl_translate.Rd fc06ec6c9f17492418496a7875111a55 *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 a6b2fc640f68348bb1df1e055a55710a *man/iterate_with_offset.Rd 67e0fd24da4ca84954a19e1b8245c23c *man/jwt_claim.Rd bbdae5dea29b21d47d7c7069c0d46ab1 *man/last_response.Rd 1200a1db05ee6346892b31e817699323 *man/multi_req_perform.Rd 9b54af46994b24405f4751fd1086c06f *man/oauth_cache_path.Rd 28127c166aacb0222ee462c49822f29e *man/oauth_client.Rd 363e6047dd2e919c90f987b11102661a *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 749f778abd6ba1366ee072c729da862d *man/oauth_token_cached.Rd 622607c5f5df647186110c9b1ce435b5 *man/obfuscate.Rd 8f4aad003a999fae004ba9361f9a99d6 *man/pipe.Rd 4cfc1fa751b1d593aad4a6911539bfc2 *man/progress_bars.Rd 8665f6d88893ca77c28f40cccac06397 *man/req_auth_basic.Rd c071d27d04a9211653d9f2c5d5c9554a *man/req_auth_bearer_token.Rd 4e388564c5f4ca114e831102230a08db *man/req_body.Rd 20c85dec2efc907c42686159acd2b528 *man/req_cache.Rd 94b43cd4d8515cf2abcaa18e136cc467 *man/req_cookie_preserve.Rd 7e6416e0a9e91d9394646c6787b24d6c *man/req_dry_run.Rd b8a8fb030466789aa4b517d9fe7cfbe0 *man/req_error.Rd 014d664aff294cdc7906257a1c5c92b8 *man/req_headers.Rd a3c7e94d5667e8a7008f481b74d7e47a *man/req_method.Rd cc91c6f0578cbce28d662266d8750890 *man/req_oauth.Rd 245f8d31741cb3196d66c9578c659d06 *man/req_oauth_auth_code.Rd ce166517d08a5ae5d17c84109a8c4ebc *man/req_oauth_bearer_jwt.Rd b6930bd13ac3338ded8d0f6f7d04d626 *man/req_oauth_client_credentials.Rd 0ea330400a139a386fed04dd06b58cd7 *man/req_oauth_device.Rd daa8bc840ca24d29da955edd2a3abc33 *man/req_oauth_password.Rd 4836b78fddaf2d716f68089b1e2f7919 *man/req_oauth_refresh.Rd d0bfcfa3163dd92ba9dc87393077fda3 *man/req_options.Rd dc3b34c0e7e8cce77eae80efc333d764 *man/req_perform.Rd a44520b3a117da36d55f97668ceb4876 *man/req_perform_iterative.Rd eb9b8e9565341c6570e447d0b05e2231 *man/req_perform_parallel.Rd b47b161361b1b4595891e76c0df7423b *man/req_perform_sequential.Rd 295ed25c3a208d596ccba7a40f90b76a *man/req_perform_stream.Rd b41d5e8f316515288ff886df0e4881d7 *man/req_progress.Rd 59d22ad187fbc4ace51383c670989560 *man/req_proxy.Rd d791fa7489d220f72c37127ce0793746 *man/req_retry.Rd 85c4960994e29dd42cf9229644b13048 *man/req_template.Rd a0afa2ba048b9bf1d2ac95a119863eb2 *man/req_throttle.Rd 79528808d74e5c9cb1b323d07c672cc0 *man/req_timeout.Rd 7ddb44c7b48380eb6bb28f2e6a0be23f *man/req_url.Rd 6848c55cdfdf0e6e8d1bbfb66523dafe *man/req_user_agent.Rd ec13797048b64a2290587c8eeff06864 *man/req_verbose.Rd 86431a6776c6bce76aa9039d3369d130 *man/request.Rd a3307daf39b928c4688e48ff39b5e86d *man/resp_body_raw.Rd 08f675c317916198c73456c25493aad1 *man/resp_check_content_type.Rd 6ae157ce986f4fdf165c0a6ac0ff4086 *man/resp_content_type.Rd 296488452ba2bccb344c32fba170ad17 *man/resp_date.Rd eeecb518000b961f0cc080ca8210d2e5 *man/resp_headers.Rd 8a610a29036f14bbea3513167894bc60 *man/resp_link_url.Rd 74da3657f55ca00d40f2578fde92fd10 *man/resp_raw.Rd f2e4f673eeac27726e79caea8860e5d6 *man/resp_retry_after.Rd 46156e9abe2a1aee73a63f2ef36ebf82 *man/resp_status.Rd da54f7d09ea69abcb72b60a5147d33f5 *man/resp_url.Rd 712d1929f961ef8b93224aab5238fd30 *man/response.Rd 7149070f6fbc8cbf62db975f8c0c468e *man/resps_successes.Rd 575da98679a53e6989ce1b94517b6ed8 *man/secrets.Rd ddef6b65c32aabc60f757ed193a88134 *man/signal_total_pages.Rd 3045c501a77cbffeda91c520dfccfe1f *man/throttle_status.Rd 8cb5433fa4b42103e4039005fc54278c *man/url_parse.Rd 1db5ba24b3f55a0ab371859f591c26ba *man/with_mocked_responses.Rd ee022e3c977f1c527ec0ec29a0c22eb6 *man/with_verbosity.Rd c2b2cef37a5921be7c43b192f6ab8cae *tests/testthat.R 2abbb09e4412155bb8c71d2f5d01f842 *tests/testthat/_snaps/content-type.md 1d96277aefa951c04ab5e854cfc54aa9 *tests/testthat/_snaps/curl.md bd0372ba1a8a3abbcd4986ce7b05fb59 *tests/testthat/_snaps/headers.md 80f7f8dd80eaec7d4dd7dcbf843b5522 *tests/testthat/_snaps/iterate-helpers.md 7fed77e81c3f22fa048ff542e406e40d *tests/testthat/_snaps/iterate.md 63c889187a3db35ac3a458a83acb854f *tests/testthat/_snaps/multi-req.md b69a85489f0e5c965c2f6f6ed6678e25 *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 22b30aee6b8ca0a8ecbb0e1ee2f1bd90 *tests/testthat/_snaps/oauth-token.md ec27f758dc64156a63a37151654938ac *tests/testthat/_snaps/oauth.md 46bbfab227503b1e6b3c5f408befb4a0 *tests/testthat/_snaps/req-body.md 43ad35fce622bb9a09fb3bb7d1682b65 *tests/testthat/_snaps/req-cache.md 3e31359c6520222447d6233f39f415b9 *tests/testthat/_snaps/req-cookies.md f9c831a6fd93a36222a2f8b026dcb933 *tests/testthat/_snaps/req-error.md bc00406611a4379e24b3a5e20c84ba1e *tests/testthat/_snaps/req-headers.md f9590c20318dd7d97c35ad3c6410040d *tests/testthat/_snaps/req-mock.md 5197a993461f4b825ee8a646be0d96cf *tests/testthat/_snaps/req-options.md 304742dbf0ddb5549a47bddcb27b8b6b *tests/testthat/_snaps/req-perform-stream.md 94f451fd8a53349fc62f3d59e6f4f53c *tests/testthat/_snaps/req-perform.md 9b07d019e4eab37f0f6d97245e61535f *tests/testthat/_snaps/req-policy.md 864e3c8110ff03831ed3c5f1d9af5697 *tests/testthat/_snaps/req-retries.md a6aa2b17597e91ded969ff83d8ae1aa7 *tests/testthat/_snaps/req-template.md 76cbea12ce426ece85dbe3e03a9a12ef *tests/testthat/_snaps/req-url.md 05349394ee4361f76aaf4c3519bccfb0 *tests/testthat/_snaps/req.md 60e6374c33a9a6251ee9662ec1eab2cb *tests/testthat/_snaps/resp-body.md dd83ab51d56154baedd0fce1794d4b78 *tests/testthat/_snaps/resp-status.md 1ba4bf30863a89df8376edaed8e79239 *tests/testthat/_snaps/resp.md 9a2997f35ff08553b17ad7ffd5445ee2 *tests/testthat/_snaps/secret.md 23197b884a9489a8ba9f505cf7502382 *tests/testthat/_snaps/sequential.md a09476510fc0c89f7e10f102561a24a0 *tests/testthat/_snaps/url.md 44c5d6d7c37249a3c71939b83eafa622 *tests/testthat/_snaps/utils-multi.md 174c1cf3a6b256064d31f351d8928bea *tests/testthat/_snaps/utils.md da0824f5ba70df4cb80983244d7a07d6 *tests/testthat/azure-cert.rds 6d46dd9362a66c2dc7a7b7ca04e24b66 *tests/testthat/azure-key.rds 63864fa9e8c9e485bdf6026c2aeb5f1a *tests/testthat/test-content-type.R de7d680b20f1dca3c0591375f01f6a5e *tests/testthat/test-curl.R bb05f379e71b020064f3b0db5a23922f *tests/testthat/test-headers.R 5be02d74f062de3487e54c8d4bfa25d7 *tests/testthat/test-iterate-helpers.R 6d3ec8a9144133090eb42a027c84d50b *tests/testthat/test-iterate-responses.R b9552006cdd1edef956efff4947361ab *tests/testthat/test-iterate.R b3706469622e045c3bf73e4f3499ec82 *tests/testthat/test-multi-req.R da1c04bca53e199b761be5b06efde1a8 *tests/testthat/test-oauth-client.R b51ba3ea94ac474cfca31050a8f65cb8 *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 efe3300855e884d06ee918dc585d9745 *tests/testthat/test-oauth-flow-refresh.R 651f1049628a54d0e03fd5449ba45aaf *tests/testthat/test-oauth-flow.R 3b6a5ecf363085dbaf2e9bb26f82bdb9 *tests/testthat/test-oauth-token.R 25dfa670e19932258cd4952d71033d7e *tests/testthat/test-oauth.R b1e61d719adf03c5a3747ecc5670a4c1 *tests/testthat/test-parse.R 9731ce2fae5c9084c1797c99dd5245a3 *tests/testthat/test-req-auth.R e1853cc4551a4d6a1ef54b1cdc7cbb4d *tests/testthat/test-req-body.R 5d949c19e6c49199a8617779beea26a3 *tests/testthat/test-req-cache.R 39f39eb2537f77eddd52c448a39f3122 *tests/testthat/test-req-cookies.R 714ebb7e5bd7747e518a6accbc0f6e53 *tests/testthat/test-req-error.R 4ca49c15d21c65abc3a132754e40139b *tests/testthat/test-req-headers.R abe3ec676219640db627c485562b04c3 *tests/testthat/test-req-method.R 1ba643659b0ab592408244bff0542d53 *tests/testthat/test-req-mock.R da98932f68102ee2b1cf07eca3ae614b *tests/testthat/test-req-options.R be700155734db19960aa00305d301d09 *tests/testthat/test-req-perform-stream.R 386247e127935f0da2657f87fe90bc97 *tests/testthat/test-req-perform.R 8e5b70954049fa379b900743857d68d0 *tests/testthat/test-req-policy.R f2a24acdeb733020380392f45d8c581d *tests/testthat/test-req-retries.R ae3b9e9c19ac87aa2cc32e5fbca040a9 *tests/testthat/test-req-template.R ae0aaa8920ca07f421ba3e1a00b56f40 *tests/testthat/test-req-throttle.R 7dbc34e12b4fc2507f844c9fff1edf24 *tests/testthat/test-req-url.R 3409ac8868b4ef7459bf20c2109c6dd0 *tests/testthat/test-req.R be67c09b38777922c22e5345c9cf3297 *tests/testthat/test-resp-body.R 02cfdcfb6810eaddb3c4dd329eaf9cbc *tests/testthat/test-resp-headers.R 306705998dbf3b108cbeb46449a01ec5 *tests/testthat/test-resp-status.R 2a891e35620fe4003801eb3be2faceed *tests/testthat/test-resp-url.R 3d36f3ef3d15bc7d9739ab50c175ae83 *tests/testthat/test-resp.R 6e1cf597de2078da4f7cad93112d6b9e *tests/testthat/test-secret.R 57013c2bbff9e24e5d76e5f86b163217 *tests/testthat/test-sequential.R 22cd2141eafbe522695d75e4e7006375 *tests/testthat/test-url.R 2f68cfd0571464f93d4e04e46824605a *tests/testthat/test-utils-multi.R fb2f5c3f74f043b5c470cc752a0bb773 *tests/testthat/test-utils.R 04b0a09ebe1847f15c2b36527ba834ca *tools/examples.R 9249b39665759aeaa85e75a450706103 *vignettes/httr2.Rmd httr2/configure.win0000644000176200001440000000004314556444037014026 0ustar liggesusers#! /usr/bin/env sh sh ./configure httr2/R/0000755000176200001440000000000014645305454011530 5ustar liggesusershttr2/R/oauth-token.R0000644000176200001440000000535114556444037014117 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 = "/"), ">")) redacted <- list_redact(x, c("access_token", "refresh_token", "id_token")) if (has_name(redacted, "expires_at")) { redacted$expires_at <- format(.POSIXct(x$expires_at)) } # https://github.com/r-lib/cli/issues/347 is_empty <- map_lgl(redacted, ~ .x == "") redacted[is_empty] <- "''" cli::cli_dl(compact(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/progress.R0000644000176200001440000000326114556444037013523 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-mock.R0000644000176200001440000000525414556444037013401 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_warn("1.0.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.0.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/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/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/iterate-helpers.R0000644000176200001440000001025214556444037014752 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.R0000644000176200001440000000521714556444037015403 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 `vignette("oauth")`. #' #' @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.R0000644000176200001440000000771114643705565013604 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 ) } ) } httr2/R/resp-url.R0000644000176200001440000000213614556444037013430 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.R0000644000176200001440000000214714556444037014102 0ustar liggesusers#' Preserve cookies across requests #' #' By default, httr2 uses a clean slate for every request meaning that cookies #' are not automatically preserved across requests. To preserve cookies, you #' must set a cookie file which 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 #' path <- tempfile() #' httpbin <- request(example_url()) |> #' req_cookie_preserve(path) #' #' # Manually set two cookies #' httpbin |> #' req_template("/cookies/set/:name/:value", name = "chocolate", value = "chip") |> #' req_perform() |> #' resp_body_json() #' #' httpbin |> #' req_template("/cookies/set/:name/:value", name = "oatmeal", value = "raisin") |> #' 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 ) } 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.R0000644000176200001440000000370114556453673015340 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. #' @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/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.R0000644000176200001440000001211214556444037014144 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 { resp_abort(resp, resp$request, info, call = error_call) } } resp_abort <- function(resp, req, info = NULL, call = caller_env()) { status <- resp_status(resp) desc <- resp_status_desc(resp) message <- glue("HTTP {status} {desc}.") abort( c(message, resp_auth_message(resp), info), status = status, resp = resp, class = c(glue("httr2_http_{status}"), "httr2_http", "httr2_error"), request = req, call = call ) } # 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.R0000644000176200001440000000766514643703753013577 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. #' #' @param resp A response object. #' @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.") } else if (is_path(resp$body)) { readBin(resp$body, "raw", file.size(resp$body)) } else { resp$body } } #' @rdname resp_body_raw #' @export resp_has_body <- function(resp) { check_response(resp) if (is_path(resp$body)) { file.size(resp$body) > 0 } else { length(resp$body) > 0 } } #' @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 ) xml2::read_html(resp$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 ) resp$cache[[key]] <- xml2::read_xml(resp$body, ...) resp$cache[[key]] } body_cache_key <- function(prefix, ...) { key <- hash(list(...)) paste0(prefix, "-", substr(key, 1, 10)) } httr2/R/oauth-client.R0000644000176200001440000002060714556444037014256 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")) cli::cli_dl(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. #' @param req A [request]. #' @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.R0000644000176200001440000000421614556444037013745 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, 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." ), 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.R0000644000176200001440000000453514645244744014457 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. #' * `show_after`: numeric scalar. Only show the progress bar after this #' number of seconds. It overrides the `cli.progress_show_after` #' global option. #' * `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/multi-req.R0000644000176200001440000001536214643732273013602 0ustar liggesusers#' Perform a list of requests in parallel #' #' @description #' This variation on [req_perform_sequential()] performs multiple requests in #' parallel. Exercise caution when using this function; it's easy to pummel a #' server with many simultaneous requests. Only use it with hosts designed to #' serve many files at once, which are typically web servers, not API servers. #' #' `req_perform_parallel()` has a few limitations: #' #' * Will not retrieve a new OAuth token if it expires part way through #' the requests. #' * Does not perform throttling with [req_throttle()]. #' * Does not attempt retries as described by [req_retry()]. #' * Only consults the cache set by [req_cache()] before/after all requests. #' #' If any of these limitations are problematic for your use case, we recommend #' [req_perform_sequential()] instead. #' #' @inherit req_perform_sequential params return #' @param pool Optionally, a curl pool made by [curl::new_pool()]. Supply #' this if you want to override the defaults for total concurrent connections #' (100) or concurrent connections per host (6). #' @export #' @examples #' # Requesting these 4 pages one at a time would take 2 seconds: #' request_base <- request(example_url()) #' 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 = NULL, on_error = c("stop", "return", "continue"), progress = TRUE) { check_paths(paths, reqs) on_error <- arg_match(on_error) progress <- create_progress_bar( total = length(reqs), name = "Iterating", config = progress ) perfs <- vector("list", length(reqs)) for (i in seq_along(reqs)) { perfs[[i]] <- Performance$new( req = reqs[[i]], path = paths[[i]], progress = progress, error_call = environment() ) perfs[[i]]$submit(pool) } pool_run(pool, perfs, on_error = on_error) progress$done() map(perfs, ~ .$resp) } #' 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 = NULL, 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" ) } pool_run <- function(pool, perfs, on_error = "continue") { on.exit(pool_cancel(pool, perfs), add = TRUE) # The done and fail callbacks for curl::multi_add() are designed to always # succeed. If the request actually failed, they raise a `httr_fail` # signal (not error) that wraps the error. Here we catch that error and # handle it based on the value of `on_error` httr2_fail <- switch(on_error, stop = function(cnd) cnd_signal(cnd$error), continue = function(cnd) zap(), return = function(cnd) NULL ) try_fetch( repeat({ run <- curl::multi_run(0.1, pool = pool, poll = TRUE) if (run$pending == 0) { break } }), interrupt = function(cnd) NULL, httr2_fail = httr2_fail ) invisible() } # Wrap up all components of request -> response in a single object Performance <- R6Class("Performance", public = list( req = NULL, path = NULL, handle = NULL, resp = NULL, pool = NULL, error_call = NULL, progress = NULL, initialize = function(req, path = NULL, progress = NULL, error_call = NULL) { self$req <- req self$path <- path self$progress <- progress self$error_call <- error_call req <- auth_oauth_sign(req) req <- cache_pre_fetch(req) if (is_response(req)) { self$resp <- req } else { self$handle <- req_handle(req) curl::handle_setopt(self$handle, url = req$url) } }, submit = function(pool = NULL) { if (!is.null(self$resp)) { # cached return() } self$pool <- pool curl::multi_add( handle = self$handle, pool = self$pool, data = self$path, done = self$succeed, fail = self$fail ) invisible(self) }, succeed = function(res) { self$progress$update() if (is.null(self$path)) { body <- res$content } else { # Only needed with curl::multi_run() if (!file.exists(self$path)) { file.create(self$path) } body <- new_path(self$path) } resp <- new_response( method = req_method_get(self$req), url = res$url, status_code = res$status_code, headers = as_headers(res$headers), body = body, request = self$req ) resp <- cache_post_fetch(self$req, resp, path = self$path) self$resp <- tryCatch( resp_check_status(resp, error_call = self$error_call), error = identity ) if (is_error(self$resp)) { signal("", error = self$resp, class = "httr2_fail") } }, fail = function(msg) { self$progress$update() self$resp <- error_cnd( "httr2_failure", message = msg, request = self$req, call = self$error_call ) signal("", error = self$resp, class = "httr2_fail") }, cancel = function() { # No handle if response was cached if (!is.null(self$handle)) { curl::multi_cancel(self$handle) } } )) pool_cancel <- function(pool, perfs) { walk(perfs, ~ .x$cancel()) curl::multi_run(pool = pool) } httr2/R/req-perform.R0000644000176200001440000002166414643705565014130 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 [request]. #' @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 <- auth_oauth_sign(req) req <- cache_pre_fetch(req) if (is_response(req)) { return(req) } handle <- req_handle(req) max_tries <- retry_max_tries(req) deadline <- Sys.time() + retry_max_seconds(req) n <- 0 tries <- 0 reauth <- FALSE # only ever re-authenticate once throttle_delay(req) delay <- 0 while(tries < max_tries && Sys.time() < deadline) { sys_sleep(delay, "for retry backoff") n <- n + 1 resp <- tryCatch( req_perform1(req, path = path, handle = handle), error = function(err) { error_cnd( message = "Failed to perform HTTP request.", class = c("httr2_failure", "httr2_error"), parent = err, request = req, call = error_call, trace = trace_back() ) } ) if (is_error(resp)) { tries <- tries + 1 delay <- retry_backoff(req, tries) } else if (!reauth && resp_is_invalid_oauth_token(req, resp)) { reauth <- TRUE req <- auth_oauth_sign(req, TRUE) handle <- req_handle(req) delay <- 0 } else if (retry_is_transient(req, resp)) { tries <- tries + 1 delay <- retry_after(req, resp, tries) } else { # done break } } # Used for testing signal(class = "httr2_fetch", n = n, tries = tries, reauth = reauth) 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 (is_error(resp)) { cnd_signal(resp) } else if (error_is_error(req, resp)) { body <- error_body(req, resp, error_call) resp_abort(resp, req, body, call = error_call) } else { resp } } req_perform1 <- function(req, path = NULL, handle = NULL) { the$last_request <- req the$last_response <- NULL if (!is.null(path)) { res <- curl::curl_fetch_disk(req$url, path, handle) body <- new_path(path) } else { res <- curl::curl_fetch_memory(req$url, handle) body <- res$content } # 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) resp <- new_response( method = req_method_get(req), url = res$url, status_code = res$status_code, headers = as_headers(res$headers), body = body, request = req ) the$last_response <- resp resp } 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 } #' 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()]. #' #' @inheritParams req_verbose #' @param quiet If `TRUE` doesn't print anything. #' @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) { check_request(req) check_installed("httpuv") if (!quiet) { to_redact <- attr(req$headers, "redact") debug <- function(type, msg) { if (type == 2L) verbose_header("", msg, redact = redact_headers, to_redact = to_redact) if (type == 4L) verbose_message("", msg) } req <- req_options(req, debugfunction = debug, verbose = TRUE) } handle <- req_handle(req) curl::handle_setopt(handle, url = req$url) resp <- curl::curl_echo(handle, progress = FALSE) invisible(list( method = resp$method, path = resp$path, headers = as.list(resp$headers) )) } req_handle <- function(req) { req <- req_method_apply(req) req <- req_body_apply(req) if (!has_name(req$options, "useragent")) { req <- req_user_agent(req) } handle <- curl::new_handle() 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 } new_path <- function(x) structure(x, class = "httr2_path") is_path <- function(x) inherits(x, "httr2_path") 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.R0000644000176200001440000001040514645244703015402 0ustar liggesusers #' Perform a request and handle data as it streams back #' #' @description #' 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) handle <- req_handle(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 stream <- curl::curl(req$url, handle = handle) open(stream, "rbf") withr::defer(close(stream)) res <- curl::handle_data(handle) the$last_request <- req # Return early if there's a problem resp <- new_response( method = req_method_get(req), url = res$url, status_code = res$status_code, headers = as_headers(res$headers), body = NULL, request = req ) if (error_is_error(req, resp)) { resp$body <- read_con(stream) the$last_response <- resp handle_resp(req, resp) } 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) } the$last_response <- resp resp } 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 ) } } 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 } } #' @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.R0000644000176200001440000002266314644201474013510 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. #' #' 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_exists <- function(req) { if (!req_policy_exists(req, "cache_path")) { return(FALSE) } path <- req_cache_path(req) if (!file.exists(path)) { return(FALSE) } tryCatch( { readRDS(path) TRUE }, error = function(e) { FALSE } ) } # Callers responsibility to check that cache exists cache_get <- function(req) { path <- req_cache_path(req) touch(path) readRDS(path) } cache_set <- function(req, resp) { if (is_path(resp$body)) { 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) { if (!cache_exists(req)) { return(req) } debug <- cache_debug(req) cache_prune_if_needed(req, debug = debug) info <- resp_cache_info(cache_get(req)) if (debug) cli::cli_text("Found url in cache {.val {hash(req$url)}}") if (!is.na(info$expires) && info$expires >= Sys.time()) { signal("", "httr2_cache_cached") if (debug) cli::cli_text("Cached value is fresh; retrieving response from cache") cache_get(req) } 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 ) } } cache_post_fetch <- function(req, resp, path = NULL) { if (!req_policy_exists(req, "cache_path")) { return(resp) } debug <- cache_debug(req) if (is_error(resp)) { if (cache_use_on_error(req) && cache_exists(req)) { if (debug) cli::cli_text("Request errored; retrieving response from cache") cache_get(req) } else { resp } } else if (resp_status(resp) == 304 && cache_exists(req)) { signal("", "httr2_cache_not_modified") if (debug) cli::cli_text("Cached value still ok; retrieving body from cache") # Replace body with cached result resp$body <- cache_body(req, path) # Combine headers resp$headers <- cache_headers(req, resp) resp } else if (resp_is_cacheable(resp)) { signal("", "httr2_cache_save") if (debug) cli::cli_text("Saving response to cache {.val {hash(req$url)}}") cache_set(req, resp) resp } else { resp } } cache_body <- function(req, path = NULL) { body <- cache_get(req)$body if (is.null(path)) { return(body) } if (is_path(body)) { file.copy(body, path, overwrite = TRUE) } else { writeBin(body, path) } new_path(path) } cache_headers <- function(req, resp) { # https://www.rfc-editor.org/rfc/rfc7232#section-4.1 cached_headers <- cache_get(req)$headers as_headers(modify_list(cached_headers, !!!resp$headers)) } # Caching headers --------------------------------------------------------- resp_is_cacheable <- function(resp, control = NULL) { if (resp$method != "GET") { return(FALSE) } if (resp_status(resp) != 200L) { 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, ",")[[1]] pieces <- gsub("^\\s+|\\s+$", "", pieces) pieces <- tolower(pieces) is_value <- grepl("=", pieces) 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.R0000644000176200001440000000462014556444037013405 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 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), .redact = "Authorization") } #' 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), .redact = "Authorization") } httr2/R/zzz.R0000644000176200001440000000006214063722633012502 0ustar liggesusers.onLoad <- function(...) { cache_disk_prune() } httr2/R/req-retries.R0000644000176200001440000001316014556444037014120 0ustar liggesusers#' Control when a request will retry, and how long it will wait between tries #' #' @description #' `req_retry()` alters [req_perform()] so that it will automatically retry #' in the case of failure. To activate it, you must specify either the total #' number of requests to make with `max_tries` or the total amount of time #' to spend with `max_seconds`. Then `req_perform()` 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 request. This occurs, for example, if your wifi is down. #' #' * The error is "transient", i.e. it's an HTTP error that can be resolved #' by waiting. By default, 429 and 503 statuses are treated as transient, #' but if the API you are wrapping has other transient status codes (or #' conveys transient-ness with some other property of the response), you can #' override the default with `is_transient`. #' #' 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 behaviour 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 to at most 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 with #' `max_tries` or the total elapsed time from the first request with #' `max_seconds`. If neither option is supplied (the default), [req_perform()] #' will not retry. #' @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 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 `NULL`, which indicates #' that a precise wait time is not available that the `backoff` strategy #' should be used instead.. #' @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 = ~ 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, is_transient = NULL, backoff = NULL, after = NULL) { check_request(req) req_policies(req, retry_max_tries = max_tries, retry_max_wait = max_seconds, 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_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_is_transient <- function(req, resp) { 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()) { 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/secret.R0000644000176200001440000002060214556444037013142 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_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 `.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/oauth-flow-jwt.R0000644000176200001440000000574714556444037014561 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 `vignette("oauth")`. #' #' @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-template.R0000644000176200001440000000717514556444037014267 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, " ")[[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)) { "colon" } else { "none" } } httr2/R/req-throttle.R0000644000176200001440000000424614627335230014306 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. #' #' @inheritParams req_perform #' @param rate Maximum rate, i.e. maximum number of requests per second. #' Usually easiest expressed as a fraction, #' `number_of_requests / number_of_seconds`, e.g. 15 requests per minute #' is `15 / 60`. #' @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(rate = 30 / 60) #' #' resp <- req_perform(req) #' throttle_status() #' resp <- req_perform(req) #' throttle_status() req_throttle <- function(req, rate, realm = NULL) { check_request(req) check_number_decimal(rate) delay <- 1 / rate throttle_delay <- function(req) { realm <- realm %||% url_parse(req$url)$hostname last <- the$throttle[[realm]] if (is.null(last)) { wait <- 0 } else { wait <- delay - (unix_time() - last) } sys_sleep(wait, "for throttling delay") throttle_touch(realm) wait } req_policies(req, throttle_delay = throttle_delay) } #' Display internal throttle status #' #' Sometimes useful for debugging. #' #' @return A data frame with two columns: the `realm` and time the #' `last_request` was made. #' @export #' @keywords internal throttle_status <- function() { realms <- sort(names(the$throttle)) data.frame( realm = realms, last_request = .POSIXct(unlist(the$throttle[realms]) %||% double()), row.names = NULL, stringsAsFactors = FALSE ) } throttle_reset <- function() { env_bind(the, throttle = list()) invisible() } throttle_touch <- function(realm) { env_bind(the, throttle = modify_list(the$throttle, !!realm := unix_time())) } throttle_delay <- function(req) { req_policy_call(req, "throttle_delay", list(req), default = 0) } httr2/R/url.R0000644000176200001440000001410014643741746012457 0ustar liggesusers#' Parse and build URLs #' #' `url_parse()` parses a URL into its component pieces; `url_build()` does #' the reverse, converting a list of pieces into a string URL. See `r rfc(3986)` #' for the details of the parsing algorithm. #' #' @param url For `url_parse()` a string to parse into a URL; #' for `url_build()` a URL to turn back into a string. #' @returns #' * `url_build()` returns a string. #' * `url_parse()` returns a URL: a S3 list with class `httr2_url` #' and elements `scheme`, `hostname`, `port`, `path`, `fragment`, `query`, #' `username`, `password`. #' @export #' @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") #' #' url <- url_parse("http://google.com/") #' url$port <- 80 #' url$hostname <- "example.com" #' url$query <- list(a = 1, b = 2, c = 3) #' url_build(url) url_parse <- function(url) { check_string(url) # https://datatracker.ietf.org/doc/html/rfc3986#appendix-B pieces <- parse_match(url, "^(([^:/?#]+):)?(//([^/?#]*))?([^?#]*)(\\?([^#]*))?(#(.*))?") scheme <- pieces[[2]] authority <- pieces[[4]] path <- pieces[[5]] query <- pieces[[7]] if (!is.null(query)) { query <- query_parse(query) } fragment <- pieces[[9]] # https://datatracker.ietf.org/doc/html/rfc3986#section-3.2 pieces <- parse_match(authority %||% "", "^(([^@]+)@)?([^:]+)?(:([^#]+))?") userinfo <- pieces[[2]] if (!is.null(userinfo)) { userinfo <- parse_in_half(userinfo, ":") if (userinfo$right == "") { userinfo$right <- NULL } } hostname <- pieces[[3]] port <- pieces[[5]] structure( list( scheme = scheme, hostname = hostname, username = userinfo$left, password = userinfo$right, port = port, path = path, query = query, fragment = fragment ), class = "httr2_url" ) } url_modify <- function(url, ..., error_call = caller_env()) { url <- url_parse(url) url <- modify_list(url, ..., error_call = error_call) url_build(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)) 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) } #' @export #' @rdname url_parse url_build <- function(url) { if (!is.null(url$query)) { query <- 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) ) } query_parse <- function(x) { x <- gsub("^\\?", "", x) # strip leading ?, if present params <- parse_name_equals_value(parse_delim(x, "&")) if (length(params) == 0) { return(NULL) } out <- as.list(curl::curl_unescape(params)) names(out) <- curl::curl_unescape(names(params)) out } query_build <- function(x, error_call = caller_env()) { if (!is_list(x) || (!is_named(x) && length(x) > 0)) { cli::cli_abort("Query 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 = "&") } format_query_param <- function(x, name, multi = 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") curl::curl_escape(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.R0000644000176200001440000000400714643705565012450 0ustar liggesusers#' Create a new HTTP request #' #' @description #' To perform a HTTP request, first create a request object with `request()`, #' then define its behaviour with `req_` functions, then 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 ), 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.R0000644000176200001440000000410214556444037014052 0ustar liggesusers#' Modify request headers #' #' `req_headers()` allows you to set the value of any header. #' #' @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 Headers to redact. If `NULL`, the default, the added headers #' are not 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 `.redact` to hide a header in the output #' req |> #' req_headers(Secret = "this-is-private", Public = "but-this-is-not", .redact = "Secret") |> #' req_dry_run() req_headers <- function(.req, ..., .redact = NULL) { check_request(.req) headers <- list2(...) header_names <- names2(headers) check_character(.redact, allow_null = TRUE) redact_out <- attr(.req$headers, "redact") %||% .redact %||% character() redact_out <- union(redact_out, .redact) .req$headers <- modify_list(.req$headers, !!!headers) attr(.req$headers, "redact") <- redact_out .req } httr2/R/sequential.R0000644000176200001440000000733714556444037014041 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 slower than [req_perform_parallel()] but #' has fewer limitations. #' #' @param reqs A list of [request]s. #' @param paths An optional list of paths, if you want to download the request #' bodies to disks. 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? Use `TRUE` to turn on a basic #' progress bar, use a string to give it a name, or see [progress_bars] to #' customise it in other ways. #' @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/iterate.R0000644000176200001440000001466414556444037013325 0ustar liggesusers#' Perform requests iteratively, generating new requests from previous responses #' #' @description #' `r lifecycle::badge("experimental")` #' #' `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")) #' #' 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") #' ) #' }) 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/test.R0000644000176200001440000000364514643437760012646 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() { check_installed("webfakes") if (is_testing()) { testthat::skip_on_covr() } 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 ) }) env_cache(the, "test_app", webfakes::new_app_process( app, opts = webfakes::server_opts(num_threads = 2) ) ) the$test_app$url() } #' @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-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.R0000644000176200001440000001651514556444037014145 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)) { versions <- c( httr2 = as.character(utils::packageVersion("httr2")), `r-curl` = as.character(utils::packageVersion("curl")), libcurl = curl_system_version() ) string <- paste0(names(versions), "/", versions, collapse = " ") } else { check_string(string) } req_options(req, useragent = string) } 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) ) } #' 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) to_redact <- attr(req$headers, "redact") debug <- function(type, msg) { switch(type + 1, text = if (info) verbose_message("* ", msg), headerOut = if (header_resp) verbose_header("<- ", msg), headerIn = if (header_req) verbose_header("-> ", msg, redact_headers, to_redact = to_redact), dataOut = if (body_resp) verbose_message("<< ", msg), dataIn = if (body_req) verbose_message(">> ", msg) ) } req_options(req, debugfunction = debug, verbose = TRUE) } # helpers ----------------------------------------------------------------- verbose_message <- function(prefix, x) { if (any(x > 128)) { # This doesn't handle unicode, but it seems like most output # will be compressed in some way, so displaying bodies is unlikely # to be useful anyway. lines <- paste0(length(x), " bytes of binary data") } else { 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(":", line, fixed = TRUE)) { header <- headers_redact(as_headers(line), redact, to_redact = to_redact) cli::cat_line(prefix, cli::style_bold(names(header)), ": ", header) } else { cli::cat_line(prefix, line) } } } 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.R0000644000176200001440000001513214643732273013016 0ustar liggesusersbullets_with_header <- function(header, x) { if (length(x) == 0) { return() } cli::cli_text("{.strong {header}}") as_simple <- function(x) { if (is.atomic(x) && length(x) == 1) { if (is.character(x)) { paste0("'", x, "'") } else { format(x) } } else { obj_type_friendly(x) } } vals <- map_chr(x, as_simple) cli::cli_li(paste0("{.field ", names(x), "}: ", vals)) } modify_list <- function(.x, ..., 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 ) } 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 = getOption("httr2_progress", TRUE)) { check_number_decimal(seconds) if (seconds == 0) { return(invisible()) } if (!progress) { cli::cli_alert("Waiting {ceiling(seconds)}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() } 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)) } #' Temporarily set verbosity for all requests #' #' `with_verbosity()` is useful for debugging httr2 code buried deep inside #' another package because it allows you to see exactly what's been sent #' and requested. #' #' @inheritParams req_perform #' @param code Code to execture #' @returns The result of evaluating `code`. #' @export #' @examples #' fun <- function() { #' request("https://httr2.r-lib.org") |> req_perform() #' } #' with_verbosity(fun()) with_verbosity <- function(code, verbosity = 1) { withr::local_options(httr2_verbosity = verbosity) code } httr2_verbosity <- function() { x <- getOption("httr2_verbosity") if (!is.null(x)) { return(x) } # Hackish fallback for httr::with_verbose old <- getOption("httr_config") if (!is.null(old$options$debugfunction)) { 1 } else { 0 } } 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, ...) } httr2/R/resp-headers.R0000644000176200001440000001300714556444037014240 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 An HTTP response object, as 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) { # 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)) { 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() } links <- parse_link(resp_header(resp, "Link")) sel <- map_lgl(links, ~ .$rel == rel) if (sum(sel) != 1L) { return() } links[[which(sel)]]$url } httr2/R/oauth.R0000644000176200001440000001356414556444037013006 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_policies(req, auth_oauth = list( cache = cache, flow = flow, flow_params = flow_params ) ) } auth_oauth_sign <- function(req, reauth = FALSE) { if (!req_policy_exists(req, "auth_oauth")) { return(req) } token <- auth_oauth_token_get( cache = req$policies$auth_oauth$cache, flow = req$policies$auth_oauth$flow, flow_params = req$policies$auth_oauth$flow_params, reauth = reauth ) req_auth_bearer_token(req, token$access_token) } auth_oauth_token_get <- function(cache, flow, flow_params = list(), reauth = FALSE) { token <- cache$get() if (reauth || 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) flow_params$client <- client auth_oauth_token_get( cache = cache, flow = flow, flow_params = flow_params, reauth = reauth ) } resp_is_invalid_oauth_token <- function(req, resp) { if (!req_policy_exists(req, "auth_oauth")) { return(FALSE) } if (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") } httr2/R/sysdata.rda0000644000176200001440000000067214064455702013672 0ustar liggesusersBZh91AY&SY6H@gԀ8j@@@@@P%#"f" bi 1 z AI (SF 4@hiQ++ee]U61Z Xz,YFm Բ ▲aKw&k2>.CtFp(Bz!w<@4L@*  ipa%YL@ cId4E& RchlLT\H fqS&LIe :HΙw3y'm9Nʀ[eNlԅUDBrhp}FK%5US Au-Kev =y@a\YAmV M‹H%q )O`:D r3-lMR ]=}1w$S A`httr2/R/utils-multi.R0000644000176200001440000000454114643732273014150 0ustar liggesusersmulti_dots <- function(..., .multi = c("error", "comma", "pipe", "explode"), 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) } 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) 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) 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) 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) 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, 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.R0000644000176200001440000002254714602572273012630 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")) { 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) # Content type set with data type <- data$headers$`Content-Type` 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" 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 ")) out <- paste0(out, "\n") if (clip) { cli::cli_alert_success("Copying to clipboard:") clipr::write_clip(out) } 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 } # 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
...] [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 -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)) { 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) { check_dots_empty0(...) args <- c(main_args, dots) if (is_empty(args) && !keep_if_empty) { return(steps) } names <- quote_name(names2(args)) string <- vapply(args, is.character, logical(1L)) 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 } httr2/R/req-url.R0000644000176200001440000000560514556444037013252 0ustar liggesusers#' Modify request URL #' #' @description #' * `req_url()` replaces the entire url #' * `req_url_query()` modifies the components of the query #' * `req_url_path()` modifies the path #' * `req_url_path_append()` adds to the path #' #' @inheritParams req_perform #' @param url New URL; completely replaces existing. #' @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 #' req <- request("http://example.com") #' #' # 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") #' #' # Change complete url #' req |> #' req_url("http://google.com") #' #' # 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 #' @param .multi Controls what happens when an element of `...` is a vector #' containing multiple values: #' #' * `"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 functions work, you can alternatively supply a function #' that takes a character vector and returns a string. req_url_query <- function(.req, ..., .multi = c("error", "comma", "pipe", "explode")) { check_request(.req) dots <- multi_dots(..., .multi = .multi) url <- url_parse(.req$url) url$query <- modify_list(url$query, !!!dots) req_url(.req, url_build(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/httr2-package.R0000644000176200001440000000053714556444037014316 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 <- list() the$cache_throttle <- list() the$token_cache <- new_environment() the$last_response <- NULL the$last_request <- NULL httr2/R/oauth-flow-password.R0000644000176200001440000000446114644200171015572 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 `vignette("oauth")`. #' #' @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.R0000644000176200001440000001143714556444037012634 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" ) } #' @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 if (is_path(body)) { cli::cli_text("{.field Body}: On disk {.path {body}} ({file.size(body)} bytes)") } else { cli::cli_text("{.field Body}: In memory ({length(body)} bytes)") } 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. #' #' @param resp An HTTP [response] #' @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.R0000644000176200001440000000321614556444037017513 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 `vignette("oauth")`. #' #' @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.R0000644000176200001440000001137314556444037015204 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 `vignette("oauth")`. #' #' @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.R0000644000176200001440000000760014556444037014311 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 resp A response object. #' @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 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 ) } httr2/R/oauth-flow-auth-code.R0000644000176200001440000004165614556444037015625 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 `vignette("oauth")`. #' #' # 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. a public client #' not an confidential client) or ensure that possession of the `client_secret` #' doesn't bestow any meaningful rights. #' #' Only modern APIs from the bigger players (Azure, Google, etc) explicitly #' native apps. However, in most cases, even for older APIs, possessing the #' `client_secret` gives you no ability to do anything harmful, so our #' general principle is that it's fine to include it in an R package, as long #' as it's mildly obfuscated to protect it from credential scraping. There's #' no incentive to steal your client credentials if it takes less time to #' create a new client than find your client secret. #' #' @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 `vignette("oauth")` #' @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()) { 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 = 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 <- 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.R0000644000176200001440000000551714556444037012471 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 = size, header = list()) { check_installed("jose") jose::jwt_encode_sig(claim, secret, size = size, header = header) } httr2/R/headers.R0000644000176200001440000000424314556444037013273 0ustar liggesusersas_headers <- function(x, error_call = caller_env()) { if (is.character(x) || is.raw(x)) { headers <- curl::parse_headers(x) headers <- headers[grepl(":", headers, fixed = TRUE)] equals <- regexpr(":", headers, fixed = TRUE) pieces <- regmatches(headers, equals, invert = TRUE) names <- map_chr(pieces, "[[", 1) values <- as.list(trimws(map_chr(pieces, "[[", 2))) new_headers(set_names(values, names), error_call = error_call) } else if (is.list(x)) { new_headers(x, 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, 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, class = "httr2_headers") } #' @export print.httr2_headers <- function(x, ..., redact = TRUE) { cli::cli_text("{.cls {class(x)}}") if (length(x) > 0) { cli::cat_line(cli::style_bold(names(x)), ": ", headers_redact(x, redact)) } invisible(x) } headers_redact <- function(x, redact = TRUE, to_redact = NULL) { if (!redact) { x } else { to_redact <- union(attr(x, "redact"), to_redact) attr(x, "redact") <- NULL list_redact(x, to_redact, case_sensitive = FALSE) } } headers_flatten <- function(x) { set_names(as.character(unlist(x, use.names = FALSE)), rep(names(x), lengths(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] <- cli::col_grey("") x } #' @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.R0000644000176200001440000001670314643751122013377 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. You shouldn't generally need to specify this as #' the defaults are usually pretty good, e.g. `req_body_file()` will guess it #' from the extension of of `path`. 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); #' * 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()) { 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_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 done <- FALSE # Only open connection if needed delayedAssign("con", file(data, "rb")) # Leaks connection if request doesn't complete readfunction <- function(nbytes, ...) { if (done) { return(raw()) } out <- readBin(con, "raw", nbytes) if (length(out) <= nbytes) { close(con) done <<- TRUE con <<- NULL } out } seekfunction <- function(offset, ...) { if (done) { con <<- file(data, "rb") done <<- FALSE } seek(con, where = offset) } req <- req_options(req, post = TRUE, readfunction = readfunction, seekfunction = seekfunction, postfieldsize_large = size ) } else if (type == "raw") { req <- req_body_apply_raw(req, data) } else if (type == "json") { json <- exec(jsonlite::toJSON, data, !!!req$body$params) req <- req_body_apply_raw(req, json) } else if (type == "multipart") { data <- unobfuscate(data) req$fields <- data } else if (type == "form") { data <- unobfuscate(data) req <- req_body_apply_raw(req, query_build(data)) } 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/cleanup0000755000176200001440000000006114645305471012700 0ustar liggesusers#! /usr/bin/env sh rm -f man/macros/examples.Rd httr2/vignettes/0000755000176200001440000000000014645305470013335 5ustar liggesusershttr2/vignettes/httr2.Rmd0000644000176200001440000001530514556444037015054 0ustar liggesusers--- title: "httr2" output: rmarkdown::html_vignette vignette: > %\VignetteIndexEntry{httr2} %\VignetteEngine{knitr::rmarkdown} %\VignetteEncoding{UTF-8} --- ```{r, include = FALSE} has_pipe <- getRversion() >= "4.1.0" knitr::opts_chunk$set( collapse = TRUE, comment = "#>", eval = has_pipe ) ``` 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 (has_pipe) 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's its 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 for 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/NAMESPACE0000644000176200001440000000662514556444037012561 0ustar liggesusers# Generated by roxygen2: do not edit by hand S3method("$",httr2_headers) S3method("[",httr2_headers) S3method("[[",httr2_headers) 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_obfuscated) export("%>%") export(curl_help) export(curl_translate) export(example_github_client) export(example_url) 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(multi_req_perform) 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_redirect_uri) export(oauth_token) export(oauth_token_cached) export(obfuscate) export(obfuscated) 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_dry_run) export(req_error) export(req_headers) 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_options) export(req_perform) export(req_perform_iterative) export(req_perform_parallel) 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_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_retry_after) export(resp_status) export(resp_status_desc) 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_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.md0000644000176200001440000003012514645305444012425 0ustar liggesusers# 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/0000755000176200001440000000000014645305470012302 5ustar liggesusershttr2/inst/doc/0000755000176200001440000000000014645305470013047 5ustar liggesusershttr2/inst/doc/httr2.html0000644000176200001440000010501014645305470014775 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:60598/
#> 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
#> Host: 127.0.0.1:60598
#> User-Agent: httr2/1.0.2 r-curl/5.2.1 libcurl/8.6.0
#> Accept: */*
#> Accept-Encoding: deflate, gzip

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’s its 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 (60598).

  • 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
#> Host: 127.0.0.1:60598
#> User-Agent: httr2/1.0.2 r-curl/5.2.1 libcurl/8.6.0
#> Accept-Encoding: deflate, gzip
#> Name: Hadley
#> Shoe-Size: 11
#> Accept: application/json

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
#> Host: 127.0.0.1:60598
#> User-Agent: httr2/1.0.2 r-curl/5.2.1 libcurl/8.6.0
#> Accept: */*
#> Accept-Encoding: deflate, gzip
#> Content-Type: application/json
#> Content-Length: 15
#> 
#> {"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 for 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
#> Host: 127.0.0.1:60598
#> User-Agent: httr2/1.0.2 r-curl/5.2.1 libcurl/8.6.0
#> Accept: */*
#> Accept-Encoding: deflate, gzip
#> Content-Type: application/x-www-form-urlencoded
#> Content-Length: 7
#> 
#> 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
#> Host: 127.0.0.1:60598
#> User-Agent: httr2/1.0.2 r-curl/5.2.1 libcurl/8.6.0
#> Accept: */*
#> Accept-Encoding: deflate, gzip
#> Content-Length: 246
#> Content-Type: multipart/form-data; boundary=------------------------WPD7NVApDJfsWxPBE3AkFe
#> 
#> --------------------------WPD7NVApDJfsWxPBE3AkFe
#> Content-Disposition: form-data; name="x"
#> 
#> 1
#> --------------------------WPD7NVApDJfsWxPBE3AkFe
#> Content-Disposition: form-data; name="y"
#> 
#> a
#> --------------------------WPD7NVApDJfsWxPBE3AkFe--

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:60598/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
#> Connection: close
#> Date: Mon, 15 Jul 2024 20:48:55 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>
#> Connection: close
#> Date: Mon, 15 Jul 2024 20:48:55 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.Rmd0000644000176200001440000001530514556444037014566 0ustar liggesusers--- title: "httr2" output: rmarkdown::html_vignette vignette: > %\VignetteIndexEntry{httr2} %\VignetteEngine{knitr::rmarkdown} %\VignetteEncoding{UTF-8} --- ```{r, include = FALSE} has_pipe <- getRversion() >= "4.1.0" knitr::opts_chunk$set( collapse = TRUE, comment = "#>", eval = has_pipe ) ``` 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 (has_pipe) 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's its 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 for 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.R0000644000176200001440000000445714645305470014247 0ustar liggesusers## ----include = FALSE---------------------------------------------------------- has_pipe <- getRversion() >= "4.1.0" knitr::opts_chunk$set( collapse = TRUE, comment = "#>", eval = has_pipe ) ## ----setup-------------------------------------------------------------------- library(httr2) ## ----------------------------------------------------------------------------- req <- request(example_url()) req ## ----------------------------------------------------------------------------- req |> req_dry_run() ## ----------------------------------------------------------------------------- port <- if (has_pipe) 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------------------------------------------------------------- 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.md0000644000176200001440000001074014645245146012611 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 ground-up rewrite of [httr](https://httr.r-lib.org) that provides a pipeable API with an explicit request object that solves more problems felt by packages that wrap APIs (e.g. built-in rate-limiting, retries, OAuth, secure secrets, and more). ## 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 # Automatically retry if the request fails req |> req_retry(max_tries = 5) #> #> GET https://r-project.org #> Body: empty #> Policies: #> • retry_max_tries: 5 # 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 #> Host: r-project.org #> User-Agent: httr2/1.0.1.9000 r-curl/5.2.1 libcurl/8.6.0 #> Accept: */* #> Accept-Encoding: deflate, gzip ``` 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 (6951 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://jeroen.cran.dev/curl/), [openssl](https://github.com/jeroen/openssl/), [jsonlite](https://jeroen.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://research.google/people/CraigCitro/) who have given me much useful feedback on both the design of the internals and the user facing API. httr2/build/0000755000176200001440000000000014645305470012424 5ustar liggesusershttr2/build/vignette.rds0000644000176200001440000000027614645305470014770 0ustar liggesusersb```b`a@&0`b fd`aҜ%%EFzA)h` 4A.ꌒ4v9@i `aB65/17]KjAj^ HvѴpxVaaqIY0AAn0Ez0?·Ht&${+%$Q/n$bhttr2/configure0000755000176200001440000000075114645305471013240 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/0000755000176200001440000000000014645244703012101 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.Rd0000644000176200001440000000251514556444037014727 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/req-perform.R \name{req_dry_run} \alias{req_dry_run} \title{Perform a dry run} \usage{ req_dry_run(req, quiet = FALSE, redact_headers = TRUE) } \arguments{ \item{req}{A \link{request}.} \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.} } \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()}}. } \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.Rd0000644000176200001440000000314714556444037020302 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 \link{request}.} \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 \code{vignette("oauth")}. } \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}()} } \concept{OAuth flows} httr2/man/req_auth_bearer_token.Rd0000644000176200001440000000206614556444037016727 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 \link{request}.} \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.Rd0000644000176200001440000000204714643705565015462 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/utils.R \name{with_verbosity} \alias{with_verbosity} \title{Temporarily set verbosity for all requests} \usage{ with_verbosity(code, verbosity = 1) } \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.} } \value{ The result of evaluating \code{code}. } \description{ \code{with_verbosity()} is useful for debugging httr2 code buried deep inside another package because it allows you to see exactly what's been sent and requested. } \examples{ fun <- function() { request("https://httr2.r-lib.org") |> req_perform() } with_verbosity(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.Rd0000644000176200001440000000207014556444037014361 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 \link{request}.} \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.Rd0000644000176200001440000000172314645245622015030 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.Rd0000644000176200001440000000137414556444037014430 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 \link{request}.} \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}, digest, digest_ie, gssnegotiate, ntlm, 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.Rd0000644000176200001440000000253514556444037016133 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/multi-req.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 = NULL, cancel_on_error = FALSE) } \arguments{ \item{reqs}{A list of \link{request}s.} \item{paths}{An optional list of paths, if you want to download the request bodies to disks. If supplied, must be the same length as \code{reqs}.} \item{pool}{Optionally, a curl pool made by \code{\link[curl:multi]{curl::new_pool()}}. Supply this if you want to override the defaults for total concurrent connections (100) or concurrent connections per host (6).} \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/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.Rd0000644000176200001440000000433314556444037015704 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 \link{request}.} \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 \code{vignette("oauth")}} \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 \code{vignette("oauth")}. } \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.Rd0000644000176200001440000001177514556444037017003 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/iterate.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? Use \code{TRUE} to turn on a basic progress bar, use a string to give it a name, or see \link{progress_bars} to customise it in other ways.} } \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{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} \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")) 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") ) }) } httr2/man/progress_bars.Rd0000644000176200001440000000504014645244746015251 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{show_after}: numeric scalar. Only show the progress bar after this number of seconds. It overrides the \code{cli.progress_show_after} global option. \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.Rd0000644000176200001440000000266714556444037016152 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}{An HTTP response object, as 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.Rd0000644000176200001440000000057114556444037015646 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 two columns: the \code{realm} and time the \code{last_request} was made. } \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.Rd0000644000176200001440000001354514556444037016405 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 \link{request}.} \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 \code{vignette("oauth")}} \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 \code{vignette("oauth")}. } \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. a public client not an confidential client) or ensure that possession of the \code{client_secret} doesn't bestow any meaningful rights. Only modern APIs from the bigger players (Azure, Google, etc) explicitly native apps. However, in most cases, even for older APIs, possessing the \code{client_secret} gives you no ability to do anything harmful, so our general principle is that it's fine to include it in an R package, as long as it's mildly obfuscated to protect it from credential scraping. There's no incentive to steal your client credentials if it takes less time to create a new client than find your client secret. } \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}()} } \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.Rd0000644000176200001440000000230014556444037014362 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/url.R \name{url_parse} \alias{url_parse} \alias{url_build} \title{Parse and build URLs} \usage{ url_parse(url) url_build(url) } \arguments{ \item{url}{For \code{url_parse()} a string to parse into a URL; for \code{url_build()} a URL to turn back into a string.} } \value{ \itemize{ \item \code{url_build()} returns a string. \item \code{url_parse()} returns a URL: a S3 list with class \code{httr2_url} and elements \code{scheme}, \code{hostname}, \code{port}, \code{path}, \code{fragment}, \code{query}, \code{username}, \code{password}. } } \description{ \code{url_parse()} parses a URL into its component pieces; \code{url_build()} does the reverse, converting a list of pieces into a string URL. See \href{https://datatracker.ietf.org/doc/html/rfc3986}{RFC 3986} for the details of the parsing algorithm. } \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") url <- url_parse("http://google.com/") url$port <- 80 url$hostname <- "example.com" url$query <- list(a = 1, b = 2, c = 3) url_build(url) } httr2/man/example_url.Rd0000644000176200001440000000123314556444037014707 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() 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.Rd0000644000176200001440000000444014556444037016306 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 \link{request}.} \item{client}{An \code{\link[=oauth_client]{oauth_client()}}.} \item{username}{User name.} \item{password}{Password. You 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 \code{vignette("oauth")}} \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 \code{vignette("oauth")}. } \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}()} } \concept{OAuth flows} httr2/man/req_oauth_refresh.Rd0000644000176200001440000000455714556444037016113 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 \link{request}.} \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 \code{vignette("oauth")}. } \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}()} } \concept{OAuth flows} httr2/man/req_verbose.Rd0000644000176200001440000000354614556444037014717 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/req-options.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 \link{request}.} \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.Rd0000644000176200001440000000210514556444037016424 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} \title{Preserve cookies across requests} \usage{ req_cookie_preserve(req, path) } \arguments{ \item{req}{A \link{request}.} \item{path}{A path to a file where cookies will be read from before and updated after the request.} } \description{ By default, httr2 uses a clean slate for every request meaning that cookies are not automatically preserved across requests. To preserve cookies, you must set a cookie file which will be read before and updated after each request. } \examples{ path <- tempfile() httpbin <- request(example_url()) |> req_cookie_preserve(path) # Manually set two cookies httpbin |> req_template("/cookies/set/:name/:value", name = "chocolate", value = "chip") |> req_perform() |> resp_body_json() httpbin |> req_template("/cookies/set/:name/:value", name = "oatmeal", value = "raisin") |> req_perform() |> resp_body_json() # The cookie path has a straightforward format cat(readChar(path, nchars = 1e4)) } httr2/man/req_throttle.Rd0000644000176200001440000000223514627335230015102 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, realm = NULL) } \arguments{ \item{req}{A \link{request}.} \item{rate}{Maximum rate, i.e. maximum number of requests per second. Usually easiest expressed as a fraction, \code{number_of_requests / number_of_seconds}, e.g. 15 requests per minute is \code{15 / 60}.} \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. } \examples{ # Ensure we never send more than 30 requests a minute req <- request(example_url()) |> req_throttle(rate = 30 / 60) resp <- req_perform(req) throttle_status() resp <- req_perform(req) throttle_status() } \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/secrets.Rd0000644000176200001440000001020614556444037014042 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 \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_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/resp_body_raw.Rd0000644000176200001440000000455714556444037015245 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 response object.} \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.Rd0000644000176200001440000000311214556444037016177 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 \code{vignette("oauth")}} \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.Rd0000644000176200001440000000307014556444037017274 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 response object.} \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.Rd0000644000176200001440000000344314565167154015615 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.} } \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.Rd0000644000176200001440000000630414556444037016744 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 \link{request}.} \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.Rd0000644000176200001440000000453614556444037016576 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 \link{request}.} \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 \code{vignette("oauth")}. } \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}()} } \concept{OAuth flows} httr2/man/resp_raw.Rd0000644000176200001440000000120714556444037014215 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}{An HTTP \link{response}} } \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.Rd0000644000176200001440000000265714556444037015051 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}{An HTTP response object, as 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/req_error.Rd0000644000176200001440000000703114643705565014377 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 \link{request}.} \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/resp_link_url.Rd0000644000176200001440000000175014556444037015246 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}{An HTTP response object, as 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 liggesusersPNG  IHDRޫh cHRMz&u0`:pQ<bKGDtIME (w @IDATxw|yݽ`{U(Q[[;qN޼yNvl'.rmY.%YQ"{/ Ar}w x>p8wg"+F '+@!6@K"r.p'j_?y \?y TK/y B ^. l e~$->| q_)7A?buEK:|Z7+8'Z5( j>4p `>hU*z}:6ct qQ&w;Ro'2e 1(#iA/ |% ^/pq`uz( ؈^? ėS !o&:>J("z}p`!_B}ݷK$3xYdK$A[g%aIeIBv7J bߕ&a; - |%01}ݷ~&5-J [|5e,a~,dp\%A:lQh>0rOdFt[KwM࿔U!t ._t.=̯60D+h@-nu?0renH0&ut8I{ A/4xhoO3u/@ /er2k [< j.Pk}?w[^D?siR^V㡦Sgj U')eܘL?ozP8幤~n~ܾi #cAxn z}"yCg9:L'>sM;Vx4a&Mo/qzb)%[W^\ɔ U~{Dy\iI!s-^_?<7[Y t=zV:?17(;/;Y,ڇߋG|.) H،Y> ;bݘ9I)))*#{2>/Xe7=*RJ tRܜ_Ǹ(pI"a3²L ˑT:ک(.'|317 p0h3zeyXH8}/| %,3[w_R>sWiDJ|f,wzMK)(Ld#Y= }«B* ~ s),#/7A*E,-Lcs+M-mD"1r\88wxe誔ɰEՔ;feV_57槔2 >{ăcx=:L% }bqQka)%7.[}-Oj^_ v<Oj*Q؂au]nxyȊrfN8vC(`R*l!:ku~"xҚ^ۏxe:=>t9U+JAa<c 0?WSܽj ]X2`=;<;bh)~"s]7mw=-xcFN?jiL_2i&VP)/'!k7s2Cˊ(hhnE搟UYv\z'ص0"5>^W,P7rV:r@$wTNTL0qtM=?{9b8a0m ǑxMLXvəŎ=Y~gjm˰!%,Y0XI # ݶ#X߫G>OX%%?N]J{4x}謏_Bga~J)r~S5"5{]8a̞>>M:䶕גN0 v?ʎ=@0 !RbS'ai) oBan\ǃ)7Oÿ|5iTqY6lok_gNIȶUk_<_7YiyADhF  < Tu{ a~seI)iBn~a&7o8#*0fOp) Ծ6tIՈJ.LIk3qHra cF+(.fRrkft,LHH4F4ȉ<h a׼R*O|lBJ0 ZZC_$H`FƃC))u{~@iqA<q5|(wZں ›~sGΩZiCity$'H(+) ߗ0LY`,3B]-olֺ2ݽ0 ~/9Ai))u$wtwx]ٵ]1Lo5ѮI] ӲIA"aP8UO;v*^ɨ|?S8%yݿ[ailڶ7n;V82wǑ,=% fKocX'{^W|ho=9U+ynf^T(%y"fN1Db<bidyA[(oob޶k2fd'cڤ1NEyKRBPVR{5'_3Ix-LMddL>n}U ]L/^^?{Ϛ#ہSJǞ'^zl\A<`]{NyY`&Ͻ[O"aߺ5WŻhSxxx n,|#ΩZ#/Zw:~ЁW8ފ1ylE)^{g#uB1-y)9ضó/CsKkX.ܱG(/+JM۷d3$ aʛihj/>ϫ5o,0ؼ}/?x>Z =+mf.#Tf"19p?mCYh#kVH! | w ,a~>NX$cV M-f(T0u(V. =ɫom8V/q 2v\4Wi>oy O8iM$ @mCG1 v=?9xDNvJ0g 2!SKM]#M<˧0M;ۧ^Z1tHIFSgP8DzxLe}Aw@H)9e<ǎ0}6غk?GOA5u.oD, HU gܩH2֛Gf֛٥w4+p_{hC&tfޑ̛9㡪3OyǾ %m\ | Haǂ@ a~ a~%Ck t͵[D~zm'x8u6k\+BZlھ7~,y)%#*ʹ~ +!gjyo.}Zpu)+)ʘ> lٺnw6gn0{Ǟ~ˍ/D)ņm3,:QC/|NI\|~uZxۨL{&d+ {p^Rxt kͻJllnX:vW :fףHXh#+;a7nˉY|V]t?z&Gg|qp~A$j3at ^)%Ņ|1o<ڵ{y7S_..hMoca^01t!VTL4R{riE^nMͭѧhln=չD)E^N[/2 ۼfx" H͚Ĥq2nn08t$u6 Vql]>_A[{# )1 zSbɂ Gfv‘m̛9$Oko?đi0++O>ˆm{aa뵸ebZYs .-;doAo?a>xύLm~'y i+t)>w\=\̚G 46nNw+^Ł'o%nXcfw}ӲfoL],jDΟah Yt3tvljÙ �SG~?z)o7r QNa1k/>ĨC Gc<˧8tdƖN1ݱ*(/eٵs2Bycf ;m>WJڹ:}dBi#7jziq_xߝ+m;<p$^ôQ͚L^nN Xq'̛7\^|cO&eR9U#>l^ӵlغ?3QLPaitx ?_iƠxm46f1|eWQZRH~NǫbwFY#+/)n^8uE:뇏< /  #`>3:c|O0m \;:em]#ǫX)zV)0 məmvì6iLƺ5[kv2Ν μ|XбSBY}BջΘ2ϰhԌH,e9Q7~kzd$ mR&i=mzOC$Λw INC-E.kvQ̛9)Â, ƻm'Wܾqv8ʞG;L;[5+ }6jt)!Lcx< ʱt ` /}cF|]1Mx7Î0W;00J*NCYiQY) v޺C0M3 ̩Ty3&Ck[a|J 2φȉlMJߏTJ1:;}(xsV[CO_zocJ0e% )+\?a|{-KwRy}7O?HiqA*Z@7soJ:Ӄo;^XFLy3'zz=G 8[@$rhi>JC便-kvBV.B\6nNm}SqKdDEyincs+o ՞=]y<p߭ |x̴*B U;kk{ϫH0tH _p n.5Efz-n^?0 9UM&d̞>d/bi j*U#g=@NПkZcDzhRJ<޺0rhj2MZxi:Kl۵Dβ7o6zP5΍Z~;_?r0 }!cJ*Ò:Y-ͧ0/#&Vohӯtx|QV=+Ryn! RbͭmF~lھx<ըʁ `Ċ%t ֺ-Xi'X 3 nyۻXx=^U>V@a~.&uo&@:I3&:yn>V́#'d\ԁ pPJo;x{ttIy87l"`Y6i,:%OOn9ێC8Ų,|^O2H{}5,]ë,v.O2yBUj e^~)^}k=ma`f;ow`)YYΈ!r&Z痏ȻwtrKaќ%o;|RJLbqoJcKg* Kw \Bpl=k6L!Y} OTX 8 M-k=qGOOyY1$T~<~2iT{+2̥_>s>[7W;CڸV0uB9Sۧ^IicW=U#2> o)fŵs)hni͵[>v2͝tt/ܶN0dOJqa.m"ͭ!7~{wJ(%SRTwKi?kǑѧX>O156~^cđv_vv*[SvB4+W-wֿ!ϯΚiCfN ?{wN s™bY]/T,;C2>vç}J%??ǏC3qH!x!V^7?}19y}6|^Mmw_=:}^‚~Ψ>HY0{J08z4GHϙRrq M|SrR*M_|>PW7kk0F V2Yi.sxǡ/~A*rsH1y#*pWxU RIFip:w6۝TLAyiqmwt.)Ǐ亅: !8]SǮGT+Pcy9׽w=Dsk[2RrY~˲ÿ)/|}TzP<+ۼ3uuݺO.,b|CNf2M_5$*pdQ_%4]]ٚו`(5cX<+JNTװi@ '}$M~õ -+XúwT`8RpTV.)Hu7LO ⺅ڗ?GyY1I7fK)ebV] ɗqEʤ`"| o~q(+)-D<@A%_^Z~\K`ڤ!tY4f^J3uH[ a1P:Ccsk5CmUv' ;։:Lsk ;}"J;3˯sT+'~o= =m!WpXu0ԇ[鳌>GJ_H$46r>m{s M-(Pj|>|GS)0uT?X#UVp,bؐRFɪH8۴C*-JLU#u>+{Kgy)Usu0p8ztwrŬ\2kk[ںF^7-[WO().;?~LgD3Ĕdy̘<>5hm Mz?7JJ'ǴIchm {,:Dz(+)Æ0}XnZ8|ȫogߡc#1!p':]~Ks4T36ZCaO)%**W6E@P8B v{9>y U*XIń#;A -{IR^Z;mCNeX3XANJqj27)%Fg@+Z#T"˲ß Gɯ&GkV] bLI]CsJ`|#p-ד$ ݟqUɈRY#'`ΌI̙> [wʛyo.N>K$pp0e8>|ܾjǖ2X窮EPNH&يrG+Ic 8b L{FAB]7SxR08~& `(/%79s>O|HFJ}BPRϭ+aֳ҅Qv=76c6̝1su"%eFߎ߫0 X ]e} E`Ȁ'?Y, OPuej8zuA]ڬ(g W!];il{QecɁ#':q }g74Û6EDb1Z_ N&µ# H$hi s [wkټcx`}};?E8C1Z06`&FK[;MG{@8C'QB  ŌbWӫ/ `%ǏӚ2mokuQE'g-DWjwwoc)_S^{gc`P8ʏ S'VQ1,eɍFcϡ 7}[Kȱe~?³Ö1ppYNV7[бS1*RR!J6Jyo !xܹlgă~3'C5ᨆB+GjKB)bq\Rd}/\E93olasl`};tS82ihj;?~GEݿ9R=9ux|ㇿf~~oqm˩ZٺFVW@sK[%uԋok1 h,Sf"Jw` w)tuKkLmC]ކх?8QC۰)Ǭmf6̺&$=Y"ٓI@ DKx* ?7g? t>gmڀE{-ןddД!&u~SYK{#'|{oYF [[ygvZ%B&n4Fq+Tَ7kJ hf7y;+LnZW򓌨(7 rxc;P=8DWP.;vwL543mpH4F$Kw#+wCsX|TIAN3LŞ03oa1Dp@? W )V%_ ގIA~^IFjnZCi~U~7Dꛈ/Ft\a6" r"'|Rh _i4x:C2{&fnmqRkQRT„1#Y8g*̛ URyTgF%0R5+L߇u4y?*Gq:^Eʝ GlS*yJ%@㡤(L<9&2eBN0@oIHm7/HIħAHPA^6Fy,QBEtt4>5K7ͮXRZRQLCJZƈrFUe!STlOc;*J:盦A$c׾<[߰^߀SVDd̺f|[w]QqVA A^v2_Ǩ'2>~qF۽}ky ͥ |JK RRDYiŅ摟KNIz۬vf&iOTeݦZۼfC͵ۖQׄ3|"%1e^dX9tԅ^} 0p*]2l` F& LSV3-4,eXx=^׃}~{  ||>^eڽ4@̮GfjD9Y}-;{ظm7'Og=d[q]Lb)mr~gh G Ex:DX9gj) jL0rW\sz`BhI_ ),Kk5ϫ5O0# ^>~?߫jaPClF ~kpi2n@5:Y璎C[(̙z>غs?D"Y\MLˤVq.PhYć# rQB`6~"p;2My7 YGӧy090GK UYÛ2J!X yPV\HYi!ŅPTGA~.9I͖,3U;N} Ro)΅Y{BtͬEqZڨodu :zB,ծ]ƈCINآq4͛=(F$Jo_>fM zbRb,G Vci*uOkIJ~ZPV\HRFVe V!%哟C kA7Įit"X#@V)mǑ$Xp$Jk[VmtM5l]-"6JɴwW (VD%+#6C}>b ѸbvUI|w`-= V3t,H<@ƅ9w3opSZN;c):9T's(37gB?Tsa].tW7W*'+bY E#ITm֐i FÈ.޾&%;P=GTٳ7ZgSkVL=Y<=B BQ bVP̌;}/\A;^ƌ亅3Y~MCQa~LGz1hW=48re>v?gii Hةpk u\vۇބ70U,I E@im+@ 8CK_%jC:cWUs}3FSp`mԑGDV)/8hlQ1DEe'0,-N_ W.Bbϛ-1dJtΪdt{-4Mvm`aS4&S&А5Kf (IGl@&=r5Dw𽷃Qx#7h] ݇1ZBXG1ZxMN֑SSh{捓l̆fj! 9 ~$o 뱘<~$XM2np|>Ou~ {-EA]c3w6nN:C$C@Jvs z ^7bK# ˂b\l!0ZC -zRwY߂YBbޭK>E01H`;an/.rMO }-/b e~*D8 sg'773gDz]3 HnhkqEx?tBMN-*g'|=k#alʨÒCYNi^0{Pz-!_ϑfD* + B nڝ:JP-a%y#Ƴ0Z(J\x;[% `>o`ɂ&#^dvzKtpÑ(͵mM߮e{'$bUIx k Q%آi4-S^Њo~<cƬo|;(,[{CVry+m?X40Zʎ=s9 )/-rX"rqNykN}E~o+-m93n^mґElōQ҈M!6k^|[s#׭}r5y,܋L&P>/ChD $|!kh=PC~nCˋP5S3sxƌ$?OВ)VUJm~~gyi{<Ҧi48h(9UQɊqh^1hnӧp/᳊HM*I] b,ǩ(a'jNuKR"ef9.^P =ʾAt‚<&u g9L7`td Vkh'^?OuMhzyby2+?߶ܤK\̚B/N)aT=qڌɞkn? ~8Ot |[交(pMױd,J ɔ m[vwtg_)wl&&$n6SNxi6J_xDȡD">gNq= 04.JIOz^">ޙm$2sxJnZK0v̱xǞ~1jvUivXuY8sۺO\Hiu#v |=Վ'nO^DFý8 ?B]x)t;{goaތIx*O%<ڝRy,bsZôv4)ooRSV"a|^ X%ЂYׄ؂D/R)B^7 ;~ / {dO y">{:qL%+0 M_|auo:(0>!̊;$%b>veޭ d>YըnPZ Qr(-)$|RLy[yԎ8vE8CcosFs6A+6gc챺 Mo#+ُ 'Ǒ!v5o]C_<۩>7(e%5dV\2>PUOt8"5 S_XgmxQ$ހC`G#(Ra_4KQ?}G$QUAbHb&2v}G Ff8mF;Y1/Kg!4ҒCgZ=`%8e^Y( K'P̆fbs&}*!(К4:u)ck0[1t;ŕS^΀yו𥃷]!`}?}v5uϼ6?q+xӦC]anXHÔ*|H ߆]xhjCDc5{JpǒcIXYp4p$?kоdeLeCldҾ&NZ;juAL<1kXdiC/y>yM@_jxA֞]'}ZBX)i=po"_.xkcv>}ȡ ֩%<;%+mmY\ `=I`cinT*[;?ꪄ@1"Q/QKh?il\RKML~Lq]xHRˡy;i44؎Ç)+B8>v*Wo@7G$9 8Ju Gg?8;Z! ~-IS`@̵%Y?9J4?"ak8#w+:m2mVdF0\vDq.=}+a߿~o_R 4Yv3ϿnBB3bvP'Ou 9 G\*l!hz3'VXAޭjo\_jȗ -1̸zTa+E#X"h =۳ gm8V MLV/?Я[x]1 6STϪq !hn =G[(_f+ޅ1gZT(Alpbw L(ƻ0#Èj\8k 6z vYI+qh϶jXõ-OȑJf%$ q' ‹gv,2T^ecɡv(fC3<O9rJԉ/#%Thg[-{8xMCpO6i8if6۲/|kʙqZrb3y~ )&&woӗ&rL[VbS'*Ş80Qp)L=GEyħsG(g1|j]ﵐdAϙh c8)uZ;' /͎9^g+U|B/a(] Ƚ4M9}|+J <›QZrnI-i))/w\uWkDžukr໹&5IDŽ!/etcJ[RoJ`)S`WUItlC79DZU]]QoͶ)(DȂ<aCK1Z0ktd^YA\hµ-n_@%I ,E! AI%l:Nj&sPz7n᧿~G8x$6J '1DavF 6WìmR8[7RԚԘZswQb(&% Iǃ*#QYF֊RooY9ԑ< ԱݎoN:Ce$FٷG :|ꍈXX\8FkD6~ϖ:lq9Dh#%ЯnW(XpKiݓpLf&7eh Sz^Z^J#u gQjȾ>b~A׉.g1b).]qD.)B ~=IpG1VLK$$*#QQFlL%1ÇhGDL^^3߆ݠ6ZC :SOϞՆxB?|bYtZ8RqN^Ҿx pkxߔm6''Bhl!! )0M̠ʢ|>^Z&cN]{^W à#؎*Y:[;^< 1B^]YӠ+Ȃ\⓪G÷a""&5u/^"aBB1-! A@I.!>f8q#GE|V<{j5յ:V<]G;,efri=F6k^ྊ2>8c"2r$2@%lA@e'a3G zBwu0 6n kf~y ":qVnً3T;!"QrZ#7]M!} ,`LuTF˸U8`p#XhX6bLVHkGא&%fyMvZ9@g(bܦ]S_&7R'm#Q i;82gmX}}.䰋A8 ^w -xv d-֩6LG1#m qI0EyG#2{h (0ZpaV[CkךvXL%1`[v!v6Lx` ^/yP$Q9BD)k%WgD{2wy!Q9v:К/$&$$S`:ЄQD[i`m@(O'eݙ`M\`ڄBt[)tއl }Lv= &ә=G)MLn/ug@:lOs/-R¸$hPO|| (Lu8CA**YG|pah յmujJcG_ѯ$\=6{m'gWj Qb|xJ a -Xy$0sw0X aë;lEyV:{rD(on m[Ew4xsf]# *Cƻ}+׬=ժWƾCvk#x^WTxK(\<(DC3m;}[%B ڶ􎕘9:"Phɔ0@EOu?Ӛ`?H4,S^U]Kx7m"j!* 6*-k]IW[t[5>q޳M /\V7C Aq-ȟ?'_&^ۀwH m?g !z V^NO˺A@_ZxEr6cFxJXG{9c44 ߻2W[]n' j鉭 +&3~Ibgj =BT *&Q@h!‡!cq<vs+mwe4DV9/- XW|%Ap?p3FC ?~Ϯú!4ٹM ­f`_}T*nyI[p¸G. Ӽ8-% RQa۴lB;q:5kݴ z:UmD p2KC Jb(˜0i+-"9M @Hy1-t ]%姻,PS9NPJ9n#J;m큄^xis JݶyH&i4uZ)TWI:w$#K?3(} or(JI[v7cDFoJ?:CofW6<9@)*nݬNVxGx) q⒥Q :Ƶ9F7,;<7[k1~T]Ca^\RqKkJ J I13n BB+xo#5=N㼗سM (zy`+Cya}^F&hѫ-NGbzg1ZR1^  *S,07PlY#5 9tsMSS۠j ,:FMs@[ VQ->/)UI|Dk- /85^-Ы_Ӫh;#Ƴ0fM=T(J JJT=d 5 3} + Gy#ϡ}kh9s;x x3sPuRb<Ϋ#31՞PH+#T:8..0ږyD珡eHf|wcV"d:A rGJi˲y 4E+PB8u,Rgۗ+`Gbe/ϩ}N8a^Th#9%M~Ȓ\;r)[OX[r}T00D*/!2g"ѕ)p؆{^cAr  S$ ;JC-਩K8BqouJyskϚHDI_l/Hvվ[=[G^h |tFWrA a*O*'$ˣ3cyES+>ISo`Ku3ੀɫ~6ݧ0i0@yϝڿrL^hJ,9#ZUgM ʺn{oPы^v}/'=k9ߠt^vTX,LK~h^0Ywa}^{L%$Z7e P)[y h؂L»(QB%>kNE։M;}-֥^WۚJ1Q\\uaKDA.хi7nއŏf}t)C 'Ϊc%}B`%ٷݷ_X Wxסu.Į}ާP:k /h }U:ˆCYVDdb3' ԕC?C)BgQ˵k/mV(onBϚHb0<Ǫ)p{ˈ}Z޸^1 7QQ|$1b(TB:jӞM +^w":p~Ǵ{zy.?7m:D^8`;XΠ|da=GߩH6h+p2nf? xN;BhT({0MFƁi`C耎'0[zvcn ?.9ƴ{zᅬlx~-m;EO': "n9pT 3ob4>Ju K~g&uf{m~\MKş#$ĦTYĤ(QDb(H#vY1ç Wȧ8k9N_*eIê^BBg?U} 1S_xEdP!#ĤфO›Լ 00Z?,Ey=6:qYO|rQm܍uFK(S3 CfN5 x+ ^T ŝa9Q_0@d$"#sxwBDc$&BD{;^2rp][k 7hRf^U/wO((ʧ8%dn%"GA?!:3V|!A OK|$<EʁWd8ဇ79uiKn ;\xΝ@ {& 6ݼ7ܱ{Sn_dGmvͫ^b H˜iRaDb^ZSIX'g+T ݔ \5թ(#1f81,Omv=6}`WsdE֐0 hZĤX'jĤۉm^$iST5A!s"g&xpm\$(⣇v& k;uIk񿽅F"za=Lq$ ̯>0?Tn&+^PX xBJ09P\@lTAFݺͺcɭLpuA\&C[u}-W f$ I^f&NQ>B)IEJu} YOt|̚z|v%pq RJo]Ukߛ$x:wrnMH\aPA?֡:qx#װN' "i[B=HAOLֺW!e(GِdO=8Flք1UB1b4]<#: h _u!8yBON xxu@*p[(Ai7ƛ]Q߄uǬk"ٷnT@$D2Z7ZxK޵\MPkb#?-"~*eEVBsD:z3o[nهomnh҆^<`ַvA?+^l7JppWȦAl8nĄ(Ծx}X-3J.h+;tZFx0ԁѶ"6{Pi1 @)|vcNE8C -ѫ"HH5Q^10Tr# . ?[g.Ս~zjBrfn()ƅDFIolķy/Fk8PY _<07tZFxOδH &Dy-]]Yׄu88^X=j(f]!F7E`y߻{W ̀lⶰ= 2w ;#QU 5ܬr[.n<Mvw|нkQ1 yA2ڐTߌu4NqAʧlh![DV.7M!bq"BΛv` ֙K l y94߹Y(O'[M6:v<h_t|ozN7_ /hLN(b3FbWbAN2T0yrC}{0"+|ju{H))ljhZo2yu ؙY] ̉ )~7':?, OBAcr8\𺳣bC(G,Za% "р(=j։Ҽt\*kb`h xw"t2<OtirqT{<OM6xl u}-W3(mT1ItSǤ|ݓi/9kp4s E)îB`j 8lvu^"?[g.BOod{1,ךv!6 raPKHuc ( W)*>/M+G )Gb4XF[Y$_\T$&FxaGP'pBl=B-"B'1Bn 2:$$/LMoSaV\]8Zc#ZCzE)Kl|[Dy;Wٍs n:gLὰ;QZQt*,uSOM{ "Y~繖AxA;T*H>/{ؐoGC -?[g.58d &&Nzki,Ԙ&/=]4RtP'!y{T1ƁutmG˳:!{4H2ůҙ/cx{ V3/tB.VEPj*:T+=09lie=O?6%Nc('l^ PfԈ~@.唹Clë^F +^Hij_8Ri`!?iRhLOMz CAx{^¯(&+9V=̴]U"E$lq=}N^rӂ'7qJ9 c6AgnAI'%{(P<^|W81M T=y_)n)|>/9Wo:v0uB{ mqV 4a] ,/}U]B?›MW{~tL3o4`WDgW2)yATNB`F82FhNMऩx$9m"y dx^w@=?;uH,>C=obs'|3JhӞrFK5}{ IF~ޮ1E i6,)4c\]ELSOm +Z\0 D(#<녍D+^v@=ߵ xx( Uh\1۴Ϯ(D%cX"]C$u"ԻW.-^XDWVѹޞCM 07,s ϑS(%B7BQa;Th4%ˢo)o|Pkh7+=BtPvƕ oTQx rSio(=m6 mrq#d"S^pL1uZU=Axgo뾺5mExt(hj%!e2_JFYۈ%.dGԼ10H^+^T2ϕ=*%DV.up~Si|Q]2TF(^_"!S Yb3sP^r7-Fy!E_YԊ ,<&R(HU/LO9/6>̓l> |x6 ^/3{6 ~Af\*1DTf&;Q^ 1J!2-Ro#pWs\ ڀ<8cg)MK䏻>Tv@.|}Ei;VU$|5 X'kn?H$ƍ>0tx,@8B&+ vP+ Voi薃/reZFWןK0G*k$us@{]'" ["B3ui'yox xe HV0晆'ʂH At]\'b 8i&z_vz7}.XZ⾌ހ\̠ ›fv݆ ȓ53ILof|mPTGW-#tX(wX: ,MP=toMz0h@> |c mf)x[K|8TGk?JbXooE(<茓(X.\齨#w"BT缚 o;ʮc]^/IN "9 3(𦷙9kë@y16ˈxnهGOu8Nㅣ)P׶H^sV*`-qڗłEJ6 O)6۳6jSٍ y/|Mq7"RSƦw\m}niӹh[^2! _Kz `WҴq(4P;x {x9V`<PwA*> z_mTUWm^R&\/~Mz`H!Uts[7Mg\Q"1!%* l.J̚zUTj(-2hjɼ4dx_uu,E`\p]$v{a7M7Z1bx 7_SVwAD<=jX{{ԙ"Fc+"n#1벮{"hhd^wC%8h!w e= G:o׼CQ@ےYħ&dZ%Epy_L#]LB &T5ǁRa~\W̋ook&msZXBs#030X QBW! wӐ;%o'ڗMIJ6AR*!(~KPbpcTbWU[Q)GX L= u݇P)TI8E-xzzLQDA|pB-!>s"-\f3F HE,n}W=hm7h[ .}0t"B29naJcç _0@ۇnQYׄw!|;[0 #x@HuZTAbxv`Obm!B)d^صpF9| gD90$=+_IDAT͚HtT g60Y 3 op&/v%xDW#7vk|` | "LŸ# t5DAE>{x9FC w3%p&}ϞBhp9T<ۀwAc* MƄCdt,a0鎁@PJtc? \W$R + `Էsv+^R(,*bz*σiT^['B$l|w鬒s^#ۣv*G f#պHl'0[1Zu4Tc F83#%F0 {Hs&?+1tFpƀXt7ss{*`WҴq@-0Tq'9^Yb|4,1JhmȲ"uxwĮ6Gtݹ7=26xaj\b]6jዀW$Aa`$l6s#2?c8Cp*JILE|pm,+(AZ1:M~ 0dhckwW8P>mXxQ %`_+J-m@l$g8wa7;YA(")/&1i4"gϟB%411"A$:%G?_GG+`W4c$`$Pq㓗^E|uo (G[Z>qdqf}^̰g)R5yc>P{1뛐y-mc00ZCxwCT%0ZQDMî(5K`2Wp֑sE_wb$jxH>9\Y6.H߶)si GݎYߌԊu<`o샣(8yv.{ bAE⨣E6iժVZ_Nu:vvߵT3QQP)!!Ke_xv/g rI.Lvog7yVx&AiA,`71eO#ިJՇ>̌)E38[j)[;ֽ`iyTj)T>4[1!]W 1x}W p_ Læ{璞=,EtgH"xf7U7Xl a-ؾ'”vpcsgOʿX xFExotm瞂74~ٹ򿿽p}^MER Rx 70]9DŸƵpSNMr8uD7nC28uXi: hk 4X8wLA\o Giϵ\0H."[w!#X_6(]lF}NͿx)yX`;׊O>+ RLYC^PvUIwD~|u DnA];0 P5/_r+RRP. MGPB+x"fXv,Z/zGoo D!pA]c= ooL+j++hRJ}SEي8 fmxE /eAa1e?D]R= g,[b(浔p+ Y'9$R<}-DˡsI< l'rT[HSTLG1hQ~Q#xBpFF1; |@$S\)ߢt5 ٸ?]Ĭ v $9ih=k-WOtk6UjjEyv.Zv ř(k8& G{j c5(cu^k}da>0@ 0JL[DQ FEqC\ԦI͜BӍEjiWnf|Si$Abeֶnvxklqؔܛ!"9@mQĀQ&h̛mڠ.O Эna pXud8'1},z(*T.͗J.X]K9b"G Dk5xY#.s.]X0&0ib=3 O:76 b湯cʕ Kp ku,qB;@B((xp_+L ##ʱwA$uQd(Etf>܀́-խmV“1x3uяBeiH ̚Z1AA= ? Ĺ?MDU"Eqdnfm[11 3ȎEk4Mx`o h ,4՚?ߔ8ѳ6 wpwRÙd#;_[,x]-K+J GdxyԴI$s-"n]p>#f/lG5Q<6y (dɋt66@TCoqZF>n:N.>!z}褑S9/ޭ"<_J9Z .@Dz`99^7E%¹Y ;a&o܆CK"~Wt\F"<]w{ưTp)  |,"UǗ&F!{Uv6pZ!)\ vf}ԋDzqb8:k,bxGI^?S( ɘW%5WEw**d(eUݖ*zh6cB㠁܃Sp)d x0_ܤ4.HmC69YC1`p旂ܾRp+d8?&r .^zQ{-aA$ xG^ [Ak2z~+JʎTYβ^-f bwc'Cx^C"`Sv_ }5ؕ96K2!_17O:&lbzXK$˩MbwB(o_ %k+R +sr(5nz#lr`c bow/ +Bޚz֞Fw|!fd` ~* Aߞd8\T?rm+mƁ}Rx끿` _:| aQ?ll}}o;&̰ك܁R+&lNIL%_Dž"s q=W0j܁V Q#`W( OBJu݆z|; D4\\b*a+Tui< > <  K0ֹ[ЫB.40ܥsCpB@acu=4*ង-9]*  .\\֠YA*VEGb,A w@0̯d\" bL\?ZW8@?J#9b6/<dni(Ĵ$1"jeyvΗܾvHt rzY` _OBKTEU\ٜעS剮,/kA%W CxKO!%%syլs`-"jP'xwπl3LmT<xz4n~ 8ft6+s讇:H! k FW :?l U7tEXtSoftwareAdobe ImageReadyqe<IENDB`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.Rd0000644000176200001440000000437514556444037014055 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_query} \alias{req_url_path} \alias{req_url_path_append} \title{Modify request URL} \usage{ req_url(req, url) req_url_query(.req, ..., .multi = c("error", "comma", "pipe", "explode")) req_url_path(req, ...) req_url_path_append(req, ...) } \arguments{ \item{req, .req}{A \link{request}.} \item{url}{New URL; completely replaces existing.} \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 an element of \code{...} is a vector containing multiple values: \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 functions work, you can alternatively supply a function that takes a character vector and returns a string.} } \value{ A modified HTTP \link{request}. } \description{ \itemize{ \item \code{req_url()} replaces the entire url \item \code{req_url_query()} modifies the components of the query \item \code{req_url_path()} modifies the path \item \code{req_url_path_append()} adds to the path } } \examples{ req <- request("http://example.com") # 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") # Change complete url req |> req_url("http://google.com") # 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") } httr2/man/resp_status.Rd0000644000176200001440000000441314556444037014751 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}{An HTTP response object, as 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.Rd0000644000176200001440000000112014643705565014060 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{ To perform a HTTP request, first create a request object with \code{request()}, then define its behaviour with \code{req_} functions, then perform the request and fetch the response with \code{\link[=req_perform]{req_perform()}}. } \examples{ request("http://r-project.org") } httr2/man/req_perform_stream.Rd0000644000176200001440000000355514645244703016274 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 \link{request}.} \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{ 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.Rd0000644000176200001440000000131114556444037014516 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 \link{request}.} \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.Rd0000644000176200001440000000507714556444037017157 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/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 list of paths, if you want to download the request bodies to disks. 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? Use \code{TRUE} to turn on a basic progress bar, use a string to give it a name, or see \link{progress_bars} to customise it in other ways.} } \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 slower than \code{\link[=req_perform_parallel]{req_perform_parallel()}} but has fewer limitations. } \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.Rd0000644000176200001440000000234314556444037015346 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 \link{request}.} \item{username}{User name.} \item{password}{Password. You 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.Rd0000644000176200001440000000771614556444037014422 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{Control when a request will retry, and how long it will wait between tries} \usage{ req_retry( req, max_tries = NULL, max_seconds = NULL, is_transient = NULL, backoff = NULL, after = NULL ) } \arguments{ \item{req}{A \link{request}.} \item{max_tries, max_seconds}{Cap the maximum number of attempts with \code{max_tries} or the total elapsed time from the first request with \code{max_seconds}. If neither option is supplied (the default), \code{\link[=req_perform]{req_perform()}} will not retry.} \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{NULL}, which indicates that a precise wait time is not available that the \code{backoff} strategy should be used instead..} } \value{ A modified HTTP \link{request}. } \description{ \code{req_retry()} alters \code{\link[=req_perform]{req_perform()}} so that it will automatically retry in the case of failure. To activate it, you must specify either the total number of requests to make with \code{max_tries} or the total amount of time to spend with \code{max_seconds}. Then \code{req_perform()} will retry if: \itemize{ \item 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 request. This occurs, for example, if your wifi is down. \item The error is "transient", i.e. it's an HTTP error that can be resolved by waiting. By default, 429 and 503 statuses are treated as transient, but if the API you are wrapping has other transient status codes (or conveys transient-ness with some other property of the response), you can override the default with \code{is_transient}. } 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 behaviour 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 to at most 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 = ~ 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.Rd0000644000176200001440000000102214556444037014723 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 \link{request}.} \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.Rd0000644000176200001440000000131514556444037014341 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}{An HTTP response object, as 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/req_headers.Rd0000644000176200001440000000343114556444037014656 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/req-headers.R \name{req_headers} \alias{req_headers} \title{Modify request headers} \usage{ req_headers(.req, ..., .redact = NULL) } \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}{Headers to redact. If \code{NULL}, the default, the added headers are not redacted.} } \value{ A modified HTTP \link{request}. } \description{ \code{req_headers()} allows you to set the value of any header. } \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 `.redact` to hide a header in the output req |> req_headers(Secret = "this-is-private", Public = "but-this-is-not", .redact = "Secret") |> req_dry_run() } httr2/man/resp_retry_after.Rd0000644000176200001440000000155114556444037015754 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}{An HTTP response object, as 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.Rd0000644000176200001440000000466314556444037014355 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 = size, 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.Rd0000644000176200001440000000163314556444037015401 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 \link{request}.} \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/req_body.Rd0000644000176200001440000000740714556444037014207 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 \link{request}.} \item{body}{A literal string or raw vector to send as body.} \item{type}{MIME content type. You shouldn't generally need to specify this as the defaults are usually pretty good, e.g. \code{req_body_file()} will guess it from the extension of of \code{path}. 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); \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 an element of \code{...} is a vector containing multiple values: \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 functions work, you can alternatively supply a function that takes a character vector and returns a 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.Rd0000644000176200001440000000500314644201474014275 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 \link{request}.} \item{path}{Path to cache directory. 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.Rd0000644000176200001440000000203014556444037014221 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}{An HTTP response object, as 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.Rd0000644000176200001440000000711514556444037016574 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/multi-req.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 = NULL, on_error = c("stop", "return", "continue"), progress = TRUE ) } \arguments{ \item{reqs}{A list of \link{request}s.} \item{paths}{An optional list of paths, if you want to download the request bodies to disks. If supplied, must be the same length as \code{reqs}.} \item{pool}{Optionally, a curl pool made by \code{\link[curl:multi]{curl::new_pool()}}. Supply this if you want to override the defaults for total concurrent connections (100) or concurrent connections per host (6).} \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? Use \code{TRUE} to turn on a basic progress bar, use a string to give it a name, or see \link{progress_bars} to customise it in other ways.} } \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. Exercise caution when using this function; it's easy to pummel a server with many simultaneous requests. Only use it with hosts designed to serve many files at once, which are typically web servers, not API servers. \code{req_perform_parallel()} has a few limitations: \itemize{ \item Will not retrieve a new OAuth token if it expires part way through the requests. \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()}} before/after all requests. } If any of these limitations are problematic for your use case, we recommend \code{\link[=req_perform_sequential]{req_perform_sequential()}} instead. } \examples{ # Requesting these 4 pages one at a time would take 2 seconds: request_base <- request(example_url()) 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.Rd0000644000176200001440000000720514643705565014723 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 \link{request}.} \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.Rd0000644000176200001440000000311614556444037015056 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 \link{request}.} \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.Rd0000644000176200001440000000130114556444037015101 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/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/DESCRIPTION0000644000176200001440000000263214645436632013043 0ustar liggesusersPackage: httr2 Title: Perform HTTP Requests and Process the Responses Version: 1.0.2 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 (>= 5.1.0), 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, rmarkdown, testthat (>= 3.1.8), tibble, webfakes, xml2 VignetteBuilder: knitr Config/Needs/website: tidyverse/tidytemplate Config/testthat/edition: 3 Config/testthat/parallel: true Encoding: UTF-8 RoxygenNote: 7.3.2 NeedsCompilation: no Packaged: 2024-07-15 20:48:57 UTC; hadleywickham Author: Hadley Wickham [aut, cre], Posit Software, PBC [cph, fnd], Maximilian Girlich [ctb] Maintainer: Hadley Wickham Repository: CRAN Date/Publication: 2024-07-16 09:30:02 UTC