Add configurable request timeouts via Config type

README.md

@@ -44,6 +44,23 @@ without OpenSSL.
                 "{}")
 ```
 
+### Timeouts and redirect limits
+
+Create a `RequestConfig` to set connect/read timeouts (in seconds) and a
+redirect limit:
+
+```clojure
+(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 `&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
 
 For chunked or long-running responses, use `Client.request-stream` to get a
@@ -80,6 +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 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).
 
@@ -88,6 +112,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.
 
+### `RequestConfig`
+
+| Function | Purpose |
+|----------|---------|
+| `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`
 
 A union of `(Plain TcpStream)` and `(Secure TlsStream)`. Used internally for

http-client.carp

@@ -46,6 +46,38 @@ the HTTP client to dispatch send/read over either transport.")
       (Connection.Plain s) (TcpStream.close! s)
       (Connection.Secure s) (TlsStream.close! s))))
 
+; ===========================================================================
+; RequestConfig — per-request configuration
+; ===========================================================================
+
+(doc RequestConfig "holds per-request configuration such as timeouts and
+redirect limits.
+
+Create one with `RequestConfig.init` or `RequestConfig.default`:
+
+```
+(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 (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 RequestConfig [connect-timeout Int
+                        read-timeout Int
+                        max-redirects Int])
+
+(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)
 ; ===========================================================================
@@ -195,28 +227,40 @@ the response is complete.")
 
   (hidden connect)
   (private connect)
-  (defn connect [scheme host port]
+  (defn connect [scheme host port config]
     (if (= scheme "https")
       (match (TlsStream.connect host port)
-        (Result.Success s) (Result.Success (Connection.Secure s))
+        (Result.Success s)
+          (do
+            (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))
-      (match (TcpStream.connect host port)
-        (Result.Success s) (Result.Success (Connection.Plain s))
-        (Result.Error e) (Result.Error e))))
+      (let [tcp-result (if (> @(RequestConfig.connect-timeout config) 0)
+              (TcpStream.connect-timeout host
+                                         port
+                                         @(RequestConfig.connect-timeout config))
+              (TcpStream.connect host port))]
+        (match tcp-result
+          (Result.Success s)
+            (do
+              (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)]
+              port (Maybe.from @(URI.port &uri) (default-port &scheme))]
           (if (= (String.length &host) 0)
             (Result.Error @"missing host in URL")
-            (match (connect &scheme &host port)
+            (match (connect &scheme &host port config)
               (Result.Error e) (Result.Error e)
               (Result.Success conn)
                 (let-do [host-vals [@&host]
@@ -335,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)
@@ -397,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
@@ -417,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.
@@ -432,6 +483,18 @@ 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
+`RequestConfig` and returns a `ResponseStream`.
+
+```
+(let [cfg (RequestConfig.init 5 10 10)]
+  (Client.request-stream-with-config \"POST\" url headers body &cfg))
+```
+
+See `RequestConfig` for timeout and redirect details.")
+  (defn request-stream-with-config [verb url headers body config]
+    (request-stream- verb url headers body config))
+
   (hidden drain-stream)
   (private drain-stream)
   (defn drain-stream [s]
@@ -470,6 +533,25 @@ 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 `RequestConfig`.
+Returns `(Result Response String)`.
+
+```
+(let [cfg (RequestConfig.init 5 10 10)]
+  (Client.request-with-config \"GET\" url headers body &cfg))
+```
+
+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)
+      (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 +576,54 @@ 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))
+
+  ; =========================================================================
+  ; RequestConfig-aware convenience wrappers
+  ; =========================================================================
+
+  (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
+                         (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
+`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
+`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
+`RequestConfig`. Returns `(Result Response String)`.
+See `RequestConfig` for timeout and redirect 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 `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)))

test/http-client.carp

@@ -176,4 +176,76 @@
       (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")
+
+  ; =========================================================================
+  ; RequestConfig
+  ; =========================================================================
+
+  (assert-true test
+    (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")
+
+  ; =========================================================================
+  ; RequestConfig-aware requests
+  ; =========================================================================
+
+  (assert-true test
+    (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 (RequestConfig.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 (RequestConfig.init 0 30 10)]
+      (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 (RequestConfig.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 (RequestConfig.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 (RequestConfig.init 0 2 10)]
+      (Result.error?
+        &(Client.get-with-config "https://httpbin.org/delay/10" &cfg)))
+    "read-timeout causes error on slow response"))