From 99036170351d1e284e9f071a50447a86760999ab Mon Sep 17 00:00:00 2001 From: "carpentry-heartbeat[bot]" Date: Sun, 31 May 2026 22:56:19 +0200 Subject: [PATCH 1/2] Add configurable request timeouts via Config type Introduce a Config type with connect-timeout and read-timeout fields (in seconds, 0 = no timeout). Add -with-config variants for all public request functions: request-with-config, request-stream-with-config, get-with-config, post-with-config, put-with-config, del-with-config, and patch-with-config. Connect-timeout uses TcpStream.connect-timeout for plain HTTP. Read-timeout uses set-timeout on both TcpStream and TlsStream. Also adds Connection.set-timeout as a dispatch helper. --- README.md | 30 ++++++ http-client.carp | 240 +++++++++++++++++++++++++++++++++++++++++- test/http-client.carp | 72 ++++++++++++- 3 files changed, 339 insertions(+), 3 deletions(-) diff --git a/README.md b/README.md index bb2eec7..152678e 100644 --- a/README.md +++ b/README.md @@ -44,6 +44,22 @@ without OpenSSL. "{}") ``` +### Timeouts + +Create a `Config` to set connect and read timeouts (in seconds): + +```clojure +(let [cfg (Config.init 5 10)] ; 5s connect, 10s read + (match (Client.get-with-config "https://example.com/" &cfg) + (Result.Success r) (println* (Response.body &r)) + (Result.Error e) (IO.errorln &e))) +``` + +All `-with-config` variants accept a `&Config` as the last argument. A timeout +of 0 (the default) means no timeout. Connect-timeout applies only to plain HTTP; +HTTPS connections go through `TlsStream.connect`, which does not support a +timeout parameter. + ### Streaming For chunked or long-running responses, use `Client.request-stream` to get a @@ -80,6 +96,13 @@ implements the `poll` interface from the | `Client.request-with-max-redirects verb url headers body n` | Generic request with custom redirect limit | | `Client.request-stream verb url headers body` | Returns a `ResponseStream` | | `Client.request-stream-with-max-redirects verb url headers body n` | Streaming with custom redirect limit | +| `Client.get-with-config url config` | GET with timeout config | +| `Client.post-with-config url headers body config` | POST with timeout config | +| `Client.put-with-config url headers body config` | PUT with timeout config | +| `Client.del-with-config url config` | DELETE with timeout config | +| `Client.patch-with-config url headers body config` | PATCH with timeout config | +| `Client.request-with-config verb url headers body config` | Generic request with timeout config | +| `Client.request-stream-with-config verb url headers body config` | Streaming with timeout config | All return `(Result Response String)` (or `(Result ResponseStream String)` for the streaming variants). @@ -88,6 +111,13 @@ which is 10). For 301/302/303 responses the method is changed to GET and the bod dropped. For 307/308 responses the original method and body are preserved. Use the `-with-max-redirects` variants to control the limit, or pass 0 to disable. +### `Config` + +| Function | Purpose | +|----------|---------| +| `Config.init connect-timeout read-timeout` | Create a config (timeouts in seconds, 0 = none) | +| `Config.default` | Config with no timeouts | + ### `Connection` A union of `(Plain TcpStream)` and `(Secure TlsStream)`. Used internally for diff --git a/http-client.carp b/http-client.carp index 5cb4e70..b378900 100644 --- a/http-client.carp +++ b/http-client.carp @@ -44,7 +44,39 @@ the HTTP client to dispatch send/read over either transport.") (defn close! [conn] (match-ref conn (Connection.Plain s) (TcpStream.close! s) - (Connection.Secure s) (TlsStream.close! s)))) + (Connection.Secure s) (TlsStream.close! s))) + + (doc set-timeout "sets read and write timeouts on the connection, in seconds. +Pass 0 to clear timeouts.") + (defn set-timeout [conn timeout] + (match-ref conn + (Connection.Plain s) (TcpStream.set-timeout s timeout) + (Connection.Secure s) (TlsStream.set-timeout s timeout)))) + +; =========================================================================== +; Config — request-level configuration +; =========================================================================== + +(doc Config "holds per-request configuration such as timeouts. + +Create one with `Config.init` or `Config.default`: + +``` +(let [cfg (Config.init 5 10)] ; 5s connect, 10s read + (Client.get-with-config \"https://example.com/\" &cfg)) +``` + +All timeout values are in seconds. A value of 0 means no timeout (the default). + +**Note**: connect-timeout applies only to plain HTTP connections. +HTTPS connections go through `TlsStream.connect`, which does not +currently support a timeout parameter.") +(deftype Config [connect-timeout Int + read-timeout Int]) + +(defmodule Config + (doc default "creates a Config with no timeouts.") + (defn default [] (Config.init 0 0))) ; =========================================================================== ; Chunked transfer-encoding decoder (C helper) @@ -204,6 +236,30 @@ the response is complete.") (Result.Success s) (Result.Success (Connection.Plain s)) (Result.Error e) (Result.Error e)))) + (hidden connect-with-config) + (private connect-with-config) + (defn connect-with-config [scheme host port config] + (if (= scheme "https") + (match (TlsStream.connect host port) + (Result.Success s) + (do + (when (> @(Config.read-timeout config) 0) + (TlsStream.set-timeout &s @(Config.read-timeout config))) + (Result.Success (Connection.Secure s))) + (Result.Error e) (Result.Error e)) + (let [tcp-result (if (> @(Config.connect-timeout config) 0) + (TcpStream.connect-timeout host + port + @(Config.connect-timeout config)) + (TcpStream.connect host port))] + (match tcp-result + (Result.Success s) + (do + (when (> @(Config.read-timeout config) 0) + (TcpStream.set-timeout &s @(Config.read-timeout config))) + (Result.Success (Connection.Plain s))) + (Result.Error e) (Result.Error e))))) + (hidden build-and-send) (private build-and-send) (defn build-and-send [verb url headers body] @@ -229,6 +285,31 @@ the response is complete.") (ignore (Connection.send &conn &(Request.str &req))) (Result.Success conn))))))) + (hidden build-and-send-with-config) + (private build-and-send-with-config) + (defn build-and-send-with-config [verb url headers body config] + (match (URI.parse url) + (Result.Error e) (Result.Error @&e) + (Result.Success uri) + (let [scheme (Maybe.from @(URI.scheme &uri) @"http") + host (Maybe.from @(URI.host &uri) @"") + port (Maybe.from @(URI.port &uri) (default-port &scheme)) + path (URI.full-path &uri)] + (if (= (String.length &host) 0) + (Result.Error @"missing host in URL") + (match (connect-with-config &scheme &host port config) + (Result.Error e) (Result.Error e) + (Result.Success conn) + (let-do [host-vals [@&host] + conn-vals [@"close"] + with-host (Map.put headers &@"Host" &host-vals) + full-headers (Map.put with-host + &@"Connection" + &conn-vals) + req (Request.request @verb uri [] full-headers @body)] + (ignore (Connection.send &conn &(Request.str &req))) + (Result.Success conn))))))) + (hidden read-headers) (private read-headers) (doc read-headers "reads from a connection until HTTP headers are complete. @@ -432,6 +513,96 @@ See `request-stream-with-max-redirects` to control the redirect limit.") body default-max-redirects)) + (doc request-stream-with-config "sends an HTTP request with the given `Config` +and returns a `ResponseStream`. Follows up to `default-max-redirects` HTTP +redirects automatically. + +``` +(let [cfg (Config.init 5 10)] + (Client.request-stream-with-config \"POST\" url headers body &cfg)) +``` + +See `Config` for timeout details.") + (defn request-stream-with-config [verb url headers body config] + (let-do [cur-verb @verb + cur-url @url + cur-body @body + cur-headers headers + remaining default-max-redirects + result (the (Result ResponseStream String) (Result.Error @""))] + (while-do true + (match (build-and-send-with-config &cur-verb + &cur-url + @&cur-headers + &cur-body + config) + (Result.Error e) (do (set! result (Result.Error e)) (break)) + (Result.Success conn) + (match (read-headers &conn) + (Result.Error e) + (do + (Connection.close conn) + (set! result (Result.Error e)) + (break)) + (Result.Success pair) + (let [resp @(Pair.a &pair) + code @(Response.code &resp)] + (if (redirect? code) + (if (> remaining 0) + (match (Response.header &resp "Location") + (Maybe.Nothing) + (do + (Connection.close conn) + (set! result + (Result.Error @"redirect without Location header")) + (break)) + (Maybe.Just location) + (let [trimmed (Pattern.trim &location)] + (if (String.empty? &trimmed) + (do + (Connection.close conn) + (set! result + (Result.Error @"redirect with empty Location header")) + (break)) + (let-do [new-url (resolve-location &cur-url + &trimmed)] + (Connection.close conn) + (when (cross-origin? &cur-url &new-url) + (set! cur-headers + (strip-sensitive-headers &cur-headers))) + (set! cur-url new-url) + (let-do [new-verb (redirect-verb code &cur-verb)] + (when-do (/= &new-verb &cur-verb) + (set! cur-body @"") + (set! cur-headers + (remove-content-length &cur-headers))) + (set! cur-verb new-verb)) + (set! remaining (Int.dec remaining)))))) + (do + (Connection.close conn) + (set! result + (Result.Error + (fmt "too many redirects (max %d)" + default-max-redirects))) + (break))) + (let-do [leftover @(Pair.b &pair) + is-chunked (match (Response.header &resp + "Transfer-Encoding") + (Maybe.Just te) + (String.contains-string? &te "chunked") + _ false)] + (set! result + (Result.Success + (ResponseStream.init conn + leftover + @"" + is-chunked + false + code + resp))) + (break))))))) + result)) + (hidden drain-stream) (private drain-stream) (defn drain-stream [s] @@ -470,6 +641,26 @@ See `request-with-max-redirects` to control the redirect limit.") (defn request [verb url headers body] (request-with-max-redirects verb url headers body default-max-redirects)) + (doc request-with-config "sends an HTTP request with the given `Config`. +Returns `(Result Response String)`. + +Follows up to `default-max-redirects` HTTP redirects automatically. + +``` +(let [cfg (Config.init 5 10)] + (Client.request-with-config \"GET\" url headers body &cfg)) +``` + +See `Config` for timeout details.") + (defn request-with-config [verb url headers body config] + (match (request-stream-with-config verb url headers body config) + (Result.Error e) (Result.Error e) + (Result.Success stream) + (let-do [decoded-body (drain-stream &stream) + base-resp @(ResponseStream.parsed-response &stream)] + (ResponseStream.close stream) + (Result.Success (Response.set-body base-resp decoded-body))))) + (doc get "performs an HTTP GET request. Returns `(Result Response String)`.") (defn get [url] (request "GET" url (the (Map String (Array String)) {}) "")) @@ -494,4 +685,49 @@ Returns `(Result Response String)`.") (doc patch "performs an HTTP PATCH request with headers and body. Returns `(Result Response String)`.") - (defn patch [url headers body] (body-request "PATCH" url headers body))) + (defn patch [url headers body] (body-request "PATCH" url headers body)) + + ; ========================================================================= + ; Config-aware convenience wrappers + ; ========================================================================= + + (doc get-with-config "performs an HTTP GET request with the given `Config`. +Returns `(Result Response String)`. See `Config` for timeout details.") + (defn get-with-config [url config] + (request-with-config "GET" + url + (the (Map String (Array String)) {}) + "" + config)) + + (hidden body-request-with-config) + (private body-request-with-config) + (defn body-request-with-config [verb url headers body config] + (let [cl-vals [(Int.str (String.length body))] + hdrs (Map.put headers &@"Content-Length" &cl-vals)] + (request-with-config verb url hdrs body config))) + + (doc post-with-config "performs an HTTP POST request with the given `Config`. +Returns `(Result Response String)`. See `Config` for timeout details.") + (defn post-with-config [url headers body config] + (body-request-with-config "POST" url headers body config)) + + (doc put-with-config "performs an HTTP PUT request with the given `Config`. +Returns `(Result Response String)`. See `Config` for timeout details.") + (defn put-with-config [url headers body config] + (body-request-with-config "PUT" url headers body config)) + + (doc del-with-config "performs an HTTP DELETE request with the given `Config`. +Returns `(Result Response String)`. See `Config` for timeout details.") + (defn del-with-config [url config] + (request-with-config "DELETE" + url + (the (Map String (Array String)) {}) + "" + config)) + + (doc patch-with-config + "performs an HTTP PATCH request with the given `Config`. +Returns `(Result Response String)`. See `Config` for timeout details.") + (defn patch-with-config [url headers body config] + (body-request-with-config "PATCH" url headers body config))) diff --git a/test/http-client.carp b/test/http-client.carp index 03f8c20..6c84829 100644 --- a/test/http-client.carp +++ b/test/http-client.carp @@ -176,4 +176,74 @@ (Result.Success r) (not (String.contains-string? (Response.body &r) "Bearer secret-token")) (Result.Error _) true) - "cross-origin redirect strips Authorization header")) + "cross-origin redirect strips Authorization header") + + ; ========================================================================= + ; Config + ; ========================================================================= + + (assert-true test + (let [cfg (Config.default)] + (and (= @(Config.connect-timeout &cfg) 0) + (= @(Config.read-timeout &cfg) 0))) + "Config.default creates zero timeouts") + + ; ========================================================================= + ; Config-aware requests + ; ========================================================================= + + (assert-true test + (let [cfg (Config.default)] + (match (Client.get-with-config "https://example.com/" &cfg) + (Result.Success r) (Response.ok? &r) + _ false)) + "get-with-config with default config returns 200") + + (assert-true test + (let [cfg (Config.default)] + (match (Client.post-with-config "https://httpbin.org/post" + {@"Content-Type" [@"application/json"]} + "{\"test\": true}" + &cfg) + (Result.Success r) (Response.ok? &r) + _ false)) + "post-with-config with default config returns 200") + + ; generous read-timeout should not interfere with a fast response + (assert-true test + (let [cfg (Config.init 0 30)] + (match (Client.get-with-config "https://example.com/" &cfg) + (Result.Success r) (Response.ok? &r) + _ false)) + "generous read-timeout does not affect fast response") + + ; request-stream-with-config works + (assert-true test + (let [cfg (Config.default)] + (match (Client.request-stream-with-config "GET" + "https://example.com/" + (the (Map String (Array String)) + {}) + "" + &cfg) + (Result.Success stream) + (let-do [code @(ResponseStream.status-code &stream)] + (ResponseStream.close stream) + (= code 200)) + _ false)) + "request-stream-with-config returns stream with correct status") + + ; config-aware requests follow redirects + (assert-true test + (let [cfg (Config.default)] + (match (Client.get-with-config "https://httpbin.org/redirect/1" &cfg) + (Result.Success r) (Response.ok? &r) + _ false)) + "get-with-config follows redirects") + + ; read-timeout triggers on a slow response + (assert-true test + (let [cfg (Config.init 0 2)] + (Result.error? + &(Client.get-with-config "https://httpbin.org/delay/10" &cfg))) + "read-timeout causes error on slow response")) From 12eb0a1684ee8c9179ddef0ff57c422d5f2aa5fa Mon Sep 17 00:00:00 2001 From: "carpentry-heartbeat[bot]" Date: Mon, 1 Jun 2026 06:26:48 +0200 Subject: [PATCH 2/2] Address review feedback: rename Config, deduplicate redirect logic - Rename Config to RequestConfig (hellerve: too generic) - Add max-redirects field to RequestConfig - Remove dead Connection.set-timeout - Refactor duplicated redirect loop into shared request-stream- internal - Remove redundant connect/build-and-send (config path handles both) - Fix unused path binding in build-and-send - Document negative timeout behavior (treated same as 0) --- README.md | 35 +++--- http-client.carp | 246 ++++++++++++------------------------------ test/http-client.carp | 26 ++--- 3 files changed, 103 insertions(+), 204 deletions(-) diff --git a/README.md b/README.md index 152678e..54a8fc9 100644 --- a/README.md +++ b/README.md @@ -44,21 +44,22 @@ without OpenSSL. "{}") ``` -### Timeouts +### Timeouts and redirect limits -Create a `Config` to set connect and read timeouts (in seconds): +Create a `RequestConfig` to set connect/read timeouts (in seconds) and a +redirect limit: ```clojure -(let [cfg (Config.init 5 10)] ; 5s connect, 10s read +(let [cfg (RequestConfig.init 5 10 10)] ; 5s connect, 10s read, 10 redirects (match (Client.get-with-config "https://example.com/" &cfg) (Result.Success r) (println* (Response.body &r)) (Result.Error e) (IO.errorln &e))) ``` -All `-with-config` variants accept a `&Config` as the last argument. A timeout -of 0 (the default) means no timeout. Connect-timeout applies only to plain HTTP; -HTTPS connections go through `TlsStream.connect`, which does not support a -timeout parameter. +All `-with-config` variants accept a `&RequestConfig` as the last argument. +A timeout of 0 or negative (the default) means no timeout. Connect-timeout +applies only to plain HTTP; HTTPS connections go through `TlsStream.connect`, +which does not support a timeout parameter. ### Streaming @@ -96,13 +97,13 @@ implements the `poll` interface from the | `Client.request-with-max-redirects verb url headers body n` | Generic request with custom redirect limit | | `Client.request-stream verb url headers body` | Returns a `ResponseStream` | | `Client.request-stream-with-max-redirects verb url headers body n` | Streaming with custom redirect limit | -| `Client.get-with-config url config` | GET with timeout config | -| `Client.post-with-config url headers body config` | POST with timeout config | -| `Client.put-with-config url headers body config` | PUT with timeout config | -| `Client.del-with-config url config` | DELETE with timeout config | -| `Client.patch-with-config url headers body config` | PATCH with timeout config | -| `Client.request-with-config verb url headers body config` | Generic request with timeout config | -| `Client.request-stream-with-config verb url headers body config` | Streaming with timeout config | +| `Client.get-with-config url config` | GET with request config | +| `Client.post-with-config url headers body config` | POST with request config | +| `Client.put-with-config url headers body config` | PUT with request config | +| `Client.del-with-config url config` | DELETE with request config | +| `Client.patch-with-config url headers body config` | PATCH with request config | +| `Client.request-with-config verb url headers body config` | Generic request with request config | +| `Client.request-stream-with-config verb url headers body config` | Streaming with request config | All return `(Result Response String)` (or `(Result ResponseStream String)` for the streaming variants). @@ -111,12 +112,12 @@ which is 10). For 301/302/303 responses the method is changed to GET and the bod dropped. For 307/308 responses the original method and body are preserved. Use the `-with-max-redirects` variants to control the limit, or pass 0 to disable. -### `Config` +### `RequestConfig` | Function | Purpose | |----------|---------| -| `Config.init connect-timeout read-timeout` | Create a config (timeouts in seconds, 0 = none) | -| `Config.default` | Config with no timeouts | +| `RequestConfig.init connect-timeout read-timeout max-redirects` | Create a config (timeouts in seconds, 0 = none) | +| `RequestConfig.default` | Config with no timeouts and 10 max redirects | ### `Connection` diff --git a/http-client.carp b/http-client.carp index b378900..b1e4fdd 100644 --- a/http-client.carp +++ b/http-client.carp @@ -44,39 +44,39 @@ the HTTP client to dispatch send/read over either transport.") (defn close! [conn] (match-ref conn (Connection.Plain s) (TcpStream.close! s) - (Connection.Secure s) (TlsStream.close! s))) - - (doc set-timeout "sets read and write timeouts on the connection, in seconds. -Pass 0 to clear timeouts.") - (defn set-timeout [conn timeout] - (match-ref conn - (Connection.Plain s) (TcpStream.set-timeout s timeout) - (Connection.Secure s) (TlsStream.set-timeout s timeout)))) + (Connection.Secure s) (TlsStream.close! s)))) ; =========================================================================== -; Config — request-level configuration +; RequestConfig — per-request configuration ; =========================================================================== -(doc Config "holds per-request configuration such as timeouts. +(doc RequestConfig "holds per-request configuration such as timeouts and +redirect limits. -Create one with `Config.init` or `Config.default`: +Create one with `RequestConfig.init` or `RequestConfig.default`: ``` -(let [cfg (Config.init 5 10)] ; 5s connect, 10s read +(let [cfg (RequestConfig.init 5 10 10)] ; 5s connect, 10s read, 10 redirects (Client.get-with-config \"https://example.com/\" &cfg)) ``` -All timeout values are in seconds. A value of 0 means no timeout (the default). +All timeout values are in seconds. A value of 0 (or negative) means no +timeout. + +The `max-redirects` field controls how many HTTP redirects to follow. +Pass 0 to disable redirect following entirely. **Note**: connect-timeout applies only to plain HTTP connections. HTTPS connections go through `TlsStream.connect`, which does not currently support a timeout parameter.") -(deftype Config [connect-timeout Int - read-timeout Int]) +(deftype RequestConfig [connect-timeout Int + read-timeout Int + max-redirects Int]) -(defmodule Config - (doc default "creates a Config with no timeouts.") - (defn default [] (Config.init 0 0))) +(defmodule RequestConfig + (doc default + "creates a RequestConfig with no timeouts and up to 10 redirects.") + (defn default [] (RequestConfig.init 0 0 10))) ; =========================================================================== ; Chunked transfer-encoding decoder (C helper) @@ -227,77 +227,40 @@ the response is complete.") (hidden connect) (private connect) - (defn connect [scheme host port] - (if (= scheme "https") - (match (TlsStream.connect host port) - (Result.Success s) (Result.Success (Connection.Secure s)) - (Result.Error e) (Result.Error e)) - (match (TcpStream.connect host port) - (Result.Success s) (Result.Success (Connection.Plain s)) - (Result.Error e) (Result.Error e)))) - - (hidden connect-with-config) - (private connect-with-config) - (defn connect-with-config [scheme host port config] + (defn connect [scheme host port config] (if (= scheme "https") (match (TlsStream.connect host port) (Result.Success s) (do - (when (> @(Config.read-timeout config) 0) - (TlsStream.set-timeout &s @(Config.read-timeout config))) + (when (> @(RequestConfig.read-timeout config) 0) + (TlsStream.set-timeout &s @(RequestConfig.read-timeout config))) (Result.Success (Connection.Secure s))) (Result.Error e) (Result.Error e)) - (let [tcp-result (if (> @(Config.connect-timeout config) 0) + (let [tcp-result (if (> @(RequestConfig.connect-timeout config) 0) (TcpStream.connect-timeout host port - @(Config.connect-timeout config)) + @(RequestConfig.connect-timeout config)) (TcpStream.connect host port))] (match tcp-result (Result.Success s) (do - (when (> @(Config.read-timeout config) 0) - (TcpStream.set-timeout &s @(Config.read-timeout config))) + (when (> @(RequestConfig.read-timeout config) 0) + (TcpStream.set-timeout &s @(RequestConfig.read-timeout config))) (Result.Success (Connection.Plain s))) (Result.Error e) (Result.Error e))))) (hidden build-and-send) (private build-and-send) - (defn build-and-send [verb url headers body] + (defn build-and-send [verb url headers body config] (match (URI.parse url) (Result.Error e) (Result.Error @&e) (Result.Success uri) (let [scheme (Maybe.from @(URI.scheme &uri) @"http") host (Maybe.from @(URI.host &uri) @"") - port (Maybe.from @(URI.port &uri) (default-port &scheme)) - path (URI.full-path &uri)] - (if (= (String.length &host) 0) - (Result.Error @"missing host in URL") - (match (connect &scheme &host port) - (Result.Error e) (Result.Error e) - (Result.Success conn) - (let-do [host-vals [@&host] - conn-vals [@"close"] - with-host (Map.put headers &@"Host" &host-vals) - full-headers (Map.put with-host - &@"Connection" - &conn-vals) - req (Request.request @verb uri [] full-headers @body)] - (ignore (Connection.send &conn &(Request.str &req))) - (Result.Success conn))))))) - - (hidden build-and-send-with-config) - (private build-and-send-with-config) - (defn build-and-send-with-config [verb url headers body config] - (match (URI.parse url) - (Result.Error e) (Result.Error @&e) - (Result.Success uri) - (let [scheme (Maybe.from @(URI.scheme &uri) @"http") - host (Maybe.from @(URI.host &uri) @"") - port (Maybe.from @(URI.port &uri) (default-port &scheme)) - path (URI.full-path &uri)] + port (Maybe.from @(URI.port &uri) (default-port &scheme))] (if (= (String.length &host) 0) (Result.Error @"missing host in URL") - (match (connect-with-config &scheme &host port config) + (match (connect &scheme &host port config) (Result.Error e) (Result.Error e) (Result.Success conn) (let-do [host-vals [@&host] @@ -416,22 +379,18 @@ to follow. Used by `request`, `request-stream`, and convenience methods.") (private cross-origin?) (defn cross-origin? [url-a url-b] (/= &(url-origin url-a) &(url-origin url-b))) - (doc request-stream-with-max-redirects "sends an HTTP request and returns a -`ResponseStream`, following up to `max-redirects` HTTP redirects. - -For 301, 302, and 303 responses the method is changed to GET and the body is -dropped. For 307 and 308 responses the original method and body are preserved. - -Pass 0 to disable redirect following.") - (defn request-stream-with-max-redirects [verb url headers body max-redirects] + (hidden request-stream-) + (private request-stream-) + (defn request-stream- [verb url headers body config] (let-do [cur-verb @verb cur-url @url cur-body @body cur-headers headers - remaining max-redirects + max-redir @(RequestConfig.max-redirects config) + remaining max-redir result (the (Result ResponseStream String) (Result.Error @""))] (while-do true - (match (build-and-send &cur-verb &cur-url @&cur-headers &cur-body) + (match (build-and-send &cur-verb &cur-url @&cur-headers &cur-body config) (Result.Error e) (do (set! result (Result.Error e)) (break)) (Result.Success conn) (match (read-headers &conn) @@ -478,7 +437,7 @@ Pass 0 to disable redirect following.") (Connection.close conn) (set! result (Result.Error - (fmt "too many redirects (max %d)" max-redirects))) + (fmt "too many redirects (max %d)" max-redir))) (break))) (let-do [leftover @(Pair.b &pair) is-chunked (match (Response.header &resp @@ -498,6 +457,17 @@ Pass 0 to disable redirect following.") (break))))))) result)) + (doc request-stream-with-max-redirects "sends an HTTP request and returns a +`ResponseStream`, following up to `max-redirects` HTTP redirects. + +For 301, 302, and 303 responses the method is changed to GET and the body is +dropped. For 307 and 308 responses the original method and body are preserved. + +Pass 0 to disable redirect following.") + (defn request-stream-with-max-redirects [verb url headers body max-redirects] + (let [cfg (RequestConfig.init 0 0 max-redirects)] + (request-stream- verb url headers body &cfg))) + (doc request-stream "sends an HTTP request and returns a `ResponseStream` for reading the response body incrementally. Follows up to `default-max-redirects` HTTP redirects automatically. Use `ResponseStream.poll` to read chunks. @@ -513,95 +483,17 @@ See `request-stream-with-max-redirects` to control the redirect limit.") body default-max-redirects)) - (doc request-stream-with-config "sends an HTTP request with the given `Config` -and returns a `ResponseStream`. Follows up to `default-max-redirects` HTTP -redirects automatically. + (doc request-stream-with-config "sends an HTTP request with the given +`RequestConfig` and returns a `ResponseStream`. ``` -(let [cfg (Config.init 5 10)] +(let [cfg (RequestConfig.init 5 10 10)] (Client.request-stream-with-config \"POST\" url headers body &cfg)) ``` -See `Config` for timeout details.") +See `RequestConfig` for timeout and redirect details.") (defn request-stream-with-config [verb url headers body config] - (let-do [cur-verb @verb - cur-url @url - cur-body @body - cur-headers headers - remaining default-max-redirects - result (the (Result ResponseStream String) (Result.Error @""))] - (while-do true - (match (build-and-send-with-config &cur-verb - &cur-url - @&cur-headers - &cur-body - config) - (Result.Error e) (do (set! result (Result.Error e)) (break)) - (Result.Success conn) - (match (read-headers &conn) - (Result.Error e) - (do - (Connection.close conn) - (set! result (Result.Error e)) - (break)) - (Result.Success pair) - (let [resp @(Pair.a &pair) - code @(Response.code &resp)] - (if (redirect? code) - (if (> remaining 0) - (match (Response.header &resp "Location") - (Maybe.Nothing) - (do - (Connection.close conn) - (set! result - (Result.Error @"redirect without Location header")) - (break)) - (Maybe.Just location) - (let [trimmed (Pattern.trim &location)] - (if (String.empty? &trimmed) - (do - (Connection.close conn) - (set! result - (Result.Error @"redirect with empty Location header")) - (break)) - (let-do [new-url (resolve-location &cur-url - &trimmed)] - (Connection.close conn) - (when (cross-origin? &cur-url &new-url) - (set! cur-headers - (strip-sensitive-headers &cur-headers))) - (set! cur-url new-url) - (let-do [new-verb (redirect-verb code &cur-verb)] - (when-do (/= &new-verb &cur-verb) - (set! cur-body @"") - (set! cur-headers - (remove-content-length &cur-headers))) - (set! cur-verb new-verb)) - (set! remaining (Int.dec remaining)))))) - (do - (Connection.close conn) - (set! result - (Result.Error - (fmt "too many redirects (max %d)" - default-max-redirects))) - (break))) - (let-do [leftover @(Pair.b &pair) - is-chunked (match (Response.header &resp - "Transfer-Encoding") - (Maybe.Just te) - (String.contains-string? &te "chunked") - _ false)] - (set! result - (Result.Success - (ResponseStream.init conn - leftover - @"" - is-chunked - false - code - resp))) - (break))))))) - result)) + (request-stream- verb url headers body config)) (hidden drain-stream) (private drain-stream) @@ -641,17 +533,16 @@ See `request-with-max-redirects` to control the redirect limit.") (defn request [verb url headers body] (request-with-max-redirects verb url headers body default-max-redirects)) - (doc request-with-config "sends an HTTP request with the given `Config`. + (doc request-with-config + "sends an HTTP request with the given `RequestConfig`. Returns `(Result Response String)`. -Follows up to `default-max-redirects` HTTP redirects automatically. - ``` -(let [cfg (Config.init 5 10)] +(let [cfg (RequestConfig.init 5 10 10)] (Client.request-with-config \"GET\" url headers body &cfg)) ``` -See `Config` for timeout details.") +See `RequestConfig` for timeout and redirect details.") (defn request-with-config [verb url headers body config] (match (request-stream-with-config verb url headers body config) (Result.Error e) (Result.Error e) @@ -688,11 +579,12 @@ Returns `(Result Response String)`.") (defn patch [url headers body] (body-request "PATCH" url headers body)) ; ========================================================================= - ; Config-aware convenience wrappers + ; RequestConfig-aware convenience wrappers ; ========================================================================= - (doc get-with-config "performs an HTTP GET request with the given `Config`. -Returns `(Result Response String)`. See `Config` for timeout details.") + (doc get-with-config "performs an HTTP GET request with the given +`RequestConfig`. Returns `(Result Response String)`. +See `RequestConfig` for timeout and redirect details.") (defn get-with-config [url config] (request-with-config "GET" url @@ -707,18 +599,21 @@ Returns `(Result Response String)`. See `Config` for timeout details.") hdrs (Map.put headers &@"Content-Length" &cl-vals)] (request-with-config verb url hdrs body config))) - (doc post-with-config "performs an HTTP POST request with the given `Config`. -Returns `(Result Response String)`. See `Config` for timeout details.") + (doc post-with-config "performs an HTTP POST request with the given +`RequestConfig`. Returns `(Result Response String)`. +See `RequestConfig` for timeout and redirect details.") (defn post-with-config [url headers body config] (body-request-with-config "POST" url headers body config)) - (doc put-with-config "performs an HTTP PUT request with the given `Config`. -Returns `(Result Response String)`. See `Config` for timeout details.") + (doc put-with-config "performs an HTTP PUT request with the given +`RequestConfig`. Returns `(Result Response String)`. +See `RequestConfig` for timeout and redirect details.") (defn put-with-config [url headers body config] (body-request-with-config "PUT" url headers body config)) - (doc del-with-config "performs an HTTP DELETE request with the given `Config`. -Returns `(Result Response String)`. See `Config` for timeout details.") + (doc del-with-config "performs an HTTP DELETE request with the given +`RequestConfig`. Returns `(Result Response String)`. +See `RequestConfig` for timeout and redirect details.") (defn del-with-config [url config] (request-with-config "DELETE" url @@ -727,7 +622,8 @@ Returns `(Result Response String)`. See `Config` for timeout details.") config)) (doc patch-with-config - "performs an HTTP PATCH request with the given `Config`. -Returns `(Result Response String)`. See `Config` for timeout details.") + "performs an HTTP PATCH request with the given `RequestConfig`. +Returns `(Result Response String)`. +See `RequestConfig` for timeout and redirect details.") (defn patch-with-config [url headers body config] (body-request-with-config "PATCH" url headers body config))) diff --git a/test/http-client.carp b/test/http-client.carp index 6c84829..52e543f 100644 --- a/test/http-client.carp +++ b/test/http-client.carp @@ -179,28 +179,30 @@ "cross-origin redirect strips Authorization header") ; ========================================================================= - ; Config + ; RequestConfig ; ========================================================================= (assert-true test - (let [cfg (Config.default)] - (and (= @(Config.connect-timeout &cfg) 0) - (= @(Config.read-timeout &cfg) 0))) - "Config.default creates zero timeouts") + (let [cfg (RequestConfig.default)] + (and + (= @(RequestConfig.connect-timeout &cfg) 0) + (and (= @(RequestConfig.read-timeout &cfg) 0) + (= @(RequestConfig.max-redirects &cfg) 10)))) + "RequestConfig.default creates zero timeouts and 10 max redirects") ; ========================================================================= - ; Config-aware requests + ; RequestConfig-aware requests ; ========================================================================= (assert-true test - (let [cfg (Config.default)] + (let [cfg (RequestConfig.default)] (match (Client.get-with-config "https://example.com/" &cfg) (Result.Success r) (Response.ok? &r) _ false)) "get-with-config with default config returns 200") (assert-true test - (let [cfg (Config.default)] + (let [cfg (RequestConfig.default)] (match (Client.post-with-config "https://httpbin.org/post" {@"Content-Type" [@"application/json"]} "{\"test\": true}" @@ -211,7 +213,7 @@ ; generous read-timeout should not interfere with a fast response (assert-true test - (let [cfg (Config.init 0 30)] + (let [cfg (RequestConfig.init 0 30 10)] (match (Client.get-with-config "https://example.com/" &cfg) (Result.Success r) (Response.ok? &r) _ false)) @@ -219,7 +221,7 @@ ; request-stream-with-config works (assert-true test - (let [cfg (Config.default)] + (let [cfg (RequestConfig.default)] (match (Client.request-stream-with-config "GET" "https://example.com/" (the (Map String (Array String)) @@ -235,7 +237,7 @@ ; config-aware requests follow redirects (assert-true test - (let [cfg (Config.default)] + (let [cfg (RequestConfig.default)] (match (Client.get-with-config "https://httpbin.org/redirect/1" &cfg) (Result.Success r) (Response.ok? &r) _ false)) @@ -243,7 +245,7 @@ ; read-timeout triggers on a slow response (assert-true test - (let [cfg (Config.init 0 2)] + (let [cfg (RequestConfig.init 0 2 10)] (Result.error? &(Client.get-with-config "https://httpbin.org/delay/10" &cfg))) "read-timeout causes error on slow response"))