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

;; lib/dream/tests/form.sx — urlencoded parsing, Ok/Err, CSRF accept/reject, multipart.

(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

(define
  dream-fo-stack
  (fn
    (handler)
    ((dream-sessions dream-fo-backend) ((dream-csrf "topsecret") handler))))

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

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

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