HTTP and Web APIs

download.file(url, destfile, method, quiet = FALSE, mode = "w",
              cacheOK = TRUE, extra = getOption("download.file.extra"),
              headers = NULL, ...)

source("scenario.R")

capabilities("libcurl")
#> libcurl
#>    TRUE

# A local test server: plumber serving the shelf CSV files. HEAD is allowed
# too, because curlGetHeaders() sends a HEAD request.
shelf_api <- function(files, port) {
  plumber::pr() |>
    plumber::pr_handle(
      c("GET", "HEAD"), "/csv/<name>",
      \(res, name) {
        if (!name %in% names(files)) {
          res$status <- 404L
          return("no such file")
        }
        files[[name]]
      },
      serializer = plumber::serializer_text(type = "text/csv")
    ) |>
    plumber::pr_run(host = "127.0.0.1", port = port, docs = FALSE, quiet = TRUE)
}

files <- list(
  books = readChar("books.csv", file.size("books.csv")),
  loans = readChar("loans.csv", file.size("loans.csv"))
)
srv <- callr::r_bg(shelf_api, args = list(files = files, port = 8765L))
base <- "http://127.0.0.1:8765"

# curlGetHeaders() fails until the port is open: a handy readiness probe.
for (i in seq_len(40L)) {
  probe <- try(curlGetHeaders(paste0(base, "/csv/books")), silent = TRUE)
  if (!inherits(probe, "try-error")) break
  Sys.sleep(0.25)
}

dest <- tempfile(fileext = ".csv")
status <- download.file(
  paste0(base, "/csv/books"), dest,
  method = "libcurl", mode = "wb", quiet = TRUE
)
status
#> [1] 0
file.exists(dest)
#> [1] TRUE
identical(read.csv(dest), books)
#> [1] TRUE
unname(tools::md5sum(dest) == tools::md5sum("books.csv"))
#> [1] TRUE

# With quiet = FALSE the progress messages go to the message stream.
download.file(paste0(base, "/csv/books"), dest, mode = "wb")
#> trying URL 'http://127.0.0.1:8765/csv/books'
#> Content type 'text/csv' length 1187 bytes
#> ==================================================
#> downloaded 1187 bytes

# Several files at once: url and destfile are vectors (libcurl only).
dests <- c(tempfile(), tempfile())
urls <- paste0(base, "/csv/", c("books", "loans"))
download.file(urls, dests, method = "libcurl", quiet = TRUE)
file.size(dests) == file.size(c("books.csv", "loans.csv"))
#> [1] TRUE TRUE

# A file:// URL is read by R's own code, with an empty host field.
local_url <- paste0("file://", normalizePath("books.csv"))
substr(local_url, 1L, 8L)
#> [1] "file:///"
dest_file <- tempfile()
download.file(local_url, dest_file, quiet = TRUE)
identical(readLines(dest_file), readLines("books.csv"))
#> [1] TRUE

# The curl package: curl_download() is a simpler, cross-platform equivalent.
dest_curl <- tempfile()
invisible(curl::curl_download(paste0(base, "/csv/books"), dest_curl))
identical(readLines(dest_curl), readLines("books.csv"))
#> [1] TRUE

invisible(srv$kill())

source("scenario.R")

shelf_api <- function(files, port) {
  plumber::pr() |>
    plumber::pr_handle(
      c("GET", "HEAD"), "/csv/<name>",
      \(res, name) {
        if (!name %in% names(files)) {
          res$status <- 404L
          return("no such file")
        }
        files[[name]]
      },
      serializer = plumber::serializer_text(type = "text/csv")
    ) |>
    plumber::pr_run(host = "127.0.0.1", port = port, docs = FALSE, quiet = TRUE)
}

files <- list(books = readChar("books.csv", file.size("books.csv")))
srv <- callr::r_bg(shelf_api, args = list(files = files, port = 8765L))
base <- "http://127.0.0.1:8765"
for (i in seq_len(40L)) {
  probe <- try(curlGetHeaders(paste0(base, "/csv/books")), silent = TRUE)
  if (!inherits(probe, "try-error")) break
  Sys.sleep(0.25)
}

# Run an expression and return its warnings and its error message.
diagnose <- function(expr) {
  warnings <- character()
  error <- withCallingHandlers(
    tryCatch({
      expr
      NA_character_
    }, error = \(e) conditionMessage(e)),
    warning = \(w) {
      warnings <<- c(warnings, conditionMessage(w))
      invokeRestart("muffleWarning")
    }
  )
  list(warnings = warnings, error = error)
}

# 1. The server answers 404: two warnings, then an error.
dest <- tempfile()
diagnose(download.file(paste0(base, "/csv/shelves"), dest, quiet = TRUE))
#> $warnings
#> [1] "downloaded length 0 != reported length 12"
#> [2] "cannot open URL 'http://127.0.0.1:8765/csv/shelves': HTTP status was '404 Not Found'"
#>
#> $error
#> [1] "cannot open URL 'http://127.0.0.1:8765/csv/shelves'"
#>
file.exists(dest)
#> [1] FALSE

