feat: terminate_jobs() (#345)

Co-authored-by: Barret Schloerke <barret@posit.co>

NAMESPACE

@@ -138,6 +138,7 @@ export(set_thumbnail)
 export(set_vanity_url)
 export(swap_vanity_url)
 export(tbl_connect)
+export(terminate_jobs)
 export(user_guid_from_username)
 export(users_create_remote)
 export(vanity_is_available)

NEWS.md

@@ -14,6 +14,8 @@
   users on a Connect server. (#311)
 - The new `get_group_content()` function lets you view the content that groups
   have permission to access. (#334)
+- The new `terminate_jobs()` function lets you terminate processes associated
+  with a content item. (#332)
 
 ## Minor improvements and fixes
 

R/content.R

@@ -93,7 +93,7 @@ Content <- R6::R6Class(
     get_dashboard_url = function(pane = "") {
       dashboard_url_chr(self$connect$server, self$content$guid, pane = pane)
     },
-    #' @description Return the jobs for this content.
+    #' @description Return the jobs for this content
     jobs = function() {
       res <- self$connect$GET(v1_url("content", self$content$guid, "jobs"), parser = NULL)
       use_unversioned <- endpoint_does_not_exist(res)
@@ -126,6 +126,17 @@ Content <- R6::R6Class(
         ~ purrr::list_modify(.x, app_guid = content_guid)
       )[[1]]
     },
+    #' @description Terminate a single job for this content item.
+    #' @param key The job key.
+    register_job_kill_order = function(key) {
+      con <- self$connect
+      url <- v1_url("content", self$content$guid, "jobs", key)
+      res <- self$connect$DELETE(url)
+      if (endpoint_does_not_exist(res)) {
+        con$raise_error(res)
+      }
+      res
+    },
     #' @description Return the variants for this content.
     variants = function() {
       warn_experimental("variants")
@@ -656,7 +667,7 @@ get_jobs <- function(content) {
   validate_R6_class(content, "Content")
 
   jobs <- content$jobs()
-  parse_connectapi_typed(jobs, connectapi_ptypes$jobs, order_columns = TRUE)
+  parse_connectapi_typed(jobs, connectapi_ptypes$jobs, strict = TRUE)
 }
 
 # TODO: Need to test `logged_error` on a real error
@@ -684,6 +695,58 @@ get_job <- function(content, key) {
   parse_connectapi_typed(list(job), connectapi_ptypes$job)
 }
 
+#' Terminate Jobs
+#'
+#' Register a job kill order for one or more jobs associated with a content
+#' item. Requires Connect 2022.10.0 or newer.
+#'
+#' @param content A Content object, as returned by `content_item()`
+#' @param keys Optional. One or more job keys, which can be obtained using
+#' `get_jobs(content)`. If no keys are provided, will terminate all active
+#' jobs for the provided content item.
+
+#' @return A data frame with the status of each termination request.
+#'
+#' - `app_id`: The content item's identifier.
+#' - `app_guid`: The content item's GUID.
+#' - `job_key`: The job key.
+#' - `job_id`: The job's identifier.
+#' - `result`: The result string returned by Connect.
+#' - `code`: An error code, `NA` if the request was successful.
+#' - `error`: An error message, `NA` if the result was successful.
+#'
+#' Note that `app_id`, `app_guid`, `job_id`, and `result` are `NA` if the
+#' request returns an error.
+#'
+#' @family job functions
+#' @family content functions
+#' @export
+terminate_jobs <- function(content, keys = NULL) {
+  validate_R6_class(content, "Content")
+
+  if (is.null(keys)) {
+    all_jobs <- get_jobs(content)
+    keys <- all_jobs[all_jobs$status == 0, ]$key
+    if (length(keys) == 0) {
+      message("No active jobs found.")
+      return(vctrs::vec_ptype(connectapi_ptypes$job_termination))
+    }
+  }
+
+  res <- purrr::map(keys, content$register_job_kill_order)
+  res_content <- purrr::map(res, httr::content)
+  res_df <- tibble::tibble(
+    parse_connectapi_typed(
+      res_content,
+      connectapi_ptypes$job_termination,
+      strict = TRUE
+    )
+  )
+  # Errors will not have the job_key.
+  res_df$job_key <- keys
+  res_df
+}
+
 #' Set RunAs User
 #'
 #' Set the `RunAs` user for a piece of content.

R/parse.R

@@ -27,17 +27,18 @@ make_timestamp <- function(input) {
   safe_format(input, "%Y-%m-%dT%H:%M:%SZ", tz = "UTC", usetz = FALSE)
 }
 
-ensure_columns <- function(.data, ptype, order_columns = FALSE) {
+ensure_columns <- function(.data, ptype, strict = FALSE) {
   # Given a prototype, ensure that all columns are present and cast to the correct type.
   # If a column is missing in .data, it will be created with all missing values of the correct type.
   # If a column is present in both, it will be cast to the correct type.
   # If a column is present in .data but not in ptype, it will be left as is.
+  # If `strict == TRUE`, include only columns present in the ptype, in the order they occur.
   for (i in names(ptype)) {
     .data <- ensure_column(.data, ptype[[i]], i)
   }
 
-  if (order_columns) {
-    .data <- .data[, unique(c(names(ptype), names(.data))), drop = FALSE]
+  if (strict) {
+    .data <- .data[, names(ptype), drop = FALSE]
   }
 
   .data
@@ -70,8 +71,8 @@ ensure_column <- function(data, default, name) {
   data
 }
 
-parse_connectapi_typed <- function(data, ptype, order_columns = FALSE) {
-  ensure_columns(parse_connectapi(data), ptype, order_columns)
+parse_connectapi_typed <- function(data, ptype, strict = FALSE) {
+  ensure_columns(parse_connectapi(data), ptype, strict)
 }
 
 parse_connectapi <- function(data) {

R/ptype.R

@@ -224,5 +224,14 @@ connectapi_ptypes <- list(
     content_title = NA_character_,
     access_type = NA_character_,
     permissions = NA_list_
+  ),
+  job_termination = tibble::tibble(
+    app_id = NA_integer_,
+    app_guid = NA_character_,
+    job_key = NA_character_,
+    job_id = NA_character_,
+    result = NA_character_,
+    code = NA_integer_,
+    error = NA_character_
   )
 )

_pkgdown.yml

@@ -40,6 +40,7 @@ reference:
       - matches("image")
       - matches("vanity")
       - matches("schedule")
+      - matches("job")
       - set_run_as
 
   - title: "Users and groups"