Add cookie jar for automatic cookie management

README.md

@@ -82,6 +82,27 @@ For chunked or long-running responses, use `Client.request-stream` to get a
 implements the `poll` interface from the
 [streams](https://github.com/carpentry-org/streams) library.
 
+### Cookie jar
+
+Use a `CookieJar` to store cookies from responses and replay them on
+subsequent requests automatically:
+
+```clojure
+(let-do [jar (CookieJar.create)]
+  (match (Client.get-with-jar "https://example.com/login" &jar)
+    (Result.Success r) (println* (Response.body &r))
+    (Result.Error e) (IO.errorln &e))
+  ; jar now has cookies from the login response
+  (match (Client.get-with-jar "https://example.com/dashboard" &jar)
+    (Result.Success r) (println* (Response.body &r))
+    (Result.Error e) (IO.errorln &e)))
+```
+
+The jar handles domain matching (RFC 6265 suffix rules), path matching,
+Secure flag enforcement, and expiry. Cookies are deduplicated by
+name+domain+path. During redirects, cookies from every hop are stored and
+re-applied for each new URL.
+
 ## API
 
 ### `Client`
@@ -106,6 +127,16 @@ implements the `poll` interface from the
 | `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 |
+| `Client.get-with-jar url jar` | GET with cookie jar |
+| `Client.post-with-jar url headers body jar` | POST with cookie jar |
+| `Client.put-with-jar url headers body jar` | PUT with cookie jar |
+| `Client.del-with-jar url jar` | DELETE with cookie jar |
+| `Client.head-with-jar url jar` | HEAD with cookie jar |
+| `Client.patch-with-jar url headers body jar` | PATCH with cookie jar |
+| `Client.request-with-jar verb url headers body jar` | Generic request with cookie jar |
+| `Client.request-stream-with-jar verb url headers body jar` | Streaming with cookie jar |
+| `Client.request-with-jar-and-config verb url headers body jar config` | Generic request with jar and config |
+| `Client.request-stream-with-jar-and-config verb url headers body jar config` | Streaming with jar and config |
 
 All return `(Result Response String)` (or `(Result ResponseStream String)` for the streaming variants).
 
@@ -121,6 +152,19 @@ dropped. For 307/308 responses the original method and body are preserved. Use t
 | `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 |
 
+### `CookieJar`
+
+| Function | Purpose |
+|----------|---------|
+| `CookieJar.create` | Create an empty jar |
+| `CookieJar.store! jar cookie` | Store a cookie, replacing duplicates by name+domain+path |
+| `CookieJar.store-response! jar response url` | Store cookies from a response, defaulting domain from URL |
+| `CookieJar.matching jar url` | Return cookies matching the URL by domain, path, security, and expiry |
+| `CookieJar.cookie-header jar url` | Build a `Cookie` header value, or `Nothing` if no cookies match |
+| `CookieJar.apply-to-headers jar url headers` | Add a `Cookie` header to the headers map |
+| `CookieJar.size jar` | Number of stored cookies |
+| `CookieJar.clear! jar` | Remove all cookies |
+
 ### `Connection`
 
 A union of `(Plain TcpStream)` and `(Secure TlsStream)`. Used internally for

gendocs.carp

@@ -37,5 +37,5 @@ transparently over plain TCP or TLS-encrypted streams.
 Requires OpenSSL for HTTPS support (via the `tls` library).
 Plain HTTP works without OpenSSL.")
 
-(save-docs Client Connection)
+(save-docs Client Connection CookieJar)
 (quit)

http-client.carp

@@ -4,6 +4,7 @@
 (load "git@github.com:carpentry-org/strbuf@0.1.0")
 
 (load "src/multipart.carp")
+(load "src/cookie-jar.carp")
 
 (relative-include "src/chunked.h")
 
@@ -652,4 +653,165 @@ See `RequestConfig` for timeout and redirect details.")
             (Map.put headers &@"Content-Type" &ct-vals)
             &@"Content-Length"
             &cl-vals)]
