dream: middleware pipeline + logger + content-type sniffer + 20 tests
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 1m19s
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>
This commit is contained in:
92
lib/dream/middleware.sx
Normal file
92
lib/dream/middleware.sx
Normal file
@@ -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))))))
|
||||
Reference in New Issue
Block a user