From edff7735e777d571566ea95cc5e23d2773a19f95 Mon Sep 17 00:00:00 2001 From: giles Date: Sun, 7 Jun 2026 14:38:26 +0000 Subject: [PATCH] =?UTF-8?q?dream:=20flash=20messages=20=E2=80=94=20single-?= =?UTF-8?q?request=20cookie=20store=20+=2014=20tests?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Co-Authored-By: Claude Opus 4.8 (1M context) --- lib/dream/conformance.sh | 2 + lib/dream/flash.sx | 91 +++++++++++++++++++++++++++ lib/dream/tests/flash.sx | 129 +++++++++++++++++++++++++++++++++++++++ plans/dream-on-sx.md | 11 +++- 4 files changed, 232 insertions(+), 1 deletion(-) create mode 100644 lib/dream/flash.sx create mode 100644 lib/dream/tests/flash.sx diff --git a/lib/dream/conformance.sh b/lib/dream/conformance.sh index b8133df7..3dd4c7df 100644 --- a/lib/dream/conformance.sh +++ b/lib/dream/conformance.sh @@ -26,6 +26,7 @@ MODULES=( "lib/dream/router.sx" "lib/dream/middleware.sx" "lib/dream/session.sx" + "lib/dream/flash.sx" ) # Suites: NAME RUNNER-FN PATH @@ -34,6 +35,7 @@ SUITES=( "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" + "flash dream-fl-tests-run! lib/dream/tests/flash.sx" ) TMPFILE=$(mktemp); trap "rm -f $TMPFILE" EXIT diff --git a/lib/dream/flash.sx b/lib/dream/flash.sx new file mode 100644 index 00000000..c026fdf6 --- /dev/null +++ b/lib/dream/flash.sx @@ -0,0 +1,91 @@ +;; lib/dream/flash.sx — Dream-on-SX flash messages. +;; A single-request cookie store: messages added during one request are read on +;; the NEXT request, then the cookie is cleared. Depends on types.sx + session.sx +;; (shared cookie helpers). A message is {:category c :message m}. + +;; ── cookie codec ─────────────────────────────────────────────────── +;; escape the field separators so categories/messages round-trip safely +(define + dr/flash-esc + (fn (s) (replace (replace (replace s "%" "%25") "|" "%7C") "~" "%7E"))) +(define + dr/flash-unesc + (fn (s) (replace (replace (replace s "%7E" "~") "%7C" "|") "%25" "%"))) + +(define + dr/flash-encode + (fn + (msgs) + (join + "~" + (map + (fn + (m) + (str + (dr/flash-esc (get m :category)) + "|" + (dr/flash-esc (get m :message)))) + msgs)))) + +(define + dr/flash-decode + (fn + (s) + (if + (= s "") + (list) + (map + (fn (part) (let ((i (index-of part "|"))) {:message (dr/flash-unesc (substr part (+ i 1))) :category (dr/flash-unesc (substr part 0 i))})) + (split s "~"))))) + +;; ── mutable outbox cell ──────────────────────────────────────────── +(define dr/flash-box (fn () (let ((items (list))) {:add (fn (x) (set! items (concat items (list x)))) :get (fn () items)}))) + +;; ── middleware ───────────────────────────────────────────────────── +(define dream-flash-cookie-name "dream.flash") + +(define + dream-flash + (fn + (next) + (fn + (req) + (let + ((incoming (dr/flash-decode (or (dream-cookie req dream-flash-cookie-name) ""))) + (box (dr/flash-box))) + (let + ((resp (next (assoc req :dream-flash {:box box :incoming incoming})))) + (let + ((out ((get box :get)))) + (cond + ((not (empty? out)) + (dream-set-cookie + resp + dream-flash-cookie-name + (dr/flash-encode out) + {:path "/" :http-only true :same-site "Lax"})) + ((not (empty? incoming)) + (dream-drop-cookie resp dream-flash-cookie-name)) + (else resp)))))))) + +;; ── handler-facing API ───────────────────────────────────────────── +(define + dream-add-flash-message + (fn + (req category msg) + (begin ((get (get (get req :dream-flash) :box) :add) {:message msg :category category}) req))) + +(define + dream-flash-messages + (fn (req) (get (get req :dream-flash) :incoming))) +(define dream-flash-category (fn (m) (get m :category))) +(define dream-flash-message (fn (m) (get m :message))) + +;; convenience: only messages of a given category +(define + dream-flash-of + (fn + (req category) + (filter + (fn (m) (= (get m :category) category)) + (dream-flash-messages req)))) diff --git a/lib/dream/tests/flash.sx b/lib/dream/tests/flash.sx new file mode 100644 index 00000000..815f983b --- /dev/null +++ b/lib/dream/tests/flash.sx @@ -0,0 +1,129 @@ +;; lib/dream/tests/flash.sx — codec + read-after-write across requests. + +(define dream-fl-pass 0) +(define dream-fl-fail 0) +(define dream-fl-fails (list)) + +(define + dream-fl-test + (fn + (name actual expected) + (if + (= actual expected) + (set! dream-fl-pass (+ dream-fl-pass 1)) + (begin + (set! dream-fl-fail (+ dream-fl-fail 1)) + (append! dream-fl-fails {:name name :actual actual :expected expected}))))) + +;; ── codec ────────────────────────────────────────────────────────── +(dream-fl-test "encode one" (dr/flash-encode (list {:message "saved" :category "info"})) "info|saved") +(dream-fl-test + "encode two" + (dr/flash-encode (list {:message "a" :category "info"} {:message "b" :category "error"})) + "info|a~error|b") +(dream-fl-test "decode one" (dr/flash-decode "info|saved") (list {:message "saved" :category "info"})) +(dream-fl-test "decode empty" (dr/flash-decode "") (list)) +(dream-fl-test + "roundtrip special chars" + (dr/flash-decode (dr/flash-encode (list {:message "a~b%c" :category "x|y"}))) + (list {:message "a~b%c" :category "x|y"})) +(dream-fl-test "escape pipe" (dr/flash-encode (list {:message "a|b" :category "c"})) "c|a%7Cb") + +;; extract a cookie value from a Set-Cookie string +(define + dream-fl-cookie-val + (fn + (setc) + (let + ((after (substr setc (+ (index-of setc "=") 1)))) + (substr after 0 (index-of after ";"))))) + +;; ── read-after-write across requests ─────────────────────────────── +(define + dream-fl-set-h + (fn + (req) + (begin (dream-add-flash-message req "info" "Saved!") (dream-text "done")))) +(define dream-fl-set-app (dream-flash dream-fl-set-h)) + +;; request 1: add a flash, no incoming -> sets the flash cookie +(define + dream-fl-r1 + (dream-fl-set-app (dream-request "POST" "/save" {} ""))) +(dream-fl-test "writer body" (dream-resp-body dream-fl-r1) "done") +(dream-fl-test + "writer sets flash cookie" + (len (dream-resp-cookies dream-fl-r1)) + 1) +(dream-fl-test + "writer has no incoming" + (dream-flash-messages + (assoc (dream-request "GET" "/" {} "") :dream-flash {:box (dr/flash-box) :incoming (list)})) + (list)) + +;; request 2: carries the flash cookie -> handler reads it, cookie cleared +(define + dream-fl-cval + (dream-fl-cookie-val (first (dream-resp-cookies dream-fl-r1)))) +(define + dream-fl-read-h + (fn + (req) + (let + ((msgs (dream-flash-messages req))) + (dream-text + (if (empty? msgs) "none" (dream-flash-message (first msgs))))))) +(define dream-fl-read-app (dream-flash dream-fl-read-h)) +(define + dream-fl-r2 + (dream-fl-read-app (dream-request "GET" "/" {:Cookie (str "dream.flash=" dream-fl-cval)} ""))) +(dream-fl-test "reader sees message" (dream-resp-body dream-fl-r2) "Saved!") +(dream-fl-test + "reader clears cookie (Max-Age=0)" + (contains? (first (dream-resp-cookies dream-fl-r2)) "Max-Age=0") + true) + +;; request 3: no flash cookie -> nothing to read, no cookie set +(define + dream-fl-r3 + (dream-fl-read-app (dream-request "GET" "/" {} ""))) +(dream-fl-test "no flash -> none" (dream-resp-body dream-fl-r3) "none") +(dream-fl-test + "no flash -> no cookie" + (len (dream-resp-cookies dream-fl-r3)) + 0) + +;; ── multiple categories ──────────────────────────────────────────── +(define + dream-fl-multi-h + (fn + (req) + (begin + (dream-add-flash-message req "info" "i1") + (dream-add-flash-message req "error" "e1") + (dream-add-flash-message req "info" "i2") + (dream-text "ok")))) +(define + dream-fl-multi-r1 + ((dream-flash dream-fl-multi-h) (dream-request "GET" "/" {} ""))) +(define + dream-fl-multi-val + (dream-fl-cookie-val (first (dream-resp-cookies dream-fl-multi-r1)))) +(define + dream-fl-count-h + (fn + (req) + (dream-text + (str + (len (dream-flash-messages req)) + "/" + (len (dream-flash-of req "info")))))) +(define + dream-fl-multi-r2 + ((dream-flash dream-fl-count-h) (dream-request "GET" "/" {:Cookie (str "dream.flash=" dream-fl-multi-val)} ""))) +(dream-fl-test + "multi: all + filtered counts" + (dream-resp-body dream-fl-multi-r2) + "3/2") + +(define dream-fl-tests-run! (fn () {:total (+ dream-fl-pass dream-fl-fail) :passed dream-fl-pass :failed dream-fl-fail :fails dream-fl-fails})) diff --git a/plans/dream-on-sx.md b/plans/dream-on-sx.md index cbf84f1f..2da05160 100644 --- a/plans/dream-on-sx.md +++ b/plans/dream-on-sx.md @@ -60,7 +60,7 @@ The five types: `request`, `response`, `handler = request -> response`, `middlew - Cookie-backed session middleware. - `dream-session-field req key`, `dream-set-session-field req key val`. - `dream-invalidate-session req`. -- [ ] **Flash messages** in `lib/dream/flash.sx`: +- [x] **Flash messages** in `lib/dream/flash.sx`: - `dream-flash-middleware` — single-request cookie store. - `dream-add-flash-message req category msg`. - `dream-flash-messages req` — returns list of `(category, msg)`. @@ -142,6 +142,15 @@ Confirm scope before starting; some of these may be addable as Dream-internal he `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. +- **2026-06-07 — Flash** (`lib/dream/flash.sx`, 14 tests). `dream-flash` middleware: + decodes the incoming `dream.flash` cookie into the request, gives the handler a + mutable outbox cell (`dr/flash-box`, the same `set!`-captured-`let` trick), then on + response writes the outbox as a fresh flash cookie, or drops the cookie (Max-Age=0) + when there were incoming messages but no new ones — so messages show exactly once. + Handler API: `dream-add-flash-message` / `dream-flash-messages` (returns the + PREVIOUS request's messages) / `dream-flash-of` (by category) / accessors. Cookie + codec percent-escapes the `|`/`~`/`%` separators so categories/messages round-trip. + Read-after-write verified across request boundaries incl. multi-category. ## Blockers