Merge pull request #37 from nationalparkservice/alexa-dev

get_park_units function

Author: wright13

DESCRIPTION

@@ -26,8 +26,10 @@ Imports:
     stringr,
     tibble
 Depends: 
-    R (>= 3.5)
+    R (>= 4.1.0)
 LazyData: true
 VignetteBuilder: knitr
 URL: https://nationalparkservice.github.io/NPSdatastore/, https://github.com/nationalparkservice/NPSdatastore
 BugReports: https://github.com/nationalparkservice/NPSdatastore/issues
+Remotes:  
+    nationalparkservice/QCkit

NAMESPACE

@@ -17,6 +17,7 @@ export(get_external_links)
 export(get_file_info)
 export(get_keywords)
 export(get_lifecycle_info)
+export(get_park_units)
 export(get_reference_owners)
 export(get_reference_types)
 export(search_references_by_id)

R/get.R

@@ -356,6 +356,59 @@ get_bibliography <- function(reference_id, nps_internal = FALSE, dev = FALSE) {
   return(bib)
 }
 
+
+#' Retrieve the park units from a DataStore reference
+#'
+#'@inheritParams upload_file_to_reference
+#'@inheritParams search_references_by_id
+#'
+#' @returns A tibble of park codes and park names.
+#' @export
+#'
+#' @examples
+#' park_units <- get_park_units(reference_id = 2305911)
+#'
+get_park_units <- function(reference_id, nps_internal = FALSE, dev = FALSE) {
+
+  .validate_ref_id(reference_id)
+
+  park_units <- .datastore_request(is_secure = nps_internal, is_dev = dev) |>
+    httr2::req_url_path_append("Reference", reference_id, "Units") |>
+    httr2::req_perform()
+
+  .validate_resp(park_units)
+
+  park_units <- httr2::resp_body_json(park_units)
+
+  if(length(park_units) == 0) {
+    cli::cli_inform("There are no park units associated with this reference.")
+  } else {
+    park_units <- paste(sapply(park_units, `[[`, "unitCode"), collapse = ";")
+
+    unit_names <- httr2::request("https://irmaservices.nps.gov/Unit/v2/api/") |>
+      httr2::req_url_path_append(park_units)|>
+      httr2::req_headers(format = "json") |>
+      httr2::req_headers(Accept = "application/json") |>
+      httr2::req_perform()
+
+    .validate_resp(unit_names)
+
+    unit_names <- httr2::resp_body_json(unit_names)
+
+    unit_names <- tibble::as_tibble(
+      do.call(rbind,
+              lapply(unit_names, function(x) {
+                data.frame(
+                  UnitCode = as.character(x[["UnitCode"]])[1],
+                  UnitName = as.character(x[["FullName"]])[1],
+                  stringsAsFactors = FALSE)
+              }))
+    )
+  }
+
+  return(unit_names)
+}
+
 #' Determine if a reference was created by/for the NPS
 #'
 #' @inheritParams get_bibliography
@@ -404,4 +457,4 @@ get_lifecycle_info <- function(reference_id, dev = FALSE) {
   lifecycle_info <- httr2::resp_body_json(lifecycle_info)
 
   return(lifecycle_info)
-}
+  }

R/helpers.R

@@ -343,29 +343,48 @@ example_ref_ids <- function(visibility = c("public", "internal", "both"), n, see
   }
 }
 
