Add retry functionality

DESCRIPTION

@@ -31,6 +31,7 @@ Suggests:
     knitr,
     rmarkdown,
     markdown,
+    bench,
     callr
 Language: en-US
 Imports: 

NAMESPACE

@@ -8,3 +8,4 @@ export(get_stats)
 export(get_versions)
 export(get_wb)
 export(health_check)
+importFrom(stats,runif)

R/get_aux.R

@@ -24,20 +24,15 @@ get_aux <- function(table = NULL, version = NULL, api_version = "v1",
   api_version <- match.arg(api_version)
   format <- match.arg(format)
 
-  # Check connection
-  check_internet()
-  check_api(api_version, server)
-
-  # Build query string
-  u <- build_url(server, "aux", api_version = api_version)
-
   # Return response
   if (is.null(table)) {
-    res <- httr::GET(u)
+    res <- send_query(server, endpoint = "aux", api_version = api_version)
     parse_response(res, simplify = simplify)
   } else {
     args <- build_args(table = table, version = version, format = format)
-    res <- httr::GET(u, query = args, httr::user_agent(pipr_user_agent))
+    res <-  send_query(server, endpoint = "aux",
+                       query = args,
+                       api_version = api_version)
     parse_response(res, simplify = simplify)
   }
 }
@@ -57,7 +52,6 @@ get_countries <- function(version = NULL, api_version = "v1",
   )
 }
 
-
 #' @rdname get_aux
 #' @export
 #' @examples

R/get_stats.R

@@ -88,10 +88,6 @@ get_stats <- function(country = "all",
     group_by <- NULL
   }
 
