Switch from httr to httr2

DESCRIPTION

@@ -15,10 +15,11 @@ Depends: R (>= 3.4)
 Imports:
     cli (>= 3.0.1),
     gitcreds,
-    httr (>= 1.2),
+    httr2,
     ini,
     jsonlite,
-    rlang
+    lifecycle,
+    rlang (>= 1.0.0)
 Suggests:
     covr,
     knitr,
@@ -33,6 +34,6 @@ VignetteBuilder:
 Encoding: UTF-8
 Language: en-US
 Roxygen: list(markdown = TRUE)
-RoxygenNote: 7.2.1.9000
+RoxygenNote: 7.2.3
 Config/testthat/edition: 3
 Config/Needs/website: tidyverse/tidytemplate

NAMESPACE

@@ -11,25 +11,16 @@ export(gh_last)
 export(gh_next)
 export(gh_prev)
 export(gh_rate_limit)
+export(gh_rate_limits)
 export(gh_token)
 export(gh_tree_remote)
 export(gh_whoami)
+import(rlang)
 importFrom(cli,cli_status)
 importFrom(cli,cli_status_update)
-importFrom(httr,DELETE)
-importFrom(httr,GET)
-importFrom(httr,PATCH)
-importFrom(httr,POST)
-importFrom(httr,PUT)
-importFrom(httr,add_headers)
-importFrom(httr,content)
-importFrom(httr,headers)
-importFrom(httr,http_type)
-importFrom(httr,status_code)
-importFrom(httr,write_disk)
-importFrom(httr,write_memory)
 importFrom(jsonlite,fromJSON)
 importFrom(jsonlite,prettify)
 importFrom(jsonlite,toJSON)
+importFrom(lifecycle,deprecated)
 importFrom(utils,URLencode)
 importFrom(utils,capture.output)

NEWS.md

@@ -1,5 +1,15 @@
 # gh (development version)
 
