diff --git a/lib/dream/conformance.sh b/lib/dream/conformance.sh index 16de8614..03b0118d 100644 --- a/lib/dream/conformance.sh +++ b/lib/dream/conformance.sh @@ -24,12 +24,14 @@ VERBOSE="${1:-}" MODULES=( "lib/dream/types.sx" "lib/dream/router.sx" + "lib/dream/middleware.sx" ) # Suites: NAME RUNNER-FN PATH SUITES=( - "types dream-ty-tests-run! lib/dream/tests/types.sx" - "router dream-rt-tests-run! lib/dream/tests/router.sx" + "types dream-ty-tests-run! lib/dream/tests/types.sx" + "router dream-rt-tests-run! lib/dream/tests/router.sx" + "middleware dream-mw-tests-run! lib/dream/tests/middleware.sx" ) TMPFILE=$(mktemp); trap "rm -f $TMPFILE" EXIT diff --git a/lib/dream/middleware.sx b/lib/dream/middleware.sx new file mode 100644 index 00000000..9a980a90 --- /dev/null +++ b/lib/dream/middleware.sx @@ -0,0 +1,92 @@ +;; lib/dream/middleware.sx — Dream-on-SX middleware. +;; A middleware is handler->handler. Composition is plain function composition: +;; m1 @@ m2 @@ handler = (m1 (m2 handler)). Depends on types.sx + router.sx +;; (reuses dr/apply-middlewares for the fold). + +;; ── composition ──────────────────────────────────────────────────── +;; (dream-pipeline (list m1 m2 m3) handler) = (m1 (m2 (m3 handler))). +(define + dream-pipeline + (fn (middlewares handler) (dr/apply-middlewares middlewares handler))) + +;; identity middleware +(define dream-no-middleware (fn (next) next)) + +;; ── logger ───────────────────────────────────────────────────────── +;; Parameterised on a clock and a sink so it is testable without IO. +;; sink receives {:method :path :status :elapsed}. +(define + dream-logger-with + (fn + (clock sink) + (fn + (next) + (fn + (req) + (let + ((t0 (clock))) + (let ((resp (next req))) (begin (sink {:path (dream-path req) :status (dream-status resp) :method (dream-method req) :elapsed (- (clock) t0)}) resp))))))) + +;; default logger performs host effects for the clock and the log sink +(define + dream-logger + (dream-logger-with + (fn () (perform (:dream-clock))) + (fn (entry) (perform (:dream-log entry))))) + +;; format a log entry as a one-line string (apache-ish) +(define + dream-log-line + (fn + (entry) + (str + (get entry :method) + " " + (get entry :path) + " -> " + (get entry :status) + " (" + (get entry :elapsed) + "ms)"))) + +;; ── content-type sniffer ─────────────────────────────────────────── +(define + dr/sniff-content-type + (fn + (body) + (cond + ((= body "") "text/plain; charset=utf-8") + ((starts-with? body "<") "text/html; charset=utf-8") + ((starts-with? body "{") "application/json") + ((starts-with? body "[") "application/json") + (else "text/plain; charset=utf-8")))) + +;; sets Content-Type from the body only when the handler left it unset +(define + dream-content-type + (fn + (next) + (fn + (req) + (let + ((resp (next req))) + (if + (dream-resp-header resp "content-type") + resp + (dream-add-header + resp + "content-type" + (dr/sniff-content-type (dream-resp-body resp)))))))) + +;; ── small reusable middlewares ───────────────────────────────────── +;; always attach a response header +(define + dream-set-header + (fn + (name val) + (fn (next) (fn (req) (dream-add-header (next req) name val))))) + +;; rewrite/observe the request before the handler sees it +(define + dream-tap-request + (fn (f) (fn (next) (fn (req) (next (f req)))))) diff --git a/lib/dream/tests/middleware.sx b/lib/dream/tests/middleware.sx new file mode 100644 index 00000000..6a275af6 --- /dev/null +++ b/lib/dream/tests/middleware.sx @@ -0,0 +1,150 @@ +;; 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 "

hi

") + "text/html; charset=utf-8") +(dream-mw-test + "sniff doctype" + (dream-mw-sniff "") + "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})) diff --git a/plans/dream-on-sx.md b/plans/dream-on-sx.md index 555d54f6..2b373bf0 100644 --- a/plans/dream-on-sx.md +++ b/plans/dream-on-sx.md @@ -51,7 +51,7 @@ The five types: `request`, `response`, `handler = request -> response`, `middlew - `dream-router routes` — dispatch tree, returns handler; no match → 404. - Path param extraction: `:name` segments, `**` wildcard. - `dream-param req name` — retrieve matched path param. -- [ ] **Middleware** in `lib/dream/middleware.sx`: +- [x] **Middleware** in `lib/dream/middleware.sx`: - `dream-pipeline middlewares handler` — compose middleware left-to-right. - `dream-no-middleware` — identity. - Logger: `(dream-logger next req)` — logs method, path, status, timing. @@ -121,6 +121,13 @@ Confirm scope before starting; some of these may be addable as Dream-internal he prefix and folds the middleware chain (`m1 @@ m2 @@ h`, first = outermost) onto each route's handler; nests correctly (inner mw innermost). Shared `dr/apply-middlewares` fold will back `dream-pipeline`. +- **2026-06-07 — Middleware** (`lib/dream/middleware.sx`, 20 tests). `dream-pipeline` + (reuses `dr/apply-middlewares`), `dream-no-middleware` identity. `dream-logger-with + clock sink` is the testable core (records `{:method :path :status :elapsed}`); + `dream-logger` wires it to `(perform (:dream-clock))` / `(perform (:dream-log …))`; + `dream-log-line` formats one line. `dream-content-type` sniffs body (`<`→html, + `{`/`[`→json, else text) only when the handler left Content-Type unset. Bonus + `dream-set-header` and `dream-tap-request` combinators. ## Blockers