Add URL conversion functions

DESCRIPTION

@@ -32,13 +32,15 @@ Imports:
     RcppSimdJson,
     rlang,
     sf,
-    utils
+    utils,
+    lifecycle
 Suggests:
     arcgisbinding,
     collapse (>= 2.0.0),
     data.table,
     jsonify,
     testthat (>= 3.0.0),
+    curl,
     vctrs
 Config/rextendr/version: 0.3.1.9001
 Config/testthat/edition: 3

NAMESPACE

@@ -6,13 +6,20 @@ S3method(has_m,sfc)
 S3method(has_m,sfg)
 S3method(has_z,sfc)
 S3method(has_z,sfg)
+S3method(print,PortalItem)
 export("%||%")
 export(arc_agent)
 export(arc_base_req)
+export(arc_group)
 export(arc_host)
+export(arc_item)
+export(arc_item_data)
+export(arc_portal_urls)
 export(arc_self_meta)
 export(arc_token)
 export(arc_url_parse)
+export(arc_url_type)
+export(arc_user)
 export(as_esri_features)
 export(as_esri_featureset)
 export(as_esri_geometry)
@@ -42,6 +49,7 @@ export(has_m)
 export(has_z)
 export(infer_esri_type)
 export(is_date)
+export(is_url)
 export(obj_check_token)
 export(parse_esri_json)
 export(ptype_tbl)
@@ -52,4 +60,5 @@ export(set_arc_token)
 export(unset_arc_token)
 export(validate_crs)
 export(validate_or_refresh_token)
+importFrom(lifecycle,deprecated)
 useDynLib(arcgisutils, .registration = TRUE)

NEWS.md

@@ -1,5 +1,7 @@
 # arcgisutils (development version)
 
