Test server improvements

DESCRIPTION

@@ -38,6 +38,7 @@ Suggests:
     jsonlite,
     knitr,
     later (>= 1.4.0),
+    nanonext,
     paws.common,
     promises,
     rmarkdown,

R/resp-stream.R

@@ -306,7 +306,10 @@
       # again, they'll get the same error rather than reading the stream
       # having missed a bunch of bytes.
       resp$cache$push_back <- buffer
-      cli::cli_abort("Streaming read exceeded size limit of {max_size}")
+      cli::cli_abort(
+        "Streaming read exceeded size limit of {max_size}",
+        class = "httr2_streaming_error"
+      )
     }
 
     # We didn't have enough data. Attempt to read more

tests/testthat/helper-sync.R

@@ -0,0 +1,45 @@
+sync_req <- function(name = "default", .env = parent.frame()) {
+  skip_on_cran()
+  skip_if_not_installed("nanonext")
+
+  connected <- FALSE
+  cv <- nanonext::cv()
+  sock <- nanonext::socket("req")
+  withr::defer(nanonext::reap(sock), envir = .env)
+  nanonext::pipe_notify(sock, cv, add = TRUE)
+  nanonext::listen(sock, url = sprintf("ipc:///tmp/nanonext%s", name))
+
+  function(expr = {}, timeout = 1000L) {
+    if (!connected) {
+      nanonext::until_(cv, timeout) || stop("req connect: timed out")
+      connected <<- TRUE
+    }
+    ctx <- nanonext::.context(sock)
+    saio <- nanonext::send_aio(ctx, 0L, mode = 2L)
+    expr
+    r <- nanonext::recv_aio(ctx, mode = 8L, timeout = timeout)[]
+    nanonext::is_error_value(r) && stop("req sync: ", nanonext::nng_error(r))
+  }
+
+}
+
+sync_rep <- function(name = "default", .env = parent.frame()) {
+  connected <- FALSE
+  cv <- nanonext::cv()
+  sock <- nanonext::socket("rep")
+  nanonext::pipe_notify(sock, cv, add = TRUE)
+  withr::defer(nanonext::reap(sock), envir = .env)
+  nanonext::dial(sock, url = sprintf("ipc:///tmp/nanonext%s", name))
+
+  function(expr = {}, timeout = 1000L) {
+    if (!connected) {
+      nanonext::until_(cv, timeout) || stop("resp connect: timed out")
+      connected <<- TRUE
+    }
+    ctx <- nanonext::.context(sock)
+    r <- nanonext::recv_aio(ctx, mode = 8L, timeout = timeout)[]
+    nanonext::is_error_value(r) && stop("resp sync: ", nanonext::nng_error(r))
+    expr
+    nanonext::send(ctx, 0L, mode = 2L, block = TRUE)
+  }
+}

tests/testthat/helper-webfakes.R

@@ -6,7 +6,15 @@ local_app_request <- function(fun, method = "get", frame = parent.frame()) {
   }
 
   app <- webfakes::new_app()
+
+  app$locals$i <- 0
+  app$use(function(req, res) {
+    app$locals$i <- app$locals$i + 1
+    "next"
+  })
+
   app[[method]]("/test", fun)
+  app$locals$sync_rep <- sync_rep
   server <- webfakes::local_app_process(app, .local_envir = frame)
 
   req <- request(server$url("/test"))

tests/testthat/test-req-perform-connection.R

@@ -32,9 +32,7 @@ test_that("reads body on error", {
 
 test_that("can retry a transient error", {
   req <- local_app_request(function(req, res) {
-    i <- res$app$locals$i %||% 1
-    if (i == 1) {
-      res$app$locals$i <- 2
+    if (res$app$locals$i == 1) {
       res$
         set_status(429)$
         set_header("retry-after", 0)$

tests/testthat/test-req-perform-parallel.R

@@ -167,9 +167,7 @@ test_that("requests are throttled", {
 
 test_that("can retry an OAuth failure", {
   req <- local_app_request(function(req, res) {
-    i <- res$app$locals$i %||% 1
-    if (i == 1) {
-      res$app$locals$i <- 2
+    if (res$app$locals$i == 1) {
       res$
         set_status(401)$
         set_header("WWW-Authenticate", 'Bearer realm="example", error="invalid_token"')$
@@ -206,9 +204,7 @@ test_that("but multiple failures causes an error", {
 
 test_that("can retry a transient error", {
   req <- local_app_request(function(req, res) {
-    i <- res$app$locals$i %||% 1
-    if (i == 1) {
-      res$app$locals$i <- 2
+    if (res$app$locals$i == 1) {
       res$
         set_status(429)$
         set_header("retry-after", 2)$

tests/testthat/test-req-perform.R

@@ -71,9 +71,7 @@ test_that("don't retry curl errors by default", {
 
 test_that("can retry a transient error", {
   req <- local_app_request(function(req, res) {
-    i <- res$app$locals$i %||% 1
-    if (i == 1) {
-      res$app$locals$i <- 2
+    if (res$app$locals$i == 1) {
       res$
         set_status(429)$
         set_header("retry-after", 0)$