From 8fc7469a3c8f7295f179549534061e7b35b2dada Mon Sep 17 00:00:00 2001 From: giles Date: Sun, 7 Jun 2026 14:27:05 +0000 Subject: [PATCH 01/22] =?UTF-8?q?dream:=20core=20types=20=E2=80=94=20reque?= =?UTF-8?q?st/response/route=20records=20+=2041=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 | 87 +++++++++++++++++++++++ lib/dream/tests/types.sx | 148 +++++++++++++++++++++++++++++++++++++++ lib/dream/types.sx | 146 ++++++++++++++++++++++++++++++++++++++ plans/dream-on-sx.md | 13 +++- 4 files changed, 391 insertions(+), 3 deletions(-) create mode 100644 lib/dream/conformance.sh create mode 100644 lib/dream/tests/types.sx create mode 100644 lib/dream/types.sx diff --git a/lib/dream/conformance.sh b/lib/dream/conformance.sh new file mode 100644 index 00000000..2ab78043 --- /dev/null +++ b/lib/dream/conformance.sh @@ -0,0 +1,87 @@ +#!/usr/bin/env bash +# dream-on-sx conformance runner — loads all dream modules + test suites in one +# sx_server process and reports pass/fail per suite. +# +# Usage: +# bash lib/dream/conformance.sh # run all suites +# bash lib/dream/conformance.sh -v # verbose (list each suite) + +set -uo pipefail +cd "$(git rev-parse --show-toplevel)" + +SX_SERVER="${SX_SERVER:-hosts/ocaml/_build/default/bin/sx_server.exe}" +if [ ! -x "$SX_SERVER" ]; then + SX_SERVER="/root/rose-ash/hosts/ocaml/_build/default/bin/sx_server.exe" +fi +if [ ! -x "$SX_SERVER" ]; then + echo "ERROR: sx_server.exe not found." >&2 + exit 1 +fi + +VERBOSE="${1:-}" + +# Dream library modules loaded before any test suite. +MODULES=( + "lib/dream/types.sx" +) + +# Suites: NAME RUNNER-FN PATH +SUITES=( + "types dream-ty-tests-run! lib/dream/tests/types.sx" +) + +TMPFILE=$(mktemp); trap "rm -f $TMPFILE" EXIT +EPOCH=1 +emit_load () { echo "(epoch $EPOCH)"; echo "(load \"$1\")"; EPOCH=$((EPOCH+1)); } +emit_eval () { echo "(epoch $EPOCH)"; echo "(eval \"$1\")"; EPOCH=$((EPOCH+1)); } + +{ + for M in "${MODULES[@]}"; do emit_load "$M"; done + for SUITE in "${SUITES[@]}"; do + read -r _NAME _RUNNER FILE <<< "$SUITE" + emit_load "$FILE" + emit_eval "($_RUNNER)" + done +} > "$TMPFILE" + +OUTPUT=$(timeout 540 "$SX_SERVER" < "$TMPFILE" 2>&1 || true) + +TOTAL_PASS=0 +TOTAL_FAIL=0 +FAILED_SUITES=() +LAST_DICT_LINES=$(echo "$OUTPUT" | grep -E '^\{:' || true) + +I=0 +while read -r LINE; do + [ -z "$LINE" ] && continue + P=$(echo "$LINE" | grep -oE ':passed [0-9]+' | awk '{print $2}') + F=$(echo "$LINE" | grep -oE ':failed [0-9]+' | awk '{print $2}') + [ -z "$P" ] && P=0 + [ -z "$F" ] && F=0 + SUITE_INFO="${SUITES[$I]}" + SUITE_NAME=$(echo "$SUITE_INFO" | awk '{print $1}') + TOTAL_PASS=$((TOTAL_PASS + P)) + TOTAL_FAIL=$((TOTAL_FAIL + F)) + if [ "$F" -gt 0 ]; then + FAILED_SUITES+=("$SUITE_NAME: $P/$((P+F))") + printf 'X %-12s %d/%d\n' "$SUITE_NAME" "$P" "$((P+F))" + echo "$LINE" | grep -oE ':name "[^"]*"' | sed 's/:name / fail: /' + elif [ "$VERBOSE" = "-v" ]; then + printf 'ok %-12s %d passed\n' "$SUITE_NAME" "$P" + fi + I=$((I+1)) +done <<< "$LAST_DICT_LINES" + +TOTAL=$((TOTAL_PASS + TOTAL_FAIL)) +if [ "$TOTAL" -eq 0 ]; then + echo "ERROR: no suite results parsed. Raw output:" >&2 + echo "$OUTPUT" >&2 + exit 1 +fi +if [ $TOTAL_FAIL -eq 0 ]; then + echo "ok $TOTAL_PASS/$TOTAL dream-on-sx tests passed (${#SUITES[@]} suites)" +else + echo "FAIL $TOTAL_PASS/$TOTAL passed, $TOTAL_FAIL failed:" + for S in "${FAILED_SUITES[@]}"; do echo " $S"; done + exit 1 +fi diff --git a/lib/dream/tests/types.sx b/lib/dream/tests/types.sx new file mode 100644 index 00000000..5b4f9893 --- /dev/null +++ b/lib/dream/tests/types.sx @@ -0,0 +1,148 @@ +;; lib/dream/tests/types.sx — request/response/route records. + +(define dream-ty-pass 0) +(define dream-ty-fail 0) +(define dream-ty-fails (list)) + +(define + dream-ty-test + (fn + (name actual expected) + (if + (= actual expected) + (set! dream-ty-pass (+ dream-ty-pass 1)) + (begin + (set! dream-ty-fail (+ dream-ty-fail 1)) + (append! dream-ty-fails {:name name :actual actual :expected expected}))))) + +;; ── request construction + accessors ─────────────────────────────── +(define + dream-ty-req + (dream-request "get" "/users/42?tab=info&x=1" {:X-Token "abc" :Content-Type "text/html"} "hello")) + +(dream-ty-test "method uppercased" (dream-method dream-ty-req) "GET") +(dream-ty-test "path strips query" (dream-path dream-ty-req) "/users/42") +(dream-ty-test + "target keeps query" + (dream-target dream-ty-req) + "/users/42?tab=info&x=1") +(dream-ty-test "body" (dream-body dream-ty-req) "hello") +(dream-ty-test + "header case-insensitive" + (dream-header dream-ty-req "content-type") + "text/html") +(dream-ty-test + "header mixed case" + (dream-header dream-ty-req "X-Token") + "abc") +(dream-ty-test + "missing header is nil" + (dream-header dream-ty-req "absent") + nil) +(dream-ty-test + "query param tab" + (dream-query-param dream-ty-req "tab") + "info") +(dream-ty-test "query param x" (dream-query-param dream-ty-req "x") "1") +(dream-ty-test "params empty by default" (dream-param dream-ty-req "id") nil) +(dream-ty-test "is a request" (dream-request? dream-ty-req) true) +(dream-ty-test "string is not a request" (dream-request? "x") false) + +;; ── query edge cases ─────────────────────────────────────────────── +(dream-ty-test + "no query is empty" + (dream-query-param (dream-request "GET" "/plain" {} "") "k") + nil) +(dream-ty-test + "valueless query param" + (dream-query-param (dream-request "GET" "/p?flag" {} "") "flag") + "") + +;; ── path params ──────────────────────────────────────────────────── +(define dream-ty-req2 (dream-with-param dream-ty-req "id" "42")) +(dream-ty-test "with-param sets" (dream-param dream-ty-req2 "id") "42") +(dream-ty-test "with-param immutable" (dream-param dream-ty-req "id") nil) +(define dream-ty-req3 (dream-with-params dream-ty-req {:a "1" :b "2"})) +(dream-ty-test "with-params a" (dream-param dream-ty-req3 "a") "1") +(dream-ty-test "with-params b" (dream-param dream-ty-req3 "b") "2") + +;; ── response construction ────────────────────────────────────────── +(dream-ty-test "html status" (dream-status (dream-html "

")) 200) +(dream-ty-test "html body" (dream-resp-body (dream-html "

")) "

") +(dream-ty-test + "html content-type" + (dream-resp-header (dream-html "