-  # Check connection
-  check_internet()
-  check_api(api_version, server)
-
   # Build query string
   args <- build_args(
     country = country, year = year, povline = povline,
@@ -100,10 +96,12 @@ get_stats <- function(country = "all",
     reporting_level = reporting_level,
     version = version, format = format
   )
-  u <- build_url(server, endpoint, api_version)
 
   # Send query
-  res <- httr::GET(u, query = args, httr::user_agent(pipr_user_agent))
+  res <- send_query(
+    server, query = args,
+    endpoint = endpoint,
+    api_version = api_version)
 
   # Parse result
   out <- parse_response(res, simplify)
@@ -125,19 +123,17 @@ get_wb <- function(year = "all",
   api_version <- match.arg(api_version)
   format <- match.arg(format)
 
-  # Check connection
-  check_internet()
-  check_api(api_version, server)
-
   # Build query string
   args <- build_args(
     country = "all", year = year, povline = povline,
     group_by = "wb", version = version, format = format
   )
-  u <- build_url(server, "pip-grp", api_version)
-
+
   # Send query
-  res <- httr::GET(u, query = args, httr::user_agent(pipr_user_agent))
+  res <- send_query(
+    server, query = args,
+    endpoint = "pip-grp",
+    api_version = api_version)
 
   # Parse result
   out <- parse_response(res, simplify)

R/other.R

@@ -5,8 +5,7 @@
 #' @examples
 #' health_check()
 health_check <- function(api_version = "v1", server = NULL) {
-  check_internet()
-  res <- check_api(api_version, server = server)
+  res <- send_query(server, endpoint = "health-check", api_version = api_version)
   parse_response(res, simplify = FALSE)$content
 }
 
@@ -19,9 +18,7 @@ health_check <- function(api_version = "v1", server = NULL) {
 #' @examples
 #' get_versions()
 get_versions <- function(api_version = "v1", server = NULL, simplify = TRUE) {
-  check_internet()
-  u <- build_url(server, "versions", api_version)
-  res <- httr::GET(u, httr::user_agent(pipr_user_agent))
+  res <- send_query(server, endpoint = "versions", api_version = api_version)
   parse_response(res, simplify = simplify)
 }
 
@@ -34,8 +31,6 @@ get_versions <- function(api_version = "v1", server = NULL, simplify = TRUE) {
 #' @examples
 #' get_pip_info()
 get_pip_info <- function(api_version = "v1", server = NULL) {
-  check_internet()
-  u <- build_url(server, "pip-info", api_version)
-  res <- httr::GET(u, httr::user_agent(pipr_user_agent))
+  res <- send_query(server, endpoint = "pip-info", api_version = api_version)
   parse_response(res, simplify = FALSE)$content
 }

R/utils.R

@@ -46,8 +46,84 @@ check_status <- function(res, parsed) {
   invisible(TRUE)
 }
 
+#' check_host
+#' @inheritParams send_query
+#' @return logical
+#' @noRd
+check_host <- function(server, ...)  {
+  base_url <- select_base_url(server)
+  host <- gsub("/pip|/api|http(s)?://", "", base_url)
+  retry_host(host, ...)
+  invisible(TRUE)
+}
+
+#' Retry host
+#'
+#' Retry connection to a server host in case the host could not be resolved.
+#'
+#' @param host A server host
+#' @param times Maximum number of requests to attempt
+#' @param min Minimum number of seconds to sleep for each retry
+#' @param max Maximum number of seconds to sleep for each retry
+#' @return logical
+#' @noRd
+#' @examples
+#' retry_host("google.com")
+#' retry_host("google.tmp")
+#' @importFrom stats runif
+retry_host <- function(host, times = 3L, min = 1, max = 3) {
+  # Only do one request of times == 1
+  if (times == 1)  {
+    check <- curl::nslookup(host, error = FALSE)
+  } else {
+    # Else iterate over n times
+    for (i in seq_len(times)) {
+      check <- curl::nslookup(host, error = FALSE)
+      if (!is.null(check)) break
+      sleep <- round(runif(1, min, max), 1)
+      message(sprintf("Could not connect to %s. Retrying in %s seconds...", host, sleep))
+      Sys.sleep(sleep)
+    }
+  }
+  attempt::stop_if(is.null(check), msg = sprintf("Could not connect to %s", host))
+  invisible(TRUE)
+}
+
+#' Retry request
+#'
+#' Retry a GET request in case the server returns a 500 type error.
+#'
+#' @param url A URL
+#' @param query Query parameters (optional)
+#' @param times Maximum number of requests to attempt
+#' @param min Minimum number of seconds to sleep for each retry
+#' @param max Maximum number of seconds to sleep for each retry
+#' @return A httr response
+#' @noRd
+#' @examples
+#' retry_request("http://httpbin.org/status/200")
+#' retry_request("http://httpbin.org/status/400")
+#' retry_request("http://httpbin.org/status/500")
+retry_request <- function(url, query = NULL, times = 3L, min = 1, max = 3) {
+  # Only do one request if times == 1
+  if (times == 1)  {
+    res <- httr::GET(url, query = query, httr::user_agent(pipr_user_agent))
+    return(res)
+  }
+  # Iterate over n times
+  for (i in seq_len(times)) {
+    res <- httr::GET(url, query = query, httr::user_agent(pipr_user_agent))
+    if (!res$status_code %in% c(429, 500, 503, 504)) break
+    sleep <- round(runif(1, min, max), 1)
+    message(sprintf("Request failed [%s]. Retrying in %s seconds...", res$status_code, sleep))
+    Sys.sleep(sleep)
+  }
+  return(res)
+}
+
 #' build_url
-#' @param server character: Server
+#' @param server character: Server. Either "prod", "qa" or "dev". Defaults to
+#'   NULL (ie. prod).
 #' @param endpoint character: Endpoint
 #' @param api_version character: API version
 #' @inheritParams get_stats
@@ -57,6 +133,36 @@ build_url <- function(server, endpoint, api_version) {
   sprintf("%s/%s/%s", base_url, api_version, endpoint)
 }
 
+#' Select base URL
+#'
+#' Helper function to switch base URLs depending on PIP server being used
+#'
+#' @inheritParams build_url
+#' @return character
+#' @noRd
+select_base_url <- function(server) {
+
+  if (!is.null(server)) {
+    match.arg(server, c("prod", "qa", "dev"))
+    # Check ENV vars for DEV/QA urls
+    if (server %in% c("qa", "dev")) {
+      if (server == "qa") base_url <- Sys.getenv("PIP_QA_URL")
+      if (server == "dev") base_url <- Sys.getenv("PIP_DEV_URL")
+      attempt::stop_if(
+        base_url == "",
+        msg = sprintf("'%s' url not found. Check your .Renviron file.", server)
+      )
+    }
+  }
+
+  # Set base_url to prod_url (standard)
+  if (is.null(server) || server == "prod") {
+    base_url <- prod_url
+  }
+
+  return(base_url)
+}
+
 #' build_args
 #' @inheritParams get_stats
 #' @noRd
@@ -91,6 +197,21 @@ build_args <- function(country = NULL,
   return(args)
 }
 
+#' Send API query
+#'
+#' @inheritParams build_url
+#' @inheritParams query Query parameters (optional)
+#' @param ... Additional parameters passed to `retry_host()` and
+#'   `retry_request()`
+#' @return A httr response
+#' @noRd
+send_query <- function(server, query = NULL, endpoint, api_version, ...) {
+  # check_host(server, ...)
+  u <- build_url(server, endpoint, api_version)
+  retry_request(u, query = query, ...)
+}
+
+
 #' parse_response
 #' @param res A httr response
 #' @inheritParams get_stats

tests/testthat/test-other.R

@@ -3,7 +3,8 @@ qa_host <- gsub("/pip|/api|http(s)?://", "", Sys.getenv("PIP_QA_URL"))
 
 test_that("health_check() works", {
   expect_identical(health_check(), "PIP API is running")
-  expect_error(health_check("xx"))
+  expect_equal(health_check("xx")$statusCode, 404)
+
   skip_if(Sys.getenv("PIPR_RUN_LOCAL_TESTS") != "TRUE")
   skip_if(is.null(curl::nslookup(dev_host, error = FALSE)), message = "Could not connect to DEV host")
   expect_identical(health_check(server = "dev"), "PIP API is running")

tests/testthat/test-utils.R

@@ -4,6 +4,8 @@ res_ex_csv <- readRDS("../testdata/res-ex-csv.RDS")
 res_ex_rds <- readRDS("../testdata/res-ex-rds.RDS")
 res_ex_404 <- readRDS("../testdata/res-ex-404.RDS")
 
+library(bench)
+
 # tests
 test_that("check_internet() works", {
   expect_true(check_internet())
@@ -39,6 +41,54 @@ test_that("check_status() works", {
 
 })
 
+test_that("retry_host() works", {
+  expect_invisible(retry_host("google.com"))
+  expect_error(retry_host("google.tmp", 1)) # "Error: Could not connect to google.tmp"
+  expect_error(retry_host("google.tmp", 2, min = 0.1, max = .2))
+  tmp <- bench::system_time(try(retry_host("google.tmp", times = 3, min = 1, max = 1)))
+  expect_gte(tmp[2], 3)
+  # TO DO: Should tests for explicit iteration as well
+})
+
+test_that("retry_request() works", {
+  # 200 (no retry)
+  tmp <- retry_request("http://httpbin.org/status/200")
+  expect_equal(tmp$status_code, 200)
+  tmp <- bench::system_time(retry_request("http://httpbin.org/status/200", min = 1, max = 1))
+  expect_lte(tmp[2], .5)
+  tmp <- bench::system_time(retry_request("http://httpbin.org/status/200", times = 1))
+  expect_lte(tmp[2], .5)
+
+  # 400 (no retry)
+  tmp <- retry_request("http://httpbin.org/status/400")
+  expect_equal(tmp$status_code, 400)
+  tmp <- bench::system_time(retry_request("http://httpbin.org/status/400", min = 1, max = 1))
+  expect_lte(tmp[2], .5)
+
+  # 500 (should retry)
+  tmp <- retry_request("http://httpbin.org/status/500", min = 0.1, max = 0.1)
+  expect_equal(tmp$status_code, 500)
+  tmp <- bench::system_time(retry_request("http://httpbin.org/status/500", min = 1, max = 1))
+  expect_gte(tmp[2], 3)
+
+  # TO DO: Should tests for explicit iteration as well
+})
+
+test_that("check_host() works", {
+  expect_true(check_host(NULL))
+  expect_true(check_host("prod"))
+  skip_if(Sys.getenv("PIP_DEV_URL") != "")
+  expect_error(check_host("dev", times = 2, min = 0.1, max = .5))
+})
+
+test_that("send_query() works", {
+  res <- send_query("prod", query = list(country = "AGO"), api_version = "v1", endpoint = "pip")
+  expect_equal(res$status_code, 200)
+  res <- send_query("prod", query = list(country = "AGO"), api_version = "v1", endpoint = "tmp")
+  expect_equal(res$status_code, 404)
+  # TO DO: Add more tests to make sure dots arguments are passed correctly
+})
+
 test_that("build_url() works", {
 
   # Check that url is correctly pasted together
@@ -238,3 +288,4 @@ test_that("Temporay renaming of response columns work", {
                      "reporting_pop", "reporting_gdp",
                      "reporting_pce") %in% names(res)))
 })
+