diff --git a/DESCRIPTION b/DESCRIPTION index aeeeeab..fccc401 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -25,14 +25,14 @@ BugReports: https://github.com/ropensci/opencage/issues Depends: R (>= 3.4.0) Imports: - crul (>= 0.5.2), dplyr (>= 0.7.4), + httr2 (>= 0.2.0), jsonlite (>= 1.5), lifecycle, + magrittr, memoise (>= 1.1.0), progress (>= 1.1.2), purrr (>= 0.2.4), - ratelimitr (>= 0.4.0), rlang, tibble (>= 1.4.2), tidyr (>= 0.8.0), diff --git a/NAMESPACE b/NAMESPACE index 8c03a7d..534673b 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -26,4 +26,5 @@ export(oc_reverse_df) export(opencage_forward) export(opencage_key) export(opencage_reverse) +importFrom(magrittr,`%>%`) importFrom(rlang,.data) diff --git a/NEWS.md b/NEWS.md index a1df7af..79cc3a4 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,7 @@ # opencage (development version) + +* http requests are now handled by {[httr2](https://httr2.r-lib.org/)}, not {[crul](https://docs.ropensci.org/crul/)}; and rate limitation / throttling by httr2, not [ratelimitr](https://github.com/tarakc02/ratelimitr) ([#156](https://github.com/ropensci/opencage/issues/156)). * opencage now supports an `address_only` parameter, see "[New optional API parameter 'address_only'](https://blog.opencagedata.com/post/new-optional-parameter-addressonly)", ([#151](https://github.com/ropensci/opencage/pull/151)). * The geocoding functions will not send a query to the API anymore if no API key is present ([#133](https://github.com/ropensci/opencage/issues/133)). * `NA`s are allowed again for the `placename` or `latitude`/`longitude` arguments (also empty strings for `placename`). diff --git a/R/oc_api_ok.R b/R/oc_api_ok.R index ec1cb52..abb41c7 100644 --- a/R/oc_api_ok.R +++ b/R/oc_api_ok.R @@ -10,5 +10,11 @@ #' @keywords internal oc_api_ok <- function(url = "https://api.opencagedata.com") { - crul::ok(url, useragent = "https://github.com/ropensci/opencage") + resp <- httr2::request(url) %>% + httr2::req_method("HEAD") %>% + httr2::req_user_agent(oc_ua_string) %>% + httr2::req_error(is_error = function(resp) FALSE) %>% + httr2::req_perform() + + !httr2::resp_is_error(resp) } diff --git a/R/oc_config.R b/R/oc_config.R index 499557d..ebd9b73 100644 --- a/R/oc_config.R +++ b/R/oc_config.R @@ -119,16 +119,16 @@ oc_config <- Sys.setenv(OPENCAGE_KEY = pat) - # set rate limit - ratelimitr::UPDATE_RATE( - oc_get_limited, - ratelimitr::rate(n = rate_sec, period = 1L) - ) - # set no_record oc_check_logical(no_record, check_length_one = TRUE) options("oc_no_record" = no_record) # set show_key options("oc_show_key" = show_key) + + # set rate + if (!is.numeric(rate_sec)) { + cli::cli_abort("Must use a numeric {.code rate_sec}") + } + options("oc_rate_sec" = rate_sec) } diff --git a/R/oc_process.R b/R/oc_process.R index d52c74c..8f576ee 100644 --- a/R/oc_process.R +++ b/R/oc_process.R @@ -130,7 +130,7 @@ oc_process <- } # build url - oc_url <- oc_build_url( + oc_url_parts <- oc_build_url( query_par = list( q = query, bounds = bounds, @@ -150,6 +150,8 @@ oc_process <- ), endpoint = endpoint ) + query_req <- build_query_with_req(oc_url_parts) + oc_url <- query_req[["url"]] # return url only if (return == "url_only") { @@ -166,13 +168,11 @@ oc_process <- # send query to API if not NA, else return (fake) empty res_text if (!is.na(query) && nchar(query) >= 2) { # get response - res_env <- oc_get_memoise(oc_url) + res_env <- oc_get_memoise(oc_url_parts) # parse response res_text <- oc_parse_text(res_env) - # check status message - oc_check_status(res_env, res_text) } else { # Fake 0 results response @@ -236,8 +236,7 @@ oc_build_url <- function(query_par, endpoint) { oc_path <- paste0("geocode/v1/", endpoint) - crul::url_build( - url = "https://api.opencagedata.com", + list( path = oc_path, query = query_par ) @@ -246,18 +245,38 @@ oc_build_url <- function(query_par, endpoint) { #' GET request from OpenCage #' -#' @param oc_url character string URL with query parameters, built with +#' @param oc_url_parts list with path and query, built with #' `oc_build_url()` #' -#' @return crul::HttpResponse object +#' @return httr2 response #' @noRd -oc_get <- function(oc_url) { - client <- crul::HttpClient$new( - url = oc_url, - headers = list(`User-Agent` = oc_ua_string) - ) - client$get() +oc_get <- function(oc_url_parts = NULL) { + + query_req <- build_query_with_req(oc_url_parts) + + query_req %>% + httr2::req_throttle(rate = getOption("oc_rate_sec", default = 1L) / 1L) %>% + httr2::req_user_agent(oc_ua_string) %>% + httr2::req_perform() # will error if API error :-) +} + +build_query_with_req <- function(oc_url_parts) { + initial_req <- httr2::request("https://api.opencagedata.com") + + req_with_url <- if (!is.null(oc_url_parts[["path"]])) { + httr2::req_url_path_append(initial_req, oc_url_parts[["path"]]) + } else { + initial_req + } + + query_req <- if (!is.null(oc_url_parts[["query"]])) { + httr2::req_url_query(req_with_url, !!!oc_url_parts[["query"]]) + } else { + req_with_url + } + + query_req } # user-agent string: this is set at build-time, but that should be okay, @@ -277,36 +296,13 @@ oc_ua_string <- #' @noRd oc_parse_text <- function(res) { - text <- res$parse(encoding = "UTF-8") + text <- httr2::resp_body_string(res) if (identical(text, "")) { stop("OpenCage returned an empty response.", call. = FALSE) } text } - -#' Check the status of the HttpResponse -#' -#' @param res_env crul::HttpResponse object -#' @param res_text parsed HttpResponse -#' -#' @return NULL if status code less than or equal to 201, else `stop()` -#' @noRd - -oc_check_status <- function(res_env, res_text) { - if (res_env$success()) { - return(invisible()) - } - message <- - jsonlite::fromJSON( - res_text, - simplifyVector = TRUE, - flatten = TRUE - )$status$message - stop("HTTP failure: ", res_env$status_code, "\n", message, call. = FALSE) -} - - #' Format the result string #' #' @param res_text parsed HttpResponse diff --git a/R/zzz.R b/R/zzz.R index 26c18d1..19b3a07 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -1,27 +1,17 @@ +#' @importFrom magrittr `%>%` + # We use `<<-` below to modify the package's namespace. # It doesn't modify the global environment. -# We do this to prevent build time dependencies on {memoise} and {ratelimitr}, +# We do this to prevent build time dependencies on {memoise}, # as recommended in . # Cf. for further details. -# First make sure that the functions are defined at build time -oc_get_limited <- oc_get -oc_get_memoise <- oc_get_limited +# First make sure that the function is defined at build time +oc_get_memoise <- oc_get # Then modify them at load-time # nocov start .onLoad <- function(libname, pkgname) { - # limit requests per second - oc_get_limited <<- - ratelimitr::limit_rate( - oc_get, - # rate can be changed via oc_config()/ratelimitr::UPDATE_RATE() - ratelimitr::rate( - n = 1L, - period = 1L - ) - ) - - oc_get_memoise <<- memoise::memoise(oc_get_limited) + oc_get_memoise <<- memoise::memoise(oc_get) } # nocov end diff --git a/tests/testthat/test-oc_build_url.R b/tests/testthat/test-oc_build_url.R index f527987..7cc75dc 100644 --- a/tests/testthat/test-oc_build_url.R +++ b/tests/testthat/test-oc_build_url.R @@ -1,9 +1,9 @@ -test_that("oc_build_url returns a string", { +test_that("oc_build_url returns a list", { expect_type( oc_build_url( query_par = list(placename = "Haarlem"), endpoint = "json" ), - "character" + "list" ) }) diff --git a/tests/testthat/test-oc_check_status.R b/tests/testthat/test-oc_check_status.R index 23e0bda..7bd544e 100644 --- a/tests/testthat/test-oc_check_status.R +++ b/tests/testthat/test-oc_check_status.R @@ -22,7 +22,7 @@ test_that("oc_check_status returns 400 error if request is invalid", { longitude = 0, return = "json_list" ), - "HTTP failure: 400" + "HTTP 400 Bad Request" ) # We don't send queries with nchar(query) <= 1 to the API, see .oc_process() @@ -31,7 +31,7 @@ test_that("oc_check_status returns 400 error if request is invalid", { placename = " ", return = "json_list" ), - "HTTP failure: 400" + "HTTP 400 Bad Request" ) }) @@ -42,7 +42,7 @@ test_that("oc_check_status returns 401 error if key is invalid", { withr::local_envvar(c("OPENCAGE_KEY" = "32charactersandnumbers1234567890")) expect_error( oc_reverse(latitude = 0, longitude = 0), - "HTTP failure: 401" + "HTTP 401 Unauthorized" ) }) @@ -53,7 +53,7 @@ test_that("oc_check_status returns 402 error if quota exceeded", { withr::local_envvar(c("OPENCAGE_KEY" = key_402)) expect_error( oc_reverse(latitude = 0, longitude = 0), - "HTTP failure: 402" + "HTTP 402" ) }) @@ -64,7 +64,7 @@ test_that("oc_check_status returns 403 error if key is blocked", { withr::local_envvar(c("OPENCAGE_KEY" = key_403)) expect_error( oc_reverse(latitude = 0, longitude = 0), - "HTTP failure: 403" + "HTTP 403" ) }) @@ -75,6 +75,6 @@ test_that("oc_check_status returns 429 error if rate limit is exceeded", { withr::local_envvar(c("OPENCAGE_KEY" = key_429)) expect_error( oc_reverse(latitude = 0, longitude = 0), - "HTTP failure: 429" + "HTTP 429" ) }) diff --git a/tests/testthat/test-oc_clear_cache.R b/tests/testthat/test-oc_clear_cache.R index 64581e1..657340c 100644 --- a/tests/testthat/test-oc_clear_cache.R +++ b/tests/testthat/test-oc_clear_cache.R @@ -2,11 +2,8 @@ test_that("oc_clear_cache clears cache", { skip_on_cran() skip_if_offline("httpbin.org") - # until a memoise >v.1.1 is released, we need to run oc_get_memoise() twice to - # have it really cache results - # https://github.com/ropensci/opencage/pull/87#issuecomment-573573183 - replicate(2, oc_get_memoise("https://httpbin.org/get")) - expect_true(memoise::has_cache(oc_get_memoise)("https://httpbin.org/get")) + replicate(2, oc_get_memoise()) + expect_true(memoise::has_cache(oc_get_memoise)()) oc_clear_cache() - expect_false(memoise::has_cache(oc_get_memoise)("https://httpbin.org/get")) + expect_false(memoise::has_cache(oc_get_memoise)()) }) diff --git a/tests/testthat/test-oc_config.R b/tests/testthat/test-oc_config.R index a23de06..5d673f9 100644 --- a/tests/testthat/test-oc_config.R +++ b/tests/testthat/test-oc_config.R @@ -48,25 +48,6 @@ test_that("oc_config throws error with faulty OpenCage key", { ) }) -# test rate_sec argument -------------------------------------------------- - -test_that("oc_config updates rate limit of oc_get_limit", { - # make sure there is a key present - withr::local_envvar(c("OPENCAGE_KEY" = key_200)) - - rps <- 5L - oc_config(rate_sec = rps) - expect_identical(ratelimitr::get_rates(oc_get_limited)[[1]][["n"]], rps) - - rps <- 3L - oc_config(rate_sec = rps) - expect_identical(ratelimitr::get_rates(oc_get_limited)[[1]][["n"]], rps) - - # set rate_sec back to default: 1L/sec - oc_config() - expect_identical(ratelimitr::get_rates(oc_get_limited)[[1]][["n"]], 1L) -}) - # test no_record argument ------------------------------------------------- test_that("oc_config sets no_record option", { @@ -112,3 +93,12 @@ test_that("oc_config sets show_key option", { oc_config(show_key = TRUE) expect_true(getOption("oc_show_key")) }) + +test_that("rate_sec checks/sets oc_rate_sec option", { + withr::local_envvar(c("OPENCAGE_KEY" = key_200)) + withr::local_options(oc_rate_sec = 123) + oc_config(rate_sec = 42) + expect_equal(getOption("oc_rate_sec"), 42) + + expect_error(oc_config(rate_sec = "blablabla"), "Must") +}) diff --git a/tests/testthat/test-oc_get.R b/tests/testthat/test-oc_get.R index b55f351..497cb77 100644 --- a/tests/testthat/test-oc_get.R +++ b/tests/testthat/test-oc_get.R @@ -14,7 +14,7 @@ test_that("oc_get returns a response object", { endpoint = "json" ) ), - "HttpResponse" + "httr2_response" ) }) @@ -33,7 +33,7 @@ test_that("oc_get returns a response object for Namibia NA countrycode", { endpoint = "json" ) ), - "HttpResponse" + "httr2_response" ) }) @@ -52,21 +52,10 @@ test_that("oc_get returns a response object for vector countrycode", { endpoint = "json" ) ), - "HttpResponse" + "httr2_response" ) }) -test_that("oc_get_limited is rate limited", { - skip_on_cran() - skip_if_offline("httpbin.org") - - tm <- system.time({ - replicate(2, oc_get_limited("https://httpbin.org/get")) - }) - rate <- ratelimitr::get_rates(oc_get_limited) - expect_gte(tm[["elapsed"]], rate[[1]][["period"]] / rate[[1]][["n"]]) -}) - test_that("oc_get_memoise memoises", { skip_on_cran() skip_if_offline("httpbin.org")