function factory to give httr::VERB n retries; replace all GETs (fixes …

…#225)

.travis.yml

@@ -1,5 +1,6 @@
 language: R
 cache: packages
+sudo: false
 before_install:
   - openssl aes-256-cbc -K $encrypted_1ac2f65e8ef8_key -iv $encrypted_1ac2f65e8ef8_iv
     -in tests/testthat/googlesheets_token.rds.enc -out tests/testthat/googlesheets_token.rds -d

R/gd_drive_user.R

@@ -15,7 +15,7 @@ drive_user <- function() {
 
   ## https://developers.google.com/drive/v2/reference/about
   url <- file.path(.state$gd_base_url, "drive/v2/about")
-  req <- httr::GET(url, google_token()) %>%
+  req <- rGET(url, google_token()) %>%
     httr::stop_for_status()
   rc <- content_as_json_UTF8(req)
   rc$date <- req$headers$date %>% httr::parse_http_date()

R/gd_metadata.R

@@ -20,7 +20,7 @@ gd_metadata <- function(id, auth = TRUE) {
   fields <- paste(fields, collapse = ",")
   the_url <- file.path(.state$gd_base_url_files_v3, id)
   the_url <- httr::modify_url(the_url, query = list(fields = fields))
-  req <- httr::GET(the_url, include_token_if(auth)) %>%
+  req <- rGET(the_url, include_token_if(auth)) %>%
     httr::stop_for_status()
   httr::content(req)
 }

R/gd_permissions.R

@@ -32,7 +32,7 @@
 gs_perm_ls <- function(ss, filter = NULL) {
 
   url <- file.path(.state$gd_base_url_files_v2, ss$sheet_key, "permissions")
-  req <- httr::GET(url, google_token()) %>%
+  req <- rGET(url, google_token()) %>%
     httr::stop_for_status()
   req <- content_as_json_UTF8(req)
 

R/googlesheet.R

@@ -34,7 +34,7 @@ as.googlesheet <-
 as.googlesheet.ws_feed <- function(x, ssf = NULL,
                                    lookup, verbose = TRUE, ...) {
 
-  req <- httr::GET(x, omit_token_if(grepl("public", x))) %>%
+  req <- rGET(x, omit_token_if(grepl("public", x))) %>%
     httr::stop_for_status()
   rc <- content_as_xml_UTF8(req)
 

R/gs_add_row.R

@@ -59,9 +59,9 @@ gs_add_row <- function(ss, ws = 1, input = '', verbose = TRUE) {
   ## http://stackoverflow.com/questions/11361956/limiting-the-resultset-size-on-a-google-spreadsheets-forms-list-feed
   ## http://stackoverflow.com/questions/27678331/retreive-a-range-of-rows-from-google-spreadsheet-using-list-based-feed-api-and
   the_url <- this_ws$listfeed
-  req <- httr::GET(the_url,
-                   omit_token_if(grepl("public", the_url)),
-                   query = list(`max-results` = 1)) %>%
+  req <- rGET(the_url,
+              omit_token_if(grepl("public", the_url)),
+              query = list(`max-results` = 1)) %>%
     httr::stop_for_status()
   rc <- content_as_xml_UTF8(req)
 

R/gs_download.R

@@ -79,14 +79,14 @@ gs_download <-
     stop(mess)
   }
 
-  httr::GET(link, omit_token_if(grepl("public", from$ws_feed)),
-            if (interactive()) httr::progress() else NULL,
-            httr::write_disk(to, overwrite = overwrite))
+  rGET(link, omit_token_if(grepl("public", from$ws_feed)),
+       if (interactive()) httr::progress() else NULL,
+       httr::write_disk(to, overwrite = overwrite))
 
   if (file.exists(to)) {
 
     to <- normalizePath(to)
-    if(verbose) {
+    if (verbose) {
       mpf("Sheet successfully downloaded:\n%s", to)
     }
     return(invisible(to))

R/gs_ls.R

@@ -66,7 +66,7 @@ gs_ls <- function(regex = NULL, ..., verbose = TRUE) {
 
   # only calling spreadsheets feed from here, so hardwiring url
   the_url <- "https://spreadsheets.google.com/feeds/spreadsheets/private/full"
-  req <- httr::GET(the_url, google_token()) %>%
+  req <- rGET(the_url, google_token()) %>%
     httr::stop_for_status()
   rc <- content_as_xml_UTF8(req)
 

R/gs_read_cellfeed.R

@@ -79,10 +79,10 @@ gs_read_cellfeed <- function(
 
   the_url <- this_ws$cellsfeed
   req <-
-    httr::GET(the_url,
-              omit_token_if(grepl("public", the_url)),
-              query = query,
-              if (interactive() && ddd$progress && verbose) httr::progress() else NULL) %>%
+    rGET(the_url,
+         omit_token_if(grepl("public", the_url)),
+         query = query,
+         if (interactive() && ddd$progress && verbose) httr::progress() else NULL) %>%
     httr::stop_for_status()
   rc <- content_as_xml_UTF8(req)
 

R/gs_read_csv.R

@@ -48,9 +48,9 @@ gs_read_csv <- function(ss, ws = 1, ..., verbose = TRUE) {
   }
 
   req <-
-    httr::GET(this_ws$exportcsv,
-              omit_token_if(ss$is_public),
-              if (interactive() && ddd$progress && verbose) httr::progress() else NULL) %>%
+    rGET(this_ws$exportcsv,
+         omit_token_if(ss$is_public),
+         if (interactive() && ddd$progress && verbose) httr::progress() else NULL) %>%
     httr::stop_for_status()
   stop_for_content_type(req, "text/csv")
 

R/gs_read_listfeed.R

@@ -107,9 +107,9 @@ gs_read_listfeed <- function(ss, ws = 1,
   the_query <- list(reverse = reverse, orderby = orderby, sq = sq)
   the_url <- httr::modify_url(this_ws$listfeed, query = the_query)
   req <-
-    httr::GET(the_url,
-              omit_token_if(grepl("public", the_url)),
-              if (interactive() && ddd$progress && verbose) httr::progress() else NULL) %>%
+    rGET(the_url,
+         omit_token_if(grepl("public", the_url)),
+         if (interactive() && ddd$progress && verbose) httr::progress() else NULL) %>%
     httr::stop_for_status()
   rc <- content_as_xml_UTF8(req)
   ns <- xml2::xml_ns_rename(xml2::xml_ns(rc), d1 = "feed")

R/gs_ws.R

@@ -313,7 +313,7 @@ gs_ws_modify <- function(ss, from = NULL, to = NULL,
 
   this_ws <- ss %>% gs_ws(from, verbose = FALSE)
 
-  req <- httr::GET(this_ws$ws_id, google_token()) %>%
+  req <- rGET(this_ws$ws_id, google_token()) %>%
     httr::stop_for_status()
   stop_for_content_type(req, expected = "application/atom+xml; charset=UTF-8")
   ## yes, that's right

R/httr-helpers.R

@@ -22,3 +22,30 @@ content_as_xml_UTF8 <- function(req) {
   stop_for_content_type(req, expected = "application/atom+xml; charset=UTF-8")
   xml2::read_xml(httr::content(req, as = "text", encoding = "UTF-8"))
 }
+
+## http://www.iana.org/assignments/http-status-codes/http-status-codes-1.csv
+coarsen_code <- function(code)
+  #cut(code, c(0, 299, 500, 600), right = FALSE, labels = FALSE)
+  cut(code, c(0, 500, 600), right = FALSE, labels = FALSE)
+
+VERB_n <- function(VERB, n = 5) {
+  function(...) {
+    for (i in seq_len(n)) {
+      out <- VERB(...)
+      status <- httr::status_code(out)
+      switch(coarsen_code(status),
+             break, ## < 500
+             {## >= 500
+               backoff <- runif(n = 1, min = 0, max = 2 ^ i - 1)
+               ## TO DO: honor a verbose argument or option
+               mess <- paste("HTTP error %s on attempt %d ...\n",
+                             "  backing off %0.2f seconds, retrying")
+               mpf(mess, status, i, backoff)
+               Sys.sleep(backoff)
+             })
+    }
+    out
+  }
+}
+
+rGET <- VERB_n(httr::GET)