# 2. One of several downloads fails: no error, but attribute "retvals".
dests <- c(tempfile(), tempfile())
urls <- paste0(base, "/csv/", c("books", "shelves"))
status <- suppressWarnings(
  download.file(urls, dests, method = "libcurl", quiet = TRUE)
)
unclass(status)
#> [1] 0
#> attr(,"retvals")
#> [1] 0 1
file.exists(dests)
#> [1]  TRUE FALSE

# 3. In a script, check the return value (a non-zero status is not an error).
ok <- download.file(paste0(base, "/csv/books"), dests[[1L]], quiet = TRUE)
if (ok != 0L) stop("download failed", call. = FALSE)
nrow(read.csv(dests[[1L]]))
#> [1] 16

# 4. The server is gone: R reports a libcurl error code.
invisible(srv$kill())
res <- diagnose(download.file(paste0(base, "/csv/books"), dest, quiet = TRUE))
res$warnings
#> [1] "URL 'http://127.0.0.1:8765/csv/books': status was 'Couldn't connect to server'"
res$error
#> [1] "cannot open URL 'http://127.0.0.1:8765/csv/books'"
res <- diagnose(readLines(url(paste0(base, "/csv/books"))))
res$warnings
#> [1] "URL 'http://127.0.0.1:8765/csv/books': status was 'Couldn't connect to server'"
res$error
#> [1] "cannot open the connection to 'http://127.0.0.1:8765/csv/books'"
err <- tryCatch(curlGetHeaders(paste0(base, "/csv/books")), error = identity)
sub("after [0-9]+ ms", "after N ms", conditionMessage(err))
#> [1] "libcurl error code 7:\n\tFailed to connect to 127.0.0.1 port 8765 after N ms: Couldn't connect to server\n"

# 5. The timeout option: seconds without a response, default 60.
getOption("timeout")
#> [1] 60

source("scenario.R")

# A local test server: CSV files, a JSON list of books, a header echo and a
# redirect. HEAD is allowed because curlGetHeaders() sends a HEAD request.
shelf_api <- function(books, csv, port) {
  plumber::pr() |>
    plumber::pr_handle(
      c("GET", "HEAD"), "/books.csv", \() csv,
      serializer = plumber::serializer_text(type = "text/csv")
    ) |>
    plumber::pr_handle(c("GET", "HEAD"), "/old-books.csv", \(res) {
      res$status <- 302L
      res$setHeader("Location", "/books.csv")
      ""
    }) |>
    plumber::pr_get("/books", \() books[, c("title", "isbn", "year")]) |>
    plumber::pr_get("/whoami", \(req) {
      list(client = req$HTTP_X_SHELF_CLIENT)
    }, serializer = plumber::serializer_unboxed_json()) |>
    plumber::pr_run(host = "127.0.0.1", port = port, docs = FALSE, quiet = TRUE)
}

csv <- readChar("books.csv", file.size("books.csv"))
srv <- callr::r_bg(
  shelf_api,
  args = list(books = books, csv = csv, port = 8765L)
)
base <- "http://127.0.0.1:8765"
for (i in seq_len(40L)) {
  probe <- try(curlGetHeaders(paste0(base, "/books.csv")), silent = TRUE)
  if (!inherits(probe, "try-error")) break
  Sys.sleep(0.25)
}

# readLines() opens the connection, reads, and closes it again.
readLines(url(paste0(base, "/books.csv")), n = 3L)
#> [1] "\"title\",\"author\",\"isbn\",\"year\",\"genre\",\"pages\""
#> [2] "\"The Dispossessed\",\"Ursula K. Le Guin\",\"978-0-306-40615-7\",1974,\"Science fiction\",387"
#> [3] "\"Pride and Prejudice\",\"Jane Austen\",\"978-0-14-143951-8\",1813,\"Classic\",432"

# An explicit connection: create, open, read in pieces, close.
con <- url(paste0(base, "/books.csv"))
summary(con)[c("class", "opened")]
#> $class
#> [1] "url-libcurl"
#>
#> $opened
#> [1] "closed"
#>
open(con, "r")
readLines(con, n = 1L)
#> [1] "\"title\",\"author\",\"isbn\",\"year\",\"genre\",\"pages\""
readLines(con, n = 1L)
#> [1] "\"The Dispossessed\",\"Ursula K. Le Guin\",\"978-0-306-40615-7\",1974,\"Science fiction\",387"
close(con)

# read.csv() takes a URL string directly: it makes the url() connection.
shelf <- read.csv(paste0(base, "/books.csv"))
identical(shelf, books)
#> [1] TRUE

# Extra request headers for the connection (R 3.6.0 and later).
whoami <- url(paste0(base, "/whoami"), headers = c("X-Shelf-Client" = "docs"))
readLines(whoami, warn = FALSE)
#> [1] "{\"client\":\"docs\"}"

# JSON straight from a URL with jsonlite.
head(jsonlite::fromJSON(paste0(base, "/books")), 2L)
#>                 title              isbn year
#> 1    The Dispossessed 978-0-306-40615-7 1974
#> 2 Pride and Prejudice 978-0-14-143951-8 1813

# curlGetHeaders(): status and header lines, following redirects by default.
h <- curlGetHeaders(paste0(base, "/books.csv"))
attr(h, "status")
#> [1] 200
h <- trimws(h[!grepl("^Date:", h)])
h[nzchar(h)]
#> [1] "HTTP/1.1 200 OK"        "Content-Type: text/csv" "Content-Length: 1187"

