host: live wiring — native http-listen <-> Dream bridge + serve.sh, 145/145
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 19s
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 19s
lib/host/server.sx adapts the native http-listen contract (string-keyed
{method,path,query,headers,body} -> {:status :headers :body}) to the Dream
host app: native->dream reassembles path+query into a target dream-request
parses; dream->native is near-identity (dream-response is already
{:body :headers :status}). host/serve = http-listen over host/native-handler
. host/make-app. lib/host/serve.sh boots the full module set and serves in the
foreground (container-entry shaped). Verified live on a host port: health/feed/
feed?actor=/relations reads serve real JSON, unknown->404. server suite (13)
covers the bridge as pure functions.
Co-Authored-By: Claude Opus 4.8 <noreply@anthropic.com>
This commit is contained in:
44
lib/host/server.sx
Normal file
44
lib/host/server.sx
Normal file
@@ -0,0 +1,44 @@
|
||||
;; 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).
|
||||
(define host/-dream->native
|
||||
(fn (resp)
|
||||
{:status (dream-status resp)
|
||||
:headers (or (dream-headers 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)))))
|
||||
Reference in New Issue
Block a user