host: live wiring — native http-listen <-> Dream bridge + serve.sh, 145/145

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>

lib/host/conformance.sh

@@ -66,6 +66,7 @@ MODULES=(
   "lib/host/router.sx"
   "lib/host/feed.sx"
   "lib/host/relations.sx"
+  "lib/host/server.sx"
   "lib/host/ledger.sx"
 )
 
@@ -77,6 +78,7 @@ SUITES=(
   "router      host-rt-tests-run!  lib/host/tests/router.sx"
   "feed        host-fd-tests-run!  lib/host/tests/feed.sx"
   "relations   host-rl-tests-run!  lib/host/tests/relations.sx"
+  "server      host-sv-tests-run!  lib/host/tests/server.sx"
   "ledger      host-lg-tests-run!  lib/host/tests/ledger.sx"
 )
 

lib/host/serve.sh

@@ -0,0 +1,85 @@
+#!/usr/bin/env bash
+# host-on-sx live server launcher. Loads the kernel stdlib, the subsystem
+# libraries, and the host modules into one sx_server process, then calls
+# (host/serve PORT ...) which binds the native http-listen server to the
+# Dream-shaped host app. Runs in the FOREGROUND (http-listen blocks), so this
+# doubles as a container entrypoint and a local launcher.
+#
+# Usage:
+#   bash lib/host/serve.sh                 # serve on $HOST_PORT (default 8910)
+#   HOST_PORT=8920 bash lib/host/serve.sh  # pick a port
+#
+# The module list is kept identical to lib/host/conformance.sh so what serves is
+# exactly what the suites verify.
+
+set -uo pipefail
+cd "$(git rev-parse --show-toplevel)"
+
+SX_SERVER="${SX_SERVER:-hosts/ocaml/_build/default/bin/sx_server.exe}"
+if [ ! -x "$SX_SERVER" ]; then
+  SX_SERVER="/root/rose-ash/hosts/ocaml/_build/default/bin/sx_server.exe"
+fi
+if [ ! -x "$SX_SERVER" ]; then
+  echo "ERROR: sx_server.exe not found." >&2
+  exit 1
+fi
+
+PORT="${HOST_PORT:-8910}"
+
+# Modules: every load line from conformance.sh's MODULES list, minus the ledger
+# (not needed to serve). server.sx supplies host/serve.
+MODULES=(
+  "spec/stdlib.sx"
+  "lib/r7rs.sx"
+  "lib/apl/runtime.sx"
+  "lib/datalog/tokenizer.sx"
+  "lib/datalog/parser.sx"
+  "lib/datalog/unify.sx"
+  "lib/datalog/db.sx"
+  "lib/datalog/builtins.sx"
+  "lib/datalog/aggregates.sx"
+  "lib/datalog/strata.sx"
+  "lib/datalog/eval.sx"
+  "lib/datalog/api.sx"
+  "lib/datalog/magic.sx"
+  "lib/acl/schema.sx"
+  "lib/acl/facts.sx"
+  "lib/acl/engine.sx"
+  "lib/acl/explain.sx"
+  "lib/acl/audit.sx"
+  "lib/acl/federation.sx"
+  "lib/acl/api.sx"
+  "lib/relations/schema.sx"
+  "lib/relations/engine.sx"
+  "lib/relations/api.sx"
+  "lib/relations/explain.sx"
+  "lib/relations/federation.sx"
+  "lib/relations/tree.sx"
+  "lib/feed/normalize.sx"
+  "lib/feed/stream.sx"
+  "lib/feed/api.sx"
+  "lib/dream/types.sx"
+  "lib/dream/json.sx"
+  "lib/dream/auth.sx"
+  "lib/dream/error.sx"
+  "lib/dream/router.sx"
+  "lib/host/handler.sx"
+  "lib/host/middleware.sx"
+  "lib/host/sxtp.sx"
+  "lib/host/router.sx"
+  "lib/host/feed.sx"
+  "lib/host/relations.sx"
+  "lib/host/server.sx"
+)
+
+EPOCH=1
+{
+  for M in "${MODULES[@]}"; do
+    echo "(epoch $EPOCH)"; echo "(load \"$M\")"; EPOCH=$((EPOCH+1))
+  done
+  echo "(epoch $EPOCH)"
+  # Anonymous read endpoints: feed timeline + relations container reads. Guarded
+  # write groups (auth/ACL or internal-HMAC) are added here once their injected
+  # policy is supplied at wiring time.
+  echo "(eval \"(host/serve $PORT (list host/feed-routes host/relations-routes))\")"
+} | exec "$SX_SERVER"