h <- curlGetHeaders(paste0(base, "/old-books.csv"))
attr(h, "status")
#> [1] 200
sum(grepl("^HTTP/", h))
#> [1] 2
trimws(h[grepl("^(HTTP|Location)", h)])
#> [1] "HTTP/1.1 302 Found"   "Location: /books.csv" "HTTP/1.1 200 OK"

h <- curlGetHeaders(paste0(base, "/old-books.csv"), redirect = FALSE)
attr(h, "status")
#> [1] 302
trimws(h[grepl("^(HTTP|Location)", h)])
#> [1] "HTTP/1.1 302 Found"   "Location: /books.csv"

h <- curlGetHeaders(paste0(base, "/missing"))
attr(h, "status")
#> [1] 404
trimws(h[1L])
#> [1] "HTTP/1.1 404 Not Found"

invisible(srv$kill())

library(httr2)

# A request is an immutable object: every req_*() returns a modified copy.
# api.example.com is a placeholder host; nothing here is sent.
req <- request("https://api.example.com/v1")
req
#> <httr2_request>
#> GET https://api.example.com/v1
#> Body: empty
req_get_url(req)
#> [1] "https://api.example.com/v1"

books_req <- req |>
  req_url_path_append("books") |>
  req_url_query(genre = "fiction", limit = 2)
req_get_url(books_req)
#> [1] "https://api.example.com/v1/books?genre=fiction&limit=2"
req_get_url(req)
#> [1] "https://api.example.com/v1"

# req_url_path_append() adds segments; it does not escape them for you.
req |> req_url_path_append("books", "978-0-306-40615-7") |> req_get_url()
#> [1] "https://api.example.com/v1/books/978-0-306-40615-7"
segment <- "search results"
tryCatch(
  req |> req_url_path_append(segment) |> req_url_query(page = 1),
  error = \(e) conditionMessage(e)
)
#> [1] "Failed to parse URL: Malformed input to a URL function"
req |>
  req_url_path_append(curl::curl_escape(segment)) |>
  req_url_query(page = 1) |>
  req_get_url()
#> [1] "https://api.example.com/v1/search%20results?page=1"

# A vector value needs a strategy: .multi.
genres <- c("fiction", "poetry")
tryCatch(
  req |> req_url_query(genre = genres),
  error = \(e) conditionMessage(e)
)
#> [1] "All vector elements of `...` must be length 1.\nℹ Use `.multi` to choose a strategy for handling vectors."
req |> req_url_query(genre = genres, .multi = "explode") |> req_get_url()
#> [1] "https://api.example.com/v1?genre=fiction&genre=poetry"
req |> req_url_query(genre = genres, .multi = "comma") |> req_get_url()
#> [1] "https://api.example.com/v1?genre=fiction,poetry"
req |> req_url_query(genre = genres, .multi = "pipe") |> req_get_url()
#> [1] "https://api.example.com/v1?genre=fiction|poetry"

# Spaces are %20 by default; .space = "form" gives + for HTML-form style APIs.
req |> req_url_query(title = "Salt and Static") |> req_get_url()
#> [1] "https://api.example.com/v1?title=Salt%20and%20Static"
req |>
  req_url_query(title = "Salt and Static", .space = "form") |>
  req_get_url()
#> [1] "https://api.example.com/v1?title=Salt+and+Static"

# Headers: names are case-insensitive, a later value replaces an earlier one.
h <- books_req |>
  req_headers(Accept = "application/json", `X-Shelf-Client` = "docs") |>
  req_headers(accept = "text/csv")
req_get_headers(h)
#> $`X-Shelf-Client`
#> [1] "docs"
#>
#> $accept
#> [1] "text/csv"
#>

# .redact hides a header when the request is printed or logged. The value
# comes from the environment, never from the script ("demo-key" is a dummy).
Sys.setenv(SHELF_API_KEY = "demo-key")
h <- books_req |>
  req_headers(`X-Api-Key` = Sys.getenv("SHELF_API_KEY"), .redact = "X-Api-Key")
h
#> <httr2_request>
#> GET https://api.example.com/v1/books?genre=fiction&limit=2
#> Headers:
#> * X-Api-Key: <REDACTED>
#> Body: empty
names(req_get_headers(h))
#> character(0)
req_get_headers(h, redacted = "reveal")
#> $`X-Api-Key`
#> [1] "demo-key"
#>

# A user agent, a method and a timeout.
books_req |>
  req_user_agent("shelf-client/0.1 (docs example)") |>
  req_method("HEAD") |>
  req_timeout(5) |>
  print()
#> <httr2_request>
#> HEAD https://api.example.com/v1/books?genre=fiction&limit=2
#> Body: empty
#> Options:
#> * useragent     : "shelf-client/0.1 (docs example)"
#> * timeout_ms    : 5000
#> * connecttimeout: 0
req_get_method(books_req)
#> [1] "GET"
books_req |> req_method("DELETE") |> req_get_method()
#> [1] "DELETE"

library(httr2)

