split timeout and connect_timeout (#610)

paws.common/NEWS.md

@@ -1,5 +1,6 @@
 # paws.common 0.5.8
 * fix mismatch apparent method as.list.struct (#634)
+* split timeout and connecttimeout in http call (#610). Thanks to @stuart-storypark for identifying issue, and @joakibo for extra insight and testing.
 
 # paws.common 0.5.7
 * skip network unit test on cran (#632)

paws.common/R/client.R

@@ -13,7 +13,7 @@ Config <- struct(
   disable_ssl = FALSE,
   close_connection = FALSE,
   max_retries = -1,
-  timeout = 60,
+  connect_timeout = 60,
   retryer = NULL,
   disable_param_validation = FALSE,
   disable_compute_checksums = FALSE,

paws.common/R/net.R

@@ -23,6 +23,7 @@ HttpRequest <- struct(
   request_uri = "",
   tls = NULL,
   cancel = NULL,
+  connect_timeout = NULL,
   timeout = NULL,
   response = NULL,
   ctx = list(),
@@ -53,10 +54,11 @@ HttpResponse <- struct(
 # @param url The URL to send the request to.
 # @param body The body to send in the request, in bytes.
 # @param close Whether to immediately close the connection, or else reuse connections.
-# @param timeout How long to wait for an initial response.
+# @param connect_timeout How long to wait for an initial response.
+# @param timeout Timeout for the entire request.
 # @param dest Control where the response body is written
 # @param header list of HTTP headers to add to the request
-new_http_request <- function(method, url, body = NULL, close = FALSE, timeout = NULL, dest = NULL, header = list()) {
+new_http_request <- function(method, url, body = NULL, close = FALSE, connect_timeout = NULL, timeout = NULL, dest = NULL, header = list()) {
   if (method == "") {
     method <- "GET"
   }
@@ -74,6 +76,7 @@ new_http_request <- function(method, url, body = NULL, close = FALSE, timeout =
     body = body,
     host = u$host,
     close = close,
+    connect_timeout = connect_timeout,
     timeout = timeout,
     dest = dest
   )
@@ -104,8 +107,12 @@ issue <- function(http_request) {
     headers["Connection"] <- "close"
   }
   body <- http_request$body
-  timeout <- httr::config(connecttimeout = http_request$timeout)
-  if (is.null(http_request$timeout)) timeout <- NULL
+
+  timeout_config <- Filter(
+    Negate(is.null),
+    list(connecttimeout = http_request$connect_timeout, timeout = http_request$timeout)
+  )
+  timeout <- do.call(httr::config, timeout_config)
 
   if (url == "") {
     stop("no url provided")

paws.common/R/request.R

@@ -114,7 +114,7 @@ new_request <- function(client, operation, params, data, dest = NULL) {
     url = "",
     body = NULL,
     close = client$config$close_connection,
-    timeout = client$config$timeout,
+    connect_timeout = client$config$connect_timeout,
     dest = dest
   )
 

paws.common/tests/testthat/test_net.R

@@ -16,6 +16,19 @@ test_that("issue", {
   }
 })
 
+test_that("connect_timeout", {
+  req <- HttpRequest(
+    method = "GET",
+    url = parse_url("https://example.com:81"),
+    connect_timeout = 1
+  )
+  quietly <- function(expr) suppressMessages(tryCatch(expr, error = function(e) {}))
+  time <- system.time({
+    quietly(issue(req))
+  })
+  expect_equivalent(time["elapsed"], 1, tolerance = 0.5)
+})
+
 test_that("timeout", {
   req <- HttpRequest(
     method = "GET",
@@ -29,14 +42,14 @@ test_that("timeout", {
   expect_equivalent(time["elapsed"], 1, tolerance = 0.5)
 })
 
-test_that("timeout does not affect established connections", {
+test_that("connect_timeout does not affect established connections", {
   # Avoid CRAN check errors due to unavailable network resources.
   skip_on_cran()
 
   req <- HttpRequest(
     method = "GET",
     url = parse_url("https://httpbin.org/delay/3"),
-    timeout = 1
+    connect_timeout = 1
   )
   resp <- issue(req)