lib/host/server.sx

@@ -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)))))

lib/host/tests/server.sx

@@ -0,0 +1,88 @@
+;; lib/host/tests/server.sx — the native<->dream bridge. Pure-function coverage of
+;; host/-native->dream, host/-dream->native, and the host/native-handler adapter
+;; over a real host app (no socket — the http-listen call itself is exercised live
+;; via lib/host/serve.sx, not here).
+
+(define host-sv-pass 0)
+(define host-sv-fail 0)
+(define host-sv-fails (list))
+
+(define
+  host-sv-test
+  (fn
+    (name actual expected)
+    (if
+      (= actual expected)
+      (set! host-sv-pass (+ host-sv-pass 1))
+      (begin
+        (set! host-sv-fail (+ host-sv-fail 1))
+        (append! host-sv-fails {:name name :actual actual :expected expected})))))
+
+(define host-sv-native
+  (fn (method path query body)
+    {"method" method "path" path "query" query "body" body "headers" {}}))
+
+;; ── native request -> dream request ─────────────────────────────────
+(define host-sv-dreq (host/-native->dream (host-sv-native "post" "/feed" "actor=alice" "hi")))
+(host-sv-test "n->d method upcased" (get host-sv-dreq :method) "POST")
+(host-sv-test "n->d path" (get host-sv-dreq :path) "/feed")
+(host-sv-test "n->d query param" (dream-query-param host-sv-dreq "actor") "alice")
+(host-sv-test "n->d body" (get host-sv-dreq :body) "hi")
+;; empty query -> bare path, no trailing "?"
+(host-sv-test
+  "n->d empty query -> bare path"
+  (get (host/-native->dream (host-sv-native "GET" "/health" "" "")) :path)
+  "/health")
+
+;; ── dream response -> native response ───────────────────────────────
+(define host-sv-nresp
+  (host/-dream->native (dream-response 201 {:content-type "application/json"} "{}")))
+(host-sv-test "d->n status" (get host-sv-nresp :status) 201)
+(host-sv-test "d->n body" (get host-sv-nresp :body) "{}")
+(host-sv-test "d->n headers is dict" (= (type-of (get host-sv-nresp :headers)) "dict") true)
+
+;; ── adapter over a real host app ────────────────────────────────────
+(feed/reset!)
+(define host-sv-app (host/native-handler (host/make-app (list host/feed-routes))))
+(host-sv-test
+  "health -> 200"
+  (get (host-sv-app (host-sv-native "GET" "/health" "" "")) :status)
+  200)
+(host-sv-test
+  "health body healthy"
+  (contains? (get (host-sv-app (host-sv-native "GET" "/health" "" "")) :body) "healthy")
+  true)
+(host-sv-test
+  "feed read -> 200"
+  (get (host-sv-app (host-sv-native "GET" "/feed" "" "")) :status)
+  200)
+;; native response shape is exactly {:status :headers :body}
+(host-sv-test
+  "native resp keys"
+  (let ((r (host-sv-app (host-sv-native "GET" "/health" "" ""))))
+    (and (has-key? r :status) (has-key? r :headers) (has-key? r :body)))
+  true)
+
+;; ── relations read through the bridge (end-to-end shape) ────────────
+(relations/load! (list))
+(relations/relate (string->symbol "org:1") (string->symbol "list:7") (string->symbol "member"))
+(define host-sv-rapp (host/native-handler (host/make-app (list host/relations-routes))))
+(host-sv-test
+  "relations read via bridge"
+  (contains?
+    (get
+      (host-sv-rapp
+        (host-sv-native "GET" "/internal/data/get-children"
+          "parent-type=org&parent-id=1&relation-type=member" ""))
+      :body)
+    "list:7")
+  true)
+
+(define
+  host-sv-tests-run!
+  (fn
+    ()
+    {:total (+ host-sv-pass host-sv-fail)
+     :passed host-sv-pass
+     :failed host-sv-fail
+     :fails host-sv-fails}))