# req_dry_run() prints the HTTP request httr2 would send, without sending it.
# The host is a placeholder and no network access is used.
req <- request("https://api.example.com/v1") |>
  req_user_agent("shelf-client/0.1") |>
  req_url_path_append("books", curl::curl_escape("search results")) |>
  req_url_query(genre = "fiction", limit = 2)
req_dry_run(req)
#> GET /v1/books/search%20results HTTP/1.1
#> accept: */*
#> accept-encoding: deflate, gzip, br, zstd
#> host: api.example.com
#> user-agent: shelf-client/0.1
#>

# A JSON body: req_body_json() sets Content-Type and POSTs by default.
new_book <- list(title = "Ten Winters", isbn = "9780013001331", year = 2022L)
req |>
  req_url_path("/v1/books") |>
  req_body_json(new_book) |>
  req_dry_run()
#> POST /v1/books HTTP/1.1
#> accept: */*
#> accept-encoding: deflate, gzip, br, zstd
#> content-length: 58
#> content-type: application/json
#> host: api.example.com
#> user-agent: shelf-client/0.1
#>
#> {
#>   "title": "Ten Winters",
#>   "isbn": "9780013001331",
#>   "year": 2022
#> }

# A form body, with an explicit method.
req |>
  req_url_path("/v1/books/9780013001331") |>
  req_body_form(year = 2022, genre = "Fiction") |>
  req_method("PATCH") |>
  req_dry_run()
#> PATCH /v1/books/9780013001331 HTTP/1.1
#> accept: */*
#> accept-encoding: deflate, gzip, br, zstd
#> content-length: 23
#> content-type: application/x-www-form-urlencoded
#> host: api.example.com
#> user-agent: shelf-client/0.1
#>

# A bearer token from the environment. The Authorization header is redacted
# when the request is printed and in the dry run. "demo-token" is a dummy.
Sys.setenv(SHELF_API_TOKEN = "demo-token")
authed <- req |>
  req_url_path("/v1/me") |>
  req_auth_bearer_token(Sys.getenv("SHELF_API_TOKEN"))
authed
#> <httr2_request>
#> GET https://api.example.com/v1/me?genre=fiction&limit=2
#> Headers:
#> * Authorization: <REDACTED>
#> Body: empty
#> Options:
#> * useragent: "shelf-client/0.1"
req_dry_run(authed)
#> GET /v1/me HTTP/1.1
#> accept: */*
#> accept-encoding: deflate, gzip, br, zstd
#> authorization: <REDACTED>
#> host: api.example.com
#> user-agent: shelf-client/0.1
#>

# Basic authentication works the same way.
Sys.setenv(SHELF_API_PASSWORD = "demo-password")
req |>
  req_url_path("/v1/me") |>
  req_auth_basic("reader", Sys.getenv("SHELF_API_PASSWORD")) |>
  req_dry_run()
#> GET /v1/me HTTP/1.1
#> accept: */*
#> accept-encoding: deflate, gzip, br, zstd
#> authorization: <REDACTED>
#> host: api.example.com
#> user-agent: shelf-client/0.1
#>

# The redaction is a display feature: the value is still in the request.
names(req_get_headers(authed))
#> character(0)
req_get_headers(authed, redacted = "reveal")[["Authorization"]]
#> [1] "Bearer demo-token"

library(httr2)
source("scenario.R")

# A local test server: the shelf books as JSON and CSV, and a POST route.
shelf_api <- function(books, csv, port) {
  plumber::pr() |>
    plumber::pr_set_serializer(plumber::serializer_unboxed_json()) |>
    plumber::pr_get("/books", \(res, limit = "100") {
      res$setHeader("X-Total-Count", nrow(books))
      books[seq_len(min(as.integer(limit), nrow(books))), ]
    }) |>
    plumber::pr_get(
      "/books.csv", \() csv,
      serializer = plumber::serializer_text(type = "text/csv")
    ) |>
    plumber::pr_post("/books", \(req, res) {
      res$status <- 201L
      res$setHeader("Location", "/books/new")
      list(created = req$body$title, year = req$body$year)
    }) |>
    plumber::pr_run(host = "127.0.0.1", port = port, docs = FALSE, quiet = TRUE)
}

csv <- readChar("books.csv", file.size("books.csv"))
srv <- callr::r_bg(
  shelf_api,
  args = list(books = books, csv = csv, port = 8765L)
)
base <- "http://127.0.0.1:8765"
request(base) |>
  req_retry(max_tries = 20, retry_on_failure = TRUE, backoff = \(i) 0.25) |>
  req_error(is_error = \(resp) FALSE) |>
  req_perform() |>
  invisible()

resp <- request(base) |>
  req_url_path_append("books") |>
  req_url_query(limit = 3) |>
  req_perform()
resp
#> <httr2_response>
#> GET http://127.0.0.1:8765/books?limit=3
#> Status: 200 OK
#> Content-Type: application/json
#> Body: In memory (380 bytes)

# Status, content type and headers.
resp_status(resp)
#> [1] 200
resp_status_desc(resp)
#> [1] "OK"
resp_content_type(resp)
#> [1] "application/json"
resp_header(resp, "x-total-count")
#> [1] "16"
resp_header(resp, "X-No-Such-Header", default = "none")
#> [1] "none"
resp_headers(resp, filter = "^X-Total|^Content-Type")
#> <httr2_headers>
#> X-Total-Count: 16
#> Content-Type: application/json