+- Adds new experimental functions for parsing urls `arc_url_parse()`, `arc_url_type()`, and `is_url()` h/t [@elipousson](https://github.com/elipousson)
+- Adds new experimental functions for working with a portal's sharing API `arc_item()`, `arc_group()`, `arc_user()`, `arc_item_data()`, `arc_portal_urls()`
 - Validate `token` in `arc_base_req()`
 
 # arcgisutils 0.3.2

R/arc-auth.R

@@ -285,12 +285,17 @@ validate_or_refresh_token <- function(
 ) {
   # validate the object is a token
   obj_check_token(token, call = call)
-  check_string(client, allow_empty = FALSE)
+  check_string(client, allow_empty = TRUE)
   check_string(host, allow_empty = FALSE)
   check_number_whole(refresh_threshold, min = 0, max = 3600)
 
   cur_time <- as.numeric(Sys.time())
 
+  # if there isn't a client token value then we can return the token
+  if (!nzchar(client)) {
+    return(token)
+  }
+
   # provide an error if there is an expired token
   if (token[["expires_at"]] <= cur_time) {
     cli::cli_abort("Provided token has expired", call = call)

R/arc-base-req.R

@@ -56,7 +56,7 @@ arc_base_req <- function(
   # if token is not missing, check it
   if (!is.null(token)) {
     # ensure that the token is an httr2_token
-    token <- validate_or_refresh_token(token, error_call)
+    # token <- validate_or_refresh_token(token, error_call)
 
     # set the auth header
     req <- httr2::req_headers(

R/arcgisutils-package.R

@@ -1,5 +1,6 @@
 ## usethis namespace: start
-#' @useDynLib arcgisutils, .registration = TRUE
+#' @importFrom lifecycle deprecated
 #' @keywords internal
+#' @useDynLib arcgisutils, .registration = TRUE
 ## usethis namespace: end
 NULL

R/sharing.R

@@ -0,0 +1,169 @@
+#' Portal Item Metadata
+#'
+#' Given the unique ID of a content item, fetches the item's metadata from a portal.
+#'
+#' @param item_id the ID of the item to fetch. A scalar character.
+#' @inheritParams auth_user
+#' @details
+#'
+#' See [API Reference](https://developers.arcgis.com/rest/users-groups-and-items/item/) for more information.
+#'
+#' `r lifecycle::badge("experimental")`
+#' @export
+#' @family portal item
+#' @examplesIf curl::has_internet()
+#' arc_item("9df5e769bfe8412b8de36a2e618c7672")
+#' @returns an object of class `PortalItem` which is a list with the item's metadata.
+arc_item <- function(item_id, host = arc_host(), token = arc_token()) {
+  check_string(item_id, allow_empty = FALSE)
+  resp <- arc_base_req(
+    host,
+    path = paste0("sharing/rest/content/items/", item_id),
+    token,
+    query = c("f" = "json")
+  ) |>
+    httr2::req_perform() |>
+    httr2::resp_body_string() |>
+    RcppSimdJson::fparse() |>
+    detect_errors()
+
+  structure(resp, class = c("PortalItem", "list"))
+}
+
+#' @export
+print.PortalItem <- function(x, ...) {
+  cat(sprintf("<PortalItem<%s>>\n", x$type))
+  for (field in c("id", "title", "owner")) {
+    cat(field, ": ", x[[field]], "\n", sep = "")
+  }
+  invisible(x)
+}
+
+#' Organization's URLs
+#'
+#' Returns the URLs of an organizations services.
+#'
+#' See [API Reference](https://developers.arcgis.com/rest/users-groups-and-items/urls/) for more information.
+#' `r lifecycle::badge("experimental")`
+#' @export
+#' @family portal
+#' @inheritParams auth_user
+#' @examplesIf curl::has_internet()
+#' arc_portal_urls()
+arc_portal_urls <- function(host = arc_host(), token = arc_token()) {
+  arc_base_req(
+    host,
+    token,
+    "sharing/rest/portals/self/urls",
+    query = c("f" = "json")
+  ) |>
+    httr2::req_perform() |>
+    httr2::resp_body_string() |>
+    RcppSimdJson::fparse()
+}
+
+
+#' Download an Item's Data
+#'
+#' Download the data backing a portal item. This function always returns
+#' a raw vector as the type of the data that is downloaded cannot always be known.
+#'
+#' `r lifecycle::badge("experimental")`
+#' @param item the item ID or the result of `arc_item()`.
+#' @export
+#' @inheritParams auth_user
+#' @family portal item
+#' @examplesIf curl::has_internet()
+#' arc_item_data("9df5e769bfe8412b8de36a2e618c7672")
+#' @returns a raw vector containing the bytes of the data associated with the item. If the response is `application/json` then the json string is returned without parsing.
+arc_item_data <- function(
+  item,
+  host = arc_host(),
+  token = arc_token()
+) {
+  e_msg <- "Expected a content ID or {.cls PortalItem<_>} created with {.fn arc_item}"
+
+  if (rlang::is_string(item)) {
+    item <- rlang::try_fetch(
+      arc_item(item, host, token),
+      error = function(cnd) cli::cli_abort(e_msg)
+    )
+  }
+
+  if (!inherits(item, "PortalItem")) {
+    cli::cli_abort(e_msg)
+  }
+
+  resp <- arc_base_req(
+    host,
+    path = c("sharing/rest/content/items/", item[["id"]], "data"),
+    token
+  ) |>
+    httr2::req_perform()
+
+  resp_type <- httr2::resp_content_type(resp)
+
+  if (resp_type == "application/json") {
+    resp_str <- httr2::resp_body_string(resp)
+    catch_error(resp_str)
+    resp_str
+  } else {
+    httr2::resp_body_raw(resp)
+  }
+}
+
+
+#' Fetch Group Information
+#'
+#' Fetches metadata about a group based on a provided `group_id`.
+#'
+#' `r lifecycle::badge("experimental")`
+#' @param group_id the unique group identifier. A scalar character.
+#' @inheritParams arc_item
+#' @export
+#' @family portal organization
+#' @examplesIf curl::has_internet()
+#' arc_group("2f0ec8cb03574128bd673cefab106f39")
+#' @returns a list with group metadata
+arc_group <- function(
+  group_id,
+  host = arc_host(),
+  token = arc_token()
+) {
+  check_string(group_id)
+  arc_base_req(
+    host,
+    token,
+    c("sharing/rest/community/groups", group_id),
+    query = c("f" = "json")
+  ) |>
+    httr2::req_perform() |>
+    httr2::resp_body_string() |>
+    RcppSimdJson::fparse() |>
+    detect_errors()
+}
+
+#' User Information
+#'
+#' Fetch a user's metadata based on username.
+#'
+#' `r lifecycle::badge("experimental")`
+#'
+#' @param username the username to fetch. A scalar character.
+#' @inheritParams arc_item
+#' @export
+#' @family portal organization
+#' @examplesIf curl::has_internet()
+#' arc_user("esri_en")
+arc_user <- function(username, host = arc_host(), token = arc_token()) {
+  arc_base_req(
+    host,
+    token,
+    c("sharing/rest/community/users", username),
+    query = c("f" = "json")
+  ) |>
+    httr2::req_perform() |>
+    httr2::resp_body_string() |>
+    RcppSimdJson::fparse() |>
+    detect_errors()
+}

R/utils-requests.R

@@ -22,7 +22,11 @@
 #' meta <- fetch_layer_metadata(furl)
 #' head(names(meta))
 #' @returns returns a list object
-fetch_layer_metadata <- function(url, token = NULL, call = rlang::caller_env()) {
+fetch_layer_metadata <- function(
+  url,
+  token = NULL,
+  call = rlang::caller_env()
+) {
   req <- arc_base_req(url, token, error_call = call)
 
   # add f=json to the url for querying
@@ -75,7 +79,7 @@ detect_errors <- function(response, error_call = rlang::caller_env()) {
   e_msg <- capture_message(response)
 
   if (is.null(e_msg)) {
-    return(invisible(NULL))
+    return(response)
   }
 
   rlang::abort(