") "content-type") + "text/html; charset=utf-8") +(dream-ty-test + "text content-type" + (dream-resp-header (dream-text "hi") "content-type") + "text/plain; charset=utf-8") +(dream-ty-test + "json content-type" + (dream-resp-header (dream-json "{}") "content-type") + "application/json") +(dream-ty-test + "html-status code" + (dream-status (dream-html-status 201 "ok")) + 201) +(dream-ty-test + "not-found status" + (dream-status (dream-not-found)) + 404) +(dream-ty-test + "empty status" + (dream-status (dream-empty 204)) + 204) +(dream-ty-test "empty body" (dream-resp-body (dream-empty 204)) "") +(dream-ty-test + "redirect status" + (dream-status (dream-redirect "/home")) + 303) +(dream-ty-test + "redirect location" + (dream-resp-header (dream-redirect "/home") "location") + "/home") +(dream-ty-test + "redirect-status code" + (dream-status (dream-redirect-status 301 "/x")) + 301) +(dream-ty-test "is a response" (dream-response? (dream-html "x")) true) + +;; ── response mutation ────────────────────────────────────────────── +(define dream-ty-resp (dream-add-header (dream-html "x") "X-Custom" "yes")) +(dream-ty-test + "add-header" + (dream-resp-header dream-ty-resp "x-custom") + "yes") +(dream-ty-test "add-header keeps body" (dream-resp-body dream-ty-resp) "x") +(dream-ty-test + "set-status" + (dream-status (dream-set-status (dream-html "x") 500)) + 500) + +;; ── coercion ─────────────────────────────────────────────────────── +(dream-ty-test + "coerce string" + (dream-status (dream-coerce-response "hi")) + 200) +(dream-ty-test + "coerce string body" + (dream-resp-body (dream-coerce-response "hi")) + "hi") +(dream-ty-test + "coerce response passthrough" + (dream-status (dream-coerce-response (dream-empty 204))) + 204) + +;; ── route ────────────────────────────────────────────────────────── +(define dream-ty-h (fn (req) (dream-text "ok"))) +(define dream-ty-route (dream-route "post" "/submit" dream-ty-h)) +(dream-ty-test "route method" (dream-route-method dream-ty-route) "POST") +(dream-ty-test "route path" (dream-route-path dream-ty-route) "/submit") +(dream-ty-test "route is route" (dream-route? dream-ty-route) true) +(dream-ty-test + "route handler invokes" + (dream-resp-body ((dream-route-handler dream-ty-route) dream-ty-req)) + "ok") + +(define dream-ty-tests-run! (fn () {:total (+ dream-ty-pass dream-ty-fail) :passed dream-ty-pass :failed dream-ty-fail :fails dream-ty-fails})) diff --git a/lib/dream/types.sx b/lib/dream/types.sx new file mode 100644 index 00000000..75d93aba --- /dev/null +++ b/lib/dream/types.sx @@ -0,0 +1,146 @@ +;; lib/dream/types.sx — Dream-on-SX core types. +;; The five types: request, response, route. handler = request->response and +;; middleware = handler->handler are plain SX functions (no records needed). +;; request/response/route are dicts. Headers are dicts with lowercased string +;; keys; keywords are strings in SX, so :content-type == "content-type". + +;; ── internal helpers ─────────────────────────────────────────────── +(define + dr/normalize-headers + (fn + (h) + (reduce + (fn (acc k) (assoc acc (lower k) (get h k))) + {} + (keys h)))) + +(define + dr/path-of + (fn + (target) + (let + ((i (index-of target "?"))) + (if (< i 0) target (substr target 0 i))))) + +(define + dr/query-of + (fn + (target) + (let + ((i (index-of target "?"))) + (if (< i 0) "" (substr target (+ i 1)))))) + +(define + dr/parse-pair + (fn + (acc pair) + (if + (= pair "") + acc + (let + ((j (index-of pair "="))) + (if + (< j 0) + (assoc acc pair "") + (assoc + acc + (substr pair 0 j) + (substr pair (+ j 1)))))))) + +(define + dr/parse-query + (fn + (target) + (let + ((q (dr/query-of target))) + (if + (= q "") + {} + (reduce dr/parse-pair {} (split q "&")))))) + +;; ── request ──────────────────────────────────────────────────────── +(define dream-request (fn (method target headers body) {:path (dr/path-of target) :params {} :query (dr/parse-query target) :body body :headers (dr/normalize-headers headers) :method (upper method) :target target})) + +(define + dream-request? + (fn (x) (and (dict? x) (has-key? x :method) (has-key? x :path)))) +(define dream-method (fn (req) (get req :method))) +(define dream-target (fn (req) (get req :target))) +(define dream-path (fn (req) (get req :path))) +(define dream-body (fn (req) (get req :body))) +(define + dream-header + (fn (req name) (get (get req :headers) (lower name)))) +(define dream-query-param (fn (req name) (get (get req :query) name))) +(define dream-param (fn (req name) (get (get req :params) name))) +(define dream-params (fn (req) (get req :params))) + +;; router fills path params during dispatch +(define + dream-with-param + (fn + (req name val) + (assoc req :params (assoc (get req :params) name val)))) +(define + dream-with-params + (fn + (req more) + (assoc + req + :params (reduce + (fn (acc k) (assoc acc k (get more k))) + (get req :params) + (keys more))))) +(define dream-set-body (fn (req body) (assoc req :body body))) + +;; ── response ─────────────────────────────────────────────────────── +(define dream-response (fn (status headers body) {:body body :headers (dr/normalize-headers headers) :status status})) + +(define + dream-response? + (fn (x) (and (dict? x) (has-key? x :status) (has-key? x :body)))) +(define dream-status (fn (resp) (get resp :status))) +(define + dream-resp-header + (fn (resp name) (get (get resp :headers) (lower name)))) +(define dream-resp-body (fn (resp) (get resp :body))) +(define dream-headers (fn (resp) (get resp :headers))) + +(define + dream-add-header + (fn + (resp name val) + (assoc resp :headers (assoc (get resp :headers) (lower name) val)))) +(define dream-set-status (fn (resp status) (assoc resp :status status))) + +;; smart constructors +(define dream-html (fn (body) (dream-response 200 {:content-type "text/html; charset=utf-8"} body))) +(define + dream-html-status + (fn (status body) (dream-response status {:content-type "text/html; charset=utf-8"} body))) +(define dream-text (fn (body) (dream-response 200 {:content-type "text/plain; charset=utf-8"} body))) +(define dream-json (fn (body) (dream-response 200 {:content-type "application/json"} body))) +(define dream-empty (fn (status) (dream-response status {} ""))) +(define + dream-not-found + (fn () (dream-response 404 {:content-type "text/plain; charset=utf-8"} "Not Found"))) +(define + dream-redirect + (fn (location) (dream-response 303 {:location location} ""))) +(define + dream-redirect-status + (fn (status location) (dream-response status {:location location} ""))) + +;; coerce a handler result: strings become 200 text/html responses +(define + dream-coerce-response + (fn (x) (if (dream-response? x) x (dream-html x)))) + +;; ── route ────────────────────────────────────────────────────────── +(define dream-route (fn (method path handler) {:path path :handler handler :method (upper method)})) +(define + dream-route? + (fn (x) (and (dict? x) (has-key? x :handler) (has-key? x :path)))) +(define dream-route-method (fn (r) (get r :method))) +(define dream-route-path (fn (r) (get r :path))) +(define dream-route-handler (fn (r) (get r :handler))) diff --git a/plans/dream-on-sx.md b/plans/dream-on-sx.md index 6339ed64..3cc80f94 100644 --- a/plans/dream-on-sx.md +++ b/plans/dream-on-sx.md @@ -44,7 +44,7 @@ The user-facing story: rose-ash users who'd never touch s-expressions might writ The five types: `request`, `response`, `handler = request -> response`, `middleware = handler -> handler`, `route`. Everything else is a function over these. -- [ ] **Core types** in `lib/dream/types.sx`: request/response records, route record. +- [x] **Core types** in `lib/dream/types.sx`: request/response records, route record. - [ ] **Router** in `lib/dream/router.sx`: - `dream-get path handler`, `dream-post path handler`, etc. for all HTTP methods. - `dream-scope prefix middlewares routes` — prefix mount with middleware chain. @@ -104,8 +104,15 @@ Confirm scope before starting; some of these may be addable as Dream-internal he ## Progress log -_(awaiting activation conditions)_ +- **2026-06-07 — Core types** (`lib/dream/types.sx`, 41 tests). OCaml gate verified + green (scoreboard 480/480, Phases 1–5 + Phase 6 stdlib). Dream is implemented in + plain SX over the CEK — keywords are strings, so headers are dicts with lowercased + string keys (`:content-type` == `"content-type"`). request (method/target/path/ + query/headers/body/params), response (status/headers/body), route records with + constructors + accessors; smart response constructors (html/text/json/empty/ + not-found/redirect); `dream-coerce-response` wraps bare strings; query-string + parsing. Conformance runner `lib/dream/conformance.sh` modelled on flow's. ## Blockers -_(none yet — plan is cold)_ +_(none — gate green, loop active)_ From 66226b332b36ad707706c576b31700f80b68fa78 Mon Sep 17 00:00:00 2001 From: giles Date: Sun, 7 Jun 2026 14:29:50 +0000 Subject: [PATCH 02/22] dream: router dispatch + path params + scopes + 27 tests Co-Authored-By: Claude Opus 4.8 (1M context) --- lib/dream/conformance.sh | 4 +- lib/dream/router.sx | 129 +++++++++++++++++++++ lib/dream/tests/router.sx | 232 ++++++++++++++++++++++++++++++++++++++ plans/dream-on-sx.md | 11 +- 4 files changed, 374 insertions(+), 2 deletions(-) create mode 100644 lib/dream/router.sx create mode 100644 lib/dream/tests/router.sx diff --git a/lib/dream/conformance.sh b/lib/dream/conformance.sh index 2ab78043..16de8614 100644 --- a/lib/dream/conformance.sh +++ b/lib/dream/conformance.sh @@ -23,11 +23,13 @@ VERBOSE="${1:-}" # Dream library modules loaded before any test suite. MODULES=( "lib/dream/types.sx" + "lib/dream/router.sx" ) # Suites: NAME RUNNER-FN PATH SUITES=( - "types dream-ty-tests-run! lib/dream/tests/types.sx" + "types dream-ty-tests-run! lib/dream/tests/types.sx" + "router dream-rt-tests-run! lib/dream/tests/router.sx" ) TMPFILE=$(mktemp); trap "rm -f $TMPFILE" EXIT diff --git a/lib/dream/router.sx b/lib/dream/router.sx new file mode 100644 index 00000000..723e69f6 --- /dev/null +++ b/lib/dream/router.sx @@ -0,0 +1,129 @@ +;; lib/dream/router.sx — Dream-on-SX routing. +;; Routes are dicts {:method :path :handler}; a router is a handler that +;; dispatches request -> response by method + path, extracting :name path +;; params and binding a ** catch-all. No match -> 404. Depends on types.sx. + +;; ── route constructors (one per HTTP method) ─────────────────────── +(define dream-get (fn (path handler) (dream-route "GET" path handler))) +(define dream-post (fn (path handler) (dream-route "POST" path handler))) +(define dream-put (fn (path handler) (dream-route "PUT" path handler))) +(define + dream-delete + (fn (path handler) (dream-route "DELETE" path handler))) +(define dream-patch (fn (path handler) (dream-route "PATCH" path handler))) +(define dream-head (fn (path handler) (dream-route "HEAD" path handler))) +(define + dream-options + (fn (path handler) (dream-route "OPTIONS" path handler))) +(define dream-any (fn (path handler) (dream-route "ANY" path handler))) + +;; ── path segmentation ────────────────────────────────────────────── +;; "/users/42/" -> ("users" "42"); "/" -> () +(define + dr/segs + (fn (path) (filter (fn (s) (not (= s ""))) (split path "/")))) + +(define + dr/join-path + (fn + (prefix path) + (str "/" (join "/" (concat (dr/segs prefix) (dr/segs path)))))) + +;; ── segment matching ─────────────────────────────────────────────── +;; Returns a params dict on match (possibly empty {}), nil on no match. +(define + dr/match-segs + (fn + (pat path params) + (cond + ((and (empty? pat) (empty? path)) params) + ((empty? pat) nil) + (else + (let + ((ps (first pat))) + (cond + ((= ps "**") (assoc params "**" (join "/" path))) + ((empty? path) nil) + ((starts-with? ps ":") + (dr/match-segs + (rest pat) + (rest path) + (assoc params (substr ps 1) (first path)))) + ((= ps (first path)) + (dr/match-segs (rest pat) (rest path) params)) + (else nil))))))) + +(define + dr/method-match? + (fn + (route-method req-method) + (or (= route-method "ANY") (= route-method req-method)))) + +;; ── middleware pipeline (shared with middleware.sx) ──────────────── +;; m1 @@ m2 @@ handler = (m1 (m2 handler)); first in list is outermost. +(define + dr/apply-middlewares + (fn (mws handler) (reduce (fn (h mw) (mw h)) handler (reverse mws)))) + +;; ── scope: prefix mount + middleware chain ───────────────────────── +;; Returns a flat list of routes; nested scopes flatten correctly. +(define + dr/flatten-routes + (fn + (items) + (reduce + (fn + (acc it) + (if + (dream-route? it) + (concat acc (list it)) + (concat acc (dr/flatten-routes it)))) + (list) + items))) + +(define + dream-scope + (fn + (prefix middlewares routes) + (map + (fn + (r) + (dream-route + (dream-route-method r) + (dr/join-path prefix (dream-route-path r)) + (dr/apply-middlewares middlewares (dream-route-handler r)))) + (dr/flatten-routes routes)))) + +;; ── dispatch ─────────────────────────────────────────────────────── +(define + dr/try-route + (fn + (r req) + (if + (dr/method-match? (dream-route-method r) (dream-method req)) + (let + ((params (dr/match-segs (dr/segs (dream-route-path r)) (dr/segs (dream-path req)) {}))) + (if + (nil? params) + :no-match (dream-coerce-response + ((dream-route-handler r) (dream-with-params req params))))) + :no-match))) + +(define + dr/dispatch + (fn + (routes req) + (if + (empty? routes) + (dream-not-found) + (let + ((res (dr/try-route (first routes) req))) + (if (= res :no-match) (dr/dispatch (rest routes) req) res))))) + +(define + dream-router + (fn + (routes) + (let + ((flat (dr/flatten-routes routes))) + (fn (req) (dr/dispatch flat req))))) diff --git a/lib/dream/tests/router.sx b/lib/dream/tests/router.sx new file mode 100644 index 00000000..fc6568fd --- /dev/null +++ b/lib/dream/tests/router.sx @@ -0,0 +1,232 @@ +;; lib/dream/tests/router.sx — routing dispatch, path params, scopes. + +(define dream-rt-pass 0) +(define dream-rt-fail 0) +(define dream-rt-fails (list)) + +(define + dream-rt-test + (fn + (name actual expected) + (if + (= actual expected) + (set! dream-rt-pass (+ dream-rt-pass 1)) + (begin + (set! dream-rt-fail (+ dream-rt-fail 1)) + (append! dream-rt-fails {:name name :actual actual :expected expected}))))) + +(define + dream-rt-req + (fn (method target) (dream-request method target {} ""))) + +;; ── basic dispatch ───────────────────────────────────────────────── +(define + dream-rt-app + (dream-router + (list + (dream-get "/" (fn (req) (dream-text "home"))) + (dream-get "/about" (fn (req) (dream-text "about"))) + (dream-post "/submit" (fn (req) (dream-text "posted")))))) + +(dream-rt-test + "GET / -> home" + (dream-resp-body (dream-rt-app (dream-rt-req "GET" "/"))) + "home") +(dream-rt-test + "GET /about" + (dream-resp-body (dream-rt-app (dream-rt-req "GET" "/about"))) + "about") +(dream-rt-test + "POST /submit" + (dream-resp-body (dream-rt-app (dream-rt-req "POST" "/submit"))) + "posted") +(dream-rt-test + "unknown path 404" + (dream-status (dream-rt-app (dream-rt-req "GET" "/nope"))) + 404) +(dream-rt-test + "wrong method 404" + (dream-status (dream-rt-app (dream-rt-req "GET" "/submit"))) + 404) +(dream-rt-test + "trailing slash equiv" + (dream-resp-body (dream-rt-app (dream-rt-req "GET" "/about/"))) + "about") +(dream-rt-test + "query ignored for routing" + (dream-resp-body (dream-rt-app (dream-rt-req "GET" "/about?x=1"))) + "about") + +;; ── path params ──────────────────────────────────────────────────── +(define + dream-rt-papp + (dream-router + (list + (dream-get + "/users/:id" + (fn (req) (dream-text (dream-param req "id")))) + (dream-get + "/users/:id/posts/:pid" + (fn + (req) + (dream-text + (str (dream-param req "id") "-" (dream-param req "pid"))))) + (dream-get + "/files/**" + (fn (req) (dream-text (dream-param req "**"))))))) + +(dream-rt-test + "single param" + (dream-resp-body (dream-rt-papp (dream-rt-req "GET" "/users/42"))) + "42") +(dream-rt-test + "two params" + (dream-resp-body (dream-rt-papp (dream-rt-req "GET" "/users/7/posts/9"))) + "7-9") +(dream-rt-test + "param no over-match" + (dream-status (dream-rt-papp (dream-rt-req "GET" "/users/7/extra"))) + 404) +(dream-rt-test + "catch-all captures rest" + (dream-resp-body (dream-rt-papp (dream-rt-req "GET" "/files/a/b/c.txt"))) + "a/b/c.txt") +(dream-rt-test + "catch-all empty rest" + (dream-resp-body (dream-rt-papp (dream-rt-req "GET" "/files/"))) + "") + +;; ── route order: first match wins ────────────────────────────────── +(define + dream-rt-order + (dream-router + (list + (dream-get "/x/specific" (fn (req) (dream-text "specific"))) + (dream-get "/x/:slug" (fn (req) (dream-text "generic")))))) +(dream-rt-test + "first match wins" + (dream-resp-body (dream-rt-order (dream-rt-req "GET" "/x/specific"))) + "specific") +(dream-rt-test + "fallthrough to param" + (dream-resp-body (dream-rt-order (dream-rt-req "GET" "/x/other"))) + "generic") + +;; ── ANY method ───────────────────────────────────────────────────── +(define + dream-rt-any + (dream-router + (list (dream-any "/ping" (fn (req) (dream-text (dream-method req))))))) +(dream-rt-test + "ANY matches GET" + (dream-resp-body (dream-rt-any (dream-rt-req "GET" "/ping"))) + "GET") +(dream-rt-test + "ANY matches DELETE" + (dream-resp-body (dream-rt-any (dream-rt-req "DELETE" "/ping"))) + "DELETE") + +;; ── handler returns bare string (coerced) ────────────────────────── +(define + dream-rt-coerce + (dream-router (list (dream-get "/s" (fn (req) "bare"))))) +(dream-rt-test + "string coerced to 200" + (dream-status (dream-rt-coerce (dream-rt-req "GET" "/s"))) + 200) +(dream-rt-test + "string coerced body" + (dream-resp-body (dream-rt-coerce (dream-rt-req "GET" "/s"))) + "bare") + +;; ── scope: prefix mount ──────────────────────────────────────────── +(define + dream-rt-scoped + (dream-router + (list + (dream-get "/" (fn (req) (dream-text "root"))) + (dream-scope + "/api" + (list) + (list + (dream-get "/users" (fn (req) (dream-text "api-users"))) + (dream-get + "/users/:id" + (fn + (req) + (dream-text (str "api-user-" (dream-param req "id")))))))))) +(dream-rt-test + "scope root still works" + (dream-resp-body (dream-rt-scoped (dream-rt-req "GET" "/"))) + "root") +(dream-rt-test + "scope prefix path" + (dream-resp-body (dream-rt-scoped (dream-rt-req "GET" "/api/users"))) + "api-users") +(dream-rt-test + "scope prefix param" + (dream-resp-body (dream-rt-scoped (dream-rt-req "GET" "/api/users/5"))) + "api-user-5") +(dream-rt-test + "scope unprefixed 404" + (dream-status (dream-rt-scoped (dream-rt-req "GET" "/users"))) + 404) + +;; ── scope: middleware applied to all routes ──────────────────────── +(define + dream-rt-mw + (fn (next) (fn (req) (dream-add-header (next req) "X-Scope" "on")))) +(define + dream-rt-mwapp + (dream-router + (list + (dream-scope + "/v1" + (list dream-rt-mw) + (list (dream-get "/a" (fn (req) (dream-text "a")))))))) +(dream-rt-test + "scope mw header" + (dream-resp-header (dream-rt-mwapp (dream-rt-req "GET" "/v1/a")) "x-scope") + "on") +(dream-rt-test + "scope mw body intact" + (dream-resp-body (dream-rt-mwapp (dream-rt-req "GET" "/v1/a"))) + "a") + +;; ── nested scopes ────────────────────────────────────────────────── +(define + dream-rt-outer + (fn (next) (fn (req) (dream-add-header (next req) "X-Outer" "1")))) +(define + dream-rt-inner + (fn (next) (fn (req) (dream-add-header (next req) "X-Inner" "1")))) +(define + dream-rt-nested + (dream-router + (list + (dream-scope + "/api" + (list dream-rt-outer) + (list + (dream-scope + "/v2" + (list dream-rt-inner) + (list (dream-get "/thing" (fn (req) (dream-text "thing")))))))))) +(dream-rt-test + "nested path" + (dream-resp-body (dream-rt-nested (dream-rt-req "GET" "/api/v2/thing"))) + "thing") +(dream-rt-test + "nested outer mw" + (dream-resp-header + (dream-rt-nested (dream-rt-req "GET" "/api/v2/thing")) + "x-outer") + "1") +(dream-rt-test + "nested inner mw" + (dream-resp-header + (dream-rt-nested (dream-rt-req "GET" "/api/v2/thing")) + "x-inner") + "1") + +(define dream-rt-tests-run! (fn () {:total (+ dream-rt-pass dream-rt-fail) :passed dream-rt-pass :failed dream-rt-fail :fails dream-rt-fails})) diff --git a/plans/dream-on-sx.md b/plans/dream-on-sx.md index 3cc80f94..555d54f6 100644 --- a/plans/dream-on-sx.md +++ b/plans/dream-on-sx.md @@ -45,7 +45,7 @@ The user-facing story: rose-ash users who'd never touch s-expressions might writ The five types: `request`, `response`, `handler = request -> response`, `middleware = handler -> handler`, `route`. Everything else is a function over these. - [x] **Core types** in `lib/dream/types.sx`: request/response records, route record. -- [ ] **Router** in `lib/dream/router.sx`: +- [x] **Router** in `lib/dream/router.sx`: - `dream-get path handler`, `dream-post path handler`, etc. for all HTTP methods. - `dream-scope prefix middlewares routes` — prefix mount with middleware chain. - `dream-router routes` — dispatch tree, returns handler; no match → 404. @@ -112,6 +112,15 @@ Confirm scope before starting; some of these may be addable as Dream-internal he constructors + accessors; smart response constructors (html/text/json/empty/ not-found/redirect); `dream-coerce-response` wraps bare strings; query-string parsing. Conformance runner `lib/dream/conformance.sh` modelled on flow's. +- **2026-06-07 — Router** (`lib/dream/router.sx`, 27 tests). `dream-get/post/put/ + delete/patch/head/options/any` route constructors; `dream-router` flattens routes + (incl. nested scopes) and dispatches by method+path, first-match-wins, 404 on no + match. Path matching is recursive over `/`-split segments: literal, `:name` binds + a param, `**` catch-all binds remaining path under key `"**"`. Trailing slashes and + query strings are ignored for routing. `dream-scope prefix mws routes` prepends the + prefix and folds the middleware chain (`m1 @@ m2 @@ h`, first = outermost) onto each + route's handler; nests correctly (inner mw innermost). Shared `dr/apply-middlewares` + fold will back `dream-pipeline`. ## Blockers From b5a273cc99433d29c199cd005c65c679837438b8 Mon Sep 17 00:00:00 2001 From: giles Date: Sun, 7 Jun 2026 14:32:06 +0000 Subject: [PATCH 03/22] dream: middleware pipeline + logger + content-type sniffer + 20 tests Co-Authored-By: Claude Opus 4.8 (1M context) --- lib/dream/conformance.sh | 6 +- lib/dream/middleware.sx | 92 +++++++++++++++++++++ lib/dream/tests/middleware.sx | 150 ++++++++++++++++++++++++++++++++++ plans/dream-on-sx.md | 9 +- 4 files changed, 254 insertions(+), 3 deletions(-) create mode 100644 lib/dream/middleware.sx create mode 100644 lib/dream/tests/middleware.sx diff --git a/lib/dream/conformance.sh b/lib/dream/conformance.sh index 16de8614..03b0118d 100644 --- a/lib/dream/conformance.sh +++ b/lib/dream/conformance.sh @@ -24,12 +24,14 @@ VERBOSE="${1:-}" MODULES=( "lib/dream/types.sx" "lib/dream/router.sx" + "lib/dream/middleware.sx" ) # Suites: NAME RUNNER-FN PATH SUITES=( - "types dream-ty-tests-run! lib/dream/tests/types.sx" - "router dream-rt-tests-run! lib/dream/tests/router.sx" + "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" ) TMPFILE=$(mktemp); trap "rm -f $TMPFILE" EXIT diff --git a/lib/dream/middleware.sx b/lib/dream/middleware.sx new file mode 100644 index 00000000..9a980a90 --- /dev/null +++ b/lib/dream/middleware.sx @@ -0,0 +1,92 @@ +;; lib/dream/middleware.sx — Dream-on-SX middleware. +;; A middleware is handler->handler. Composition is plain function composition: +;; m1 @@ m2 @@ handler = (m1 (m2 handler)). Depends on types.sx + router.sx +;; (reuses dr/apply-middlewares for the fold). + +;; ── composition ──────────────────────────────────────────────────── +;; (dream-pipeline (list m1 m2 m3) handler) = (m1 (m2 (m3 handler))). +(define + dream-pipeline + (fn (middlewares handler) (dr/apply-middlewares middlewares handler))) + +;; identity middleware +(define dream-no-middleware (fn (next) next)) + +;; ── logger ───────────────────────────────────────────────────────── +;; Parameterised on a clock and a sink so it is testable without IO. +;; sink receives {:method :path :status :elapsed}. +(define + dream-logger-with + (fn + (clock sink) + (fn + (next) + (fn + (req) + (let + ((t0 (clock))) + (let ((resp (next req))) (begin (sink {:path (dream-path req) :status (dream-status resp) :method (dream-method req) :elapsed (- (clock) t0)}) resp))))))) + +;; default logger performs host effects for the clock and the log sink +(define + dream-logger + (dream-logger-with + (fn () (perform (:dream-clock))) + (fn (entry) (perform (:dream-log entry))))) + +;; format a log entry as a one-line string (apache-ish) +(define + dream-log-line + (fn + (entry) + (str + (get entry :method) + " " + (get entry :path) + " -> " + (get entry :status) + " (" + (get entry :elapsed) + "ms)"))) + +;; ── content-type sniffer ─────────────────────────────────────────── +(define + dr/sniff-content-type + (fn + (body) + (cond + ((= body "") "text/plain; charset=utf-8") + ((starts-with? body "<") "text/html; charset=utf-8") + ((starts-with? body "{") "application/json") + ((starts-with? body "[") "application/json") + (else "text/plain; charset=utf-8")))) + +;; sets Content-Type from the body only when the handler left it unset +(define + dream-content-type + (fn + (next) + (fn + (req) + (let + ((resp (next req))) + (if + (dream-resp-header resp "content-type") + resp + (dream-add-header + resp + "content-type" + (dr/sniff-content-type (dream-resp-body resp)))))))) + +;; ── small reusable middlewares ───────────────────────────────────── +;; always attach a response header +(define + dream-set-header + (fn + (name val) + (fn (next) (fn (req) (dream-add-header (next req) name val))))) + +;; rewrite/observe the request before the handler sees it +(define + dream-tap-request + (fn (f) (fn (next) (fn (req) (next (f req)))))) diff --git a/lib/dream/tests/middleware.sx b/lib/dream/tests/middleware.sx new file mode 100644 index 00000000..6a275af6 --- /dev/null +++ b/lib/dream/tests/middleware.sx @@ -0,0 +1,150 @@ +;; lib/dream/tests/middleware.sx — composition, logger, content-type sniffer. + +(define dream-mw-pass 0) +(define dream-mw-fail 0) +(define dream-mw-fails (list)) + +(define + dream-mw-test + (fn + (name actual expected) + (if + (= actual expected) + (set! dream-mw-pass (+ dream-mw-pass 1)) + (begin + (set! dream-mw-fail (+ dream-mw-fail 1)) + (append! dream-mw-fails {:name name :actual actual :expected expected}))))) + +(define dream-mw-req (dream-request "GET" "/p" {} "")) + +;; ── pipeline composition order ───────────────────────────────────── +(define + dream-mw-wrap + (fn + (tag) + (fn + (next) + (fn + (req) + (dream-html (str tag "(" (dream-resp-body (next req)) ")")))))) +(define dream-mw-h (fn (req) (dream-html "h"))) + +(dream-mw-test + "pipeline empty is identity" + (dream-resp-body ((dream-pipeline (list) dream-mw-h) dream-mw-req)) + "h") +(dream-mw-test + "pipeline single" + (dream-resp-body + ((dream-pipeline (list (dream-mw-wrap "a")) dream-mw-h) dream-mw-req)) + "a(h)") +(dream-mw-test + "pipeline first is outermost" + (dream-resp-body + ((dream-pipeline (list (dream-mw-wrap "a") (dream-mw-wrap "b")) dream-mw-h) + dream-mw-req)) + "a(b(h))") +(dream-mw-test + "no-middleware is identity" + (dream-resp-body ((dream-no-middleware dream-mw-h) dream-mw-req)) + "h") + +;; ── logger ───────────────────────────────────────────────────────── +(define dream-mw-clock-n 0) +(define + dream-mw-clock + (fn + () + (begin + (set! dream-mw-clock-n (+ dream-mw-clock-n 1)) + dream-mw-clock-n))) +(define dream-mw-entries (list)) +(define dream-mw-sink (fn (e) (append! dream-mw-entries e))) +(define + dream-mw-logged + ((dream-logger-with dream-mw-clock dream-mw-sink) + (fn (req) (dream-html-status 201 "ok")))) +(define + dream-mw-lresp + (dream-mw-logged (dream-request "POST" "/log/path" {} ""))) + +(dream-mw-test + "logger passes response through" + (dream-resp-body dream-mw-lresp) + "ok") +(dream-mw-test "logger records one entry" (len dream-mw-entries) 1) +(dream-mw-test + "logger entry method" + (get (first dream-mw-entries) :method) + "POST") +(dream-mw-test + "logger entry path" + (get (first dream-mw-entries) :path) + "/log/path") +(dream-mw-test + "logger entry status" + (get (first dream-mw-entries) :status) + 201) +(dream-mw-test + "logger entry elapsed" + (get (first dream-mw-entries) :elapsed) + 1) +(dream-mw-test + "log-line format" + (dream-log-line {:path "/x" :status 200 :method "GET" :elapsed 4}) + "GET /x -> 200 (4ms)") + +;; ── content-type sniffer ─────────────────────────────────────────── +(define dream-mw-ct (fn (handler) (dream-content-type handler))) +(define + dream-mw-sniff + (fn + (body) + (dream-resp-header + ((dream-content-type (fn (req) (dream-response 200 {} body))) + dream-mw-req) + "content-type"))) + +(dream-mw-test + "sniff html" + (dream-mw-sniff "

hi

") + "text/html; charset=utf-8") +(dream-mw-test + "sniff doctype" + (dream-mw-sniff "") + "text/html; charset=utf-8") +(dream-mw-test + "sniff json object" + (dream-mw-sniff "{\"a\":1}") + "application/json") +(dream-mw-test "sniff json array" (dream-mw-sniff "[1,2]") "application/json") +(dream-mw-test + "sniff plain text" + (dream-mw-sniff "just words") + "text/plain; charset=utf-8") +(dream-mw-test + "sniff empty body" + (dream-mw-sniff "") + "text/plain; charset=utf-8") +(dream-mw-test + "sniff does not override existing" + (dream-resp-header + ((dream-content-type (fn (req) (dream-json "{}"))) dream-mw-req) + "content-type") + "application/json") + +;; ── small middlewares ────────────────────────────────────────────── +(dream-mw-test + "set-header attaches" + (dream-resp-header + (((dream-set-header "X-A" "1") dream-mw-h) dream-mw-req) + "x-a") + "1") +(dream-mw-test + "tap-request rewrites" + (dream-resp-body + (((dream-tap-request (fn (req) (dream-set-body req "tapped"))) (fn (req) (dream-html (dream-body req)))) + (dream-request "GET" "/" {} "orig"))) + "tapped") + +(define dream-mw-tests-run! (fn () {:total (+ dream-mw-pass dream-mw-fail) :passed dream-mw-pass :failed dream-mw-fail :fails dream-mw-fails})) diff --git a/plans/dream-on-sx.md b/plans/dream-on-sx.md index 555d54f6..2b373bf0 100644 --- a/plans/dream-on-sx.md +++ b/plans/dream-on-sx.md @@ -51,7 +51,7 @@ The five types: `request`, `response`, `handler = request -> response`, `middlew - `dream-router routes` — dispatch tree, returns handler; no match → 404. - Path param extraction: `:name` segments, `**` wildcard. - `dream-param req name` — retrieve matched path param. -- [ ] **Middleware** in `lib/dream/middleware.sx`: +- [x] **Middleware** in `lib/dream/middleware.sx`: - `dream-pipeline middlewares handler` — compose middleware left-to-right. - `dream-no-middleware` — identity. - Logger: `(dream-logger next req)` — logs method, path, status, timing. @@ -121,6 +121,13 @@ Confirm scope before starting; some of these may be addable as Dream-internal he prefix and folds the middleware chain (`m1 @@ m2 @@ h`, first = outermost) onto each route's handler; nests correctly (inner mw innermost). Shared `dr/apply-middlewares` fold will back `dream-pipeline`. +- **2026-06-07 — Middleware** (`lib/dream/middleware.sx`, 20 tests). `dream-pipeline` + (reuses `dr/apply-middlewares`), `dream-no-middleware` identity. `dream-logger-with + clock sink` is the testable core (records `{:method :path :status :elapsed}`); + `dream-logger` wires it to `(perform (:dream-clock))` / `(perform (:dream-log …))`; + `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. ## Blockers From 55ec0b8f6401e52263154898947910aef6ccc0fa Mon Sep 17 00:00:00 2001 From: giles Date: Sun, 7 Jun 2026 14:35:46 +0000 Subject: [PATCH 04/22] 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 From edff7735e777d571566ea95cc5e23d2773a19f95 Mon Sep 17 00:00:00 2001 From: giles Date: Sun, 7 Jun 2026 14:38:26 +0000 Subject: [PATCH 05/22] =?UTF-8?q?dream:=20flash=20messages=20=E2=80=94=20s?= =?UTF-8?q?ingle-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 From 9a67ced7484be8d25092f74ab13090773d4bb8b8 Mon Sep 17 00:00:00 2001 From: giles Date: Sun, 7 Jun 2026 14:43:41 +0000 Subject: [PATCH 06/22] dream: forms (urlencoded) + stateless signed CSRF + 26 tests Co-Authored-By: Claude Opus 4.8 (1M context) --- lib/dream/conformance.sh | 2 + lib/dream/form.sx | 228 +++++++++++++++++++++++++++++++++++++++ lib/dream/tests/form.sx | 181 +++++++++++++++++++++++++++++++ plans/dream-on-sx.md | 23 +++- 4 files changed, 429 insertions(+), 5 deletions(-) create mode 100644 lib/dream/form.sx create mode 100644 lib/dream/tests/form.sx diff --git a/lib/dream/conformance.sh b/lib/dream/conformance.sh index 3dd4c7df..dadb9a88 100644 --- a/lib/dream/conformance.sh +++ b/lib/dream/conformance.sh @@ -27,6 +27,7 @@ MODULES=( "lib/dream/middleware.sx" "lib/dream/session.sx" "lib/dream/flash.sx" + "lib/dream/form.sx" ) # Suites: NAME RUNNER-FN PATH @@ -36,6 +37,7 @@ SUITES=( "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" + "form dream-fo-tests-run! lib/dream/tests/form.sx" ) TMPFILE=$(mktemp); trap "rm -f $TMPFILE" EXIT diff --git a/lib/dream/form.sx b/lib/dream/form.sx new file mode 100644 index 00000000..4f4fe1f1 --- /dev/null +++ b/lib/dream/form.sx @@ -0,0 +1,228 @@ +;; lib/dream/form.sx — Dream-on-SX forms + CSRF. +;; Parses application/x-www-form-urlencoded bodies; CSRF tokens are stateless, +;; signed, and session-scoped. The signing function is injectable (a pure-SX keyed +;; hash by default — production should swap in a host HMAC). Depends on types.sx + +;; session.sx. dream-form returns an Ok/Err result value. + +;; ── Result (Ok/Err) ──────────────────────────────────────────────── +(define dream-ok (fn (v) {:value v :result "ok"})) +(define dream-err (fn (r) {:reason r :result "err"})) +(define dream-ok? (fn (x) (= (get x :result) "ok"))) +(define dream-err? (fn (x) (= (get x :result) "err"))) +(define dream-ok-value (fn (x) (get x :value))) +(define dream-err-reason (fn (x) (get x :reason))) + +;; ── percent decoding ─────────────────────────────────────────────── +(define + dr/hex-digit + (fn + (c) + (let + ((n (char-code c))) + (cond + ((and (>= n 48) (<= n 57)) (- n 48)) + ((and (>= n 65) (<= n 70)) + (+ 10 (- n 65))) + ((and (>= n 97) (<= n 102)) + (+ 10 (- n 97))) + (else 0))))) + +(define + dr/url-decode-loop + (fn + (s i n acc) + (if + (>= i n) + acc + (let + ((c (char-at s i))) + (if + (and (= c "%") (< (+ i 2) n)) + (dr/url-decode-loop + s + (+ i 3) + n + (str + acc + (char-from-code + (+ + (* 16 (dr/hex-digit (char-at s (+ i 1)))) + (dr/hex-digit (char-at s (+ i 2))))))) + (dr/url-decode-loop s (+ i 1) n (str acc c))))))) + +(define + dr/url-decode + (fn + (s) + (let + ((s2 (replace s "+" " "))) + (dr/url-decode-loop s2 0 (string-length s2) "")))) + +;; ── urlencoded body parsing ──────────────────────────────────────── +(define + dr/parse-form-body + (fn + (body) + (if + (= body "") + {} + (reduce + (fn + (acc pair) + (if + (= pair "") + acc + (let + ((j (index-of pair "="))) + (if + (< j 0) + (assoc acc (dr/url-decode pair) "") + (assoc + acc + (dr/url-decode (substr pair 0 j)) + (dr/url-decode (substr pair (+ j 1)))))))) + {} + (split body "&"))))) + +;; raw fields, no CSRF check +(define dream-form-fields (fn (req) (dr/parse-form-body (dream-body req)))) +(define + dream-form-field + (fn (req name) (get (dream-form-fields req) name))) + +;; ── CSRF signing (injectable; pure-SX keyed hash default) ────────── +(define + dr/poly-hash + (fn (s base seed) (dr/poly-loop s 0 (string-length s) seed base))) +(define + dr/poly-loop + (fn + (s i n h base) + (if + (>= i n) + h + (dr/poly-loop + s + (+ i 1) + n + (mod (+ (* h base) (char-code (char-at s i))) 2147483647) + base)))) + +;; NOTE: not cryptographic — adequate to demonstrate stateless CSRF; production +;; should inject a real HMAC via dream-csrf-with. +(define + dream-csrf-sign-default + (fn + (secret msg) + (let + ((m (str secret "|" msg))) + (str + (dr/poly-hash m 131 7) + "-" + (dr/poly-hash m 137 13))))) + +(define dream-csrf-field-name "dream.csrf") + +(define + dr/csrf-make-token + (fn (sign secret sid) (str sid "." (sign secret sid)))) + +(define + dr/csrf-valid? + (fn + (sign secret sid token) + (if + (or (nil? token) (= token "")) + false + (let + ((dot (index-of token "."))) + (if + (< dot 0) + false + (let + ((tsid (substr token 0 dot)) + (tsig (substr token (+ dot 1)))) + (and (= tsid sid) (= tsig (sign secret sid))))))))) + +;; ── CSRF middleware: attach signing context (needs session upstream) ── +(define + dream-csrf-with + (fn + (secret sign) + (fn (next) (fn (req) (next (assoc req :dream-csrf {:sign sign :sid (dream-session-id req) :secret secret})))))) + +(define + dream-csrf + (fn (secret) (dream-csrf-with secret dream-csrf-sign-default))) + +(define dr/csrf-of (fn (req) (get req :dream-csrf))) + +;; current token + hidden-input tag for templates +(define + dream-csrf-token + (fn + (req) + (let + ((c (dr/csrf-of req))) + (dr/csrf-make-token (get c :sign) (get c :secret) (get c :sid))))) + +(define + dream-csrf-tag + (fn + (req) + (str + ""))) + +;; ── dream-form: parse + verify CSRF -> Ok fields | Err reason ────── +(define + dream-form + (fn + (req) + (let + ((c (dr/csrf-of req))) + (if + (nil? c) + (dream-err :csrf-context-missing) + (let + ((fields (dream-form-fields req))) + (if + (dr/csrf-valid? + (get c :sign) + (get c :secret) + (get c :sid) + (get fields dream-csrf-field-name)) + (dream-ok fields) + (dream-err :csrf-token-invalid))))))) + +;; ── CSRF auto-rejecting middleware (unsafe methods need a valid token) ── +(define + dr/csrf-safe-method? + (fn (m) (or (= m "GET") (= m "HEAD") (= m "OPTIONS")))) + +(define + dream-csrf-protect-with + (fn + (secret sign) + (fn + (next) + (fn + (req) + (let + ((req2 (assoc req :dream-csrf {:sign sign :sid (dream-session-id req) :secret secret}))) + (if + (dr/csrf-safe-method? (dream-method req2)) + (next req2) + (let + ((token (get (dream-form-fields req2) dream-csrf-field-name))) + (if + (dr/csrf-valid? sign secret (dream-session-id req2) token) + (next req2) + (dream-html-status 403 "CSRF token invalid"))))))))) + +(define + dream-csrf-protect + (fn (secret) (dream-csrf-protect-with secret dream-csrf-sign-default))) diff --git a/lib/dream/tests/form.sx b/lib/dream/tests/form.sx new file mode 100644 index 00000000..5ec7503a --- /dev/null +++ b/lib/dream/tests/form.sx @@ -0,0 +1,181 @@ +;; lib/dream/tests/form.sx — urlencoded parsing, Ok/Err, CSRF accept/reject. + +(define dream-fo-pass 0) +(define dream-fo-fail 0) +(define dream-fo-fails (list)) + +(define + dream-fo-test + (fn + (name actual expected) + (if + (= actual expected) + (set! dream-fo-pass (+ dream-fo-pass 1)) + (begin + (set! dream-fo-fail (+ dream-fo-fail 1)) + (append! dream-fo-fails {:name name :actual actual :expected expected}))))) + +;; ── Result ───────────────────────────────────────────────────────── +(dream-fo-test "ok? on ok" (dream-ok? (dream-ok 5)) true) +(dream-fo-test "err? on ok" (dream-err? (dream-ok 5)) false) +(dream-fo-test "ok value" (dream-ok-value (dream-ok {:a 1})) {:a 1}) +(dream-fo-test "err reason" (dream-err-reason (dream-err :bad)) "bad") + +;; ── urlencoded parsing ───────────────────────────────────────────── +(define + dream-fo-req + (fn (body) (dream-request "POST" "/f" {:Content-Type "application/x-www-form-urlencoded"} body))) + +(dream-fo-test + "parse two fields" + (dream-form-fields (dream-fo-req "a=1&b=2")) + {:a "1" :b "2"}) +(dream-fo-test + "url-decoded value" + (dream-form-field (dream-fo-req "name=Ada+Lovelace") "name") + "Ada Lovelace") +(dream-fo-test + "percent decode" + (dream-form-field (dream-fo-req "x=a%20b%21") "x") + "a b!") +(dream-fo-test "empty body" (dream-form-fields (dream-fo-req "")) {}) +(dream-fo-test + "valueless key" + (dream-form-field (dream-fo-req "flag") "flag") + "") +(dream-fo-test + "decoded key" + (dream-form-field (dream-fo-req "first%20name=x") "first name") + "x") + +;; ── CSRF sign + verify ───────────────────────────────────────────── +(dream-fo-test + "sign deterministic" + (= + (dream-csrf-sign-default "secret" "s1") + (dream-csrf-sign-default "secret" "s1")) + true) +(dream-fo-test + "sign secret-sensitive" + (= + (dream-csrf-sign-default "secret" "s1") + (dream-csrf-sign-default "other" "s1")) + false) +(dream-fo-test + "sign session-sensitive" + (= + (dream-csrf-sign-default "secret" "s1") + (dream-csrf-sign-default "secret" "s2")) + false) +(dream-fo-test + "token valid for own session" + (dr/csrf-valid? + dream-csrf-sign-default + "k" + "s1" + (dr/csrf-make-token dream-csrf-sign-default "k" "s1")) + true) +(dream-fo-test + "token invalid for other session" + (dr/csrf-valid? + dream-csrf-sign-default + "k" + "s2" + (dr/csrf-make-token dream-csrf-sign-default "k" "s1")) + false) +(dream-fo-test + "tampered token invalid" + (dr/csrf-valid? dream-csrf-sign-default "k" "s1" "s1.deadbeef") + false) +(dream-fo-test + "empty token invalid" + (dr/csrf-valid? dream-csrf-sign-default "k" "s1" "") + false) +(dream-fo-test + "nil token invalid" + (dr/csrf-valid? dream-csrf-sign-default "k" "s1" nil) + false) + +;; ── full stack: session -> csrf -> handler ───────────────────────── +(define dream-fo-backend (dream-memory-sessions)) +(define dream-fo-sid (dream-fo-backend {:op "session/create"})) ;; s1 + +;; build a request already carrying the session cookie + csrf middleware applied +(define + dream-fo-stack + (fn + (handler) + ((dream-sessions dream-fo-backend) ((dream-csrf "topsecret") handler)))) + +;; a handler that emits its csrf tag +(define + dream-fo-tag-out + (dream-resp-body + ((dream-fo-stack (fn (req) (dream-text (dream-csrf-tag req)))) + (dream-request "GET" "/form" {:Cookie "dream.session=s1"} "")))) +(dream-fo-test + "csrf-tag is hidden input" + (contains? dream-fo-tag-out "type=\"hidden\"") + true) +(dream-fo-test + "csrf-tag names field" + (contains? dream-fo-tag-out "name=\"dream.csrf\"") + true) + +;; valid token (signed for s1) -> dream-form Ok +(define + dream-fo-good-token + (dr/csrf-make-token dream-csrf-sign-default "topsecret" "s1")) +(define + dream-fo-submit + (fn + (token) + ((dream-fo-stack (fn (req) (let ((r (dream-form req))) (if (dream-ok? r) (dream-text (str "ok:" (get (dream-ok-value r) "msg"))) (dream-text (str "err:" (dream-err-reason r))))))) + (dream-request + "POST" + "/form" + {:Cookie "dream.session=s1"} + (str "msg=hello&dream.csrf=" token))))) + +(dream-fo-test + "valid csrf -> Ok fields" + (dream-resp-body (dream-fo-submit dream-fo-good-token)) + "ok:hello") +(dream-fo-test + "bad csrf -> Err" + (dream-resp-body (dream-fo-submit "s1.wrong")) + "err:csrf-token-invalid") +(dream-fo-test + "missing csrf -> Err" + (dream-resp-body (dream-fo-submit "")) + "err:csrf-token-invalid") + +;; ── csrf-protect middleware auto-rejects ─────────────────────────── +(define + dream-fo-protected + (fn + (handler) + ((dream-sessions dream-fo-backend) + ((dream-csrf-protect "topsecret") handler)))) +(define dream-fo-ph (dream-fo-protected (fn (req) (dream-text "reached")))) + +(dream-fo-test + "GET passes without token" + (dream-resp-body (dream-fo-ph (dream-request "GET" "/x" {:Cookie "dream.session=s1"} ""))) + "reached") +(dream-fo-test + "POST without token 403" + (dream-status (dream-fo-ph (dream-request "POST" "/x" {:Cookie "dream.session=s1"} ""))) + 403) +(dream-fo-test + "POST with valid token reaches" + (dream-resp-body + (dream-fo-ph + (dream-request + "POST" + "/x" + {:Cookie "dream.session=s1"} + (str "dream.csrf=" dream-fo-good-token)))) + "reached") + +(define dream-fo-tests-run! (fn () {:total (+ dream-fo-pass dream-fo-fail) :passed dream-fo-pass :failed dream-fo-fail :fails dream-fo-fails})) diff --git a/plans/dream-on-sx.md b/plans/dream-on-sx.md index 2da05160..3df906f8 100644 --- a/plans/dream-on-sx.md +++ b/plans/dream-on-sx.md @@ -64,11 +64,11 @@ The five types: `request`, `response`, `handler = request -> response`, `middlew - `dream-flash-middleware` — single-request cookie store. - `dream-add-flash-message req category msg`. - `dream-flash-messages req` — returns list of `(category, msg)`. -- [ ] **Forms + CSRF** in `lib/dream/form.sx`: - - `dream-form req` — returns `(Ok fields)` or `(Err :csrf-token-invalid)`. - - `dream-multipart req` — streaming multipart form data. - - CSRF middleware: stateless signed tokens, session-scoped. - - `dream-csrf-tag req` — returns hidden input fragment for SX templates. +- [~] **Forms + CSRF** in `lib/dream/form.sx`: + - [x] `dream-form req` — returns `(Ok fields)` or `(Err :csrf-token-invalid)`. + - [ ] `dream-multipart req` — streaming multipart form data. *(next commit)* + - [x] CSRF middleware: stateless signed tokens, session-scoped. + - [x] `dream-csrf-tag req` — returns hidden input fragment for SX templates. - [ ] **WebSockets** in `lib/dream/websocket.sx`: - `dream-websocket handler` — upgrades request; handler `(fn (ws) ...)`. - `dream-send ws msg`, `dream-receive ws`, `dream-close ws`. @@ -151,6 +151,19 @@ Confirm scope before starting; some of these may be addable as Dream-internal he 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. +- **2026-06-07 — Forms + CSRF (urlencoded)** (`lib/dream/form.sx`, 26 tests). Ok/Err + result values (`dream-ok`/`dream-err` + predicates/accessors). `dream-form-fields` + parses `application/x-www-form-urlencoded` with a full percent-decoder + (`%XX` via `char-from-code`, `+`→space). CSRF is stateless + signed + session- + scoped: token = `sid.signature`, verified by recomputing the signature and checking + the session id — no server storage. Signing is **injectable** (`dream-csrf-with`); + the default `dream-csrf-sign-default` is a pure-SX dual-base polynomial keyed hash + (NOT cryptographic — production should inject a host HMAC). `dream-csrf` attaches + context (needs the session middleware upstream for the sid); `dream-csrf-token` / + `dream-csrf-tag` (hidden input for templates); `dream-form` returns `Ok fields` or + `Err :csrf-token-invalid`; `dream-csrf-protect` auto-rejects unsafe methods (403) + lacking a valid token. Full session→csrf→form stack verified accept + reject. + Multipart deferred to the next commit. ## Blockers From fbc0c03f3a818b0befea508ee6c73726f95ff91a Mon Sep 17 00:00:00 2001 From: giles Date: Sun, 7 Jun 2026 14:47:10 +0000 Subject: [PATCH 07/22] dream: multipart/form-data parsing + 9 tests Co-Authored-By: Claude Opus 4.8 (1M context) --- lib/dream/form.sx | 138 ++++++++++++++++++++++++++++++++++++++++ lib/dream/tests/form.sx | 53 +++++++++++++-- plans/dream-on-sx.md | 14 +++- 3 files changed, 199 insertions(+), 6 deletions(-) diff --git a/lib/dream/form.sx b/lib/dream/form.sx index 4f4fe1f1..1593b698 100644 --- a/lib/dream/form.sx +++ b/lib/dream/form.sx @@ -58,6 +58,20 @@ ((s2 (replace s "+" " "))) (dr/url-decode-loop s2 0 (string-length s2) "")))) +;; ── substring splitter (split primitive is char-class based) ─────── +(define + dr/split-on + (fn + (s sep) + (let + ((i (index-of s sep))) + (if + (< i 0) + (list s) + (cons + (substr s 0 i) + (dr/split-on (substr s (+ i (string-length sep))) sep)))))) + ;; ── urlencoded body parsing ──────────────────────────────────────── (define dr/parse-form-body @@ -226,3 +240,127 @@ (define dream-csrf-protect (fn (secret) (dream-csrf-protect-with secret dream-csrf-sign-default))) + +;; ── multipart/form-data parsing ──────────────────────────────────── +;; In-memory (not yet streaming): parses the whole body into parts, each +;; {:name :filename :content-type :content}. Returns Ok parts | Err :not-multipart. +(define + dr/multipart-boundary + (fn + (ctype) + (let + ((i (index-of ctype "boundary="))) + (if + (< i 0) + "" + (let + ((raw (trim (substr ctype (+ i 9))))) + (if + (starts-with? raw "\"") + (substr raw 1 (- (string-length raw) 2)) + raw)))))) + +;; strip one leading and one trailing CRLF +(define + dr/strip-edges + (fn + (s) + (let + ((s1 (if (starts-with? s "\r\n") (substr s 2) s))) + (if + (ends-with? s1 "\r\n") + (substr s1 0 (- (string-length s1) 2)) + s1)))) + +;; value of attr="..." within a header block +(define + dr/cd-attr + (fn + (block attr) + (let + ((key (str attr "=\""))) + (let + ((i (index-of block key))) + (if + (< i 0) + nil + (let + ((rest (substr block (+ i (string-length key))))) + (substr rest 0 (index-of rest "\"")))))))) + +;; value of a named header line within a header block +(define + dr/block-header + (fn + (block name) + (reduce + (fn + (acc line) + (if + (and + (nil? acc) + (starts-with? (lower line) (str (lower name) ":"))) + (trim (substr line (+ (index-of line ":") 1))) + acc)) + nil + (dr/split-on block "\r\n")))) + +(define + dr/parse-part + (fn + (seg) + (let + ((s (dr/strip-edges seg))) + (let + ((sp (index-of s "\r\n\r\n"))) + (if + (< sp 0) + nil + (let + ((block (substr s 0 sp)) + (content (substr s (+ sp 4)))) + {:name (dr/cd-attr block "name") :filename (dr/cd-attr block "filename") :content-type (dr/block-header block "content-type") :content content})))))) + +(define + dream-multipart + (fn + (req) + (let + ((boundary (dr/multipart-boundary (or (dream-header req "content-type") "")))) + (if + (= boundary "") + (dream-err :not-multipart) + (let + ((segs (dr/split-on (dream-body req) (str "--" boundary)))) + (dream-ok + (filter + (fn (p) (not (nil? p))) + (map + dr/parse-part + (filter (fn (seg) (starts-with? seg "\r\n")) segs))))))))) + +;; accessors over a parts list +(define + dream-multipart-field + (fn + (parts name) + (reduce + (fn + (acc p) + (if (and (nil? acc) (= (get p :name) name)) (get p :content) acc)) + nil + parts))) + +(define + dream-multipart-file + (fn + (parts name) + (reduce + (fn + (acc p) + (if + (and (nil? acc) (= (get p :name) name) (get p :filename)) + p + acc)) + nil + parts))) diff --git a/lib/dream/tests/form.sx b/lib/dream/tests/form.sx index 5ec7503a..8b1e9eb4 100644 --- a/lib/dream/tests/form.sx +++ b/lib/dream/tests/form.sx @@ -1,4 +1,4 @@ -;; lib/dream/tests/form.sx — urlencoded parsing, Ok/Err, CSRF accept/reject. +;; lib/dream/tests/form.sx — urlencoded parsing, Ok/Err, CSRF accept/reject, multipart. (define dream-fo-pass 0) (define dream-fo-fail 0) @@ -100,14 +100,12 @@ (define dream-fo-backend (dream-memory-sessions)) (define dream-fo-sid (dream-fo-backend {:op "session/create"})) ;; s1 -;; build a request already carrying the session cookie + csrf middleware applied (define dream-fo-stack (fn (handler) ((dream-sessions dream-fo-backend) ((dream-csrf "topsecret") handler)))) -;; a handler that emits its csrf tag (define dream-fo-tag-out (dream-resp-body @@ -122,7 +120,6 @@ (contains? dream-fo-tag-out "name=\"dream.csrf\"") true) -;; valid token (signed for s1) -> dream-form Ok (define dream-fo-good-token (dr/csrf-make-token dream-csrf-sign-default "topsecret" "s1")) @@ -178,4 +175,52 @@ (str "dream.csrf=" dream-fo-good-token)))) "reached") +;; ── multipart/form-data ──────────────────────────────────────────── +(define + dream-fo-mp-body + (str + "--B1\r\n" + "Content-Disposition: form-data; name=\"title\"\r\n\r\n" + "Hello\r\n" + "--B1\r\n" + "Content-Disposition: form-data; name=\"file\"; filename=\"a.txt\"\r\nContent-Type: text/plain\r\n\r\n" + "line1\r\nline2\r\n" + "--B1--\r\n")) +(define + dream-fo-mp-req + (dream-request "POST" "/upload" {:Content-Type "multipart/form-data; boundary=B1"} dream-fo-mp-body)) +(define dream-fo-mp (dream-multipart dream-fo-mp-req)) +(dream-fo-test "multipart is Ok" (dream-ok? dream-fo-mp) true) +(define dream-fo-parts (dream-ok-value dream-fo-mp)) +(dream-fo-test "two parts" (len dream-fo-parts) 2) +(dream-fo-test + "field value" + (dream-multipart-field dream-fo-parts "title") + "Hello") +(dream-fo-test + "file part filename" + (get (dream-multipart-file dream-fo-parts "file") :filename) + "a.txt") +(dream-fo-test + "file content-type" + (get (dream-multipart-file dream-fo-parts "file") :content-type) + "text/plain") +(dream-fo-test + "file content keeps inner CRLF" + (get (dream-multipart-file dream-fo-parts "file") :content) + "line1\r\nline2") +(dream-fo-test + "field is not a file" + (get (dream-multipart-file dream-fo-parts "title") :filename) + nil) +(dream-fo-test + "non-multipart is Err" + (dream-err? (dream-multipart (dream-request "POST" "/x" {:Content-Type "text/plain"} "hi"))) + true) +(dream-fo-test + "quoted boundary parsed" + (dream-ok? + (dream-multipart (dream-request "POST" "/u" {:Content-Type "multipart/form-data; boundary=\"B1\""} dream-fo-mp-body))) + true) + (define dream-fo-tests-run! (fn () {:total (+ dream-fo-pass dream-fo-fail) :passed dream-fo-pass :failed dream-fo-fail :fails dream-fo-fails})) diff --git a/plans/dream-on-sx.md b/plans/dream-on-sx.md index 3df906f8..dc15f3f1 100644 --- a/plans/dream-on-sx.md +++ b/plans/dream-on-sx.md @@ -64,9 +64,9 @@ The five types: `request`, `response`, `handler = request -> response`, `middlew - `dream-flash-middleware` — single-request cookie store. - `dream-add-flash-message req category msg`. - `dream-flash-messages req` — returns list of `(category, msg)`. -- [~] **Forms + CSRF** in `lib/dream/form.sx`: +- [x] **Forms + CSRF** in `lib/dream/form.sx`: - [x] `dream-form req` — returns `(Ok fields)` or `(Err :csrf-token-invalid)`. - - [ ] `dream-multipart req` — streaming multipart form data. *(next commit)* + - [x] `dream-multipart req` — multipart form data (in-memory, not yet streaming). - [x] CSRF middleware: stateless signed tokens, session-scoped. - [x] `dream-csrf-tag req` — returns hidden input fragment for SX templates. - [ ] **WebSockets** in `lib/dream/websocket.sx`: @@ -164,6 +164,16 @@ Confirm scope before starting; some of these may be addable as Dream-internal he `Err :csrf-token-invalid`; `dream-csrf-protect` auto-rejects unsafe methods (403) lacking a valid token. Full session→csrf→form stack verified accept + reject. Multipart deferred to the next commit. +- **2026-06-07 — Multipart** (`lib/dream/form.sx` +9 tests, 35 total). `dream-multipart + req` parses `multipart/form-data` into parts `{:name :filename :content-type + :content}`, returns `Ok parts | Err :not-multipart`. Needed a substring splitter + `dr/split-on` because the `split` primitive is **character-class** based (multi-char + separators split on every char) — important gotcha. Boundary from the Content-Type + (handles quoted form); segments filtered to those starting with CRLF; each split on + the first `\r\n\r\n` into headers/content with one edge CRLF stripped (inner CRLFs + in file content preserved). `dream-multipart-field` / `dream-multipart-file` + accessors. In-memory, not streaming (noted for future). `\r`/`\n` string escapes + work in SX literals. ## Blockers From b67709dab53e71f72cba3322259a7783d92fb73a Mon Sep 17 00:00:00 2001 From: giles Date: Sun, 7 Jun 2026 14:49:15 +0000 Subject: [PATCH 08/22] =?UTF-8?q?dream:=20websockets=20=E2=80=94=20upgrade?= =?UTF-8?q?=20+=20send/receive/close/broadcast=20+=2016=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/tests/websocket.sx | 94 ++++++++++++++++++++++++++++++++++++ lib/dream/websocket.sx | 42 ++++++++++++++++ plans/dream-on-sx.md | 10 +++- 4 files changed, 147 insertions(+), 1 deletion(-) create mode 100644 lib/dream/tests/websocket.sx create mode 100644 lib/dream/websocket.sx diff --git a/lib/dream/conformance.sh b/lib/dream/conformance.sh index dadb9a88..9bc27604 100644 --- a/lib/dream/conformance.sh +++ b/lib/dream/conformance.sh @@ -28,6 +28,7 @@ MODULES=( "lib/dream/session.sx" "lib/dream/flash.sx" "lib/dream/form.sx" + "lib/dream/websocket.sx" ) # Suites: NAME RUNNER-FN PATH @@ -38,6 +39,7 @@ SUITES=( "session dream-ss-tests-run! lib/dream/tests/session.sx" "flash dream-fl-tests-run! lib/dream/tests/flash.sx" "form dream-fo-tests-run! lib/dream/tests/form.sx" + "websocket dream-ws-tests-run! lib/dream/tests/websocket.sx" ) TMPFILE=$(mktemp); trap "rm -f $TMPFILE" EXIT diff --git a/lib/dream/tests/websocket.sx b/lib/dream/tests/websocket.sx new file mode 100644 index 00000000..dea146ac --- /dev/null +++ b/lib/dream/tests/websocket.sx @@ -0,0 +1,94 @@ +;; lib/dream/tests/websocket.sx — upgrade, send/receive/close, broadcast. + +(define dream-ws-pass 0) +(define dream-ws-fail 0) +(define dream-ws-fails (list)) + +(define + dream-ws-test + (fn + (name actual expected) + (if + (= actual expected) + (set! dream-ws-pass (+ dream-ws-pass 1)) + (begin + (set! dream-ws-fail (+ dream-ws-fail 1)) + (append! dream-ws-fails {:name name :actual actual :expected expected}))))) + +;; ── upgrade response ─────────────────────────────────────────────── +(define dream-ws-echo (fn (ws) (dream-text "unused"))) +(define + dream-ws-up + ((dream-websocket dream-ws-echo) (dream-request "GET" "/ws" {} ""))) +(dream-ws-test "upgrade status 101" (dream-status dream-ws-up) 101) +(dream-ws-test "is a websocket response" (dream-websocket? dream-ws-up) true) +(dream-ws-test + "plain response is not ws" + (dream-websocket? (dream-html "x")) + false) +(dream-ws-test + "upgrade header" + (dream-resp-header dream-ws-up "upgrade") + "websocket") + +;; ── basic send / receive / close on a mock ───────────────────────── +(define dream-ws-w1 (dream-mock-ws (list "hi" "there"))) +(dream-ws-test "open initially" (dream-ws-open? dream-ws-w1) true) +(dream-ws-test "receive first" (dream-receive dream-ws-w1) "hi") +(dream-ws-test "receive second" (dream-receive dream-ws-w1) "there") +(dream-ws-test "receive empty -> nil" (dream-receive dream-ws-w1) nil) +(dream-send dream-ws-w1 "out1") +(dream-send dream-ws-w1 "out2") +(dream-ws-test + "sent recorded" + (dream-ws-sent dream-ws-w1) + (list "out1" "out2")) +(dream-close dream-ws-w1) +(dream-ws-test "closed flag" (dream-ws-closed? dream-ws-w1) true) +(dream-ws-test "open? false after close" (dream-ws-open? dream-ws-w1) false) + +;; ── echo handler driven over the upgrade response ────────────────── +(define + dream-ws-echo-h + (fn + (ws) + (let + ((m (dream-receive ws))) + (if + (nil? m) + (dream-close ws) + (begin (dream-send ws (str "echo:" m)) (dream-ws-echo-h ws)))))) +(define + dream-ws-echo-up + ((dream-websocket dream-ws-echo-h) + (dream-request "GET" "/ws" {} ""))) +(define dream-ws-echo-conn (dream-mock-ws (list "a" "b" "c"))) +(dream-ws-run dream-ws-echo-up dream-ws-echo-conn) +(dream-ws-test + "echo all messages" + (dream-ws-sent dream-ws-echo-conn) + (list "echo:a" "echo:b" "echo:c")) +(dream-ws-test + "echo closes at end" + (dream-ws-closed? dream-ws-echo-conn) + true) + +;; ── broadcast to a room ──────────────────────────────────────────── +(define dream-ws-c1 (dream-mock-ws (list))) +(define dream-ws-c2 (dream-mock-ws (list))) +(define dream-ws-c3 (dream-mock-ws (list))) +(dream-ws-broadcast (list dream-ws-c1 dream-ws-c2 dream-ws-c3) "hello room") +(dream-ws-test + "broadcast c1" + (dream-ws-sent dream-ws-c1) + (list "hello room")) +(dream-ws-test + "broadcast c2" + (dream-ws-sent dream-ws-c2) + (list "hello room")) +(dream-ws-test + "broadcast c3" + (dream-ws-sent dream-ws-c3) + (list "hello room")) + +(define dream-ws-tests-run! (fn () {:total (+ dream-ws-pass dream-ws-fail) :passed dream-ws-pass :failed dream-ws-fail :fails dream-ws-fails})) diff --git a/lib/dream/websocket.sx b/lib/dream/websocket.sx new file mode 100644 index 00000000..b55c0f10 --- /dev/null +++ b/lib/dream/websocket.sx @@ -0,0 +1,42 @@ +;; lib/dream/websocket.sx — Dream-on-SX WebSockets. +;; dream-websocket wraps a (fn (ws) ...) handler into an ordinary handler that +;; returns a 101 upgrade response carrying the ws handler. The host detects the +;; upgrade, builds a ws backed by host IO, and runs the handler. The ws carries an +;; injectable io fn — a mock in-memory ws for tests, (perform op) in production. +;; Depends on types.sx. + +;; ── upgrade response ─────────────────────────────────────────────── +(define dream-websocket (fn (handler) (fn (req) {:websocket handler :body "" :headers {:connection "Upgrade" :upgrade "websocket"} :status 101}))) + +(define + dream-websocket? + (fn (resp) (and (dict? resp) (has-key? resp :websocket)))) +(define dream-ws-handler (fn (resp) (get resp :websocket))) + +;; ── ws operations (over an injectable io) ────────────────────────── +(define dream-send (fn (ws msg) ((get ws :io) {:op "ws/send" :msg msg}))) +(define dream-receive (fn (ws) ((get ws :io) {:op "ws/receive"}))) +(define dream-close (fn (ws) ((get ws :io) {:op "ws/close"}))) +(define dream-ws-open? (fn (ws) ((get ws :io) {:op "ws/open?"}))) +(define + dream-ws-broadcast + (fn (wss msg) (for-each (fn (ws) (dream-send ws msg)) wss))) + +;; production io: every op suspends to the host +(define dream-ws-perform-io (fn (op) (perform op))) +(define dream-ws-from-io (fn (io) {:io io})) + +;; ── in-memory mock ws (tests + demos) ────────────────────────────── +;; incoming is a list of messages dream-receive will yield in order. +(define + dream-mock-ws + (fn + (incoming) + (let ((inbox incoming) (outbox (list)) (closed false)) {:closed? (fn () closed) :outbox (fn () outbox) :io (fn (op) (cond ((= (get op :op) "ws/send") (begin (set! outbox (concat outbox (list (get op :msg)))) true)) ((= (get op :op) "ws/receive") (if (empty? inbox) nil (let ((m (first inbox))) (begin (set! inbox (rest inbox)) m)))) ((= (get op :op) "ws/close") (begin (set! closed true) true)) ((= (get op :op) "ws/open?") (not closed)) (else nil)))}))) + +;; test/demo introspection +(define dream-ws-sent (fn (ws) ((get ws :outbox)))) +(define dream-ws-closed? (fn (ws) ((get ws :closed?)))) + +;; drive a ws handler (from an upgrade response) against a ws +(define dream-ws-run (fn (resp ws) ((dream-ws-handler resp) ws))) diff --git a/plans/dream-on-sx.md b/plans/dream-on-sx.md index dc15f3f1..99e49ed2 100644 --- a/plans/dream-on-sx.md +++ b/plans/dream-on-sx.md @@ -69,7 +69,7 @@ The five types: `request`, `response`, `handler = request -> response`, `middlew - [x] `dream-multipart req` — multipart form data (in-memory, not yet streaming). - [x] CSRF middleware: stateless signed tokens, session-scoped. - [x] `dream-csrf-tag req` — returns hidden input fragment for SX templates. -- [ ] **WebSockets** in `lib/dream/websocket.sx`: +- [x] **WebSockets** in `lib/dream/websocket.sx`: - `dream-websocket handler` — upgrades request; handler `(fn (ws) ...)`. - `dream-send ws msg`, `dream-receive ws`, `dream-close ws`. - [ ] **Static files:** `dream-static root-path` — serves files, ETags, range requests. @@ -174,6 +174,14 @@ Confirm scope before starting; some of these may be addable as Dream-internal he in file content preserved). `dream-multipart-field` / `dream-multipart-file` accessors. In-memory, not streaming (noted for future). `\r`/`\n` string escapes work in SX literals. +- **2026-06-07 — WebSockets** (`lib/dream/websocket.sx`, 16 tests). `dream-websocket + handler` wraps a `(fn (ws) …)` into an ordinary handler returning a 101 upgrade + response carrying the ws handler (`dream-websocket?` / `dream-ws-handler` for the + host to detect + dispatch). `dream-send` / `dream-receive` / `dream-close` / + `dream-ws-open?` / `dream-ws-broadcast` operate over an injectable io; production io + is `(perform op)`, tests use `dream-mock-ws` (in-memory inbox/outbox/closed via the + cell pattern) with `dream-ws-sent` / `dream-ws-closed?` introspection and + `dream-ws-run` to drive a handler. Echo loop + room broadcast verified. ## Blockers From 04b44401fb4980250c182fc313a6de2fbf330c5f Mon Sep 17 00:00:00 2001 From: giles Date: Sun, 7 Jun 2026 14:51:25 +0000 Subject: [PATCH 09/22] =?UTF-8?q?dream:=20static=20file=20serving=20?= =?UTF-8?q?=E2=80=94=20mime,=20etags,=20304,=20ranges,=20traversal=20guard?= =?UTF-8?q?=20+=2028=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/static.sx | 182 ++++++++++++++++++++++++++++++++++++++ lib/dream/tests/static.sx | 125 ++++++++++++++++++++++++++ plans/dream-on-sx.md | 9 +- 4 files changed, 317 insertions(+), 1 deletion(-) create mode 100644 lib/dream/static.sx create mode 100644 lib/dream/tests/static.sx diff --git a/lib/dream/conformance.sh b/lib/dream/conformance.sh index 9bc27604..26462fad 100644 --- a/lib/dream/conformance.sh +++ b/lib/dream/conformance.sh @@ -29,6 +29,7 @@ MODULES=( "lib/dream/flash.sx" "lib/dream/form.sx" "lib/dream/websocket.sx" + "lib/dream/static.sx" ) # Suites: NAME RUNNER-FN PATH @@ -40,6 +41,7 @@ SUITES=( "flash dream-fl-tests-run! lib/dream/tests/flash.sx" "form dream-fo-tests-run! lib/dream/tests/form.sx" "websocket dream-ws-tests-run! lib/dream/tests/websocket.sx" + "static dream-st-tests-run! lib/dream/tests/static.sx" ) TMPFILE=$(mktemp); trap "rm -f $TMPFILE" EXIT diff --git a/lib/dream/static.sx b/lib/dream/static.sx new file mode 100644 index 00000000..372019a3 --- /dev/null +++ b/lib/dream/static.sx @@ -0,0 +1,182 @@ +;; lib/dream/static.sx — Dream-on-SX static file serving. +;; dream-static mounts at a ** route and serves files under a root: content-type by +;; extension, ETags + If-None-Match (304), and Range requests (206). The filesystem +;; is injectable: production reads via (perform op); tests pass an in-memory map. +;; Depends on types.sx. + +;; ── filesystem backends ──────────────────────────────────────────── +;; An fs is (fn (op) result); op {:op "file/read" :path p} -> content | nil. +(define dream-static-perform-fs (fn (op) (perform op))) + +;; in-memory fs over a {path -> content} dict (tests + demos) +(define + dream-memory-fs + (fn + (files) + (fn + (op) + (if (= (get op :op) "file/read") (get files (get op :path)) nil)))) + +;; ── content-type by extension ────────────────────────────────────── +(define dr/mime-types {:js "application/javascript" :jpeg "image/jpeg" :css "text/css; charset=utf-8" :ico "image/x-icon" :mjs "application/javascript" :html "text/html; charset=utf-8" :pdf "application/pdf" :jpg "image/jpeg" :json "application/json" :htm "text/html; charset=utf-8" :wasm "application/wasm" :webp "image/webp" :gif "image/gif" :png "image/png" :svg "image/svg+xml" :md "text/markdown; charset=utf-8" :xml "application/xml" :sx "text/plain; charset=utf-8" :txt "text/plain; charset=utf-8"}) + +(define + dr/ext-of + (fn + (path) + (let + ((segs (split path "."))) + (if + (> (len segs) 1) + (lower (nth segs (- (len segs) 1))) + "")))) + +(define + dream-content-type-for + (fn + (path) + (or (get dr/mime-types (dr/ext-of path)) "application/octet-stream"))) + +;; ── ETag (weak content hash) ─────────────────────────────────────── +(define + dr/static-hash + (fn (s) (dr/static-hash-loop s 0 (string-length s) 7))) +(define + dr/static-hash-loop + (fn + (s i n h) + (if + (>= i n) + h + (dr/static-hash-loop + s + (+ i 1) + n + (mod (+ (* h 131) (char-code (char-at s i))) 2147483647))))) +(define + dr/etag-of + (fn + (content) + (str "\"" (dr/static-hash content) "-" (string-length content) "\""))) +(define + dr/etag-match? + (fn (inm etag) (and (not (nil? inm)) (or (= inm "*") (= inm etag))))) + +;; ── path safety ──────────────────────────────────────────────────── +(define + dr/static-relpath + (fn + (req) + (or (dream-param req "**") (substr (dream-path req) 1)))) +(define + dr/unsafe-path? + (fn (rel) (or (contains? rel "..") (starts-with? rel "/")))) +(define + dr/path-join + (fn + (root rel) + (if (ends-with? root "/") (str root rel) (str root "/" rel)))) + +;; ── range requests ───────────────────────────────────────────────── +(define + dr/parse-range + (fn + (header total) + (let + ((eq (index-of header "="))) + (if + (< eq 0) + nil + (let + ((spec (substr header (+ eq 1)))) + (let + ((dash (index-of spec "-"))) + (if + (< dash 0) + nil + (let + ((s (substr spec 0 dash)) + (e (substr spec (+ dash 1)))) + (let + ((start (if (= s "") 0 (parse-int s))) + (end (if (= e "") (- total 1) (parse-int e)))) + (if + (or + (< start 0) + (>= start total) + (> end (- total 1)) + (> start end)) + nil + {:start start :end end})))))))))) + +(define + dr/serve-range + (fn + (req content etag ctype) + (let + ((total (string-length content))) + (let + ((r (dr/parse-range (dream-header req "range") total))) + (if + (nil? r) + (dream-add-header + (dream-response 416 {:content-type ctype} "") + "content-range" + (str "bytes */" total)) + (let + ((start (get r :start)) (end (get r :end))) + (dream-add-header + (dream-add-header + (dream-response + 206 + {:content-type ctype} + (substr content start (+ 1 (- end start)))) + "content-range" + (str "bytes " start "-" end "/" total)) + "etag" + etag))))))) + +;; ── serving ──────────────────────────────────────────────────────── +(define + dr/serve-file + (fn + (req content) + (let + ((rel (dr/static-relpath req))) + (let + ((etag (dr/etag-of content)) (ctype (dream-content-type-for rel))) + (cond + ((dr/etag-match? (dream-header req "if-none-match") etag) + (dream-add-header (dream-empty 304) "etag" etag)) + ((dream-header req "range") + (dr/serve-range req content etag ctype)) + (else + (dream-add-header + (dream-add-header + (dream-response 200 {:content-type ctype} content) + "etag" + etag) + "accept-ranges" + "bytes"))))))) + +(define + dream-static-with + (fn + (root fs) + (fn + (req) + (let + ((rel (dr/static-relpath req))) + (if + (dr/unsafe-path? rel) + (dream-html-status 403 "Forbidden") + (let + ((content (fs {:path (dr/path-join root rel) :op "file/read"}))) + (if + (nil? content) + (dream-not-found) + (dr/serve-file req content)))))))) + +(define + dream-static + (fn (root) (dream-static-with root dream-static-perform-fs))) diff --git a/lib/dream/tests/static.sx b/lib/dream/tests/static.sx new file mode 100644 index 00000000..2df74b5b --- /dev/null +++ b/lib/dream/tests/static.sx @@ -0,0 +1,125 @@ +;; lib/dream/tests/static.sx — content types, etags, 304, ranges, traversal. + +(define dream-st-pass 0) +(define dream-st-fail 0) +(define dream-st-fails (list)) + +(define + dream-st-test + (fn + (name actual expected) + (if + (= actual expected) + (set! dream-st-pass (+ dream-st-pass 1)) + (begin + (set! dream-st-fail (+ dream-st-fail 1)) + (append! dream-st-fails {:name name :actual actual :expected expected}))))) + +;; ── content type + ext ───────────────────────────────────────────── +(dream-st-test "ext css" (dr/ext-of "a/b/style.css") "css") +(dream-st-test "ext multi-dot" (dr/ext-of "a.min.js") "js") +(dream-st-test "ext none" (dr/ext-of "README") "") +(dream-st-test + "ctype css" + (dream-content-type-for "x.css") + "text/css; charset=utf-8") +(dream-st-test + "ctype html" + (dream-content-type-for "x.html") + "text/html; charset=utf-8") +(dream-st-test "ctype png" (dream-content-type-for "x.png") "image/png") +(dream-st-test + "ctype unknown" + (dream-content-type-for "x.bin") + "application/octet-stream") + +;; ── etag ─────────────────────────────────────────────────────────── +(dream-st-test + "etag deterministic" + (= (dr/etag-of "abc") (dr/etag-of "abc")) + true) +(dream-st-test + "etag content-sensitive" + (= (dr/etag-of "abc") (dr/etag-of "abd")) + false) +(dream-st-test + "etag length-sensitive" + (= (dr/etag-of "ab") (dr/etag-of "abc")) + false) + +;; ── serving via router mount ─────────────────────────────────────── +(define dream-st-files {:/srv/app.css "body{color:red}" :/srv/index.html "

