Merge branch 'main' into pkg_support

* main:
  chore: Migrate `{httr}` to `{httr2}` (#420)

Author: schloerke

DESCRIPTION

@@ -29,7 +29,7 @@ Imports:
     cli,
     fs,
     globals (>= 0.14.0),
-    httr,
+    httr2,
     jsonlite,
     lifecycle (>= 1.0.3),
     pingr,
@@ -97,7 +97,7 @@ Collate:
     'cpp11.R'
     'expect-snapshot.R'
     'expr-recurse.R'
-    'httr.R'
+    'httr2.R'
     'migrate.R'
     'missing-value.R'
     'utils.R'

NEWS.md

@@ -6,6 +6,8 @@
 
 * Fixed internal bug where `{testthat}` v3.3.0 changed expectation behavior for screenshot snapshots within `App$expect_values()` (#418).
 
+* Migrated from `{httr}` to `{httr2}` for all HTTP requests made by `{shinytest2}` (#420).
+
 # shinytest2 0.4.1
 
 ## Bug

R/R6-helper.R

@@ -1,5 +1,6 @@
-
-Count <- R6Class( # nolint
+# nolint start
+Count <- R6Class(
+  # nolint end
   "Count",
   private = list(
     count = 0
@@ -16,7 +17,8 @@ Count <- R6Class( # nolint
 )
 
 app_next_temp_snapshot_path <- function(
-  self, private,
+  self,
+  private,
   name, # full path or filename
   ext = "json"
 ) {
@@ -36,7 +38,9 @@ app_next_temp_snapshot_path <- function(
 }
 
 
-Url <- R6Class( # nolint
+# nolint start
+Url <- R6Class(
+  # nolint end
   "Url",
   private = list(
     url = NULL
@@ -46,9 +50,27 @@ Url <- R6Class( # nolint
       private$url
     },
     set = function(url) {
-      res <- httr::parse_url(url)
+      res <- tryCatch(
+        httr2::url_parse(url),
+        error = function(e) {
+          # httr2::url_parse() uses curl underneath which is stricter
+          # Convert parsing errors to validation errors
+          if (grepl("Port number", e$message)) {
+            warning(e$message)
+            stop("Assertion on 'url port' failed")
+          }
+          if (grepl("parse URL", e$message)) {
+            stop("Assertion on 'url hostname' failed: Must be a single string")
+          }
+          stop(e)
+        }
+      )
 
-      checkmate::assert_subset(res$scheme, c("http", "https"), .var.name = "url scheme")
+      checkmate::assert_subset(
+        res$scheme,
+        c("http", "https"),
+        .var.name = "url scheme"
+      )
 
       if (!is.null(res$port)) {
         res$port <- as.integer(res$port)
@@ -57,7 +79,7 @@ Url <- R6Class( # nolint
 
       ckm8_assert_single_string(res$hostname, .var.name = "url hostname")
 
-      private$url <- httr::build_url(res)
+      private$url <- httr2::url_build(res)
 
       invisible(self)
     }

R/app-driver-expect-download.R

@@ -20,10 +20,10 @@ app_download <- function(
 
   # Add the base location to the URL
   full_url <- paste0(private$shiny_url$get(), sub_url)
-  req <- app_httr_get(self, private, full_url)
+  req <- app_httr2_get(self, private, full_url)
 
   # Find suggested name
-  content_dispo <- httr::headers(req)[["content-disposition"]]
+  content_dispo <- httr2::resp_headers(req)[["content-disposition"]]
   filename_header <- NULL
   if (
     length(content_dispo) == 1 &&
@@ -75,7 +75,7 @@ app_download <- function(
     fs::path_sanitize(filename, "_")
   )
   # Save contents
-  writeBin(req$content, download_path)
+  writeBin(httr2::resp_body_raw(req), download_path)
 
   list(
     download_path = download_path,

R/app-driver-expect-values.R

@@ -124,7 +124,7 @@ app_get_values <- function(
 
   # Ask Shiny for info
   cur_env <- rlang::current_env()
-  req <- app_httr_get(self, private, url, fn_404 = function(req) {
+  req <- app_httr2_get(self, private, url, fn_404 = function(req) {
     app_abort(
       self,
       private,
@@ -168,7 +168,7 @@ app_get_values <- function(
 
   tmpfile <- tempfile()
   on.exit(unlink(tmpfile), add = TRUE)
-  writeBin(req$content, tmpfile)
+  writeBin(httr2::resp_body_raw(req), tmpfile)
   values <- readRDS(tmpfile)
 
   if (hash_images) {
@@ -226,7 +226,7 @@ app_expect_values <- function(
   )
   # Ask Shiny for info
   cur_env <- rlang::current_env()
-  req <- app_httr_get(self, private, url, fn_404 = function(req) {
+  req <- app_httr2_get(self, private, url, fn_404 = function(req) {
     app_abort(
       self,
       private,
@@ -239,7 +239,7 @@ app_expect_values <- function(
   })
 
   # Convert to text, then replace base64-encoded images with hashes.
-  content <- raw_to_utf8(req$content)
+  content <- raw_to_utf8(httr2::resp_body_raw(req))
   # original_content <- content
   content <- hash_snapshot_image_data(content, is_json_file = TRUE)
   # Adjust the text to _pretty_ print

R/httr.R R/httr2.RR/httr.R renamed to R/httr2.R

@@ -1,42 +1,60 @@
-app_httr_get <- function(self, private, url, fn_404 = NULL) {
+app_httr2_get <- function(self, private, url, fn_404 = NULL) {
   ckm8_assert_app_driver(self, private)
 
-  pieces <- httr::parse_url(url)
+  pieces <- httr2::url_parse(url)
   # Add in port information if it's missing
   # https://github.com/rstudio/shinytest2/issues/158
   if (is.null(pieces$port)) {
     pieces$port <- switch(pieces$scheme, "http" = 80, "https" = 443)
   }
 
   if (!pingr::is_up(pieces$hostname, pieces$port, check_online = FALSE)) {
-    app_abort(self, private, "Could not find Shiny server. Shiny app is no longer running")
+    app_abort(
+      self,
+      private,
+      "Could not find Shiny server. Shiny app is no longer running"
+    )
   }
 
-  withCallingHandlers( # abort() on error
-    { # nolint
-      req <- httr::GET(url)
+  withCallingHandlers(
+    # abort() on error
+    {
+      # nolint
+      req <- httr2::request(url)
+      req <- httr2::req_error(req, is_error = function(resp) FALSE)
+      req <- httr2::req_perform(req)
     },
     # Attempt to capture empty reply error and provide better message
     error = function(e) {
       if (grepl("Empty reply from server", as.character(e), fixed = TRUE)) {
-        app_abort(self, private, "Empty reply received from Shiny server. Shiny app is no longer running", parent = e)
+        app_abort(
+          self,
+          private,
+          "Empty reply received from Shiny server. Shiny app is no longer running",
+          parent = e
+        )
       }
       # Unknown error, rethrow
       app_abort(self, private, e)
     }
   )
 
-  status <- httr::status_code(req)
+  status <- httr2::resp_status(req)
   if (status == 200) {
     return(req)
   }
   if (status == 404 && is.function(fn_404)) {
     return(fn_404(req))
   }
 
-  cat("{shinytest2} query failed (", status, ")----------------------\n", sep = "")
+  cat(
+    "{shinytest2} query failed (",
+    status,
+    ")----------------------\n",
+    sep = ""
+  )
   cat("URL: ", url, "\n", sep = "")
-  cat(httr::content(req, "text"), "\n")
+  cat(httr2::resp_body_string(req), "\n")
   cat("----------------------------------------\n")
   app_abort(self, private, "Unable request data from server")
 }

tests/testthat/apps/task-button/app.R

@@ -8,7 +8,6 @@ input_task_button <- yoink("bslib", "input_task_button")
 bind_task_button <- yoink("bslib", "bind_task_button")
 
 
-
 ui <- fluidPage(
   actionButton("run_normal", "Run normal"),
   textOutput("normal_result"),
@@ -26,13 +25,16 @@ server <- function(input, output, session) {
   task <- ExtendedTask$new(function() {
     promise(function(resolve, reject) {
       # Use later to simulate future promise calls
-      later(function() {
-        resolve(slow_function())
-        # Add extra time for extra checks
-      }, delay = 0.01)
+      later(
+        function() {
+          resolve(slow_function())
+          # Add extra time for extra checks
+        },
+        delay = 0.01
+      )
     })
-  }) |> bind_task_button("run_async")
-
+  }) |>
+    bind_task_button("run_async")
 
   # Normal
   observeEvent(input$run_normal, {

tests/testthat/test-save-app.R

@@ -4,6 +4,7 @@ require("shiny", quietly = TRUE, character.only = TRUE)
 test_that("Make sure global vars are set - issue303", {
   # Only run on CI. CRAN requires package to be installed to run `callr::rscript()
   skip_if(!on_ci(), "Only run on CI")
+  skip_on_os("windows")
 
   # Run the script in a global environment that does not polute this global environment
   p <- callr::rscript("scripts/issue_303.R", show = FALSE)
@@ -21,6 +22,7 @@ test_that("Make sure global vars are set - issue303", {
 test_that("Make sure global vars are set - pr307", {
   # Only run on CI. CRAN requires package to be installed to run `callr::rscript()
   skip_if(!on_ci(), "Only run on CI")
+  skip_on_os("windows")
 
   # Run the script in a global environment that does not polute this global environment
   p <- callr::rscript("scripts/pr_307.R", show = FALSE)
@@ -83,7 +85,6 @@ test_that("can run saved app", {
 })
 
 
-
 test_that("can get ui and server from app", {
   ui <- fluidPage("Hi!")
   server <- function(input, output, session) {

tests/testthat/test-url.R

@@ -1,6 +1,4 @@
-
 test_that("Url Class behaves as expected", {
-
   expect_url <- function(url, expected_url) {
     expect_equal(Url$new()$set(url)$get(), expected_url)
   }
@@ -15,11 +13,12 @@ test_that("Url Class behaves as expected", {
   expect_url("http://user@a.b.com/", "http://user@a.b.com/")
   expect_url("http://user:pass@a.b.com/", "http://user:pass@a.b.com/")
 
+  expect_url("http:/a.b.com/", "http://a.b.com/")
+
   # Malformed URLs, or non-http/https protocol
   expect_url_error <- function(url, ...) {
     expect_error(Url$new()$set(url), ...)
   }
-  expect_url_error("http:/a.b.com/", "url hostname")
   expect_warning(
     expect_url_error("http://a.b.com:12ab/", "url port")
   )