aws workspace upload, download, and destroy

DESCRIPTION

@@ -12,7 +12,7 @@ Description: Pipeline tools coordinate the pieces of computationally
   The methodology in this package
   borrows from GNU 'Make' (2015, ISBN:978-9881443519)
   and 'drake' (2018, <doi:10.21105/joss.00550>).
-Version: 1.10.1.9000
+Version: 1.10.1.9001
 License: MIT + file LICENSE
 URL: https://docs.ropensci.org/targets/, https://github.com/ropensci/targets
 BugReports: https://github.com/ropensci/targets/issues

NEWS.md

@@ -1,6 +1,6 @@
-# targets 1.10.1.9000 (development)
-
+# targets 1.10.1.9001 (development)
 
+* Upload workspaces to the cloud if `tar_option_get("repository_meta")` is `"aws"`. Download them with `tar_workspace_download()` and delete them with `tar_destroy(destroy = "all")` or `tar_destroy(destroy = "cloud")`.
 
 # targets 1.10.1
 

R/class_database_aws.R

@@ -69,7 +69,7 @@ database_aws_class <- R6::R6Class(
     },
     download_workspace = function(name, store, verbose = TRUE) {
       path <- path_workspace(store, name)
-      key <- path_workspace(dirname(self$key), name)
+      key <- path_workspace(dirname(dirname(self$key)), name)
       aws <- self$resources$aws
       if (verbose) {
         tar_print(
@@ -123,7 +123,7 @@ database_aws_class <- R6::R6Class(
     upload_workspace = function(target, meta, reporter) {
       name <- target_get_name(target)
       path <- path_workspace(meta$store, name)
-      key <- path_workspace(dirname(self$key), name)
+      key <- path_workspace(dirname(dirname(self$key)), name)
       aws <- self$resources$aws
       aws_s3_upload(
         file = path,
@@ -168,6 +168,39 @@ database_aws_class <- R6::R6Class(
         args = aws$args,
         max_tries = aws$max_tries %|||% 5L
       )
+    },
+    delete_cloud_workspaces = function() {
+      prefix <- dirname(path_workspace(dirname(dirname(self$key)), "x"))
+      aws <- self$resources$aws
+      names <- names(
+        aws_s3_list_etags(
+          prefix = prefix,
+          bucket = aws$bucket,
+          page_size = 1000L,
+          verbose = FALSE,
+          region = aws$region,
+          endpoint = aws$endpoint,
+          args = aws$args,
+          max_tries = aws$max_tries %|||% 5L,
+          seconds_timeout = aws$seconds_timeout,
+          close_connection = aws$close_connection,
+          s3_force_path_style = aws$s3_force_path_style
+        )
+      )
+      aws_s3_delete_objects(
+        objects = lapply(names, function(x) list(Key = x)),
+        bucket = aws$bucket,
+        batch_size = 1000L,
+        region = aws$region,
+        endpoint = aws$endpoint,
+        args = aws$args,
+        max_tries = aws$max_tries %|||% 5L,
+        seconds_timeout = aws$seconds_timeout,
+        close_connection = aws$close_connection,
+        s3_force_path_style = aws$s3_force_path_style,
+        verbose = FALSE
+      )
+      invisible()
     }
   )
 )

R/class_database_local.R

@@ -57,6 +57,9 @@ database_local_class <- R6::R6Class(
         tar_print("Not configured to delete cloud object ", self$key)
       }
       invisible()
+    },
+    delete_cloud_workspaces = function() {
+      invisible()
     }
   )
 )

R/tar_destroy.R

@@ -33,8 +33,9 @@
 #' @param destroy Character of length 1, what to destroy. Choices:
 #'   * `"all"`: entire data store (default: `_targets/`)
 #'     including cloud data, as well as download/upload scratch files.
-#'   * `"cloud"`: cloud data, including metadata as well as target object data
-#'     from targets with `tar_target(..., repository = "aws")`.
+#'   * `"cloud"`: cloud data, including metadata, target object data
+#'     from targets with `tar_target(..., repository = "aws")`,
+#'     and workspace files saved on the cloud.
 #'     Also deletes temporary staging files in
 #'     `file.path(tempdir(), "targets")`
 #'     that may have been accidentally left over from incomplete
@@ -135,7 +136,7 @@ tar_destroy <- function(
       batch_size = batch_size,
       verbose = verbose
     )
-    tar_delete_cloud_meta(script = script)
+    tar_delete_cloud_meta_and_workspaces(script = script)
     unlink(path_scratch_dir_network(), recursive = TRUE)
   }
   if (tar_should_delete(path = path, ask = ask)) {
@@ -146,7 +147,7 @@ tar_destroy <- function(
 
 # Covered in AWS and GCP tests.
 # nocov start
-tar_delete_cloud_meta <- function(script) {
+tar_delete_cloud_meta_and_workspaces <- function(script) {
   if (!file.exists(script)) {
     return()
   }
@@ -167,6 +168,7 @@ tar_delete_cloud_meta <- function(script) {
   progress$delete_cloud(verbose = FALSE)
   process$delete_cloud(verbose = FALSE)
   crew$delete_cloud(verbose = FALSE)
+  meta$delete_cloud_workspaces()
   invisible()
 }
 # nocov end

tests/aws/test-aws-workspaces.R

@@ -26,12 +26,17 @@ tar_test("aws workspaces are uploaded and downloaded", {
   })
   expr <- tar_tidy_eval(expr, environment(), TRUE)
   eval(as.call(list(`tar_script`, expr, ask = FALSE)))
-  expect_error(tar_make(callr_function = NULL), class = "tar_condition_run")
   path <- "_targets/workspaces/x"
+  expect_false(aws_s3_exists(key = path, bucket = bucket_name))
+  expect_error(tar_make(callr_function = NULL), class = "tar_condition_run")
+  expect_true(aws_s3_exists(key = path, bucket = bucket_name))
   unlink(path)
   expect_false(file.exists(path))
   expect_error(tar_workspace(x), class = "tar_condition_validate")
   tar_workspace_download(x)
   expect_true(file.exists(path))
   expect_silent(tar_workspace(x))
+  tar_destroy()
+  expect_false(aws_s3_exists(key = path, bucket = bucket_name))
+  expect_error(tar_workspace_download(x), class = "http_404")
 })

tests/testthat/test-class_database.R

@@ -426,6 +426,7 @@ tar_test("local database cloud methods", {
   expect_null(database$download_workspace(NULL, NULL, TRUE))
   expect_null(database$upload())
   expect_null(database$upload_workspace(NULL, NULL, TRUE))
+  expect_null(database$delete_cloud_workspaces())
   expect_false(database$head()$exists)
   expect_null(database$delete_cloud())
 })