Hi

"}) +(define dream-st-fs (dream-memory-fs dream-st-files)) +(define + dream-st-app + (dream-router + (list (dream-get "/static/**" (dream-static-with "/srv" dream-st-fs))))) +(define + dream-st-get + (fn + (target headers) + (dream-st-app (dream-request "GET" target headers "")))) + +(define dream-st-css (dream-st-get "/static/app.css" {})) +(dream-st-test "serve status 200" (dream-status dream-st-css) 200) +(dream-st-test "serve body" (dream-resp-body dream-st-css) "body{color:red}") +(dream-st-test + "serve content-type" + (dream-resp-header dream-st-css "content-type") + "text/css; charset=utf-8") +(dream-st-test + "serve accept-ranges" + (dream-resp-header dream-st-css "accept-ranges") + "bytes") +(dream-st-test + "serve has etag" + (not (nil? (dream-resp-header dream-st-css "etag"))) + true) +(dream-st-test + "missing file 404" + (dream-status (dream-st-get "/static/nope.txt" {})) + 404) +(dream-st-test + "traversal blocked 403" + (dream-status (dream-st-get "/static/../secret" {})) + 403) + +;; ── conditional: If-None-Match -> 304 ────────────────────────────── +(define dream-st-etag (dream-resp-header dream-st-css "etag")) +(define dream-st-304 (dream-st-get "/static/app.css" {:If-None-Match dream-st-etag})) +(dream-st-test "matching etag 304" (dream-status dream-st-304) 304) +(dream-st-test "304 empty body" (dream-resp-body dream-st-304) "") +(dream-st-test + "stale etag 200" + (dream-status (dream-st-get "/static/app.css" {:If-None-Match "\"stale\""})) + 200) +(dream-st-test + "star etag 304" + (dream-status (dream-st-get "/static/app.css" {:If-None-Match "*"})) + 304) + +;; ── range requests ───────────────────────────────────────────────── +(define dream-st-range (dream-st-get "/static/app.css" {:Range "bytes=0-3"})) +(dream-st-test "range status 206" (dream-status dream-st-range) 206) +(dream-st-test "range body slice" (dream-resp-body dream-st-range) "body") +(dream-st-test + "range content-range" + (dream-resp-header dream-st-range "content-range") + "bytes 0-3/15") +(define dream-st-open (dream-st-get "/static/app.css" {:Range "bytes=5-"})) +(dream-st-test "open range body" (dream-resp-body dream-st-open) "color:red}") +(dream-st-test + "open range header" + (dream-resp-header dream-st-open "content-range") + "bytes 5-14/15") +(define dream-st-bad (dream-st-get "/static/app.css" {:Range "bytes=20-30"})) +(dream-st-test + "unsatisfiable range 416" + (dream-status dream-st-bad) + 416) +(dream-st-test + "416 content-range" + (dream-resp-header dream-st-bad "content-range") + "bytes */15") + +(define dream-st-tests-run! (fn () {:total (+ dream-st-pass dream-st-fail) :passed dream-st-pass :failed dream-st-fail :fails dream-st-fails})) diff --git a/plans/dream-on-sx.md b/plans/dream-on-sx.md index 99e49ed2..bd7228f8 100644 --- a/plans/dream-on-sx.md +++ b/plans/dream-on-sx.md @@ -72,7 +72,7 @@ The five types: `request`, `response`, `handler = request -> response`, `middlew - [x] **WebSockets** in `lib/dream/websocket.sx`: - `dream-websocket handler` — upgrades request; handler `(fn (ws) ...)`. - `dream-send ws msg`, `dream-receive ws`, `dream-close ws`. -- [ ] **Static files:** `dream-static root-path` — serves files, ETags, range requests. +- [x] **Static files:** `dream-static root-path` — serves files, ETags, range requests. - [ ] **`dream-run`**: wires root handler into SX's `perform (:http-listen ...)`. - [ ] **Demos** in `lib/dream/demos/`: - `hello.ml` → `lib/dream/demos/hello.sx`: "Hello, World!" route. @@ -182,6 +182,13 @@ Confirm scope before starting; some of these may be addable as Dream-internal he is `(perform op)`, tests use `dream-mock-ws` (in-memory inbox/outbox/closed via the cell pattern) with `dream-ws-sent` / `dream-ws-closed?` introspection and `dream-ws-run` to drive a handler. Echo loop + room broadcast verified. +- **2026-06-07 — Static files** (`lib/dream/static.sx`, 28 tests). `dream-static root` + mounts at a `**` route and serves files: content-type by extension (mime map), + weak ETag (`"hash-length"`) with `If-None-Match` → 304 (incl. `*`), and `Range: + bytes=` requests → 206 with `Content-Range` (open-ended `bytes=N-` supported, + unsatisfiable → 416). `..`/absolute path traversal → 403; missing → 404; full + responses advertise `Accept-Ranges`. Filesystem is injectable — + `dream-static-perform-fs` (host) vs `dream-memory-fs` (in-memory map for tests). ## Blockers From 2b42aabe6b47a06cb50fc0b88ce6bcb604e42e03 Mon Sep 17 00:00:00 2001 From: giles Date: Sun, 7 Jun 2026 14:53:10 +0000 Subject: [PATCH 10/22] dream: dream-run entry point + request/response host adapter + 20 tests Co-Authored-By: Claude Opus 4.8 (1M context) --- lib/dream/conformance.sh | 2 + lib/dream/run.sx | 42 +++++++++++++ lib/dream/tests/run.sx | 123 +++++++++++++++++++++++++++++++++++++++ plans/dream-on-sx.md | 11 +++- 4 files changed, 177 insertions(+), 1 deletion(-) create mode 100644 lib/dream/run.sx create mode 100644 lib/dream/tests/run.sx diff --git a/lib/dream/conformance.sh b/lib/dream/conformance.sh index 26462fad..2748ccd3 100644 --- a/lib/dream/conformance.sh +++ b/lib/dream/conformance.sh @@ -30,6 +30,7 @@ MODULES=( "lib/dream/form.sx" "lib/dream/websocket.sx" "lib/dream/static.sx" + "lib/dream/run.sx" ) # Suites: NAME RUNNER-FN PATH @@ -42,6 +43,7 @@ SUITES=( "form dream-fo-tests-run! lib/dream/tests/form.sx" "websocket dream-ws-tests-run! lib/dream/tests/websocket.sx" "static dream-st-tests-run! lib/dream/tests/static.sx" + "run dream-rn-tests-run! lib/dream/tests/run.sx" ) TMPFILE=$(mktemp); trap "rm -f $TMPFILE" EXIT diff --git a/lib/dream/run.sx b/lib/dream/run.sx new file mode 100644 index 00000000..18401f86 --- /dev/null +++ b/lib/dream/run.sx @@ -0,0 +1,42 @@ +;; lib/dream/run.sx — Dream-on-SX entry point. +;; dream-run installs a root handler into the existing SX HTTP server via +;; (perform (:http/listen …)) — it does NOT implement its own socket loop. The +;; host invokes the installed app per request with a raw request dict; the app +;; adapts it to a dream-request, runs the handler, and serialises the response +;; (status/headers/body/set-cookies, or a websocket upgrade). Depends on types.sx +;; + websocket.sx. The listen transport is injectable for testing. + +;; ── response serialisation for the host ──────────────────────────── +(define + dr/serialize-response + (fn (resp) (if (dream-websocket? resp) {:websocket (dream-ws-handler resp) :body "" :headers (dream-headers resp) :status 101 :set-cookies (list)} {:body (dream-resp-body resp) :headers (dream-headers resp) :status (dream-status resp) :set-cookies (dream-resp-cookies resp)}))) + +;; ── the app: raw host request -> serialised response ─────────────── +(define + dream-app + (fn + (handler) + (fn + (raw) + (let + ((req (dream-request (or (get raw :method) "GET") (or (get raw :target) (or (get raw :path) "/")) (or (get raw :headers) {}) (or (get raw :body) "")))) + (dr/serialize-response (dream-coerce-response (handler req))))))) + +;; ── dream-run ────────────────────────────────────────────────────── +(define dream-default-port 8080) + +(define dream-run-with (fn (listen handler opts) (listen {:op "http/listen" :port (or (get opts :port) dream-default-port) :app (dream-app handler) :host (or (get opts :host) "0.0.0.0")}))) + +(define dream-perform-listen (fn (op) (perform op))) + +(define + dream-run + (fn (handler) (dream-run-with dream-perform-listen handler {}))) +(define + dream-run-port + (fn + (handler port) + (dream-run-with dream-perform-listen handler {:port port}))) +(define + dream-run-opts + (fn (handler opts) (dream-run-with dream-perform-listen handler opts))) diff --git a/lib/dream/tests/run.sx b/lib/dream/tests/run.sx new file mode 100644 index 00000000..2298ea15 --- /dev/null +++ b/lib/dream/tests/run.sx @@ -0,0 +1,123 @@ +;; lib/dream/tests/run.sx — app adapter + dream-run wiring. + +(define dream-rn-pass 0) +(define dream-rn-fail 0) +(define dream-rn-fails (list)) + +(define + dream-rn-test + (fn + (name actual expected) + (if + (= actual expected) + (set! dream-rn-pass (+ dream-rn-pass 1)) + (begin + (set! dream-rn-fail (+ dream-rn-fail 1)) + (append! dream-rn-fails {:name name :actual actual :expected expected}))))) + +;; ── app adapter: raw -> serialised response ──────────────────────── +(define + dream-rn-router + (dream-router + (list + (dream-get "/" (fn (req) (dream-text "home"))) + (dream-get + "/u/:id" + (fn (req) (dream-text (str "u=" (dream-param req "id"))))) + (dream-post "/echo" (fn (req) (dream-text (dream-body req))))))) +(define dream-rn-app (dream-app dream-rn-router)) + +(define dream-rn-r1 (dream-rn-app {:method "GET" :target "/"})) +(dream-rn-test "serialised status" (get dream-rn-r1 :status) 200) +(dream-rn-test "serialised body" (get dream-rn-r1 :body) "home") +(dream-rn-test + "serialised content-type" + (get (get dream-rn-r1 :headers) "content-type") + "text/plain; charset=utf-8") +(dream-rn-test + "serialised set-cookies empty" + (get dream-rn-r1 :set-cookies) + (list)) + +(dream-rn-test + "adapts target+params" + (get (dream-rn-app {:method "GET" :target "/u/42"}) :body) + "u=42") +(dream-rn-test "adapts body" (get (dream-rn-app {:body "ping" :method "POST" :target "/echo"}) :body) "ping") +(dream-rn-test + "method defaults to GET" + (get (dream-rn-app {:target "/"}) :body) + "home") +(dream-rn-test + "missing target -> /" + (get (dream-rn-app {:method "GET"}) :status) + 200) +(dream-rn-test + "unknown route 404" + (get (dream-rn-app {:method "GET" :target "/nope"}) :status) + 404) + +;; bare-string handler is coerced +(define dream-rn-bare (dream-app (fn (req) "plain"))) +(dream-rn-test + "coerces bare string status" + (get (dream-rn-bare {:target "/"}) :status) + 200) +(dream-rn-test + "coerces bare string body" + (get (dream-rn-bare {:target "/"}) :body) + "plain") + +;; ── set-cookies flow through (session middleware) ────────────────── +(define + dream-rn-sess-app + (dream-app + ((dream-sessions (dream-memory-sessions)) + (fn (req) (dream-text "ok"))))) +(define dream-rn-sess-r (dream-rn-sess-app {:method "GET" :target "/"})) +(dream-rn-test + "session set-cookie present" + (len (get dream-rn-sess-r :set-cookies)) + 1) +(dream-rn-test + "session cookie content" + (contains? (first (get dream-rn-sess-r :set-cookies)) "dream.session=") + true) + +;; ── websocket upgrade serialisation ──────────────────────────────── +(define + dream-rn-ws-app + (dream-app (dream-websocket (fn (ws) (dream-close ws))))) +(define dream-rn-ws-r (dream-rn-ws-app {:method "GET" :target "/ws"})) +(dream-rn-test "ws upgrade status 101" (get dream-rn-ws-r :status) 101) +(dream-rn-test + "ws handler carried" + (not (nil? (get dream-rn-ws-r :websocket))) + true) + +;; ── dream-run wiring (mock listen captures the op) ───────────────── +(define dream-rn-captured nil) +(define + dream-rn-listen + (fn (op) (begin (set! dream-rn-captured op) :listening))) +(define + dream-rn-result + (dream-run-with dream-rn-listen dream-rn-router {:port 9000})) +(dream-rn-test "listen returns" dream-rn-result :listening) +(dream-rn-test "listen op kind" (get dream-rn-captured :op) "http/listen") +(dream-rn-test "listen port" (get dream-rn-captured :port) 9000) +(dream-rn-test + "default port" + (get + (begin + (dream-run-with dream-rn-listen dream-rn-router {}) + dream-rn-captured) + :port) + 8080) +;; the captured app is runnable +(dream-rn-test + "captured app serves" + (get ((get dream-rn-captured :app) {:method "GET" :target "/"}) :body) + "home") + +(define dream-rn-tests-run! (fn () {:total (+ dream-rn-pass dream-rn-fail) :passed dream-rn-pass :failed dream-rn-fail :fails dream-rn-fails})) diff --git a/plans/dream-on-sx.md b/plans/dream-on-sx.md index bd7228f8..c97ee1d6 100644 --- a/plans/dream-on-sx.md +++ b/plans/dream-on-sx.md @@ -73,7 +73,7 @@ The five types: `request`, `response`, `handler = request -> response`, `middlew - `dream-websocket handler` — upgrades request; handler `(fn (ws) ...)`. - `dream-send ws msg`, `dream-receive ws`, `dream-close ws`. - [x] **Static files:** `dream-static root-path` — serves files, ETags, range requests. -- [ ] **`dream-run`**: wires root handler into SX's `perform (:http-listen ...)`. +- [x] **`dream-run`**: wires root handler into SX's `perform (:http-listen ...)`. - [ ] **Demos** in `lib/dream/demos/`: - `hello.ml` → `lib/dream/demos/hello.sx`: "Hello, World!" route. - `counter.ml` → `lib/dream/demos/counter.sx`: in-memory counter with sessions. @@ -189,6 +189,15 @@ Confirm scope before starting; some of these may be addable as Dream-internal he unsatisfiable → 416). `..`/absolute path traversal → 403; missing → 404; full responses advertise `Accept-Ranges`. Filesystem is injectable — `dream-static-perform-fs` (host) vs `dream-memory-fs` (in-memory map for tests). +- **2026-06-07 — dream-run** (`lib/dream/run.sx`, 20 tests). `dream-run handler` + installs the root handler via `(perform (:http/listen {:port :host :app …}))` — no + socket code, it wraps the existing server. `dream-app handler` is the adapter the + host invokes per request: raw `{:method :target :headers :body}` → `dream-request` + → handler → serialised `{:status :headers :body :set-cookies}`, or a `{:status 101 + :websocket …}` upgrade. Bare-string handlers coerced; method defaults to GET; + set-cookies (from session/flash) flow through. Listen transport injectable + (`dream-run-with`) so the full wiring is tested with a mock that captures the op and + re-runs the captured app. `dream-run-port` / `dream-run-opts` variants. ## Blockers From 2551109ffa0887eba77e87afa97ec4675a4db227 Mon Sep 17 00:00:00 2001 From: giles Date: Sun, 7 Jun 2026 14:54:46 +0000 Subject: [PATCH 11/22] dream: hello + counter demos + 10 end-to-end tests Co-Authored-By: Claude Opus 4.8 (1M context) --- lib/dream/conformance.sh | 3 ++ lib/dream/demos/counter.sx | 35 ++++++++++++++++ lib/dream/demos/hello.sx | 16 ++++++++ lib/dream/tests/demos.sx | 83 ++++++++++++++++++++++++++++++++++++++ plans/dream-on-sx.md | 15 ++++--- 5 files changed, 147 insertions(+), 5 deletions(-) create mode 100644 lib/dream/demos/counter.sx create mode 100644 lib/dream/demos/hello.sx create mode 100644 lib/dream/tests/demos.sx diff --git a/lib/dream/conformance.sh b/lib/dream/conformance.sh index 2748ccd3..2cd59de2 100644 --- a/lib/dream/conformance.sh +++ b/lib/dream/conformance.sh @@ -31,6 +31,8 @@ MODULES=( "lib/dream/websocket.sx" "lib/dream/static.sx" "lib/dream/run.sx" + "lib/dream/demos/hello.sx" + "lib/dream/demos/counter.sx" ) # Suites: NAME RUNNER-FN PATH @@ -44,6 +46,7 @@ SUITES=( "websocket dream-ws-tests-run! lib/dream/tests/websocket.sx" "static dream-st-tests-run! lib/dream/tests/static.sx" "run dream-rn-tests-run! lib/dream/tests/run.sx" + "demos dream-dm-tests-run! lib/dream/tests/demos.sx" ) TMPFILE=$(mktemp); trap "rm -f $TMPFILE" EXIT diff --git a/lib/dream/demos/counter.sx b/lib/dream/demos/counter.sx new file mode 100644 index 00000000..4166d7f7 --- /dev/null +++ b/lib/dream/demos/counter.sx @@ -0,0 +1,35 @@ +;; lib/dream/demos/counter.sx — per-session visit counter (counter.ml). +;; Demonstrates the session middleware: each browser session keeps its own count. + +(define + dream-counter-handler + (fn + (req) + (let + ((n (+ 1 (or (dream-session-field req "count") 0)))) + (begin + (dream-set-session-field req "count" n) + (dream-html (str "

