rose-ash/lib/dream/tests/form.sx

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