+#' Check HTTP response and throw a helpful error if needed
+#'
+#' @param resp HTTP response as returned by `httr2::req_perform()`
+#' @param nice_msg_400 Optional. Custom message for errors in the 400 range
+#' @param nice_msg_500 Optional. Custom message for errors in the 500 range
+#' @param details Optional. Name of JSON field in response body that contains more info about the error
+#' @param call Caller environment
+#'
+#' @keywords internal
+#'
 .validate_resp <- function(resp,
                            nice_msg_400,
                            nice_msg_500,
+                           details,
                            call = rlang::caller_env()) {
 
   if (httr2::resp_is_error(resp)) {
-    if (missing(nice_msg_400)) {
-      nice_msg_400 <- c("i" = "There's a problem with your API request. Check reference IDs, search terms, etc. for typos.",
-                        "i" = "If you are an NPS user attempting to edit a reference or access non-public data, verify that you are on the NPS network, have the appropriate permissions, and have set {.arg nps_internal = TRUE} if applicable.",
-                        "i" = "Verify that {.arg dev} is set correctly.")
-    }
-    if (missing(nice_msg_500)) {
-      nice_msg_500 <- c("i" = "Something seems to have gone wrong on DataStore's end. For troubleshooting help, take a screenshot of this error and contact the package maintainer or the DataStore helpdesk.")
-    }
 
     status_num <- httr2::resp_status(resp)
 
-    if (floor(status_num/100) == 5) {
+    if (floor(status_num/100) == 5) {  # error in 500 range (likely server-side)
+      if (missing(nice_msg_500)) {
+        nice_msg_500 <- "Something seems to have gone wrong on DataStore's end. For troubleshooting help, take a screenshot of this error and contact the package maintainer or the DataStore helpdesk."
+      }
       nice_msg <- nice_msg_500
-    } else if (floor(status_num/100) == 4) {
+    } else if (floor(status_num/100) == 4) {  # error in 400 range (likely client-side)
+      if (missing(nice_msg_400)) {
+        nice_msg_400 <- c("There's a problem with your API request. Check reference IDs, search terms, etc. for typos.",
+                          "If you are an NPS user attempting to edit a reference or access non-public data, verify that you are on the NPS network, have the appropriate permissions, and have set {.arg nps_internal = TRUE} if applicable.",
+                          "Verify that {.arg dev} is set correctly.")
+      }
       nice_msg <- nice_msg_400
     }
 
+    names(nice_msg) <- rep("i", length(nice_msg))
+
+    if(!missing(details)) {
+      resp_body <- httr2::resp_body_json(resp)
+      detail_msg <- glue::glue("DETAILS: {resp_body[[details]]}")
+      nice_msg <- c(nice_msg, "i" = detail_msg)
+    }
+
     http_err <- glue::glue("HTTP {status_num}: {httr2::resp_status_desc(resp)}")
     cli::cli_abort(c(http_err, nice_msg), call = call)
   }

R/set.R

@@ -451,10 +451,10 @@ add_external_link <- function(reference_id, url, description, last_verified = fo
   }
 
   links <- list(resourceId = 0,
-                          userSort = 0,
-                          description = description,
-                          uri = url,
-                          lastVerified = last_verified)
+                userSort = 0,
+                description = description,
+                uri = url,
+                lastVerified = last_verified)
 
   added_link <- .datastore_request(is_secure = TRUE, is_dev = dev) |>
     httr2::req_url_path_append("Reference", reference_id, "ExternalLinks") |>
@@ -539,8 +539,8 @@ set_by_for_nps <- function(reference_id, by_for_nps, dev = TRUE, interactive = T
   # Set values
   nps_internal <- TRUE
   by_for_nps <- dplyr::case_when(by_for_nps ~ 'true',
-                             !by_for_nps ~ 'false',
-                             .default = NA_character_)  # convert by_for_nps to a string for the API
+                                 !by_for_nps ~ 'false',
+                                 .default = NA_character_)  # convert by_for_nps to a string for the API
 
   # Verify that we're modifying the right reference
   if (interactive) {
@@ -665,14 +665,22 @@ set_license <- function(reference_id, license_type_id, dev = TRUE, interactive =
 #'
 set_lifecycle_active <- function(reference_id, dev = TRUE, interactive = TRUE) {
   .validate_ref_id(reference_id)
+  # Verify that we're modifying the right reference
+  if (interactive) {
+    .user_validate_ref_title(ref_id = reference_id,
+                             is_secure = TRUE,
+                             is_dev = dev)
+  }
 
   lifecycle_info <- .datastore_request(is_secure = TRUE, is_dev = dev) |>
     httr2::req_url_path_append("Reference", reference_id, "Lifecycle", "Active") |>
     httr2::req_body_json(list()) |>
     httr2::req_method("PUT") |>
     httr2::req_perform()
 
-  .validate_resp(lifecycle_info)
+  .validate_resp(lifecycle_info,
+                 nice_msg_500 = "DataStore could not change the reference lifecycle. See below for details.",
+                 details = "exceptionMessage")
 
   lifecycle_info <- get_lifecycle_info(reference_id = reference_id, dev = dev)
 
@@ -694,14 +702,23 @@ set_lifecycle_active <- function(reference_id, dev = TRUE, interactive = TRUE) {
 #'
 set_lifecycle_draft <- function(reference_id, dev = TRUE, interactive = TRUE) {
   .validate_ref_id(reference_id)
+  # Verify that we're modifying the right reference
+  if (interactive) {
+    .user_validate_ref_title(ref_id = reference_id,
+                             is_secure = TRUE,
+                             is_dev = dev)
+  }
+
 
   lifecycle_info <- .datastore_request(is_secure = TRUE, is_dev = dev) |>
     httr2::req_url_path_append("Reference", reference_id, "Lifecycle", "Draft") |>
     httr2::req_body_json(list()) |>
     httr2::req_method("PUT") |>
     httr2::req_perform()
 
-  .validate_resp(lifecycle_info)
+  .validate_resp(lifecycle_info,
+                 nice_msg_500 = "DataStore could not change the reference lifecycle. See below for details.",
+                 details = "exceptionMessage")
 
   lifecycle_info <- get_lifecycle_info(reference_id = reference_id, dev = dev)
 

man/dot-validate_resp.Rd

@@ -34,3 +34,22 @@ test_that("example_ref_ids returns example reference IDs", {
   expect_warning(example_ref_ids(n = 500), "exceeds total number")
 
 })
+
+test_that(".get_ref_profile_url constructs the correct URL", {
+
+  public <- .get_ref_profile_url(public_refs[37], is_dev = FALSE)
+  public_dev <- .get_ref_profile_url(public_refs[5], is_dev = TRUE)
+  secure <- .get_ref_profile_url(internal_refs[22], is_dev = FALSE)
+  secure_dev <- .get_ref_profile_url(internal_refs[9], is_dev = TRUE)
+
+
+  expect_type(public_dev, "character")
+  expect_type(public, "character")
+  expect_type(secure_dev, "character")
+  expect_type(secure, "character")
+
+  expect_equal(substr(public_dev, 1, 52), "https://irmadev.nps.gov/DataStore/Reference/Profile/")
+  expect_equal(substr(public, 1, 49), "https://irma.nps.gov/DataStore/Reference/Profile/")
+  expect_equal(substr(secure_dev, 1, 52), "https://irmadev.nps.gov/DataStore/Reference/Profile/")
+  expect_equal(substr(secure, 1, 49), "https://irma.nps.gov/DataStore/Reference/Profile/")
+})