Skip to content

Commit d26910a

Browse files
gilbertocamaragilbertocamara
authored
Merge pull request #1176 from OldLipe/feat/dev-sits
Convert from `httr` package to `httr2` package
2 parents 1a4802c + f6be56c commit d26910a

12 files changed

+566
-30
lines changed

‎DESCRIPTION

+4-2
Original file line numberDiff line numberDiff line change
@@ -83,7 +83,7 @@ Suggests:
8383
gdalcubes (>= 0.6.0),
8484
geojsonsf,
8585
ggplot2,
86-
httr,
86+
httr2,
8787
jsonlite,
8888
kohonen (>= 3.0.11),
8989
leafem (>= 0.2.0),
@@ -112,7 +112,7 @@ Config/testthat/start-first: cube, raster, regularize, data, ml
112112
LinkingTo:
113113
Rcpp,
114114
RcppArmadillo
115-
RoxygenNote: 7.3.1
115+
RoxygenNote: 7.3.2
116116
Collate:
117117
'api_accessors.R'
118118
'api_accuracy.R'
@@ -165,6 +165,8 @@ Collate:
165165
'api_reclassify.R'
166166
'api_reduce.R'
167167
'api_regularize.R'
168+
'api_request.R'
169+
'api_request_httr2.R'
168170
'api_roi.R'
169171
'api_s2tile.R'
170172
'api_samples.R'

‎NAMESPACE

+11
Original file line numberDiff line numberDiff line change
@@ -92,6 +92,7 @@ S3method(.cube_token_generator,mpc_cube)
9292
S3method(.data_get_ts,class_cube)
9393
S3method(.data_get_ts,raster_cube)
9494
S3method(.gc_arrange_images,raster_cube)
95+
S3method(.get_request,httr2)
9596
S3method(.ml_normalize,default)
9697
S3method(.ml_normalize,torch_model)
9798
S3method(.mosaic_split_band_date,derived_cube)
@@ -134,6 +135,16 @@ S3method(.raster_yres,terra)
134135
S3method(.reg_s2tile_convert,dem_cube)
135136
S3method(.reg_s2tile_convert,grd_cube)
136137
S3method(.reg_s2tile_convert,rtc_cube)
138+
S3method(.request,httr2)
139+
S3method(.request_check_package,httr2)
140+
S3method(.request_headers,httr2)
141+
S3method(.request_query,httr2)
142+
S3method(.response_check_status,httr2)
143+
S3method(.response_content,httr2)
144+
S3method(.response_content_type,httr2)
145+
S3method(.response_is_error,httr2)
146+
S3method(.response_status,httr2)
147+
S3method(.retry_request,httr2)
137148
S3method(.samples_alloc_strata,class_cube)
138149
S3method(.samples_alloc_strata,class_vector_cube)
139150
S3method(.samples_bands,default)

‎R/api_conf.R

+12
Original file line numberDiff line numberDiff line change
@@ -963,6 +963,18 @@
963963
res <- .conf("raster_api_package")
964964
return(res)
965965
}
966+
967+
#' @title Retrieve the request package to be used
968+
#' @name .conf_request_pkg
969+
#' @keywords internal
970+
#' @noRd
971+
#' @return the package used to process http requisitions
972+
#'
973+
.conf_request_pkg <- function() {
974+
res <- .conf("request_api_package")
975+
return(res)
976+
}
977+
966978
#' @title Basic access config functions
967979
#' @noRd
968980
#'

‎R/api_cube.R