You have visited this page " n " time(s).

")))))) + +;; reset clears the session counter +(define + dream-counter-reset + (fn + (req) + (begin + (dream-set-session-field req "count" 0) + (dream-redirect "/")))) + +(define + dream-counter-app-with + (fn + (backend) + ((dream-sessions backend) + (dream-router + (list + (dream-get "/" dream-counter-handler) + (dream-post "/reset" dream-counter-reset)))))) + +(define dream-counter-app (dream-counter-app-with (dream-memory-sessions))) + +;; entry point: (dream-run (dream-counter-app-with (dream-memory-sessions))) diff --git a/lib/dream/demos/hello.sx b/lib/dream/demos/hello.sx new file mode 100644 index 00000000..0082dc25 --- /dev/null +++ b/lib/dream/demos/hello.sx @@ -0,0 +1,16 @@ +;; lib/dream/demos/hello.sx — the canonical Dream "Hello, World!" (hello.ml). +;; Dream.run (Dream.router [Dream.get "/" (fun _ -> Dream.html "Hello!")]). + +(define + dream-hello-app + (dream-router + (list + (dream-get "/" (fn (req) (dream-html "

Hello, World!

"))) + (dream-get + "/hello/:name" + (fn + (req) + (dream-html (str "

Hello, " (dream-param req "name") "!