# The body, three ways.
resp_has_body(resp)
#> [1] TRUE
raw_body <- resp_body_raw(resp)
class(raw_body)
#> [1] "raw"
length(raw_body)
#> [1] 380
substr(resp_body_string(resp), 1L, 60L)
#> [1] "[{\"title\":\"The Dispossessed\",\"author\":\"Ursula K. Le Guin\",\"i"
resp_body_json(resp) |> length()
#> [1] 3
resp_body_json(resp)[[1L]][c("title", "year")]
#> $title
#> [1] "The Dispossessed"
#>
#> $year
#> [1] 1974
#>
resp_body_json(resp, simplifyVector = TRUE) |> str()
#> 'data.frame':	3 obs. of  6 variables:
#>  $ title : chr  "The Dispossessed" "Pride and Prejudice" "  the quiet streets "
#>  $ author: chr  "Ursula K. Le Guin" "Jane Austen" "Mara Quill"
#>  $ isbn  : chr  "978-0-306-40615-7" "978-0-14-143951-8" "9780001000100"
#>  $ year  : int  1974 1813 2019
#>  $ genre : chr  "Science fiction" "Classic" "Fiction"
#>  $ pages : int  387 432 214

# Which request produced this response?
resp_url(resp)
#> [1] "http://127.0.0.1:8765/books?limit=3"
resp_request(resp) |> req_get_url()
#> [1] "http://127.0.0.1:8765/books?limit=3"
last_response()$status_code
#> [1] 200

# resp_body_json() insists on a JSON content type.
csv_resp <- request(base) |> req_url_path_append("books.csv") |> req_perform()
resp_content_type(csv_resp)
#> [1] "text/csv"
tryCatch(resp_body_json(csv_resp), error = \(e) conditionMessage(e))
#> [1] "Unexpected content type \"text/csv\".\n• Expecting type \"application/json\" or suffix \"json\"."
read.csv(text = resp_body_string(csv_resp)) |> dim()
#> [1] 16  6

# Save a body straight to a file with path = ; the body is then a path.
dest <- tempfile(fileext = ".csv")
saved <- request(base) |>
  req_url_path_append("books.csv") |>
  req_perform(path = dest)
class(saved$body)
#> [1] "httr2_path"
file.size(dest)
#> [1] 1187

# POST a JSON body: 201 Created and the Location header.
created <- request(base) |>
  req_url_path_append("books") |>
  req_body_json(list(title = "Ten Winters", year = 2022L)) |>
  req_perform()
resp_status(created)
#> [1] 201
resp_header(created, "Location")
#> [1] "/books/new"
resp_body_json(created)
#> $created
#> [1] "Ten Winters"
#>
#> $year
#> [1] 2022
#>
req_get_method(resp_request(created))
#> [1] "POST"

invisible(srv$kill())

library(httr2)
source("scenario.R")

# A local test server: a missing book (404 with a JSON body), an endpoint
# that always fails (500), a protected route (401) and a slow one.
shelf_api <- function(books, port) {
  plain <- gsub("-", "", books$isbn)
  plumber::pr() |>
    plumber::pr_set_serializer(plumber::serializer_unboxed_json()) |>
    plumber::pr_get("/books/<isbn>", \(res, isbn) {
      hit <- books[plain == gsub("-", "", isbn), c("title", "isbn")]
      if (nrow(hit) == 0L) {
        res$status <- 404L
        return(list(error = "no such book", isbn = isbn))
      }
      as.list(hit)
    }) |>
    plumber::pr_get("/boom", \(res) {
      res$status <- 500L
      list(error = "the shelf is on fire", code = "E500")
    }) |>
    plumber::pr_get("/secure", \(req, res) {
      if (!identical(req$HTTP_AUTHORIZATION, "Bearer demo-token")) {
        res$status <- 401L
        return(list(error = "token missing or wrong"))
      }
      list(user = "shelf-reader")
    }) |>
    plumber::pr_get("/slow", \() {
      Sys.sleep(1)
      list(ok = TRUE)
    }) |>
    plumber::pr_run(host = "127.0.0.1", port = port, docs = FALSE, quiet = TRUE)
}

srv <- callr::r_bg(shelf_api, args = list(books = books, port = 8765L))
base <- "http://127.0.0.1:8765"
request(base) |>
  req_retry(max_tries = 20, retry_on_failure = TRUE, backoff = \(i) 0.25) |>
  req_error(is_error = \(resp) FALSE) |>
  req_perform() |>
  invisible()

missing_book <- request(base) |> req_url_path_append("books", "000")

# 1. By default a 4xx/5xx status is an R error with a class per status.
err <- tryCatch(req_perform(missing_book), error = identity)
conditionMessage(err)
#> [1] "HTTP 404 Not Found."
class(err)
#> [1] "httr2_http_404" "httr2_http"     "httr2_error"    "rlang_error"
#> [5] "rlang_error"    "error"          "condition"

# 2. Handle one status, or any HTTP error, by class.
tryCatch(req_perform(missing_book), httr2_http_404 = \(e) "not on the shelf")
#> [1] "not on the shelf"
tryCatch(
  request(base) |> req_url_path_append("boom") |> req_perform(),
  httr2_http_404 = \(e) "not on the shelf",
  httr2_http = \(e) paste("HTTP error", e$status)
)
#> [1] "HTTP error 500"

