From 55ec0b8f6401e52263154898947910aef6ccc0fa Mon Sep 17 00:00:00 2001 From: giles Date: Sun, 7 Jun 2026 14:35:46 +0000 Subject: [PATCH] dream: cookie-backed sessions + in-memory store + 30 tests Co-Authored-By: Claude Opus 4.8 (1M context) --- lib/dream/conformance.sh | 2 + lib/dream/session.sx | 170 +++++++++++++++++++++++++++++++++++++ lib/dream/tests/session.sx | 156 ++++++++++++++++++++++++++++++++++ plans/dream-on-sx.md | 16 +++- 4 files changed, 343 insertions(+), 1 deletion(-) create mode 100644 lib/dream/session.sx create mode 100644 lib/dream/tests/session.sx diff --git a/lib/dream/conformance.sh b/lib/dream/conformance.sh index 03b0118d..b8133df7 100644 --- a/lib/dream/conformance.sh +++ b/lib/dream/conformance.sh @@ -25,6 +25,7 @@ MODULES=( "lib/dream/types.sx" "lib/dream/router.sx" "lib/dream/middleware.sx" + "lib/dream/session.sx" ) # Suites: NAME RUNNER-FN PATH @@ -32,6 +33,7 @@ SUITES=( "types dream-ty-tests-run! lib/dream/tests/types.sx" "router dream-rt-tests-run! lib/dream/tests/router.sx" "middleware dream-mw-tests-run! lib/dream/tests/middleware.sx" + "session dream-ss-tests-run! lib/dream/tests/session.sx" ) TMPFILE=$(mktemp); trap "rm -f $TMPFILE" EXIT diff --git a/lib/dream/session.sx b/lib/dream/session.sx new file mode 100644 index 00000000..5ca4c818 --- /dev/null +++ b/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)))) diff --git a/lib/dream/tests/session.sx b/lib/dream/tests/session.sx new file mode 100644 index 00000000..7706af27 --- /dev/null +++ b/lib/dream/tests/session.sx @@ -0,0 +1,156 @@ +;; lib/dream/tests/session.sx — cookies, store, session round-trip. + +(define dream-ss-pass 0) +(define dream-ss-fail 0) +(define dream-ss-fails (list)) + +(define + dream-ss-test + (fn + (name actual expected) + (if + (= actual expected) + (set! dream-ss-pass (+ dream-ss-pass 1)) + (begin + (set! dream-ss-fail (+ dream-ss-fail 1)) + (append! dream-ss-fails {:name name :actual actual :expected expected}))))) + +;; ── cookie parsing ───────────────────────────────────────────────── +(define dream-ss-creq (dream-request "GET" "/" {:Cookie "a=1; b=2; dream.session=s9"} "")) +(dream-ss-test "parse cookie a" (dream-cookie dream-ss-creq "a") "1") +(dream-ss-test "parse cookie b" (dream-cookie dream-ss-creq "b") "2") +(dream-ss-test + "parse session cookie" + (dream-cookie dream-ss-creq "dream.session") + "s9") +(dream-ss-test "missing cookie nil" (dream-cookie dream-ss-creq "z") nil) +(dream-ss-test + "no cookie header" + (dream-cookie (dream-request "GET" "/" {} "") "a") + nil) + +;; ── cookie building ──────────────────────────────────────────────── +(dream-ss-test + "build basic cookie" + (dr/build-cookie "k" "v" {}) + "k=v; Path=/") +(dream-ss-test + "build httponly samesite" + (dr/build-cookie "sid" "x" {:http-only true :same-site "Lax"}) + "sid=x; Path=/; HttpOnly; SameSite=Lax") +(dream-ss-test + "build max-age" + (dr/build-cookie "k" "v" {:max-age 0}) + "k=v; Path=/; Max-Age=0") +(dream-ss-test + "set-cookie appends" + (len + (dream-resp-cookies + (dream-set-cookie (dream-html "x") "k" "v" {}))) + 1) +(dream-ss-test + "set-cookie two" + (len + (dream-resp-cookies + (dream-set-cookie + (dream-set-cookie (dream-html "x") "a" "1" {}) + "b" + "2" + {}))) + 2) +(dream-ss-test + "drop cookie max-age 0" + (contains? + (first (dream-resp-cookies (dream-drop-cookie (dream-html "x") "k"))) + "Max-Age=0") + true) + +;; ── in-memory store ──────────────────────────────────────────────── +(define dream-ss-store (dream-memory-sessions)) +(define dream-ss-sid (dream-ss-store {:op "session/create"})) +(dream-ss-test "create returns id" dream-ss-sid "s1") +(dream-ss-test "new session exists" (dream-ss-store {:op "session/exists" :sid "s1"}) true) +(dream-ss-test "absent session not exists" (dream-ss-store {:op "session/exists" :sid "s99"}) false) +(dream-ss-test "get missing key nil" (dream-ss-store {:key "k" :op "session/get" :sid "s1"}) nil) +(dream-ss-store {:val "ada" :key "user" :op "session/set" :sid "s1"}) +(dream-ss-test "set then get" (dream-ss-store {:key "user" :op "session/get" :sid "s1"}) "ada") +(dream-ss-store {:val "admin" :key "role" :op "session/set" :sid "s1"}) +(dream-ss-test "load all fields" (dream-ss-store {:op "session/load" :sid "s1"}) {:role "admin" :user "ada"}) +(dream-ss-test "second create distinct" (dream-ss-store {:op "session/create"}) "s2") +(dream-ss-store {:op "session/clear" :sid "s1"}) +(dream-ss-test "clear removes" (dream-ss-store {:op "session/exists" :sid "s1"}) false) + +;; ── middleware round-trip ────────────────────────────────────────── +(define dream-ss-backend (dream-memory-sessions)) +(define + dream-ss-counter-h + (fn + (req) + (let + ((n (or (dream-session-field req "count") 0))) + (begin + (dream-set-session-field req "count" (+ n 1)) + (dream-text (str "count=" (+ n 1))))))) +(define dream-ss-app ((dream-sessions dream-ss-backend) dream-ss-counter-h)) + +;; first request: no cookie -> creates session, sets cookie +(define dream-ss-r1 (dream-ss-app (dream-request "GET" "/" {} ""))) +(dream-ss-test "first body count=1" (dream-resp-body dream-ss-r1) "count=1") +(dream-ss-test + "first sets one cookie" + (len (dream-resp-cookies dream-ss-r1)) + 1) +(dream-ss-test + "session cookie name+id" + (contains? (first (dream-resp-cookies dream-ss-r1)) "dream.session=s1") + true) +(dream-ss-test + "session cookie httponly" + (contains? (first (dream-resp-cookies dream-ss-r1)) "HttpOnly") + true) + +;; second request: carries the cookie -> reuses, sees prior count, no new cookie +(define dream-ss-r2 (dream-ss-app (dream-request "GET" "/" {:Cookie "dream.session=s1"} ""))) +(dream-ss-test "second body count=2" (dream-resp-body dream-ss-r2) "count=2") +(dream-ss-test + "second sets no cookie" + (len (dream-resp-cookies dream-ss-r2)) + 0) + +;; third request continues +(define dream-ss-r3 (dream-ss-app (dream-request "GET" "/" {:Cookie "dream.session=s1"} ""))) +(dream-ss-test "third body count=3" (dream-resp-body dream-ss-r3) "count=3") + +;; unknown cookie id -> fresh session created +(define dream-ss-r4 (dream-ss-app (dream-request "GET" "/" {:Cookie "dream.session=bogus"} ""))) +(dream-ss-test + "bogus id starts fresh" + (dream-resp-body dream-ss-r4) + "count=1") +(dream-ss-test + "bogus id gets new cookie" + (len (dream-resp-cookies dream-ss-r4)) + 1) + +;; ── session-all + invalidate via middleware ──────────────────────── +(define + dream-ss-inspect-h + (fn (req) (dream-text (str (dream-session-all req))))) +(define dream-ss-app2 ((dream-sessions dream-ss-backend) dream-ss-inspect-h)) +(define dream-ss-r5 (dream-ss-app2 (dream-request "GET" "/" {:Cookie "dream.session=s1"} ""))) +(dream-ss-test + "session-all shows count" + (dream-session-all + (assoc (dream-request "GET" "/" {} "") :dream-session {:io dream-ss-backend :sid "s1"})) + {:count 3}) + +(define + dream-ss-invalidate-h + (fn (req) (begin (dream-invalidate-session req) (dream-text "bye")))) +(define + dream-ss-app3 + ((dream-sessions dream-ss-backend) dream-ss-invalidate-h)) +(dream-ss-app3 (dream-request "GET" "/" {:Cookie "dream.session=s1"} "")) +(dream-ss-test "invalidate clears store" (dream-ss-backend {:op "session/exists" :sid "s1"}) false) + +(define dream-ss-tests-run! (fn () {:total (+ dream-ss-pass dream-ss-fail) :passed dream-ss-pass :failed dream-ss-fail :fails dream-ss-fails})) diff --git a/plans/dream-on-sx.md b/plans/dream-on-sx.md index 2b373bf0..cbf84f1f 100644 --- a/plans/dream-on-sx.md +++ b/plans/dream-on-sx.md @@ -56,7 +56,7 @@ The five types: `request`, `response`, `handler = request -> response`, `middlew - `dream-no-middleware` — identity. - Logger: `(dream-logger next req)` — logs method, path, status, timing. - Content-type sniffer. -- [ ] **Sessions** in `lib/dream/session.sx`: +- [x] **Sessions** in `lib/dream/session.sx`: - Cookie-backed session middleware. - `dream-session-field req key`, `dream-set-session-field req key val`. - `dream-invalidate-session req`. @@ -128,6 +128,20 @@ Confirm scope before starting; some of these may be addable as Dream-internal he `dream-log-line` formats one line. `dream-content-type` sniffs body (`<`→html, `{`/`[`→json, else text) only when the handler left Content-Type unset. Bonus `dream-set-header` and `dream-tap-request` combinators. +- **2026-06-07 — Sessions** (`lib/dream/session.sx`, 30 tests). Solved the + request→response mutation-visibility problem the way Dream does: the cookie carries + only a session id; fields live in an injectable back-end store (the mapping table's + `(perform (:session-get …))`). `dream-memory-sessions` is an in-memory store built + on a `set!`-mutated captured `let` binding (no `ref`/`atom` in base env); + `dream-perform-sessions` is the production back-end. `dream-sessions backend` + middleware reads/creates the id, attaches `{:sid :io}` to the request, and emits a + `Set-Cookie` (HttpOnly, SameSite=Lax) only for new sessions. Handler API: + `dream-session-field` / `dream-set-session-field` / `dream-session-all` / + `dream-invalidate-session` / `dream-session-id`. Also added shared cookie infra + (`dr/parse-cookies`, `dream-cookie(s)`, `dr/build-cookie`, `dream-set-cookie`, + `dream-resp-cookies`, `dream-drop-cookie`) — outgoing cookies accumulate in a + `:set-cookies` list on the response so multiple Set-Cookie headers don't collide; + reused by flash + CSRF. Full counter round-trip verified across three requests. ## Blockers