From aa19e510bfa6dd25b863b30c5fdf09c2196d4ead Mon Sep 17 00:00:00 2001 From: "carpentry-heartbeat[bot]" Date: Mon, 15 Jun 2026 17:00:15 +0200 Subject: [PATCH] Add cookie jar for automatic cookie management Introduces CookieJar type that stores cookies from Set-Cookie response headers and automatically replays matching cookies on subsequent requests. Cookies are matched by domain (suffix), path (prefix), Secure flag, and expiry. Adds jar-aware Client functions (get-with-jar, post-with-jar, etc.) that integrate cookie handling into the redirect loop. --- http-client.carp | 169 ++++++++++++++++- src/cookie-jar.carp | 126 +++++++++++++ test/cookie-jar.carp | 427 +++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 721 insertions(+), 1 deletion(-) create mode 100644 src/cookie-jar.carp create mode 100644 test/cookie-jar.carp diff --git a/http-client.carp b/http-client.carp index 65348a3..b35c5fd 100644 --- a/http-client.carp +++ b/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") @@ -682,4 +683,170 @@ 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))) + + ; ========================================================================= + ; Cookie jar — automatic cookie management + ; ========================================================================= + + (hidden request-stream-with-jar-) + (private request-stream-with-jar-) + ; Like request-stream- but stores/replays cookies via a CookieJar. + (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))) diff --git a/src/cookie-jar.carp b/src/cookie-jar.carp new file mode 100644 index 0000000..3030bf0 --- /dev/null +++ b/src/cookie-jar.carp @@ -0,0 +1,126 @@ +; 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] + (if (Cookie.expired? c) + acc + (if (and @(Cookie.secure c) (not is-secure)) + acc + (match-ref (Cookie.domain c) + (Maybe.Nothing) acc + (Maybe.Just d) + (if (and (domain-matches? d &host) + (path-matches? (Cookie.path c) &path)) + (Array.push-back acc @c) + acc))))) + (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) [])))) diff --git a/test/cookie-jar.carp b/test/cookie-jar.carp new file mode 100644 index 0000000..02a7845 --- /dev/null +++ b/test/cookie-jar.carp @@ -0,0 +1,427 @@ +(load "Test.carp") +(load "../http-client.carp") + +(use Test) + +(deftest test + ; ========================================================================= + ; CookieJar basics + ; ========================================================================= + + (assert-equal test + 0 + (CookieJar.size &(CookieJar.create)) + "empty jar has size 0") + + (assert-equal test + 1 + (let-do [jar (CookieJar.create)] + (CookieJar.store! &jar + &(Cookie.init @"name" + @"value" + @"/" + (Maybe.Nothing) + (Maybe.Just @"example.com") + false + false + (SameSite.Lax))) + (CookieJar.size &jar)) + "store! adds a cookie") + + ; ========================================================================= + ; Deduplication + ; ========================================================================= + + (assert-equal test + 1 + (let-do [jar (CookieJar.create)] + (CookieJar.store! &jar + &(Cookie.init @"name" + @"val1" + @"/" + (Maybe.Nothing) + (Maybe.Just @"example.com") + false + false + (SameSite.Lax))) + (CookieJar.store! &jar + &(Cookie.init @"name" + @"val2" + @"/" + (Maybe.Nothing) + (Maybe.Just @"example.com") + false + false + (SameSite.Lax))) + (CookieJar.size &jar)) + "store! replaces cookie with same name/domain/path") + + (assert-equal test + 2 + (let-do [jar (CookieJar.create)] + (CookieJar.store! &jar + &(Cookie.init @"name" + @"val1" + @"/" + (Maybe.Nothing) + (Maybe.Just @"a.com") + false + false + (SameSite.Lax))) + (CookieJar.store! &jar + &(Cookie.init @"name" + @"val2" + @"/" + (Maybe.Nothing) + (Maybe.Just @"b.com") + false + false + (SameSite.Lax))) + (CookieJar.size &jar)) + "same name but different domain keeps both") + + ; ========================================================================= + ; Domain matching + ; ========================================================================= + + (assert-equal test + 1 + (let-do [jar (CookieJar.create)] + (CookieJar.store! &jar + &(Cookie.init @"n" + @"v" + @"/" + (Maybe.Nothing) + (Maybe.Just @"example.com") + false + false + (SameSite.Lax))) + (Array.length &(CookieJar.matching &jar "https://example.com/"))) + "matches exact domain") + + (assert-equal test + 1 + (let-do [jar (CookieJar.create)] + (CookieJar.store! &jar + &(Cookie.init @"n" + @"v" + @"/" + (Maybe.Nothing) + (Maybe.Just @"example.com") + false + false + (SameSite.Lax))) + (Array.length &(CookieJar.matching &jar "https://sub.example.com/"))) + "matches subdomain") + + (assert-equal test + 1 + (let-do [jar (CookieJar.create)] + (CookieJar.store! &jar + &(Cookie.init @"n" + @"v" + @"/" + (Maybe.Nothing) + (Maybe.Just @".example.com") + false + false + (SameSite.Lax))) + (Array.length &(CookieJar.matching &jar "https://sub.example.com/"))) + "matches subdomain with leading-dot domain") + + (assert-equal test + 0 + (let-do [jar (CookieJar.create)] + (CookieJar.store! &jar + &(Cookie.init @"n" + @"v" + @"/" + (Maybe.Nothing) + (Maybe.Just @"example.com") + false + false + (SameSite.Lax))) + (Array.length &(CookieJar.matching &jar "https://other.com/"))) + "does not match different domain") + + (assert-equal test + 0 + (let-do [jar (CookieJar.create)] + (CookieJar.store! &jar + &(Cookie.init @"n" + @"v" + @"/" + (Maybe.Nothing) + (Maybe.Just @"sub.example.com") + false + false + (SameSite.Lax))) + (Array.length &(CookieJar.matching &jar "https://example.com/"))) + "subdomain cookie does not match parent domain") + + ; ========================================================================= + ; Path matching + ; ========================================================================= + + (assert-equal test + 1 + (let-do [jar (CookieJar.create)] + (CookieJar.store! &jar + &(Cookie.init @"n" + @"v" + @"/api" + (Maybe.Nothing) + (Maybe.Just @"example.com") + false + false + (SameSite.Lax))) + (Array.length &(CookieJar.matching &jar "https://example.com/api/users"))) + "matches path prefix") + + (assert-equal test + 0 + (let-do [jar (CookieJar.create)] + (CookieJar.store! &jar + &(Cookie.init @"n" + @"v" + @"/api" + (Maybe.Nothing) + (Maybe.Just @"example.com") + false + false + (SameSite.Lax))) + (Array.length &(CookieJar.matching &jar "https://example.com/other"))) + "does not match different path") + + (assert-equal test + 0 + (let-do [jar (CookieJar.create)] + (CookieJar.store! &jar + &(Cookie.init @"n" + @"v" + @"/api" + (Maybe.Nothing) + (Maybe.Just @"example.com") + false + false + (SameSite.Lax))) + (Array.length &(CookieJar.matching &jar "https://example.com/apiary"))) + "path /api does not match /apiary") + + (assert-equal test + 1 + (let-do [jar (CookieJar.create)] + (CookieJar.store! &jar + &(Cookie.init @"n" + @"v" + @"/" + (Maybe.Nothing) + (Maybe.Just @"example.com") + false + false + (SameSite.Lax))) + (Array.length &(CookieJar.matching &jar "https://example.com/anything"))) + "root path matches everything") + + ; ========================================================================= + ; Secure flag + ; ========================================================================= + + (assert-equal test + 0 + (let-do [jar (CookieJar.create)] + (CookieJar.store! &jar + &(Cookie.init @"n" + @"v" + @"/" + (Maybe.Nothing) + (Maybe.Just @"example.com") + true + false + (SameSite.Lax))) + (Array.length &(CookieJar.matching &jar "http://example.com/"))) + "secure cookie not sent over HTTP") + + (assert-equal test + 1 + (let-do [jar (CookieJar.create)] + (CookieJar.store! &jar + &(Cookie.init @"n" + @"v" + @"/" + (Maybe.Nothing) + (Maybe.Just @"example.com") + true + false + (SameSite.Lax))) + (Array.length &(CookieJar.matching &jar "https://example.com/"))) + "secure cookie sent over HTTPS") + + ; ========================================================================= + ; Cookie header generation + ; ========================================================================= + + (assert-equal test + &(Maybe.Just @"name=value") + &(let-do [jar (CookieJar.create)] + (CookieJar.store! &jar + &(Cookie.init @"name" + @"value" + @"/" + (Maybe.Nothing) + (Maybe.Just @"example.com") + false + false + (SameSite.Lax))) + (CookieJar.cookie-header &jar "https://example.com/")) + "cookie-header produces name=value") + + (assert-equal test + &(Maybe.Just @"a=1; b=2") + &(let-do [jar (CookieJar.create)] + (CookieJar.store! &jar + &(Cookie.init @"a" + @"1" + @"/" + (Maybe.Nothing) + (Maybe.Just @"example.com") + false + false + (SameSite.Lax))) + (CookieJar.store! &jar + &(Cookie.init @"b" + @"2" + @"/" + (Maybe.Nothing) + (Maybe.Just @"example.com") + false + false + (SameSite.Lax))) + (CookieJar.cookie-header &jar "https://example.com/")) + "cookie-header joins multiple cookies with semicolon") + + (assert-true test + (let-do [jar (CookieJar.create)] + (Maybe.nothing? &(CookieJar.cookie-header &jar "https://example.com/"))) + "cookie-header returns Nothing for empty jar") + + ; ========================================================================= + ; apply-to-headers + ; ========================================================================= + + (assert-true test + (let-do [jar (CookieJar.create)] + (CookieJar.store! &jar + &(Cookie.init @"s" + @"abc" + @"/" + (Maybe.Nothing) + (Maybe.Just @"example.com") + false + false + (SameSite.Lax))) + (let [hdrs (CookieJar.apply-to-headers &jar + "https://example.com/" + &(the (Map String (Array String)) + {})) + vs &(Map.get-with-default &hdrs &@"Cookie" &[])] + (and (> (Array.length vs) 0) + (String.contains-string? (Array.unsafe-first vs) "s=abc")))) + "apply-to-headers adds Cookie header") + + (assert-true test + (let-do [jar (CookieJar.create)] + (let [hdrs (CookieJar.apply-to-headers &jar + "https://example.com/" + &{@"X-Custom" [@"val"]}) + cookie-vs &(Map.get-with-default &hdrs &@"Cookie" &[]) + custom-vs &(Map.get-with-default &hdrs &@"X-Custom" &[])] + (and (= (Array.length cookie-vs) 0) (> (Array.length custom-vs) 0)))) + "apply-to-headers preserves existing headers when no cookies match") + + ; ========================================================================= + ; store-response! + ; ========================================================================= + + (assert-equal test + 1 + (let-do [jar (CookieJar.create) + resp (Response.init 200 + @"OK" + @"HTTP/1.1" + [(Cookie.init @"sid" + @"abc" + @"/" + (Maybe.Nothing) + (Maybe.Nothing) + false + false + (SameSite.Lax))] + (the (Map String (Array String)) {}) + @"")] + (CookieJar.store-response! &jar &resp "https://example.com/login") + (CookieJar.size &jar)) + "store-response! extracts cookies from response") + + (assert-equal test + 1 + (let-do [jar (CookieJar.create) + resp (Response.init 200 + @"OK" + @"HTTP/1.1" + [(Cookie.init @"sid" + @"abc" + @"/" + (Maybe.Nothing) + (Maybe.Nothing) + false + false + (SameSite.Lax))] + (the (Map String (Array String)) {}) + @"")] + (CookieJar.store-response! &jar &resp "https://example.com/login") + (Array.length &(CookieJar.matching &jar "https://example.com/"))) + "store-response! defaults domain from URL so cookies match") + + ; ========================================================================= + ; clear! + ; ========================================================================= + + (assert-equal test + 0 + (let-do [jar (CookieJar.create)] + (CookieJar.store! &jar + &(Cookie.init @"n" + @"v" + @"/" + (Maybe.Nothing) + (Maybe.Just @"example.com") + false + false + (SameSite.Lax))) + (CookieJar.clear! &jar) + (CookieJar.size &jar)) + "clear! removes all cookies") + + ; ========================================================================= + ; Integration: cookie round-trip via httpbin + ; ========================================================================= + + (assert-true test + (let-do [jar (CookieJar.create)] + (match (Client.get-with-jar + "https://httpbin.org/cookies/set/testcookie/testvalue" + &jar) + (Result.Success r) + (String.contains-string? (Response.body &r) "testcookie") + _ false)) + "cookie jar stores and replays cookies through redirect") + + (assert-true test + (let-do [jar (CookieJar.create)] + (match (Client.get-with-jar + "https://httpbin.org/cookies/set/mycookie/myvalue" + &jar) + _ ()) + (> (CookieJar.size &jar) 0)) + "jar has cookies after visiting set-cookie endpoint"))