Merge pull request #5 from OldLipe/b-0.9.0

rstac version 0.9.0

DESCRIPTION

@@ -1,15 +1,18 @@
 Package: rstac
 Title: R Client Library for SpatioTemporal Asset Catalog
-Version: 0.3.3
+Version: 0.9.0
 Authors@R: 
-    c(person("Brazil Data Cube Team", email = "[email protected]", 
-             role = c("cph", "cre", "aut")))
+    c(person("Brazil Data Cube Team", 
+            email = "[email protected]",
+            role = c("cre", "aut")),
+    person(given = "National Institute for Space Research (INPE)", 
+            role = c("cph")))
 Description: 
     R client library for STAC is a R package that interfaces STAC API 
     endpoints.
     For more information about the STAC specification, please consult the
     specification page (<http://stacspec.org>).
-    This package supports the version 0.8.1 of the STAC specification.
+    This package supports the version 0.8.1 or higher of the STAC specification.
 License: MIT + file LICENSE
 URL: https://github.com/brazil-data-cube/rstac
 BugReports: https://github.com/brazil-data-cube/rstac/issues

NAMESPACE

@@ -3,8 +3,9 @@
 S3method(print,stac)
 S3method(print,stac_catalog)
 S3method(print,stac_collection)
+S3method(print,stac_collection_list)
 S3method(print,stac_item)
-S3method(print,stac_items)
+S3method(print,stac_item_collection)
 export(assets_download)
 export(collections)
 export(content_get_response)

R/assets_download.R

@@ -3,49 +3,51 @@
 #' @description The \code{assets_download} function downloads the assets
 #' provided by the STAC API.
 #'
-#' @param items       a \code{stac_items} or \code{stac_item} object
+#' @param items       a \code{stac_item_collection} or \code{stac_item} object
 #'  representing the result of \code{/stac/search},
 #'  \code{/collections/{collectionId}/items} or
 #'  \code{/collections/{collectionId}/items/{itemId}} endpoints.
 #'
 #' @param assets_name a \code{character} with the assets names to be filtered.
 #'
-#' @param output_dir  a \code{character} directory in which the images will be
+#' @param output_dir  a \code{character} directory in which the assets will be
 #'  saved.
 #'
 #' @param progress    a \code{logical} indicating if a progress bar must be
 #'  shown or not. Defaults to \code{TRUE}.
 #'
+#' @param ...        other params to be passed to \link[httr]{GET} method.
+#'
 #' @param headers    a \code{character} of named arguments to be passed as
 #' HTTP request headers.
 #'
 #' @seealso
-#' \code{\link{stac_search}}, \code{\link{get_request}},
-#'  \code{\link{post_request}}
+#' \code{\link{stac_search}}, \code{\link{items}}, \code{\link{get_request}}
 #'
 #' @examples
 #' \dontrun{
 #'
-#' stac("http://brazildatacube.dpi.inpe.br/bdc-stac/0.8.0") %>%
+#' stac("http://brazildatacube.dpi.inpe.br/bdc-stac/0.8.1",
+#'      force_version = "0.8.1") %>%
 #'  stac_search(collections = "MOD13Q1",
 #'             bbox = c(-55.16335, -4.26325, -49.31739, -1.18355),
 #'             limit = 2) %>%
 #'  get_request() %>%
 #'  assets_download(assets_name = c("thumbnail"), output_dir = ".")
 #' }
 #'
-#' @return The same \code{stac_items} or \code{stac_item} object, with the
+#' @return The same \code{stac_item_collection} or \code{stac_item} object, with the
 #' link of the item pointing to the directory where the assets were saved.
 #'
 #' @export
 assets_download <- function(items, assets_name, output_dir = ".",
-                            progress = TRUE, headers = character()) {
+                            progress = TRUE, ..., headers = character()) {
 
   # TODO: add parameter to cut out the assets if provided - keep_assets
   # TODO: warning if the value of item_length is different of item_matched
 
   #check the object class
-  .check_obj(items, expected = c("stac_items", "stac_item"))
+  .check_obj(items, expected = c("stac_item_collection", "stac_item"))
 
   # check output dir
   if (!dir.exists(output_dir))
@@ -55,7 +57,8 @@ assets_download <- function(items, assets_name, output_dir = ".",
   if (inherits(items, "stac_item")) {
     items <- .item_download(stac_item   = items,
                             assets_name = assets_name,
-                            output_dir  = output_dir)
+                            output_dir  = output_dir,
+                            ..., headers = headers)
 
     return(items)
   }
@@ -78,7 +81,8 @@ assets_download <- function(items, assets_name, output_dir = ".",
       utils::setTxtProgressBar(pb, i)
 
     items$features[[i]] <- .item_download(items$features[[i]],
-                                          assets_name, output_dir)
+                                          assets_name, output_dir,
+                                          ..., headers = headers)
   }
   # close progress bar
   if (progress)
@@ -102,14 +106,17 @@ assets_download <- function(items, assets_name, output_dir = ".",
 #' @param output_dir  a \code{character} directory in which the images will be
 #'  saved.
 #'
+#' @param ...        other params to be passed to \link[httr]{GET} or
+#' \link[httr]{POST} methods
+#'
 #' @param headers    a \code{character} of named arguments to be passed as
 #' HTTP request headers.
 #'
 #' @return The same \code{stac_item} object, but with the link of the item
 #'  pointing to the directory where the assets were saved.
 #'
 #' @noRd
-.item_download <- function(stac_item, assets_name, output_dir,
+.item_download <- function(stac_item, assets_name, output_dir, ...,
                            headers = character()) {
 
   feat_id <- stac_item[["id"]]
@@ -128,7 +135,7 @@ assets_download <- function(items, assets_name, output_dir = ".",
     tryCatch({
       httr::GET(url = asset_href,
                 httr::write_disk(path = dest_file),
-                httr::add_headers(headers))
+                httr::add_headers(headers), ...)
 
     }, error = function(error){
       warning(paste("\n", error, "in ", asset_href))

R/collections.R

@@ -4,7 +4,8 @@
 #'
 #' @description
 #' The \code{collections} function implements the WFS3 \code{/collections}
-#' and \code{/collections/\{collectionId\}} endpoints (v0.8.1).
+#'  and \code{/collections/\{collectionId\}} endpoints
+#'  (v0.8.0, v0.8.1 and v0.9.0).
 #'
 #' Each endpoint retrieves specific STAC objects:
 #' \itemize{
@@ -15,8 +16,7 @@
 #' }
 #'
 #' @param s             a \code{stac} object expressing a STAC search criteria
-#' provided by \code{stac}, \code{stac_search}, \code{stac_collections},
-#' or \code{stac_items} functions.
+#' provided by \code{stac} or \code{collections} functions.
 #'
 #' @param collection_id a \code{character} collection id to be retrieved.
 #'
@@ -31,13 +31,15 @@
 #' @examples
 #' \dontrun{
 #'
-#' stac("http://brazildatacube.dpi.inpe.br/bdc-stac/0.8.0") %>%
-#'   collections() %>%
-#'   get_request()
+#' stac("http://brazildatacube.dpi.inpe.br/bdc-stac/0.8.1",
+#'     force_version = "0.8.1") %>%
+#'  collections() %>%
+#'  get_request()
 #'
-#' stac("http://brazildatacube.dpi.inpe.br/bdc-stac/0.8.0") %>%
-#'   collections(collection_id = "MOD13Q1") %>%
-#'   get_request()
+#' stac("http://brazildatacube.dpi.inpe.br/bdc-stac/0.8.1",
+#'       force_version = "0.8.1") %>%
+#' collections(collection_id = "MOD13Q1") %>%
+#' get_request()
 #' }
 
 #' @export
@@ -48,18 +50,23 @@ collections <- function(s, collection_id) {
     .check_obj(s, expected = "stac", exclusive = TRUE)
 
   params <- list()
-  endpoint <- "/collections"
+  endpoint <- .OAFeat_collections_endpoint()
   if (!missing(collection_id)) {
 
-    params[["collection_id"]] <- collection_id[[1]]
-    endpoint <- paste("/collections", collection_id[[1]], sep = "/")
+    if (length(collection_id) != 1)
+      .error("Parameter `collection_id` must be a single value.")
+
+    params[["collection_id"]] <- collection_id
+
+    endpoint <- .OAFeat_collections_endpoint(
+      collection_id = params[["collection_id"]])
   }
 
   content <- .build_stac(url = s$url,
-                        endpoint = endpoint,
-                        params = params,
-                        subclass = "collections",
-                        base_stac = s)
+                         endpoint = endpoint,
+                         params = params,
+                         subclass = "collections",
+                         base_stac = s)
   return(content)
 }
 
@@ -88,7 +95,7 @@ params_post_request.collections <- function(s, enctype) {
 content_get_response.collections <- function(s, res) {
 
   # detect expected response object class
-  content_class <- "stac_catalog"
+  content_class <- "stac_collection_list"
 
   if (!is.null(s$params[["collection_id"]]))
     content_class <- "stac_collection"
@@ -105,7 +112,7 @@ content_get_response.collections <- function(s, res) {
 content_post_response.collections <- function(s, res, enctype) {
 
   # detect expected response object class
-  content_class <- "stac_catalog"
+  content_class <- "stac_list_catalog"
 
   if (!is.null(s$params[["collection_id"]]))
     content_class <- "stac_collection"

R/endpoints.R

@@ -0,0 +1,67 @@
+#' @title endpoints functions
+#'
+#' @param collection_id a \code{character} collection id to be retrieved.
+#'
+#' @return a \code{character} with the STAC endpoint of the required version.
+#'
+#' @noRd
+.OAFeat_collections_endpoint <- function(collection_id) {
+
+  endpoint <- "/collections"
+
+  if (!missing(collection_id))
+    endpoint <- paste(endpoint, collection_id, sep = "/")
+
+  return(endpoint)
+}
+
+#' @title endpoints functions
+#'
+#' @param collection_id a \code{character} collection id to be retrieved.
+#'
+#' @param feature_id  a \code{character} with item id to be fetched.
+#' Only works if the \code{collection_id} is informed. This is equivalent to
+#' the endpoint \code{/collections/\{collectionId\}/items/\{itemId\}}.
+#'
+#' @return a \code{character} with the STAC endpoint of the required version.
+#'
+#' @noRd
+.OAFeat_items_endpoint <- function(collection_id, feature_id) {
+
+  endpoint <- paste("/collections", collection_id, "items", sep = "/")
+
+  if (!missing(feature_id))
+    endpoint <- paste(endpoint, feature_id, sep = "/")
+
+  return(endpoint)
+}
+
+#' @title endpoints functions
+#'
+#' @param version    a \code{character} with the STAC version.
+#'
+#' @return a \code{character} with the STAC endpoint of the required version.
+#'
+#' @noRd
+.stac_landpage_endpoint <- function(version) {
+
+  if (version < "0.9.0")
+    return("/stac")
+
+  return("/") # version >= "0.9.0"
+}
+
+#' @title endpoints functions
+#'
+#' @param version    a \code{character} with the STAC version.
+#'
+#' @return a \code{character} with the STAC endpoint of the required version.
+#'
+#' @noRd
+.stac_search_endpoint <- function(version) {
+
+  if (version < "0.9.0")
+    return("/stac/search")
+
+  return("/search") # version >= "0.9.0"
+}

R/ext_query.R

@@ -62,7 +62,8 @@
 #' @examples
 #' \dontrun{
 #' # filter items that has 'bdc:tile' property equal to '022024'
-#' stac(url = "http://brazildatacube.dpi.inpe.br/bdc-stac/0.8.0") %>%
+#' stac(url = "http://brazildatacube.dpi.inpe.br/bdc-stac/0.8.1",
+#'      force_version = "0.8.1") %>%
 #'   stac_search(collections = "CB4_64_16D_STK") %>%
 #'   extension_query("bdc:tile" == "022024") %>%
 #'   post_request()