From 4c2887bf8d311c2d1c3a9a5f7abf663252767007 Mon Sep 17 00:00:00 2001
From: Hadley Wickham <h.wickham@gmail.com>
Date: Wed, 10 Jul 2024 09:36:13 +0200
Subject: [PATCH 1/2] Only open connection when needed

Fixes #487
---
 NEWS.md                         |  1 +
 R/req-body.R                    | 30 +++++++++++++++++++-----------
 tests/testthat/test-multi-req.R |  8 ++++++++
 3 files changed, 28 insertions(+), 11 deletions(-)

diff --git a/NEWS.md b/NEWS.md
index a23402720..bdcaaf5bb 100644
--- a/NEWS.md
+++ b/NEWS.md
@@ -1,5 +1,6 @@
 # httr2 (development version)
 
+* `req_body_file()` now only opens a connection when the request actually needs data. In particular, this makes it work better with `req_perform_parallel()` (#487).
 * Corrupt `rds` files no longer cause the request to fail.
 
 # httr2 1.0.1
diff --git a/R/req-body.R b/R/req-body.R
index e3f176cea..8b52a035a 100644
--- a/R/req-body.R
+++ b/R/req-body.R
@@ -203,23 +203,31 @@ req_body_apply <- function(req) {
 
   if (type == "raw-file") {
     size <- file.info(data)$size
-    con <- file(data, "rb")
+    started <- FALSE
+    done <- FALSE
+    con <- NULL
+
     # Leaks connection if request doesn't complete
     readfunction <- function(nbytes, ...) {
-      if (is.null(con)) {
-        raw()
-      } else {
-        out <- readBin(con, "raw", nbytes)
-        if (length(out) < nbytes) {
-          close(con)
-          con <<- NULL
-        }
-        out
+      if (!started) {
+        con <<- file(data, "rb")
+        started <<- TRUE
+      } else if (done) {
+        return(raw())
+      }
+      out <- readBin(con, "raw", nbytes)
+      if (length(out) <= nbytes) {
+        close(con)
+        done <<- TRUE
+        con <<- NULL
       }
+      out
     }
     seekfunction <- function(offset, ...) {
-      if (is.null(con)) {
+      if (done) {
         con <<- file(data, "rb")
+        started <<- TRUE
+        done <<- FALSE
       }
       seek(con, where = offset)
     }
diff --git a/tests/testthat/test-multi-req.R b/tests/testthat/test-multi-req.R
index e38dde8e8..b49ce49cc 100644
--- a/tests/testthat/test-multi-req.R
+++ b/tests/testthat/test-multi-req.R
@@ -21,6 +21,14 @@ test_that("requests happen in parallel", {
   expect_lt(time[[3]], 1)
 })
 
+test_that("can perform >128 file uploads in parallel", {
+  temp <- withr::local_tempfile(lines = letters)
+  req <- request(example_url()) |> req_body_file(temp)
+  reqs <- rep(list(req), 150)
+  
+  expect_no_error(req_perform_parallel(reqs, on_error = "continue"))
+})
+
 test_that("can download files", {
   reqs <- list(request_test("/json"), request_test("/html"))
   paths <- c(withr::local_tempfile(), withr::local_tempfile())

From 90df03f3de469468280f36d27f23e2b342f70361 Mon Sep 17 00:00:00 2001
From: Hadley Wickham <h.wickham@gmail.com>
Date: Wed, 10 Jul 2024 09:58:12 +0200
Subject: [PATCH 2/2] Don't use base pipe

---
 tests/testthat/test-multi-req.R | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/tests/testthat/test-multi-req.R b/tests/testthat/test-multi-req.R
index b49ce49cc..1c95612bb 100644
--- a/tests/testthat/test-multi-req.R
+++ b/tests/testthat/test-multi-req.R
@@ -23,7 +23,7 @@ test_that("requests happen in parallel", {
 
 test_that("can perform >128 file uploads in parallel", {
   temp <- withr::local_tempfile(lines = letters)
-  req <- request(example_url()) |> req_body_file(temp)
+  req <- request(example_url()) %>% req_body_file(temp)
   reqs <- rep(list(req), 150)
   
   expect_no_error(req_perform_parallel(reqs, on_error = "continue"))