Merge commit 'a241b04b079c5a76a04e5ac449c0612c99e0fd00'

NAMESPACE

@@ -60,6 +60,7 @@ export(req_body_multipart)
 export(req_body_raw)
 export(req_cache)
 export(req_cookie_preserve)
+export(req_cookies_set)
 export(req_dry_run)
 export(req_error)
 export(req_headers)

NEWS.md

@@ -1,5 +1,8 @@
 # httr2 (development version)
 
+* New `req_cookie_set()` allows you to set client side cookies (#369).
+* `req_body_file()` no longer leaks a connection if the response doesn't complete succesfully (#534).
+* `req_perform()` no longer displays a progress bar when sleeping during tests. You can override this behaviour by setting the option `httr2_progress`.
 * `req_cache()` now re-caches the response if the body is hasn't been modified but the headers have changed (#442).
 * `req_cache()` works better when `req_perform()` sets a path (#442).
 * `req_body_*()` now give informative error if you attempt to change the body type (#451).

R/curl.R

@@ -197,7 +197,7 @@ curl_data <- function(x, binary = FALSE, raw = FALSE) {
 }
 
 # Format described at <http://docopt.org>
-curl_opts <- "Usage: curl [<url>] [-H <header> ...] [options] [<url>]
+curl_opts <- "Usage: curl [<url>] [-H <header> ...] [-d <data> ...] [options] [<url>]
       --basic                  (IGNORED)
       --compressed             (IGNORED)
       --digest                 (IGNORED)

R/multi-req.R

@@ -147,6 +147,7 @@ pool_run <- function(pool, perfs, on_error = "continue") {
 # Wrap up all components of request -> response in a single object
 Performance <- R6Class("Performance", public = list(
   req = NULL,
+  req_prep = NULL,
   path = NULL,
 
   handle = NULL,
@@ -166,6 +167,7 @@ Performance <- R6Class("Performance", public = list(
     if (is_response(req)) {
       self$resp <- req
     } else {
+      self$req_prep <- req_prepare(req)
       self$handle <- req_handle(req)
       curl::handle_setopt(self$handle, url = req$url)
     }
@@ -190,6 +192,7 @@ Performance <- R6Class("Performance", public = list(
 
   succeed = function(res) {
     self$progress$update()
+    req_completed(self$req_prep)
 
     if (is.null(self$path)) {
       body <- res$content
@@ -220,6 +223,7 @@ Performance <- R6Class("Performance", public = list(
 
   fail = function(msg) {
     self$progress$update()
+    req_completed(self$req_prep)
 
     self$resp <- error_cnd(
       "httr2_failure",

R/req-body.R

@@ -229,35 +229,17 @@ req_body_apply <- function(req) {
 
   if (type == "raw-file") {
     size <- file.info(data)$size
-    done <- FALSE
     # Only open connection if needed
     delayedAssign("con", file(data, "rb"))
 
-    # Leaks connection if request doesn't complete
-    readfunction <- function(nbytes, ...) {
-      if (done) {
-        return(raw())
-      }
-      out <- readBin(con, "raw", nbytes)
-      if (length(out) < nbytes) {
-        close(con)
-        done <<- TRUE
-        con <<- NULL
-      }
-      out
-    }
-    seekfunction <- function(offset, ...) {
-      if (done) {
-        con <<- file(data, "rb")
-        done <<- FALSE
-      }
-      seek(con, where = offset)
-    }
-
+    req <- req_policies(
+      req,
+      done = function() close(con)
+    )
     req <- req_options(req,
       post = TRUE,
-      readfunction = readfunction,
-      seekfunction = seekfunction,
+      readfunction = function(nbytes, ...) readBin(con, "raw", nbytes),
+      seekfunction = function(offset, ...) seek(con, where = offset),
       postfieldsize_large = size
     )
   } else if (type == "raw") {

R/req-cookies.R

@@ -1,37 +1,68 @@
-#' Preserve cookies across requests
+#' Set and preserve cookies
+#'
+#' @description
+#' Use `req_cookie_set()` to set client side cookies that are sent to the
+#' server.
 #'
 #' By default, httr2 uses a clean slate for every request meaning that cookies
-#' are not automatically preserved across requests. To preserve cookies, you
-#' must set a cookie file which will be read before and updated after each
-#' request.
+#' are not automatically preserved across requests. To preserve cookies, use
+#' `req_cookie_preserve()` along with the path to cookie file that will be
+#' read before and updated after each request.
 #'
 #' @inheritParams req_perform
 #' @param path A path to a file where cookies will be read from before and updated after the request.
 #' @export
 #' @examples
+#' # Use `req_cookies_set()` to set client-side cookies
+#' request(example_url()) |>
+#'   req_cookies_set(a = 1, b = 1) |>
+#'   req_dry_run()
+#'
+#' # Use `req_cookie_preserve()` to preserve server-side cookies across requests
 #' path <- tempfile()
-#' httpbin <- request(example_url()) |>
-#'   req_cookie_preserve(path)
 #'
-#' # Manually set two cookies
-#' httpbin |>
+#' # Set a server-side cookie
+#' request(example_url()) |>
+#'   req_cookie_preserve(path) |>
 #'   req_template("/cookies/set/:name/:value", name = "chocolate", value = "chip") |>
 #'   req_perform() |>
 #'   resp_body_json()
 #'
-#' httpbin |>
+#' # Set another sever-side cookie
+#' request(example_url()) |>
+#'   req_cookie_preserve(path) |>
 #'   req_template("/cookies/set/:name/:value", name = "oatmeal", value = "raisin") |>
 #'   req_perform() |>
 #'   resp_body_json()
 #'
+#' # Add a client side cookie
+#' request(example_url()) |>
+#'   req_url_path("/cookies/set") |>
+#'   req_cookie_preserve(path) |>
+#'   req_cookies_set(snicker = "doodle") |>
+#'   req_perform() |>
+#'   resp_body_json()
+#'
 #' # The cookie path has a straightforward format
 #' cat(readChar(path, nchars = 1e4))
 req_cookie_preserve <- function(req, path) {
   check_request(req)
   check_string(path, allow_empty = FALSE)
 
-  req_options(req,
-    cookiejar = path,
-    cookiefile = path
-  )
+  req_options(req, cookiejar = path, cookiefile = path)
+}
+
+#' @export
+#' @rdname req_cookie_preserve
+#' @param ... <[`dynamic-dots`][rlang::dyn-dots]>
+#'   Name-value pairs that define query parameters. Each value must be
+#'   an atomic vector, which is automatically escaped. To opt-out of escaping,
+#'   wrap strings in `I()`.
+req_cookies_set <- function(req, ...) {
+  check_request(req)
+  req_options(req, cookie = cookies_build(list2(...)))
+}
+
+cookies_build <- function(x, error_call = caller_env()) {
+  elements_build(x, "Cookies", ";", error_call = error_call)
 }

R/req-perform-connection.R

@@ -37,7 +37,8 @@ req_perform_connection <- function(req, blocking = TRUE) {
   check_request(req)
   check_bool(blocking)
 
-  handle <- req_handle(req)
+  req_prep <- req_prepare(req)
+  handle <- req_handle(req_prep)
   the$last_request <- req
   the$last_response <- NULL
 
@@ -62,6 +63,7 @@ req_perform_connection <- function(req, blocking = TRUE) {
       break
     }
   }
+  req_completed(req)
 
   if (error_is_error(req, resp)) {
     # Read full body if there's an error

R/req-perform-stream.R

@@ -39,7 +39,6 @@ req_perform_stream <- function(req,
                                round = c("byte", "line")) {
   check_request(req)
 
-  handle <- req_handle(req)
   check_function(callback)
   check_number_decimal(timeout_sec, min = 0)
   check_number_decimal(buffer_kb, min = 0)

R/req-perform.R

@@ -94,7 +94,8 @@ req_perform <- function(
     return(req)
   }
 
-  handle <- req_handle(req)
+  req_prep <- req_prepare(req)
+  handle <- req_handle(req_prep)
   max_tries <- retry_max_tries(req)
   deadline <- Sys.time() + retry_max_seconds(req)
 
@@ -122,14 +123,16 @@ req_perform <- function(
         )
       }
     )
+    req_completed(req_prep)
 
     if (is_error(resp)) {
       tries <- tries + 1
       delay <- retry_backoff(req, tries)
     } else if (!reauth && resp_is_invalid_oauth_token(req, resp)) {
       reauth <- TRUE
       req <- auth_oauth_sign(req, TRUE)
-      handle <- req_handle(req)
+      req_prep <- req_prepare(req)
+      handle <- req_handle(req_prep)
       delay <- 0
     } else if (retry_is_transient(req, resp)) {
       tries <- tries + 1
@@ -258,6 +261,7 @@ req_dry_run <- function(req, quiet = FALSE, redact_headers = TRUE) {
     req <- req_options(req, debugfunction = debug, verbose = TRUE)
   }
 
+  req <- req_prepare(req)
   handle <- req_handle(req)
   curl::handle_setopt(handle, url = req$url)
   resp <- curl::curl_echo(handle, progress = FALSE)
@@ -269,14 +273,19 @@ req_dry_run <- function(req, quiet = FALSE, redact_headers = TRUE) {
   ))
 }
 
-req_handle <- function(req) {
+# Must call req_prepare(), then req_handle(), then after the request has been
+# performed, req_completed()
+req_prepare <- function(req) {
   req <- req_method_apply(req)
   req <- req_body_apply(req)
 
   if (!has_name(req$options, "useragent")) {
     req <- req_user_agent(req)
   }
 
+  req
+}
+req_handle <- function(req) {
   handle <- curl::new_handle()
   curl::handle_setheaders(handle, .list = headers_flatten(req$headers))
   curl::handle_setopt(handle, .list = req$options)
@@ -286,6 +295,9 @@ req_handle <- function(req) {
 
   handle
 }
+req_completed <- function(req) {
+  req_policy_call(req, "done", list(), NULL)
+}
 
 new_path <- function(x) structure(x, class = "httr2_path")
 is_path <- function(x) inherits(x, "httr2_path")

R/url.R

@@ -165,8 +165,12 @@ query_parse <- function(x) {
 }
 
 query_build <- function(x, error_call = caller_env()) {
+  elements_build(x, "Query", "&", error_call = error_call)
+}
+
+elements_build <- function(x, name, collapse, error_call = caller_env()) {
   if (!is_list(x) || (!is_named(x) && length(x) > 0)) {
-    cli::cli_abort("Query must be a named list.", call = error_call)
+    cli::cli_abort("{name} must be a named list.", call = error_call)
   }
 
   x <- compact(x)
@@ -177,7 +181,7 @@ query_build <- function(x, error_call = caller_env()) {
   values <- map2_chr(x, names(x), format_query_param, error_call = error_call)
   names <- curl::curl_escape(names(x))
 
-  paste0(names, "=", values, collapse = "&")
+  paste0(names, "=", values, collapse = collapse)
 }
 
 format_query_param <- function(x,

R/utils.R

@@ -43,11 +43,12 @@ modify_list <- function(.x, ..., error_call = caller_env()) {
 }
 
 
-sys_sleep <- function(seconds,
-                      task,
-                      fps = 10,
-                      progress = getOption("httr2_progress", TRUE)) {
+sys_sleep <- function(seconds, task, fps = 10, progress = NULL) {
   check_number_decimal(seconds)
+  check_string(task)
+  check_number_decimal(fps)
+  progress <- progress %||% getOption("httr2_progress", !is_testing())
+  check_bool(progress, allow_null = TRUE)
 
   if (seconds == 0) {
     return(invisible())