"))))))) + +;; entry point (installs the handler on the host): +;; (dream-run dream-hello-app) diff --git a/lib/dream/tests/demos.sx b/lib/dream/tests/demos.sx new file mode 100644 index 00000000..7394dbd9 --- /dev/null +++ b/lib/dream/tests/demos.sx @@ -0,0 +1,83 @@ +;; lib/dream/tests/demos.sx — end-to-end demo apps exercising the full stack. + +(define dream-dm-pass 0) +(define dream-dm-fail 0) +(define dream-dm-fails (list)) + +(define + dream-dm-test + (fn + (name actual expected) + (if + (= actual expected) + (set! dream-dm-pass (+ dream-dm-pass 1)) + (begin + (set! dream-dm-fail (+ dream-dm-fail 1)) + (append! dream-dm-fails {:name name :actual actual :expected expected}))))) + +(define + dream-dm-req + (fn (method target headers) (dream-request method target headers ""))) + +;; ── hello ────────────────────────────────────────────────────────── +(dream-dm-test + "hello root" + (dream-resp-body (dream-hello-app (dream-dm-req "GET" "/" {}))) + "

Hello, World!

") +(dream-dm-test + "hello name" + (dream-resp-body + (dream-hello-app (dream-dm-req "GET" "/hello/Ada" {}))) + "

Hello, Ada!

") +(dream-dm-test + "hello content-type" + (dream-resp-header + (dream-hello-app (dream-dm-req "GET" "/" {})) + "content-type") + "text/html; charset=utf-8") + +;; ── counter (sessions) ───────────────────────────────────────────── +(define dream-dm-cbackend (dream-memory-sessions)) +(define dream-dm-capp (dream-counter-app-with dream-dm-cbackend)) + +;; first visit: no cookie -> count 1, session cookie set +(define dream-dm-c1 (dream-dm-capp (dream-dm-req "GET" "/" {}))) +(dream-dm-test + "counter first visit" + (dream-resp-body dream-dm-c1) + "

You have visited this page 1 time(s).

") +(dream-dm-test + "counter sets cookie" + (len (dream-resp-cookies dream-dm-c1)) + 1) + +;; subsequent visits with the cookie increment +(dream-dm-test + "counter second visit" + (dream-resp-body (dream-dm-capp (dream-dm-req "GET" "/" {:Cookie "dream.session=s1"}))) + "

You have visited this page 2 time(s).

") +(dream-dm-test + "counter third visit" + (dream-resp-body (dream-dm-capp (dream-dm-req "GET" "/" {:Cookie "dream.session=s1"}))) + "

You have visited this page 3 time(s).

") + +;; reset zeroes the counter then redirects +(define + dream-dm-reset + (dream-dm-capp (dream-dm-req "POST" "/reset" {:Cookie "dream.session=s1"}))) +(dream-dm-test + "counter reset redirects" + (dream-status dream-dm-reset) + 303) +(dream-dm-test + "counter after reset" + (dream-resp-body (dream-dm-capp (dream-dm-req "GET" "/" {:Cookie "dream.session=s1"}))) + "

You have visited this page 1 time(s).

") + +;; a different session is independent +(dream-dm-test + "counter distinct session" + (dream-resp-body (dream-dm-capp (dream-dm-req "GET" "/" {}))) + "

You have visited this page 1 time(s).

") + +(define dream-dm-tests-run! (fn () {:total (+ dream-dm-pass dream-dm-fail) :passed dream-dm-pass :failed dream-dm-fail :fails dream-dm-fails})) diff --git a/plans/dream-on-sx.md b/plans/dream-on-sx.md index c97ee1d6..7438d325 100644 --- a/plans/dream-on-sx.md +++ b/plans/dream-on-sx.md @@ -74,11 +74,11 @@ The five types: `request`, `response`, `handler = request -> response`, `middlew - `dream-send ws msg`, `dream-receive ws`, `dream-close ws`. - [x] **Static files:** `dream-static root-path` — serves files, ETags, range requests. - [x] **`dream-run`**: wires root handler into SX's `perform (:http-listen ...)`. -- [ ] **Demos** in `lib/dream/demos/`: - - `hello.ml` → `lib/dream/demos/hello.sx`: "Hello, World!" route. - - `counter.ml` → `lib/dream/demos/counter.sx`: in-memory counter with sessions. - - `chat.ml` → `lib/dream/demos/chat.sx`: multi-room WebSocket chat. - - `todo.ml` → `lib/dream/demos/todo.sx`: CRUD list with forms + CSRF. +- [~] **Demos** in `lib/dream/demos/`: + - [x] `hello.ml` → `lib/dream/demos/hello.sx`: "Hello, World!" route. + - [x] `counter.ml` → `lib/dream/demos/counter.sx`: in-memory counter with sessions. + - [ ] `chat.ml` → `lib/dream/demos/chat.sx`: multi-room WebSocket chat. + - [ ] `todo.ml` → `lib/dream/demos/todo.sx`: CRUD list with forms + CSRF. - [ ] Tests in `lib/dream/tests/`: routing dispatch, middleware composition, session round-trip, CSRF accept/reject, flash read-after-write — 60+ tests. ## Stdlib additions Dream will need @@ -198,6 +198,11 @@ Confirm scope before starting; some of these may be addable as Dream-internal he set-cookies (from session/flash) flow through. Listen transport injectable (`dream-run-with`) so the full wiring is tested with a mock that captures the op and re-runs the captured app. `dream-run-port` / `dream-run-opts` variants. +- **2026-06-07 — Demos: hello + counter** (`lib/dream/demos/`, 10 tests). `hello.sx` + is the canonical router with a `:name` param route. `counter.sx` is a per-session + visit counter on the session middleware (+ a `/reset` POST that redirects), + demonstrating session isolation across browsers. End-to-end tests drive both apps + as the host would. chat (ws) + todo (forms+CSRF) next. ## Blockers From b1be3a36ec8cf6cb413256428b9f3f2d72c6f052 Mon Sep 17 00:00:00 2001 From: giles Date: Sun, 7 Jun 2026 14:57:17 +0000 Subject: [PATCH 12/22] dream: chat (ws rooms) + todo (forms+CSRF) demos + 17 tests Co-Authored-By: Claude Opus 4.8 (1M context) --- lib/dream/conformance.sh | 2 + lib/dream/demos/chat.sx | 46 ++++++++++++++ lib/dream/demos/todo.sx | 95 ++++++++++++++++++++++++++++ lib/dream/tests/demos.sx | 129 ++++++++++++++++++++++++++++++++++++--- plans/dream-on-sx.md | 14 ++++- 5 files changed, 276 insertions(+), 10 deletions(-) create mode 100644 lib/dream/demos/chat.sx create mode 100644 lib/dream/demos/todo.sx diff --git a/lib/dream/conformance.sh b/lib/dream/conformance.sh index 2cd59de2..7596f771 100644 --- a/lib/dream/conformance.sh +++ b/lib/dream/conformance.sh @@ -33,6 +33,8 @@ MODULES=( "lib/dream/run.sx" "lib/dream/demos/hello.sx" "lib/dream/demos/counter.sx" + "lib/dream/demos/chat.sx" + "lib/dream/demos/todo.sx" ) # Suites: NAME RUNNER-FN PATH diff --git a/lib/dream/demos/chat.sx b/lib/dream/demos/chat.sx new file mode 100644 index 00000000..b932d085 --- /dev/null +++ b/lib/dream/demos/chat.sx @@ -0,0 +1,46 @@ +;; lib/dream/demos/chat.sx — multi-room WebSocket chat (chat.ml). +;; A room registry holds the live connections per room; each ws session joins its +;; room, broadcasts every received message to the room, and leaves on close. + +(define dream-chat-rooms (fn () (let ((rooms {})) {:join (fn (room ws) (set! rooms (assoc rooms room (concat (or (get rooms room) (list)) (list ws))))) :broadcast (fn (room msg) (for-each (fn (w) (dream-send w msg)) (or (get rooms room) (list)))) :members (fn (room) (or (get rooms room) (list))) :leave (fn (room ws) (set! rooms (assoc rooms room (filter (fn (w) (not (= w ws))) (or (get rooms room) (list))))))}))) + +(define + dream-chat-loop + (fn + (rooms room ws) + (let + ((m (dream-receive ws))) + (if + (nil? m) + (begin ((get rooms :leave) room ws) (dream-close ws)) + (begin + ((get rooms :broadcast) room m) + (dream-chat-loop rooms room ws)))))) + +(define + dream-chat-session + (fn + (rooms room) + (fn + (ws) + (begin ((get rooms :join) room ws) (dream-chat-loop rooms room ws))))) + +(define + dream-chat-route + (fn + (rooms) + (fn + (req) + ((dream-websocket (dream-chat-session rooms (dream-param req "room"))) + req)))) + +(define + dream-chat-app-with + (fn + (rooms) + (dream-router + (list + (dream-get "/" (fn (req) (dream-html "

Rooms

"))) + (dream-get "/chat/:room" (dream-chat-route rooms)))))) + +;; entry point: (dream-run (dream-chat-app-with (dream-chat-rooms))) diff --git a/lib/dream/demos/todo.sx b/lib/dream/demos/todo.sx new file mode 100644 index 00000000..72317b22 --- /dev/null +++ b/lib/dream/demos/todo.sx @@ -0,0 +1,95 @@ +;; lib/dream/demos/todo.sx — CRUD todo list with forms + CSRF (todo.ml). +;; An in-memory store holds items; add/toggle/delete go through POST forms guarded +;; by the CSRF middleware. Wires session -> csrf -> router. + +(define + dream-todo-store + (fn () (let ((items (list)) (next-id 0)) {:all (fn () items) :add (fn (text) (begin (set! next-id (+ next-id 1)) (set! items (concat items (list {:id next-id :text text :done false}))) next-id)) :delete (fn (id) (set! items (filter (fn (it) (not (= (get it :id) id))) items))) :toggle (fn (id) (set! items (map (fn (it) (if (= (get it :id) id) (assoc it :done (not (get it :done))) it)) items)))}))) + +(define + dr/todo-render + (fn + (store req) + (str + "
    " + (reduce + (fn + (acc it) + (str + acc + "
  • " + (if (get it :done) "[x] " "[ ] ") + (get it :text) + "
    • ")) + "" + ((get store :all))) + "
" + "
" + (dream-csrf-tag req) + "
"))) + +(define + dream-todo-index + (fn (store) (fn (req) (dream-html (dr/todo-render store req))))) + +(define + dream-todo-add + (fn + (store) + (fn + (req) + (let + ((r (dream-form req))) + (if + (dream-ok? r) + (begin + ((get store :add) (get (dream-ok-value r) "text")) + (dream-redirect "/")) + (dream-html-status + 403 + (str "Rejected: " (dream-err-reason r)))))))) + +(define + dream-todo-toggle + (fn + (store) + (fn + (req) + (let + ((r (dream-form req))) + (if + (dream-ok? r) + (begin + ((get store :toggle) (parse-int (dream-param req "id"))) + (dream-redirect "/")) + (dream-html-status 403 "Rejected")))))) + +(define + dream-todo-delete + (fn + (store) + (fn + (req) + (let + ((r (dream-form req))) + (if + (dream-ok? r) + (begin + ((get store :delete) (parse-int (dream-param req "id"))) + (dream-redirect "/")) + (dream-html-status 403 "Rejected")))))) + +(define + dream-todo-app-with + (fn + (store backend secret) + ((dream-sessions backend) + ((dream-csrf secret) + (dream-router + (list + (dream-get "/" (dream-todo-index store)) + (dream-post "/add" (dream-todo-add store)) + (dream-post "/toggle/:id" (dream-todo-toggle store)) + (dream-post "/delete/:id" (dream-todo-delete store)))))))) + +;; entry: (dream-run (dream-todo-app-with (dream-todo-store) (dream-memory-sessions) "change-me")) diff --git a/lib/dream/tests/demos.sx b/lib/dream/tests/demos.sx index 7394dbd9..4e5c1d23 100644 --- a/lib/dream/tests/demos.sx +++ b/lib/dream/tests/demos.sx @@ -40,7 +40,6 @@ (define dream-dm-cbackend (dream-memory-sessions)) (define dream-dm-capp (dream-counter-app-with dream-dm-cbackend)) -;; first visit: no cookie -> count 1, session cookie set (define dream-dm-c1 (dream-dm-capp (dream-dm-req "GET" "/" {}))) (dream-dm-test "counter first visit" @@ -50,8 +49,6 @@ "counter sets cookie" (len (dream-resp-cookies dream-dm-c1)) 1) - -;; subsequent visits with the cookie increment (dream-dm-test "counter second visit" (dream-resp-body (dream-dm-capp (dream-dm-req "GET" "/" {:Cookie "dream.session=s1"}))) @@ -60,8 +57,6 @@ "counter third visit" (dream-resp-body (dream-dm-capp (dream-dm-req "GET" "/" {:Cookie "dream.session=s1"}))) "

You have visited this page 3 time(s).

") - -;; reset zeroes the counter then redirects (define dream-dm-reset (dream-dm-capp (dream-dm-req "POST" "/reset" {:Cookie "dream.session=s1"}))) @@ -73,11 +68,131 @@ "counter after reset" (dream-resp-body (dream-dm-capp (dream-dm-req "GET" "/" {:Cookie "dream.session=s1"}))) "

You have visited this page 1 time(s).

") - -;; a different session is independent (dream-dm-test "counter distinct session" (dream-resp-body (dream-dm-capp (dream-dm-req "GET" "/" {}))) "

You have visited this page 1 time(s).

") +;; ── chat (websocket rooms) ───────────────────────────────────────── +(define dream-dm-rooms (dream-chat-rooms)) +(define dream-dm-wsB (dream-mock-ws (list))) +(define dream-dm-wsC (dream-mock-ws (list))) +((get dream-dm-rooms :join) "general" dream-dm-wsB) +((get dream-dm-rooms :join) "general" dream-dm-wsC) +(dream-dm-test + "room has two members" + (len ((get dream-dm-rooms :members) "general")) + 2) + +;; client A joins, sends two messages, then disconnects +(define dream-dm-wsA (dream-mock-ws (list "hi" "again"))) +((dream-chat-session dream-dm-rooms "general") dream-dm-wsA) +(dream-dm-test + "B got broadcasts" + (dream-ws-sent dream-dm-wsB) + (list "hi" "again")) +(dream-dm-test + "C got broadcasts" + (dream-ws-sent dream-dm-wsC) + (list "hi" "again")) +(dream-dm-test + "A echoed own messages" + (dream-ws-sent dream-dm-wsA) + (list "hi" "again")) +(dream-dm-test + "A left on disconnect" + (len ((get dream-dm-rooms :members) "general")) + 2) +(dream-dm-test "A closed" (dream-ws-closed? dream-dm-wsA) true) + +;; route produces an upgrade response +(define dream-dm-chat-app (dream-chat-app-with (dream-chat-rooms))) +(dream-dm-test + "chat route upgrades" + (dream-websocket? + (dream-dm-chat-app (dream-dm-req "GET" "/chat/lobby" {}))) + true) +(dream-dm-test + "chat index html" + (dream-resp-body (dream-dm-chat-app (dream-dm-req "GET" "/" {}))) + "

Rooms

") + +;; ── todo (forms + CSRF) ──────────────────────────────────────────── +(define dream-dm-todo-store (dream-todo-store)) +(define dream-dm-todo-backend (dream-memory-sessions)) +(define + dream-dm-todo-app + (dream-todo-app-with dream-dm-todo-store dream-dm-todo-backend "topsecret")) +(define + dream-dm-todo-tok + (dr/csrf-make-token dream-csrf-sign-default "topsecret" "s1")) + +;; establish session s1 +(dream-dm-todo-app (dream-request "GET" "/" {} "")) +(define + dream-dm-add1 + (dream-dm-todo-app + (dream-request + "POST" + "/add" + {:Cookie "dream.session=s1"} + (str "text=Buy+milk&dream.csrf=" dream-dm-todo-tok)))) +(dream-dm-test "todo add redirects" (dream-status dream-dm-add1) 303) +(dream-dm-test + "todo store has item" + (len ((get dream-dm-todo-store :all))) + 1) + +(define + dream-dm-todo-page + (dream-resp-body + (dream-dm-todo-app (dream-request "GET" "/" {:Cookie "dream.session=s1"} "")))) +(dream-dm-test + "todo lists item" + (contains? dream-dm-todo-page "Buy milk") + true) +(dream-dm-test + "todo has csrf tag" + (contains? dream-dm-todo-page "dream.csrf") + true) +(dream-dm-test + "todo item not done" + (contains? dream-dm-todo-page "[ ] Buy milk") + true) + +(dream-dm-todo-app + (dream-request + "POST" + "/toggle/1" + {:Cookie "dream.session=s1"} + (str "dream.csrf=" dream-dm-todo-tok))) +(dream-dm-test + "todo toggled done" + (contains? + (dream-resp-body + (dream-dm-todo-app (dream-request "GET" "/" {:Cookie "dream.session=s1"} ""))) + "[x] Buy milk") + true) + +(dream-dm-test + "todo add without token 403" + (dream-status + (dream-dm-todo-app (dream-request "POST" "/add" {:Cookie "dream.session=s1"} "text=Sneaky"))) + 403) +(dream-dm-test + "todo unchanged after reject" + (len ((get dream-dm-todo-store :all))) + 1) + +(dream-dm-todo-app + (dream-request + "POST" + "/delete/1" + {:Cookie "dream.session=s1"} + (str "dream.csrf=" dream-dm-todo-tok))) +(dream-dm-test + "todo deleted" + (len ((get dream-dm-todo-store :all))) + 0) + (define dream-dm-tests-run! (fn () {:total (+ dream-dm-pass dream-dm-fail) :passed dream-dm-pass :failed dream-dm-fail :fails dream-dm-fails})) diff --git a/plans/dream-on-sx.md b/plans/dream-on-sx.md index 7438d325..7ff8e2e6 100644 --- a/plans/dream-on-sx.md +++ b/plans/dream-on-sx.md @@ -74,11 +74,11 @@ The five types: `request`, `response`, `handler = request -> response`, `middlew - `dream-send ws msg`, `dream-receive ws`, `dream-close ws`. - [x] **Static files:** `dream-static root-path` — serves files, ETags, range requests. - [x] **`dream-run`**: wires root handler into SX's `perform (:http-listen ...)`. -- [~] **Demos** in `lib/dream/demos/`: +- [x] **Demos** in `lib/dream/demos/`: - [x] `hello.ml` → `lib/dream/demos/hello.sx`: "Hello, World!" route. - [x] `counter.ml` → `lib/dream/demos/counter.sx`: in-memory counter with sessions. - - [ ] `chat.ml` → `lib/dream/demos/chat.sx`: multi-room WebSocket chat. - - [ ] `todo.ml` → `lib/dream/demos/todo.sx`: CRUD list with forms + CSRF. + - [x] `chat.ml` → `lib/dream/demos/chat.sx`: multi-room WebSocket chat. + - [x] `todo.ml` → `lib/dream/demos/todo.sx`: CRUD list with forms + CSRF. - [ ] Tests in `lib/dream/tests/`: routing dispatch, middleware composition, session round-trip, CSRF accept/reject, flash read-after-write — 60+ tests. ## Stdlib additions Dream will need @@ -203,6 +203,14 @@ Confirm scope before starting; some of these may be addable as Dream-internal he visit counter on the session middleware (+ a `/reset` POST that redirects), demonstrating session isolation across browsers. End-to-end tests drive both apps as the host would. chat (ws) + todo (forms+CSRF) next. +- **2026-06-07 — Demos: chat + todo** (`lib/dream/demos/`, demos suite now 27 tests). + `chat.sx` is a multi-room WebSocket chat over a room registry (join/leave/members/ + broadcast on the cell pattern); verified three clients see each other's broadcasts + and a disconnect leaves the room. `todo.sx` is a CRUD list wiring session→csrf→ + router: add/toggle/delete go through `dream-form` (CSRF-guarded), an in-memory store + holds items, pages render the list + `dream-csrf-tag`; verified the full + add→render→toggle→delete cycle plus a 403 on a token-less POST. ws object equality + is by reference, so the `:leave` filter removes exactly the right connection. ## Blockers From 078872728e93f70ca0aadf6234e97b4218bfee12 Mon Sep 17 00:00:00 2001 From: giles Date: Sun, 7 Jun 2026 15:00:29 +0000 Subject: [PATCH 13/22] dream: router 405 Method Not Allowed + Allow header + automatic HEAD + 9 tests Co-Authored-By: Claude Opus 4.8 (1M context) --- lib/dream/router.sx | 85 +++++++++++++++++++++++++++++---------- lib/dream/tests/router.sx | 46 +++++++++++++++++++-- plans/dream-on-sx.md | 28 ++++++++++++- 3 files changed, 133 insertions(+), 26 deletions(-) diff --git a/lib/dream/router.sx b/lib/dream/router.sx index 723e69f6..9158ee7d 100644 --- a/lib/dream/router.sx +++ b/lib/dream/router.sx @@ -1,7 +1,9 @@ ;; lib/dream/router.sx — Dream-on-SX routing. ;; Routes are dicts {:method :path :handler}; a router is a handler that ;; dispatches request -> response by method + path, extracting :name path -;; params and binding a ** catch-all. No match -> 404. Depends on types.sx. +;; params and binding a ** catch-all. No path match -> 404; path matches but +;; method doesn't -> 405 + Allow. HEAD falls back to the GET handler with an +;; empty body. Depends on types.sx. ;; ── route constructors (one per HTTP method) ─────────────────────── (define dream-get (fn (path handler) (dream-route "GET" path handler))) @@ -53,11 +55,25 @@ (dr/match-segs (rest pat) (rest path) params)) (else nil))))))) +;; path-only match: returns params dict or nil (define - dr/method-match? + dr/route-params + (fn + (r req) + (dr/match-segs + (dr/segs (dream-route-path r)) + (dr/segs (dream-path req)) + {}))) + +;; method acceptance: exact, ANY, or HEAD served by a GET route +(define + dr/method-accepts? (fn (route-method req-method) - (or (= route-method "ANY") (= route-method req-method)))) + (or + (= route-method "ANY") + (= route-method req-method) + (and (= req-method "HEAD") (= route-method "GET"))))) ;; ── middleware pipeline (shared with middleware.sx) ──────────────── ;; m1 @@ m2 @@ handler = (m1 (m2 handler)); first in list is outermost. @@ -95,30 +111,55 @@ (dr/flatten-routes routes)))) ;; ── dispatch ─────────────────────────────────────────────────────── -(define - dr/try-route - (fn - (r req) - (if - (dr/method-match? (dream-route-method r) (dream-method req)) - (let - ((params (dr/match-segs (dr/segs (dream-route-path r)) (dr/segs (dream-path req)) {}))) - (if - (nil? params) - :no-match (dream-coerce-response - ((dream-route-handler r) (dream-with-params req params))))) - :no-match))) - +;; allowed = methods of routes whose PATH matched (for 405 + Allow). (define dr/dispatch (fn - (routes req) + (routes req allowed) (if (empty? routes) - (dream-not-found) + (if + (empty? allowed) + (dream-not-found) + (dream-method-not-allowed allowed)) (let - ((res (dr/try-route (first routes) req))) - (if (= res :no-match) (dr/dispatch (rest routes) req) res))))) + ((r (first routes))) + (let + ((params (dr/route-params r req))) + (if + (nil? params) + (dr/dispatch (rest routes) req allowed) + (if + (dr/method-accepts? (dream-route-method r) (dream-method req)) + (dr/run-route r req params) + (dr/dispatch + (rest routes) + req + (concat allowed (list (dream-route-method r))))))))))) + +;; run a matched route; blank the body for an auto-HEAD on a GET route +(define + dr/run-route + (fn + (r req params) + (let + ((resp (dream-coerce-response ((dream-route-handler r) (dream-with-params req params))))) + (if + (and + (= (dream-method req) "HEAD") + (not (= (dream-route-method r) "HEAD"))) + (dream-response (dream-status resp) (dream-headers resp) "") + resp)))) + +;; 405 response with an Allow header listing the path's methods +(define + dream-method-not-allowed + (fn + (allowed) + (dream-add-header + (dream-response 405 {:content-type "text/plain; charset=utf-8"} "Method Not Allowed") + "allow" + (join ", " allowed)))) (define dream-router @@ -126,4 +167,4 @@ (routes) (let ((flat (dr/flatten-routes routes))) - (fn (req) (dr/dispatch flat req))))) + (fn (req) (dr/dispatch flat req (list)))))) diff --git a/lib/dream/tests/router.sx b/lib/dream/tests/router.sx index fc6568fd..61f064f5 100644 --- a/lib/dream/tests/router.sx +++ b/lib/dream/tests/router.sx @@ -1,4 +1,4 @@ -;; lib/dream/tests/router.sx — routing dispatch, path params, scopes. +;; lib/dream/tests/router.sx — routing dispatch, path params, scopes, 405/HEAD. (define dream-rt-pass 0) (define dream-rt-fail 0) @@ -45,9 +45,9 @@ (dream-status (dream-rt-app (dream-rt-req "GET" "/nope"))) 404) (dream-rt-test - "wrong method 404" + "wrong method 405" (dream-status (dream-rt-app (dream-rt-req "GET" "/submit"))) - 404) + 405) (dream-rt-test "trailing slash equiv" (dream-resp-body (dream-rt-app (dream-rt-req "GET" "/about/"))) @@ -229,4 +229,44 @@ "x-inner") "1") +;; ── 405 Method Not Allowed + Allow ───────────────────────────────── +(define + dream-rt-mapp + (dream-router + (list + (dream-get "/r" (fn (req) (dream-text "get"))) + (dream-post "/r" (fn (req) (dream-text "post"))) + (dream-get "/only" (fn (req) (dream-html "

