Add cookie jar for automatic cookie management

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)))

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) []))))