Port all the underlying HTTP code to use httr2

DESCRIPTION

@@ -22,7 +22,7 @@ Imports:
     curl,
     DBI,
     gargle (>= 1.5.0),
-    httr,
+    httr2,
     jsonlite,
     lifecycle,
     methods,

NAMESPACE

@@ -156,18 +156,21 @@ import(methods)
 import(rlang, except = unbox)
 importFrom(bit64,integer64)
 importFrom(gargle,token_fetch)
-importFrom(httr,DELETE)
-importFrom(httr,GET)
-importFrom(httr,PATCH)
-importFrom(httr,POST)
-importFrom(httr,PUT)
-importFrom(httr,add_headers)
-importFrom(httr,config)
-importFrom(httr,content)
-importFrom(httr,headers)
-importFrom(httr,http_status)
-importFrom(httr,parse_media)
-importFrom(httr,status_code)
+importFrom(httr2,req_auth_bearer_token)
+importFrom(httr2,req_body_json)
+importFrom(httr2,req_body_raw)
+importFrom(httr2,req_error)
+importFrom(httr2,req_method)
+importFrom(httr2,req_perform)
+importFrom(httr2,req_url_path_append)
+importFrom(httr2,req_url_query)
+importFrom(httr2,req_user_agent)
+importFrom(httr2,request)
+importFrom(httr2,resp_body_json)
+importFrom(httr2,resp_body_raw)
+importFrom(httr2,resp_body_string)
+importFrom(httr2,resp_content_type)
+importFrom(httr2,resp_status)
 importFrom(jsonlite,unbox)
 importFrom(lifecycle,deprecated)
 importFrom(tibble,tibble)

NEWS.md

@@ -9,6 +9,8 @@
 
 * bigrquery now requires R 4.0, in line with our version support principles.
 
+* bigrquery now uses `httr2` internally instead of `httr`.
+
 # bigrquery 1.5.1
 
 * Forward compatibility with upcoming dbplyr release (#601).

R/bq-auth.R

@@ -92,6 +92,12 @@ bq_auth <- function(email = gargle::gargle_oauth_email(),
         "Try calling {.fun bq_auth} directly with necessary specifics."
     ))
   }
+  # Take a tip from httr2::oauth_token() and store the expiry time. That way
+  # we know when we need to refresh credentials before making a request.
+  expires_in <- cred$credentials$expires_in
+  if (!is.null(expires_in)) {
+    cred$credentials$expires_at <- as.numeric(Sys.time()) + expires_in
+  }
   .auth$set_cred(cred)
   .auth$set_auth_active(TRUE)
 
@@ -131,7 +137,7 @@ bq_deauth <- function() {
 #' Produce configured token
 #'
 #' @eval gargle:::PREFIX_token_description(gargle_lookup_table)
-#' @eval gargle:::PREFIX_token_return()
+#' @returns An OAuth bearer token.
 #'
 #' @family low-level API functions
 #' @export
@@ -143,7 +149,19 @@ bq_token <- function() {
   if (!bq_has_token()) {
     bq_auth()
   }
-  httr::config(token = .auth$cred)
+  # Opportunistically refresh the token, if possible. We are doing something
+  # close to httr2:::token_has_expired() here, but melded to gargle's refresh
+  # implementation.
+  token <- .auth$cred$credentials
+  if (is.null(token$expires_at) || !.auth$cred$can_refresh()) {
+    return(token$access_token)
+  }
+  deadline <- as.integer(Sys.time()) + 5
+  if (deadline > token$expires_at) {
+    .auth$cred$refresh()
+    token <- .auth$cred$credentials
+  }
+  token$access_token
 }
 
 #' Is there a token on hand?
@@ -229,7 +247,7 @@ bq_oauth_client <- function() {
 #' }
 bq_user <- function() {
   if (bq_has_token()) {
-    gargle::token_email(bq_token())
+    gargle::token_email(.auth$cred)
   } else {
     NULL
   }

R/bq-download.R

@@ -391,13 +391,13 @@ bq_download_chunk_handle <- function(x, begin = 0L, max_results = 1e4) {
   )
 
   url <- paste0(base_url, bq_path(x$project, dataset = x$dataset, table = x$table, data = ""))
-  url <- httr::modify_url(url, query = prepare_bq_query(query))
+  url <- httr2::url_parse(url)
+  url$query <- prepare_bq_query(query)
+  url <- httr2::url_build(url)
 
   if (bq_has_token()) {
-    token <- .auth$get_cred()
-    signed <- token$sign("GET", url)
-    url <- signed$url
-    headers <- signed$headers
+    # TODO: Did we break non-header clients here?
+    headers <- c("Authorization" = paste("Bearer", bq_token()))
   } else {
     headers <- list()
   }
@@ -416,12 +416,14 @@ bq_download_callback <- function(path, progress = NULL, call = caller_env()) {
   function(result) {
     if (!is.null(progress)) cli::cli_progress_update(id = progress)
 
-    bq_check_response(
-      status = result$status_code,
-      type = curl::parse_headers_list(result$headers)[["content-type"]],
-      content = result$content,
-      call = call
-    )
+    if (result$status_code >= 400) {
+      resp <- httr2::response(
+        status_code = result$status_code,
+        headers = result$headers,
+        body = result$content
+      )
+      cli::cli_abort(bq_error_body(resp), call = call)
+    }
 
     con <- file(path, open = "wb")
     defer(close(con))