Refactor timeout for requests to GCE metadataserver

NEWS.md

@@ -48,6 +48,10 @@ As a bridging measure, `gargle_oauth_client` currently inherits from httr's `oau
 
 `gce_instance_service_accounts()` is a newly exported utility that exposes the service accounts available from the metadata server for the current instance (#234).
 
+The global option `"gargle.gce.timeout"` is newly documented in `credentials_gce()`.
+This controls the timeout, in seconds, for requests to the metadata server.
+The default value (or strategy) for setting this should often suffice, but the option exists for those with an empirical need to increase the timeout (#186, #195).
+
 `vignette("non-interactive-auth")` has a new section "Workload Identity on Google Kubernetes Engine (GKE)" that explains how gargle supports the use of workload identity for applications running on GKE. This is the recommended method of auth in R code running on GKE that needs to access other Google Cloud services, such as the BigQuery API (#197, #223, @MarkEdmondson1234).
 
 ## Credential function registry

R/credentials_gce.R

@@ -32,6 +32,16 @@
 #'     `"gargle.gce.use_ip"` is `TRUE`. If undefined, the default is
 #'     `169.254.169.254`.
 
+#'
+#' * Change (presumably increase) the timeout for requests to the metadata
+#' server via the `"gargle.gce.timeout"` global option. This timeout is given in
+#' seconds and is set to a value (strategy, really) that often works well in
+#' practice. However, in some cases it may be necessary to increase the timeout
+#' with code such as:
+#' ``` r
+#' options(gargle.gce.timeout = 3)
+#' ```
+
 #' For details on specific use cases, such as Google Kubernetes Engine (GKE),
 #' see `vignette("non-interactive-auth")`.
 #'
@@ -163,7 +173,7 @@ gce_metadata_request <- function(path = "", query = NULL, stop_on_error = TRUE)
   timeout <- getOption("gargle.gce.timeout", default = 0.8)
   response <- try(
     {
-      httr::with_config(httr::timeout(timeout), {
+      httr::with_config(httr::timeout(gce_timeout()), {
         httr::GET(url, httr::add_headers("Metadata-Flavor" = "Google"))
       })
     },
@@ -229,3 +239,29 @@ fetch_gce_access_token <- function(scopes, service_account) {
   response <- gce_metadata_request(path)
   httr::content(response, as = "parsed", type = "application/json")
 }
+
+# wrapper to access the "gargle.gce.timeout" option
+# https://github.com/r-lib/gargle/issues/186
+# https://github.com/r-lib/gargle/pull/195
+# if called with no argument:
+#   if option is set, return that value
+#   if unset: return a short default, suitable for initial ping of
+#     the metadata server (and not too burdensome for non-GCE users) and set the
+#     option to a longer default, suitable for a subsequent request for all
+#     service accounts or a specific token
+# if called with an argument:
+#   set the option to that value (and return the old value)
+gce_timeout <- function(v) {
+  opt <- getOption("gargle.gce.timeout")
+  if (missing(v)) {
+    if (is.null(opt)) {
+      ret <- 0.8                      # short default timeout
+      options(gargle.gce.timeout = 2) # long default timeout
+    } else {
+      ret <- opt
+    }
+  } else {
+    ret <- options(gargle.gce.timeout = v)[["gargle.gce.timeout"]]
+  }
+  ret
+}

tests/testthat/test-credentials_gce.R

@@ -29,3 +29,21 @@ test_that("Can list service accounts", {
   service_accounts <- gce_instance_service_accounts()
   expect_s3_class(service_accounts, class = "data.frame")
 })
+
+test_that("gce_timeout() works", {
+  withr::with_options(
+    list(gargle.gce.timeout = NULL),
+    {
+      expect_equal(gce_timeout(), 0.8)
+      expect_equal(gce_timeout(), 2)
+    }
+  )
+  withr::with_options(
+    new = list(gargle.gce.timeout = 100),
+    {
+      expect_equal(gce_timeout(), 100)
+      expect_equal(gce_timeout(200), 100)
+      expect_equal(gce_timeout(), 200)
+    }
+  )
+})