Allow configurable OAuth expiry margins

NEWS.md

@@ -2,6 +2,7 @@
 
 * Fixed OAuth token cache pruning so that it actually matches the encrypted `.rds.enc` files written to disk; previously the pruning pattern only matched an unencrypted `.rds` file that was never created, so cached tokens were never automatically deleted regardless of age.
 * httr2 now requires rlang >= 1.3.0, which changes the hash used to name files cached by `req_cache()` and on-disk OAuth token caches (e.g. from `req_oauth_auth_code(cache_disk = TRUE)`). Existing cached files won't match the new hash, so they'll be silently ignored (triggering a normal cache miss/re-authentication) and cleaned up over time by the usual pruning rules; you can also delete them manually.
+* `req_oauth_*()` gains an `expiry_margin` argument to control how early cached OAuth tokens are treated as expired; the default margin increases from 5 to 30 seconds (@zacdav-db, #860).
 
 # httr2 1.2.3
 

R/oauth-flow-auth-code.R

@@ -83,6 +83,9 @@
 #'   Learn more in <https://httr2.r-lib.org/articles/oauth.html>.
 #' @param cache_key If you want to cache multiple tokens per app, use this
 #'   key to disambiguate them.
+#' @param expiry_margin Number of seconds before a token's stated expiry that
+#'   it should be treated as expired. Increase this for servers that reject
+#'   tokens shortly before they expire. Defaults to 30 seconds.
 #' @returns `req_oauth_auth_code()` returns a modified HTTP [request] that will
 #'   use OAuth; `oauth_flow_auth_code()` returns an [oauth_token].
 #' @examples
@@ -106,7 +109,8 @@ req_oauth_auth_code <- function(
   token_params = list(),
   redirect_uri = oauth_redirect_uri(),
   cache_disk = FALSE,
-  cache_key = NULL
+  cache_key = NULL,
+  expiry_margin = 30
 ) {
   auth_url <- oauth_flow_url(auth_url, client, "auth_url")
   redirect <- normalize_redirect_uri(redirect_uri = redirect_uri)
@@ -122,7 +126,13 @@ req_oauth_auth_code <- function(
   )
 
   cache <- cache_choose(client, cache_disk, cache_key)
-  req_oauth(req, "oauth_flow_auth_code", params, cache = cache)
+  req_oauth(
+    req,
+    "oauth_flow_auth_code",
+    params,
+    cache = cache,
+    expiry_margin = expiry_margin
+  )
 }
 
 #' @export

R/oauth-flow-client-credentials.R

@@ -28,7 +28,8 @@ req_oauth_client_credentials <- function(
   req,
   client,
   scope = NULL,
-  token_params = list()
+  token_params = list(),
+  expiry_margin = 30
 ) {
   params <- list(
     client = client,
@@ -37,7 +38,13 @@ req_oauth_client_credentials <- function(
   )
 
   cache <- cache_mem(client, NULL)
-  req_oauth(req, "oauth_flow_client_credentials", params, cache = cache)
+  req_oauth(
+    req,
+    "oauth_flow_client_credentials",
+    params,
+    cache = cache,
+    expiry_margin = expiry_margin
+  )
 }
 
 #' @export

R/oauth-flow-device.R

@@ -41,7 +41,8 @@ req_oauth_device <- function(
   auth_params = list(),
   token_params = list(),
   cache_disk = FALSE,
-  cache_key = NULL
+  cache_key = NULL,
+  expiry_margin = 30
 ) {
   auth_url <- oauth_flow_url(auth_url, client, "device_auth_url")
   params <- list(
@@ -54,7 +55,13 @@ req_oauth_device <- function(
     token_params = token_params
   )
   cache <- cache_choose(client, cache_disk, cache_key)
-  req_oauth(req, "oauth_flow_device", params, cache = cache)
+  req_oauth(
+    req,
+    "oauth_flow_device",
+    params,
+    cache = cache,
+    expiry_margin = expiry_margin
+  )
 }
 
 #' @export

R/oauth-flow-jwt.R

@@ -46,7 +46,8 @@ req_oauth_bearer_jwt <- function(
   signature = "jwt_encode_sig",
   signature_params = list(),
   scope = NULL,
-  token_params = list()
+  token_params = list(),
+  expiry_margin = 30
 ) {
   params <- list(
     client = client,
@@ -58,7 +59,13 @@ req_oauth_bearer_jwt <- function(
   )
 
   cache <- cache_mem(client, claim)
-  req_oauth(req, "oauth_flow_bearer_jwt", params, cache = cache)
+  req_oauth(
+    req,
+    "oauth_flow_bearer_jwt",
+    params,
+    cache = cache,
+    expiry_margin = expiry_margin
+  )
 }
 
 #' @export

R/oauth-flow-password.R

@@ -33,7 +33,8 @@ req_oauth_password <- function(
   scope = NULL,
   token_params = list(),
   cache_disk = FALSE,
-  cache_key = username
+  cache_key = username,
+  expiry_margin = 30
 ) {
   params <- list(
     client = client,
@@ -43,7 +44,13 @@ req_oauth_password <- function(
     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)
+  req_oauth(
+    req,
+    "oauth_flow_password",
+    params,
+    cache = cache,
+    expiry_margin = expiry_margin
+  )
 }
 
 #' @export

R/oauth-flow-refresh.R

@@ -36,7 +36,8 @@ req_oauth_refresh <- function(
   client,
   refresh_token = Sys.getenv("HTTR2_REFRESH_TOKEN"),
   scope = NULL,
-  token_params = list()
+  token_params = list(),
+  expiry_margin = 30
 ) {
   params <- list(
     client = client,
@@ -46,7 +47,13 @@ req_oauth_refresh <- function(
   )
   cache <- cache_mem(client, refresh_token)
 
-  req_oauth(req, "oauth_flow_refresh", params, cache = cache)
+  req_oauth(
+    req,
+    "oauth_flow_refresh",
+    params,
+    cache = cache,
+    expiry_margin = expiry_margin
+  )
 }
 
 #' @export

R/oauth-flow-token-exchange.R

@@ -65,7 +65,8 @@ req_oauth_token_exchange <- function(
   requested_token_type = NULL,
   actor_token = NULL,
   actor_token_type = NULL,
-  token_params = list()
+  token_params = list(),
+  expiry_margin = 30
 ) {
   params <- list(
     client = client,
@@ -80,7 +81,13 @@ req_oauth_token_exchange <- function(
     token_params = token_params
   )
   cache <- cache_mem(client, NULL)
-  req_oauth(req, "oauth_flow_token_exchange", params, cache = cache)
+  req_oauth(
+    req,
+    "oauth_flow_token_exchange",
+    params,
+    cache = cache,
+    expiry_margin = expiry_margin
+  )
 }
 
 #' @export

R/oauth-token.R

@@ -66,7 +66,7 @@ print.httr2_token <- function(x, ...) {
   invisible(x)
 }
 
-token_has_expired <- function(token, delay = 5) {
+token_has_expired <- function(token, delay = 30) {
   if (is.null(token$expires_at)) {
     FALSE
   } else {

R/oauth.R

@@ -15,36 +15,57 @@
 #' @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`.
+#' @param expiry_margin Number of seconds before a token's stated expiry that
+#'   it should be treated as expired. Increase this for servers that reject
+#'   tokens shortly before they expire. Defaults to 30 seconds.
 #' @returns An [oauth_token].
 #' @keywords internal
 #' @export
-req_oauth <- function(req, flow, flow_params, cache) {
+req_oauth <- function(req, flow, flow_params, cache, expiry_margin = 30) {
+  check_number_whole(expiry_margin, min = 0)
+
   # Want req object to contain meaningful objects, not just a closure
   req <- req_auth_sign(
     req,
     fun = auth_oauth_sign,
-    params = list(flow = flow, flow_params = flow_params),
+    params = list(
+      flow = flow,
+      flow_params = flow_params,
+      expiry_margin = expiry_margin
+    ),
     cache = cache
   )
   req <- req_policies(req, auth_oauth = TRUE)
   req
 }
 
-auth_oauth_sign <- function(req, cache, flow, flow_params) {
+auth_oauth_sign <- function(
+  req,
+  cache,
+  flow,
+  flow_params,
+  expiry_margin = 30
+) {
   token <- auth_oauth_token_get(
     cache = cache,
     flow = flow,
-    flow_params = flow_params
+    flow_params = flow_params,
+    expiry_margin = expiry_margin
   )
   req_auth_bearer_token(req, token$access_token)
 }
 
-auth_oauth_token_get <- function(cache, flow, flow_params = list()) {
+auth_oauth_token_get <- function(
+  cache,
+  flow,
+  flow_params = list(),
+  expiry_margin = 30
+) {
   token <- cache$get()
   if (is.null(token)) {
     token <- exec(flow, !!!flow_params)
     cache$set(token)
-  } else if (token_has_expired(token)) {
+  } else if (token_has_expired(token, delay = expiry_margin)) {
     cache$clear()
     if (is.null(token$refresh_token)) {
       token <- exec(flow, !!!flow_params)