dream: flash messages — single-request cookie store + 14 tests

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

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