dream: cookie-backed sessions + in-memory store + 30 tests

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>

lib/dream/session.sx

@@ -0,0 +1,170 @@
+;; lib/dream/session.sx — Dream-on-SX cookie-backed sessions.
+;; The session cookie carries only a session id; fields live in a back-end store.
+;; The store is injectable: production wires it to (perform op); tests pass an
+;; in-memory store. Depends on types.sx. Also hosts shared cookie helpers reused
+;; by flash.sx and form.sx.
+
+;; ── cookie helpers (shared) ────────────────────────────────────────
+(define
+  dr/parse-cookies
+  (fn
+    (header)
+    (if
+      (or (nil? header) (= header ""))
+      {}
+      (reduce
+        (fn
+          (acc part)
+          (let
+            ((kv (trim part)))
+            (let
+              ((j (index-of kv "=")))
+              (if
+                (< j 0)
+                acc
+                (assoc
+                  acc
+                  (substr kv 0 j)
+                  (substr kv (+ j 1)))))))
+        {}
+        (split header ";")))))
+
+(define
+  dream-cookie
+  (fn (req name) (get (dr/parse-cookies (dream-header req "cookie")) name)))
+(define
+  dream-cookies
+  (fn (req) (dr/parse-cookies (dream-header req "cookie"))))
+
+(define
+  dr/build-cookie
+  (fn
+    (name val opts)
+    (let
+      ((o (if (nil? opts) {} opts)))
+      (str
+        name
+        "="
+        val
+        "; Path="
+        (or (get o :path) "/")
+        (if (get o :http-only) "; HttpOnly" "")
+        (if (get o :secure) "; Secure" "")
+        (if (get o :same-site) (str "; SameSite=" (get o :same-site)) "")
+        (if (get o :max-age) (str "; Max-Age=" (get o :max-age)) "")))))
+
+(define
+  dream-set-cookie
+  (fn
+    (resp name val opts)
+    (assoc
+      resp
+      :set-cookies (concat
+        (or (get resp :set-cookies) (list))
+        (list (dr/build-cookie name val opts))))))
+
+(define
+  dream-resp-cookies
+  (fn (resp) (or (get resp :set-cookies) (list))))
+
+;; expire a cookie on the client
+(define
+  dream-drop-cookie
+  (fn (resp name) (dream-set-cookie resp name "" {:max-age 0})))
+
+;; ── in-memory session store (tests + demos) ────────────────────────
+;; A backend is (fn (op) result) where op is a dict {:op ... :sid ... :key ...}.
+(define
+  dream-memory-sessions
+  (fn
+    ()
+    (let
+      ((store {}) (counter 0))
+      (fn
+        (op)
+        (let
+          ((kind (get op :op)))
+          (cond
+            ((= kind "session/create")
+              (begin
+                (set! counter (+ counter 1))
+                (let
+                  ((sid (str "s" counter)))
+                  (begin (set! store (assoc store sid {})) sid))))
+            ((= kind "session/exists") (has-key? store (get op :sid)))
+            ((= kind "session/get")
+              (get (or (get store (get op :sid)) {}) (get op :key)))
+            ((= kind "session/set")
+              (let
+                ((sid (get op :sid)))
+                (set!
+                  store
+                  (assoc
+                    store
+                    sid
+                    (assoc
+                      (or (get store sid) {})
+                      (get op :key)
+                      (get op :val))))))
+            ((= kind "session/load")
+              (or (get store (get op :sid)) {}))
+            ((= kind "session/clear")
+              (set! store (dissoc store (get op :sid))))
+            (else nil)))))))
+
+;; production back-end: every op suspends to the host
+(define dream-perform-sessions (fn (op) (perform op)))
+
+;; ── session middleware ─────────────────────────────────────────────
+(define dream-session-cookie-name "dream.session")
+
+(define
+  dream-sessions
+  (fn
+    (backend)
+    (fn
+      (next)
+      (fn
+        (req)
+        (let
+          ((sid0 (dream-cookie req dream-session-cookie-name)))
+          (let
+            ((have (and sid0 (backend {:op "session/exists" :sid sid0}))))
+            (let
+              ((sid (if have sid0 (backend {:op "session/create"}))))
+              (let
+                ((resp (next (assoc req :dream-session {:io backend :sid sid}))))
+                (if
+                  have
+                  resp
+                  (dream-set-cookie
+                    resp
+                    dream-session-cookie-name
+                    sid
+                    {:path "/" :http-only true :same-site "Lax"}))))))))))
+
+;; ── handler-facing session API ─────────────────────────────────────
+(define dr/session-of (fn (req) (get req :dream-session)))
+(define dream-session-id (fn (req) (get (dr/session-of req) :sid)))
+
+(define
+  dream-session-field
+  (fn
+    (req key)
+    (let ((s (dr/session-of req))) ((get s :io) {:key key :op "session/get" :sid (get s :sid)}))))
+
+(define
+  dream-set-session-field
+  (fn
+    (req key val)
+    (let ((s (dr/session-of req))) (begin ((get s :io) {:val val :key key :op "session/set" :sid (get s :sid)}) req))))
+
+(define
+  dream-session-all
+  (fn (req) (let ((s (dr/session-of req))) ((get s :io) {:op "session/load" :sid (get s :sid)}))))
+
+(define
+  dream-invalidate-session
+  (fn
+    (req)
+    (let ((s (dr/session-of req))) (begin ((get s :io) {:op "session/clear" :sid (get s :sid)}) req))))