Split querying into a separate function

.Rbuildignore

@@ -13,3 +13,4 @@
 ^CITATION\.cff$
 ^doc$
 ^Meta$
+^vignettes/articles$

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: rsi
 Title: Utilities for Retrieving Satellite Imagery, Calculating Spectral
     Indices, and Wrangling the Outputs
-Version: 0.0.0.9000
+Version: 0.0.0.9001
 Authors@R: c(
     person("Michael", "Mahoney", , "[email protected]", role = c("aut", "cre"),
            comment = c(ORCID = "0000-0003-2402-304X")),

NAMESPACE

@@ -4,6 +4,7 @@ S3method("[",rsi_band_mapping)
 S3method("[[",rsi_band_mapping)
 S3method(print,rsi_band_mapping)
 export(calculate_indices)
+export(default_query_function)
 export(filter_bands)
 export(filter_platforms)
 export(get_dem)
@@ -13,7 +14,6 @@ export(get_sentinel2_imagery)
 export(get_stac_data)
 export(landsat_mask_function)
 export(landsat_platform_filter)
-export(query_planetary_computer)
 export(sentinel2_mask_function)
 export(sign_planetary_computer)
 export(spectral_indices)

R/get_stac_data.R

@@ -82,7 +82,7 @@
 #' images from.
 #' @param query_function A function that takes the output from
 #' [rstac::stac_search()] and executes the request. See
-#' [query_planetary_computer()] and the `query_function` slots of
+#' [default_query_function()] and the `query_function` slots of
 #' [sentinel1_band_mapping], [sentinel2_band_mapping], and
 #' [landsat_band_mapping].
 #' @param sign_function A function that takes the output from `query_function`
@@ -143,7 +143,7 @@
 #'   ),
 #'   stac_source = "https://planetarycomputer.microsoft.com/api/stac/v1/",
 #'   collection = "landsat-c2-l2",
-#'   query_function = query_planetary_computer,
+#'   query_function = default_query_function,
 #'   sign_function = sign_planetary_computer,
 #'   mask_band = "qa_pixel",
 #'   mask_function = landsat_mask_function,
@@ -167,8 +167,8 @@ get_stac_data <- function(aoi,
                           asset_names,
                           stac_source,
                           collection,
-                          query_function,
                           ...,
+                          query_function = default_query_function,
                           sign_function = NULL,
                           rescale_bands = TRUE,
                           item_filter_function = NULL,
@@ -242,6 +242,10 @@ get_stac_data <- function(aoi,
     gdalwarp_options = character()
   )
 
+  if (is.null(sign_function) && stac_source == "https://planetarycomputer.microsoft.com/api/stac/v1") {
+    sign_function <- sign_planetary_computer
+  }
+
   gdalwarp_options <- process_gdalwarp_options(
     gdalwarp_options = gdalwarp_options,
     aoi = aoi,
@@ -251,17 +255,25 @@ get_stac_data <- function(aoi,
 
   aoi_bbox <- sf::st_bbox(aoi)
 
-  items <- get_items(
-    sf::st_bbox(sf::st_transform(aoi, 4326)),
-    stac_source,
-    collection,
-    start_date,
-    end_date,
-    limit,
-    query_function,
-    item_filter_function,
+  if (!is.null(start_date)) {
+    start_date <- process_dates(start_date)
+    end_date <- process_dates(end_date)
+  }
+
+  items <- query_function(
+    bbox = sf::st_bbox(sf::st_transform(aoi, 4326)),
+    stac_source = stac_source,
+    collection = collection,
+    start_date = start_date,
+    end_date = end_date,
+    limit = limit,
     ...
   )
+
+  if (!is.null(item_filter_function)) {
+    items <- item_filter_function(items, ...)
+  }
+
   if (missing(asset_names)) asset_names <- NULL
   if (is.null(asset_names)) asset_names <- rstac::items_assets(items)
   if (is.null(names(asset_names))) names(asset_names) <- asset_names
@@ -845,45 +857,6 @@ process_dates <- function(date) {
   gsub("UTC", "Z", date)
 }
 
-get_items <- function(bbox_wgs84,
-                      stac_source,
-                      collections,
-                      start_date,
-                      end_date,
-                      limit,
-                      download_function,
-                      item_filter_function,
-                      ...) {
-  if (!is.null(start_date)) {
-    start_date <- process_dates(start_date)
-    end_date <- process_dates(end_date)
-    datetime <- paste0(start_date, "/", end_date)
-  } else {
-    datetime <- NULL
-  }
-
-  items <- rstac::stac_search(
-    rstac::stac(stac_source),
-    collections = collections,
-    bbox = c(
-      bbox_wgs84["xmin"],
-      bbox_wgs84["ymin"],
-      bbox_wgs84["xmax"],
-      bbox_wgs84["ymax"]
-    ),
-    datetime = datetime,
-    limit = limit
-  )
-
-  items <- download_function(items)
-
-  if (!is.null(item_filter_function)) {
-    items <- item_filter_function(items, ...)
-  }
-
-  items
-}
-
 extract_urls <- function(asset_names, items) {
   items_urls <- lapply(
     names(asset_names),

R/query_and_sign.R

@@ -0,0 +1,111 @@
+#' Query a STAC API using a specific spatiotemporal area of interest
+#'
+#' This function is the default method used to retrieve lists of items to
+#' download for all the collections and endpoints supported by rsi. It will
+#' likely work for any other STAC APIs of interest.
+#'
+#' You can pass your own query functions to `get_stac_data()` and its variants.
+#' This is the best way to perform more complex queries, for instance if you
+#' need to provide authentication to get the list of items (not just the assets)
+#' available for your AOI, or to perform cloud filtering prior to downloading
+#' assets.
+#'
+#' @param bbox An sfc object representing the spatial bounding box of your area
+#' of interest. This must be in EPSG:4326 coordinates (and, if this function is
+#' called from within `get_stac_data()`, it will be)
+#' @inheritParams get_stac_data
+#' @param start_date,end_date Character strings of length 1 representing the
+#' boundaries of your temporal range of interest, in RFC-3339 format. Set either
+#' argument to `..` to use an open interval; set `start_date` to `NULL` to not
+#' pass a temporal range of interest (which may cause errors with some APIs). If
+#' this function is called from within `get_stac_data()`, the inputs to
+#' `start_date` and `end_date` will have already been processed to try and force
+#' RFC-3339 compliance.
+#' @param ... Ignored by this function. Arguments passed to `get_stac_data()`
+#' via `...` will be available (unchanged) in this function
+#'
+#' @returns  A StacItemCollection object.
+#'
+#' @examplesIf interactive()
+#' aoi <- sf::st_point(c(-74.912131, 44.080410))
+#' aoi <- sf::st_set_crs(sf::st_sfc(aoi), 4326)
+#' aoi <- sf::st_buffer(sf::st_transform(aoi, 5070), 100)
+#'
+#' landsat_image <- get_landsat_imagery(
+#'   aoi,
+#'   start_date = "2022-06-01",
+#'   end_date = "2022-08-30",
+#'   query_function = default_query_function
+#' )
+#'
+#' @export
+default_query_function <- function(bbox,
+                                   stac_source,
+                                   collection,
+                                   start_date,
+                                   end_date,
+                                   limit,
+                                   ...) {
+
+  if (!is.null(start_date)) {
+    datetime <- paste0(start_date, "/", end_date)
+  } else {
+    datetime <- NULL
+  }
+
+  items <- rstac::stac_search(
+    rstac::stac(stac_source),
+    collections = collection,
+    bbox = c(
+      bbox["xmin"],
+      bbox["ymin"],
+      bbox["xmax"],
+      bbox["ymax"]
+    ),
+    datetime = datetime,
+    limit = limit
+  )
+
+  items <- rstac::items_fetch(rstac::get_request(items))
+
+  items
+}
+
+#' Sign STAC items retrieved from the Planetary Computer
+#'
+#' @param items A STACItemCollection, as returned by `default_query_function`.
+#' @param subscription_key Optionally, a subscription key associated with your
+#' Planetary Computer account. At the time of writing, this is required for
+#' downloading Sentinel 1 RTC products, as well as NAIP imagery. This key will
+#' be automatically used if the environment variable `rsi_pc_key` is set.
+#'
+#' @returns A STACItemCollection object with signed assets url.
+#'
+#' @examplesIf interactive()
+#' aoi <- sf::st_point(c(-74.912131, 44.080410))
+#' aoi <- sf::st_set_crs(sf::st_sfc(aoi), 4326)
+#' aoi <- sf::st_buffer(sf::st_transform(aoi, 5070), 100)
+#'
+#' landsat_image <- get_landsat_imagery(
+#'   aoi,
+#'   start_date = "2022-06-01",
+#'   end_date = "2022-08-30",
+#'   sign_function = sign_planetary_computer
+#' )
+#'
+#' @export
+sign_planetary_computer <- function(items,
+                                    subscription_key = Sys.getenv("rsi_pc_key")) {
+  if (subscription_key == "") {
+    rstac::items_sign(items, rstac::sign_planetary_computer())
+  } else {
+    rstac::items_sign(
+      items,
+      rstac::sign_planetary_computer(
+        headers = c("Ocp-Apim-Subscription-Key" = subscription_key)
+      )
+    )
+  }
+}
+
+

_pkgdown.yml

@@ -37,5 +37,6 @@ reference:
     contents:
       - ends_with("mask_function")
       - landsat_platform_filter
-      - query_planetary_computer
+      - default_query_function
+      - sign_planetary_computer
       - stack_rasters

data-raw/band_mappings.R

@@ -1,3 +1,4 @@
+# rstudioapi::restartSession()
 devtools::install()
 library(rsi)
 sentinel2_band_mapping <- list(
@@ -20,9 +21,7 @@ sentinel2_band_mapping <- list(
     mask_function = sentinel2_mask_function,
     stac_source = "https://earth-search.aws.element84.com/v0/",
     collection_name = "sentinel-s2-l2a-cogs",
-    query_function = \(q) {
-      rstac::items_fetch(rstac::get_request(q))
-    },
+    query_function = default_query_function,
     class = "rsi_band_mapping"
   ),
   aws_v1 = structure(
@@ -44,9 +43,7 @@ sentinel2_band_mapping <- list(
     mask_function = sentinel2_mask_function,
     stac_source = "https://earth-search.aws.element84.com/v1/",
     collection_name = "sentinel-2-l2a",
-    query_function = \(q) {
-      rstac::items_fetch(rstac::get_request(q))
-    },
+    query_function = default_query_function,
     class = "rsi_band_mapping"
   )
 )
@@ -55,7 +52,7 @@ sentinel2_band_mapping$planetary_computer_v1 <- sentinel2_band_mapping$aws_v0
 attr(sentinel2_band_mapping$planetary_computer_v1, "scl_name") <- "SCL"
 attr(sentinel2_band_mapping$planetary_computer_v1, "stac_source") <- "https://planetarycomputer.microsoft.com/api/stac/v1/"
 attr(sentinel2_band_mapping$planetary_computer_v1, "collection_name") <- "sentinel-2-l2a"
-attr(sentinel2_band_mapping$planetary_computer_v1, "query_function") <- query_planetary_computer
+attr(sentinel2_band_mapping$planetary_computer_v1, "query_function") <- default_query_function
 attr(sentinel2_band_mapping$planetary_computer_v1, "sign_function") <- sign_planetary_computer
 
 usethis::use_data(sentinel2_band_mapping, overwrite = TRUE)
@@ -77,7 +74,7 @@ landsat_band_mapping <- list(
     mask_function = landsat_mask_function,
     stac_source = "https://planetarycomputer.microsoft.com/api/stac/v1/",
     collection_name = "landsat-c2-l2",
-    query_function = query_planetary_computer,
+    query_function = default_query_function,
     sign_function = sign_planetary_computer,
     class = "rsi_band_mapping"
   )
@@ -95,7 +92,7 @@ sentinel1_band_mapping <- list(
     ),
     stac_source = "https://planetarycomputer.microsoft.com/api/stac/v1/",
     collection_name = "sentinel-1-grd",
-    query_function = query_planetary_computer,
+    query_function = default_query_function,
     sign_function = sign_planetary_computer,
     class = "rsi_band_mapping"
   )
@@ -108,7 +105,7 @@ pc_dem_mapping <- function(assets, collection_name) {
     assets,
     stac_source = "https://planetarycomputer.microsoft.com/api/stac/v1/",
     collection_name = collection_name,
-    query_function = query_planetary_computer,
+    query_function = default_query_function,
     sign_function = sign_planetary_computer,
     class = "rsi_band_mapping"
   )