hi

")))))) +(define dream-rt-405 (dream-rt-mapp (dream-rt-req "DELETE" "/r"))) +(dream-rt-test "405 status" (dream-status dream-rt-405) 405) +(dream-rt-test + "405 Allow has GET" + (contains? (dream-resp-header dream-rt-405 "allow") "GET") + true) +(dream-rt-test + "405 Allow has POST" + (contains? (dream-resp-header dream-rt-405 "allow") "POST") + true) +(dream-rt-test + "matching method still works" + (dream-resp-body (dream-rt-mapp (dream-rt-req "POST" "/r"))) + "post") +(dream-rt-test + "no path is 404 not 405" + (dream-status (dream-rt-mapp (dream-rt-req "DELETE" "/absent"))) + 404) + +;; ── automatic HEAD (serve GET, empty body) ───────────────────────── +(define dream-rt-head (dream-rt-mapp (dream-rt-req "HEAD" "/only"))) +(dream-rt-test "HEAD status 200" (dream-status dream-rt-head) 200) +(dream-rt-test "HEAD empty body" (dream-resp-body dream-rt-head) "") +(dream-rt-test + "HEAD keeps content-type" + (dream-resp-header dream-rt-head "content-type") + "text/html; charset=utf-8") +(dream-rt-test + "HEAD on missing path 404" + (dream-status (dream-rt-mapp (dream-rt-req "HEAD" "/none"))) + 404) + (define dream-rt-tests-run! (fn () {:total (+ dream-rt-pass dream-rt-fail) :passed dream-rt-pass :failed dream-rt-fail :fails dream-rt-fails})) diff --git a/plans/dream-on-sx.md b/plans/dream-on-sx.md index 7ff8e2e6..88e7e476 100644 --- a/plans/dream-on-sx.md +++ b/plans/dream-on-sx.md @@ -79,7 +79,33 @@ The five types: `request`, `response`, `handler = request -> response`, `middlew - [x] `counter.ml` → `lib/dream/demos/counter.sx`: in-memory counter with sessions. - [x] `chat.ml` → `lib/dream/demos/chat.sx`: multi-room WebSocket chat. - [x] `todo.ml` → `lib/dream/demos/todo.sx`: CRUD list with forms + CSRF. -- [ ] Tests in `lib/dream/tests/`: routing dispatch, middleware composition, session round-trip, CSRF accept/reject, flash read-after-write — 60+ tests. +- [x] Tests in `lib/dream/tests/`: routing dispatch, middleware composition, session round-trip, CSRF accept/reject, flash read-after-write — **258 tests across 10 suites** (well past the 60+ target). Runner: `lib/dream/conformance.sh`. + +**Roadmap complete (2026-06-07): all boxes ticked, 258/258 green.** Loop continues +with extensions + hardening below. +- **2026-06-07 — Ext: router HTTP correctness** (router suite 27→36, 267 total). + Dispatch now tracks which routes' *paths* matched: path matched + method didn't → + `405 Method Not Allowed` with an `Allow` header listing the path's methods (was a + blanket 404); genuinely-absent paths stay 404. `HEAD` falls back to the matching + `GET` handler with the body blanked but headers kept. `dr/route-params` (path-only + match) + `dr/method-accepts?` (ANY / HEAD→GET) + `dream-method-not-allowed`. NOTE: + in this worktree every `sx-tree` *edit* tool (`sx_replace_node`, + `sx_replace_by_pattern`, `sx_insert_near`) raises a yojson `Expected string, got + null` error — only `sx_write_file` works, so edits rewrite the whole file. + +## Extensions (post-roadmap) + +The five-types core is complete; these harden it toward a production HTTP front door. + +- [x] **Router HTTP correctness**: 405 Method Not Allowed + `Allow` header; automatic + HEAD (serve the GET handler with an empty body). +- [ ] **Status reason phrases** + `dream-status-text`. +- [ ] **CORS middleware** (`dream-cors`). +- [ ] **Error-handling middleware** (`dream-catch` / custom 404 + 500 templates). +- [ ] **Signed session cookies** (the noted hardening — sign the sid). +- [ ] **JSON helpers** (build from dict; parse to dict). +- [ ] **Query/header convenience** (`dream-queries`, defaults). +- [ ] **`api.sx` facade + README** — single load point listing the public surface. ## Stdlib additions Dream will need From 17ef5f50b324a17c8b4625e0b576fca2c62c3488 Mon Sep 17 00:00:00 2001 From: giles Date: Sun, 7 Jun 2026 15:03:17 +0000 Subject: [PATCH 14/22] dream: error-handling middleware (dream-catch) + status reason phrases + 15 tests Co-Authored-By: Claude Opus 4.8 (1M context) --- lib/dream/conformance.sh | 2 + lib/dream/error.sx | 41 ++++++++++++++++++ lib/dream/tests/error.sx | 90 ++++++++++++++++++++++++++++++++++++++++ plans/dream-on-sx.md | 11 ++++- 4 files changed, 142 insertions(+), 2 deletions(-) create mode 100644 lib/dream/error.sx create mode 100644 lib/dream/tests/error.sx diff --git a/lib/dream/conformance.sh b/lib/dream/conformance.sh index 7596f771..fafbf810 100644 --- a/lib/dream/conformance.sh +++ b/lib/dream/conformance.sh @@ -30,6 +30,7 @@ MODULES=( "lib/dream/form.sx" "lib/dream/websocket.sx" "lib/dream/static.sx" + "lib/dream/error.sx" "lib/dream/run.sx" "lib/dream/demos/hello.sx" "lib/dream/demos/counter.sx" @@ -47,6 +48,7 @@ SUITES=( "form dream-fo-tests-run! lib/dream/tests/form.sx" "websocket dream-ws-tests-run! lib/dream/tests/websocket.sx" "static dream-st-tests-run! lib/dream/tests/static.sx" + "error dream-er-tests-run! lib/dream/tests/error.sx" "run dream-rn-tests-run! lib/dream/tests/run.sx" "demos dream-dm-tests-run! lib/dream/tests/demos.sx" ) diff --git a/lib/dream/error.sx b/lib/dream/error.sx new file mode 100644 index 00000000..9f1d3174 --- /dev/null +++ b/lib/dream/error.sx @@ -0,0 +1,41 @@ +;; lib/dream/error.sx — Dream-on-SX status phrases + error-handling middleware. +;; dream-catch wraps a handler and turns a raised error into a 500 response (or a +;; custom page). Depends on types.sx. + +;; ── status reason phrases ────────────────────────────────────────── +(define dr/status-texts {:206 "Partial Content" :202 "Accepted" :422 "Unprocessable Entity" :400 "Bad Request" :302 "Found" :204 "No Content" :502 "Bad Gateway" :429 "Too Many Requests" :301 "Moved Permanently" :415 "Unsupported Media Type" :405 "Method Not Allowed" :303 "See Other" :401 "Unauthorized" :304 "Not Modified" :503 "Service Unavailable" :404 "Not Found" :308 "Permanent Redirect" :504 "Gateway Timeout" :416 "Range Not Satisfiable" :500 "Internal Server Error" :307 "Temporary Redirect" :201 "Created" :501 "Not Implemented" :409 "Conflict" :200 "OK" :410 "Gone" :403 "Forbidden"}) + +(define + dream-status-text + (fn (status) (or (get dr/status-texts (str status)) "Unknown"))) +(define + dream-status-line + (fn (status) (str status " " (dream-status-text status)))) + +;; ── error-handling middleware ────────────────────────────────────── +(define + dream-default-error-page + (fn + (req e) + (dream-html-status + 500 + (str "

" (dream-status-line 500) "

")))) + +(define + dream-catch-with + (fn + (on-error) + (fn + (next) + (fn (req) (guard (e (true (on-error req e))) (next req)))))) + +(define dream-catch (dream-catch-with dream-default-error-page)) + +;; a fallback handler that renders a status page for any code +(define + dream-status-page + (fn + (status) + (dream-html-status + status + (str "

" (dream-status-line status) "

")))) diff --git a/lib/dream/tests/error.sx b/lib/dream/tests/error.sx new file mode 100644 index 00000000..27ad1e7c --- /dev/null +++ b/lib/dream/tests/error.sx @@ -0,0 +1,90 @@ +;; lib/dream/tests/error.sx — status phrases + dream-catch. + +(define dream-er-pass 0) +(define dream-er-fail 0) +(define dream-er-fails (list)) + +(define + dream-er-test + (fn + (name actual expected) + (if + (= actual expected) + (set! dream-er-pass (+ dream-er-pass 1)) + (begin + (set! dream-er-fail (+ dream-er-fail 1)) + (append! dream-er-fails {:name name :actual actual :expected expected}))))) + +;; ── status phrases ───────────────────────────────────────────────── +(dream-er-test "200 OK" (dream-status-text 200) "OK") +(dream-er-test "404 Not Found" (dream-status-text 404) "Not Found") +(dream-er-test + "405 phrase" + (dream-status-text 405) + "Method Not Allowed") +(dream-er-test + "500 phrase" + (dream-status-text 500) + "Internal Server Error") +(dream-er-test "unknown phrase" (dream-status-text 599) "Unknown") +(dream-er-test "status line" (dream-status-line 404) "404 Not Found") +(dream-er-test + "status page status" + (dream-status (dream-status-page 403)) + 403) +(dream-er-test + "status page body" + (dream-resp-body (dream-status-page 403)) + "

403 Forbidden

") + +;; ── dream-catch ──────────────────────────────────────────────────── +(define dream-er-boom (fn (req) (error "kaboom"))) +(define dream-er-ok (fn (req) (dream-text "fine"))) + +(dream-er-test + "catch normal passes through" + (dream-resp-body + ((dream-catch dream-er-ok) (dream-request "GET" "/" {} ""))) + "fine") +(dream-er-test + "catch error -> 500" + (dream-status + ((dream-catch dream-er-boom) (dream-request "GET" "/" {} ""))) + 500) +(dream-er-test + "catch 500 body" + (dream-resp-body + ((dream-catch dream-er-boom) (dream-request "GET" "/" {} ""))) + "

500 Internal Server Error