-      (request-with-config "POST" url hdrs &body config))))
+      (request-with-config "POST" url hdrs &body config)))
+
+  (hidden request-stream-with-jar-)
+  (private request-stream-with-jar-)
+  (defn request-stream-with-jar- [verb url headers body config jar]
+    (let-do [cur-verb @verb
+             cur-url @url
+             cur-body @body
+             cur-headers headers
+             max-redir @(RequestConfig.max-redirects config)
+             remaining max-redir
+             result (the (Result ResponseStream String) (Result.Error @""))]
+      (while-do true
+        (let [with-cookies (CookieJar.apply-to-headers jar &cur-url &cur-headers)]
+          (match (build-and-send &cur-verb
+                                 &cur-url
+                                 with-cookies
+                                 &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)]
+                    (CookieJar.store-response! jar &resp &cur-url)
+                    (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)" max-redir)))
+                          (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))
+
+  (doc request-stream-with-jar "sends an HTTP request using the given
+`CookieJar`. Matching cookies are sent automatically, and Set-Cookie
+response headers are stored in the jar. Returns a `ResponseStream`.
+Follows up to `default-max-redirects` redirects.")
+  (defn request-stream-with-jar [verb url headers body jar]
+    (let [cfg (RequestConfig.default)]
+      (request-stream-with-jar- verb url headers body &cfg jar)))
+
+  (doc request-stream-with-jar-and-config "sends an HTTP request using the
+given `CookieJar` and `RequestConfig`. Returns a `ResponseStream`.")
+  (defn request-stream-with-jar-and-config [verb url headers body jar config]
+    (request-stream-with-jar- verb url headers body config jar))
+
+  (doc request-with-jar "sends an HTTP request using the given `CookieJar`.
+Matching cookies are sent automatically, and Set-Cookie response headers
+are stored in the jar. Returns `(Result Response String)`.
+Follows up to `default-max-redirects` redirects.")
+  (defn request-with-jar [verb url headers body jar]
+    (match (request-stream-with-jar verb url headers body jar)
+      (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 request-with-jar-and-config "sends an HTTP request using the given
+`CookieJar` and `RequestConfig`. Returns `(Result Response String)`.")
+  (defn request-with-jar-and-config [verb url headers body jar config]
+    (match (request-stream-with-jar-and-config verb url headers body jar 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-with-jar "performs an HTTP GET request using the given `CookieJar`.
+Returns `(Result Response String)`.")
+  (defn get-with-jar [url jar]
+    (request-with-jar "GET" url (the (Map String (Array String)) {}) "" jar))
+
+  (doc head-with-jar "performs an HTTP HEAD request using the given `CookieJar`.
+Returns `(Result Response String)`.")
+  (defn head-with-jar [url jar]
+    (request-with-jar "HEAD" url (the (Map String (Array String)) {}) "" jar))
+
+  (hidden body-request-with-jar)
+  (private body-request-with-jar)
+  (defn body-request-with-jar [verb url headers body jar]
+    (let [cl-vals [(Int.str (String.length body))]
+          hdrs (Map.put headers &@"Content-Length" &cl-vals)]
+      (request-with-jar verb url hdrs body jar)))
+
+  (doc post-with-jar "performs an HTTP POST request using the given `CookieJar`.
+Returns `(Result Response String)`.")
+  (defn post-with-jar [url headers body jar]
+    (body-request-with-jar "POST" url headers body jar))
+
+  (doc put-with-jar "performs an HTTP PUT request using the given `CookieJar`.
+Returns `(Result Response String)`.")
+  (defn put-with-jar [url headers body jar]
+    (body-request-with-jar "PUT" url headers body jar))
+
+  (doc del-with-jar
+    "performs an HTTP DELETE request using the given `CookieJar`.
+Returns `(Result Response String)`.")
+  (defn del-with-jar [url jar]
+    (request-with-jar "DELETE" url (the (Map String (Array String)) {}) "" jar))
+
+  (doc patch-with-jar
+    "performs an HTTP PATCH request using the given `CookieJar`.
+Returns `(Result Response String)`.")
+  (defn patch-with-jar [url headers body jar]
+    (body-request-with-jar "PATCH" url headers body jar)))

src/cookie-jar.carp

@@ -0,0 +1,123 @@
+; Cookie jar for automatic HTTP cookie management.
+; Stores cookies from Set-Cookie response headers and replays matching
+; cookies on subsequent requests by domain, path, and expiry.
+
+(doc CookieJar "stores cookies and replays them on matching requests.
+
+Create a jar with `CookieJar.create`, then pass it to `Client.get-with-jar`
+and similar functions:
+
+```
+(let-do [jar (CookieJar.create)]
+  (match (Client.get-with-jar \"https://example.com/\" &jar)
+    (Result.Success r) (println* (Response.body &r))
+    (Result.Error e) (IO.errorln &e))
+  ; jar now has cookies; they are sent on the next request automatically
+  (match (Client.get-with-jar \"https://example.com/page\" &jar)
+    (Result.Success r) (println* (Response.body &r))
+    (Result.Error e) (IO.errorln &e)))
+```")
+(deftype CookieJar [cookies (Array Cookie)])
+
+(defmodule CookieJar
+  (doc create "creates an empty cookie jar.")
+  (defn create [] (init []))
+
+  (hidden domain-matches?)
+  (private domain-matches?)
+  (defn domain-matches? [cookie-domain host]
+    (let [cd (String.ascii-to-lower &(String.trim cookie-domain))
+          h (String.ascii-to-lower host)
+          norm (if (String.starts-with? &cd ".") (String.suffix &cd 1) @&cd)]
+      (or (= &norm &h) (String.ends-with? &h &(fmt ".%s" &norm)))))
+
+  (hidden path-matches?)
+  (private path-matches?)
+  (defn path-matches? [cookie-path request-path]
+    (or (= cookie-path request-path)
+        (if (String.ends-with? cookie-path "/")
+          (String.starts-with? request-path cookie-path)
+          (String.starts-with? request-path &(fmt "%s/" cookie-path)))))
+
+  (doc store! "stores a cookie, replacing any with the same name, domain,
+and path.")
+  (defn store! [jar c]
+    (let [filtered (Array.reduce
+            &(fn [acc existing]
+              (if (and
+                  (= (Cookie.name existing) (Cookie.name c))
+                  (and
+                    (= (Cookie.domain existing) (Cookie.domain c))
+                    (= (Cookie.path existing) (Cookie.path c))))
+                acc
+                (Array.push-back acc @existing)))
+            (the (Array Cookie) [])
+            (cookies jar))
+          new-arr (Array.push-back filtered @c)]
+      (set-cookies! jar new-arr)))
+
+  (doc store-response! "stores cookies from a response. The URL provides the
+default domain for cookies without a Domain attribute.")
+  (defn store-response! [jar resp url]
+    (match (URI.parse url)
+      (Result.Error _) ()
+      (Result.Success uri)
+        (let [host (Maybe.from @(URI.host &uri) @"")]
+          (for [i 0 (Array.length (Response.cookies resp))]
+            (let [raw @(Array.unsafe-nth (Response.cookies resp) i)
+                  c (if (Maybe.nothing? (Cookie.domain &raw))
+                    (Cookie.set-domain raw (Maybe.Just @&host))
+                    raw)]
+              (store! jar &c))))))
+
+  (doc matching "returns cookies matching the given URL by domain, path,
+security, and expiry.")
+  (defn matching [jar url]
+    (match (URI.parse url)
+      (Result.Error _) []
+      (Result.Success uri)
+        (let [host (Maybe.from @(URI.host &uri) @"")
+              path (Maybe.from @(URI.path &uri) @"/")
+              scheme (Maybe.from @(URI.scheme &uri) @"http")
+              is-secure (= &scheme "https")]
+          (Array.reduce
+            &(fn [acc c]
+              (let [d (Maybe.from @(Cookie.domain c) @"")]
+                (cond
+                  (Cookie.expired? c) acc
+                  (and @(Cookie.secure c) (not is-secure)) acc
+                  (Maybe.nothing? (Cookie.domain c)) acc
+                  (not (domain-matches? &d &host)) acc
+                  (not (path-matches? (Cookie.path c) &path)) acc
+                  (Array.push-back acc @c))))
+            (the (Array Cookie) [])
+            (cookies jar)))))
+
+  (doc cookie-header "builds a Cookie header value for the URL, or Nothing
+if no cookies match.")
+  (defn cookie-header [jar url]
+    (let [matched (matching jar url)]
+      (if (Array.empty? &matched)
+        (Maybe.Nothing)
+        (let-do [sb (StringBuf.create)]
+          (for [i 0 (Array.length &matched)]
+            (do
+              (when (> i 0) (StringBuf.append-str &sb "; "))
+              (StringBuf.append-str &sb
+                                    &(Cookie.kv (Array.unsafe-nth &matched i)))))
+          (let-do [s (StringBuf.to-string &sb)]
+            (StringBuf.delete sb)
+            (Maybe.Just s))))))
+
+  (doc apply-to-headers "adds a Cookie header for matching cookies to the
+headers map. Returns headers unchanged if no cookies match.")
+  (defn apply-to-headers [jar url headers]
+    (match (cookie-header jar url)
+      (Maybe.Nothing) @headers
+      (Maybe.Just hdr) (Map.put @headers &@"Cookie" &[hdr])))
+
+  (doc size "returns the number of cookies stored.")
+  (defn size [jar] (Array.length (cookies jar)))
+
+  (doc clear! "removes all cookies.")
+  (defn clear! [jar] (set-cookies! jar (the (Array Cookie) []))))