dream: forms (urlencoded) + stateless signed CSRF + 26 tests
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 59s
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:
@@ -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
228
lib/dream/form.sx
Normal 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
181
lib/dream/tests/form.sx
Normal 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}))
|
||||
@@ -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
|
||||
|
||||
|
||||
Reference in New Issue
Block a user