diff --git a/DESCRIPTION b/DESCRIPTION index e11def2..8f7b785 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -31,6 +31,7 @@ Suggests: knitr, rmarkdown, markdown, + bench, callr Language: en-US Imports: diff --git a/NAMESPACE b/NAMESPACE index c00122e..ba4a3dc 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -8,3 +8,4 @@ export(get_stats) export(get_versions) export(get_wb) export(health_check) +importFrom(stats,runif) diff --git a/R/get_aux.R b/R/get_aux.R index d282c41..ecca385 100644 --- a/R/get_aux.R +++ b/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 diff --git a/R/get_stats.R b/R/get_stats.R index 33ff422..7a0c825 100644 --- a/R/get_stats.R +++ b/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) diff --git a/R/other.R b/R/other.R index c45834c..14534dc 100644 --- a/R/other.R +++ b/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 } diff --git a/R/utils.R b/R/utils.R index b78b331..bd3f032 100644 --- a/R/utils.R +++ b/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 diff --git a/tests/testthat/test-other.R b/tests/testthat/test-other.R index 7b50bac..5eeb386 100644 --- a/tests/testthat/test-other.R +++ b/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") diff --git a/tests/testthat/test-utils.R b/tests/testthat/test-utils.R index a2ebe72..022570c 100644 --- a/tests/testthat/test-utils.R +++ b/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))) }) +