# 3. The response travels with the error.
resp_status(err$resp)
#> [1] 404
resp_body_json(err$resp)
#> $error
#> [1] "no such book"
#>
#> $isbn
#> [1] "000"
#>

# 4. req_error(body = ) puts the API's own message into the R error.
api_message <- \(resp) paste("The API says:", resp_body_json(resp)$error)
explained <- request(base) |>
  req_url_path_append("boom") |>
  req_error(body = api_message)
err <- tryCatch(req_perform(explained), error = identity)
class(err)[1:2]
#> [1] "httr2_http_500" "httr2_http"
cat(conditionMessage(err), "\n")
#> HTTP 500 Internal Server Error.
#> ℹ The API says: the shelf is on fire

# 5. req_error(is_error = ) decides what counts as an error.
lenient <- missing_book |> req_error(is_error = \(resp) FALSE)
resp <- req_perform(lenient)
resp_status(resp)
#> [1] 404
resp_is_error(resp)
#> [1] TRUE
resp_status_desc(resp)
#> [1] "Not Found"
err <- tryCatch(resp_check_status(resp), error = identity)
conditionMessage(err)
#> [1] "HTTP 404 Not Found."
class(err)[1L]
#> [1] "httr2_http_404"

# 6. The last request and response are kept for debugging.
last_response()$status_code
#> [1] 404
req_get_url(last_request())
#> [1] "http://127.0.0.1:8765/books/000"

# 7. 401: a bearer token from the environment ("demo-token" is a dummy).
secure <- request(base) |> req_url_path_append("secure")
tryCatch(req_perform(secure), httr2_http_401 = \(e) conditionMessage(e))
#> [1] "HTTP 401 Unauthorized."
Sys.setenv(SHELF_API_TOKEN = "demo-token")
secure |>
  req_auth_bearer_token(Sys.getenv("SHELF_API_TOKEN")) |>
  req_perform() |>
  resp_body_json()
#> $user
#> [1] "shelf-reader"
#>

# 8. A timeout is a failure of the transfer, not an HTTP status.
slow <- request(base) |> req_url_path_append("slow") |> req_timeout(0.3)
err <- tryCatch(req_perform(slow), error = identity)
class(err)[1:2]
#> [1] "httr2_failure" "httr2_error"
sub("after [0-9]+ milliseconds", "after N milliseconds", conditionMessage(err))
#> [1] "Failed to perform HTTP request.\nCaused by error in `curl::curl_fetch_memory()`:\n! Timeout was reached [127.0.0.1]:\nOperation timed out after N milliseconds with 0 bytes received"
class(err$parent)[1L]
#> [1] "curl_error_operation_timedout"

# 9. A server that is gone is a failure too.
invisible(srv$kill())
err <- tryCatch(req_perform(missing_book), error = identity)
class(err)[1:2]
#> [1] "httr2_failure" "httr2_error"
sub("after [0-9]+ ms", "after N ms", conditionMessage(err))
#> [1] "Failed to perform HTTP request.\nCaused by error in `curl::curl_fetch_memory()`:\n! Couldn't connect to server [127.0.0.1]:\nFailed to connect to 127.0.0.1 port 8765 after N ms: Couldn't connect to server"
class(err$parent)[1L]
#> [1] "curl_error_couldnt_connect"

library(httr2)

# A local test server with a rate limit: /busy answers 429 with a Retry-After
# header twice and then succeeds; /limited never succeeds; /flaky fails once
# with a 500; /ok always succeeds.
shelf_api <- function(port) {
  seen <- new.env()
  seen$busy <- 0L
  seen$flaky <- 0L
  plumber::pr() |>
    plumber::pr_set_serializer(plumber::serializer_unboxed_json()) |>
    plumber::pr_get("/ok", \() list(ok = TRUE)) |>
    plumber::pr_get("/busy", \(res) {
      seen$busy <- seen$busy + 1L
      if (seen$busy <= 2L) {
        res$status <- 429L
        res$setHeader("Retry-After", "1")
        return(list(error = "slow down"))
      }
      list(ok = TRUE, attempt = seen$busy)
    }) |>
    plumber::pr_get("/flaky", \(res) {
      seen$flaky <- seen$flaky + 1L
      if (seen$flaky <= 1L) {
        res$status <- 500L
        return(list(error = "hiccup"))
      }
      list(ok = TRUE, attempt = seen$flaky)
    }) |>
    plumber::pr_get("/limited", \(res) {
      res$status <- 429L
      res$setHeader("Retry-After", "1")
      list(error = "slow down")
    }) |>
    plumber::pr_run(host = "127.0.0.1", port = port, docs = FALSE, quiet = TRUE)
}

srv <- callr::r_bg(shelf_api, args = list(port = 8765L))
base <- "http://127.0.0.1:8765"
request(base) |>
  req_url_path_append("ok") |>
  req_retry(max_tries = 20, retry_on_failure = TRUE, backoff = \(i) 0.25) |>
  req_perform() |>
  invisible()

