Merge pull request #566 from Crunch-io/dry-run-only

Dry run only

Author: gergness

R/api.R

@@ -7,8 +7,10 @@
 #' @param status.handlers named list of specific HTTP statuses and a response
 #' function to call in the case where that status is returned. Passed to the
 #' [handleAPIresponse()] function.
+#' @param progress.handler an optional function that resolves errors raised
+#' during an async request. Passed to the [`pollProgress()`] function.
 #' @keywords internal
-crunchAPI <- function(http.verb, url, config = list(), status.handlers = list(), ...) {
+crunchAPI <- function(http.verb, url, config = list(), status.handlers = list(), progress.handler = NULL, ...) {
     url ## force lazy eval of url
     if (isTRUE(getOption("crunch.debug"))) {
         ## TODO: work this into httpcache.log
@@ -17,7 +19,11 @@ crunchAPI <- function(http.verb, url, config = list(), status.handlers = list(),
     }
     FUN <- get(http.verb, envir = asNamespace("httpcache"))
     x <- FUN(url, ..., config = c(get_crunch_config(), config, strip_token_if_outside(url)))
-    out <- handleAPIresponse(x, special.statuses = status.handlers)
+    out <- handleAPIresponse(
+        x,
+        special.statuses = status.handlers,
+        progress.handler = progress.handler
+    )
     return(out)
 }
 
@@ -51,11 +57,18 @@ crDELETE <- function(...) crunchAPI("DELETE", ...)
 #' Do the right thing with the HTTP response
 #' @param response an httr response object
 #' @param special.statuses an optional named list of functions by status code.
+#' @param progress.handler an optional function to handle errors reported by
+#' a progress result. Default NULL prints the string `message`; other
+#' functions required to handle non-string messages in progress responses.
 #' @return The full HTTP response object, just the content, or any other
 #' status-specific action
 #' @importFrom httr content http_status
 #' @keywords internal
-handleAPIresponse <- function(response, special.statuses = list()) {
+handleAPIresponse <- function(
+    response,
+    special.statuses = list(),
+    progress.handler = NULL
+) {
     warning <- get_header("Warning", response$headers)
     if (!is.null(warning)) {
         if (startsWith(warning, "299")) {
@@ -81,13 +94,13 @@ handleAPIresponse <- function(response, special.statuses = list()) {
     if (is.function(handler)) {
         invisible(handler(response))
     } else if (tolower(http_status(response)$category) == "success") {
-        handleAPIsuccess(code, response)
+        handleAPIsuccess(code, response, progress.handler)
     } else {
         handleAPIfailure(code, response)
     }
 }
 
-handleAPIsuccess <- function(code, response) {
+handleAPIsuccess <- function(code, response, progress.handler) {
     if (code == 202) {
         ## 202 Continue: a few cases:
         ## 1) Legacy: POST /batches/ returns Batch entity in Location, no
@@ -106,7 +119,7 @@ handleAPIsuccess <- function(code, response) {
                     message(paste0("Checking progress at: ", progress_url))
                 }
                 tryCatch(
-                    pollProgress(progress_url, getOption("crunch.poll.wait", 0.5)),
+                    pollProgress(progress_url, getOption("crunch.poll.wait", 0.5), progress.handler),
                     error = function(e) {
                         message(paste0(
                             "Something went wrong during `pollProgress()` of url: ",

R/automation.R

@@ -102,6 +102,11 @@ setMethod("scriptSavepoint", "Script", function(x) {
 #' @param is_file The default guesses whether a file or string was
 #' used in the `script` argument, but you can override the heuristics
 #' by specifying `TRUE` for a file, and `FALSE` for a string.
+#' @param encoding Optional encoding to convert **from**, defaults to UTF-8.
+#' The API accepts only UTF-8, so all text will be converted to UTF-8 before
+#' being sent to the server.
+#' @param ... Additional options, such as `dry_run = TRUE` passed on
+#' to the API
 #'
 #' @return For `runCrunchAutomation()`: an updated dataset (invisibly),
 #' For `showScriptErrors()`, when run after a failure, a list with two items:
@@ -116,6 +121,9 @@ setMethod("scriptSavepoint", "Script", function(x) {
 #' # Or a string directly:
 #' ds <- runCrunchAutomation(ds, "RENAME v1 TO age;")
 #'
+#' # A "dry run" that validates the script but does not run it:
+#' runCrunchAutomation(ds, "RENAME V1 TO age;", dry_run = TRUE)
+#'
 #' # After a failed run, some error information prints to console,
 #' # But more details are available with function:
 #' showScriptErrors()
@@ -126,24 +134,36 @@ setMethod("scriptSavepoint", "Script", function(x) {
 #' }
 #' @export
 #' @seealso [`automation-undo`] & [`script-catalog`]
-runCrunchAutomation <- function(dataset, script, is_file = string_is_file_like(script)) {
+runCrunchAutomation <- function(
+    dataset,
+    script,
+    is_file = string_is_file_like(script),
+    encoding = "UTF-8",
+    ...
+) {
     reset_automation_error_env()
     stopifnot(is.dataset(dataset))
     stopifnot(is.character(script))
 
     if (is_file) {
         automation_error_env$file <- script
-        script <- readLines(script, encoding = "UTF-8", warn = FALSE)
+        script <- readLines(script, encoding = encoding, warn = FALSE)
     } else {
         automation_error_env$file <- NULL
     }
     if (length(script) != 1) script <- paste(script, collapse = "\n")
 
+    body <- list(body = script, ...)
+    automation_error_env$last_attempted_script <- script
+
     crPOST(
         shojiURL(dataset, "catalogs", "scripts"),
-        body = toJSON(wrapEntity(body = list(body = script))),
-        status.handlers = list(`400` = crunchAutomationErrorHandler)
+        body = toJSON(wrapEntity(body = body)),
+        status.handlers = list(`400` = crunchAutomationErrorHandler),
+        progress.handler = crunchAutomationErrorHandler
     )
+    # Provide feedback for dry_run success so that user is confident it was succesful
+    if (isTRUE(body$dry_run)) message("Script dry run was successful")
     invisible(refresh(dataset))
 }
 
@@ -193,18 +213,27 @@ make_rstudio_markers <- function(errors) {
     rstudioapi::sourceMarkers("crunchAutomation", markers)
 }
 # nocov end
+
 #' @importFrom jsonlite fromJSON
 #' @importFrom httr http_status content
 crunchAutomationErrorHandler <- function(response) {
-    msg <- http_status(response)$message
-    automation_messages <- try(content(response)$resolution, silent = TRUE)
+    # Get data from appropriate place if it's a direct httr response
+    # or if it's from pollProgress (because validation was async)
+    # TODO: If this becomes a common pattern, should probably put
+    # somewhere else
+    if (inherits(response, "response")) {
+        msg <- http_status(response)$message
+        response_content <- content(response)
+    }  else {
+        msg <- response$message$description
+        response_content <- response$message
+    }
+    automation_messages <- try(response_content$resolution, silent = TRUE)
 
-    if (!is.error(automation_messages)) {
-        # dig into the response to get the script as we sent it to the server
-        request_body <- fromJSON(rawToChar(response$request$options$postfields))
-        automation_error_env$script <- request_body$body$body
+    if (!is.error(automation_messages) && !is.null(automation_messages)) {
+        automation_error_env$script <- automation_error_env$last_attempted_script
 
-        # And convert the full information of the error messages into a data.frame
+        # convert the full information of the error messages into a data.frame
         automation_error_cols <- c("column", "command", "line", "message")
         errors <- lapply(
             automation_messages,
@@ -236,6 +265,13 @@ crunchAutomationErrorHandler <- function(response) {
         }
 
         msg <- paste("Crunch Automation Error\n", error_items, more_info_text, sep = "")
+    } else {
+        # could also have information in message property
+        # try to use it if it's a character string
+        other_msg <- try(content(response)[["message"]], silent = TRUE) #nocov
+        if (is.character(other_msg)) { #nocov
+            msg <- paste0(msg, " - ", paste0(other_msg, collapse = "\n")) #nocov
+        }
     }
     halt(msg)
 }

R/progress.R

@@ -6,13 +6,15 @@
 #' @param progress_url A Crunch progress URL
 #' @param wait Number of seconds to wait between polling. This time is increased
 #' 20 percent on each poll.
+#' @param error_handler An optional function that takes the status object
+#' when the progress is less than 0 (meaning the request failed)
 #' @return The percent completed of the progress. Assuming the
 #' `options(crunch.timeout)` (default: 15 minutes) hasn't been reached, this
 #' will be 100. If the timeout is reached, it will be the last reported progress
 #' value.
 #' @export
 #' @importFrom httpcache uncached
-pollProgress <- function(progress_url, wait = .5) {
+pollProgress <- function(progress_url, wait = .5, error_handler = NULL) {
     ## Configure polling interval. Will increase by rate (>1) until reaches max
     max.wait <- 30
     increase.by <- 1.2
@@ -37,7 +39,9 @@ pollProgress <- function(progress_url, wait = .5) {
     }
     close(pb)
 
-    if (status < 0) {
+    if (status < 0 && !is.null(error_handler)) {
+        return(error_handler(prog))
+    } else if (status < 0) {
         email <- "There was an error on the server. Please contact [email protected]"
         msg <- prog$message %||% email
         halt(msg)

dev-misc/fixture-creation/vegetables-dataset.R

@@ -540,6 +540,26 @@ file_copy(cube_path, here("mocks", "cubes", "numa-x-mr.json"), overwrite = TRUE)
 
 dir_delete(temp_dir)
 
+
+### Generate failed async crunch automation failure
+httpcache::clearCache()
+dir_create(temp_dir)
+
+start_capturing(temp_dir)
+failed <- try(runCrunchAutomation(ds, "NOT A COMMAND", async = TRUE), silent = TRUE)
+stop_capturing()
+
+progress_path <- path(temp_dir, "app.crunch.io/api/progress.json")
+
+file_copy(
+    progress_path,
+    here("mocks", "app.crunch.io", "api", "progress-failed-async-script.json"),
+    overwrite = TRUE
+)
+
+dir_delete(temp_dir)
+
+
 # Cleanup ----
 rm(deck) # Hopefully gets rid of weird message after sourcing script
 with_consent(delete(ds))

man/crunchAPI.Rd

@@ -100,7 +100,8 @@
                         "other": 0,
                         "selected": 210
                     }
-                }
+                },
+                "is_cat_date": false
             },
             "filtered": {
                 "unweighted_n": 210,

man/handleAPIresponse.Rd

@@ -100,7 +100,8 @@
                         "other": 0,
                         "selected": 210
                     }
-                }
+                },
+                "is_cat_date": false
             },
             "filtered": {
                 "unweighted_n": 210,