diff --git a/.Rbuildignore b/.Rbuildignore index 3bb3d729..b2675245 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -12,3 +12,5 @@ ^doc$ ^Meta$ ^\.github$ +^revdep$ +^cran-comments\.md$ diff --git a/.gitignore b/.gitignore index bbaa6dd3..ad486f19 100644 --- a/.gitignore +++ b/.gitignore @@ -42,3 +42,5 @@ docs inst/doc /doc/ /Meta/ +/revdep/ +cran-comments.md diff --git a/DESCRIPTION b/DESCRIPTION index 01565a7b..494df321 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: rstac Title: Client Library for SpatioTemporal Asset Catalog -Version: 0.9.2-5 +Version: 1.0.0 Authors@R: c(person("Rolf", "Simoes", email = "rolfsimoes@gmail.com", @@ -22,32 +22,23 @@ License: MIT + file LICENSE URL: https://brazil-data-cube.github.io/rstac/ BugReports: https://github.com/brazil-data-cube/rstac/issues Encoding: UTF-8 -RoxygenNote: 7.2.3 +RoxygenNote: 7.3.1 Depends: R (>= 3.5) Imports: - httr, - crayon, utils, + httr, jsonlite, - lifecycle, - magrittr -Suggests: - testthat, + crayon, sf, - knitr, - rmarkdown, png, jpeg, - tibble, - dplyr, - purrr, - slider, - leaflet, - tmap, - stars, - ggplot2, - geojsonsf + grid, + magrittr +Suggests: + lifecycle, + testthat, + knitr Collate: 'cql2-expr-funs.R' 'cql2-types.R' @@ -65,10 +56,11 @@ Collate: 'conformance-query.R' 'collections-query.R' 'deprec-funs.R' - 'document-funs.R' + 'doc-funs.R' 'ext_filter.R' 'ext_query.R' 'extensions.R' + 'geom-funs.R' 'items-funs.R' 'items-utils.R' 'items-query.R' @@ -80,10 +72,11 @@ Collate: 'request.R' 'signatures.R' 'stac-query.R' - 'stac_search.R' - 'stac_version.R' + 'search-query.R' + 'stac-funs.R' + 'static-funs.R' 'url-utils.R' 'utils.R' 'rstac.R' + 'rstac-funs.R' Roxygen: list(markdown = TRUE) -VignetteBuilder: knitr diff --git a/NAMESPACE b/NAMESPACE index 0863c341..5400e132 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,6 +1,5 @@ # Generated by roxygen2: do not edit by hand -S3method(after_response,RSTACQuery) S3method(after_response,collection_id) S3method(after_response,collections) S3method(after_response,conformance) @@ -12,21 +11,19 @@ S3method(after_response,queryables) S3method(after_response,search) S3method(after_response,stac) S3method(as.character,cql2_filter) -S3method(assets_download,STACItem) -S3method(assets_download,STACItemCollection) +S3method(as.character,cql2_spatial) S3method(assets_download,default) -S3method(assets_filter,STACItem) -S3method(assets_filter,STACItemCollection) -S3method(assets_rename,STACItem) -S3method(assets_rename,STACItemCollection) +S3method(assets_download,doc_item) +S3method(assets_download,doc_items) S3method(assets_rename,default) -S3method(assets_select,STACItem) -S3method(assets_select,STACItemCollection) +S3method(assets_rename,doc_item) +S3method(assets_rename,doc_items) S3method(assets_select,default) -S3method(assets_url,STACItem) -S3method(assets_url,STACItemCollection) +S3method(assets_select,doc_item) +S3method(assets_select,doc_items) S3method(assets_url,default) -S3method(before_request,RSTACQuery) +S3method(assets_url,doc_item) +S3method(assets_url,doc_items) S3method(before_request,collection_id) S3method(before_request,collections) S3method(before_request,conformance) @@ -37,76 +34,73 @@ S3method(before_request,items) S3method(before_request,queryables) S3method(before_request,search) S3method(before_request,stac) -S3method(check_subclass,RSTACDocument) -S3method(check_subclass,RSTACQuery) -S3method(endpoint,RSTACQuery) -S3method(endpoint,collection_id) -S3method(endpoint,collections) -S3method(endpoint,conformance) -S3method(endpoint,ext_filter) -S3method(endpoint,ext_query) -S3method(endpoint,item_id) -S3method(endpoint,items) -S3method(endpoint,queryables) -S3method(endpoint,search) -S3method(endpoint,stac) S3method(get_spatial,GEOMETRYCOLLECTION) S3method(get_spatial,character) S3method(get_spatial,list) S3method(get_spatial,sf) S3method(get_spatial,sfc) S3method(get_spatial,sfg) -S3method(has_assets,STACItem) -S3method(has_assets,STACItemCollection) S3method(has_assets,default) -S3method(items_as_sf,STACItem) -S3method(items_as_sf,STACItemCollection) -S3method(items_assets,STACItem) -S3method(items_assets,STACItemCollection) +S3method(has_assets,doc_item) +S3method(has_assets,doc_items) +S3method(items_as_sf,doc_item) +S3method(items_as_sf,doc_items) +S3method(items_as_sfc,doc_item) +S3method(items_as_sfc,doc_items) +S3method(items_as_tibble,doc_item) +S3method(items_as_tibble,doc_items) S3method(items_assets,default) -S3method(items_bbox,STACItem) -S3method(items_bbox,STACItemCollection) -S3method(items_bbox,default) -S3method(items_compact,STACItemCollection) -S3method(items_datetime,STACItem) -S3method(items_datetime,STACItemCollection) -S3method(items_datetime,default) -S3method(items_fetch,STACItemCollection) -S3method(items_fields,STACItem) -S3method(items_fields,STACItemCollection) -S3method(items_fields,default) -S3method(items_filter,STACItemCollection) -S3method(items_length,STACItem) -S3method(items_length,STACItemCollection) -S3method(items_length,default) -S3method(items_matched,STACItem) -S3method(items_matched,STACItemCollection) -S3method(items_matched,default) -S3method(items_next,STACItemCollection) -S3method(items_reap,STACItem) -S3method(items_reap,STACItemCollection) +S3method(items_assets,doc_item) +S3method(items_assets,doc_items) +S3method(items_bbox,doc_item) +S3method(items_bbox,doc_items) +S3method(items_compact,doc_items) +S3method(items_datetime,doc_item) +S3method(items_datetime,doc_items) +S3method(items_fetch,doc_items) +S3method(items_fields,doc_item) +S3method(items_fields,doc_items) +S3method(items_filter,doc_items) +S3method(items_intersects,doc_item) +S3method(items_intersects,doc_items) +S3method(items_length,doc_items) +S3method(items_matched,doc_items) +S3method(items_next,doc_items) +S3method(items_properties,doc_item) +S3method(items_properties,doc_items) S3method(items_reap,default) -S3method(items_sign,STACItem) -S3method(items_sign,STACItemCollection) +S3method(items_reap,doc_item) +S3method(items_reap,doc_items) +S3method(items_select,doc_items) S3method(items_sign,default) +S3method(items_sign,doc_item) +S3method(items_sign,doc_items) +S3method(link_open,doc_link) +S3method(links,rstac_doc) S3method(parse_params,ext_filter) S3method(parse_params,ext_query) S3method(parse_params,items) S3method(parse_params,search) -S3method(print,Conformance) -S3method(print,Queryables) -S3method(print,RSTACQuery) -S3method(print,STACCatalog) -S3method(print,STACCollection) -S3method(print,STACCollectionList) -S3method(print,STACItem) -S3method(print,STACItemCollection) S3method(print,cql2_filter) -S3method(stac_version,RSTACDocument) -S3method(stac_version,RSTACQuery) -S3method(stac_version,STACCollectionList) -S3method(subclass,RSTACDocument) -S3method(subclass,RSTACQuery) +S3method(print,doc_catalog) +S3method(print,doc_collection) +S3method(print,doc_collections) +S3method(print,doc_conformance) +S3method(print,doc_item) +S3method(print,doc_items) +S3method(print,doc_link) +S3method(print,doc_links) +S3method(print,doc_queryables) +S3method(print,rstac_query) +S3method(read_collections,catalog) +S3method(read_items,doc_collection) +S3method(stac_type,rstac_doc) +S3method(stac_version,doc_collections) +S3method(stac_version,doc_items) +S3method(stac_version,rstac_doc) +S3method(stac_version,rstac_query) +S3method(subclass,rstac_doc) +S3method(subclass,rstac_query) S3method(text_not_op,cql2_between_op) S3method(text_not_op,cql2_in_op) S3method(text_not_op,cql2_isnull_op) @@ -176,7 +170,6 @@ export(asset_eo_bands) export(asset_key) export(asset_raster_bands) export(assets_download) -export(assets_filter) export(assets_rename) export(assets_select) export(assets_url) @@ -194,6 +187,8 @@ export(get_request) export(has_assets) export(items) export(items_as_sf) +export(items_as_sfc) +export(items_as_tibble) export(items_assets) export(items_bbox) export(items_compact) @@ -201,30 +196,53 @@ export(items_datetime) export(items_fetch) export(items_fields) export(items_filter) -export(items_group) +export(items_intersects) export(items_length) export(items_matched) export(items_next) +export(items_properties) export(items_reap) +export(items_select) export(items_sign) +export(items_sign_bdc) +export(items_sign_planetary_computer) +export(link_open) +export(links) export(post_request) export(preview_plot) export(queryables) +export(read_collections) +export(read_items) +export(read_stac) export(sign_bdc) export(sign_planetary_computer) export(stac) export(stac_search) +export(stac_type) export(stac_version) importFrom(crayon,bold) +importFrom(grid,grid.raster) importFrom(httr,GET) importFrom(httr,POST) importFrom(httr,add_headers) +importFrom(httr,build_url) importFrom(httr,content) importFrom(httr,http_type) +importFrom(httr,parse_url) importFrom(httr,status_code) importFrom(httr,write_disk) +importFrom(jpeg,readJPEG) importFrom(jsonlite,fromJSON) -importFrom(lifecycle,deprecated) +importFrom(jsonlite,read_json) importFrom(magrittr,"%>%") +importFrom(png,readPNG) +importFrom(sf,st_geometry) +importFrom(sf,st_geometry_type) +importFrom(sf,st_intersects) +importFrom(sf,st_sf) +importFrom(sf,st_sfc) +importFrom(sf,st_transform) importFrom(utils,URLdecode) importFrom(utils,modifyList) +importFrom(utils,setTxtProgressBar) +importFrom(utils,txtProgressBar) diff --git a/NEWS.md b/NEWS.md index a0e25cc3..0d1e8a1f 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,4 +1,14 @@ -# rstac (development version) +# rstac 1.0.0 (Released 2024-02-14) + +* Add support to static catalogs; +* `read_stac()`: read any STAC document from an URL (e.g. Catalog, Collection, Items, or Item); +* `links()`: extract and filter links from a STAC document; +* `link_open()`: open the document referenced by the provided link; +* `read_items()`: read items listed in links section of the provided Collection document; +* `read_collections()`: read collections listed in links section of the provided Catalog document; +* Provide new functions to facilitate work with items; +* `items_as_sf()` / `items_as_sfc()`: convert items into sf objects +* `items_intersects()`: is a helper function to test what items intersect some given geometry. # rstac 0.9.2-4 (Released 2023-06-15) diff --git a/R/assets-funs.R b/R/assets-funs.R index d28c6af6..47df0203 100644 --- a/R/assets-funs.R +++ b/R/assets-funs.R @@ -1,8 +1,8 @@ #' @title Assets functions #' #' @description -#' These functions provide support to work with `STACItemCollection` and -#' `STACItem` item objects. +#' These functions provide support to work with `doc_items` and +#' `doc_item` item objects. #' #' \itemize{ #' \item `assets_download()`: Downloads the assets provided by the STAC API. @@ -23,7 +23,7 @@ #' asset using a named list or a function. #' } #' -#' @param items a `STACItem` or `STACItemCollection` object +#' @param items a `doc_item` or `doc_items` object #' representing the result of `/stac/search`, #' \code{/collections/{collectionId}/items} or #' \code{/collections/{collectionId}/items/{itemId}} endpoints. @@ -47,26 +47,23 @@ #' each item to be downloaded. Using this function, you can change the #' hrefs for each asset, as well as the way download is done. #' -#' @param fn `r lifecycle::badge('deprecated')` -#' use `download_fn` parameter instead. -#' #' @param append_gdalvsi a `logical` value. If true, gdal drivers are #' included in the URL of each asset. The following schemes are supported: #' HTTP/HTTPS files, S3 (AWS S3) and GS (Google Cloud Storage). #' #' @param create_json a `logical` indicating if a JSON file with item -#' metadata (`STACItem` or `STACItemCollection`) must be created in the +#' metadata (`doc_item` or `doc_items`) must be created in the #' output directory. #' #' @param select_fn a `function` to select assets an item -#' (`STACItem` or `STACItemCollection`). This function receives as parameter +#' (`doc_item` or `doc_items`). This function receives as parameter #' the asset element and, optionally, the asset name. Asset elements #' contain metadata describing spatial-temporal objects. Users can provide #' a function to select assets based on this metadata by returning a #' logical value where `TRUE` selects the asset, and `FALSE` discards it. #' #' @param mapper either a named `list` or a `function` to rename assets -#' of an item (`STACItem` or `STACItemCollection`). In the case of a named +#' of an item (`doc_item` or `doc_items`). In the case of a named #' list, use ` = ` to rename the assets. The function #' can be used to rename the assets by returning a `character` string using #' the metadata contained in the asset object. @@ -104,17 +101,17 @@ #' #' \itemize{ #' \item `assets_download()`: returns the same input object item -#' (`STACItem` or `STACItemCollection`) where `href` properties point to +#' (`doc_item` or `doc_items`) where `href` properties point to #' the download assets. #' #' \item `assets_url()`: returns a character vector with all assets `href` -#' of an item (`STACItem` or `STACItemCollection`). +#' of an item (`doc_item` or `doc_items`). #' #' \item `assets_select()`: returns the same input object item -#' (`STACItem` or `STACItemCollection`) with the selected assets. +#' (`doc_item` or `doc_items`) with the selected assets. #' #' \item `assets_rename()`: returns the same input object item -#' (`STACItemCollection` or `STACItem`) with the assets renamed. +#' (`doc_items` or `doc_item`) with the assets renamed. #' } #' #' @examples @@ -185,36 +182,23 @@ assets_download <- function(items, asset_names = NULL, output_dir = getwd(), overwrite = FALSE, ..., - download_fn = NULL, - fn = deprecated()) { - + download_fn = NULL) { # check output dir if (!dir.exists(output_dir)) .error(paste("The directory provided does not exist.", - "Please specify a valid directory.")) - + "Please, provide an existing directory.")) UseMethod("assets_download", items) } #' @rdname assets_functions #' #' @export -assets_download.STACItem <- function(items, +assets_download.doc_item <- function(items, asset_names = NULL, output_dir = getwd(), overwrite = FALSE, ..., create_json = FALSE, - download_fn = NULL, - fn = deprecated()) { - if (!missing(fn)) { - deprec_parameter( - deprec_var = "fn", - deprec_version = "0.9.2", - msg = "Please, use `download_fn` parameter instead." - ) - download_fn <- fn - } - + download_fn = NULL) { if (!is.null(asset_names)) { in_assets <- asset_names %in% items_assets(items) if (!all(asset_names %in% items_assets(items))) { @@ -223,12 +207,10 @@ assets_download.STACItem <- function(items, } items <- assets_select(items = items, asset_names = asset_names) } - items$assets <- lapply( items$assets, asset_download, output_dir = output_dir, overwrite = overwrite, ..., download_fn = download_fn ) - if (create_json) { file <- "item.json" if ("id" %in% names(items)) { @@ -236,67 +218,49 @@ assets_download.STACItem <- function(items, } cat(to_json(items), file = file.path(output_dir, file)) } - return(items) + items } #' @rdname assets_functions #' #' @export -assets_download.STACItemCollection <- function(items, - asset_names = NULL, - output_dir = getwd(), - overwrite = FALSE, ..., - download_fn = NULL, - create_json = TRUE, - items_max = Inf, - progress = TRUE, - fn = deprecated()) { - if (!missing(fn)) { - deprec_parameter( - deprec_var = "fn", - deprec_version = "0.9.2", - msg = "Please, use `download_fn` parameter instead." - ) - download_fn <- fn - } - +assets_download.doc_items <- function(items, + asset_names = NULL, + output_dir = getwd(), + overwrite = FALSE, ..., + download_fn = NULL, + create_json = TRUE, + items_max = Inf, + progress = TRUE) { # remove empty items items <- items_compact(items) items_max <- max(0, min(items_length(items), items_max)) - # verify if progress bar can be shown progress <- progress && items_max > 1 - if (progress) { pb <- utils::txtProgressBar(max = items_max, style = 3) + # close progress bar when exit + on.exit(if (progress) close(pb)) } - items$features <- items$features[seq_len(items_max)] for (i in seq_len(items_max)) { - if (progress) { + if (progress) utils::setTxtProgressBar(pb, i) - } - items$features[[i]] <- assets_download( items = items$features[[i]], asset_names = asset_names, output_dir = output_dir, overwrite = overwrite, create_json = FALSE, download_fn = download_fn, ... ) } - # close progress bar - if (progress) { - close(pb) - } - if (create_json) { + if (create_json) cat(to_json(items), file = file.path(output_dir, "items.json")) - } - return(items) + items } #' @rdname assets_functions #' #' @export -assets_download.default <- assets_download.STACItem +assets_download.default <- assets_download.doc_item #' @rdname assets_functions #' @@ -308,7 +272,7 @@ assets_url <- function(items, asset_names = NULL, append_gdalvsi = FALSE) { #' @rdname assets_functions #' #' @export -assets_url.STACItem <- function(items, +assets_url.doc_item <- function(items, asset_names = NULL, append_gdalvsi = FALSE) { if (is.null(asset_names)) { @@ -332,9 +296,9 @@ assets_url.STACItem <- function(items, #' @rdname assets_functions #' #' @export -assets_url.STACItemCollection <- function(items, - asset_names = NULL, - append_gdalvsi = FALSE) { +assets_url.doc_items <- function(items, + asset_names = NULL, + append_gdalvsi = FALSE) { if (is.null(asset_names)) { asset_names <- items_assets(items) } @@ -357,7 +321,7 @@ assets_url.STACItemCollection <- function(items, #' @rdname assets_functions #' #' @export -assets_url.default <- assets_url.STACItem +assets_url.default <- assets_url.doc_item #' @rdname assets_functions #' @@ -369,33 +333,28 @@ assets_select <- function(items, ..., asset_names = NULL, select_fn = NULL) { #' @rdname assets_functions #' #' @export -assets_select.STACItem <- function(items, ..., +assets_select.doc_item <- function(items, ..., asset_names = NULL, select_fn = NULL) { exprs <- unquote( expr = as.list(substitute(list(...), env = environment())[-1]), env = parent.frame() ) - + init_length <- length(items$assets) if (!is.null(asset_names)) { asset_names <- intersect(names(items$assets), asset_names) items$assets <- items$assets[asset_names] } - if (length(exprs) > 0) { if (!is.null(names(exprs))) .error("Select expressions cannot be named.") - for (i in seq_along(exprs)) { sel <- map_lgl(names(items$assets), function(key) { - val <- select_eval(key = key, asset = items$assets[[key]], - expr = exprs[[i]]) - return(val) + select_eval(key = key, asset = items$assets[[key]], expr = exprs[[i]]) }) items$assets <- items$assets[sel] } } - if (!is.null(select_fn)) { sel <- map_lgl(names(items$assets), function(key) { val <- select_exec(key = key, asset = items$assets[[key]], @@ -404,16 +363,19 @@ assets_select.STACItem <- function(items, ..., }) items$assets <- items$assets[sel] } - - return(items) + if (length(items$assets) == 0 && init_length > 0) + .warning(paste("Filter criteria did not match any asset.\n", + "Please, see `?assets_select` for more details on", + "how expressions are evaluated by `assets_select()`.")) + items } #' @rdname assets_functions #' #' @export -assets_select.STACItemCollection <- function(items, ..., - asset_names = NULL, - select_fn = NULL) { +assets_select.doc_items <- function(items, ..., + asset_names = NULL, + select_fn = NULL) { items <- foreach_item( items, assets_select, asset_names = asset_names, ..., select_fn = select_fn @@ -424,7 +386,7 @@ assets_select.STACItemCollection <- function(items, ..., #' @rdname assets_functions #' #' @export -assets_select.default <- assets_select.STACItem +assets_select.default <- assets_select.doc_item #' @rdname assets_functions #' @@ -436,7 +398,7 @@ assets_rename <- function(items, mapper = NULL, ...) { #' @rdname assets_functions #' #' @export -assets_rename.STACItem <- function(items, mapper = NULL, ...) { +assets_rename.doc_item <- function(items, mapper = NULL, ...) { dots <- list(...) if (is.function(mapper)) { new_names <- as.list(map_chr(items$assets, mapper, use_names = TRUE)) @@ -466,14 +428,14 @@ assets_rename.STACItem <- function(items, mapper = NULL, ...) { #' @rdname assets_functions #' #' @export -assets_rename.STACItemCollection <- function(items, mapper = NULL, ...) { +assets_rename.doc_items <- function(items, mapper = NULL, ...) { return(foreach_item(items, assets_rename, mapper = mapper, ...)) } #' @rdname assets_functions #' #' @export -assets_rename.default <- assets_rename.STACItem +assets_rename.default <- assets_rename.doc_item #' @rdname assets_functions #' @@ -485,23 +447,21 @@ has_assets <- function(items) { #' @rdname assets_functions #' #' @export -has_assets.STACItem <- function(items) { - if (!"assets" %in% names(items)) - .error("Parameter `items` is not a valid.") - return(length(items$assets) > 0) +has_assets.doc_item <- function(items) { + length(items$assets) > 0 } #' @rdname assets_functions #' #' @export -has_assets.STACItemCollection <- function(items) { +has_assets.doc_items <- function(items) { map_lgl(items$features, has_assets) } #' @rdname assets_functions #' #' @export -has_assets.default <- has_assets.STACItem +has_assets.default <- has_assets.doc_item #' @rdname assets_functions #' diff --git a/R/assets-utils.R b/R/assets-utils.R index 932d2fe3..ade3f611 100644 --- a/R/assets-utils.R +++ b/R/assets-utils.R @@ -52,3 +52,23 @@ select_exec <- function(key, asset, select_fn) { select_check_eval(val) return(val) } + +asset_download <- function(asset, + output_dir, + overwrite, ..., + download_fn = NULL) { + if (!is.null(download_fn)) + return(download_fn(asset)) + # create a full path name + path <- url_get_path(asset$href) + out_file <- path_normalize(output_dir, path) + dir_create(out_file) + make_get_request( + url = asset$href, + httr::write_disk(path = out_file, overwrite = overwrite), + ..., + error_msg = "Error while downloading" + ) + asset$href <- path + asset +} diff --git a/R/check-utils.R b/R/check-utils.R index 174ec588..f2200e04 100644 --- a/R/check-utils.R +++ b/R/check-utils.R @@ -19,49 +19,61 @@ #' #' @noRd .check_rfc_3339 <- function(datetime) { - # Standard regexp of RFC 3339 pattern_rfc <- "^\\d{4}-\\d{2}-\\d{2}?(T\\d{2}:\\d{2}:\\d{2}Z)?$" check_pattern <- grepl(pattern_rfc, datetime, perl = TRUE) - return(check_pattern) } -#' @title Utility functions -#' -#' @param obj an `object` to compare. -#' -#' @param expected a `character` with the expected classes. -#' -#' @noRd -.check_obj <- function(obj, expected) { - - obj_name <- as.character(substitute(obj, env = environment())) +check_link <- function(link) { + if (!is.list(link) || is.null(names(link))) + .error("Invalid doc_link object.") + if (!"href" %in% names(link)) + .error("Invalid doc_link object. Expecting `href` key.") + link +} - if (!inherits(obj, expected)) - .error("Invalid %s value in `%s` param.", - paste0("`", expected, "`", collapse = " or "), obj_name) +check_item <- function(items) { + if (!is.list(items) || is.null(names(items))) + .error("Invalid doc_item object.") + if (!"type" %in% names(items) || items$type != "Feature") + .error("Invalid doc_item object. Expecting 'type': 'Feature' key value.") + if (!"geometry" %in% names(items)) + .error("Invalid doc_item object. Expecting `geometry` key.") + if (!"properties" %in% names(items)) + .error("Invalid doc_item object. Expecting `properties` key") + items } check_items <- function(items) { - UseMethod("check_items", items) + if (!is.list(items) || is.null(names(items))) + .error("Invalid doc_items object.") + if (!"type" %in% names(items) || items$type != "FeatureCollection") + .error("Invalid doc_items object. Expecting ", + "'type': 'FeatureCollection' key value.") + if (!"features" %in% names(items)) + .error("Invalid doc_items object. Expecting `features` key") + items } -check_items.STACItem <- function(items) { - if (!(is.list(items) && "assets" %in% names(items))) { - .error("Invalid STACItem object.") - } +check_catalog <- function(catalog) { + if (!is.list(catalog) || is.null(names(catalog))) + .error("Invalid doc_catalog object.") + if (!"links" %in% names(catalog)) + .error("Invalid doc_catalog object. Expecting `links` key.") + catalog } -check_items.STACItemCollection <- function(items) { - if (!(is.list(items) && "features" %in% names(items))) { - .error("Invalid STACItemCollection object.") - } +check_collection <- function(collection) { + if (!is.list(collection) || is.null(names(collection))) + .error("Invalid doc_collection object.") + if (!"id" %in% names(collection)) + .error("Invalid doc_collection object. Expecting `id` key.") + if (!"links" %in% names(collection)) + .error("Invalid doc_collection object. Expecting `links` key.") + collection } -check_items.default <- check_items.STACItem - - check_character <- function(x, msg, ...) { if (!is.character(x)) .error(msg, ...) diff --git a/R/collections-query.R b/R/collections-query.R index 9533561b..82d2a4f3 100644 --- a/R/collections-query.R +++ b/R/collections-query.R @@ -14,7 +14,7 @@ #' Collection object #' } #' -#' @param q a `RSTACQuery` object expressing a STAC query +#' @param q a `rstac_query` object expressing a STAC query #' criteria. #' #' @param collection_id a `character` collection id to be retrieved. @@ -23,7 +23,7 @@ #' [get_request()], [post_request()], [items()] #' #' @return -#' A `RSTACQuery` object with the subclass `collections` for +#' A `rstac_query` object with the subclass `collections` for #' `/collections/` endpoint, or a `collection_id` subclass for #' \code{/collections/{collection_id}} endpoint, containing all search field #' parameters to be provided to STAC API web service. @@ -41,77 +41,43 @@ #' #' @export collections <- function(q, collection_id = NULL) { - - # check q parameter - check_subclass(q, "stac") - + check_query(q, "stac") params <- list() - subclass <- "collections" if (!is.null(collection_id)) { - if (length(collection_id) != 1) .error("Parameter `collection_id` must be a single value.") - - params[["collection_id"]] <- collection_id - + params$collection_id <- collection_id subclass <- "collection_id" } - - RSTACQuery(version = q$version, - base_url = q$base_url, - params = utils::modifyList(q$params, params), - subclass = subclass) -} - -#' @export -endpoint.collections <- function(q) { - - return("/collections") + rstac_query( + version = q$version, + base_url = q$base_url, + params = utils::modifyList(q$params, params), + subclass = subclass + ) } #' @export before_request.collections <- function(q) { - check_query_verb(q, verbs = c("GET", "POST")) - - return(q) + set_query_endpoint(q, endpoint = "./collections") } #' @export after_response.collections <- function(q, res) { - 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 = "/")) + content <- content_response_json(res) + doc_collections(content) } #' @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 - q <- omit_query_params(q, names = "collection_id") - - return(q) + set_query_endpoint(q, endpoint = "./collections/%s", params = "collection_id") } #' @export after_response.collection_id <- function(q, res) { - 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")) + content <- content_response_json(res) + doc_collection(content) } diff --git a/R/conformance-query.R b/R/conformance-query.R index 39ce790a..7e05a44d 100644 --- a/R/conformance-query.R +++ b/R/conformance-query.R @@ -1,16 +1,16 @@ -#' @title Conformance endpoint +#' @title doc_conformance endpoint #' #' @description #' The conformance endpoint provides the capabilities of #' the service. #' This endpoint is accessible from the provider's catalog (`/conformance`). #' -#' @param q a `RSTACQuery` object expressing a STAC query criteria. +#' @param q a `rstac_query` object expressing a STAC query criteria. #' #' @seealso [get_request()], [stac()], [collections()] #' #' @return -#' A `RSTACQuery` object with the subclass `conformance` for `/conformance` +#' A `rstac_query` object with the subclass `conformance` for `/conformance` #' endpoint. #' #' @examples @@ -21,33 +21,23 @@ #' #' @export conformance <- function(q) { - # check q parameter - check_subclass(q, "stac") - - RSTACQuery(version = q$version, - base_url = q$base_url, - params = q$params, - subclass = unique(c("conformance", subclass(q)))) -} - -#' @export -endpoint.conformance <- function(q) { -return("/conformance") + check_query(q, "stac") + rstac_query( + version = q$version, + base_url = q$base_url, + params = q$params, + subclass = "conformance" + ) } #' @export before_request.conformance <- function(q) { check_query_verb(q, verbs = c("GET", "POST")) - return(q) + set_query_endpoint(q, endpoint = "./conformance") } #' @export after_response.conformance <- function(q, res) { - content <- content_response( - res, - status_codes = "200", - content_types = "application/.*json", - key_message = c("message", "description", "detail") - ) - RSTACDocument(content = content, q = q, subclass = "Conformance") + content <- content_response_json(res) + doc_conformance(content) } diff --git a/R/cql2-adv_comp.R b/R/cql2-adv_comp.R index 8a2f1f61..f406d8fd 100644 --- a/R/cql2-adv_comp.R +++ b/R/cql2-adv_comp.R @@ -96,8 +96,8 @@ get_spatial.character <- function(x) { get_spatial.list <- function(x) { if (!all(c("type", "coordinates") %in% names(x))) .error("Not a valid GeoJSON geometry.") - if (!x[["type"]] %in% spatial_types) - .error("GeoJSON type '%s' is not supported.", x[["type"]]) + if (!x$type %in% spatial_types) + .error("GeoJSON type '%s' is not supported.", x$type) class(x) <- c("cql2_spatial", "list") x } @@ -137,6 +137,11 @@ get_spatial.GEOMETRYCOLLECTION <- function(x) { ) } +#' @export +as.character.cql2_spatial <- function(x, ...) { + to_text(x) +} + # temporal_op temporal_op <- function(op) { function(a, b) { diff --git a/R/cql2-funs.R b/R/cql2-funs.R index 9d198eaf..9f171623 100644 --- a/R/cql2-funs.R +++ b/R/cql2-funs.R @@ -47,10 +47,10 @@ cql2_crs <- function(obj) { } cql2_filter <- function(obj) { - obj[["filter"]] + obj$filter } `cql2_filter<-` <- function(obj, value) { - obj[["filter"]] <- value + obj$filter <- value obj } diff --git a/R/cql2-text.R b/R/cql2-text.R index eda3485c..4c31f324 100644 --- a/R/cql2-text.R +++ b/R/cql2-text.R @@ -253,7 +253,7 @@ wkt_spatial_type <- function(x) { if (!"type" %in% names(x) || !any(c("coordinates", "geometries") %in% names(x))) .error("Not a valid GeoJSON geometry.") - x[["type"]] + x$type } wkt_spatial_switch <- function(x, ...) { diff --git a/R/cql2-types.R b/R/cql2-types.R index 98d91ab6..980a3b2a 100644 --- a/R/cql2-types.R +++ b/R/cql2-types.R @@ -30,6 +30,68 @@ is_spatial <- function(x) { # input check ---- +iso_3339_date_fullyear <- "[0-9]{4}" + +iso_3339_date_month <- "(1[0-2]|0[1-9])" + +iso_3339_date_mday <- "(3[01]|[12][0-9]|0[1-9])" + +iso_3339_time_hour <- "(2[0-3]|[01][0-9])" + +iso_3339_time_minute <- "([0-5][0-9])" + +iso_3339_time_second <- "(60|[0-5][0-9])" + +iso_3339_time_secfrac <- "(\\.[0-9]+)?" + +iso_3339_time_numoffset <- paste0( + "[+-]", + paste( + iso_3339_time_hour, + iso_3339_time_minute, + sep = ":" + ) +) + +iso_3339_time_offset <- paste0( + "(Z|", iso_3339_time_numoffset, ")" +) + +iso_3339_partial_time <- paste0( + paste( + iso_3339_time_hour, + iso_3339_time_minute, + iso_3339_time_second, + sep = ":" + ), + iso_3339_time_secfrac +) + +iso_3339_full_date <- paste( + iso_3339_date_fullyear, + iso_3339_date_month, + iso_3339_date_mday, + sep = "-" +) + +iso_3339_full_time <- paste0( + iso_3339_partial_time, + iso_3339_time_offset +) +iso_3339_date_time <- paste0( + iso_3339_full_date, + "T", + iso_3339_full_time +) + +grep_iso_3339_date <- function(x) { + grepl(paste0("^", iso_3339_full_date, "$"), x) +} + +grep_iso_3339_date_time <- function(x) { + grepl(paste0("^", iso_3339_date_time, "$"), x) +} + # check timestamp instant is_time <- function(x) { is_str(x) && grep_iso_3339_date_time(x) || diff --git a/R/deprec-funs.R b/R/deprec-funs.R index c8ad3cd2..e69de29b 100644 --- a/R/deprec-funs.R +++ b/R/deprec-funs.R @@ -1,160 +0,0 @@ -#' @title Assets filter (Deprecated) -#' -#' @description `r lifecycle::badge('deprecated')` -#' -#' @param items a `STACItemCollection` object representing -#' the result of `/stac/search`, \code{/collections/{collectionId}/items}. -#' -#' @param ... additional arguments. See details. -#' -#' @param filter_fn a `function` that will be used to filter the -#' attributes listed in the properties. -#' -#' @return a `list` with the attributes of date, bands and paths. -#' -#' @name assets_filter -#' -#' @export -assets_filter <- function(items, ..., filter_fn = NULL) { - UseMethod("assets_filter", items) -} - -#' @rdname assets_filter -#' -#' @export -assets_filter.STACItemCollection <- function(items, ..., filter_fn = NULL) { - # signal the deprecation to the user - lifecycle::deprecate_soft( - when = "0.9.2-1", - what = "rstac::assets_filter()", - with = "rstac::assets_select()" - ) - dots <- substitute(list(...), env = environment())[-1] - - if (length(dots) > 0) { - if (!is.null(names(dots))) .error("Invalid filter arguments.") - - for (i in seq_along(dots)) { - - items$features <- lapply(items$features, function(item) { - - sel <- vapply(item$assets, function(asset) { - - tryCatch({ - eval(dots[[i]], envir = asset, enclos = baseenv()) - }, error = function(e) { NA }) - }, logical(1)) - - if (all(is.na(sel))) - .error("Invalid condition arguments.") - - sel[is.na(sel)] <- FALSE - - item$assets <- item$assets[sel] - - item - }) - } - } - - if (!is.null(filter_fn)) { - items$features <- lapply(items$features, function(item) { - - sel <- vapply(item$assets, filter_fn, logical(1)) - - item$assets <- item$assets[sel] - item - }) - } - - items -} - -#' @rdname assets_filter -#' -#' @export -assets_filter.STACItem <- function(items, ..., filter_fn = NULL) { - # signal the deprecation to the user - lifecycle::deprecate_soft( - when = "0.9.2-1", - what = "rstac::assets_filter()", - with = "rstac::assets_select()" - ) - dots <- substitute(list(...), env = environment())[-1] - - if (length(dots) > 0) { - if (!is.null(names(dots))) .error("Invalid filter arguments.") - - for (i in seq_along(dots)) { - sel <- vapply(items$assets, function(asset) { - tryCatch({ - eval(dots[[i]], envir = asset, enclos = baseenv()) - }, error = function(e) { NA }) - }, logical(1)) - - if (all(is.na(sel))) .error("Invalid condition arguments.") - - sel[is.na(sel)] <- FALSE - items$assets <- items$assets[sel] - } - } - - if (!is.null(filter_fn)) { - sel <- vapply(items$assets, filter_fn, logical(1)) - items$assets <- items$assets[sel] - } - - items -} - -#' @rdname items_functions -#' -#' @export -items_group <- function(items, ..., field = NULL, index = NULL) { - # signal the deprecation to the user - lifecycle::deprecate_soft( - when = "0.9.2-1", - what = "rstac::items_group()" - ) - - # checks if the object is STACItemCollections - if (items_length(items) == 0) return(list(items)) - - dots <- substitute(list(...), env = environment())[-1] - if (!is.character(dots)) dots <- as.character(dots) - - if (length(index) == 0 && length(field) == 0 && length(dots) == 0) - .error(paste("Either parameters 'index', 'field' or '...' parameters must", - "be supplied.")) - - if (length(index) > 0 && (length(field) > 0 || length(dots) > 0)) - .error(paste("Only one of the parameters '...','index' or 'field' should", - "be supplied.")) - - if (is.null(index)) { - index <- items_reap(items, ..., field = field) - - if (!is.atomic(index)) - .error("The field must be atomic vector.") - } else { - - if (items_matched(items) > items_length(items)) - .warning(paste("The number of matched items is greater than the number", - "of items length on your object. Considere to use", - "the 'items_fetch()' function before this operation.")) - } - - if (items_length(items) != length(index)) - .error(paste("The length of the field provided for grouping must contain", - "the same size as the length of the items.")) - - features <- unname(tapply(X = items$features, - INDEX = index, - FUN = c, simplify = FALSE)) - - lapply(features, function(x){ - items$features <- x - - items - }) -} diff --git a/R/doc-funs.R b/R/doc-funs.R new file mode 100644 index 00000000..916e4b79 --- /dev/null +++ b/R/doc-funs.R @@ -0,0 +1,159 @@ +rstac_doc <- function(x, subclass) { + structure(x, class = c(subclass, "list"), query = NULL) +} + +#' @export +stac_version.rstac_doc <- function(x, ...) { + default_version <- "0.8.0" + if (!is.null(x$stac_version)) + return(x$stac_version) + default_version +} + +#' @export +stac_version.doc_collections <- function(x, ...) { + if (length(x$collections) > 0) + stac_version(x$collections[[1]]) +} + +#' @export +stac_version.doc_items <- function(x, ...) { + if (!is.null(x$stac_version)) + return(x$stac_version) + if ("features" %in% names(x) && length(x$features) > 0) + stac_version(x$features[[1]]) +} + +#' @export +subclass.rstac_doc <- function(x) { + class(x)[[1]] +} + +#' @export +stac_type.rstac_doc <- function(x) { + subclass <- subclass(x) + switch( + subclass, + doc_conformance = "Conformance", + doc_catalog = "Catalog", + doc_collection = "Collection", + doc_collections = "Collections", + doc_item = "Item", + doc_items = "Items" + ) +} + +stac_subclass <- function(obj) { + if (!is.list(obj) || is.null(names(obj))) + .error("Invalid STAC document.") + if ("type" %in% names(obj)) { + if (obj$type == "Feature") + return("doc_item") + if (obj$type == "FeatureCollection") + return("doc_items") + if (obj$type == "Collection") + return("doc_collection") + if (obj$type == "Catalog") + return("doc_catalog") + .error("Invalid STAC document. Key value 'type': '", obj$type, + "' is not a supported STAC document.") + } else { + if ("conformsTo" %in% names(obj)) + return("doc_conformance") + if ("collections" %in% names(obj)) + return("doc_collections") + if ("id" %in% names(obj) && "links" %in% names(obj)) + return("doc_collection") + if ("links" %in% names(obj)) + return("doc_catalog") + .error("Invalid STAC document.") + } +} + +as_rstac_doc <- function(x, base_url = NULL) { + subclass <- stac_subclass(x) + switch( + subclass, + doc_conformance = doc_conformance(x), + doc_catalog = doc_catalog(x, base_url = base_url), + doc_collection = doc_collection(x, base_url = base_url), + doc_collections = doc_collections(x, base_url = base_url), + doc_item = doc_item(x, base_url = base_url), + doc_items = doc_items(x, base_url = base_url) + ) +} + +doc_conformance <- function(x) { + if (!is.list(x) || !"conformsTo" %in% names(x)) + .error("Invalid Conformance object.") + rstac_doc(x, subclass = c("doc_conformance", "rstac_doc")) +} + +doc_queryables <- function(x) { + rstac_doc(x, subclass = c("doc_queryables", "rstac_doc")) +} + +doc_link <- function(x, base_url = NULL) { + if (!is.list(x) || !"href" %in% names(x) || !"rel" %in% names(x)) + .error("Invalid Link object.") + if (!is.null(base_url)) + x[["rstac:base_url"]] <- base_url + rstac_doc(x, subclass = c("doc_link")) +} + +doc_links <- function(x, base_url = NULL) { + if (is.null(x)) + x <- list() + if (!is.list(x)) + .error("Invalid Links object.") + x <- lapply(x, doc_link, base_url = base_url) + x <- c(list(list(rel = "self", href = base_url)), x) + rstac_doc(x, subclass = c("doc_links")) +} + +doc_catalog <- function(x, base_url = NULL) { + if (!is.list(x) || !"links" %in% names(x)) + .error("Invalid Catalog object.") + x$links <- doc_links(x$links, base_url = base_url) + rstac_doc(x, subclass = c("doc_catalog", "rstac_doc")) +} + +doc_collection <- function(x, base_url = NULL) { + if (!is.list(x) || !"links" %in% names(x)) + .error("Invalid Collection object.") + x$links <- doc_links(x$links, base_url = base_url) + rstac_doc(x, subclass = c("doc_collection", "rstac_doc")) +} + +doc_collections <- function(x, base_url = NULL) { + if (!is.list(x) || !"collections" %in% names(x)) + .error("Invalid Collections object.") + x$links <- doc_links(x$links, base_url = base_url) + x$collections <- lapply(x$collections, doc_collection) + rstac_doc(x, subclass = c("doc_collections", "rstac_doc")) +} + +doc_item <- function(x, base_url = NULL) { + if (!is.list(x) || !"type" %in% names(x)) + .error("Invalid Item object.") + if (x$type != "Feature") + .error("Invalid Item object. Type '%s' is not supported.", x$type) + if ("links" %in% names(x)) + x$links <- doc_links(x$links, base_url = base_url) + rstac_doc(x, subclass = c("doc_item", "rstac_doc")) +} + +doc_items <- function(x, base_url = NULL, query = NULL) { + if (!is.list(x) || !"type" %in% names(x)) + .error("Invalid Items object.") + if (x$type != "FeatureCollection") + .error("Invalid Items object. Type '%s' is not supported.", x$type) + if (!"features" %in% names(x)) + .error("Invalid Items object. Expecting 'features' key.") + x$features <- lapply(x$features, doc_item) + if ("links" %in% names(x)) + x$links <- doc_links(x$links, base_url = base_url) + items <- rstac_doc(x, subclass = c("doc_items", "rstac_doc")) + attr(items, "query") <- query + items +} diff --git a/R/document-funs.R b/R/document-funs.R deleted file mode 100644 index 820da76f..00000000 --- a/R/document-funs.R +++ /dev/null @@ -1,70 +0,0 @@ -#' @title Document development functions -#' -#' @param content a `list` data structure representing the JSON file -#' received in HTTP response (see [content_response()] function) -#' -#' @param q a `RSTACQuery` object expressing the STAC query used -#' to retrieve the document. -#' -#' @param subclass a `character` corresponding to the subclass of the -#' document to be created. -#' -#' @return -#' The `RSTACDocument()` function returns a `RSTACDocument` object -#' with subclass defined by `subclass` parameter. -#' -#' @keywords internal -RSTACDocument <- function(content, q = NULL, subclass = NULL) { - structure( - content, - query = q, - class = c(subclass, "RSTACDocument", "list") - ) -} - -#' @export -subclass.RSTACDocument <- function(x) { - - class(x)[[1]] -} - -#' @export -check_subclass.RSTACDocument <- function(x, subclasses) { - - if (!all(subclass(x) %in% subclasses)) - .error("Expecting %s document(s).", - paste0("`", subclasses, "`", collapse = " or ")) -} - -#' @title Document utils functions -#' -#' @param d an `RSTACDocument` object -#' -#' @return a `RSTACQuery` object with the predecessor subclass with the -#' fields used in the request. -#' -#' @keywords internal -doc_query <- function(d) { - - .check_obj(d, "RSTACDocument") - - attr(d, "query") -} - -#' @export -stac_version.RSTACDocument <- function(x, ...) { - - if (is.null(x$stac_version)) - return(stac_version(doc_query(x))) - x$stac_version -} - -#' @export -stac_version.STACCollectionList <- function(x, ...) { - - q <- doc_query(x) - if (!is.null(q)) - return(stac_version(q)) - if (length(x$collections) > 0) - return(x$collections[[1]]$stac_version) -} diff --git a/R/ext_filter.R b/R/ext_filter.R index e3afbf73..6c3bac55 100644 --- a/R/ext_filter.R +++ b/R/ext_filter.R @@ -19,7 +19,7 @@ #' filter criteria using R language. For more details on how to create #' CQL2 expressions in `rstac`. See the details section. #' -#' @param q a `RSTACQuery` object expressing a STAC query +#' @param q a `rstac_query` object expressing a STAC query #' criteria. #' @param expr a valid R expression to be translated to CQL2 (see details). #' @param lang a character value indicating which CQL2 representation @@ -101,11 +101,10 @@ #' for example `"date"`. #' #' @seealso [ext_query()], [stac_search()], [post_request()], -#' [endpoint()], [before_request()], -#' [after_response()], [content_response()] +#' [before_request()], [after_response()], [content_response()] #' #' @return -#' A `RSTACQuery` object with the subclass `ext_filter` containing +#' A `rstac_query` object with the subclass `ext_filter` containing #' all request parameters to be passed to `get_request()` or #' `post_request()` function. #' @@ -113,8 +112,8 @@ #' \dontrun{ #' # Standard comparison operators in rstac: #' # Creating a stac search query -#' req <- rstac::stac("https://planetarycomputer.microsoft.com/api/stac/v1") %>% -#' rstac::stac_search(limit = 5) +#' req <- stac("https://planetarycomputer.microsoft.com/api/stac/v1") %>% +#' stac_search(limit = 5) #' #' # Equal operator '=' with collection property #' req %>% ext_filter(collection == "sentinel-2-l2a") %>% post_request() @@ -211,45 +210,36 @@ #' #' @export ext_filter <- function(q, expr, lang = NULL, crs = NULL) { - # check parameter - check_subclass(q, c("stac", "search", "items")) + check_query(q, c("stac", "search", "items")) check_lang(lang) - # get expression expr <- unquote( expr = substitute(expr = expr, env = environment()), env = parent.frame() ) params <- cql2(expr, lang = lang, crs = crs) - - if (any(c("seach", "items") %in% subclass(q))) - class <- unique(c("ext_filter", subclass(q))) + if (any(c("search", "items") %in% subclass(q))) + subclass <- unique(c("ext_filter", subclass(q))) else - class <- unique(c("ext_filter", "search", subclass(q))) - - RSTACQuery(version = q$version, - base_url = q$base_url, - params = modify_list(q$params, params), - subclass = class) + subclass <- unique(c("ext_filter", "search", subclass(q))) + rstac_query( + version = q$version, + base_url = q$base_url, + params = modify_list(q$params, params), + subclass = subclass + ) } check_lang <- function(lang) { if (!is.null(lang) && !lang[[1]] %in% c("cql2-json", "cql2-text")) - .error("Value '%s' lang is not supported", lang[[1]]) -} - -#' @export -endpoint.ext_filter <- function(q) { - # using endpoint from search or items document - if (any(c("stac", "search") %in% subclass(q))) - return(endpoint.search(q)) - return(endpoint.items(q)) + .error("Language '%s' is not supported", lang[[1]]) } #' @export before_request.ext_filter <- function(q) { - check_query_verb(q, verbs = c("GET", "POST")) + # call super class + q <- NextMethod("before_request", q) if (q$verb == "GET") { # transform list into string to provide as querystring in GET if (!is.null(cql2_lang(q$params)) && cql2_lang(q$params) == "cql2-json") { @@ -265,12 +255,7 @@ before_request.ext_filter <- function(q) { cql2_lang(q$params) <- "cql2-json" } } - - if ("items" %in% subclass(q)) { - # don't send 'collection_id' in url's query string or content body - q <- omit_query_params(q, names = "collection_id") - } - return(q) + q } #' @export @@ -280,14 +265,11 @@ after_response.ext_filter <- function(q, res) { #' @export parse_params.ext_filter <- function(q, params) { - # call super class params <- NextMethod("parse_params") - params } - #' @rdname ext_filter #' @export cql2_json <- function(expr) { @@ -297,7 +279,7 @@ cql2_json <- function(expr) { ) filter_expr <- to_json(cql2(expr, lang = "cql2-json")) cat(filter_expr) - return(invisible(filter_expr)) + invisible(filter_expr) } #' @rdname ext_filter @@ -309,5 +291,5 @@ cql2_text <- function(expr) { ) filter_expr <- to_text(cql2(expr, lang = "cql2-text")) cat(filter_expr) - return(invisible(filter_expr)) + invisible(filter_expr) } diff --git a/R/ext_query.R b/R/ext_query.R index effd85fd..407e7e1f 100644 --- a/R/ext_query.R +++ b/R/ext_query.R @@ -34,24 +34,22 @@ #' Besides this function, the following S3 generic methods were implemented #' to get things done for this extension: #' \itemize{ -#' \item The `endpoint()` for subclass `ext_query` #' \item The `before_request()` for subclass `ext_query` #' \item The `after_response()` for subclass `ext_query` #' } #' See source file `ext_query.R` for an example of how to implement new #' extensions. #' -#' @param q a `RSTACQuery` object expressing a STAC query +#' @param q a `rstac_query` object expressing a STAC query #' criteria. #' #' @param ... entries with format ` `. #' #' @seealso [ext_filter()], [stac_search()], [post_request()], -#' [endpoint()], [before_request()], -#' [after_response()], [content_response()] +#' [before_request()], [after_response()], [content_response()] #' #' @return -#' A `RSTACQuery` object with the subclass `ext_query` containing +#' A `rstac_query` object with the subclass `ext_query` containing #' all request parameters to be passed to `post_request()` function. #' #' @examples @@ -64,13 +62,9 @@ #' #' @export ext_query <- function(q, ...) { - - # check s parameter - check_subclass(q, "search") - + check_query(q, "search") # get the env parent env_parent <- parent.frame() - params <- list() if (!is.null(substitute(list(...), env = environment())[-1])) { dots <- substitute(list(...), env = environment())[-1] @@ -79,11 +73,9 @@ ext_query <- function(q, ...) { keys <- lapply(dots, function(x) as.character(x[[2]])) values <- lapply(dots, function(x) eval(x[[3]], env_parent)) }, error = function(e) { - .error("Invalid query expression.") }) } - ops <- lapply(ops, function(op) { if (op == "==") return("eq") if (op == "!=") return("neq") @@ -97,46 +89,32 @@ ext_query <- function(q, ...) { if (op == "%in%") return("in") .error("Invalid operator '%s'.", op) }) - uniq_keys <- unique(keys) entries <- lapply(uniq_keys, function(k) { - res <- lapply(values[keys == k], c) names(res) <- ops[keys == k] - res <- lapply(names(res), .parse_values_op, res) names(res) <- ops[keys == k] return(res) }) - if (length(entries) == 0) return(q) - names(entries) <- uniq_keys - params[["query"]] <- entries - - RSTACQuery(version = q$version, - base_url = q$base_url, - params = utils::modifyList(q$params, params), - subclass = unique(c("ext_query", subclass(q)))) -} - -#' @export -endpoint.ext_query <- function(q) { - - # using endpoint from search document - endpoint.search(q) + params$query <- entries + rstac_query( + version = q$version, + base_url = q$base_url, + params = utils::modifyList(q$params, params), + subclass = unique(c("ext_query", subclass(q))) + ) } #' @export before_request.ext_query <- function(q) { - - msg <- paste0("Query extension param is not supported by HTTP GET", - "method. Try use `post_request()` method instead.") - - check_query_verb(q, verbs = "POST", msg = msg) - - return(q) + error_msg <- paste0("Query extension is not supported by HTTP GET", + "method. Please, use `post_request()` method instead.") + check_query_verb(q, verbs = "POST", msg = error_msg) + before_request.search(q) } #' @export @@ -146,12 +124,9 @@ after_response.ext_query <- function(q, res) { #' @export parse_params.ext_query <- function(q, params) { - # call super class params <- NextMethod("parse_params") - params$query <- .parse_values_keys(params$query) - params } @@ -164,13 +139,11 @@ parse_params.ext_query <- function(q, params) { #' #' @noRd .parse_values_op <- function(op, values) { - if (op == "in") { if (length(values[[op]]) == 1) return(list(values[[op]])) return(values[[op]]) } - if (length(values[[op]]) > 1) .warning(paste("Only the first value of '%s' operation was considered", "in 'ext_query()' function."), op) @@ -185,24 +158,17 @@ parse_params.ext_query <- function(q, params) { #' #' @noRd .parse_values_keys <- function(query) { - uniq_keys <- names(query) - entries <- lapply(uniq_keys, function(k) { ops <- names(query[[k]]) - values <- lapply(ops, function(op){ query[[k]][[op]] }) - names(values) <- ops - res <- lapply(ops, .parse_values_op, values) names(res) <- ops return(res) }) - names(entries) <- uniq_keys - entries } diff --git a/R/extensions.R b/R/extensions.R index b2c2974d..9351fb9c 100644 --- a/R/extensions.R +++ b/R/extensions.R @@ -3,11 +3,11 @@ #' @description #' Currently, there are five STAC documents defined in STAC spec: #' \itemize{ -#' \item `STACCatalog` -#' \item `STACCollection` -#' \item `STACCollectionList` -#' \item `STACItem` -#' \item `STACItemCollection` +#' \item `doc_catalog` +#' \item `doc_collection` +#' \item `doc_collections` +#' \item `doc_item` +#' \item `doc_items` #' } #' #' Each document class is associated with STAC API endpoints. @@ -44,22 +44,18 @@ #' extensions. An extension must define a subclass name and implement all the #' following S3 generic methods for that subclass: #' \itemize{ -#' \item `endpoint()`: returns the endpoint value of the extension. -#' Endpoints that vary between STAC API versions can be properly returned by -#' checking the `version` field of `RSTACQuery` object. #' \item `before_request()`: allows handling query parameters before -#' submit them to the HTTP server; +#' submit them to the HTTP server, usually sets up the query endpoint; #' \item `after_request()`: allows to check and parse document received #' by the HTTP server; #' } #' -#' These methods will work 'behind the scenes' when a `RSTACQuery` object +#' These methods will work 'behind the scenes' when a `rstac_query` object #' representing a user query are passed to a request function #' (e.g. `get_request()` or `post_request()`). The calling order is: #' \enumerate{ #' \item begin of `get_request()` or `post_request()` #' \item if STAC API version is not defined, try detect it -#' \item call `endpoint()` #' \item call `before_request()` #' \item send HTTP request #' \item receive HTTP response @@ -68,13 +64,13 @@ #' } #' #' Besides that, the extension must expose a function to receive user -#' parameters and return a `RSTACQuery` object with a subclass +#' parameters and return a `rstac_query` object with a subclass #' associated with the above S3 methods. This function must accept as its -#' first parameter a `RSTACQuery` object representing the actual query. +#' first parameter a `rstac_query` object representing the actual query. #' To keep the command flow consistency, the function needs to check the #' subclass of the input query. After that, it must set new or changes the #' input query parameters according to the user input and, finally, -#' return the new query as a `RSTACQuery` object. +#' return the new query as a `rstac_query` object. #' #' You can see examples on how to implement an STAC API extension by looking at #' `stac.R`, `collections.R`, `items.R`, `stac_search.R`, @@ -85,15 +81,14 @@ #' section bellow that can help the extension development. #' #' -#' @param q a `RSTACQuery` object expressing a STAC query +#' @param q a `rstac_query` object expressing a STAC query #' criteria. #' #' @param res a `httr` `response` object. #' @param params a `list` with params to add in request. #' #' @return -#' A `character` endpoint value for `endpoint()` function. -#' A `RSTACQuery` object for `before_request()` and +#' A `rstac_query` object for `before_request()` and #' `after_response()` functions. #' #' @seealso [ext_query()] @@ -103,14 +98,6 @@ #' @keywords internal NULL -#' @title Extension development functions -#' -#' @rdname extensions -endpoint <- function(q) { - - UseMethod("endpoint", q) -} - #' @title Extension development functions #' #' @rdname extensions @@ -186,7 +173,7 @@ content_response <- function(res, status_codes, content_types, key_message) { #' verbs are allowed. It is useful for establishing which verbs will be #' supported by an extension. #' -#' @param q a `RSTACQuery` object. +#' @param q a `rstac_query` object. #' #' @param verbs a `character` vector with allowed HTTP request methods #' @@ -202,36 +189,57 @@ check_query_verb <- function(q, verbs, msg = NULL) { } #' @describeIn extensions -#' The `check_subclass()` function specifies which type of query -#' objects (`RSTACQuery`) or document objects (`RSTACDocument`) -#' are expected in the function extension. +#' The `check_query()` function specifies which type of query +#' object (`rstac_query`) is expected in the function extension. #' -#' @param x either a `RSTACQuery` object expressing a STAC query -#' criteria or any `RSTACDocument`. +#' @param x a `rstac_query` object expressing a STAC query +#' criteria. #' -#' @param subclasses a `character` vector with all allowed S3 subclasses -check_subclass <- function(x, subclasses) { - UseMethod("check_subclass", x) +#' @param classes a `character` vector with all allowed S3 sub-classes +check_query <- function(x, classes = NULL) { + if (!inherits(x, "rstac_query")) + .error("Invalid rstac_query value.") + if (!is.null(classes) && !any(classes %in% subclass(x))) + .error("Expecting %s query.", paste0("`", classes, "`", collapse = " or ")) } #' @describeIn extensions #' The `subclass()` function returns a `character` representing the -#' subclass name of either `RSTACQuery` or `RSTACDocument` S3 classes. +#' subclass name of `rstac_query` objects. subclass <- function(x) { UseMethod("subclass", x) } #' @describeIn extensions -#' The `omit_query_params()` function was created to omit the paths that -#' are defined as query parameters to simplify the creation of a query. -#' Therefore, use this method only in endpoints that specify a parameter in -#' their paths. -#' -#' @param q a `RSTACQuery` object. -#' -#' @param names a `character` vector with the names do omit. -omit_query_params <- function(q, names) { - .check_obj(names, "character") - q$omitted <- unname(names) +#' The `set_query_endpoint()` function defines the endpoint of a query. +#' If `params` parameter is passed, each value must be an entry of params +#' field of the given query. The corresponding param value will be used as +#' value replacement of `%s` occurrences in the `endpoint` string. After +#' the replacement, all params in this list will be removed. +#' +#' @param q a `rstac_query` object. +#' +#' @param endpoint a `character` vector with the format string with the +#' endpoint url. +#' +#' @param params a `character` vector with the params entries to replace +#' all `%s` occurrences in the endpoint string. +#' +set_query_endpoint <- function(q, endpoint, params = NULL) { + if (any(!params %in% names(q$params))) + .error("Invalid param(s) %s.", + paste("`", setdiff(params, names(q$params)), "`", collapse = ", ")) + values <- unname(q$params[params]) + q$endpoint <- do.call(sprintf, args = c(list(fmt = endpoint), values)) + q$params[params] <- NULL q } + +content_response_json <- function(res) { + content_response( + res = res, + status_codes = "200", + content_types = "application/.*json", + key_message = c("message", "description", "detail") + ) +} diff --git a/R/geom-funs.R b/R/geom-funs.R new file mode 100644 index 00000000..84d2aba5 --- /dev/null +++ b/R/geom-funs.R @@ -0,0 +1,71 @@ +geom_type <- function(x) { + if (!"type" %in% names(x)) + .error("Invalid geometry object") + x$type +} + +geom_switch <- function(x, ...) { + switch(geom_type(x), ..., + .error("Geometry of type '%s' is not supported", geom_type(x))) +} + +get_geom <- function(x) { + if ("geometry" %in% names(x)) + x <- x$geometry + geom_switch( + x, + Point = point(x), + MultiPoint = multi_point(x), + LineString = linestring(x), + MultiLineString = multi_linestring(x), + Polygon = polygon(x), + MultiPolygon = multi_polygon(x), + GeometryCollection = geom_collection(x) + ) +} + +point <- function(x) { + data <- unlist(x$coordinates)[c(1, 2)] + structure(data, class = c("XY", "POINT", "sfg")) +} + +multi_point <- function(x) { + data <- matrix(unlist(x$coordinates), ncol = 2, byrow = TRUE) + structure(c(data), dim = dim(data), class = c("XY", "MULTIPOINT", "sfg")) +} + +linestring <- function(x) { + data <- matrix(unlist(x$coordinates), ncol = 2, byrow = TRUE) + structure(c(data), dim = dim(data), class = c("XY", "LINESTRING", "sfg")) +} + +multi_linestring <- function(x) { + data <- lapply(x$coordinates, \(ls) { + data <- matrix(unlist(ls), ncol = 2, byrow = TRUE) + structure(c(data), dim = dim(data)) + }) + structure(data, class = c("XY", "MULTILINESTRING", "sfg")) +} + +polygon <- function(x) { + data <- lapply(x$coordinates, \(lr) { + data <- matrix(unlist(lr), ncol = 2, byrow = TRUE) + structure(c(data), dim = dim(data)) + }) + structure(data, class = c("XY", "POLYGON", "sfg")) +} + +multi_polygon <- function(x) { + data <- lapply(x$coordinates, \(pl) { + lapply(pl, \(lr) { + data <- matrix(unlist(lr), ncol = 2, byrow = TRUE) + structure(c(data), dim = dim(data)) + }) + }) + structure(data, class = c("XY", "MULTIPOLYGON", "sfg")) +} + +geom_collection <- function(x) { + data <- lapply(x$geometries, get_geom) + structure(data, class = c("XY", "GEOMETRYCOLLECTION", "sfg")) +} diff --git a/R/items-funs.R b/R/items-funs.R index 4252bf3d..399392a9 100644 --- a/R/items-funs.R +++ b/R/items-funs.R @@ -2,11 +2,11 @@ #' #' @description #' These functions provide support to work with -#' `STACItemCollection` and `STACItem` objects. +#' `doc_items` and `doc_item` objects. #' #' \itemize{ #' \item `items_length()`: shows how many items there are in -#' the `STACItemCollection` object. +#' the `doc_items` object. #' #' \item `items_matched()`: shows how many items matched the #' search criteria. It supports `search:metadata` (v0.8.0), @@ -18,32 +18,39 @@ #' \item `items_next()`: fetches a new page from STAC service. #' #' \item `items_datetime()`: retrieves the `datetime` -#' field in `properties` from `STACItemCollection` and -#' `STACItem` objects. +#' field in `properties` from `doc_items` and +#' `doc_item` objects. #' #' \item `items_bbox()`: retrieves the `bbox` -#' field of a `STACItemCollection` or a `STACItem` object. +#' field of a `doc_items` or a `doc_item` object. #' #' \item `item_assets()`: returns the assets name from -#' `STACItemCollection` and `STACItem` objects. +#' `doc_items` and `doc_item` objects. #' #' \item `items_filter()`: selects only items that match some criteria #' (see details section). #' #' \item `items_reap()`: extract key values by traversing all items -#' in a `STACItemCollection` object. +#' in a `doc_items` object. #' #' \item `items_fields()`: lists field names inside an item. #' -#' \item `items_group()`: `r lifecycle::badge('deprecated')` organizes -#' items as elements of a list using some criteria. -#' #' \item `items_sign()`: allow access assets by preparing its url. #' -#' \item `items_as_sf()`: `r lifecycle::badge('experimental')` convert items to `sf` object. +#' \item `items_as_sf()`: `r lifecycle::badge('experimental')` convert items +#' to `sf` object. +#' +#' \item `items_as_sfc()`: `r lifecycle::badge('experimental')` convert items +#' to `sfc` object. +#' +#' \item `items_intersects()`: `r lifecycle::badge('experimental')` indicates +#' which items intersects a given geometry. +#' +#' \item `items_properties()`: lists properties names inside an item. +#' #' } #' -#' @param items a `STACItemCollection` object. +#' @param items a `doc_items` object. #' #' @param matched_field a `character` vector with the path #' where the number of items returned in the named list is located starting @@ -54,22 +61,25 @@ #' @param progress a `logical` indicating if a progress bar must be #' shown or not. Defaults to `TRUE`. #' -#' @param simplify `r lifecycle::badge('deprecated')` no side-effect -#' #' @param field a `character` with the names of the field to #' get the subfields values. #' #' @param pick_fn a `function` used to pick elements from items #' addressed by `field` parameter. #' -#' @param index an `atomic` vector with values as the group index. -#' #' @param sign_fn a `function` that receives an item as a parameter #' and returns an item signed. #' #' @param filter_fn a `function` that receives an item that should #' evaluate a `logical` value. #' +#' @param crs a `character` representing the geometry projection. +#' +#' @param geom a `sf` or `sfc` object. +#' +#' @param selection an `integer` vector containing the indices of the items +#' to select. +#' #' @param ... additional arguments. See details. #' #' @details @@ -83,11 +93,8 @@ #' methods, such as [add_headers][httr::add_headers] or #' [set_cookies][httr::set_cookies]. #' -#' \item `items_fields()`: ellipsis parameter is deprecated in version -#' 0.9.2 of rstac. Please, use `field` parameter instead. -#' #' \item `items_filter()`: ellipsis is used to pass logical -#' expressions to be evaluated against a `STACItem` field as filter criteria. +#' expressions to be evaluated against a `doc_item` field as filter criteria. #' #' **WARNING:** the evaluation of filter expressions changed in `rstac` 0.9.2. #' Older versions of `rstac` used `properties` field to evaluate filter @@ -118,7 +125,7 @@ #' \item `items_matched()`: returns an `integer` value if the STAC web server #' does support this extension. Otherwise returns `NULL`. #' -#' \item `items_fetch()`: a `STACItemCollection` with all matched items. +#' \item `items_fetch()`: a `doc_items` with all matched items. #' #' \item `items_next()`: fetches a new page from STAC service. #' @@ -126,29 +133,38 @@ #' #' \item `items_bbox()`: returns a `list` with all items' bounding boxes. #' -#' \item `item_assets()`: Returns a `character` value with all assets names -#' of the all items. +#' \item `item_assets()`: returns a `character` value with all assets names +#' of all items. #' -#' \item `items_filter()`: a `STACItemCollection` object. +#' \item `items_filter()`: a `doc_items` object. #' #' \item `items_reap()`: a `vector` if the supplied field is atomic, #' otherwise or a `list`. #' #' \item `items_fields()`: a `character` vector. #' -#' \item `items_group()`: a `list` of `STACItemCollection` objects. -#' -#' \item `items_sign()`: a `STACItemCollection` object with signed assets url. +#' \item `items_sign()`: a `doc_items` object with signed assets url. #' #' \item `items_as_sf()`: a `sf` object. #' +#' \item `items_as_sfc()`: a `sfc` object. +#' +#' \item `items_as_tibble()`: a `tibble` object. +#' +#' \item `items_intersects()`: a `logical` vector. +#' +#' \item `items_properties()`: returns a `character` value with all properties +#' of all items. +#' +#' \item `items_select()`: select features from an items object. +#' #' } #' #' @examples #' \dontrun{ #' x <- stac("https://brazildatacube.dpi.inpe.br/stac") %>% #' stac_search(collections = "CB4-16D-2") %>% -#' stac_search(limit = 500) %>% +#' stac_search(datetime = "2020-01-01/2021-01-01", limit = 500) %>% #' get_request() #' #' x %>% items_length() @@ -162,7 +178,7 @@ #' # Defining BDC token #' Sys.setenv("BDC_ACCESS_KEY" = "token-123") #' -#' # STACItem object +#' # doc_item object #' stac("https://brazildatacube.dpi.inpe.br/stac/") %>% #' stac_search(collections = "CB4-16D-2", limit = 100, #' datetime = "2017-08-01/2018-03-01", @@ -172,7 +188,7 @@ #' } #' #' \dontrun{ -#' # STACItemCollection object +#' # doc_items object #' stac("https://brazildatacube.dpi.inpe.br/stac/") %>% #' stac_search(collections = "CB4-16D-2", limit = 100, #' datetime = "2017-08-01/2018-03-01", @@ -191,7 +207,7 @@ #' } #' #' \dontrun{ -#' # STACItemCollection object +#' # doc_items object #' stac_item <- stac("https://brazildatacube.dpi.inpe.br/stac/") %>% #' stac_search(collections = "CB4-16D-2", limit = 100, #' datetime = "2017-08-01/2018-03-01", @@ -199,6 +215,13 @@ #' get_request() %>% items_fetch(progress = FALSE) #' #' stac_item %>% items_reap(field = c("properties", "datetime")) +#' +#' stac_item %>% items_as_sf() +#' +#' stac_item %>% items_as_tibble() +#' +#' stac_item %>% items_select(c(1, 4, 10, 20)) +#' #' } #' #' @name items_functions @@ -214,24 +237,11 @@ items_length <- function(items) { #' @rdname items_functions #' #' @export -items_length.STACItem <- function(items) { - check_items(items) - return(1) -} - -#' @rdname items_functions -#' -#' @export -items_length.STACItemCollection <- function(items) { +items_length.doc_items <- function(items) { check_items(items) return(length(items$features)) } -#' @rdname items_functions -#' -#' @export -items_length.default <- items_length.STACItem - #' @rdname items_functions #' #' @export @@ -242,43 +252,23 @@ items_matched <- function(items, matched_field = NULL) { #' @rdname items_functions #' #' @export -items_matched.STACItem <- function(items, matched_field = NULL) { - check_items(items) - return(1) -} - -#' @rdname items_functions -#' -#' @export -items_matched.STACItemCollection <- function(items, matched_field = NULL) { +items_matched.doc_items <- function(items, matched_field = NULL) { check_items(items) matched <- NULL - # try by the matched_field provided by user. This allow users specify a # non-standard field for matched items. - if (is.character(matched_field) && matched_field %in% names(items)) { - matched <- as.numeric(items[[matched_field]]) - } - if (is.null(matched)) { - if (stac_version(items) < "0.9.0") - # STAC API < 0.9.0 extensions - matched <- items$`search:metadata`$matched - else - # STAC API >= 0.9.0 extensions - matched <- items$`context`$matched - - # try the last resort: OGC features core spec - if (is.null(matched)) - matched <- items$numberMatched - } - return(matched) + if (is.character(matched_field) && matched_field %in% names(items)) + matched <- as.numeric(items[[matched_field]]) + if (is.null(matched) && "search:metadata" %in% names(items)) + matched <- items$`search:metadata`$matched + if (is.null(matched) && "context" %in% names(items)) + matched <- items$`context`$matched + # try the last resort: OGC features core spec + if (is.null(matched)) + matched <- items$numberMatched + matched } -#' @rdname items_functions -#' -#' @export -items_matched.default <- items_matched.STACItem - #' @rdname items_functions #' #' @export @@ -289,55 +279,48 @@ items_fetch <- function(items, ...) { #' @rdname items_functions #' #' @export -items_fetch.STACItemCollection <- function(items, ..., - progress = TRUE, - matched_field = NULL) { +items_fetch.doc_items <- function(items, ..., + progress = TRUE, + matched_field = NULL) { check_items(items) matched <- items_matched(items, matched_field) - # verify if progress bar can be shown progress <- progress & (!is.null(matched) && (items_length(items) < matched)) - if (progress) + if (progress) { pb <- utils::txtProgressBar( min = items_length(items), max = matched, style = 3 ) - + # close progress bar when exit + on.exit({ + if (progress) { + utils::setTxtProgressBar(pb, matched) + close(pb) + } + }) + } + # Initialize the items + next_items <- items while (TRUE) { - # check if features is complete if (!is.null(matched) && (items_length(items) == matched)) break - # protect against infinite loop if (!is.null(matched) && (items_length(items) > matched)) .error(paste("Length of returned items (%s) is different", "from matched items (%s)."), items_length(items), matched) - - content <- tryCatch({ - items_next(items, ...) - }, - next_error = function(e) NULL - ) - - if (!is.null(content)) - items <- content - else + next_items <- tryCatch({ + items_next(next_items, ...) + }, next_error = function(e) NULL) + if (is.null(next_items)) break - + items$features <- c(items$features, next_items$features) # update progress bar if (progress) - utils::setTxtProgressBar(pb, length(content)) + utils::setTxtProgressBar(pb, length(next_items)) } - - # close progress bar - if (progress) { - utils::setTxtProgressBar(pb, matched) - close(pb) - } - - return(items) + items } #' @rdname items_functions @@ -350,103 +333,47 @@ items_next <- function(items, ...) { #' @rdname items_functions #' #' @export -items_next.STACItemCollection <- function(items, ...) { +items_next.doc_items <- function(items, ...) { check_items(items) - matched <- items_matched(items) - - q <- doc_query(items) - if (is.null(q)) { - .error("Cannot get next link URL", class = "next_error") - } - # get url of the next page - next_url <- Filter(function(x) x$rel == "next", items$links) - if (length(next_url) == 0) - .error("Cannot get next link URL", class = "next_error") - - next_url <- next_url[[1]] - - # create a new stac object with params from the next url + rel <- NULL + next_link <- links(items, rel == "next") + if (length(next_link) == 0) + .error("Cannot get next link URL.", class = "next_error") + next_link <- next_link[[1]] # check for body implementation in next link - if (q$verb == "POST" && all(c("body", "method") %in% names(next_url))) { - - # TODO: check if spec can enforce that the same provided base url - # must be used to proceed pagination. - # For security concerns, here, the original base_url will be used in - # subsequent requests of pagination - - # # update query base_url and verb to the returned one - # q$base_url <- next_url$href - - # erase current parameters if merge == FALSE - if (!is.null(next_url$merge) && !next_url$merge) { - q$params <- list() + verb <- "GET" + if ("method" %in% names(next_link) && next_link$method %in% c("GET", "POST")) + verb <- next_link$method + q <- NULL + if (verb == "POST") { + # POST + q <- attr(items, "query") + if (!is.null(q)) { + # merge content body to next body field + if ("merge" %in% names(next_link) && next_link$merge) + next_link$body <- modify_list(q$params, next_link$body) + next_link$body <- parse_params(q, next_link$body) } - - # get parameters - params <- next_url$body - - } else { - - # TODO: check if spec can enforce that the same provided base url - # must be used to proceed pagination. - # For security concerns, here, the original base_url will be used in - # subsequent requests of pagination - - # # update query base_url and verb to the returned one - # q$base_url <- gsub("^([^?]+)(\\?.*)?$", "\\1", next_url$href) - - # get next link parameters from url - params <- .querystring_decode(substring( - gsub("^([^?]+)(\\?.*)?$", "\\2", next_url$href), 2) + res <- make_post_request( + url = next_link$href, + body = next_link$body, + headers = next_link$headers, + ..., + error_msg = "Error while requesting next page" + ) + } else if (verb == "GET") { + # GET + res <- make_get_request( + url = next_link$href, + headers = next_link$headers, + ..., + error_msg = "Error while requesting next page" ) - - # verify if query params is valid - params <- .validate_query(params = params) - } - - # parse params - params <- parse_params(q, params = params) - - next_stac <- RSTACQuery(version = q$version, - base_url = q$base_url, - params = modify_list(q$params, params), - subclass = subclass(q)) - - # call request - if (q$verb == "GET") { - - content <- get_request(next_stac, ...) - } else if (q$verb == "POST") { - - content <- post_request(next_stac, ..., encode = q$encode) - } else { - .error("Invalid HTTP method.") - } - - # check content response - check_subclass(content, "STACItemCollection") - - # check pagination length - if (!is.null(q$params[["limit"]]) && - items_length(content) > as.numeric(q$params[["limit"]])) { - .error("STAC invalid retrieved page length.") - } - - # check if result length is valid - if (!is.null(matched) && !is.null(q$params[["limit"]]) && - (items_length(content) != as.numeric(q$params[["limit"]])) && - (items_length(content) + items_length(items) != matched)) { - .error("STAC pagination error.") } - - # merge features result into resulting content - content$features <- c(items$features, content$features) - - # prepares next iteration - items <- content - - return(items) + content <- content_response_json(res) + # return items + doc_items(content, query = q) } #' @rdname items_functions @@ -459,27 +386,22 @@ items_datetime <- function(items) { #' @rdname items_functions #' #' @export -items_datetime.STACItem <- function(items) { - check_items(items) +items_datetime.doc_item <- function(items) { + check_item(items) if (!"datetime" %in% names(items$properties)) { - .error("Parameter `items` is invalid.") + .error("Item has no datetime field.") } - return(items$properties$datetime) + items$properties$datetime } #' @rdname items_functions #' #' @export -items_datetime.STACItemCollection <- function(items) { +items_datetime.doc_items <- function(items) { check_items(items) - return(map_chr(items$features, items_datetime)) + map_chr(items$features, items_datetime) } -#' @rdname items_functions -#' -#' @export -items_datetime.default <- items_datetime.STACItem - #' @rdname items_functions #' #' @export @@ -490,15 +412,15 @@ items_bbox <- function(items) { #' @rdname items_functions #' #' @export -items_bbox.STACItem <- function(items) { - check_items(items) +items_bbox.doc_item <- function(items) { + check_item(items) return(items$bbox) } #' @rdname items_functions #' #' @export -items_bbox.STACItemCollection <- function(items) { +items_bbox.doc_items <- function(items) { check_items(items) return(items_reap(items, field = "bbox")) } @@ -506,42 +428,36 @@ items_bbox.STACItemCollection <- function(items) { #' @rdname items_functions #' #' @export -items_bbox.default <- items_bbox.STACItem - -#' @rdname items_functions -#' -#' @export -items_assets <- function(items, simplify = deprecated()) { - if (!missing(simplify)) { - deprec_parameter( - deprec_var = "simplify", - deprec_version = "0.9.2", - msg = "By default, the return will be simplified." - ) - } +items_assets <- function(items) { UseMethod("items_assets", items) } #' @rdname items_functions #' #' @export -items_assets.STACItem <- function(items, simplify = deprecated()) { - check_items(items) - return(items_fields(items, field = "assets")) +items_assets.doc_item <- function(items) { + check_item(items) + if (!"assets" %in% names(items)) + .error("Item has no assets.") + names(items$assets) } #' @rdname items_functions #' #' @export -items_assets.STACItemCollection <- function(items, simplify = deprecated()) { +items_assets.doc_items <- function(items) { check_items(items) - return(sort(unique(unlist(lapply(items$features, items_assets.STACItem))))) + sort(unique(unlist(lapply(items$features, items_assets.doc_item)))) } #' @rdname items_functions #' #' @export -items_assets.default <- items_assets.STACItem +items_assets.default <- function(items) { + if (!"assets" %in% names(items)) + .error("Item has no assets.") + names(items$assets) +} #' @rdname items_functions #' @@ -553,52 +469,29 @@ items_filter <- function(items, ..., filter_fn = NULL) { #' @rdname items_functions #' #' @export -items_filter.STACItemCollection <- function(items, ..., filter_fn = NULL) { - check_items(items) +items_filter.doc_items <- function(items, ..., filter_fn = NULL) { + init_length <- items_length(items) exprs <- unquote( expr = as.list(substitute(list(...), env = environment())[-1]), env = parent.frame() ) - if (length(exprs) > 0) { if (!is.null(names(exprs))) .error("Filter expressions cannot be named.") - - show_warning <- TRUE for (i in seq_along(exprs)) { - if (show_warning && check_old_expression(items, exprs[[i]])) { - # NOTE: this warning will be removed in next versions. We will no - # longer support the old way of filter evaluation - .warning(paste( - "In version 0.9.2, rstac changed how filter expressions are", - "evaluated. In future versions, the expression '%s' will be", - "evaluated against each feature in items intead of `properties`", - "field.\nSee ?items_filter for more details on how to change", - "your expression." - ), deparse(exprs[[i]])) - show_warning <- FALSE - } sel <- map_lgl(items$features, eval_filter_expr, expr = exprs[[i]]) + items$features <- items$features[sel] } - items$features <- items$features[sel] } - if (!is.null(filter_fn)) { - if (check_old_fn(items, filter_fn)) { - # NOTE: this warning will be removed in next versions. We will no - # longer support the old way of filter evaluation - .warning(paste( - "In version 0.9.2, rstac changed how filter function is", - "evaluated. In future versions, the `filter_fn` parameter will be", - "evaluated against each feature in items instead of `properties`", - "field.\nSee ?items_filter for more details on how to change your", - "function." - )) - } sel <- map_lgl(items$features, eval_filter_fn, filter_fn = filter_fn) items$features <- items$features[sel] } - return(items) + if (items_length(items) == 0 && init_length > 0) + .warning(paste("Filter criteria did not match any item.\n", + "Please, see `?items_filter` for more details on", + "how expressions are evaluated by `items_filter()`.")) + items } #' @rdname items_functions @@ -611,7 +504,7 @@ items_compact <- function(items) { #' @rdname items_functions #' #' @export -items_compact.STACItemCollection <- function(items) { +items_compact.doc_items <- function(items) { check_items(items) items_filter(items, filter_fn = has_assets) } @@ -619,79 +512,53 @@ items_compact.STACItemCollection <- function(items) { #' @rdname items_functions #' #' @export -items_reap <- function(items, field, ..., pick_fn = identity) { +items_reap <- function(items, field, pick_fn = identity) { UseMethod("items_reap", items) } #' @rdname items_functions #' #' @export -items_reap.STACItem <- function(items, field, ..., pick_fn = identity) { - check_items(items) - dots <- list(...) - if (length(dots) > 0) { - deprec_parameter( - deprec_var = "...", - deprec_version = "0.9.2", - msg = "Please, use `field` parameter instead." - ) - field = c(field, unlist(dots, use.names = FALSE)) - } - values <- apply_deeply(items, i = field, fn = pick_fn) - return(values) +items_reap.doc_item <- function(items, field, pick_fn = identity) { + check_item(items) + apply_deeply(items, i = field, fn = pick_fn) } #' @rdname items_functions #' #' @export -items_reap.STACItemCollection <- function(items, - field, ..., - pick_fn = identity) { +items_reap.doc_items <- function(items, field, pick_fn = identity) { check_items(items) if (items_length(items) == 0) return(NULL) - dots <- list(...) - if (length(dots) > 0) { - deprec_parameter( - deprec_var = "...", - deprec_version = "0.9.2", - msg = "Please, use `field` parameter instead." - ) - field = c(field, unlist(dots, use.names = FALSE)) - } - val <- lapply(items$features, items_reap.STACItem, field = field, - pick_fn = pick_fn) - if (is.null(names(val)) && - all(vapply(val, function(x) is.atomic(x) && length(x) == 1, logical(1)))) - return(unlist(val)) - return(val) + values <- lapply(items$features, items_reap.doc_item, field = field, + pick_fn = pick_fn) + is_atomic <- all(vapply(values, function(x) { + is.atomic(x) && length(x) == 1 + }, logical(1))) + if (is_atomic) + return(unlist(values)) + values } #' @rdname items_functions #' #' @export -items_reap.default <- items_reap.STACItem +items_reap.default <- function(items, field, pick_fn = identity) { + apply_deeply(items, i = field, fn = pick_fn) +} #' @rdname items_functions #' #' @export -items_fields <- function(items, field = NULL, ...) { +items_fields <- function(items, field = NULL) { UseMethod("items_fields", items) } #' @rdname items_functions #' #' @export -items_fields.STACItem <- function(items, field = NULL, ...) { - check_items(items) - dots <- list(...) - if (length(dots) > 0) { - deprec_parameter( - deprec_var = "...", - deprec_version = "0.9.2", - msg = "Please, use `field` parameter instead." - ) - field = c(field, unlist(dots, use.names = FALSE)) - } +items_fields.doc_item <- function(items, field = NULL) { + check_item(items) if (length(field) == 0) { fields <- names(items) } else { @@ -699,83 +566,218 @@ items_fields.STACItem <- function(items, field = NULL, ...) { items, i = field, fn = names ), use.names = FALSE)) } - return(sort(fields)) + sort(fields) } #' @rdname items_functions #' #' @export -items_fields.STACItemCollection <- function(items, field = NULL, ...) { +items_fields.doc_items <- function(items, field = NULL) { check_items(items) - dots <- list(...) - if (length(dots) > 0) { - deprec_parameter( - deprec_var = "...", - deprec_version = "0.9.2", - msg = "Please, use `field` parameter instead." - ) - field = c(field, unlist(dots, use.names = FALSE)) - } if (items_length(items) == 0) return(NULL) + fields <- apply_deeply(items, i = c("features", "*", field), fn = names) + sort(unique(unlist(unname(fields)))) +} + +#' @rdname items_functions +#' +#' @export +items_sign <- function(items, sign_fn) { + UseMethod("items_sign", items) +} - fields <- lapply(items$features, items_fields.STACItem, field = field) +#' @rdname items_functions +#' +#' @export +items_sign.doc_item <- function(items, sign_fn) { + check_item(items) + sign_fn(items) +} - return(sort(unique(unlist(unname(fields))))) +#' @rdname items_functions +#' +#' @export +items_sign.doc_items <- function(items, sign_fn) { + check_items(items) + foreach_item(items, sign_fn) } #' @rdname items_functions #' #' @export -items_fields.default <- items_fields.STACItem +items_sign.default <- function(items, sign_fn) { + sign_fn(items) +} #' @rdname items_functions #' #' @export -items_sign <- function(items, sign_fn) { - UseMethod("items_sign", items) +items_as_sf <- function(items, ..., crs = 4326) { + UseMethod("items_as_sf", items) +} + +#' @rdname items_functions +#' +#' @export +items_as_sf.doc_item <- function(items, ..., crs = 4326) { + check_item(items) + data <- sf::st_sf( + items_as_tibble(items), + geometry = items_as_sfc(items, crs = crs) + ) + class(data) <- c("sf", "tbl_df", "tbl", "data.frame") + data +} + +#' @rdname items_functions +#' +#' @export +items_as_sf.doc_items <- function(items, ..., crs = 4326) { + check_items(items) + data <- sf::st_sf( + items_as_tibble(items), + geometry = items_as_sfc(items, crs = crs) + ) + #class(data) <- c("sf", "tbl_df", "tbl", "data.frame") + data +} + +#' @rdname items_functions +#' +#' @export +items_as_sfc <- function(items, crs = 4326) { + UseMethod("items_as_sfc", items) +} + +#' @rdname items_functions +#' +#' @export +items_as_sfc.doc_item <- function(items, crs = 4326) { + check_item(items) + sf::st_sfc(get_geom(items$geometry), crs = crs) +} + +#' @rdname items_functions +#' +#' @export +items_as_sfc.doc_items <- function(items, crs = 4326) { + check_items(items) + sf::st_sfc(lapply(items$features, get_geom), crs = crs) +} + +#' @rdname items_functions +#' +#' @export +items_as_tibble <- function(items) { + UseMethod("items_as_tibble", items) +} + +#' @rdname items_functions +#' +#' @export +items_as_tibble.doc_item <- function(items) { + check_item(items) + non_atomic <- non_atomic_properties(items) + items$properties[non_atomic] <- lapply(items$properties[non_atomic], list) + data <- list(items$properties) + data <- do.call(mapply, args = c(list(FUN = c, SIMPLIFY = FALSE), data)) + structure( + data, + class = c("tbl_df", "tbl", "data.frame"), + row.names = if (length(data)) c(NA, -length(data[[1]])) else integer(0) + ) } #' @rdname items_functions #' #' @export -items_sign.STACItem <- function(items, sign_fn) { +items_as_tibble.doc_items <- function(items) { check_items(items) - return(sign_fn(items)) + non_atomic <- non_atomic_properties(items) + data <- lapply(items$features, function(item) { + item$properties[non_atomic] <- lapply(item$properties[non_atomic], list) + item$properties + }) + data <- do.call(mapply, args = c(list(FUN = c, SIMPLIFY = FALSE), data)) + structure( + data, + class = c("tbl_df", "tbl", "data.frame"), + row.names = if (length(data)) c(NA, -length(data[[1]])) else integer(0) + ) +} + +#' @rdname items_functions +#' +#' @export +items_intersects <- function(items, geom, ..., crs = 4326) { + UseMethod("items_intersects", items) } #' @rdname items_functions #' #' @export -items_sign.STACItemCollection <- function(items, sign_fn) { +items_intersects.doc_item <- function(items, geom, ..., crs = 4326) { + check_item(items) + items_geom <- items_as_sfc(items, crs = crs) + geom <- sf::st_transform(geom, crs = crs) + apply(sf::st_intersects(items_geom, geom), 1, any) > 0 +} + +#' @rdname items_functions +#' +#' @export +items_intersects.doc_items <- function(items, geom, ..., crs = 4326) { check_items(items) - return(foreach_item(items, sign_fn)) + items_geom <- items_as_sfc(items, crs = crs) + geom <- sf::st_transform(geom, crs = crs) + apply(sf::st_intersects(items_geom, geom), 1, any) > 0 } #' @rdname items_functions #' #' @export -items_sign.default <- items_sign.STACItem +items_properties <- function(items) { + UseMethod("items_properties", items) +} #' @rdname items_functions #' #' @export -items_as_sf <- function(items) { - UseMethod("items_as_sf", items) +items_properties.doc_item <- function(items) { + check_item(items) + sort(names(items$properties)) } #' @rdname items_functions #' #' @export -items_as_sf.STACItem <- function(items) { +items_properties.doc_items <- function(items) { check_items(items) - geojsonsf::geojson_sf(to_json(items)) + sort(unique(unlist(lapply(items$features, function(item) { + names(item$properties) + })))) +} + +#' @rdname items_functions +#' +#' @export +items_select <- function(items, selection) { + UseMethod("items_select", items) } #' @rdname items_functions #' #' @export -items_as_sf.STACItemCollection <- function(items) { +items_select.doc_items <- function(items, selection) { check_items(items) - geojsonsf::geojson_sf(to_json(items)) + items$features <- items$features[selection] + # clear numberMatched information + if ("search:metadata" %in% names(items)) + items$`search:metadata`$matched <- NULL + if ("context" %in% names(items)) + items$`context`$matched <- NULL + if ("numberMatched" %in% names(items)) + items$numberMatched <- NULL + items } diff --git a/R/items-query.R b/R/items-query.R index 9925bd85..50020f60 100644 --- a/R/items-query.R +++ b/R/items-query.R @@ -16,7 +16,7 @@ #' The endpoint \code{/collections/\{collectionId\}/items} accepts the same #' filters parameters of [stac_search()] function. #' -#' @param q a `RSTACQuery` object expressing a STAC query +#' @param q a `rstac_query` object expressing a STAC query #' criteria. #' #' @param feature_id a `character` with item id to be fetched. @@ -66,7 +66,7 @@ #' [collections()] #' #' @return -#' A `RSTACQuery` object with the subclass `items` for +#' A `rstac_query` object with the subclass `items` for #' \code{/collections/{collection_id}/items} endpoint, or a #' `item_id` subclass for #' \code{/collections/{collection_id}/items/{feature_id}} endpoint, @@ -87,112 +87,63 @@ #' } #' #' @export -items <- function(q, feature_id = NULL, - datetime = NULL, - bbox = NULL, +items <- function(q, feature_id = NULL, datetime = NULL, bbox = NULL, limit = NULL) { - - # check q parameter - check_subclass(q, c("collection_id", "items")) - + check_query(q, c("collection_id", "items")) params <- list() - if (!is.null(datetime)) - params[["datetime"]] <- .parse_datetime(datetime) - + params$datetime <- .parse_datetime(datetime) if (!is.null(bbox)) - params[["bbox"]] <- .parse_bbox(bbox) - + params$bbox <- .parse_bbox(bbox) if (!is.null(limit) && !is.null(limit)) - params[["limit"]] <- .parse_limit(limit) - + params$limit <- .parse_limit(limit) # set subclass subclass <- "items" if (!is.null(feature_id)) { - - params[["feature_id"]] <- .parse_feature_id(feature_id) - + params$feature_id <- .parse_feature_id(feature_id) subclass <- "item_id" } - - RSTACQuery(version = q$version, - base_url = q$base_url, - params = utils::modifyList(q$params, params), - subclass = subclass) + rstac_query( + version = q$version, + base_url = q$base_url, + params = utils::modifyList(q$params, params), + subclass = subclass + ) } #' @export parse_params.items <- function(q, params) { - if (!is.null(params[["datetime"]])) - params[["datetime"]] <- .parse_datetime(params[["datetime"]]) - - if (!is.null(params[["bbox"]])) - params[["bbox"]] <- .parse_bbox(params[["bbox"]]) - - if (!is.null(params[["limit"]])) - params[["limit"]] <- .parse_limit(params[["limit"]]) - + if (!is.null(params$datetime)) + params$datetime <- .parse_datetime(params$datetime) + if (!is.null(params$bbox)) + params$bbox <- .parse_bbox(params$bbox) + if (!is.null(params$limit)) + params$limit <- .parse_limit(params$limit) params } -#' @export -endpoint.items <- function(q) { - - return(paste("/collections", q$params[["collection_id"]], "items", sep = "/")) -} - #' @export before_request.items <- function(q) { - check_query_verb(q, verbs = c("GET", "POST")) - - # don't send 'collection_id' in url's query string or content body - q <- omit_query_params(q, names = "collection_id") - - return(q) + set_query_endpoint(q, endpoint = "./collections/%s/items", + params = "collection_id") } #' @export after_response.items <- function(q, res) { - content <- content_response( - 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, - subclass = "STACItem") - } - RSTACDocument(content = content, q = q, subclass = "STACItemCollection") -} - -#' @export -endpoint.item_id <- function(q) { - - return(paste("/collections", q$params[["collection_id"]], "items", - q$params[["feature_id"]], sep = "/")) + content <- content_response_json(res) + doc_items(content, query = q) } #' @export before_request.item_id <- function(q) { - check_query_verb(q, verbs = c("GET", "POST")) - - # don't send 'collection_id' and 'feature_id' in - # url's query string or content body - q <- omit_query_params(q, names = c("collection_id", "feature_id")) - - return(q) + set_query_endpoint(q, endpoint = "./collections/%s/items/%s", + params = c("collection_id", "feature_id")) } #' @export after_response.item_id <- function(q, res) { - content <- content_response( - res, - status_codes = "200", - content_types = "application/.*json", - key_message = c("message", "description", "detail") - ) - RSTACDocument(content = content, q = q, subclass = "STACItem") + content <- content_response_json(res) + doc_item(content) } diff --git a/R/items-utils.R b/R/items-utils.R index a5a02329..f339caff 100644 --- a/R/items-utils.R +++ b/R/items-utils.R @@ -1,79 +1,30 @@ eval_filter_expr <- function(f, expr) { - # NOTE: this tryCatch will be removed in next versions. - # We will no longer support the old way of filter evaluation - val <- tryCatch({ - f$properties$properties <- NULL - eval(expr, envir = f$properties, - enclos = parent.env(parent.frame())) + value <- tryCatch({ + eval(expr, envir = f, enclos = parent.env(parent.frame())) }, error = function(e) { - return(NULL) + return(FALSE) }) - - if (length(val) == 0) { - val <- tryCatch({ - eval(expr, envir = f, enclos = parent.env(parent.frame())) - }, error = function(e) { - return(FALSE) - }) - } - - if (length(val) == 0) { - val <- FALSE - } - return(val) + if (length(value) == 0) + value <- FALSE + value } eval_filter_fn <- function(f, filter_fn) { - # NOTE: this tryCatch will be removed in next versions. - # We will no longer support the old way of filter evaluation - val <- tryCatch({ - f$properties$properties <- NULL - filter_fn(f$properties) + value <- tryCatch({ + filter_fn(f) }, error = function(e) { - return(NULL) - }) - - if (length(val) == 0) { - val <- tryCatch({ - filter_fn(f) - }, error = function(e) { - return(FALSE) - }) - } - - if (length(val) == 0) { - val <- FALSE - } - return(val) -} - -# NOTE: this function will be removed in next versions. -# We will no longer support the old way of filter evaluation -check_old_expression <- function(items, expr) { - val <- map_lgl(items$features, function(f) { - f$properties$properties <- NULL - tryCatch({ - val <- eval(expr, envir = f$properties, - enclos = parent.env(parent.frame())) - is.logical(val) && length(val) > 0 - }, error = function(e) { - return(FALSE) - }) + return(FALSE) }) - return(any(val)) + if (length(value) == 0) + value <- FALSE + value } -# NOTE: this function will be removed in next versions. -# We will no longer support the old way of filter evaluation -check_old_fn <- function(items, fn) { - val <- map_lgl(items$features, function(f) { - f$properties$properties <- NULL - tryCatch({ - val <- fn(f$properties) - is.logical(val) && length(val) > 0 - }, error = function(e) { - return(FALSE) - }) - }) - return(any(val)) +non_atomic_properties <- function(items) { + unique(unlist(lapply(items$features, function(item) { + non_atomic <- vapply(item$properties, function(x) { + length(x) == 0 || !is.atomic(x) || length(x) > 1 + }, FUN.VALUE = logical(1), USE.NAMES = FALSE) + names(item$properties)[non_atomic] + }))) } diff --git a/R/parse-utils.R b/R/parse-utils.R index 1e86c80d..c8652beb 100644 --- a/R/parse-utils.R +++ b/R/parse-utils.R @@ -17,26 +17,19 @@ #' #' @noRd .parse_bbox <- function(bbox) { - if (is.character(bbox)) bbox <- strsplit(bbox, ",")[[1]] - if (!length(bbox) %in% c(4, 6)) .error("Param `bbox` must have 4 or 6 numbers, not %s.", length(bbox)) - if (length(bbox) == 4) { - if (bbox[[2]] > bbox[[4]]) bbox <- bbox[c(1, 4, 3, 2)] } else { - if (bbox[[2]] > bbox[[5]]) bbox <- bbox[c(1, 5, 3, 4, 2, 6)] - if (bbox[[3]] > bbox[[6]]) bbox <- bbox[c(1, 2, 6, 4, 5, 3)] } - return(bbox) } @@ -50,17 +43,12 @@ #' #' @noRd .parse_limit <- function(limit) { - if (length(limit) != 1) .error("Parameter `limit` must be a single value.") - limit <- as.character(limit) - limit_int <- suppressWarnings(as.integer(limit)) - if (any(is.na(as.integer(limit))) || as.character(limit_int) != limit) .error("Param `limit` must be an integer.") - return(limit) } @@ -75,10 +63,8 @@ #' #' @noRd .parse_feature_id <- function(feature_id) { - if (length(feature_id) != 1) .error("Parameter `feature_id` must be a single value.") - return(feature_id) } @@ -92,19 +78,15 @@ #' #' @noRd .parse_collections <- function(collections) { - - if (is.list(collections)) - for (e in collections) - check_character(e, "Collection name must be a character value.") - else + if (is.list(collections)) { + for (col in collections) + check_character(col, "Collection name must be a character value.") + } else check_character(collections, "Collection name must be a character value.") - if (is.character(collections) && length(collections) == 1) collections <- strsplit(collections, ",")[[1]] - if (is.character(collections)) collections <- as.list(collections) - return(collections) } @@ -117,7 +99,6 @@ #' #' @noRd .parse_ids <- function(ids) { - if (is.list(ids)) { ids <- lapply(ids, function(id) { if (is.numeric(id)) @@ -133,7 +114,6 @@ ids <- strsplit(ids, ",")[[1]] ids <- as.list(ids) } - return(ids) } @@ -174,109 +154,48 @@ #' #' @noRd .parse_datetime <- function(datetime) { - # check if the date time provided is an open interval check_interval <- grepl("(?=^(\\..\\/.*)).+|(.*/\\..)", datetime, perl = TRUE) - if (check_interval) { # regex to separate the open interval elements split_datetime <- strsplit(datetime, "(\\/\\..)|(\\..\\/)", perl = TRUE) split_datetime <- split_datetime[[1]][which(unlist(split_datetime) != "")] - # checking if date time is in the RFC standards match_rfc <- .check_rfc_3339(split_datetime) - if (!match_rfc) .error(paste("The interval date time provided is not in RFC format,", "please check the RFC 3339 rules.")) - return(datetime) } else { - # Splits the vector elements with the dates by the backslash split_datetime <- strsplit(datetime, "/", perl = TRUE) split_datetime <- unlist(split_datetime) - # In case the vector has two elements it is a closed date time if (length(split_datetime) == 2) { # Checks if there is FALSE value in vector if (!all(.check_rfc_3339(split_datetime))) .error(paste0("The date time provided not follow the RFC 3339 format,", "please check the RFC 3339 rules.")) - # formatting the closed date time according to the RFC interval_dt <- as.POSIXct(split_datetime, tz = "UTC", tryFormats = c("%Y-%m-%dT%H:%M:%SZ", "%Y-%m-%d")) - # Check the interval, if the interval is wrong an error is returned if (interval_dt[1] > interval_dt[2]) { .error(paste("The closed date time provided is not in correct", "interval, the first date time shold be less than", "second.")) } - return(datetime) } - - # Check if date time is a fixed interval else { + # Check if date time is a fixed interval if (!all(.check_rfc_3339(split_datetime)) || length(split_datetime) != 1) .error(paste("The date time provided not follow the RFC 3339 format,", "please check the RFC 3339 rules.")) - return(datetime) } } } - -iso_3339_date_fullyear <- "[0-9]{4}" -iso_3339_date_month <- "(1[0-2]|0[1-9])" -iso_3339_date_mday <- "(3[01]|[12][0-9]|0[1-9])" -iso_3339_time_hour <- "(2[0-3]|[01][0-9])" -iso_3339_time_minute <- "([0-5][0-9])" -iso_3339_time_second <- "(60|[0-5][0-9])" -iso_3339_time_secfrac <- "(\\.[0-9]+)?" -iso_3339_time_numoffset <- paste0( - "[+-]", - paste( - iso_3339_time_hour, - iso_3339_time_minute, - sep = ":" - ) -) -iso_3339_time_offset <- paste0( - "(Z|", iso_3339_time_numoffset, ")" -) -iso_3339_partial_time <- paste0( - paste( - iso_3339_time_hour, - iso_3339_time_minute, - iso_3339_time_second, - sep = ":" - ), - iso_3339_time_secfrac -) -iso_3339_full_date <- paste( - iso_3339_date_fullyear, - iso_3339_date_month, - iso_3339_date_mday, - sep = "-" -) -iso_3339_full_time <- paste0( - iso_3339_partial_time, - iso_3339_time_offset -) -iso_3339_date_time <- paste0( - iso_3339_full_date, - "T", - iso_3339_full_time -) -grep_iso_3339_date <- function(x) { - grepl(paste0("^", iso_3339_full_date, "$"), x) -} -grep_iso_3339_date_time <- function(x) { - grepl(paste0("^", iso_3339_date_time, "$"), x) -} diff --git a/R/preview-utils.R b/R/preview-utils.R index 61efe433..eac51640 100644 --- a/R/preview-utils.R +++ b/R/preview-utils.R @@ -50,7 +50,7 @@ preview_read_file <- function(url) { make_get_request( url = url, httr::write_disk(path = temp_file, overwrite = TRUE), - error_msg = "Error in downloading" + error_msg = "Error while downloading" ) preview_switch( url, diff --git a/R/print.R b/R/print.R index cac9fd0e..75113fca 100644 --- a/R/print.R +++ b/R/print.R @@ -3,20 +3,20 @@ #' @description The print function covers all objects in the rstac package: #' #' \itemize{ -#' \item [stac()]: returns a `STACCatalog` document from +#' \item [stac()]: returns a `doc_catalog` document from #' `/stac` (v0.8.0) or `/` (v0.9.0 or v1.0.0) endpoint. -#' \item [stac_search()]: returns a `STACItemCollection` +#' \item [stac_search()]: returns a `doc_items` #' document from `/stac/search` (v0.8.0) or `/search` #' (v0.9.0 or v1.0.0) endpoint containing all Items that match #' the provided search predicates. #' \item [collections()]: implements the `/collections` and #' \code{/collections/\{collectionId\}} endpoints. The former returns -#' a `STACCollectionList` document that lists all collections published -#' by the server, and the later returns a single `STACCollection` +#' a `doc_collections` document that lists all collections published +#' by the server, and the later returns a single `doc_collection` #' document that describes a unique collection. -#' \item [items()]: retrieves a `STACItemCollection` document +#' \item [items()]: retrieves a `doc_items` document #' from \code{/collections/\{collectionId\}/items} endpoint and a -#' `STACItem` document from +#' `doc_item` document from #' \code{/collections/\{collectionId\}/items/\{itemId\}} endpoints. #' } #' @@ -27,19 +27,19 @@ #' Call `print()` function to print the rstac's objects. #' You can determine how many items will be printed using `n` parameter. #' -#' @param x either a `RSTACQuery` object expressing a STAC query -#' criteria or any `RSTACDocument`. +#' @param x either a `rstac_query` object expressing a STAC query +#' criteria or any `rstac_doc`. #' #' @param n number of entries to print. Each object has its own rule of -#' truncation: the `STACCollection` objects will print +#' truncation: the `doc_collection` objects will print #' 10 links by default. If the object has less than 20 collections, all -#' collections will be shown. In `STACItemCollection`, 10 features +#' collections will be shown. In `doc_items`, 10 features #' will be printed by default. To show all entries, use `n = Inf`. #' #' @param ... other parameters passed in the functions. #' #' @param tail A `logical` value indicating if last features in -#' STACItemCollection object must be show. +#' doc_items object must be show. #' #' @seealso #' [stac()] [stac_search()] [collections()] @@ -47,7 +47,7 @@ #' #' @examples #' \dontrun{ -#' # STACItemCollection object +#' # doc_items object #' stac_item_collection <- #' stac("https://brazildatacube.dpi.inpe.br/stac/") %>% #' stac_search(collections = "CB4-16D-2", @@ -57,7 +57,7 @@ #' #' print(stac_item_collection, n = 10) #' -#' # STACCollectionList object +#' # doc_collections object #' stac_collection <- #' stac("https://brazildatacube.dpi.inpe.br/stac/") %>% #' collections() %>% @@ -65,19 +65,19 @@ #' #' print(stac_collection, n = 5) #' -#' # RSTACQuery object +#' # rstac_query object #' obj_rstac <- stac("https://brazildatacube.dpi.inpe.br/stac/") #' #' print(obj_rstac) #' } NULL -# ---- RSTACQuery ---- +# ---- rstac_query ---- #' @rdname print #' @export -print.RSTACQuery <- function(x, ...) { - cat(crayon::bold("###RSTACQuery"), fill = TRUE) +print.rstac_query <- function(x, ...) { + cat(crayon::bold("###rstac_query"), fill = TRUE) cat("-", crayon::bold("url:"), x$base_url, fill = TRUE) cat("-", crayon::bold("params:"), fill = TRUE) for (n in names(x$params)) { @@ -89,12 +89,12 @@ print.RSTACQuery <- function(x, ...) { invisible(x) } -# ---- STACCatalog ---- +# ---- doc_catalog ---- #' @rdname print #' @export -print.STACCatalog <- function(x, ...) { - cat(crayon::bold("###STACCatalog"), fill = TRUE) +print.doc_catalog <- function(x, ...) { + cat(crayon::bold("###Catalog"), fill = TRUE) cat("-", crayon::bold("id:"), x$id, fill = TRUE) if (!is.null(x$description) && x$description != "") cat("-", crayon::bold("description:"), x$description, fill = TRUE) @@ -104,12 +104,12 @@ print.STACCatalog <- function(x, ...) { invisible(x) } -# ---- STACCollectionList ---- +# ---- doc_collections ---- #' @rdname print #' @export -print.STACCollectionList <- function(x, n = 10, ...) { - cat(crayon::bold("###STACCollectionList"), fill = TRUE) +print.doc_collections <- function(x, n = 10, ...) { + cat(crayon::bold("###Collections"), fill = TRUE) cat("-", crayon::bold("collections"), sprintf("(%s item(s)):", length(x$collections)), fill = TRUE) @@ -128,12 +128,12 @@ print.STACCollectionList <- function(x, n = 10, ...) { invisible(x) } -# ---- STACCollection ---- +# ---- doc_collection ---- #' @rdname print #' @export -print.STACCollection <- function(x, ...) { - cat(crayon::bold("###STACCollection"), fill = TRUE) +print.doc_collection <- function(x, ...) { + cat(crayon::bold("###Collection"), fill = TRUE) cat("-", crayon::bold("id:"), x$id, fill = TRUE) if (!is.null(x$title) && x$title != "") cat("-", crayon::bold("title:"), x$title, fill = TRUE) @@ -144,28 +144,24 @@ print.STACCollection <- function(x, ...) { invisible(x) } -# ---- STACItemCollection ---- +# ---- doc_items ---- #' @rdname print #' @export -print.STACItemCollection <- function(x, n = 10, ..., tail = FALSE) { - cat(crayon::bold("###STACItemCollection"), fill = TRUE) +print.doc_items <- function(x, n = 10, ..., tail = FALSE) { + cat(crayon::bold("###Items"), fill = TRUE) matched <- suppressWarnings(items_matched(x)) - if (!is.null(matched)) + if (!is.null(matched)) { cat("-", crayon::bold("matched feature(s):"), matched, fill = TRUE) - - if (!is.null(matched)) cat("-", crayon::bold("features"), sprintf("(%s item(s) / %s not fetched):", length(x$features), matched - length(x$features)), fill = TRUE) - else + } else cat("-", crayon::bold("features"), sprintf("(%s item(s)):", length(x$features)), fill = TRUE) - if (missing(n) && length(x$features) < 2 * n) n <- length(x$features) n <- min(n, length(x$features)) - seq_it <- seq_len(n) if (tail) seq_it <- seq.int(to = length(x$features), length.out = n) @@ -177,7 +173,6 @@ print.STACItemCollection <- function(x, n = 10, ..., tail = FALSE) { if (n != length(x$features)) cat(sprintf(" - ... with %s more feature(s).", length(x$features) - n), fill = TRUE) - cat("-", crayon::bold("assets:"), paste0(items_assets(x), collapse = ", "), fill = TRUE) @@ -186,12 +181,12 @@ print.STACItemCollection <- function(x, n = 10, ..., tail = FALSE) { invisible(x) } -# ---- STACItem ---- +# ---- doc_item ---- #' @rdname print #' @export -print.STACItem <- function(x, ...) { - cat(crayon::bold("###STACItem"), fill = TRUE) +print.doc_item <- function(x, ...) { + cat(crayon::bold("###Item"), fill = TRUE) cat("-", crayon::bold("id:"), x$id, fill = TRUE) cat("-", crayon::bold("collection:"), x$collection, fill = TRUE) cat("-", crayon::bold("bbox:"), format_bbox(x$bbox), fill = TRUE) @@ -204,48 +199,97 @@ print.STACItem <- function(x, ...) { invisible(x) } -# ---- Queryables ---- +# ---- doc_queryables ---- #' @rdname print #' @export -print.Queryables <- function(x, n = 10, ...) { +print.doc_queryables <- function(x, n = 10, ...) { cat(crayon::bold("###Queryables"), fill = TRUE) - if (missing(n) && length(x$properties) < 2 * n) { n <- length(x$properties) } n <- min(n, length(x$properties)) + cat("-", crayon::bold("properties"), + sprintf("(%s entries(s)):", length(x$properties)), fill = TRUE) if (n > 0) { seq_it <- seq_len(n) - cat("-", crayon::bold("properties"), fill = TRUE) for (i in seq_it) { e <- names(x$properties[i]) cat(paste0(" - ", e), fill = TRUE) } + if (n != length(x$properties)) + cat(sprintf(" - ... with %s more entry(ies).", + length(x$properties) - n), fill = TRUE) } - cat("-", crayon::bold("field(s):"), - paste0(names(x), collapse = ", "), fill = TRUE) + cat("-", crayon::bold("field(s):"), paste0(names(x), collapse = ", "), + fill = TRUE) invisible(x) } -# ---- Conformance ---- +# ---- doc_conformance ---- #' @rdname print #' @export -print.Conformance <- function(x, n = 5, ...) { +print.doc_conformance <- function(x, n = 10, ...) { cat(crayon::bold("###Conformance"), fill = TRUE) - if (missing(n) && length(x$conformsTo) < 2 * n) { n <- length(x$conformsTo) } n <- min(n, length(x$conformsTo)) + cat("-", crayon::bold("conformances"), + sprintf("(%s entries(s)):", length(x$conformsTo)), fill = TRUE) if (n > 0) { seq_it <- seq_len(n) - cat("-", crayon::bold("conformsTo: "), fill = TRUE) for (i in seq_it) { e <- x$conformsTo[[i]] cat(paste0(" - ", e), fill = TRUE) } + if (n != length(x$conformsTo)) + cat(sprintf(" - ... with %s more entry(ies).", + length(x$conformsTo) - n), fill = TRUE) + } + invisible(x) +} + +# ---- Links ---- + +#' @rdname print +#' @export +print.doc_link <- function(x, ...) { + cat(crayon::bold("###Link"), fill = TRUE) + if ("title" %in% names(x)) + cat("-", crayon::bold(x$title), fill = TRUE) + cat("-", crayon::bold("href:"), x$href, fill = TRUE) + cat("-", crayon::bold("rel:"), x$rel, fill = TRUE) + cat("-", crayon::bold("field(s):"), + paste0(names(x), collapse = ", "), fill = TRUE) + invisible(x) +} + +#' @rdname print +#' @export +print.doc_links <- function(x, n = 10, ...) { + cat(crayon::bold("###Links"), fill = TRUE) + if (missing(n) && length(x) < 2 * n) + n <- length(x) + n <- min(n, length(x)) + cat("-", crayon::bold("links"), + sprintf("(%s entries(s)):", length(x)), fill = TRUE) + if (n > 0) { + seq_it <- seq_len(n) + seq_format <- format(seq_it, width = min(3, floor(log10(n)) + 1)) + for (i in seq_it) { + if ("title" %in% names(x[[i]])) { + cat(seq_format[[i]], crayon::bold(x[[i]]$title), + paste0("(", x[[i]]$href, ")"), fill = TRUE) + } else if ("rel" %in% names(x[[i]])) { + cat(seq_format[[i]], crayon::bold(paste0("[", x[[i]]$rel, "]")), + paste0("(", x[[i]]$href, ")"), fill = TRUE) + } else + cat(seq_format[[i]], paste0("(", x[[i]]$href, ")"), fill = TRUE) + } + if (n != length(x)) + cat(sprintf(" ... with %s more link(s).", length(x) - n), fill = TRUE) } invisible(x) } diff --git a/R/query-funs.R b/R/query-funs.R index f8ad356e..6a299039 100644 --- a/R/query-funs.R +++ b/R/query-funs.R @@ -1,8 +1,8 @@ #' @title Query development functions #' #' @describeIn extensions -#' The `RSTACQuery()` function is a constructor of `RSTACQuery` -#' objects. Every extension must implement a subclass of `RSTACQuery` to +#' The `rstac_query()` function is a constructor of `rstac_query` +#' objects. Every extension must implement a subclass of `rstac_query` to #' represent its queries. This is done by informing to the `subclass` #' parameter the extension's subclass name. #' @@ -32,9 +32,9 @@ #' object to be created. #' #' @return -#' The `RSTACQuery()` function returns a `STACQuery` object with +#' The `rstac_query()` function returns a `STACQuery` object with #' subclass defined by `subclass` parameter. -RSTACQuery <- function(version = NULL, base_url, params = list(), subclass) { +rstac_query <- function(version = NULL, base_url, params = list(), subclass) { structure( list(version = version, base_url = base_url, @@ -42,43 +42,32 @@ RSTACQuery <- function(version = NULL, base_url, params = list(), subclass) { params = params, verb = "GET", encode = NULL), - class = c(subclass, "RSTACQuery")) + class = c(subclass, "rstac_query")) } #' @export -stac_version.RSTACQuery <- function(x, ...) { - +stac_version.rstac_query <- function(x, ...) { if (!is.null(x$version)) return(x$version) - version <- NULL # check in '/' endpoint res <- make_get_request( - url = make_url(x$base_url, endpoint = "/"), ... + url = resolve_url(x$base_url, "./"), + ... ) if (!is.null(res)) { - content <- content_response( - res, - status_codes = "200", - content_types = "application/.*json", - key_message = c("message", "description", "detail") - ) - version <- content[["stac_version"]] + content <- content_response_json(res) + version <- content$stac_version } - - # if no version was found, try '/stac' endpoint + # if no version was found, try './stac' endpoint if (is.null(version)) { res <- make_get_request( - url = make_url(x$base_url, endpoint = "/stac"), ..., error_msg = NULL + url = resolve_url(x$base_url, "./stac"), + ... ) if (!is.null(res)) { - content <- content_response( - res, - status_codes = "200", - content_types = "application/.*json", - key_message = c("message", "description", "detail") - ) - version <- content[["stac_version"]] + content <- content_response_json(res) + version <- content$stac_version } } if (is.null(version)) @@ -86,38 +75,14 @@ stac_version.RSTACQuery <- function(x, ...) { "Could not determine STAC version in URL '%s'.", "Please, use 'force_version' parameter in stac() function" ), x$base_url) - - return(version) -} - -#' @export -subclass.RSTACQuery <- function(x) { - - setdiff(class(x), "RSTACQuery") -} - -#' @export -check_subclass.RSTACQuery <- function(x, subclasses) { - - if (!any(subclasses %in% subclass(x))) - .error("Expecting %s query.", - paste0("`", subclasses, "`", collapse = " or ")) -} - -#' @export -endpoint.RSTACQuery <- function(q) { - - .error("No endpoint was defined for the extension `%s`.", subclass(q)) + version } #' @export -before_request.RSTACQuery <- function(q) { - - check_query_verb(q, "") +subclass.rstac_query <- function(x) { + setdiff(class(x), "rstac_query") } -#' @export -after_response.RSTACQuery <- function(q, res) { - - check_query_verb(q, "") +query_class <- function(q) { + class(q)[[1]] } diff --git a/R/queryables-query.R b/R/queryables-query.R index aa80a415..82a1daf6 100644 --- a/R/queryables-query.R +++ b/R/queryables-query.R @@ -6,64 +6,49 @@ #' This endpoint can be accessed from the catalog (`/queryables`) #' or from a collection (`/collections/{collection_id}/queryables`). #' -#' @param q a `RSTACQuery` object expressing a STAC query criteria. +#' @param q a `rstac_query` object expressing a STAC query criteria. #' #' @seealso [ext_filter()], [conformance()], [collections()] #' #' @return -#' A `RSTACQuery` object with the subclass `queryables` for `/queryables` +#' A `rstac_query` object with the subclass `queryables` for `/queryables` #' endpoint. #' #' @examples #' \dontrun{ #' # Catalog's queryables -#' rstac::stac("https://planetarycomputer.microsoft.com/api/stac/v1") %>% -#' rstac::queryables() %>% rstac::get_request() +#' stac("https://planetarycomputer.microsoft.com/api/stac/v1") %>% +#' queryables() %>% get_request() #' #' # Collection's queryables -#' rstac::stac("https://planetarycomputer.microsoft.com/api/stac/v1") %>% -#' rstac::collections(collection_id = "sentinel-2-l2a") %>% -#' rstac::queryables() %>% -#' rstac::get_request() +#' stac("https://planetarycomputer.microsoft.com/api/stac/v1") %>% +#' collections(collection_id = "sentinel-2-l2a") %>% +#' queryables() %>% +#' get_request() #' } #' #' @export queryables <- function(q) { - # check q parameter - check_subclass(q, c("collection_id", "stac")) - - RSTACQuery(version = q$version, - base_url = q$base_url, - params = q$params, - subclass = unique(c("queryables", subclass(q)))) -} - -#' @export -endpoint.queryables <- function(q) { - if ("collection_id" %in% subclass(q)) { - col_id <- q$params[["collection_id"]] - return(paste("/collections", col_id, "queryables", sep = "/")) - } - return("/queryables") + check_query(q, c("collection_id", "stac")) + rstac_query( + version = q$version, + base_url = q$base_url, + params = q$params, + subclass = "queryables" + ) } #' @export before_request.queryables <- function(q) { check_query_verb(q, verbs = c("GET", "POST")) - # don't send 'collection_id' in url's query string or content body - if ("collection_id" %in% subclass(q)) { - q <- omit_query_params(q, names = "collection_id") - } - return(q) + if ("collection_id" %in% names(q$params)) + return(set_query_endpoint(q, endpoint = "./collections/%s/queryables", + params = "collection_id")) + set_query_endpoint(q, endpoint = "./queryables") } #' @export after_response.queryables <- function(q, res) { - content <- content_response( - res, - status_codes = "200", - content_types = "application/.*json", - key_message = c("message", "description", "detail") - ) - RSTACDocument(content = content, q = q, subclass = "Queryables") + content <- content_response_json(res) + doc_queryables(content) } diff --git a/R/request.R b/R/request.R index 41eb2d0c..cbc762c7 100644 --- a/R/request.R +++ b/R/request.R @@ -8,7 +8,7 @@ #' The `post_request` is function that makes HTTP POST #' requests to STAC web services, retrieves, and parse the data. #' -#' @param q a `RSTACQuery` object expressing a STAC query +#' @param q a `rstac_query` object expressing a STAC query #' criteria. #' #' @param encode a `character` informing the request body @@ -26,8 +26,8 @@ #' [items()] #' #' @return -#' Either a `STACCatalog`, `STACCollection`, -#' `STACCollectionList`, `STACItemCollection` or `STACItem` +#' Either a `doc_catalog`, `doc_collection`, +#' `doc_collections`, `doc_items` or `doc_item` #' object depending on the subclass and search fields parameters of `q` #' argument. #' @@ -42,118 +42,39 @@ #' } #' @export get_request <- function(q, ...) { - - # check the object class - .check_obj(q, "RSTACQuery") - - # stamp verb + check_query(q) q$verb <- "GET" q$encode <- NULL - - # check version q$version <- stac_version(q, ...) - - # set endpoint - q$endpoint <- endpoint(q) - - # process STAC object q <- before_request(q) - - # process omitted params - q <- .do_omit_query_params(q) - res <- make_get_request( - url = make_url(q$base_url, endpoint = q$endpoint), - query = .querystrings_encode(q$params), ... + url = resolve_url(q$base_url, q$endpoint), + query = query_encode(q$params), + ..., + error_msg = "Error while requesting" ) - - # restore omitted params - q <- .undo_omit_query_params(q) - - # process content according to status-code and content-type - content <- after_response(q, res = res) - - return(content) + # process content and return + after_response(q, res = res) } #' @rdname request #' @export post_request <- function(q, ..., encode = c("json", "multipart", "form")) { - - # check the object class - .check_obj(q, "RSTACQuery") - + check_query(q) # check request settings - httr_encode <- c("json", "multipart", "form") encode <- encode[[1]] - if (!encode %in% httr_encode) - .error("Invalid body `encode` '%s'. Allowed `encode` are %s.", - encode, paste0("'", httr_encode, "'", collapse = ", ")) - - # stamp verb + check_body_encode(encode) q$verb <- "POST" q$encode <- encode - - # detect version q$version <- stac_version(q, ...) - - # set endpoint - q$endpoint <- endpoint(q) - - # process STAC object q <- before_request(q) - - # process omitted params - q <- .do_omit_query_params(q) - - tryCatch({ - res <- httr::POST(url = make_url(q$base_url, endpoint = q$endpoint), ..., - body = q$params, encode = q$encode) - }, - error = function(e) { - .error("Request error. %s", e$message) - }) - - # restore omitted params - q <- .undo_omit_query_params(q) - - # process content according to status-code and content-type - content <- after_response(q, res = res) - - return(content) -} - -#' @describeIn extensions -#' The `.do_omit_query_params()` Function to make the omission of the -#' parameters that were omitted in function `omit_query_params()`. -#' -#' @param q a `RSTACQuery` object. -#' -#' @noRd -.do_omit_query_params <- function(q) { - - if (is.character(q$omitted)) { - - to_omit <- names(q$param) %in% q$omitted - if (length(to_omit) > 0) { - q$omitted <- q$params[to_omit] - q$params[to_omit] <- NULL - } - } - q -} - -#' @describeIn extensions -#' The `.undo_omit_query_params()` function to undo the omission of -#' parameters that were omitted in function `omit_query_params()`. -#' -#' @param q a `RSTACQuery` object. -#' -#' @noRd -.undo_omit_query_params <- function(q) { - - if (is.list(q$omitted)) - q$params <- utils::modifyList(q$params, q$omitted) - q$omitted <- NULL - q + res <- make_post_request( + url = resolve_url(q$base_url, q$endpoint), + body = q$params, + encode = q$encode, + ..., + error_msg = "Error while requesting" + ) + # process content and return + after_response(q, res = res) } diff --git a/R/rstac-funs.R b/R/rstac-funs.R new file mode 100644 index 00000000..5f6c738a --- /dev/null +++ b/R/rstac-funs.R @@ -0,0 +1,15 @@ +# doc_items <- function(items) { +# if (!"features" %in% names(items)) { +# stac_version <- "1.0.0" +# if (length(items) > 0 && "stac_version" %in% names(items[[1]])) { +# stac_version <- items[[1]]$stac_version +# } +# items <- list( +# type = "FeatureCollection", +# stac_version = stac_version, +# features = items +# ) +# } +# items$features <- lapply(items$features, doc_item) +# structure(items, class = c("doc_items", "rstac_doc", "list")) +# } diff --git a/R/rstac.R b/R/rstac.R index c085417b..d0aae7a0 100644 --- a/R/rstac.R +++ b/R/rstac.R @@ -44,9 +44,9 @@ #' } #' #' @section Data types: -#' The package implements the following S3 classes: `STACItemCollection`, -#' `STACItem`, `STACCatalog`, `STACCollectionList` and -#' `STACCollection`. These classes are regular lists representing the +#' The package implements the following S3 classes: `doc_items`, +#' `doc_item`, `doc_catalog`, `doc_collections` and +#' `doc_collection`. These classes are regular lists representing the #' corresponding JSON STAC objects. #' #' @name rstac @@ -58,10 +58,12 @@ NULL #' @export magrittr::`%>%` -#' @importFrom httr GET POST write_disk add_headers content status_code -#' http_type +#' @importFrom utils txtProgressBar setTxtProgressBar modifyList URLdecode +#' @importFrom httr write_disk http_type content status_code parse_url add_headers build_url GET POST +#' @importFrom jsonlite fromJSON read_json +#' @importFrom sf st_geometry st_geometry_type st_sf st_sfc st_transform st_intersects +#' @importFrom grid grid.raster +#' @importFrom png readPNG +#' @importFrom jpeg readJPEG #' @importFrom crayon bold -#' @importFrom utils modifyList URLdecode -#' @importFrom jsonlite fromJSON -#' @importFrom lifecycle deprecated NULL diff --git a/R/stac_search.R b/R/search-query.R similarity index 74% rename from R/stac_search.R rename to R/search-query.R index df1aa317..5c584dd0 100644 --- a/R/stac_search.R +++ b/R/search-query.R @@ -9,10 +9,10 @@ #' It prepares query parameters used in the search API request, a #' `stac` object with all filter parameters to be provided to #' `get_request` or `post_request` functions. The GeoJSON content -#' returned by these requests is a `STACItemCollection` object, a regular R +#' returned by these requests is a `doc_items` object, a regular R #' `list` representing a STAC Item Collection document. #' -#' @param q a `RSTACQuery` object expressing a STAC query +#' @param q a `rstac_query` object expressing a STAC query #' criteria. #' #' @param collections a `character` vector of collection IDs to include in @@ -58,8 +58,8 @@ #' #' @param intersects a `list` expressing GeoJSON geometries #' objects as specified in RFC 7946. Only returns items that intersect with -#' the provided geometry. To turn a GeoJSON into a list the packages -#' `geojsonsf` or `jsonlite` can be used. +#' the provided geometry. To turn a GeoJSON into a list the package +#' `jsonlite` can be used. #' #' @param limit an `integer` defining the maximum number of results #' to return. If not informed, it defaults to the service implementation. @@ -68,7 +68,7 @@ #' [get_request()], [post_request()] #' #' @return -#' A `RSTACQuery` object with the subclass `search` containing all +#' A `rstac_query` object with the subclass `search` containing all #' search field parameters to be provided to STAC API web service. #' #' @examples @@ -94,31 +94,21 @@ stac_search <- function(q, datetime = NULL, intersects = NULL, limit = NULL) { - - # check q parameter - check_subclass(q, c("stac", "search")) - + check_query(q, c("stac", "search")) params <- list() - if (!is.null(collections)) - params[["collections"]] <- .parse_collections(collections) - + params$collections <- .parse_collections(collections) if (!is.null(ids)) - params[["ids"]] <- .parse_ids(ids) - + params$ids <- .parse_ids(ids) if (!is.null(datetime)) - params[["datetime"]] <- .parse_datetime(datetime) - + params$datetime <- .parse_datetime(datetime) if (!is.null(bbox)) - params[["bbox"]] <- .parse_bbox(bbox) - + params$bbox <- .parse_bbox(bbox) if (!is.null(intersects)) - params[["intersects"]] <- .parse_intersects(intersects) - + params$intersects <- .parse_intersects(intersects) if (!is.null(limit)) - params[["limit"]] <- .parse_limit(limit) - - RSTACQuery( + params$limit <- .parse_limit(limit) + rstac_query( version = q$version, base_url = q$base_url, params = utils::modifyList(q$params, params), @@ -128,46 +118,30 @@ stac_search <- function(q, #' @export parse_params.search <- function(q, params) { - - if (!is.null(params[["collections"]])) - params[["collections"]] <- .parse_collections(params[["collections"]]) - - if (!is.null(params[["ids"]])) - params[["ids"]] <- .parse_ids(params[["ids"]]) - - if (!is.null(params[["datetime"]])) - params[["datetime"]] <- .parse_datetime(params[["datetime"]]) - - if (!is.null(params[["bbox"]])) - params[["bbox"]] <- .parse_bbox(params[["bbox"]]) - - if (!is.null(params[["intersects"]])) - params[["intersects"]] <- .parse_intersects(params[["intersects"]]) - - if (!is.null(params[["limit"]])) - params[["limit"]] <- .parse_limit(params[["limit"]]) - + if (!is.null(params$collections)) + params$collections <- .parse_collections(params$collections) + if (!is.null(params$ids)) + params$ids <- .parse_ids(params$ids) + if (!is.null(params$datetime)) + params$datetime <- .parse_datetime(params$datetime) + if (!is.null(params$bbox)) + params$bbox <- .parse_bbox(params$bbox) + if (!is.null(params$intersects)) + params$intersects <- .parse_intersects(params$intersects) + if (!is.null(params$limit)) + params$limit <- .parse_limit(params$limit) params } -#' @export -endpoint.search <- function(q) { - - if (q$version < "0.9.0") - return("/stac/search") - return("/search") -} - #' @export before_request.search <- function(q) { - check_query_verb(q, verbs = c("GET", "POST")) - - if (!is.null(q$params[["intersects"]]) && q$verb == "GET") + if (!is.null(q$params$intersects) && q$verb == "GET") .error(paste0("Search param `intersects` is not supported by HTTP GET", - "method. Try use `post_request` method instead.")) - - return(q) + "method. Try use `post_request()` method instead.")) + if (!is.null(q$version) && q$version < "0.9.0") + return(set_query_endpoint(q, endpoint = "./stac/search")) + set_query_endpoint(q, endpoint = "./search") } #' @export diff --git a/R/signatures.R b/R/signatures.R index 4228de61..2a6b856f 100644 --- a/R/signatures.R +++ b/R/signatures.R @@ -3,9 +3,26 @@ ms_token <- new_env() #' @title Signature in hrefs provided by the STAC from the Brazil Data Cube #' project. #' -#' @description To sign the hrefs with your token you need to store it in an +#' @description +#' These functions provide support to access assets from Brazil Data Cube. +#' +#' \itemize{ +#' \item `items_sign_bdc()`: `r lifecycle::badge('experimental')` +#' A simplified function to sign assets' URL from Brazil Data Cube +#' to be able to access the data. +#' +#' \item `sign_bdc()`: Creates a signing function to be +#' used by `items_sign()`. This function sign all the assets' URL. +#' } +#' +#' To sign the hrefs with your token you need to store it in an #' environment variable in `BDC_ACCESS_KEY`or use `acess_token` parameter. #' +#' @param items a `doc_item` or `doc_items` object +#' representing the result of `/stac/search`, +#' \code{/collections/{collectionId}/items} or +#' \code{/collections/{collectionId}/items/{itemId}} endpoints. +#' #' @param access_token a `character` with the access token parameter to access #' Brazil Data Cube assets. #' @@ -13,20 +30,40 @@ ms_token <- new_env() #' function of the `httr` package. #' #' @return a `function` that signs each item assets. +#' \itemize{ +#' \item `items_sign_bdc()`: items with signed assets URLs. +#' +#' \item `sign_bdc()`: a function to to be passed to `items_sign()`. +#' } #' #' @examples #' \dontrun{ -#' # STACItemCollection object +#' # doc_items object #' stac_obj <- stac("https://brazildatacube.dpi.inpe.br/stac/") %>% #' stac_search(collections = "CB4-16D-2", #' datetime = "2019-06-01/2019-08-01") %>% #' stac_search() %>% #' get_request() #' -#' # signing each item href -#' stac_obj %>% items_sign(sign_fn = sign_bdc(access_token = "123")) +#' # the new way to authenticate: +#' stac_obj <- stac_obj %>% +#' items_sign_bdc("") +#' +#' # this is the old way of authentication (still works): +#' # stac_obj %>% +#' # items_sign(sign_fn = sign_bdc(access_token = "")) #' } #' +#' @name items_sign_bdc +#' +#' @export +items_sign_bdc <- function(items, access_token = NULL, ...) { + sign_fn <- sign_bdc(access_token) + items_sign(items, sign_fn) +} + +#' @rdname items_sign_bdc +#' #' @export sign_bdc <- function(access_token = NULL, ...) { @@ -36,8 +73,9 @@ sign_bdc <- function(access_token = NULL, ...) { # append the same token for an asset parse <- function(obj_req) { - token_str <- paste0("?access_token=", obj_req[["token"]]) - obj_req[["token_value"]] <- httr::parse_url(token_str)[["query"]] + token_str <- paste0("?access_token=", obj_req$token) + parsed_url <- httr::parse_url(token_str) + obj_req$token_value <- parsed_url$query obj_req } @@ -53,7 +91,7 @@ sign_bdc <- function(access_token = NULL, ...) { token[["default"]] <<- list("token" = Sys.getenv("BDC_ACCESS_KEY")) } - token[["default"]] <<- parse(token[["default"]]) + token[["default"]] <<- parse(token$default) } exists_token <- function(item) { @@ -61,7 +99,7 @@ sign_bdc <- function(access_token = NULL, ...) { } get_token_value <- function(item) { - token[["default"]][["token_value"]] + token$default$token_value } # in the current implementation bdc tokens do not expire @@ -75,12 +113,12 @@ sign_bdc <- function(access_token = NULL, ...) { sign_asset <- function(asset, token) { - asset_url <- httr::parse_url(asset[["href"]]) + asset_url <- httr::parse_url(asset$href) # if the href is already sign it will not be modified asset_url$query <- modify_list(asset_url$query, token) - asset[["href"]] <- httr::build_url(asset_url) + asset$href <- httr::build_url(asset_url) asset } @@ -89,8 +127,7 @@ sign_bdc <- function(access_token = NULL, ...) { if (!exists_token(item) || is_token_expired(item)) new_token(item) - item$assets <- lapply(item$assets, sign_asset, - get_token_value(item)) + item$assets <- lapply(item$assets, sign_asset, get_token_value(item)) return(item) } @@ -98,15 +135,31 @@ sign_bdc <- function(access_token = NULL, ...) { return(sign_item) } -#' @title Signature in hrefs provided by the STAC from Microsoft's Planetary -#' Computer. +#' @title Signs URL to access assets from Microsoft's Planetary Computer. +#' +#' @description +#' These functions provide support to access assets from Planetary Computer. #' -#' @description To perform the signing of the hrefs a request is sent to -#' Planetary Computer servers and the returned content corresponds to the -#' token that will be used in the href. +#' \itemize{ +#' \item `items_sign_planetary_computer()`: `r lifecycle::badge('experimental')` +#' A simplified function to sign assets' URL from Microsoft Planetary +#' Computer to be able to access the data. +#' +#' \item `sign_planetary_computer()`: Creates a signing function to be +#' used by `items_sign()`. This function sign all the assets' URL. +#' } +#' +#' @param items a `doc_item` or `doc_items` object +#' representing the result of `/stac/search`, +#' \code{/collections/{collectionId}/items} or +#' \code{/collections/{collectionId}/items/{itemId}} endpoints. +#' +#' @param subscription_key the `subscription-key` to access restricted +#' assets in Microsoft Planetary Computer. You can keep this parameter +#' empty for non-protected assets. #' #' @param ... additional parameters can be supplied to the `GET` function -#' of the `httr` package. +#' of the `httr` package. #' #' @param headers a named character vector with headers key-value content. #' @@ -115,18 +168,29 @@ sign_bdc <- function(access_token = NULL, ...) { #' By default is used: #' `"https://planetarycomputer.microsoft.com/api/sas/v1/token"` #' -#' @return a `function` that signs each item assets. +#' @return +#' \itemize{ +#' \item `items_sign_planetary_computer()`: items with signed assets URLs. +#' +#' \item `sign_planetary_computer()`: a function to to be passed to +#' `items_sign()`. +#' } #' #' @examples #' \dontrun{ -#' # STACItemCollection object +#' # doc_items object #' stac_obj <- stac("https://planetarycomputer.microsoft.com/api/stac/v1/") %>% #' stac_search(collections = "sentinel-2-l2a", #' bbox = c(-47.02148, -17.35063, -42.53906, -12.98314)) %>% #' get_request() #' -#' # signing each asset href -#' stac_obj %>% items_sign(sign_fn = sign_planetary_computer()) +#' # the new way to authenticate: +#' stac_obj <- stac_obj %>% +#' items_sign_planetary_computer() +#' +#' # this is the old way of authentication (still works): +#' # stac_obj <- stac_obj %>% +#' # items_sign(sign_fn = sign_planetary_computer()) #' #' # example of access to collections that require authentication #' stac_obj <- stac("https://planetarycomputer.microsoft.com/api/stac/v1") %>% @@ -135,25 +199,43 @@ sign_bdc <- function(access_token = NULL, ...) { #' datetime = "2019-01-01/2019-01-28") %>% #' post_request() #' -#' # signing each asset href -#' # stac_obj %>% items_sign( -#' # sign_fn = sign_planetary_computer( -#' # headers = c("Ocp-Apim-Subscription-Key" = ) +#' # the new way to authenticate: +#' # stac_obj <- stac_obj %>% +#' # items_sign_planetary_computer("") +#' +#' # this is the old way of authentication (still works): +#' # stac_obj <- stac_obj %>% +#' # items_sign( +#' # sign_fn = sign_planetary_computer( +#' # headers = c("Ocp-Apim-Subscription-Key" = ) +#' # ) #' # ) -#' # ) #' } #' +#' @name items_sign_planetary_computer +#' @export +items_sign_planetary_computer <- function(items, subscription_key = NULL, ...) { + header <- NULL + if (!is.null(subscription_key)) + header <- httr::add_headers( + c("Ocp-Apim-Subscription-Key" = subscription_key) + ) + sign_fn <- sign_planetary_computer(header) + items_sign(items, sign_fn) +} + +#' @rdname items_sign_planetary_computer #' @export sign_planetary_computer <- function(..., headers = NULL, token_url = NULL) { # general info ms_token_endpoint <- "https://planetarycomputer.microsoft.com/api/sas/v1/token" get_ms_info <- function(asset) { - parsed_url <- httr::parse_url(asset[["href"]]) + parsed_url <- httr::parse_url(asset$href) host_spplited <- strsplit( - x = parsed_url[["hostname"]], split = ".", fixed = TRUE + x = parsed_url$hostname, split = ".", fixed = TRUE ) - path_spplited <- strsplit(parsed_url[["path"]], split = "/", fixed = TRUE) + path_spplited <- strsplit(parsed_url$path, split = "/", fixed = TRUE) list( acc = host_spplited[[1]][[1]], @@ -162,17 +244,17 @@ sign_planetary_computer <- function(..., headers = NULL, token_url = NULL) { } get_ms_acc <- function(ms_info) { - ms_info[["acc"]] + ms_info$acc } get_ms_cnt <- function(ms_info) { - ms_info[["cnt"]] + ms_info$cnt } is_public_asset <- function(parsed_url) { ms_blob_name <- ".blob.core.windows.net" ms_public_assets <- "ai4edatasetspublicassets.blob.core.windows.net" - host <- parsed_url[["hostname"]] + host <- parsed_url$hostname !endsWith(host, ms_blob_name) || host == ms_public_assets } @@ -188,8 +270,9 @@ sign_planetary_computer <- function(..., headers = NULL, token_url = NULL) { res[["msft:expiry"]], "%Y-%m-%dT%H:%M:%SZ" )) - token_str <- paste0("?", res[["token"]]) - res[["token_value"]] <- httr::parse_url(token_str)[["query"]] + token_str <- paste0("?", res$token) + parsed_url <- httr::parse_url(token_str) + res$token_value <- parsed_url$query res } @@ -214,29 +297,26 @@ sign_planetary_computer <- function(..., headers = NULL, token_url = NULL) { if (exists_token(acc, cnt) && !is_token_expired(acc, cnt)) return(NULL) res <- make_get_request( url = paste(ms_token_endpoint, acc, cnt, sep = "/"), - httr::add_headers(.headers = headers), ... - ) - res_content <- content_response( - res, - status_codes = "200", - content_types = "application/.*json", - key_message = c("message", "description", "detail") + httr::add_headers(.headers = headers), + ..., + error_msg = "Error while requesting" ) + content <- content_response_json(res) if (!acc %in% names(ms_token)) { assign(acc, value = list(), envir = ms_token) } - ms_token[[acc]][[cnt]] <- parse_token(res_content) + ms_token[[acc]][[cnt]] <- parse_token(content) } get_token <- function(acc, cnt) { new_token(acc, cnt) # get token value from global variable - ms_token[[acc]][[cnt]][["token_value"]] + ms_token[[acc]][[cnt]]$token_value } sign_asset <- function(asset) { # public assets do not require a signature - parsed_url <- httr::parse_url(asset[["href"]]) + parsed_url <- httr::parse_url(asset$href) if (is_public_asset(parsed_url)) { return(asset) } @@ -246,9 +326,9 @@ sign_planetary_computer <- function(..., headers = NULL, token_url = NULL) { # get an existing token or generate a new one token_value <- get_token(account, container) # if the href is already sign it will not be modified - parsed_url$query <- modify_list(parsed_url[["query"]], token_value) + parsed_url$query <- modify_list(parsed_url$query, token_value) - asset[["href"]] <- httr::build_url(parsed_url) + asset$href <- httr::build_url(parsed_url) asset } diff --git a/R/stac_version.R b/R/stac-funs.R similarity index 60% rename from R/stac_version.R rename to R/stac-funs.R index d43d44cb..4d65d1ba 100644 --- a/R/stac_version.R +++ b/R/stac-funs.R @@ -2,11 +2,11 @@ #' #' @description #' These function retrieves information about either `rstac` queries -#' (`RSTACQuery` objects) or `rstac` documents -#' (`RSTACDocument` objects). +#' (`rstac_query` objects) or `rstac` documents +#' (`rstac_doc` objects). #' -#' @param x either a `RSTACQuery` object expressing a STAC query -#' criteria or any `RSTACDocument`. +#' @param x either a `rstac_query` object expressing a STAC query +#' criteria or any `rstac_doc`. #' #' @param ... config parameters to be passed to [GET][httr::GET] #' method, such as [add_headers][httr::add_headers] or [set_cookies][httr::set_cookies]. @@ -15,8 +15,16 @@ #' The `stac_version()` function returns a `character` STAC API #' version. #' +#' @name stac_functions +#' #' @export stac_version <- function(x, ...) { - UseMethod("stac_version", x) } + +#' @rdname stac_functions +#' +#' @export +stac_type <- function(x) { + UseMethod("stac_type", x) +} diff --git a/R/stac-query.R b/R/stac-query.R index f3c4216e..9c21ca71 100644 --- a/R/stac-query.R +++ b/R/stac-query.R @@ -20,7 +20,7 @@ #' [post_request()] #' #' @return -#' A `RSTACQuery` object with the subclass `stac` containing all +#' A `rstac_query` object with the subclass `stac` containing all #' request parameters to be provided to API service. #' #' @examples @@ -32,42 +32,32 @@ #' @rdname stac #' @export stac <- function(base_url, force_version = NULL) { - # check url parameter - .check_obj(base_url, "character") - + check_character(base_url, "STAC URL must be a character value.") # check version force_version <- force_version[[1]] if (!is.null(force_version) && force_version < "0.8.0") .warning("STAC API version '%s' is not supported by `rstac` package.", force_version) - # create a new STAC - RSTACQuery(version = force_version, - base_url = base_url, - params = list(), - subclass = "stac") -} - -#' @export -endpoint.stac <- function(q) { - if (q$version < "0.9.0") - return("/stac") - return("/") + base_url <- url_normalize(base_url) + rstac_query( + version = force_version, + base_url = base_url, + params = list(), + subclass = "stac" + ) } #' @export before_request.stac <- function(q) { check_query_verb(q, verbs = c("GET", "POST")) - return(q) + if (!is.null(q$version) && q$version < "0.9.0") + return(set_query_endpoint(q, endpoint = "./stac")) + set_query_endpoint(q, endpoint = "./") } #' @export after_response.stac <- function(q, res) { - content <- content_response( - res, - status_codes = "200", - content_types = "application/.*json", - key_message = c("message", "description", "detail") - ) - RSTACDocument(content = content, q = q, subclass = "STACCatalog") + content <- content_response_json(res) + doc_catalog(content) } diff --git a/R/static-funs.R b/R/static-funs.R new file mode 100644 index 00000000..dd94cec8 --- /dev/null +++ b/R/static-funs.R @@ -0,0 +1,266 @@ +#' @title Static functions +#' +#' @description +#' These functions provide support to work with static catalogs. +#' +#' \itemize{ +#' \item `stac_read()`: open a STAC document from an URL. +#' +#' \item `read_items()`: opens (statically) all items referred in `links` +#' key entry of a given collection document (`doc_collection`). +#' +#' \item `links()`: extracts and filters the links of any STAC document. +#' +#' \item `link_open()`: opens (statically) the document referenced by +#' the link. This function can resolve any relative URL. +#' } +#' +#' @param url a `character` value with the URL to a valid STAC document. +#' +#' @param catalog a `doc_catalog` object to fetch all `rel=="child"` links. +#' +#' @param collection a `doc_collection` object to fetch all +#' `rel=="item"` links. +#' +#' @param limit an `integer` with defining the page size of items to fetch. +#' +#' @param page an `integer` with the page number to fetch the items. +#' +#' @param progress a `logical` indicating if a progress bar must be +#' shown or not. Defaults to `TRUE`. +#' +#' @param x any `rstac` document with `'links'` key entry. +#' +#' @param link a `doc_link` object, usually an element of `links` key entry. +#' +#' @param base_url a `character` with the base URL to resolve relative links. +#' If `NULL` (default) `rstac` will try resolve relative links using +#' internal metadata. +#' +#' @param ... additional arguments. See details. +#' +#' @details +#' Ellipsis argument (`...`) may appears in different items functions and +#' has distinct purposes: +#' \itemize{ +#' +#' \item `stac_read()`: ellipsis is used to pass any additional parameters +#' to [read_json][jsonlite::read_json] function. +#' +#' \item `links()`: ellipsis is used to pass logical expressions to be +#' evaluated against a `doc_link` item as a filter criteria. See examples. +#' +#' } +#' +#' @return +#' +#' \itemize{ +#' \item `links()`: a `doc_links` object containing a list of `link` entries. +#' +#' \item `link_open()`: a recognizable `rstac` document. +#' } +#' +#' @examples +#' \dontrun{ +#' x <- stac("https://brazildatacube.dpi.inpe.br/stac") %>% +#' collections("CB4-16D-2") %>% +#' get_request() +#' +#' link <- links(x, rel == "items") +#' link_open(link[[1]]) +#' } +#' +#' \dontrun{ +#' wv_url <- paste0( +#' "https://s3.eu-central-1.wasabisys.com", +#' "/stac/openlandmap/wv_mcd19a2v061.seasconv/collection.json" +#' ) +#' wv <- read_stac(wv_url) +#' stac_type(wv) # Collection +#' +#' # reads the second page of 5 links +#' wv_items <- read_items(wv, limit = 5, page = 2) +#' +#' # lists all links of the collection document that are not items +#' links(wv, rel != "item") +#' +#' # lists all links of the items document +#' links(wv_items) +#' } +#' +#' @name static_functions +NULL + +#' @rdname static_functions +#' +#' @export +read_stac <- function(url, ...) { + check_character(url, "STAC URL must be a character value.") + content <- jsonlite::read_json(url, ...) + # create an rstac doc from content and return + as_rstac_doc(content, base_url = url) +} + +#' @rdname static_functions +#' +#' @export +read_items <- function(collection, ..., + limit = 100, + page = 1, + progress = TRUE) { + UseMethod("read_items", collection) +} + +#' @export +read_items.doc_collection <- function(collection, ..., + limit = 100, + page = 1, + progress = TRUE) { + check_collection(collection) + rel <- NULL + link_items <- links(collection, rel == "item", ...) + if (is.null(limit) || limit < 1) + limit <- length(link_items) + limit <- max(1, as.integer(limit)) + page <- max(1, as.integer(page)) + pages <- ceiling(length(link_items) / limit) + if (page > pages) + return(NULL) + if (length(link_items) > limit) { + previous_len <- (page - 1) * limit + len <- min(limit, length(link_items) - previous_len) + link_items <- link_items[previous_len + seq_len(len)] + } + + # verify if progress bar can be shown + progress <- progress && length(link_items) > 1 + if (progress) { + pb <- utils::txtProgressBar(max = length(link_items), style = 3) + # close progress bar when exit + on.exit(if (progress) close(pb)) + } + features <- list() + for (i in seq_along(link_items)) { + if (progress) + utils::setTxtProgressBar(pb, i) + item <- link_open(link_items[[i]]) + features <- c(features, list(item)) + } + # Convert to doc_items object and return + parent <- links(collection, rel == "self") + if (length(parent) > 0) { + parent <- parent[[1]] + parent$rel <- "parent" + parent <- list(parent) + } + doc_items(list( + type = "FeatureCollection", + features = features, + links = parent + )) +} + +#' @rdname static_functions +#' +#' @export +read_collections <- function(catalog, ..., + limit = 100, + page = 1, + progress = TRUE) { + UseMethod("read_collections", catalog) +} + +#' @export +read_collections.catalog <- function(catalog, ..., + limit = 100, + page = 1, + progress = TRUE) { + check_catalog(catalog) + rel <- NULL + link_collections <- links(catalog, rel == "child", ...) + if (is.null(limit) || limit < 1) + limit <- length(link_collections) + limit <- max(1, as.integer(limit)) + page <- max(1, as.integer(page)) + pages <- ceiling(length(link_collections) / limit) + if (page > pages) + return(NULL) + if (length(link_collections) > limit) { + previous_len <- (page - 1) * limit + len <- min(limit, length(link_collections) - previous_len) + link_collections <- link_collections[previous_len + seq_len(len)] + } + + # verify if progress bar can be shown + progress <- progress && length(link_collections) > 1 + if (progress) { + pb <- utils::txtProgressBar(max = length(link_collections), style = 3) + # close progress bar when exit + on.exit(if (progress) close(pb)) + } + collections <- list() + for (i in seq_along(link_collections)) { + if (progress) + utils::setTxtProgressBar(pb, i) + collection <- link_open(link_collections[[i]]) + collections <- c(collections, list(collection)) + } + # Convert to doc_items object and return + parent <- links(catalog, rel == "self") + if (length(parent) > 0) { + parent <- parent[[1]] + parent$rel <- "parent" + parent <- list(parent) + } + doc_collections(list( + collections = collections, + links = parent + )) +} + +#' @rdname static_functions +#' +#' @export +links <- function(x, ...) { + UseMethod("links") +} + +#' @export +links.rstac_doc <- function(x, ...) { + exprs <- unquote( + expr = as.list(substitute(list(...), env = environment())[-1]), + env = parent.frame() + ) + sel <- !logical(length(x$links)) + for (expr in exprs) { + sel <- sel & map_lgl(x$links, function(x) { + tryCatch( + eval(expr, envir = x), + error = function(e) { + FALSE + } + ) + }) + } + structure(x$links[sel], class = c("doc_links", "list")) +} + +#' @rdname static_functions +#' +#' @export +link_open <- function(link, base_url = NULL) { + UseMethod("link_open", link) +} + +#' @export +link_open.doc_link <- function(link, base_url = NULL) { + check_link(link) + url <- link$href + if (!is.null(base_url)) + url <- resolve_url(base_url, url) + else if ("rstac:base_url" %in% names(link)) + url <- resolve_url(link[["rstac:base_url"]], url) + content <- jsonlite::read_json(url) + # create an rstac doc from content and return + as_rstac_doc(content, base_url = url) +} diff --git a/R/url-utils.R b/R/url-utils.R index 3f63dffe..c960022f 100644 --- a/R/url-utils.R +++ b/R/url-utils.R @@ -1,18 +1,73 @@ -make_url <- function(url, endpoint = "", params = list()) { - # remove trailing '/' char - if (substring(url, nchar(url)) == "/") - url <- substring(url, 1, nchar(url) - 1) - endpoint <- paste0(endpoint, collapse = "/") +remove_dot_segments <- function(path) { + while (grepl("[^/]+/\\.\\./?", path)) { + path <- gsub("[^/]+/\\.\\./?", "", path) + } + path <- gsub("(\\./)+", "", path) + gsub("/\\.$", "/", path) +} + +remove_last_segment <- function(path) { + gsub("/[^/]*$", "", path) +} + +resolve_url <- function(url, new_url) { + parsed_url <- httr::parse_url(url) + if (is.null(new_url) || new_url == "") { + return(httr::build_url(parsed_url)) + } + parsed_new <- httr::parse_url(new_url) + if (!is.null(parsed_new$scheme)) { + return(new_url) + } else { + if (!is.null(parsed_new$hostname)) { + parsed_url$hostname <- parsed_new$hostname + parsed_url$path <- parsed_new$path + parsed_url$query <- parsed_new$query + parsed_url$params <- parsed_new$params + parsed_url$fragment <- parsed_new$fragment + } else if (parsed_new$path != "") { + if (startsWith(parsed_new$path, "/")) + path <- parsed_new$path + else { + path <- remove_last_segment(parsed_url$path) + path <- paste(path, parsed_new$path, sep = "/") + } + parsed_url$path <- remove_dot_segments(path) + parsed_url$query <- parsed_new$query + parsed_url$params <- parsed_new$params + parsed_url$fragment <- parsed_new$fragment + } else if (!is.null(parsed_new$query)) { + parsed_url$query <- parsed_new$query + } else if (!is.null(parsed_new$params)) { + parsed_url$params <- parsed_new$params + path <- remove_last_segment(parsed_url$path) + path <- paste(path, parsed_new$path, sep = "/") + parsed_url$path <- remove_dot_segments(path) + parsed_url$query <- parsed_new$query + } else if (!is.null(parsed_new$fragment)) { + parsed_url$fragment <- parsed_new$fragment + } + } + httr::build_url(parsed_url) +} - res <- paste0(url, endpoint) +is_url_file <- function(url) { + parsed_url <- httr::parse_url(url) + grepl("/[^/]+\\.[^/]+$", parsed_url$path) +} - return(res) +url_normalize <- function(url) { + if (!is_url_file(url)) + url <- paste0(gsub("/$", "", url), "/") + url } -make_get_request <- function(url, ..., error_msg = "Error while requesting") { +make_get_request <- function(url, ..., headers = NULL, error_msg = NULL) { + if (!is.null(headers)) + headers <- httr::add_headers(headers) tryCatch({ - httr::GET(url, ...) + httr::GET(url, headers, ...) }, error = function(e) { if (!is.null(error_msg)) @@ -20,33 +75,26 @@ make_get_request <- function(url, ..., error_msg = "Error while requesting") { }) } -.querystrings_encode <- function(params) { - return(lapply(params, paste0, collapse = ",")) -} - -.querystring_decode <- function(querystring) { - # first decode and remove all coded spaces - querystring <- URLdecode(querystring) - querystring_spplited <- strsplit(querystring, split = "&")[[1]] - # remove empty spaces - querystring_spplited <- querystring_spplited[nzchar(querystring_spplited)] - values <- lapply(querystring_spplited, - function(x) regmatches(x, regexpr("=", x), invert = TRUE)[[1]]) - params <- lapply(values, `[[`, 2) - names(params) <- map_chr(values, `[[`, 1) - return(params) +make_post_request <- function(url, ..., body, + encode = c("json", "multipart", "form"), + headers = NULL, + error_msg = NULL) { + # check request settings + encode <- encode[[1]] + check_body_encode(encode) + if (!is.null(headers)) + headers <- httr::add_headers(headers) + tryCatch({ + httr::POST(url, body = body, encode = encode, headers, ...) + }, + error = function(e) { + if (!is.null(error_msg)) + .error(paste(error_msg, "'%s'. \n%s"), url, e$message) + }) } -.validate_query <- function(params) { - - if (!is.null(params$query) && is.character(params$query)) { - params$query <- jsonlite::fromJSON(params$query, simplifyVector = FALSE) - - if (is.list(params$query)) - params$query <- list(params$query) - } - - return(params) +query_encode <- function(params) { + return(lapply(params, paste0, collapse = ",")) } gdalvsi_schema <- function(url) { @@ -84,29 +132,6 @@ format_bbox <- function(bbox) { sprintf("%.5f", bbox), collapse = ", ")) } -asset_download <- function(asset, - output_dir, - overwrite, ..., - download_fn = NULL) { - if (!is.null(download_fn)) - return(download_fn(asset)) - - # create a full path name - path <- url_get_path(asset$href) - out_file <- path_normalize(output_dir, path) - dir_create(out_file) - - make_get_request( - url = asset$href, - httr::write_disk(path = out_file, overwrite = overwrite), - ..., - error_msg = "Error in downloading" - ) - asset$href <- path - - asset -} - path_normalize <- function(...) { path <- file.path(...) path <- gsub("\\\\", "/", path) @@ -116,7 +141,8 @@ path_normalize <- function(...) { } url_get_path <- function(url) { - return(httr::parse_url(url)[["path"]]) + parsed_url <- httr::parse_url(url) + return(parsed_url$path) } dir_create <- function(path) { @@ -133,3 +159,10 @@ dir_create <- function(path) { path_get_dir <- function(path) { return(gsub("^\\.", "", dirname(path))) } + +check_body_encode <- function(encode) { + valid_encodes <- c("json", "multipart", "form") + if (!encode %in% valid_encodes) + .error("Invalid body `encode` '%s'. Allowed `encode` are %s.", + encode, paste0("'", valid_encodes, "'", collapse = ", ")) +} diff --git a/README.Rmd b/README.Rmd index a6ae0b5d..7625aaca 100644 --- a/README.Rmd +++ b/README.Rmd @@ -48,9 +48,7 @@ install.packages("rstac") To install the development version of `rstac`, run the following commands ```{R install-dev, eval=FALSE} -# load necessary libraries -library(devtools) -install_github("brazil-data-cube/rstac") +remotes::install_github("brazil-data-cube/rstac") ``` Importing `rstac` package: @@ -106,10 +104,10 @@ containing a feature collection). ```{R bdc-items1, echo=TRUE} -it_obj <- s_obj |> +it_obj <- s_obj %>% stac_search(collections = "CB4-16D-2", bbox = c(-47.02148, -17.35063, -42.53906, -12.98314), - limit = 100) |> + limit = 100) %>% get_request() it_obj @@ -121,9 +119,9 @@ HTTP requests, allowing the use of tokens from the authorization protocols OAuth an example of how to pass a parameter token on a HTTP request. ```{R bdc-items2, eval=FALSE} -it_obj <- s_obj |> +it_obj <- s_obj %>% stac_search(collections = "CB4-16D-2", - bbox = c(-47.02148, -17.35063, -42.53906, -12.98314)) |> + bbox = c(-47.02148, -17.35063, -42.53906, -12.98314)) %>% get_request(add_headers("x-api-key" = "MY-TOKEN")) ``` @@ -137,7 +135,7 @@ In the example below, we get how many items matched the search criteria: ```{R bdc-items3, echo=TRUE} # it_obj variable from the last code example -it_obj |> +it_obj %>% items_matched() ``` @@ -145,7 +143,7 @@ However, if we count how many items there are in `it_obj` variable, we get `10`, meaning that more items could be fetched from the STAC service: ```{R bdc-items4, echo=TRUE} -it_obj |> +it_obj %>% items_length() ``` @@ -153,10 +151,10 @@ it_obj |> ```{R bdc-items5, echo=TRUE} # fetch all items from server # (but don't stored them back in it_obj) -it_obj <- it_obj |> +it_obj <- it_obj %>% items_fetch(progress = FALSE) -it_obj |> +it_obj %>% items_length() ``` @@ -170,7 +168,7 @@ below downloads the `thumbnail` assets (.png files) of `10` items stored in `it_obj` variable. ```{R download, eval=FALSE} -download_items <- it_obj |> +download_items <- it_obj %>% assets_download(assets_name = "thumbnail", items_max = 10) ``` @@ -183,12 +181,12 @@ natural way. For a complete ```{R cql2, echo=TRUE} s_obj <- stac("https://planetarycomputer.microsoft.com/api/stac/v1") -it_obj <- s_obj |> +it_obj <- s_obj %>% ext_filter( collection == "sentinel-2-l2a" && `s2:vegetation_percentage` >= 50 && `eo:cloud_cover` <= 10 && `s2:mgrs_tile` == "20LKP" && anyinteracts(datetime, interval("2020-06-01", "2020-09-30")) - ) |> + ) %>% post_request() ``` @@ -217,6 +215,8 @@ We acknowledge and thank the project funders that provided financial and materia - Radiant Earth Foundation and STAC Project Steering Committee for the advance of STAC ecosystem programme. +- OpenGeoHub Foundation and the European Commission (EC) through the project Open-Earth-Monitor Cyberinfrastructure: Environmental information to support EU’s Green Deal (1 Jun. 2022 – 31 May 2026 - 101059548) + ## How to contribute? The `rstac` package was implemented based on an extensible architecture, so @@ -227,10 +227,9 @@ based on the STAC API specifications. 1. Make a project [fork](https://docs.github.com/en/github/getting-started-with-github/fork-a-repo). 2. Create a file inside the `R/` directory called `ext_{extension_name}.R`. -3. In the code, you need to specify a subclass name (e.g.`ext_subclass`) for -your extension in [`RSTACQuery`](https://github.com/OldLipe/rstac/blob/49370251033cca26c6da5b1a38f6d4fa4a83bb96/R/documents.R#L33-L40) function constructor, and implement the S3 generics methods: [`get_endpoint`](https://github.com/OldLipe/rstac/blob/49370251033cca26c6da5b1a38f6d4fa4a83bb96/R/extensions.R#L87-L90), -[`before_request`](https://github.com/OldLipe/rstac/blob/49370251033cca26c6da5b1a38f6d4fa4a83bb96/R/extensions.R#L93-L96), and [`after_response`](https://github.com/OldLipe/rstac/blob/49370251033cca26c6da5b1a38f6d4fa4a83bb96/R/extensions.R#L99-L102). Using these S3 generics methods you -can define how parameters must be submitted to the HTTP request and the types -of the returned documents responses. See the implemented [ext_query](https://github.com/brazil-data-cube/rstac/blob/master/R/ext_query.R) -API extension as an example. -4. Make a [Pull Request](https://docs.github.com/en/github/collaborating-with-issues-and-pull-requests/creating-a-pull-request) on the branch [dev](https://github.com/OldLipe/rstac/tree/dev). +3. In the code, you need to specify a subclass name (e.g.`my_subclass`) for +your extension and use it when calling [`rstac_query()`](https://github.com/brazil-data-cube/rstac/blob/master/R/query-funs.R) function. You also need to implement for your subclass the following S3 generic functions: [`before_request()`](https://github.com/brazil-data-cube/rstac/blob/master/R/extensions.R), [`after_response()`](https://github.com/brazil-data-cube/rstac/blob/master/R/extensions.R), and [`parse_params()`](https://github.com/brazil-data-cube/rstac/blob/master/R/extensions.R). With these S3 generics methods you +can define how parameters should be submitted to the HTTP request and the types +of the returned documents. See the implemented [ext_filter](https://github.com/brazil-data-cube/rstac/blob/master/R/ext_filter.R) +API extension as an example. +4. Make a [Pull Request](https://docs.github.com/en/github/collaborating-with-issues-and-pull-requests/creating-a-pull-request) on the most recent [development branch](https://github.com/brazil-data-cube/rstac/). diff --git a/README.md b/README.md index cafa1793..a3f82682 100644 --- a/README.md +++ b/README.md @@ -44,9 +44,7 @@ To install the development version of `rstac`, run the following commands ``` r -# load necessary libraries -library(devtools) -install_github("brazil-data-cube/rstac") +remotes::install_github("brazil-data-cube/rstac") ``` Importing `rstac` package: @@ -82,7 +80,7 @@ Brazilian National Space Research Institute (INPE). s_obj <- stac("https://brazildatacube.dpi.inpe.br/stac/") get_request(s_obj) -#> ###STACCatalog +#> ###Catalog #> - id: bdc #> - description: Brazil Data Cube Catalog #> - field(s): description, id, stac_version, links @@ -102,26 +100,26 @@ containing a feature collection). ``` r -it_obj <- s_obj |> +it_obj <- s_obj %>% stac_search(collections = "CB4-16D-2", bbox = c(-47.02148, -17.35063, -42.53906, -12.98314), - limit = 100) |> + limit = 100) %>% get_request() it_obj -#> ###STACItemCollection -#> - matched feature(s): 1003 -#> - features (100 item(s) / 903 not fetched): -#> - CB4-16D_V2_007004_20230509 -#> - CB4-16D_V2_007005_20230509 -#> - CB4-16D_V2_007006_20230509 -#> - CB4-16D_V2_008004_20230509 -#> - CB4-16D_V2_008006_20230509 -#> - CB4-16D_V2_008005_20230509 -#> - CB4-16D_V2_007004_20230423 -#> - CB4-16D_V2_007005_20230423 -#> - CB4-16D_V2_007006_20230423 -#> - CB4-16D_V2_008004_20230423 +#> ###Items +#> - matched feature(s): 1096 +#> - features (100 item(s) / 996 not fetched): +#> - CB4-16D_V2_007004_20240101 +#> - CB4-16D_V2_007005_20240101 +#> - CB4-16D_V2_007006_20240101 +#> - CB4-16D_V2_008004_20240101 +#> - CB4-16D_V2_008006_20240101 +#> - CB4-16D_V2_008005_20240101 +#> - CB4-16D_V2_007004_20231219 +#> - CB4-16D_V2_007006_20231219 +#> - CB4-16D_V2_007005_20231219 +#> - CB4-16D_V2_008004_20231219 #> - ... with 90 more feature(s). #> - assets: #> BAND13, BAND14, BAND15, BAND16, CLEAROB, CMASK, EVI, NDVI, PROVENANCE, thumbnail, TOTALOB @@ -136,9 +134,9 @@ the code below, we present an example of how to pass a parameter token on a HTTP request. ``` r -it_obj <- s_obj |> +it_obj <- s_obj %>% stac_search(collections = "CB4-16D-2", - bbox = c(-47.02148, -17.35063, -42.53906, -12.98314)) |> + bbox = c(-47.02148, -17.35063, -42.53906, -12.98314)) %>% get_request(add_headers("x-api-key" = "MY-TOKEN")) ``` @@ -154,9 +152,9 @@ search criteria: ``` r # it_obj variable from the last code example -it_obj |> +it_obj %>% items_matched() -#> [1] 1003 +#> [1] 1096 ``` However, if we count how many items there are in `it_obj` variable, we @@ -164,7 +162,7 @@ get `10`, meaning that more items could be fetched from the STAC service: ``` r -it_obj |> +it_obj %>% items_length() #> [1] 100 ``` @@ -172,12 +170,12 @@ it_obj |> ``` r # fetch all items from server # (but don't stored them back in it_obj) -it_obj <- it_obj |> +it_obj <- it_obj %>% items_fetch(progress = FALSE) -it_obj |> +it_obj %>% items_length() -#> [1] 1003 +#> [1] 1096 ``` ### Download assets @@ -190,7 +188,7 @@ assets. The code below downloads the `thumbnail` assets (.png files) of `10` items stored in `it_obj` variable. ``` r -download_items <- it_obj |> +download_items <- it_obj %>% assets_download(assets_name = "thumbnail", items_max = 10) ``` @@ -203,12 +201,12 @@ easy and natural way. For a complete ``` r s_obj <- stac("https://planetarycomputer.microsoft.com/api/stac/v1") -it_obj <- s_obj |> +it_obj <- s_obj %>% ext_filter( collection == "sentinel-2-l2a" && `s2:vegetation_percentage` >= 50 && `eo:cloud_cover` <= 10 && `s2:mgrs_tile` == "20LKP" && anyinteracts(datetime, interval("2020-06-01", "2020-09-30")) - ) |> + ) %>% post_request() ``` @@ -245,6 +243,11 @@ material support: - Radiant Earth Foundation and STAC Project Steering Committee for the advance of STAC ecosystem programme. +- OpenGeoHub Foundation and the European Commission (EC) through the + project Open-Earth-Monitor Cyberinfrastructure: Environmental + information to support EU’s Green Deal (1 Jun. 2022 – 31 May 2026 - + 101059548) + ## How to contribute? The `rstac` package was implemented based on an extensible architecture, @@ -256,19 +259,21 @@ based on the STAC API specifications. [fork](https://docs.github.com/en/github/getting-started-with-github/fork-a-repo). 2. Create a file inside the `R/` directory called `ext_{extension_name}.R`. -3. In the code, you need to specify a subclass name - (e.g.`ext_subclass`) for your extension in - [`RSTACQuery`](https://github.com/OldLipe/rstac/blob/49370251033cca26c6da5b1a38f6d4fa4a83bb96/R/documents.R#L33-L40) - function constructor, and implement the S3 generics methods: - [`get_endpoint`](https://github.com/OldLipe/rstac/blob/49370251033cca26c6da5b1a38f6d4fa4a83bb96/R/extensions.R#L87-L90), - [`before_request`](https://github.com/OldLipe/rstac/blob/49370251033cca26c6da5b1a38f6d4fa4a83bb96/R/extensions.R#L93-L96), +3. In the code, you need to specify a subclass name (e.g.`my_subclass`) + for your extension and use it when calling + [`rstac_query()`](https://github.com/brazil-data-cube/rstac/blob/master/R/query-funs.R) + function. You also need to implement for your subclass the following + S3 generic functions: + [`before_request()`](https://github.com/brazil-data-cube/rstac/blob/master/R/extensions.R), + [`after_response()`](https://github.com/brazil-data-cube/rstac/blob/master/R/extensions.R), and - [`after_response`](https://github.com/OldLipe/rstac/blob/49370251033cca26c6da5b1a38f6d4fa4a83bb96/R/extensions.R#L99-L102). - Using these S3 generics methods you can define how parameters must + [`parse_params()`](https://github.com/brazil-data-cube/rstac/blob/master/R/extensions.R). + With these S3 generics methods you can define how parameters should be submitted to the HTTP request and the types of the returned - documents responses. See the implemented - [ext_query](https://github.com/brazil-data-cube/rstac/blob/master/R/ext_query.R) - API extension as an example. + documents. See the implemented + [ext_filter](https://github.com/brazil-data-cube/rstac/blob/master/R/ext_filter.R) + API extension as an example. 4. Make a [Pull Request](https://docs.github.com/en/github/collaborating-with-issues-and-pull-requests/creating-a-pull-request) - on the branch [dev](https://github.com/OldLipe/rstac/tree/dev). + on the most recent [development + branch](https://github.com/brazil-data-cube/rstac/). diff --git a/man/RSTACDocument.Rd b/man/RSTACDocument.Rd deleted file mode 100644 index 011c9cdb..00000000 --- a/man/RSTACDocument.Rd +++ /dev/null @@ -1,26 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/document-funs.R -\name{RSTACDocument} -\alias{RSTACDocument} -\title{Document development functions} -\usage{ -RSTACDocument(content, q = NULL, subclass = NULL) -} -\arguments{ -\item{content}{a \code{list} data structure representing the JSON file -received in HTTP response (see \code{\link[=content_response]{content_response()}} function)} - -\item{q}{a \code{RSTACQuery} object expressing the STAC query used -to retrieve the document.} - -\item{subclass}{a \code{character} corresponding to the subclass of the -document to be created.} -} -\value{ -The \code{RSTACDocument()} function returns a \code{RSTACDocument} object -with subclass defined by \code{subclass} parameter. -} -\description{ -Document development functions -} -\keyword{internal} diff --git a/man/assets_filter.Rd b/man/assets_filter.Rd deleted file mode 100644 index bb994875..00000000 --- a/man/assets_filter.Rd +++ /dev/null @@ -1,29 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/deprec-funs.R -\name{assets_filter} -\alias{assets_filter} -\alias{assets_filter.STACItemCollection} -\alias{assets_filter.STACItem} -\title{Assets filter (Deprecated)} -\usage{ -assets_filter(items, ..., filter_fn = NULL) - -\method{assets_filter}{STACItemCollection}(items, ..., filter_fn = NULL) - -\method{assets_filter}{STACItem}(items, ..., filter_fn = NULL) -} -\arguments{ -\item{items}{a \code{STACItemCollection} object representing -the result of \verb{/stac/search}, \code{/collections/{collectionId}/items}.} - -\item{...}{additional arguments. See details.} - -\item{filter_fn}{a \code{function} that will be used to filter the -attributes listed in the properties.} -} -\value{ -a \code{list} with the attributes of date, bands and paths. -} -\description{ -\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} -} diff --git a/man/assets_functions.Rd b/man/assets_functions.Rd index 8ff13209..7f37e02a 100644 --- a/man/assets_functions.Rd +++ b/man/assets_functions.Rd @@ -3,24 +3,24 @@ \name{assets_functions} \alias{assets_functions} \alias{assets_download} -\alias{assets_download.STACItem} -\alias{assets_download.STACItemCollection} +\alias{assets_download.doc_item} +\alias{assets_download.doc_items} \alias{assets_download.default} \alias{assets_url} -\alias{assets_url.STACItem} -\alias{assets_url.STACItemCollection} +\alias{assets_url.doc_item} +\alias{assets_url.doc_items} \alias{assets_url.default} \alias{assets_select} -\alias{assets_select.STACItem} -\alias{assets_select.STACItemCollection} +\alias{assets_select.doc_item} +\alias{assets_select.doc_items} \alias{assets_select.default} \alias{assets_rename} -\alias{assets_rename.STACItem} -\alias{assets_rename.STACItemCollection} +\alias{assets_rename.doc_item} +\alias{assets_rename.doc_items} \alias{assets_rename.default} \alias{has_assets} -\alias{has_assets.STACItem} -\alias{has_assets.STACItemCollection} +\alias{has_assets.doc_item} +\alias{has_assets.doc_items} \alias{has_assets.default} \alias{asset_key} \alias{asset_eo_bands} @@ -33,22 +33,20 @@ assets_download( output_dir = getwd(), overwrite = FALSE, ..., - download_fn = NULL, - fn = deprecated() + download_fn = NULL ) -\method{assets_download}{STACItem}( +\method{assets_download}{doc_item}( items, asset_names = NULL, output_dir = getwd(), overwrite = FALSE, ..., create_json = FALSE, - download_fn = NULL, - fn = deprecated() + download_fn = NULL ) -\method{assets_download}{STACItemCollection}( +\method{assets_download}{doc_items}( items, asset_names = NULL, output_dir = getwd(), @@ -57,8 +55,7 @@ assets_download( download_fn = NULL, create_json = TRUE, items_max = Inf, - progress = TRUE, - fn = deprecated() + progress = TRUE ) \method{assets_download}{default}( @@ -68,39 +65,38 @@ assets_download( overwrite = FALSE, ..., create_json = FALSE, - download_fn = NULL, - fn = deprecated() + download_fn = NULL ) assets_url(items, asset_names = NULL, append_gdalvsi = FALSE) -\method{assets_url}{STACItem}(items, asset_names = NULL, append_gdalvsi = FALSE) +\method{assets_url}{doc_item}(items, asset_names = NULL, append_gdalvsi = FALSE) -\method{assets_url}{STACItemCollection}(items, asset_names = NULL, append_gdalvsi = FALSE) +\method{assets_url}{doc_items}(items, asset_names = NULL, append_gdalvsi = FALSE) \method{assets_url}{default}(items, asset_names = NULL, append_gdalvsi = FALSE) assets_select(items, ..., asset_names = NULL, select_fn = NULL) -\method{assets_select}{STACItem}(items, ..., asset_names = NULL, select_fn = NULL) +\method{assets_select}{doc_item}(items, ..., asset_names = NULL, select_fn = NULL) -\method{assets_select}{STACItemCollection}(items, ..., asset_names = NULL, select_fn = NULL) +\method{assets_select}{doc_items}(items, ..., asset_names = NULL, select_fn = NULL) \method{assets_select}{default}(items, ..., asset_names = NULL, select_fn = NULL) assets_rename(items, mapper = NULL, ...) -\method{assets_rename}{STACItem}(items, mapper = NULL, ...) +\method{assets_rename}{doc_item}(items, mapper = NULL, ...) -\method{assets_rename}{STACItemCollection}(items, mapper = NULL, ...) +\method{assets_rename}{doc_items}(items, mapper = NULL, ...) \method{assets_rename}{default}(items, mapper = NULL, ...) has_assets(items) -\method{has_assets}{STACItem}(items) +\method{has_assets}{doc_item}(items) -\method{has_assets}{STACItemCollection}(items) +\method{has_assets}{doc_items}(items) \method{has_assets}{default}(items) @@ -111,7 +107,7 @@ asset_eo_bands(field) asset_raster_bands(field) } \arguments{ -\item{items}{a \code{STACItem} or \code{STACItemCollection} object +\item{items}{a \code{doc_item} or \code{doc_items} object representing the result of \verb{/stac/search}, \code{/collections/{collectionId}/items} or \code{/collections/{collectionId}/items/{itemId}} endpoints.} @@ -131,11 +127,8 @@ if FALSE, a warning message is shown.} each item to be downloaded. Using this function, you can change the hrefs for each asset, as well as the way download is done.} -\item{fn}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} -use \code{download_fn} parameter instead.} - \item{create_json}{a \code{logical} indicating if a JSON file with item -metadata (\code{STACItem} or \code{STACItemCollection}) must be created in the +metadata (\code{doc_item} or \code{doc_items}) must be created in the output directory.} \item{items_max}{a \code{numeric} corresponding to how many items will be @@ -149,14 +142,14 @@ included in the URL of each asset. The following schemes are supported: HTTP/HTTPS files, S3 (AWS S3) and GS (Google Cloud Storage).} \item{select_fn}{a \code{function} to select assets an item -(\code{STACItem} or \code{STACItemCollection}). This function receives as parameter +(\code{doc_item} or \code{doc_items}). This function receives as parameter the asset element and, optionally, the asset name. Asset elements contain metadata describing spatial-temporal objects. Users can provide a function to select assets based on this metadata by returning a logical value where \code{TRUE} selects the asset, and \code{FALSE} discards it.} \item{mapper}{either a named \code{list} or a \code{function} to rename assets -of an item (\code{STACItem} or \code{STACItemCollection}). In the case of a named +of an item (\code{doc_item} or \code{doc_items}). In the case of a named list, use \verb{ = } to rename the assets. The function can be used to rename the assets by returning a \code{character} string using the metadata contained in the asset object.} @@ -167,22 +160,22 @@ return.} \value{ \itemize{ \item \code{assets_download()}: returns the same input object item -(\code{STACItem} or \code{STACItemCollection}) where \code{href} properties point to +(\code{doc_item} or \code{doc_items}) where \code{href} properties point to the download assets. \item \code{assets_url()}: returns a character vector with all assets \code{href} -of an item (\code{STACItem} or \code{STACItemCollection}). +of an item (\code{doc_item} or \code{doc_items}). \item \code{assets_select()}: returns the same input object item -(\code{STACItem} or \code{STACItemCollection}) with the selected assets. +(\code{doc_item} or \code{doc_items}) with the selected assets. \item \code{assets_rename()}: returns the same input object item -(\code{STACItemCollection} or \code{STACItem}) with the assets renamed. +(\code{doc_items} or \code{doc_item}) with the assets renamed. } } \description{ -These functions provide support to work with \code{STACItemCollection} and -\code{STACItem} item objects. +These functions provide support to work with \code{doc_items} and +\code{doc_item} item objects. \itemize{ \item \code{assets_download()}: Downloads the assets provided by the STAC API. diff --git a/man/collections.Rd b/man/collections.Rd index 22161912..f5a452ed 100644 --- a/man/collections.Rd +++ b/man/collections.Rd @@ -7,13 +7,13 @@ collections(q, collection_id = NULL) } \arguments{ -\item{q}{a \code{RSTACQuery} object expressing a STAC query +\item{q}{a \code{rstac_query} object expressing a STAC query criteria.} \item{collection_id}{a \code{character} collection id to be retrieved.} } \value{ -A \code{RSTACQuery} object with the subclass \code{collections} for +A \code{rstac_query} object with the subclass \code{collections} for \verb{/collections/} endpoint, or a \code{collection_id} subclass for \code{/collections/{collection_id}} endpoint, containing all search field parameters to be provided to STAC API web service. diff --git a/man/conformance.Rd b/man/conformance.Rd index cac3d56e..8afce489 100644 --- a/man/conformance.Rd +++ b/man/conformance.Rd @@ -2,15 +2,15 @@ % Please edit documentation in R/conformance-query.R \name{conformance} \alias{conformance} -\title{Conformance endpoint} +\title{doc_conformance endpoint} \usage{ conformance(q) } \arguments{ -\item{q}{a \code{RSTACQuery} object expressing a STAC query criteria.} +\item{q}{a \code{rstac_query} object expressing a STAC query criteria.} } \value{ -A \code{RSTACQuery} object with the subclass \code{conformance} for \verb{/conformance} +A \code{rstac_query} object with the subclass \code{conformance} for \verb{/conformance} endpoint. } \description{ diff --git a/man/doc_query.Rd b/man/doc_query.Rd deleted file mode 100644 index 693da8ae..00000000 --- a/man/doc_query.Rd +++ /dev/null @@ -1,19 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/document-funs.R -\name{doc_query} -\alias{doc_query} -\title{Document utils functions} -\usage{ -doc_query(d) -} -\arguments{ -\item{d}{an \code{RSTACDocument} object} -} -\value{ -a \code{RSTACQuery} object with the predecessor subclass with the -fields used in the request. -} -\description{ -Document utils functions -} -\keyword{internal} diff --git a/man/ext_filter.Rd b/man/ext_filter.Rd index 65a6a1c0..e57b61d6 100644 --- a/man/ext_filter.Rd +++ b/man/ext_filter.Rd @@ -13,7 +13,7 @@ cql2_json(expr) cql2_text(expr) } \arguments{ -\item{q}{a \code{RSTACQuery} object expressing a STAC query +\item{q}{a \code{rstac_query} object expressing a STAC query criteria.} \item{expr}{a valid R expression to be translated to CQL2 (see details).} @@ -28,7 +28,7 @@ system used by geometry objects. If \code{NULL} (default), STAC services assume \code{"WGS 84"}.} } \value{ -A \code{RSTACQuery} object with the subclass \code{ext_filter} containing +A \code{rstac_query} object with the subclass \code{ext_filter} containing all request parameters to be passed to \code{get_request()} or \code{post_request()} function. } @@ -137,8 +137,8 @@ double quoted properties in R is to use the escape character (\verb{), for examp \dontrun{ # Standard comparison operators in rstac: # Creating a stac search query -req <- rstac::stac("https://planetarycomputer.microsoft.com/api/stac/v1") \%>\% - rstac::stac_search(limit = 5) +req <- stac("https://planetarycomputer.microsoft.com/api/stac/v1") \%>\% + stac_search(limit = 5) # Equal operator '=' with collection property req \%>\% ext_filter(collection == "sentinel-2-l2a") \%>\% post_request() @@ -236,6 +236,5 @@ cql2_json(collection == "landsat-c2-l2" && } \seealso{ \code{\link[=ext_query]{ext_query()}}, \code{\link[=stac_search]{stac_search()}}, \code{\link[=post_request]{post_request()}}, -\code{\link[=endpoint]{endpoint()}}, \code{\link[=before_request]{before_request()}}, -\code{\link[=after_response]{after_response()}}, \code{\link[=content_response]{content_response()}} +\code{\link[=before_request]{before_request()}}, \code{\link[=after_response]{after_response()}}, \code{\link[=content_response]{content_response()}} } diff --git a/man/ext_query.Rd b/man/ext_query.Rd index c232af2e..0a375542 100644 --- a/man/ext_query.Rd +++ b/man/ext_query.Rd @@ -7,13 +7,13 @@ ext_query(q, ...) } \arguments{ -\item{q}{a \code{RSTACQuery} object expressing a STAC query +\item{q}{a \code{rstac_query} object expressing a STAC query criteria.} \item{...}{entries with format \verb{ }.} } \value{ -A \code{RSTACQuery} object with the subclass \code{ext_query} containing +A \code{rstac_query} object with the subclass \code{ext_query} containing all request parameters to be passed to \code{post_request()} function. } \description{ @@ -50,7 +50,6 @@ search operator. Besides this function, the following S3 generic methods were implemented to get things done for this extension: \itemize{ -\item The \code{endpoint()} for subclass \code{ext_query} \item The \code{before_request()} for subclass \code{ext_query} \item The \code{after_response()} for subclass \code{ext_query} } @@ -68,6 +67,5 @@ extensions. } \seealso{ \code{\link[=ext_filter]{ext_filter()}}, \code{\link[=stac_search]{stac_search()}}, \code{\link[=post_request]{post_request()}}, -\code{\link[=endpoint]{endpoint()}}, \code{\link[=before_request]{before_request()}}, -\code{\link[=after_response]{after_response()}}, \code{\link[=content_response]{content_response()}} +\code{\link[=before_request]{before_request()}}, \code{\link[=after_response]{after_response()}}, \code{\link[=content_response]{content_response()}} } diff --git a/man/extensions.Rd b/man/extensions.Rd index d3368a56..314c6d7b 100644 --- a/man/extensions.Rd +++ b/man/extensions.Rd @@ -2,20 +2,17 @@ % Please edit documentation in R/extensions.R, R/query-funs.R \name{extensions} \alias{extensions} -\alias{endpoint} \alias{before_request} \alias{after_response} \alias{parse_params} \alias{content_response} \alias{check_query_verb} -\alias{check_subclass} +\alias{check_query} \alias{subclass} -\alias{omit_query_params} -\alias{RSTACQuery} +\alias{set_query_endpoint} +\alias{rstac_query} \title{Extension development functions} \usage{ -endpoint(q) - before_request(q) after_response(q, res) @@ -26,16 +23,16 @@ content_response(res, status_codes, content_types, key_message) check_query_verb(q, verbs, msg = NULL) -check_subclass(x, subclasses) +check_query(x, classes = NULL) subclass(x) -omit_query_params(q, names) +set_query_endpoint(q, endpoint, params = NULL) -RSTACQuery(version = NULL, base_url, params = list(), subclass) +rstac_query(version = NULL, base_url, params = list(), subclass) } \arguments{ -\item{q}{a \code{RSTACQuery} object.} +\item{q}{a \code{rstac_query} object.} \item{res}{a \code{httr} \code{response} object.} @@ -55,12 +52,13 @@ requested API message.} \item{msg}{a \code{character} with a personalized error message} -\item{x}{either a \code{RSTACQuery} object expressing a STAC query -criteria or any \code{RSTACDocument}.} +\item{x}{a \code{rstac_query} object expressing a STAC query +criteria.} -\item{subclasses}{a \code{character} vector with all allowed S3 subclasses} +\item{classes}{a \code{character} vector with all allowed S3 sub-classes} -\item{names}{a \code{character} vector with the names do omit.} +\item{endpoint}{a \code{character} vector with the format string with the +endpoint url.} \item{version}{a \code{character} with the STAC version.} @@ -71,24 +69,23 @@ STAC web service.} object to be created.} } \value{ -A \code{character} endpoint value for \code{endpoint()} function. -A \code{RSTACQuery} object for \code{before_request()} and +A \code{rstac_query} object for \code{before_request()} and \code{after_response()} functions. The \code{content_response()} function returns a \code{list} data structure representing the JSON file received in HTTP response -The \code{RSTACQuery()} function returns a \code{STACQuery} object with +The \code{rstac_query()} function returns a \code{STACQuery} object with subclass defined by \code{subclass} parameter. } \description{ Currently, there are five STAC documents defined in STAC spec: \itemize{ -\item \code{STACCatalog} -\item \code{STACCollection} -\item \code{STACCollectionList} -\item \code{STACItem} -\item \code{STACItemCollection} +\item \code{doc_catalog} +\item \code{doc_collection} +\item \code{doc_collections} +\item \code{doc_item} +\item \code{doc_items} } Each document class is associated with STAC API endpoints. @@ -125,22 +122,18 @@ These functions are intended for those who want to implement new STAC API extensions. An extension must define a subclass name and implement all the following S3 generic methods for that subclass: \itemize{ -\item \code{endpoint()}: returns the endpoint value of the extension. -Endpoints that vary between STAC API versions can be properly returned by -checking the \code{version} field of \code{RSTACQuery} object. \item \code{before_request()}: allows handling query parameters before -submit them to the HTTP server; +submit them to the HTTP server, usually sets up the query endpoint; \item \code{after_request()}: allows to check and parse document received by the HTTP server; } -These methods will work 'behind the scenes' when a \code{RSTACQuery} object +These methods will work 'behind the scenes' when a \code{rstac_query} object representing a user query are passed to a request function (e.g. \code{get_request()} or \code{post_request()}). The calling order is: \enumerate{ \item begin of \code{get_request()} or \code{post_request()} \item if STAC API version is not defined, try detect it -\item call \code{endpoint()} \item call \code{before_request()} \item send HTTP request \item receive HTTP response @@ -149,13 +142,13 @@ representing a user query are passed to a request function } Besides that, the extension must expose a function to receive user -parameters and return a \code{RSTACQuery} object with a subclass +parameters and return a \code{rstac_query} object with a subclass associated with the above S3 methods. This function must accept as its -first parameter a \code{RSTACQuery} object representing the actual query. +first parameter a \code{rstac_query} object representing the actual query. To keep the command flow consistency, the function needs to check the subclass of the input query. After that, it must set new or changes the input query parameters according to the user input and, finally, -return the new query as a \code{RSTACQuery} object. +return the new query as a \code{rstac_query} object. You can see examples on how to implement an STAC API extension by looking at \code{stac.R}, \code{collections.R}, \code{items.R}, \code{stac_search.R}, @@ -175,20 +168,20 @@ It returns the parsed content response. verbs are allowed. It is useful for establishing which verbs will be supported by an extension. -\item \code{check_subclass()}: The \code{check_subclass()} function specifies which type of query -objects (\code{RSTACQuery}) or document objects (\code{RSTACDocument}) -are expected in the function extension. +\item \code{check_query()}: The \code{check_query()} function specifies which type of query +object (\code{rstac_query}) is expected in the function extension. \item \code{subclass()}: The \code{subclass()} function returns a \code{character} representing the -subclass name of either \code{RSTACQuery} or \code{RSTACDocument} S3 classes. +subclass name of \code{rstac_query} objects. -\item \code{omit_query_params()}: The \code{omit_query_params()} function was created to omit the paths that -are defined as query parameters to simplify the creation of a query. -Therefore, use this method only in endpoints that specify a parameter in -their paths. +\item \code{set_query_endpoint()}: The \code{set_query_endpoint()} function defines the endpoint of a query. +If \code{params} parameter is passed, each value must be an entry of params +field of the given query. The corresponding param value will be used as +value replacement of \verb{\%s} occurrences in the \code{endpoint} string. After +the replacement, all params in this list will be removed. -\item \code{RSTACQuery()}: The \code{RSTACQuery()} function is a constructor of \code{RSTACQuery} -objects. Every extension must implement a subclass of \code{RSTACQuery} to +\item \code{rstac_query()}: The \code{rstac_query()} function is a constructor of \code{rstac_query} +objects. Every extension must implement a subclass of \code{rstac_query} to represent its queries. This is done by informing to the \code{subclass} parameter the extension's subclass name. diff --git a/man/items.Rd b/man/items.Rd index c327efef..8daa5f30 100644 --- a/man/items.Rd +++ b/man/items.Rd @@ -7,7 +7,7 @@ items(q, feature_id = NULL, datetime = NULL, bbox = NULL, limit = NULL) } \arguments{ -\item{q}{a \code{RSTACQuery} object expressing a STAC query +\item{q}{a \code{rstac_query} object expressing a STAC query criteria.} \item{feature_id}{a \code{character} with item id to be fetched. @@ -53,7 +53,7 @@ in cases where the box spans the antimeridian, the first value to return. If not informed, it defaults to the service implementation.} } \value{ -A \code{RSTACQuery} object with the subclass \code{items} for +A \code{rstac_query} object with the subclass \code{items} for \code{/collections/{collection_id}/items} endpoint, or a \code{item_id} subclass for \code{/collections/{collection_id}/items/{feature_id}} endpoint, diff --git a/man/items_functions.Rd b/man/items_functions.Rd index 91b10d72..dd25fdce 100644 --- a/man/items_functions.Rd +++ b/man/items_functions.Rd @@ -1,150 +1,161 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/deprec-funs.R, R/items-funs.R -\name{items_group} -\alias{items_group} +% Please edit documentation in R/items-funs.R +\name{items_functions} \alias{items_functions} \alias{items_length} -\alias{items_length.STACItem} -\alias{items_length.STACItemCollection} -\alias{items_length.default} +\alias{items_length.doc_items} \alias{items_matched} -\alias{items_matched.STACItem} -\alias{items_matched.STACItemCollection} -\alias{items_matched.default} +\alias{items_matched.doc_items} \alias{items_fetch} -\alias{items_fetch.STACItemCollection} +\alias{items_fetch.doc_items} \alias{items_next} -\alias{items_next.STACItemCollection} +\alias{items_next.doc_items} \alias{items_datetime} -\alias{items_datetime.STACItem} -\alias{items_datetime.STACItemCollection} -\alias{items_datetime.default} +\alias{items_datetime.doc_item} +\alias{items_datetime.doc_items} \alias{items_bbox} -\alias{items_bbox.STACItem} -\alias{items_bbox.STACItemCollection} -\alias{items_bbox.default} +\alias{items_bbox.doc_item} +\alias{items_bbox.doc_items} \alias{items_assets} -\alias{items_assets.STACItem} -\alias{items_assets.STACItemCollection} +\alias{items_assets.doc_item} +\alias{items_assets.doc_items} \alias{items_assets.default} \alias{items_filter} -\alias{items_filter.STACItemCollection} +\alias{items_filter.doc_items} \alias{items_compact} -\alias{items_compact.STACItemCollection} +\alias{items_compact.doc_items} \alias{items_reap} -\alias{items_reap.STACItem} -\alias{items_reap.STACItemCollection} +\alias{items_reap.doc_item} +\alias{items_reap.doc_items} \alias{items_reap.default} \alias{items_fields} -\alias{items_fields.STACItem} -\alias{items_fields.STACItemCollection} -\alias{items_fields.default} +\alias{items_fields.doc_item} +\alias{items_fields.doc_items} \alias{items_sign} -\alias{items_sign.STACItem} -\alias{items_sign.STACItemCollection} +\alias{items_sign.doc_item} +\alias{items_sign.doc_items} \alias{items_sign.default} \alias{items_as_sf} -\alias{items_as_sf.STACItem} -\alias{items_as_sf.STACItemCollection} +\alias{items_as_sf.doc_item} +\alias{items_as_sf.doc_items} +\alias{items_as_sfc} +\alias{items_as_sfc.doc_item} +\alias{items_as_sfc.doc_items} +\alias{items_as_tibble} +\alias{items_as_tibble.doc_item} +\alias{items_as_tibble.doc_items} +\alias{items_intersects} +\alias{items_intersects.doc_item} +\alias{items_intersects.doc_items} +\alias{items_properties} +\alias{items_properties.doc_item} +\alias{items_properties.doc_items} +\alias{items_select} +\alias{items_select.doc_items} \title{Items functions} \usage{ -items_group(items, ..., field = NULL, index = NULL) - items_length(items) -\method{items_length}{STACItem}(items) - -\method{items_length}{STACItemCollection}(items) - -\method{items_length}{default}(items) +\method{items_length}{doc_items}(items) items_matched(items, matched_field = NULL) -\method{items_matched}{STACItem}(items, matched_field = NULL) - -\method{items_matched}{STACItemCollection}(items, matched_field = NULL) - -\method{items_matched}{default}(items, matched_field = NULL) +\method{items_matched}{doc_items}(items, matched_field = NULL) items_fetch(items, ...) -\method{items_fetch}{STACItemCollection}(items, ..., progress = TRUE, matched_field = NULL) +\method{items_fetch}{doc_items}(items, ..., progress = TRUE, matched_field = NULL) items_next(items, ...) -\method{items_next}{STACItemCollection}(items, ...) +\method{items_next}{doc_items}(items, ...) items_datetime(items) -\method{items_datetime}{STACItem}(items) - -\method{items_datetime}{STACItemCollection}(items) +\method{items_datetime}{doc_item}(items) -\method{items_datetime}{default}(items) +\method{items_datetime}{doc_items}(items) items_bbox(items) -\method{items_bbox}{STACItem}(items) - -\method{items_bbox}{STACItemCollection}(items) +\method{items_bbox}{doc_item}(items) -\method{items_bbox}{default}(items) +\method{items_bbox}{doc_items}(items) -items_assets(items, simplify = deprecated()) +items_assets(items) -\method{items_assets}{STACItem}(items, simplify = deprecated()) +\method{items_assets}{doc_item}(items) -\method{items_assets}{STACItemCollection}(items, simplify = deprecated()) +\method{items_assets}{doc_items}(items) -\method{items_assets}{default}(items, simplify = deprecated()) +\method{items_assets}{default}(items) items_filter(items, ..., filter_fn = NULL) -\method{items_filter}{STACItemCollection}(items, ..., filter_fn = NULL) +\method{items_filter}{doc_items}(items, ..., filter_fn = NULL) items_compact(items) -\method{items_compact}{STACItemCollection}(items) +\method{items_compact}{doc_items}(items) -items_reap(items, field, ..., pick_fn = identity) +items_reap(items, field, pick_fn = identity) -\method{items_reap}{STACItem}(items, field, ..., pick_fn = identity) +\method{items_reap}{doc_item}(items, field, pick_fn = identity) -\method{items_reap}{STACItemCollection}(items, field, ..., pick_fn = identity) +\method{items_reap}{doc_items}(items, field, pick_fn = identity) -\method{items_reap}{default}(items, field, ..., pick_fn = identity) +\method{items_reap}{default}(items, field, pick_fn = identity) -items_fields(items, field = NULL, ...) +items_fields(items, field = NULL) -\method{items_fields}{STACItem}(items, field = NULL, ...) +\method{items_fields}{doc_item}(items, field = NULL) -\method{items_fields}{STACItemCollection}(items, field = NULL, ...) - -\method{items_fields}{default}(items, field = NULL, ...) +\method{items_fields}{doc_items}(items, field = NULL) items_sign(items, sign_fn) -\method{items_sign}{STACItem}(items, sign_fn) +\method{items_sign}{doc_item}(items, sign_fn) -\method{items_sign}{STACItemCollection}(items, sign_fn) +\method{items_sign}{doc_items}(items, sign_fn) \method{items_sign}{default}(items, sign_fn) -items_as_sf(items) +items_as_sf(items, ..., crs = 4326) -\method{items_as_sf}{STACItem}(items) +\method{items_as_sf}{doc_item}(items, ..., crs = 4326) -\method{items_as_sf}{STACItemCollection}(items) -} -\arguments{ -\item{items}{a \code{STACItemCollection} object.} +\method{items_as_sf}{doc_items}(items, ..., crs = 4326) -\item{...}{additional arguments. See details.} +items_as_sfc(items, crs = 4326) -\item{field}{a \code{character} with the names of the field to -get the subfields values.} +\method{items_as_sfc}{doc_item}(items, crs = 4326) -\item{index}{an \code{atomic} vector with values as the group index.} +\method{items_as_sfc}{doc_items}(items, crs = 4326) + +items_as_tibble(items) + +\method{items_as_tibble}{doc_item}(items) + +\method{items_as_tibble}{doc_items}(items) + +items_intersects(items, geom, ..., crs = 4326) + +\method{items_intersects}{doc_item}(items, geom, ..., crs = 4326) + +\method{items_intersects}{doc_items}(items, geom, ..., crs = 4326) + +items_properties(items) + +\method{items_properties}{doc_item}(items) + +\method{items_properties}{doc_items}(items) + +items_select(items, selection) + +\method{items_select}{doc_items}(items, selection) +} +\arguments{ +\item{items}{a \code{doc_items} object.} \item{matched_field}{a \code{character} vector with the path where the number of items returned in the named list is located starting @@ -152,19 +163,29 @@ from the initial node of the list. For example, if the information is in a position \code{items$meta$found} of the object, it must be passed as the following parameter \code{c("meta", "found")}.} +\item{...}{additional arguments. See details.} + \item{progress}{a \code{logical} indicating if a progress bar must be shown or not. Defaults to \code{TRUE}.} -\item{simplify}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} no side-effect} - \item{filter_fn}{a \code{function} that receives an item that should evaluate a \code{logical} value.} +\item{field}{a \code{character} with the names of the field to +get the subfields values.} + \item{pick_fn}{a \code{function} used to pick elements from items addressed by \code{field} parameter.} \item{sign_fn}{a \code{function} that receives an item as a parameter and returns an item signed.} + +\item{crs}{a \code{character} representing the geometry projection.} + +\item{geom}{a \code{sf} or \code{sfc} object.} + +\item{selection}{an \code{integer} vector containing the indices of the items +to select.} } \value{ \itemize{ @@ -173,7 +194,7 @@ and returns an item signed.} \item \code{items_matched()}: returns an \code{integer} value if the STAC web server does support this extension. Otherwise returns \code{NULL}. -\item \code{items_fetch()}: a \code{STACItemCollection} with all matched items. +\item \code{items_fetch()}: a \code{doc_items} with all matched items. \item \code{items_next()}: fetches a new page from STAC service. @@ -181,31 +202,40 @@ does support this extension. Otherwise returns \code{NULL}. \item \code{items_bbox()}: returns a \code{list} with all items' bounding boxes. -\item \code{item_assets()}: Returns a \code{character} value with all assets names -of the all items. +\item \code{item_assets()}: returns a \code{character} value with all assets names +of all items. -\item \code{items_filter()}: a \code{STACItemCollection} object. +\item \code{items_filter()}: a \code{doc_items} object. \item \code{items_reap()}: a \code{vector} if the supplied field is atomic, otherwise or a \code{list}. \item \code{items_fields()}: a \code{character} vector. -\item \code{items_group()}: a \code{list} of \code{STACItemCollection} objects. - -\item \code{items_sign()}: a \code{STACItemCollection} object with signed assets url. +\item \code{items_sign()}: a \code{doc_items} object with signed assets url. \item \code{items_as_sf()}: a \code{sf} object. +\item \code{items_as_sfc()}: a \code{sfc} object. + +\item \code{items_as_tibble()}: a \code{tibble} object. + +\item \code{items_intersects()}: a \code{logical} vector. + +\item \code{items_properties()}: returns a \code{character} value with all properties +of all items. + +\item \code{items_select()}: select features from an items object. + } } \description{ These functions provide support to work with -\code{STACItemCollection} and \code{STACItem} objects. +\code{doc_items} and \code{doc_item} objects. \itemize{ \item \code{items_length()}: shows how many items there are in -the \code{STACItemCollection} object. +the \code{doc_items} object. \item \code{items_matched()}: shows how many items matched the search criteria. It supports \code{search:metadata} (v0.8.0), @@ -217,29 +247,36 @@ pagination. \item \code{items_next()}: fetches a new page from STAC service. \item \code{items_datetime()}: retrieves the \code{datetime} -field in \code{properties} from \code{STACItemCollection} and -\code{STACItem} objects. +field in \code{properties} from \code{doc_items} and +\code{doc_item} objects. \item \code{items_bbox()}: retrieves the \code{bbox} -field of a \code{STACItemCollection} or a \code{STACItem} object. +field of a \code{doc_items} or a \code{doc_item} object. \item \code{item_assets()}: returns the assets name from -\code{STACItemCollection} and \code{STACItem} objects. +\code{doc_items} and \code{doc_item} objects. \item \code{items_filter()}: selects only items that match some criteria (see details section). \item \code{items_reap()}: extract key values by traversing all items -in a \code{STACItemCollection} object. +in a \code{doc_items} object. \item \code{items_fields()}: lists field names inside an item. -\item \code{items_group()}: \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} organizes -items as elements of a list using some criteria. - \item \code{items_sign()}: allow access assets by preparing its url. -\item \code{items_as_sf()}: \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} convert items to \code{sf} object. +\item \code{items_as_sf()}: \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} convert items +to \code{sf} object. + +\item \code{items_as_sfc()}: \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} convert items +to \code{sfc} object. + +\item \code{items_intersects()}: \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} indicates +which items intersects a given geometry. + +\item \code{items_properties()}: lists properties names inside an item. + } } \details{ @@ -253,11 +290,8 @@ additional \code{httr} options to \link[httr:GET]{GET} or \link[httr:POST]{POST} methods, such as \link[httr:add_headers]{add_headers} or \link[httr:set_cookies]{set_cookies}. -\item \code{items_fields()}: ellipsis parameter is deprecated in version -0.9.2 of rstac. Please, use \code{field} parameter instead. - \item \code{items_filter()}: ellipsis is used to pass logical -expressions to be evaluated against a \code{STACItem} field as filter criteria. +expressions to be evaluated against a \code{doc_item} field as filter criteria. \strong{WARNING:} the evaluation of filter expressions changed in \code{rstac} 0.9.2. Older versions of \code{rstac} used \code{properties} field to evaluate filter @@ -284,7 +318,7 @@ Data Cube products and Microsoft Planetary Computer catalogs, respectively. \dontrun{ x <- stac("https://brazildatacube.dpi.inpe.br/stac") \%>\% stac_search(collections = "CB4-16D-2") \%>\% - stac_search(limit = 500) \%>\% + stac_search(datetime = "2020-01-01/2021-01-01", limit = 500) \%>\% get_request() x \%>\% items_length() @@ -298,7 +332,7 @@ Data Cube products and Microsoft Planetary Computer catalogs, respectively. # Defining BDC token Sys.setenv("BDC_ACCESS_KEY" = "token-123") -# STACItem object +# doc_item object stac("https://brazildatacube.dpi.inpe.br/stac/") \%>\% stac_search(collections = "CB4-16D-2", limit = 100, datetime = "2017-08-01/2018-03-01", @@ -308,7 +342,7 @@ stac("https://brazildatacube.dpi.inpe.br/stac/") \%>\% } \dontrun{ -# STACItemCollection object +# doc_items object stac("https://brazildatacube.dpi.inpe.br/stac/") \%>\% stac_search(collections = "CB4-16D-2", limit = 100, datetime = "2017-08-01/2018-03-01", @@ -327,7 +361,7 @@ stac("https://earth-search.aws.element84.com/v0") \%>\% } \dontrun{ -# STACItemCollection object +# doc_items object stac_item <- stac("https://brazildatacube.dpi.inpe.br/stac/") \%>\% stac_search(collections = "CB4-16D-2", limit = 100, datetime = "2017-08-01/2018-03-01", @@ -335,6 +369,13 @@ stac_item <- stac("https://brazildatacube.dpi.inpe.br/stac/") \%>\% get_request() \%>\% items_fetch(progress = FALSE) stac_item \%>\% items_reap(field = c("properties", "datetime")) + +stac_item \%>\% items_as_sf() + +stac_item \%>\% items_as_tibble() + +stac_item \%>\% items_select(c(1, 4, 10, 20)) + } } diff --git a/man/items_sign_bdc.Rd b/man/items_sign_bdc.Rd new file mode 100644 index 00000000..993c5667 --- /dev/null +++ b/man/items_sign_bdc.Rd @@ -0,0 +1,66 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/signatures.R +\name{items_sign_bdc} +\alias{items_sign_bdc} +\alias{sign_bdc} +\title{Signature in hrefs provided by the STAC from the Brazil Data Cube +project.} +\usage{ +items_sign_bdc(items, access_token = NULL, ...) + +sign_bdc(access_token = NULL, ...) +} +\arguments{ +\item{items}{a \code{doc_item} or \code{doc_items} object +representing the result of \verb{/stac/search}, +\code{/collections/{collectionId}/items} or +\code{/collections/{collectionId}/items/{itemId}} endpoints.} + +\item{access_token}{a \code{character} with the access token parameter to access +Brazil Data Cube assets.} + +\item{...}{additional parameters can be supplied to the \code{GET} +function of the \code{httr} package.} +} +\value{ +a \code{function} that signs each item assets. +\itemize{ +\item \code{items_sign_bdc()}: items with signed assets URLs. + +\item \code{sign_bdc()}: a function to to be passed to \code{items_sign()}. +} +} +\description{ +These functions provide support to access assets from Brazil Data Cube. + +\itemize{ +\item \code{items_sign_bdc()}: \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} +A simplified function to sign assets' URL from Brazil Data Cube +to be able to access the data. + +\item \code{sign_bdc()}: Creates a signing function to be +used by \code{items_sign()}. This function sign all the assets' URL. +} + +To sign the hrefs with your token you need to store it in an +environment variable in \code{BDC_ACCESS_KEY}or use \code{acess_token} parameter. +} +\examples{ +\dontrun{ + # doc_items object + stac_obj <- stac("https://brazildatacube.dpi.inpe.br/stac/") \%>\% + stac_search(collections = "CB4-16D-2", + datetime = "2019-06-01/2019-08-01") \%>\% + stac_search() \%>\% + get_request() + + # the new way to authenticate: + stac_obj <- stac_obj \%>\% + items_sign_bdc("") + + # this is the old way of authentication (still works): + # stac_obj \%>\% + # items_sign(sign_fn = sign_bdc(access_token = "")) +} + +} diff --git a/man/items_sign_planetary_computer.Rd b/man/items_sign_planetary_computer.Rd new file mode 100644 index 00000000..2e557cbb --- /dev/null +++ b/man/items_sign_planetary_computer.Rd @@ -0,0 +1,88 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/signatures.R +\name{items_sign_planetary_computer} +\alias{items_sign_planetary_computer} +\alias{sign_planetary_computer} +\title{Signs URL to access assets from Microsoft's Planetary Computer.} +\usage{ +items_sign_planetary_computer(items, subscription_key = NULL, ...) + +sign_planetary_computer(..., headers = NULL, token_url = NULL) +} +\arguments{ +\item{items}{a \code{doc_item} or \code{doc_items} object +representing the result of \verb{/stac/search}, +\code{/collections/{collectionId}/items} or +\code{/collections/{collectionId}/items/{itemId}} endpoints.} + +\item{subscription_key}{the \code{subscription-key} to access restricted +assets in Microsoft Planetary Computer. You can keep this parameter +empty for non-protected assets.} + +\item{...}{additional parameters can be supplied to the \code{GET} function +of the \code{httr} package.} + +\item{headers}{a named character vector with headers key-value content.} + +\item{token_url}{a \code{character} with the URL that generates the tokens +in the Microsoft service. +By default is used: +\code{"https://planetarycomputer.microsoft.com/api/sas/v1/token"}} +} +\value{ +\itemize{ +\item \code{items_sign_planetary_computer()}: items with signed assets URLs. + +\item \code{sign_planetary_computer()}: a function to to be passed to +\code{items_sign()}. +} +} +\description{ +These functions provide support to access assets from Planetary Computer. + +\itemize{ +\item \code{items_sign_planetary_computer()}: \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} +A simplified function to sign assets' URL from Microsoft Planetary +Computer to be able to access the data. + +\item \code{sign_planetary_computer()}: Creates a signing function to be +used by \code{items_sign()}. This function sign all the assets' URL. +} +} +\examples{ +\dontrun{ + # doc_items object + stac_obj <- stac("https://planetarycomputer.microsoft.com/api/stac/v1/") \%>\% + stac_search(collections = "sentinel-2-l2a", + bbox = c(-47.02148, -17.35063, -42.53906, -12.98314)) \%>\% + get_request() + + # the new way to authenticate: + stac_obj <- stac_obj \%>\% + items_sign_planetary_computer() + + # this is the old way of authentication (still works): + # stac_obj <- stac_obj \%>\% + # items_sign(sign_fn = sign_planetary_computer()) + + # example of access to collections that require authentication + stac_obj <- stac("https://planetarycomputer.microsoft.com/api/stac/v1") \%>\% + stac_search(collections = c("sentinel-1-rtc"), + bbox = c(-64.8597, -10.4919, -64.79272527, -10.4473), + datetime = "2019-01-01/2019-01-28") \%>\% + post_request() + + # the new way to authenticate: + # stac_obj <- stac_obj \%>\% + # items_sign_planetary_computer("") + + # this is the old way of authentication (still works): + # stac_obj <- stac_obj \%>\% + # items_sign( + # sign_fn = sign_planetary_computer( + # headers = c("Ocp-Apim-Subscription-Key" = ) + # ) + # ) +} + +} diff --git a/man/print.Rd b/man/print.Rd index 00d74e46..1059e6ef 100644 --- a/man/print.Rd +++ b/man/print.Rd @@ -2,65 +2,71 @@ % Please edit documentation in R/print.R \name{print} \alias{print} -\alias{print.RSTACQuery} -\alias{print.STACCatalog} -\alias{print.STACCollectionList} -\alias{print.STACCollection} -\alias{print.STACItemCollection} -\alias{print.STACItem} -\alias{print.Queryables} -\alias{print.Conformance} +\alias{print.rstac_query} +\alias{print.doc_catalog} +\alias{print.doc_collections} +\alias{print.doc_collection} +\alias{print.doc_items} +\alias{print.doc_item} +\alias{print.doc_queryables} +\alias{print.doc_conformance} +\alias{print.doc_link} +\alias{print.doc_links} \title{Printing functions} \usage{ -\method{print}{RSTACQuery}(x, ...) +\method{print}{rstac_query}(x, ...) -\method{print}{STACCatalog}(x, ...) +\method{print}{doc_catalog}(x, ...) -\method{print}{STACCollectionList}(x, n = 10, ...) +\method{print}{doc_collections}(x, n = 10, ...) -\method{print}{STACCollection}(x, ...) +\method{print}{doc_collection}(x, ...) -\method{print}{STACItemCollection}(x, n = 10, ..., tail = FALSE) +\method{print}{doc_items}(x, n = 10, ..., tail = FALSE) -\method{print}{STACItem}(x, ...) +\method{print}{doc_item}(x, ...) -\method{print}{Queryables}(x, n = 10, ...) +\method{print}{doc_queryables}(x, n = 10, ...) -\method{print}{Conformance}(x, n = 5, ...) +\method{print}{doc_conformance}(x, n = 10, ...) + +\method{print}{doc_link}(x, ...) + +\method{print}{doc_links}(x, n = 10, ...) } \arguments{ -\item{x}{either a \code{RSTACQuery} object expressing a STAC query -criteria or any \code{RSTACDocument}.} +\item{x}{either a \code{rstac_query} object expressing a STAC query +criteria or any \code{rstac_doc}.} \item{...}{other parameters passed in the functions.} \item{n}{number of entries to print. Each object has its own rule of -truncation: the \code{STACCollection} objects will print +truncation: the \code{doc_collection} objects will print 10 links by default. If the object has less than 20 collections, all -collections will be shown. In \code{STACItemCollection}, 10 features +collections will be shown. In \code{doc_items}, 10 features will be printed by default. To show all entries, use \code{n = Inf}.} \item{tail}{A \code{logical} value indicating if last features in -STACItemCollection object must be show.} +doc_items object must be show.} } \description{ The print function covers all objects in the rstac package: \itemize{ -\item \code{\link[=stac]{stac()}}: returns a \code{STACCatalog} document from +\item \code{\link[=stac]{stac()}}: returns a \code{doc_catalog} document from \verb{/stac} (v0.8.0) or \code{/} (v0.9.0 or v1.0.0) endpoint. -\item \code{\link[=stac_search]{stac_search()}}: returns a \code{STACItemCollection} +\item \code{\link[=stac_search]{stac_search()}}: returns a \code{doc_items} document from \verb{/stac/search} (v0.8.0) or \verb{/search} (v0.9.0 or v1.0.0) endpoint containing all Items that match the provided search predicates. \item \code{\link[=collections]{collections()}}: implements the \verb{/collections} and \code{/collections/\{collectionId\}} endpoints. The former returns -a \code{STACCollectionList} document that lists all collections published -by the server, and the later returns a single \code{STACCollection} +a \code{doc_collections} document that lists all collections published +by the server, and the later returns a single \code{doc_collection} document that describes a unique collection. -\item \code{\link[=items]{items()}}: retrieves a \code{STACItemCollection} document +\item \code{\link[=items]{items()}}: retrieves a \code{doc_items} document from \code{/collections/\{collectionId\}/items} endpoint and a -\code{STACItem} document from +\code{doc_item} document from \code{/collections/\{collectionId\}/items/\{itemId\}} endpoints. } @@ -73,7 +79,7 @@ You can determine how many items will be printed using \code{n} parameter. } \examples{ \dontrun{ - # STACItemCollection object + # doc_items object stac_item_collection <- stac("https://brazildatacube.dpi.inpe.br/stac/") \%>\% stac_search(collections = "CB4-16D-2", @@ -83,7 +89,7 @@ You can determine how many items will be printed using \code{n} parameter. print(stac_item_collection, n = 10) - # STACCollectionList object + # doc_collections object stac_collection <- stac("https://brazildatacube.dpi.inpe.br/stac/") \%>\% collections() \%>\% @@ -91,7 +97,7 @@ You can determine how many items will be printed using \code{n} parameter. print(stac_collection, n = 5) - # RSTACQuery object + # rstac_query object obj_rstac <- stac("https://brazildatacube.dpi.inpe.br/stac/") print(obj_rstac) diff --git a/man/queryables.Rd b/man/queryables.Rd index 931ef1ea..d861ca08 100644 --- a/man/queryables.Rd +++ b/man/queryables.Rd @@ -7,10 +7,10 @@ queryables(q) } \arguments{ -\item{q}{a \code{RSTACQuery} object expressing a STAC query criteria.} +\item{q}{a \code{rstac_query} object expressing a STAC query criteria.} } \value{ -A \code{RSTACQuery} object with the subclass \code{queryables} for \verb{/queryables} +A \code{rstac_query} object with the subclass \code{queryables} for \verb{/queryables} endpoint. } \description{ @@ -22,14 +22,14 @@ or from a collection (\verb{/collections/\{collection_id\}/queryables}). \examples{ \dontrun{ # Catalog's queryables -rstac::stac("https://planetarycomputer.microsoft.com/api/stac/v1") \%>\% - rstac::queryables() \%>\% rstac::get_request() +stac("https://planetarycomputer.microsoft.com/api/stac/v1") \%>\% + queryables() \%>\% get_request() # Collection's queryables -rstac::stac("https://planetarycomputer.microsoft.com/api/stac/v1") \%>\% - rstac::collections(collection_id = "sentinel-2-l2a") \%>\% - rstac::queryables() \%>\% - rstac::get_request() +stac("https://planetarycomputer.microsoft.com/api/stac/v1") \%>\% + collections(collection_id = "sentinel-2-l2a") \%>\% + queryables() \%>\% + get_request() } } diff --git a/man/request.Rd b/man/request.Rd index 64e2ae9f..490e462a 100644 --- a/man/request.Rd +++ b/man/request.Rd @@ -10,7 +10,7 @@ get_request(q, ...) post_request(q, ..., encode = c("json", "multipart", "form")) } \arguments{ -\item{q}{a \code{RSTACQuery} object expressing a STAC query +\item{q}{a \code{rstac_query} object expressing a STAC query criteria.} \item{...}{config parameters to be passed to \link[httr:GET]{GET} or @@ -24,8 +24,8 @@ and \code{'multipart'} (\code{'multipart/form-data'}). Defaults to \code{'json'}.} } \value{ -Either a \code{STACCatalog}, \code{STACCollection}, -\code{STACCollectionList}, \code{STACItemCollection} or \code{STACItem} +Either a \code{doc_catalog}, \code{doc_collection}, +\code{doc_collections}, \code{doc_items} or \code{doc_item} object depending on the subclass and search fields parameters of \code{q} argument. } diff --git a/man/rstac.Rd b/man/rstac.Rd index b80b6d29..71076468 100644 --- a/man/rstac.Rd +++ b/man/rstac.Rd @@ -2,8 +2,8 @@ % Please edit documentation in R/rstac.R \docType{package} \name{rstac} -\alias{rstac} \alias{rstac-package} +\alias{rstac} \title{R client library for STAC (rstac)} \description{ \if{html}{\figure{logo.png}{options: style='float: right' alt='logo' width='120'}} @@ -61,9 +61,9 @@ them accessible. \section{Data types}{ -The package implements the following S3 classes: \code{STACItemCollection}, -\code{STACItem}, \code{STACCatalog}, \code{STACCollectionList} and -\code{STACCollection}. These classes are regular lists representing the +The package implements the following S3 classes: \code{doc_items}, +\code{doc_item}, \code{doc_catalog}, \code{doc_collections} and +\code{doc_collection}. These classes are regular lists representing the corresponding JSON STAC objects. } diff --git a/man/sign_bdc.Rd b/man/sign_bdc.Rd deleted file mode 100644 index ab775f75..00000000 --- a/man/sign_bdc.Rd +++ /dev/null @@ -1,37 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/signatures.R -\name{sign_bdc} -\alias{sign_bdc} -\title{Signature in hrefs provided by the STAC from the Brazil Data Cube -project.} -\usage{ -sign_bdc(access_token = NULL, ...) -} -\arguments{ -\item{access_token}{a \code{character} with the access token parameter to access -Brazil Data Cube assets.} - -\item{...}{additional parameters can be supplied to the \code{GET} -function of the \code{httr} package.} -} -\value{ -a \code{function} that signs each item assets. -} -\description{ -To sign the hrefs with your token you need to store it in an -environment variable in \code{BDC_ACCESS_KEY}or use \code{acess_token} parameter. -} -\examples{ -\dontrun{ - # STACItemCollection object - stac_obj <- stac("https://brazildatacube.dpi.inpe.br/stac/") \%>\% - stac_search(collections = "CB4-16D-2", - datetime = "2019-06-01/2019-08-01") \%>\% - stac_search() \%>\% - get_request() - - # signing each item href - stac_obj \%>\% items_sign(sign_fn = sign_bdc(access_token = "123")) -} - -} diff --git a/man/sign_planetary_computer.Rd b/man/sign_planetary_computer.Rd deleted file mode 100644 index d72638be..00000000 --- a/man/sign_planetary_computer.Rd +++ /dev/null @@ -1,55 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/signatures.R -\name{sign_planetary_computer} -\alias{sign_planetary_computer} -\title{Signature in hrefs provided by the STAC from Microsoft's Planetary -Computer.} -\usage{ -sign_planetary_computer(..., headers = NULL, token_url = NULL) -} -\arguments{ -\item{...}{additional parameters can be supplied to the \code{GET} function -of the \code{httr} package.} - -\item{headers}{a named character vector with headers key-value content.} - -\item{token_url}{a \code{character} with the URL that generates the tokens -in the Microsoft service. -By default is used: -\code{"https://planetarycomputer.microsoft.com/api/sas/v1/token"}} -} -\value{ -a \code{function} that signs each item assets. -} -\description{ -To perform the signing of the hrefs a request is sent to -Planetary Computer servers and the returned content corresponds to the -token that will be used in the href. -} -\examples{ -\dontrun{ - # STACItemCollection object - stac_obj <- stac("https://planetarycomputer.microsoft.com/api/stac/v1/") \%>\% - stac_search(collections = "sentinel-2-l2a", - bbox = c(-47.02148, -17.35063, -42.53906, -12.98314)) \%>\% - get_request() - - # signing each asset href - stac_obj \%>\% items_sign(sign_fn = sign_planetary_computer()) - - # example of access to collections that require authentication - stac_obj <- stac("https://planetarycomputer.microsoft.com/api/stac/v1") \%>\% - stac_search(collections = c("sentinel-1-rtc"), - bbox = c(-64.8597, -10.4919, -64.79272527, -10.4473), - datetime = "2019-01-01/2019-01-28") \%>\% - post_request() - - # signing each asset href - # stac_obj \%>\% items_sign( - # sign_fn = sign_planetary_computer( - # headers = c("Ocp-Apim-Subscription-Key" = ) - # ) - # ) -} - -} diff --git a/man/stac.Rd b/man/stac.Rd index e30fa413..5c75a736 100644 --- a/man/stac.Rd +++ b/man/stac.Rd @@ -16,7 +16,7 @@ the version of STAC used. It is highly recommended that you inform the STAC version you are using.} } \value{ -A \code{RSTACQuery} object with the subclass \code{stac} containing all +A \code{rstac_query} object with the subclass \code{stac} containing all request parameters to be provided to API service. } \description{ diff --git a/man/stac_version.Rd b/man/stac_functions.Rd similarity index 60% rename from man/stac_version.Rd rename to man/stac_functions.Rd index e1950722..8c208f70 100644 --- a/man/stac_version.Rd +++ b/man/stac_functions.Rd @@ -1,14 +1,18 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/stac_version.R -\name{stac_version} +% Please edit documentation in R/stac-funs.R +\name{stac_functions} +\alias{stac_functions} \alias{stac_version} +\alias{stac_type} \title{Utility functions} \usage{ stac_version(x, ...) + +stac_type(x) } \arguments{ -\item{x}{either a \code{RSTACQuery} object expressing a STAC query -criteria or any \code{RSTACDocument}.} +\item{x}{either a \code{rstac_query} object expressing a STAC query +criteria or any \code{rstac_doc}.} \item{...}{config parameters to be passed to \link[httr:GET]{GET} method, such as \link[httr:add_headers]{add_headers} or \link[httr:set_cookies]{set_cookies}.} @@ -19,6 +23,6 @@ version. } \description{ These function retrieves information about either \code{rstac} queries -(\code{RSTACQuery} objects) or \code{rstac} documents -(\code{RSTACDocument} objects). +(\code{rstac_query} objects) or \code{rstac} documents +(\code{rstac_doc} objects). } diff --git a/man/stac_search.Rd b/man/stac_search.Rd index 54bf3381..3cabf7a7 100644 --- a/man/stac_search.Rd +++ b/man/stac_search.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/stac_search.R +% Please edit documentation in R/search-query.R \name{stac_search} \alias{stac_search} \title{Endpoint functions} @@ -15,7 +15,7 @@ stac_search( ) } \arguments{ -\item{q}{a \code{RSTACQuery} object expressing a STAC query +\item{q}{a \code{rstac_query} object expressing a STAC query criteria.} \item{collections}{a \code{character} vector of collection IDs to include in @@ -61,14 +61,14 @@ interval or date-time informed in \code{datetime} are selected.} \item{intersects}{a \code{list} expressing GeoJSON geometries objects as specified in RFC 7946. Only returns items that intersect with -the provided geometry. To turn a GeoJSON into a list the packages -\code{geojsonsf} or \code{jsonlite} can be used.} +the provided geometry. To turn a GeoJSON into a list the package +\code{jsonlite} can be used.} \item{limit}{an \code{integer} defining the maximum number of results to return. If not informed, it defaults to the service implementation.} } \value{ -A \code{RSTACQuery} object with the subclass \code{search} containing all +A \code{rstac_query} object with the subclass \code{search} containing all search field parameters to be provided to STAC API web service. } \description{ @@ -81,7 +81,7 @@ The \code{stac_search} function implements \verb{/stac/search} API endpoint It prepares query parameters used in the search API request, a \code{stac} object with all filter parameters to be provided to \code{get_request} or \code{post_request} functions. The GeoJSON content -returned by these requests is a \code{STACItemCollection} object, a regular R +returned by these requests is a \code{doc_items} object, a regular R \code{list} representing a STAC Item Collection document. } \examples{ diff --git a/man/static_functions.Rd b/man/static_functions.Rd new file mode 100644 index 00000000..fc93ace1 --- /dev/null +++ b/man/static_functions.Rd @@ -0,0 +1,110 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/static-funs.R +\name{static_functions} +\alias{static_functions} +\alias{read_stac} +\alias{read_items} +\alias{read_collections} +\alias{links} +\alias{link_open} +\title{Static functions} +\usage{ +read_stac(url, ...) + +read_items(collection, ..., limit = 100, page = 1, progress = TRUE) + +read_collections(catalog, ..., limit = 100, page = 1, progress = TRUE) + +links(x, ...) + +link_open(link, base_url = NULL) +} +\arguments{ +\item{url}{a \code{character} value with the URL to a valid STAC document.} + +\item{...}{additional arguments. See details.} + +\item{collection}{a \code{doc_collection} object to fetch all +\code{rel=="item"} links.} + +\item{limit}{an \code{integer} with defining the page size of items to fetch.} + +\item{page}{an \code{integer} with the page number to fetch the items.} + +\item{progress}{a \code{logical} indicating if a progress bar must be +shown or not. Defaults to \code{TRUE}.} + +\item{catalog}{a \code{doc_catalog} object to fetch all \code{rel=="child"} links.} + +\item{x}{any \code{rstac} document with \code{'links'} key entry.} + +\item{link}{a \code{doc_link} object, usually an element of \code{links} key entry.} + +\item{base_url}{a \code{character} with the base URL to resolve relative links. +If \code{NULL} (default) \code{rstac} will try resolve relative links using +internal metadata.} +} +\value{ +\itemize{ +\item \code{links()}: a \code{doc_links} object containing a list of \code{link} entries. + +\item \code{link_open()}: a recognizable \code{rstac} document. +} +} +\description{ +These functions provide support to work with static catalogs. + +\itemize{ +\item \code{stac_read()}: open a STAC document from an URL. + +\item \code{read_items()}: opens (statically) all items referred in \code{links} +key entry of a given collection document (\code{doc_collection}). + +\item \code{links()}: extracts and filters the links of any STAC document. + +\item \code{link_open()}: opens (statically) the document referenced by +the link. This function can resolve any relative URL. +} +} +\details{ +Ellipsis argument (\code{...}) may appears in different items functions and +has distinct purposes: +\itemize{ + +\item \code{stac_read()}: ellipsis is used to pass any additional parameters +to \link[jsonlite:read_json]{read_json} function. + +\item \code{links()}: ellipsis is used to pass logical expressions to be +evaluated against a \code{doc_link} item as a filter criteria. See examples. + +} +} +\examples{ +\dontrun{ + x <- stac("https://brazildatacube.dpi.inpe.br/stac") \%>\% + collections("CB4-16D-2") \%>\% + get_request() + + link <- links(x, rel == "items") + link_open(link[[1]]) +} + +\dontrun{ + wv_url <- paste0( + "https://s3.eu-central-1.wasabisys.com", + "/stac/openlandmap/wv_mcd19a2v061.seasconv/collection.json" + ) + wv <- read_stac(wv_url) + stac_type(wv) # Collection + + # reads the second page of 5 links + wv_items <- read_items(wv, limit = 5, page = 2) + + # lists all links of the collection document that are not items + links(wv, rel != "item") + + # lists all links of the items document + links(wv_items) +} + +} diff --git a/tests/testthat.R b/tests/testthat.R index 28b6789a..be8d8c4a 100644 --- a/tests/testthat.R +++ b/tests/testthat.R @@ -2,6 +2,6 @@ library(testthat) library(rstac) library(magrittr) -if (Sys.getenv("RSTAC_TESTS", unset = 0) == 1) { +if (identical(Sys.getenv("NOT_CRAN"), "true")) { test_check("rstac") } diff --git a/tests/testthat/test-assets_functions.R b/tests/testthat/test-assets_functions.R index 15792064..a07f10de 100644 --- a/tests/testthat/test-assets_functions.R +++ b/tests/testthat/test-assets_functions.R @@ -4,7 +4,7 @@ testthat::test_that("assets functions", { # assets_download----------------------------------------------------------- testthat::expect_equal( - object = rstac::stac("https://brazildatacube.dpi.inpe.br/stac/") %>% + object = stac("https://brazildatacube.dpi.inpe.br/stac/") %>% stac_search( collections = "CB4-16D-2", datetime = "2019-09-01/2019-11-01", @@ -19,8 +19,8 @@ testthat::test_that("assets functions", { testthat::expect_error( stac("https://brazildatacube.dpi.inpe.br/stac/") %>% - get_request(.) %>% - assets_download(., asset_names = c("blue", "evi")) + get_request() %>% + assets_download(asset_names = c("blue", "evi")) ) # error - wrong path @@ -49,25 +49,7 @@ testthat::test_that("assets functions", { create_json = FALSE) subclass(x) }, - expected = "STACItemCollection" - ) - - # deprec param - testthat::expect_message( - object = { - stac("https://brazildatacube.dpi.inpe.br/stac/") %>% - stac_search( - collections = "CB4-16D-2", - datetime = "2019-09-01/2019-11-01", - limit = 1) %>% - get_request() %>% - assets_download(asset_names = c("thumbnail"), - fn = function(x) { x }, - output_dir = tempdir(), - create_json = FALSE, - overwrite = TRUE) - }, - regexp = "deprecated" + expected = "doc_items" ) testthat::expect_equal( @@ -86,7 +68,7 @@ testthat::test_that("assets functions", { overwrite = TRUE) subclass(x) }, - expected = "STACItemCollection" + expected = "doc_items" ) testthat::expect_equal( @@ -101,23 +83,7 @@ testthat::test_that("assets functions", { overwrite = TRUE) subclass(x) }, - expected = "STACItem" - ) - - # deprec fn param - testthat::expect_message( - object = { - stac("https://brazildatacube.dpi.inpe.br/stac/") %>% - collections("CB4-16D-2") %>% - items("CB4-16D_V2_000002_20230509") %>% - get_request() %>% - assets_download(asset_names = c("thumbnail"), - fn = function(x) {x}, - output_dir = tempdir(), - create_json = FALSE, - overwrite = TRUE) - }, - regexp = "deprecated" + expected = "doc_item" ) testthat::expect_equal( @@ -134,7 +100,7 @@ testthat::test_that("assets functions", { overwrite = TRUE) subclass(x) }, - expected = "STACItem" + expected = "doc_item" ) stac_items <- stac("https://brazildatacube.dpi.inpe.br/stac") %>% @@ -151,13 +117,13 @@ testthat::test_that("assets functions", { # return the same object after select? testthat::expect_s3_class( object = assets_select(stac_items, asset_names = "BAND13"), - class = c("STACItemCollection", "RSTACDocument") + class = c("doc_items", "rstac_doc") ) # return the same object after select? testthat::expect_s3_class( object = assets_select(stac_item, asset_names = "BAND13"), - class = c("STACItem", "RSTACDocument") + class = c("doc_item", "rstac_doc") ) # were the asset selected? @@ -170,7 +136,7 @@ testthat::test_that("assets functions", { testthat::expect_equal( object = items_assets(assets_select(stac_items, asset_names = c("BAND14", "EVI"), - `eo:bands` == 5)), + `eo:bands` == 8)), expected = "EVI" ) @@ -193,14 +159,14 @@ testthat::test_that("assets functions", { expect_length( object = items_assets( - assets_select(stac_item, 10 %in% asset_get("eo:band")) + suppressWarnings(assets_select(stac_item, 10 %in% asset_get("eo:band"))) ), n = 0 ) expect_length( object = items_assets( - assets_select(stac_item, "B1" %in% asset_get("eo:band")) + suppressWarnings(assets_select(stac_item, "B1" %in% asset_get("eo:band"))) ), n = 0 ) @@ -221,36 +187,36 @@ testthat::test_that("assets functions", { testthat::expect_s3_class( object = assets_rename(selected_items, c("BAND13" = "B13")), - class = c("STACItemCollection", "RSTACDocument") + class = c("doc_items", "rstac_doc") ) testthat::expect_s3_class( object = assets_rename(selected_item, c("BAND13" = "B13")), - class = c("STACItem", "RSTACDocument") + class = c("doc_item", "rstac_doc") ) testthat::expect_s3_class( object = assets_rename(selected_items, list("BAND13" = "B13")), - class = c("STACItemCollection", "RSTACDocument") + class = c("doc_items", "rstac_doc") ) testthat::expect_s3_class( object = assets_rename(selected_item, list("BAND13" = "B13")), - class = c("STACItem", "RSTACDocument") + class = c("doc_item", "rstac_doc") ) testthat::expect_s3_class( object = assets_rename(selected_items, list(BAND13 = "B13"), BAND14 = "B14"), - class = c("STACItemCollection", "RSTACDocument") + class = c("doc_items", "rstac_doc") ) testthat::expect_s3_class( object = assets_rename(selected_item, list(BAND13 = "B13"), BAND14 = "B14"), - class = c("STACItem", "RSTACDocument") + class = c("doc_item", "rstac_doc") ) testthat::expect_equal( @@ -332,7 +298,7 @@ testthat::test_that("assets functions", { return(x$`eo:bands` < 6) return(FALSE) }), - class = c("STACItem", "RSTACDocument") + class = c("doc_item", "rstac_doc") ) # return the same object after filter? @@ -344,56 +310,50 @@ testthat::test_that("assets functions", { }) ) - # assets_filter----------------------------------------------------------- - # deprec function assets_filter + # assets_select----------------------------------------------------------- testthat::expect_equal( - object = {suppressWarnings(class(assets_filter(stac_items, `eo:bands` < 6)))}, - expected = c("STACItemCollection", "RSTACDocument", "list") + object = {class(assets_select(stac_items, `eo:bands` < 6))}, + expected = c("doc_items", "rstac_doc", "list") ) - # deprec function assets_filter testthat::expect_equal( - object = {suppressWarnings(class(assets_filter(stac_items, filter_fn = function(x) { + object = {class(assets_select(stac_items, select_fn = function(x) { if ("eo:bands" %in% names(x)) return(x$`eo:bands` < 6) return(FALSE) - })))}, - expected = c("STACItemCollection", "RSTACDocument", "list") + }))}, + expected = c("doc_items", "rstac_doc", "list") ) - # deprec function assets_filter testthat::expect_equal( - object = {suppressWarnings(class(assets_filter(stac_item, `eo:bands` < 6)))}, - expected = c("STACItem", "RSTACDocument", "list") + object = class(assets_select(stac_item, `eo:bands` < 6)), + expected = c("doc_item", "rstac_doc", "list") ) - # deprec function assets_filter testthat::expect_error( - object = suppressWarnings(assets_filter(stac_item, a = `eo:bands` < 6)), + object = assets_select(stac_item, a = `eo:bands` < 6), ) - # deprec function assets_filter - testthat::expect_error( - object = suppressWarnings(assets_filter(stac_item, `eo:dbandsd` < 6)), + testthat::expect_warning( + object = assets_select(stac_item, `eo:dbandsd` < 6), ) - # deprec function assets_filter testthat::expect_error( - object = suppressWarnings(assets_filter(stac_items, a = `eo:bands` < 6)), + object = assets_select(stac_items, a = `eo:bands` < 6), ) - # deprec function assets_filter - testthat::expect_error( - object = suppressWarnings(assets_filter(stac_items, `eo:dbandsd` < 6)), + testthat::expect_warning( + object = assets_select(stac_items, `eo:dbandsd` < 6), ) - # deprec function assets_filter testthat::expect_equal( - object = {suppressWarnings(class(assets_filter(stac_item, filter_fn = function(x) { - if ("eo:bands" %in% names(x)) - return(x$`eo:bands` < 6) - return(FALSE) - })))}, - expected = c("STACItem", "RSTACDocument", "list") + object = { + class(assets_select(stac_item, select_fn = function(x) { + if ("eo:bands" %in% names(x)) + return(x$`eo:bands` < 6) + return(FALSE) + })) + }, + expected = c("doc_item", "rstac_doc", "list") ) }) diff --git a/tests/testthat/test-examples.R b/tests/testthat/test-examples.R index 6f3f1de9..68d711d7 100644 --- a/tests/testthat/test-examples.R +++ b/tests/testthat/test-examples.R @@ -6,17 +6,17 @@ testthat::test_that("examples rstac", { # test collections - /collections/ testthat::expect_s3_class( - object = rstac::stac("https://brazildatacube.dpi.inpe.br/stac/") %>% - rstac::collections() %>% - rstac::get_request(), - class = c("STACCollectionList", "RSTACDocument")) + object = stac("https://brazildatacube.dpi.inpe.br/stac/") %>% + collections() %>% + get_request(), + class = c("doc_collections", "rstac_doc")) # test collections items - /collections/{collection_id} testthat::expect_s3_class( object = stac("https://brazildatacube.dpi.inpe.br/stac/") %>% collections(collection_id = "CB4-16D-2") %>% get_request(), - class = c("STACCollection", "STACCatalog", "RSTACDocument")) + class = c("doc_collection", "doc_catalog", "rstac_doc")) # test items collection - /collections/{collection_id}/items testthat::expect_s3_class( @@ -24,7 +24,7 @@ testthat::test_that("examples rstac", { collections("CB4-16D-2") %>% items(bbox = c(-47.02148, -12.98314, -42.53906, -17.35063)) %>% get_request(), - class = c("STACItemCollection", "RSTACDocument")) + class = c("doc_items", "rstac_doc")) # test items collection - /search/ testthat::expect_s3_class( @@ -32,7 +32,7 @@ testthat::test_that("examples rstac", { stac_search(collections = "CB4-16D-2", bbox = c(-47.02148, -12.98314, -42.53906, -17.35063)) %>% get_request(), - class = c("STACItemCollection", "RSTACDocument")) + class = c("doc_items", "rstac_doc")) # test items collection - /search/ testthat::expect_s3_class( @@ -40,7 +40,7 @@ testthat::test_that("examples rstac", { stac_search(collections = "CB4-16D-2", bbox = c(-47.02148, -12.98314, -42.53906, -17.35063)) %>% post_request(), - class = c("STACItemCollection", "RSTACDocument")) + class = c("doc_items", "rstac_doc")) # test stac item - /collections/{collection_id}/items/{feature_id} testthat::expect_s3_class( @@ -48,13 +48,13 @@ testthat::test_that("examples rstac", { collections("CB4-16D-2") %>% items("CB4-16D_V2_000002_20230509") %>% get_request(), - class = c("STACItem", "RSTACDocument")) + class = c("doc_item", "rstac_doc")) # test stac catalog - / testthat::expect_s3_class( object = stac("https://brazildatacube.dpi.inpe.br/stac/") %>% get_request(), - class = c("STACCatalog", "RSTACDocument")) + class = c("doc_catalog", "rstac_doc")) #### tests in extensions #### @@ -64,7 +64,7 @@ testthat::test_that("examples rstac", { stac_search(collections = "CB4-16D-2") %>% ext_query("bdc:tile" == "021027") %>% post_request(), - class = c("STACItem", "RSTACDocument")) + class = c("doc_item", "rstac_doc")) #### tests in items #### @@ -75,7 +75,7 @@ testthat::test_that("examples rstac", { limit = 500) %>% get_request() %>% items_fetch(), - class = c("STACItemCollection", "RSTACDocument")) + class = c("doc_items", "rstac_doc")) # test item_length testthat::expect_equal( @@ -86,62 +86,6 @@ testthat::test_that("examples rstac", { items_length(), expected = 10) - # test items_group - testthat::expect_error( - object = - suppressWarnings( - stac("https://brazildatacube.dpi.inpe.br/stac/") %>% - stac_search(collections = "LCC_C4_64_1M_STK_GO_PA-SPC-AC-NA-1", - limit = 500, - datetime = "2018-09-01/2019-08-31") %>% - get_request() %>% - items_fetch() %>% - items_group() - ) - ) - - # test items_group - testthat::expect_error( - object = - suppressWarnings( - stac("https://brazildatacube.dpi.inpe.br/stac/") %>% - stac_search(collections = "LCC_C4_64_1M_STK_GO_PA-SPC-AC-NA-1", - limit = 500, - datetime = "2018-09-01/2019-08-31") %>% - get_request() %>% - items_fetch() %>% - items_group() - ) - ) - - # test items_group - testthat::expect_error( - object = - suppressWarnings( - stac("https://brazildatacube.dpi.inpe.br/stac/") %>% - stac_search(collections = "LCC_C4_64_1M_STK_GO_PA-SPC-AC-NA-1", - limit = 500, - datetime = "2018-09-01/2019-08-31") %>% - get_request() %>% - items_fetch() %>% - items_group(field = "test", index = "test") - ) - ) - - # test items_group - testthat::expect_error( - object = - suppressWarnings( - stac("https://brazildatacube.dpi.inpe.br/stac/") %>% - stac_search(collections = "LCC_C4_64_1M_STK_GO_PA-SPC-AC-NA-1", - limit = 500, - datetime = "2018-09-01/2019-08-31") %>% - get_request() %>% - items_fetch() %>% - items_group(index = list(1, 2, 3)) - ) - ) - # test items_reap testthat::expect_equal( object = typeof( diff --git a/tests/testthat/test-ext_filter.R b/tests/testthat/test-ext_filter.R index ad8f6d55..6ad8f81e 100644 --- a/tests/testthat/test-ext_filter.R +++ b/tests/testthat/test-ext_filter.R @@ -5,8 +5,11 @@ conformance_test <- function(q, expected_number) { ) } -test_that("Conformance Test 7", { - q <- rstac::stac(base_url = "https://cql2test.ldproxy.net/ne110m4cql2", +test_that("doc_conformance Test 7", { + skip_if({ + httr::http_error(httr::HEAD("https://cql2test.ldproxy.net/ne110m4cql2")) + }, "Test server is offline") + q <- stac(base_url = "https://cql2test.ldproxy.net/ne110m4cql2", force_version = "0.9.0") conformance_test( q = ext_filter( @@ -38,10 +41,10 @@ test_that("Conformance Test 7", { datetime < "2019-02-02") res <- post_request(res) - expect_s3_class(res, "STACItemCollection") + expect_s3_class(res, "doc_items") res2 <- items_next(res) - expect_s3_class(res2, "STACItemCollection") - expect_gt(object = items_length(res2), expected = items_length(res)) + expect_s3_class(res2, "doc_items") + expect_equal(object = items_length(res2), expected = items_length(res)) conformance_test( q = ext_filter( @@ -252,8 +255,11 @@ test_that("Conformance Test 7", { ) }) -test_that("Conformance Test 12", { - q <- rstac::stac(base_url = "https://cql2test.ldproxy.net/ne110m4cql2", +test_that("doc_conformance Test 12", { + skip_if({ + httr::http_error(httr::HEAD("https://cql2test.ldproxy.net/ne110m4cql2")) + }, "Test server is offline") + q <- stac(base_url = "https://cql2test.ldproxy.net/ne110m4cql2", force_version = "0.9.0") conformance_test( q = ext_filter( @@ -370,8 +376,11 @@ test_that("Conformance Test 12", { ) }) -test_that("Conformance Test 16", { - q <- rstac::stac(base_url = "https://cql2test.ldproxy.net/ne110m4cql2", +test_that("doc_conformance Test 16", { + skip_if({ + httr::http_error(httr::HEAD("https://cql2test.ldproxy.net/ne110m4cql2")) + }, "Test server is offline") + q <- stac(base_url = "https://cql2test.ldproxy.net/ne110m4cql2", force_version = "0.9.0") conformance_test( @@ -457,8 +466,11 @@ test_that("Conformance Test 16", { ) }) -test_that("Conformance Test 25", { - q <- rstac::stac(base_url = "https://cql2test.ldproxy.net/ne110m4cql2", +test_that("doc_conformance Test 25", { + skip_if({ + httr::http_error(httr::HEAD("https://cql2test.ldproxy.net/ne110m4cql2")) + }, "Test server is offline") + q <- stac(base_url = "https://cql2test.ldproxy.net/ne110m4cql2", force_version = "0.9.0") polygon <- list( @@ -532,8 +544,11 @@ test_that("Conformance Test 25", { ) }) -test_that("Conformance Test 34", { - q <- rstac::stac(base_url = "https://cql2test.ldproxy.net/ne110m4cql2", +test_that("doc_conformance Test 34", { + skip_if({ + httr::http_error(httr::HEAD("https://cql2test.ldproxy.net/ne110m4cql2")) + }, "Test server is offline") + q <- stac(base_url = "https://cql2test.ldproxy.net/ne110m4cql2", force_version = "0.9.0") polygon <- list( type = "Polygon", @@ -685,8 +700,11 @@ test_that("Conformance Test 34", { ) }) -test_that("Conformance Test 38", { - q <- rstac::stac(base_url = "https://cql2test.ldproxy.net/ne110m4cql2", +test_that("doc_conformance Test 38", { + skip_if({ + httr::http_error(httr::HEAD("https://cql2test.ldproxy.net/ne110m4cql2")) + }, "Test server is offline") + q <- stac(base_url = "https://cql2test.ldproxy.net/ne110m4cql2", force_version = "0.9.0") conformance_test( @@ -874,8 +892,11 @@ test_that("Conformance Test 38", { ) }) -test_that("Conformance Test 45", { - q <- rstac::stac(base_url = "https://cql2test.ldproxy.net/ne110m4cql2", +test_that("doc_conformance Test 45", { + skip_if({ + httr::http_error(httr::HEAD("https://cql2test.ldproxy.net/ne110m4cql2")) + }, "Test server is offline") + q <- stac(base_url = "https://cql2test.ldproxy.net/ne110m4cql2", force_version = "0.9.0") conformance_test( q = ext_filter( diff --git a/tests/testthat/test-internals.R b/tests/testthat/test-internals.R index 70da6dc8..526a2b38 100644 --- a/tests/testthat/test-internals.R +++ b/tests/testthat/test-internals.R @@ -2,15 +2,11 @@ testthat::test_that("internals functions", { # skip cran check test testthat::skip_on_cran() - stac_obj <- rstac::stac("https://brazildatacube.dpi.inpe.br/stac/") + stac_obj <- stac("https://brazildatacube.dpi.inpe.br/stac/") - # check_subclass object + # check_query object testthat::expect_null( - object = check_subclass(stac_obj, subclasses = c("stac")) - ) - - testthat::expect_error( - object = .check_obj(stac_obj, "numeric") + object = check_query(stac_obj, classes = c("stac")) ) # check for query for wrong verb @@ -26,7 +22,7 @@ testthat::test_that("internals functions", { testthat::expect_error( object = { mock_obj <- stac_obj - class(mock_obj) <- "RSTACQuery" + class(mock_obj) <- "rstac_query" after_response(mock_obj, res = NULL) } ) @@ -34,7 +30,7 @@ testthat::test_that("internals functions", { testthat::expect_error( object = { mock_obj <- stac_obj - class(mock_obj) <- "RSTACQuery" + class(mock_obj) <- "rstac_query" endpoint(mock_obj) } ) @@ -54,10 +50,6 @@ testthat::test_that("internals functions", { testthat::expect_warning( .warning("warning function") ) - - testthat::expect_error( - .make_url("aaa", params = list(1)) - ) }) testthat::test_that("internals response", { diff --git a/tests/testthat/test-items_functions.R b/tests/testthat/test-items_functions.R index 37f97e39..807ff4a1 100644 --- a/tests/testthat/test-items_functions.R +++ b/tests/testthat/test-items_functions.R @@ -2,13 +2,13 @@ testthat::test_that("items functions", { # skip cran check test testthat::skip_on_cran() - res <- rstac::stac("https://brazildatacube.dpi.inpe.br/stac/") %>% + res <- stac("https://brazildatacube.dpi.inpe.br/stac/") %>% stac_search( collections = "CB4-16D-2", limit = 10) %>% get_request() - res_bbox <- rstac::stac("https://brazildatacube.dpi.inpe.br/stac/") %>% + res_bbox <- stac("https://brazildatacube.dpi.inpe.br/stac/") %>% stac_search( collections = "CB4-16D-2", limit = 1, @@ -26,7 +26,7 @@ testthat::test_that("items functions", { .Dim = c(1L, 5L, 2L)) ) - res_geo <- rstac::stac("https://brazildatacube.dpi.inpe.br/stac/") %>% + res_geo <- stac("https://brazildatacube.dpi.inpe.br/stac/") %>% stac_search( collections = "CB4-16D-2", limit = 1, @@ -34,13 +34,13 @@ testthat::test_that("items functions", { intersects = intersects_geojson) %>% post_request() - res_ext <- rstac::stac("https://brazildatacube.dpi.inpe.br/stac/") %>% + res_ext <- stac("https://brazildatacube.dpi.inpe.br/stac/") %>% stac_search(collections = "CB4-16D-2", limit = 10) %>% ext_query("bdc:tile" %in% "007004") %>% post_request() - item_stac <- rstac::stac("https://brazildatacube.dpi.inpe.br/stac/") %>% + item_stac <- stac("https://brazildatacube.dpi.inpe.br/stac/") %>% collections(collection_id = "CB4-16D-2") %>% items(feature_id = "CB4-16D_V2_000002_20230509") %>% get_request() @@ -71,12 +71,12 @@ testthat::test_that("items functions", { # ok - stac_collection_list object testthat::expect_equal( object = subclass( - rstac::stac("https://brazildatacube.dpi.inpe.br/stac/") %>% + stac("https://brazildatacube.dpi.inpe.br/stac/") %>% stac_search(collections = "LCC_C4_64_1M_STK_GO_PA-SPC-AC-NA-1", limit = 500) %>% get_request(.) %>% items_fetch()), - expected = "STACItemCollection" + expected = "doc_items" ) testthat::expect_error( @@ -95,7 +95,7 @@ testthat::test_that("items functions", { ext_query("io:tile_id" %in% "60W") %>% post_request() %>% items_fetch())), - expected = "STACItemCollection" + expected = "doc_items" ) # items_length-------------------------------------------------------------- @@ -103,47 +103,47 @@ testthat::test_that("items functions", { testthat::expect_true(is.numeric(items_length(res))) # items_datetime------------------------------------------------------------ - # STACItemCollection + # doc_items testthat::expect_length(items_datetime(res), n = 10) - # STACItem + # doc_item testthat::expect_vector(items_datetime(item_stac), ptype = character()) # provide wrong object testthat::expect_error( object = items_datetime( - rstac::stac("https://brazildatacube.dpi.inpe.br/stac/") %>% + stac("https://brazildatacube.dpi.inpe.br/stac/") %>% collections(collection_id = "CB4-16D-2") %>% get_request() ) ) # items_bbox---------------------------------------------------------------- - # STACItemCollection + # doc_items testthat::expect_length(items_bbox(res), n = 10) - # STACItem + # doc_item testthat::expect_vector(items_bbox(item_stac), ptype = double()) testthat::expect_error( object = items_bbox( - rstac::stac("https://brazildatacube.dpi.inpe.br/stac/") %>% + stac("https://brazildatacube.dpi.inpe.br/stac/") %>% collections(collection_id = "CB4-16D-2") %>% get_request() ) ) # items_assets--------------------------------------------------------------- - # STACItemCollection + # doc_items testthat::expect_length(items_assets(res), n = 11) - # STACItem + # doc_item testthat::expect_vector(items_assets(item_stac), ptype = character()) # provide wrong object testthat::expect_error( object = items_assets( - rstac::stac("https://brazildatacube.dpi.inpe.br/stac/") %>% + stac("https://brazildatacube.dpi.inpe.br/stac/") %>% collections(collection_id = "CB4-16D-2") %>% get_request() ) @@ -163,36 +163,36 @@ testthat::test_that("items functions", { object = items_filter( res, filter_fn = function(x) {x[["eo:cloud_cover"]] < 10} ), - class = "STACItemCollection" + class = "doc_items" ) testthat::expect_s3_class( object = items_filter( res, filter_fn = function(x) {x$properties$`eo:cloud_cover` < 10} ), - class = "STACItemCollection" + class = "doc_items" ) testthat::expect_warning( - object = items_filter(res, `eo:cloud_cover` < 10), - class = "STACItemCollection" + object = items_filter(res, properies$`eo:cloud_cover` < 10), + class = "doc_items" ) testthat::expect_s3_class( object = items_filter(res, properties$`eo:cloud_cover` < 10), - class = "STACItemCollection" + class = "doc_items" ) testthat::expect_s3_class( object = items_filter(res), - class = "STACItemCollection" + class = "doc_items" ) testthat::expect_error( object = items_filter(item_stac, `eo:cloud_cover` < 10) ) - testthat::expect_error( + testthat::expect_warning( object = items_filter(res, list(`eo:cloud_cover` < 10)) ) @@ -202,11 +202,6 @@ testthat::test_that("items functions", { expected = "character" ) - testthat::expect_message( - items_assets(res, simplify = FALSE), - regexp = "deprecated" - ) - testthat::expect_equal( object = class(items_assets(item_stac)), expected = "character" @@ -215,40 +210,39 @@ testthat::test_that("items functions", { # items_next---------------------------------------------------------------- testthat::expect_s3_class( object = items_next(res_geo), - class = "STACItemCollection" + class = "doc_items" ) testthat::expect_s3_class( object = items_next(res_bbox), - class = "STACItemCollection" + class = "doc_items" ) testthat::expect_s3_class( object = items_next(res), - class = "STACItemCollection" + class = "doc_items" ) testthat::expect_s3_class( object = items_next(res_ext), - class = "STACItemCollection" + class = "doc_items" ) testthat::expect_equal( object = items_length(items_next(res)), - expected = 20 + expected = 10 ) testthat::expect_error( object = { mock_obj <- res_geo attributes(mock_obj)$query <- list(NULL) - items_next(mock_obj) } ) # items_reap---------------------------------------------------------------- - # STACItemCollection + # doc_items testthat::expect_equal( object = class(items_reap(item_stac, field = c("properties", "datetime"))), expected = "character" @@ -260,14 +254,12 @@ testthat::test_that("items functions", { ) testthat::expect_null(items_reap(item_stac, FALSE)) - testthat::expect_message(items_reap(item_stac, FALSE, field = FALSE), - regexp = "^The parameter \\.\\.\\.") testthat::expect_error( object = subclass(items_reap(item_stac)) ) - # STACItemCollection + # doc_items testthat::expect_equal( object = class(items_reap(res, field = c("properties", "datetime"))), expected = "character" @@ -280,14 +272,14 @@ testthat::test_that("items functions", { # items_reap with pick_fn testthat::expect_equal( - object = class(items_reap(item_stac, field = c("properties"), - pick_fn = function(x) x[["datetime"]])), + object = class(items_reap(item_stac, field = "properties", + pick_fn = function(x) x$datetime)), expected = "character" ) testthat::expect_length( - object = items_reap(item_stac, field = c("properties"), - pick_fn = function(x) x[["datetime"]]), + object = items_reap(item_stac, field = "properties", + pick_fn = function(x) x$datetime), n = 1 ) diff --git a/tests/testthat/test-rstac_objs.R b/tests/testthat/test-rstac_objs.R index cc091370..0c9e9294 100644 --- a/tests/testthat/test-rstac_objs.R +++ b/tests/testthat/test-rstac_objs.R @@ -5,35 +5,6 @@ testthat::test_that("stac search object", { stac("https://landsatlook.usgs.gov/sat-api/stac", force_version = "0.7.0") ) - testthat::expect_equal( - suppressWarnings( - endpoint(stac("https://landsatlook.usgs.gov/sat-api/stac", - force_version = "0.7.0") - ) - ), - expected = "/stac" - ) - - testthat::expect_equal( - suppressWarnings( - endpoint(stac("https://landsatlook.usgs.gov/sat-api/stac", - force_version = "0.8.1") %>% - stac_search() - - ) - ), - expected = "/stac/search" - ) - - testthat::expect_equal( - suppressWarnings( - endpoint(stac("https://landsatlook.usgs.gov/sat-api/stac", - force_version = "1.0.0") - ) - ), - expected = "/" - ) - # no stac version detected testthat::expect_error( stac("https://landsatlook.usgs.gov/sat-api/stac") %>% @@ -46,68 +17,59 @@ testthat::test_that("stac search object", { # Error when creating the stac object by parameter bbox testthat::expect_error( - rstac::stac("https://brazildatacube.dpi.inpe.br/stac/") %>% - rstac::stac_search(bbox = c(-55.16335, -4.26325, -49.31739)) + stac("https://brazildatacube.dpi.inpe.br/stac/") %>% + stac_search(bbox = c(-55.16335, -4.26325, -49.31739)) ) # check object class of stac_search testthat::expect_equal( object = class( - rstac::stac("https://brazildatacube.dpi.inpe.br/stac/") %>% - rstac::stac_search(bbox = "-48.19039,-16.00871,-41.6341,-11.91345")), - expected = c("search", "RSTACQuery") + stac("https://brazildatacube.dpi.inpe.br/stac/") %>% + stac_search(bbox = "-48.19039,-16.00871,-41.6341,-11.91345")), + expected = c("search", "rstac_query") ) # check object class of stac_search testthat::expect_s3_class( - object = rstac::stac("https://brazildatacube.dpi.inpe.br/stac/") %>% - rstac::stac_search(bbox = c(-48.19039, -16.00871, + object = stac("https://brazildatacube.dpi.inpe.br/stac/") %>% + stac_search(bbox = c(-48.19039, -16.00871, -41.6341, -11.91345, -18.00871, -42.12)), - class = c("search", "RSTACQuery") + class = c("search", "rstac_query") ) # check object class of stac_search testthat::expect_s3_class( object = before_request( - rstac::stac("https://brazildatacube.dpi.inpe.br/stac/") %>% - rstac::stac_search(bbox = c(-48.19039, -16.00871, + stac("https://brazildatacube.dpi.inpe.br/stac/") %>% + stac_search(bbox = c(-48.19039, -16.00871, -41.6341, -11.91345, -18.00871, -42.12))), - class = c("search", "RSTACQuery") - ) - - # check object class of stac_search - testthat::expect_error( - object = endpoint( - rstac::stac("https://brazildatacube.dpi.inpe.br/stac/") %>% - rstac::stac_search(bbox = c(-48.19039, -16.00871, - -41.6341, -11.91345, - -18.00871, -42.12))) + class = c("search", "rstac_query") ) # check object class of stac_search testthat::expect_error( object = after_response( - rstac::stac("https://brazildatacube.dpi.inpe.br/stac/") %>% - rstac::stac_search(bbox = c(-48.19039, -16.00871, + stac("https://brazildatacube.dpi.inpe.br/stac/") %>% + stac_search(bbox = c(-48.19039, -16.00871, -41.6341, -11.91345, -18.00871, -42.12)), NULL) ) # check object class of stac_search testthat::expect_s3_class( - object = rstac::stac("https://brazildatacube.dpi.inpe.br/stac/") %>% - rstac::stac_search(bbox = c(-48.19039, -16.00871, + object = stac("https://brazildatacube.dpi.inpe.br/stac/") %>% + stac_search(bbox = c(-48.19039, -16.00871, -41.6341, -11.91345)), - class = c("search", "RSTACQuery") + class = c("search", "rstac_query") ) # check object class of stac_search testthat::expect_s3_class( - object = rstac::stac("https://brazildatacube.dpi.inpe.br/stac/") %>% - rstac::stac_search(limit = 10), - class = c("search", "RSTACQuery") + object = stac("https://brazildatacube.dpi.inpe.br/stac/") %>% + stac_search(limit = 10), + class = c("search", "rstac_query") ) testthat::expect_error( @@ -118,63 +80,63 @@ testthat::test_that("stac search object", { testthat::expect_error( object = suppressWarnings( - rstac::stac("https://brazildatacube.dpi.inpe.br/stac/") %>% - rstac::stac_search(limit = "dddd") + stac("https://brazildatacube.dpi.inpe.br/stac/") %>% + stac_search(limit = "dddd") ) ) testthat::expect_error( object = suppressWarnings( - rstac::stac("https://brazildatacube.dpi.inpe.br/stac/") %>% - rstac::stac_search(limit = c(1, 2)) + stac("https://brazildatacube.dpi.inpe.br/stac/") %>% + stac_search(limit = c(1, 2)) ) ) # check object class of stac_search testthat::expect_s3_class( - object = rstac::stac("https://brazildatacube.dpi.inpe.br/stac/") %>% - rstac::stac_search(ids = c(1, 2)), - class = c("search", "RSTACQuery") + object = stac("https://brazildatacube.dpi.inpe.br/stac/") %>% + stac_search(ids = c(1, 2)), + class = c("search", "rstac_query") ) # check object class of stac_search testthat::expect_s3_class( - object = rstac::stac("https://brazildatacube.dpi.inpe.br/stac/") %>% - rstac::stac_search(intersects = paste0( + object = stac("https://brazildatacube.dpi.inpe.br/stac/") %>% + stac_search(intersects = paste0( "{\"type\":\"Polygon\",\"coordinates\":[[[-48.19039,-16.00871],", "[-41.6341,-16.00871],[-41.6341,-11.91345],[-48.19039,-11.91345],", "[-48.19039,-16.00871]]]}")), - class = c("search", "RSTACQuery") + class = c("search", "rstac_query") ) # check object class of stac_search testthat::expect_s3_class( - object = rstac::stac("https://brazildatacube.dpi.inpe.br/stac/") %>% - rstac::stac_search(collections = "ssss", ids = "aaa,bbb,ccc"), - class = c("search", "RSTACQuery") + object = stac("https://brazildatacube.dpi.inpe.br/stac/") %>% + stac_search(collections = "ssss", ids = "aaa,bbb,ccc"), + class = c("search", "rstac_query") ) # check GET request from stac_search object testthat::expect_equal( object = subclass( - rstac::stac("https://brazildatacube.dpi.inpe.br/stac/") %>% - rstac::stac_search(bbox = c(-48.19039, -16.00871, + stac("https://brazildatacube.dpi.inpe.br/stac/") %>% + stac_search(bbox = c(-48.19039, -16.00871, -41.6341, -11.91345)) %>% get_request()), - expected = "STACItemCollection" + expected = "doc_items" ) # check for invalid stac endpoint testthat::expect_error( - object = rstac::stac("https://brazildataddddde.dpi.inpe.br/stac/") %>% - rstac::stac_search(bbox = c(-48.19039, -16.00871, + object = stac("https://brazildataddddde.dpi.inpe.br/stac/") %>% + stac_search(bbox = c(-48.19039, -16.00871, -41.6341, -11.91345)) %>% get_request() ) testthat::expect_error( - object = rstac::stac("https://brazildatacube.dpi.inpe.br/stac/") %>% - rstac::stac_search(intersects = "aaa") + object = stac("https://brazildatacube.dpi.inpe.br/stac/") %>% + stac_search(intersects = "aaa") ) # Check extensions --------------------------------------------------------- @@ -183,7 +145,7 @@ testthat::test_that("stac search object", { testthat::expect_error( object = stac("https://brazildatacube.dpi.inpe.br/stac/") %>% ext_query("bdc:tile" == "007004") %>% - rstac::stac_search(datetime = "2018-01-01/..") + stac_search(datetime = "2018-01-01/..") ) # check extension query - wrong query @@ -211,8 +173,8 @@ testthat::test_that("stac search object", { ) s_search <- - rstac::stac("https://brazildatacube.dpi.inpe.br/stac/") %>% - rstac::stac_search() + stac("https://brazildatacube.dpi.inpe.br/stac/") %>% + stac_search() # Check each operation in query extension ---------------------------------- @@ -291,7 +253,7 @@ testthat::test_that("stac search object", { testthat::expect_s3_class( object = ext_query(s_search, "bdc:tile" %in% "007004") %>% post_request(), - class = "STACItemCollection" + class = "doc_items" ) # Check print function------------------------------------------------------ @@ -299,44 +261,44 @@ testthat::test_that("stac search object", { # check object testthat::expect_output( object = print( - rstac::stac("https://brazildatacube.dpi.inpe.br/stac/") %>% - rstac::stac_search(datetime = "2018-01-01/2018-07-01", limit = 10) %>% + stac("https://brazildatacube.dpi.inpe.br/stac/") %>% + stac_search(datetime = "2018-01-01/2018-07-01", limit = 10) %>% get_request(), n = 10), - regexp = "###STACItemCollection" + regexp = "###Items" ) testthat::expect_output( object = print( - rstac::stac("https://brazildatacube.dpi.inpe.br/stac/") %>% - rstac::stac_search(datetime = "2018-01-01/2018-07-01", limit = 10) %>% + stac("https://brazildatacube.dpi.inpe.br/stac/") %>% + stac_search(datetime = "2018-01-01/2018-07-01", limit = 10) %>% get_request(), n = 10), - regexp = "###STACItemCollection" + regexp = "###Items" ) # Check errors in fixed date time------------------------------------------- # check fixed date time testthat::expect_error( - rstac::stac("https://brazildatacube.dpi.inpe.br/stac/") %>% - rstac::stac_search(datetime = "20-02-2012T00:00:00Z") + stac("https://brazildatacube.dpi.inpe.br/stac/") %>% + stac_search(datetime = "20-02-2012T00:00:00Z") ) # check fixed date time testthat::expect_error( - rstac::stac("https://brazildatacube.dpi.inpe.br/stac/") %>% - rstac::stac_search(datetime = "20-2012-20T00:00:00Z") + stac("https://brazildatacube.dpi.inpe.br/stac/") %>% + stac_search(datetime = "20-2012-20T00:00:00Z") ) # check fixed date time testthat::expect_error( - rstac::stac("https://brazildatacube.dpi.inpe.br/stac/") %>% - rstac::stac_search(datetime = "20-02-2012") + stac("https://brazildatacube.dpi.inpe.br/stac/") %>% + stac_search(datetime = "20-02-2012") ) # check fixed date time testthat::expect_equal( object = subclass( - rstac::stac("https://brazildatacube.dpi.inpe.br/stac/") %>% - rstac::stac_search(datetime = "2019-02-12T00:00:00Z")), + stac("https://brazildatacube.dpi.inpe.br/stac/") %>% + stac_search(datetime = "2019-02-12T00:00:00Z")), expected = c("search") ) @@ -344,16 +306,16 @@ testthat::test_that("stac search object", { # check closed date time testthat::expect_error( - rstac::stac("https://brazildatacube.dpi.inpe.br/stac/") %>% - rstac::stac_search( + stac("https://brazildatacube.dpi.inpe.br/stac/") %>% + stac_search( datetime = "2019-02-12T00:00:00Z/2018-03-18T12:31:12Z") ) # check fixed date time testthat::expect_equal( object = subclass( - rstac::stac("https://brazildatacube.dpi.inpe.br/stac/") %>% - rstac::stac_search( + stac("https://brazildatacube.dpi.inpe.br/stac/") %>% + stac_search( datetime = "2018-02-12T00:00:00Z/2018-03-18T12:31:12Z")), expected = c("search") ) @@ -362,33 +324,33 @@ testthat::test_that("stac search object", { # check interval date time testthat::expect_error( - rstac::stac("https://brazildatacube.dpi.inpe.br/stac/") %>% - rstac::stac_search(datetime = "./2018-03-18T12:31:12Z") + stac("https://brazildatacube.dpi.inpe.br/stac/") %>% + stac_search(datetime = "./2018-03-18T12:31:12Z") ) # check interval date time - wrong pattern testthat::expect_error( - rstac::stac("https://brazildatacube.dpi.inpe.br/stac/") %>% - rstac::stac_search(datetime = "../1008-03-2018T12:31:12Z") + stac("https://brazildatacube.dpi.inpe.br/stac/") %>% + stac_search(datetime = "../1008-03-2018T12:31:12Z") ) # check interval date time testthat::expect_error( - rstac::stac("https://brazildatacube.dpi.inpe.br/stac/") %>% - rstac::search(datetime = "2018-03-18T12:31:12Z/.") + stac("https://brazildatacube.dpi.inpe.br/stac/") %>% + search(datetime = "2018-03-18T12:31:12Z/.") ) # check interval date time - wrong pattern testthat::expect_error( - rstac::stac("https://brazildatacube.dpi.inpe.br/stac/") %>% - rstac::stac_search(datetime = "20-03-2018T12:31:12Z/..") + stac("https://brazildatacube.dpi.inpe.br/stac/") %>% + stac_search(datetime = "20-03-2018T12:31:12Z/..") ) # check fixed date time testthat::expect_equal( object = subclass( - rstac::stac("https://brazildatacube.dpi.inpe.br/stac/") %>% - rstac::stac_search(datetime = "2018-03-20T12:31:12Z/..")), + stac("https://brazildatacube.dpi.inpe.br/stac/") %>% + stac_search(datetime = "2018-03-20T12:31:12Z/..")), expected = c("search") ) }) @@ -400,13 +362,13 @@ testthat::test_that("stac collection object", { # stac_collections---------------------------------------------------------- # check object class of stac collections - s_col <- rstac::stac("https://brazildatacube.dpi.inpe.br/stac/") %>% - rstac::collections() %>% + s_col <- stac("https://brazildatacube.dpi.inpe.br/stac/") %>% + collections() %>% get_request() testthat::expect_equal( - object = subclass(s_col), - expected = "STACCollectionList" + object = stac_type(s_col), + expected = "Collections" ) testthat::expect_equal( @@ -424,9 +386,9 @@ testthat::test_that("stac collection object", { # check print stac object testthat::expect_output( - object = print(rstac::stac("https://brazildatacube.dpi.inpe.br/stac/") %>% - rstac::collections()), - regexp = "###RSTACQuery" + object = print(stac("https://brazildatacube.dpi.inpe.br/stac/") %>% + collections()), + regexp = "###rstac_query" ) testthat::expect_output( @@ -434,15 +396,10 @@ testthat::test_that("stac collection object", { regexp = "collections" ) - testthat::expect_equal( - object = attributes(s_col)$query$endpoint, - expected = "/collections" - ) - # check object class of stac collections s_colid <- - rstac::stac("https://brazildatacube.dpi.inpe.br/stac/") %>% - rstac::collections(collection_id = "CB4-16D-2") + stac("https://brazildatacube.dpi.inpe.br/stac/") %>% + collections(collection_id = "CB4-16D-2") testthat::expect_null( object = s_colid$endpoint @@ -457,13 +414,13 @@ testthat::test_that("stac collection object", { # check request from stac collections object testthat::expect_equal( object = subclass(s_colid %>% get_request()), - expected = "STACCollection" + expected = "doc_collection" ) # check print stac_collection object testthat::expect_output( object = print((s_colid %>% get_request())), - regexp = "###STACCollection" + regexp = "###Collection" ) }) @@ -471,7 +428,7 @@ testthat::test_that("stac object", { # skip cran check test testthat::skip_on_cran() - stac_catalog <- rstac::stac("https://brazildatacube.dpi.inpe.br/stac/") %>% + stac_catalog <- stac("https://brazildatacube.dpi.inpe.br/stac/") %>% get_request() testthat::expect_equal( @@ -482,24 +439,24 @@ testthat::test_that("stac object", { # check object class of stac testthat::expect_equal( object = subclass( - rstac::stac("https://brazildatacube.dpi.inpe.br/stac/")), + stac("https://brazildatacube.dpi.inpe.br/stac/")), expected = "stac" ) # check request from stac object testthat::expect_equal( object = subclass( - rstac::stac("https://brazildatacube.dpi.inpe.br/stac/") %>% + stac("https://brazildatacube.dpi.inpe.br/stac/") %>% get_request()), - expected = "STACCatalog" + expected = "doc_catalog" ) # check print stac_collection object testthat::expect_output( object = print( - rstac::stac("https://brazildatacube.dpi.inpe.br/stac") %>% + stac("https://brazildatacube.dpi.inpe.br/stac") %>% get_request()), - regexp = "###STACCatalog" + regexp = "###Catalog" ) }) @@ -509,13 +466,13 @@ testthat::test_that("stac item object", { # not provide collection id testthat::expect_error( - rstac::stac("https://brazildatacube.dpi.inpe.br/stac/") %>% + stac("https://brazildatacube.dpi.inpe.br/stac/") %>% items(bbox = c(-48.19039, -16.00871, -41.6341, -11.91345)) ) # wrong date testthat::expect_error( - rstac::stac("https://brazildatacube.dpi.inpe.br/stac/") %>% + stac("https://brazildatacube.dpi.inpe.br/stac/") %>% items( bbox = c(-48.19039, -16.00871, -41.6341, -11.91345), datetime = "2018-02-01/.", @@ -524,7 +481,7 @@ testthat::test_that("stac item object", { # wrong bbox testthat::expect_error( - rstac::stac("https://brazildatacube.dpi.inpe.br/stac/") %>% + stac("https://brazildatacube.dpi.inpe.br/stac/") %>% items( bbox = c(-48.19039, -16.00871, -41.6341, -11.91345), datetime = "2018-02-01/..", @@ -534,7 +491,7 @@ testthat::test_that("stac item object", { # stac_collection_list object testthat::expect_equal( object = subclass( - rstac::stac("https://brazildatacube.dpi.inpe.br/stac/", + stac("https://brazildatacube.dpi.inpe.br/stac/", force_version = "0.9.0") %>% collections("CB4_64-1") %>% items( @@ -547,7 +504,7 @@ testthat::test_that("stac item object", { # stac_item object testthat::expect_equal( object = subclass( - rstac::stac("https://brazildatacube.dpi.inpe.br/stac/") %>% + stac("https://brazildatacube.dpi.inpe.br/stac/") %>% collections("CB4_64-1") %>% items( bbox = c(-48.19039, -16.00871, -41.6341, -11.91345), @@ -560,7 +517,7 @@ testthat::test_that("stac item object", { # stac_item object testthat::expect_equal( object = stac_version( - rstac::stac("https://brazildatacube.dpi.inpe.br/stac/") %>% + stac("https://brazildatacube.dpi.inpe.br/stac/") %>% collections("CB4_64-1") %>% items( bbox = c(-48.19039, -16.00871, -41.6341, -11.91345), @@ -570,7 +527,7 @@ testthat::test_that("stac item object", { expected = "0.9.0" ) - stac_item <- rstac::stac("https://brazildatacube.dpi.inpe.br/stac/") %>% + stac_item <- stac("https://brazildatacube.dpi.inpe.br/stac/") %>% collections("CB4-16D-2") %>% items( bbox = c(-48.19039, -16.00871, -41.6341, -11.91345), @@ -582,26 +539,9 @@ testthat::test_that("stac item object", { # output test testthat::expect_output( object = print(stac_item), - regexp = "###STACItem" + regexp = "###Item" ) - # output test - testthat::expect_equal( - object = items_length(stac_item), - expected = 1 - ) - - # output test - testthat::expect_equal( - object = items_matched(stac_item), - expected = 1 - ) - - # output test - testthat::expect_equal( - object = items_length(stac_item), - expected = 1 - ) }) testthat::test_that("queryables object", { @@ -613,23 +553,23 @@ testthat::test_that("queryables object", { testthat::expect_equal( object = subclass( - rstac::stac("https://brazildatacube.dpi.inpe.br/stac/") %>% + stac("https://brazildatacube.dpi.inpe.br/stac/") %>% queryables()), - expected = c("queryables", "stac") + expected = c("queryables") ) testthat::expect_equal( object = subclass( - rstac::stac("https://brazildatacube.dpi.inpe.br/stac/") %>% + stac("https://brazildatacube.dpi.inpe.br/stac/") %>% queryables()), - expected = c("queryables", "stac") + expected = c("queryables") ) testthat::expect_equal( object = subclass( - rstac::stac("https://brazildatacube.dpi.inpe.br/stac/") %>% + stac("https://brazildatacube.dpi.inpe.br/stac/") %>% collections("sentinel") %>% queryables()), - expected = c("queryables", "collection_id") + expected = c("queryables") ) testthat::expect_equal( @@ -637,7 +577,7 @@ testthat::test_that("queryables object", { stac("https://planetarycomputer.microsoft.com/api/stac/v1") %>% queryables() %>% get_request()), - expected = c("Queryables", "RSTACDocument", "list") + expected = c("doc_queryables", "rstac_doc", "list") ) testthat::expect_equal( @@ -646,7 +586,7 @@ testthat::test_that("queryables object", { collections(collection_id = "sentinel-2-l2a") %>% queryables() %>% get_request()), - expected = c("Queryables", "RSTACDocument", "list") + expected = c("doc_queryables", "rstac_doc", "list") ) testthat::expect_output( @@ -668,16 +608,16 @@ testthat::test_that("conformance object", { testthat::expect_equal( object = subclass( - rstac::stac("https://brazildatacube.dpi.inpe.br/stac/") %>% + stac("https://brazildatacube.dpi.inpe.br/stac/") %>% conformance()), - expected = c("conformance", "stac") + expected = c("conformance") ) testthat::expect_equal( object = subclass( - rstac::stac("https://brazildatacube.dpi.inpe.br/stac/") %>% + stac("https://brazildatacube.dpi.inpe.br/stac/") %>% conformance()), - expected = c("conformance", "stac") + expected = c("conformance") ) testthat::expect_equal( @@ -685,7 +625,7 @@ testthat::test_that("conformance object", { stac("https://planetarycomputer.microsoft.com/api/stac/v1") %>% conformance() %>% get_request()), - expected = c("Conformance", "RSTACDocument", "list") + expected = c("doc_conformance", "rstac_doc", "list") ) testthat::expect_output( diff --git a/tests/testthat/test-signatures.R b/tests/testthat/test-signatures.R index d11c2fd1..9ae2df89 100644 --- a/tests/testthat/test-signatures.R +++ b/tests/testthat/test-signatures.R @@ -16,13 +16,13 @@ testthat::test_that("signature functions", { # return the same object after signature? testthat::expect_s3_class( object = stac_items %>% items_sign(sign_fn = sign_bdc("AAAA-BBB")), - class = c("STACItemCollection", "RSTACDocument") + class = c("doc_items", "rstac_doc") ) # return the same object after signature? testthat::expect_s3_class( object = stac_item %>% items_sign(sign_fn = sign_bdc("AAAA-BBB")), - class = c("STACItem", "RSTACDocument") + class = c("doc_item", "rstac_doc") ) items_signed <- items_sign(stac_items, sign_fn = sign_bdc("AAAA-BBB")) @@ -91,7 +91,7 @@ testthat::test_that("signature functions", { object = suppressWarnings( items_sign(stac_items, sign_planetary_computer) ), - class = c("STACItemCollection", "RSTACDocument") + class = c("doc_items", "rstac_doc") ) # provided wrong url @@ -107,7 +107,7 @@ testthat::test_that("signature functions", { object = suppressWarnings( items_sign(stac_item, sign_fn = sign_planetary_computer()) ), - class = c("STACItem", "RSTACDocument") + class = c("doc_item", "rstac_doc") ) items_signed <- suppressWarnings( diff --git a/vignettes/.gitignore b/vignettes/.gitignore deleted file mode 100644 index 097b2416..00000000 --- a/vignettes/.gitignore +++ /dev/null @@ -1,2 +0,0 @@ -*.html -*.R diff --git a/vignettes/rstac-01-intro.Rmd b/vignettes/rstac-01-intro.Rmd deleted file mode 100644 index 6b458bc3..00000000 --- a/vignettes/rstac-01-intro.Rmd +++ /dev/null @@ -1,368 +0,0 @@ ---- -title: "Introduction to rstac package" -author: "Rolf Simoes, Felipe Carvalho, and Gilberto Camara" -date: "2023-01-09" -output: - html_document: - df_print: tibble -classoption: x11names -fontsize: 10,5pt -indent: yes -link-citations: yes -vignette: > - %\VignetteIndexEntry{Introduction to rstac package} - %\VignetteEngine{knitr::rmarkdown} - %\VignetteEncoding{UTF-8} ---- - -```{r prepare, include = FALSE} -is_online <- tryCatch({ - res <- httr::GET("https://brazildatacube.dpi.inpe.br/stac/") - !httr::http_error(res) -}, error = function(e) { - FALSE -}) - -knitr::opts_chunk$set( - collapse = TRUE, - comment = "#>", - eval = is_online -) -library(tibble) -``` - -```{r setup, eval=TRUE, echo=FALSE} -library(rstac) -``` - -# About rstac{-} - -This document will introduce the concepts of the `rstac` package. `rstac` is an R client library for STAC that fully supports STAC API v1.0.0 and its earlier versions (>= v0.8.0). - -The table shows the functions implemented by the `rstac` package according to -the STAC API endpoints. For each endpoint, `rstac` has a specialized implementation. - - -```{R endpoints, eval=TRUE, echo=FALSE} - -data.frame( - "**STAC** endpoints" = c( - "`/`", "`/stac`","`/collections`", "`/collections/{collectionId}`", - "`/collections/{collectionId}/items`", "`/collections/{collectionId}/items/{itemId}`", "`/search`", "`/stac/search`", - "`/conformance`", "`/collections/{collectionId}/queryables`" - ), "`rstac` functions" = c( - "`stac()`", "`stac()`", "`collections()`", "`collections(collection_id)`", - "`items()`", "`items(feature_id)`", "`stac_search()`", "`stac_search()`", - "`conformance()`", "`queryables()`" - ), "API version" = c( - ">= 0.9.0", "< 0.9.0", ">= 0.9.0", ">= 0.9.0", ">= 0.9.0", ">= 0.9.0", - ">= 0.9.0", "< 0.9.0", ">= 0.9.0", ">= 1.0.0" - ), - check.names = FALSE -) %>% knitr::kable(format = "markdown") -``` - -The `rstac` package makes the requests explicitly. The `rstac` pipeline creates the endpoints with function concatenations and then requests them. - -## Getting started{-} - -Let's start by installing the `rstac` package: - -```{r installing, eval=FALSE} -install.packages("rstac") -``` - -## Creating queries{-} - -This tutorial use the STAC API made available by the [Brazil Data Cube (BDC)](http://www.brazildatacube.org/en/home-page-2/) project. BDC is a research, development, and technological innovation project of the National Institute for Space Research (INPE), Brazil. - -Let's start by creating a query for the BDC catalog. - -```{r queries-1, eval=TRUE} -s_obj <- stac("https://brazildatacube.dpi.inpe.br/stac/") -s_obj -``` -The `RSTACQuery` object stores the metadata of the created query. -This metadata can be accessed as a list element during query creation. - -```{r base-url, eval=TRUE} -s_obj$base_url -``` -Endpoints are constructed through function concatenations provided by `rstac`. Some examples are shown below: - -```{r queries-2, eval=TRUE} -s_obj |> - collections() -``` - -```{r queries-3, eval=TRUE} -s_obj |> - collections("S2-16D-2") -``` - -```{r queries-4, eval=TRUE} -s_obj |> - collections("S2-16D-2") |> - items() -``` - -```{r queries-5, eval=TRUE} -s_obj |> - collections("S2-16D-2") |> - items(feature_id = "S2-16D_V2_015011_20190117") -``` - -```{r queries-6, eval=TRUE} -s_obj |> - stac_search(collections = c("CB4-16D-2", "S2-16D-2")) |> - ext_query("bdc:tile" == "007004") -``` - -## Making requests{-} - -`rstac` package supports **GET** and **POST** HTTP -methods. With future updates to the STAC specifications, it is intended to -support other methods such as **PUT** and **DELETE**. -In addition, it is possible to add more configuration options to the request, -such as headers (`httr::add_headers()`) and cookies (`httr::set_cookies()`). -These options are available in the `httr` package documentation in the [`config`](https://httr.r-lib.org/reference/config.html). - -### HTTP GET: `get_request()`{-} - -```{r request-1} -s_obj |> - collections(collection_id = "CB4-16D-2") |> - items() |> - get_request() -``` - -### HTTP POST: `post_request()`{-} - -```{r request-2} -s_obj |> - stac_search( - collections = c("CB4-16D-2", "S2-16D-2"), - datetime = "2021-01-01/2021-01-31", - limit = 400) |> - post_request() -``` - -Example of providing an additional argument to HTTP verb in a request: - -```{r request-3} -s_obj |> - stac_search(collections = c("CB4-16D-2", "S2-16D-2")) |> - post_request(config = c(httr::add_headers("x-api-key" = "MY-KEY"))) -``` - -## Visualization of the documents{-} - -Each `rstac` object is mapped according to the endpoints of the STAC spec. In this way, each object has a different view. The format for viewing objects is in **Markdown**. - -#### `STACCatalog` object{-} - -```{r catalog} -s_obj |> - get_request() -``` - -#### `STACCollection` object{-} - -```{r collection} -s_obj |> - collections("S2-16D-2") |> - get_request() -``` - -#### `STACItem` object{-} - -```{r item} -s_obj |> - collections("CB4-16D-2") |> - items(feature_id = "CB4-16D_V2_000002_20230509") |> - get_request() -``` - -#### `STACItemCollection` object{-} - -```{r item-collection} -s_obj |> - stac_search(collections = c("CB4_64_16D_STK", "S2-16D-2")) |> - get_request() -``` - - -Besides, the `rstac` package provides several auxiliary functions for `STACItem` and `STACItemCollection` objects. These auxiliary functions operate at the item or asset level. Functions dedicated to items have the prefix `items_`. Otherwise, asset-oriented functions have the prefix `assets_` - -## Items functions{-} - -The `STACItemCollection` object have some facilitating functions to manipulate/extract information, for example: - -- **`items_fields()`:** Lists fields names inside an item. -- **`items_filter()`:** Performs a filter by items according to expressions operating on the properties of a `STACItemCollection` object. -- **`items_fetch()`:** Performs the pagination of items. -- **`items_length()`:** Returns the number of items in an object. -- **`items_matched()`:** Returns the number of items matching the search criteria. -- **`items_assets()`:** Returns the assets name from `STACItemCollection` and `STACItem` objects. - - -It is interesting to verify the fields of items before filtering: - -```{r fields} -s_obj |> - stac_search( - collections = "CB4-16D-2", - datetime = "2019-01-01/2019-12-31", - limit = 100) |> - post_request() |> - items_fields(field = "properties") -``` - -Let's filter items that have the percentage of clouds smaller than 10%: - -```{r filter} -s_obj |> - stac_search( - collections = "CB4-16D-2", - datetime = "2019-01-01/2019-12-31", - limit = 100) |> - post_request() |> - items_filter(properties$`eo:cloud_cover` < 10) -``` -Number of items returned in the query (in this case equal to the limit defined as parameter): - -```{r length} -s_obj |> - stac_search( - collections = "CB4-16D-2", - datetime = "2019-01-01/2019-12-31", - limit = 100) |> - post_request() |> - items_length() -``` -Number of matched items in the query: - -```{r matched} -s_obj |> - stac_search( - collections = "CB4-16D-2", - datetime = "2019-01-01/2019-12-31", - limit = 100) |> - post_request() |> - items_matched() -``` -Paginating all items that were matched in the query: - -```{r fetch} -items_fetched <- s_obj |> - stac_search( - collections = "CB4-16D-2", - datetime = "2019-01-01/2019-12-31", - limit = 500) |> - post_request() |> - items_fetch(progress = FALSE) - -items_fetched -``` -Note that the 1127 has been recovered: - -```{r length-2} -items_length(items_fetched) -``` - -Listing the assets of the retrieved items: - -```{r assets} -items_assets(items_fetched) -``` - - -## Assets functions{-} - -- **`assets_download()`:** Downloads the assets provided by the STAC API. -- **`assets_url()`:** Returns a character vector with each asset href. -For the URL you can add the GDAL library drivers for the following schemes: - - HTTP/HTTPS files; - - S3 (AWS S3); - - GS (Google Cloud Storage). -- **`assets_select()`:** Selects the assets of each item by its name. -- **`assets_rename()`:** Rename each asset using a named list or a function. - -Listing the assets names of all items: - -```{r assets-2} -s_obj |> - stac_search( - collections = "CB4-16D-2", - datetime = "2019-01-01/2019-12-31", - limit = 10) |> - post_request() |> - items_assets() -``` - -Selecting assets that have names `"BAND14"` and `"NDVI"` - -```{r assets-select} -selected_assets <- s_obj |> - stac_search( - collections = "CB4-16D-2", - datetime = "2019-01-01/2019-12-31", - limit = 10) |> - post_request() |> - assets_select(asset_names = c("BAND14", "NDVI")) -``` - -```{r assets-3} -items_assets(selected_assets) -``` - -Listing asset urls from the selected bands: - -```{r assets-url} -selected_assets |> - assets_url() -``` - -Renaming assets using the pattern ` = ` - -```{r assets-renamed} -renamed_assets <- selected_assets |> - assets_rename(BAND14 = "B14") -renamed_assets -``` - -In the `assets` field of the output it can be seen that the asset's name has changed. -It is also possible to check the asset names using the `items_assets()` function. - -```{r assets-4} -items_assets(renamed_assets) -``` - - -## Asset preview{-} - -`rstac` also provides a helper function to plot preview assets (e.g. thumbnail and quicklook). - -```{r asset-preview-check, eval=TRUE, include=FALSE, echo=FALSE} -is_accessible <- is_online && tryCatch({ - res <- httr::HEAD( - assets_url(items_fetched$features[[2]], asset_names = "thumbnail") - ) - !httr::http_error(res) -}, error = function(e) { - FALSE -}) -``` - -```{r plot-preview, eval=is_accessible, fig.height=3, fig.width=5} -second_item <- items_fetched$features[[2]] -second_item |> - assets_url(asset_names = "thumbnail") |> - preview_plot() -``` - -Here, we selected the second item of `items_fetched`'s features and plotted its `thumbnail` asset. - -# Conclusion{-} - -The `rstac` package can be useful for querying and working with satellite imagery data from STAC APIs. It offers a simple interface for searching STAC items, exploring the results, and working with assets. Additional functionalities include reading and plotting preview images. This tutorial has provided a short introduction on how to use the package. For more about CQL2 in `rstac`, type the command `?ext_filter`. diff --git a/vignettes/rstac-02-cql2.Rmd b/vignettes/rstac-02-cql2.Rmd deleted file mode 100644 index ad803492..00000000 --- a/vignettes/rstac-02-cql2.Rmd +++ /dev/null @@ -1,232 +0,0 @@ ---- -title: "CQL2 examples" -author: "Rolf Simoes, Felipe Carvalho, and Gilberto Camara" -date: "2022-12-16" -output: - html_document: - df_print: tibble -classoption: x11names -fontsize: 10,5pt -indent: yes -link-citations: yes -vignette: > - %\VignetteIndexEntry{CQL2 examples} - %\VignetteEngine{knitr::rmarkdown} - %\VignetteEncoding{UTF-8} ---- - -```{r prepare, include = FALSE} -knitr::opts_chunk$set( - collapse = TRUE, - comment = "#>" -) -``` - -# Introduction{-} - -CQL2 is an OGC standard that enables complex filter expressions on OAFeat3 or STAC web services. CQL2 standard states that expressions can be represented in JSON or TEXT formats. Our implementation intends to convert native R expressions into CQL2 valid expressions without needing cumbersome nested lists or dictionaries. Also, we can make CQL2 filter requisition in JSON or TEXT formats with the same filter representation. - -# Translating R expressions to CQL2 syntax{-} - -To explain the difference between the TEXT and JSON CQL2 representation, let's start with a simple example. In the following code, we have a valid CQL2 expression (in TEXT format) that refers to two properties, `vehicle_height` and `bridge_clearance`. - -```{verbatim} -vehicle_height > (bridge_clearance - 1)) -``` - -This filter expression can be passed in the HTTP GET verb implemented by the service to retrieve only those features that satisfy the condition. The same expression can be represented in JSON format, which is more suitable for HTTP POST requests: - -```{verbatim} -{ - "op": ">", - "args": [ - {"property":"vehicle_height"}, - { - "op": "-", - "args": [ - {"property":"bridge_clearance"}, - 1 - ] - } - ] -} -``` - -Note how properties `vehicle_height` and `bridge_clearance` are represented in this format. They are elements of an object containing a `property` member. Also, they go as arguments of operators (in this case,`>` and `-` operators). - -In the R language, the JSON above could be represented by nested lists, which would be somewhat cumbersome to write. To produce valid CQL2 filter expressions, we use the R abstract syntax tree (AST) from R expressions that can be converted to TEXT or JSON formats. Let us see the same previous example written in R CQL2: - -```{r setup} -library(rstac) -``` - -```{r text-1} -cql2_text(vehicle_height > (bridge_clearance - 1)) # TEXT format -``` - -```{r json-1} -cql2_json(vehicle_height > (bridge_clearance - 1)) # JSON format -``` - -In both cases, the same CQL2 object representation is built from the expression using AST of R expression evaluation. Then, the object is converted into TEXT or JSON format. - -CQL2 filters in TEXT format are sometimes represented the same way as in the R expression. However, this should only sometimes be the case, as we can see in some examples provided below. - -## Data types and literal values{-} - -A literal value is any part of a CQL2 filter expression used the same as specified in the expression. - -The scalar data types are: `character string`, `number`, `boolean`, `timestamp`, and `date`. - -**character string** -```{r string} -cql2_text("Via dell'Avvento") -cql2_json("Via dell'Avvento") -``` - - -**number** -```{r number} -cql2_text(3.1415) -cql2_json(-100) -``` - -**boolean** -```{r boolean} -cql2_text(TRUE) -cql2_json(FALSE) -``` - -**timestamp** -```{r timestamp} -cql2_text(timestamp("1969-07-20T20:17:40Z")) -cql2_json(timestamp("1969-07-20T20:17:40Z")) -``` - -**date** -```{r date} -cql2_text(date("1969-07-20")) -cql2_json(date("1969-07-20")) -``` - -## Property references{-} - -The property of an item can be evaluated in the CQL2 filter expression by its name. - -```{r property} -cql2_text(windSpeed > 1) -cql2_json(windSpeed > 1) -``` - -## Standard comparison predicates{-} - -A comparison predicate evaluates if two scalar expressions satisfy the specified comparison operator. - -The standard comparison operators are: `=`, `!=`, `<`, `>`, `<=`, `>=`, and `IS NULL`. - -```{r comparison-1} -cql2_text(city == "Crato") -cql2_json(city == "Jacareí") -``` - -```{r comparison-2} -cql2_text(avg(windSpeed) < 4) -cql2_json(avg(windSpeed) < 4) -``` - -```{r comparison-3} -cql2_text(balance - 150.0 > 0) -cql2_json(balance - 150.0 > 0) -``` - -```{r comparison-4} -cql2_text(updated >= date('1970-01-01')) -cql2_json(updated >= date('1970-01-01')) -``` - -**`IS NULL` operator** - -```{r is-null} -cql2_text(!is_null(geometry)) -cql2_json(!is_null(geometry)) -``` - -## Advanced comparison operators{-} - -A comparison predicate evaluates if two scalar expressions satisfy the specified comparison operator. - -Advanced comparison operators are: `LIKE`, `BETWEEN`, and `IN`. - -**`LIKE` operator** - -```{r like} -cql2_text(name %like% "Smith%") -cql2_json(name %like% "Smith%") -``` - -**`BETWEEN` operator** - -```{r between} -cql2_text(between(depth, 100.0, 150.0)) -cql2_json(between(depth, 100.0, 150.0)) -``` - -**`IN` operator** - -```{r in-1} -cql2_text(cityName %in% list('Toronto', 'Frankfurt', 'Tokyo', 'New York')) -cql2_json(cityName %in% list('Toronto', 'Frankfurt', 'Tokyo', 'New York')) -``` -```{r in-2} -cql2_text(!category %in% list(1, 2, 3, 4)) -cql2_json(!category %in% list(1, 2, 3, 4)) -``` - -## Spatial operators{-} - -A spatial predicate evaluates if two spatial expressions satisfy the specified spatial operator. - -The supported spatial operators are: `S_INTERSECTS`, `S_EQUALS`, `S_DISJOINT`, `S_TOUCHES`, `S_WITHIN`, `S_OVERLAPS`, `S_CROSSES`, and `S_CONTAINS`. - - -```{R spatial, message=FALSE} -poly <- list( - type = "Polygon", - coordinates = list( - rbind( - c(0,0), - c(0,1), - c(0,1) - ) - )) -cql2_text(s_intersects(geometry, {{poly}})) -cql2_json(s_intersects(geometry, {{poly}})) -``` - -> Note: We provide an escape to evaluate user variables using `{{` or `!!`. Both symbols are largely used in the R Data Science community. - -## Temporal operators{-} - -A temporal predicate evaluates if two temporal expressions satisfy the specified temporal operator. - -The supported temporal operators are: `T_AFTER`, `T_BEFORE`, `T_CONTAINS`, `T_DISJOINT`, `T_DURING`, `T_EQUALS`, `T_FINISHEDBY`, `T_FINISHES`, `T_INTERSECTS`, `T_MEETS`, `T_METBY`, `T_OVERLAPPEDBY`, `T_OVERLAPS`, `T_STARTEDBY`, and `T_STARTS`. - -```{r temporal} -cql2_text(t_intersects(event_date, interval("1969-07-16T05:32:00Z", "1969-07-24T16:50:35Z"))) -cql2_json(t_intersects(event_date, interval("1969-07-16T05:32:00Z", "1969-07-24T16:50:35Z"))) -``` - -## Support for functions in CQL2{-} - -Functions allow implementations to extend the language. - -**Example of a function that returns a geometry value.** - -```{r functions} -cql2_text(s_within(road, Buffer(geometry, 10, "m"))) -cql2_json(s_within(road, Buffer(geometry, 10, "m"))) -``` - -# Conclusion{-} - -In conclusion, this tutorial has demonstrated using the `rstac` package to build CQL2 expressions, making it easier for R users to write syntactically correct filter criteria for STAC services. This functionality can be an alternative for users to construct CQL2 expressions easily and efficiently. For more about CQL2 in `rstac`, type the command `?ext_filter`. diff --git a/vignettes/rstac-03-cql2-mpc.Rmd b/vignettes/rstac-03-cql2-mpc.Rmd deleted file mode 100644 index 08984248..00000000 --- a/vignettes/rstac-03-cql2-mpc.Rmd +++ /dev/null @@ -1,312 +0,0 @@ ---- -title: "Reading Planetary Computer Data using CQL2 filter extension" -date: "2022-12-21" -output: - html_document: - df_print: tibble -classoption: x11names -fontsize: 10,5pt -indent: yes -link-citations: yes -vignette: > - %\VignetteIndexEntry{Reading Planetary Computer Data using CQL2 filter extension} - %\VignetteEngine{knitr::rmarkdown} - %\VignetteEncoding{UTF-8} ---- - -```{r, include = FALSE} -is_online <- tryCatch({ - res <- httr::GET("https://planetarycomputer.microsoft.com/api/stac/v1") - !httr::http_error(res) -}, error = function(e) { - FALSE -}) - -knitr::opts_chunk$set( - collapse = TRUE, - comment = "#>", - eval = is_online -) -``` - - -```{r load-rstac, eval=TRUE} -library(rstac) -``` - -# Introduction{-} - -This tutorial will use the open-source package `rstac` to search data in Planetary Computer's SpatioTemporal Asset Catalog (STAC) service. STAC services can be accessed through STAC API endpoints, which allow users to search datasets using various parameters such as space and time. In addition to demonstrating the use of `rstac`, the tutorial will explain the Common Query Language (CQL2) filter extension to narrow the search results and find datasets that meet specific criteria in the STAC API. - -This tutorial is based on [reading STAC API data in Python](https://planetarycomputer.microsoft.com/docs/quickstarts/reading-stac/). - -# Reading data from STAC API{-} - -To access Planetary Computer STAC API, we'll create a `rstac` query. - -```{r connection, eval=TRUE} -planetary_computer <- stac("https://planetarycomputer.microsoft.com/api/stac/v1") -planetary_computer -``` - -## Listing supported properties in CQL2{-} - -CQL2 expressions can be constructed using properties that refer to attributes of items. A list of all properties supported by a collection can be obtained by accessing the `/collections//queryables` endpoint. Filter expressions can use properties listed in this endpoint. - -In this example, we will search for [Landsat Collection 2 Level-2](https://planetarycomputer.microsoft.com/dataset/landsat-c2-l2) imagery of the Microsoft main campus from December 2020. The name of this collection in STAC service is `landsat-c2-l2`. Here we'll prepare a query to retrieve its queriables and make a `GET` request to the service. - -```{r queryables} -planetary_computer |> - collections("landsat-c2-l2") |> - queryables() |> - get_request() -``` - -## Searching with CQL2{-} - -Now we can use `rstac` to make a search query with CQL2 filter extension to obtain the items. - -```{r cql2-search} -time_range <- cql2_interval("2020-12-01", "2020-12-31") -bbox <- c(-122.2751, 47.5469, -121.9613, 47.7458) -area_of_interest = cql2_bbox_as_geojson(bbox) - -stac_items <- planetary_computer |> - ext_filter( - collection == "landsat-c2-l2" && - t_intersects(datetime, {{time_range}}) && - s_intersects(geometry, {{area_of_interest}}) - ) |> - post_request() -``` - -In that example, our filter expression used a temporal (`t_intersects`) and a spatial (`s_intersects`) operators. `t_intersects()` only accepts interval as it second argument, which we created using function `cql2_interval()`. `s_intersects()` spatial operator only accepts GeoJSON objects as its arguments. This is why we had to convert the bounding box vector (`bbox`) into a structure representing a GeoJSON object using the function `cql2_bbox_as_geojson()`. We embrace the arguments using `{{` to evaluate them before make the request. - -`items` is a `STACItemCollection` object containing 8 items that matched our search criteria. - -```{r items-length} -stac_items -``` - -## Exploring data{-} - -A `STACItemCollection` is a regular GeoJSON object. It is a collection of `STACItem` entries that stores metadata on assets. Users can convert a `STACItemCollection` to a `sf` object containing the properties field as columns. Here we depict the items footprint. - -```{r geojson-to-sf} -sf <- items_as_sf(stac_items) - -# create a function to plot a map -plot_map <- function(x) { - library(tmap) - library(leaflet) - current.mode <- tmap_mode("view") - tm_basemap(providers[["Stamen.Watercolor"]]) + - tm_shape(x) + - tm_borders() -} - -plot_map(sf) -``` - -Some collections use the `eo` extension, which allows us to sort items by attributes like cloud coverage. The next example selects the item with lowest cloud_cover attribute: - -```{r lowest-cloud-cover} -cloud_cover <- stac_items |> - items_reap(field = c("properties", "eo:cloud_cover")) -selected_item <- stac_items$features[[which.min(cloud_cover)]] -``` - -We use function `items_reap()` to extract cloud cover values from all features. - -Each STAC item have an `assets` field which describes files and provides link to access them. - -```{r assets-list} -items_assets(selected_item) - -purrr::map_dfr(items_assets(selected_item), function(key) { - tibble::tibble(asset = key, description = selected_item$assets[[key]]$title) -}) -``` - -Here, we’ll inspect the `rendered_preview` asset. To plot this asset, we can use the helper function `preview_plot()` and provide a URL to be plotted. We use the function `assets_url()` to get the URL. This function extracts all available URLs in items. - -```{r asset-preview-check, eval=TRUE, include=FALSE, echo=FALSE} -is_accessible <- is_online && tryCatch({ - res <- httr::HEAD( - assets_url(selected_item, asset_names = "rendered_preview") - ) - !httr::http_error(res) -}, error = function(e) { - FALSE -}) -``` - -```{r asset-preview, eval=is_accessible, fig.height=3, fig.width=5} -selected_item$assets[["rendered_preview"]]$href - -selected_item |> - assets_url(asset_names = "rendered_preview") |> - preview_plot() -``` - -The `rendered_preview` asset is generated dynamically by Planetary Computer API using raw data. We can access the raw data, stored as Cloud Optimized GeoTIFFs (COG) in Azure Blob Storage, using the other assets. These assets are in private Azure Blob Storage containers and is necessary to sign them to have access to the data, otherwise, you’ll get a 404 (forbidden) status code. - -## Signing items{-} - -To sign URL in `rstac`, we can use `items_sign()` function. - -```{r sign-item} -selected_item <- selected_item |> - items_sign(sign_fn = sign_planetary_computer()) - -selected_item |> - assets_url(asset_names = "blue") |> - substr(1, 255) -``` - -Everything after the `?` in that URL is a [SAS token](https://learn.microsoft.com/en-us/azure/storage/common/storage-sas-overview) grants access to the data. See https://planetarycomputer.microsoft.com/docs/concepts/sas/ for more on using tokens to access data. - -```{r url-check} -library(httr) -selected_item |> - assets_url(asset_names = "blue") |> - httr::HEAD() |> - httr::status_code() -``` - -The 200 status code means that we were able to access the data using the signed URL with the SAS token included. - -## Reading files{-} - -We can load up that single COG file using packages like [stars](https://github.com/r-spatial/stars) or [terra](https://github.com/rspatial/terra). - -```{r read-file} -library(stars) -selected_item |> - assets_url(asset_names = "blue", append_gdalvsi = TRUE) |> - stars::read_stars(RasterIO = list(nBufXSize = 512, nBufYSize = 512)) |> - plot(main = "blue") -``` - -We used the `assets_url()` method with the `append_gdalvsi = TRUE` parameter to insert `/vsicurl` in the URL. This allows the GDAL VSI driver to access the data using HTTP. - -# Searching on additional properties{-} - -In the previous step of this tutorial, we learned how to search for items by specifying the space and time parameters. However, the Planetary Computer's STAC API offers even more flexibility by allowing you to search for items based on additional properties. - -For instance, collections like `sentinel-2-l2a` and `landsat-c2-l2` both implement the [eo](https://github.com/stac-extensions/eo) STAC extension and include an `eo:cloud_cover` property. To filter your search results to only return items that have a cloud coverage of less than 20%, you can use: - -```{r cql2-search-cloud} -stac_items <- planetary_computer |> - ext_filter( - collection %in% c("sentinel-2-l2a", "landsat-c2-l2") && - t_intersects(datetime, {{time_range}}) && - s_intersects(geometry, {{area_of_interest}}) && - `eo:cloud_cover` < 20 - ) |> - post_request() -``` - -Here we search for `sentinel-2-l2a` and `landsat-c2-l2` assets. As a result, we have images from both collections in our search results. Users can rename the assets to have a common name in both collections. - -```{r assets-rename} -stac_items <- stac_items |> - assets_select(asset_names = c("B11", "swir16")) |> - assets_rename(B11 = "swir16") - -stac_items |> - items_assets() -``` - -`assets_rename()` uses parameter mapper that is used to rename asset names. The parameter can be either a named list or a function that is called against each asset metadata. A last parameter was included to force band renaming. - -## Analyzing STAC Metadata{-} - -`STACItem` objects are features of `STACItemCollection` and store information about assets. - -```{r items-fetch} -stac_items <- planetary_computer |> - ext_filter( - collection == "sentinel-2-l2a" && - t_intersects(datetime, interval("2020-01-01", "2020-12-31")) && - s_intersects(geometry, {{ - cql2_bbox_as_geojson(c(-124.2751, 45.5469, -123.9613, 45.7458)) - }}) - ) |> - post_request() - -stac_items <- items_fetch(stac_items) -``` - -We can use the metadata to plot cloud cover of a region over time, for example. - -```{r cloud-cover-ts-plot} -library(dplyr) -library(slider) -library(ggplot2) - -df <- items_as_sf(stac_items) |> - dplyr::mutate(datetime = as.Date(datetime)) |> - dplyr::group_by(datetime) |> - dplyr::summarise(`eo:cloud_cover` = mean(`eo:cloud_cover`)) |> - dplyr::mutate( - `eo:cloud_cover` = slider::slide_mean( - `eo:cloud_cover`, before = 3, after = 3 - ) - ) - -df |> - ggplot2::ggplot() + - ggplot2::geom_line(ggplot2::aes(x = datetime, y = `eo:cloud_cover`)) -``` - -`cql2_bbox_as_geojson()` is a `rstac` helper function and it must be evaluated before the request. This is why we embraced it with `{{`. We use `items_fetch()` to retrieve all paginated items matched in the search. - - -# Working with STAC Catalogs and Collections{-} - -STAC organizes items in catalogs (`STACCatalog`) and collections (`STACCollection`). These JSON documents contains metadata of the dataset they refer to. For instance, here we look at the [Bands](https://github.com/stac-extensions/eo#band-object) available for [Landsat 8 Collection 2 Level 2](https://planetarycomputer.microsoft.com/dataset/landsat-c2-l2) data: - -```{r collection-landsat-bands} -landsat <- planetary_computer |> - collections(collection_id = "landsat-c2-l2") |> - get_request() - -library(purrr) -purrr::map_dfr(landsat$summaries$`eo:bands`, tibble::as_tibble_row) -``` - -We can see what [Assets](https://github.com/radiantearth/stac-spec/blob/master/item-spec/item-spec.md#asset-object) are available on our item with: - -```{r landsat-assets} -purrr::map_dfr(landsat$item_assets, function(x) { - tibble::as_tibble_row( - purrr::compact(x[c("title", "description", "gsd")]) - ) -}) -``` - -Some collections, like [Daymet](https://planetarycomputer.microsoft.com/dataset/daymet-daily-na) include collection-level assets. You can use the `assets` property to access those assets. - -```{r collection-daymet} -daymet <- planetary_computer |> - collections(collection_id = "daymet-daily-na") |> - get_request() - -daymet -``` - -Just like assets on items, these assets include links to data in Azure Blob Storage. - -```{r daymet-assets} -items_assets(daymet) - -daymet |> - assets_select(asset_names = "zarr-abfs") |> - assets_url() -``` - -# Learn more{-} - -For more about the Planetary Computer's STAC API, see [Using tokens for data access](https://learn.microsoft.com/en-us/azure/storage/common/storage-sas-overview) and the [STAC API reference](https://planetarycomputer.microsoft.com/docs/reference/stac/). -For more about CQL2 in `rstac`, type the command `?ext_filter`.