") + +;; custom error page receives the error +(define + dream-er-custom + (dream-catch-with (fn (req e) (dream-text (str "ERR:" e))))) +(dream-er-test + "custom error page" + (dream-resp-body + ((dream-er-custom dream-er-boom) (dream-request "GET" "/" {} ""))) + "ERR:kaboom") +(dream-er-test + "custom passes normal through" + (dream-resp-body + ((dream-er-custom dream-er-ok) (dream-request "GET" "/" {} ""))) + "fine") + +;; catch composes around a router +(define + dream-er-app + (dream-catch + (dream-router + (list (dream-get "/boom" dream-er-boom) (dream-get "/ok" dream-er-ok))))) +(dream-er-test + "router error caught" + (dream-status (dream-er-app (dream-request "GET" "/boom" {} ""))) + 500) +(dream-er-test + "router ok intact" + (dream-resp-body (dream-er-app (dream-request "GET" "/ok" {} ""))) + "fine") + +(define dream-er-tests-run! (fn () {:total (+ dream-er-pass dream-er-fail) :passed dream-er-pass :failed dream-er-fail :fails dream-er-fails})) diff --git a/plans/dream-on-sx.md b/plans/dream-on-sx.md index 88e7e476..99ec7e39 100644 --- a/plans/dream-on-sx.md +++ b/plans/dream-on-sx.md @@ -92,6 +92,13 @@ with extensions + hardening below. in this worktree every `sx-tree` *edit* tool (`sx_replace_node`, `sx_replace_by_pattern`, `sx_insert_near`) raises a yojson `Expected string, got null` error — only `sx_write_file` works, so edits rewrite the whole file. +- **2026-06-07 — Ext: error handling + status phrases** (`lib/dream/error.sx`, 15 + tests, 282 total). `dream-status-text` / `dream-status-line` reason-phrase map (string + keys); `dream-status-page` renders a status page. `dream-catch` is a `guard`-based + middleware that turns a raised error into a 500 (`dream-catch-with on-error` for a + custom page receiving `(req e)`); normal responses pass through untouched, composes + around a router. (`guard` catches explicit `(error …)` raises; `e` stringifies to the + message.) ## Extensions (post-roadmap) @@ -99,9 +106,9 @@ The five-types core is complete; these harden it toward a production HTTP front - [x] **Router HTTP correctness**: 405 Method Not Allowed + `Allow` header; automatic HEAD (serve the GET handler with an empty body). -- [ ] **Status reason phrases** + `dream-status-text`. +- [x] **Status reason phrases** + `dream-status-text` (`lib/dream/error.sx`). - [ ] **CORS middleware** (`dream-cors`). -- [ ] **Error-handling middleware** (`dream-catch` / custom 404 + 500 templates). +- [x] **Error-handling middleware** (`dream-catch` / custom 500 templates; `guard`-based). - [ ] **Signed session cookies** (the noted hardening — sign the sid). - [ ] **JSON helpers** (build from dict; parse to dict). - [ ] **Query/header convenience** (`dream-queries`, defaults). From 30aece839b408d731ca1aa6e9e8be03fc1e4172a Mon Sep 17 00:00:00 2001 From: giles Date: Sun, 7 Jun 2026 15:04:43 +0000 Subject: [PATCH 15/22] dream: CORS middleware + preflight handling + 12 tests Co-Authored-By: Claude Opus 4.8 (1M context) --- lib/dream/conformance.sh | 2 + lib/dream/cors.sx | 51 ++++++++++++++++++++++ lib/dream/tests/cors.sx | 93 ++++++++++++++++++++++++++++++++++++++++ plans/dream-on-sx.md | 7 ++- 4 files changed, 152 insertions(+), 1 deletion(-) create mode 100644 lib/dream/cors.sx create mode 100644 lib/dream/tests/cors.sx diff --git a/lib/dream/conformance.sh b/lib/dream/conformance.sh index fafbf810..73c7b042 100644 --- a/lib/dream/conformance.sh +++ b/lib/dream/conformance.sh @@ -31,6 +31,7 @@ MODULES=( "lib/dream/websocket.sx" "lib/dream/static.sx" "lib/dream/error.sx" + "lib/dream/cors.sx" "lib/dream/run.sx" "lib/dream/demos/hello.sx" "lib/dream/demos/counter.sx" @@ -49,6 +50,7 @@ SUITES=( "websocket dream-ws-tests-run! lib/dream/tests/websocket.sx" "static dream-st-tests-run! lib/dream/tests/static.sx" "error dream-er-tests-run! lib/dream/tests/error.sx" + "cors dream-co-tests-run! lib/dream/tests/cors.sx" "run dream-rn-tests-run! lib/dream/tests/run.sx" "demos dream-dm-tests-run! lib/dream/tests/demos.sx" ) diff --git a/lib/dream/cors.sx b/lib/dream/cors.sx new file mode 100644 index 00000000..c0d25756 --- /dev/null +++ b/lib/dream/cors.sx @@ -0,0 +1,51 @@ +;; lib/dream/cors.sx — Dream-on-SX CORS middleware. +;; Decorates responses with Access-Control-Allow-* headers and short-circuits +;; preflight OPTIONS requests with a 204. Depends on types.sx. + +(define dream-cors-defaults {:methods "GET, POST, PUT, PATCH, DELETE, OPTIONS" :headers "Content-Type" :max-age 86400 :credentials false :origin "*"}) + +(define + dr/cors-origin-headers + (fn + (opts resp) + (let + ((r1 (dream-add-header resp "access-control-allow-origin" (get opts :origin)))) + (if + (get opts :credentials) + (dream-add-header r1 "access-control-allow-credentials" "true") + r1)))) + +(define + dr/cors-preflight + (fn + (opts) + (dr/cors-origin-headers + opts + (dream-add-header + (dream-add-header + (dream-add-header + (dream-empty 204) + "access-control-allow-methods" + (get opts :methods)) + "access-control-allow-headers" + (get opts :headers)) + "access-control-max-age" + (str (get opts :max-age)))))) + +(define + dream-cors-with + (fn + (opts) + (fn + (next) + (fn + (req) + (if + (= (dream-method req) "OPTIONS") + (dr/cors-preflight opts) + (dr/cors-origin-headers opts (next req))))))) + +(define dream-cors (dream-cors-with dream-cors-defaults)) +(define + dream-cors-origin + (fn (origin) (dream-cors-with (assoc dream-cors-defaults :origin origin)))) diff --git a/lib/dream/tests/cors.sx b/lib/dream/tests/cors.sx new file mode 100644 index 00000000..51ee9dc7 --- /dev/null +++ b/lib/dream/tests/cors.sx @@ -0,0 +1,93 @@ +;; lib/dream/tests/cors.sx — CORS decoration + preflight. + +(define dream-co-pass 0) +(define dream-co-fail 0) +(define dream-co-fails (list)) + +(define + dream-co-test + (fn + (name actual expected) + (if + (= actual expected) + (set! dream-co-pass (+ dream-co-pass 1)) + (begin + (set! dream-co-fail (+ dream-co-fail 1)) + (append! dream-co-fails {:name name :actual actual :expected expected}))))) + +(define dream-co-h (fn (req) (dream-text "payload"))) +(define dream-co-app (dream-cors dream-co-h)) + +;; ── decoration of normal responses ───────────────────────────────── +(define dream-co-get (dream-co-app (dream-request "GET" "/" {} ""))) +(dream-co-test + "allow-origin star" + (dream-resp-header dream-co-get "access-control-allow-origin") + "*") +(dream-co-test "body preserved" (dream-resp-body dream-co-get) "payload") +(dream-co-test "status preserved" (dream-status dream-co-get) 200) +(dream-co-test + "no credentials by default" + (dream-resp-header dream-co-get "access-control-allow-credentials") + nil) + +;; ── preflight OPTIONS ────────────────────────────────────────────── +(define + dream-co-pre + (dream-co-app (dream-request "OPTIONS" "/" {} ""))) +(dream-co-test "preflight 204" (dream-status dream-co-pre) 204) +(dream-co-test + "preflight origin" + (dream-resp-header dream-co-pre "access-control-allow-origin") + "*") +(dream-co-test + "preflight methods" + (contains? + (dream-resp-header dream-co-pre "access-control-allow-methods") + "POST") + true) +(dream-co-test + "preflight headers" + (dream-resp-header dream-co-pre "access-control-allow-headers") + "Content-Type") +(dream-co-test + "preflight max-age" + (dream-resp-header dream-co-pre "access-control-max-age") + "86400") + +;; ── custom origin ────────────────────────────────────────────────── +(define + dream-co-custom + ((dream-cors-origin "https://app.example.com") dream-co-h)) +(dream-co-test + "custom origin" + (dream-resp-header + (dream-co-custom (dream-request "GET" "/" {} "")) + "access-control-allow-origin") + "https://app.example.com") + +;; ── credentials enabled ──────────────────────────────────────────── +(define + dream-co-cred + ((dream-cors-with (assoc dream-cors-defaults :credentials true)) + dream-co-h)) +(dream-co-test + "credentials header" + (dream-resp-header + (dream-co-cred (dream-request "GET" "/" {} "")) + "access-control-allow-credentials") + "true") + +;; ── composes around a router ─────────────────────────────────────── +(define + dream-co-router + (dream-cors + (dream-router (list (dream-get "/api" (fn (req) (dream-json "{}"))))))) +(dream-co-test + "router cors origin" + (dream-resp-header + (dream-co-router (dream-request "GET" "/api" {} "")) + "access-control-allow-origin") + "*") + +(define dream-co-tests-run! (fn () {:total (+ dream-co-pass dream-co-fail) :passed dream-co-pass :failed dream-co-fail :fails dream-co-fails})) diff --git a/plans/dream-on-sx.md b/plans/dream-on-sx.md index 99ec7e39..b8d54a6d 100644 --- a/plans/dream-on-sx.md +++ b/plans/dream-on-sx.md @@ -99,6 +99,11 @@ with extensions + hardening below. custom page receiving `(req e)`); normal responses pass through untouched, composes around a router. (`guard` catches explicit `(error …)` raises; `e` stringifies to the message.) +- **2026-06-07 — Ext: CORS** (`lib/dream/cors.sx`, 12 tests, 294 total). `dream-cors` + decorates responses with `Access-Control-Allow-Origin` (+ credentials), and + short-circuits preflight `OPTIONS` with a 204 carrying Allow-Methods/Headers/Max-Age. + `dream-cors-origin` for a specific origin, `dream-cors-with opts` for full control + (origin/methods/headers/credentials/max-age). Composes around a router. ## Extensions (post-roadmap) @@ -107,7 +112,7 @@ The five-types core is complete; these harden it toward a production HTTP front - [x] **Router HTTP correctness**: 405 Method Not Allowed + `Allow` header; automatic HEAD (serve the GET handler with an empty body). - [x] **Status reason phrases** + `dream-status-text` (`lib/dream/error.sx`). -- [ ] **CORS middleware** (`dream-cors`). +- [x] **CORS middleware** (`dream-cors`). - [x] **Error-handling middleware** (`dream-catch` / custom 500 templates; `guard`-based). - [ ] **Signed session cookies** (the noted hardening — sign the sid). - [ ] **JSON helpers** (build from dict; parse to dict). From b061442c0643d0022c81ccce05f02b481089c6f9 Mon Sep 17 00:00:00 2001 From: giles Date: Sun, 7 Jun 2026 15:07:48 +0000 Subject: [PATCH 16/22] dream: pure-SX JSON encode + recursive-descent parse + 35 tests Co-Authored-By: Claude Opus 4.8 (1M context) --- lib/dream/conformance.sh | 2 + lib/dream/json.sx | 183 +++++++++++++++++++++++++++++++++++++++ lib/dream/tests/json.sx | 105 ++++++++++++++++++++++ plans/dream-on-sx.md | 10 ++- 4 files changed, 299 insertions(+), 1 deletion(-) create mode 100644 lib/dream/json.sx create mode 100644 lib/dream/tests/json.sx diff --git a/lib/dream/conformance.sh b/lib/dream/conformance.sh index 73c7b042..a66cfc35 100644 --- a/lib/dream/conformance.sh +++ b/lib/dream/conformance.sh @@ -32,6 +32,7 @@ MODULES=( "lib/dream/static.sx" "lib/dream/error.sx" "lib/dream/cors.sx" + "lib/dream/json.sx" "lib/dream/run.sx" "lib/dream/demos/hello.sx" "lib/dream/demos/counter.sx" @@ -51,6 +52,7 @@ SUITES=( "static dream-st-tests-run! lib/dream/tests/static.sx" "error dream-er-tests-run! lib/dream/tests/error.sx" "cors dream-co-tests-run! lib/dream/tests/cors.sx" + "json dream-js-tests-run! lib/dream/tests/json.sx" "run dream-rn-tests-run! lib/dream/tests/run.sx" "demos dream-dm-tests-run! lib/dream/tests/demos.sx" ) diff --git a/lib/dream/json.sx b/lib/dream/json.sx new file mode 100644 index 00000000..92d6cadc --- /dev/null +++ b/lib/dream/json.sx @@ -0,0 +1,183 @@ +;; lib/dream/json.sx — Dream-on-SX JSON encode/parse (pure SX). +;; The host JSON primitives live in the ocaml-on-sx runtime, not the base env, so +;; Dream ships its own. Depends on types.sx. (number? is unreliable in this env — +;; type-of "number" is used instead.) + +;; ── encoding ─────────────────────────────────────────────────────── +(define + dr/json-escape + (fn + (s) + (replace + (replace + (replace (replace (replace s "\\" "\\\\") "\"" "\\\"") "\n" "\\n") + "\r" + "\\r") + "\t" + "\\t"))) +(define dr/json-quote (fn (s) (str "\"" (dr/json-escape s) "\""))) + +(define + dream-json-encode + (fn + (v) + (cond + ((nil? v) "null") + ((boolean? v) (if v "true" "false")) + ((= (type-of v) "number") (str v)) + ((string? v) (dr/json-quote v)) + ((list? v) (str "[" (join "," (map dream-json-encode v)) "]")) + ((dict? v) + (str + "{" + (join + "," + (map + (fn + (k) + (str (dr/json-quote k) ":" (dream-json-encode (get v k)))) + (keys v))) + "}")) + (else (dr/json-quote (str v)))))) + +;; ── parsing (recursive descent; returns {:val :pos}) ─────────────── +(define + dr/json-space? + (fn (c) (or (= c " ") (= c "\n") (= c "\r") (= c "\t")))) +(define + dr/json-ws + (fn + (s i) + (if + (and (< i (string-length s)) (dr/json-space? (char-at s i))) + (dr/json-ws s (+ i 1)) + i))) + +(define + dr/json-digit? + (fn + (c) + (let ((n (char-code c))) (and (>= n 48) (<= n 57))))) +(define + dr/json-num-char? + (fn + (c) + (or + (dr/json-digit? c) + (= c "-") + (= c "+") + (= c ".") + (= c "e") + (= c "E")))) +(define + dr/json-num-end + (fn + (s i) + (if + (and (< i (string-length s)) (dr/json-num-char? (char-at s i))) + (dr/json-num-end s (+ i 1)) + i))) +(define + dr/json-to-number + (fn + (str-val) + (if + (or + (contains? str-val ".") + (contains? str-val "e") + (contains? str-val "E")) + (parse-float str-val) + (parse-int str-val)))) + +(define + dr/json-str + (fn + (s i acc) + (let + ((c (char-at s i))) + (cond + ((= c "\"") {:val acc :pos (+ i 1)}) + ((= c "\\") + (let + ((e (char-at s (+ i 1)))) + (cond + ((= e "n") (dr/json-str s (+ i 2) (str acc "\n"))) + ((= e "r") (dr/json-str s (+ i 2) (str acc "\r"))) + ((= e "t") (dr/json-str s (+ i 2) (str acc "\t"))) + (else (dr/json-str s (+ i 2) (str acc e)))))) + (else (dr/json-str s (+ i 1) (str acc c))))))) + +(define + dr/json-num + (fn (s i) (let ((j (dr/json-num-end s i))) {:val (dr/json-to-number (substr s i (- j i))) :pos j}))) + +(define + dr/json-arr + (fn + (s i acc) + (let + ((i (dr/json-ws s i))) + (if + (= (char-at s i) "]") + {:val acc :pos (+ i 1)} + (let + ((r (dr/json-val s i))) + (let + ((i2 (dr/json-ws s (get r :pos)))) + (if + (= (char-at s i2) ",") + (dr/json-arr + s + (+ i2 1) + (concat acc (list (get r :val)))) + {:val (concat acc (list (get r :val))) :pos (+ i2 1)}))))))) + +(define + dr/json-obj + (fn + (s i acc) + (let + ((i (dr/json-ws s i))) + (if + (= (char-at s i) "}") + {:val acc :pos (+ i 1)} + (let + ((kr (dr/json-str s (+ i 1) ""))) + (let + ((i2 (dr/json-ws s (get kr :pos)))) + (let + ((vr (dr/json-val s (+ i2 1)))) + (let + ((i3 (dr/json-ws s (get vr :pos)))) + (if + (= (char-at s i3) ",") + (dr/json-obj + s + (+ i3 1) + (assoc acc (get kr :val) (get vr :val))) + {:val (assoc acc (get kr :val) (get vr :val)) :pos (+ i3 1)}))))))))) + +(define + dr/json-val + (fn + (s i) + (let + ((i (dr/json-ws s i))) + (let + ((c (char-at s i))) + (cond + ((= c "{") (dr/json-obj s (+ i 1) {})) + ((= c "[") (dr/json-arr s (+ i 1) (list))) + ((= c "\"") (dr/json-str s (+ i 1) "")) + ((= c "t") {:val true :pos (+ i 4)}) + ((= c "f") {:val false :pos (+ i 5)}) + ((= c "n") {:val nil :pos (+ i 4)}) + (else (dr/json-num s i))))))) + +(define dream-json-parse (fn (s) (get (dr/json-val s 0) :val))) + +;; ── responses ────────────────────────────────────────────────────── +;; encode a value into a JSON response (dream-json takes a raw string body) +(define dream-json-value (fn (v) (dream-json (dream-json-encode v)))) +;; read + parse the request body as JSON +(define dream-json-body (fn (req) (dream-json-parse (dream-body req)))) diff --git a/lib/dream/tests/json.sx b/lib/dream/tests/json.sx new file mode 100644 index 00000000..6deca84e --- /dev/null +++ b/lib/dream/tests/json.sx @@ -0,0 +1,105 @@ +;; lib/dream/tests/json.sx — JSON encode/parse round-trips. + +(define dream-js-pass 0) +(define dream-js-fail 0) +(define dream-js-fails (list)) + +(define + dream-js-test + (fn + (name actual expected) + (if + (= actual expected) + (set! dream-js-pass (+ dream-js-pass 1)) + (begin + (set! dream-js-fail (+ dream-js-fail 1)) + (append! dream-js-fails {:name name :actual actual :expected expected}))))) + +;; ── encoding scalars ─────────────────────────────────────────────── +(dream-js-test "encode int" (dream-json-encode 42) "42") +(dream-js-test "encode float" (dream-json-encode 1.5) "1.5") +(dream-js-test "encode true" (dream-json-encode true) "true") +(dream-js-test "encode false" (dream-json-encode false) "false") +(dream-js-test "encode nil" (dream-json-encode nil) "null") +(dream-js-test "encode string" (dream-json-encode "hi") "\"hi\"") +(dream-js-test + "encode string escapes quote" + (dream-json-encode "a\"b") + "\"a\\\"b\"") +(dream-js-test + "encode list" + (dream-json-encode (list 1 2 3)) + "[1,2,3]") +(dream-js-test + "encode list of strings" + (dream-json-encode (list "a" "b")) + "[\"a\",\"b\"]") +(dream-js-test + "encode single-key dict" + (dream-json-encode {:a 1}) + "{\"a\":1}") +(dream-js-test "encode empty list" (dream-json-encode (list)) "[]") +(dream-js-test "encode empty dict" (dream-json-encode {}) "{}") + +;; ── parsing scalars ──────────────────────────────────────────────── +(dream-js-test "parse int" (dream-json-parse "5") 5) +(dream-js-test "parse negative" (dream-json-parse "-7") -7) +(dream-js-test "parse float" (dream-json-parse "1.5") 1.5) +(dream-js-test "parse true" (dream-json-parse "true") true) +(dream-js-test "parse false" (dream-json-parse "false") false) +(dream-js-test "parse null" (dream-json-parse "null") nil) +(dream-js-test "parse string" (dream-json-parse "\"hello\"") "hello") +(dream-js-test "parse string escape" (dream-json-parse "\"a\\nb\"") "a\nb") +(dream-js-test + "parse array" + (dream-json-parse "[1,2,3]") + (list 1 2 3)) +(dream-js-test "parse empty array" (dream-json-parse "[]") (list)) +(dream-js-test + "parse with whitespace" + (dream-json-parse " [ 1 , 2 ] ") + (list 1 2)) + +;; ── parsing objects ──────────────────────────────────────────────── +(define dream-js-obj (dream-json-parse "{\"x\":5,\"y\":\"hi\"}")) +(dream-js-test "parse obj number" (get dream-js-obj "x") 5) +(dream-js-test "parse obj string" (get dream-js-obj "y") "hi") +(dream-js-test "parse empty obj" (dream-json-parse "{}") {}) + +;; ── nested ───────────────────────────────────────────────────────── +(define dream-js-nested (dream-json-parse "{\"a\":[1,{\"b\":2}],\"c\":true}")) +(dream-js-test + "nested array first" + (first (get dream-js-nested "a")) + 1) +(dream-js-test + "nested object in array" + (get (nth (get dream-js-nested "a") 1) "b") + 2) +(dream-js-test "nested bool" (get dream-js-nested "c") true) + +;; ── round-trips ──────────────────────────────────────────────────── +(define dream-js-v {:name "Ada" :age 36 :tags (list "math" "engine")}) +(define dream-js-rt (dream-json-parse (dream-json-encode dream-js-v))) +(dream-js-test "roundtrip name" (get dream-js-rt "name") "Ada") +(dream-js-test "roundtrip age" (get dream-js-rt "age") 36) +(dream-js-test + "roundtrip tags" + (get dream-js-rt "tags") + (list "math" "engine")) + +;; ── response + request helpers ───────────────────────────────────── +(dream-js-test + "json-value content-type" + (dream-resp-header (dream-json-value {:ok true}) "content-type") + "application/json") +(dream-js-test + "json-value body" + (dream-resp-body (dream-json-value {:ok true})) + "{\"ok\":true}") +(dream-js-test + "json-body parses request" + (get (dream-json-body (dream-request "POST" "/" {} "{\"n\":9}")) "n") + 9) + +(define dream-js-tests-run! (fn () {:total (+ dream-js-pass dream-js-fail) :passed dream-js-pass :failed dream-js-fail :fails dream-js-fails})) diff --git a/plans/dream-on-sx.md b/plans/dream-on-sx.md index b8d54a6d..2184f11a 100644 --- a/plans/dream-on-sx.md +++ b/plans/dream-on-sx.md @@ -104,6 +104,14 @@ with extensions + hardening below. short-circuits preflight `OPTIONS` with a 204 carrying Allow-Methods/Headers/Max-Age. `dream-cors-origin` for a specific origin, `dream-cors-with opts` for full control (origin/methods/headers/credentials/max-age). Composes around a router. +- **2026-06-07 — Ext: JSON** (`lib/dream/json.sx`, 35 tests, 329 total). Host JSON + primitives live in the ocaml-on-sx runtime (not the base env), so Dream ships its own + pure-SX `dream-json-encode` (scalars/list/dict, string escaping) + `dream-json-parse` + (recursive-descent over chars, objects/arrays/strings/numbers/true/false/null, + whitespace-tolerant). `dream-json-value` (encode → application/json response) and + `dream-json-body` (parse request body). GOTCHA: `number?` is unreliable in this env — + used `(= (type-of v) "number")`; `parse-float` handles decimals. Multi-key dict + encode order follows `keys` (non-deterministic) so tests assert via parse round-trip. ## Extensions (post-roadmap) @@ -115,7 +123,7 @@ The five-types core is complete; these harden it toward a production HTTP front - [x] **CORS middleware** (`dream-cors`). - [x] **Error-handling middleware** (`dream-catch` / custom 500 templates; `guard`-based). - [ ] **Signed session cookies** (the noted hardening — sign the sid). -- [ ] **JSON helpers** (build from dict; parse to dict). +- [x] **JSON helpers** (encode + recursive-descent parse, pure SX). - [ ] **Query/header convenience** (`dream-queries`, defaults). - [ ] **`api.sx` facade + README** — single load point listing the public surface. From 7d2d8478cc0ed94226cb1218ddba159e0fa9ce6e Mon Sep 17 00:00:00 2001 From: giles Date: Sun, 7 Jun 2026 15:10:03 +0000 Subject: [PATCH 17/22] dream: signed session cookies (tamper-evident sid) + 11 tests Co-Authored-By: Claude Opus 4.8 (1M context) --- lib/dream/session.sx | 68 ++++++++++++++++++++++++++++++++++++++ lib/dream/tests/session.sx | 61 ++++++++++++++++++++++++++++------ plans/dream-on-sx.md | 9 ++++- 3 files changed, 127 insertions(+), 11 deletions(-) diff --git a/lib/dream/session.sx b/lib/dream/session.sx index 5ca4c818..cb6c647a 100644 --- a/lib/dream/session.sx +++ b/lib/dream/session.sx @@ -72,6 +72,48 @@ dream-drop-cookie (fn (resp name) (dream-set-cookie resp name "" {:max-age 0}))) +;; ── signed cookie values (tamper-evident) ────────────────────────── +;; NOTE: pure-SX keyed hash — not cryptographic; production should inject a host +;; HMAC. Value carries no "." so the first "." splits value from signature. +(define + dr/sess-hash + (fn (s) (dr/sess-hash-loop s 0 (string-length s) 7))) +(define + dr/sess-hash-loop + (fn + (s i n h) + (if + (>= i n) + h + (dr/sess-hash-loop + s + (+ i 1) + n + (mod (+ (* h 131) (char-code (char-at s i))) 2147483647))))) +(define + dr/sess-sig + (fn (secret val) (str (dr/sess-hash (str secret "|" val))))) + +(define + dream-cookie-sign + (fn (secret val) (str val "." (dr/sess-sig secret val)))) +(define + dream-cookie-unsign + (fn + (secret signed) + (if + (or (nil? signed) (= signed "")) + nil + (let + ((dot (index-of signed "."))) + (if + (< dot 0) + nil + (let + ((val (substr signed 0 dot)) + (sig (substr signed (+ dot 1)))) + (if (= sig (dr/sess-sig secret val)) val nil))))))) + ;; ── in-memory session store (tests + demos) ──────────────────────── ;; A backend is (fn (op) result) where op is a dict {:op ... :sid ... :key ...}. (define @@ -143,6 +185,32 @@ sid {:path "/" :http-only true :same-site "Lax"})))))))))) +;; signed variant: the cookie value is signed so a guessed/forged sid is rejected +(define + dream-sessions-signed + (fn + (backend secret) + (fn + (next) + (fn + (req) + (let + ((sid0 (dream-cookie-unsign secret (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 + (dream-cookie-sign secret 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))) diff --git a/lib/dream/tests/session.sx b/lib/dream/tests/session.sx index 7706af27..d1c91a2d 100644 --- a/lib/dream/tests/session.sx +++ b/lib/dream/tests/session.sx @@ -1,4 +1,4 @@ -;; lib/dream/tests/session.sx — cookies, store, session round-trip. +;; lib/dream/tests/session.sx — cookies, store, session round-trip, signed cookies. (define dream-ss-pass 0) (define dream-ss-fail 0) @@ -65,6 +65,19 @@ "Max-Age=0") true) +;; ── signed cookie values ─────────────────────────────────────────── +(dream-ss-test + "sign/unsign roundtrip" + (dream-cookie-unsign "k" (dream-cookie-sign "k" "s5")) + "s5") +(dream-ss-test + "unsign wrong secret" + (dream-cookie-unsign "k2" (dream-cookie-sign "k" "s5")) + nil) +(dream-ss-test "unsign tampered" (dream-cookie-unsign "k" "s5.999") nil) +(dream-ss-test "unsign no dot" (dream-cookie-unsign "k" "s5") nil) +(dream-ss-test "unsign nil" (dream-cookie-unsign "k" nil) nil) + ;; ── in-memory store ──────────────────────────────────────────────── (define dream-ss-store (dream-memory-sessions)) (define dream-ss-sid (dream-ss-store {:op "session/create"})) @@ -93,7 +106,6 @@ (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 @@ -109,7 +121,6 @@ (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 @@ -117,11 +128,9 @@ (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" @@ -133,11 +142,6 @@ 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 @@ -153,4 +157,41 @@ (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) +;; ── signed session middleware ────────────────────────────────────── +(define dream-ss-sbackend (dream-memory-sessions)) +(define + dream-ss-sapp + ((dream-sessions-signed dream-ss-sbackend "topsecret") + (fn (req) (dream-text (dream-session-id req))))) + +(define dream-ss-sr1 (dream-ss-sapp (dream-request "GET" "/" {} ""))) +(dream-ss-test "signed first sid" (dream-resp-body dream-ss-sr1) "s1") +(dream-ss-test + "signed cookie is signed" + (contains? (first (dream-resp-cookies dream-ss-sr1)) "dream.session=s1.") + true) + +;; forged plaintext sid (no signature) is rejected -> a fresh session is made +(dream-ss-test + "forged plaintext rejected -> new session" + (dream-resp-body (dream-ss-sapp (dream-request "GET" "/" {:Cookie "dream.session=s1"} ""))) + "s2") + +;; a validly-signed cookie reuses the session +(define dream-ss-signed-val (dream-cookie-sign "topsecret" "s1")) +(define dream-ss-sr3 (dream-ss-sapp (dream-request "GET" "/" {:Cookie (str "dream.session=" dream-ss-signed-val)} ""))) +(dream-ss-test "valid signed reuses s1" (dream-resp-body dream-ss-sr3) "s1") +(dream-ss-test + "valid signed sets no new cookie" + (len (dream-resp-cookies dream-ss-sr3)) + 0) + +;; a cookie signed with the wrong secret is rejected +(dream-ss-test + "wrong-secret signed rejected" + (= + (dream-resp-body (dream-ss-sapp (dream-request "GET" "/" {:Cookie (str "dream.session=" (dream-cookie-sign "other" "s1"))} ""))) + "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 2184f11a..5a7bbdf0 100644 --- a/plans/dream-on-sx.md +++ b/plans/dream-on-sx.md @@ -112,6 +112,13 @@ with extensions + hardening below. `dream-json-body` (parse request body). GOTCHA: `number?` is unreliable in this env — used `(= (type-of v) "number")`; `parse-float` handles decimals. Multi-key dict encode order follows `keys` (non-deterministic) so tests assert via parse round-trip. +- **2026-06-07 — Ext: signed session cookies** (`lib/dream/session.sx`, session suite + 30→41, 340 total). The default store uses guessable sids (`s1`, `s2`), so + `dream-sessions-signed backend secret` signs the cookie value (`sid.signature`) and + rejects any cookie whose signature doesn't verify — a forged plaintext `s1` or a + wrong-secret cookie yields a fresh session instead of a hijack. `dream-cookie-sign` / + `dream-cookie-unsign` (keyed hash; same not-cryptographic caveat — inject a host HMAC + in production). Plain `dream-sessions` unchanged for the no-secret case. ## Extensions (post-roadmap) @@ -122,7 +129,7 @@ The five-types core is complete; these harden it toward a production HTTP front - [x] **Status reason phrases** + `dream-status-text` (`lib/dream/error.sx`). - [x] **CORS middleware** (`dream-cors`). - [x] **Error-handling middleware** (`dream-catch` / custom 500 templates; `guard`-based). -- [ ] **Signed session cookies** (the noted hardening — sign the sid). +- [x] **Signed session cookies** (`dream-sessions-signed` — tamper-evident sid). - [x] **JSON helpers** (encode + recursive-descent parse, pure SX). - [ ] **Query/header convenience** (`dream-queries`, defaults). - [ ] **`api.sx` facade + README** — single load point listing the public surface. From 6b9df03d016db9a4c35884fd3a4cd52cf3bb40d3 Mon Sep 17 00:00:00 2001 From: giles Date: Sun, 7 Jun 2026 15:11:55 +0000 Subject: [PATCH 18/22] dream: query/header convenience helpers + content negotiation + 18 tests Co-Authored-By: Claude Opus 4.8 (1M context) --- lib/dream/tests/types.sx | 53 +++++++++++++++++++++++++++++++++++++++- lib/dream/types.sx | 29 ++++++++++++++++++++++ plans/dream-on-sx.md | 7 +++++- 3 files changed, 87 insertions(+), 2 deletions(-) diff --git a/lib/dream/tests/types.sx b/lib/dream/tests/types.sx index 5b4f9893..d4a8dcdc 100644 --- a/lib/dream/tests/types.sx +++ b/lib/dream/tests/types.sx @@ -1,4 +1,4 @@ -;; lib/dream/tests/types.sx — request/response/route records. +;; lib/dream/tests/types.sx — request/response/route records + convenience. (define dream-ty-pass 0) (define dream-ty-fail 0) @@ -66,6 +66,57 @@ (dream-ty-test "with-params a" (dream-param dream-ty-req3 "a") "1") (dream-ty-test "with-params b" (dream-param dream-ty-req3 "b") "2") +;; ── request convenience ──────────────────────────────────────────── +(dream-ty-test "queries dict" (dream-queries dream-ty-req) {:x "1" :tab "info"}) +(dream-ty-test + "query-or present" + (dream-query-param-or dream-ty-req "tab" "def") + "info") +(dream-ty-test + "query-or default" + (dream-query-param-or dream-ty-req "missing" "def") + "def") +(dream-ty-test "has-query yes" (dream-has-query? dream-ty-req "tab") true) +(dream-ty-test "has-query no" (dream-has-query? dream-ty-req "nope") false) +(dream-ty-test + "header-or present" + (dream-header-or dream-ty-req "x-token" "d") + "abc") +(dream-ty-test + "header-or default" + (dream-header-or dream-ty-req "x-absent" "d") + "d") +(dream-ty-test + "has-header yes" + (dream-has-header? dream-ty-req "Content-Type") + true) +(dream-ty-test + "has-header no" + (dream-has-header? dream-ty-req "x-absent") + false) +(dream-ty-test "param-or default" (dream-param-or dream-ty-req "id" "0") "0") +(dream-ty-test + "param-or present" + (dream-param-or dream-ty-req2 "id" "0") + "42") +(dream-ty-test + "content-type-of" + (dream-content-type-of dream-ty-req) + "text/html") +(dream-ty-test "method-is yes" (dream-method-is? dream-ty-req "get") true) +(dream-ty-test "method-is no" (dream-method-is? dream-ty-req "post") false) +(define dream-ty-jreq (dream-request "GET" "/" {:Accept "application/json, text/html"} "")) +(dream-ty-test + "accepts json" + (dream-accepts? dream-ty-jreq "application/json") + true) +(dream-ty-test + "accepts missing" + (dream-accepts? dream-ty-req "application/json") + false) +(dream-ty-test "wants-json yes" (dream-wants-json? dream-ty-jreq) true) +(dream-ty-test "wants-json no" (dream-wants-json? dream-ty-req) false) + ;; ── response construction ────────────────────────────────────────── (dream-ty-test "html status" (dream-status (dream-html "

")) 200) (dream-ty-test "html body" (dream-resp-body (dream-html "

")) "

") diff --git a/lib/dream/types.sx b/lib/dream/types.sx index 75d93aba..2e31f3fb 100644 --- a/lib/dream/types.sx +++ b/lib/dream/types.sx @@ -93,6 +93,35 @@ (keys more))))) (define dream-set-body (fn (req body) (assoc req :body body))) +;; ── request convenience ──────────────────────────────────────────── +(define dream-queries (fn (req) (get req :query))) +(define + dream-query-param-or + (fn (req name default) (or (dream-query-param req name) default))) +(define dream-has-query? (fn (req name) (has-key? (get req :query) name))) +(define + dream-header-or + (fn (req name default) (or (dream-header req name) default))) +(define + dream-has-header? + (fn (req name) (has-key? (get req :headers) (lower name)))) +(define + dream-param-or + (fn (req name default) (or (dream-param req name) default))) +(define dream-has-param? (fn (req name) (has-key? (get req :params) name))) +(define dream-content-type-of (fn (req) (dream-header req "content-type"))) +(define dream-method-is? (fn (req m) (= (dream-method req) (upper m)))) +(define + dream-accepts? + (fn + (req mime) + (let + ((a (dream-header req "accept"))) + (if a (contains? a mime) false)))) +(define + dream-wants-json? + (fn (req) (dream-accepts? req "application/json"))) + ;; ── response ─────────────────────────────────────────────────────── (define dream-response (fn (status headers body) {:body body :headers (dr/normalize-headers headers) :status status})) diff --git a/plans/dream-on-sx.md b/plans/dream-on-sx.md index 5a7bbdf0..89344d77 100644 --- a/plans/dream-on-sx.md +++ b/plans/dream-on-sx.md @@ -119,6 +119,11 @@ with extensions + hardening below. wrong-secret cookie yields a fresh session instead of a hijack. `dream-cookie-sign` / `dream-cookie-unsign` (keyed hash; same not-cryptographic caveat — inject a host HMAC in production). Plain `dream-sessions` unchanged for the no-secret case. +- **2026-06-07 — Ext: query/header convenience** (`lib/dream/types.sx`, types suite + 41→59, 358 total). `dream-queries`, `dream-query-param-or` / `dream-header-or` / + `dream-param-or` (defaults), `dream-has-query?` / `-header?` / `-param?`, + `dream-content-type-of`, `dream-method-is?`, `dream-accepts?` / `dream-wants-json?` + (Accept-header content negotiation). ## Extensions (post-roadmap) @@ -131,7 +136,7 @@ The five-types core is complete; these harden it toward a production HTTP front - [x] **Error-handling middleware** (`dream-catch` / custom 500 templates; `guard`-based). - [x] **Signed session cookies** (`dream-sessions-signed` — tamper-evident sid). - [x] **JSON helpers** (encode + recursive-descent parse, pure SX). -- [ ] **Query/header convenience** (`dream-queries`, defaults). +- [x] **Query/header convenience** (`dream-queries`, `*-or` defaults, `dream-accepts?`). - [ ] **`api.sx` facade + README** — single load point listing the public surface. ## Stdlib additions Dream will need From 7fb833f54cd04de8b85428acc7b1e8905331b284 Mon Sep 17 00:00:00 2001 From: giles Date: Sun, 7 Jun 2026 15:13:44 +0000 Subject: [PATCH 19/22] dream: api.sx facade (make-app/serve) + README documenting public surface + 9 tests Co-Authored-By: Claude Opus 4.8 (1M context) --- lib/dream/README.md | 79 ++++++++++++++++++++++++++++++++++++++++ lib/dream/api.sx | 33 +++++++++++++++++ lib/dream/conformance.sh | 2 + lib/dream/tests/api.sx | 77 +++++++++++++++++++++++++++++++++++++++ plans/dream-on-sx.md | 8 +++- 5 files changed, 198 insertions(+), 1 deletion(-) create mode 100644 lib/dream/README.md create mode 100644 lib/dream/api.sx create mode 100644 lib/dream/tests/api.sx diff --git a/lib/dream/README.md b/lib/dream/README.md new file mode 100644 index 00000000..d7c533b5 --- /dev/null +++ b/lib/dream/README.md @@ -0,0 +1,79 @@ +# dream-on-sx + +OCaml's [Dream](https://aantron.github.io/dream/) web framework, reimplemented in +**plain SX** on the CEK evaluator. Dream is the cleanest middleware-shaped HTTP +framework in any language, and it maps onto SX with almost no impedance: + +| Dream | SX | +|-------|-----| +| `handler = request -> response promise` | `(fn (req) … (perform …))` | +| `middleware = handler -> handler` | `(fn (next) (fn (req) …))` | +| `m1 @@ m2 @@ handler` | `(m1 (m2 handler))` — left fold | +| `Dream.run handler` | `(dream-run handler)` → `(perform (:http/listen …))` | + +There are five types — **request, response, route**, and (as plain functions) +**handler** and **middleware**. Everything else is a function over them. + +## Quickstart + +```lisp +(dream-run + (dream-make-app + (list + (dream-get "/" (fn (req) (dream-html "

Hello, World!

