suppress task output and renv dependency output on logLevel="quiet" (#…

…1064) fixes #1051
rstudio · Apr 24, 2024 · 76ffcfe · 76ffcfe
1 parent d585c26
commit 76ffcfe
Show file tree

Hide file tree

Showing 6 changed files with 149 additions and 13 deletions.
diff --git a/NEWS.md b/NEWS.md
@@ -1,5 +1,11 @@
 # rsconnect (development version)
 
+* `deployApp(logLevel = "quiet")` suppresses Posit Connect deployment task
+  output. (#1051)
+
+* `deployApp(logLevel = "quiet")` and `writeManifest(quiet=TRUE)` suppress
+  output when using renv to analyze dependencies. (#1051)
+
 # rsconnect 1.2.2
 
 * Use internally computed SHA1 sums and PKI signing when SHA1 is disabled 

diff --git a/R/bundlePackage.R b/R/bundlePackage.R
@@ -63,7 +63,7 @@ computePackageDependencies <- function(bundleDir,
   } else {
     taskStart(quiet, "Capturing R dependencies with renv")
     # TODO: give user option to choose between implicit and explicit
-    deps <- snapshotRenvDependencies(bundleDir, extraPackages, verbose = verbose)
+    deps <- snapshotRenvDependencies(bundleDir, extraPackages, quiet = quiet, verbose = verbose)
   }
   taskComplete(quiet, "Found {nrow(deps)} dependenc{?y/ies}")
 

diff --git a/R/bundlePackageRenv.R b/R/bundlePackageRenv.R
@@ -1,5 +1,6 @@
 snapshotRenvDependencies <- function(bundleDir,
                                      extraPackages = character(),
+                                     quiet = FALSE,
                                      verbose = FALSE) {
   recordExtraDependencies(bundleDir, extraPackages)
 
@@ -20,7 +21,11 @@ snapshotRenvDependencies <- function(bundleDir,
 
   # analyze code dependencies ourselves rather than relying on the scan during renv::snapshot, as
   # that will add renv to renv.lock as a dependency.
-  deps <- renv::dependencies(bundleDir, root = bundleDir, progress = FALSE)
+  deps <- renv::dependencies(
+    bundleDir,
+    root = bundleDir,
+    quiet = if (quiet) TRUE else NULL,
+    progress = FALSE)
   renv::snapshot(bundleDir, packages = deps$Package, prompt = FALSE)
   defer(removeRenv(bundleDir))
 

diff --git a/R/client-connect.R b/R/client-connect.R
@@ -1,5 +1,11 @@
 # Docs: https://docs.posit.co/connect/api/
 
+stripConnectTimestamps <- function(messages) {
+  # Strip timestamps, if found
+  timestamp_re <- "^\\d{4}/\\d{2}/\\d{2} \\d{2}:\\d{2}:\\d{2}\\.\\d{3,} "
+  gsub(timestamp_re, "", messages)
+}
+
 connectClient <- function(service, authInfo) {
   list(
 
@@ -113,23 +119,22 @@ connectClient <- function(service, authInfo) {
       POST_JSON(service, authInfo, path, list())
     },
 
-    waitForTask = function(taskId, quiet) {
+    waitForTask = function(taskId, quiet = FALSE) {
       start <- 0
       while (TRUE) {
         path <- paste0(file.path("/tasks", taskId), "?first_status=", start)
         response <- GET(service, authInfo, path)
 
         if (length(response$status) > 0) {
-          messages <- unlist(response$status)
-
-          # Strip timestamps, if found
-          timestamp_re <- "\\d{4}/\\d{2}/\\d{2} \\d{2}:\\d{2}:\\d{2}\\.\\d{3,} "
-          messages <- gsub(timestamp_re, "", messages)
-
-          # Made headers more prominent.
-          heading <- grepl("^# ", messages)
-          messages[heading] <- cli::style_bold(messages[heading])
-          cat(paste0(messages, "\n", collapse = ""))
+          if (!quiet) {
+            messages <- unlist(response$status)
+            messages <- stripConnectTimestamps(messages)
+
+            # Made headers more prominent.
+            heading <- grepl("^# ", messages)
+            messages[heading] <- cli::style_bold(messages[heading])
+            cat(paste0(messages, "\n", collapse = ""))
+          }
 
           start <- response$last_status
         }

diff --git a/tests/testthat/_snaps/client-connect.md b/tests/testthat/_snaps/client-connect.md
@@ -0,0 +1,46 @@
+# leading timestamps are stripped
+
+    Code
+      stripConnectTimestamps(c(
+        "2024/04/24 13:08:04.901698921 [rsc-session] Content GUID: 3bfbd98a-6d6d-41bd-a15f-cab52025742f",
+        "2024/04/24 13:08:04.901734307 [rsc-session] Content ID: 43888",
+        "2024/04/24 13:08:04.901742487 [rsc-session] Bundle ID: 94502",
+        "2024/04/24 13:08:04.901747536 [rsc-session] Variant ID: 6465"))
+    Output
+      [1] "[rsc-session] Content GUID: 3bfbd98a-6d6d-41bd-a15f-cab52025742f"
+      [2] "[rsc-session] Content ID: 43888"                                 
+      [3] "[rsc-session] Bundle ID: 94502"                                  
+      [4] "[rsc-session] Variant ID: 6465"                                  
+
+# non-leading timestamps remain
+
+    Code
+      stripConnectTimestamps(c(
+        "this message has a timestamp 2024/04/24 13:08:04.901698921 within a line"))
+    Output
+      [1] "this message has a timestamp 2024/04/24 13:08:04.901698921 within a line"
+
+# messages without recognized timestamps are unmodified
+
+    Code
+      stripConnectTimestamps(c("this message has no timestamp",
+        "2024/04/24 13:08 this message timestamp has a different format"))
+    Output
+      [1] "this message has no timestamp"                                 
+      [2] "2024/04/24 13:08 this message timestamp has a different format"
+
+# waitForTask
+
+    Code
+      invisible(client$waitForTask(101, quiet = FALSE))
+    Output
+      [rsc-session] Content GUID: 3bfbd98a-6d6d-41bd-a15f-cab52025742f
+      [rsc-session] Content ID: 43888
+      [rsc-session] Bundle ID: 94502
+      [rsc-session] Variant ID: 6465
+
+---
+
+    Code
+      invisible(client$waitForTask(42, quiet = TRUE))
+
diff --git a/tests/testthat/test-client-connect.R b/tests/testthat/test-client-connect.R
@@ -1,3 +1,77 @@
+test_that("leading timestamps are stripped", {
+  expect_snapshot(
+    stripConnectTimestamps(
+      c(
+        "2024/04/24 13:08:04.901698921 [rsc-session] Content GUID: 3bfbd98a-6d6d-41bd-a15f-cab52025742f",
+        "2024/04/24 13:08:04.901734307 [rsc-session] Content ID: 43888",
+        "2024/04/24 13:08:04.901742487 [rsc-session] Bundle ID: 94502",
+        "2024/04/24 13:08:04.901747536 [rsc-session] Variant ID: 6465"
+      )
+    )
+  )
+})
+
+test_that("non-leading timestamps remain", {
+  expect_snapshot(
+    stripConnectTimestamps(
+      c(
+        "this message has a timestamp 2024/04/24 13:08:04.901698921 within a line"
+      )
+    )
+  )
+})
+
+test_that("messages without recognized timestamps are unmodified", {
+  expect_snapshot(
+    stripConnectTimestamps(
+      c(
+        "this message has no timestamp",
+        "2024/04/24 13:08 this message timestamp has a different format"
+      )
+    )
+  )
+})
+
+test_that("waitForTask", {
+  task_app <- webfakes::new_app()
+  task_app$use(webfakes::mw_json())
+  task_app$get("/tasks/:id", function(req, res) {
+    res$set_status(200L)$send_json(
+      list(
+        id = I(req$params$id),
+        user_id = I(42),
+        status = c(
+          "2024/04/24 13:08:04.901698921 [rsc-session] Content GUID: 3bfbd98a-6d6d-41bd-a15f-cab52025742f",
+          "2024/04/24 13:08:04.901734307 [rsc-session] Content ID: 43888",
+          "2024/04/24 13:08:04.901742487 [rsc-session] Bundle ID: 94502",
+          "2024/04/24 13:08:04.901747536 [rsc-session] Variant ID: 6465"
+        ),
+        result = NULL,
+        finished = TRUE,
+        code = 0,
+        error = "",
+        last_status = 4
+      ), auto_unbox = TRUE
+    )
+  })
+  app <- webfakes::new_app_process(task_app)
+  service <- parseHttpUrl(app$url())
+
+  authInfo <- list(
+    secret = NULL,
+    private_key = NULL,
+    apiKey = "the-api-key",
+    protocol = "https",
+    certificate = NULL
+  )
+  client <- connectClient(service, authInfo)
+
+  # task messages are logged when not quiet.
+  expect_snapshot(invisible(client$waitForTask(101, quiet = FALSE)))
+  # task messages are not logged when quiet.
+  expect_snapshot(invisible(client$waitForTask(42, quiet = TRUE)))
+})
+
 # NOTE: These tests expect that you're already running connect; the tests
 # will speak to that running connect process (if it can find it)
 findConnect <- function() {