dream: forms (urlencoded) + stateless signed CSRF + 26 tests
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 59s

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
This commit is contained in:
2026-06-07 14:43:41 +00:00
parent edff7735e7
commit 9a67ced748
4 changed files with 429 additions and 5 deletions

View File

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

228
lib/dream/form.sx Normal file
View File

@@ -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
"<input type=\"hidden\" name=\""
dream-csrf-field-name
"\" value=\""
(dream-csrf-token req)
"\">")))
;; ── 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)))

181
lib/dream/tests/form.sx Normal file
View File

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

View File

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