From 002898ef30540484c13948fccac5b607df17a123 Mon Sep 17 00:00:00 2001 From: James Lamb Date: Sun, 19 Apr 2020 13:37:26 -0500 Subject: [PATCH] added retry logic for all HTTP requests --- NAMESPACE | 3 +-- R/features.R | 4 ++-- R/getbb.R | 2 +- R/osmdata-package.R | 2 +- R/overpass-query.R | 4 ++-- tests/testthat/test-features.R | 6 +++--- tests/testthat/test-getbb.R | 6 +++--- tests/testthat/test-osmdata.R | 4 ++-- 8 files changed, 15 insertions(+), 16 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 8233b8fa..1028bfb4 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -32,8 +32,7 @@ export(unname_osmdata_sf) import(sp) importFrom(Rcpp,evalCpp) importFrom(curl,has_internet) -importFrom(httr,GET) -importFrom(httr,POST) +importFrom(httr,RETRY) importFrom(httr,content) importFrom(httr,stop_for_status) importFrom(jsonlite,fromJSON) diff --git a/R/features.R b/R/features.R index a30c9aee..b17c2c70 100644 --- a/R/features.R +++ b/R/features.R @@ -16,7 +16,7 @@ available_features <- function() { url_ftrs <- "https://wiki.openstreetmap.org/wiki/Map_Features" if (curl::has_internet ()) { - pg <- xml2::read_html (httr::GET (url_ftrs)) + pg <- xml2::read_html (httr::RETRY ("GET", url_ftrs, terminate_on = c(403, 404))) keys <- xml2::xml_attr (rvest::html_nodes (pg, "a[href^='/wiki/Key']"), #nolint "title") unique (sort (gsub ("^Key:", "", keys))) @@ -48,7 +48,7 @@ available_tags <- function(feature) { if (missing (feature)) stop ("Please specify feature") - pg <- xml2::read_html (httr::GET (url_ftrs)) + pg <- xml2::read_html (httr::RETRY ("GET", url_ftrs, terminate_on = c(403, 404))) #tags <- xml2::xml_attr (rvest::html_nodes (pg, # sprintf("a[title^='Tag:%s']", feature)), "title") #unique (sort (gsub (sprintf ("Tag:%s=", feature), "", diff --git a/R/getbb.R b/R/getbb.R index 8fed2078..b0968798 100644 --- a/R/getbb.R +++ b/R/getbb.R @@ -177,7 +177,7 @@ getbb <- function(place_name, if (!silent) print(q_url) - #res <- httr::POST(base_url, query = query, httr::timeout (100)) + #res <- httr::RETRY("POST", base_url, query = query, httr::timeout (100)) res <- httr::RETRY("POST", q_url, times = 10) txt <- httr::content(res, as = "text", encoding = "UTF-8", type = "application/xml") diff --git a/R/osmdata-package.R b/R/osmdata-package.R index b241a9fc..ae4dd6f3 100644 --- a/R/osmdata-package.R +++ b/R/osmdata-package.R @@ -48,7 +48,7 @@ #' @author Mark Padgham, Bob Rudis, Robin Lovelace, Maëlle Salmon #' @import sp #' @importFrom curl has_internet -#' @importFrom httr content GET POST stop_for_status +#' @importFrom httr content RETRY stop_for_status #' @importFrom jsonlite fromJSON #' @importFrom lubridate force_tz ymd_hms wday day month year #' @importFrom magrittr %>% diff --git a/R/overpass-query.R b/R/overpass-query.R index d27089b3..d1845c51 100644 --- a/R/overpass-query.R +++ b/R/overpass-query.R @@ -175,7 +175,7 @@ overpass_query <- function (query, quiet = FALSE, wait = TRUE, pad_wait = 5, units = 'secs'))) + pad_wait message (sprintf ('Waiting %s seconds', wait)) Sys.sleep (wait) - res <- httr::POST (overpass_url, body = query) + res <- httr::RETRY ("POST", overpass_url, body = query, terminate_on = c(403, 404)) } else { stop ('Overpass query unavailable', call. = FALSE) } @@ -190,7 +190,7 @@ overpass_query <- function (query, quiet = FALSE, wait = TRUE, pad_wait = 5, else doc <- httr::content (res, as = 'text', encoding = encoding, type = "application/xml") - # TODO: Just return the direct httr::POST result here and convert in the + # TODO: Just return the direct httr::RETRY() result here and convert in the # subsequent functions (`osmdata_xml/csv/sp/sf`)? check_for_error (doc) diff --git a/tests/testthat/test-features.R b/tests/testthat/test-features.R index de1a8588..aee4d4ee 100644 --- a/tests/testthat/test-features.R +++ b/tests/testthat/test-features.R @@ -26,7 +26,7 @@ if (get_local) cfm_output_af <<- returnValue() } ) - res <- httr::GET (url_ftrs) + res <- httr::RETRY ("GET", url_ftrs, terminate_on = c(403, 404)) untrace (curl::curl_fetch_memory) save (cfm_output_af, file = "../cfm_output_af.rda") } @@ -42,7 +42,7 @@ test_that ("available_features", { if (!test_all) { load ("../cfm_output_af.rda") - stub (available_features, 'httr::GET', function (x) + stub (available_features, 'httr::RETRY', function (...) cfm_output_af$content ) } expect_is (available_features (), "character") @@ -57,7 +57,7 @@ test_that ("available_tags", { if (!test_all) { load ("../cfm_output_af.rda") - stub (available_tags, 'httr::GET', function (x) + stub (available_tags, 'httr::RETRY', function (...) cfm_output_af$content ) } expect_that (length (available_tags ("junk")), equals (0)) diff --git a/tests/testthat/test-getbb.R b/tests/testthat/test-getbb.R index 7dce09fb..8ae7e39f 100644 --- a/tests/testthat/test-getbb.R +++ b/tests/testthat/test-getbb.R @@ -25,7 +25,7 @@ if (get_local) { exit = function() { cfm_output <<- returnValue() }) - res <- httr::GET (the_url) + res <- httr::RETRY ("POST", the_url, terminate_on = c(403, 404)) class (cfm_output) <- 'response' untrace (curl::curl_fetch_memory) return (cfm_output) @@ -58,7 +58,7 @@ test_that ('getbb-place_name', { if (!test_all) { load("../cfm_output_bb1.rda") - stub (getbb, 'httr::GET', function (x) cfm_output_bb ) + stub (getbb, 'httr::RETRY', function (...) cfm_output_bb ) } res <- getbb (place_name = "Salzburg") expect_is (res, "matrix") @@ -86,7 +86,7 @@ test_that ('getbb-polygon', { if (!test_all) { load("../cfm_output_bb2.rda") - stub (getbb, 'httr::GET', function (x) cfm_output_bb ) + stub (getbb, 'httr::RETRY', function (...) cfm_output_bb ) } res <- getbb (place_name = "Salzburg", format_out = "polygon") expect_is (res, "list") diff --git a/tests/testthat/test-osmdata.R b/tests/testthat/test-osmdata.R index a6216065..57fe49a3 100644 --- a/tests/testthat/test-osmdata.R +++ b/tests/testthat/test-osmdata.R @@ -18,7 +18,7 @@ get_local <- FALSE if (get_local) { # This test needs to return the results of overpass_query(), not the direct - # httr::POST call, so can't be grabbed with curl_fetch_memory + # httr::RETRY call, so can't be grabbed with curl_fetch_memory qry <- opq (bbox = c(-0.118, 51.514, -0.115, 51.517)) qry <- add_osm_feature (qry, key = 'highway') overpass_query_result <- overpass_query (opq_string (qry), @@ -33,7 +33,7 @@ if (get_local) exit = function() { cfm_output_overpass_query <<- returnValue() }) - res <- httr::POST (base_url, body = opq_string (qry)) + res <- httr::RETRY ("POST", base_url, body = opq_string (qry), terminate_on = c(403, 404)) untrace (curl::curl_fetch_memory) class (cfm_output_overpass_query) <- 'response' save (cfm_output_overpass_query, file = '../cfm_output_overpass_query.rda')