"))) + (dream-get "/hello/:name" + (fn (req) (dream-text (str "Hi, " (dream-param req "name")))))))) +``` + +`dream-make-app` wraps the router in the default stack (error catch + content-type). +`dream-run` installs the root handler on the existing SX HTTP server — it does **not** +open its own socket. + +## Public surface + +- **types** — `dream-request`/`dream-response`/`dream-route`, accessors + (`dream-method`/`-path`/`-body`/`-header`/`-query-param`/`-param`), smart + constructors (`dream-html`/`-text`/`-json`/`-empty`/`-not-found`/`-redirect`), + convenience (`dream-queries`, `*-or` defaults, `dream-accepts?`/`dream-wants-json?`). +- **router** — `dream-get`/`-post`/`-put`/`-delete`/`-patch`/`-head`/`-options`/`-any`, + `dream-router`, `dream-scope` (prefix + middleware), `:name` params + `**` catch-all, + 405 + `Allow`, automatic HEAD. +- **middleware** — `dream-pipeline`, `dream-no-middleware`, `dream-logger`, + `dream-content-type`, `dream-set-header`, `dream-tap-request`. +- **session** — `dream-sessions` / `dream-sessions-signed`, `dream-session-field` / + `dream-set-session-field` / `dream-session-all` / `dream-invalidate-session`; cookie + helpers (`dream-cookie`, `dream-set-cookie`, `dream-cookie-sign`/`-unsign`). +- **flash** — `dream-flash`, `dream-add-flash-message`, `dream-flash-messages`. +- **form** — `dream-form` (Ok/Err), `dream-form-fields`, `dream-multipart`, CSRF + (`dream-csrf` / `dream-csrf-protect` / `dream-csrf-token` / `dream-csrf-tag`). +- **websocket** — `dream-websocket`, `dream-send`/`-receive`/`-close`/`-broadcast`. +- **static** — `dream-static` (mime, ETags, 304, ranges, traversal guard). +- **error** — `dream-catch`, `dream-status-text`/`-line`, `dream-status-page`. +- **cors** — `dream-cors`, `dream-cors-origin`, `dream-cors-with`. +- **json** — `dream-json-encode`/`-parse`, `dream-json-value`, `dream-json-body`. +- **run / api** — `dream-run`/`-port`/`-opts`, `dream-app`, `dream-make-app`, + `dream-serve`. + +## Testing story + +Every effectful concern is **dependency-injected**, so the whole framework is testable +without a running host: + +- sessions take a backend `(fn (op) …)` — `dream-memory-sessions` for tests, + `dream-perform-sessions` in production; +- static files take an fs — `dream-memory-fs` vs `dream-static-perform-fs`; +- websockets take an io — `dream-mock-ws` vs `dream-ws-perform-io`; +- `dream-run` takes a listen transport (`dream-run-with`). + +Run the suite: `bash lib/dream/conformance.sh` (367 tests, 14 suites). + +## Notes & caveats + +- Headers are dicts with **lowercased string keys** (in SX keywords *are* strings, so + `:content-type` == `"content-type"`). +- Outgoing cookies accumulate in a `:set-cookies` list on the response so multiple + `Set-Cookie` headers don't collide. +- The CSRF/cookie/ETag signing uses a pure-SX keyed hash — **not cryptographic**. + Production should inject a host HMAC (`dream-csrf-with`, and the signed-session + secret path). +- JSON and multipart are in-memory (not streaming). diff --git a/lib/dream/api.sx b/lib/dream/api.sx new file mode 100644 index 00000000..63b1850b --- /dev/null +++ b/lib/dream/api.sx @@ -0,0 +1,33 @@ +;; lib/dream/api.sx — Dream-on-SX public facade. +;; Loaded last; bundles the modules into a batteries-included surface. The full +;; public API is the `dream-*` functions across types/router/middleware/session/ +;; flash/form/websocket/static/error/cors/json/run; this file adds convenience +;; app builders. Depends on all other dream modules. + +(define dream-version "0.1.0") + +;; standard middleware stack (pure — no IO): error catch outermost, then +;; content-type sniffing. Logger is opt-in since it performs host IO. +(define + dream-defaults + (fn + (handler) + (dream-pipeline (list dream-catch dream-content-type) handler))) + +;; build a complete app handler from a route list with the default stack +(define + dream-make-app + (fn (routes) (dream-defaults (dream-router routes)))) + +;; build an app and wrap it with extra middleware (outermost first) +(define + dream-make-app-with + (fn + (middlewares routes) + (dream-pipeline middlewares (dream-make-app routes)))) + +;; one-call serve: routes + opts -> installed on the host +(define + dream-serve + (fn (routes opts) (dream-run-opts (dream-make-app routes) opts))) +(define dream-serve-port (fn (routes port) (dream-serve routes {:port port}))) diff --git a/lib/dream/conformance.sh b/lib/dream/conformance.sh index a66cfc35..0d634986 100644 --- a/lib/dream/conformance.sh +++ b/lib/dream/conformance.sh @@ -34,6 +34,7 @@ MODULES=( "lib/dream/cors.sx" "lib/dream/json.sx" "lib/dream/run.sx" + "lib/dream/api.sx" "lib/dream/demos/hello.sx" "lib/dream/demos/counter.sx" "lib/dream/demos/chat.sx" @@ -54,6 +55,7 @@ SUITES=( "cors dream-co-tests-run! lib/dream/tests/cors.sx" "json dream-js-tests-run! lib/dream/tests/json.sx" "run dream-rn-tests-run! lib/dream/tests/run.sx" + "api dream-ap-tests-run! lib/dream/tests/api.sx" "demos dream-dm-tests-run! lib/dream/tests/demos.sx" ) diff --git a/lib/dream/tests/api.sx b/lib/dream/tests/api.sx new file mode 100644 index 00000000..add9b71f --- /dev/null +++ b/lib/dream/tests/api.sx @@ -0,0 +1,77 @@ +;; lib/dream/tests/api.sx — facade: app builders + default stack. + +(define dream-ap-pass 0) +(define dream-ap-fail 0) +(define dream-ap-fails (list)) + +(define + dream-ap-test + (fn + (name actual expected) + (if + (= actual expected) + (set! dream-ap-pass (+ dream-ap-pass 1)) + (begin + (set! dream-ap-fail (+ dream-ap-fail 1)) + (append! dream-ap-fails {:name name :actual actual :expected expected}))))) + +(dream-ap-test "version is a string" (string? dream-version) true) + +;; ── dream-make-app: routes -> handler with default stack ─────────── +(define + dream-ap-routes + (list + (dream-get "/" (fn (req) (dream-html "

hi

"))) + (dream-get "/boom" (fn (req) (error "kaboom"))) + (dream-get + "/raw" + (fn (req) (dream-response 200 {} "plain words"))))) +(define dream-ap-app (dream-make-app dream-ap-routes)) + +(dream-ap-test + "app serves" + (dream-resp-body (dream-ap-app (dream-request "GET" "/" {} ""))) + "

hi

") +(dream-ap-test + "app catches errors -> 500" + (dream-status (dream-ap-app (dream-request "GET" "/boom" {} ""))) + 500) +(dream-ap-test + "app 404 for unknown" + (dream-status (dream-ap-app (dream-request "GET" "/nope" {} ""))) + 404) +(dream-ap-test + "app sniffs content-type" + (dream-resp-header + (dream-ap-app (dream-request "GET" "/raw" {} "")) + "content-type") + "text/plain; charset=utf-8") + +;; ── dream-make-app-with: extra outer middleware ──────────────────── +(define + dream-ap-tag + (fn (next) (fn (req) (dream-add-header (next req) "X-App" "1")))) +(define + dream-ap-app2 + (dream-make-app-with (list dream-ap-tag) dream-ap-routes)) +(dream-ap-test + "extra middleware header" + (dream-resp-header + (dream-ap-app2 (dream-request "GET" "/" {} "")) + "x-app") + "1") + +;; ── dream-serve wires through dream-run ──────────────────────────── +(define dream-ap-captured nil) +(define dream-ap-listen (fn (op) (begin (set! dream-ap-captured op) :ok))) +(define + dream-ap-served + (dream-run-with dream-ap-listen (dream-make-app dream-ap-routes) {:port 7000})) +(dream-ap-test "serve listens" dream-ap-served :ok) +(dream-ap-test "serve port" (get dream-ap-captured :port) 7000) +(dream-ap-test + "served app runs" + (get ((get dream-ap-captured :app) {:method "GET" :target "/"}) :body) + "

hi

") + +(define dream-ap-tests-run! (fn () {:total (+ dream-ap-pass dream-ap-fail) :passed dream-ap-pass :failed dream-ap-fail :fails dream-ap-fails})) diff --git a/plans/dream-on-sx.md b/plans/dream-on-sx.md index 89344d77..913d4cb7 100644 --- a/plans/dream-on-sx.md +++ b/plans/dream-on-sx.md @@ -124,6 +124,12 @@ with extensions + hardening below. `dream-param-or` (defaults), `dream-has-query?` / `-header?` / `-param?`, `dream-content-type-of`, `dream-method-is?`, `dream-accepts?` / `dream-wants-json?` (Accept-header content negotiation). +- **2026-06-07 — Ext: api.sx facade + README** (`lib/dream/api.sx`, 9 tests, 367 total). + `dream-version`, `dream-defaults` (pure stack: error-catch + content-type; logger is + opt-in since it performs IO), `dream-make-app routes`, `dream-make-app-with`, + `dream-serve`/`dream-serve-port`. `lib/dream/README.md` documents the full public + surface, quickstart, the dependency-injection testing story, and caveats. **All + planned extensions complete — 367/367 across 14 suites.** ## Extensions (post-roadmap) @@ -137,7 +143,7 @@ The five-types core is complete; these harden it toward a production HTTP front - [x] **Signed session cookies** (`dream-sessions-signed` — tamper-evident sid). - [x] **JSON helpers** (encode + recursive-descent parse, pure SX). - [x] **Query/header convenience** (`dream-queries`, `*-or` defaults, `dream-accepts?`). -- [ ] **`api.sx` facade + README** — single load point listing the public surface. +- [x] **`api.sx` facade + README** — `dream-make-app` / `dream-serve` + `README.md`. ## Stdlib additions Dream will need From 85aea61f3cd9bb0ffe18e5a4357e3c0258647625 Mon Sep 17 00:00:00 2001 From: giles Date: Sun, 7 Jun 2026 15:16:29 +0000 Subject: [PATCH 20/22] =?UTF-8?q?dream:=20auth=20=E2=80=94=20pure-SX=20bas?= =?UTF-8?q?e64=20+=20HTTP=20Basic=20+=20Bearer-token=20middleware=20+=2023?= =?UTF-8?q?=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/auth.sx | 172 +++++++++++++++++++++++++++++++++++++++ lib/dream/conformance.sh | 2 + lib/dream/tests/auth.sx | 109 +++++++++++++++++++++++++ plans/dream-on-sx.md | 7 ++ 4 files changed, 290 insertions(+) create mode 100644 lib/dream/auth.sx create mode 100644 lib/dream/tests/auth.sx diff --git a/lib/dream/auth.sx b/lib/dream/auth.sx new file mode 100644 index 00000000..16c5dd61 --- /dev/null +++ b/lib/dream/auth.sx @@ -0,0 +1,172 @@ +;; lib/dream/auth.sx — Dream-on-SX authentication helpers. +;; HTTP Basic auth (with a pure-SX base64 codec) and Bearer-token guards. +;; Depends on types.sx. + +;; ── base64 (pure SX; arithmetic, no bitwise) ─────────────────────── +(define + dr/b64-alpha + "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/") +(define dr/b64-char (fn (n) (char-at dr/b64-alpha n))) +(define dr/b64-index (fn (c) (index-of dr/b64-alpha c))) + +(define + dr/b64-encode-loop + (fn + (s i n acc) + (if + (>= i n) + acc + (let + ((b0 (char-code (char-at s i))) (rem (- n i))) + (cond + ((>= rem 3) + (let + ((triple (+ (* b0 65536) (* (char-code (char-at s (+ i 1))) 256) (char-code (char-at s (+ i 2)))))) + (dr/b64-encode-loop + s + (+ i 3) + n + (str + acc + (dr/b64-char (mod (quotient triple 262144) 64)) + (dr/b64-char (mod (quotient triple 4096) 64)) + (dr/b64-char (mod (quotient triple 64) 64)) + (dr/b64-char (mod triple 64)))))) + ((= rem 2) + (let + ((triple (+ (* b0 65536) (* (char-code (char-at s (+ i 1))) 256)))) + (str + acc + (dr/b64-char (mod (quotient triple 262144) 64)) + (dr/b64-char (mod (quotient triple 4096) 64)) + (dr/b64-char (mod (quotient triple 64) 64)) + "="))) + (else + (let + ((triple (* b0 65536))) + (str + acc + (dr/b64-char (mod (quotient triple 262144) 64)) + (dr/b64-char (mod (quotient triple 4096) 64)) + "==")))))))) + +(define + dream-base64-encode + (fn (s) (dr/b64-encode-loop s 0 (string-length s) ""))) + +(define + dr/b64-decode-loop + (fn + (s i n acc) + (if + (>= i n) + acc + (let + ((p2 (char-at s (+ i 2))) + (p3 (char-at s (+ i 3)))) + (let + ((c0 (dr/b64-index (char-at s i))) + (c1 (dr/b64-index (char-at s (+ i 1)))) + (c2 (if (= p2 "=") 0 (dr/b64-index p2))) + (c3 (if (= p3 "=") 0 (dr/b64-index p3)))) + (let + ((triple (+ (* c0 262144) (* c1 4096) (* c2 64) c3))) + (dr/b64-decode-loop + s + (+ i 4) + n + (str + acc + (char-from-code + (mod (quotient triple 65536) 256)) + (if + (= p2 "=") + "" + (char-from-code + (mod (quotient triple 256) 256))) + (if (= p3 "=") "" (char-from-code (mod triple 256))))))))))) + +(define + dream-base64-decode + (fn + (s) + (if (= s "") "" (dr/b64-decode-loop s 0 (string-length s) "")))) + +;; ── Authorization header parsing ─────────────────────────────────── +(define dream-authorization (fn (req) (dream-header req "authorization"))) + +(define + dream-bearer-token + (fn + (req) + (let + ((a (dream-authorization req))) + (if (and a (starts-with? a "Bearer ")) (substr a 7) nil)))) + +(define + dream-basic-credentials + (fn + (req) + (let + ((a (dream-authorization req))) + (if + (and a (starts-with? a "Basic ")) + (let + ((decoded (dream-base64-decode (substr a 6)))) + (let + ((colon (index-of decoded ":"))) + (if (< colon 0) nil {:pass (substr decoded (+ colon 1)) :user (substr decoded 0 colon)}))) + nil)))) + +;; ── Basic auth middleware ────────────────────────────────────────── +;; check is (fn (user pass) -> bool). On success the request gains :dream-user. +(define + dr/www-authenticate + (fn + (realm) + (dream-add-header + (dream-response 401 {:content-type "text/plain; charset=utf-8"} "Unauthorized") + "www-authenticate" + (str "Basic realm=\"" realm "\"")))) + +(define + dream-basic-auth + (fn + (realm check) + (fn + (next) + (fn + (req) + (let + ((creds (dream-basic-credentials req))) + (if + (and creds (check (get creds :user) (get creds :pass))) + (next (assoc req :dream-user (get creds :user))) + (dr/www-authenticate realm))))))) + +(define dream-user (fn (req) (get req :dream-user))) + +;; ── Bearer-token middleware ──────────────────────────────────────── +;; check is (fn (token) -> principal | nil). On success the request gains +;; :dream-principal. Missing/invalid -> 401. +(define + dream-require-bearer + (fn + (check) + (fn + (next) + (fn + (req) + (let + ((tok (dream-bearer-token req))) + (let + ((principal (if tok (check tok) nil))) + (if + (nil? principal) + (dream-add-header + (dream-response 401 {:content-type "text/plain; charset=utf-8"} "Unauthorized") + "www-authenticate" + "Bearer") + (next (assoc req :dream-principal principal))))))))) + +(define dream-principal (fn (req) (get req :dream-principal))) diff --git a/lib/dream/conformance.sh b/lib/dream/conformance.sh index 0d634986..2aae5fca 100644 --- a/lib/dream/conformance.sh +++ b/lib/dream/conformance.sh @@ -33,6 +33,7 @@ MODULES=( "lib/dream/error.sx" "lib/dream/cors.sx" "lib/dream/json.sx" + "lib/dream/auth.sx" "lib/dream/run.sx" "lib/dream/api.sx" "lib/dream/demos/hello.sx" @@ -54,6 +55,7 @@ SUITES=( "error dream-er-tests-run! lib/dream/tests/error.sx" "cors dream-co-tests-run! lib/dream/tests/cors.sx" "json dream-js-tests-run! lib/dream/tests/json.sx" + "auth dream-au-tests-run! lib/dream/tests/auth.sx" "run dream-rn-tests-run! lib/dream/tests/run.sx" "api dream-ap-tests-run! lib/dream/tests/api.sx" "demos dream-dm-tests-run! lib/dream/tests/demos.sx" diff --git a/lib/dream/tests/auth.sx b/lib/dream/tests/auth.sx new file mode 100644 index 00000000..f5cb9806 --- /dev/null +++ b/lib/dream/tests/auth.sx @@ -0,0 +1,109 @@ +;; lib/dream/tests/auth.sx — base64, basic auth, bearer tokens. + +(define dream-au-pass 0) +(define dream-au-fail 0) +(define dream-au-fails (list)) + +(define + dream-au-test + (fn + (name actual expected) + (if + (= actual expected) + (set! dream-au-pass (+ dream-au-pass 1)) + (begin + (set! dream-au-fail (+ dream-au-fail 1)) + (append! dream-au-fails {:name name :actual actual :expected expected}))))) + +;; ── base64 ───────────────────────────────────────────────────────── +(dream-au-test "encode Man" (dream-base64-encode "Man") "TWFu") +(dream-au-test "encode Ma" (dream-base64-encode "Ma") "TWE=") +(dream-au-test "encode M" (dream-base64-encode "M") "TQ==") +(dream-au-test + "encode user:pass" + (dream-base64-encode "user:pass") + "dXNlcjpwYXNz") +(dream-au-test "decode Man" (dream-base64-decode "TWFu") "Man") +(dream-au-test "decode Ma" (dream-base64-decode "TWE=") "Ma") +(dream-au-test "decode M" (dream-base64-decode "TQ==") "M") +(dream-au-test + "decode user:pass" + (dream-base64-decode "dXNlcjpwYXNz") + "user:pass") +(dream-au-test + "roundtrip phrase" + (dream-base64-decode (dream-base64-encode "Hello, World!")) + "Hello, World!") +(dream-au-test + "roundtrip empty" + (dream-base64-decode (dream-base64-encode "")) + "") + +;; ── header parsing ───────────────────────────────────────────────── +(dream-au-test + "bearer token" + (dream-bearer-token (dream-request "GET" "/" {:Authorization "Bearer abc.123"} "")) + "abc.123") +(dream-au-test + "no bearer" + (dream-bearer-token (dream-request "GET" "/" {} "")) + nil) +(dream-au-test + "basic creds" + (dream-basic-credentials (dream-request "GET" "/" {:Authorization "Basic dXNlcjpwYXNz"} "")) + {:pass "pass" :user "user"}) +(dream-au-test + "no basic" + (dream-basic-credentials (dream-request "GET" "/" {} "")) + nil) + +;; ── basic auth middleware ────────────────────────────────────────── +(define dream-au-check (fn (u p) (and (= u "admin") (= p "secret")))) +(define + dream-au-app + ((dream-basic-auth "Admin Area" dream-au-check) + (fn (req) (dream-text (str "hi " (dream-user req)))))) + +(define dream-au-ok (dream-au-app (dream-request "GET" "/" {:Authorization (str "Basic " (dream-base64-encode "admin:secret"))} ""))) +(dream-au-test "basic ok reaches" (dream-resp-body dream-au-ok) "hi admin") +(dream-au-test "basic ok status" (dream-status dream-au-ok) 200) + +(define dream-au-bad (dream-au-app (dream-request "GET" "/" {:Authorization (str "Basic " (dream-base64-encode "admin:wrong"))} ""))) +(dream-au-test "basic wrong 401" (dream-status dream-au-bad) 401) +(dream-au-test + "basic wrong www-authenticate" + (contains? (dream-resp-header dream-au-bad "www-authenticate") "Admin Area") + true) +(dream-au-test + "basic missing 401" + (dream-status (dream-au-app (dream-request "GET" "/" {} ""))) + 401) + +;; ── bearer middleware ────────────────────────────────────────────── +(define dream-au-tokens {:t-ada "ada" :t-bob "bob"}) +(define dream-au-lookup (fn (tok) (get dream-au-tokens tok))) +(define + dream-au-bapp + ((dream-require-bearer dream-au-lookup) + (fn (req) (dream-text (dream-principal req))))) + +(dream-au-test + "bearer valid principal" + (dream-resp-body (dream-au-bapp (dream-request "GET" "/" {:Authorization "Bearer t-ada"} ""))) + "ada") +(dream-au-test + "bearer invalid 401" + (dream-status (dream-au-bapp (dream-request "GET" "/" {:Authorization "Bearer nope"} ""))) + 401) +(dream-au-test + "bearer missing 401" + (dream-status (dream-au-bapp (dream-request "GET" "/" {} ""))) + 401) +(dream-au-test + "bearer 401 header" + (dream-resp-header + (dream-au-bapp (dream-request "GET" "/" {} "")) + "www-authenticate") + "Bearer") + +(define dream-au-tests-run! (fn () {:total (+ dream-au-pass dream-au-fail) :passed dream-au-pass :failed dream-au-fail :fails dream-au-fails})) diff --git a/plans/dream-on-sx.md b/plans/dream-on-sx.md index 913d4cb7..55db180e 100644 --- a/plans/dream-on-sx.md +++ b/plans/dream-on-sx.md @@ -130,6 +130,12 @@ with extensions + hardening below. `dream-serve`/`dream-serve-port`. `lib/dream/README.md` documents the full public surface, quickstart, the dependency-injection testing story, and caveats. **All planned extensions complete — 367/367 across 14 suites.** +- **2026-06-07 — Ext: auth** (`lib/dream/auth.sx`, 23 tests, 390 total). Pure-SX base64 + codec (`dream-base64-encode`/`-decode`, arithmetic via `quotient`/`mod` — no bitwise), + verified against RFC vectors (Man/Ma/M padding). `dream-basic-auth realm check` → + 401 + `WWW-Authenticate: Basic realm=…`, attaches `:dream-user` on success; + `dream-basic-credentials` / `dream-authorization` accessors. `dream-require-bearer + check` → attaches `:dream-principal` or 401; `dream-bearer-token` accessor. ## Extensions (post-roadmap) @@ -144,6 +150,7 @@ The five-types core is complete; these harden it toward a production HTTP front - [x] **JSON helpers** (encode + recursive-descent parse, pure SX). - [x] **Query/header convenience** (`dream-queries`, `*-or` defaults, `dream-accepts?`). - [x] **`api.sx` facade + README** — `dream-make-app` / `dream-serve` + `README.md`. +- [x] **Auth** — base64 (pure SX), HTTP Basic auth + Bearer-token middleware. ## Stdlib additions Dream will need From 0366373c8a83133d03619dd96a88acbc67b22d82 Mon Sep 17 00:00:00 2001 From: giles Date: Sun, 7 Jun 2026 15:18:49 +0000 Subject: [PATCH 21/22] dream: HTML escaping (dream-escape) + fix XSS hole in todo demo + 11 tests Co-Authored-By: Claude Opus 4.8 (1M context) --- lib/dream/conformance.sh | 2 ++ lib/dream/demos/todo.sx | 5 ++-- lib/dream/html.sx | 24 ++++++++++++++++ lib/dream/tests/html.sx | 59 ++++++++++++++++++++++++++++++++++++++++ plans/dream-on-sx.md | 6 ++++ 5 files changed, 94 insertions(+), 2 deletions(-) create mode 100644 lib/dream/html.sx create mode 100644 lib/dream/tests/html.sx diff --git a/lib/dream/conformance.sh b/lib/dream/conformance.sh index 2aae5fca..21ffd739 100644 --- a/lib/dream/conformance.sh +++ b/lib/dream/conformance.sh @@ -34,6 +34,7 @@ MODULES=( "lib/dream/cors.sx" "lib/dream/json.sx" "lib/dream/auth.sx" + "lib/dream/html.sx" "lib/dream/run.sx" "lib/dream/api.sx" "lib/dream/demos/hello.sx" @@ -56,6 +57,7 @@ SUITES=( "cors dream-co-tests-run! lib/dream/tests/cors.sx" "json dream-js-tests-run! lib/dream/tests/json.sx" "auth dream-au-tests-run! lib/dream/tests/auth.sx" + "html dream-ht-tests-run! lib/dream/tests/html.sx" "run dream-rn-tests-run! lib/dream/tests/run.sx" "api dream-ap-tests-run! lib/dream/tests/api.sx" "demos dream-dm-tests-run! lib/dream/tests/demos.sx" diff --git a/lib/dream/demos/todo.sx b/lib/dream/demos/todo.sx index 72317b22..ab367199 100644 --- a/lib/dream/demos/todo.sx +++ b/lib/dream/demos/todo.sx @@ -1,6 +1,7 @@ ;; lib/dream/demos/todo.sx — CRUD todo list with forms + CSRF (todo.ml). ;; An in-memory store holds items; add/toggle/delete go through POST forms guarded -;; by the CSRF middleware. Wires session -> csrf -> router. +;; by the CSRF middleware. User text is HTML-escaped on render (dream-escape). +;; Wires session -> csrf -> router. (define dream-todo-store @@ -19,7 +20,7 @@ acc "
  • " (if (get it :done) "[x] " "[ ] ") - (get it :text) + (dream-escape (get it :text)) "
    • ")) "" ((get store :all))) diff --git a/lib/dream/html.sx b/lib/dream/html.sx new file mode 100644 index 00000000..feeec7a8 --- /dev/null +++ b/lib/dream/html.sx @@ -0,0 +1,24 @@ +;; lib/dream/html.sx — Dream-on-SX HTML escaping for safe templating. +;; Interpolating user input into HTML without escaping is an XSS hole; dream-escape +;; neutralises it. Depends on nothing (pure string ops). + +;; escape text for HTML element content / double-quoted attributes +(define + dream-escape + (fn + (s) + (replace + (replace + (replace (replace (replace s "&" "&") "<" "<") ">" ">") + "\"" + """) + "'" + "'"))) + +;; build a single attribute: name="escaped-value" +(define dream-attr (fn (name val) (str name "=\"" (dream-escape val) "\""))) + +;; join escaped text with a separator, escaping each piece +(define + dream-escape-join + (fn (sep pieces) (join sep (map dream-escape pieces)))) diff --git a/lib/dream/tests/html.sx b/lib/dream/tests/html.sx new file mode 100644 index 00000000..bf76b7bb --- /dev/null +++ b/lib/dream/tests/html.sx @@ -0,0 +1,59 @@ +;; lib/dream/tests/html.sx — HTML escaping (+ demo XSS regression). + +(define dream-ht-pass 0) +(define dream-ht-fail 0) +(define dream-ht-fails (list)) + +(define + dream-ht-test + (fn + (name actual expected) + (if + (= actual expected) + (set! dream-ht-pass (+ dream-ht-pass 1)) + (begin + (set! dream-ht-fail (+ dream-ht-fail 1)) + (append! dream-ht-fails {:name name :actual actual :expected expected}))))) + +(dream-ht-test "escape ampersand" (dream-escape "a & b") "a & b") +(dream-ht-test "escape lt gt" (dream-escape "") "<b>") +(dream-ht-test "escape quote" (dream-escape "say \"hi\"") "say "hi"") +(dream-ht-test "escape apostrophe" (dream-escape "it's") "it's") +(dream-ht-test + "escape script tag" + (dream-escape "") + "<script>alert(1)</script>") +(dream-ht-test + "ampersand first (no double-escape)" + (dream-escape "<") + "&lt;") +(dream-ht-test + "safe string unchanged" + (dream-escape "hello world") + "hello world") +(dream-ht-test + "attr escapes value" + (dream-attr "title" "a\"b") + "title=\"a"b\"") +(dream-ht-test + "escape-join" + (dream-escape-join " " (list "" "")) + "<a> <b>") + +;; ── todo demo escapes user input (XSS regression) ────────────────── +(define dream-ht-store (dream-todo-store)) +((get dream-ht-store :add) "") +(define + dream-ht-ctx + (assoc (dream-request "GET" "/" {} "") :dream-csrf {:sign dream-csrf-sign-default :sid "s1" :secret "k"})) +(define dream-ht-rendered (dr/todo-render dream-ht-store dream-ht-ctx)) +(dream-ht-test + "todo escapes script" + (contains? dream-ht-rendered "<script>") + true) +(dream-ht-test + "todo has no raw script" + (contains? dream-ht-rendered "