giles
3b8e1dfe2e
Unblock the guarded blog write routes for browsers: a login form sets a signed session cookie that the same routes accept (alongside Bearer), so publishing works end-to-end on blog.rose-ash.com without Quart. - kernel: http-listen emit serialises a response :set-cookies LIST as one Set-Cookie header each (a headers dict can't hold more than one). Purely additive — responses without :set-cookies are unchanged. - server.sx: host/-dream->native forwards :set-cookies to the native resp. - lib/host/session.sx: durable, signed sessions on the persist KV (session/create|exists|get|set|clear), wired via dream-sessions-signed. - lib/host/auth.sx: GET/POST /login + POST /logout; host/require-user accepts a session principal OR a Bearer token. - router.sx: host/make-app wraps the whole app in the session middleware and auto-mounts /login + /logout — the front door always has sessions. - blog.sx: write routes use host/require-user; serve.sh flips POST /new from the experimental UNGUARDED route to the guarded write routes, with admin creds + signing secret + ACL grant from the container env. - session conformance suite (12): login->cookie->guarded write 201; no cookie/forged/logged-out -> 401; Bearer fallback still works. Verified live on blog.rose-ash.com: 401 unauthenticated, 303 login, 303 publish, anonymous read renders, post persists across container recreate. Co-Authored-By: Claude Opus 4.8 <noreply@anthropic.com>
49 lines
2.6 KiB
Plaintext
49 lines
2.6 KiB
Plaintext
;; lib/host/server.sx — the live wiring: bridge the native OCaml http-listen
|
|
;; server to the Dream-shaped host app, and serve. The native server hands a
|
|
;; handler a STRING-keyed request dict {"method" "path" "query" "headers" "body"}
|
|
;; and expects back {:status :headers :body}. The host app (host/make-app ->
|
|
;; dream-router) is a fn dream-request -> dream-response. This module adapts
|
|
;; between the two shapes and calls http-listen.
|
|
;; Depends on lib/dream/* (dream-request/response accessors) + lib/host/router.sx
|
|
;; + the kernel http-listen primitive.
|
|
|
|
;; ── native request -> dream request ─────────────────────────────────
|
|
;; Reassemble path + query into the target string dream-request parses, and carry
|
|
;; method/headers/body. Missing fields default empty.
|
|
(define host/-native->dream
|
|
(fn (req)
|
|
(let ((path (or (get req "path") "/"))
|
|
(query (or (get req "query") ""))
|
|
(method (or (get req "method") "GET"))
|
|
(headers (or (get req "headers") {}))
|
|
(body (or (get req "body") "")))
|
|
(let ((target (if (> (len query) 0) (str path "?" query) path)))
|
|
(dream-request method target headers body)))))
|
|
|
|
;; ── dream response -> native response ───────────────────────────────
|
|
;; dream-response is already {:body :headers :status}; the native server wants
|
|
;; {:status :headers :body}. Same keys — normalise the shape explicitly so the
|
|
;; contract is visible (and headers/body never nil). :set-cookies is a LIST of
|
|
;; pre-formatted cookie strings (Dream's dream-set-cookie); the kernel http-listen
|
|
;; emit serialises one Set-Cookie header per item (a headers dict can't hold more
|
|
;; than one). Carry it through so sessions/login can set the cookie.
|
|
(define host/-dream->native
|
|
(fn (resp)
|
|
{:status (dream-status resp)
|
|
:headers (or (dream-headers resp) {})
|
|
:set-cookies (dream-resp-cookies resp)
|
|
:body (or (dream-resp-body resp) "")}))
|
|
|
|
;; ── adapter + serve ─────────────────────────────────────────────────
|
|
;; Wrap a Dream app as a native http-listen handler.
|
|
(define host/native-handler
|
|
(fn (app)
|
|
(fn (req)
|
|
(host/-dream->native (app (host/-native->dream req))))))
|
|
|
|
;; Build the app from route groups and start the native server on `port`.
|
|
;; Blocks (the http-listen primitive runs the server loop).
|
|
(define host/serve
|
|
(fn (port groups)
|
|
(http-listen port (host/native-handler (host/make-app groups)))))
|