+* gh is now powered by httr2. This should generally have little impact on normal
+  operation but if a request fails, you can use `httr2::last_response()` and 
+  `httr2::last_request()` to debug.
+
+* `gh()` gains a new `.max_wait` argument which gives the maximum number of 
+  minutes to wait if you are rate limited (#67).
+
+* New `gh_rate_limits()` function reports on all rate limits for the active 
+  user.
+
 * gh can now validate GitHub
   [fine-grained](https://github.blog/2022-10-18-introducing-fine-grained-personal-access-tokens-for-github/)
   personal access tokens (@jvstein, #171).

R/gh-package.R

@@ -5,10 +5,10 @@
 # The following block is used by usethis to automatically manage
 # roxygen namespace tags. Modify with care!
 ## usethis namespace: start
-#' @importFrom httr content add_headers headers status_code http_type GET POST
-#'   PATCH PUT DELETE
+#' @import rlang
+#' @importFrom cli cli_status cli_status_update
 #' @importFrom jsonlite fromJSON toJSON
+#' @importFrom lifecycle deprecated
 #' @importFrom utils URLencode capture.output
-#' @importFrom cli cli_status cli_status_update
 ## usethis namespace: end
 NULL

R/gh.R

@@ -65,7 +65,7 @@
 #' @param .params Additional list of parameters to append to `...`.
 #'   It is easier to use this than `...` if you have your parameters in
 #'   a list already.
-#'
+#' @param .max_wait Maximum number of minutes to wait if rate limited.
 #' @return Answer from the API as a `gh_response` object, which is also a
 #'   `list`. Failed requests will generate an R error. Requests that
 #'   generate a raw response will return a raw vector.
@@ -141,10 +141,20 @@
 #'     "Content-Type" = "application/json"
 #'   )
 #' )
-gh <- function(endpoint, ..., per_page = NULL, .token = NULL, .destfile = NULL,
-               .overwrite = FALSE, .api_url = NULL, .method = "GET",
-               .limit = NULL, .accept = "application/vnd.github.v3+json",
-               .send_headers = NULL, .progress = TRUE, .params = list()) {
+gh <- function(endpoint,
+               ...,
+               per_page = NULL,
+               .token = NULL,
+               .destfile = NULL,
+               .overwrite = FALSE,
+               .api_url = NULL,
+               .method = "GET",
+               .limit = NULL,
+               .accept = "application/vnd.github.v3+json",
+               .send_headers = NULL,
+               .progress = TRUE,
+               .params = list(),
+               .max_wait = 10) {
   params <- c(list(...), .params)
   params <- drop_named_nulls(params)
 
@@ -159,11 +169,16 @@ gh <- function(endpoint, ..., per_page = NULL, .token = NULL, .destfile = NULL,
   }
 
   req <- gh_build_request(
-    endpoint = endpoint, params = params,
-    token = .token, destfile = .destfile,
-    overwrite = .overwrite, accept = .accept,
+    endpoint = endpoint,
+    params = params,
+    token = .token,
+    destfile = .destfile,
+    overwrite = .overwrite,
+    accept = .accept,
     send_headers = .send_headers,
-    api_url = .api_url, method = .method
+    max_wait = .max_wait,
+    api_url = .api_url,
+    method = .method
   )
 
 
@@ -172,7 +187,6 @@ gh <- function(endpoint, ..., per_page = NULL, .token = NULL, .destfile = NULL,
   if (.progress) prbr <- make_progress_bar(req)
 
   raw <- gh_make_request(req)
-
   res <- gh_process_response(raw)
   len <- gh_response_length(res)
 
@@ -234,21 +248,99 @@ gh_response_length <- function(res) {
   }
 }
 
-gh_make_request <- function(x) {
-  method_fun <- list(
-    "GET" = GET, "POST" = POST, "PATCH" = PATCH,
-    "PUT" = PUT, "DELETE" = DELETE
-  )[[x$method]]
-  if (is.null(method_fun)) {
+gh_make_request <- function(x, error_call = caller_env()) {
+  if (!x$method %in% c("GET", "POST", "PATCH", "PUT", "DELETE")) {
     cli::cli_abort("Unknown HTTP verb: {.val {x$method}}")
   }
 
-  raw <- do.call(
-    method_fun,
-    compact(list(
-      url = x$url, query = x$query, body = x$body,
-      add_headers(x$headers), x$dest
-    ))
+  req <- httr2::request(x$url)
+  req <- httr2::req_method(req, x$method)
+  req <- httr2::req_url_query(req, !!!x$query)
+  if (is.raw(x$body)) {
+    req <- httr2::req_body_raw(req, x$body)
+  } else {
+    req <- httr2::req_body_json(req, x$body, null = "list", digits = 4)
+  }
+  req <- httr2::req_headers(req, !!!x$headers)
+
+  if (!is_testing()) {
+    req <- httr2::req_retry(
+      req,
+      max_tries = 3,
+      is_transient = function(resp) github_is_transient(resp, x$max_wait),
+      after = github_after
+    )
+  }
+
+  # allow custom handling with gh_error
+  req <- httr2::req_error(req, is_error = function(resp) FALSE)
+
+  resp <- httr2::req_perform(req, path = x$dest)
+  if (httr2::resp_status(resp) >= 300) {
+    gh_error(resp, error_call = error_call)
+  }
+
+  resp
+}
+
+# https://docs.github.com/v3/#client-errors
+gh_error <- function(response, error_call = caller_env()) {
+  heads <- httr2::resp_headers(response)
+  res <- httr2::resp_body_json(response)
+  status <- httr2::resp_status(response)
+
+  msg <- "GitHub API error ({status}): {heads$status %||% ''} {res$message}"
+
+  if (status == 404) {
+    msg <- c(msg, x = c("URL not found: {.url {response$url}}"))
+  }
+
+  doc_url <- res$documentation_url
+  if (!is.null(doc_url)) {
+    msg <- c(msg, c("i" = "Read more at {.url {doc_url}}"))
+  }
+
+  errors <- res$errors
+  if (!is.null(errors)) {
+    errors <- as.data.frame(do.call(rbind, errors))
+    nms <- c("resource", "field", "code", "message")
+    nms <- nms[nms %in% names(errors)]
+    msg <- c(
+      msg,
+      capture.output(print(errors[nms], row.names = FALSE))
+    )
+  }
+
+  cli::cli_abort(
+    msg,
+    class = c("github_error", paste0("http_error_", status)),
+    call = error_call,
+    response_headers = heads,
+    response_content = res
   )
-  raw
+}
+
+
+# use retry-after info when possible
+# https://docs.github.com/en/rest/overview/resources-in-the-rest-api#exceeding-the-rate-limit
+github_is_transient <- function(resp, max_wait) {
+  if (httr2::resp_status(resp) != 403) {
+    return(FALSE)
+  }
+  if (!identical(httr2::resp_header(resp, "x-ratelimit-remaining"), "0")) {
+    return(FALSE)
+  }
+
+  time <- httr2::resp_header(resp, "x-ratelimit-reset")
+  if (is.null(time)) {
+    return(FALSE)
+  }
+
+  time <- as.numeric(time)
+  minutes_to_wait <- (time - unclass(Sys.time())) / 60
+  minutes_to_wait <= max_wait
+}
+github_after <- function(resp) {
+  time <- as.numeric(httr2::resp_header(resp, "x-ratelimit-reset"))
+  time - unclass(Sys.time())
 }

R/gh_rate_limit.R

@@ -1,8 +1,8 @@
 #' Return GitHub user's current rate limits
 #'
-#' Reports the current rate limit status for the authenticated user,
-#' either pulls this information from a previous successful request
-#' or directly from the GitHub API.
+#' @description
+#' `gh_rate_limits()` reports on all rate limits for the authenticated user.
+#' `gh_rate_limit()` reports on rate limits for previous successful request.
 #'
 #' Further details on GitHub's API rate limit policies are available at
 #' <https://docs.github.com/v3/#rate-limiting>.
@@ -20,6 +20,11 @@
 
 gh_rate_limit <- function(response = NULL, .token = NULL, .api_url = NULL, .send_headers = NULL) {
   if (is.null(response)) {
+    lifecycle::deprecate_warn(
+      when = "2.0.0",
+      what = "gh_rate_limit(response)",
+      with = "gh_rate_limits()"
+    )
     # This end point does not count against limit
     .token <- .token %||% gh_token(.api_url)
     response <- gh("GET /rate_limit",
@@ -41,3 +46,30 @@ gh_rate_limit <- function(response = NULL, .token = NULL, .api_url = NULL, .send
     reset     = reset
   )
 }
+
+#' @export
+#' @rdname gh_rate_limit
+gh_rate_limits <- function(.token = NULL, .api_url = NULL, .send_headers = NULL) {
+  .token <- .token %||% gh_token(.api_url)
+  response <- gh(
+    "GET /rate_limit",
+    .token = .token,
+    .api_url = .api_url,
+    .send_headers = .send_headers
+  )
+
+  resources <- response$resources
+
+  reset <- .POSIXct(sapply(resources, "[[", "reset"))
+
+  data.frame(
+    type = names(resources),
+    limit = sapply(resources, "[[", "limit"),
+    used = sapply(resources, "[[", "used"),
+    remaining = sapply(resources, "[[", "remaining"),
+    reset = reset,
+    mins_left = round((unclass(reset) - unclass(Sys.time())) / 60, 1),
+    stringsAsFactors = FALSE,
+    row.names = NULL
+  )
+}

R/gh_request.R

@@ -6,17 +6,31 @@ default_api_url <- function() {
 ## Headers to send with each API request
 default_send_headers <- c("User-Agent" = "https://github.com/r-lib/gh")
 
-gh_build_request <- function(endpoint = "/user", params = list(),
-                             token = NULL, destfile = NULL, overwrite = NULL,
-                             accept = NULL, send_headers = NULL,
-                             api_url = NULL, method = "GET") {
+gh_build_request <- function(endpoint = "/user",
+                             params = list(),
+                             token = NULL,
+                             destfile = NULL,
+                             overwrite = NULL,
+                             accept = NULL,
+                             send_headers = NULL,
+                             max_wait = 10,
+                             api_url = NULL,
+                             method = "GET") {
   working <- list(
-    method = method, url = character(), headers = NULL,
-    query = NULL, body = NULL,
-    endpoint = endpoint, params = params,
-    token = token, accept = c(Accept = accept),
-    send_headers = send_headers, api_url = api_url,
-    dest = destfile, overwrite = overwrite
+    method = method,
+    url = character(),
+    headers = NULL,
+    query = NULL,
+    body = NULL,
+    endpoint = endpoint,
+    params = params,
+    token = token,
+    accept = c(Accept = accept),
+    send_headers = send_headers,
+    api_url = api_url,
+    dest = destfile,
+    overwrite = overwrite,
+    max_wait = max_wait
   )
 
   working <- gh_set_verb(working)
@@ -25,13 +39,12 @@ gh_build_request <- function(endpoint = "/user", params = list(),
   working <- gh_set_body(working)
   working <- gh_set_url(working)
   working <- gh_set_headers(working)
-  working <- gh_set_dest(working)
   working[c("method", "url", "headers", "query", "body", "dest")]
 }
 
 
 ## gh_set_*(x)
-## x = a list in which we build up an httr request
+## x = a list in which we build up an httr2 request
 ## x goes in, x comes out, possibly modified
 
 gh_set_verb <- function(x) {
@@ -110,7 +123,7 @@ gh_set_body <- function(x) {
   if (length(x$params) == 1 && is.raw(x$params[[1]])) {
     x$body <- x$params[[1]]
   } else {
-    x$body <- toJSON(x$params, auto_unbox = TRUE)
+    x$body <- x$params
   }
   x
 }
@@ -182,16 +195,6 @@ gh_send_headers <- function(accept_header = NULL, headers = NULL) {
   )
 }
 
-#' @importFrom httr write_disk write_memory
-gh_set_dest <- function(x) {
-  if (is.null(x$dest)) {
-    x$dest <- write_memory()
-  } else {
-    x$dest <- write_disk(x$dest, overwrite = x$overwrite)
-  }
-  x
-}
-
 # helpers ----
 # https://tools.ietf.org/html/rfc6570
 # we support what the RFC calls "Level 1 templates", which only require