diff --git a/paws.common/NEWS.md b/paws.common/NEWS.md index 0a03effce..f3a5aaf41 100644 --- a/paws.common/NEWS.md +++ b/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) diff --git a/paws.common/R/client.R b/paws.common/R/client.R index 58a6a0e0a..df2427ade 100644 --- a/paws.common/R/client.R +++ b/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, diff --git a/paws.common/R/net.R b/paws.common/R/net.R index 6549ee28c..802acc2dc 100644 --- a/paws.common/R/net.R +++ b/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") diff --git a/paws.common/R/request.R b/paws.common/R/request.R index 791d765ff..fdd2665b3 100644 --- a/paws.common/R/request.R +++ b/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 ) diff --git a/paws.common/tests/testthat/test_net.R b/paws.common/tests/testthat/test_net.R index e756b264b..412ca2073 100644 --- a/paws.common/tests/testthat/test_net.R +++ b/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)