+7-7
Original file line numberDiff line numberDiff line change
@@ -1332,12 +1332,12 @@ NULL
13321332
while (is.null(res_content) && n_tries > 0) {
13331333
res_content <- tryCatch(
13341334
{
1335-
res <- httr::GET(
1335+
res <- .get_request(
13361336
url = url,
1337-
httr::add_headers("Ocp-Apim-Subscription-Key" = access_key)
1337+
headers = c("Ocp-Apim-Subscription-Key" = access_key)
13381338
)
1339-
res <- httr::stop_for_status(res)
1340-
httr::content(res, encoding = "UTF-8")
1339+
res <- .response_check_status(res)
1340+
.response_content(res)
13411341
},
13421342
error = function(e) {
13431343
return(NULL)
@@ -1352,19 +1352,19 @@ NULL
13521352
# check that token is valid
13531353
.check_that(.has(res_content))
13541354
# parse token
1355-
token_parsed <- httr::parse_url(paste0("?", res_content[["token"]]))
1355+
token_parsed <- .url_parse(paste0("?", res_content[["token"]]))
13561356
file_info[["path"]] <- purrr::map_chr(seq_along(fi_paths), function(i) {
13571357
path <- fi_paths[[i]]
13581358
if (are_local_paths[[i]]) {
13591359
return(path)
13601360
}
1361-
url_parsed <- httr::parse_url(path)
1361+
url_parsed <- .url_parse(path)
13621362
url_parsed[["query"]] <- utils::modifyList(
13631363
url_parsed[["query"]],
13641364
token_parsed[["query"]]
13651365
)
13661366
# remove the additional chars added by httr
1367-
new_path <- gsub("^://", "", httr::build_url(url_parsed))
1367+
new_path <- gsub("^://", "", .url_build(url_parsed))
13681368
new_path
13691369
})
13701370
file_info[["token_expires"]] <- strptime(

‎R/api_download.R

+4-10
Original file line numberDiff line numberDiff line change
@@ -137,16 +137,10 @@
137137
if (.file_is_local(file)) {
138138
file <- .file_path("file://", file, sep = "")
139139
}
140-
# Download file
141-
out <- httr::RETRY(
142-
verb = "GET",
143-
url = file,
144-
httr::write_disk(path = out_file, overwrite = TRUE),
145-
times = n_tries,
146-
pause_min = 10,
147-
...
148-
)
149-
if (httr::http_error(out)) {
140+
# Perform request
141+
out <- .retry_request(url = file, path = out_file, n_tries = n_tries)
142+
# Verify error
143+
if (.response_is_error(out)) {
150144
warning(paste("Error in downloading file", file))
151145
}
152146
# Return file name

‎R/api_opensearch.R

+4-4
Original file line numberDiff line numberDiff line change
@@ -116,15 +116,15 @@
116116
)
117117
query <- purrr::discard(query, is.null)
118118
# Get items from Open Search (with pagination)
119-
while(is_to_fetch_more) {
119+
while (is_to_fetch_more) {
120120
# Get raw content from Open Search API
121-
response <- httr::GET(url = collection_url, query = query)
122-
.check_int_parameter(httr::status_code(response),
121+
response <- .get_request(url = collection_url, query = query)
122+
.check_int_parameter(.response_status(response),
123123
min = 200,
124124
max = 200
125125
)
126126
# Extract data from the response
127-
page_data <- httr::content(response, "parsed")
127+
page_data <- .response_content(response)
128128
# Extract features from response data
129129
features <- page_data[["features"]]
130130
features <- .opensearch_as_stac_item(features, product_type)

‎R/api_request.R

+199
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,199 @@
1+
#' @title Supported http verbs packages
2+
#' @keywords internal
3+
#' @noRd
4+
#' @return Names of http verbs packages supported by sits
5+
.request_supported_packages <- function() {
6+
return("httr2")
7+
}
8+
9+
#' @title Check for request package availability
10+
#' @name .request_check_package
11+
#' @keywords internal
12+
#' @noRd
13+
#'
14+
#' @return name of the package.
15+
.request_check_package <- function() {
16+
pkg_class <- .conf_request_pkg()
17+
class(pkg_class) <- pkg_class
18+
19+
UseMethod(".request_check_package", pkg_class)
20+
}
21+
22+
#' @title Perform a request
23+
#' @name .request
24+
#' @keywords internal
25+
#' @noRd
26+
#' @author Felipe Carvalho, \email{felipe.carvalho@@inpe.br}
27+
#'
28+
#' @param req_obj A request object.
29+
#' @param ... Additional parameters to be passed to httr2 package
30+
#'
31+
#' @return A response object.
32+
.request <- function(req_obj, ...) {
33+
# check package
34+
pkg_class <- .request_check_package()
35+
36+
# call function
37+
UseMethod(".request", pkg_class)
38+
}
39+
40+
#' @title Retry a GET requisition
41+
#' @name .retry_request
42+
#' @keywords internal
43+
#' @noRd
44+
#' @author Felipe Carvalho, \email{felipe.carvalho@@inpe.br}
45+
#'
46+
#' @param url A character with URL.
47+
#' @param n_tries A integer with the number with tried requisitions.
48+
#' @param sleep A integer with sleep time in seconds.
49+
#' @param ... Additional parameters to be passed to httr2 package
50+
#'
51+
#' @return A response object returned by the requisition package
52+
.retry_request <- function(url, n_tries = 10, sleep = 10, ...) {
53+
# check package
54+
pkg_class <- .request_check_package()
55+
56+
# call function
57+
UseMethod(".retry_request", pkg_class)
58+
}
59+
60+
#' @title GET requistion
61+
#' @name .get_request
62+
#' @keywords internal
63+
#' @noRd
64+
#' @author Felipe Carvalho, \email{felipe.carvalho@@inpe.br}
65+
#'
66+
#' @param url A character with URL.
67+
#' @param query A named list with values to be passed in query.
68+
#' @param headers A named list with values to be passed to headers.
69+
#' @param ... Additional parameters to be passed to httr2 package
70+
#'
71+
#' @return A response object returned by the requisition package
72+
.get_request <- function(url, query = NULL, headers = NULL, ...) {
73+
# check package
74+
pkg_class <- .request_check_package()
75+
76+
# call function
77+
UseMethod(".get_request", pkg_class)
78+
}
79+
80+
#' @title Add query values into a request object
81+
#' @name .request_query
82+
#' @keywords internal
83+
#' @noRd
84+
#' @author Felipe Carvalho, \email{felipe.carvalho@@inpe.br}
85+
#'
86+
#' @param req_obj A request object.
87+
#' @param query A named list with values to be passed in query.
88+
#'
89+
#' @return A request object returned by the requisition package.
90+
.request_query <- function(req_obj, query) {
91+
# check package
92+
pkg_class <- .request_check_package()
93+
94+
# call function
95+
UseMethod(".request_query", pkg_class)
96+
}
97+
98+
#' @title Add headers values into a request object
99+
#' @name .request_headers
100+
#' @keywords internal
101+
#' @noRd
102+
#' @author Felipe Carvalho, \email{felipe.carvalho@@inpe.br}
103+
#'
104+
#' @param req_obj A request object.
105+
#' @param header A named list with values to be passed in headers.
106+
#'
107+
#' @return A request object returned by the requisition package.
108+
.request_headers <- function(req_obj, ...) {
109+
# check package
110+
pkg_class <- .request_check_package()
111+
112+
# call function
113+
UseMethod(".request_headers", pkg_class)
114+
}
115+
116+
#' @title Get response content from object
117+
#' @name .response_content
118+
#' @keywords internal
119+
#' @noRd
120+
#' @author Felipe Carvalho, \email{felipe.carvalho@@inpe.br}
121+
#'
122+
#' @param resp_obj A response object.
123+
#'
124+
#' @return A list with content values returned by the response.
125+
.response_content <- function(resp_obj) {
126+
# check package
127+
pkg_class <- .request_check_package()
128+
129+
# call function
130+
UseMethod(".response_content", pkg_class)
131+
}
132+
133+
#' @title Get response status from object
134+
#' @name .response_status
135+
#' @keywords internal
136+
#' @noRd
137+
#' @author Felipe Carvalho, \email{felipe.carvalho@@inpe.br}
138+
#'
139+
#' @param resp_obj A response object.
140+
#'
141+
#' @return A integer value returned by the response.
142+
.response_status <- function(resp_obj) {
143+
# check package
144+
pkg_class <- .request_check_package()
145+
146+
# call function
147+
UseMethod(".response_status", pkg_class)
148+
}
149+
150+
#' @title Get TRUE/FALSE response status from object
151+
#' @name .response_is_error
152+
#' @keywords internal
153+
#' @noRd
154+
#' @author Felipe Carvalho, \email{felipe.carvalho@@inpe.br}
155+
#'
156+
#' @param resp_obj A response object.
157+
#'
158+
#' @return A logical value returned by the response.
159+
.response_is_error <- function(resp_obj) {
160+
# check package
161+
pkg_class <- .request_check_package()
162+
163+
# call function
164+
UseMethod(".response_is_error", pkg_class)
165+
}
166+
167+
#' @title A response checker status from object
168+
#' @name .response_status
169+
#' @keywords internal
170+
#' @noRd
171+
#' @author Felipe Carvalho, \email{felipe.carvalho@@inpe.br}
172+
#'
173+
#' @param resp_obj A response object.
174+
#'
175+
#' @return An invisible logical or an error.
176+
.response_check_status <- function(resp_obj) {
177+
# check package
178+
pkg_class <- .request_check_package()
179+
180+
# call function
181+
UseMethod(".response_check_status", pkg_class)
182+
}
183+
184+
#' @title Get response type from object
185+
#' @name .response_content_type
186+
#' @keywords internal
187+
#' @noRd
188+
#' @author Felipe Carvalho, \email{felipe.carvalho@@inpe.br}
189+
#'
190+
#' @param resp_obj A response object.
191+
#'
192+
#' @return An character with response type.
193+
.response_content_type <- function(resp_obj) {
194+
# check package
195+
pkg_class <- .request_check_package()
196+
197+
# call function
198+
UseMethod(".response_content_type", pkg_class)
199+
}

0 commit comments

Comments
 (0)