Merge pull request #3 from OldLipe/master

Update version 0.3.3

.Rbuildignore

@@ -3,3 +3,7 @@
 ^codecov\.yml$
 ^appveyor\.yml$
 ^\.travis\.yml$
+^\.httr-oauth$
+^_pkgdown\.yml$
+^docs$
+^pkgdown$

.gitattributes

@@ -0,0 +1,2 @@
+* text=auto
+tests/fixtures/**/* -diff

.gitignore

@@ -38,3 +38,5 @@ vignettes/*.pdf
 # R Environment Variables
 .Renviron
 .Rproj.user
+docs
+inst/doc

DESCRIPTION

@@ -1,27 +1,25 @@
 Package: rstac
 Title: R Client Library for SpatioTemporal Asset Catalog
-Version: 0.1.4
+Version: 0.3.3
 Authors@R: 
-    c(person("Brazil Data Cube Team", email = "[email protected]", 
-             role = c("cph", "cre")),
-      person("Rolf", "Simoes", email = "[email protected]",
-             role = c("aut"),
-             comment = c(ORCID = "0000-0003-0953-4132")),
-      person("Felipe", "Carvalho", email = "[email protected]", role = c("aut")))
+    c(person("Brazil Data Cube Team", email = "[email protected]", 
+             role = c("cph", "cre", "aut")))
 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.0 of the STAC specification.
+    This package supports the version 0.8.1 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
 Encoding: UTF-8
 LazyData: true
 RoxygenNote: 7.1.1
 Depends:
-    jsonlite,
-    httr
-Suggests: 
+    httr,
+    crayon
+Suggests:
     covr,
     magrittr,
     testthat,

NAMESPACE

@@ -1,22 +1,30 @@
 # Generated by roxygen2: do not edit by hand
 
+S3method(print,stac)
+S3method(print,stac_catalog)
+S3method(print,stac_collection)
+S3method(print,stac_item)
+S3method(print,stac_items)
 export(assets_download)
+export(collections)
+export(content_get_response)
+export(content_post_response)
+export(extension_query)
 export(get_request)
-export(items_assets)
+export(items)
 export(items_fetch)
 export(items_length)
 export(items_matched)
+export(params_get_request)
+export(params_post_request)
 export(post_request)
 export(stac)
-export(stac_collections)
-export(stac_items)
 export(stac_search)
+importFrom(crayon,bold)
 importFrom(httr,GET)
 importFrom(httr,POST)
 importFrom(httr,add_headers)
 importFrom(httr,content)
 importFrom(httr,http_type)
 importFrom(httr,status_code)
 importFrom(httr,write_disk)
-importFrom(jsonlite,fromJSON)
-importFrom(jsonlite,validate)

R/assets_download.R

@@ -1,12 +1,11 @@
 #' @title assets download
 #'
-#' @author Felipe Carvalho and Rolf Simoes
-#'
 #' @description The \code{assets_download} function downloads the assets
-#' provided by the STAC API
+#' provided by the STAC API.
 #'
-#' @param items       a \code{stac_items} object representing the result of
-#'  \code{/stac/search}, \code{/collections/{collectionId}/items}, or
+#' @param items       a \code{stac_items} 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.
@@ -17,27 +16,33 @@
 #' @param progress    a \code{logical} indicating if a progress bar must be
 #'  shown or not. Defaults to \code{TRUE}.
 #'
+#' @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}}
 #'
 #' @examples
 #' \dontrun{
 #'
-#' stac_search(url = "http://brazildatacube.dpi.inpe.br/bdc-stac/0.8.0",
-#'             collections = "MOD13Q1",
+#' stac("http://brazildatacube.dpi.inpe.br/bdc-stac/0.8.0") %>%
+#'  stac_search(collections = "MOD13Q1",
 #'             bbox = c(-55.16335, -4.26325, -49.31739, -1.18355),
-#'             limit = 10) %>%
-#'      get_request() %>%
-#'      assets_download(assets_name = c("thumbnail"), output_dir = "./")
+#'             limit = 2) %>%
+#'  get_request() %>%
+#'  assets_download(assets_name = c("thumbnail"), output_dir = ".")
 #' }
 #'
-#' @return The same \code{stac_items} object, but with the link of the item
-#'  pointing to the directory where the assets were saved.
+#' @return The same \code{stac_items} 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 = c(), output_dir = "./",
-                            progress = TRUE) {
+assets_download <- function(items, assets_name, output_dir = ".",
+                            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"))
@@ -97,11 +102,15 @@ assets_download <- function(items, assets_name = c(), output_dir = "./",
 #' @param output_dir  a \code{character} directory in which the images will be
 #'  saved.
 #'
+#' @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 = c(), output_dir = "./") {
+.item_download <- function(stac_item, assets_name, output_dir,
+                           headers = character()) {
 
   feat_id <- stac_item[["id"]]
   assets  <- .select_assets(stac_item[["assets"]], assets_name)
@@ -117,12 +126,12 @@ assets_download <- function(items, assets_name = c(), output_dir = "./",
                           file_ext)
 
     tryCatch({
-      # TODO: ver o config
-      httr::GET(url      = asset_href,
-                httr::write_disk(path = dest_file))
+      httr::GET(url = asset_href,
+                httr::write_disk(path = dest_file),
+                httr::add_headers(headers))
 
     }, error = function(error){
-      message(paste("\n", error, "in ", asset_href))
+      warning(paste("\n", error, "in ", asset_href))
     })
 
     if (file.exists(dest_file)) {
@@ -134,8 +143,6 @@ assets_download <- function(items, assets_name = c(), output_dir = "./",
 
 #' @title Helper function of \code{assets_download} function
 #'
-#' @author Implemented by \code{tools package}
-#'
 #' @description The \code{.file_ext} is function to extract the extension
 #' from a file
 #'
@@ -145,16 +152,14 @@ assets_download <- function(items, assets_name = c(), output_dir = "./",
 #'
 #' @noRd
 .file_ext <- function(asset_url) {
-  pos   <- regexpr("\\.([[:alnum:]]+)$", asset_url)
-  str_t <- ifelse(pos > -1L, substring(asset_url, pos + 1L), "")
 
-  return(str_t)
+  pos <- regexpr("\\.([[:alnum:]]+)$", asset_url[[1]])
+  if (pos < 0) return("")
+  return(substring(asset_url[[1]], pos + 1))
 }
 
 #' @title Helper function of \code{assets_download} function
 #'
-#' @author Felipe Carvalho
-#'
 #' @description The helper function \code{.select_assets} selects the names of
 #' each asset provided by users
 #'
@@ -167,20 +172,18 @@ assets_download <- function(items, assets_name = c(), output_dir = "./",
 #'  selected assets names.
 #'
 #' @noRd
-.select_assets <- function(assets_list = list(), assets_names = c()) {
+.select_assets <- function(assets, assets_names) {
 
   # If not provided the assets name, by default all assets will be used
-  if (length(assets_names) == 0) {
-    return(assets_list)
+  if (missing(assets_names)) {
+    return(assets)
   }
 
-  index_filter <- which(names(assets_list) %in% assets_names)
-  if (length(index_filter) == 0) {
-    warning("The provided assets names do not match with the API assets names.
-             By default, all assets will be used", call. = FALSE)
-    return(assets_list)
+  if (!all(assets_names %in% names(assets))) {
+    .error(paste("The provided assets names do not match with the API",
+                 "assets names. By default, all assets will be used"))
   }
-  assets_list <- assets_list[index_filter]
+  assets <- assets[names(assets) %in% assets_names]
 
-  return(assets_list)
+  return(assets)
 }

R/collections.R

@@ -0,0 +1,120 @@
+#' @title Endpoint functions
+#'
+#' @rdname collections
+#'
+#' @description
+#' The \code{collections} function implements the WFS3 \code{/collections}
+#' and \code{/collections/\{collectionId\}} endpoints (v0.8.1).
+#'
+#' Each endpoint retrieves specific STAC objects:
+#' \itemize{
+#'   \item \code{/collections}: Returns a list of STAC Collection published in
+#'     the STAC service
+#'   \item \code{/collections/\{collectionId\}}: Returns a single STAC
+#'     Collection object
+#' }
+#'
+#' @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.
+#'
+#' @param collection_id a \code{character} collection id to be retrieved.
+#'
+#' @seealso
+#' \code{\link{get_request}}, \code{\link{post_request}},
+#'  \code{\link{items}}
+#'
+#' @return
+#' A \code{stac} object containing all search field parameters to be provided
+#' to STAC API web service.
+#'
+#' @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.0") %>%
+#'   collections(collection_id = "MOD13Q1") %>%
+#'   get_request()
+#' }
+
+#' @export
+collections <- function(s, collection_id) {
+
+  # check s parameter
+  if (!"collections" %in% class(s))
+    .check_obj(s, expected = "stac", exclusive = TRUE)
+
+  params <- list()
+  endpoint <- "/collections"
+  if (!missing(collection_id)) {
+
+    params[["collection_id"]] <- collection_id[[1]]
+    endpoint <- paste("/collections", collection_id[[1]], sep = "/")
+  }
+
+  content <- .build_stac(url = s$url,
+                        endpoint = endpoint,
+                        params = params,
+                        subclass = "collections",
+                        base_stac = s)
+  return(content)
+}
+
+params_get_request.collections <- function(s) {
+
+  # ignore 'collection_id' param
+  s$params[["collection_id"]] <- NULL
+
+  # process stac params
+  params <- params_get_request.stac(s)
+
+  return(params)
+}
+
+params_post_request.collections <- function(s, enctype) {
+
+  # ignore 'collection_id' param
+  s$params[["collection_id"]] <- NULL
+
+  # process stac params
+  params <- params_post_request.stac(s, enctype = enctype)
+
+  return(params)
+}
+
+content_get_response.collections <- function(s, res) {
+
+  # detect expected response object class
+  content_class <- "stac_catalog"
+
+  if (!is.null(s$params[["collection_id"]]))
+    content_class <- "stac_collection"
+
+  content <- structure(
+    .check_response(res, "200", "application/json"),
+    stac = s,
+    request = list(method = "get"),
+    class = content_class)
+
+  return(content)
+}
+
+content_post_response.collections <- function(s, res, enctype) {
+
+  # detect expected response object class
+  content_class <- "stac_catalog"
+
+  if (!is.null(s$params[["collection_id"]]))
+    content_class <- "stac_collection"
+
+  content <- structure(
+    .check_response(res, "200", "application/json"),
+    stac = s,
+    request = list(method = "post", enctype = enctype),
+    class = content_class)
+
+  return(content)
+}