Expose request timing (#735)

Author: arcresu

NAMESPACE

@@ -131,6 +131,7 @@ export(resp_stream_is_complete)
 export(resp_stream_lines)
 export(resp_stream_raw)
 export(resp_stream_sse)
+export(resp_timing)
 export(resp_url)
 export(resp_url_path)
 export(resp_url_queries)

NEWS.md

@@ -1,5 +1,6 @@
 # httr2 (development version)
 
+* `resp_timing()` exposes timing information about the request measured by libcurl (@arcresu, #725).
 * `req_url_query()` now re-calculates n lengths when using `.multi = "explode"` to avoid select/recycling issues (@Kevanness, #719).
 
 # httr2 1.1.2

R/resp-timing.R

@@ -0,0 +1,24 @@
+#' Extract timing data
+#'
+#' The underlying curl library measures how long different components of the
+#' request take to complete. This function retrieves that information.
+#'
+#' @inheritParams resp_header
+#' @returns Named numeric vector of timing information.
+#'  The names of the elements in this vector correspond to the names used
+#'  in [libcurl's `curl_easy_getinfo()` API][curl docs].
+#'  The most useful component is likely `"total"` (corresponding to
+#'  `CURLINFO_TOTAL_TIME`), the overall time in seconds to complete the
+#'  request including any redirects followed.
+#'
+#'  [curl docs]: https://curl.se/libcurl/c/curl_easy_getinfo.html
+#' @export
+#' @examples
+#' req <- request(example_url())
+#' resp <- req_perform(req)
+#' resp_timing(resp)
+resp_timing <- function(resp) {
+  check_response(resp)
+
+  resp$timing
+}

R/resp.R

@@ -19,6 +19,8 @@
 #'   which will be parsed using the standard rules, or a named list.
 #' @param body Response, if any, contained in the response body.
 #'   For `response_json()`, a R data structure to serialize to JSON.
+#' @param timing A named numeric vector giving the time taken by various
+#'   components.
 #' @returns An HTTP response: an S3 list with class `httr2_response`.
 #' @export
 #' @examples
@@ -30,7 +32,8 @@ response <- function(
   url = "https://example.com",
   method = "GET",
   headers = list(),
-  body = raw()
+  body = raw(),
+  timing = NULL
 ) {
   check_number_whole(status_code, min = 100, max = 700)
   check_string(url)
@@ -43,7 +46,8 @@ response <- function(
     url = url,
     status_code = as.integer(status_code),
     headers = headers,
-    body = body
+    body = body,
+    timing = timing
   )
 }
 
@@ -76,13 +80,17 @@ new_response <- function(
   status_code,
   headers,
   body,
+  timing = NULL,
   request = NULL,
   error_call = caller_env()
 ) {
   check_string(method, call = error_call)
   check_string(url, call = error_call)
   check_number_whole(status_code, call = error_call)
   check_request(request, allow_null = TRUE)
+  if (!is.null(timing) && !is_bare_numeric(timing)) {
+    stop_input_type(timing, "a numeric vector", allow_null = TRUE)
+  }
 
   headers <- as_headers(headers, error_call = error_call)
   # ensure we always have a date field
@@ -97,6 +105,7 @@ new_response <- function(
       status_code = status_code,
       headers = headers,
       body = body,
+      timing = timing,
       request = request,
       cache = new_environment()
     ),
@@ -111,6 +120,7 @@ create_response <- function(req, curl_data, body) {
     status_code = curl_data$status_code,
     headers = as_headers(curl_data$headers),
     body = body,
+    timing = curl_data$times,
     request = req
   )
 

man/resp_timing.Rd

@@ -9,6 +9,9 @@ test_that("successful request returns expected response", {
   expect_s3_class(resp$headers, "httr2_headers")
   expect_type(resp$body, "raw")
   expect_equal(resp$request, req)
+
+  expect_type(resp$timing, "double")
+  expect_true(all(resp$timing >= 0))
 })
 
 test_that("request updates last_response()", {

man/response.Rd

@@ -0,0 +1,4 @@
+test_that("can extract request timing", {
+  req <- response(timing = c(total = 1))
+  expect_equal(resp_timing(req), c(total = 1))
+})