# Without req_retry() a 429 is an ordinary HTTP error.
busy <- request(base) |> req_url_path_append("busy")
limited <- request(base) |> req_url_path_append("limited")
tryCatch(req_perform(limited), httr2_http_429 = \(e) conditionMessage(e))
#> [1] "HTTP 429 Too Many Requests."

# req_retry() retries 429 and 503. httr2 waits for the number of seconds in
# Retry-After; the server count shows the third attempt succeeded.
started <- proc.time()[["elapsed"]]
resp <- busy |> req_retry(max_tries = 4) |> req_perform()
resp_body_json(resp)
#> $ok
#> [1] TRUE
#>
#> $attempt
#> [1] 3
#>
proc.time()[["elapsed"]] - started >= 2
#> [1] TRUE

# The same wait spelled out: after = reads the header; backoff = is used when
# after returns NA.
retry_after <- \(resp) as.numeric(resp_header(resp, "Retry-After", "NA"))
policy <- limited |>
  req_retry(max_tries = 2, after = retry_after, backoff = \(i) 2^i)
err <- tryCatch(req_perform(policy), error = identity)
class(err)[1:2]
#> [1] "httr2_http_429" "httr2_http"
conditionMessage(err)
#> [1] "HTTP 429 Too Many Requests."
resp_retry_after(err$resp)
#> [1] 1

# is_transient decides which responses are retried: also treat 500 as transient.
flaky <- request(base) |> req_url_path_append("flaky")
tryCatch(req_perform(flaky), httr2_http_500 = \(e) conditionMessage(e))
#> [1] "HTTP 500 Internal Server Error."
transient <- \(resp) resp_status(resp) %in% c(429L, 500L, 503L)
flaky |>
  req_retry(max_tries = 3, is_transient = transient, backoff = \(i) 0.1) |>
  req_perform() |>
  resp_body_json()
#> $ok
#> [1] TRUE
#>
#> $attempt
#> [1] 2
#>

# Rate limit on the client: a token bucket. capacity = 2 per second means two
# requests are free, then one request every half second.
ok <- request(base) |> req_url_path_append("ok")
throttled <- ok |> req_throttle(capacity = 2, fill_time_s = 1)
started <- proc.time()[["elapsed"]]
for (i in seq_len(5L)) req_perform(throttled)
proc.time()[["elapsed"]] - started > 1
#> [1] TRUE

# rate = is the older spelling: rate times fill_time_s (60 s by default) is
# the capacity, so rate = 2 / 1 is a bucket of 120 and nothing waits here.
old_style <- ok |> req_throttle(rate = 2 / 1)
started <- proc.time()[["elapsed"]]
for (i in seq_len(5L)) req_perform(old_style)
proc.time()[["elapsed"]] - started < 1
#> [1] TRUE

invisible(srv$kill())

library(httr2)
source("scenario.R")

# A local test server: /books returns one page, "limit" rows from "offset",
# and reports the total in the X-Total-Count header.
shelf_api <- function(books, port) {
  plumber::pr() |>
    plumber::pr_set_serializer(plumber::serializer_unboxed_json()) |>
    plumber::pr_get("/books", \(res, limit = "5", offset = "0") {
      rows <- as.integer(offset) + seq_len(as.integer(limit))
      res$setHeader("X-Total-Count", nrow(books))
      books[rows[rows <= nrow(books)], c("title", "isbn", "year")]
    }) |>
    plumber::pr_run(host = "127.0.0.1", port = port, docs = FALSE, quiet = TRUE)
}

srv <- callr::r_bg(shelf_api, args = list(books = books, port = 8765L))
base <- "http://127.0.0.1:8765"
req <- request(base) |>
  req_url_path_append("books") |>
  req_url_query(limit = 5) |>
  req_retry(max_tries = 20, retry_on_failure = TRUE, backoff = \(i) 0.25)
invisible(req_perform(req))

# How many pages? The total is in a header.
total <- \(resp) as.integer(resp_header(resp, "X-Total-Count"))
pages <- \(resp) ceiling(total(resp) / 5)

# req_perform_iterative(): each request is made from the previous response.
resps <- req_perform_iterative(
  req,
  next_req = iterate_with_offset("offset", start = 0, offset = 5,
                                 resp_pages = pages),
  progress = FALSE
)
length(resps)
#> [1] 4
vapply(resps, resp_status, integer(1L))
#> [1] 200 200 200 200
req_get_url(resp_request(resps[[2L]]))
#> [1] "http://127.0.0.1:8765/books?limit=5&offset=5"

# resps_data() combines the parsed bodies; here, a data frame per page.
page_data <- \(resp) resp_body_json(resp, simplifyVector = TRUE)
shelf <- resps_data(resps, page_data)
dim(shelf)
#> [1] 16  3
shelf$title[c(1L, 16L)]
#> [1] "The Dispossessed" "Salt and Static"

# max_reqs caps the loop (the default is 20).
two <- req_perform_iterative(
  req,
  next_req = iterate_with_offset("offset", start = 0, offset = 5,
                                 resp_pages = pages),
  max_reqs = 2,
  progress = FALSE
)
length(two)
#> [1] 2

