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>
93 lines
3.0 KiB
Plaintext
93 lines
3.0 KiB
Plaintext
;; 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))))))
|