diff --git a/README.md b/README.md index 2382ac7..9a18a40 100644 --- a/README.md +++ b/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 diff --git a/gendocs.carp b/gendocs.carp index 4b1cc6d..07211b1 100644 --- a/gendocs.carp +++ b/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) diff --git a/http-client.carp b/http-client.carp index b0049cf..41b55c8 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") @@ -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))) diff --git a/src/cookie-jar.carp b/src/cookie-jar.carp new file mode 100644 index 0000000..1c47b40 --- /dev/null +++ b/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) [])))) diff --git a/test/cookie-jar.carp b/test/cookie-jar.carp new file mode 100644 index 0000000..f4f7a53 --- /dev/null +++ b/test/cookie-jar.carp @@ -0,0 +1,448 @@ +(defn cookie-jar-tests [test] + (do + (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") + + (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") + + (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") + + (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") + + (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") + + (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") + + (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") + + (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") + + (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") + + (assert-equal test + 0 + (let-do [jar (CookieJar.create)] + (CookieJar.store! &jar + &(Cookie.init @"n" + @"v" + @"/" + (Maybe.Just + (Datetime.init 2020 + 1 + 1 + (Maybe.Just 0) + (Maybe.Just 0) + (Maybe.Just 0) + (Maybe.Nothing) + (Maybe.Nothing))) + (Maybe.Just @"example.com") + false + false + (SameSite.Lax))) + (Array.length &(CookieJar.matching &jar "https://example.com/"))) + "expired cookie is not returned by matching") + + (assert-equal test + 1 + (let-do [jar (CookieJar.create) + resp (Response.init 200 + @"OK" + @"HTTP/1.1" + [(Cookie.init @"sid" + @"abc" + @"/" + (Maybe.Nothing) + (Maybe.Just @"other.com") + false + false + (SameSite.Lax))] + (the (Map String (Array String)) {}) + @"")] + (CookieJar.store-response! &jar &resp "https://example.com/login") + (Array.length &(CookieJar.matching &jar "https://other.com/"))) + "store-response! preserves explicit Domain attribute") + + (assert-equal test + 0 + (let-do [jar (CookieJar.create) + resp (Response.init 200 + @"OK" + @"HTTP/1.1" + [(Cookie.init @"sid" + @"abc" + @"/" + (Maybe.Nothing) + (Maybe.Just @"other.com") + 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/"))) + "explicit Domain cookie does not match request host") + + (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") + + test)) diff --git a/test/http-client.carp b/test/http-client.carp index 52404d6..4b55961 100644 --- a/test/http-client.carp +++ b/test/http-client.carp @@ -3,6 +3,8 @@ (use Test) +(load "cookie-jar.carp") + (deftest test (assert-true test (Result.success? &(Client.get "https://example.com/")) @@ -328,4 +330,6 @@ (Result.Success r) (String.contains-string? (Response.body &r) "file contents") _ false) - "post-multipart file part is echoed back by httpbin")) + "post-multipart file part is echoed back by httpbin") + + (set! test (cookie-jar-tests test)))