diff --git a/.Rbuildignore b/.Rbuildignore index c6714fd..67a224a 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -8,3 +8,4 @@ ^pkgdown$ TEMP/ ^data-raw$ +CONTRIBUTING.md \ No newline at end of file diff --git a/NAMESPACE b/NAMESPACE index 7fe030e..7355908 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -7,3 +7,4 @@ export(get_regions) export(get_stats) export(get_versions) export(health_check) +importFrom(stats,runif) diff --git a/R/get_aux.R b/R/get_aux.R index 71c9f98..94f6de9 100644 --- a/R/get_aux.R +++ b/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) } } diff --git a/R/get_stats.R b/R/get_stats.R index 6cbd441..e6f1d39 100644 --- a/R/get_stats.R +++ b/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) diff --git a/R/other.R b/R/other.R index 6f97ca2..d252e1a 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) { - 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 } diff --git a/R/utils.R b/R/utils.R index 06af0b1..ed66325 100644 --- a/R/utils.R +++ b/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) -} diff --git a/tests/testthat/test-other.R b/tests/testthat/test-other.R index abdd64a..f8242c7 100644 --- a/tests/testthat/test-other.R +++ b/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") diff --git a/tests/testthat/test-utils.R b/tests/testthat/test-utils.R index 8ab366b..f1835e6 100644 --- a/tests/testthat/test-utils.R +++ b/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"))) }) + +