Merge pull request #130 from OldLipe/hotfix/mpc_content_type

Hotfix in MPC vignette
brazil-data-cube · Feb 2, 2023 · 25ac997 · 25ac997
2 parents 821d2b4 + 23fc7fc
commit 25ac997
Show file tree

Hide file tree

Showing 14 changed files with 75 additions and 61 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,6 +1,6 @@
 Package: rstac
 Title: Client Library for SpatioTemporal Asset Catalog
-Version: 0.9.2-1
+Version: 0.9.2-2
 Authors@R:
     c(person("Rolf", "Simoes",
              email = "[email protected]",

diff --git a/R/collections-query.R b/R/collections-query.R
@@ -80,21 +80,22 @@ before_request.collections <- function(q) {
 
 #' @export
 after_response.collections <- function(q, res) {
-
-  content <- content_response(res, "200", "application/json")
-
+  content <- content_response(
+    res,
+    status_codes = "200",
+    content_types = "application/.*json",
+    key_message = c("message", "description", "detail")
+  )
   RSTACDocument(content = content, q = q, subclass = "STACCollectionList")
 }
 
 #' @export
 endpoint.collection_id <- function(q) {
-
   return(paste("/collections", q$params[["collection_id"]], sep = "/"))
 }
 
 #' @export
 before_request.collection_id <- function(q) {
-
   check_query_verb(q, verbs = c("GET", "POST"))
 
   # don't send 'collection_id' in url's query string or content body
@@ -105,9 +106,12 @@ before_request.collection_id <- function(q) {
 
 #' @export
 after_response.collection_id <- function(q, res) {
-
-  content <- content_response(res, "200", "application/json")
-
+  content <- content_response(
+    res,
+    status_codes = "200",
+    content_types = "application/.*json",
+    key_message = c("message", "description", "detail")
+  )
   RSTACDocument(content = content, q = q,
                 subclass = c("STACCollection", "STACCatalog"))
 }
diff --git a/R/conformance-query.R b/R/conformance-query.R
@@ -44,7 +44,10 @@ before_request.conformance <- function(q) {
 #' @export
 after_response.conformance <- function(q, res) {
   content <- content_response(
-    res, "200", c("application/geo+json", "application/json")
+    res,
+    status_codes = "200",
+    content_types = "application/.*json",
+    key_message = c("message", "description", "detail")
   )
   RSTACDocument(content = content, q = q, subclass = "Conformance")
 }
diff --git a/R/extensions.R b/R/extensions.R
@@ -151,20 +151,16 @@ parse_params <- function(q, params) {
 #' @return
 #' The `content_response()` function returns a `list` data structure
 #' representing the JSON file received in HTTP response
-content_response <- function(res,
-                             status_codes,
-                             content_types,
-                             key_message = c("message", "description",
-                                             "detail")) {
-
+content_response <- function(res, status_codes, content_types, key_message) {
   # convert any json extension
-  content_type <- httr::http_type(res)
-  if (grepl("application/.*json", content_type))
-    content_type <- "application/json"
+  if (!grepl(content_types, httr::http_type(res))) {
+    .error("HTTP content type response '%s' not defined for this operation.",
+           httr::http_type(res))
+  }
 
   # parse content
   content <- httr::content(res,
-                           type = content_type,
+                           type = "application/json",
                            encoding = "UTF-8",
                            simplifyVector = TRUE,
                            simplifyDataFrame = FALSE,
@@ -182,11 +178,6 @@ content_response <- function(res,
     .error("HTTP status '%s'. %s", status_code, message)
   }
 
-  # test for allowed content types
-  if (!httr::http_type(res) %in% content_types)
-    .error("HTTP content type response '%s' not defined for this operation.",
-           httr::http_type(res))
-
   return(content)
 }
 

diff --git a/R/items-query.R b/R/items-query.R
@@ -154,10 +154,11 @@ before_request.items <- function(q) {
 
 #' @export
 after_response.items <- function(q, res) {
-
   content <- content_response(
-    res, status_codes = "200", content_types = c("application/geo+json",
-                                                 "application/json")
+    res,
+    status_codes = "200",
+    content_types = "application/.*json",
+    key_message = c("message", "description", "detail")
   )
   if ("features" %in% names(content)) {
     content$features <- lapply(content$features, RSTACDocument,
@@ -187,9 +188,11 @@ before_request.item_id <- function(q) {
 
 #' @export
 after_response.item_id <- function(q, res) {
-
-  content <- content_response(res, "200", c("application/geo+json",
-                                            "application/json"))
-
+  content <- content_response(
+    res,
+    status_codes = "200",
+    content_types = "application/.*json",
+    key_message = c("message", "description", "detail")
+  )
   RSTACDocument(content = content, q = q, subclass = "STACItem")
 }
diff --git a/R/query-funs.R b/R/query-funs.R
@@ -57,7 +57,12 @@ stac_version.RSTACQuery <- function(x, ...) {
     url = make_url(x$base_url, endpoint = "/"), ...
   )
   if (!is.null(res)) {
-    content <- content_response(res, "200", "application/json")
+    content <- content_response(
+      res,
+      status_codes = "200",
+      content_types = "application/.*json",
+      key_message = c("message", "description", "detail")
+    )
     version <- content[["stac_version"]]
   }
 
@@ -67,7 +72,12 @@ stac_version.RSTACQuery <- function(x, ...) {
       url = make_url(x$base_url, endpoint = "/stac"), ..., error_msg = NULL
     )
     if (!is.null(res)) {
-      content <- content_response(res, "200", "application/json")
+      content <- content_response(
+        res,
+        status_codes = "200",
+        content_types = "application/.*json",
+        key_message = c("message", "description", "detail")
+      )
       version <- content[["stac_version"]]
     }
   }

diff --git a/R/queryables-query.R b/R/queryables-query.R
@@ -60,7 +60,10 @@ before_request.queryables <- function(q) {
 #' @export
 after_response.queryables <- function(q, res) {
   content <- content_response(
-    res, "200", c("application/geo+json", "application/json")
+    res,
+    status_codes = "200",
+    content_types = "application/.*json",
+    key_message = c("message", "description", "detail")
   )
   RSTACDocument(content = content, q = q, subclass = "Queryables")
 }
diff --git a/R/signatures.R b/R/signatures.R
@@ -217,11 +217,11 @@ sign_planetary_computer <- function(..., headers = NULL, token_url = NULL) {
       httr::add_headers(.headers = headers), ...
     )
     res_content <- content_response(
-      res = res,
+      res,
       status_codes = "200",
-      content_types = "application/json"
+      content_types = "application/.*json",
+      key_message = c("message", "description", "detail")
     )
-
     token[[acc]][[cnt]] <<- parse_token(res_content)
   }
 

diff --git a/R/stac-query.R b/R/stac-query.R
@@ -63,6 +63,11 @@ before_request.stac <- function(q) {
 
 #' @export
 after_response.stac <- function(q, res) {
-  content <- content_response(res, "200", "application/json")
+  content <- content_response(
+    res,
+    status_codes = "200",
+    content_types = "application/.*json",
+    key_message = c("message", "description", "detail")
+  )
   RSTACDocument(content = content, q = q, subclass = "STACCatalog")
 }
diff --git a/README.Rmd b/README.Rmd
@@ -85,7 +85,7 @@ tibble::tribble(
 These functions can be used to retrieve information from a STAC API service.
 The code below creates a `stac` object and list the available collections of 
 the STAC API of the [Brazil Data Cube](http://www.brazildatacube.org/en/home-page-2/) project of 
-the Brazilian National Space Research Institute [INPE](https://www.gov.br/inpe/pt-br/).
+the Brazilian National Space Research Institute (INPE).
 
 ```{R stac-obj, echo=TRUE}
 s_obj <- stac("https://brazildatacube.dpi.inpe.br/stac/")

diff --git a/README.md b/README.md
@@ -77,8 +77,7 @@ These functions can be used to retrieve information from a STAC API
 service. The code below creates a `stac` object and list the available
 collections of the STAC API of the [Brazil Data
 Cube](http://www.brazildatacube.org/en/home-page-2/) project of the
-Brazilian National Space Research Institute
-[INPE](https://www.gov.br/inpe/pt-br/).
+Brazilian National Space Research Institute (INPE).
 
 ``` r
 s_obj <- stac("https://brazildatacube.dpi.inpe.br/stac/")

diff --git a/inst/CITATION b/inst/CITATION
@@ -1,17 +1,16 @@
-citHeader("To cite rstac in publications use:")
-
-citEntry(entry = "InProceedings",
+bibentry(bibtype = "InProceedings",
          title        = "Rstac: An R Package to Access Spatiotemporal Asset Catalog Satellite Imagery",
-         author       = personList(as.person("Rolf Simoes"),
-                                   as.person("Felipe Souza"),
-                                   as.person("Matheus Zaglia"),
-                                   as.person("Gilberto Ribeiro Queiroz"),
-                                   as.person("Rafael Santos"),
-                                   as.person("Karine Ferreira")),
+         author       = c(as.person("Rolf Simoes"),
+                          as.person("Felipe Souza"),
+                          as.person("Matheus Zaglia"),
+                          as.person("Gilberto Ribeiro Queiroz"),
+                          as.person("Rafael Santos"),
+                          as.person("Karine Ferreira")),
          booktitle    = "2021 IEEE International Geoscience and Remote Sensing Symposium IGARSS",
          year         = "2021",
          pages        = "7674-7677",
          doi          = "10.1109/IGARSS47720.2021.9553518",
+         header = "To cite rstac in publications use:",
          textVersion  =
              paste("R. Simoes, F. C. de Souza, M. Zaglia, G. R. de Queiroz,",
                    "R. D. C. dos Santos and K. R. Ferreira, \"Rstac: An R",

diff --git a/man/extensions.Rd b/man/extensions.Rd
diff --git a/tests/testthat/test-internals.R b/tests/testthat/test-internals.R
@@ -66,13 +66,15 @@ testthat::test_that("internals response", {
 
     testthat::expect_error(
       content_response(res = bdc_catalog,
-                       status_codes = c(300),
-                       content_types = "application/json")
+                       status_codes = 300,
+                       content_types = "application/.*json",
+                       key_message = c("message", "description", "detail"))
     )
 
     testthat::expect_error(
       content_response(res = bdc_wrong_path,
-                       status_codes = c(300),
-                       content_types = "application/json")
+                       status_codes = 300,
+                       content_types = "application/.*json",
+                       key_message = c("message", "description", "detail"))
     )
 })