Add retry functionality

* Add new functions; retry_host() and retry_request()
* Remove check_api() and check_internet() from main exported functions
* Add new function; send_query to call the API

Closes #5
Closes #8

.Rbuildignore

@@ -8,3 +8,4 @@
 ^pkgdown$
 TEMP/
 ^data-raw$
+CONTRIBUTING.md

NAMESPACE

@@ -7,3 +7,4 @@ export(get_regions)
 export(get_stats)
 export(get_versions)
 export(health_check)
+importFrom(stats,runif)

R/get_aux.R

@@ -24,15 +24,8 @@ 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)
-
   # Get available tables
-  res <- httr::GET(u)
+  res <- send_query(server, endpoint = "aux", api_version = api_version)
   tables <- parse_response(res, simplify = FALSE)$content
 
   # Check table input
@@ -50,7 +43,9 @@ get_aux <- function(table = NULL, version = NULL, api_version = "v1",
     return(tables)
   } else {
     args <- build_args(table = table, version = version, format = format)
-    res <- httr::GET(u, query = args)
+    res <-  send_query(server, endpoint = "aux",
+                       query = args,
+                       api_version = api_version)
     parse_response(res, simplify = simplify)
   }
 }

R/get_stats.R

@@ -79,10 +79,6 @@ get_stats <- function(country = "all",
     endpoint <- "pip"
   }
 
-  # Check connection
-  check_internet()
-  check_api(api_version, server)
-
   # Build query string
   args <- build_args(
     country = country, year = year, povline = povline,
@@ -91,10 +87,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)
+  res <- send_query(
+    server, query = args,
+    endpoint = endpoint,
+    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) {
-  check_internet()
-  u <- build_url(server, "versions", api_version)
-  res <- httr::GET(u)
+  res <- send_query(server, endpoint = "versions", api_version = api_version)
   parse_response(res, simplify = FALSE)$content
 }
 
@@ -34,8 +31,6 @@ get_versions <- function(api_version = "v1", server = NULL) {
 #' @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)
+  res <- send_query(server, endpoint = "pip-info", api_version = api_version)
   parse_response(res, simplify = FALSE)$content
 }

R/utils.R

@@ -37,8 +37,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)
+    return(res)
+  }
+  # Iterate over n times
+  for (i in seq_len(times)) {
+    res <- httr::GET(url, query = query)
+    if (!res$status_code %in% seq(500, 511, 1)) 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
@@ -48,6 +124,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
@@ -82,6 +188,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
@@ -121,30 +242,3 @@ parse_response <- function(res, simplify) {
     )
   }
 }
-
-#' Select base URL
-#'
-#' Helper function to switch base URLs depending on PIP server being used
-#'
-#' @param server character: c("prod", "qa", "dev"). Defaults to NULL (ie. prod).
-#' @return character
-#' @noRd
-select_base_url <- function(server) {
-  if (!is.null(server)) {
-    match.arg(server, c("prod", "qa", "dev"))
-    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)
-      )
-    }
-  }
-
-  if (is.null(server) || server == "prod") {
-    base_url <- prod_url
-  }
-
-  return(base_url)
-}

tests/testthat/test-other.R

@@ -1,9 +1,10 @@
 dev_host <- gsub("/api|http://", "", Sys.getenv("PIP_DEV_URL"))
-qa_host <- gsub("/api|http://", "", Sys.getenv("PIP_QA_URL"))
+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

@@ -3,6 +3,8 @@ res_ex_json <- readRDS("../testdata/res-ex-json.RDS")
 res_ex_csv <- readRDS("../testdata/res-ex-csv.RDS")
 res_ex_rds <- readRDS("../testdata/res-ex-rds.RDS")
 
+library(bench)
+
 # tests
 test_that("check_internet() works", {
   expect_true(check_internet())
@@ -27,6 +29,52 @@ test_that("check_status() works", {
   expect_error(check_status(res, parsed))
 })
 
+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)
+
+  # 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
@@ -208,3 +256,5 @@ test_that("parse_response() works for different formats", {
   expect_identical(class(res$response), "response")
   expect_true(all(class(res$content) %in% c("data.table", "data.frame")))
 })
+
+