# When the page count is known, build the requests and send them together.
offsets <- seq(0L, 15L, by = 5L)
reqs <- lapply(offsets, \(o) req |> req_url_query(offset = o))
par_resps <- req_perform_parallel(reqs, progress = FALSE)
vapply(par_resps, resp_status, integer(1L))
#> [1] 200 200 200 200
identical(resps_data(par_resps, page_data), shelf)
#> [1] TRUE

# req_perform_sequential() has the same interface, one request at a time.
seq_resps <- req_perform_sequential(reqs, progress = FALSE)
identical(resps_data(seq_resps, page_data), shelf)
#> [1] TRUE

# on_error = "continue" keeps going and returns the failures with the rest.
bad <- c(reqs[1:2], list(request(base) |> req_url_path_append("nope")))
mixed <- req_perform_parallel(bad, on_error = "continue", progress = FALSE)
vapply(mixed, \(x) class(x)[1L], character(1L))
#> [1] "httr2_response" "httr2_response" "httr2_http_404"
length(resps_successes(mixed))
#> [1] 2
length(resps_failures(mixed))
#> [1] 1
resps_ok(mixed)
#> [1]  TRUE  TRUE FALSE

invisible(srv$kill())

library(httr2)

# A local test server: /count increments a counter on every request that
# reaches it, and /fresh/count marks the response cacheable for 60 seconds.
shelf_api <- function(port) {
  seen <- new.env()
  seen$plain <- 0L
  seen$fresh <- 0L
  plumber::pr() |>
    plumber::pr_set_serializer(plumber::serializer_unboxed_json()) |>
    plumber::pr_get("/count", \() {
      seen$plain <- seen$plain + 1L
      list(served = seen$plain)
    }) |>
    plumber::pr_get("/fresh/count", \(res) {
      seen$fresh <- seen$fresh + 1L
      res$setHeader("Cache-Control", "max-age=60")
      list(served = seen$fresh)
    }) |>
    plumber::pr_run(host = "127.0.0.1", port = port, docs = FALSE, quiet = TRUE)
}

srv <- callr::r_bg(shelf_api, args = list(port = 8765L))
base <- "http://127.0.0.1:8765"
request(base) |>
  req_url_path_append("count") |>
  req_retry(max_tries = 20, retry_on_failure = TRUE, backoff = \(i) 0.25) |>
  req_perform() |>
  invisible()

served <- \(req) resp_body_json(req_perform(req))$served

# No cache headers: every call reaches the server (the first count was above).
plain <- request(base) |> req_url_path_append("count")
served(plain)
#> [1] 2
served(plain)
#> [1] 3

# A cacheable response with req_cache(): the second call does not.
cache_dir <- tempfile("shelf-cache")
fresh <- request(base) |>
  req_url_path_append("fresh", "count") |>
  req_cache(cache_dir)
served(fresh)
#> [1] 1
served(fresh)
#> [1] 1
length(list.files(cache_dir))
#> [1] 1

# The same request without req_cache() goes to the server again.
served(request(base) |> req_url_path_append("fresh", "count"))
#> [1] 2

# Only GET responses with status 200 and a caching header are stored: the
# plain route above has none, so a cache would store nothing for it.
cache_dir_2 <- tempfile("shelf-cache")
cached_plain <- plain |> req_cache(cache_dir_2)
invisible(served(cached_plain))
length(list.files(cache_dir_2))
#> [1] 0

invisible(srv$kill())

library(httr2)

# A function that talks to a web API (a placeholder host; never contacted).
book_title <- function(isbn) {
  request("https://api.example.com/v1") |>
    req_url_path_append("books", isbn) |>
    req_perform() |>
    resp_body_json() |>
    _$title
}

# with_mocked_responses(): the mock replaces req_perform()'s network call.
# A function receives the request and returns a response.
with_mocked_responses(
  \(req) response_json(body = list(title = "Ten Winters")),
  book_title("9780013001331")
)
#> [1] "Ten Winters"

# The function sees the request, so one mock can serve several URLs.
router <- \(req) {
  if (grepl("/books/9780013001331$", req$url)) {
    response_json(body = list(title = "Ten Winters"))
  } else {
    response_json(status_code = 404L, body = list(error = "no such book"))
  }
}
with_mocked_responses(router, book_title("9780013001331"))
#> [1] "Ten Winters"
with_mocked_responses(
  router,
  tryCatch(book_title("0"), httr2_http_404 = \(e) conditionMessage(e))
)
#> [1] "HTTP 404 Not Found."

# A list is served in order, one response per request.
with_mocked_responses(
  list(
    response_json(body = list(title = "Ten Winters")),
    response_json(body = list(title = "Salt and Static"))
  ),
  c(book_title("1"), book_title("2"))
)
#> [1] "Ten Winters"     "Salt and Static"

# local_mocked_responses() lasts until the function that calls it returns:
# the form to use inside test_that() blocks.
offline_title <- function() {
  local_mocked_responses(\(req) response_json(body = list(title = "Offline")))
  book_title("anything")
}
offline_title()
#> [1] "Offline"

# response() builds any response, including a non-JSON one.
text_resp <- response(
  status_code = 200L,
  headers = list("Content-Type" = "text/plain"),
  body = charToRaw("hello")
)
hello <- \() {
  request("https://api.example.com/hello") |>
    req_perform() |>
    resp_body_string()
}
with_mocked_responses(\(req) text_resp, hello())
#> [1] "hello"