Merge pull request #1179 from OldLipe/feat/dev-sits

Fix request bug in `.cube_token_generator`  and update `rstac` version in DESCRIPTION

DESCRIPTION

@@ -55,7 +55,7 @@ Imports:
     parallel (>= 4.0.5),
     purrr (>= 1.0.2),
     Rcpp,
-    rstac (>= 1.0.0),
+    rstac (>= 1.0.1),
     sf (>= 1.0-12),
     showtext,
     sysfonts,

R/api_cube.R

@@ -1334,7 +1334,7 @@ NULL
             {
                 res <- .get_request(
                     url = url,
-                    headers = c("Ocp-Apim-Subscription-Key" = access_key)
+                    headers = list("Ocp-Apim-Subscription-Key" = access_key)
                 )
                 res <- .response_check_status(res)
                 .response_content(res)

R/api_download.R

@@ -138,7 +138,11 @@
             file <- .file_path("file://", file, sep = "")
         }
         # Perform request
-        out <- .retry_request(url = file, path = out_file, n_tries = n_tries)
+        out <- .retry_request(
+            url = file,
+            path = out_file,
+            n_tries = n_tries
+        )
         # Verify error
         if (.response_is_error(out)) {
             warning(paste("Error in downloading file", file))

R/api_request.R

@@ -105,7 +105,7 @@
 #' @param header   A named list with values to be passed in headers.
 #'
 #' @return A request object returned by the requisition package.
-.request_headers <- function(req_obj, ...) {
+.request_headers <- function(req_obj, header) {
     # check package
     pkg_class <- .request_check_package()
 

R/api_request_httr2.R

@@ -29,7 +29,7 @@
 #' @return A httr2 response object.
 #' @export
 .request.httr2 <-  function(req_obj, ...) {
-    httr2::req_perform(req_obj, verbosity = 0, ...)
+    httr2::req_perform(req_obj, ...)
 }
 
 #' @title Retry a GET requisition with httr2
@@ -66,18 +66,24 @@
 #' @param url      A character with URL.
 #' @param query    A named list with values to be passed in query.
 #' @param headers  A named list with values to be passed to headers.
-#' @param ...      Additional parameters to be passed to httr2 package
+#' @param ...      Additional parameters to be passed to httr2 package.
+#' @param quiet    Quiet requisition? Default is TRUE.
 #'
 #' @return A httr2 response object.
 #' @export
-.get_request.httr2 <- function(url, query = NULL, headers = NULL, ...) {
+.get_request.httr2 <- function(url, query = NULL, headers = NULL, ...,
+                               quiet = TRUE) {
     req_obj <- httr2::request(url)
     # Prepare query
-    req_obj <- .prepare(query, .request_query(req_obj, query), req_obj)
+    req_obj <- .prepare_null(query, .request_query(req_obj, query), req_obj)
     # Prepare headers
-    req_obj <- .prepare(headers, .request_headers(req_obj, headers), req_obj)
+    req_obj <- .prepare_null(
+        headers, .request_headers(req_obj, headers), req_obj
+    )
+    # Quiet requisition? zero verbosity means quiet request
+    quiet <- .prepare_lgl(quiet, 0, 1)
     # Perform request
-    .request(req_obj, ...)
+    .request(req_obj, verbosity = quiet, ...)
 }
 
 #' @title Add query values into a request httr2 object
@@ -92,6 +98,9 @@
 #' @return A httr2 request object.
 #' @export
 .request_query.httr2 <- function(req_obj, query) {
+    # Force to a named list
+    query <- as.list(query)
+    # Append query into requisition
     httr2::req_url_query(req_obj, !!!query)
 }
 
@@ -106,7 +115,10 @@
 #'
 #' @return A httr2 request object.
 #' @export
-.request_headers.httr2 <- function(req_obj, header, ...) {
+.request_headers.httr2 <- function(req_obj, header) {
+    # Force to a named list
+    header <- as.list(header)
+    # Create a default header
     default_value <- list(
         "User-Agent" =  "SITS-R-PACKAGE (github.com/e-sensing/sits)",
         "Accept" =  "*/*",
@@ -117,7 +129,7 @@
         x = header,
         val = default_value
     )
-
+    # Append headers into requisition
     httr2::req_headers(req_obj, !!!header_values)
 }
 

R/api_utils.R

@@ -286,13 +286,26 @@ NULL
 #' @param prepare   Prepared value
 #' @param default   Default value
 #' @returns Prepared value if x is not NULL
-.prepare <- function(x, prepare, default) {
+.prepare_null <- function(x, prepare, default) {
     if (!all(is.na(x)) && .has(x)) {
         return(prepare)
     }
     return(default)
 }
 
+#' @title Return prepared value if X is TRUE
+#' @noRd
+#' @param x         R object
+#' @param prepare   Prepared value
+#' @param default   Default value
+#' @returns Prepared value if x is TRUE
+.prepare_lgl <- function(x, prepare, default) {
+    if (.has(x) && x) {
+        return(prepare)
+    }
+    return(default)
+}
+
 #' @title Create a tibble from a vector
 #' @noRd
 #' @param ...   Generic entries