giles
b5a273cc99
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 1m19s
Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
151 lines
4.4 KiB
Plaintext
151 lines
4.4 KiB
Plaintext
;; 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 "<p>hi</p>")
|
|
"text/html; charset=utf-8")
|
|
(dream-mw-test
|
|
"sniff doctype"
|
|
(dream-mw-sniff "<!doctype html>")
|
|
"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}))
|