Merge pull request #143 from R-ArcGIS/basereq

Basereq

Author: JosiahParry

Diff for: DESCRIPTION

@@ -34,7 +34,7 @@ Imports:
     terra,
     utils
 Roxygen: list(markdown = TRUE)
-RoxygenNote: 7.3.0
+RoxygenNote: 7.3.1
 Suggests: 
     dbplyr,
     dplyr,

Diff for: NEWS.md

@@ -1,5 +1,8 @@
 # arcgislayers 0.1.0 (unreleased)
 
+- **Breaking**: 
+  - `token` arguments are required to be a valid `httr2_token` object (strings are not supported).
+  - all `host` arguments are removed. Instead, the host is fetched from the `token`.
 - Add support for `GroupLayer`s
 - Add `arc_read()` with support for `name_repair` argument using `{vctrs}` (#108)
 - Add `get_layer_estimates()` to retrieve estimate info such as the number of features and the extent of the layer
@@ -14,4 +17,3 @@
 - adds cli as an explicit import (has been implicitly imported by httr2)
 - repository made public
 - add lifecycle badges to all exported functions <https://github.com/R-ArcGIS/arcgislayers/pull/101>
-- Use `arcgisutils::arc_token()` to get "ARCGIS_TOKEN" environment variable. This ensures that empty strings do not cause HTTP 498 "invalid token" error.

Diff for: R/add_item.R

@@ -49,8 +49,8 @@
 #'   nc <- sf::st_read(system.file("shape/nc.shp", package = "sf"))
 #'   x <- nc[1:5, 13]
 #'
-#'   tkn <- auth_code()
-#'   set_auth_token(tkn)
+#'   token <- auth_code()
+#'   set_arc_token(tkn)
 #'
 #'   publish_res <- publish_layer(
 #'     x, "North Carolina SIDS sample"
@@ -68,12 +68,19 @@ add_item <- function(
     categories = character(0),
     async = FALSE,
     type = "Feature Service",
-    host = arc_host(),
     token = arc_token()
 ) {
 
+
+  # validate the token
+  obj_check_token(token)
+
+  # fetch the host from the token
+  host <- token[["arcgis_host"]]
+
   # if async = TRUE stop
   # type must be feature service right now
+  # TODO make this cli_abort()
   stopifnot(
     "`async` must be `FALSE`" = !async,
     "`type` must be `\"Feature Service\"`" = identical(type, "Feature Service")
@@ -87,22 +94,27 @@ add_item <- function(
     )
 
     if (choice == 2L) {
+      # TODO cli_abort
       stop("Aborting. CRS is missing.")
     } else {
+      # TODO cli_warn
       warning("Set the CRS to prevent this interruption.\n  - use `sf::st_set_crs()`")
     }
   } else if (!interactive() && is.na(sf::st_crs(x))) {
+    # TODO cli_warn
     warning(
       "CRS is missing from `x`\nAssuming EPSG:3857."
     )
   }
 
   # check if snippet is too long
+  # TODO cli_warn
   if (nchar(snippet) > 2048) warning("Snippet must be 2048 or fewer characters.")
 
   # check if description is too big or too many eles
   descrip_kb <- as.numeric(utils::object.size(description)) / 1000
 
+  # TODO cli_abort
   stopifnot(
     "`description` must be smaller than 64kb" = descrip_kb <= 64,
     "`description` must be length 1" = length(description) == 1
@@ -139,20 +151,16 @@ add_item <- function(
       categories = categories,
       type = "Feature Collection",
       async = async,
-      token = token,
       url = host,
       f = "json"
     )
   )
 
-
-  req <- httr2::request(req_url)
+  req <- arc_base_req(req_url, token)
   req_body <- httr2::req_body_form(req, !!!req_fields)
   resp <- httr2::req_perform(req_body)
-
   parsed <- RcppSimdJson::fparse(httr2::resp_body_string(resp))
   detect_errors(parsed)
-
   data.frame(parsed)
 }
 
@@ -170,22 +178,30 @@ publish_item <- function(
     user = Sys.getenv("ARCGIS_USER"),
     publish_params = .publish_params(),
     file_type = "featureCollection",
-    host = arc_host(),
     token = arc_token()
 ) {
 
+  # validate the token
+  obj_check_token(token)
+
+  # fetch the host
+  host <- token[["arcgis_host"]]
+
   # create request URL
   # TODO check for trailing `/` in host (should create a `sanitize_host()`)
   req_url <- paste0(host, "/sharing/rest/content/users/", user, "/publish")
 
+  # add token and agent
+  base_req <- arc_base_req(req_url, token)
+
+
   # create request
   req <- httr2::req_body_form(
-    httr2::request(req_url),
+    base_req,
     itemID = item_id,
     fileType = file_type,
     publishParameters = jsonify::to_json(publish_params, unbox = TRUE),
     f = "json",
-    token = token
   )
 
   resp <- httr2::req_perform(req)
@@ -207,7 +223,6 @@ publish_layer <- function(
     ...,
     user = Sys.getenv("ARCGIS_USER"),
     publish_params = .publish_params(title, target_crs = sf::st_crs(x)),
-    host = arc_host(),
     token = arc_token()
 ) {
 
@@ -218,7 +233,6 @@ publish_layer <- function(
       x,
       title,
       user = user,
-      host = host,
       token = token,
       !!!adtl_args
     )
@@ -232,7 +246,6 @@ publish_layer <- function(
     item_id,
     user = user,
     publish_params = publish_params,
-    host = host,
     token = token
   )
 

Diff for: R/arc-add-update-delete.R

@@ -130,7 +130,8 @@ add_features <- function(
   indices <- chunk_indices(n, chunk_size)
 
   # create the base request from the feature url
-  req <- httr2::req_url_path_append(httr2::request(x[["url"]]), "addFeatures")
+  base_req <- arc_base_req(x[["url"]], token)
+  req <- httr2::req_url_path_append(base_req, "addFeatures")
 
   # pre-allocate list
   all_reqs <- vector("list", length = lengths(indices)[1])
@@ -144,7 +145,6 @@ add_features <- function(
       req,
       features = as_esri_features(.data[start:end,]),
       rollbackOnFailure = rollback_on_failure,
-      token = token,
       f = "json"
     )
   }
@@ -246,22 +246,19 @@ update_features <- function(
   .data <- .data[, present_index]
 
   # create base request
-  req <- httr2::request(
-    paste0(x[["url"]], "/updateFeatures")
-  )
+  req <- arc_base_req(paste0(x[["url"]], "/updateFeatures"), token)
 
   req <- httr2::req_body_form(
     req,
     # transform `.data`
     features = as_esri_features(.data),
     rollbackOnFailure = rollback_on_failure,
-    token = token,
     f = "json",
     ...
   )
 
   resp <- httr2::req_perform(req)
-  jsonify::from_json(httr2::resp_body_string(resp))
+  RcppSimdJson::fparse(httr2::resp_body_string(resp))
 }
 
 
@@ -281,9 +278,7 @@ update_features <- function(
 #' @inheritParams prepare_spatial_filter
 #' @param rollback_on_failure default `TRUE`. Specifies whether the edits should be
 #'   applied only if all submitted edits succeed.
-#' @param token your authorization token. By default, token is set to the
-#'   environment variable `ARCGIS_TOKEN`. Use `set_auth_token()` to set
-#'   `ARCGIS_TOKEN`.
+#' @param token default `arc_token()`. An `httr2_token`.
 #' @export
 #' @rdname modify
 delete_features <- function(
@@ -327,21 +322,20 @@ delete_features <- function(
   }
 
   # https://developers.arcgis.com/rest/services-reference/enterprise/delete-features.htm
-  req <- httr2::request(paste0(x[["url"]], "/deleteFeatures"))
+  req <- arc_base_req(paste0(x[["url"]], "/deleteFeatures"), token)
 
   req <- httr2::req_body_form(
     req,
     !!!(compact(list(where = where, objectIds = object_ids))),
     !!!filter_geom,
     f = "json",
-    token = token,
     rollbackOnFailure = rollback_on_failure,
     ...
   )
 
   resp <- httr2::req_perform(req)
 
-  jsonify::from_json(httr2::resp_body_string(resp))
+  RcppSimdJson::fparse(httr2::resp_body_string(resp))
 }
 
 

Diff for: R/arc-open.R

@@ -61,12 +61,11 @@ arc_open <- function(url, token = arc_token()) {
 
   stopifnot("`url` must be of length 1" = length(url) == 1)
 
-  # generate base request
-  req <- httr2::request(url)
-
   # extract layer metadata
-  meta <- compact(fetch_layer_metadata(req, token))
-  meta[["url"]] <- url # set url for later use
+  meta <- compact(fetch_layer_metadata(url, token))
+
+  # set url for later use
+  meta[["url"]] <- url
 
   # layer class
   layer_class <- gsub("\\s", "", meta[["type"]])
@@ -103,7 +102,12 @@ arc_open <- function(url, token = arc_token()) {
     "ImageServer" = structure(meta, class = layer_class),
     "MapServer" = structure(meta, class = layer_class),
     "GroupLayer" = structure(meta, class = layer_class),
-    cli::cli_abort("Unsupported service")
+    cli::cli_abort(
+      c(
+        "Unsupported service type",
+        "i"=  "Please report this at {.url https://github.com/R-ArcGIS/arcgislayers/issues}"
+      )
+    )
   )
 
   res

Diff for: R/arc-raster.R

@@ -64,23 +64,26 @@ arc_raster <- function(
   # if bbox_crs is missing set to `crs`
   bbox_sr <- validate_crs(bbox_crs %||% crs)[[c("spatialReference", "wkid")]]
 
-  req <- httr2::request(paste0(x[["url"]], "/exportImage"))
+  # create the base req
+  burl <- paste0(x[["url"]], "/exportImage")
+
+  # pass that into arc_base_req() to set agent and token
+  req <- arc_base_req(burl, token)
 
   req <- httr2::req_body_form(
     req,
-    # bbox = paste0(bbox, collapse = ","),
     bbox = paste0(c(xmin, ymin, xmax, ymax), collapse = ","),
     bboxSR = bbox_sr,
     format = format,
     size = paste0(c(width, height), collapse = ","),
-    token = token,
     outSR = out_sr,
     f = "json"
   )
 
+  # fetch the response
   resp <- httr2::req_perform(req)
 
-  resp_meta <- jsonify::from_json(httr2::resp_body_string(resp))
+  resp_meta <- RcppSimdJson::fparse(httr2::resp_body_string(resp))
 
   detect_errors(resp_meta)
 

Diff for: R/arc-select.R

@@ -60,6 +60,7 @@ arc_select <- function(
     token = arc_token(),
     ...
 ) {
+
   # Developer note:
   # For this function we extract the query object and manipulate the elements
   # inside of the query object to modify our request. We then splice those
@@ -135,20 +136,16 @@ collect_layer <- function(x,
                           token = arc_token(),
                           ...,
                           error_call = rlang::caller_env()) {
-  check_inherits_any(
-    x,
-    c("FeatureLayer", "Table", "ImageServer"),
-    call = error_call
-  )
-
   # 1. Make base request
   # 2. Identify necessary query parameters
   # 3. Figure out offsets and update query parameters
   # 4. Make list of requests
   # 5. Make requests
   # 6. Identify errors (if any) -- skip for now
   # 7. Parse:
-  req <- httr2::request(x[["url"]])
+
+  # sets token and agent
+  req <- arc_base_req(x[["url"]], token)
 
   # determine if the layer can query
   can_query <- switch(
@@ -177,13 +174,14 @@ collect_layer <- function(x,
 
   # parameter validation ----------------------------------------------------
   # get existing parameters
-  query_params <- validate_params(query, token = token)
+  query_params <- validate_params(query)
 
   # Offsets -----------------------------------------------------------------
+  # TODO make adjustable
   feats_per_page <- x[["maxRecordCount"]]
 
   # count the number of features in a query
-  n_feats <- count_results(req, query, token)
+  n_feats <- count_results(req, query)
 
   if (is.null(n_feats)) {
     cli::cli_abort(
@@ -215,13 +213,11 @@ collect_layer <- function(x,
   all_requests <- lapply(offsets, add_offset, req, query_params)
 
   # make all requests and store responses in list
-  all_resps <- httr2::req_perform_parallel(all_requests)
+  all_resps <- httr2::req_perform_parallel(all_requests, on_error = "continue")
 
   # identify any errors
-  has_error <- vapply(all_resps, function(x) inherits(x, "error"), logical(1))
-  #   if (any(has_error)) {
   # TODO: determine how to handle errors
-  #   }
+  has_error <- vapply(all_resps, function(x) inherits(x, "error"), logical(1))
 
   # fetch the results
   res <- lapply(
@@ -357,9 +353,7 @@ add_offset <- function(offset, request, params) {
 #'
 #' @keywords internal
 #' @noRd
-validate_params <- function(params, token) {
-  # set the token
-  params[["token"]] <- token
+validate_params <- function(params) {
 
   # if output fields are missing set to "*"
   if (is.null(params[["outFields"]])) params[["outFields"]] <- "*"
@@ -378,10 +372,10 @@ validate_params <- function(params, token) {
 }
 
 # Given a query, determine how many features will be returned
-count_results <- function(req, query, token) {
+count_results <- function(req, query) {
   n_req <- httr2::req_body_form(
     httr2::req_url_path_append(req, "query"),
-    !!!validate_params(query, token),
+    !!!validate_params(query),
     returnCountOnly = "true"
   )