host: wire :body into live rendering — composition fold is fold #1, live (roadmap step 2)

A record may carry a :body (a composition node); host/blog-post renders it via the
render-fold (host/comp-render) against a context built from the principal (auth), else the
legacy sx_content path. compose.sx loaded into the host (serve.sh + conformance.sh module
lists). host/blog-body-of / host/blog--set-body!.

Seeded /compose-demo: ONE composition object that shows seq + alt(when auth) + row(par) +
each, and renders DIFFERENTLY by context. Verified live-path (ephemeral SX_SERVING_JIT=1):
anon -> login-prompt (else) + columns + event list; authed -> member block (when auth),
login-prompt gone. The object is the program; the render is the execution -- now live.
Focused eval confirms the in-process render matches the test (ANON<span>..> vs MEMBER<..>).
Tests added; full blog suite still box-contended.

Co-Authored-By: Claude Opus 4.8 <noreply@anthropic.com>

applications/sxtp/spec.sx

@@ -97,6 +97,42 @@
       (:body "Any SX value — event payload (optional)")
       (:time "Number — unix timestamp (optional)"))))
 
+;; ── patch (DOM fragment patch — borrowed from Datastar) ───────────
+;; A server-driven instruction to morph a region of the client DOM.
+;; Subsumes HTMX swap modes; the :body is an SX subtree that the client
+;; renders to DOM nodes before applying the mode at the target.
+(define
+  patch-fields
+  (quote
+    ((:target "String — CSS selector for the element to patch (required)")
+      (:mode "Symbol — patch mode (optional, default outer)")
+      (:body "SX tree — the new content (omitted for mode remove)")
+      (:transition "Boolean — use a view transition (optional, default false)"))))
+
+(define
+  patch-modes
+  (quote
+    ((outer "Replace the target's outerHTML (default; the morph target)")
+      (inner "Replace the target's innerHTML, preserving the wrapper")
+      (replace "Hard-replace without morphing (no diff, plain swap)")
+      (prepend "Insert the body as the target's first child")
+      (append "Insert the body as the target's last child")
+      (before "Insert the body before the target")
+      (after "Insert the body after the target")
+      (remove "Detach the target; :body MUST be absent"))))
+
+;; ── signals (reactive state patch — borrowed from Datastar) ──────
+;; A server-driven update to client-side reactive signals. :values is a
+;; dict of signal-name -> new-value; setting a value to nil REMOVES the
+;; signal. With :only-if-missing true, existing signals are not touched
+;; (use this to lazily initialise signal state without clobbering).
+(define
+  signals-fields
+  (quote
+    ((:values "Dict — signal-name -> new-value (required)")
+      (:only-if-missing
+        "Boolean — only set signals that don't yet exist (optional, default false)"))))
+
 (define
   example-navigate
   (quote
@@ -148,6 +184,23 @@
           :message "No such post"
           :retry false)))))
 
+;; A streaming response intermixing patch + signals: the server pushes
+;; DOM updates AND signal updates over the same channel. The client
+;; dispatches each message by its head symbol; ordering is preserved.
+(define
+  example-patch-stream
+  (quote
+    ((request :verb subscribe :path "/cart/live" :capabilities (fetch))
+      (response :status ok :stream true)
+      (signals :values {:cart/count 3 :cart/loading false})
+      (patch
+        :target "#cart-mini"
+        :mode outer
+        :body (~cart-mini :count 3 :total 47.50))
+      (patch :target "#flash" :mode inner :body (p "Item added."))
+      (signals :values {:cart/loading true})
+      (patch :target "#cart-loading-spinner" :mode remove))))
+
 (define
   example-inspect
   (quote

docker-compose.dev-sx-host.yml

@@ -0,0 +1,58 @@
+# host-on-sx live service — the SX web host (lib/host) served by the native
+# http-listen server via lib/host/serve.sh. Joins the sx-dev project + externalnet
+# so Caddy can reverse_proxy a subdomain to it (blog.rose-ash.com). Isolated from
+# the sx_docs server: separate container, separate port.
+#
+# Usage:
+#   docker compose -p sx-dev -f docker-compose.dev-sx-host.yml up -d sx_host
+#   docker compose -p sx-dev -f docker-compose.dev-sx-host.yml logs -f sx_host
+#   docker compose -p sx-dev -f docker-compose.dev-sx-host.yml down
+
+services:
+  sx_host:
+    image: registry.rose-ash.com:5000/sx_docs:latest
+    container_name: sx-dev-sx_host-1
+    entrypoint: ["bash", "/app/lib/host/serve.sh"]
+    working_dir: /app
+    environment:
+      SX_PROJECT_DIR: /app
+      SX_SERVER: /app/bin/sx_server
+      HOST_PORT: "8000"
+      # Bind all interfaces so Caddy (on externalnet) can reach it.
+      SX_HTTP_HOST: "0.0.0.0"
+      # Durable persist store root — on a named volume so data survives restarts.
+      SX_PERSIST_DIR: /data/persist
+      # Blog write auth: admin login + session-cookie signing secret. The blog
+      # write routes (POST /new, POST/PUT/DELETE /posts) are guarded by a session
+      # login or Bearer token, so these gate publishing. Not a real site — these
+      # are demo creds; rotate by editing here and recreating the container.
+      SX_ADMIN_USER: admin
+      SX_ADMIN_PASSWORD: "sx-host-camper-van-2026"
+      SX_SESSION_SECRET: "ra-host-sess-7c1f9b3e2a8d4056"
+      # Serving-mode JIT: bytecode-compile hot SX (esp. the Datalog/relations path)
+      # on the epoch serving channel. Validated: host conformance 271/271 under JIT,
+      # 5.4x faster (1m43s -> 19s). Default-OFF gate, opt in here.
+      SX_SERVING_JIT: "1"
+      OCAMLRUNPARAM: "b"
+    volumes:
+      # SX source (hot-reload on container restart)
+      - ./spec:/app/spec:ro
+      - ./lib:/app/lib:ro
+      - ./web:/app/web:ro
+      # Client assets for the blog SPA: the WASM OCaml kernel + sx-platform + the
+      # web-stack modules, served by lib/host/static.sx at /static/**.
+      - ./shared/static:/app/shared/static:ro
+      # OCaml server binary — this worktree's build (has the SX_HTTP_HOST bind fix)
+      - ./hosts/ocaml/_build/default/bin/sx_server.exe:/app/bin/sx_server:ro
+      # Durable persist store (the SX op-log/kv on disk) — survives restarts.
+      # Host dir, chowned to the image's appuser (uid 10001) so the non-root
+      # server can write: sudo mkdir -p /root/sx-host-persist && sudo chown 10001:10001 /root/sx-host-persist
+      - /root/sx-host-persist:/data/persist
+    networks:
+      - externalnet
+      - default
+    restart: unless-stopped
+
+networks:
+  externalnet:
+    external: true

hosts/ocaml/bin/dune

@@ -1,5 +1,5 @@
 (executables
- (names run_tests debug_set sx_server integration_tests bench_cek bench_inspect bench_vm)
+ (names run_tests debug_set sx_server integration_tests bench_cek bench_inspect bench_vm repro_jit_resume)
  (libraries sx unix threads.posix otfm yojson))
 
 (executable

hosts/ocaml/bin/integration_tests.ml

@@ -263,7 +263,7 @@ let make_integration_env () =
 
   (* Type predicates — needed by adapter-sx.sx *)
   bind "callable?" (fun args ->
-    match args with [NativeFn _] | [Lambda _] | [Component _] | [Island _] -> Bool true | _ -> Bool false);
+    match args with [NativeFn _] | [Lambda _] | [Component _] | [Island _] | [VmClosure _] -> Bool true | _ -> Bool false);
   bind "lambda?" (fun args -> match args with [Lambda _] -> Bool true | _ -> Bool false);
   bind "macro?" (fun args -> match args with [Macro _] -> Bool true | _ -> Bool false);
   bind "island?" (fun args -> match args with [Island _] -> Bool true | _ -> Bool false);

hosts/ocaml/bin/mcp_tree.ml

@@ -477,7 +477,7 @@ let setup_env () =
   bind "number?" (fun args -> match args with
     | [Number _] -> Bool true | _ -> Bool false);
   bind "callable?" (fun args -> match args with
-    | [NativeFn _ | Lambda _ | Component _ | Island _] -> Bool true | _ -> Bool false);
+    | [NativeFn _ | Lambda _ | Component _ | Island _ | VmClosure _] -> Bool true | _ -> Bool false);
   bind "empty?" (fun args -> match args with
     | [List []] | [ListRef { contents = [] }] -> Bool true
     | [Nil] -> Bool true | _ -> Bool false);

hosts/ocaml/bin/repro_jit_resume.ml

@@ -0,0 +1,202 @@
+(* Surgical repro for the serving-JIT OP_PERFORM/resume stack misalignment.
+   Mirrors what register_jit_hook's resolve_loop does: call_closure, catch
+   VmSuspended, resolve IO (return Nil), resume_vm — looping on re-suspend.
+   No CEK evaluator needed for the direct/multi-frame/reuse paths. *)
+
+open Sx_types
+
+let req_dict () =
+  let h = Hashtbl.create 1 in
+  Hashtbl.replace h "op" (String "noop");
+  Dict h
+
+(* Mirror the serving hook's resolve loop exactly. *)
+let drive cl =
+  let globals = cl.vm_closure_env |> ignore; cl.vm_env_ref in
+  let rec resolve_loop req vm =
+    let _ = req in
+    (try Sx_vm.resume_vm vm Nil
+     with Sx_vm.VmSuspended (r2, v2) -> resolve_loop r2 v2)
+  in
+  try Sx_vm.call_closure cl [] globals
+  with Sx_vm.VmSuspended (req, vm) -> resolve_loop req vm
+
+let mk_code ~locals ~bc ~consts = {
+  vc_arity = 0; vc_rest_arity = -1; vc_locals = locals;
+  vc_bytecode = Array.of_list bc;
+  vc_constants = Array.of_list consts;
+  vc_bytecode_list = None; vc_constants_list = None;
+}
+
+let mk_cl ?(name="tf") ?(env=Hashtbl.create 64) code =
+  { vm_code = code; vm_upvalues = [||]; vm_name = Some name;
+    vm_env_ref = env; vm_closure_env = None }
+
+let report label v =
+  Printf.printf "%-28s => %s\n%!" label (Sx_runtime.value_to_str v)
+
+let run label f =
+  (try report label (f ())
+   with
+   | Eval_error m -> Printf.printf "%-28s => ERROR: %s\n%!" label m
+   | e -> Printf.printf "%-28s => EXN: %s\n%!" label (Printexc.to_string e))
+
+(* opcodes *)
+let _const i = [1; i land 0xff; (i lsr 8) land 0xff]
+let _perform = [112]
+let _pop = [5]
+let _call_prim idx argc = [52; idx land 0xff; (idx lsr 8) land 0xff; argc]
+let _call argc = [48; argc]
+let _return = [50]
+
+let () =
+  (* Serving mode: a synchronous IO resolver is installed (mirrors
+     sx_server's http setup). Our mock resolves every request to Nil. *)
+  Sx_types._cek_io_resolver := Some (fun _req _ -> Nil);
+
+  (* Case 1: direct OP_PERFORM then a list prim in the SAME frame.
+     (do (perform {..}) (rest (list 1 2 3)))  =>  (2 3) *)
+  run "1.direct perform→rest" (fun () ->
+    let consts = [ req_dict (); List [Number 1.; Number 2.; Number 3.]; String "rest" ] in
+    let bc = _const 0 @ _perform @ _pop @ _const 1 @ _call_prim 2 1 @ _return in
+    drive (mk_cl (mk_code ~locals:0 ~bc ~consts)));
+
+  (* Case 2: direct perform then map (2-arg prim).
+     (do (perform {..}) (map inc (list 1 2 3)))  — needs a fn; use a NativeFn const *)
+  run "2.direct perform→map" (fun () ->
+    let inc = NativeFn ("inc1", function [Number n] -> Number (n +. 1.) | _ -> Nil) in
+    let consts = [ req_dict (); inc; List [Number 1.; Number 2.; Number 3.]; String "map" ] in
+    (* push fn, push list, CALL_PRIM map 2 *)
+    let bc = _const 0 @ _perform @ _pop @ _const 1 @ _const 2 @ _call_prim 3 2 @ _return in
+    drive (mk_cl (mk_code ~locals:0 ~bc ~consts)));
+
+  (* Case 3: multi-frame — outer calls a JIT'd helper that performs, THEN outer maps.
+     helper: (do (perform {..}) 99)
+     outer:  (do (helper) (map inc (list 1 2 3))) *)
+  run "3.multiframe perform→map" (fun () ->
+    let env = Hashtbl.create 64 in
+    let helper_code = mk_code ~locals:0
+      ~bc:(_const 0 @ _perform @ _pop @ _const 1 @ _return)
+      ~consts:[ req_dict (); Number 99. ] in
+    let helper_cl = mk_cl ~name:"helper" ~env helper_code in
+    let inc = NativeFn ("inc1", function [Number n] -> Number (n +. 1.) | _ -> Nil) in
+    let consts = [ VmClosure helper_cl; inc; List [Number 1.; Number 2.; Number 3.]; String "map" ] in
+    (* push helper-closure, CALL 0, POP its result, push inc, push list, CALL_PRIM map 2 *)
+    let bc = _const 0 @ _call 0 @ _pop @ _const 1 @ _const 2 @ _call_prim 3 2 @ _return in
+    drive (mk_cl ~name:"outer" ~env (mk_code ~locals:0 ~bc ~consts)));
+
+  (* Case 4: map whose CALLBACK performs (reuse_stack path), then a trailing prim.
+     callback: (do (perform {..}) (inc e))   — but callback gets arg e in slot 0
+     outer: (do (map cb (list 1 2 3)) (rest (list 7 8 9)))  *)
+  run "4.map-callback-perform" (fun () ->
+    let env = Hashtbl.create 64 in
+    (* callback arity 1: slot0 = e. body: (perform {..}); (inc e) ; return
+       LOCAL_GET 0 then CALL_PRIM inc... use NativeFn inc via CALL_PRIM *)
+    let cb_code = {
+      vc_arity = 1; vc_rest_arity = -1; vc_locals = 1;
+      vc_bytecode = Array.of_list (_const 0 @ _perform @ _pop
+                                   @ [16;0] (* LOCAL_GET 0 *)
+                                   @ _call_prim 1 1 @ _return);
+      vc_constants = [| req_dict (); String "inc" |];
+      vc_bytecode_list = None; vc_constants_list = None } in
+    let cb_cl = mk_cl ~name:"cb" ~env cb_code in
+    let consts = [ VmClosure cb_cl; List [Number 1.; Number 2.; Number 3.]; String "map";
+                   List [Number 7.; Number 8.; Number 9.]; String "rest" ] in
+    (* push cb, push list, CALL_PRIM map 2, POP, push list2, CALL_PRIM rest 1, RETURN *)
+    let bc = _const 0 @ _const 1 @ _call_prim 2 2 @ _pop @ _const 3 @ _call_prim 4 1 @ _return in
+    drive (mk_cl ~name:"outer4" ~env (mk_code ~locals:0 ~bc ~consts)));
+
+  (* Case 5: THE HOST CASE — perform via an INTERPRETED helper (pending_cek path),
+     then a list prim. helper is a Lambda (l_compiled = jit_failed) whose body
+     performs; vm_call routes it through cek_call_or_suspend → pending_cek.
+       helper: (perform {..})  [interpreted via CEK]
+       outer:  (do (helper) (rest (list 1 2 3)))  => (2 3) *)
+  run "5.pending_cek perform→rest" (fun () ->
+    let env = Sx_types.make_env () in
+    let helper = Lambda {
+      l_params = []; l_body = List [Symbol "perform"; req_dict ()];
+      l_closure = env; l_name = Some "kvread";
+      l_compiled = Some Sx_vm.jit_failed_sentinel; l_call_count = 0;
+      l_uid = Sx_types.next_lambda_uid () } in
+    let consts = [ helper; List [Number 1.; Number 2.; Number 3.]; String "rest" ] in
+    (* push helper, CALL 0, POP, push list, CALL_PRIM rest 1, RETURN *)
+    let bc = _const 0 @ _call 0 @ _pop @ _const 1 @ _call_prim 2 1 @ _return in
+    drive (mk_cl ~name:"outer5" ~env:(Hashtbl.create 64) (mk_code ~locals:0 ~bc ~consts)));
+
+  (* Case 6: pending_cek perform → MAP (2-arg), the exact host shape. *)
+  run "6.pending_cek perform→map" (fun () ->
+    let env = Sx_types.make_env () in
+    let helper = Lambda {
+      l_params = []; l_body = List [Symbol "perform"; req_dict ()];
+      l_closure = env; l_name = Some "kvread";
+      l_compiled = Some Sx_vm.jit_failed_sentinel; l_call_count = 0;
+      l_uid = Sx_types.next_lambda_uid () } in
+    let inc = NativeFn ("inc1", function [Number n] -> Number (n +. 1.) | _ -> Nil) in
+    let consts = [ helper; inc; List [Number 1.; Number 2.; Number 3.]; String "map" ] in
+    (* push helper, CALL 0, POP, push inc, push list, CALL_PRIM map 2, RETURN *)
+    let bc = _const 0 @ _call 0 @ _pop @ _const 1 @ _const 2 @ _call_prim 3 2 @ _return in
+    drive (mk_cl ~name:"outer6" ~env:(Hashtbl.create 64) (mk_code ~locals:0 ~bc ~consts)));
+
+  (* Case 7: THE HOST SHAPE — map whose callback calls an INTERPRETED helper
+     that performs (kv read via persist helper inside a map), THEN a trailing
+     prim. callback(e): (do (kvread) e)  — kvread suspends via pending_cek.
+     outer: (do (map cb (list 1 2 3)) (drop (list 5 6 7 8) 2)) => (7 8) *)
+  run "7.HOST: map[cb→helper perform]→drop" (fun () ->
+    let genv = Sx_types.make_env () in
+    let helper = Lambda {
+      l_params = []; l_body = List [Symbol "perform"; req_dict ()];
+      l_closure = genv; l_name = Some "kvread";
+      l_compiled = Some Sx_vm.jit_failed_sentinel; l_call_count = 0;
+      l_uid = Sx_types.next_lambda_uid () } in
+    let env = Hashtbl.create 64 in
+    (* cb(e): push helper, CALL 0, POP, LOCAL_GET 0, RETURN *)
+    let cb_code = {
+      vc_arity = 1; vc_rest_arity = -1; vc_locals = 1;
+      vc_bytecode = Array.of_list (_const 0 @ _call 0 @ _pop @ [16;0] @ _return);
+      vc_constants = [| helper |]; vc_bytecode_list=None; vc_constants_list=None } in
+    let cb_cl = mk_cl ~name:"cb7" ~env cb_code in
+    let consts = [ VmClosure cb_cl; List [Number 1.; Number 2.; Number 3.]; String "map";
+                   List [Number 5.; Number 6.; Number 7.; Number 8.]; Number 2.; String "drop" ] in
+    (* push cb, push list, CALL_PRIM map 2, POP, push list2, push 2, CALL_PRIM drop 2, RETURN *)
+    let bc = _const 0 @ _const 1 @ _call_prim 2 2 @ _pop
+             @ _const 3 @ _const 4 @ _call_prim 5 2 @ _return in
+    drive (mk_cl ~name:"outer7" ~env (mk_code ~locals:0 ~bc ~consts)));
+
+  (* Case 8: reduce whose callback performs. (reduce + 0 (list 1 2 3)) with a
+     perform in the reducer => 6 *)
+  run "8.reduce[acc→perform]" (fun () ->
+    let env = Hashtbl.create 64 in
+    (* reducer(acc e): (do (perform {..}) (+ acc e)). slots: 0=acc 1=e *)
+    let rd_code = {
+      vc_arity = 2; vc_rest_arity = -1; vc_locals = 2;
+      vc_bytecode = Array.of_list (_const 0 @ _perform @ _pop
+                                   @ [16;0] @ [16;1] @ _call_prim 1 2 @ _return);
+      vc_constants = [| req_dict (); String "+" |];
+      vc_bytecode_list=None; vc_constants_list=None } in
+    let rd_cl = mk_cl ~name:"rd" ~env rd_code in
+    let consts = [ VmClosure rd_cl; Number 0.; List [Number 1.; Number 2.; Number 3.]; String "reduce" ] in
+    (* push reducer, push 0, push list, CALL_PRIM reduce 3, RETURN *)
+    let bc = _const 0 @ _const 1 @ _const 2 @ _call_prim 3 3 @ _return in
+    drive (mk_cl ~name:"outer8" ~env (mk_code ~locals:0 ~bc ~consts)));
+
+  (* Case 9: nested map — outer map callback runs an inner map whose callback
+     performs. outer over (list 1 2), inner over (list 10 20) performing.
+     cb_outer(x): (map cb_inner (list 10 20)) ; cb_inner(y): (do (perform) y)
+     => ((10 20) (10 20)) *)
+  run "9.nested map[inner→perform]" (fun () ->
+    let env = Hashtbl.create 64 in
+    let inner_code = {
+      vc_arity = 1; vc_rest_arity = -1; vc_locals = 1;
+      vc_bytecode = Array.of_list (_const 0 @ _perform @ _pop @ [16;0] @ _return);
+      vc_constants = [| req_dict () |]; vc_bytecode_list=None; vc_constants_list=None } in
+    let inner_cl = mk_cl ~name:"cbin" ~env inner_code in
+    (* outer cb(x): push inner_cl, push (10 20), CALL_PRIM map 2, RETURN *)
+    let outer_cb_code = {
+      vc_arity = 1; vc_rest_arity = -1; vc_locals = 1;
+      vc_bytecode = Array.of_list (_const 0 @ _const 1 @ _call_prim 2 2 @ _return);
+      vc_constants = [| VmClosure inner_cl; List [Number 10.; Number 20.]; String "map" |];
+      vc_bytecode_list=None; vc_constants_list=None } in
+    let outer_cb_cl = mk_cl ~name:"cbout" ~env outer_cb_code in
+    let consts = [ VmClosure outer_cb_cl; List [Number 1.; Number 2.]; String "map" ] in
+    let bc = _const 0 @ _const 1 @ _call_prim 2 2 @ _return in
+    drive (mk_cl ~name:"outer9" ~env (mk_code ~locals:0 ~bc ~consts)))

hosts/ocaml/bin/run_tests.ml

@@ -595,7 +595,7 @@ let make_test_env () =
   (* regex-find-all now provided by sx_primitives.ml *)
   bind "callable?" (fun args ->
     match args with
-    | [NativeFn _] | [Lambda _] | [Component _] | [Island _] -> Bool true
+    | [NativeFn _] | [Lambda _] | [Component _] | [Island _] | [VmClosure _] -> Bool true
     | _ -> Bool false);
   bind "make-sx-expr" (fun args -> match args with [String s] -> SxExpr s | _ -> raise (Eval_error "make-sx-expr: expected string"));
   bind "sx-expr-source" (fun args -> match args with [SxExpr s] -> String s | [String s] -> String s | _ -> raise (Eval_error "sx-expr-source: expected sx-expr or string"));
@@ -2812,10 +2812,13 @@ let run_spec_tests env test_files =
               | "insertAdjacentHTML" | "prepend" | "showModal" | "show" | "close"
               | "getBoundingClientRect" | "getAnimations" | "scrollIntoView"
               | "scrollTo" | "scroll" | "reset" -> Bool true
-              | "firstElementChild" ->
+              | "firstElementChild" | "firstChild" ->
+                (* the mock treats element children and child nodes alike, so
+                   firstChild == firstElementChild — children-to-fragment walks
+                   firstChild to drain a parsed fragment into a swap target. *)
                 let kids = match Hashtbl.find_opt d "children" with Some (List l) -> l | _ -> [] in
                 (match kids with c :: _ -> c | [] -> Nil)
-              | "lastElementChild" ->
+              | "lastElementChild" | "lastChild" ->
                 let kids = match Hashtbl.find_opt d "children" with Some (List l) -> l | _ -> [] in
                 (match List.rev kids with c :: _ -> c | [] -> Nil)
               | "nextElementSibling" | "nextSibling" ->
@@ -2961,6 +2964,15 @@ let run_spec_tests env test_files =
        | "setTimeout" -> (match rest with fn :: _ -> ignore (Sx_ref.cek_call fn (List [])); Nil | _ -> Nil)
        | "clearTimeout" -> Nil
        | _ -> Nil)
+    (* NodeList.item(i) — dom-query-all iterates the querySelectorAll result
+       (a bare List) via this method, exactly like a browser NodeList. *)
+    | (List _ | ListRef _) :: String "item" :: [idx] ->
+      let items = match args with
+        | List l :: _ -> l
+        | ListRef { contents = l } :: _ -> l
+        | _ -> [] in
+      let i = match idx with Number n -> int_of_float n | Integer n -> n | _ -> -1 in
+      if i >= 0 && i < List.length items then List.nth items i else Nil
     | Dict d :: String "hasOwnProperty" :: [String k] ->
       Bool (Hashtbl.mem d k)
     | Dict d :: String m :: rest ->
@@ -3070,6 +3082,26 @@ let run_spec_tests env test_files =
         (* console.log/debug/error — no-op in tests *)
         Nil
 
+      else if mt = "domparser" then
+        (* DOMParser.parseFromString(text, "text/html") — returns a mock
+           document whose <body> is parsed from `text`. An empty string yields
+           a valid empty document (truthy), matching the browser: that's what
+           the engine's handle-html-response relies on for an empty-body
+           sx-swap="delete" response. *)
+        (match m with
+         | "parseFromString" ->
+           let text = match rest with String t :: _ -> t | _ -> "" in
+           let bd = match make_mock_element "body" with Dict d -> d | _ -> Hashtbl.create 0 in
+           Hashtbl.replace bd "tagName" (String "BODY");
+           Hashtbl.replace bd "nodeName" (String "BODY");
+           parse_html_into bd text;
+           Hashtbl.replace bd "innerHTML" (String text);
+           let doc = Hashtbl.create 4 in
+           Hashtbl.replace doc "__mock_type" (String "document");
+           Hashtbl.replace doc "body" (Dict bd);
+           Dict doc
+         | _ -> Nil)
+
       else
         (* Element methods *)
         (match m with
@@ -3483,6 +3515,10 @@ let run_spec_tests env test_files =
       Dict ev
     | [String "Object"] ->
       Dict (Hashtbl.create 4)
+    | [String "DOMParser"] ->
+      let d = Hashtbl.create 4 in
+      Hashtbl.replace d "__mock_type" (String "domparser");
+      Dict d
     | _ -> Nil);
 
   reg "host-callback" (fun args ->
@@ -3660,6 +3696,7 @@ let run_spec_tests env test_files =
   load_module "router.sx" web_dir;
   load_module "deps.sx" web_dir;
   load_module "orchestration.sx" web_dir;
+  load_module "console-render.sx" web_dir;
   (* Library modules for lib/tests/ *)
   load_module "bytecode.sx" lib_dir;
   load_module "compiler.sx" lib_dir;

hosts/ocaml/bin/sx_server.ml

@@ -32,6 +32,14 @@ let () = ignore (Sx_vm_extensions.id_of_name "")
    which we swallow so a re-entered server process doesn't die. *)
 let () = try Erlang_ext.register () with Failure _ -> ()
 
+(* Ignore SIGPIPE: a client that closes its connection mid-response (a browser
+   aborting an in-flight fetch — the SX engine cancels superseded requests on a
+   debounced filter or a fast nav) must NOT kill the server. SIGPIPE's default
+   action terminates the process before any exception is raised; ignoring it
+   turns the failed write into a catchable Sys_error (EPIPE), which the
+   per-connection handler already swallows, dropping just that one connection. *)
+let () = try Sys.set_signal Sys.sigpipe Sys.Signal_ignore with _ -> ()
+
 (* ====================================================================== *)
 (* Font measurement via otfm — reads OpenType/TrueType font tables         *)
 (* ====================================================================== *)
@@ -522,9 +530,61 @@ let rec load_library_file path =
       Printf.eprintf "[load-library] %s: %s\n%!" (Filename.basename path) msg
   ) exprs
 
-(** IO-aware CEK run — handles suspension by dispatching IO requests.
-    Import requests are handled locally (load .sx file).
-    Other IO requests are sent to the Python bridge. *)
+(* IO-aware CEK run (cek_run_with_io, below) — handles suspension by dispatching
+   IO requests. Import requests are handled locally (load .sx file). *)
+(** Resolve a single IO request value to its response. Shared by
+    cek_run_with_io's suspension loop AND the _cek_io_resolver installed for the
+    http-listen serving path, so the synchronous inline-resolve path (sx_vm.ml's
+    HO-callback suspend fix) resolves durable reads byte-identically to the
+    CEK-driven path. Without an installed resolver, a `perform` inside an HO
+    primitive callback (map/filter/…) unwinds the native loop and corrupts the
+    stack — the host's map/rest/drop serving-JIT miscompile. *)
+and resolve_io_request request =
+  let op = match Sx_runtime.get_val request (String "op") with String s -> s | _ -> "" in
+  (match op with
+   | "import" ->
+     (* Resolve library locally — load the .sx file *)
+     let lib_spec = Sx_runtime.get_val request (String "library") in
+     (* library_loaded_p takes the library SPEC and computes the key itself —
+        passing an already-computed key string double-applies library_name_key
+        and crashes (sx_to_list on a string). *)
+     if Sx_types.sx_truthy (Sx_ref.library_loaded_p lib_spec) then
+       (* Already loaded — just resume *)
+       Nil
+     else begin
+       (match resolve_library_path lib_spec with
+        | Some path -> load_library_file path
+        | None ->
+          Printf.eprintf "[import] WARNING: no file for library %s\n%!"
+            (Sx_runtime.value_to_str lib_spec));
+       Nil
+     end
+   | "text-measure" ->
+     let args = let a = Sx_runtime.get_val request (String "args") in
+       (match a with List l -> l | _ -> [a]) in
+     let font = match args with String f :: _ -> f | _ -> "serif" in
+     let size = match args with
+       | [_font; Number sz; _text] -> sz
+       | [_font; Number sz] -> sz
+       | _ -> 16.0 in
+     let text = match args with
+       | [_font; _sz; String t] -> t
+       | _ -> "" in
+     let (w, h, asc, desc) = measure_text_otfm font size text in
+     let d = Hashtbl.create 4 in
+     Hashtbl.replace d "width" (Number w);
+     Hashtbl.replace d "height" (Number h);
+     Hashtbl.replace d "ascent" (Number asc);
+     Hashtbl.replace d "descent" (Number desc);
+     Dict d
+   | _ ->
+     let argsv = Sx_runtime.get_val request (String "args") in
+     (match Sx_persist_store.handle_op op argsv with
+      | Some resp -> resp
+      | None ->
+        let args = (match argsv with List l -> l | _ -> [argsv]) in
+        io_request op args))
+
 and cek_run_with_io state =
   let s = ref state in
   let is_terminal s = match Sx_ref.cek_terminal_p s with Bool true -> true | _ -> false in
@@ -535,49 +595,7 @@ and cek_run_with_io state =
     done;
     if is_suspended !s then begin
       let request = Sx_runtime.get_val !s (String "request") in
-      let op = match Sx_runtime.get_val request (String "op") with String s -> s | _ -> "" in
-      let response = match op with
-        | "import" ->
-          (* Resolve library locally — load the .sx file *)
-          let lib_spec = Sx_runtime.get_val request (String "library") in
-          let key = Sx_ref.library_name_key lib_spec in
-          if Sx_types.sx_truthy (Sx_ref.library_loaded_p key) then
-            (* Already loaded — just resume *)
-            Nil
-          else begin
-            (match resolve_library_path lib_spec with
-             | Some path -> load_library_file path
-             | None ->
-               Printf.eprintf "[import] WARNING: no file for library %s\n%!"
-                 (Sx_runtime.value_to_str lib_spec));
-            Nil
-          end
-        | "text-measure" ->
-          let args = let a = Sx_runtime.get_val request (String "args") in
-            (match a with List l -> l | _ -> [a]) in
-          let font = match args with String f :: _ -> f | _ -> "serif" in
-          let size = match args with
-            | [_font; Number sz; _text] -> sz
-            | [_font; Number sz] -> sz
-            | _ -> 16.0 in
-          let text = match args with
-            | [_font; _sz; String t] -> t
-            | _ -> "" in
-          let (w, h, asc, desc) = measure_text_otfm font size text in
-          let d = Hashtbl.create 4 in
-          Hashtbl.replace d "width" (Number w);
-          Hashtbl.replace d "height" (Number h);
-          Hashtbl.replace d "ascent" (Number asc);
-          Hashtbl.replace d "descent" (Number desc);
-          Dict d
-        | _ ->
-          let argsv = Sx_runtime.get_val request (String "args") in
-          (match Sx_persist_store.handle_op op argsv with
-           | Some resp -> resp
-           | None ->
-             let args = (match argsv with List l -> l | _ -> [argsv]) in
-             io_request op args)
-      in
+      let response = resolve_io_request request in
       s := Sx_ref.cek_resume !s response;
       loop ()
     end else
@@ -745,9 +763,27 @@ let setup_evaluator_bridge env =
         | _ -> raise (Eval_error "http-listen: (port handler)") in
       let sock = Unix.socket Unix.PF_INET Unix.SOCK_STREAM 0 in
       Unix.setsockopt sock Unix.SO_REUSEADDR true;
+      (* Bind host: loopback by default (safe for tests + local runs); set
+         SX_HTTP_HOST=0.0.0.0 to expose on the network (container/Caddy). *)
+      let bind_addr =
+        match Sys.getenv_opt "SX_HTTP_HOST" with
+        | Some h -> (try Unix.inet_addr_of_string h
+                     with _ -> Unix.inet_addr_loopback)
+        | None -> Unix.inet_addr_loopback in
       Unix.bind sock
-        (Unix.ADDR_INET (Unix.inet_addr_loopback, port));
+        (Unix.ADDR_INET (bind_addr, port));
       Unix.listen sock 64;
+      (* Install the synchronous IO resolver for the serving path. Without it, a
+         `perform` (durable kv read) that fires inside an HO-primitive callback
+         (map/filter/reduce/…) during request handling suspends through the
+         native OCaml loop, dropping its iteration state and leaving the stack
+         misaligned — the serving-JIT host miscompile (map/rest/drop wrong args,
+         blank pages, empty picker). With a resolver installed, sx_vm.ml resolves
+         that callback's IO inline (byte-identically to cek_run_with_io) and the
+         loop is never unwound. Only set if one isn't already installed. *)
+      (if !Sx_types._cek_io_resolver = None then
+         Sx_types._cek_io_resolver :=
+           Some (fun request _state -> resolve_io_request request));
       (* SX runtime is shared across threads — serialize handler calls. *)
       let mtx = Mutex.create () in
       let reason = function
@@ -807,9 +843,31 @@ let setup_evaluator_bridge env =
              Hashtbl.replace req "body" (String body);
              Mutex.lock mtx;
              let resp =
-               (try Sx_runtime.sx_call handler [Dict req]
-                with e -> Mutex.unlock mtx; raise e) in
-             Mutex.unlock mtx;
+               (* Run the handler through the IO-aware CEK runner (not bare
+                  sx_call) so request handlers can perform per-request IO —
+                  durable store reads/writes resolve via cek_run_with_io's
+                  suspension loop instead of returning an unresolved suspension.
+                  On ANY handler exception, synthesise a 500 response rather than
+                  letting it escape: an escaped exception drops the connection
+                  with no bytes written, which a reverse proxy (Caddy/Cloudflare)
+                  surfaces as a 502 error page. A real 500 keeps the origin
+                  responsive and debuggable. Note: a native exception (e.g. the
+                  parser's Parse_error) cannot be caught by an SX (guard ...), so
+                  this boundary is the only place it can be trapped. *)
+               (try
+                  let st = Sx_ref.continue_with_call handler
+                             (List [Dict req]) (Env (Sx_types.make_env ()))
+                             (List [Dict req]) (List []) in
+                  let r = cek_run_with_io st in
+                  Mutex.unlock mtx; r
+                with e ->
+                  Mutex.unlock mtx;
+                  Printf.eprintf "[http-listen] handler error: %s\n%!"
+                    (Printexc.to_string e);
+                  let d = Sx_types.make_dict () in
+                  Hashtbl.replace d "status" (Integer 500);
+                  Hashtbl.replace d "body" (String "Internal Server Error");
+                  Dict d) in
              let getk k = match resp with
                | Dict h -> Hashtbl.find_opt h k | _ -> None in
              let status = match getk "status" with
@@ -835,6 +893,18 @@ let setup_evaluator_bridge env =
              List.iter (fun (k, v) ->
                Buffer.add_string buf
                  (Printf.sprintf "%s: %s\r\n" k v)) rhdrs;
+             (* Cookies: a response carries :set-cookies as a LIST of pre-formatted
+                cookie strings (Dream's dream-set-cookie), because a headers Dict
+                cannot hold more than one Set-Cookie. Emit one header per item. *)
+             (match getk "set-cookies" with
+              | Some (List items) ->
+                List.iter (fun v ->
+                  match v with
+                  | String s ->
+                    Buffer.add_string buf
+                      (Printf.sprintf "Set-Cookie: %s\r\n" s)
+                  | _ -> ()) items
+              | _ -> ());
              if not (List.exists
                        (fun (k, _) ->
                           String.lowercase_ascii k = "content-type")
@@ -1097,7 +1167,11 @@ let setup_introspection env =
   bind "component?" (fun args ->
     match args with [Component _] | [Island _] -> Bool true | _ -> Bool false);
   bind "callable?" (fun args ->
-    match args with [NativeFn _] | [Lambda _] | [Component _] | [Island _] -> Bool true | _ -> Bool false);
+    (* VmClosure must count as callable: a JIT-compiled higher-order function
+       returns its inner closure as a VmClosure, and downstream code (e.g.
+       scheme-apply's `(callable? proc)` guard) must recognize it — it is
+       invocable via the normal call path. *)
+    match args with [NativeFn _] | [Lambda _] | [Component _] | [Island _] | [VmClosure _] -> Bool true | _ -> Bool false);
   bind "spread?" (fun args -> match args with [Spread _] -> Bool true | _ -> Bool false);
   bind "continuation?" (fun args ->
     match args with [Continuation _] -> Bool true | [_] -> Bool false | _ -> Bool false);
@@ -1223,6 +1297,20 @@ let setup_type_constructors env =
       (* Already a value — return as-is *)
       v
     | _ -> raise (Eval_error "parse: expected string"));
+  (* Like parse, but returns nil instead of raising on malformed input. The
+     parser raises a native Parse_error that an SX-level (guard ...) cannot catch
+     (guard only traps SX conditions, not host exceptions), so code that handles
+     untrusted text — e.g. a stored post body — needs a value-returning parse to
+     degrade gracefully rather than crash the request. *)
+  bind "parse-safe" (fun args ->
+    match args with
+    | [String s] | [SxExpr s] ->
+      (try
+         let exprs = Sx_parser.parse_all s in
+         (match exprs with [e] -> e | _ -> List exprs)
+       with _ -> Nil)
+    | [v] -> v
+    | _ -> Nil);
   (* Native bytecode compiler — bootstrapped from lib/compiler.sx *)
   bind "compile" (fun args ->
     match args with [expr] -> Sx_compiler.compile expr | _ -> Nil);
@@ -1468,6 +1556,22 @@ let sx_render_to_html expr env =
 
 let _jit_warned : (string, bool) Hashtbl.t = Hashtbl.create 16
 
+(* Bisection aid: env-var-driven JIT filter. Lets us narrow which named
+   lambda the VM miscompiles without rebuilding.
+   SX_JIT_DENY=name1,name2  — never JIT these (substring match on exact name).
+   SX_JIT_ONLY=name1,name2  — JIT ONLY these (exact name); skip all others. *)
+let _jit_deny_set =
+  match Sys.getenv_opt "SX_JIT_DENY" with
+  | None | Some "" -> []
+  | Some s -> String.split_on_char ',' s |> List.map String.trim
+let _jit_only_set =
+  match Sys.getenv_opt "SX_JIT_ONLY" with
+  | None | Some "" -> []
+  | Some s -> String.split_on_char ',' s |> List.map String.trim
+let _jit_name_allowed name =
+  (not (List.mem name _jit_deny_set))
+  && (match _jit_only_set with [] -> true | only -> List.mem name only)
+
 let rec make_vm_suspend_marker request saved_vm =
   let d = Hashtbl.create 3 in
   Hashtbl.replace d "__vm_suspended" (Bool true);
@@ -1486,6 +1590,8 @@ let rec make_vm_suspend_marker request saved_vm =
 let register_jit_hook env =
   Sx_runtime._jit_try_call_fn := Some (fun f args ->
     match f with
+    | Lambda l when (match l.l_name with Some n -> not (_jit_name_allowed n) | None -> false) ->
+      None  (* bisection filter excluded this name *)
     | Lambda l ->
       (match l.l_compiled with
        | Some cl when not (Sx_vm.is_jit_failed cl) ->
@@ -1502,7 +1608,23 @@ let register_jit_hook env =
                let rec resolve_loop req vm =
                  let result = resolver req (Nil) in
                  (try Some (Sx_vm.resume_vm vm result)
-                  with Sx_vm.VmSuspended (req2, vm2) -> resolve_loop req2 vm2)
+                  with
+                  | Sx_vm.VmSuspended (req2, vm2) -> resolve_loop req2 vm2
+                  | e ->
+                    (* (B) Resume raised mid-execution. resolve_loop runs inside
+                       the VmSuspended handler, so without catching here the
+                       error escapes to the http handler (→ 500). Recover THIS
+                       call on the CEK instead: mark jit_failed and return None
+                       so the interpreter re-runs it (idempotent for the host's
+                       durable reads). Self-heals on the first hit, not a retry. *)
+                    let fn_name = match l.l_name with Some n -> n | None -> "?" in
+                    if not (Hashtbl.mem _jit_warned fn_name) then begin
+                      Hashtbl.replace _jit_warned fn_name true;
+                      Printf.eprintf "[jit] %s resume fallback to CEK: %s\n%!"
+                        fn_name (Printexc.to_string e)
+                    end;
+                    l.l_compiled <- Some Sx_vm.jit_failed_sentinel;
+                    None)
                in
                resolve_loop request saved_vm
              | None -> Some (make_vm_suspend_marker request saved_vm))
@@ -1535,7 +1657,16 @@ let register_jit_hook env =
                    let rec resolve_loop req vm =
                      let result = resolver req (Nil) in
                      (try Some (Sx_vm.resume_vm vm result)
-                      with Sx_vm.VmSuspended (req2, vm2) -> resolve_loop req2 vm2)
+                      with
+                      | Sx_vm.VmSuspended (req2, vm2) -> resolve_loop req2 vm2
+                      | e ->
+                        (* (B) See note above — recover a failed resume on the
+                           CEK instead of escaping to the handler (→ 500). *)
+                        Printf.eprintf "[jit] %s resume fallback to CEK: %s\n%!"
+                          fn_name (Printexc.to_string e);
+                        Hashtbl.replace _jit_warned fn_name true;
+                        l.l_compiled <- Some Sx_vm.jit_failed_sentinel;
+                        None)
                    in
                    resolve_loop request saved_vm
                  | None -> Some (make_vm_suspend_marker request saved_vm))
@@ -1667,6 +1798,10 @@ let rec dispatch env cmd =
         | Nil -> "nil"
         | Bool true -> "true" | Bool false -> "false"
         | Number n -> Sx_types.format_number n
+        (* Bytecode opcodes + arity/upvalue-count are Integers; without this case
+           they hit the `_ -> "nil"` fallthrough, so every .sxbc came out as
+           `:bytecode (nil nil ...)` -> "VM: unknown opcode 0" -> source fallback. *)
+        | Integer n -> string_of_int n
         | String s -> "\"" ^ escape_sx_string s ^ "\""
         | Symbol s -> s | Keyword k -> ":" ^ k
         | List items | ListRef { contents = items } -> "(" ^ String.concat " " (List.map raw_serialize items) ^ ")"
@@ -1694,8 +1829,9 @@ let rec dispatch env cmd =
             | _ -> "" in
           let response = if op = "import" then begin
             let lib_spec = Sx_runtime.get_val request (String "library") in
-            let key = Sx_ref.library_name_key lib_spec in
-            if Sx_types.sx_truthy (Sx_ref.library_loaded_p key) then Nil
+            (* pass the SPEC, not a pre-computed key — library_loaded_p applies
+               library_name_key itself (a key string would crash sx_to_list). *)
+            if Sx_types.sx_truthy (Sx_ref.library_loaded_p lib_spec) then Nil
             else begin
               (match resolve_library_path lib_spec with
                | Some path -> load_library_file path | None -> ());
@@ -4854,6 +4990,46 @@ let () =
   else begin
     (* Normal persistent server mode *)
     let env = make_server_env () in
+    (* render-page: render an (unevaluated) SX page/component expression to HTML
+       using the server env, so http-listen handlers can serve interactive SX
+       pages. render-to-html expands components + collects keyword attrs itself;
+       SX handlers can't reach the server env, so this primitive supplies it. *)
+    ignore (env_bind env "render-page" (NativeFn ("render-page", fun args ->
+      match args with
+      | expr :: _ -> String (sx_render_to_html expr env)
+      | _ -> raise (Eval_error "render-page: (expr)"))));
+    (* JIT in the epoch serving mode is OPT-IN via SX_SERVING_JIT=1.
+       Default OFF: this mode is the shared command channel used by every
+       loop's conformance runner, and enabling JIT globally regresses
+       continuation-based guest interpreters (Scheme/Erlang/Prolog/CL: their
+       eval/dispatch cores capture call/cc continuations the stack VM can't
+       escape, and deep AST recursion can miscompile into a non-terminating
+       loop). Guests that are safe declare their interpret-only namespace with
+       `(jit-exclude! "<ns>-*")`; until every guest is validated, the safe
+       default is no JIT here. Opt in (SX_SERVING_JIT=1) for validated
+       workloads — e.g. the content/Smalltalk page server. *)
+    (match Sys.getenv_opt "SX_SERVING_JIT" with
+     | Some ("1" | "true" | "yes" | "on") ->
+       (* Load the SX bytecode compiler (lib/compiler.sx) as `compile` — the
+          native Sx_compiler.compile is an incomplete stub (arity-0 bytecode,
+          params as GLOBAL_GET). http/cli/site modes already load it. *)
+       (_import_env := Some env;
+        let project_dir = try Sys.getenv "SX_PROJECT_DIR" with Not_found ->
+          try Sys.getenv "SX_ROOT" with Not_found ->
+          if Sys.file_exists "/app/spec" then "/app" else Sys.getcwd () in
+        let lib_base = try Sys.getenv "SX_LIB_DIR" with Not_found ->
+          project_dir ^ "/lib" in
+        let compiler_path = lib_base ^ "/compiler.sx" in
+        let compiler_path =
+          if Sys.file_exists compiler_path then compiler_path
+          else if Sys.file_exists "lib/compiler.sx" then "lib/compiler.sx"
+          else compiler_path in
+        try load_library_file compiler_path; rebind_host_extensions env
+        with exn ->
+          Printf.eprintf "[sx-server] WARNING: failed to load compiler.sx for JIT (%s) — JIT disabled\n%!"
+            (Printexc.to_string exn));
+       register_jit_hook env
+     | _ -> ());
     send "(ready)";
     (* Main command loop *)
     try

hosts/ocaml/browser/bundle.sh

@@ -71,6 +71,11 @@ cp "$ROOT/shared/sx/templates/tw-layout.sx" "$DIST/sx/"
 cp "$ROOT/shared/sx/templates/tw-type.sx"   "$DIST/sx/"
 cp "$ROOT/shared/sx/templates/tw.sx"        "$DIST/sx/"
 
+# 9b. Host app components (content-addressed, client-expanded on boosted nav).
+# Listed in the host's data-sx-manifest "boot" array so the client eager-loads
+# them after the web stack — see lib/host/static.sx + sx-platform.js loadWebStack.
+cp "$ROOT/lib/host/sx/relate-picker.sx" "$DIST/sx/"
+
 # 10. Hyperscript
 for f in tokenizer parser compiler runtime integration htmx; do
   cp "$ROOT/lib/hyperscript/$f.sx" "$DIST/sx/hs-$f.sx"

hosts/ocaml/browser/compile-modules.js

@@ -48,6 +48,8 @@ const SOURCE_MAP = {
   'boot.sx': 'web/boot.sx',
   'tw-layout.sx': 'web/tw-layout.sx', 'tw-type.sx': 'web/tw-type.sx', 'tw.sx': 'web/tw.sx',
   'text-layout.sx': 'lib/text-layout.sx',
+  // Host app components (content-addressed, client-expanded on boosted nav).
+  'relate-picker.sx': 'lib/host/sx/relate-picker.sx',
 };
 let synced = 0;
 for (const [dist, src] of Object.entries(SOURCE_MAP)) {
@@ -87,6 +89,8 @@ const FILES = [
   'hs-tokenizer.sx', 'hs-parser.sx', 'hs-compiler.sx', 'hs-runtime.sx',
   'hs-worker.sx', 'hs-prolog.sx',
   'hs-integration.sx', 'hs-htmx.sx',
+  // Host app components — standalone defcomps, no inter-module deps.
+  'relate-picker.sx',
   'boot.sx',
 ];
 

hosts/ocaml/browser/sx-platform.js

@@ -646,6 +646,18 @@
     // Load entry point itself (boot.sx — not a library, just defines + init)
     loadBytecodeFile("sx/" + entry.file) || loadSxFile("sx/" + entry.file.replace(/\.sxbc$/, '.sx'));
 
+    // App components: the page's data-sx-manifest "boot" array lists app-specific
+    // modules (e.g. ~relate-picker) to eager-load after the web stack, so their
+    // defcomps are registered before a boosted fragment references them. Loaded
+    // content-addressed, the same as any module.
+    var pageM = loadPageManifest();
+    if (pageM && pageM.boot && pageM.boot.length) {
+      for (var b = 0; b < pageM.boot.length; b++) {
+        var bf = pageM.boot[b];
+        loadBytecodeFile("sx/" + bf) || loadSxFile("sx/" + bf.replace(/\.sxbc$/, '.sx'));
+      }
+    }
+
     if (K.endModuleLoad) K.endModuleLoad();
     var count = Object.keys(_loadedLibs).length + 1; // +1 for entry
     var dt = Math.round(performance.now() - t0);

hosts/ocaml/browser/sx_browser.ml

@@ -73,6 +73,7 @@ let rec value_to_js (v : value) : Js.Unsafe.any =
   | Nil -> Js.Unsafe.inject Js.null
   | Bool b -> Js.Unsafe.inject (Js.bool b)
   | Number n -> Js.Unsafe.inject (Js.number_of_float n)
+  | Integer n -> Js.Unsafe.inject (Js.number_of_float (float_of_int n))
   | String s -> Js.Unsafe.inject (Js.string s)
   | RawHTML s -> Js.Unsafe.inject (Js.string s)
   | Symbol s ->
@@ -329,8 +330,9 @@ let handle_import_suspension request =
   let lib_spec = match request with
     | Dict d -> (match Hashtbl.find_opt d "library" with Some v -> v | _ -> Nil)
     | _ -> Nil in
-  let key = Sx_ref.library_name_key lib_spec in
-  if Sx_types.sx_truthy (Sx_ref.library_loaded_p key) then
+  (* library_loaded_p takes the SPEC and applies library_name_key itself —
+     passing a pre-computed key string double-applies it and crashes. *)
+  if Sx_types.sx_truthy (Sx_ref.library_loaded_p lib_spec) then
     Some Nil  (* Already loaded — resume immediately *)
   else
     None  (* Not loaded — JS platform must fetch it *)

hosts/ocaml/lib/sx_cbor.ml

@@ -15,25 +15,29 @@ exception Cbor_error of string
 
 let write_head buf major v =
   let m = major lsl 5 in
+  (* Width selection + big-endian byte emission via Int64, so the web targets
+     compute identically to native: on js_of_ocaml [int] is 32-bit, so the
+     literal 0x100000000 (2^32) truncates to 0 (sending small values to the
+     8-byte branch) and [v lsr (8*i)] with i>=4 is shift-mod-32. Int64 has the
+     full 64-bit width and well-defined shifts on every target. *)
+  let v64 = Int64.of_int v in
+  let put_be nbytes =
+    for i = nbytes - 1 downto 0 do
+      Buffer.add_char buf
+        (Char.chr (Int64.to_int
+           (Int64.logand (Int64.shift_right_logical v64 (8 * i)) 0xFFL)))
+    done
+  in
   if v < 24 then
     Buffer.add_char buf (Char.chr (m lor v))
   else if v < 0x100 then begin
-    Buffer.add_char buf (Char.chr (m lor 24));
-    Buffer.add_char buf (Char.chr v)
+    Buffer.add_char buf (Char.chr (m lor 24)); put_be 1
   end else if v < 0x10000 then begin
-    Buffer.add_char buf (Char.chr (m lor 25));
-    Buffer.add_char buf (Char.chr ((v lsr 8) land 0xFF));
-    Buffer.add_char buf (Char.chr (v land 0xFF))
-  end else if v < 0x100000000 then begin
-    Buffer.add_char buf (Char.chr (m lor 26));
-    for i = 3 downto 0 do
-      Buffer.add_char buf (Char.chr ((v lsr (8 * i)) land 0xFF))
-    done
+    Buffer.add_char buf (Char.chr (m lor 25)); put_be 2
+  end else if Int64.compare v64 0x100000000L < 0 then begin
+    Buffer.add_char buf (Char.chr (m lor 26)); put_be 4
   end else begin
-    Buffer.add_char buf (Char.chr (m lor 27));
-    for i = 7 downto 0 do
-      Buffer.add_char buf (Char.chr ((v lsr (8 * i)) land 0xFF))
-    done
+    Buffer.add_char buf (Char.chr (m lor 27)); put_be 8
   end
 
 (* dag-cbor map key order: shorter key first, then bytewise. *)

hosts/ocaml/lib/sx_cid.ml

@@ -32,7 +32,11 @@ let base32_lower (s : string) : string =
     while !bits >= 5 do
       bits := !bits - 5;
       Buffer.add_char buf b32_alpha.[(!acc lsr !bits) land 0x1f]
-    done) s;
+    done;
+    (* Keep only the unconsumed low [bits] bits, so [acc] stays tiny (< 2^13).
+       Without this it grows by 8 bits per byte and overflows native [int] on
+       the 32-bit web targets, corrupting the emitted symbols. *)
+    acc := !acc land ((1 lsl !bits) - 1)) s;
   if !bits > 0 then
     Buffer.add_char buf b32_alpha.[(!acc lsl (5 - !bits)) land 0x1f];
   Buffer.contents buf

hosts/ocaml/lib/sx_ed25519.ml

@@ -68,15 +68,22 @@ let sub (a : bn) (b : bn) : bn =
   norm r
 
 let mul (a : bn) (b : bn) : bn =
+  (* Accumulate in Int64: a limb product is 26+26 = 52 bits, which overflows the
+     web targets' int (32-bit js_of_ocaml / 31-bit wasm_of_ocaml). Int64 is a
+     real 64-bit type on every target, so the carries are exact. *)
   let la = Array.length a and lb = Array.length b in
   let r = Array.make (la + lb) 0 in
+  let maskL = Int64.of_int mask in
   for i = 0 to la - 1 do
-    let carry = ref 0 in
+    let carry = ref 0L in
+    let ai = Int64.of_int a.(i) in
     for j = 0 to lb - 1 do
-      let s = r.(i + j) + a.(i) * b.(j) + !carry in
-      r.(i + j) <- s land mask; carry := s lsr bits
+      let s = Int64.add (Int64.add (Int64.of_int r.(i + j))
+                           (Int64.mul ai (Int64.of_int b.(j)))) !carry in
+      r.(i + j) <- Int64.to_int (Int64.logand s maskL);
+      carry := Int64.shift_right_logical s bits
     done;
-    r.(i + lb) <- r.(i + lb) + !carry
+    r.(i + lb) <- r.(i + lb) + Int64.to_int !carry
   done;
   norm r
 
@@ -109,12 +116,16 @@ let bn_mod (a : bn) (m : bn) : bn =
   end
 
 let div_small (a : bn) (d : int) : bn =
+  (* [rem lsl bits] reaches ~2^34 (rem < d <= 256, bits = 26), past the web
+     targets' int width — accumulate the running remainder in Int64. *)
   let la = Array.length a in
   let q = Array.make la 0 in
-  let rem = ref 0 in
+  let rem = ref 0L in
+  let dL = Int64.of_int d in
   for i = la - 1 downto 0 do
-    let cur = (!rem lsl bits) lor a.(i) in
-    q.(i) <- cur / d; rem := cur mod d
+    let cur = Int64.logor (Int64.shift_left !rem bits) (Int64.of_int a.(i)) in
+    q.(i) <- Int64.to_int (Int64.div cur dL);
+    rem := Int64.rem cur dL
   done;
   norm q
 

hosts/ocaml/lib/sx_primitives.ml

@@ -4168,6 +4168,38 @@ let () =
     ) Sx_types.jit_cache_queue;
     Queue.clear Sx_types.jit_cache_queue;
     Nil);
+  register "jit-exclude!" (fun args ->
+    (* Mark function names as interpret-only (never JIT-compiled). A guest
+       interpreter calls this for its continuation-using dispatch core.
+       Accepts string/symbol names; a trailing "*" makes it a namespace prefix
+       (e.g. "er-*" excludes every function whose name starts with "er-") —
+       the robust way to declare a whole guest interpreter core. *)
+    List.iter (fun a ->
+      match a with
+      | String n | Symbol n ->
+        let len = String.length n in
+        if len > 0 && n.[len - 1] = '*' then begin
+          let prefix = String.sub n 0 (len - 1) in
+          if not (List.mem prefix !Sx_types.jit_excluded_prefixes) then
+            Sx_types.jit_excluded_prefixes := prefix :: !Sx_types.jit_excluded_prefixes
+        end else
+          Hashtbl.replace Sx_types.jit_excluded n ()
+      | _ -> ()) args;
+    Nil);
+  register "jit-excluded?" (fun args ->
+    match args with
+    | [String n] | [Symbol n] -> Bool (Sx_types.jit_name_excluded n)
+    | _ -> Bool false);
+  register "jit-exclude-callers-of!" (fun args ->
+    (* Register call/cc-establishing forms (e.g. cl-restart-case). Any function
+       whose bytecode references one of these is itself interpret-only — JIT
+       would force the form into a nested cek-run where its continuation can't
+       escape. A guest declares its condition-system / escaping forms here. *)
+    List.iter (fun a ->
+      match a with
+      | String n | Symbol n -> Hashtbl.replace Sx_types.jit_excluded_caller_names n ()
+      | _ -> ()) args;
+    Nil);
   register "jit-reset-counters!" (fun _args ->
     Sx_types.jit_compiled_count := 0;
     Sx_types.jit_skipped_count := 0;

hosts/ocaml/lib/sx_ref.ml

@@ -404,7 +404,7 @@ and library_loaded_p spec =
 
 (* library-exports *)
 and library_exports spec =
-  (get ((get (_library_registry_) ((library_name_key (spec))))) ((String "exports")))
+  (let entry = (get (_library_registry_) ((library_name_key (spec)))) in (if sx_truthy (entry) then (get (entry) ((String "exports"))) else (Dict (Hashtbl.create 0))))
 
 (* register-library *)
 and register_library spec exports =

hosts/ocaml/lib/sx_runtime.ml

@@ -17,11 +17,19 @@ let rec _fast_eq a b =
   | Number x, Number y -> x = y
   | Integer x, Number y -> float_of_int x = y
   | Number x, Integer y -> x = float_of_int y
+  (* Exact rationals — must match the "=" primitive (safe_eq). Cross-multiply
+     for rational/rational; coerce for rational/int and rational/float. *)
+  | Rational (an, ad), Rational (bn, bd) -> an * bd = bn * ad
+  | Rational (n, d), Integer y -> n = y * d
+  | Integer x, Rational (n, d) -> x * d = n
+  | Rational (n, d), Number y -> float_of_int n /. float_of_int d = y
+  | Number x, Rational (n, d) -> x = float_of_int n /. float_of_int d
   | Bool x, Bool y -> x = y
   | Nil, Nil -> true
   | Symbol x, Symbol y -> x = y
   | Keyword x, Keyword y -> x = y
-  | List la, List lb ->
+  | (List la | ListRef { contents = la }),
+    (List lb | ListRef { contents = lb }) ->
     (try List.for_all2 _fast_eq la lb with Invalid_argument _ -> false)
   | _ -> false
 

hosts/ocaml/lib/sx_sha2.ml

@@ -3,37 +3,40 @@
     No C stubs, no external deps. Used by the fed-sx host primitives
     [crypto-sha256] / [crypto-sha512]. Reference: FIPS 180-4. *)
 
-(* ---- SHA-256 (FIPS 180-4 §6.2). 32-bit words held in native int,
-   masked to 32 bits after every arithmetic op. ---- *)
-
-let mask32 = 0xFFFFFFFF
+(* ---- SHA-256 (FIPS 180-4 §6.2). 32-bit words via Int32, NOT native int.
+   On the web targets the kernel is compiled by js_of_ocaml (32-bit int) and
+   wasm_of_ocaml (31-bit int), where native [int] silently truncates the 32-bit
+   round words — producing WRONG digests (and, downstream, bad CIDs and a
+   Char.chr crash at kernel init). Int32 has well-defined wrap-around mod 2^32 on
+   every target, so this matches the 63-bit native build exactly. ---- *)
 
 let k256 = [|
-  0x428a2f98; 0x71374491; 0xb5c0fbcf; 0xe9b5dba5;
-  0x3956c25b; 0x59f111f1; 0x923f82a4; 0xab1c5ed5;
-  0xd807aa98; 0x12835b01; 0x243185be; 0x550c7dc3;
-  0x72be5d74; 0x80deb1fe; 0x9bdc06a7; 0xc19bf174;
-  0xe49b69c1; 0xefbe4786; 0x0fc19dc6; 0x240ca1cc;
-  0x2de92c6f; 0x4a7484aa; 0x5cb0a9dc; 0x76f988da;
-  0x983e5152; 0xa831c66d; 0xb00327c8; 0xbf597fc7;
-  0xc6e00bf3; 0xd5a79147; 0x06ca6351; 0x14292967;
-  0x27b70a85; 0x2e1b2138; 0x4d2c6dfc; 0x53380d13;
-  0x650a7354; 0x766a0abb; 0x81c2c92e; 0x92722c85;
-  0xa2bfe8a1; 0xa81a664b; 0xc24b8b70; 0xc76c51a3;
-  0xd192e819; 0xd6990624; 0xf40e3585; 0x106aa070;
-  0x19a4c116; 0x1e376c08; 0x2748774c; 0x34b0bcb5;
-  0x391c0cb3; 0x4ed8aa4a; 0x5b9cca4f; 0x682e6ff3;
-  0x748f82ee; 0x78a5636f; 0x84c87814; 0x8cc70208;
-  0x90befffa; 0xa4506ceb; 0xbef9a3f7; 0xc67178f2 |]
+  0x428a2f98l; 0x71374491l; 0xb5c0fbcfl; 0xe9b5dba5l;
+  0x3956c25bl; 0x59f111f1l; 0x923f82a4l; 0xab1c5ed5l;
+  0xd807aa98l; 0x12835b01l; 0x243185bel; 0x550c7dc3l;
+  0x72be5d74l; 0x80deb1fel; 0x9bdc06a7l; 0xc19bf174l;
+  0xe49b69c1l; 0xefbe4786l; 0x0fc19dc6l; 0x240ca1ccl;
+  0x2de92c6fl; 0x4a7484aal; 0x5cb0a9dcl; 0x76f988dal;
+  0x983e5152l; 0xa831c66dl; 0xb00327c8l; 0xbf597fc7l;
+  0xc6e00bf3l; 0xd5a79147l; 0x06ca6351l; 0x14292967l;
+  0x27b70a85l; 0x2e1b2138l; 0x4d2c6dfcl; 0x53380d13l;
+  0x650a7354l; 0x766a0abbl; 0x81c2c92el; 0x92722c85l;
+  0xa2bfe8a1l; 0xa81a664bl; 0xc24b8b70l; 0xc76c51a3l;
+  0xd192e819l; 0xd6990624l; 0xf40e3585l; 0x106aa070l;
+  0x19a4c116l; 0x1e376c08l; 0x2748774cl; 0x34b0bcb5l;
+  0x391c0cb3l; 0x4ed8aa4al; 0x5b9cca4fl; 0x682e6ff3l;
+  0x748f82eel; 0x78a5636fl; 0x84c87814l; 0x8cc70208l;
+  0x90befffal; 0xa4506cebl; 0xbef9a3f7l; 0xc67178f2l |]
 
-let rotr32 x n = ((x lsr n) lor (x lsl (32 - n))) land mask32
+let rotr32 (x : int32) (n : int) : int32 =
+  Int32.logor (Int32.shift_right_logical x n) (Int32.shift_left x (32 - n))
 
 let sha256_hex (msg : string) : string =
-  let h = [| 0x6a09e667; 0xbb67ae85; 0x3c6ef372; 0xa54ff53a;
-             0x510e527f; 0x9b05688c; 0x1f83d9ab; 0x5be0cd19 |] in
+  let h = [| 0x6a09e667l; 0xbb67ae85l; 0x3c6ef372l; 0xa54ff53al;
+             0x510e527fl; 0x9b05688cl; 0x1f83d9abl; 0x5be0cd19l |] in
   let len = String.length msg in
   (* Padded length: multiple of 64 bytes. *)
-  let bitlen = len * 8 in
+  let bitlen = Int64.mul (Int64.of_int len) 8L in
   let padlen =
     let r = (len + 1) mod 64 in
     if r <= 56 then 56 - r else 120 - r
@@ -42,60 +45,79 @@ let sha256_hex (msg : string) : string =
   let buf = Bytes.make total '\000' in
   Bytes.blit_string msg 0 buf 0 len;
   Bytes.set buf len '\x80';
-  (* 64-bit big-endian bit length (we cap at OCaml int range). *)
+  (* 64-bit big-endian bit length. Int64 shifts so the high bytes (shift >= 32)
+     are correct on the 32-bit web targets — native int `lsr 32` is shift-mod-32
+     on js_of_ocaml and would leak the low length byte into a higher word. *)
   for i = 0 to 7 do
     Bytes.set buf (total - 1 - i)
-      (Char.chr ((bitlen lsr (8 * i)) land 0xFF))
+      (Char.chr (Int64.to_int
+         (Int64.logand (Int64.shift_right_logical bitlen (8 * i)) 0xFFL)))
   done;
-  let w = Array.make 64 0 in
+  let byte i = Int32.of_int (Char.code (Bytes.get buf i)) in
+  let w = Array.make 64 0l in
   let nblocks = total / 64 in
   for b = 0 to nblocks - 1 do
     let base = b * 64 in
     for t = 0 to 15 do
       let o = base + t * 4 in
       w.(t) <-
-        (Char.code (Bytes.get buf o) lsl 24)
-        lor (Char.code (Bytes.get buf (o + 1)) lsl 16)
-        lor (Char.code (Bytes.get buf (o + 2)) lsl 8)
-        lor (Char.code (Bytes.get buf (o + 3)))
+        Int32.logor
+          (Int32.logor
+             (Int32.shift_left (byte o) 24)
+             (Int32.shift_left (byte (o + 1)) 16))
+          (Int32.logor
+             (Int32.shift_left (byte (o + 2)) 8)
+             (byte (o + 3)))
     done;
     for t = 16 to 63 do
       let s0 =
-        (rotr32 w.(t - 15) 7) lxor (rotr32 w.(t - 15) 18)
-        lxor (w.(t - 15) lsr 3) in
+        Int32.logxor
+          (Int32.logxor (rotr32 w.(t - 15) 7) (rotr32 w.(t - 15) 18))
+          (Int32.shift_right_logical w.(t - 15) 3) in
       let s1 =
-        (rotr32 w.(t - 2) 17) lxor (rotr32 w.(t - 2) 19)
-        lxor (w.(t - 2) lsr 10) in
-      w.(t) <- (w.(t - 16) + s0 + w.(t - 7) + s1) land mask32
+        Int32.logxor
+          (Int32.logxor (rotr32 w.(t - 2) 17) (rotr32 w.(t - 2) 19))
+          (Int32.shift_right_logical w.(t - 2) 10) in
+      w.(t) <-
+        Int32.add (Int32.add w.(t - 16) s0) (Int32.add w.(t - 7) s1)
     done;
     let a = ref h.(0) and bb = ref h.(1) and c = ref h.(2)
     and d = ref h.(3) and e = ref h.(4) and f = ref h.(5)
     and g = ref h.(6) and hh = ref h.(7) in
     for t = 0 to 63 do
       let s1 =
-        (rotr32 !e 6) lxor (rotr32 !e 11) lxor (rotr32 !e 25) in
-      let ch = (!e land !f) lxor ((lnot !e land mask32) land !g) in
-      let t1 = (!hh + s1 + ch + k256.(t) + w.(t)) land mask32 in
+        Int32.logxor
+          (Int32.logxor (rotr32 !e 6) (rotr32 !e 11)) (rotr32 !e 25) in
+      let ch =
+        Int32.logxor (Int32.logand !e !f)
+          (Int32.logand (Int32.lognot !e) !g) in
+      let t1 =
+        Int32.add
+          (Int32.add (Int32.add !hh s1) (Int32.add ch k256.(t))) w.(t) in
       let s0 =
-        (rotr32 !a 2) lxor (rotr32 !a 13) lxor (rotr32 !a 22) in
-      let maj = (!a land !bb) lxor (!a land !c) lxor (!bb land !c) in
-      let t2 = (s0 + maj) land mask32 in
+        Int32.logxor
+          (Int32.logxor (rotr32 !a 2) (rotr32 !a 13)) (rotr32 !a 22) in
+      let maj =
+        Int32.logxor
+          (Int32.logxor (Int32.logand !a !bb) (Int32.logand !a !c))
+          (Int32.logand !bb !c) in
+      let t2 = Int32.add s0 maj in
       hh := !g; g := !f; f := !e;
-      e := (!d + t1) land mask32;
+      e := Int32.add !d t1;
       d := !c; c := !bb; bb := !a;
-      a := (t1 + t2) land mask32
+      a := Int32.add t1 t2
     done;
-    h.(0) <- (h.(0) + !a) land mask32;
-    h.(1) <- (h.(1) + !bb) land mask32;
-    h.(2) <- (h.(2) + !c) land mask32;
-    h.(3) <- (h.(3) + !d) land mask32;
-    h.(4) <- (h.(4) + !e) land mask32;
-    h.(5) <- (h.(5) + !f) land mask32;
-    h.(6) <- (h.(6) + !g) land mask32;
-    h.(7) <- (h.(7) + !hh) land mask32
+    h.(0) <- Int32.add h.(0) !a;
+    h.(1) <- Int32.add h.(1) !bb;
+    h.(2) <- Int32.add h.(2) !c;
+    h.(3) <- Int32.add h.(3) !d;
+    h.(4) <- Int32.add h.(4) !e;
+    h.(5) <- Int32.add h.(5) !f;
+    h.(6) <- Int32.add h.(6) !g;
+    h.(7) <- Int32.add h.(7) !hh
   done;
   let out = Buffer.create 64 in
-  Array.iter (fun x -> Buffer.add_string out (Printf.sprintf "%08x" x)) h;
+  Array.iter (fun x -> Buffer.add_string out (Printf.sprintf "%08lx" x)) h;
   Buffer.contents out
 
 (* ---- SHA-512 (FIPS 180-4 §6.4). 64-bit words via Int64.
@@ -146,7 +168,7 @@ let sha512_hex (msg : string) : string =
              0x510e527fade682d1L; 0x9b05688c2b3e6c1fL;
              0x1f83d9abfb41bd6bL; 0x5be0cd19137e2179L |] in
   let len = String.length msg in
-  let bitlen = len * 8 in
+  let bitlen = Int64.mul (Int64.of_int len) 8L in
   (* Pad to a multiple of 128 bytes; 16-byte big-endian length. *)
   let padlen =
     let r = (len + 1) mod 128 in
@@ -156,9 +178,12 @@ let sha512_hex (msg : string) : string =
   let buf = Bytes.make total '\000' in
   Bytes.blit_string msg 0 buf 0 len;
   Bytes.set buf len '\x80';
+  (* Low 64 bits of the bit length (high 64 stay 0). Int64 shifts so the bytes
+     at shift >= 32 are correct on the 32-bit web targets (js shift-mod-32). *)
   for i = 0 to 7 do
     Bytes.set buf (total - 1 - i)
-      (Char.chr ((bitlen lsr (8 * i)) land 0xFF))
+      (Char.chr (Int64.to_int
+         (Int64.logand (Int64.shift_right_logical bitlen (8 * i)) 0xFFL)))
   done;
   let w = Array.make 80 0L in
   let nblocks = total / 128 in

hosts/ocaml/lib/sx_types.ml

@@ -470,6 +470,52 @@ let jit_compiled_count = ref 0
 let jit_skipped_count = ref 0
 let jit_threshold_skipped_count = ref 0
 
+(** Runtime, data-driven JIT exclusion set. Names added here are never
+    JIT-compiled — they run on the CEK interpreter instead.
+
+    This is how a guest interpreter declares its *interpret-only* functions:
+    those that capture or invoke first-class continuations (e.g. Smalltalk's
+    [call/cc]-based non-local return [^expr], or block escape). The stack VM
+    cannot transfer control through a CEK continuation, so a JIT-compiled
+    frame on the OCaml/VM stack between a [call/cc] and its [(k v)] invocation
+    would either fail at runtime or (worse) re-run with duplicated side
+    effects. Marking the dispatch core interpret-only keeps those functions on
+    the CEK while pure helpers still JIT.
+
+    Populated from SX via the [jit-exclude!] primitive (see sx_primitives).
+    Consulted in [Sx_vm.jit_compile_lambda], so it covers BOTH JIT entry
+    points: the CEK call hook and the in-VM tiered-compilation path. *)
+let jit_excluded : (string, unit) Hashtbl.t = Hashtbl.create 64
+
+(** Namespace-prefix exclusions. A guest interpreter declares its whole
+    function namespace interpret-only with one entry (e.g. ["er-"], ["scm-"]),
+    which is far more robust than enumerating every function — a name-list
+    misses functions in extra files (the erlang VM dispatcher, etc.) and
+    silently regresses. Set via [jit-exclude!] with a trailing ["*"]
+    (e.g. [(jit-exclude! "er-*")]). Checked via [jit_name_excluded]. *)
+let jit_excluded_prefixes : string list ref = ref []
+
+(** True if [name] is excluded from JIT — by exact name or by namespace prefix. *)
+let jit_name_excluded name =
+  Hashtbl.mem jit_excluded name
+  || List.exists (fun p ->
+       String.length name >= String.length p
+       && String.sub name 0 (String.length p) = p) !jit_excluded_prefixes
+
+(** Names of functions that ESTABLISH an escaping continuation via call/cc
+    (e.g. Common-Lisp's [cl-restart-case] / [cl-handler-case] — the condition
+    system). Any SX function that *calls* one of these is itself unsafe to JIT:
+    JIT-compiling the caller forces the call/cc-wrapping form to run in a nested
+    cek-run, where invoking the captured continuation runs-to-completion-and-
+    returns instead of escaping — so a restart/non-local exit silently fails
+    and the body falls through (observed as result accumulation / no-abort).
+
+    These callers are NOT a fixed namespace (they are arbitrary user/test code),
+    so they cannot be prefix-excluded. Instead a guest declares its escaping
+    forms here (via [jit-exclude-callers-of!]) and [jit_compile_lambda] skips
+    any function whose constant pool references one of them. *)
+let jit_excluded_caller_names : (string, unit) Hashtbl.t = Hashtbl.create 16
+
 (** {2 JIT cache LRU eviction — Phase 2}
 
     Once a lambda crosses the threshold, its [l_compiled] slot is filled.

hosts/ocaml/lib/sx_vm.ml

@@ -336,30 +336,51 @@ and call_closure_reuse cl args =
     push_closure_frame vm cl args;
     let saved_frames = List.tl vm.frames in
     vm.frames <- [List.hd vm.frames];
-    (try run vm
-     with
-     | VmSuspended _ as e ->
-       (* IO suspension: save the caller's continuation on the reuse stack.
-          DON'T merge frames — that corrupts the frame chain with nested
-          closures. On resume, restore_reuse in resume_vm processes these
-          in innermost-first order after the callback finishes. *)
-       vm.reuse_stack <- (saved_frames, saved_sp) :: vm.reuse_stack;
-       raise e
-     | e ->
-       vm.frames <- saved_frames;
-       vm.sp <- saved_sp;
-       raise e);
-    vm.frames <- saved_frames;
-    (* Snapshot/restore sp around the popped result.
-       OP_RETURN normally leaves sp = saved_sp + 1, but the bytecode-exhausted
-       path (or a callee that returns a closure whose own RETURN leaves extra
-       stack residue) can leave sp inconsistent. Read the result at the
-       expected slot and reset sp explicitly so the parent frame's
-       intermediate values are not corrupted. *)
     let result =
-      if vm.sp > saved_sp then vm.stack.(vm.sp - 1)
-      else Nil
+      (try run vm;
+        (* Normal completion: result sits at the top of the stack.
+           OP_RETURN normally leaves sp = saved_sp + 1, but the
+           bytecode-exhausted path (or a callee that returns a closure whose
+           own RETURN leaves extra stack residue) can leave sp inconsistent.
+           Read the result at the expected slot. *)
+        if vm.sp > saved_sp then vm.stack.(vm.sp - 1) else Nil
+       with
+       | VmSuspended (req, _) as e ->
+         (match !Sx_types._cek_io_resolver with
+          | Some resolver ->
+            (* Serving path: a `perform` fired inside this HO-primitive
+               callback (map/filter/reduce/for-each/…). The primitive's native
+               OCaml loop sits between us and the resume point, so we CANNOT
+               unwind it and resume later (the loop state would be lost and the
+               remaining elements dropped — corrupting the stack so the next
+               CALL_PRIM sees wrong args). Instead resolve the callback's IO
+               inline and run it to completion right here, returning its value
+               to the native loop exactly as a non-suspending callback would.
+               reuse_stack is isolated so an outer suspension's saved
+               continuations aren't consumed by this nested resume. *)
+            let saved_reuse = vm.reuse_stack in
+            vm.reuse_stack <- [];
+            let rec settle req =
+              let r = resolver req Nil in
+              (try resume_vm vm r
+               with VmSuspended (req2, _) -> settle req2)
+            in
+            let cb = settle req in
+            vm.reuse_stack <- saved_reuse;
+            cb
+          | None ->
+            (* CEK-driven path (no synchronous resolver): preserve the existing
+               behaviour — save the caller's continuation on the reuse stack and
+               re-raise so resume_vm restores it after the callback finishes.
+               DON'T merge frames — that corrupts the frame chain. *)
+            vm.reuse_stack <- (saved_frames, saved_sp) :: vm.reuse_stack;
+            raise e)
+       | e ->
+         vm.frames <- saved_frames;
+         vm.sp <- saved_sp;
+         raise e)
     in
+    vm.frames <- saved_frames;
     vm.sp <- saved_sp;
     result
   | None ->
@@ -808,14 +829,31 @@ and run vm =
           let b = pop vm and a = pop vm in
           push vm (match a, b with
             | Integer x, Integer y when y <> 0 && x mod y = 0 -> Integer (x / y)
-            | Integer x, Integer y -> Number (float_of_int x /. float_of_int y)
+            (* Non-divisible Integer/Integer must delegate to the "/" primitive:
+               it returns an exact Rational (e.g. 1/2), matching CEK semantics.
+               Inlining float division here (0.5) diverges from the interpreter
+               and breaks numeric equality against rational results. *)
             | Number x, Number y -> Number (x /. y)
             | Integer x, Number y -> Number (float_of_int x /. y)
             | Number x, Integer y -> Number (x /. float_of_int y)
             | _ -> (Hashtbl.find Sx_primitives.primitives "/") [a; b])
         | 164 (* OP_EQ *) ->
           let b = pop vm and a = pop vm in
-          push vm (Bool (Sx_runtime._fast_eq a b))
+          (* Trivial scalar cases inline; everything else (Rational, Dict,
+             Record, Vector, ListRef, nested lists) delegates to the "="
+             primitive so VM equality matches CEK exactly. _fast_eq is a
+             stripped-down subset and must not be the source of truth here. *)
+          push vm (match a, b with
+            | Integer x, Integer y -> Bool (x = y)
+            | Number x, Number y -> Bool (x = y)
+            | Integer x, Number y -> Bool (float_of_int x = y)
+            | Number x, Integer y -> Bool (x = float_of_int y)
+            | String x, String y -> Bool (x = y)
+            | Bool x, Bool y -> Bool (x = y)
+            | Symbol x, Symbol y -> Bool (x = y)
+            | Keyword x, Keyword y -> Bool (x = y)
+            | Nil, Nil -> Bool true
+            | _ -> (Hashtbl.find Sx_primitives.primitives "=") [a; b])
         | 165 (* OP_LT *) ->
           let b = pop vm and a = pop vm in
           push vm (match a, b with
@@ -921,7 +959,17 @@ and run vm =
 
     After the callback finishes, restores any call_closure_reuse
     continuations saved on vm.reuse_stack (innermost first). *)
-let resume_vm vm result =
+and resume_vm vm result =
+  (* The resumed execution runs on [vm]; HO primitives (map/filter/…) called
+     during the resume reach for [!_active_vm] to run their callbacks on the
+     same stack. call_closure restored [_active_vm] to the *caller* when the
+     original VmSuspended unwound through it, so without re-asserting it here
+     the resumed run's callbacks land on the wrong VM (or allocate a fresh
+     one), corrupting the stack. Mirror call_closure's save/set/restore. *)
+  let prev_active = !_active_vm in
+  _active_vm := Some vm;
+  let restore () = _active_vm := prev_active in
+  (try
   (match vm.pending_cek with
    | Some cek_state ->
      vm.pending_cek <- None;
@@ -993,7 +1041,9 @@ let resume_vm vm result =
   let pending = List.rev vm.reuse_stack in
   vm.reuse_stack <- [];
   restore_reuse pending;
-  pop vm
+  let r = pop vm in
+  restore (); r
+  with e -> restore (); raise e)
 
 (** Execute a compiled module (top-level bytecode). *)
 let execute_module code globals =
@@ -1072,7 +1122,7 @@ let _jit_is_broken_name n =
     Operand-size logic mirrors [opcode_operand_size] (which is defined
     later, in the disassembly section); inlined here so this helper can
     sit before [jit_compile_lambda] in the file. *)
-let bytecode_uses_extension_opcodes (bc : int array) (consts : value array) =
+let bytecode_find_opcode (pred : int -> bool) (bc : int array) (consts : value array) =
   let core_operand_size = function
     | 1 | 20 | 21 | 64 | 65 | 128 -> 2  (* u16 *)
     | 16 | 17 | 18 | 19 | 48 | 49 | 144 -> 1  (* u8 *)
@@ -1085,7 +1135,7 @@ let bytecode_uses_extension_opcodes (bc : int array) (consts : value array) =
   let found = ref false in
   while not !found && !ip < len do
     let op = bc.(!ip) in
-    if op >= 200 then found := true
+    if pred op then found := true
     else begin
       ip := !ip + 1;
       let extra = match op with
@@ -1112,6 +1162,49 @@ let bytecode_uses_extension_opcodes (bc : int array) (consts : value array) =
   done;
   !found
 
+let bytecode_uses_extension_opcodes bc consts =
+  bytecode_find_opcode (fun op -> op >= 200) bc consts
+
+(** True if [code] — or any closure nested in its constant pool — installs an
+    exception handler (OP_PUSH_HANDLER = 35), i.e. contains a `guard` /
+    `handler-bind` / dream-catch form. The VM's PUSH_HANDLER only intercepts a
+    VM-level RAISE (opcode 37); it does NOT catch the OCaml [Eval_error] that
+    the `error` primitive throws from inside a CALL/CALL_PRIM in a callee
+    frame. So a JIT-compiled guard silently fails to catch thrown errors (they
+    escape across the JIT frame).
+
+    The scan is RECURSIVE: a curried higher-order function (e.g. Dream's
+    `dream-catch-with = (fn (on-error) (fn (next) (fn (req) (guard ...))))`)
+    has no PUSH_HANDLER in its own body — the guard lives in a nested
+    `OP_CLOSURE` whose code sits in the constant pool. JIT-compiling the outer
+    function would mint that inner guard as a VmClosure with the broken VM
+    handler. Descending into nested closure codes catches this, so the whole
+    closure family runs on the CEK (whose guard catches correctly). Covers
+    dream-catch-with, host wrap-errors, and every guard user centrally. *)
+let rec code_uses_handler code =
+  bytecode_find_opcode (fun op -> op = 35) code.vc_bytecode code.vc_constants
+  || Array.exists (fun c ->
+       match c with
+       | Dict d when Hashtbl.mem d "bytecode" || Hashtbl.mem d "vc-bytecode" ->
+         (try code_uses_handler (code_from_value c) with _ -> false)
+       | _ -> false) code.vc_constants
+
+(** True if [code] — or any nested closure code — references (in its constant
+    pool, as a GLOBAL_GET/CALL name) a function registered in
+    [Sx_types.jit_excluded_caller_names] (a call/cc-establishing form like
+    Common-Lisp's cl-restart-case/cl-handler-case). Such a caller must run on
+    the CEK so the continuation captured inside the called form can escape.
+    The constant-pool string IS the referenced symbol name, so membership is a
+    direct lookup; recurse into nested closure codes. Skipped entirely (no
+    Hashtbl walk) when no escaping forms are registered. *)
+let rec code_refs_escaping_caller code =
+  Array.exists (fun c ->
+    match c with
+    | String s -> Hashtbl.mem Sx_types.jit_excluded_caller_names s
+    | Dict d when Hashtbl.mem d "bytecode" || Hashtbl.mem d "vc-bytecode" ->
+      (try code_refs_escaping_caller (code_from_value c) with _ -> false)
+    | _ -> false) code.vc_constants
+
 let jit_compile_lambda (l : lambda) globals =
   let fn_name = match l.l_name with Some n -> n | None -> "<anon>" in
   if !_jit_compiling then (
@@ -1127,6 +1220,13 @@ let jit_compile_lambda (l : lambda) globals =
     None
   ) else if _jit_is_broken_name fn_name then (
     None
+  ) else if Sx_types.jit_name_excluded fn_name then (
+    (* Guest-declared interpret-only function (continuation-using dispatch
+       core, or a whole namespace via prefix). Run on the CEK; the stack VM
+       can't escape through a CEK continuation and may miscompile deep AST
+       recursion into a non-terminating loop. See Sx_types.jit_excluded /
+       jit_excluded_prefixes. *)
+    None
   ) else
   try
     _jit_compiling := true;
@@ -1183,6 +1283,20 @@ let jit_compile_lambda (l : lambda) globals =
             Printf.eprintf "[jit] SKIP %s: bytecode uses extension opcodes (interpret-only in v1)\n%!"
               fn_name;
             None
+          end else if code_uses_handler code then begin
+            (* guard / handler-bind (possibly in a nested closure): VM
+               PUSH_HANDLER doesn't catch the `error` primitive's OCaml
+               exception across frames — run on the CEK. *)
+            Printf.eprintf "[jit] SKIP %s: installs an exception handler (guard) — interpret-only\n%!"
+              fn_name;
+            None
+          end else if Hashtbl.length Sx_types.jit_excluded_caller_names > 0
+                      && code_refs_escaping_caller code then begin
+            (* Calls a call/cc-establishing form (e.g. cl-restart-case): must
+               run on the CEK so the captured continuation can escape. *)
+            Printf.eprintf "[jit] SKIP %s: calls a call/cc-establishing form — interpret-only\n%!"
+              fn_name;
+            None
           end else
             Some { vm_code = code; vm_upvalues = [||];
                    vm_name = l.l_name; vm_env_ref = effective_globals; vm_closure_env = Some l.l_closure }

lib/artdag/conformance.sh

@@ -13,7 +13,7 @@ if [ ! -x "$SX_SERVER" ]; then
   exit 1
 fi
 
-SUITES=(dag analyze plan execute optimize fed cost serialize stats fault post maude-optimize schedule)
+SUITES=(dag analyze plan execute optimize fed cost serialize stats fault)
 
 OUT_JSON="lib/artdag/scoreboard.json"
 OUT_MD="lib/artdag/scoreboard.md"
@@ -23,49 +23,6 @@ run_suite() {
   local file="lib/artdag/tests/${suite}.sx"
   local TMP
   TMP=$(mktemp)
-  local MAUDE_LOADS=""
-  local BRIDGE_LOAD=""
-  local MK_LOADS=""
-  local SCHED_LOAD=""
-  if [ "$suite" = "schedule" ]; then
-    MK_LOADS='(load "lib/guest/match.sx")
-(load "lib/minikanren/unify.sx")
-(load "lib/minikanren/stream.sx")
-(load "lib/minikanren/goals.sx")
-(load "lib/minikanren/fresh.sx")
-(load "lib/minikanren/conde.sx")
-(load "lib/minikanren/run.sx")
-(load "lib/minikanren/relations.sx")
-(load "lib/minikanren/project.sx")
-(load "lib/minikanren/diseq.sx")
-(load "lib/minikanren/intarith.sx")
-(load "lib/minikanren/matche.sx")
-(load "lib/minikanren/defrel.sx")
-(load "lib/minikanren/nafc.sx")
-(load "lib/minikanren/fd.sx")
-(load "lib/minikanren/clpfd.sx")'
-    SCHED_LOAD='(load "lib/artdag/schedule.sx")'
-  fi
-  if [ "$suite" = "maude-optimize" ]; then
-    MAUDE_LOADS='(load "lib/guest/lex.sx")
-(load "lib/guest/pratt.sx")
-(load "lib/maude/term.sx")
-(load "lib/maude/parser.sx")
-(load "lib/maude/sorts.sx")
-(load "lib/maude/reduce.sx")
-(load "lib/maude/matching.sx")
-(load "lib/maude/conditional.sx")
-(load "lib/maude/fire.sx")
-(load "lib/maude/confluence.sx")
-(load "lib/maude/rewrite.sx")
-(load "lib/maude/searchpath.sx")
-(load "lib/maude/strategy.sx")
-(load "lib/maude/meta.sx")
-(load "lib/maude/pretty.sx")
-(load "lib/maude/run.sx")'
-    BRIDGE_LOAD='(load "lib/artdag/maude-bridge.sx")
-(load "lib/artdag/optimize-rules.sx")'
-  fi
   cat > "$TMP" << EPOCHS
 (epoch 1)
 (load "spec/stdlib.sx")
@@ -84,8 +41,6 @@ run_suite() {
 (load "lib/persist/log.sx")
 (load "lib/persist/kv.sx")
 (load "lib/persist/api.sx")
-${MAUDE_LOADS}
-${MK_LOADS}
 (load "lib/artdag/dag.sx")
 (load "lib/artdag/analyze.sx")
 (load "lib/artdag/plan.sx")
@@ -96,10 +51,7 @@ ${MK_LOADS}
 (load "lib/artdag/serialize.sx")
 (load "lib/artdag/stats.sx")
 (load "lib/artdag/fault.sx")
-(load "lib/artdag/post.sx")
 (load "lib/artdag/api.sx")
-${BRIDGE_LOAD}
-${SCHED_LOAD}
 (epoch 2)
 (eval "(define artdag-test-pass 0)")
 (eval "(define artdag-test-fail 0)")

lib/artdag/maude-bridge.sx

@@ -1,118 +0,0 @@
-; lib/artdag/maude-bridge.sx — adapter between an artdag effect DAG and maude terms.
-; A node {:op :inputs :params :commutative} <-> a maude (mau/app op (args...)).
-; Inputs become argument subterms (recursively from the DAG). A trailing
-; "artdag:meta" subterm carries the params (a write-to-string token) and the
-; commutativity flag, so the encoding is lossless and dag->term->dag is the
-; identity on canonical (content-id) form. Commutative ops map to maude AC
-; operators in the optimizer module, so input order is irrelevant there —
-; mirroring the content-id's order-insensitivity for commutative nodes.
-;
-; maude (lib/maude) is a READ-ONLY consumed substrate: mau/app, mau/const,
-; mau/op, mau/args, mau/app? are its term constructors/accessors.
-
-; ---- list helpers (no host last/but-last) ----
-
-(define
-  artdag/mb-last
-  (fn
-    (xs)
-    (if (empty? (rest xs)) (first xs) (artdag/mb-last (rest xs)))))
-
-(define
-  artdag/mb-but-last
-  (fn
-    (xs)
-    (if
-      (empty? (rest xs))
-      (list)
-      (cons (first xs) (artdag/mb-but-last (rest xs))))))
-
-; ---- params <-> token ----
-; params are keyword-keyed dicts; write-to-string/read round-trips them
-; (key order may differ but the dicts compare structurally equal).
-
-(define artdag/mb-meta-op "artdag:meta")
-
-(define artdag/params->token (fn (params) (write-to-string params)))
-
-(define artdag/token->params (fn (token) (read (open-input-string token))))
-
-(define
-  artdag/mb-meta-term
-  (fn
-    (params commutative)
-    (mau/app
-      artdag/mb-meta-op
-      (list
-        (mau/const (artdag/params->token params))
-        (mau/const (if commutative "c" "n"))))))
-
-(define
-  artdag/mb-meta-term?
-  (fn (t) (and (mau/app? t) (= (mau/op t) artdag/mb-meta-op))))
-
-; ---- dag -> term ----
-
-(define
-  artdag/node->term
-  (fn
-    (node input-terms)
-    (mau/app
-      (artdag/node-op node)
-      (concat
-        input-terms
-        (list
-          (artdag/mb-meta-term
-            (artdag/node-params node)
-            (get node :commutative)))))))
-
-(define
-  artdag/dag->term
-  (fn
-    (dag id)
-    (let
-      ((node (artdag/dag-get dag id)))
-      (artdag/node->term
-        node
-        (map (fn (in) (artdag/dag->term dag in)) (artdag/node-inputs node))))))
-
-; ---- term -> dag ----
-; build-entries with synthesized local names; artdag/build recomputes content-ids
-; (which are name-independent), so the reconstructed dag is identical on canonical
-; form. Shared subterms re-collapse to one node/id during build's dedup.
-
-(define artdag/term-meta (fn (t) (artdag/mb-last (mau/args t))))
-
-(define artdag/term-input-terms (fn (t) (artdag/mb-but-last (mau/args t))))
-
-(define
-  artdag/term-params
-  (fn
-    (t)
-    (artdag/token->params (mau/op (first (mau/args (artdag/term-meta t)))))))
-
-(define
-  artdag/term-commutative
-  (fn
-    (t)
-    (= "c" (mau/op (nth (mau/args (artdag/term-meta t)) 1)))))
-
-(define
-  artdag/term->build
-  (fn
-    (t counter acc)
-    (let
-      ((built (reduce (fn (st child) (let ((r (artdag/term->build child (get st :counter) (get st :acc)))) {:counter (get r :counter) :acc (get r :acc) :names (concat (get st :names) (list (get r :name)))})) {:counter counter :acc acc :names (list)} (artdag/term-input-terms t))))
-      (let ((my-name (str "mb" (get built :counter)))) {:name my-name :counter (+ (get built :counter) 1) :acc (concat (get built :acc) (list (list my-name (mau/op t) (get built :names) (artdag/term-params t) (artdag/term-commutative t))))}))))
-
-(define
-  artdag/term->entries
-  (fn (t) (get (artdag/term->build t 0 (list)) :acc)))
-
-(define artdag/term->dag (fn (t) (artdag/build (artdag/term->entries t))))
-
-; ---- round-trip convenience ----
-
-(define
-  artdag/mb-roundtrip
-  (fn (dag id) (artdag/term->dag (artdag/dag->term dag id))))

lib/artdag/optimize-rules.sx

@@ -1,213 +0,0 @@
-; lib/artdag/optimize-rules.sx — Phase 7: optimisation laws as a confluent maude module.
-; The optimised effect pipeline IS the normal form of the rule set, so confluence
-; (mau/confluent?) is exactly content-id stability: every rewrite order reaches the
-; same normal form. Media ops (blur/bright/id/over) are the opaque-op model from
-; lib/maude/tests/effects.sx — the engine reasons about the pipeline algebra, never
-; pixels. The radius algebra is an AC operator with identity 0 (unary 1s): Peano
-; successor rules (s M + N = s(M+N), 0 + N = N) are NOT confluent here (the symbolic
-; critical pairs M + 0 and (A+B)+C vs A+(B+C) stick), whereas [assoc comm id: 0]
-; joins them via canonical form. maude (lib/maude) is a READ-ONLY consumed substrate:
-; mau/parse-module, mau/creduce, mau/creduce->str, mau/ccanon, mau/confluent?,
-; mau/non-joinable-pairs, mau/cp->str, mau/app/const/op/args/app?.
-
-(define
-  artdag/opt-module-src
-  (str
-    "fmod ARTDAGOPT is\n"
-    "  sorts Img Num .\n"
-    "  op 0 : -> Num .\n"
-    "  op 1 : -> Num .\n"
-    "  op _+_ : Num Num -> Num [assoc comm id: 0] .\n"
-    "  op blur : Img Num -> Img .\n"
-    "  op bright : Img Num -> Img .\n"
-    "  op id : Img -> Img .\n"
-    "  op over : Img Img -> Img [comm] .\n"
-    "  vars I J : Img .\n"
-    "  vars M N : Num .\n"
-    "  eq id(I) = I .\n"
-    "  eq blur(I, 0) = I .\n"
-    "  eq bright(I, 0) = I .\n"
-    "  eq blur(blur(I, M), N) = blur(I, M + N) .\n"
-    "  eq bright(bright(I, M), N) = bright(I, M + N) .\n"
-    "  eq over(I, I) = I .\n"
-    "endfm"))
-
-(define artdag/opt-module (mau/parse-module artdag/opt-module-src))
-
-; ops whose last term arg is the radius (Num); other args are image inputs.
-(define artdag/opt-radius-ops (list "blur" "bright"))
-; commutative ops (mirror the content-id's order-insensitivity).
-(define artdag/opt-comm-ops (list "over"))
-
-; ---- reduce a surface pipeline (source string) to its optimised normal form ----
-
-(define
-  artdag/opt-reduce-term
-  (fn (src) (mau/creduce-term artdag/opt-module src)))
-
-(define
-  artdag/opt-normal-form
-  (fn (src) (mau/creduce->str artdag/opt-module src)))
-
-(define artdag/opt-canon (fn (src) (mau/ccanon artdag/opt-module src)))
-
-; two surface pipelines optimise to the same pipeline (=> same content id) iff
-; their normal forms coincide.
-(define
-  artdag/opt-same-form?
-  (fn (a b) (= (artdag/opt-normal-form a) (artdag/opt-normal-form b))))
-
-; ---- confluence / content-id stability (consume lib/maude/confluence.sx) ----
-
-(define artdag/opt-confluent? (fn () (mau/confluent? artdag/opt-module)))
-
-(define
-  artdag/opt-non-joinable
-  (fn () (mau/non-joinable-pairs artdag/opt-module)))
-
-(define
-  artdag/opt-non-joinable->strs
-  (fn
-    ()
-    (map
-      (fn (cp) (mau/cp->str artdag/opt-module cp))
-      (artdag/opt-non-joinable))))
-
-; ---- radius <-> unary Num term ----
-
-(define
-  artdag/num->unary
-  (fn
-    (n)
-    (if
-      (<= n 0)
-      (mau/const "0")
-      (reduce
-        (fn (acc i) (mau/app "_+_" (list acc (mau/const "1"))))
-        (mau/const "1")
-        (range 1 n)))))
-
-(define
-  artdag/unary->num
-  (fn
-    (t)
-    (let
-      ((op (mau/op t)))
-      (cond
-        ((= op "1") 1)
-        ((= op "_+_")
-          (reduce
-            (fn (a x) (+ a (artdag/unary->num x)))
-            0
-            (mau/args t)))
-        (else 0)))))
-
-; ---- dag cone -> opt-term ----
-; leaves -> nullary const (op name); a :radius node -> op(inputs..., unary radius);
-; any other op -> op(inputs...). over (commutative) maps to the module's comm op.
-
-(define
-  artdag/dag->opt-term
-  (fn
-    (dag id)
-    (let
-      ((node (artdag/dag-get dag id)))
-      (let
-        ((op (artdag/node-op node))
-          (ins
-            (map
-              (fn (i) (artdag/dag->opt-term dag i))
-              (artdag/node-inputs node)))
-          (params (artdag/node-params node)))
-        (if
-          (empty? ins)
-          (mau/const op)
-          (if
-            (artdag/member? op artdag/opt-radius-ops)
-            (mau/app
-              op
-              (concat ins (list (artdag/num->unary (get params :radius)))))
-            (mau/app op ins)))))))
-
-; ---- opt-term -> build entries (synthesized names; build recomputes content-ids) ----
-
-(define
-  artdag/opt-last
-  (fn
-    (xs)
-    (if (empty? (rest xs)) (first xs) (artdag/opt-last (rest xs)))))
-
-(define
-  artdag/opt-but-last
-  (fn
-    (xs)
-    (if
-      (empty? (rest xs))
-      (list)
-      (cons (first xs) (artdag/opt-but-last (rest xs))))))
-
-(define
-  artdag/opt-term->build
-  (fn
-    (t counter acc)
-    (if
-      (not (mau/app? t))
-      (let ((nm (str "ob" counter))) {:name nm :acc (concat acc (list (list nm (mau/op t) (list) {}))) :counter (+ counter 1)})
-      (let
-        ((op (mau/op t))
-          (radius? (artdag/member? (mau/op t) artdag/opt-radius-ops)))
-        (let
-          ((in-terms (if radius? (artdag/opt-but-last (mau/args t)) (mau/args t)))
-            (params (if radius? {:radius (artdag/unary->num (artdag/opt-last (mau/args t)))} {}))
-            (comm? (artdag/member? op artdag/opt-comm-ops)))
-          (let
-            ((built (reduce (fn (st ct) (let ((r (artdag/opt-term->build ct (get st :counter) (get st :acc)))) {:acc (get r :acc) :counter (get r :counter) :names (concat (get st :names) (list (get r :name)))})) {:acc acc :counter counter :names (list)} in-terms)))
-            (let ((nm (str "ob" (get built :counter)))) {:name nm :acc (concat (get built :acc) (list (list nm op (get built :names) params comm?))) :counter (+ (get built :counter) 1)})))))))
-
-(define
-  artdag/opt-term->entries
-  (fn (t) (get (artdag/opt-term->build t 0 (list)) :acc)))
-
-; ---- optimise a DAG via maude: encode -> creduce -> decode -> rebuild ----
-; result-preserving: the optimised DAG executes to the same result as the original.
-(define
-  artdag/opt-reduce
-  (fn
-    (dag id)
-    (artdag/build
-      (artdag/opt-term->entries
-        (mau/creduce artdag/opt-module (artdag/dag->opt-term dag id))))))
-
-; content-id of the optimised sink (the head of the reduced term's rebuilt DAG).
-(define
-  artdag/opt-reduce-sink
-  (fn
-    (dag id)
-    (let
-      ((o (artdag/opt-reduce dag id)))
-      (artdag/opt-last (artdag/dag-order o)))))
-
-; ---- cost-directed: the maude-optimised cone never costs more than the original ----
-; compares the original output cone (dce to id) against the maude-reduced DAG under an
-; injected cost-fn (op params). Monotone per-node costs => optimisation is never a
-; pessimisation: fewer nodes (DCE/dedup) and fused ops (one blur(M+N) for two blurs).
-
-(define
-  artdag/opt-improvement
-  (fn
-    (dag id cost-fn)
-    (let
-      ((orig (artdag/dce dag (list id))) (opt (artdag/opt-reduce dag id)))
-      {:before (artdag/total-work orig cost-fn)
-        :after (artdag/total-work opt cost-fn)
-        :before-path (artdag/critical-path orig cost-fn)
-        :after-path (artdag/critical-path opt cost-fn)
-        :optimized opt})))
-
-(define
-  artdag/opt-cheaper?
-  (fn
-    (dag id cost-fn)
-    (let
-      ((imp (artdag/opt-improvement dag id cost-fn)))
-      (<= (get imp :after) (get imp :before)))))

lib/artdag/post.sx

@@ -1,68 +0,0 @@
-; lib/artdag/post.sx — project an artdag job to/from a feed "post object", so a job
-; can ride as the :object of a feed activity ({:actor :verb :object :at :tags}) per the
-; host loop. A post object is content-addressed and self-verifying:
-;   {:type "artdag/job" :id <content-id of the output node> :wire <dag->wire>}
-; The :id IS the post/object id (the stable structural digest = natural AP object id);
-; the :wire is the self-describing, write/read-safe payload from serialize.sx whose
-; records each carry their own content-id. The dag<->feed-activity wrapping (actor/verb/
-; at/tags) stays on the host/feed side; this file is only the job<->object projection.
-; Depends on dag.sx + serialize.sx (and execute.sx for post-run).
-
-(define artdag/post-type "artdag/job")
-
-; a job = a dag + the output node (by author name) the post is "about".
-(define artdag/job->post-object (fn (dag output-name) {:id (artdag/dag-id dag output-name) :type artdag/post-type :wire (artdag/dag->wire dag)}))
-
-(define
-  artdag/post-object?
-  (fn
-    (x)
-    (and
-      (= (type-of x) "dict")
-      (= (get x :type) artdag/post-type)
-      (has-key? x :id)
-      (has-key? x :wire))))
-
-(define artdag/post-object-id (fn (post) (get post :id)))
-
-(define artdag/post-object-wire (fn (post) (get post :wire)))
-
-; integrity: the payload's records each verify (id == recomputed content-id) AND the
-; claimed post id is actually produced by the job (present among the wire records).
-(define
-  artdag/post-object-verify
-  (fn
-    (post)
-    (and
-      (artdag/post-object? post)
-      (artdag/wire-verify (get post :wire))
-      (artdag/member?
-        (get post :id)
-        (map (fn (rec) (nth rec 0)) (get post :wire))))))
-
-; decode the payload back into a runnable dag (pure; verify separately, mirroring
-; serialize.sx's wire->dag / wire-verify split).
-(define
-  artdag/post-object->job
-  (fn (post) (artdag/wire->dag (get post :wire))))
-
-; ---- string transport (drop into a feed activity / SXTP body) ----
-
-(define
-  artdag/job->post-string
-  (fn
-    (dag output-name)
-    (write-to-string (artdag/job->post-object dag output-name))))
-
-(define artdag/post-string->object (fn (s) (read (open-input-string s))))
-
-; ---- run a received post: decode -> run -> result at the post id ----
-; the peer recomputes the job (content-addressed, so a warm cache hits everything it
-; already has). Returns the result of the output node the post is about.
-(define
-  artdag/post-run
-  (fn
-    (post runner cache)
-    (artdag/result-of
-      (artdag/run (artdag/post-object->job post) runner cache)
-      (artdag/post-object-id post))))

lib/artdag/schedule.sx

@@ -1,139 +0,0 @@
-; lib/artdag/schedule.sx — relational scheduling on lib/minikanren CLP(FD).
-; Each node gets a slot var in [1..max-slots]; every edge (input->node) imposes
-; `fd-lt slot(input) slot(node)`. `fd-label` searches the finite domains; a solution
-; is a {node-id -> slot} assignment respecting all dependencies. Grouping by slot
-; gives parallel batches (plan.sx's batch shape). Labeling picks smallest slots
-; first, so the FIRST solution is the ASAP leveling — it agrees with plan.sx's greedy
-; Kahn waves; the relational extra is enumerating EVERY valid schedule. The
-; parallelism cap is a cardinality property, enforced by filtering labeled solutions
-; (the FD core handles precedence only). lib/minikanren is a READ-ONLY consumed
-; substrate: make-var, fd-in, fd-lt, fd-label, mk-conj, reify, stream-take, empty-s.
-
-(define
-  artdag/range1
-  (fn (n) (map (fn (i) (+ i 1)) (range 0 n))))
-
-(define
-  artdag/-zip-assoc
-  (fn
-    (ids vals)
-    (reduce
-      (fn (m p) (assoc m (first p) (nth p 1)))
-      {}
-      (zip ids vals))))
-
-; build the constraint goal + the ordered slot vars for a dag over domain 1..maxslots.
-(define
-  artdag/sched-goal-and-vars
-  (fn
-    (dag maxslots)
-    (let
-      ((ids (artdag/dag-order dag)))
-      (let
-        ((vars (map (fn (id) (make-var)) ids)))
-        (let
-          ((id->var (artdag/-zip-assoc ids vars))
-            (dom (artdag/range1 maxslots)))
-          (let
-            ((in-goals (map (fn (v) (fd-in v dom)) vars))
-              (lt-goals
-                (reduce
-                  (fn
-                    (acc id)
-                    (concat
-                      acc
-                      (map
-                        (fn
-                          (inp)
-                          (fd-lt (get id->var inp) (get id->var id)))
-                        (artdag/node-inputs (artdag/dag-get dag id)))))
-                  (list)
-                  ids)))
-            {:goal (apply mk-conj (concat in-goals lt-goals (list (fd-label vars)))) :vars vars :ids ids}))))))
-
-(define
-  artdag/-sched-solutions
-  (fn
-    (g limit)
-    (map
-      (fn (sol) (artdag/-zip-assoc (get g :ids) sol))
-      (map
-        (fn (s) (reify (get g :vars) s))
-        (stream-take limit ((get g :goal) empty-s))))))
-
-; all valid dependency-respecting slot assignments within 1..maxslots.
-(define
-  artdag/schedules
-  (fn
-    (dag maxslots)
-    (artdag/-sched-solutions
-      (artdag/sched-goal-and-vars dag maxslots)
-      -1)))
-
-; one valid assignment (ASAP within the bound), or nil if maxslots is too small.
-(define
-  artdag/schedule
-  (fn
-    (dag maxslots)
-    (let
-      ((ss (artdag/-sched-solutions (artdag/sched-goal-and-vars dag maxslots) 1)))
-      (if (empty? ss) nil (first ss)))))
-
-; ASAP schedule: node-count slots are always sufficient (a linear chain is the worst
-; case), and smallest-first labeling yields the tightest leveling.
-(define
-  artdag/schedule-asap
-  (fn (dag) (artdag/schedule dag (artdag/node-count dag))))
-
-(define
-  artdag/schedule-makespan
-  (fn
-    (assignment)
-    (reduce
-      (fn (m id) (max m (get assignment id)))
-      0
-      (keys assignment))))
-
-; group node-ids by slot (ascending), each batch id-sorted for determinism.
-(define
-  artdag/schedule->batches
-  (fn
-    (dag assignment)
-    (let
-      ((mx (artdag/schedule-makespan assignment)))
-      (filter
-        (fn (b) (not (empty? b)))
-        (map
-          (fn
-            (slot)
-            (artdag/sort-strings
-              (filter
-                (fn (id) (= (get assignment id) slot))
-                (keys assignment))))
-          (artdag/range1 mx))))))
-
-; independent check: every input is scheduled strictly before its consumer.
-(define
-  artdag/schedule-valid?
-  (fn
-    (dag assignment)
-    (every?
-      (fn
-        (id)
-        (every?
-          (fn (inp) (< (get assignment inp) (get assignment id)))
-          (artdag/node-inputs (artdag/dag-get dag id))))
-      (artdag/dag-order dag))))
-
-; schedules whose every slot holds <= cap nodes (parallelism cap as a post-filter).
-(define
-  artdag/schedules-capped
-  (fn
-    (dag maxslots cap)
-    (filter
-      (fn
-        (asn)
-        (every?
-          (fn (b) (<= (len b) cap))
-          (artdag/schedule->batches dag asn)))
-      (artdag/schedules dag maxslots))))

lib/artdag/scoreboard.json

@@ -9,12 +9,9 @@
     "cost": {"pass": 13, "fail": 0},
     "serialize": {"pass": 13, "fail": 0},
     "stats": {"pass": 12, "fail": 0},
-    "fault": {"pass": 14, "fail": 0},
-    "post": {"pass": 12, "fail": 0},
-    "maude-optimize": {"pass": 40, "fail": 0},
-    "schedule": {"pass": 15, "fail": 0}
+    "fault": {"pass": 14, "fail": 0}
   },
-  "total_pass": 225,
+  "total_pass": 158,
   "total_fail": 0,
-  "total": 225
+  "total": 158
 }

lib/artdag/scoreboard.md

@@ -14,7 +14,4 @@ _Generated by `lib/artdag/conformance.sh`_
 | serialize | 13 | 0 | 13 |
 | stats | 12 | 0 | 12 |
 | fault | 14 | 0 | 14 |
-| post | 12 | 0 | 12 |
-| maude-optimize | 40 | 0 | 40 |
-| schedule | 15 | 0 | 15 |
-| **Total** | **225** | **0** | **225** |
+| **Total** | **158** | **0** | **158** |

lib/artdag/tests/maude-optimize.sx

@@ -1,345 +0,0 @@
-; Phase 7 — rule-based optimization via maude-on-sx.
-; Bridge round-trip: dag->term->dag is the identity on canonical (content-id) form.
-
-; ---- linear chain a -> b -> c (b carries params) ----
-
-(define
-  mo-chain
-  (artdag/build
-    (list
-      (list "a" "in" (list) {:v 5})
-      (list "b" "blur" (list "a") {:radius 2})
-      (list "c" "blur" (list "b") {:radius 3}))))
-(define mo-c-id (artdag/dag-id mo-chain "c"))
-(define mo-chain-rt (artdag/mb-roundtrip mo-chain mo-c-id))
-
-(artdag-test
-  "roundtrip: sink id preserved"
-  (artdag/member? mo-c-id (keys (artdag/dag-nodes mo-chain-rt)))
-  true)
-
-(artdag-test
-  "roundtrip: node count preserved"
-  (artdag/node-count mo-chain-rt)
-  3)
-
-(artdag-test
-  "roundtrip: sink op preserved"
-  (artdag/node-op (artdag/dag-get mo-chain-rt mo-c-id))
-  "blur")
-
-(artdag-test
-  "roundtrip: sink params preserved"
-  (artdag/node-params (artdag/dag-get mo-chain-rt mo-c-id))
-  {:radius 3})
-
-(artdag-test
-  "roundtrip: full reconstructed node equals original"
-  (= (artdag/dag-get mo-chain-rt mo-c-id) (artdag/dag-get mo-chain mo-c-id))
-  true)
-
-; ---- term shape ----
-
-(define mo-c-term (artdag/dag->term mo-chain mo-c-id))
-
-(artdag-test "term: sink op is the maude operator" (mau/op mo-c-term) "blur")
-
-(artdag-test
-  "term: params recovered from meta"
-  (artdag/term-params mo-c-term)
-  {:radius 3})
-
-(artdag-test
-  "term: commutative flag recovered (false)"
-  (artdag/term-commutative mo-c-term)
-  false)
-
-(artdag-test
-  "term->entries: one entry per node"
-  (len (artdag/term->entries mo-c-term))
-  3)
-
-; ---- commutative node: order-insensitive id survives round-trip ----
-
-(define
-  mo-comm
-  (artdag/build
-    (list
-      (list "x" "src" (list) {})
-      (list "y" "noise" (list) {})
-      (list "z" "over" (list "x" "y") {} true))))
-(define mo-z-id (artdag/dag-id mo-comm "z"))
-(define mo-comm-rt (artdag/mb-roundtrip mo-comm mo-z-id))
-
-(artdag-test
-  "roundtrip comm: commutative id preserved"
-  (artdag/member? mo-z-id (keys (artdag/dag-nodes mo-comm-rt)))
-  true)
-
-(artdag-test
-  "term comm: commutative flag recovered (true)"
-  (artdag/term-commutative (artdag/dag->term mo-comm mo-z-id))
-  true)
-
-; ---- diamond: shared subgraph re-collapses to one node ----
-
-(define
-  mo-diamond
-  (artdag/build
-    (list
-      (list "a" "src" (list) {})
-      (list "b" "blur" (list "a") {:radius 1})
-      (list "c" "bright" (list "a") {:gain 2})
-      (list "d" "over" (list "b" "c") {} true))))
-(define mo-d-id (artdag/dag-id mo-diamond "d"))
-(define mo-diamond-rt (artdag/mb-roundtrip mo-diamond mo-d-id))
-
-(artdag-test
-  "roundtrip diamond: shared node not duplicated"
-  (artdag/node-count mo-diamond-rt)
-  4)
-
-(artdag-test
-  "roundtrip diamond: sink id preserved"
-  (artdag/member? mo-d-id (keys (artdag/dag-nodes mo-diamond-rt)))
-  true)
-
-(artdag-test
-  "roundtrip diamond: shared src id preserved"
-  (artdag/member?
-    (artdag/dag-id mo-diamond "a")
-    (keys (artdag/dag-nodes mo-diamond-rt)))
-  true)
-
-; ---- optimisation laws as a confluent maude module (optimize-rules.sx) ----
-; The optimised pipeline is the normal form; confluence => stable content id.
-
-(artdag-test "opt module is confluent" (artdag/opt-confluent?) true)
-
-(artdag-test
-  "opt module has no non-joinable critical pairs"
-  (len (artdag/opt-non-joinable))
-  0)
-
-(artdag-test
-  "law: identity elimination"
-  (artdag/opt-normal-form "id(src)")
-  "src")
-
-(artdag-test
-  "law: zero-radius blur is a no-op"
-  (artdag/opt-normal-form "blur(src, 0)")
-  "src")
-
-(artdag-test
-  "law: zero-radius bright is a no-op"
-  (artdag/opt-normal-form "bright(src, 0)")
-  "src")
-
-(artdag-test
-  "law: adjacent blur fusion adds radii"
-  (artdag/opt-normal-form "blur(blur(src, 1), 1)")
-  "blur(src, _+_(1, 1))")
-
-(artdag-test
-  "fusion normal form is rewrite-order stable"
-  (artdag/opt-same-form?
-    "blur(blur(blur(src, 1), 1), 1)"
-    "blur(blur(src, 1 + 1), 1)")
-  true)
-
-(artdag-test
-  "laws compose: id + no-op + fusion"
-  (artdag/opt-normal-form "bright(id(blur(blur(src, 1), 1)), 0)")
-  "blur(src, _+_(1, 1))")
-
-(artdag-test
-  "law: idempotent over dedup (CSE)"
-  (artdag/opt-normal-form "over(blur(src, 1), blur(src, 1))")
-  "blur(src, 1)")
-
-(artdag-test
-  "distinct over operands do not dedup"
-  (artdag/opt-same-form? "over(blur(src, 1), blur(src, 1 + 1))" "blur(src, 1)")
-  false)
-
-(artdag-test
-  "distinct pipelines stay distinct"
-  (artdag/opt-same-form? "blur(src, 1)" "bright(src, 1)")
-  false)
-
-; ---- bridge the normal form back to a runnable DAG (opt-reduce) ----
-; result-preserving: the maude-optimised DAG executes to the same result as the
-; original, with fewer nodes. Runner is a numeric op model (blur/bright additive in
-; radius, id pass-through, over idempotent) so the pipeline algebra holds concretely.
-
-(define
-  mo-eq-runner
-  (artdag/op-table-runner
-    {:src (fn (params inputs) 0)
-      :blur (fn (params inputs) (+ (first inputs) (get params :radius)))
-      :bright (fn (params inputs) (+ (first inputs) (* 100 (get params :radius))))
-      :id (fn (params inputs) (first inputs))
-      :over (fn (params inputs) (if (= (nth inputs 0) (nth inputs 1)) (nth inputs 0) (+ (nth inputs 0) (nth inputs 1))))}))
-
-(define
-  mo-eq-result
-  (fn (dag id) (artdag/result-of (artdag/run dag mo-eq-runner (persist/open)) id)))
-
-(define
-  mo-eq-opt-result
-  (fn
-    (dag id)
-    (let
-      ((o (artdag/opt-reduce dag id)))
-      (artdag/result-of (artdag/run o mo-eq-runner (persist/open)) (artdag/opt-last (artdag/dag-order o))))))
-
-; fixture: blur;blur chain + id + zero-radius bright (all collapse to one blur)
-(define
-  mo-chain5
-  (artdag/build
-    (list
-      (list "s" "src" (list) {})
-      (list "b1" "blur" (list "s") {:radius 1})
-      (list "b2" "blur" (list "b1") {:radius 1})
-      (list "i" "id" (list "b2") {})
-      (list "z" "bright" (list "i") {:radius 0}))))
-(define mo-chain5-id (artdag/dag-id mo-chain5 "z"))
-(define mo-chain5-opt (artdag/opt-reduce mo-chain5 mo-chain5-id))
-(define mo-chain5-sink (artdag/opt-last (artdag/dag-order mo-chain5-opt)))
-
-(artdag-test
-  "opt-reduce: 5-node chain collapses to 2 nodes"
-  (artdag/node-count mo-chain5-opt)
-  2)
-
-(artdag-test
-  "opt-reduce: fused sink op is blur"
-  (artdag/node-op (artdag/dag-get mo-chain5-opt mo-chain5-sink))
-  "blur")
-
-(artdag-test
-  "opt-reduce: fused sink radius is the sum"
-  (artdag/node-params (artdag/dag-get mo-chain5-opt mo-chain5-sink))
-  {:radius 2})
-
-(artdag-test
-  "opt-reduce: result-preserving on chain"
-  (= (mo-eq-result mo-chain5 mo-chain5-id) (mo-eq-opt-result mo-chain5 mo-chain5-id))
-  true)
-
-; fixture: over of identical subpipelines (idempotent dedup)
-(define
-  mo-dedup
-  (artdag/build
-    (list
-      (list "s" "src" (list) {})
-      (list "b" "blur" (list "s") {:radius 2})
-      (list "o" "over" (list "b" "b") {} true))))
-(define mo-dedup-id (artdag/dag-id mo-dedup "o"))
-
-(artdag-test
-  "opt-reduce: over dedup collapses to 2 nodes"
-  (artdag/node-count (artdag/opt-reduce mo-dedup mo-dedup-id))
-  2)
-
-(artdag-test
-  "opt-reduce: result-preserving on dedup"
-  (= (mo-eq-result mo-dedup mo-dedup-id) (mo-eq-opt-result mo-dedup mo-dedup-id))
-  true)
-
-; non-optimisable DAG: opt-reduce is a faithful round-trip (no laws fire)
-(define
-  mo-plain
-  (artdag/build
-    (list
-      (list "s" "src" (list) {})
-      (list "b" "blur" (list "s") {:radius 3}))))
-(define mo-plain-id (artdag/dag-id mo-plain "b"))
-(define mo-plain-opt (artdag/opt-reduce mo-plain mo-plain-id))
-
-(artdag-test
-  "opt-reduce: untouched DAG keeps its node count"
-  (artdag/node-count mo-plain-opt)
-  2)
-
-(artdag-test
-  "opt-reduce: untouched DAG keeps its radius (unary round-trip)"
-  (artdag/node-params
-    (artdag/dag-get mo-plain-opt (artdag/opt-last (artdag/dag-order mo-plain-opt))))
-  {:radius 3})
-
-; ---- cost-directed: optimisation never increases cost ----
-
-(define
-  mo-rcost
-  (fn (op params) (if (= op "blur") (max 1 (get params :radius)) 1)))
-
-(artdag-test
-  "opt-improvement: const-cost total work drops on fused chain"
-  (let ((imp (artdag/opt-improvement mo-chain5 mo-chain5-id artdag/const-cost)))
-    (list (get imp :before) (get imp :after)))
-  (list 5 2))
-
-(artdag-test
-  "opt-improvement: critical path shrinks under const cost"
-  (let ((imp (artdag/opt-improvement mo-chain5 mo-chain5-id artdag/const-cost)))
-    (< (get imp :after-path) (get imp :before-path)))
-  true)
-
-(artdag-test
-  "opt-cheaper?: fused chain is cheaper under radius-weighted cost"
-  (artdag/opt-cheaper? mo-chain5 mo-chain5-id mo-rcost)
-  true)
-
-(artdag-test
-  "opt-cheaper?: over dedup is cheaper"
-  (artdag/opt-cheaper? mo-dedup mo-dedup-id artdag/const-cost)
-  true)
-
-(artdag-test
-  "opt-cheaper?: untouched DAG keeps equal cost (never a pessimisation)"
-  (artdag/opt-cheaper? mo-plain mo-plain-id artdag/const-cost)
-  true)
-
-; ---- the confluence gate is meaningful, not vacuous ----
-; the Peano-arithmetic variant of the same laws is KNOWN non-confluent (M+0 sticks,
-; (A+B)+C vs A+(B+C) don't join). Assert the checker actually catches it, so the
-; green "opt module is confluent" above is real evidence, not a checker that passes
-; everything.
-
-(define
-  mo-peano-module
-  (mau/parse-module
-    (str
-      "fmod ARTDAGPEANO is\n"
-      "  sorts Img Num .\n"
-      "  op src : -> Img .\n"
-      "  op 0 : -> Num .\n"
-      "  op s_ : Num -> Num .\n"
-      "  op _+_ : Num Num -> Num .\n"
-      "  op blur : Img Num -> Img .\n"
-      "  op bright : Img Num -> Img .\n"
-      "  op id : Img -> Img .\n"
-      "  op over : Img Img -> Img [comm] .\n"
-      "  vars I J : Img .\n"
-      "  vars M N : Num .\n"
-      "  eq 0 + N = N .\n"
-      "  eq s M + N = s (M + N) .\n"
-      "  eq id(I) = I .\n"
-      "  eq blur(I, 0) = I .\n"
-      "  eq bright(I, 0) = I .\n"
-      "  eq blur(blur(I, M), N) = blur(I, M + N) .\n"
-      "  eq bright(bright(I, M), N) = bright(I, M + N) .\n"
-      "  eq over(I, I) = I .\n"
-      "endfm")))
-
-(artdag-test
-  "confluence gate is real: Peano variant is flagged non-confluent"
-  (mau/confluent? mo-peano-module)
-  false)
-
-(artdag-test
-  "confluence gate is real: Peano variant names its non-joinable pairs"
-  (> (len (mau/non-joinable-pairs mo-peano-module)) 0)
-  true)

lib/artdag/tests/post.sx

@@ -1,111 +0,0 @@
-; Forward direction — artdag job as a feed "post object" (per the host loop).
-; A job projects to a content-addressed, self-verifying object suitable as a feed
-; activity :object; a peer decodes, verifies and runs it to the same result.
-
-(define po-runner (artdag/op-table-runner {:blur (fn (params inputs) (+ (first inputs) (get params :radius))) :src (fn (params inputs) 0) :over (fn (params inputs) (+ (nth inputs 0) (nth inputs 1)))}))
-
-(define
-  po-job
-  (artdag/build
-    (list
-      (list "s" "src" (list) {})
-      (list "b" "blur" (list "s") {:radius 2})
-      (list "c" "blur" (list "s") {:radius 3})
-      (list "out" "over" (list "b" "c") {} true))))
-(define po-out-id (artdag/dag-id po-job "out"))
-(define po-post (artdag/job->post-object po-job "out"))
-
-(artdag-test
-  "post: is a well-formed post object"
-  (artdag/post-object? po-post)
-  true)
-
-(artdag-test "post: type tag is artdag/job" (get po-post :type) "artdag/job")
-
-(artdag-test
-  "post: post id is the output node's content-id"
-  (artdag/post-object-id po-post)
-  po-out-id)
-
-(artdag-test
-  "post: payload is the whole dag (one record per node)"
-  (len (artdag/post-object-wire po-post))
-  (artdag/node-count po-job))
-
-(artdag-test
-  "post: verifies (ids intact, output present)"
-  (artdag/post-object-verify po-post)
-  true)
-
-; ---- round-trip: decode reconstructs the job by content-id ----
-
-(define po-job2 (artdag/post-object->job po-post))
-
-(artdag-test
-  "post: decoded job contains the output node by content-id"
-  (artdag/member? po-out-id (keys (artdag/dag-nodes po-job2)))
-  true)
-
-(artdag-test
-  "post: decoded job has the same node count"
-  (artdag/node-count po-job2)
-  (artdag/node-count po-job))
-
-; ---- string transport (feed activity / SXTP body) ----
-
-(define po-str (artdag/job->post-string po-job "out"))
-(define po-post2 (artdag/post-string->object po-str))
-
-(artdag-test
-  "post: survives string transport (id preserved)"
-  (artdag/post-object-id po-post2)
-  po-out-id)
-
-(artdag-test
-  "post: transported post still verifies"
-  (artdag/post-object-verify po-post2)
-  true)
-
-; ---- a peer runs the received post to the same result ----
-
-(define
-  po-local-result
-  (artdag/result-of (artdag/run po-job po-runner (persist/open)) po-out-id))
-(define po-peer-result (artdag/post-run po-post2 po-runner (persist/open)))
-
-(artdag-test
-  "post: peer runs the received job to the same result"
-  (= po-peer-result po-local-result)
-  true)
-
-; ---- tamper detection: mutate a param under a stale id ----
-
-(define
-  po-tampered
-  (assoc
-    po-post
-    :wire (map
-      (fn
-        (rec)
-        (if
-          (= (nth rec 1) "blur")
-          (list
-            (nth rec 0)
-            (nth rec 1)
-            (nth rec 2)
-            {:radius 99}
-            (nth rec 4))
-          rec))
-      (artdag/post-object-wire po-post))))
-
-(artdag-test
-  "post: tampered payload fails verification"
-  (artdag/post-object-verify po-tampered)
-  false)
-
-; ---- an id not produced by the job fails verification ----
-
-(artdag-test
-  "post: post id absent from payload fails verification"
-  (artdag/post-object-verify (assoc po-post :id "node:bogus"))
-  false)

lib/artdag/tests/schedule.sx

@@ -1,127 +0,0 @@
-; Phase 3/7 (optional) — relational scheduling on lib/minikanren CLP(FD).
-; Each node gets a slot var; edges impose fd-lt; fd-label searches. The ASAP solution
-; agrees with plan.sx's greedy Kahn waves; enumerating all solutions is the extra.
-
-; ---- linear chain a -> b -> c: exactly one minimal schedule ----
-
-(define
-  sc-chain
-  (artdag/build
-    (list
-      (list "a" "src" (list) {})
-      (list "b" "blur" (list "a") {:radius 1})
-      (list "c" "blur" (list "b") {:radius 2}))))
-(define sc-chain-a (artdag/dag-id sc-chain "a"))
-(define sc-chain-b (artdag/dag-id sc-chain "b"))
-(define sc-chain-c (artdag/dag-id sc-chain "c"))
-(define sc-chain-asap (artdag/schedule-asap sc-chain))
-
-(artdag-test "chain: ASAP schedule exists" (nil? sc-chain-asap) false)
-
-(artdag-test
-  "chain: slots are strictly increasing along the chain"
-  (list
-    (get sc-chain-asap sc-chain-a)
-    (get sc-chain-asap sc-chain-b)
-    (get sc-chain-asap sc-chain-c))
-  (list 1 2 3))
-
-(artdag-test
-  "chain: makespan equals chain length"
-  (artdag/schedule-makespan sc-chain-asap)
-  3)
-
-(artdag-test
-  "chain: exactly one schedule when slots = node count (no slack)"
-  (len (artdag/schedules sc-chain 3))
-  1)
-
-(artdag-test
-  "chain: ASAP batches are one node per slot"
-  (map len (artdag/schedule->batches sc-chain sc-chain-asap))
-  (list 1 1 1))
-
-(artdag-test
-  "chain: ASAP schedule is valid (deps respected)"
-  (artdag/schedule-valid? sc-chain sc-chain-asap)
-  true)
-
-; ---- diamond a -> b,c -> d: b and c are parallel ----
-
-(define
-  sc-dia
-  (artdag/build
-    (list
-      (list "a" "src" (list) {})
-      (list "b" "blur" (list "a") {:radius 1})
-      (list "c" "bright" (list "a") {:radius 1})
-      (list "d" "over" (list "b" "c") {} true))))
-(define sc-dia-asap (artdag/schedule-asap sc-dia))
-
-(artdag-test
-  "diamond: ASAP makespan is 3 (a | b,c | d)"
-  (artdag/schedule-makespan sc-dia-asap)
-  3)
-
-(artdag-test
-  "diamond: ASAP batch sizes are 1,2,1"
-  (map len (artdag/schedule->batches sc-dia sc-dia-asap))
-  (list 1 2 1))
-
-(artdag-test
-  "diamond: FD ASAP batches agree with plan.sx greedy waves"
-  (=
-    (artdag/schedule->batches sc-dia sc-dia-asap)
-    (map artdag/sort-strings (artdag/plan sc-dia 0)))
-  true)
-
-(artdag-test
-  "diamond: every enumerated schedule is valid"
-  (every?
-    (fn (asn) (artdag/schedule-valid? sc-dia asn))
-    (artdag/schedules sc-dia 4))
-  true)
-
-(artdag-test
-  "diamond: b and c share a slot in the ASAP schedule"
-  (=
-    (get sc-dia-asap (artdag/dag-id sc-dia "b"))
-    (get sc-dia-asap (artdag/dag-id sc-dia "c")))
-  true)
-
-; ---- parallelism cap: filter schedules to <= cap nodes per slot ----
-
-(artdag-test
-  "cap 1: the ASAP (b,c parallel) schedule is excluded, serial ones remain"
-  (every?
-    (fn
-      (asn)
-      (every?
-        (fn (b) (<= (len b) 1))
-        (artdag/schedule->batches sc-dia asn)))
-    (artdag/schedules-capped sc-dia 4 1))
-  true)
-
-(artdag-test
-  "cap 1: at least one serial schedule exists within 4 slots"
-  (> (len (artdag/schedules-capped sc-dia 4 1)) 0)
-  true)
-
-(artdag-test
-  "cap 2: admits the parallel ASAP schedule"
-  (if
-    (some
-      (fn (shape) (= shape (list 1 2 1)))
-      (map
-        (fn (asn) (map len (artdag/schedule->batches sc-dia asn)))
-        (artdag/schedules-capped sc-dia 4 2)))
-    true
-    false)
-  true)
-
-; ---- unsatisfiable: too few slots for the chain ----
-
-(artdag-test
-  "chain: no schedule when slots < chain length"
-  (nil? (artdag/schedule sc-chain 2))
-  true)

lib/common-lisp/runtime.sx

@@ -758,3 +758,23 @@
       (cl-restart-case
         (fn () (cl-signal-obj obj cl-handler-stack))
         (list "continue" (list) (fn () nil))))))
+;; ── JIT interpret-only boundary ───────────────────────────────────────────
+;; The Common-Lisp evaluator implements block/return-from, catch/throw, and
+;; the condition system via non-local control (host continuations); under JIT
+;; a compiled frame can't transfer control through a CEK continuation. Exclude
+;; the cl-/clos- namespaces from JIT. See Sx_types.jit_excluded_prefixes.
+(jit-exclude! "cl-*" "clos-*")
+
+;; cl-restart-case / cl-handler-case / cl-handler-bind wrap their body in
+;; call/cc (restarts + non-local handler exit). Any function that CALLS one of
+;; these (e.g. SX fixtures driving the condition system: parse-recover,
+;; interactive-debugger) must also be interpret-only: JIT'ing such a caller
+;; forces the call/cc form into a nested cek-run where the captured
+;; continuation runs-to-completion-and-returns instead of escaping, so a
+;; restart fails to abort and the body falls through (accumulation/no-abort).
+(jit-exclude-callers-of! "cl-restart-case" "cl-handler-case" "cl-handler-bind")
+;; Also the INVOKE side: cl-invoke-restart / cl-invoke-debugger / cl-signal
+;; trigger the continuation escape; a JIT'd caller can't let the escape
+;; propagate out of its frame (e.g. make-policy-debugger building a debugger
+;; hook that invokes a restart). Mark their callers interpret-only too.
+(jit-exclude-callers-of! "cl-invoke-restart" "cl-invoke-debugger" "cl-signal" "cl-error-with-debugger")

lib/compiler.sx

@@ -783,11 +783,7 @@
                 (rest-clauses
                   (if (> (len flat-args) 2) (slice flat-args 2) (list))))
               (if
-                (or
-                  (and
-                    (= (type-of test) "keyword")
-                    (= (keyword-name test) "else"))
-                  (= test true))
+                (or (and (= (type-of test) "keyword") (= (keyword-name test) "else")) (and (= (type-of test) "symbol") (or (= (symbol-name test) "else") (= (symbol-name test) ":else"))) (= test true))
                 (compile-expr em body scope tail?)
                 (do
                   (compile-expr em test scope false)
@@ -828,11 +824,7 @@
               (rest-clauses
                 (if (> (len clauses) 2) (slice clauses 2) (list))))
             (if
-              (or
-                (and
-                  (= (type-of test) "keyword")
-                  (= (keyword-name test) "else"))
-                (= test true))
+              (or (and (= (type-of test) "keyword") (= (keyword-name test) "else")) (and (= (type-of test) "symbol") (or (= (symbol-name test) "else") (= (symbol-name test) ":else"))) (= test true))
               (do (emit-op em 5) (compile-expr em body scope tail?))
               (do
                 (emit-op em 6)
@@ -1172,11 +1164,7 @@
               (test (first clause))
               (body (rest clause)))
             (if
-              (or
-                (and
-                  (= (type-of test) "keyword")
-                  (= (keyword-name test) "else"))
-                (= test true))
+              (or (and (= (type-of test) "keyword") (= (keyword-name test) "else")) (and (= (type-of test) "symbol") (or (= (symbol-name test) "else") (= (symbol-name test) ":else"))) (= test true))
               (compile-begin em body scope tail?)
               (do
                 (compile-expr em test scope false)

lib/dream/README.md

@@ -0,0 +1,79 @@
+# dream-on-sx
+
+OCaml's [Dream](https://aantron.github.io/dream/) web framework, reimplemented in
+**plain SX** on the CEK evaluator. Dream is the cleanest middleware-shaped HTTP
+framework in any language, and it maps onto SX with almost no impedance:
+
+| Dream | SX |
+|-------|-----|
+| `handler = request -> response promise` | `(fn (req) … (perform …))` |
+| `middleware = handler -> handler` | `(fn (next) (fn (req) …))` |
+| `m1 @@ m2 @@ handler` | `(m1 (m2 handler))` — left fold |
+| `Dream.run handler` | `(dream-run handler)` → `(perform (:http/listen …))` |
+
+There are five types — **request, response, route**, and (as plain functions)
+**handler** and **middleware**. Everything else is a function over them.
+
+## Quickstart
+
+```lisp
+(dream-run
+  (dream-make-app
+    (list
+      (dream-get "/" (fn (req) (dream-html "<h1>Hello, World!</h1>")))
+      (dream-get "/hello/:name"
+        (fn (req) (dream-text (str "Hi, " (dream-param req "name"))))))))
+```
+
+`dream-make-app` wraps the router in the default stack (error catch + content-type).
+`dream-run` installs the root handler on the existing SX HTTP server — it does **not**
+open its own socket.
+
+## Public surface
+
+- **types** — `dream-request`/`dream-response`/`dream-route`, accessors
+  (`dream-method`/`-path`/`-body`/`-header`/`-query-param`/`-param`), smart
+  constructors (`dream-html`/`-text`/`-json`/`-empty`/`-not-found`/`-redirect`),
+  convenience (`dream-queries`, `*-or` defaults, `dream-accepts?`/`dream-wants-json?`).
+- **router** — `dream-get`/`-post`/`-put`/`-delete`/`-patch`/`-head`/`-options`/`-any`,
+  `dream-router`, `dream-scope` (prefix + middleware), `:name` params + `**` catch-all,
+  405 + `Allow`, automatic HEAD.
+- **middleware** — `dream-pipeline`, `dream-no-middleware`, `dream-logger`,
+  `dream-content-type`, `dream-set-header`, `dream-tap-request`.
+- **session** — `dream-sessions` / `dream-sessions-signed`, `dream-session-field` /
+  `dream-set-session-field` / `dream-session-all` / `dream-invalidate-session`; cookie
+  helpers (`dream-cookie`, `dream-set-cookie`, `dream-cookie-sign`/`-unsign`).
+- **flash** — `dream-flash`, `dream-add-flash-message`, `dream-flash-messages`.
+- **form** — `dream-form` (Ok/Err), `dream-form-fields`, `dream-multipart`, CSRF
+  (`dream-csrf` / `dream-csrf-protect` / `dream-csrf-token` / `dream-csrf-tag`).
+- **websocket** — `dream-websocket`, `dream-send`/`-receive`/`-close`/`-broadcast`.
+- **static** — `dream-static` (mime, ETags, 304, ranges, traversal guard).
+- **error** — `dream-catch`, `dream-status-text`/`-line`, `dream-status-page`.
+- **cors** — `dream-cors`, `dream-cors-origin`, `dream-cors-with`.
+- **json** — `dream-json-encode`/`-parse`, `dream-json-value`, `dream-json-body`.
+- **run / api** — `dream-run`/`-port`/`-opts`, `dream-app`, `dream-make-app`,
+  `dream-serve`.
+
+## Testing story
+
+Every effectful concern is **dependency-injected**, so the whole framework is testable
+without a running host:
+
+- sessions take a backend `(fn (op) …)` — `dream-memory-sessions` for tests,
+  `dream-perform-sessions` in production;
+- static files take an fs — `dream-memory-fs` vs `dream-static-perform-fs`;
+- websockets take an io — `dream-mock-ws` vs `dream-ws-perform-io`;
+- `dream-run` takes a listen transport (`dream-run-with`).
+
+Run the suite: `bash lib/dream/conformance.sh` (367 tests, 14 suites).
+
+## Notes & caveats
+
+- Headers are dicts with **lowercased string keys** (in SX keywords *are* strings, so
+  `:content-type` == `"content-type"`).
+- Outgoing cookies accumulate in a `:set-cookies` list on the response so multiple
+  `Set-Cookie` headers don't collide.
+- The CSRF/cookie/ETag signing uses a pure-SX keyed hash — **not cryptographic**.
+  Production should inject a host HMAC (`dream-csrf-with`, and the signed-session
+  secret path).
+- JSON and multipart are in-memory (not streaming).

lib/dream/api.sx

@@ -0,0 +1,33 @@
+;; lib/dream/api.sx — Dream-on-SX public facade.
+;; Loaded last; bundles the modules into a batteries-included surface. The full
+;; public API is the `dream-*` functions across types/router/middleware/session/
+;; flash/form/websocket/static/error/cors/json/run; this file adds convenience
+;; app builders. Depends on all other dream modules.
+
+(define dream-version "0.1.0")
+
+;; standard middleware stack (pure — no IO): error catch outermost, then
+;; content-type sniffing. Logger is opt-in since it performs host IO.
+(define
+  dream-defaults
+  (fn
+    (handler)
+    (dream-pipeline (list dream-catch dream-content-type) handler)))
+
+;; build a complete app handler from a route list with the default stack
+(define
+  dream-make-app
+  (fn (routes) (dream-defaults (dream-router routes))))
+
+;; build an app and wrap it with extra middleware (outermost first)
+(define
+  dream-make-app-with
+  (fn
+    (middlewares routes)
+    (dream-pipeline middlewares (dream-make-app routes))))
+
+;; one-call serve: routes + opts -> installed on the host
+(define
+  dream-serve
+  (fn (routes opts) (dream-run-opts (dream-make-app routes) opts)))
+(define dream-serve-port (fn (routes port) (dream-serve routes {:port port})))

lib/dream/auth.sx

@@ -0,0 +1,172 @@
+;; lib/dream/auth.sx — Dream-on-SX authentication helpers.
+;; HTTP Basic auth (with a pure-SX base64 codec) and Bearer-token guards.
+;; Depends on types.sx.
+
+;; ── base64 (pure SX; arithmetic, no bitwise) ───────────────────────
+(define
+  dr/b64-alpha
+  "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/")
+(define dr/b64-char (fn (n) (char-at dr/b64-alpha n)))
+(define dr/b64-index (fn (c) (index-of dr/b64-alpha c)))
+
+(define
+  dr/b64-encode-loop
+  (fn
+    (s i n acc)
+    (if
+      (>= i n)
+      acc
+      (let
+        ((b0 (char-code (char-at s i))) (rem (- n i)))
+        (cond
+          ((>= rem 3)
+            (let
+              ((triple (+ (* b0 65536) (* (char-code (char-at s (+ i 1))) 256) (char-code (char-at s (+ i 2))))))
+              (dr/b64-encode-loop
+                s
+                (+ i 3)
+                n
+                (str
+                  acc
+                  (dr/b64-char (mod (quotient triple 262144) 64))
+                  (dr/b64-char (mod (quotient triple 4096) 64))
+                  (dr/b64-char (mod (quotient triple 64) 64))
+                  (dr/b64-char (mod triple 64))))))
+          ((= rem 2)
+            (let
+              ((triple (+ (* b0 65536) (* (char-code (char-at s (+ i 1))) 256))))
+              (str
+                acc
+                (dr/b64-char (mod (quotient triple 262144) 64))
+                (dr/b64-char (mod (quotient triple 4096) 64))
+                (dr/b64-char (mod (quotient triple 64) 64))
+                "=")))
+          (else
+            (let
+              ((triple (* b0 65536)))
+              (str
+                acc
+                (dr/b64-char (mod (quotient triple 262144) 64))
+                (dr/b64-char (mod (quotient triple 4096) 64))
+                "=="))))))))
+
+(define
+  dream-base64-encode
+  (fn (s) (dr/b64-encode-loop s 0 (string-length s) "")))
+
+(define
+  dr/b64-decode-loop
+  (fn
+    (s i n acc)
+    (if
+      (>= i n)
+      acc
+      (let
+        ((p2 (char-at s (+ i 2)))
+          (p3 (char-at s (+ i 3))))
+        (let
+          ((c0 (dr/b64-index (char-at s i)))
+            (c1 (dr/b64-index (char-at s (+ i 1))))
+            (c2 (if (= p2 "=") 0 (dr/b64-index p2)))
+            (c3 (if (= p3 "=") 0 (dr/b64-index p3))))
+          (let
+            ((triple (+ (* c0 262144) (* c1 4096) (* c2 64) c3)))
+            (dr/b64-decode-loop
+              s
+              (+ i 4)
+              n
+              (str
+                acc
+                (char-from-code
+                  (mod (quotient triple 65536) 256))
+                (if
+                  (= p2 "=")
+                  ""
+                  (char-from-code
+                    (mod (quotient triple 256) 256)))
+                (if (= p3 "=") "" (char-from-code (mod triple 256)))))))))))
+
+(define
+  dream-base64-decode
+  (fn
+    (s)
+    (if (= s "") "" (dr/b64-decode-loop s 0 (string-length s) ""))))
+
+;; ── Authorization header parsing ───────────────────────────────────
+(define dream-authorization (fn (req) (dream-header req "authorization")))
+
+(define
+  dream-bearer-token
+  (fn
+    (req)
+    (let
+      ((a (dream-authorization req)))
+      (if (and a (starts-with? a "Bearer ")) (substr a 7) nil))))
+
+(define
+  dream-basic-credentials
+  (fn
+    (req)
+    (let
+      ((a (dream-authorization req)))
+      (if
+        (and a (starts-with? a "Basic "))
+        (let
+          ((decoded (dream-base64-decode (substr a 6))))
+          (let
+            ((colon (index-of decoded ":")))
+            (if (< colon 0) nil {:pass (substr decoded (+ colon 1)) :user (substr decoded 0 colon)})))
+        nil))))
+
+;; ── Basic auth middleware ──────────────────────────────────────────
+;; check is (fn (user pass) -> bool). On success the request gains :dream-user.
+(define
+  dr/www-authenticate
+  (fn
+    (realm)
+    (dream-add-header
+      (dream-response 401 {:content-type "text/plain; charset=utf-8"} "Unauthorized")
+      "www-authenticate"
+      (str "Basic realm=\"" realm "\""))))
+
+(define
+  dream-basic-auth
+  (fn
+    (realm check)
+    (fn
+      (next)
+      (fn
+        (req)
+        (let
+          ((creds (dream-basic-credentials req)))
+          (if
+            (and creds (check (get creds :user) (get creds :pass)))
+            (next (assoc req :dream-user (get creds :user)))
+            (dr/www-authenticate realm)))))))
+
+(define dream-user (fn (req) (get req :dream-user)))
+
+;; ── Bearer-token middleware ────────────────────────────────────────
+;; check is (fn (token) -> principal | nil). On success the request gains
+;; :dream-principal. Missing/invalid -> 401.
+(define
+  dream-require-bearer
+  (fn
+    (check)
+    (fn
+      (next)
+      (fn
+        (req)
+        (let
+          ((tok (dream-bearer-token req)))
+          (let
+            ((principal (if tok (check tok) nil)))
+            (if
+              (nil? principal)
+              (dream-add-header
+                (dream-response 401 {:content-type "text/plain; charset=utf-8"} "Unauthorized")
+                "www-authenticate"
+                "Bearer")
+              (next (assoc req :dream-principal principal)))))))))
+
+(define dream-principal (fn (req) (get req :dream-principal)))

lib/dream/conformance.sh

@@ -0,0 +1,122 @@
+#!/usr/bin/env bash
+# dream-on-sx conformance runner — loads all dream modules + test suites in one
+# sx_server process and reports pass/fail per suite.
+#
+# Usage:
+#   bash lib/dream/conformance.sh        # run all suites
+#   bash lib/dream/conformance.sh -v     # verbose (list each suite)
+
+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
+
+VERBOSE="${1:-}"
+
+# Dream library modules loaded before any test suite.
+MODULES=(
+  "lib/dream/types.sx"
+  "lib/dream/router.sx"
+  "lib/dream/middleware.sx"
+  "lib/dream/session.sx"
+  "lib/dream/flash.sx"
+  "lib/dream/form.sx"
+  "lib/dream/websocket.sx"
+  "lib/dream/static.sx"
+  "lib/dream/error.sx"
+  "lib/dream/cors.sx"
+  "lib/dream/json.sx"
+  "lib/dream/auth.sx"
+  "lib/dream/html.sx"
+  "lib/dream/headers.sx"
+  "lib/dream/run.sx"
+  "lib/dream/api.sx"
+  "lib/dream/demos/hello.sx"
+  "lib/dream/demos/counter.sx"
+  "lib/dream/demos/chat.sx"
+  "lib/dream/demos/todo.sx"
+)
+
+# Suites: NAME RUNNER-FN PATH
+SUITES=(
+  "types       dream-ty-tests-run!  lib/dream/tests/types.sx"
+  "router      dream-rt-tests-run!  lib/dream/tests/router.sx"
+  "middleware  dream-mw-tests-run!  lib/dream/tests/middleware.sx"
+  "session     dream-ss-tests-run!  lib/dream/tests/session.sx"
+  "flash       dream-fl-tests-run!  lib/dream/tests/flash.sx"
+  "form        dream-fo-tests-run!  lib/dream/tests/form.sx"
+  "websocket   dream-ws-tests-run!  lib/dream/tests/websocket.sx"
+  "static      dream-st-tests-run!  lib/dream/tests/static.sx"
+  "error       dream-er-tests-run!  lib/dream/tests/error.sx"
+  "cors        dream-co-tests-run!  lib/dream/tests/cors.sx"
+  "json        dream-js-tests-run!  lib/dream/tests/json.sx"
+  "auth        dream-au-tests-run!  lib/dream/tests/auth.sx"
+  "html        dream-ht-tests-run!  lib/dream/tests/html.sx"
+  "headers     dream-hd-tests-run!  lib/dream/tests/headers.sx"
+  "run         dream-rn-tests-run!  lib/dream/tests/run.sx"
+  "api         dream-ap-tests-run!  lib/dream/tests/api.sx"
+  "demos       dream-dm-tests-run!  lib/dream/tests/demos.sx"
+)
+
+TMPFILE=$(mktemp); trap "rm -f $TMPFILE" EXIT
+EPOCH=1
+emit_load () { echo "(epoch $EPOCH)"; echo "(load \"$1\")"; EPOCH=$((EPOCH+1)); }
+emit_eval () { echo "(epoch $EPOCH)"; echo "(eval \"$1\")"; EPOCH=$((EPOCH+1)); }
+
+{
+  for M in "${MODULES[@]}"; do emit_load "$M"; done
+  for SUITE in "${SUITES[@]}"; do
+    read -r _NAME _RUNNER FILE <<< "$SUITE"
+    emit_load "$FILE"
+    emit_eval "($_RUNNER)"
+  done
+} > "$TMPFILE"
+
+OUTPUT=$(timeout 540 "$SX_SERVER" < "$TMPFILE" 2>&1 || true)
+
+TOTAL_PASS=0
+TOTAL_FAIL=0
+FAILED_SUITES=()
+LAST_DICT_LINES=$(echo "$OUTPUT" | grep -E '^\{:' || true)
+
+I=0
+while read -r LINE; do
+  [ -z "$LINE" ] && continue
+  P=$(echo "$LINE" | grep -oE ':passed [0-9]+' | awk '{print $2}')
+  F=$(echo "$LINE" | grep -oE ':failed [0-9]+' | awk '{print $2}')
+  [ -z "$P" ] && P=0
+  [ -z "$F" ] && F=0
+  SUITE_INFO="${SUITES[$I]}"
+  SUITE_NAME=$(echo "$SUITE_INFO" | awk '{print $1}')
+  TOTAL_PASS=$((TOTAL_PASS + P))
+  TOTAL_FAIL=$((TOTAL_FAIL + F))
+  if [ "$F" -gt 0 ]; then
+    FAILED_SUITES+=("$SUITE_NAME: $P/$((P+F))")
+    printf 'X %-12s %d/%d\n' "$SUITE_NAME" "$P" "$((P+F))"
+    echo "$LINE" | grep -oE ':name "[^"]*"' | sed 's/:name /    fail: /'
+  elif [ "$VERBOSE" = "-v" ]; then
+    printf 'ok %-12s %d passed\n' "$SUITE_NAME" "$P"
+  fi
+  I=$((I+1))
+done <<< "$LAST_DICT_LINES"
+
+TOTAL=$((TOTAL_PASS + TOTAL_FAIL))
+if [ "$TOTAL" -eq 0 ]; then
+  echo "ERROR: no suite results parsed. Raw output:" >&2
+  echo "$OUTPUT" >&2
+  exit 1
+fi
+if [ $TOTAL_FAIL -eq 0 ]; then
+  echo "ok $TOTAL_PASS/$TOTAL dream-on-sx tests passed (${#SUITES[@]} suites)"
+else
+  echo "FAIL $TOTAL_PASS/$TOTAL passed, $TOTAL_FAIL failed:"
+  for S in "${FAILED_SUITES[@]}"; do echo "  $S"; done
+  exit 1
+fi

lib/dream/cors.sx

@@ -0,0 +1,51 @@
+;; lib/dream/cors.sx — Dream-on-SX CORS middleware.
+;; Decorates responses with Access-Control-Allow-* headers and short-circuits
+;; preflight OPTIONS requests with a 204. Depends on types.sx.
+
+(define dream-cors-defaults {:methods "GET, POST, PUT, PATCH, DELETE, OPTIONS" :headers "Content-Type" :max-age 86400 :credentials false :origin "*"})
+
+(define
+  dr/cors-origin-headers
+  (fn
+    (opts resp)
+    (let
+      ((r1 (dream-add-header resp "access-control-allow-origin" (get opts :origin))))
+      (if
+        (get opts :credentials)
+        (dream-add-header r1 "access-control-allow-credentials" "true")
+        r1))))
+
+(define
+  dr/cors-preflight
+  (fn
+    (opts)
+    (dr/cors-origin-headers
+      opts
+      (dream-add-header
+        (dream-add-header
+          (dream-add-header
+            (dream-empty 204)
+            "access-control-allow-methods"
+            (get opts :methods))
+          "access-control-allow-headers"
+          (get opts :headers))
+        "access-control-max-age"
+        (str (get opts :max-age))))))
+
+(define
+  dream-cors-with
+  (fn
+    (opts)
+    (fn
+      (next)
+      (fn
+        (req)
+        (if
+          (= (dream-method req) "OPTIONS")
+          (dr/cors-preflight opts)
+          (dr/cors-origin-headers opts (next req)))))))
+
+(define dream-cors (dream-cors-with dream-cors-defaults))
+(define
+  dream-cors-origin
+  (fn (origin) (dream-cors-with (assoc dream-cors-defaults :origin origin))))

lib/dream/demos/chat.sx

@@ -0,0 +1,46 @@
+;; lib/dream/demos/chat.sx — multi-room WebSocket chat (chat.ml).
+;; A room registry holds the live connections per room; each ws session joins its
+;; room, broadcasts every received message to the room, and leaves on close.
+
+(define dream-chat-rooms (fn () (let ((rooms {})) {:join (fn (room ws) (set! rooms (assoc rooms room (concat (or (get rooms room) (list)) (list ws))))) :broadcast (fn (room msg) (for-each (fn (w) (dream-send w msg)) (or (get rooms room) (list)))) :members (fn (room) (or (get rooms room) (list))) :leave (fn (room ws) (set! rooms (assoc rooms room (filter (fn (w) (not (= w ws))) (or (get rooms room) (list))))))})))
+
+(define
+  dream-chat-loop
+  (fn
+    (rooms room ws)
+    (let
+      ((m (dream-receive ws)))
+      (if
+        (nil? m)
+        (begin ((get rooms :leave) room ws) (dream-close ws))
+        (begin
+          ((get rooms :broadcast) room m)
+          (dream-chat-loop rooms room ws))))))
+
+(define
+  dream-chat-session
+  (fn
+    (rooms room)
+    (fn
+      (ws)
+      (begin ((get rooms :join) room ws) (dream-chat-loop rooms room ws)))))
+
+(define
+  dream-chat-route
+  (fn
+    (rooms)
+    (fn
+      (req)
+      ((dream-websocket (dream-chat-session rooms (dream-param req "room")))
+        req))))
+
+(define
+  dream-chat-app-with
+  (fn
+    (rooms)
+    (dream-router
+      (list
+        (dream-get "/" (fn (req) (dream-html "<h1>Rooms</h1>")))
+        (dream-get "/chat/:room" (dream-chat-route rooms))))))
+
+;; entry point: (dream-run (dream-chat-app-with (dream-chat-rooms)))

lib/dream/demos/counter.sx

@@ -0,0 +1,35 @@
+;; lib/dream/demos/counter.sx — per-session visit counter (counter.ml).
+;; Demonstrates the session middleware: each browser session keeps its own count.
+
+(define
+  dream-counter-handler
+  (fn
+    (req)
+    (let
+      ((n (+ 1 (or (dream-session-field req "count") 0))))
+      (begin
+        (dream-set-session-field req "count" n)
+        (dream-html (str "<p>You have visited this page " n " time(s).</p>"))))))
+
+;; reset clears the session counter
+(define
+  dream-counter-reset
+  (fn
+    (req)
+    (begin
+      (dream-set-session-field req "count" 0)
+      (dream-redirect "/"))))
+
+(define
+  dream-counter-app-with
+  (fn
+    (backend)
+    ((dream-sessions backend)
+      (dream-router
+        (list
+          (dream-get "/" dream-counter-handler)
+          (dream-post "/reset" dream-counter-reset))))))
+
+(define dream-counter-app (dream-counter-app-with (dream-memory-sessions)))
+
+;; entry point: (dream-run (dream-counter-app-with (dream-memory-sessions)))

lib/dream/demos/hello.sx

@@ -0,0 +1,16 @@
+;; lib/dream/demos/hello.sx — the canonical Dream "Hello, World!" (hello.ml).
+;; Dream.run (Dream.router [Dream.get "/" (fun _ -> Dream.html "Hello!")]).
+
+(define
+  dream-hello-app
+  (dream-router
+    (list
+      (dream-get "/" (fn (req) (dream-html "<h1>Hello, World!</h1>")))
+      (dream-get
+        "/hello/:name"
+        (fn
+          (req)
+          (dream-html (str "<h1>Hello, " (dream-param req "name") "!</h1>")))))))
+
+;; entry point (installs the handler on the host):
+;;   (dream-run dream-hello-app)

lib/dream/demos/todo.sx

@@ -0,0 +1,96 @@
+;; lib/dream/demos/todo.sx — CRUD todo list with forms + CSRF (todo.ml).
+;; An in-memory store holds items; add/toggle/delete go through POST forms guarded
+;; by the CSRF middleware. User text is HTML-escaped on render (dream-escape).
+;; Wires session -> csrf -> router.
+
+(define
+  dream-todo-store
+  (fn () (let ((items (list)) (next-id 0)) {:all (fn () items) :add (fn (text) (begin (set! next-id (+ next-id 1)) (set! items (concat items (list {:id next-id :text text :done false}))) next-id)) :delete (fn (id) (set! items (filter (fn (it) (not (= (get it :id) id))) items))) :toggle (fn (id) (set! items (map (fn (it) (if (= (get it :id) id) (assoc it :done (not (get it :done))) it)) items)))})))
+
+(define
+  dr/todo-render
+  (fn
+    (store req)
+    (str
+      "<ul>"
+      (reduce
+        (fn
+          (acc it)
+          (str
+            acc
+            "<li>"
+            (if (get it :done) "[x] " "[ ] ")
+            (dream-escape (get it :text))
+            "</li>"))
+        ""
+        ((get store :all)))
+      "</ul>"
+      "<form method=\"post\" action=\"/add\">"
+      (dream-csrf-tag req)
+      "<input name=\"text\"><button>Add</button></form>")))
+
+(define
+  dream-todo-index
+  (fn (store) (fn (req) (dream-html (dr/todo-render store req)))))
+
+(define
+  dream-todo-add
+  (fn
+    (store)
+    (fn
+      (req)
+      (let
+        ((r (dream-form req)))
+        (if
+          (dream-ok? r)
+          (begin
+            ((get store :add) (get (dream-ok-value r) "text"))
+            (dream-redirect "/"))
+          (dream-html-status
+            403
+            (str "Rejected: " (dream-err-reason r))))))))
+
+(define
+  dream-todo-toggle
+  (fn
+    (store)
+    (fn
+      (req)
+      (let
+        ((r (dream-form req)))
+        (if
+          (dream-ok? r)
+          (begin
+            ((get store :toggle) (parse-int (dream-param req "id")))
+            (dream-redirect "/"))
+          (dream-html-status 403 "Rejected"))))))
+
+(define
+  dream-todo-delete
+  (fn
+    (store)
+    (fn
+      (req)
+      (let
+        ((r (dream-form req)))
+        (if
+          (dream-ok? r)
+          (begin
+            ((get store :delete) (parse-int (dream-param req "id")))
+            (dream-redirect "/"))
+          (dream-html-status 403 "Rejected"))))))
+
+(define
+  dream-todo-app-with
+  (fn
+    (store backend secret)
+    ((dream-sessions backend)
+      ((dream-csrf secret)
+        (dream-router
+          (list
+            (dream-get "/" (dream-todo-index store))
+            (dream-post "/add" (dream-todo-add store))
+            (dream-post "/toggle/:id" (dream-todo-toggle store))
+            (dream-post "/delete/:id" (dream-todo-delete store))))))))
+
+;; entry: (dream-run (dream-todo-app-with (dream-todo-store) (dream-memory-sessions) "change-me"))

lib/dream/error.sx

@@ -0,0 +1,41 @@
+;; lib/dream/error.sx — Dream-on-SX status phrases + error-handling middleware.
+;; dream-catch wraps a handler and turns a raised error into a 500 response (or a
+;; custom page). Depends on types.sx.
+
+;; ── status reason phrases ──────────────────────────────────────────
+(define dr/status-texts {:206 "Partial Content" :202 "Accepted" :422 "Unprocessable Entity" :400 "Bad Request" :302 "Found" :204 "No Content" :502 "Bad Gateway" :429 "Too Many Requests" :301 "Moved Permanently" :415 "Unsupported Media Type" :405 "Method Not Allowed" :303 "See Other" :401 "Unauthorized" :304 "Not Modified" :503 "Service Unavailable" :404 "Not Found" :308 "Permanent Redirect" :504 "Gateway Timeout" :416 "Range Not Satisfiable" :500 "Internal Server Error" :307 "Temporary Redirect" :201 "Created" :501 "Not Implemented" :409 "Conflict" :200 "OK" :410 "Gone" :403 "Forbidden"})
+
+(define
+  dream-status-text
+  (fn (status) (or (get dr/status-texts (str status)) "Unknown")))
+(define
+  dream-status-line
+  (fn (status) (str status " " (dream-status-text status))))
+
+;; ── error-handling middleware ──────────────────────────────────────
+(define
+  dream-default-error-page
+  (fn
+    (req e)
+    (dream-html-status
+      500
+      (str "<h1>" (dream-status-line 500) "</h1>"))))
+
+(define
+  dream-catch-with
+  (fn
+    (on-error)
+    (fn
+      (next)
+      (fn (req) (guard (e (true (on-error req e))) (next req))))))
+
+(define dream-catch (dream-catch-with dream-default-error-page))
+
+;; a fallback handler that renders a status page for any code
+(define
+  dream-status-page
+  (fn
+    (status)
+    (dream-html-status
+      status
+      (str "<h1>" (dream-status-line status) "</h1>"))))

lib/dream/flash.sx

@@ -0,0 +1,91 @@
+;; lib/dream/flash.sx — Dream-on-SX flash messages.
+;; A single-request cookie store: messages added during one request are read on
+;; the NEXT request, then the cookie is cleared. Depends on types.sx + session.sx
+;; (shared cookie helpers). A message is {:category c :message m}.
+
+;; ── cookie codec ───────────────────────────────────────────────────
+;; escape the field separators so categories/messages round-trip safely
+(define
+  dr/flash-esc
+  (fn (s) (replace (replace (replace s "%" "%25") "|" "%7C") "~" "%7E")))
+(define
+  dr/flash-unesc
+  (fn (s) (replace (replace (replace s "%7E" "~") "%7C" "|") "%25" "%")))
+
+(define
+  dr/flash-encode
+  (fn
+    (msgs)
+    (join
+      "~"
+      (map
+        (fn
+          (m)
+          (str
+            (dr/flash-esc (get m :category))
+            "|"
+            (dr/flash-esc (get m :message))))
+        msgs))))
+
+(define
+  dr/flash-decode
+  (fn
+    (s)
+    (if
+      (= s "")
+      (list)
+      (map
+        (fn (part) (let ((i (index-of part "|"))) {:message (dr/flash-unesc (substr part (+ i 1))) :category (dr/flash-unesc (substr part 0 i))}))
+        (split s "~")))))
+
+;; ── mutable outbox cell ────────────────────────────────────────────
+(define dr/flash-box (fn () (let ((items (list))) {:add (fn (x) (set! items (concat items (list x)))) :get (fn () items)})))
+
+;; ── middleware ─────────────────────────────────────────────────────
+(define dream-flash-cookie-name "dream.flash")
+
+(define
+  dream-flash
+  (fn
+    (next)
+    (fn
+      (req)
+      (let
+        ((incoming (dr/flash-decode (or (dream-cookie req dream-flash-cookie-name) "")))
+          (box (dr/flash-box)))
+        (let
+          ((resp (next (assoc req :dream-flash {:box box :incoming incoming}))))
+          (let
+            ((out ((get box :get))))
+            (cond
+              ((not (empty? out))
+                (dream-set-cookie
+                  resp
+                  dream-flash-cookie-name
+                  (dr/flash-encode out)
+                  {:path "/" :http-only true :same-site "Lax"}))
+              ((not (empty? incoming))
+                (dream-drop-cookie resp dream-flash-cookie-name))
+              (else resp))))))))
+
+;; ── handler-facing API ─────────────────────────────────────────────
+(define
+  dream-add-flash-message
+  (fn
+    (req category msg)
+    (begin ((get (get (get req :dream-flash) :box) :add) {:message msg :category category}) req)))
+
+(define
+  dream-flash-messages
+  (fn (req) (get (get req :dream-flash) :incoming)))
+(define dream-flash-category (fn (m) (get m :category)))
+(define dream-flash-message (fn (m) (get m :message)))
+
+;; convenience: only messages of a given category
+(define
+  dream-flash-of
+  (fn
+    (req category)
+    (filter
+      (fn (m) (= (get m :category) category))
+      (dream-flash-messages req))))

lib/dream/form.sx

@@ -0,0 +1,403 @@
+;; lib/dream/form.sx — Dream-on-SX forms + CSRF.
+;; Parses application/x-www-form-urlencoded bodies; CSRF tokens are stateless,
+;; signed, and session-scoped. The signing function is injectable (a pure-SX keyed
+;; hash by default — production should swap in a host HMAC). Depends on types.sx +
+;; session.sx. dream-form returns an Ok/Err result value.
+
+;; ── Result (Ok/Err) ────────────────────────────────────────────────
+(define dream-ok (fn (v) {:value v :result "ok"}))
+(define dream-err (fn (r) {:reason r :result "err"}))
+(define dream-ok? (fn (x) (= (get x :result) "ok")))
+(define dream-err? (fn (x) (= (get x :result) "err")))
+(define dream-ok-value (fn (x) (get x :value)))
+(define dream-err-reason (fn (x) (get x :reason)))
+
+;; ── percent decoding ───────────────────────────────────────────────
+(define
+  dr/hex-digit
+  (fn
+    (c)
+    (let
+      ((n (char-code c)))
+      (cond
+        ((and (>= n 48) (<= n 57)) (- n 48))
+        ((and (>= n 65) (<= n 70))
+          (+ 10 (- n 65)))
+        ((and (>= n 97) (<= n 102))
+          (+ 10 (- n 97)))
+        (else 0)))))
+
+(define
+  dr/url-decode-loop
+  (fn
+    (s i n acc)
+    (if
+      (>= i n)
+      acc
+      (let
+        ((c (char-at s i)))
+        (if
+          (and (= c "%") (< (+ i 2) n))
+          (dr/url-decode-loop
+            s
+            (+ i 3)
+            n
+            (str
+              acc
+              (char-from-code
+                (+
+                  (* 16 (dr/hex-digit (char-at s (+ i 1))))
+                  (dr/hex-digit (char-at s (+ i 2)))))))
+          (dr/url-decode-loop s (+ i 1) n (str acc c)))))))
+
+(define
+  dr/url-decode
+  (fn
+    (s)
+    (let
+      ((s2 (replace s "+" " ")))
+      (dr/url-decode-loop s2 0 (string-length s2) ""))))
+
+;; ── percent encoding (symmetric with dr/url-decode) ────────────────
+;; RFC3986 unreserved set passes through; everything else is %XX (uppercase
+;; hex). Space becomes %20 (not +), so the result is safe in a query value.
+(define dr/hex-chars "0123456789ABCDEF")
+(define
+  dr/url-encode-char
+  (fn
+    (c)
+    (let
+      ((n (char-code c)))
+      (if
+        (or
+          (and (>= n 48) (<= n 57))   ;; 0-9
+          (and (>= n 65) (<= n 90))   ;; A-Z
+          (and (>= n 97) (<= n 122))  ;; a-z
+          (= c "-") (= c "_") (= c ".") (= c "~"))
+        c
+        (str "%"
+          (char-at dr/hex-chars (quotient n 16))
+          (char-at dr/hex-chars (mod n 16)))))))
+
+(define
+  dr/url-encode-loop
+  (fn
+    (s i n acc)
+    (if
+      (>= i n)
+      acc
+      (dr/url-encode-loop s (+ i 1) n
+        (str acc (dr/url-encode-char (char-at s i)))))))
+
+(define
+  dr/url-encode
+  (fn
+    (s)
+    (dr/url-encode-loop (or s "") 0 (string-length (or s "")) "")))
+
+;; ── substring splitter (split primitive is char-class based) ───────
+(define
+  dr/split-on
+  (fn
+    (s sep)
+    (let
+      ((i (index-of s sep)))
+      (if
+        (< i 0)
+        (list s)
+        (cons
+          (substr s 0 i)
+          (dr/split-on (substr s (+ i (string-length sep))) sep))))))
+
+;; ── urlencoded body parsing ────────────────────────────────────────
+(define
+  dr/parse-form-body
+  (fn
+    (body)
+    (if
+      (= body "")
+      {}
+      (reduce
+        (fn
+          (acc pair)
+          (if
+            (= pair "")
+            acc
+            (let
+              ((j (index-of pair "=")))
+              (if
+                (< j 0)
+                (assoc acc (dr/url-decode pair) "")
+                (assoc
+                  acc
+                  (dr/url-decode (substr pair 0 j))
+                  (dr/url-decode (substr pair (+ j 1))))))))
+        {}
+        (split body "&")))))
+
+;; raw fields, no CSRF check
+(define dream-form-fields (fn (req) (dr/parse-form-body (dream-body req))))
+(define
+  dream-form-field
+  (fn (req name) (get (dream-form-fields req) name)))
+
+;; ── CSRF signing (injectable; pure-SX keyed hash default) ──────────
+(define
+  dr/poly-hash
+  (fn (s base seed) (dr/poly-loop s 0 (string-length s) seed base)))
+(define
+  dr/poly-loop
+  (fn
+    (s i n h base)
+    (if
+      (>= i n)
+      h
+      (dr/poly-loop
+        s
+        (+ i 1)
+        n
+        (mod (+ (* h base) (char-code (char-at s i))) 2147483647)
+        base))))
+
+;; NOTE: not cryptographic — adequate to demonstrate stateless CSRF; production
+;; should inject a real HMAC via dream-csrf-with.
+(define
+  dream-csrf-sign-default
+  (fn
+    (secret msg)
+    (let
+      ((m (str secret "|" msg)))
+      (str
+        (dr/poly-hash m 131 7)
+        "-"
+        (dr/poly-hash m 137 13)))))
+
+(define dream-csrf-field-name "dream.csrf")
+
+(define
+  dr/csrf-make-token
+  (fn (sign secret sid) (str sid "." (sign secret sid))))
+
+(define
+  dr/csrf-valid?
+  (fn
+    (sign secret sid token)
+    (if
+      (or (nil? token) (= token ""))
+      false
+      (let
+        ((dot (index-of token ".")))
+        (if
+          (< dot 0)
+          false
+          (let
+            ((tsid (substr token 0 dot))
+              (tsig (substr token (+ dot 1))))
+            (and (= tsid sid) (= tsig (sign secret sid)))))))))
+
+;; ── CSRF middleware: attach signing context (needs session upstream) ──
+(define
+  dream-csrf-with
+  (fn
+    (secret sign)
+    (fn (next) (fn (req) (next (assoc req :dream-csrf {:sign sign :sid (dream-session-id req) :secret secret}))))))
+
+(define
+  dream-csrf
+  (fn (secret) (dream-csrf-with secret dream-csrf-sign-default)))
+
+(define dr/csrf-of (fn (req) (get req :dream-csrf)))
+
+;; current token + hidden-input tag for templates
+(define
+  dream-csrf-token
+  (fn
+    (req)
+    (let
+      ((c (dr/csrf-of req)))
+      (dr/csrf-make-token (get c :sign) (get c :secret) (get c :sid)))))
+
+(define
+  dream-csrf-tag
+  (fn
+    (req)
+    (str
+      "<input type=\"hidden\" name=\""
+      dream-csrf-field-name
+      "\" value=\""
+      (dream-csrf-token req)
+      "\">")))
+
+;; ── dream-form: parse + verify CSRF -> Ok fields | Err reason ──────
+(define
+  dream-form
+  (fn
+    (req)
+    (let
+      ((c (dr/csrf-of req)))
+      (if
+        (nil? c)
+        (dream-err :csrf-context-missing)
+        (let
+          ((fields (dream-form-fields req)))
+          (if
+            (dr/csrf-valid?
+              (get c :sign)
+              (get c :secret)
+              (get c :sid)
+              (get fields dream-csrf-field-name))
+            (dream-ok fields)
+            (dream-err :csrf-token-invalid)))))))
+
+;; ── CSRF auto-rejecting middleware (unsafe methods need a valid token) ──
+(define
+  dr/csrf-safe-method?
+  (fn (m) (or (= m "GET") (= m "HEAD") (= m "OPTIONS"))))
+
+(define
+  dream-csrf-protect-with
+  (fn
+    (secret sign)
+    (fn
+      (next)
+      (fn
+        (req)
+        (let
+          ((req2 (assoc req :dream-csrf {:sign sign :sid (dream-session-id req) :secret secret})))
+          (if
+            (dr/csrf-safe-method? (dream-method req2))
+            (next req2)
+            (let
+              ((token (get (dream-form-fields req2) dream-csrf-field-name)))
+              (if
+                (dr/csrf-valid? sign secret (dream-session-id req2) token)
+                (next req2)
+                (dream-html-status 403 "CSRF token invalid")))))))))
+
+(define
+  dream-csrf-protect
+  (fn (secret) (dream-csrf-protect-with secret dream-csrf-sign-default)))
+
+;; ── multipart/form-data parsing ────────────────────────────────────
+;; In-memory (not yet streaming): parses the whole body into parts, each
+;; {:name :filename :content-type :content}. Returns Ok parts | Err :not-multipart.
+(define
+  dr/multipart-boundary
+  (fn
+    (ctype)
+    (let
+      ((i (index-of ctype "boundary=")))
+      (if
+        (< i 0)
+        ""
+        (let
+          ((raw (trim (substr ctype (+ i 9)))))
+          (if
+            (starts-with? raw "\"")
+            (substr raw 1 (- (string-length raw) 2))
+            raw))))))
+
+;; strip one leading and one trailing CRLF
+(define
+  dr/strip-edges
+  (fn
+    (s)
+    (let
+      ((s1 (if (starts-with? s "\r\n") (substr s 2) s)))
+      (if
+        (ends-with? s1 "\r\n")
+        (substr s1 0 (- (string-length s1) 2))
+        s1))))
+
+;; value of attr="..." within a header block
+(define
+  dr/cd-attr
+  (fn
+    (block attr)
+    (let
+      ((key (str attr "=\"")))
+      (let
+        ((i (index-of block key)))
+        (if
+          (< i 0)
+          nil
+          (let
+            ((rest (substr block (+ i (string-length key)))))
+            (substr rest 0 (index-of rest "\""))))))))
+
+;; value of a named header line within a header block
+(define
+  dr/block-header
+  (fn
+    (block name)
+    (reduce
+      (fn
+        (acc line)
+        (if
+          (and
+            (nil? acc)
+            (starts-with? (lower line) (str (lower name) ":")))
+          (trim (substr line (+ (index-of line ":") 1)))
+          acc))
+      nil
+      (dr/split-on block "\r\n"))))
+
+(define
+  dr/parse-part
+  (fn
+    (seg)
+    (let
+      ((s (dr/strip-edges seg)))
+      (let
+        ((sp (index-of s "\r\n\r\n")))
+        (if
+          (< sp 0)
+          nil
+          (let
+            ((block (substr s 0 sp))
+              (content (substr s (+ sp 4))))
+            {:name (dr/cd-attr block "name") :filename (dr/cd-attr block "filename") :content-type (dr/block-header block "content-type") :content content}))))))
+
+(define
+  dream-multipart
+  (fn
+    (req)
+    (let
+      ((boundary (dr/multipart-boundary (or (dream-header req "content-type") ""))))
+      (if
+        (= boundary "")
+        (dream-err :not-multipart)
+        (let
+          ((segs (dr/split-on (dream-body req) (str "--" boundary))))
+          (dream-ok
+            (filter
+              (fn (p) (not (nil? p)))
+              (map
+                dr/parse-part
+                (filter (fn (seg) (starts-with? seg "\r\n")) segs)))))))))
+
+;; accessors over a parts list
+(define
+  dream-multipart-field
+  (fn
+    (parts name)
+    (reduce
+      (fn
+        (acc p)
+        (if (and (nil? acc) (= (get p :name) name)) (get p :content) acc))
+      nil
+      parts)))
+
+(define
+  dream-multipart-file
+  (fn
+    (parts name)
+    (reduce
+      (fn
+        (acc p)
+        (if
+          (and (nil? acc) (= (get p :name) name) (get p :filename))
+          p
+          acc))
+      nil
+      parts)))

lib/dream/headers.sx

@@ -0,0 +1,54 @@
+;; lib/dream/headers.sx — Dream-on-SX security headers + cache-control helpers.
+;; Depends on types.sx.
+
+;; ── security headers middleware ────────────────────────────────────
+(define dream-security-defaults {:x-frame-options "DENY" :referrer-policy "no-referrer" :x-content-type-options "nosniff" :hsts false})
+
+(define
+  dr/apply-security
+  (fn
+    (opts resp)
+    (let
+      ((r1 (dream-add-header (dream-add-header (dream-add-header resp "x-content-type-options" (get opts :x-content-type-options)) "x-frame-options" (get opts :x-frame-options)) "referrer-policy" (get opts :referrer-policy))))
+      (if
+        (get opts :hsts)
+        (dream-add-header
+          r1
+          "strict-transport-security"
+          "max-age=31536000; includeSubDomains")
+        r1))))
+
+(define
+  dream-security-headers-with
+  (fn (opts) (fn (next) (fn (req) (dr/apply-security opts (next req))))))
+(define
+  dream-security-headers
+  (dream-security-headers-with dream-security-defaults))
+
+;; ── cache-control response helpers ─────────────────────────────────
+(define
+  dream-cache
+  (fn
+    (resp seconds)
+    (dream-add-header resp "cache-control" (str "public, max-age=" seconds))))
+(define
+  dream-private-cache
+  (fn
+    (resp seconds)
+    (dream-add-header resp "cache-control" (str "private, max-age=" seconds))))
+(define
+  dream-no-store
+  (fn (resp) (dream-add-header resp "cache-control" "no-store")))
+(define
+  dream-no-cache
+  (fn
+    (resp)
+    (dream-add-header
+      resp
+      "cache-control"
+      "no-cache, no-store, must-revalidate")))
+
+;; cache-control middleware: stamp a max-age on every response
+(define
+  dream-cache-for
+  (fn (seconds) (fn (next) (fn (req) (dream-cache (next req) seconds)))))

lib/dream/html.sx

@@ -0,0 +1,24 @@
+;; lib/dream/html.sx — Dream-on-SX HTML escaping for safe templating.
+;; Interpolating user input into HTML without escaping is an XSS hole; dream-escape
+;; neutralises it. Depends on nothing (pure string ops).
+
+;; escape text for HTML element content / double-quoted attributes
+(define
+  dream-escape
+  (fn
+    (s)
+    (replace
+      (replace
+        (replace (replace (replace s "&" "&amp;") "<" "&lt;") ">" "&gt;")
+        "\""
+        "&quot;")
+      "'"
+      "&#39;")))
+
+;; build a single attribute: name="escaped-value"
+(define dream-attr (fn (name val) (str name "=\"" (dream-escape val) "\"")))
+
+;; join escaped text with a separator, escaping each piece
+(define
+  dream-escape-join
+  (fn (sep pieces) (join sep (map dream-escape pieces))))

lib/dream/json.sx

@@ -0,0 +1,183 @@
+;; lib/dream/json.sx — Dream-on-SX JSON encode/parse (pure SX).
+;; The host JSON primitives live in the ocaml-on-sx runtime, not the base env, so
+;; Dream ships its own. Depends on types.sx. (number? is unreliable in this env —
+;; type-of "number" is used instead.)
+
+;; ── encoding ───────────────────────────────────────────────────────
+(define
+  dr/json-escape
+  (fn
+    (s)
+    (replace
+      (replace
+        (replace (replace (replace s "\\" "\\\\") "\"" "\\\"") "\n" "\\n")
+        "\r"
+        "\\r")
+      "\t"
+      "\\t")))
+(define dr/json-quote (fn (s) (str "\"" (dr/json-escape s) "\"")))
+
+(define
+  dream-json-encode
+  (fn
+    (v)
+    (cond
+      ((nil? v) "null")
+      ((boolean? v) (if v "true" "false"))
+      ((= (type-of v) "number") (str v))
+      ((string? v) (dr/json-quote v))
+      ((list? v) (str "[" (join "," (map dream-json-encode v)) "]"))
+      ((dict? v)
+        (str
+          "{"
+          (join
+            ","
+            (map
+              (fn
+                (k)
+                (str (dr/json-quote k) ":" (dream-json-encode (get v k))))
+              (keys v)))
+          "}"))
+      (else (dr/json-quote (str v))))))
+
+;; ── parsing (recursive descent; returns {:val :pos}) ───────────────
+(define
+  dr/json-space?
+  (fn (c) (or (= c " ") (= c "\n") (= c "\r") (= c "\t"))))
+(define
+  dr/json-ws
+  (fn
+    (s i)
+    (if
+      (and (< i (string-length s)) (dr/json-space? (char-at s i)))
+      (dr/json-ws s (+ i 1))
+      i)))
+
+(define
+  dr/json-digit?
+  (fn
+    (c)
+    (let ((n (char-code c))) (and (>= n 48) (<= n 57)))))
+(define
+  dr/json-num-char?
+  (fn
+    (c)
+    (or
+      (dr/json-digit? c)
+      (= c "-")
+      (= c "+")
+      (= c ".")
+      (= c "e")
+      (= c "E"))))
+(define
+  dr/json-num-end
+  (fn
+    (s i)
+    (if
+      (and (< i (string-length s)) (dr/json-num-char? (char-at s i)))
+      (dr/json-num-end s (+ i 1))
+      i)))
+(define
+  dr/json-to-number
+  (fn
+    (str-val)
+    (if
+      (or
+        (contains? str-val ".")
+        (contains? str-val "e")
+        (contains? str-val "E"))
+      (parse-float str-val)
+      (parse-int str-val))))
+
+(define
+  dr/json-str
+  (fn
+    (s i acc)
+    (let
+      ((c (char-at s i)))
+      (cond
+        ((= c "\"") {:val acc :pos (+ i 1)})
+        ((= c "\\")
+          (let
+            ((e (char-at s (+ i 1))))
+            (cond
+              ((= e "n") (dr/json-str s (+ i 2) (str acc "\n")))
+              ((= e "r") (dr/json-str s (+ i 2) (str acc "\r")))
+              ((= e "t") (dr/json-str s (+ i 2) (str acc "\t")))
+              (else (dr/json-str s (+ i 2) (str acc e))))))
+        (else (dr/json-str s (+ i 1) (str acc c)))))))
+
+(define
+  dr/json-num
+  (fn (s i) (let ((j (dr/json-num-end s i))) {:val (dr/json-to-number (substr s i (- j i))) :pos j})))
+
+(define
+  dr/json-arr
+  (fn
+    (s i acc)
+    (let
+      ((i (dr/json-ws s i)))
+      (if
+        (= (char-at s i) "]")
+        {:val acc :pos (+ i 1)}
+        (let
+          ((r (dr/json-val s i)))
+          (let
+            ((i2 (dr/json-ws s (get r :pos))))
+            (if
+              (= (char-at s i2) ",")
+              (dr/json-arr
+                s
+                (+ i2 1)
+                (concat acc (list (get r :val))))
+              {:val (concat acc (list (get r :val))) :pos (+ i2 1)})))))))
+
+(define
+  dr/json-obj
+  (fn
+    (s i acc)
+    (let
+      ((i (dr/json-ws s i)))
+      (if
+        (= (char-at s i) "}")
+        {:val acc :pos (+ i 1)}
+        (let
+          ((kr (dr/json-str s (+ i 1) "")))
+          (let
+            ((i2 (dr/json-ws s (get kr :pos))))
+            (let
+              ((vr (dr/json-val s (+ i2 1))))
+              (let
+                ((i3 (dr/json-ws s (get vr :pos))))
+                (if
+                  (= (char-at s i3) ",")
+                  (dr/json-obj
+                    s
+                    (+ i3 1)
+                    (assoc acc (get kr :val) (get vr :val)))
+                  {:val (assoc acc (get kr :val) (get vr :val)) :pos (+ i3 1)})))))))))
+
+(define
+  dr/json-val
+  (fn
+    (s i)
+    (let
+      ((i (dr/json-ws s i)))
+      (let
+        ((c (char-at s i)))
+        (cond
+          ((= c "{") (dr/json-obj s (+ i 1) {}))
+          ((= c "[") (dr/json-arr s (+ i 1) (list)))
+          ((= c "\"") (dr/json-str s (+ i 1) ""))
+          ((= c "t") {:val true :pos (+ i 4)})
+          ((= c "f") {:val false :pos (+ i 5)})
+          ((= c "n") {:val nil :pos (+ i 4)})
+          (else (dr/json-num s i)))))))
+
+(define dream-json-parse (fn (s) (get (dr/json-val s 0) :val)))
+
+;; ── responses ──────────────────────────────────────────────────────
+;; encode a value into a JSON response (dream-json takes a raw string body)
+(define dream-json-value (fn (v) (dream-json (dream-json-encode v))))
+;; read + parse the request body as JSON
+(define dream-json-body (fn (req) (dream-json-parse (dream-body req))))

lib/dream/middleware.sx

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

lib/dream/router.sx

@@ -0,0 +1,170 @@
+;; lib/dream/router.sx — Dream-on-SX routing.
+;; Routes are dicts {:method :path :handler}; a router is a handler that
+;; dispatches request -> response by method + path, extracting :name path
+;; params and binding a ** catch-all. No path match -> 404; path matches but
+;; method doesn't -> 405 + Allow. HEAD falls back to the GET handler with an
+;; empty body. Depends on types.sx.
+
+;; ── route constructors (one per HTTP method) ───────────────────────
+(define dream-get (fn (path handler) (dream-route "GET" path handler)))
+(define dream-post (fn (path handler) (dream-route "POST" path handler)))
+(define dream-put (fn (path handler) (dream-route "PUT" path handler)))
+(define
+  dream-delete
+  (fn (path handler) (dream-route "DELETE" path handler)))
+(define dream-patch (fn (path handler) (dream-route "PATCH" path handler)))
+(define dream-head (fn (path handler) (dream-route "HEAD" path handler)))
+(define
+  dream-options
+  (fn (path handler) (dream-route "OPTIONS" path handler)))
+(define dream-any (fn (path handler) (dream-route "ANY" path handler)))
+
+;; ── path segmentation ──────────────────────────────────────────────
+;; "/users/42/" -> ("users" "42"); "/" -> ()
+(define
+  dr/segs
+  (fn (path) (filter (fn (s) (not (= s ""))) (split path "/"))))
+
+(define
+  dr/join-path
+  (fn
+    (prefix path)
+    (str "/" (join "/" (concat (dr/segs prefix) (dr/segs path))))))
+
+;; ── segment matching ───────────────────────────────────────────────
+;; Returns a params dict on match (possibly empty {}), nil on no match.
+(define
+  dr/match-segs
+  (fn
+    (pat path params)
+    (cond
+      ((and (empty? pat) (empty? path)) params)
+      ((empty? pat) nil)
+      (else
+        (let
+          ((ps (first pat)))
+          (cond
+            ((= ps "**") (assoc params "**" (join "/" path)))
+            ((empty? path) nil)
+            ((starts-with? ps ":")
+              (dr/match-segs
+                (rest pat)
+                (rest path)
+                (assoc params (substr ps 1) (first path))))
+            ((= ps (first path))
+              (dr/match-segs (rest pat) (rest path) params))
+            (else nil)))))))
+
+;; path-only match: returns params dict or nil
+(define
+  dr/route-params
+  (fn
+    (r req)
+    (dr/match-segs
+      (dr/segs (dream-route-path r))
+      (dr/segs (dream-path req))
+      {})))
+
+;; method acceptance: exact, ANY, or HEAD served by a GET route
+(define
+  dr/method-accepts?
+  (fn
+    (route-method req-method)
+    (or
+      (= route-method "ANY")
+      (= route-method req-method)
+      (and (= req-method "HEAD") (= route-method "GET")))))
+
+;; ── middleware pipeline (shared with middleware.sx) ────────────────
+;; m1 @@ m2 @@ handler = (m1 (m2 handler)); first in list is outermost.
+(define
+  dr/apply-middlewares
+  (fn (mws handler) (reduce (fn (h mw) (mw h)) handler (reverse mws))))
+
+;; ── scope: prefix mount + middleware chain ─────────────────────────
+;; Returns a flat list of routes; nested scopes flatten correctly.
+(define
+  dr/flatten-routes
+  (fn
+    (items)
+    (reduce
+      (fn
+        (acc it)
+        (if
+          (dream-route? it)
+          (concat acc (list it))
+          (concat acc (dr/flatten-routes it))))
+      (list)
+      items)))
+
+(define
+  dream-scope
+  (fn
+    (prefix middlewares routes)
+    (map
+      (fn
+        (r)
+        (dream-route
+          (dream-route-method r)
+          (dr/join-path prefix (dream-route-path r))
+          (dr/apply-middlewares middlewares (dream-route-handler r))))
+      (dr/flatten-routes routes))))
+
+;; ── dispatch ───────────────────────────────────────────────────────
+;; allowed = methods of routes whose PATH matched (for 405 + Allow).
+(define
+  dr/dispatch
+  (fn
+    (routes req allowed)
+    (if
+      (empty? routes)
+      (if
+        (empty? allowed)
+        (dream-not-found)
+        (dream-method-not-allowed allowed))
+      (let
+        ((r (first routes)))
+        (let
+          ((params (dr/route-params r req)))
+          (if
+            (nil? params)
+            (dr/dispatch (rest routes) req allowed)
+            (if
+              (dr/method-accepts? (dream-route-method r) (dream-method req))
+              (dr/run-route r req params)
+              (dr/dispatch
+                (rest routes)
+                req
+                (concat allowed (list (dream-route-method r)))))))))))
+
+;; run a matched route; blank the body for an auto-HEAD on a GET route
+(define
+  dr/run-route
+  (fn
+    (r req params)
+    (let
+      ((resp (dream-coerce-response ((dream-route-handler r) (dream-with-params req params)))))
+      (if
+        (and
+          (= (dream-method req) "HEAD")
+          (not (= (dream-route-method r) "HEAD")))
+        (dream-response (dream-status resp) (dream-headers resp) "")
+        resp))))
+
+;; 405 response with an Allow header listing the path's methods
+(define
+  dream-method-not-allowed
+  (fn
+    (allowed)
+    (dream-add-header
+      (dream-response 405 {:content-type "text/plain; charset=utf-8"} "Method Not Allowed")
+      "allow"
+      (join ", " allowed))))
+
+(define
+  dream-router
+  (fn
+    (routes)
+    (let
+      ((flat (dr/flatten-routes routes)))
+      (fn (req) (dr/dispatch flat req (list))))))

lib/dream/run.sx

@@ -0,0 +1,42 @@
+;; lib/dream/run.sx — Dream-on-SX entry point.
+;; dream-run installs a root handler into the existing SX HTTP server via
+;; (perform (:http/listen …)) — it does NOT implement its own socket loop. The
+;; host invokes the installed app per request with a raw request dict; the app
+;; adapts it to a dream-request, runs the handler, and serialises the response
+;; (status/headers/body/set-cookies, or a websocket upgrade). Depends on types.sx
+;; + websocket.sx. The listen transport is injectable for testing.
+
+;; ── response serialisation for the host ────────────────────────────
+(define
+  dr/serialize-response
+  (fn (resp) (if (dream-websocket? resp) {:websocket (dream-ws-handler resp) :body "" :headers (dream-headers resp) :status 101 :set-cookies (list)} {:body (dream-resp-body resp) :headers (dream-headers resp) :status (dream-status resp) :set-cookies (dream-resp-cookies resp)})))
+
+;; ── the app: raw host request -> serialised response ───────────────
+(define
+  dream-app
+  (fn
+    (handler)
+    (fn
+      (raw)
+      (let
+        ((req (dream-request (or (get raw :method) "GET") (or (get raw :target) (or (get raw :path) "/")) (or (get raw :headers) {}) (or (get raw :body) ""))))
+        (dr/serialize-response (dream-coerce-response (handler req)))))))
+
+;; ── dream-run ──────────────────────────────────────────────────────
+(define dream-default-port 8080)
+
+(define dream-run-with (fn (listen handler opts) (listen {:op "http/listen" :port (or (get opts :port) dream-default-port) :app (dream-app handler) :host (or (get opts :host) "0.0.0.0")})))
+
+(define dream-perform-listen (fn (op) (perform op)))
+
+(define
+  dream-run
+  (fn (handler) (dream-run-with dream-perform-listen handler {})))
+(define
+  dream-run-port
+  (fn
+    (handler port)
+    (dream-run-with dream-perform-listen handler {:port port})))
+(define
+  dream-run-opts
+  (fn (handler opts) (dream-run-with dream-perform-listen handler opts)))

lib/dream/session.sx

@@ -0,0 +1,238 @@
+;; lib/dream/session.sx — Dream-on-SX cookie-backed sessions.
+;; The session cookie carries only a session id; fields live in a back-end store.
+;; The store is injectable: production wires it to (perform op); tests pass an
+;; in-memory store. Depends on types.sx. Also hosts shared cookie helpers reused
+;; by flash.sx and form.sx.
+
+;; ── cookie helpers (shared) ────────────────────────────────────────
+(define
+  dr/parse-cookies
+  (fn
+    (header)
+    (if
+      (or (nil? header) (= header ""))
+      {}
+      (reduce
+        (fn
+          (acc part)
+          (let
+            ((kv (trim part)))
+            (let
+              ((j (index-of kv "=")))
+              (if
+                (< j 0)
+                acc
+                (assoc
+                  acc
+                  (substr kv 0 j)
+                  (substr kv (+ j 1)))))))
+        {}
+        (split header ";")))))
+
+(define
+  dream-cookie
+  (fn (req name) (get (dr/parse-cookies (dream-header req "cookie")) name)))
+(define
+  dream-cookies
+  (fn (req) (dr/parse-cookies (dream-header req "cookie"))))
+
+(define
+  dr/build-cookie
+  (fn
+    (name val opts)
+    (let
+      ((o (if (nil? opts) {} opts)))
+      (str
+        name
+        "="
+        val
+        "; Path="
+        (or (get o :path) "/")
+        (if (get o :http-only) "; HttpOnly" "")
+        (if (get o :secure) "; Secure" "")
+        (if (get o :same-site) (str "; SameSite=" (get o :same-site)) "")
+        (if (get o :max-age) (str "; Max-Age=" (get o :max-age)) "")))))
+
+(define
+  dream-set-cookie
+  (fn
+    (resp name val opts)
+    (assoc
+      resp
+      :set-cookies (concat
+        (or (get resp :set-cookies) (list))
+        (list (dr/build-cookie name val opts))))))
+
+(define
+  dream-resp-cookies
+  (fn (resp) (or (get resp :set-cookies) (list))))
+
+;; expire a cookie on the client
+(define
+  dream-drop-cookie
+  (fn (resp name) (dream-set-cookie resp name "" {:max-age 0})))
+
+;; ── signed cookie values (tamper-evident) ──────────────────────────
+;; NOTE: pure-SX keyed hash — not cryptographic; production should inject a host
+;; HMAC. Value carries no "." so the first "." splits value from signature.
+(define
+  dr/sess-hash
+  (fn (s) (dr/sess-hash-loop s 0 (string-length s) 7)))
+(define
+  dr/sess-hash-loop
+  (fn
+    (s i n h)
+    (if
+      (>= i n)
+      h
+      (dr/sess-hash-loop
+        s
+        (+ i 1)
+        n
+        (mod (+ (* h 131) (char-code (char-at s i))) 2147483647)))))
+(define
+  dr/sess-sig
+  (fn (secret val) (str (dr/sess-hash (str secret "|" val)))))
+
+(define
+  dream-cookie-sign
+  (fn (secret val) (str val "." (dr/sess-sig secret val))))
+(define
+  dream-cookie-unsign
+  (fn
+    (secret signed)
+    (if
+      (or (nil? signed) (= signed ""))
+      nil
+      (let
+        ((dot (index-of signed ".")))
+        (if
+          (< dot 0)
+          nil
+          (let
+            ((val (substr signed 0 dot))
+              (sig (substr signed (+ dot 1))))
+            (if (= sig (dr/sess-sig secret val)) val nil)))))))
+
+;; ── in-memory session store (tests + demos) ────────────────────────
+;; A backend is (fn (op) result) where op is a dict {:op ... :sid ... :key ...}.
+(define
+  dream-memory-sessions
+  (fn
+    ()
+    (let
+      ((store {}) (counter 0))
+      (fn
+        (op)
+        (let
+          ((kind (get op :op)))
+          (cond
+            ((= kind "session/create")
+              (begin
+                (set! counter (+ counter 1))
+                (let
+                  ((sid (str "s" counter)))
+                  (begin (set! store (assoc store sid {})) sid))))
+            ((= kind "session/exists") (has-key? store (get op :sid)))
+            ((= kind "session/get")
+              (get (or (get store (get op :sid)) {}) (get op :key)))
+            ((= kind "session/set")
+              (let
+                ((sid (get op :sid)))
+                (set!
+                  store
+                  (assoc
+                    store
+                    sid
+                    (assoc
+                      (or (get store sid) {})
+                      (get op :key)
+                      (get op :val))))))
+            ((= kind "session/load")
+              (or (get store (get op :sid)) {}))
+            ((= kind "session/clear")
+              (set! store (dissoc store (get op :sid))))
+            (else nil)))))))
+
+;; production back-end: every op suspends to the host
+(define dream-perform-sessions (fn (op) (perform op)))
+
+;; ── session middleware ─────────────────────────────────────────────
+(define dream-session-cookie-name "dream.session")
+
+(define
+  dream-sessions
+  (fn
+    (backend)
+    (fn
+      (next)
+      (fn
+        (req)
+        (let
+          ((sid0 (dream-cookie req dream-session-cookie-name)))
+          (let
+            ((have (and sid0 (backend {:op "session/exists" :sid sid0}))))
+            (let
+              ((sid (if have sid0 (backend {:op "session/create"}))))
+              (let
+                ((resp (next (assoc req :dream-session {:io backend :sid sid}))))
+                (if
+                  have
+                  resp
+                  (dream-set-cookie
+                    resp
+                    dream-session-cookie-name
+                    sid
+                    {:path "/" :http-only true :same-site "Lax"}))))))))))
+
+;; signed variant: the cookie value is signed so a guessed/forged sid is rejected
+(define
+  dream-sessions-signed
+  (fn
+    (backend secret)
+    (fn
+      (next)
+      (fn
+        (req)
+        (let
+          ((sid0 (dream-cookie-unsign secret (dream-cookie req dream-session-cookie-name))))
+          (let
+            ((have (and sid0 (backend {:op "session/exists" :sid sid0}))))
+            (let
+              ((sid (if have sid0 (backend {:op "session/create"}))))
+              (let
+                ((resp (next (assoc req :dream-session {:io backend :sid sid}))))
+                (if
+                  have
+                  resp
+                  (dream-set-cookie
+                    resp
+                    dream-session-cookie-name
+                    (dream-cookie-sign secret sid)
+                    {:path "/" :http-only true :same-site "Lax"}))))))))))
+
+;; ── handler-facing session API ─────────────────────────────────────
+(define dr/session-of (fn (req) (get req :dream-session)))
+(define dream-session-id (fn (req) (get (dr/session-of req) :sid)))
+
+(define
+  dream-session-field
+  (fn
+    (req key)
+    (let ((s (dr/session-of req))) ((get s :io) {:key key :op "session/get" :sid (get s :sid)}))))
+
+(define
+  dream-set-session-field
+  (fn
+    (req key val)
+    (let ((s (dr/session-of req))) (begin ((get s :io) {:val val :key key :op "session/set" :sid (get s :sid)}) req))))
+
+(define
+  dream-session-all
+  (fn (req) (let ((s (dr/session-of req))) ((get s :io) {:op "session/load" :sid (get s :sid)}))))
+
+(define
+  dream-invalidate-session
+  (fn
+    (req)
+    (let ((s (dr/session-of req))) (begin ((get s :io) {:op "session/clear" :sid (get s :sid)}) req))))

lib/dream/static.sx

@@ -0,0 +1,182 @@
+;; lib/dream/static.sx — Dream-on-SX static file serving.
+;; dream-static mounts at a ** route and serves files under a root: content-type by
+;; extension, ETags + If-None-Match (304), and Range requests (206). The filesystem
+;; is injectable: production reads via (perform op); tests pass an in-memory map.
+;; Depends on types.sx.
+
+;; ── filesystem backends ────────────────────────────────────────────
+;; An fs is (fn (op) result); op {:op "file/read" :path p} -> content | nil.
+(define dream-static-perform-fs (fn (op) (perform op)))
+
+;; in-memory fs over a {path -> content} dict (tests + demos)
+(define
+  dream-memory-fs
+  (fn
+    (files)
+    (fn
+      (op)
+      (if (= (get op :op) "file/read") (get files (get op :path)) nil))))
+
+;; ── content-type by extension ──────────────────────────────────────
+(define dr/mime-types {:js "application/javascript" :jpeg "image/jpeg" :css "text/css; charset=utf-8" :ico "image/x-icon" :mjs "application/javascript" :html "text/html; charset=utf-8" :pdf "application/pdf" :jpg "image/jpeg" :json "application/json" :htm "text/html; charset=utf-8" :wasm "application/wasm" :webp "image/webp" :gif "image/gif" :png "image/png" :svg "image/svg+xml" :md "text/markdown; charset=utf-8" :xml "application/xml" :sx "text/plain; charset=utf-8" :txt "text/plain; charset=utf-8"})
+
+(define
+  dr/ext-of
+  (fn
+    (path)
+    (let
+      ((segs (split path ".")))
+      (if
+        (> (len segs) 1)
+        (lower (nth segs (- (len segs) 1)))
+        ""))))
+
+(define
+  dream-content-type-for
+  (fn
+    (path)
+    (or (get dr/mime-types (dr/ext-of path)) "application/octet-stream")))
+
+;; ── ETag (weak content hash) ───────────────────────────────────────
+(define
+  dr/static-hash
+  (fn (s) (dr/static-hash-loop s 0 (string-length s) 7)))
+(define
+  dr/static-hash-loop
+  (fn
+    (s i n h)
+    (if
+      (>= i n)
+      h
+      (dr/static-hash-loop
+        s
+        (+ i 1)
+        n
+        (mod (+ (* h 131) (char-code (char-at s i))) 2147483647)))))
+(define
+  dr/etag-of
+  (fn
+    (content)
+    (str "\"" (dr/static-hash content) "-" (string-length content) "\"")))
+(define
+  dr/etag-match?
+  (fn (inm etag) (and (not (nil? inm)) (or (= inm "*") (= inm etag)))))
+
+;; ── path safety ────────────────────────────────────────────────────
+(define
+  dr/static-relpath
+  (fn
+    (req)
+    (or (dream-param req "**") (substr (dream-path req) 1))))
+(define
+  dr/unsafe-path?
+  (fn (rel) (or (contains? rel "..") (starts-with? rel "/")))) 
+(define
+  dr/path-join
+  (fn
+    (root rel)
+    (if (ends-with? root "/") (str root rel) (str root "/" rel))))
+
+;; ── range requests ─────────────────────────────────────────────────
+(define
+  dr/parse-range
+  (fn
+    (header total)
+    (let
+      ((eq (index-of header "=")))
+      (if
+        (< eq 0)
+        nil
+        (let
+          ((spec (substr header (+ eq 1))))
+          (let
+            ((dash (index-of spec "-")))
+            (if
+              (< dash 0)
+              nil
+              (let
+                ((s (substr spec 0 dash))
+                  (e (substr spec (+ dash 1))))
+                (let
+                  ((start (if (= s "") 0 (parse-int s)))
+                    (end (if (= e "") (- total 1) (parse-int e))))
+                  (if
+                    (or
+                      (< start 0)
+                      (>= start total)
+                      (> end (- total 1))
+                      (> start end))
+                    nil
+                    {:start start :end end}))))))))))
+
+(define
+  dr/serve-range
+  (fn
+    (req content etag ctype)
+    (let
+      ((total (string-length content)))
+      (let
+        ((r (dr/parse-range (dream-header req "range") total)))
+        (if
+          (nil? r)
+          (dream-add-header
+            (dream-response 416 {:content-type ctype} "")
+            "content-range"
+            (str "bytes */" total))
+          (let
+            ((start (get r :start)) (end (get r :end)))
+            (dream-add-header
+              (dream-add-header
+                (dream-response
+                  206
+                  {:content-type ctype}
+                  (substr content start (+ 1 (- end start))))
+                "content-range"
+                (str "bytes " start "-" end "/" total))
+              "etag"
+              etag)))))))
+
+;; ── serving ────────────────────────────────────────────────────────
+(define
+  dr/serve-file
+  (fn
+    (req content)
+    (let
+      ((rel (dr/static-relpath req)))
+      (let
+        ((etag (dr/etag-of content)) (ctype (dream-content-type-for rel)))
+        (cond
+          ((dr/etag-match? (dream-header req "if-none-match") etag)
+            (dream-add-header (dream-empty 304) "etag" etag))
+          ((dream-header req "range")
+            (dr/serve-range req content etag ctype))
+          (else
+            (dream-add-header
+              (dream-add-header
+                (dream-response 200 {:content-type ctype} content)
+                "etag"
+                etag)
+              "accept-ranges"
+              "bytes")))))))
+
+(define
+  dream-static-with
+  (fn
+    (root fs)
+    (fn
+      (req)
+      (let
+        ((rel (dr/static-relpath req)))
+        (if
+          (dr/unsafe-path? rel)
+          (dream-html-status 403 "Forbidden")
+          (let
+            ((content (fs {:path (dr/path-join root rel) :op "file/read"})))
+            (if
+              (nil? content)
+              (dream-not-found)
+              (dr/serve-file req content))))))))
+
+(define
+  dream-static
+  (fn (root) (dream-static-with root dream-static-perform-fs)))

lib/dream/tests/api.sx

@@ -0,0 +1,77 @@
+;; lib/dream/tests/api.sx — facade: app builders + default stack.
+
+(define dream-ap-pass 0)
+(define dream-ap-fail 0)
+(define dream-ap-fails (list))
+
+(define
+  dream-ap-test
+  (fn
+    (name actual expected)
+    (if
+      (= actual expected)
+      (set! dream-ap-pass (+ dream-ap-pass 1))
+      (begin
+        (set! dream-ap-fail (+ dream-ap-fail 1))
+        (append! dream-ap-fails {:name name :actual actual :expected expected})))))
+
+(dream-ap-test "version is a string" (string? dream-version) true)
+
+;; ── dream-make-app: routes -> handler with default stack ───────────
+(define
+  dream-ap-routes
+  (list
+    (dream-get "/" (fn (req) (dream-html "<h1>hi</h1>")))
+    (dream-get "/boom" (fn (req) (error "kaboom")))
+    (dream-get
+      "/raw"
+      (fn (req) (dream-response 200 {} "plain words")))))
+(define dream-ap-app (dream-make-app dream-ap-routes))
+
+(dream-ap-test
+  "app serves"
+  (dream-resp-body (dream-ap-app (dream-request "GET" "/" {} "")))
+  "<h1>hi</h1>")
+(dream-ap-test
+  "app catches errors -> 500"
+  (dream-status (dream-ap-app (dream-request "GET" "/boom" {} "")))
+  500)
+(dream-ap-test
+  "app 404 for unknown"
+  (dream-status (dream-ap-app (dream-request "GET" "/nope" {} "")))
+  404)
+(dream-ap-test
+  "app sniffs content-type"
+  (dream-resp-header
+    (dream-ap-app (dream-request "GET" "/raw" {} ""))
+    "content-type")
+  "text/plain; charset=utf-8")
+
+;; ── dream-make-app-with: extra outer middleware ────────────────────
+(define
+  dream-ap-tag
+  (fn (next) (fn (req) (dream-add-header (next req) "X-App" "1"))))
+(define
+  dream-ap-app2
+  (dream-make-app-with (list dream-ap-tag) dream-ap-routes))
+(dream-ap-test
+  "extra middleware header"
+  (dream-resp-header
+    (dream-ap-app2 (dream-request "GET" "/" {} ""))
+    "x-app")
+  "1")
+
+;; ── dream-serve wires through dream-run ────────────────────────────
+(define dream-ap-captured nil)
+(define dream-ap-listen (fn (op) (begin (set! dream-ap-captured op) :ok)))
+(define
+  dream-ap-served
+  (dream-run-with dream-ap-listen (dream-make-app dream-ap-routes) {:port 7000}))
+(dream-ap-test "serve listens" dream-ap-served :ok)
+(dream-ap-test "serve port" (get dream-ap-captured :port) 7000)
+(dream-ap-test
+  "served app runs"
+  (get ((get dream-ap-captured :app) {:method "GET" :target "/"}) :body)
+  "<h1>hi</h1>")
+
+(define dream-ap-tests-run! (fn () {:total (+ dream-ap-pass dream-ap-fail) :passed dream-ap-pass :failed dream-ap-fail :fails dream-ap-fails}))

lib/dream/tests/auth.sx

@@ -0,0 +1,109 @@
+;; lib/dream/tests/auth.sx — base64, basic auth, bearer tokens.
+
+(define dream-au-pass 0)
+(define dream-au-fail 0)
+(define dream-au-fails (list))
+
+(define
+  dream-au-test
+  (fn
+    (name actual expected)
+    (if
+      (= actual expected)
+      (set! dream-au-pass (+ dream-au-pass 1))
+      (begin
+        (set! dream-au-fail (+ dream-au-fail 1))
+        (append! dream-au-fails {:name name :actual actual :expected expected})))))
+
+;; ── base64 ─────────────────────────────────────────────────────────
+(dream-au-test "encode Man" (dream-base64-encode "Man") "TWFu")
+(dream-au-test "encode Ma" (dream-base64-encode "Ma") "TWE=")
+(dream-au-test "encode M" (dream-base64-encode "M") "TQ==")
+(dream-au-test
+  "encode user:pass"
+  (dream-base64-encode "user:pass")
+  "dXNlcjpwYXNz")
+(dream-au-test "decode Man" (dream-base64-decode "TWFu") "Man")
+(dream-au-test "decode Ma" (dream-base64-decode "TWE=") "Ma")
+(dream-au-test "decode M" (dream-base64-decode "TQ==") "M")
+(dream-au-test
+  "decode user:pass"
+  (dream-base64-decode "dXNlcjpwYXNz")
+  "user:pass")
+(dream-au-test
+  "roundtrip phrase"
+  (dream-base64-decode (dream-base64-encode "Hello, World!"))
+  "Hello, World!")
+(dream-au-test
+  "roundtrip empty"
+  (dream-base64-decode (dream-base64-encode ""))
+  "")
+
+;; ── header parsing ─────────────────────────────────────────────────
+(dream-au-test
+  "bearer token"
+  (dream-bearer-token (dream-request "GET" "/" {:Authorization "Bearer abc.123"} ""))
+  "abc.123")
+(dream-au-test
+  "no bearer"
+  (dream-bearer-token (dream-request "GET" "/" {} ""))
+  nil)
+(dream-au-test
+  "basic creds"
+  (dream-basic-credentials (dream-request "GET" "/" {:Authorization "Basic dXNlcjpwYXNz"} ""))
+  {:pass "pass" :user "user"})
+(dream-au-test
+  "no basic"
+  (dream-basic-credentials (dream-request "GET" "/" {} ""))
+  nil)
+
+;; ── basic auth middleware ──────────────────────────────────────────
+(define dream-au-check (fn (u p) (and (= u "admin") (= p "secret"))))
+(define
+  dream-au-app
+  ((dream-basic-auth "Admin Area" dream-au-check)
+    (fn (req) (dream-text (str "hi " (dream-user req))))))
+
+(define dream-au-ok (dream-au-app (dream-request "GET" "/" {:Authorization (str "Basic " (dream-base64-encode "admin:secret"))} "")))
+(dream-au-test "basic ok reaches" (dream-resp-body dream-au-ok) "hi admin")
+(dream-au-test "basic ok status" (dream-status dream-au-ok) 200)
+
+(define dream-au-bad (dream-au-app (dream-request "GET" "/" {:Authorization (str "Basic " (dream-base64-encode "admin:wrong"))} "")))
+(dream-au-test "basic wrong 401" (dream-status dream-au-bad) 401)
+(dream-au-test
+  "basic wrong www-authenticate"
+  (contains? (dream-resp-header dream-au-bad "www-authenticate") "Admin Area")
+  true)
+(dream-au-test
+  "basic missing 401"
+  (dream-status (dream-au-app (dream-request "GET" "/" {} "")))
+  401)
+
+;; ── bearer middleware ──────────────────────────────────────────────
+(define dream-au-tokens {:t-ada "ada" :t-bob "bob"})
+(define dream-au-lookup (fn (tok) (get dream-au-tokens tok)))
+(define
+  dream-au-bapp
+  ((dream-require-bearer dream-au-lookup)
+    (fn (req) (dream-text (dream-principal req)))))
+
+(dream-au-test
+  "bearer valid principal"
+  (dream-resp-body (dream-au-bapp (dream-request "GET" "/" {:Authorization "Bearer t-ada"} "")))
+  "ada")
+(dream-au-test
+  "bearer invalid 401"
+  (dream-status (dream-au-bapp (dream-request "GET" "/" {:Authorization "Bearer nope"} "")))
+  401)
+(dream-au-test
+  "bearer missing 401"
+  (dream-status (dream-au-bapp (dream-request "GET" "/" {} "")))
+  401)
+(dream-au-test
+  "bearer 401 header"
+  (dream-resp-header
+    (dream-au-bapp (dream-request "GET" "/" {} ""))
+    "www-authenticate")
+  "Bearer")
+
+(define dream-au-tests-run! (fn () {:total (+ dream-au-pass dream-au-fail) :passed dream-au-pass :failed dream-au-fail :fails dream-au-fails}))

lib/dream/tests/cors.sx

@@ -0,0 +1,93 @@
+;; lib/dream/tests/cors.sx — CORS decoration + preflight.
+
+(define dream-co-pass 0)
+(define dream-co-fail 0)
+(define dream-co-fails (list))
+
+(define
+  dream-co-test
+  (fn
+    (name actual expected)
+    (if
+      (= actual expected)
+      (set! dream-co-pass (+ dream-co-pass 1))
+      (begin
+        (set! dream-co-fail (+ dream-co-fail 1))
+        (append! dream-co-fails {:name name :actual actual :expected expected})))))
+
+(define dream-co-h (fn (req) (dream-text "payload")))
+(define dream-co-app (dream-cors dream-co-h))
+
+;; ── decoration of normal responses ─────────────────────────────────
+(define dream-co-get (dream-co-app (dream-request "GET" "/" {} "")))
+(dream-co-test
+  "allow-origin star"
+  (dream-resp-header dream-co-get "access-control-allow-origin")
+  "*")
+(dream-co-test "body preserved" (dream-resp-body dream-co-get) "payload")
+(dream-co-test "status preserved" (dream-status dream-co-get) 200)
+(dream-co-test
+  "no credentials by default"
+  (dream-resp-header dream-co-get "access-control-allow-credentials")
+  nil)
+
+;; ── preflight OPTIONS ──────────────────────────────────────────────
+(define
+  dream-co-pre
+  (dream-co-app (dream-request "OPTIONS" "/" {} "")))
+(dream-co-test "preflight 204" (dream-status dream-co-pre) 204)
+(dream-co-test
+  "preflight origin"
+  (dream-resp-header dream-co-pre "access-control-allow-origin")
+  "*")
+(dream-co-test
+  "preflight methods"
+  (contains?
+    (dream-resp-header dream-co-pre "access-control-allow-methods")
+    "POST")
+  true)
+(dream-co-test
+  "preflight headers"
+  (dream-resp-header dream-co-pre "access-control-allow-headers")
+  "Content-Type")
+(dream-co-test
+  "preflight max-age"
+  (dream-resp-header dream-co-pre "access-control-max-age")
+  "86400")
+
+;; ── custom origin ──────────────────────────────────────────────────
+(define
+  dream-co-custom
+  ((dream-cors-origin "https://app.example.com") dream-co-h))
+(dream-co-test
+  "custom origin"
+  (dream-resp-header
+    (dream-co-custom (dream-request "GET" "/" {} ""))
+    "access-control-allow-origin")
+  "https://app.example.com")
+
+;; ── credentials enabled ────────────────────────────────────────────
+(define
+  dream-co-cred
+  ((dream-cors-with (assoc dream-cors-defaults :credentials true))
+    dream-co-h))
+(dream-co-test
+  "credentials header"
+  (dream-resp-header
+    (dream-co-cred (dream-request "GET" "/" {} ""))
+    "access-control-allow-credentials")
+  "true")
+
+;; ── composes around a router ───────────────────────────────────────
+(define
+  dream-co-router
+  (dream-cors
+    (dream-router (list (dream-get "/api" (fn (req) (dream-json "{}")))))))
+(dream-co-test
+  "router cors origin"
+  (dream-resp-header
+    (dream-co-router (dream-request "GET" "/api" {} ""))
+    "access-control-allow-origin")
+  "*")
+
+(define dream-co-tests-run! (fn () {:total (+ dream-co-pass dream-co-fail) :passed dream-co-pass :failed dream-co-fail :fails dream-co-fails}))

lib/dream/tests/demos.sx

@@ -0,0 +1,198 @@
+;; lib/dream/tests/demos.sx — end-to-end demo apps exercising the full stack.
+
+(define dream-dm-pass 0)
+(define dream-dm-fail 0)
+(define dream-dm-fails (list))
+
+(define
+  dream-dm-test
+  (fn
+    (name actual expected)
+    (if
+      (= actual expected)
+      (set! dream-dm-pass (+ dream-dm-pass 1))
+      (begin
+        (set! dream-dm-fail (+ dream-dm-fail 1))
+        (append! dream-dm-fails {:name name :actual actual :expected expected})))))
+
+(define
+  dream-dm-req
+  (fn (method target headers) (dream-request method target headers "")))
+
+;; ── hello ──────────────────────────────────────────────────────────
+(dream-dm-test
+  "hello root"
+  (dream-resp-body (dream-hello-app (dream-dm-req "GET" "/" {})))
+  "<h1>Hello, World!</h1>")
+(dream-dm-test
+  "hello name"
+  (dream-resp-body
+    (dream-hello-app (dream-dm-req "GET" "/hello/Ada" {})))
+  "<h1>Hello, Ada!</h1>")
+(dream-dm-test
+  "hello content-type"
+  (dream-resp-header
+    (dream-hello-app (dream-dm-req "GET" "/" {}))
+    "content-type")
+  "text/html; charset=utf-8")
+
+;; ── counter (sessions) ─────────────────────────────────────────────
+(define dream-dm-cbackend (dream-memory-sessions))
+(define dream-dm-capp (dream-counter-app-with dream-dm-cbackend))
+
+(define dream-dm-c1 (dream-dm-capp (dream-dm-req "GET" "/" {})))
+(dream-dm-test
+  "counter first visit"
+  (dream-resp-body dream-dm-c1)
+  "<p>You have visited this page 1 time(s).</p>")
+(dream-dm-test
+  "counter sets cookie"
+  (len (dream-resp-cookies dream-dm-c1))
+  1)
+(dream-dm-test
+  "counter second visit"
+  (dream-resp-body (dream-dm-capp (dream-dm-req "GET" "/" {:Cookie "dream.session=s1"})))
+  "<p>You have visited this page 2 time(s).</p>")
+(dream-dm-test
+  "counter third visit"
+  (dream-resp-body (dream-dm-capp (dream-dm-req "GET" "/" {:Cookie "dream.session=s1"})))
+  "<p>You have visited this page 3 time(s).</p>")
+(define
+  dream-dm-reset
+  (dream-dm-capp (dream-dm-req "POST" "/reset" {:Cookie "dream.session=s1"})))
+(dream-dm-test
+  "counter reset redirects"
+  (dream-status dream-dm-reset)
+  303)
+(dream-dm-test
+  "counter after reset"
+  (dream-resp-body (dream-dm-capp (dream-dm-req "GET" "/" {:Cookie "dream.session=s1"})))
+  "<p>You have visited this page 1 time(s).</p>")
+(dream-dm-test
+  "counter distinct session"
+  (dream-resp-body (dream-dm-capp (dream-dm-req "GET" "/" {})))
+  "<p>You have visited this page 1 time(s).</p>")
+
+;; ── chat (websocket rooms) ─────────────────────────────────────────
+(define dream-dm-rooms (dream-chat-rooms))
+(define dream-dm-wsB (dream-mock-ws (list)))
+(define dream-dm-wsC (dream-mock-ws (list)))
+((get dream-dm-rooms :join) "general" dream-dm-wsB)
+((get dream-dm-rooms :join) "general" dream-dm-wsC)
+(dream-dm-test
+  "room has two members"
+  (len ((get dream-dm-rooms :members) "general"))
+  2)
+
+;; client A joins, sends two messages, then disconnects
+(define dream-dm-wsA (dream-mock-ws (list "hi" "again")))
+((dream-chat-session dream-dm-rooms "general") dream-dm-wsA)
+(dream-dm-test
+  "B got broadcasts"
+  (dream-ws-sent dream-dm-wsB)
+  (list "hi" "again"))
+(dream-dm-test
+  "C got broadcasts"
+  (dream-ws-sent dream-dm-wsC)
+  (list "hi" "again"))
+(dream-dm-test
+  "A echoed own messages"
+  (dream-ws-sent dream-dm-wsA)
+  (list "hi" "again"))
+(dream-dm-test
+  "A left on disconnect"
+  (len ((get dream-dm-rooms :members) "general"))
+  2)
+(dream-dm-test "A closed" (dream-ws-closed? dream-dm-wsA) true)
+
+;; route produces an upgrade response
+(define dream-dm-chat-app (dream-chat-app-with (dream-chat-rooms)))
+(dream-dm-test
+  "chat route upgrades"
+  (dream-websocket?
+    (dream-dm-chat-app (dream-dm-req "GET" "/chat/lobby" {})))
+  true)
+(dream-dm-test
+  "chat index html"
+  (dream-resp-body (dream-dm-chat-app (dream-dm-req "GET" "/" {})))
+  "<h1>Rooms</h1>")
+
+;; ── todo (forms + CSRF) ────────────────────────────────────────────
+(define dream-dm-todo-store (dream-todo-store))
+(define dream-dm-todo-backend (dream-memory-sessions))
+(define
+  dream-dm-todo-app
+  (dream-todo-app-with dream-dm-todo-store dream-dm-todo-backend "topsecret"))
+(define
+  dream-dm-todo-tok
+  (dr/csrf-make-token dream-csrf-sign-default "topsecret" "s1"))
+
+;; establish session s1
+(dream-dm-todo-app (dream-request "GET" "/" {} ""))
+(define
+  dream-dm-add1
+  (dream-dm-todo-app
+    (dream-request
+      "POST"
+      "/add"
+      {:Cookie "dream.session=s1"}
+      (str "text=Buy+milk&dream.csrf=" dream-dm-todo-tok))))
+(dream-dm-test "todo add redirects" (dream-status dream-dm-add1) 303)
+(dream-dm-test
+  "todo store has item"
+  (len ((get dream-dm-todo-store :all)))
+  1)
+
+(define
+  dream-dm-todo-page
+  (dream-resp-body
+    (dream-dm-todo-app (dream-request "GET" "/" {:Cookie "dream.session=s1"} ""))))
+(dream-dm-test
+  "todo lists item"
+  (contains? dream-dm-todo-page "Buy milk")
+  true)
+(dream-dm-test
+  "todo has csrf tag"
+  (contains? dream-dm-todo-page "dream.csrf")
+  true)
+(dream-dm-test
+  "todo item not done"
+  (contains? dream-dm-todo-page "[ ] Buy milk")
+  true)
+
+(dream-dm-todo-app
+  (dream-request
+    "POST"
+    "/toggle/1"
+    {:Cookie "dream.session=s1"}
+    (str "dream.csrf=" dream-dm-todo-tok)))
+(dream-dm-test
+  "todo toggled done"
+  (contains?
+    (dream-resp-body
+      (dream-dm-todo-app (dream-request "GET" "/" {:Cookie "dream.session=s1"} "")))
+    "[x] Buy milk")
+  true)
+
+(dream-dm-test
+  "todo add without token 403"
+  (dream-status
+    (dream-dm-todo-app (dream-request "POST" "/add" {:Cookie "dream.session=s1"} "text=Sneaky")))
+  403)
+(dream-dm-test
+  "todo unchanged after reject"
+  (len ((get dream-dm-todo-store :all)))
+  1)
+
+(dream-dm-todo-app
+  (dream-request
+    "POST"
+    "/delete/1"
+    {:Cookie "dream.session=s1"}
+    (str "dream.csrf=" dream-dm-todo-tok)))
+(dream-dm-test
+  "todo deleted"
+  (len ((get dream-dm-todo-store :all)))
+  0)
+
+(define dream-dm-tests-run! (fn () {:total (+ dream-dm-pass dream-dm-fail) :passed dream-dm-pass :failed dream-dm-fail :fails dream-dm-fails}))

lib/dream/tests/error.sx

@@ -0,0 +1,90 @@
+;; lib/dream/tests/error.sx — status phrases + dream-catch.
+
+(define dream-er-pass 0)
+(define dream-er-fail 0)
+(define dream-er-fails (list))
+
+(define
+  dream-er-test
+  (fn
+    (name actual expected)
+    (if
+      (= actual expected)
+      (set! dream-er-pass (+ dream-er-pass 1))
+      (begin
+        (set! dream-er-fail (+ dream-er-fail 1))
+        (append! dream-er-fails {:name name :actual actual :expected expected})))))
+
+;; ── status phrases ─────────────────────────────────────────────────
+(dream-er-test "200 OK" (dream-status-text 200) "OK")
+(dream-er-test "404 Not Found" (dream-status-text 404) "Not Found")
+(dream-er-test
+  "405 phrase"
+  (dream-status-text 405)
+  "Method Not Allowed")
+(dream-er-test
+  "500 phrase"
+  (dream-status-text 500)
+  "Internal Server Error")
+(dream-er-test "unknown phrase" (dream-status-text 599) "Unknown")
+(dream-er-test "status line" (dream-status-line 404) "404 Not Found")
+(dream-er-test
+  "status page status"
+  (dream-status (dream-status-page 403))
+  403)
+(dream-er-test
+  "status page body"
+  (dream-resp-body (dream-status-page 403))
+  "<h1>403 Forbidden</h1>")
+
+;; ── dream-catch ────────────────────────────────────────────────────
+(define dream-er-boom (fn (req) (error "kaboom")))
+(define dream-er-ok (fn (req) (dream-text "fine")))
+
+(dream-er-test
+  "catch normal passes through"
+  (dream-resp-body
+    ((dream-catch dream-er-ok) (dream-request "GET" "/" {} "")))
+  "fine")
+(dream-er-test
+  "catch error -> 500"
+  (dream-status
+    ((dream-catch dream-er-boom) (dream-request "GET" "/" {} "")))
+  500)
+(dream-er-test
+  "catch 500 body"
+  (dream-resp-body
+    ((dream-catch dream-er-boom) (dream-request "GET" "/" {} "")))
+  "<h1>500 Internal Server Error</h1>")
+
+;; custom error page receives the error
+(define
+  dream-er-custom
+  (dream-catch-with (fn (req e) (dream-text (str "ERR:" e)))))
+(dream-er-test
+  "custom error page"
+  (dream-resp-body
+    ((dream-er-custom dream-er-boom) (dream-request "GET" "/" {} "")))
+  "ERR:kaboom")
+(dream-er-test
+  "custom passes normal through"
+  (dream-resp-body
+    ((dream-er-custom dream-er-ok) (dream-request "GET" "/" {} "")))
+  "fine")
+
+;; catch composes around a router
+(define
+  dream-er-app
+  (dream-catch
+    (dream-router
+      (list (dream-get "/boom" dream-er-boom) (dream-get "/ok" dream-er-ok)))))
+(dream-er-test
+  "router error caught"
+  (dream-status (dream-er-app (dream-request "GET" "/boom" {} "")))
+  500)
+(dream-er-test
+  "router ok intact"
+  (dream-resp-body (dream-er-app (dream-request "GET" "/ok" {} "")))
+  "fine")
+
+(define dream-er-tests-run! (fn () {:total (+ dream-er-pass dream-er-fail) :passed dream-er-pass :failed dream-er-fail :fails dream-er-fails}))

lib/dream/tests/flash.sx

@@ -0,0 +1,129 @@
+;; lib/dream/tests/flash.sx — codec + read-after-write across requests.
+
+(define dream-fl-pass 0)
+(define dream-fl-fail 0)
+(define dream-fl-fails (list))
+
+(define
+  dream-fl-test
+  (fn
+    (name actual expected)
+    (if
+      (= actual expected)
+      (set! dream-fl-pass (+ dream-fl-pass 1))
+      (begin
+        (set! dream-fl-fail (+ dream-fl-fail 1))
+        (append! dream-fl-fails {:name name :actual actual :expected expected})))))
+
+;; ── codec ──────────────────────────────────────────────────────────
+(dream-fl-test "encode one" (dr/flash-encode (list {:message "saved" :category "info"})) "info|saved")
+(dream-fl-test
+  "encode two"
+  (dr/flash-encode (list {:message "a" :category "info"} {:message "b" :category "error"}))
+  "info|a~error|b")
+(dream-fl-test "decode one" (dr/flash-decode "info|saved") (list {:message "saved" :category "info"}))
+(dream-fl-test "decode empty" (dr/flash-decode "") (list))
+(dream-fl-test
+  "roundtrip special chars"
+  (dr/flash-decode (dr/flash-encode (list {:message "a~b%c" :category "x|y"})))
+  (list {:message "a~b%c" :category "x|y"}))
+(dream-fl-test "escape pipe" (dr/flash-encode (list {:message "a|b" :category "c"})) "c|a%7Cb")
+
+;; extract a cookie value from a Set-Cookie string
+(define
+  dream-fl-cookie-val
+  (fn
+    (setc)
+    (let
+      ((after (substr setc (+ (index-of setc "=") 1))))
+      (substr after 0 (index-of after ";")))))
+
+;; ── read-after-write across requests ───────────────────────────────
+(define
+  dream-fl-set-h
+  (fn
+    (req)
+    (begin (dream-add-flash-message req "info" "Saved!") (dream-text "done"))))
+(define dream-fl-set-app (dream-flash dream-fl-set-h))
+
+;; request 1: add a flash, no incoming -> sets the flash cookie
+(define
+  dream-fl-r1
+  (dream-fl-set-app (dream-request "POST" "/save" {} "")))
+(dream-fl-test "writer body" (dream-resp-body dream-fl-r1) "done")
+(dream-fl-test
+  "writer sets flash cookie"
+  (len (dream-resp-cookies dream-fl-r1))
+  1)
+(dream-fl-test
+  "writer has no incoming"
+  (dream-flash-messages
+    (assoc (dream-request "GET" "/" {} "") :dream-flash {:box (dr/flash-box) :incoming (list)}))
+  (list))
+
+;; request 2: carries the flash cookie -> handler reads it, cookie cleared
+(define
+  dream-fl-cval
+  (dream-fl-cookie-val (first (dream-resp-cookies dream-fl-r1))))
+(define
+  dream-fl-read-h
+  (fn
+    (req)
+    (let
+      ((msgs (dream-flash-messages req)))
+      (dream-text
+        (if (empty? msgs) "none" (dream-flash-message (first msgs)))))))
+(define dream-fl-read-app (dream-flash dream-fl-read-h))
+(define
+  dream-fl-r2
+  (dream-fl-read-app (dream-request "GET" "/" {:Cookie (str "dream.flash=" dream-fl-cval)} "")))
+(dream-fl-test "reader sees message" (dream-resp-body dream-fl-r2) "Saved!")
+(dream-fl-test
+  "reader clears cookie (Max-Age=0)"
+  (contains? (first (dream-resp-cookies dream-fl-r2)) "Max-Age=0")
+  true)
+
+;; request 3: no flash cookie -> nothing to read, no cookie set
+(define
+  dream-fl-r3
+  (dream-fl-read-app (dream-request "GET" "/" {} "")))
+(dream-fl-test "no flash -> none" (dream-resp-body dream-fl-r3) "none")
+(dream-fl-test
+  "no flash -> no cookie"
+  (len (dream-resp-cookies dream-fl-r3))
+  0)
+
+;; ── multiple categories ────────────────────────────────────────────
+(define
+  dream-fl-multi-h
+  (fn
+    (req)
+    (begin
+      (dream-add-flash-message req "info" "i1")
+      (dream-add-flash-message req "error" "e1")
+      (dream-add-flash-message req "info" "i2")
+      (dream-text "ok"))))
+(define
+  dream-fl-multi-r1
+  ((dream-flash dream-fl-multi-h) (dream-request "GET" "/" {} "")))
+(define
+  dream-fl-multi-val
+  (dream-fl-cookie-val (first (dream-resp-cookies dream-fl-multi-r1))))
+(define
+  dream-fl-count-h
+  (fn
+    (req)
+    (dream-text
+      (str
+        (len (dream-flash-messages req))
+        "/"
+        (len (dream-flash-of req "info"))))))
+(define
+  dream-fl-multi-r2
+  ((dream-flash dream-fl-count-h) (dream-request "GET" "/" {:Cookie (str "dream.flash=" dream-fl-multi-val)} "")))
+(dream-fl-test
+  "multi: all + filtered counts"
+  (dream-resp-body dream-fl-multi-r2)
+  "3/2")
+
+(define dream-fl-tests-run! (fn () {:total (+ dream-fl-pass dream-fl-fail) :passed dream-fl-pass :failed dream-fl-fail :fails dream-fl-fails}))

lib/dream/tests/form.sx

@@ -0,0 +1,226 @@
+;; lib/dream/tests/form.sx — urlencoded parsing, Ok/Err, CSRF accept/reject, multipart.
+
+(define dream-fo-pass 0)
+(define dream-fo-fail 0)
+(define dream-fo-fails (list))
+
+(define
+  dream-fo-test
+  (fn
+    (name actual expected)
+    (if
+      (= actual expected)
+      (set! dream-fo-pass (+ dream-fo-pass 1))
+      (begin
+        (set! dream-fo-fail (+ dream-fo-fail 1))
+        (append! dream-fo-fails {:name name :actual actual :expected expected})))))
+
+;; ── Result ─────────────────────────────────────────────────────────
+(dream-fo-test "ok? on ok" (dream-ok? (dream-ok 5)) true)
+(dream-fo-test "err? on ok" (dream-err? (dream-ok 5)) false)
+(dream-fo-test "ok value" (dream-ok-value (dream-ok {:a 1})) {:a 1})
+(dream-fo-test "err reason" (dream-err-reason (dream-err :bad)) "bad")
+
+;; ── urlencoded parsing ─────────────────────────────────────────────
+(define
+  dream-fo-req
+  (fn (body) (dream-request "POST" "/f" {:Content-Type "application/x-www-form-urlencoded"} body)))
+
+(dream-fo-test
+  "parse two fields"
+  (dream-form-fields (dream-fo-req "a=1&b=2"))
+  {:a "1" :b "2"})
+(dream-fo-test
+  "url-decoded value"
+  (dream-form-field (dream-fo-req "name=Ada+Lovelace") "name")
+  "Ada Lovelace")
+(dream-fo-test
+  "percent decode"
+  (dream-form-field (dream-fo-req "x=a%20b%21") "x")
+  "a b!")
+(dream-fo-test "empty body" (dream-form-fields (dream-fo-req "")) {})
+(dream-fo-test
+  "valueless key"
+  (dream-form-field (dream-fo-req "flag") "flag")
+  "")
+(dream-fo-test
+  "decoded key"
+  (dream-form-field (dream-fo-req "first%20name=x") "first name")
+  "x")
+
+;; ── CSRF sign + verify ─────────────────────────────────────────────
+(dream-fo-test
+  "sign deterministic"
+  (=
+    (dream-csrf-sign-default "secret" "s1")
+    (dream-csrf-sign-default "secret" "s1"))
+  true)
+(dream-fo-test
+  "sign secret-sensitive"
+  (=
+    (dream-csrf-sign-default "secret" "s1")
+    (dream-csrf-sign-default "other" "s1"))
+  false)
+(dream-fo-test
+  "sign session-sensitive"
+  (=
+    (dream-csrf-sign-default "secret" "s1")
+    (dream-csrf-sign-default "secret" "s2"))
+  false)
+(dream-fo-test
+  "token valid for own session"
+  (dr/csrf-valid?
+    dream-csrf-sign-default
+    "k"
+    "s1"
+    (dr/csrf-make-token dream-csrf-sign-default "k" "s1"))
+  true)
+(dream-fo-test
+  "token invalid for other session"
+  (dr/csrf-valid?
+    dream-csrf-sign-default
+    "k"
+    "s2"
+    (dr/csrf-make-token dream-csrf-sign-default "k" "s1"))
+  false)
+(dream-fo-test
+  "tampered token invalid"
+  (dr/csrf-valid? dream-csrf-sign-default "k" "s1" "s1.deadbeef")
+  false)
+(dream-fo-test
+  "empty token invalid"
+  (dr/csrf-valid? dream-csrf-sign-default "k" "s1" "")
+  false)
+(dream-fo-test
+  "nil token invalid"
+  (dr/csrf-valid? dream-csrf-sign-default "k" "s1" nil)
+  false)
+
+;; ── full stack: session -> csrf -> handler ─────────────────────────
+(define dream-fo-backend (dream-memory-sessions))
+(define dream-fo-sid (dream-fo-backend {:op "session/create"}))   ;; s1
+
+(define
+  dream-fo-stack
+  (fn
+    (handler)
+    ((dream-sessions dream-fo-backend) ((dream-csrf "topsecret") handler))))
+
+(define
+  dream-fo-tag-out
+  (dream-resp-body
+    ((dream-fo-stack (fn (req) (dream-text (dream-csrf-tag req))))
+      (dream-request "GET" "/form" {:Cookie "dream.session=s1"} ""))))
+(dream-fo-test
+  "csrf-tag is hidden input"
+  (contains? dream-fo-tag-out "type=\"hidden\"")
+  true)
+(dream-fo-test
+  "csrf-tag names field"
+  (contains? dream-fo-tag-out "name=\"dream.csrf\"")
+  true)
+
+(define
+  dream-fo-good-token
+  (dr/csrf-make-token dream-csrf-sign-default "topsecret" "s1"))
+(define
+  dream-fo-submit
+  (fn
+    (token)
+    ((dream-fo-stack (fn (req) (let ((r (dream-form req))) (if (dream-ok? r) (dream-text (str "ok:" (get (dream-ok-value r) "msg"))) (dream-text (str "err:" (dream-err-reason r)))))))
+      (dream-request
+        "POST"
+        "/form"
+        {:Cookie "dream.session=s1"}
+        (str "msg=hello&dream.csrf=" token)))))
+
+(dream-fo-test
+  "valid csrf -> Ok fields"
+  (dream-resp-body (dream-fo-submit dream-fo-good-token))
+  "ok:hello")
+(dream-fo-test
+  "bad csrf -> Err"
+  (dream-resp-body (dream-fo-submit "s1.wrong"))
+  "err:csrf-token-invalid")
+(dream-fo-test
+  "missing csrf -> Err"
+  (dream-resp-body (dream-fo-submit ""))
+  "err:csrf-token-invalid")
+
+;; ── csrf-protect middleware auto-rejects ───────────────────────────
+(define
+  dream-fo-protected
+  (fn
+    (handler)
+    ((dream-sessions dream-fo-backend)
+      ((dream-csrf-protect "topsecret") handler))))
+(define dream-fo-ph (dream-fo-protected (fn (req) (dream-text "reached"))))
+
+(dream-fo-test
+  "GET passes without token"
+  (dream-resp-body (dream-fo-ph (dream-request "GET" "/x" {:Cookie "dream.session=s1"} "")))
+  "reached")
+(dream-fo-test
+  "POST without token 403"
+  (dream-status (dream-fo-ph (dream-request "POST" "/x" {:Cookie "dream.session=s1"} "")))
+  403)
+(dream-fo-test
+  "POST with valid token reaches"
+  (dream-resp-body
+    (dream-fo-ph
+      (dream-request
+        "POST"
+        "/x"
+        {:Cookie "dream.session=s1"}
+        (str "dream.csrf=" dream-fo-good-token))))
+  "reached")
+
+;; ── multipart/form-data ────────────────────────────────────────────
+(define
+  dream-fo-mp-body
+  (str
+    "--B1\r\n"
+    "Content-Disposition: form-data; name=\"title\"\r\n\r\n"
+    "Hello\r\n"
+    "--B1\r\n"
+    "Content-Disposition: form-data; name=\"file\"; filename=\"a.txt\"\r\nContent-Type: text/plain\r\n\r\n"
+    "line1\r\nline2\r\n"
+    "--B1--\r\n"))
+(define
+  dream-fo-mp-req
+  (dream-request "POST" "/upload" {:Content-Type "multipart/form-data; boundary=B1"} dream-fo-mp-body))
+(define dream-fo-mp (dream-multipart dream-fo-mp-req))
+(dream-fo-test "multipart is Ok" (dream-ok? dream-fo-mp) true)
+(define dream-fo-parts (dream-ok-value dream-fo-mp))
+(dream-fo-test "two parts" (len dream-fo-parts) 2)
+(dream-fo-test
+  "field value"
+  (dream-multipart-field dream-fo-parts "title")
+  "Hello")
+(dream-fo-test
+  "file part filename"
+  (get (dream-multipart-file dream-fo-parts "file") :filename)
+  "a.txt")
+(dream-fo-test
+  "file content-type"
+  (get (dream-multipart-file dream-fo-parts "file") :content-type)
+  "text/plain")
+(dream-fo-test
+  "file content keeps inner CRLF"
+  (get (dream-multipart-file dream-fo-parts "file") :content)
+  "line1\r\nline2")
+(dream-fo-test
+  "field is not a file"
+  (get (dream-multipart-file dream-fo-parts "title") :filename)
+  nil)
+(dream-fo-test
+  "non-multipart is Err"
+  (dream-err? (dream-multipart (dream-request "POST" "/x" {:Content-Type "text/plain"} "hi")))
+  true)
+(dream-fo-test
+  "quoted boundary parsed"
+  (dream-ok?
+    (dream-multipart (dream-request "POST" "/u" {:Content-Type "multipart/form-data; boundary=\"B1\""} dream-fo-mp-body)))
+  true)
+
+(define dream-fo-tests-run! (fn () {:total (+ dream-fo-pass dream-fo-fail) :passed dream-fo-pass :failed dream-fo-fail :fails dream-fo-fails}))

lib/dream/tests/headers.sx

@@ -0,0 +1,94 @@
+;; lib/dream/tests/headers.sx — security headers + cache-control.
+
+(define dream-hd-pass 0)
+(define dream-hd-fail 0)
+(define dream-hd-fails (list))
+
+(define
+  dream-hd-test
+  (fn
+    (name actual expected)
+    (if
+      (= actual expected)
+      (set! dream-hd-pass (+ dream-hd-pass 1))
+      (begin
+        (set! dream-hd-fail (+ dream-hd-fail 1))
+        (append! dream-hd-fails {:name name :actual actual :expected expected})))))
+
+(define dream-hd-h (fn (req) (dream-text "body")))
+(define dream-hd-req (dream-request "GET" "/" {} ""))
+
+;; ── security headers ───────────────────────────────────────────────
+(define dream-hd-sec ((dream-security-headers dream-hd-h) dream-hd-req))
+(dream-hd-test
+  "nosniff"
+  (dream-resp-header dream-hd-sec "x-content-type-options")
+  "nosniff")
+(dream-hd-test
+  "frame deny"
+  (dream-resp-header dream-hd-sec "x-frame-options")
+  "DENY")
+(dream-hd-test
+  "referrer policy"
+  (dream-resp-header dream-hd-sec "referrer-policy")
+  "no-referrer")
+(dream-hd-test
+  "no hsts by default"
+  (dream-resp-header dream-hd-sec "strict-transport-security")
+  nil)
+(dream-hd-test "body preserved" (dream-resp-body dream-hd-sec) "body")
+
+(define
+  dream-hd-hsts
+  ((dream-security-headers-with (assoc dream-security-defaults :hsts true))
+    dream-hd-h))
+(dream-hd-test
+  "hsts when enabled"
+  (contains?
+    (dream-resp-header
+      (dream-hd-hsts dream-hd-req)
+      "strict-transport-security")
+    "max-age=31536000")
+  true)
+
+;; ── cache-control ──────────────────────────────────────────────────
+(dream-hd-test
+  "cache public"
+  (dream-resp-header
+    (dream-cache (dream-text "x") 60)
+    "cache-control")
+  "public, max-age=60")
+(dream-hd-test
+  "private cache"
+  (dream-resp-header
+    (dream-private-cache (dream-text "x") 30)
+    "cache-control")
+  "private, max-age=30")
+(dream-hd-test
+  "no-store"
+  (dream-resp-header (dream-no-store (dream-text "x")) "cache-control")
+  "no-store")
+(dream-hd-test
+  "no-cache"
+  (dream-resp-header (dream-no-cache (dream-text "x")) "cache-control")
+  "no-cache, no-store, must-revalidate")
+
+;; ── cache middleware ───────────────────────────────────────────────
+(define dream-hd-capp ((dream-cache-for 300) dream-hd-h))
+(dream-hd-test
+  "cache-for stamps"
+  (dream-resp-header (dream-hd-capp dream-hd-req) "cache-control")
+  "public, max-age=300")
+
+;; ── composes around a router ───────────────────────────────────────
+(define
+  dream-hd-app
+  (dream-security-headers
+    (dream-router
+      (list (dream-get "/" (fn (req) (dream-html "<p>hi</p>")))))))
+(dream-hd-test
+  "router security header"
+  (dream-resp-header (dream-hd-app dream-hd-req) "x-frame-options")
+  "DENY")
+
+(define dream-hd-tests-run! (fn () {:total (+ dream-hd-pass dream-hd-fail) :passed dream-hd-pass :failed dream-hd-fail :fails dream-hd-fails}))

lib/dream/tests/html.sx

@@ -0,0 +1,59 @@
+;; lib/dream/tests/html.sx — HTML escaping (+ demo XSS regression).
+
+(define dream-ht-pass 0)
+(define dream-ht-fail 0)
+(define dream-ht-fails (list))
+
+(define
+  dream-ht-test
+  (fn
+    (name actual expected)
+    (if
+      (= actual expected)
+      (set! dream-ht-pass (+ dream-ht-pass 1))
+      (begin
+        (set! dream-ht-fail (+ dream-ht-fail 1))
+        (append! dream-ht-fails {:name name :actual actual :expected expected})))))
+
+(dream-ht-test "escape ampersand" (dream-escape "a & b") "a & b")
+(dream-ht-test "escape lt gt" (dream-escape "<b>") "&lt;b&gt;")
+(dream-ht-test "escape quote" (dream-escape "say \"hi\"") "say &quot;hi&quot;")
+(dream-ht-test "escape apostrophe" (dream-escape "it's") "it&#39;s")
+(dream-ht-test
+  "escape script tag"
+  (dream-escape "<script>alert(1)</script>")
+  "&lt;script&gt;alert(1)&lt;/script&gt;")
+(dream-ht-test
+  "ampersand first (no double-escape)"
+  (dream-escape "&lt;")
+  "&amp;lt;")
+(dream-ht-test
+  "safe string unchanged"
+  (dream-escape "hello world")
+  "hello world")
+(dream-ht-test
+  "attr escapes value"
+  (dream-attr "title" "a\"b")
+  "title=\"a&quot;b\"")
+(dream-ht-test
+  "escape-join"
+  (dream-escape-join " " (list "<a>" "<b>"))
+  "&lt;a&gt; &lt;b&gt;")
+
+;; ── todo demo escapes user input (XSS regression) ──────────────────
+(define dream-ht-store (dream-todo-store))
+((get dream-ht-store :add) "<script>alert(1)</script>")
+(define
+  dream-ht-ctx
+  (assoc (dream-request "GET" "/" {} "") :dream-csrf {:sign dream-csrf-sign-default :sid "s1" :secret "k"}))
+(define dream-ht-rendered (dr/todo-render dream-ht-store dream-ht-ctx))
+(dream-ht-test
+  "todo escapes script"
+  (contains? dream-ht-rendered "&lt;script&gt;")
+  true)
+(dream-ht-test
+  "todo has no raw script"
+  (contains? dream-ht-rendered "<script>")
+  false)
+
+(define dream-ht-tests-run! (fn () {:total (+ dream-ht-pass dream-ht-fail) :passed dream-ht-pass :failed dream-ht-fail :fails dream-ht-fails}))

lib/dream/tests/json.sx

@@ -0,0 +1,105 @@
+;; lib/dream/tests/json.sx — JSON encode/parse round-trips.
+
+(define dream-js-pass 0)
+(define dream-js-fail 0)
+(define dream-js-fails (list))
+
+(define
+  dream-js-test
+  (fn
+    (name actual expected)
+    (if
+      (= actual expected)
+      (set! dream-js-pass (+ dream-js-pass 1))
+      (begin
+        (set! dream-js-fail (+ dream-js-fail 1))
+        (append! dream-js-fails {:name name :actual actual :expected expected})))))
+
+;; ── encoding scalars ───────────────────────────────────────────────
+(dream-js-test "encode int" (dream-json-encode 42) "42")
+(dream-js-test "encode float" (dream-json-encode 1.5) "1.5")
+(dream-js-test "encode true" (dream-json-encode true) "true")
+(dream-js-test "encode false" (dream-json-encode false) "false")
+(dream-js-test "encode nil" (dream-json-encode nil) "null")
+(dream-js-test "encode string" (dream-json-encode "hi") "\"hi\"")
+(dream-js-test
+  "encode string escapes quote"
+  (dream-json-encode "a\"b")
+  "\"a\\\"b\"")
+(dream-js-test
+  "encode list"
+  (dream-json-encode (list 1 2 3))
+  "[1,2,3]")
+(dream-js-test
+  "encode list of strings"
+  (dream-json-encode (list "a" "b"))
+  "[\"a\",\"b\"]")
+(dream-js-test
+  "encode single-key dict"
+  (dream-json-encode {:a 1})
+  "{\"a\":1}")
+(dream-js-test "encode empty list" (dream-json-encode (list)) "[]")
+(dream-js-test "encode empty dict" (dream-json-encode {}) "{}")
+
+;; ── parsing scalars ────────────────────────────────────────────────
+(dream-js-test "parse int" (dream-json-parse "5") 5)
+(dream-js-test "parse negative" (dream-json-parse "-7") -7)
+(dream-js-test "parse float" (dream-json-parse "1.5") 1.5)
+(dream-js-test "parse true" (dream-json-parse "true") true)
+(dream-js-test "parse false" (dream-json-parse "false") false)
+(dream-js-test "parse null" (dream-json-parse "null") nil)
+(dream-js-test "parse string" (dream-json-parse "\"hello\"") "hello")
+(dream-js-test "parse string escape" (dream-json-parse "\"a\\nb\"") "a\nb")
+(dream-js-test
+  "parse array"
+  (dream-json-parse "[1,2,3]")
+  (list 1 2 3))
+(dream-js-test "parse empty array" (dream-json-parse "[]") (list))
+(dream-js-test
+  "parse with whitespace"
+  (dream-json-parse "  [ 1 , 2 ]  ")
+  (list 1 2))
+
+;; ── parsing objects ────────────────────────────────────────────────
+(define dream-js-obj (dream-json-parse "{\"x\":5,\"y\":\"hi\"}"))
+(dream-js-test "parse obj number" (get dream-js-obj "x") 5)
+(dream-js-test "parse obj string" (get dream-js-obj "y") "hi")
+(dream-js-test "parse empty obj" (dream-json-parse "{}") {})
+
+;; ── nested ─────────────────────────────────────────────────────────
+(define dream-js-nested (dream-json-parse "{\"a\":[1,{\"b\":2}],\"c\":true}"))
+(dream-js-test
+  "nested array first"
+  (first (get dream-js-nested "a"))
+  1)
+(dream-js-test
+  "nested object in array"
+  (get (nth (get dream-js-nested "a") 1) "b")
+  2)
+(dream-js-test "nested bool" (get dream-js-nested "c") true)
+
+;; ── round-trips ────────────────────────────────────────────────────
+(define dream-js-v {:name "Ada" :age 36 :tags (list "math" "engine")})
+(define dream-js-rt (dream-json-parse (dream-json-encode dream-js-v)))
+(dream-js-test "roundtrip name" (get dream-js-rt "name") "Ada")
+(dream-js-test "roundtrip age" (get dream-js-rt "age") 36)
+(dream-js-test
+  "roundtrip tags"
+  (get dream-js-rt "tags")
+  (list "math" "engine"))
+
+;; ── response + request helpers ─────────────────────────────────────
+(dream-js-test
+  "json-value content-type"
+  (dream-resp-header (dream-json-value {:ok true}) "content-type")
+  "application/json")
+(dream-js-test
+  "json-value body"
+  (dream-resp-body (dream-json-value {:ok true}))
+  "{\"ok\":true}")
+(dream-js-test
+  "json-body parses request"
+  (get (dream-json-body (dream-request "POST" "/" {} "{\"n\":9}")) "n")
+  9)
+
+(define dream-js-tests-run! (fn () {:total (+ dream-js-pass dream-js-fail) :passed dream-js-pass :failed dream-js-fail :fails dream-js-fails}))

lib/dream/tests/middleware.sx

@@ -0,0 +1,150 @@
+;; lib/dream/tests/middleware.sx — composition, logger, content-type sniffer.
+
+(define dream-mw-pass 0)
+(define dream-mw-fail 0)
+(define dream-mw-fails (list))
+
+(define
+  dream-mw-test
+  (fn
+    (name actual expected)
+    (if
+      (= actual expected)
+      (set! dream-mw-pass (+ dream-mw-pass 1))
+      (begin
+        (set! dream-mw-fail (+ dream-mw-fail 1))
+        (append! dream-mw-fails {:name name :actual actual :expected expected})))))
+
+(define dream-mw-req (dream-request "GET" "/p" {} ""))
+
+;; ── pipeline composition order ─────────────────────────────────────
+(define
+  dream-mw-wrap
+  (fn
+    (tag)
+    (fn
+      (next)
+      (fn
+        (req)
+        (dream-html (str tag "(" (dream-resp-body (next req)) ")"))))))
+(define dream-mw-h (fn (req) (dream-html "h")))
+
+(dream-mw-test
+  "pipeline empty is identity"
+  (dream-resp-body ((dream-pipeline (list) dream-mw-h) dream-mw-req))
+  "h")
+(dream-mw-test
+  "pipeline single"
+  (dream-resp-body
+    ((dream-pipeline (list (dream-mw-wrap "a")) dream-mw-h) dream-mw-req))
+  "a(h)")
+(dream-mw-test
+  "pipeline first is outermost"
+  (dream-resp-body
+    ((dream-pipeline (list (dream-mw-wrap "a") (dream-mw-wrap "b")) dream-mw-h)
+      dream-mw-req))
+  "a(b(h))")
+(dream-mw-test
+  "no-middleware is identity"
+  (dream-resp-body ((dream-no-middleware dream-mw-h) dream-mw-req))
+  "h")
+
+;; ── logger ─────────────────────────────────────────────────────────
+(define dream-mw-clock-n 0)
+(define
+  dream-mw-clock
+  (fn
+    ()
+    (begin
+      (set! dream-mw-clock-n (+ dream-mw-clock-n 1))
+      dream-mw-clock-n)))
+(define dream-mw-entries (list))
+(define dream-mw-sink (fn (e) (append! dream-mw-entries e)))
+(define
+  dream-mw-logged
+  ((dream-logger-with dream-mw-clock dream-mw-sink)
+    (fn (req) (dream-html-status 201 "ok"))))
+(define
+  dream-mw-lresp
+  (dream-mw-logged (dream-request "POST" "/log/path" {} "")))
+
+(dream-mw-test
+  "logger passes response through"
+  (dream-resp-body dream-mw-lresp)
+  "ok")
+(dream-mw-test "logger records one entry" (len dream-mw-entries) 1)
+(dream-mw-test
+  "logger entry method"
+  (get (first dream-mw-entries) :method)
+  "POST")
+(dream-mw-test
+  "logger entry path"
+  (get (first dream-mw-entries) :path)
+  "/log/path")
+(dream-mw-test
+  "logger entry status"
+  (get (first dream-mw-entries) :status)
+  201)
+(dream-mw-test
+  "logger entry elapsed"
+  (get (first dream-mw-entries) :elapsed)
+  1)
+(dream-mw-test
+  "log-line format"
+  (dream-log-line {:path "/x" :status 200 :method "GET" :elapsed 4})
+  "GET /x -> 200 (4ms)")
+
+;; ── content-type sniffer ───────────────────────────────────────────
+(define dream-mw-ct (fn (handler) (dream-content-type handler)))
+(define
+  dream-mw-sniff
+  (fn
+    (body)
+    (dream-resp-header
+      ((dream-content-type (fn (req) (dream-response 200 {} body)))
+        dream-mw-req)
+      "content-type")))
+
+(dream-mw-test
+  "sniff html"
+  (dream-mw-sniff "<p>hi</p>")
+  "text/html; charset=utf-8")
+(dream-mw-test
+  "sniff doctype"
+  (dream-mw-sniff "<!doctype html>")
+  "text/html; charset=utf-8")
+(dream-mw-test
+  "sniff json object"
+  (dream-mw-sniff "{\"a\":1}")
+  "application/json")
+(dream-mw-test "sniff json array" (dream-mw-sniff "[1,2]") "application/json")
+(dream-mw-test
+  "sniff plain text"
+  (dream-mw-sniff "just words")
+  "text/plain; charset=utf-8")
+(dream-mw-test
+  "sniff empty body"
+  (dream-mw-sniff "")
+  "text/plain; charset=utf-8")
+(dream-mw-test
+  "sniff does not override existing"
+  (dream-resp-header
+    ((dream-content-type (fn (req) (dream-json "{}"))) dream-mw-req)
+    "content-type")
+  "application/json")
+
+;; ── small middlewares ──────────────────────────────────────────────
+(dream-mw-test
+  "set-header attaches"
+  (dream-resp-header
+    (((dream-set-header "X-A" "1") dream-mw-h) dream-mw-req)
+    "x-a")
+  "1")
+(dream-mw-test
+  "tap-request rewrites"
+  (dream-resp-body
+    (((dream-tap-request (fn (req) (dream-set-body req "tapped"))) (fn (req) (dream-html (dream-body req))))
+      (dream-request "GET" "/" {} "orig")))
+  "tapped")
+
+(define dream-mw-tests-run! (fn () {:total (+ dream-mw-pass dream-mw-fail) :passed dream-mw-pass :failed dream-mw-fail :fails dream-mw-fails}))

lib/dream/tests/router.sx

@@ -0,0 +1,272 @@
+;; lib/dream/tests/router.sx — routing dispatch, path params, scopes, 405/HEAD.
+
+(define dream-rt-pass 0)
+(define dream-rt-fail 0)
+(define dream-rt-fails (list))
+
+(define
+  dream-rt-test
+  (fn
+    (name actual expected)
+    (if
+      (= actual expected)
+      (set! dream-rt-pass (+ dream-rt-pass 1))
+      (begin
+        (set! dream-rt-fail (+ dream-rt-fail 1))
+        (append! dream-rt-fails {:name name :actual actual :expected expected})))))
+
+(define
+  dream-rt-req
+  (fn (method target) (dream-request method target {} "")))
+
+;; ── basic dispatch ─────────────────────────────────────────────────
+(define
+  dream-rt-app
+  (dream-router
+    (list
+      (dream-get "/" (fn (req) (dream-text "home")))
+      (dream-get "/about" (fn (req) (dream-text "about")))
+      (dream-post "/submit" (fn (req) (dream-text "posted"))))))
+
+(dream-rt-test
+  "GET / -> home"
+  (dream-resp-body (dream-rt-app (dream-rt-req "GET" "/")))
+  "home")
+(dream-rt-test
+  "GET /about"
+  (dream-resp-body (dream-rt-app (dream-rt-req "GET" "/about")))
+  "about")
+(dream-rt-test
+  "POST /submit"
+  (dream-resp-body (dream-rt-app (dream-rt-req "POST" "/submit")))
+  "posted")
+(dream-rt-test
+  "unknown path 404"
+  (dream-status (dream-rt-app (dream-rt-req "GET" "/nope")))
+  404)
+(dream-rt-test
+  "wrong method 405"
+  (dream-status (dream-rt-app (dream-rt-req "GET" "/submit")))
+  405)
+(dream-rt-test
+  "trailing slash equiv"
+  (dream-resp-body (dream-rt-app (dream-rt-req "GET" "/about/")))
+  "about")
+(dream-rt-test
+  "query ignored for routing"
+  (dream-resp-body (dream-rt-app (dream-rt-req "GET" "/about?x=1")))
+  "about")
+
+;; ── path params ────────────────────────────────────────────────────
+(define
+  dream-rt-papp
+  (dream-router
+    (list
+      (dream-get
+        "/users/:id"
+        (fn (req) (dream-text (dream-param req "id"))))
+      (dream-get
+        "/users/:id/posts/:pid"
+        (fn
+          (req)
+          (dream-text
+            (str (dream-param req "id") "-" (dream-param req "pid")))))
+      (dream-get
+        "/files/**"
+        (fn (req) (dream-text (dream-param req "**")))))))
+
+(dream-rt-test
+  "single param"
+  (dream-resp-body (dream-rt-papp (dream-rt-req "GET" "/users/42")))
+  "42")
+(dream-rt-test
+  "two params"
+  (dream-resp-body (dream-rt-papp (dream-rt-req "GET" "/users/7/posts/9")))
+  "7-9")
+(dream-rt-test
+  "param no over-match"
+  (dream-status (dream-rt-papp (dream-rt-req "GET" "/users/7/extra")))
+  404)
+(dream-rt-test
+  "catch-all captures rest"
+  (dream-resp-body (dream-rt-papp (dream-rt-req "GET" "/files/a/b/c.txt")))
+  "a/b/c.txt")
+(dream-rt-test
+  "catch-all empty rest"
+  (dream-resp-body (dream-rt-papp (dream-rt-req "GET" "/files/")))
+  "")
+
+;; ── route order: first match wins ──────────────────────────────────
+(define
+  dream-rt-order
+  (dream-router
+    (list
+      (dream-get "/x/specific" (fn (req) (dream-text "specific")))
+      (dream-get "/x/:slug" (fn (req) (dream-text "generic"))))))
+(dream-rt-test
+  "first match wins"
+  (dream-resp-body (dream-rt-order (dream-rt-req "GET" "/x/specific")))
+  "specific")
+(dream-rt-test
+  "fallthrough to param"
+  (dream-resp-body (dream-rt-order (dream-rt-req "GET" "/x/other")))
+  "generic")
+
+;; ── ANY method ─────────────────────────────────────────────────────
+(define
+  dream-rt-any
+  (dream-router
+    (list (dream-any "/ping" (fn (req) (dream-text (dream-method req)))))))
+(dream-rt-test
+  "ANY matches GET"
+  (dream-resp-body (dream-rt-any (dream-rt-req "GET" "/ping")))
+  "GET")
+(dream-rt-test
+  "ANY matches DELETE"
+  (dream-resp-body (dream-rt-any (dream-rt-req "DELETE" "/ping")))
+  "DELETE")
+
+;; ── handler returns bare string (coerced) ──────────────────────────
+(define
+  dream-rt-coerce
+  (dream-router (list (dream-get "/s" (fn (req) "bare")))))
+(dream-rt-test
+  "string coerced to 200"
+  (dream-status (dream-rt-coerce (dream-rt-req "GET" "/s")))
+  200)
+(dream-rt-test
+  "string coerced body"
+  (dream-resp-body (dream-rt-coerce (dream-rt-req "GET" "/s")))
+  "bare")
+
+;; ── scope: prefix mount ────────────────────────────────────────────
+(define
+  dream-rt-scoped
+  (dream-router
+    (list
+      (dream-get "/" (fn (req) (dream-text "root")))
+      (dream-scope
+        "/api"
+        (list)
+        (list
+          (dream-get "/users" (fn (req) (dream-text "api-users")))
+          (dream-get
+            "/users/:id"
+            (fn
+              (req)
+              (dream-text (str "api-user-" (dream-param req "id"))))))))))
+(dream-rt-test
+  "scope root still works"
+  (dream-resp-body (dream-rt-scoped (dream-rt-req "GET" "/")))
+  "root")
+(dream-rt-test
+  "scope prefix path"
+  (dream-resp-body (dream-rt-scoped (dream-rt-req "GET" "/api/users")))
+  "api-users")
+(dream-rt-test
+  "scope prefix param"
+  (dream-resp-body (dream-rt-scoped (dream-rt-req "GET" "/api/users/5")))
+  "api-user-5")
+(dream-rt-test
+  "scope unprefixed 404"
+  (dream-status (dream-rt-scoped (dream-rt-req "GET" "/users")))
+  404)
+
+;; ── scope: middleware applied to all routes ────────────────────────
+(define
+  dream-rt-mw
+  (fn (next) (fn (req) (dream-add-header (next req) "X-Scope" "on"))))
+(define
+  dream-rt-mwapp
+  (dream-router
+    (list
+      (dream-scope
+        "/v1"
+        (list dream-rt-mw)
+        (list (dream-get "/a" (fn (req) (dream-text "a"))))))))
+(dream-rt-test
+  "scope mw header"
+  (dream-resp-header (dream-rt-mwapp (dream-rt-req "GET" "/v1/a")) "x-scope")
+  "on")
+(dream-rt-test
+  "scope mw body intact"
+  (dream-resp-body (dream-rt-mwapp (dream-rt-req "GET" "/v1/a")))
+  "a")
+
+;; ── nested scopes ──────────────────────────────────────────────────
+(define
+  dream-rt-outer
+  (fn (next) (fn (req) (dream-add-header (next req) "X-Outer" "1"))))
+(define
+  dream-rt-inner
+  (fn (next) (fn (req) (dream-add-header (next req) "X-Inner" "1"))))
+(define
+  dream-rt-nested
+  (dream-router
+    (list
+      (dream-scope
+        "/api"
+        (list dream-rt-outer)
+        (list
+          (dream-scope
+            "/v2"
+            (list dream-rt-inner)
+            (list (dream-get "/thing" (fn (req) (dream-text "thing"))))))))))
+(dream-rt-test
+  "nested path"
+  (dream-resp-body (dream-rt-nested (dream-rt-req "GET" "/api/v2/thing")))
+  "thing")
+(dream-rt-test
+  "nested outer mw"
+  (dream-resp-header
+    (dream-rt-nested (dream-rt-req "GET" "/api/v2/thing"))
+    "x-outer")
+  "1")
+(dream-rt-test
+  "nested inner mw"
+  (dream-resp-header
+    (dream-rt-nested (dream-rt-req "GET" "/api/v2/thing"))
+    "x-inner")
+  "1")
+
+;; ── 405 Method Not Allowed + Allow ─────────────────────────────────
+(define
+  dream-rt-mapp
+  (dream-router
+    (list
+      (dream-get "/r" (fn (req) (dream-text "get")))
+      (dream-post "/r" (fn (req) (dream-text "post")))
+      (dream-get "/only" (fn (req) (dream-html "<p>hi</p>"))))))
+(define dream-rt-405 (dream-rt-mapp (dream-rt-req "DELETE" "/r")))
+(dream-rt-test "405 status" (dream-status dream-rt-405) 405)
+(dream-rt-test
+  "405 Allow has GET"
+  (contains? (dream-resp-header dream-rt-405 "allow") "GET")
+  true)
+(dream-rt-test
+  "405 Allow has POST"
+  (contains? (dream-resp-header dream-rt-405 "allow") "POST")
+  true)
+(dream-rt-test
+  "matching method still works"
+  (dream-resp-body (dream-rt-mapp (dream-rt-req "POST" "/r")))
+  "post")
+(dream-rt-test
+  "no path is 404 not 405"
+  (dream-status (dream-rt-mapp (dream-rt-req "DELETE" "/absent")))
+  404)
+
+;; ── automatic HEAD (serve GET, empty body) ─────────────────────────
+(define dream-rt-head (dream-rt-mapp (dream-rt-req "HEAD" "/only")))
+(dream-rt-test "HEAD status 200" (dream-status dream-rt-head) 200)
+(dream-rt-test "HEAD empty body" (dream-resp-body dream-rt-head) "")
+(dream-rt-test
+  "HEAD keeps content-type"
+  (dream-resp-header dream-rt-head "content-type")
+  "text/html; charset=utf-8")
+(dream-rt-test
+  "HEAD on missing path 404"
+  (dream-status (dream-rt-mapp (dream-rt-req "HEAD" "/none")))
+  404)
+
+(define dream-rt-tests-run! (fn () {:total (+ dream-rt-pass dream-rt-fail) :passed dream-rt-pass :failed dream-rt-fail :fails dream-rt-fails}))

lib/dream/tests/run.sx

@@ -0,0 +1,123 @@
+;; lib/dream/tests/run.sx — app adapter + dream-run wiring.
+
+(define dream-rn-pass 0)
+(define dream-rn-fail 0)
+(define dream-rn-fails (list))
+
+(define
+  dream-rn-test
+  (fn
+    (name actual expected)
+    (if
+      (= actual expected)
+      (set! dream-rn-pass (+ dream-rn-pass 1))
+      (begin
+        (set! dream-rn-fail (+ dream-rn-fail 1))
+        (append! dream-rn-fails {:name name :actual actual :expected expected})))))
+
+;; ── app adapter: raw -> serialised response ────────────────────────
+(define
+  dream-rn-router
+  (dream-router
+    (list
+      (dream-get "/" (fn (req) (dream-text "home")))
+      (dream-get
+        "/u/:id"
+        (fn (req) (dream-text (str "u=" (dream-param req "id")))))
+      (dream-post "/echo" (fn (req) (dream-text (dream-body req)))))))
+(define dream-rn-app (dream-app dream-rn-router))
+
+(define dream-rn-r1 (dream-rn-app {:method "GET" :target "/"}))
+(dream-rn-test "serialised status" (get dream-rn-r1 :status) 200)
+(dream-rn-test "serialised body" (get dream-rn-r1 :body) "home")
+(dream-rn-test
+  "serialised content-type"
+  (get (get dream-rn-r1 :headers) "content-type")
+  "text/plain; charset=utf-8")
+(dream-rn-test
+  "serialised set-cookies empty"
+  (get dream-rn-r1 :set-cookies)
+  (list))
+
+(dream-rn-test
+  "adapts target+params"
+  (get (dream-rn-app {:method "GET" :target "/u/42"}) :body)
+  "u=42")
+(dream-rn-test "adapts body" (get (dream-rn-app {:body "ping" :method "POST" :target "/echo"}) :body) "ping")
+(dream-rn-test
+  "method defaults to GET"
+  (get (dream-rn-app {:target "/"}) :body)
+  "home")
+(dream-rn-test
+  "missing target -> /"
+  (get (dream-rn-app {:method "GET"}) :status)
+  200)
+(dream-rn-test
+  "unknown route 404"
+  (get (dream-rn-app {:method "GET" :target "/nope"}) :status)
+  404)
+
+;; bare-string handler is coerced
+(define dream-rn-bare (dream-app (fn (req) "plain")))
+(dream-rn-test
+  "coerces bare string status"
+  (get (dream-rn-bare {:target "/"}) :status)
+  200)
+(dream-rn-test
+  "coerces bare string body"
+  (get (dream-rn-bare {:target "/"}) :body)
+  "plain")
+
+;; ── set-cookies flow through (session middleware) ──────────────────
+(define
+  dream-rn-sess-app
+  (dream-app
+    ((dream-sessions (dream-memory-sessions))
+      (fn (req) (dream-text "ok")))))
+(define dream-rn-sess-r (dream-rn-sess-app {:method "GET" :target "/"}))
+(dream-rn-test
+  "session set-cookie present"
+  (len (get dream-rn-sess-r :set-cookies))
+  1)
+(dream-rn-test
+  "session cookie content"
+  (contains? (first (get dream-rn-sess-r :set-cookies)) "dream.session=")
+  true)
+
+;; ── websocket upgrade serialisation ────────────────────────────────
+(define
+  dream-rn-ws-app
+  (dream-app (dream-websocket (fn (ws) (dream-close ws)))))
+(define dream-rn-ws-r (dream-rn-ws-app {:method "GET" :target "/ws"}))
+(dream-rn-test "ws upgrade status 101" (get dream-rn-ws-r :status) 101)
+(dream-rn-test
+  "ws handler carried"
+  (not (nil? (get dream-rn-ws-r :websocket)))
+  true)
+
+;; ── dream-run wiring (mock listen captures the op) ─────────────────
+(define dream-rn-captured nil)
+(define
+  dream-rn-listen
+  (fn (op) (begin (set! dream-rn-captured op) :listening)))
+(define
+  dream-rn-result
+  (dream-run-with dream-rn-listen dream-rn-router {:port 9000}))
+(dream-rn-test "listen returns" dream-rn-result :listening)
+(dream-rn-test "listen op kind" (get dream-rn-captured :op) "http/listen")
+(dream-rn-test "listen port" (get dream-rn-captured :port) 9000)
+(dream-rn-test
+  "default port"
+  (get
+    (begin
+      (dream-run-with dream-rn-listen dream-rn-router {})
+      dream-rn-captured)
+    :port)
+  8080)
+;; the captured app is runnable
+(dream-rn-test
+  "captured app serves"
+  (get ((get dream-rn-captured :app) {:method "GET" :target "/"}) :body)
+  "home")
+
+(define dream-rn-tests-run! (fn () {:total (+ dream-rn-pass dream-rn-fail) :passed dream-rn-pass :failed dream-rn-fail :fails dream-rn-fails}))

lib/dream/tests/session.sx

@@ -0,0 +1,197 @@
+;; lib/dream/tests/session.sx — cookies, store, session round-trip, signed cookies.
+
+(define dream-ss-pass 0)
+(define dream-ss-fail 0)
+(define dream-ss-fails (list))
+
+(define
+  dream-ss-test
+  (fn
+    (name actual expected)
+    (if
+      (= actual expected)
+      (set! dream-ss-pass (+ dream-ss-pass 1))
+      (begin
+        (set! dream-ss-fail (+ dream-ss-fail 1))
+        (append! dream-ss-fails {:name name :actual actual :expected expected})))))
+
+;; ── cookie parsing ─────────────────────────────────────────────────
+(define dream-ss-creq (dream-request "GET" "/" {:Cookie "a=1; b=2; dream.session=s9"} ""))
+(dream-ss-test "parse cookie a" (dream-cookie dream-ss-creq "a") "1")
+(dream-ss-test "parse cookie b" (dream-cookie dream-ss-creq "b") "2")
+(dream-ss-test
+  "parse session cookie"
+  (dream-cookie dream-ss-creq "dream.session")
+  "s9")
+(dream-ss-test "missing cookie nil" (dream-cookie dream-ss-creq "z") nil)
+(dream-ss-test
+  "no cookie header"
+  (dream-cookie (dream-request "GET" "/" {} "") "a")
+  nil)
+
+;; ── cookie building ────────────────────────────────────────────────
+(dream-ss-test
+  "build basic cookie"
+  (dr/build-cookie "k" "v" {})
+  "k=v; Path=/")
+(dream-ss-test
+  "build httponly samesite"
+  (dr/build-cookie "sid" "x" {:http-only true :same-site "Lax"})
+  "sid=x; Path=/; HttpOnly; SameSite=Lax")
+(dream-ss-test
+  "build max-age"
+  (dr/build-cookie "k" "v" {:max-age 0})
+  "k=v; Path=/; Max-Age=0")
+(dream-ss-test
+  "set-cookie appends"
+  (len
+    (dream-resp-cookies
+      (dream-set-cookie (dream-html "x") "k" "v" {})))
+  1)
+(dream-ss-test
+  "set-cookie two"
+  (len
+    (dream-resp-cookies
+      (dream-set-cookie
+        (dream-set-cookie (dream-html "x") "a" "1" {})
+        "b"
+        "2"
+        {})))
+  2)
+(dream-ss-test
+  "drop cookie max-age 0"
+  (contains?
+    (first (dream-resp-cookies (dream-drop-cookie (dream-html "x") "k")))
+    "Max-Age=0")
+  true)
+
+;; ── signed cookie values ───────────────────────────────────────────
+(dream-ss-test
+  "sign/unsign roundtrip"
+  (dream-cookie-unsign "k" (dream-cookie-sign "k" "s5"))
+  "s5")
+(dream-ss-test
+  "unsign wrong secret"
+  (dream-cookie-unsign "k2" (dream-cookie-sign "k" "s5"))
+  nil)
+(dream-ss-test "unsign tampered" (dream-cookie-unsign "k" "s5.999") nil)
+(dream-ss-test "unsign no dot" (dream-cookie-unsign "k" "s5") nil)
+(dream-ss-test "unsign nil" (dream-cookie-unsign "k" nil) nil)
+
+;; ── in-memory store ────────────────────────────────────────────────
+(define dream-ss-store (dream-memory-sessions))
+(define dream-ss-sid (dream-ss-store {:op "session/create"}))
+(dream-ss-test "create returns id" dream-ss-sid "s1")
+(dream-ss-test "new session exists" (dream-ss-store {:op "session/exists" :sid "s1"}) true)
+(dream-ss-test "absent session not exists" (dream-ss-store {:op "session/exists" :sid "s99"}) false)
+(dream-ss-test "get missing key nil" (dream-ss-store {:key "k" :op "session/get" :sid "s1"}) nil)
+(dream-ss-store {:val "ada" :key "user" :op "session/set" :sid "s1"})
+(dream-ss-test "set then get" (dream-ss-store {:key "user" :op "session/get" :sid "s1"}) "ada")
+(dream-ss-store {:val "admin" :key "role" :op "session/set" :sid "s1"})
+(dream-ss-test "load all fields" (dream-ss-store {:op "session/load" :sid "s1"}) {:role "admin" :user "ada"})
+(dream-ss-test "second create distinct" (dream-ss-store {:op "session/create"}) "s2")
+(dream-ss-store {:op "session/clear" :sid "s1"})
+(dream-ss-test "clear removes" (dream-ss-store {:op "session/exists" :sid "s1"}) false)
+
+;; ── middleware round-trip ──────────────────────────────────────────
+(define dream-ss-backend (dream-memory-sessions))
+(define
+  dream-ss-counter-h
+  (fn
+    (req)
+    (let
+      ((n (or (dream-session-field req "count") 0)))
+      (begin
+        (dream-set-session-field req "count" (+ n 1))
+        (dream-text (str "count=" (+ n 1)))))))
+(define dream-ss-app ((dream-sessions dream-ss-backend) dream-ss-counter-h))
+
+(define dream-ss-r1 (dream-ss-app (dream-request "GET" "/" {} "")))
+(dream-ss-test "first body count=1" (dream-resp-body dream-ss-r1) "count=1")
+(dream-ss-test
+  "first sets one cookie"
+  (len (dream-resp-cookies dream-ss-r1))
+  1)
+(dream-ss-test
+  "session cookie name+id"
+  (contains? (first (dream-resp-cookies dream-ss-r1)) "dream.session=s1")
+  true)
+(dream-ss-test
+  "session cookie httponly"
+  (contains? (first (dream-resp-cookies dream-ss-r1)) "HttpOnly")
+  true)
+
+(define dream-ss-r2 (dream-ss-app (dream-request "GET" "/" {:Cookie "dream.session=s1"} "")))
+(dream-ss-test "second body count=2" (dream-resp-body dream-ss-r2) "count=2")
+(dream-ss-test
+  "second sets no cookie"
+  (len (dream-resp-cookies dream-ss-r2))
+  0)
+
+(define dream-ss-r3 (dream-ss-app (dream-request "GET" "/" {:Cookie "dream.session=s1"} "")))
+(dream-ss-test "third body count=3" (dream-resp-body dream-ss-r3) "count=3")
+
+(define dream-ss-r4 (dream-ss-app (dream-request "GET" "/" {:Cookie "dream.session=bogus"} "")))
+(dream-ss-test
+  "bogus id starts fresh"
+  (dream-resp-body dream-ss-r4)
+  "count=1")
+(dream-ss-test
+  "bogus id gets new cookie"
+  (len (dream-resp-cookies dream-ss-r4))
+  1)
+
+;; ── session-all + invalidate via middleware ────────────────────────
+(dream-ss-test
+  "session-all shows count"
+  (dream-session-all
+    (assoc (dream-request "GET" "/" {} "") :dream-session {:io dream-ss-backend :sid "s1"}))
+  {:count 3})
+
+(define
+  dream-ss-invalidate-h
+  (fn (req) (begin (dream-invalidate-session req) (dream-text "bye"))))
+(define
+  dream-ss-app3
+  ((dream-sessions dream-ss-backend) dream-ss-invalidate-h))
+(dream-ss-app3 (dream-request "GET" "/" {:Cookie "dream.session=s1"} ""))
+(dream-ss-test "invalidate clears store" (dream-ss-backend {:op "session/exists" :sid "s1"}) false)
+
+;; ── signed session middleware ──────────────────────────────────────
+(define dream-ss-sbackend (dream-memory-sessions))
+(define
+  dream-ss-sapp
+  ((dream-sessions-signed dream-ss-sbackend "topsecret")
+    (fn (req) (dream-text (dream-session-id req)))))
+
+(define dream-ss-sr1 (dream-ss-sapp (dream-request "GET" "/" {} "")))
+(dream-ss-test "signed first sid" (dream-resp-body dream-ss-sr1) "s1")
+(dream-ss-test
+  "signed cookie is signed"
+  (contains? (first (dream-resp-cookies dream-ss-sr1)) "dream.session=s1.")
+  true)
+
+;; forged plaintext sid (no signature) is rejected -> a fresh session is made
+(dream-ss-test
+  "forged plaintext rejected -> new session"
+  (dream-resp-body (dream-ss-sapp (dream-request "GET" "/" {:Cookie "dream.session=s1"} "")))
+  "s2")
+
+;; a validly-signed cookie reuses the session
+(define dream-ss-signed-val (dream-cookie-sign "topsecret" "s1"))
+(define dream-ss-sr3 (dream-ss-sapp (dream-request "GET" "/" {:Cookie (str "dream.session=" dream-ss-signed-val)} "")))
+(dream-ss-test "valid signed reuses s1" (dream-resp-body dream-ss-sr3) "s1")
+(dream-ss-test
+  "valid signed sets no new cookie"
+  (len (dream-resp-cookies dream-ss-sr3))
+  0)
+
+;; a cookie signed with the wrong secret is rejected
+(dream-ss-test
+  "wrong-secret signed rejected"
+  (=
+    (dream-resp-body (dream-ss-sapp (dream-request "GET" "/" {:Cookie (str "dream.session=" (dream-cookie-sign "other" "s1"))} "")))
+    "s1")
+  false)
+
+(define dream-ss-tests-run! (fn () {:total (+ dream-ss-pass dream-ss-fail) :passed dream-ss-pass :failed dream-ss-fail :fails dream-ss-fails}))

lib/dream/tests/static.sx

@@ -0,0 +1,125 @@
+;; lib/dream/tests/static.sx — content types, etags, 304, ranges, traversal.
+
+(define dream-st-pass 0)
+(define dream-st-fail 0)
+(define dream-st-fails (list))
+
+(define
+  dream-st-test
+  (fn
+    (name actual expected)
+    (if
+      (= actual expected)
+      (set! dream-st-pass (+ dream-st-pass 1))
+      (begin
+        (set! dream-st-fail (+ dream-st-fail 1))
+        (append! dream-st-fails {:name name :actual actual :expected expected})))))
+
+;; ── content type + ext ─────────────────────────────────────────────
+(dream-st-test "ext css" (dr/ext-of "a/b/style.css") "css")
+(dream-st-test "ext multi-dot" (dr/ext-of "a.min.js") "js")
+(dream-st-test "ext none" (dr/ext-of "README") "")
+(dream-st-test
+  "ctype css"
+  (dream-content-type-for "x.css")
+  "text/css; charset=utf-8")
+(dream-st-test
+  "ctype html"
+  (dream-content-type-for "x.html")
+  "text/html; charset=utf-8")
+(dream-st-test "ctype png" (dream-content-type-for "x.png") "image/png")
+(dream-st-test
+  "ctype unknown"
+  (dream-content-type-for "x.bin")
+  "application/octet-stream")
+
+;; ── etag ───────────────────────────────────────────────────────────
+(dream-st-test
+  "etag deterministic"
+  (= (dr/etag-of "abc") (dr/etag-of "abc"))
+  true)
+(dream-st-test
+  "etag content-sensitive"
+  (= (dr/etag-of "abc") (dr/etag-of "abd"))
+  false)
+(dream-st-test
+  "etag length-sensitive"
+  (= (dr/etag-of "ab") (dr/etag-of "abc"))
+  false)
+
+;; ── serving via router mount ───────────────────────────────────────
+(define dream-st-files {:/srv/app.css "body{color:red}" :/srv/index.html "<h1>Hi</h1>"})
+(define dream-st-fs (dream-memory-fs dream-st-files))
+(define
+  dream-st-app
+  (dream-router
+    (list (dream-get "/static/**" (dream-static-with "/srv" dream-st-fs)))))
+(define
+  dream-st-get
+  (fn
+    (target headers)
+    (dream-st-app (dream-request "GET" target headers ""))))
+
+(define dream-st-css (dream-st-get "/static/app.css" {}))
+(dream-st-test "serve status 200" (dream-status dream-st-css) 200)
+(dream-st-test "serve body" (dream-resp-body dream-st-css) "body{color:red}")
+(dream-st-test
+  "serve content-type"
+  (dream-resp-header dream-st-css "content-type")
+  "text/css; charset=utf-8")
+(dream-st-test
+  "serve accept-ranges"
+  (dream-resp-header dream-st-css "accept-ranges")
+  "bytes")
+(dream-st-test
+  "serve has etag"
+  (not (nil? (dream-resp-header dream-st-css "etag")))
+  true)
+(dream-st-test
+  "missing file 404"
+  (dream-status (dream-st-get "/static/nope.txt" {}))
+  404)
+(dream-st-test
+  "traversal blocked 403"
+  (dream-status (dream-st-get "/static/../secret" {}))
+  403)
+
+;; ── conditional: If-None-Match -> 304 ──────────────────────────────
+(define dream-st-etag (dream-resp-header dream-st-css "etag"))
+(define dream-st-304 (dream-st-get "/static/app.css" {:If-None-Match dream-st-etag}))
+(dream-st-test "matching etag 304" (dream-status dream-st-304) 304)
+(dream-st-test "304 empty body" (dream-resp-body dream-st-304) "")
+(dream-st-test
+  "stale etag 200"
+  (dream-status (dream-st-get "/static/app.css" {:If-None-Match "\"stale\""}))
+  200)
+(dream-st-test
+  "star etag 304"
+  (dream-status (dream-st-get "/static/app.css" {:If-None-Match "*"}))
+  304)
+
+;; ── range requests ─────────────────────────────────────────────────
+(define dream-st-range (dream-st-get "/static/app.css" {:Range "bytes=0-3"}))
+(dream-st-test "range status 206" (dream-status dream-st-range) 206)
+(dream-st-test "range body slice" (dream-resp-body dream-st-range) "body")
+(dream-st-test
+  "range content-range"
+  (dream-resp-header dream-st-range "content-range")
+  "bytes 0-3/15")
+(define dream-st-open (dream-st-get "/static/app.css" {:Range "bytes=5-"}))
+(dream-st-test "open range body" (dream-resp-body dream-st-open) "color:red}")
+(dream-st-test
+  "open range header"
+  (dream-resp-header dream-st-open "content-range")
+  "bytes 5-14/15")
+(define dream-st-bad (dream-st-get "/static/app.css" {:Range "bytes=20-30"}))
+(dream-st-test
+  "unsatisfiable range 416"
+  (dream-status dream-st-bad)
+  416)
+(dream-st-test
+  "416 content-range"
+  (dream-resp-header dream-st-bad "content-range")
+  "bytes */15")
+
+(define dream-st-tests-run! (fn () {:total (+ dream-st-pass dream-st-fail) :passed dream-st-pass :failed dream-st-fail :fails dream-st-fails}))

lib/dream/tests/types.sx

@@ -0,0 +1,199 @@
+;; lib/dream/tests/types.sx — request/response/route records + convenience.
+
+(define dream-ty-pass 0)
+(define dream-ty-fail 0)
+(define dream-ty-fails (list))
+
+(define
+  dream-ty-test
+  (fn
+    (name actual expected)
+    (if
+      (= actual expected)
+      (set! dream-ty-pass (+ dream-ty-pass 1))
+      (begin
+        (set! dream-ty-fail (+ dream-ty-fail 1))
+        (append! dream-ty-fails {:name name :actual actual :expected expected})))))
+
+;; ── request construction + accessors ───────────────────────────────
+(define
+  dream-ty-req
+  (dream-request "get" "/users/42?tab=info&x=1" {:X-Token "abc" :Content-Type "text/html"} "hello"))
+
+(dream-ty-test "method uppercased" (dream-method dream-ty-req) "GET")
+(dream-ty-test "path strips query" (dream-path dream-ty-req) "/users/42")
+(dream-ty-test
+  "target keeps query"
+  (dream-target dream-ty-req)
+  "/users/42?tab=info&x=1")
+(dream-ty-test "body" (dream-body dream-ty-req) "hello")
+(dream-ty-test
+  "header case-insensitive"
+  (dream-header dream-ty-req "content-type")
+  "text/html")
+(dream-ty-test
+  "header mixed case"
+  (dream-header dream-ty-req "X-Token")
+  "abc")
+(dream-ty-test
+  "missing header is nil"
+  (dream-header dream-ty-req "absent")
+  nil)
+(dream-ty-test
+  "query param tab"
+  (dream-query-param dream-ty-req "tab")
+  "info")
+(dream-ty-test "query param x" (dream-query-param dream-ty-req "x") "1")
+(dream-ty-test "params empty by default" (dream-param dream-ty-req "id") nil)
+(dream-ty-test "is a request" (dream-request? dream-ty-req) true)
+(dream-ty-test "string is not a request" (dream-request? "x") false)
+
+;; ── query edge cases ───────────────────────────────────────────────
+(dream-ty-test
+  "no query is empty"
+  (dream-query-param (dream-request "GET" "/plain" {} "") "k")
+  nil)
+(dream-ty-test
+  "valueless query param"
+  (dream-query-param (dream-request "GET" "/p?flag" {} "") "flag")
+  "")
+
+;; ── path params ────────────────────────────────────────────────────
+(define dream-ty-req2 (dream-with-param dream-ty-req "id" "42"))
+(dream-ty-test "with-param sets" (dream-param dream-ty-req2 "id") "42")
+(dream-ty-test "with-param immutable" (dream-param dream-ty-req "id") nil)
+(define dream-ty-req3 (dream-with-params dream-ty-req {:a "1" :b "2"}))
+(dream-ty-test "with-params a" (dream-param dream-ty-req3 "a") "1")
+(dream-ty-test "with-params b" (dream-param dream-ty-req3 "b") "2")
+
+;; ── request convenience ────────────────────────────────────────────
+(dream-ty-test "queries dict" (dream-queries dream-ty-req) {:x "1" :tab "info"})
+(dream-ty-test
+  "query-or present"
+  (dream-query-param-or dream-ty-req "tab" "def")
+  "info")
+(dream-ty-test
+  "query-or default"
+  (dream-query-param-or dream-ty-req "missing" "def")
+  "def")
+(dream-ty-test "has-query yes" (dream-has-query? dream-ty-req "tab") true)
+(dream-ty-test "has-query no" (dream-has-query? dream-ty-req "nope") false)
+(dream-ty-test
+  "header-or present"
+  (dream-header-or dream-ty-req "x-token" "d")
+  "abc")
+(dream-ty-test
+  "header-or default"
+  (dream-header-or dream-ty-req "x-absent" "d")
+  "d")
+(dream-ty-test
+  "has-header yes"
+  (dream-has-header? dream-ty-req "Content-Type")
+  true)
+(dream-ty-test
+  "has-header no"
+  (dream-has-header? dream-ty-req "x-absent")
+  false)
+(dream-ty-test "param-or default" (dream-param-or dream-ty-req "id" "0") "0")
+(dream-ty-test
+  "param-or present"
+  (dream-param-or dream-ty-req2 "id" "0")
+  "42")
+(dream-ty-test
+  "content-type-of"
+  (dream-content-type-of dream-ty-req)
+  "text/html")
+(dream-ty-test "method-is yes" (dream-method-is? dream-ty-req "get") true)
+(dream-ty-test "method-is no" (dream-method-is? dream-ty-req "post") false)
+(define dream-ty-jreq (dream-request "GET" "/" {:Accept "application/json, text/html"} ""))
+(dream-ty-test
+  "accepts json"
+  (dream-accepts? dream-ty-jreq "application/json")
+  true)
+(dream-ty-test
+  "accepts missing"
+  (dream-accepts? dream-ty-req "application/json")
+  false)
+(dream-ty-test "wants-json yes" (dream-wants-json? dream-ty-jreq) true)
+(dream-ty-test "wants-json no" (dream-wants-json? dream-ty-req) false)
+
+;; ── response construction ──────────────────────────────────────────
+(dream-ty-test "html status" (dream-status (dream-html "<p>")) 200)
+(dream-ty-test "html body" (dream-resp-body (dream-html "<p>")) "<p>")
+(dream-ty-test
+  "html content-type"
+  (dream-resp-header (dream-html "<p>") "content-type")
+  "text/html; charset=utf-8")
+(dream-ty-test
+  "text content-type"
+  (dream-resp-header (dream-text "hi") "content-type")
+  "text/plain; charset=utf-8")
+(dream-ty-test
+  "json content-type"
+  (dream-resp-header (dream-json "{}") "content-type")
+  "application/json")
+(dream-ty-test
+  "html-status code"
+  (dream-status (dream-html-status 201 "ok"))
+  201)
+(dream-ty-test
+  "not-found status"
+  (dream-status (dream-not-found))
+  404)
+(dream-ty-test
+  "empty status"
+  (dream-status (dream-empty 204))
+  204)
+(dream-ty-test "empty body" (dream-resp-body (dream-empty 204)) "")
+(dream-ty-test
+  "redirect status"
+  (dream-status (dream-redirect "/home"))
+  303)
+(dream-ty-test
+  "redirect location"
+  (dream-resp-header (dream-redirect "/home") "location")
+  "/home")
+(dream-ty-test
+  "redirect-status code"
+  (dream-status (dream-redirect-status 301 "/x"))
+  301)
+(dream-ty-test "is a response" (dream-response? (dream-html "x")) true)
+
+;; ── response mutation ──────────────────────────────────────────────
+(define dream-ty-resp (dream-add-header (dream-html "x") "X-Custom" "yes"))
+(dream-ty-test
+  "add-header"
+  (dream-resp-header dream-ty-resp "x-custom")
+  "yes")
+(dream-ty-test "add-header keeps body" (dream-resp-body dream-ty-resp) "x")
+(dream-ty-test
+  "set-status"
+  (dream-status (dream-set-status (dream-html "x") 500))
+  500)
+
+;; ── coercion ───────────────────────────────────────────────────────
+(dream-ty-test
+  "coerce string"
+  (dream-status (dream-coerce-response "hi"))
+  200)
+(dream-ty-test
+  "coerce string body"
+  (dream-resp-body (dream-coerce-response "hi"))
+  "hi")
+(dream-ty-test
+  "coerce response passthrough"
+  (dream-status (dream-coerce-response (dream-empty 204)))
+  204)
+
+;; ── route ──────────────────────────────────────────────────────────
+(define dream-ty-h (fn (req) (dream-text "ok")))
+(define dream-ty-route (dream-route "post" "/submit" dream-ty-h))
+(dream-ty-test "route method" (dream-route-method dream-ty-route) "POST")
+(dream-ty-test "route path" (dream-route-path dream-ty-route) "/submit")
+(dream-ty-test "route is route" (dream-route? dream-ty-route) true)
+(dream-ty-test
+  "route handler invokes"
+  (dream-resp-body ((dream-route-handler dream-ty-route) dream-ty-req))
+  "ok")
+
+(define dream-ty-tests-run! (fn () {:total (+ dream-ty-pass dream-ty-fail) :passed dream-ty-pass :failed dream-ty-fail :fails dream-ty-fails}))

lib/dream/tests/websocket.sx

@@ -0,0 +1,94 @@
+;; lib/dream/tests/websocket.sx — upgrade, send/receive/close, broadcast.
+
+(define dream-ws-pass 0)
+(define dream-ws-fail 0)
+(define dream-ws-fails (list))
+
+(define
+  dream-ws-test
+  (fn
+    (name actual expected)
+    (if
+      (= actual expected)
+      (set! dream-ws-pass (+ dream-ws-pass 1))
+      (begin
+        (set! dream-ws-fail (+ dream-ws-fail 1))
+        (append! dream-ws-fails {:name name :actual actual :expected expected})))))
+
+;; ── upgrade response ───────────────────────────────────────────────
+(define dream-ws-echo (fn (ws) (dream-text "unused")))
+(define
+  dream-ws-up
+  ((dream-websocket dream-ws-echo) (dream-request "GET" "/ws" {} "")))
+(dream-ws-test "upgrade status 101" (dream-status dream-ws-up) 101)
+(dream-ws-test "is a websocket response" (dream-websocket? dream-ws-up) true)
+(dream-ws-test
+  "plain response is not ws"
+  (dream-websocket? (dream-html "x"))
+  false)
+(dream-ws-test
+  "upgrade header"
+  (dream-resp-header dream-ws-up "upgrade")
+  "websocket")
+
+;; ── basic send / receive / close on a mock ─────────────────────────
+(define dream-ws-w1 (dream-mock-ws (list "hi" "there")))
+(dream-ws-test "open initially" (dream-ws-open? dream-ws-w1) true)
+(dream-ws-test "receive first" (dream-receive dream-ws-w1) "hi")
+(dream-ws-test "receive second" (dream-receive dream-ws-w1) "there")
+(dream-ws-test "receive empty -> nil" (dream-receive dream-ws-w1) nil)
+(dream-send dream-ws-w1 "out1")
+(dream-send dream-ws-w1 "out2")
+(dream-ws-test
+  "sent recorded"
+  (dream-ws-sent dream-ws-w1)
+  (list "out1" "out2"))
+(dream-close dream-ws-w1)
+(dream-ws-test "closed flag" (dream-ws-closed? dream-ws-w1) true)
+(dream-ws-test "open? false after close" (dream-ws-open? dream-ws-w1) false)
+
+;; ── echo handler driven over the upgrade response ──────────────────
+(define
+  dream-ws-echo-h
+  (fn
+    (ws)
+    (let
+      ((m (dream-receive ws)))
+      (if
+        (nil? m)
+        (dream-close ws)
+        (begin (dream-send ws (str "echo:" m)) (dream-ws-echo-h ws))))))
+(define
+  dream-ws-echo-up
+  ((dream-websocket dream-ws-echo-h)
+    (dream-request "GET" "/ws" {} "")))
+(define dream-ws-echo-conn (dream-mock-ws (list "a" "b" "c")))
+(dream-ws-run dream-ws-echo-up dream-ws-echo-conn)
+(dream-ws-test
+  "echo all messages"
+  (dream-ws-sent dream-ws-echo-conn)
+  (list "echo:a" "echo:b" "echo:c"))
+(dream-ws-test
+  "echo closes at end"
+  (dream-ws-closed? dream-ws-echo-conn)
+  true)
+
+;; ── broadcast to a room ────────────────────────────────────────────
+(define dream-ws-c1 (dream-mock-ws (list)))
+(define dream-ws-c2 (dream-mock-ws (list)))
+(define dream-ws-c3 (dream-mock-ws (list)))
+(dream-ws-broadcast (list dream-ws-c1 dream-ws-c2 dream-ws-c3) "hello room")
+(dream-ws-test
+  "broadcast c1"
+  (dream-ws-sent dream-ws-c1)
+  (list "hello room"))
+(dream-ws-test
+  "broadcast c2"
+  (dream-ws-sent dream-ws-c2)
+  (list "hello room"))
+(dream-ws-test
+  "broadcast c3"
+  (dream-ws-sent dream-ws-c3)
+  (list "hello room"))
+
+(define dream-ws-tests-run! (fn () {:total (+ dream-ws-pass dream-ws-fail) :passed dream-ws-pass :failed dream-ws-fail :fails dream-ws-fails}))

lib/dream/types.sx

@@ -0,0 +1,175 @@
+;; lib/dream/types.sx — Dream-on-SX core types.
+;; The five types: request, response, route. handler = request->response and
+;; middleware = handler->handler are plain SX functions (no records needed).
+;; request/response/route are dicts. Headers are dicts with lowercased string
+;; keys; keywords are strings in SX, so :content-type == "content-type".
+
+;; ── internal helpers ───────────────────────────────────────────────
+(define
+  dr/normalize-headers
+  (fn
+    (h)
+    (reduce
+      (fn (acc k) (assoc acc (lower k) (get h k)))
+      {}
+      (keys h))))
+
+(define
+  dr/path-of
+  (fn
+    (target)
+    (let
+      ((i (index-of target "?")))
+      (if (< i 0) target (substr target 0 i)))))
+
+(define
+  dr/query-of
+  (fn
+    (target)
+    (let
+      ((i (index-of target "?")))
+      (if (< i 0) "" (substr target (+ i 1))))))
+
+(define
+  dr/parse-pair
+  (fn
+    (acc pair)
+    (if
+      (= pair "")
+      acc
+      (let
+        ((j (index-of pair "=")))
+        (if
+          (< j 0)
+          (assoc acc pair "")
+          (assoc
+            acc
+            (substr pair 0 j)
+            (substr pair (+ j 1))))))))
+
+(define
+  dr/parse-query
+  (fn
+    (target)
+    (let
+      ((q (dr/query-of target)))
+      (if
+        (= q "")
+        {}
+        (reduce dr/parse-pair {} (split q "&"))))))
+
+;; ── request ────────────────────────────────────────────────────────
+(define dream-request (fn (method target headers body) {:path (dr/path-of target) :params {} :query (dr/parse-query target) :body body :headers (dr/normalize-headers headers) :method (upper method) :target target}))
+
+(define
+  dream-request?
+  (fn (x) (and (dict? x) (has-key? x :method) (has-key? x :path))))
+(define dream-method (fn (req) (get req :method)))
+(define dream-target (fn (req) (get req :target)))
+(define dream-path (fn (req) (get req :path)))
+(define dream-body (fn (req) (get req :body)))
+(define
+  dream-header
+  (fn (req name) (get (get req :headers) (lower name))))
+(define dream-query-param (fn (req name) (get (get req :query) name)))
+(define dream-param (fn (req name) (get (get req :params) name)))
+(define dream-params (fn (req) (get req :params)))
+
+;; router fills path params during dispatch
+(define
+  dream-with-param
+  (fn
+    (req name val)
+    (assoc req :params (assoc (get req :params) name val))))
+(define
+  dream-with-params
+  (fn
+    (req more)
+    (assoc
+      req
+      :params (reduce
+        (fn (acc k) (assoc acc k (get more k)))
+        (get req :params)
+        (keys more)))))
+(define dream-set-body (fn (req body) (assoc req :body body)))
+
+;; ── request convenience ────────────────────────────────────────────
+(define dream-queries (fn (req) (get req :query)))
+(define
+  dream-query-param-or
+  (fn (req name default) (or (dream-query-param req name) default)))
+(define dream-has-query? (fn (req name) (has-key? (get req :query) name)))
+(define
+  dream-header-or
+  (fn (req name default) (or (dream-header req name) default)))
+(define
+  dream-has-header?
+  (fn (req name) (has-key? (get req :headers) (lower name))))
+(define
+  dream-param-or
+  (fn (req name default) (or (dream-param req name) default)))
+(define dream-has-param? (fn (req name) (has-key? (get req :params) name)))
+(define dream-content-type-of (fn (req) (dream-header req "content-type")))
+(define dream-method-is? (fn (req m) (= (dream-method req) (upper m))))
+(define
+  dream-accepts?
+  (fn
+    (req mime)
+    (let
+      ((a (dream-header req "accept")))
+      (if a (contains? a mime) false))))
+(define
+  dream-wants-json?
+  (fn (req) (dream-accepts? req "application/json")))
+
+;; ── response ───────────────────────────────────────────────────────
+(define dream-response (fn (status headers body) {:body body :headers (dr/normalize-headers headers) :status status}))
+
+(define
+  dream-response?
+  (fn (x) (and (dict? x) (has-key? x :status) (has-key? x :body))))
+(define dream-status (fn (resp) (get resp :status)))
+(define
+  dream-resp-header
+  (fn (resp name) (get (get resp :headers) (lower name))))
+(define dream-resp-body (fn (resp) (get resp :body)))
+(define dream-headers (fn (resp) (get resp :headers)))
+
+(define
+  dream-add-header
+  (fn
+    (resp name val)
+    (assoc resp :headers (assoc (get resp :headers) (lower name) val))))
+(define dream-set-status (fn (resp status) (assoc resp :status status)))
+
+;; smart constructors
+(define dream-html (fn (body) (dream-response 200 {:content-type "text/html; charset=utf-8"} body)))
+(define
+  dream-html-status
+  (fn (status body) (dream-response status {:content-type "text/html; charset=utf-8"} body)))
+(define dream-text (fn (body) (dream-response 200 {:content-type "text/plain; charset=utf-8"} body)))
+(define dream-json (fn (body) (dream-response 200 {:content-type "application/json"} body)))
+(define dream-empty (fn (status) (dream-response status {} "")))
+(define
+  dream-not-found
+  (fn () (dream-response 404 {:content-type "text/plain; charset=utf-8"} "Not Found")))
+(define
+  dream-redirect
+  (fn (location) (dream-response 303 {:location location} "")))
+(define
+  dream-redirect-status
+  (fn (status location) (dream-response status {:location location} "")))
+
+;; coerce a handler result: strings become 200 text/html responses
+(define
+  dream-coerce-response
+  (fn (x) (if (dream-response? x) x (dream-html x))))
+
+;; ── route ──────────────────────────────────────────────────────────
+(define dream-route (fn (method path handler) {:path path :handler handler :method (upper method)}))
+(define
+  dream-route?
+  (fn (x) (and (dict? x) (has-key? x :handler) (has-key? x :path))))
+(define dream-route-method (fn (r) (get r :method)))
+(define dream-route-path (fn (r) (get r :path)))
+(define dream-route-handler (fn (r) (get r :handler)))

lib/dream/websocket.sx

@@ -0,0 +1,42 @@
+;; lib/dream/websocket.sx — Dream-on-SX WebSockets.
+;; dream-websocket wraps a (fn (ws) ...) handler into an ordinary handler that
+;; returns a 101 upgrade response carrying the ws handler. The host detects the
+;; upgrade, builds a ws backed by host IO, and runs the handler. The ws carries an
+;; injectable io fn — a mock in-memory ws for tests, (perform op) in production.
+;; Depends on types.sx.
+
+;; ── upgrade response ───────────────────────────────────────────────
+(define dream-websocket (fn (handler) (fn (req) {:websocket handler :body "" :headers {:connection "Upgrade" :upgrade "websocket"} :status 101})))
+
+(define
+  dream-websocket?
+  (fn (resp) (and (dict? resp) (has-key? resp :websocket))))
+(define dream-ws-handler (fn (resp) (get resp :websocket)))
+
+;; ── ws operations (over an injectable io) ──────────────────────────
+(define dream-send (fn (ws msg) ((get ws :io) {:op "ws/send" :msg msg})))
+(define dream-receive (fn (ws) ((get ws :io) {:op "ws/receive"})))
+(define dream-close (fn (ws) ((get ws :io) {:op "ws/close"})))
+(define dream-ws-open? (fn (ws) ((get ws :io) {:op "ws/open?"})))
+(define
+  dream-ws-broadcast
+  (fn (wss msg) (for-each (fn (ws) (dream-send ws msg)) wss)))
+
+;; production io: every op suspends to the host
+(define dream-ws-perform-io (fn (op) (perform op)))
+(define dream-ws-from-io (fn (io) {:io io}))
+
+;; ── in-memory mock ws (tests + demos) ──────────────────────────────
+;; incoming is a list of messages dream-receive will yield in order.
+(define
+  dream-mock-ws
+  (fn
+    (incoming)
+    (let ((inbox incoming) (outbox (list)) (closed false)) {:closed? (fn () closed) :outbox (fn () outbox) :io (fn (op) (cond ((= (get op :op) "ws/send") (begin (set! outbox (concat outbox (list (get op :msg)))) true)) ((= (get op :op) "ws/receive") (if (empty? inbox) nil (let ((m (first inbox))) (begin (set! inbox (rest inbox)) m)))) ((= (get op :op) "ws/close") (begin (set! closed true) true)) ((= (get op :op) "ws/open?") (not closed)) (else nil)))})))
+
+;; test/demo introspection
+(define dream-ws-sent (fn (ws) ((get ws :outbox))))
+(define dream-ws-closed? (fn (ws) ((get ws :closed?))))
+
+;; drive a ws handler (from an upgrade response) against a ws
+(define dream-ws-run (fn (resp ws) ((dream-ws-handler resp) ws)))

lib/erlang/runtime.sx

@@ -853,112 +853,6 @@
 (define er-modules-get (fn () (nth er-modules 0)))
 (define er-modules-reset! (fn () (set-nth! er-modules 0 {})))
 
-(define er-mk-module-slot
-  (fn (mod-env old-env version)
-    {:current mod-env :old old-env :version version :tag "module"}))
-
-(define er-module-current-env (fn (slot) (get slot :current)))
-(define er-module-old-env (fn (slot) (get slot :old)))
-(define er-module-version (fn (slot) (get slot :version)))
-
-;; ── FFI BIF registry (Phase 8) ───────────────────────────────────
-;; Global dict from "Module/Name/Arity" key to {:module :name :arity :fn :pure?}.
-;; Replaces the giant cond chain in transpile.sx#er-apply-remote-bif over time —
-;; Phase 8 BIFs (crypto / cid / file / httpc / sqlite) all register here.
-(define er-bif-registry (list {}))
-(define er-bif-registry-get (fn () (nth er-bif-registry 0)))
-(define er-bif-registry-reset! (fn () (set-nth! er-bif-registry 0 {})))
-
-(define er-bif-key
-  (fn (module name arity)
-    (str module "/" name "/" arity)))
-
-(define er-register-bif!
-  (fn (module name arity sx-fn)
-    (dict-set! (er-bif-registry-get) (er-bif-key module name arity)
-      {:module module :name name :arity arity :fn sx-fn :pure? false})
-    (er-mk-atom "ok")))
-
-(define er-register-pure-bif!
-  (fn (module name arity sx-fn)
-    (dict-set! (er-bif-registry-get) (er-bif-key module name arity)
-      {:module module :name name :arity arity :fn sx-fn :pure? true})
-    (er-mk-atom "ok")))
-
-(define er-lookup-bif
-  (fn (module name arity)
-    (let ((reg (er-bif-registry-get)) (k (er-bif-key module name arity)))
-      (if (dict-has? reg k) (get reg k) nil))))
-
-(define er-list-bifs
-  (fn () (keys (er-bif-registry-get))))
-
-;; ── term marshalling (Phase 8) ───────────────────────────────────
-;; Bridge Erlang term values (tagged dicts) and SX-native values for
-;; FFI BIFs to call out into platform primitives. Conversions:
-;;
-;;   Erlang                          SX-native
-;;   ─────────────────────────       ────────────────
-;;   atom  {:tag "atom" :name S}  ↔  symbol (make-symbol S)
-;;   nil   {:tag "nil"}           ↔  '()
-;;   cons  {:tag "cons" :head :tail} →  list of marshalled elements
-;;   tuple {:tag "tuple" :elements} →  list of marshalled elements
-;;   binary {:tag "binary" :bytes} ↔ SX string
-;;   integer / float / boolean   ↔ passthrough
-;;   SX string on the way back   →  binary
-;;
-;; Pids, refs, funs pass through unchanged — they have no SX-native
-;; equivalent and are opaque to FFI primitives.
-
-(define er-cons-to-sx-list
-  (fn (v)
-    (cond
-      (er-nil? v) (list)
-      (er-cons? v)
-        (let ((tail (er-cons-to-sx-list (get v :tail)))
-              (head (er-to-sx (get v :head))))
-          (let ((out (list head)))
-            (for-each
-              (fn (i) (append! out (nth tail i)))
-              (range 0 (len tail)))
-            out))
-      :else (list v))))
-
-(define er-to-sx
-  (fn (v)
-    (cond
-      (er-atom? v) (make-symbol (get v :name))
-      (er-nil? v) (list)
-      (er-cons? v) (er-cons-to-sx-list v)
-      (er-tuple? v)
-        (let ((out (list)) (es (get v :elements)))
-          (for-each
-            (fn (i) (append! out (er-to-sx (nth es i))))
-            (range 0 (len es)))
-          out)
-      (er-binary? v) (list->string (map integer->char (get v :bytes)))
-      :else v)))
-
-(define er-of-sx
-  (fn (v)
-    (let ((ty (type-of v)))
-      (cond
-        (= ty "symbol") (er-mk-atom (str v))
-        (= ty "string") (er-mk-binary (map char->integer (string->list v)))
-        (= ty "list")
-          (let ((out (er-mk-nil)))
-            (for-each
-              (fn (i)
-                (set! out
-                  (er-mk-cons (er-of-sx (nth v (- (- (len v) 1) i))) out)))
-              (range 0 (len v)))
-            out)
-        (= ty "nil") (er-mk-nil)
-        :else v))))
-
-
-
-
 ;; Load an Erlang module declaration. Source must start with
 ;; `-module(Name).` and contain function definitions. Functions
 ;; sharing a name (different arities) get their clauses concatenated
@@ -1003,15 +897,7 @@
               ((all-clauses (get by-name k)))
               (er-env-bind! mod-env k (er-mk-fun all-clauses mod-env))))
           (keys by-name))
-        (let ((registry (er-modules-get)))
-          (if (dict-has? registry mod-name)
-            (let ((existing-slot (get registry mod-name)))
-              (dict-set! registry mod-name
-                (er-mk-module-slot mod-env
-                  (er-module-current-env existing-slot)
-                  (+ (er-module-version existing-slot) 1))))
-            (dict-set! registry mod-name
-              (er-mk-module-slot mod-env nil 1))))
+        (dict-set! (er-modules-get) mod-name mod-env)
         (er-mk-atom mod-name)))))
 
 (define
@@ -1019,7 +905,7 @@
   (fn
     (mod name vs)
     (let
-      ((mod-env (er-module-current-env (get (er-modules-get) mod))))
+      ((mod-env (get (er-modules-get) mod)))
       (if
         (not (dict-has? mod-env name))
         (raise
@@ -1303,325 +1189,24 @@
           :else (er-mk-atom "undefined")))
       :else (error "Erlang: ets:info: arity"))))
 
-
-
-;; ── file module (Phase 8 FFI) ────────────────────────────────────
-;; Synchronous file IO. Filenames must be SX strings (or Erlang
-;; binaries/char-code lists coercible to strings via er-source-to-string).
-;; Returns `{ok, Binary}` / `ok` on success, `{error, Reason}` on failure
-;; where Reason is one of `enoent`, `eacces`, `enotdir`, `posix_error`.
-
-(define er-classify-file-error
-  (fn (msg)
-    (let ((s (str msg)))
-      (cond
-        (string-contains? s "No such") (er-mk-atom "enoent")
-        (string-contains? s "Permission denied") (er-mk-atom "eacces")
-        (string-contains? s "Not a directory") (er-mk-atom "enotdir")
-        (string-contains? s "Is a directory") (er-mk-atom "eisdir")
-        :else (er-mk-atom "posix_error")))))
-
-(define er-bif-file-read-file
-  (fn (vs)
-    (let ((path (er-source-to-string (nth vs 0))))
-      (cond
-        (= path nil)
-          (er-mk-tuple (list (er-mk-atom "error") (er-mk-atom "badarg")))
-        :else
-          (let ((res (list nil)) (err (list nil)))
-            (guard (c (:else (set-nth! err 0 c)))
-              (set-nth! res 0 (file-read path)))
-            (cond
-              (not (= (nth err 0) nil))
-                (er-mk-tuple (list (er-mk-atom "error")
-                  (er-classify-file-error (nth err 0))))
-              :else
-                (er-mk-tuple (list (er-mk-atom "ok")
-                  (er-mk-binary (map char->integer (string->list (nth res 0)))))))))))) 
-
-(define er-bif-file-write-file
-  (fn (vs)
-    (let ((path (er-source-to-string (nth vs 0)))
-          (data (er-source-to-string (nth vs 1))))
-      (cond
-        (or (= path nil) (= data nil))
-          (er-mk-tuple (list (er-mk-atom "error") (er-mk-atom "badarg")))
-        :else
-          (let ((err (list nil)))
-            (guard (c (:else (set-nth! err 0 c)))
-              (file-write path data))
-            (cond
-              (not (= (nth err 0) nil))
-                (er-mk-tuple (list (er-mk-atom "error")
-                  (er-classify-file-error (nth err 0))))
-              :else (er-mk-atom "ok")))))))
-
-(define er-bif-file-delete
-  (fn (vs)
-    (let ((path (er-source-to-string (nth vs 0))))
-      (cond
-        (= path nil)
-          (er-mk-tuple (list (er-mk-atom "error") (er-mk-atom "badarg")))
-        :else
-          (let ((err (list nil)))
-            (guard (c (:else (set-nth! err 0 c)))
-              (file-delete path))
-            (cond
-              (not (= (nth err 0) nil))
-                (er-mk-tuple (list (er-mk-atom "error")
-                  (er-classify-file-error (nth err 0))))
-              :else (er-mk-atom "ok")))))))
-
-
-;; ── crypto / cid / file:list_dir (Phase 8 FFI — host primitives) ──
-;; Wired against loops/fed-prims host primitives (see plans Blockers
-;; "RESOLVED 2026-05-18"). Term marshalling at the boundary:
-;; Erlang binary/string/charlist -> SX byte-string via er-source-to-string;
-;; results -> Erlang binary via er-mk-binary.
-
-(define er-hexval
-  (fn (c)
-    (let ((v (char->integer c)))
-      (cond
-        (and (>= v 48) (<= v 57)) (- v 48)        ;; 0-9
-        (and (>= v 97) (<= v 102)) (+ 10 (- v 97)) ;; a-f
-        (and (>= v 65) (<= v 70)) (+ 10 (- v 65))  ;; A-F
-        :else 0))))
-
-(define er-hex->bytes
-  (fn (hex)
-    (let ((cs (string->list hex)) (out (list)) (n (string-length hex)))
-      (for-each
-        (fn (i)
-          (append! out
-            (+ (* 16 (er-hexval (nth cs (* i 2))))
-               (er-hexval (nth cs (+ (* i 2) 1))))))
-        (range 0 (truncate (/ n 2))))
-      out)))
-
-;; crypto:hash(Type, Data) -> raw digest binary. Type is an Erlang
-;; atom (sha256 | sha512 | sha3_256). Bad type / non-binary -> badarg.
-(define er-bif-crypto-hash
-  (fn (vs)
-    (let ((ty (nth vs 0)) (data (er-source-to-string (nth vs 1))))
-      (cond
-        (or (not (er-atom? ty)) (= data nil))
-          (raise (er-mk-error-marker (er-mk-atom "badarg")))
-        :else
-          (let ((name (get ty :name)))
-            (let ((hex (cond
-                         (= name "sha256") (crypto-sha256 data)
-                         (= name "sha512") (crypto-sha512 data)
-                         (= name "sha3_256") (crypto-sha3-256 data)
-                         :else nil)))
-              (cond
-                (= hex nil) (raise (er-mk-error-marker (er-mk-atom "badarg")))
-                :else (er-mk-binary (er-hex->bytes hex)))))))))
-
-;; cid:from_bytes(Bin) -> CIDv1 (raw codec 0x55, sha2-256 multihash)
-;; as an Erlang binary string.
-(define er-bif-cid-from-bytes
-  (fn (vs)
-    (let ((data (er-source-to-string (nth vs 0))))
-      (cond
-        (= data nil) (raise (er-mk-error-marker (er-mk-atom "badarg")))
-        :else
-          (let ((digest (er-hex->bytes (crypto-sha256 data))))
-            (let ((mh (list->string
-                        (map integer->char (append (list 18 32) digest)))))
-              (er-mk-binary
-                (map char->integer
-                  (string->list (cid-from-bytes 85 mh))))))))))
-
-;; cid:to_string(Term) -> canonical CIDv1 (dag-cbor) of the term,
-;; as an Erlang binary string.
-(define er-bif-cid-to-string
-  (fn (vs)
-    ;; Canonical CID of the term's stable string form. (cbor-encode
-    ;; rejects symbols, so er-to-sx of compound terms is unencodable;
-    ;; er-format-value yields a canonical SX string per term value.)
-    (er-mk-binary
-      (map char->integer
-        (string->list (cid-from-sx (er-format-value (nth vs 0))))))))
-
-;; file:list_dir(Path) -> {ok, [Binary]} | {error, Reason}
-(define er-bif-file-list-dir
-  (fn (vs)
-    (let ((path (er-source-to-string (nth vs 0))))
-      (cond
-        (= path nil)
-          (er-mk-tuple (list (er-mk-atom "error") (er-mk-atom "badarg")))
-        :else
-          (let ((res (list nil)) (err (list nil)))
-            (guard (c (:else (set-nth! err 0 c)))
-              (set-nth! res 0 (file-list-dir path)))
-            (cond
-              (not (= (nth err 0) nil))
-                (er-mk-tuple (list (er-mk-atom "error")
-                  (er-classify-file-error (nth err 0))))
-              :else
-                (er-mk-tuple (list (er-mk-atom "ok")
-                  (er-of-sx (nth res 0))))))))))
-
-;; ── builtin BIF registrations (Phase 8 migration) ────────────────
-;; Populates `er-bif-registry` with every existing built-in BIF. Each
-;; entry is keyed by "Module/Name/Arity"; multi-arity BIFs register
-;; once per arity. Called eagerly at the end of runtime.sx so the
-;; registry is ready before any erlang-eval-ast call.
-(define er-register-builtin-bifs!
-  (fn ()
-    ;; erlang module — type predicates (all pure)
-    (er-register-pure-bif! "erlang" "is_integer" 1 er-bif-is-integer)
-    (er-register-pure-bif! "erlang" "is_atom" 1 er-bif-is-atom)
-    (er-register-pure-bif! "erlang" "is_list" 1 er-bif-is-list)
-    (er-register-pure-bif! "erlang" "is_tuple" 1 er-bif-is-tuple)
-    (er-register-pure-bif! "erlang" "is_number" 1 er-bif-is-number)
-    (er-register-pure-bif! "erlang" "is_float" 1 er-bif-is-float)
-    (er-register-pure-bif! "erlang" "is_boolean" 1 er-bif-is-boolean)
-    (er-register-pure-bif! "erlang" "is_pid" 1 er-bif-is-pid)
-    (er-register-pure-bif! "erlang" "is_reference" 1 er-bif-is-reference)
-    (er-register-pure-bif! "erlang" "is_binary" 1 er-bif-is-binary)
-    (er-register-pure-bif! "erlang" "is_function" 1 er-bif-is-function)
-    (er-register-pure-bif! "erlang" "is_function" 2 er-bif-is-function)
-    ;; erlang module — pure data ops
-    (er-register-pure-bif! "erlang" "length" 1 er-bif-length)
-    (er-register-pure-bif! "erlang" "hd" 1 er-bif-hd)
-    (er-register-pure-bif! "erlang" "tl" 1 er-bif-tl)
-    (er-register-pure-bif! "erlang" "element" 2 er-bif-element)
-    (er-register-pure-bif! "erlang" "tuple_size" 1 er-bif-tuple-size)
-    (er-register-pure-bif! "erlang" "byte_size" 1 er-bif-byte-size)
-    (er-register-pure-bif! "erlang" "atom_to_list" 1 er-bif-atom-to-list)
-    (er-register-pure-bif! "erlang" "list_to_atom" 1 er-bif-list-to-atom)
-    (er-register-pure-bif! "erlang" "abs" 1 er-bif-abs)
-    (er-register-pure-bif! "erlang" "min" 2 er-bif-min)
-    (er-register-pure-bif! "erlang" "max" 2 er-bif-max)
-    (er-register-pure-bif! "erlang" "tuple_to_list" 1 er-bif-tuple-to-list)
-    (er-register-pure-bif! "erlang" "list_to_tuple" 1 er-bif-list-to-tuple)
-    (er-register-pure-bif! "erlang" "integer_to_list" 1 er-bif-integer-to-list)
-    (er-register-pure-bif! "erlang" "list_to_integer" 1 er-bif-list-to-integer)
-    ;; erlang module — process / runtime (side-effecting)
-    (er-register-bif! "erlang" "self" 0 er-bif-self)
-    (er-register-bif! "erlang" "spawn" 1 er-bif-spawn)
-    (er-register-bif! "erlang" "spawn" 3 er-bif-spawn)
-    (er-register-bif! "erlang" "exit" 1 er-bif-exit)
-    (er-register-bif! "erlang" "exit" 2 er-bif-exit)
-    (er-register-bif! "erlang" "make_ref" 0 er-bif-make-ref)
-    (er-register-bif! "erlang" "link" 1 er-bif-link)
-    (er-register-bif! "erlang" "unlink" 1 er-bif-unlink)
-    (er-register-bif! "erlang" "monitor" 2 er-bif-monitor)
-    (er-register-bif! "erlang" "demonitor" 1 er-bif-demonitor)
-    (er-register-bif! "erlang" "process_flag" 2 er-bif-process-flag)
-    (er-register-bif! "erlang" "register" 2 er-bif-register)
-    (er-register-bif! "erlang" "unregister" 1 er-bif-unregister)
-    (er-register-bif! "erlang" "whereis" 1 er-bif-whereis)
-    (er-register-bif! "erlang" "registered" 0 er-bif-registered)
-    ;; erlang module — exception raising (modelled as side-effecting)
-    (er-register-bif! "erlang" "throw" 1
-      (fn (vs) (raise (er-mk-throw-marker (er-bif-arg1 vs "throw")))))
-    (er-register-bif! "erlang" "error" 1
-      (fn (vs) (raise (er-mk-error-marker (er-bif-arg1 vs "error")))))
-    ;; lists module — all pure
-    (er-register-pure-bif! "lists" "reverse" 1 er-bif-lists-reverse)
-    (er-register-pure-bif! "lists" "map" 2 er-bif-lists-map)
-    (er-register-pure-bif! "lists" "foldl" 3 er-bif-lists-foldl)
-    (er-register-pure-bif! "lists" "seq" 2 er-bif-lists-seq)
-    (er-register-pure-bif! "lists" "seq" 3 er-bif-lists-seq)
-    (er-register-pure-bif! "lists" "sum" 1 er-bif-lists-sum)
-    (er-register-pure-bif! "lists" "nth" 2 er-bif-lists-nth)
-    (er-register-pure-bif! "lists" "last" 1 er-bif-lists-last)
-    (er-register-pure-bif! "lists" "member" 2 er-bif-lists-member)
-    (er-register-pure-bif! "lists" "append" 2 er-bif-lists-append)
-    (er-register-pure-bif! "lists" "filter" 2 er-bif-lists-filter)
-    (er-register-pure-bif! "lists" "any" 2 er-bif-lists-any)
-    (er-register-pure-bif! "lists" "all" 2 er-bif-lists-all)
-    (er-register-pure-bif! "lists" "duplicate" 2 er-bif-lists-duplicate)
-    ;; io module — side-effecting (writes to io buffer)
-    (er-register-bif! "io" "format" 1 er-bif-io-format)
-    (er-register-bif! "io" "format" 2 er-bif-io-format)
-    ;; ets module — side-effecting (mutates table state)
-    (er-register-bif! "ets" "new" 2 er-bif-ets-new)
-    (er-register-bif! "ets" "insert" 2 er-bif-ets-insert)
-    (er-register-bif! "ets" "lookup" 2 er-bif-ets-lookup)
-    (er-register-bif! "ets" "delete" 1 er-bif-ets-delete)
-    (er-register-bif! "ets" "delete" 2 er-bif-ets-delete)
-    (er-register-bif! "ets" "tab2list" 1 er-bif-ets-tab2list)
-    (er-register-bif! "ets" "info" 2 er-bif-ets-info)
-    ;; code module — side-effecting (mutates module registry, kills procs)
-    (er-register-bif! "code" "load_binary" 3 er-bif-code-load-binary)
-    (er-register-bif! "code" "purge" 1 er-bif-code-purge)
-    (er-register-bif! "code" "soft_purge" 1 er-bif-code-soft-purge)
-    (er-register-bif! "code" "which" 1 er-bif-code-which)
-    (er-register-bif! "code" "is_loaded" 1 er-bif-code-is-loaded)
-    (er-register-bif! "code" "all_loaded" 0 er-bif-code-all-loaded)
-    ;; file module
-    (er-register-bif! "file" "read_file" 1 er-bif-file-read-file)
-    (er-register-bif! "file" "write_file" 2 er-bif-file-write-file)
-    (er-register-bif! "file" "delete" 1 er-bif-file-delete)
-    ;; Phase 8 FFI — host-primitive BIFs (loops/fed-prims)
-    (er-register-pure-bif! "crypto" "hash" 2 er-bif-crypto-hash)
-    (er-register-pure-bif! "cid" "from_bytes" 1 er-bif-cid-from-bytes)
-    (er-register-pure-bif! "cid" "to_string" 1 er-bif-cid-to-string)
-
-;; ── binary_to_list / list_to_binary (Step 3b — term codec) ──────
-;; Standard Erlang semantics:
-;;   binary_to_list(<<B1,B2,...>>) -> [B1, B2, ...]   (Erlang cons of ints)
-;;   list_to_binary(IoList)        -> <<...>>         (flattens nested
-;;     iolists; elements are byte ints 0-255 or binaries)
-;; Bad arg / out-of-range byte / non-iolist element -> error:badarg.
-
-(define er-bif-binary-to-list
-  (fn (vs)
-    (let ((v (nth vs 0)))
-      (cond
-        (not (er-binary? v))
-          (raise (er-mk-error-marker (er-mk-atom "badarg")))
-        :else
-          (let ((bs (get v :bytes)) (out (er-mk-nil)))
-            (for-each
-              (fn (i)
-                (set! out (er-mk-cons (nth bs (- (- (len bs) 1) i)) out)))
-              (range 0 (len bs)))
-            out)))))
-
-;; Walk an Erlang iolist, appending bytes to `acc` (a mutable SX list).
-;; Accepts: nil, cons-of-X, binary, integer in 0..255. Anything else
-;; signals failure by setting (nth fail 0) to true.
-(define er-iolist-walk!
-  (fn (v acc fail)
+(define
+  er-apply-ets-bif
+  (fn
+    (name vs)
     (cond
-      (nth fail 0) nil
-      (er-nil? v) nil
-      (er-cons? v)
-        (do (er-iolist-walk! (get v :head) acc fail)
-            (er-iolist-walk! (get v :tail) acc fail))
-      (er-binary? v)
-        (for-each
-          (fn (i) (append! acc (nth (get v :bytes) i)))
-          (range 0 (len (get v :bytes))))
-      (= (type-of v) "number")
-        (cond
-          (and (>= v 0) (<= v 255)) (append! acc v)
-          :else (set-nth! fail 0 true))
-      :else (set-nth! fail 0 true))))
+      (= name "new") (er-bif-ets-new vs)
+      (= name "insert") (er-bif-ets-insert vs)
+      (= name "lookup") (er-bif-ets-lookup vs)
+      (= name "delete") (er-bif-ets-delete vs)
+      (= name "tab2list") (er-bif-ets-tab2list vs)
+      (= name "info") (er-bif-ets-info vs)
+      :else (error
+        (str "Erlang: undefined 'ets:" name "/" (len vs) "'")))))
 
-(define er-bif-list-to-binary
-  (fn (vs)
-    (let ((v (nth vs 0)) (acc (list)) (fail (list false)))
-      (cond
-        (not (or (er-nil? v) (er-cons? v) (er-binary? v)))
-          (raise (er-mk-error-marker (er-mk-atom "badarg")))
-        :else
-          (do
-            (er-iolist-walk! v acc fail)
-            (cond
-              (nth fail 0)
-                (raise (er-mk-error-marker (er-mk-atom "badarg")))
-              :else (er-mk-binary acc)))))))
-
-    (er-register-bif! "file" "list_dir" 1 er-bif-file-list-dir)
-    (er-register-pure-bif! "erlang" "binary_to_list" 1 er-bif-binary-to-list)
-    (er-register-pure-bif! "erlang" "list_to_binary"  1 er-bif-list-to-binary)
-    (er-mk-atom "ok")))
-
-;; Register everything at load time.
-(er-register-builtin-bifs!)
+;; ── JIT interpret-only boundary ───────────────────────────────────────────
+;; The Erlang evaluator (er-eval-* in transpile.sx + the vm/dispatcher) recurses
+;; over the AST and the scheduler/receive path captures call/cc continuations.
+;; Under JIT the recursive eval miscompiles into a non-terminating loop and the
+;; continuation path cannot transfer control. Exclude the whole er-/erlang-
+;; namespace (covers transpile, runtime, and vm/dispatcher in one declaration).
+(jit-exclude! "er-*" "erlang-*")

lib/haskell/runtime.sx

@@ -148,3 +148,9 @@
           (fn (acc i) (str acc (char-at buf i)))
           ""
           (range off (string-length buf)))))))
+
+;; ── JIT interpret-only boundary ───────────────────────────────────────────
+;; The Haskell evaluator (hk-eval and the lazy-thunk forcer) recurses deeply
+;; over the AST/graph; under JIT the recursive eval can miscompile into a
+;; non-terminating loop. Exclude the hk- namespace from JIT.
+(jit-exclude! "hk-*")

lib/host/auth.sx

@@ -0,0 +1,141 @@
+;; lib/host/auth.sx — browser login on top of host sessions (lib/host/session.sx).
+;; A login form posts credentials; on success the principal is written to the
+;; session cookie. The guarded write routes then accept EITHER a logged-in session
+;; OR a Bearer token (host/require-user), so the same routes serve browsers and API
+;; clients. Single admin user; credentials come from $SX_ADMIN_USER / _PASSWORD
+;; (set in serve.sh) — the in-source defaults are dev-only.
+;;
+;; Depends on lib/host/session.sx, lib/host/{handler,middleware}.sx, lib/dream/*
+;; (form/types/session) + the kernel render-page primitive.
+
+;; ── page shell (own copy; render-page renders the static SX tree) ───
+(define host/-auth-page
+  (fn (title body)
+    (str "<!doctype html>"
+      (render-page
+        (quasiquote
+          (html
+            (head (meta :charset "utf-8") (title (unquote title)))
+            (body (unquote body))))))))
+
+;; ── admin credential (override from env in serve.sh) ────────────────
+(define host/admin-user "admin")
+(define host/admin-password "letmein")
+(define host/auth-set-admin!
+  (fn (u p) (begin (set! host/admin-user u) (set! host/admin-password p))))
+(define host/-verify-cred
+  (fn (user pass)
+    (and (not (= pass ""))
+         (= user host/admin-user)
+         (= pass host/admin-password))))
+
+;; A return-to target is only honoured if it's a same-site absolute PATH — guards
+;; against an open-redirect (//evil.com, http://…) smuggled through ?next=.
+(define host/-safe-next
+  (fn (n)
+    (if (and n (not (= n "")) (starts-with? n "/") (not (starts-with? n "//")))
+      n "/")))
+
+;; The login form, parameterised by where to return after success.
+(define host/-login-form
+  (fn (next-path message)
+    (host/-auth-page "Log in"
+      (quasiquote
+        (div
+          (h1 "Log in")
+          (unquote (if message (quasiquote (p :style "color:#b00" (unquote message))) ""))
+          (form :method "post" :action "/login"
+            (input :type "hidden" :name "next" :value (unquote next-path))
+            (p (input :name "username" :placeholder "username"))
+            (p (input :name "password" :type "password" :placeholder "password"))
+            (p (button :type "submit" "Log in"))))))))
+
+;; ── GET /login — login form, honouring ?next= (where to go after login) ─────
+(define host/login-page
+  (fn (req)
+    (dream-html
+      (host/-login-form (host/-safe-next (dream-query-param req "next")) nil))))
+
+;; ── POST /login — verify, write session principal, redirect to ?next ────────
+;; The session middleware (host/sessions) has already created/loaded the session
+;; and will set the cookie on this response, so writing :principal here lands on
+;; the right sid and the browser keeps the cookie. On failure the form re-renders
+;; with the same return target so the user lands where they were headed.
+(define host/login-submit
+  (fn (req)
+    (let ((user (host/field req "username"))
+          (pass (host/field req "password"))
+          (next-path (host/-safe-next (host/field req "next"))))
+      (if (host/-verify-cred user pass)
+        (begin
+          (host/login! req user)
+          (dream-redirect next-path))
+        (dream-html-status 401
+          (host/-login-form next-path "Invalid credentials — try again."))))))
+
+;; ── /logout — clear the session, redirect home. Allowed on GET too so a plain
+;; footer link can log out (logout is low-harm, so GET is acceptable here). ─────
+(define host/logout-submit
+  (fn (req)
+    (begin
+      (host/logout! req)
+      (dream-redirect "/"))))
+
+;; ── login routes (mounted by host/make-app) ─────────────────────────
+(define host/auth-routes
+  (list
+    (dream-get "/login" host/login-page)
+    (dream-post "/login" host/login-submit)
+    (dream-get "/logout" host/logout-submit)
+    (dream-post "/logout" host/logout-submit)))
+
+;; ── auth footer fragment ────────────────────────────────────────────
+;; A small SX node pages splice into their footer: "log in" when logged out,
+;; "signed in as <user> · log out" when logged in. Guards a session-less request
+;; (no middleware) so it's safe to call anywhere. Reads the session principal.
+(define host/auth-footer
+  (fn (req)
+    (let ((who (if (get req :dream-session) (host/current-principal req) nil)))
+      (if (and who (not (= who "")))
+        (quasiquote
+          (span (unquote (str "signed in as " who)) " · "
+            (a :href "/logout" "log out")))
+        (quote (a :href "/login" "log in"))))))
+
+;; The authenticated principal for a request, or nil: a logged-in session takes
+;; precedence, else a Bearer token resolved by `resolve` (the API fallback).
+(define host/-principal-of
+  (fn (req resolve)
+    (let ((sp (host/current-principal req)))
+      (if (and sp (not (= sp "")))
+        sp
+        (let ((tok (dream-bearer-token req)))
+          (if tok (resolve tok) nil))))))
+
+;; ── auth middleware (API shape): session principal OR bearer token ──
+;; Place AFTER the session middleware (so host/current-principal can read the
+;; session) and BEFORE host/require-permission. On failure -> JSON 401 with a
+;; Bearer challenge. For API/JSON routes; browser pages want host/require-login.
+(define host/require-user
+  (fn (resolve)
+    (fn (next)
+      (fn (req)
+        (let ((principal (host/-principal-of req resolve)))
+          (if (or (nil? principal) (= principal ""))
+            (dream-add-header
+              (host/error 401 "unauthorized")
+              "www-authenticate" "Bearer")
+            (next (assoc req :dream-principal principal))))))))
+
+;; ── auth middleware (browser shape): same check, but on failure REDIRECT to
+;; the login page with a return-to, instead of a raw JSON 401. Use this for HTML
+;; routes (an edit form, the create form) so an unauthenticated click lands on a
+;; usable login page and returns to where it was headed after logging in. ──
+(define host/require-login
+  (fn (resolve)
+    (fn (next)
+      (fn (req)
+        (let ((principal (host/-principal-of req resolve)))
+          (if (or (nil? principal) (= principal ""))
+            (dream-redirect (str "/login?next=" (host/-safe-next (dream-path req))))
+            (next (assoc req :dream-principal principal))))))))

lib/host/compose.sx

@@ -0,0 +1,98 @@
+;; lib/host/compose.sx — the composition / object render-fold (plans/composition-objects.md).
+;;
+;; An object's :body is a composition node — a tiny UI language over object refs. The
+;; render-fold below is its interpreter. Four combinators (seq/row/alt/each) + leaves
+;; (field/text/card) + ref + recursion (tmpl). The context is an EXTENSIBLE ENVIRONMENT:
+;; `when` reads it, `each` extends it (:item, :depth). Same predicate set as the type
+;; guards. The object's CID is its DEFINITION; render is the EXECUTION (per context+data).
+;; Self-contained (no blog deps) so the model can be proven in isolation.
+
+;; ── predicates for `when` (over the context environment) ────────────
+(define host/comp--pred?
+  (fn (pred ctx)
+    (let ((op (str (first pred))))
+      (cond
+        ((= op "has") (not (nil? (get ctx (str (first (rest pred)))))))
+        ((= op "eq")  (= (str (get ctx (str (first (rest pred))))) (str (first (rest (rest pred))))))
+        ((= op "not") (not (host/comp--pred? (first (rest pred)) ctx)))
+        (else false)))))
+
+;; the value of a leaf (field): the current :item's key, else the context's key.
+(define host/comp--field
+  (fn (k ctx)
+    (let ((item (get ctx "item")) (key (str k)))
+      (if (and item (not (nil? (get item key))))
+        (str (get item key))
+        (str (or (get ctx key) ""))))))
+
+;; the source collection for `each`: literal items, the :item's :children (trees), or a
+;; named list field on the :item. (A graph-query source is wiring step 3, plan roadmap.)
+(define host/comp--source
+  (fn (src ctx)
+    (let ((op (str (first src))) (item (get ctx "item")))
+      (cond
+        ((= op "items")    (rest src))
+        ((= op "children") (if item (or (get item "children") (list)) (list)))
+        ((= op "field")    (if item (or (get item (str (first (rest src)))) (list)) (list)))
+        (else (list))))))
+
+;; ── template registry (recursion: a template may reference itself by name) ──
+(define host/comp--tmpls (dict))
+(define host/comp--def-tmpl! (fn (name node) (dict-set! host/comp--tmpls name node)))
+
+;; ── the render-fold (the interpreter) ───────────────────────────────
+(define host/comp--render-all
+  (fn (nodes ctx) (reduce (fn (acc n) (str acc (host/comp--render n ctx))) "" nodes)))
+
+;; alt: render the FIRST branch whose `when` holds (or `else`) — recursive first-match so
+;; a branch that legitimately renders empty isn't skipped.
+(define host/comp--alt-pick
+  (fn (branches ctx)
+    (if (empty? branches)
+      ""
+      (let ((br (first branches)) (bh (str (first (first branches)))))
+        (cond
+          ((= bh "else") (host/comp--render (first (rest br)) ctx))
+          ((= bh "when") (if (host/comp--pred? (first (rest br)) ctx)
+                           (host/comp--render (first (rest (rest br))) ctx)
+                           (host/comp--alt-pick (rest branches) ctx)))
+          (else (host/comp--alt-pick (rest branches) ctx)))))))
+
+;; each: eval source -> items; render template per item with :item bound + :depth+1
+;; (depth guard backstops runaway recursion; trees terminate naturally on empty source).
+(define host/comp--each
+  (fn (src tmpl ctx)
+    (let ((depth (or (get ctx "depth") 0)))
+      (if (> depth 40)
+        "<em>(max depth)</em>"
+        (reduce
+          (fn (acc item)
+            (str acc (host/comp--render tmpl (merge ctx {"item" item "depth" (+ depth 1)}))))
+          "" (host/comp--source src ctx))))))
+
+;; card leaf (proof: a labelled box; in the host this renders via the card-type's :template).
+(define host/comp--card
+  (fn (ctype fields)
+    (str "<div class=\"card card-" ctype "\">"
+      (reduce (fn (acc k) (str acc "<b>" k ":</b> " (str (get fields k)) " ")) "" (keys fields))
+      "</div>")))
+
+(define host/comp--render
+  (fn (node ctx)
+    (if (not (= (type-of node) "list"))
+      (str node)
+      (let ((h (str (first node))) (args (rest node)))
+        (cond
+          ((= h "seq")   (host/comp--render-all args ctx))
+          ((= h "row")   (str "<div class=\"row\" style=\"display:flex;gap:1em\">" (host/comp--render-all args ctx) "</div>"))
+          ((= h "grid")  (str "<div class=\"grid\" style=\"display:grid;gap:1em\">" (host/comp--render-all args ctx) "</div>"))
+          ((= h "alt")   (host/comp--alt-pick args ctx))
+          ((= h "each")  (host/comp--each (first args) (first (rest args)) ctx))
+          ((= h "field") (str "<span>" (host/comp--field (first args) ctx) "</span>"))
+          ((= h "text")  (str (first args)))
+          ((= h "card")  (host/comp--card (str (first args)) (first (rest args))))
+          ((= h "tmpl")  (host/comp--render (get host/comp--tmpls (str (first args))) ctx))
+          (else ""))))))
+
+;; public entry: render a composition node against a context environment.
+(define host/comp-render (fn (node ctx) (host/comp--render node ctx)))

lib/host/conformance.sh

@@ -0,0 +1,202 @@
+#!/usr/bin/env bash
+# host-on-sx conformance runner — loads the kernel stdlib, the subsystem
+# libraries the host wires to, the host modules, and the host test suites in one
+# sx_server process, then reports pass/fail per suite. Mirrors lib/dream's runner.
+#
+# Usage:
+#   bash lib/host/conformance.sh            # run all suites
+#   bash lib/host/conformance.sh sxtp       # run ONLY the sxtp suite (fast — skips
+#                                           # the Datalog-heavy blog suite)
+#   bash lib/host/conformance.sh blog -v    # one suite, verbose
+#   bash lib/host/conformance.sh -v         # all suites, verbose
+
+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
+
+# Args: an optional suite NAME runs just that suite (fast); -v is verbose per-suite.
+VERBOSE=""
+SUITE_FILTER=""
+for arg in "$@"; do
+  case "$arg" in
+    -v|--verbose) VERBOSE="-v" ;;
+    *) SUITE_FILTER="$arg" ;;
+  esac
+done
+
+# Kernel + subsystem dependencies, then the host modules. Order matters:
+# stdlib/r7rs first; the Datalog engine + ACL subsystem (authorisation); the feed
+# subsystem (the first migrated domain); Dream (types/json/auth/error/router) the
+# host builds on; then the host layer itself.
+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/persist/event.sx"
+  "lib/persist/backend.sx"
+  "lib/persist/log.sx"
+  "lib/persist/kv.sx"
+  "lib/persist/api.sx"
+  "lib/persist/durable.sx"
+  "spec/render.sx"
+  "web/adapter-html.sx"
+  "lib/dream/types.sx"
+  "lib/dream/json.sx"
+  "lib/dream/auth.sx"
+  "lib/dream/error.sx"
+  "lib/dream/form.sx"
+  "lib/dream/session.sx"
+  "lib/dream/router.sx"
+  "lib/host/handler.sx"
+  "lib/host/middleware.sx"
+  "lib/host/session.sx"
+  "lib/host/auth.sx"
+  "lib/host/sxtp.sx"
+  "lib/host/router.sx"
+  "lib/host/static.sx"
+  "lib/host/sx/relate-picker.sx"
+  "lib/host/sx/kg-cards.sx"
+  "lib/host/feed.sx"
+  "lib/host/relations.sx"
+  "lib/host/compose.sx"
+  "lib/host/blog.sx"
+  "lib/host/page.sx"
+  "lib/host/server.sx"
+  "lib/host/ledger.sx"
+)
+
+# Suites: NAME RUNNER-FN PATH
+SUITES=(
+  "handler     host-hd-tests-run!  lib/host/tests/handler.sx"
+  "middleware  host-mw-tests-run!  lib/host/tests/middleware.sx"
+  "sxtp        host-sx-tests-run!  lib/host/tests/sxtp.sx"
+  "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"
+  "blog        host-bl-tests-run!  lib/host/tests/blog.sx"
+  "session     host-se-tests-run!  lib/host/tests/session.sx"
+  "page        host-pg-tests-run!  lib/host/tests/page.sx"
+  "server      host-sv-tests-run!  lib/host/tests/server.sx"
+  "ledger      host-lg-tests-run!  lib/host/tests/ledger.sx"
+)
+
+# Filter to a single suite if a name was given (filter the array itself so its
+# indices stay aligned with the result-parsing loop below). All MODULES still load
+# — the host modules are interdependent; only the TEST suites are narrowed.
+if [ -n "$SUITE_FILTER" ]; then
+  _FILTERED=()
+  for SUITE in "${SUITES[@]}"; do
+    [ "$(echo "$SUITE" | awk '{print $1}')" = "$SUITE_FILTER" ] && _FILTERED+=("$SUITE")
+  done
+  if [ "${#_FILTERED[@]}" -eq 0 ]; then
+    echo "ERROR: no suite named '$SUITE_FILTER'. Valid names:" >&2
+    for SUITE in "${SUITES[@]}"; do echo "  $(echo "$SUITE" | awk '{print $1}')" >&2; done
+    exit 1
+  fi
+  SUITES=("${_FILTERED[@]}")
+fi
+
+TMPFILE=$(mktemp); trap "rm -f $TMPFILE" EXIT
+EPOCH=1
+emit_load () { echo "(epoch $EPOCH)"; echo "(load \"$1\")"; EPOCH=$((EPOCH+1)); }
+emit_eval () { echo "(epoch $EPOCH)"; echo "(eval \"$1\")"; EPOCH=$((EPOCH+1)); }
+
+{
+  for M in "${MODULES[@]}"; do emit_load "$M"; done
+  for SUITE in "${SUITES[@]}"; do
+    read -r _NAME _RUNNER FILE <<< "$SUITE"
+    emit_load "$FILE"
+    emit_eval "($_RUNNER)"
+  done
+} > "$TMPFILE"
+
+# 1200s: the blog suite drives the relations graph hard (every is-a/types-of/
+# instances-of query re-saturates the Datalog db), so it's CPU-bound and much slower
+# under shared-box contention (a sibling loop at load ~6 pushed it past 600s -> false
+# "no suite results parsed" truncation). Override with SX_CONF_TIMEOUT for a tighter cap.
+OUTPUT=$(timeout "${SX_CONF_TIMEOUT:-1200}" "$SX_SERVER" < "$TMPFILE" 2>&1 || true)
+
+# Fail LOUD on any load/eval error. A test file that errors mid-load silently
+# truncates its suite — the runner returns only the tests that ran before the
+# error, so the suite reports a false green (e.g. "blog 13 passed, 0 failed"
+# when 16 CRUD tests never ran). Catch the error markers and abort before the
+# pass/fail tally can hide them.
+if echo "$OUTPUT" | grep -qE 'Undefined symbol|Unhandled exception|\[load\][^|]*[Ee]rror|expected list, got|: error '; then
+  echo "FAIL: load/eval error detected — a suite may be silently truncated:" >&2
+  echo "$OUTPUT" | grep -nE 'Undefined symbol|Unhandled exception|\[load\]|expected list, got|: error ' | head -20 >&2
+  exit 1
+fi
+
+TOTAL_PASS=0
+TOTAL_FAIL=0
+FAILED_SUITES=()
+LAST_DICT_LINES=$(echo "$OUTPUT" | grep -E '^\{:' || true)
+
+I=0
+while read -r LINE; do
+  [ -z "$LINE" ] && continue
+  P=$(echo "$LINE" | grep -oE ':passed [0-9]+' | awk '{print $2}')
+  F=$(echo "$LINE" | grep -oE ':failed [0-9]+' | awk '{print $2}')
+  [ -z "$P" ] && P=0
+  [ -z "$F" ] && F=0
+  SUITE_INFO="${SUITES[$I]}"
+  SUITE_NAME=$(echo "$SUITE_INFO" | awk '{print $1}')
+  TOTAL_PASS=$((TOTAL_PASS + P))
+  TOTAL_FAIL=$((TOTAL_FAIL + F))
+  if [ "$F" -gt 0 ]; then
+    FAILED_SUITES+=("$SUITE_NAME: $P/$((P+F))")
+    printf 'X %-12s %d/%d\n' "$SUITE_NAME" "$P" "$((P+F))"
+    echo "$LINE" | grep -oE ':name "[^"]*"' | sed 's/:name /    fail: /'
+  elif [ "$VERBOSE" = "-v" ]; then
+    printf 'ok %-12s %d passed\n' "$SUITE_NAME" "$P"
+  fi
+  I=$((I+1))
+done <<< "$LAST_DICT_LINES"
+
+TOTAL=$((TOTAL_PASS + TOTAL_FAIL))
+if [ "$TOTAL" -eq 0 ]; then
+  echo "ERROR: no suite results parsed. Raw output:" >&2
+  echo "$OUTPUT" >&2
+  exit 1
+fi
+if [ $TOTAL_FAIL -eq 0 ]; then
+  echo "ok $TOTAL_PASS/$TOTAL host-on-sx tests passed (${#SUITES[@]} suites)"
+else
+  echo "FAIL $TOTAL_PASS/$TOTAL passed, $TOTAL_FAIL failed:"
+  for S in "${FAILED_SUITES[@]}"; do echo "  $S"; done
+  exit 1
+fi

lib/host/feed.sx

@@ -0,0 +1,49 @@
+;; lib/host/feed.sx — Feed domain endpoints on the host. The first domain migrated
+;; onto the SX host: read the activity timeline (GET /feed) and create activities
+;; (POST /feed). Both go straight through the feed subsystem's public API; the
+;; write path runs behind the host middleware stack (auth + ACL). Depends on
+;; lib/feed/* + lib/host/handler.sx + lib/host/middleware.sx (write routes only).
+
+;; ── read ───────────────────────────────────────────────────────────
+
+;; GET /feed -> recent-first activities as a JSON envelope.
+;; Query: ?actor=<id> (filter) ?limit=<n> (cap, applied after filtering).
+(define host/feed-timeline
+  (fn (req)
+    (let ((base (feed/recent (feed/all)))
+          (actor (dream-query-param req "actor")))
+      (let ((filtered (if actor (feed/by-actor base actor) base))
+            (limit (dream-query-param req "limit")))
+        (let ((capped
+                (if limit (feed/take filtered (string->number limit)) filtered)))
+          (host/ok (feed/items capped)))))))
+
+;; Public read route group.
+(define host/feed-routes
+  (list
+    (dream-get "/feed" host/feed-timeline)))
+
+;; ── write ──────────────────────────────────────────────────────────
+
+;; POST /feed -> create an activity from the text/sx body. Returns 201 + the created
+;; (normalised) activity. Body must be an SX dict; anything else -> 400.
+(define host/feed-create
+  (fn (req)
+    (let ((raw (host/sx-body req)))
+      (if (= (type-of raw) "dict")
+        (host/ok-status 201 (feed/post raw))
+        (host/error 400 "invalid activity")))))
+
+;; Guarded write route group: POST /feed behind auth + ACL ("post" on "feed").
+;; resolve : token -> principal | nil (injected auth policy, e.g. token lookup
+;; against the identity subsystem). Errors thrown downstream become a JSON 500.
+(define host/feed-write-routes
+  (fn (resolve)
+    (list
+      (dream-post "/feed"
+        (host/pipeline
+          (list
+            host/wrap-errors
+            (host/require-auth resolve)
+            (host/require-permission "post" (fn (req) "feed")))
+          host/feed-create)))))

lib/host/handler.sx

@@ -0,0 +1,41 @@
+;; lib/host/handler.sx — Host handler layer: the bridge from a Dream request to a
+;; subsystem call and back to a Dream response. A host handler IS a Dream handler
+;; (request -> response); these helpers build the SX-native envelope every host
+;; endpoint shares — text/sx, serialized SX wire format (NOT JSON): {:ok true
+;; :data ...} on success, {:ok false :error ...} on failure. The platform speaks
+;; SX end to end; JSON lives only at the ActivityPub federation edge (JSON-LD).
+;; Depends on lib/dream/types.sx.
+
+;; ── responses ──────────────────────────────────────────────────────
+
+;; SX response at an arbitrary status: content-type text/sx, body = the value
+;; serialized to SX wire format (the same `serialize` SXTP uses). The SX engine /
+;; WASM kernel parses this directly — NO JSON on the internal wire.
+(define host/sx-status
+  (fn (status value)
+    (dream-response status {:content-type "text/sx; charset=utf-8"}
+      (serialize value))))
+
+;; Success envelope: 200 {:ok true :data <value>}.
+(define host/ok
+  (fn (value)
+    (host/sx-status 200 {:ok true :data value})))
+
+;; Success envelope at a chosen status (e.g. 201 for a created resource).
+(define host/ok-status
+  (fn (status value)
+    (host/sx-status status {:ok true :data value})))
+
+;; Error envelope: {:ok false :error <message>} at the given status.
+(define host/error
+  (fn (status message)
+    (host/sx-status status {:ok false :error message})))
+
+;; ── request reading ────────────────────────────────────────────────
+
+;; Integer query param with a fallback (query params arrive as strings).
+;; Absent param -> fallback; present -> parsed number.
+(define host/query-int
+  (fn (req name fallback)
+    (let ((raw (dream-query-param req name)))
+      (if raw (string->number raw) fallback))))

lib/host/ledger.sx

@@ -0,0 +1,89 @@
+;; lib/host/ledger.sx — the strangler migration ledger. A catalogue of every
+;; rose-ash HTTP endpoint with its Quart original and its current host status, so
+;; the cut-over from Quart to the SX host is tracked endpoint-by-endpoint rather
+;; than big-bang. Status is one of:
+;;   :native   — born on the host, has no Quart original (e.g. /health probe)
+;;   :migrated — moved off Quart, now served by an SX handler
+;;   :proxied  — still on Quart; the host forwards until cut over
+;; Coverage (how far the strangler has progressed = how much is OFF Quart) is
+;; computed from the catalogue. Pure data + queries — no IO, fully conformable.
+
+;; ── entry constructor ───────────────────────────────────────────────
+;; quart is a "service:handler" ref string (nil for :native endpoints); handler
+;; is the SX handler name serving it (nil while still :proxied).
+(define host/ledger-entry
+  (fn (domain method path quart status handler)
+    {:domain domain :method method :path path
+     :quart quart :status status :handler handler}))
+
+;; ── the catalogue ───────────────────────────────────────────────────
+;; Reflects the live host: feed reads+writes migrated, /health native, the
+;; relations container endpoints migrated onto lib/relations (reads get-children/
+;; get-parents + writes attach-child/detach-child — see lib/host/relations.sx).
+;; The TYPED relations actions (relate/unrelate/can-relate) stay proxied: they
+;; carry registry + cardinality validation lib/relations does not implement. The
+;; internal-only likes data+action endpoints stay proxied too — likes has no SX
+;; subsystem to dispatch to.
+(define host/ledger
+  (list
+    (host/ledger-entry "host"      "GET"  "/health"                     nil                         "native"   "host/health-route")
+    (host/ledger-entry "blog"      "GET"  "/:slug"                      "blog:post_detail"          "migrated" "host/blog-post")
+    (host/ledger-entry "feed"      "GET"  "/feed"                       "feed:timeline"             "migrated" "host/feed-timeline")
+    (host/ledger-entry "feed"      "POST" "/feed"                       "feed:create"               "migrated" "host/feed-create")
+    (host/ledger-entry "relations" "GET"  "/internal/data/get-children"  "relations:get_children"  "migrated" "host/relations-children")
+    (host/ledger-entry "relations" "GET"  "/internal/data/get-parents"   "relations:get_parents"   "migrated" "host/relations-parents")
+    (host/ledger-entry "relations" "POST" "/internal/actions/attach-child" "relations:attach_child" "migrated" "host/relations-attach")
+    (host/ledger-entry "relations" "POST" "/internal/actions/detach-child" "relations:detach_child" "migrated" "host/relations-detach")
+    (host/ledger-entry "relations" "POST" "/internal/actions/relate"     "relations:relate"        "proxied"  nil)
+    (host/ledger-entry "relations" "POST" "/internal/actions/unrelate"   "relations:unrelate"      "proxied"  nil)
+    (host/ledger-entry "relations" "POST" "/internal/actions/can-relate" "relations:can_relate"    "proxied"  nil)
+    (host/ledger-entry "likes"     "GET"  "/internal/data/is-liked"     "likes:is_liked"            "proxied"  nil)
+    (host/ledger-entry "likes"     "GET"  "/internal/data/liked-slugs"  "likes:liked_slugs"         "proxied"  nil)
+    (host/ledger-entry "likes"     "GET"  "/internal/data/liked-ids"    "likes:liked_ids"           "proxied"  nil)
+    (host/ledger-entry "likes"     "POST" "/internal/actions/toggle"    "likes:toggle"              "proxied"  nil)))
+
+;; ── status / domain queries ─────────────────────────────────────────
+(define host/ledger-by-status
+  (fn (ledger status) (filter (fn (e) (= (get e :status) status)) ledger)))
+(define host/ledger-migrated (fn (ledger) (host/ledger-by-status ledger "migrated")))
+(define host/ledger-proxied  (fn (ledger) (host/ledger-by-status ledger "proxied")))
+(define host/ledger-native   (fn (ledger) (host/ledger-by-status ledger "native")))
+(define host/ledger-by-domain
+  (fn (ledger domain) (filter (fn (e) (= (get e :domain) domain)) ledger)))
+
+;; An endpoint is OFF Quart (served by the host) iff native or migrated.
+(define host/ledger-served?
+  (fn (e) (or (= (get e :status) "native") (= (get e :status) "migrated"))))
+
+;; First entry matching (method, path), or nil.
+(define host/ledger-find
+  (fn (ledger method path)
+    (let ((hits (filter
+                  (fn (e) (and (= (get e :method) method) (= (get e :path) path)))
+                  ledger)))
+      (if (> (len hits) 0) (first hits) nil))))
+
+;; Distinct domains in the catalogue (order: first-seen, reversed by cons).
+(define host/ledger-domains
+  (fn (ledger)
+    (reduce
+      (fn (acc e)
+        (let ((d (get e :domain)))
+          (if (some (fn (x) (= x d)) acc) acc (cons d acc))))
+      (list)
+      ledger)))
+
+;; ── coverage ────────────────────────────────────────────────────────
+;; served = off Quart (migrated + native); percent = served / total, floored.
+(define host/ledger-coverage
+  (fn (ledger)
+    (let ((total (len ledger))
+          (migrated (len (host/ledger-migrated ledger)))
+          (proxied (len (host/ledger-proxied ledger)))
+          (native (len (host/ledger-native ledger))))
+      {:total total
+       :migrated migrated
+       :proxied proxied
+       :native native
+       :served (+ migrated native)
+       :percent (if (= total 0) 0 (quotient (* 100 (+ migrated native)) total))})))

lib/host/live-check.sh

@@ -0,0 +1,74 @@
+#!/usr/bin/env bash
+# Non-browser live-check for the host: spins up an EPHEMERAL host server (this
+# worktree's binary + lib + web, a temp persist dir), logs in, seeds one post, then
+# runs a sequence of HTTP checks printing status | content-type | body-head for each.
+# Catches what conformance can't — the real http-listen serving path (serving-JIT
+# divergence, VmSuspended renders, content-type regressions) — without a browser and
+# without touching live data. The non-Playwright counterpart to run-picker-check.sh.
+#
+#   bash lib/host/live-check.sh                      # default smoke: /health /posts /feed / /<seeded>/
+#   bash lib/host/live-check.sh /tags /article/      # check specific GET paths instead
+#
+# Asserts: reads are text/sx (the SX-native wire), pages are non-empty, no 5xx.
+# Requires the OCaml binary built (hosts/ocaml/_build/default/bin/sx_server.exe).
+set -uo pipefail
+cd "$(git rev-parse --show-toplevel)"
+
+PORT="${LIVE_PORT:-8914}"
+USER="admin"; PASS="live-check-pw"; SECRET="live-check-secret"
+PDIR=$(mktemp -d); JAR=$(mktemp); LOG=$(mktemp); HDR=$(mktemp)
+BASE="http://127.0.0.1:$PORT"
+RC=0
+
+cleanup() {
+  local pid
+  pid=$(ss -lptn "sport = :$PORT" 2>/dev/null | grep -oE 'pid=[0-9]+' | head -1 | cut -d= -f2)
+  [ -n "$pid" ] && kill "$pid" 2>/dev/null
+  rm -f "$JAR" "$LOG" "$HDR"; rm -rf "$PDIR"
+}
+trap cleanup EXIT
+
+echo "== booting ephemeral host on :$PORT (persist=$PDIR) =="
+# SX_SERVING_JIT=1 to MATCH THE CONTAINER: it gates the http-listen IO resolver, so
+# without it perform-heavy paths (e.g. reach-down's BFS over the type graph — the is-a/
+# tags picker) falsely raise VmSuspended -> 500. The live container sets it; the harness
+# must too, or it reports false 500s the live site never shows.
+SX_SERVING_JIT=1 HOST_PORT="$PORT" SX_PERSIST_DIR="$PDIR" \
+  SX_ADMIN_USER="$USER" SX_ADMIN_PASSWORD="$PASS" SX_SESSION_SECRET="$SECRET" \
+  bash lib/host/serve.sh >"$LOG" 2>&1 &
+for i in $(seq 1 60); do
+  curl -sf -o /dev/null "$BASE/health" 2>/dev/null && break
+  sleep 1; [ "$i" = "60" ] && { echo "server never came up:"; cat "$LOG"; exit 1; }
+done
+echo "== up =="
+
+# Log in + seed one post (also exercises the form-ingest write path).
+curl -s -c "$JAR" -o /dev/null -X POST "$BASE/login" --data "username=$USER&password=$PASS"
+curl -s -b "$JAR" -o /dev/null -X POST "$BASE/new" \
+  --data 'title=Live Check Post&sx_content=(article (h1 "Live Check Post") (p "ok"))&status=published'
+
+# A GET check: prints "<status> <content-type> | <body-head>" and flags problems.
+check() {
+  local path="$1" body ct code
+  body=$(curl -s -b "$JAR" -D "$HDR" "$BASE$path")
+  code=$(awk 'NR==1{print $2}' "$HDR")
+  ct=$(grep -i '^content-type:' "$HDR" | head -1 | tr -d '\r' | sed 's/content-type: *//I')
+  printf '  %-20s %s  %-26s | %s\n' "$path" "${code:-???}" "${ct:-?}" "$(printf '%s' "$body" | tr '\n' ' ' | cut -c1-70)"
+  case "$code" in 5*) echo "    !! 5xx"; RC=1 ;; esac
+  [ -z "$body" ] && { echo "    !! empty body"; RC=1; }
+  # data endpoints must be SX, never JSON
+  case "$path" in
+    /posts|/feed) echo "$ct" | grep -qi 'text/sx' || { echo "    !! expected text/sx, got '$ct'"; RC=1; }
+                  printf '%s' "$body" | grep -q '"ok":' && { echo "    !! JSON leaked"; RC=1; } ;;
+  esac
+}
+
+echo "== checks =="
+if [ "$#" -gt 0 ]; then
+  for p in "$@"; do check "$p"; done
+else
+  for p in /health /posts /feed / /live-check-post/; do check "$p"; done
+fi
+
+echo "== done (rc $RC) =="
+exit $RC

lib/host/middleware.sx

@@ -0,0 +1,54 @@
+;; lib/host/middleware.sx — Host middleware: composable handler->handler layers
+;; for the cross-cutting concerns every write endpoint shares — error trapping
+;; (JSON 500), authentication (bearer token -> principal), and authorisation
+;; (ACL permit?). Middleware is plain function composition; host/pipeline threads a
+;; list onto a handler, FIRST middleware outermost (so it runs first). Auth and
+;; permission policy are INJECTED — the token resolver and the resource extractor —
+;; so this layer carries no hardcoded policy. Reuses Dream's bearer/error helpers
+;; and lib/acl's public acl/permit?.
+;; Depends on lib/dream/{auth,error,router}.sx + lib/acl/api.sx + lib/host/handler.sx.
+
+;; Compose a list of middlewares onto a handler (first = outermost).
+(define host/pipeline
+  (fn (middlewares handler)
+    (dr/apply-middlewares middlewares handler)))
+
+;; The authenticated principal attached by host/require-auth.
+(define host/principal (fn (req) (dream-principal req)))
+
+;; ── error trapping ─────────────────────────────────────────────────
+;; Any error thrown downstream becomes a JSON 500 envelope.
+(define host/-on-error
+  (fn (req e) (host/error 500 "internal error")))
+(define host/wrap-errors (dream-catch-with host/-on-error))
+
+;; ── authentication ─────────────────────────────────────────────────
+;; resolve : token -> principal | nil. Missing/invalid token -> JSON 401 with a
+;; WWW-Authenticate: Bearer challenge; success attaches :dream-principal so
+;; downstream layers (and host/principal) can read it.
+(define host/require-auth
+  (fn (resolve)
+    (fn (next)
+      (fn (req)
+        (let ((tok (dream-bearer-token req)))
+          (let ((principal (if tok (resolve tok) nil)))
+            (if (nil? principal)
+              (dream-add-header
+                (host/error 401 "unauthorized")
+                "www-authenticate"
+                "Bearer")
+              (next (assoc req :dream-principal principal)))))))))
+
+;; ── authorisation ──────────────────────────────────────────────────
+;; Gate on ACL: the authed principal must be permitted `action` on the resource
+;; computed by res-fn from the request. Denied -> JSON 403. Assumes the ACL fact
+;; db was loaded (acl/load!) at startup. Place AFTER host/require-auth.
+(define host/require-permission
+  (fn (action res-fn)
+    (fn (next)
+      (fn (req)
+        (let ((subject (host/principal req))
+              (resource (res-fn req)))
+          (if (acl/permit? subject action resource)
+            (next req)
+            (host/error 403 "forbidden")))))))

lib/host/page.sx

@@ -0,0 +1,22 @@
+;; lib/host/page.sx — serve interactive SX component/island pages on the host
+;; (Phase 5: the generic interactive-SX-page capability).
+;;
+;; The bare `render-to-html` path mangles an EVALUATED component tree's keyword
+;; attributes ((form :id ..) -> "<form>idpost-new-form..."), because evaluating a
+;; defcomp body turns `:id` into a child. The kernel `render-page` primitive
+;; instead renders an UNEVALUATED expression with the server env: render-to-html
+;; expands the components itself and collects keyword args as attributes. SX
+;; handlers can't reach the server env, so render-page supplies it.
+;;
+;; host/page wraps a rendered expression as an HTML response; host/page-route
+;; mounts it on a GET path. This is the component-render step (5.1); the full page
+;; shell (inlined component defs + CSS + client runtime + hydration) and static
+;; asset serving (5.2–5.4) build on top to make the page interactive.
+;; Depends on the kernel `render-page` primitive + lib/dream/types.sx (dream-html).
+
+;; Render an unevaluated SX page/component expression to an HTML response.
+(define host/page (fn (expr) (dream-html (render-page expr))))
+
+;; Mount a GET route that renders a fixed page expression.
+(define host/page-route
+  (fn (path expr) (dream-get path (fn (req) (host/page expr)))))

lib/host/playwright/relate-picker.spec.js

@@ -0,0 +1,118 @@
+// Browser check for the relate picker (lib/host/blog.sx). Runs against an
+// ephemeral host server seeded with a host post + 25 candidates by
+// run-picker-check.sh, which copies this spec into the Playwright env and sets
+// SX_TEST_URL.
+//
+// TRIMMED to the irreducibly-real-browser cases. The picker's interactive
+// behaviours — populate-on-load, debounced filter, sentinel paging, relate→delete
+// row, error/retry visible state — are now SX engine tests in
+// web/tests/test-relate-picker.sx (they drive the SAME engine against a mock DOM,
+// no Chromium). Its server contract + persistence are SX conformance tests in
+// lib/host/tests/blog.sx. What remains here needs a live boosted-SPA browser:
+//   1. a boosted form POST swaps in place (bind-boost-form regression), and
+//   2. the picker re-binds its triggers on content brought in by a boosted SPA
+//      nav (the case an inline <script> picker silently failed).
+const { test, expect } = require('playwright/test');
+
+const USER = process.env.SX_ADMIN_USER || 'admin';
+const PASS = process.env.SX_ADMIN_PASSWORD || 'letmein';
+const HOST = 'picker-host';        // the post whose edit page we drive
+// the Related picker box (the edit page now has one picker per kind)
+const REL = '.relate-picker[data-kind="related"]';
+const RELF = `${REL} .rp-filter`;
+const RELR = `${REL} .rp-results`;
+const RELROWS = `${RELR} li:not(.rp-more)`;   // candidate rows (exclude the sentinel)
+
+// boot-init marks <html data-sx-ready="true"> once the WASM kernel + web stack
+// load. WASM compile + asset fetches, so allow generous time.
+async function waitReady(page) {
+  await expect(page.locator('html[data-sx-ready="true"]')).toHaveCount(1, { timeout: 45000 });
+}
+
+// Navigate to a GUARDED path; the host redirects to /login?next=…, so fill the
+// form and we should land back on the original path (exercises the auth flow).
+async function loginTo(page, path) {
+  await page.goto(path);
+  await page.waitForURL(/\/login/);
+  await page.fill('input[name="username"]', USER);
+  await page.fill('input[name="password"]', PASS);
+  await page.click('button[type="submit"]');
+  await page.waitForURL((u) => !u.pathname.startsWith('/login'));
+}
+
+// Log in directly (for reaching PUBLIC pages while authenticated).
+async function login(page) {
+  await page.goto('/login');
+  await page.fill('input[name="username"]', USER);
+  await page.fill('input[name="password"]', PASS);
+  await page.click('button[type="submit"]');
+  await page.waitForURL((u) => !u.pathname.startsWith('/login'));
+}
+
+test.describe('relate picker (browser-only)', () => {
+  test('relating a candidate adds it to the current list AND removing keeps the picker', async ({ page }) => {
+    // The whole in-page flow the user reported broken — no reloads. Relating a
+    // candidate re-renders the editor: the post moves into the current-relations
+    // list and the picker re-loads its candidates (it is NOT blanked). Removing it
+    // re-renders the editor back: the post leaves the current list and the picker
+    // still offers candidates.
+    test.setTimeout(75000);
+    await loginTo(page, `/${HOST}/edit`);
+    await waitReady(page);
+    await page.evaluate(() => { window.__noReload = true; });
+    // relate Item 13 from the picker
+    await page.fill(RELF, 'Item 13');
+    await expect.poll(() => page.locator(RELROWS).count(), { timeout: 10000 }).toBe(1);
+    await page.locator(`${RELROWS} button`).first().click();
+    const relLink = page.locator('a[href="/picker-item-13/"]');
+    // ISSUE 1: it now appears in the CURRENT relations list (added, not just removed)
+    await expect(relLink).toHaveCount(1, { timeout: 12000 });
+    // and the re-rendered picker still offers candidates (not blanked)
+    await expect.poll(() => page.locator(RELROWS).count(), { timeout: 12000 }).toBeGreaterThan(0);
+    // now remove it via its current-list remove button
+    await page.locator('li:has(a[href="/picker-item-13/"]) button').click();
+    await expect(relLink).toHaveCount(0, { timeout: 12000 });   // left the current list
+    // ISSUE 2: removing must NOT clear "the list of posts to relate"
+    await expect.poll(() => page.locator(RELROWS).count(), { timeout: 12000 }).toBeGreaterThan(0);
+    expect(await page.evaluate(() => window.__noReload)).toBe(true);   // all in-page, no reload
+    // and the relation truly persisted gone (reload shows it not present)
+    await page.reload();
+    await waitReady(page);
+    await expect(page.locator('a[href="/picker-item-13/"]')).toHaveCount(0);
+  });
+
+  test('relating a candidate persists the relation', async ({ page }) => {
+    test.setTimeout(75000);
+    await loginTo(page, `/${HOST}/edit`);
+    await waitReady(page);
+    await page.fill(RELF, 'Item 07');
+    await expect.poll(() => page.locator(RELROWS).count(), { timeout: 10000 }).toBe(1);
+    await page.locator(`${RELROWS} button`).first().click();
+    await expect(page.locator('a[href="/picker-item-07/"]')).toHaveCount(1, { timeout: 12000 });
+    // persisted across a reload
+    await page.reload();
+    await waitReady(page);
+    await expect(page.locator('a[href="/picker-item-07/"]')).toHaveCount(1);
+    // and visible on the public post page
+    await page.goto(`/${HOST}/`);
+    await expect(page.getByRole('heading', { name: 'Related posts' })).toBeVisible();
+    await expect(page.locator('body')).toContainText('Picker Item 07');
+  });
+
+  test('picker populates after a boosted SPA nav to the edit page', async ({ page }) => {
+    // Reach the edit page by CLICKING its link (a boosted SPA nav), not page.goto.
+    // The old inline <script> picker never ran on swapped-in content, so the list
+    // stayed empty here. The declarative form's "load" trigger is re-bound by the
+    // engine on swap, so it populates — that's the regression this guards.
+    await login(page);
+    await page.goto(`/${HOST}/`);              // public post page, logged in
+    await waitReady(page);
+    await page.evaluate(() => { window.__noReload = true; });
+    await page.locator(`a[href="/${HOST}/edit"]`).first().click();
+    await page.waitForURL((u) => u.pathname === `/${HOST}/edit`, { timeout: 15000 });
+    expect(await page.evaluate(() => window.__noReload)).toBe(true);   // it was a SPA nav, no full reload
+    // the picker, brought in by the swap, loaded its first page of candidates
+    await expect.poll(() => page.locator(RELROWS).count(), { timeout: 12000 }).toBeGreaterThanOrEqual(1);
+    await expect(page.locator(RELR)).toContainText('Picker Item');
+  });
+});

lib/host/playwright/run-picker-check.sh

@@ -0,0 +1,72 @@
+#!/usr/bin/env bash
+# Browser check for the relate picker. Spins up an EPHEMERAL host server (this
+# worktree's binary + lib, a temp persist dir), seeds a host post + 25 candidates,
+# runs lib/host/playwright/relate-picker.spec.js in the main worktree's Playwright,
+# then tears everything down. No live-site dependency, no live-data pollution.
+#
+#   bash lib/host/playwright/run-picker-check.sh
+#
+# Requires: the OCaml binary built (hosts/ocaml/_build/default/bin/sx_server.exe)
+# and Playwright + chromium in /root/rose-ash (the architecture worktree).
+set -uo pipefail
+cd "$(git rev-parse --show-toplevel)"
+ROOT=$(pwd)
+
+PORT="${PICKER_PORT:-8912}"
+PW_DIR="${PW_DIR:-/root/rose-ash}"          # worktree that has node_modules + chromium
+USER="admin"
+PASS="picker-check-pw"
+SECRET="picker-check-secret"
+PDIR=$(mktemp -d)
+JAR=$(mktemp)
+SPEC_SRC="lib/host/playwright/relate-picker.spec.js"
+SPEC_DST="$PW_DIR/tests/playwright/_picker-check.spec.js"
+SERVE_LOG=$(mktemp)
+
+cleanup() {
+  [ -n "${SVPID:-}" ] && kill "$SVPID" 2>/dev/null
+  # kill whatever is still bound to the port (serve.sh re-parents via `| exec`)
+  local pid
+  pid=$(ss -lptn "sport = :$PORT" 2>/dev/null | grep -oE 'pid=[0-9]+' | head -1 | cut -d= -f2)
+  [ -n "$pid" ] && kill "$pid" 2>/dev/null
+  rm -f "$SPEC_DST" "$JAR" "$SERVE_LOG"
+  rm -rf "$PDIR"
+}
+trap cleanup EXIT
+
+echo "== starting ephemeral host server on :$PORT (persist=$PDIR) =="
+# SX_SERVING_JIT=1 matches the live container (gates the http-listen IO resolver);
+# without it, perform-heavy paths (e.g. the is-a/tags picker's reach-down) falsely 500.
+SX_SERVING_JIT=1 HOST_PORT="$PORT" SX_PERSIST_DIR="$PDIR" \
+  SX_ADMIN_USER="$USER" SX_ADMIN_PASSWORD="$PASS" SX_SESSION_SECRET="$SECRET" \
+  bash lib/host/serve.sh >"$SERVE_LOG" 2>&1 &
+SVPID=$!
+
+for i in $(seq 1 60); do
+  curl -sf -o /dev/null "http://127.0.0.1:$PORT/health" 2>/dev/null && break
+  sleep 1
+  [ "$i" = "60" ] && { echo "server never came up:"; cat "$SERVE_LOG"; exit 1; }
+done
+echo "== server up =="
+
+echo "== seeding 1 host post + 25 candidates =="
+curl -s -c "$JAR" -o /dev/null -X POST "http://127.0.0.1:$PORT/login" \
+  --data "username=$USER&password=$PASS"
+curl -s -b "$JAR" -o /dev/null -X POST "http://127.0.0.1:$PORT/new" \
+  --data 'title=Picker Host&sx_content=(p "host")&status=published'
+for n in $(seq -w 1 25); do
+  curl -s -b "$JAR" -o /dev/null -X POST "http://127.0.0.1:$PORT/new" \
+    --data "title=Picker Item $n&sx_content=(p \"item $n\")&status=published"
+done
+echo "== seeded ($(curl -s "http://127.0.0.1:$PORT/posts" | grep -o '"slug"' | wc -l) posts) =="
+
+echo "== running Playwright =="
+cp "$ROOT/$SPEC_SRC" "$SPEC_DST"
+cd "$PW_DIR"
+SX_TEST_URL="http://127.0.0.1:$PORT" SX_ADMIN_USER="$USER" SX_ADMIN_PASSWORD="$PASS" \
+  node_modules/.bin/playwright test _picker-check.spec.js --workers=1 \
+  --config tests/playwright/playwright.config.js
+RC=$?
+
+echo "== done (exit $RC) =="
+exit $RC

lib/host/playwright/run-spa-check.sh

@@ -0,0 +1,68 @@
+#!/usr/bin/env bash
+# Browser check for the blog SPA. Spins up an EPHEMERAL host server (this
+# worktree's binary + lib, a temp persist dir), seeds a couple of posts, runs
+# lib/host/playwright/spa-check.spec.js in the main worktree's Playwright, then
+# tears everything down. Verifies the WASM OCaml kernel boots in-browser and
+# sx-boost turns the blog into a SPA. No live-site dependency.
+#
+#   bash lib/host/playwright/run-spa-check.sh
+#
+# Requires: the OCaml binary built (hosts/ocaml/_build/default/bin/sx_server.exe)
+# and Playwright + chromium in /root/rose-ash (the architecture worktree).
+set -uo pipefail
+cd "$(git rev-parse --show-toplevel)"
+ROOT=$(pwd)
+
+PORT="${SPA_PORT:-8914}"
+PW_DIR="${PW_DIR:-/root/rose-ash}"          # worktree that has node_modules + chromium
+USER="admin"
+PASS="spa-check-pw"
+SECRET="spa-check-secret"
+PDIR=$(mktemp -d)
+JAR=$(mktemp)
+SPEC_SRC="lib/host/playwright/spa-check.spec.js"
+SPEC_DST="$PW_DIR/tests/playwright/_spa-check.spec.js"
+SERVE_LOG=$(mktemp)
+
+cleanup() {
+  [ -n "${SVPID:-}" ] && kill "$SVPID" 2>/dev/null
+  local pid
+  pid=$(ss -lptn "sport = :$PORT" 2>/dev/null | grep -oE 'pid=[0-9]+' | head -1 | cut -d= -f2)
+  [ -n "$pid" ] && kill "$pid" 2>/dev/null
+  rm -f "$SPEC_DST" "$JAR" "$SERVE_LOG"
+  rm -rf "$PDIR"
+}
+trap cleanup EXIT
+
+echo "== starting ephemeral host server on :$PORT (persist=$PDIR) =="
+HOST_PORT="$PORT" SX_PERSIST_DIR="$PDIR" \
+  SX_ADMIN_USER="$USER" SX_ADMIN_PASSWORD="$PASS" SX_SESSION_SECRET="$SECRET" \
+  bash lib/host/serve.sh >"$SERVE_LOG" 2>&1 &
+SVPID=$!
+
+for i in $(seq 1 60); do
+  curl -sf -o /dev/null "http://127.0.0.1:$PORT/health" 2>/dev/null && break
+  sleep 1
+  [ "$i" = "60" ] && { echo "server never came up:"; cat "$SERVE_LOG"; exit 1; }
+done
+echo "== server up =="
+
+echo "== seeding posts =="
+curl -s -c "$JAR" -o /dev/null -X POST "http://127.0.0.1:$PORT/login" \
+  --data "username=$USER&password=$PASS"
+for t in "Alpha Post" "Beta Post"; do
+  curl -s -b "$JAR" -o /dev/null -X POST "http://127.0.0.1:$PORT/new" \
+    --data "title=$t&sx_content=(article (h1 \"$t\") (p \"body\"))&status=published"
+done
+echo "== seeded ($(curl -s "http://127.0.0.1:$PORT/posts" | grep -o '"slug"' | wc -l) posts) =="
+
+echo "== running Playwright =="
+cp "$ROOT/$SPEC_SRC" "$SPEC_DST"
+cd "$PW_DIR"
+SX_TEST_URL="http://127.0.0.1:$PORT" \
+  node_modules/.bin/playwright test _spa-check.spec.js --workers=1 \
+  --config tests/playwright/playwright.config.js
+RC=$?
+
+echo "== done (exit $RC) =="
+exit $RC

lib/host/playwright/spa-check.spec.js

@@ -0,0 +1,84 @@
+// Browser check for the blog SPA (lib/host/blog.sx + lib/host/static.sx). Runs
+// against an ephemeral host server seeded with a couple of posts by
+// run-spa-check.sh, which copies this spec into the Playwright env and sets
+// SX_TEST_URL. Verifies the WASM OCaml kernel boots in the browser, the SX-htmx
+// engine activates sx-boost on #content's links, and clicking a link does a
+// fragment swap (no full page reload) with history — i.e. it's a real SPA.
+const { test, expect } = require('playwright/test');
+
+// boot-init sets data-sx-ready="true" on <html> once the WASM kernel + web stack
+// have loaded and the page has been processed. WASM compile + ~25 asset fetches,
+// so allow generous time.
+async function waitReady(page) {
+  await expect(page.locator('html[data-sx-ready="true"]')).toHaveCount(1, { timeout: 45000 });
+}
+
+// a post link in the listing (trailing slash); skip /new, /login, /tags.
+const POSTLINK = '#content a[href$="/"]';
+
+test.describe('blog SPA', () => {
+  test('WASM kernel boots, loads modules content-addressed, marks ready', async ({ page }) => {
+    const errors = [];
+    // Track web-stack module fetches: content-addressed (/sx/h/{hash}) vs the
+    // path-based .sxbc fallback. A correctly-booting client takes ONLY the
+    // content-addressed branch (immutable, localStorage-cached).
+    const caFetches = [];     // /sx/h/{hash}
+    const pathSxbc = [];      // *.sxbc by path (the fallback — should not happen)
+    page.on('request', (r) => {
+      const u = r.url();
+      if (u.includes('/sx/h/')) caFetches.push(u);
+      else if (/\.sxbc(\?|$)/.test(u)) pathSxbc.push(u);
+    });
+    page.on('console', (m) => { if (m.type() === 'error') errors.push(m.text()); });
+    page.on('pageerror', (e) => errors.push(String(e)));
+    await page.goto('/');
+    await waitReady(page);
+    // the shell shipped the WASM loaders
+    expect(await page.locator('script[src*="sx_browser.bc.wasm.js"]').count()).toBe(1);
+    expect(await page.locator('script[src*="sx-platform.js"]').count()).toBe(1);
+    // modules loaded by content hash, with no path-.sxbc fallback fetches
+    expect(caFetches.length, 'expected content-addressed /sx/h/ module fetches').toBeGreaterThan(0);
+    expect(pathSxbc, `path-based .sxbc fallback fetched:\n${pathSxbc.join('\n')}`).toEqual([]);
+    // no boot-time JS errors
+    expect(errors, errors.join('\n')).toEqual([]);
+  });
+
+  test('clicking a link does a fragment swap — no full reload, URL updates', async ({ page }) => {
+    await page.goto('/');
+    await waitReady(page);
+    // sentinel survives ONLY if there is no full-page reload
+    await page.evaluate(() => { window.__noReload = true; });
+    const link = page.locator(POSTLINK).first();
+    const href = await link.getAttribute('href');
+    await link.click();
+    await page.waitForURL((u) => u.pathname === href, { timeout: 15000 });
+    expect(await page.evaluate(() => window.__noReload)).toBe(true);     // no reload
+    // content was swapped into #content (a post page carries the post footer)
+    await expect(page.locator('#content')).toContainText(/all posts/i, { timeout: 15000 });
+    // the post BODY itself rendered — the <article> comes from raw! HTML, which
+    // exercises the client SX raw-HTML path (dom-parse-html). If that drops the
+    // content (NodeList-vs-Node bug), the footer still shows but this fails.
+    await expect(page.locator('#content article').first()).toBeVisible({ timeout: 15000 });
+  });
+
+  test('back button restores the listing', async ({ page }) => {
+    await page.goto('/');
+    await waitReady(page);
+    const link = page.locator(POSTLINK).first();
+    const href = await link.getAttribute('href');
+    await link.click();
+    await page.waitForURL((u) => u.pathname === href, { timeout: 15000 });
+    await page.goBack();
+    await page.waitForURL((u) => u.pathname === '/', { timeout: 15000 });
+    await expect(page.locator('#content h1')).toContainText('Posts');
+    // and a click AFTER back must still be a SPA nav, not a full reload — the
+    // restored content has to be re-boosted (its [sx-boost] marker is an
+    // ancestor of the swap target, so the re-boost must scan upward).
+    await page.evaluate(() => { window.__noReload2 = true; });
+    const link2 = page.locator(POSTLINK).first();
+    const href2 = await link2.getAttribute('href');
+    await link2.click();
+    await page.waitForURL((u) => u.pathname === href2, { timeout: 15000 });
+    expect(await page.evaluate(() => window.__noReload2)).toBe(true);
+  });
+});

lib/host/relations.sx

@@ -0,0 +1,134 @@
+;; lib/host/relations.sx — Relations domain endpoints on the host. The relations
+;; service is internal-only (no public routes): Quart exposes it as signed
+;; /internal/data/{query} reads + /internal/actions/{action} writes. This migrates
+;; the two READ queries — get-children, get-parents — straight onto the SX host,
+;; dispatching to the lib/relations subsystem (a saturating Datalog graph).
+;;
+;; Node model: the Quart relations API keys nodes by a (type, id) pair; the graph
+;; subsystem keys them by an opaque atom. We bridge by composing the atom as the
+;; symbol "type:id", with the relation-type as the edge kind. Optional child-type
+;; / parent-type params filter the result by that "type:" prefix — matching the
+;; Quart queries' optional type narrowing.
+;; Depends on lib/relations/* + lib/host/handler.sx + lib/dream/* (query params).
+
+;; ── node helpers ────────────────────────────────────────────────────
+(define host/-rel-node
+  (fn (type id) (string->symbol (str type ":" id))))
+(define host/-rel-node-type?
+  (fn (node type) (starts-with? (symbol->string node) (str type ":"))))
+(define host/-rel-strings
+  (fn (nodes) (map (fn (n) (symbol->string n)) nodes)))
+
+;; ── GET /internal/data/get-children ─────────────────────────────────
+;; query: parent-type, parent-id, relation-type (required); child-type (optional
+;; filter). Returns the child node ids ("type:id") for the parent under that kind.
+(define host/relations-children
+  (fn (req)
+    (let ((ptype (dream-query-param req "parent-type"))
+          (pid (dream-query-param req "parent-id"))
+          (kind (dream-query-param req "relation-type")))
+      (if (and ptype pid kind)
+        (let ((kids (relations/children (host/-rel-node ptype pid) (string->symbol kind)))
+              (ctype (dream-query-param req "child-type")))
+          (let ((sel (if ctype (filter (fn (k) (host/-rel-node-type? k ctype)) kids) kids)))
+            (host/ok (host/-rel-strings sel))))
+        (host/error 400 "missing parameter")))))
+
+;; ── GET /internal/data/get-parents ──────────────────────────────────
+;; query: child-type, child-id, relation-type (required); parent-type (optional
+;; filter). Returns the parent node ids ("type:id") for the child under that kind.
+(define host/relations-parents
+  (fn (req)
+    (let ((ctype (dream-query-param req "child-type"))
+          (cid (dream-query-param req "child-id"))
+          (kind (dream-query-param req "relation-type")))
+      (if (and ctype cid kind)
+        (let ((ps (relations/parents (host/-rel-node ctype cid) (string->symbol kind)))
+              (ptype (dream-query-param req "parent-type")))
+          (let ((sel (if ptype (filter (fn (p) (host/-rel-node-type? p ptype)) ps) ps)))
+            (host/ok (host/-rel-strings sel))))
+        (host/error 400 "missing parameter")))))
+
+;; ── read route group ────────────────────────────────────────────────
+;; Internal data reads (the signed-internal-auth gate is a separate middleware
+;; concern, like the feed reads); these dispatch straight to the subsystem.
+(define host/relations-routes
+  (list
+    (dream-get "/internal/data/get-children" host/relations-children)
+    (dream-get "/internal/data/get-parents" host/relations-parents)))
+
+;; ── writes: container relations (attach-child / detach-child) ────────
+;; The write side of get-children/get-parents: a container edge between a parent
+;; (type,id) and child (type,id) under a relation kind. Maps to relations/relate
+;; and relations/unrelate over the same "type:id" node model, so an attach is
+;; immediately visible through get-children. (The TYPED relate/unrelate/can-relate
+;; actions stay on Quart — they carry registry + cardinality validation that
+;; lib/relations does not implement.) Body is the action's JSON params dict.
+
+;; Pull the four node coordinates + kind from a payload; nil if any are absent.
+(define host/-rel-edge
+  (fn (p)
+    (let ((pt (get p :parent-type)) (pid (get p :parent-id))
+          (ct (get p :child-type)) (cid (get p :child-id))
+          (kind (get p :relation-type)))
+      (if (and pt pid ct cid kind)
+        {:parent (host/-rel-node pt pid)
+         :child (host/-rel-node ct cid)
+         :kind (string->symbol kind)
+         :parent-id (str pt ":" pid)
+         :child-id (str ct ":" cid)
+         :relation kind}
+        nil))))
+
+;; POST /internal/actions/attach-child — create the container edge. 201 on success.
+;; Body is text/sx (host/sx-body); non-dict -> 400.
+(define host/relations-attach
+  (fn (req)
+    (let ((p (host/sx-body req)))
+      (if (= (type-of p) "dict")
+        (let ((e (host/-rel-edge p)))
+          (if e
+            (begin
+              (relations/relate (get e :parent) (get e :child) (get e :kind))
+              (host/ok-status 201
+                {:parent (get e :parent-id) :child (get e :child-id)
+                 :relation (get e :relation)}))
+            (host/error 400 "missing parameter")))
+        (host/error 400 "invalid payload")))))
+
+;; POST /internal/actions/detach-child — remove the container edge. 200 on success.
+;; Body is text/sx (host/sx-body); non-dict -> 400.
+(define host/relations-detach
+  (fn (req)
+    (let ((p (host/sx-body req)))
+      (if (= (type-of p) "dict")
+        (let ((e (host/-rel-edge p)))
+          (if e
+            (begin
+              (relations/unrelate (get e :parent) (get e :child) (get e :kind))
+              (host/ok
+                {:parent (get e :parent-id) :child (get e :child-id)
+                 :relation (get e :relation) :detached true}))
+            (host/error 400 "missing parameter")))
+        (host/error 400 "invalid payload")))))
+
+;; Guarded write route group: each action behind auth + ACL. attach needs
+;; ("relate","relations"); detach needs ("unrelate","relations"). resolve is the
+;; injected token->principal auth policy (same shape as host/feed-write-routes).
+(define host/relations-write-routes
+  (fn (resolve)
+    (list
+      (dream-post "/internal/actions/attach-child"
+        (host/pipeline
+          (list
+            host/wrap-errors
+            (host/require-auth resolve)
+            (host/require-permission "relate" (fn (req) "relations")))
+          host/relations-attach))
+      (dream-post "/internal/actions/detach-child"
+        (host/pipeline
+          (list
+            host/wrap-errors
+            (host/require-auth resolve)
+            (host/require-permission "unrelate" (fn (req) "relations")))
+          host/relations-detach)))))

lib/host/router.sx

@@ -0,0 +1,25 @@
+;; lib/host/router.sx — Host application assembly. A host app is a single Dream
+;; router built from per-domain route groups, with a built-in health endpoint and
+;; a JSON 404 fallback so the native OCaml HTTP server has one entry point:
+;; request -> response. Each subsystem contributes a list of Dream routes (see
+;; lib/host/feed.sx); host/make-app concatenates them under one router.
+;; dr/flatten-routes (Dream) flattens the nested groups, so a group is just a list
+;; of routes. Depends on lib/dream/router.sx + lib/host/handler.sx + the host
+;; session middleware (lib/host/session.sx) and login routes (lib/host/auth.sx).
+
+;; Liveness probe — GET /health -> 200 {"ok":true,"data":"healthy"}.
+(define host/health-route
+  (dream-get "/health" (fn (req) (host/ok "healthy"))))
+
+;; Build the host app from a list of route groups (each a list of Dream routes).
+;; The health route + login routes are always mounted; Dream's router returns a
+;; JSON 404 for unmatched paths, which host endpoints override per-domain as
+;; needed. The WHOLE app is wrapped in the signed-session middleware so every
+;; request carries a session and any handler can log a principal in/out — this is
+;; the front door, so sessions are not optional.
+(define host/make-app
+  (fn (groups)
+    (let ((router (dream-router
+                    (cons host/health-route
+                      (cons host/auth-routes groups)))))
+      ((host/sessions) router))))

lib/host/serve.sh

@@ -0,0 +1,181 @@
+#!/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
+# Project root: SX_PROJECT_DIR in containers (set to /app by the compose stack),
+# else the git toplevel for local runs.
+cd "${SX_PROJECT_DIR:-$(git rev-parse --show-toplevel 2>/dev/null || echo .)}"
+
+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/persist/event.sx"
+  "lib/persist/backend.sx"
+  "lib/persist/log.sx"
+  "lib/persist/kv.sx"
+  "lib/persist/api.sx"
+  "lib/persist/durable.sx"
+  "spec/render.sx"
+  "web/adapter-html.sx"
+  "lib/dream/types.sx"
+  "lib/dream/json.sx"
+  "lib/dream/auth.sx"
+  "lib/dream/error.sx"
+  "lib/dream/form.sx"
+  "lib/dream/session.sx"
+  "lib/dream/router.sx"
+  "lib/host/handler.sx"
+  "lib/host/middleware.sx"
+  "lib/host/session.sx"
+  "lib/host/auth.sx"
+  "lib/host/sxtp.sx"
+  "lib/host/router.sx"
+  "lib/host/static.sx"
+  "lib/host/sx/relate-picker.sx"
+  "lib/host/sx/kg-cards.sx"
+  "lib/host/feed.sx"
+  "lib/host/relations.sx"
+  "lib/host/compose.sx"
+  "lib/host/blog.sx"
+  "lib/host/server.sx"
+)
+
+# Admin login credentials + session signing secret. Override via the container
+# env; the in-source defaults are dev-only. The blog write routes are now GUARDED
+# (session login or Bearer), so these gate publishing on blog.rose-ash.com.
+ADMIN_USER="${SX_ADMIN_USER:-admin}"
+ADMIN_PASS="${SX_ADMIN_PASSWORD:-letmein}"
+SESSION_SECRET="${SX_SESSION_SECRET:-rose-ash-host-dev-secret-change-me}"
+
+EPOCH=1
+{
+  for M in "${MODULES[@]}"; do
+    echo "(epoch $EPOCH)"; echo "(load \"$M\")"; EPOCH=$((EPOCH+1))
+  done
+  # 100% serving JIT — NO host exclude. The serving-JIT perform-in-HO-callback
+  # miscompile (map/rest/drop wrong args → blank pages, empty picker) is fixed by
+  # two composing pieces: sx-vm-extensions 81177d0e resolves a callback's IO
+  # inline (instead of unwinding the native HO loop) WHEN a synchronous resolver
+  # is installed, and sx_server.ml's http-listen now installs that resolver (it
+  # mirrors cek_run_with_io exactly). So the whole request path — host app +
+  # Dream + Datalog — runs under JIT with no exclude. Verified: ephemeral durable
+  # server, 100% JIT, zero fallbacks, real content, picker lists candidates.
+  # Point the blog at the DURABLE file backend (persists under $SX_PERSIST_DIR),
+  # then idempotently seed a welcome post (sx_content = SX element markup, the
+  # editor's content model). Re-seeding is a no-op if the slug already exists.
+  echo "(epoch $EPOCH)"
+  echo "(eval \"(host/blog-use-store! (persist/durable-backend))\")"
+  EPOCH=$((EPOCH+1))
+  # Rebuild the relations graph from the durable edge store. lib/relations holds
+  # the graph in memory only, so without this, related/tags/types vanish on every
+  # restart even though the posts persist.
+  echo "(epoch $EPOCH)"
+  echo "(eval \"(host/blog-load-edges!)\")"
+  EPOCH=$((EPOCH+1))
+  # Sessions on the DURABLE store, LAZILY: only a logged-in session (one that
+  # writes a field) persists, so a login survives a restart while anonymous /
+  # crawler traffic leaves no rows. host/session-init! bumps the per-boot epoch
+  # that keeps sids unique across restarts. Then the signing secret + admin
+  # credentials, and grant admin "edit" on "blog" so a logged-in session passes
+  # the ACL gate on the write routes.
+  echo "(epoch $EPOCH)"
+  echo "(eval \"(host/session-use-store! (persist/durable-backend))\")"
+  EPOCH=$((EPOCH+1))
+  echo "(epoch $EPOCH)"
+  echo "(eval \"(host/session-init!)\")"
+  EPOCH=$((EPOCH+1))
+  echo "(epoch $EPOCH)"
+  echo "(eval \"(host/session-set-secret! \\\"$SESSION_SECRET\\\")\")"
+  EPOCH=$((EPOCH+1))
+  echo "(epoch $EPOCH)"
+  echo "(eval \"(host/auth-set-admin! \\\"$ADMIN_USER\\\" \\\"$ADMIN_PASS\\\")\")"
+  EPOCH=$((EPOCH+1))
+  echo "(epoch $EPOCH)"
+  echo "(eval \"(acl/load! (list (acl-grant \\\"$ADMIN_USER\\\" \\\"edit\\\" \\\"blog\\\")))\")"
+  EPOCH=$((EPOCH+1))
+  # Idempotently seed a welcome post (sx_content = SX element markup, the editor's
+  # content model). Re-seeding is a no-op if the slug already exists.
+  echo "(epoch $EPOCH)"
+  echo "(eval \"(host/blog-seed! \\\"welcome\\\" \\\"Welcome to the SX host\\\" \\\"(article (h1 \\\\\\\"Welcome to the SX host\\\\\\\") (p \\\\\\\"Rendered by lib/host via render-to-html, from the durable SX store.\\\\\\\"))\\\" \\\"published\\\")\")"
+  EPOCH=$((EPOCH+1))
+  # Seed the root type-posts (type, tag) — types ARE posts. Idempotent.
+  echo "(epoch $EPOCH)"
+  echo "(eval \"(host/blog-seed-types!)\")"
+  EPOCH=$((EPOCH+1))
+  # Seed a live demo of the composition fold (plans/composition-objects.md): /compose-demo
+  # is one composition object rendered by host/comp-render — renders differently by context.
+  echo "(epoch $EPOCH)"
+  echo "(eval \"(host/blog-seed-compose-demo!)\")"
+  EPOCH=$((EPOCH+1))
+  # Load relation metadata (symmetry/labels) from the relation-posts into the
+  # in-memory cache, so render paths read it without a (VmSuspending) durable read.
+  echo "(epoch $EPOCH)"
+  echo "(eval \"(host/blog-load-rel-kinds!)\")"
+  EPOCH=$((EPOCH+1))
+  # Index the web-stack .sxbc by content hash so /sx/h/{hash} can serve them
+  # immutably and the shell can emit the data-sx-manifest (content-addressed
+  # client module cache). Done once at boot.
+  echo "(epoch $EPOCH)"
+  echo "(eval \"(host/static-build-sxh-index!)\")"
+  EPOCH=$((EPOCH+1))
+  echo "(epoch $EPOCH)"
+  # Anonymous reads (feed timeline + relations container reads + blog post detail)
+  # plus the GUARDED blog write routes: POST /new (editor form ingest), POST/PUT/
+  # DELETE /posts behind host/require-user (session login OR Bearer) + ACL. make-app
+  # auto-mounts /login + /logout and wraps everything in the signed-session
+  # middleware, so a browser logs in then publishes. The bearer resolver is a stub
+  # (no API tokens configured) — browser session is the live auth path for now.
+  # blog-routes LAST — its GET /:slug catch-all must not shadow the rest.
+  echo "(eval \"(host/serve $PORT (list host/static-routes host/feed-routes host/relations-routes (host/blog-write-routes (fn (tok) nil)) host/blog-routes))\")"
+} | exec "$SX_SERVER"

lib/host/server.sx

@@ -0,0 +1,48 @@
+;; 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)))))

lib/host/session.sx

@@ -0,0 +1,81 @@
+;; lib/host/session.sx — durable, signed sessions for the host.
+;; Backs Dream's session middleware ops (session/create|exists|get|set|clear)
+;; with the SAME durable persist KV the blog uses, so a login survives restarts.
+;; The session cookie carries only a signed sid (dream-sessions-signed): the sid
+;; itself is a persisted monotonic counter ("s1", "s2", …) — cheap and ordered —
+;; and the HMAC signature (dr/sess-hash, keyed by host/session-secret) makes a
+;; guessed or forged cookie unusable. http-listen serialises handler calls under a
+;; mutex, so the counter increment is race-free.
+;;
+;; Depends on lib/dream/session.sx (dream-sessions-signed + cookie helpers) and
+;; lib/persist/* (the KV backend). Wired into host/make-app via host/sessions.
+
+;; ── store (durable persist KV, injectable; mirrors host/blog-store) ──
+(define host/session-store (persist/open))
+(define host/session-use-store! (fn (b) (set! host/session-store b)))
+
+;; ── signing secret (override from $SX_SESSION_SECRET in serve.sh) ────
+(define host/session-secret "rose-ash-host-dev-secret-change-me")
+(define host/session-set-secret! (fn (s) (set! host/session-secret s)))
+
+;; ── keys ────────────────────────────────────────────────────────────
+(define host/-sess-key (fn (sid) (str "session:" sid)))
+(define host/-sess-epoch-key "session:-epoch")
+
+;; sid generation: a per-BOOT epoch (one durable write at startup) + an in-memory
+;; counter. The epoch keeps sids unique across restarts WITHOUT a write per
+;; request, so anonymous traffic costs no disk. host/session-init! bumps the epoch
+;; on boot (serve.sh); without it (e.g. tests) epoch 0 is fine within one process.
+(define host/session-epoch 0)
+(define host/session-ctr 0)
+(define host/session-init!
+  (fn ()
+    (let ((e (+ 1 (or (persist/backend-kv-get host/session-store host/-sess-epoch-key) 0))))
+      (begin
+        (persist/backend-kv-put host/session-store host/-sess-epoch-key e)
+        (set! host/session-epoch e)
+        (set! host/session-ctr 0)))))
+(define host/-sess-next-sid
+  (fn ()
+    (begin
+      (set! host/session-ctr (+ host/session-ctr 1))
+      (str "s" host/session-epoch "-" host/session-ctr))))
+
+;; ── backend io fn: dispatch session/* ops onto the persist KV ───────
+;; LAZY: session/create mints a sid but writes NO row, so an anonymous request
+;; (which never sets a field) leaves no durable trace — the store isn't spammed by
+;; crawlers. The row appears on the first session/set (i.e. login), so a logged-in
+;; session persists and survives a restart; session/exists is "has a written row".
+(define host/session-backend
+  (fn (op)
+    (let ((kind (get op :op)))
+      (cond
+        ((= kind "session/create") (host/-sess-next-sid))
+        ((= kind "session/exists")
+          (persist/backend-kv-has? host/session-store (host/-sess-key (get op :sid))))
+        ((= kind "session/get")
+          (get
+            (or (persist/backend-kv-get host/session-store (host/-sess-key (get op :sid))) {})
+            (get op :key)))
+        ((= kind "session/set")
+          (let ((sid (get op :sid)))
+            (persist/backend-kv-put host/session-store (host/-sess-key sid)
+              (assoc
+                (or (persist/backend-kv-get host/session-store (host/-sess-key sid)) {})
+                (get op :key)
+                (get op :val)))))
+        ((= kind "session/load")
+          (or (persist/backend-kv-get host/session-store (host/-sess-key (get op :sid))) {}))
+        ((= kind "session/clear")
+          (persist/backend-kv-delete host/session-store (host/-sess-key (get op :sid))))
+        (else nil)))))
+
+;; ── middleware for the host pipeline: signed cookie + durable backend ─
+(define host/sessions
+  (fn () (dream-sessions-signed host/session-backend host/session-secret)))
+
+;; ── handler-facing helpers ──────────────────────────────────────────
+;; The logged-in principal (or nil), and login/logout writing the session field.
+(define host/current-principal (fn (req) (dream-session-field req :principal)))
+(define host/login! (fn (req principal) (dream-set-session-field req :principal principal)))
+(define host/logout! (fn (req) (dream-invalidate-session req)))

lib/host/static.sx

@@ -0,0 +1,118 @@
+;; lib/host/static.sx — serve the client kernel + assets so the blog can boot the
+;; SX-htmx hypermedia engine (web/engine.sx) and run as a SPA. The native
+;; http-listen host reads files with the `file-read` primitive (no perform), so
+;; GET /static/** maps to a file under the static root (default "shared/static",
+;; resolved against the server cwd — mount ./shared/static there in the container).
+;;
+;; Also wires the CONTENT-ADDRESSED module cache the SX client expects: GET
+;; /sx/h/{hash} serves a web-stack .sxbc by its content hash (immutable, never
+;; stale — a deploy changes the content → changes the hash → a fresh URL), and a
+;; <script data-sx-manifest> mapping {file -> hash} makes the client's
+;; loadBytecodeFile take the content-addressed branch (localStorage + immutable)
+;; instead of the path + max-age=3600 branch.
+;; Depends on lib/dream/types.sx (dream-response/-html-status/-param) + router.
+
+(define host/static-root "shared/static")
+(define host/static-use-root! (fn (r) (set! host/static-root r)))
+
+;; content-type by file extension; default to octet-stream.
+(define host/static--ctype
+  (fn (path)
+    (cond
+      ((ends-with? path ".js")    "application/javascript; charset=utf-8")
+      ((ends-with? path ".mjs")   "application/javascript; charset=utf-8")
+      ((ends-with? path ".css")   "text/css; charset=utf-8")
+      ((ends-with? path ".json")  "application/json; charset=utf-8")
+      ((ends-with? path ".map")   "application/json; charset=utf-8")
+      ((ends-with? path ".svg")   "image/svg+xml")
+      ((ends-with? path ".png")   "image/png")
+      ((ends-with? path ".woff2") "font/woff2")
+      ((ends-with? path ".wasm")  "application/wasm")
+      (true                       "application/octet-stream"))))
+
+;; A content-hashed filename (e.g. js_of_ocaml-651f6707.wasm, or anything under
+;; /sx/h/) is immutable; everything else gets a modest max-age (mutable bundle).
+(define host/static--cache-control
+  (fn (rel)
+    (if (ends-with? rel ".wasm")
+      "public, max-age=31536000, immutable"
+      "public, max-age=3600")))
+
+;; reject empty, absolute, or traversal paths.
+(define host/static--safe?
+  (fn (rel)
+    (and (> (len rel) 0)
+         (not (starts-with? rel "/"))
+         (not (string-contains? rel "..")))))
+
+;; Serve one asset by its path relative to the static root. file-read THROWS on a
+;; missing file, so gate on file-exists? first and return a 404 instead.
+(define host/static-serve
+  (fn (rel)
+    (if (not (host/static--safe? rel))
+      (dream-html-status 403 "Forbidden")
+      (let ((path (str host/static-root "/" rel)))
+        (if (not (file-exists? path))
+          (dream-html-status 404 "Not Found")
+          (dream-response 200
+            {:content-type (host/static--ctype rel)
+             :cache-control (host/static--cache-control rel)}
+            (file-read path)))))))
+
+;; ── content-addressed module cache (/sx/h/{hash}) ───────────────────
+;; Each web-stack .sxbc carries its content hash in its head: (sxbc 1 "HASH" ...).
+;; Index every .sxbc by that hash at startup so the client can fetch each module
+;; immutably + localStorage-cached, and never stale.
+(define host/static--sxh->path (dict))   ;; hash -> filepath
+(define host/static--file->hash (dict))  ;; "dom.sxbc" -> hash
+
+;; the embedded hash from a .sxbc head: (sxbc 1 "HASH" ...  -> "HASH"
+(define host/static--sxbc-hash
+  (fn (head) (nth (split head "\"") 1)))
+
+(define host/static-build-sxh-index!
+  (fn ()
+    (for-each
+      (fn (path)
+        (let ((h (host/static--sxbc-hash (substr (file-read path) 0 60)))
+              (base (last (split path "/"))))
+          (dict-set! host/static--sxh->path h path)
+          (dict-set! host/static--file->hash base h)))
+      (file-glob (str host/static-root "/wasm/sx/*.sxbc")))))
+
+;; GET /sx/h/{hash} -> the .sxbc content, immutable (content-addressed).
+(define host/static-sxh-serve
+  (fn (hash)
+    (let ((path (get host/static--sxh->path hash)))
+      (if (nil? path)
+        (dream-html-status 404 "Not Found")
+        (dream-response 200
+          {:content-type "text/sx; charset=utf-8"
+           :cache-control "public, max-age=31536000, immutable"}
+          (file-read path))))))
+
+;; the data-sx-manifest JSON for the shell: {"modules": {"dom.sxbc": "hash", ...}}.
+;; The client's loadBytecodeFile reads manifest.modules[file] -> hash -> /sx/h/.
+;; App components the client must eager-load (after the web stack) so their
+;; defcomps are registered before a boosted fragment references them. Loaded
+;; content-addressed via the modules map below, the same as any web-stack module.
+(define host/static--boot-modules (list "relate-picker.sxbc"))
+
+(define host/static-manifest-json
+  (fn ()
+    (str "{\"v\":1,\"boot\":["
+      (join "," (map (fn (m) (str "\"" m "\"")) host/static--boot-modules))
+      "],\"defs\":{},\"modules\":{"
+      (join ","
+        (map (fn (k) (str "\"" k "\":\"" (get host/static--file->hash k) "\""))
+          (keys host/static--file->hash)))
+      "}}")))
+
+;; Route group: GET /static/** (path) + GET /sx/h/** (content-addressed). A plain
+;; route LIST (like host/feed-routes); host/serve combines + flattens the groups.
+(define host/static-routes
+  (list
+    (dream-get "/static/**"
+      (fn (req) (host/static-serve (dream-param req "**"))))
+    (dream-get "/sx/h/**"
+      (fn (req) (host/static-sxh-serve (dream-param req "**"))))))

lib/host/sx/kg-cards.sx

@@ -0,0 +1,157 @@
+;; KG card components — Ghost/Koenig-compatible card rendering, copied into the host
+;; so it can render imported Ghost posts (sx_content holds (~kg_cards/kg-*) from the
+;; lexical_to_sx converter). Produces the same HTML structure as lexical_renderer.py.
+;;
+;; ~rich-text: the host-local dep these cards need (raw HTML injection). Defined here
+;; (it was only a test fixture before) so kg-html/kg-bookmark/etc. resolve in the host.
+(defcomp ~rich-text (&key (html :as string)) (raw! html))
+
+;; @css kg-card kg-image-card kg-width-wide kg-width-full kg-gallery-card kg-gallery-container kg-gallery-row kg-gallery-image kg-embed-card kg-bookmark-card kg-bookmark-container kg-bookmark-content kg-bookmark-title kg-bookmark-description kg-bookmark-metadata kg-bookmark-icon kg-bookmark-author kg-bookmark-publisher kg-bookmark-thumbnail kg-callout-card kg-callout-emoji kg-callout-text kg-button-card kg-btn kg-btn-accent kg-toggle-card kg-toggle-heading kg-toggle-heading-text kg-toggle-card-icon kg-toggle-content kg-audio-card kg-audio-thumbnail kg-audio-player-container kg-audio-title kg-audio-player kg-audio-play-icon kg-audio-current-time kg-audio-time kg-audio-seek-slider kg-audio-playback-rate kg-audio-unmute-icon kg-audio-volume-slider kg-video-card kg-video-container kg-file-card kg-file-card-container kg-file-card-contents kg-file-card-title kg-file-card-filesize kg-file-card-icon kg-file-card-caption kg-align-center kg-align-left kg-callout-card-grey kg-callout-card-white kg-callout-card-blue kg-callout-card-green kg-callout-card-yellow kg-callout-card-red kg-callout-card-pink kg-callout-card-purple kg-callout-card-accent kg-html-card kg-md-card placeholder
+
+;; ---------------------------------------------------------------------------
+;; Image card
+;; ---------------------------------------------------------------------------
+(defcomp ~kg_cards/kg-image (&key (src :as string) (alt :as string?) (caption :as string?) (width :as string?) (href :as string?))
+  (figure :class (str "kg-card kg-image-card"
+                   (if (= width "wide") " kg-width-wide"
+                     (if (= width "full") " kg-width-full" "")))
+    (if href
+      (a :href href (img :src src :alt (or alt "") :loading "lazy"))
+      (img :src src :alt (or alt "") :loading "lazy"))
+    (when caption (figcaption caption))))
+
+;; ---------------------------------------------------------------------------
+;; Gallery card
+;; ---------------------------------------------------------------------------
+(defcomp ~kg_cards/kg-gallery (&key (images :as list) (caption :as string?))
+  (figure :class "kg-card kg-gallery-card kg-width-wide"
+    (div :class "kg-gallery-container"
+      (map (lambda (row)
+        (div :class "kg-gallery-row"
+          (map (lambda (img-data)
+            (figure :class "kg-gallery-image"
+              (img :src (get img-data "src") :alt (or (get img-data "alt") "") :loading "lazy")
+              (when (get img-data "caption") (figcaption (get img-data "caption")))))
+            row)))
+        images))
+    (when caption (figcaption caption))))
+
+;; ---------------------------------------------------------------------------
+;; HTML card — wraps user-pasted HTML so the editor can identify the block.
+;; Content is native sx children (no longer an opaque HTML string).
+;; ---------------------------------------------------------------------------
+(defcomp ~kg_cards/kg-html (&rest children)
+  (div :class "kg-card kg-html-card" children))
+
+;; ---------------------------------------------------------------------------
+;; Markdown card — rendered markdown content, editor can identify the block.
+;; ---------------------------------------------------------------------------
+(defcomp ~kg_cards/kg-md (&rest children)
+  (div :class "kg-card kg-md-card" children))
+
+;; ---------------------------------------------------------------------------
+;; Embed card
+;; ---------------------------------------------------------------------------
+(defcomp ~kg_cards/kg-embed (&key (html :as string) (caption :as string?))
+  (figure :class "kg-card kg-embed-card"
+    (~rich-text :html html)
+    (when caption (figcaption caption))))
+
+;; ---------------------------------------------------------------------------
+;; Bookmark card
+;; ---------------------------------------------------------------------------
+(defcomp ~kg_cards/kg-bookmark (&key (url :as string) (title :as string?) (description :as string?) (icon :as string?) (author :as string?) (publisher :as string?) (thumbnail :as string?) (caption :as string?))
+  (figure :class "kg-card kg-bookmark-card"
+    (a :class "kg-bookmark-container" :href url
+      (div :class "kg-bookmark-content"
+        (div :class "kg-bookmark-title" (or title ""))
+        (div :class "kg-bookmark-description" (or description ""))
+        (when (or icon author publisher)
+          (span :class "kg-bookmark-metadata"
+            (when icon (img :class "kg-bookmark-icon" :src icon :alt ""))
+            (when author (span :class "kg-bookmark-author" author))
+            (when publisher (span :class "kg-bookmark-publisher" publisher)))))
+      (when thumbnail
+        (div :class "kg-bookmark-thumbnail"
+          (img :src thumbnail :alt ""))))
+    (when caption (figcaption caption))))
+
+;; ---------------------------------------------------------------------------
+;; Callout card
+;; ---------------------------------------------------------------------------
+(defcomp ~kg_cards/kg-callout (&key (color :as string?) (emoji :as string?) (content :as string?))
+  (div :class (str "kg-card kg-callout-card kg-callout-card-" (or color "grey"))
+    (when emoji (div :class "kg-callout-emoji" emoji))
+    (div :class "kg-callout-text" (or content ""))))
+
+;; ---------------------------------------------------------------------------
+;; Button card
+;; ---------------------------------------------------------------------------
+(defcomp ~kg_cards/kg-button (&key (url :as string) (text :as string?) (alignment :as string?))
+  (div :class (str "kg-card kg-button-card kg-align-" (or alignment "center"))
+    (a :href url :class "kg-btn kg-btn-accent" (or text ""))))
+
+;; ---------------------------------------------------------------------------
+;; Toggle card (accordion)
+;; ---------------------------------------------------------------------------
+(defcomp ~kg_cards/kg-toggle (&key (heading :as string?) (content :as string?))
+  (div :class "kg-card kg-toggle-card" :data-kg-toggle-state "close"
+    (div :class "kg-toggle-heading"
+      (h4 :class "kg-toggle-heading-text" (or heading ""))
+      (button :class "kg-toggle-card-icon"
+        (~rich-text :html "<svg viewBox=\"0 0 14 14\"><path d=\"M7 0a.5.5 0 0 1 .5.5v6h6a.5.5 0 1 1 0 1h-6v6a.5.5 0 1 1-1 0v-6h-6a.5.5 0 0 1 0-1h6v-6A.5.5 0 0 1 7 0Z\" fill=\"currentColor\"/></svg>")))
+    (div :class "kg-toggle-content" (or content ""))))
+
+;; ---------------------------------------------------------------------------
+;; Audio card
+;; ---------------------------------------------------------------------------
+(defcomp ~kg_cards/kg-audio (&key (src :as string) (title :as string?) (duration :as string?) (thumbnail :as string?))
+  (div :class "kg-card kg-audio-card"
+    (if thumbnail
+      (img :src thumbnail :alt "audio-thumbnail" :class "kg-audio-thumbnail")
+      (div :class "kg-audio-thumbnail placeholder"
+        (~rich-text :html "<svg viewBox=\"0 0 24 24\"><path d=\"M2 12C2 6.48 6.48 2 12 2s10 4.48 10 10-4.48 10-10 10S2 17.52 2 12zm7.5 5.25L16 12 9.5 6.75v10.5z\" fill=\"currentColor\"/></svg>")))
+    (div :class "kg-audio-player-container"
+      (div :class "kg-audio-title" (or title ""))
+      (div :class "kg-audio-player"
+        (button :class "kg-audio-play-icon"
+          (~rich-text :html "<svg viewBox=\"0 0 24 24\"><path d=\"M8 5v14l11-7z\" fill=\"currentColor\"/></svg>"))
+        (div :class "kg-audio-current-time" "0:00")
+        (div :class "kg-audio-time" (str "/ " (or duration "0:00")))
+        (input :type "range" :class "kg-audio-seek-slider" :max "100" :value "0")
+        (button :class "kg-audio-playback-rate" "1×")
+        (button :class "kg-audio-unmute-icon"
+          (~rich-text :html "<svg viewBox=\"0 0 24 24\"><path d=\"M3 9v6h4l5 5V4L7 9H3zm13.5 3c0-1.77-1.02-3.29-2.5-4.03v8.05c1.48-.73 2.5-2.25 2.5-4.02zM14 3.23v2.06c2.89.86 5 3.54 5 6.71s-2.11 5.85-5 6.71v2.06c4.01-.91 7-4.49 7-8.77s-2.99-7.86-7-8.77z\" fill=\"currentColor\"/></svg>"))
+        (input :type "range" :class "kg-audio-volume-slider" :max "100" :value "100")))
+    (audio :src src :preload "metadata")))
+
+;; ---------------------------------------------------------------------------
+;; Video card
+;; ---------------------------------------------------------------------------
+(defcomp ~kg_cards/kg-video (&key (src :as string) (caption :as string?) (width :as string?) (thumbnail :as string?) (loop :as boolean?))
+  (figure :class (str "kg-card kg-video-card"
+                   (if (= width "wide") " kg-width-wide"
+                     (if (= width "full") " kg-width-full" "")))
+    (div :class "kg-video-container"
+      (video :src src :controls true :preload "metadata"
+        :poster (or thumbnail nil) :loop (or loop nil)))
+    (when caption (figcaption caption))))
+
+;; ---------------------------------------------------------------------------
+;; File card
+;; ---------------------------------------------------------------------------
+(defcomp ~kg_cards/kg-file (&key (src :as string) (filename :as string?) (title :as string?) (filesize :as string?) (caption :as string?))
+  (div :class "kg-card kg-file-card"
+    (a :class "kg-file-card-container" :href src :download (or filename "")
+      (div :class "kg-file-card-contents"
+        (div :class "kg-file-card-title" (or title filename ""))
+        (when filesize (div :class "kg-file-card-filesize" filesize)))
+      (div :class "kg-file-card-icon"
+        (~rich-text :html "<svg viewBox=\"0 0 24 24\"><path d=\"M19 9h-4V3H9v6H5l7 7 7-7zM5 18v2h14v-2H5z\" fill=\"currentColor\"/></svg>")))
+    (when caption (div :class "kg-file-card-caption" caption))))
+
+;; ---------------------------------------------------------------------------
+;; Paywall marker
+;; ---------------------------------------------------------------------------
+(defcomp ~kg_cards/kg-paywall ()
+  (~rich-text :html "<!--members-only-->"))

lib/host/sx/relate-picker.sx

@@ -0,0 +1,39 @@
+;; lib/host/sx/relate-picker.sx — the relate picker as a reusable, content-addressed
+;; SX component. On a FULL load render-page expands it server-side (SEO / no-JS); on a
+;; boosted SPA nav the edit body is serialized as `(~relate-picker :slug … :kind …)`
+;; and the CLIENT expands it — the component module is loaded content-addressed via
+;; the data-sx-manifest at boot, so its defcomp is registered before any fragment
+;; referencing it arrives.
+;;
+;; Pure markup, no client JS: the form GETs /<slug>/relate-options serialising kind +
+;; the filter q (a FORM is serialised on GET, a bare input is not), innerHTML-swapping
+;; the results <ul> on "load" and on a debounced "input". Paging is server-driven —
+;; each full page carries a "load more" sentinel (sx-trigger revealed) the endpoint
+;; emits. sx-retry makes a dropped/offline fetch self-heal; the engine's .sx-error
+;; class (styled by the host shell) surfaces a stuck retry. The engine re-binds these
+;; triggers on swapped-in content, so it works on full load AND boosted nav.
+(defcomp
+  ~relate-picker
+  (&key slug kind)
+  (form
+    :class "relate-picker"
+    :data-slug slug
+    :data-kind kind
+    :sx-get (str "/" slug "/relate-options")
+    :sx-trigger "input delay:200ms, load"
+    :sx-target (str "#rp-" kind "-results")
+    :sx-swap "innerHTML"
+    :sx-retry "exponential:1000:30000"
+    :style "margin:0"
+    (input :type "hidden" :name "kind" :value kind)
+    (input
+      :type "text"
+      :name "q"
+      :class "rp-filter"
+      :placeholder "filter…"
+      :autocomplete "off"
+      :style "width:100%;padding:0.4em;box-sizing:border-box")
+    (ul
+      :id (str "rp-" kind "-results")
+      :class "rp-results"
+      :style "list-style:none;padding:0;margin:0.5em 0;border:1px solid #ddd")))

lib/host/sxtp.sx

@@ -0,0 +1,224 @@
+;; lib/host/sxtp.sx — SXTP, the host<->subsystem wire format. SXTP messages are
+;; SX s-expressions (content-type text/sx): a request/response/condition/event is
+;; a tagged list `(request :verb navigate :path "/x" ...)`. See the protocol spec
+;; at applications/sxtp/spec.sx.
+;;
+;; Representation: internally a message is a plain dict tagged by :msg ("request"
+;; /"response"/"condition"/"event"/"patch"/"signals"), with string keys so the
+;; keyword==string rule makes construction and access trivial. verb/status/type/
+;; mode are stored as SYMBOLS (they ride the wire bare, not quoted). The wire
+;; LIST form is produced/consumed only at the serialise/parse boundary:
+;;   sxtp/serialize : msg-dict -> text/sx string
+;;   sxtp/parse     : text/sx string -> msg-dict
+;; A Dream HTTP request/response bridges to/from SXTP via sxtp/from-dream and
+;; sxtp/to-dream, so the host can speak SXTP to subsystems while serving HTTP.
+;; Depends on lib/dream/types.sx (dream-response + request/response accessors).
+
+;; ── helpers ────────────────────────────────────────────────────────
+(define sxtp/-sym
+  (fn (x) (if (= (type-of x) "symbol") x (string->symbol x))))
+(define sxtp/-name
+  (fn (x) (if (= (type-of x) "symbol") (symbol->string x) x)))
+
+;; ── constructors ───────────────────────────────────────────────────
+;; opts is a dict of optional fields (e.g. {:headers .. :params .. :body ..}).
+(define sxtp/request
+  (fn (verb path opts)
+    (merge {:msg "request" :verb (sxtp/-sym verb) :path path} opts)))
+(define sxtp/response
+  (fn (status opts)
+    (merge {:msg "response" :status (sxtp/-sym status)} opts)))
+(define sxtp/condition
+  (fn (ctype opts)
+    (merge {:msg "condition" :type (sxtp/-sym ctype)} opts)))
+(define sxtp/event
+  (fn (etype opts)
+    (merge {:msg "event" :type (sxtp/-sym etype)} opts)))
+
+;; Patch (Datastar-borrowed) — DOM fragment morph.
+;; target: CSS selector (required). mode in opts defaults to outer; accepts
+;; string OR symbol and is normalised. mode values: outer | inner | replace |
+;; prepend | append | before | after | remove. body: SX subtree (omit for remove).
+(define sxtp/patch
+  (fn (target opts)
+    (let ((mode (or (get opts :mode) "outer")))
+      (merge opts {:msg "patch" :target target :mode (sxtp/-sym mode)}))))
+
+;; Signals (Datastar-borrowed) — reactive state patch.
+;; values: dict of signal-name -> new-value (nil removes). only-if-missing: bool.
+(define sxtp/signals
+  (fn (values opts)
+    (merge {:msg "signals" :values values} opts)))
+
+;; ── predicates ─────────────────────────────────────────────────────
+(define sxtp/-is?
+  (fn (m tag) (and (= (type-of m) "dict") (= (get m :msg) tag))))
+(define sxtp/request? (fn (m) (sxtp/-is? m "request")))
+(define sxtp/response? (fn (m) (sxtp/-is? m "response")))
+(define sxtp/condition? (fn (m) (sxtp/-is? m "condition")))
+(define sxtp/event? (fn (m) (sxtp/-is? m "event")))
+(define sxtp/patch? (fn (m) (sxtp/-is? m "patch")))
+(define sxtp/signals? (fn (m) (sxtp/-is? m "signals")))
+
+;; ── accessors ──────────────────────────────────────────────────────
+(define sxtp/verb (fn (m) (get m :verb)))
+(define sxtp/path (fn (m) (get m :path)))
+(define sxtp/req-headers (fn (m) (get m :headers)))
+(define sxtp/params (fn (m) (get m :params)))
+(define sxtp/param (fn (m name) (get (get m :params) name)))
+(define sxtp/body (fn (m) (get m :body)))
+(define sxtp/capabilities (fn (m) (get m :capabilities)))
+(define sxtp/status (fn (m) (get m :status)))
+(define sxtp/resp-headers (fn (m) (get m :headers)))
+(define sxtp/stream? (fn (m) (= (get m :stream) true)))
+(define sxtp/cond-type (fn (m) (get m :type)))
+(define sxtp/cond-message (fn (m) (get m :message)))
+(define sxtp/target (fn (m) (get m :target)))
+(define sxtp/mode (fn (m) (get m :mode)))
+(define sxtp/values (fn (m) (get m :values)))
+(define sxtp/only-if-missing? (fn (m) (= (get m :only-if-missing) true)))
+(define sxtp/transition? (fn (m) (= (get m :transition) true)))
+
+;; ── status helpers (build responses) ───────────────────────────────
+(define sxtp/ok (fn (body) (sxtp/response "ok" {:body body})))
+(define sxtp/created (fn (body) (sxtp/response "created" {:body body})))
+(define sxtp/no-content (fn () (sxtp/response "no-content" {})))
+(define sxtp/not-found
+  (fn (path message)
+    (sxtp/response "not-found"
+      {:body (sxtp/condition "resource-not-found"
+               {:path path :message message :retry false})})))
+(define sxtp/forbidden
+  (fn (message)
+    (sxtp/response "forbidden"
+      {:body (sxtp/condition "forbidden" {:message message})})))
+(define sxtp/invalid
+  (fn (message)
+    (sxtp/response "invalid"
+      {:body (sxtp/condition "invalid" {:message message})})))
+(define sxtp/fail
+  (fn (message)
+    (sxtp/response "error"
+      {:body (sxtp/condition "error" {:message message})})))
+
+;; ── HTTP <-> SXTP mappings ─────────────────────────────────────────
+(define sxtp/-method-verbs
+  {:GET "fetch" :HEAD "fetch" :POST "create"
+   :PUT "mutate" :PATCH "mutate" :DELETE "delete" :OPTIONS "inspect"})
+(define sxtp/verb-for-method
+  (fn (method) (sxtp/-sym (get sxtp/-method-verbs (upper method) "fetch"))))
+
+(define sxtp/-status-http
+  {:ok 200 :created 201 :accepted 202 :no-content 204 :redirect 302
+   :not-modified 304 :error 500 :not-found 404 :forbidden 403
+   :invalid 400 :conflict 409 :unavailable 503})
+(define sxtp/http-status
+  (fn (status) (get sxtp/-status-http (sxtp/-name status) 200)))
+
+;; ── Dream bridge ───────────────────────────────────────────────────
+;; HTTP request -> SXTP request: method->verb, query->params, headers/body carry.
+(define sxtp/from-dream
+  (fn (req)
+    (sxtp/request
+      (sxtp/verb-for-method (get req :method))
+      (get req :path)
+      {:headers (get req :headers)
+       :params (get req :query)
+       :body (get req :body)})))
+
+;; SXTP response -> HTTP response: status->code, body serialised to text/sx.
+(define sxtp/-body-text
+  (fn (b) (if (nil? b) "" (serialize b))))
+(define sxtp/to-dream
+  (fn (resp)
+    (dream-response
+      (sxtp/http-status (sxtp/status resp))
+      (merge {:content-type "text/sx"} (or (sxtp/resp-headers resp) {}))
+      (sxtp/-body-text (sxtp/body resp)))))
+
+;; ── wire serialise (msg-dict -> text/sx) ───────────────────────────
+;; Top-level field order is fixed per message type so output is deterministic;
+;; nested dict/value order follows the serialize primitive.
+(define sxtp/-field-order
+  {:request (list :verb :path :headers :cookies :params :capabilities :body)
+   :response (list :status :headers :set-cookie :body :stream)
+   :condition (list :type :message :path :retry :detail)
+   :event (list :type :id :body :time)
+   :patch (list :target :mode :body :transition)
+   :signals (list :values :only-if-missing)})
+;; A nested SXTP message (a condition/event in a :body) serialises in its own
+;; list form; plain data values go through the serialize primitive.
+(define sxtp/-emit-value
+  (fn (v)
+    (if (and (= (type-of v) "dict") (has-key? v :msg))
+      (sxtp/serialize v)
+      (serialize v))))
+(define sxtp/serialize
+  (fn (msg)
+    (let ((head (get msg :msg)))
+      (let ((order (get sxtp/-field-order head)))
+        (str "("
+          head
+          (reduce
+            (fn (acc k)
+              (if (has-key? msg k)
+                (str acc " :" k " " (sxtp/-emit-value (get msg k)))
+                acc))
+            ""
+            order)
+          ")")))))
+
+;; ── wire parse (text/sx -> msg-dict) ───────────────────────────────
+;; parse yields a list with keyword-token keys and possibly keyword-token dict
+;; keys; sxtp/-normalize deep-converts those tokens to strings so the result is
+;; the same string-keyed shape the constructors produce.
+(define sxtp/-normalize
+  (fn (v)
+    (let ((t (type-of v)))
+      (cond
+        ((= t "keyword") (str v))
+        ((= t "dict")
+          (reduce
+            (fn (acc k) (assoc acc (str k) (sxtp/-normalize (get v k))))
+            {}
+            (keys v)))
+        ((= t "list") (map sxtp/-normalize v))
+        (true v)))))
+(define sxtp/-pairs->dict
+  (fn (kvs acc)
+    (if (< (len kvs) 2)
+      acc
+      (sxtp/-pairs->dict
+        (rest (rest kvs))
+        (assoc acc (str (first kvs)) (sxtp/-normalize (first (rest kvs))))))))
+(define sxtp/parse
+  (fn (text)
+    (let ((lst (parse text)))
+      (sxtp/-pairs->dict (rest lst) {:msg (symbol->string (first lst))}))))
+
+;; ── host write-body: a request's text/sx body -> string-keyed dict ──
+;; The write-side counterpart to host/sx-status: the SX engine posts text/sx for
+;; writes (boosted forms serialise their fields), so write handlers read the body
+;; through this instead of dream-json-body. parse-safe yields keyword-token keys;
+;; sxtp/-normalize deep-converts them to strings so (get p :field) works — the same
+;; shape dream-json-body produced from JSON. Empty / blank / non-dict / unparseable
+;; body -> nil (handlers then return 400).
+(define host/sx-body
+  (fn (req)
+    (let ((raw (dream-body req)))
+      (if (or (nil? raw) (= raw ""))
+        nil
+        (let ((v (parse-safe raw)))
+          (if (= (type-of v) "dict") (sxtp/-normalize v) nil))))))
+
+;; ── unified write-field reader: text/sx body OR urlencoded form ─────
+;; A boosted form posts text/sx (the SX engine serialises its fields); a no-engine
+;; / pre-hydration submit (and the login bootstrap) posts urlencoded. Content-type
+;; decides. host/fields returns ALL fields as one string-keyed dict; host/field
+;; reads one by name. Form handlers read through these so both encodings work.
+(define host/fields
+  (fn (req)
+    (if (contains? (or (dream-content-type-of req) "") "text/sx")
+      (or (host/sx-body req) {})
+      (or (dream-form-fields req) {}))))
+(define host/field (fn (req name) (get (host/fields req) name)))

lib/host/tests/blog.sx

@@ -0,0 +1,805 @@
+;; lib/host/tests/blog.sx — blog on the editor's content model. Posts are
+;; {slug,title,sx_content,status} records in the durable KV; a post page is
+;; render-to-html(parse sx_content). Covers read/render, home index, JSON list,
+;; slugify, the form-urlencoded editor ingest, and JSON CRUD (auth+ACL guarded).
+
+(define host-bl-pass 0)
+(define host-bl-fail 0)
+(define host-bl-fails (list))
+(define
+  host-bl-test
+  (fn (name actual expected)
+    (if (= actual expected)
+      (set! host-bl-pass (+ host-bl-pass 1))
+      (begin
+        (set! host-bl-fail (+ host-bl-fail 1))
+        (append! host-bl-fails {:name name :actual actual :expected expected})))))
+
+(define host-bl-req (fn (target) (dream-request "GET" target {} "")))
+(define host-bl-app (host/make-app (list host/feed-routes host/blog-routes)))
+
+;; ── slugify ─────────────────────────────────────────────────────────
+(host-bl-test "slugify" (host/blog-slugify "Hello World") "hello-world")
+(host-bl-test "slugify trims spaces" (host/blog-slugify "  A  B ") "a-b")
+
+;; ── render a stored post ────────────────────────────────────────────
+(host/blog-use-store! (persist/open))
+(host/blog-put! "hello" "Hello World"
+  "(article (h1 \"Hello World\") (p \"A \" (strong \"bold\") \" word.\"))" "published")
+
+(host-bl-test "post 200" (dream-status (host-bl-app (host-bl-req "/hello/"))) 200)
+(host-bl-test "post content-type html"
+  (contains? (dream-resp-header (host-bl-app (host-bl-req "/hello/")) "content-type") "text/html")
+  true)
+(host-bl-test "post renders sx_content markup"
+  (contains? (dream-resp-body (host-bl-app (host-bl-req "/hello/"))) "<strong>bold</strong>")
+  true)
+(host-bl-test "post title in page"
+  (contains? (dream-resp-body (host-bl-app (host-bl-req "/hello/"))) "<title>Hello World</title>")
+  true)
+
+;; ── home + list ─────────────────────────────────────────────────────
+(host-bl-test "home lists post"
+  (contains? (dream-resp-body (host-bl-app (host-bl-req "/"))) "href=\"/hello/\"")
+  true)
+(host-bl-test "sx list shows post"
+  (contains? (dream-resp-body (host-bl-app (host-bl-req "/posts"))) ":slug \"hello\"")
+  true)
+(host-bl-test "GET /new shows form"
+  (contains? (dream-resp-body (host-bl-app (host-bl-req "/new"))) "<form")
+  true)
+
+;; ── unknown + precedence ────────────────────────────────────────────
+(host-bl-test "unknown slug 404" (dream-status (host-bl-app (host-bl-req "/nope/"))) 404)
+(feed/reset!)
+(host-bl-test "/feed not captured by :slug"
+  (contains? (dream-resp-body (host-bl-app (host-bl-req "/feed"))) ":ok true")
+  true)
+
+;; ── writes: editor form ingest + JSON CRUD (auth+ACL) ───────────────
+(acl/load! (list (acl-grant "editor" "edit" "blog")))
+(define host-bl-resolve
+  (fn (tok) (cond ((= tok "good") "editor") ((= tok "weak") "reader") (true nil))))
+(define host-bl-wapp
+  (host/make-app (list (host/blog-write-routes host-bl-resolve) host/blog-routes)))
+(define host-bl-send
+  (fn (method target auth ctype body)
+    (dream-request method target
+      (merge (if auth {:authorization auth} {}) (if ctype {:content-type ctype} {})) body)))
+
+(host/blog-use-store! (persist/open))
+
+;; -- editor form ingest (form-urlencoded, the editor's submit shape) --
+(host-bl-test "form ingest no auth -> redirect to login"
+  (dream-status (host-bl-wapp (host-bl-send "POST" "/new" nil
+    "application/x-www-form-urlencoded" "title=X")))
+  303)
+(host-bl-test "form ingest no auth Location is /login"
+  (contains? (dream-resp-header (host-bl-wapp (host-bl-send "POST" "/new" nil
+    "application/x-www-form-urlencoded" "title=X")) "location") "/login")
+  true)
+(host-bl-test "form ingest authed -> 303 redirect"
+  (dream-status (host-bl-wapp (host-bl-send "POST" "/new" "Bearer good"
+    "application/x-www-form-urlencoded"
+    "title=My+First+Post&sx_content=(article+(h1+%22My+First+Post%22)+(p+%22Hi%22))&status=published")))
+  303)
+(host-bl-test "form ingest set Location to the new slug"
+  (dream-resp-header
+    (host-bl-wapp (host-bl-send "POST" "/new" "Bearer good"
+      "application/x-www-form-urlencoded"
+      "title=Another+One&sx_content=(p+%22x%22)&status=published"))
+    "location")
+  "/another-one/")
+(host-bl-test "ingested post renders"
+  (contains? (dream-resp-body (host-bl-wapp (host-bl-req "/my-first-post/"))) "<h1>My First Post</h1>")
+  true)
+
+;; (JSON CRUD tests removed — the /posts JSON create/update/delete endpoints were
+;; deleted in the SX-native pivot; create + edit go through the form ingest above.)
+
+;; -- write-time validation: malformed sx_content rejected, never stored --
+;; "%3Ch1+broken%29" decodes to "<h1 broken)" — a typo'd paren the parser rejects.
+(host-bl-test "form ingest malformed sx_content -> 400"
+  (dream-status (host-bl-wapp (host-bl-send "POST" "/new" "Bearer good"
+    "application/x-www-form-urlencoded"
+    "title=Bad+Form&sx_content=%3Ch1+broken%29&status=published")))
+  400)
+(host-bl-test "rejected form post was not stored"
+  (dream-status (host-bl-wapp (host-bl-req "/bad-form/")))
+  404)
+;; (JSON malformed-content tests removed with the JSON CRUD endpoints; the form
+;; ingest malformed-content checks above still cover write-time validation.)
+
+;; -- view source (public) --
+(host-bl-test "view source -> 200"
+  (dream-status (host-bl-wapp (host-bl-req "/my-first-post/source"))) 200)
+(host-bl-test "view source is text/plain"
+  (dream-resp-header (host-bl-wapp (host-bl-req "/my-first-post/source")) "content-type")
+  "text/plain; charset=utf-8")
+(host-bl-test "view source returns raw sx_content"
+  (contains? (dream-resp-body (host-bl-wapp (host-bl-req "/my-first-post/source"))) "(article")
+  true)
+(host-bl-test "view source missing -> 404"
+  (dream-status (host-bl-wapp (host-bl-req "/ghost/source"))) 404)
+(host-bl-test "/:slug not shadowed by /:slug/source"
+  (dream-status (host-bl-wapp (host-bl-req "/my-first-post/"))) 200)
+
+;; -- edit source (guarded GET form + guarded POST save) --
+(host-bl-test "edit form no auth -> redirect to login"
+  (dream-status (host-bl-wapp (host-bl-send "GET" "/my-first-post/edit" nil "" ""))) 303)
+(host-bl-test "edit form no auth Location carries next=/…/edit"
+  (contains?
+    (dream-resp-header (host-bl-wapp (host-bl-send "GET" "/my-first-post/edit" nil "" "")) "location")
+    "/login?next=/my-first-post/edit")
+  true)
+(host-bl-test "edit form authed -> 200"
+  (dream-status (host-bl-wapp (host-bl-send "GET" "/my-first-post/edit" "Bearer good" "" ""))) 200)
+(host-bl-test "edit form shows current source"
+  (contains? (dream-resp-body (host-bl-wapp (host-bl-send "GET" "/my-first-post/edit" "Bearer good" "" "")))
+    "(article")
+  true)
+(host-bl-test "edit submit no auth -> redirect to login"
+  (dream-status (host-bl-wapp (host-bl-send "POST" "/my-first-post/edit" nil
+    "application/x-www-form-urlencoded" "sx_content=(p+%22x%22)"))) 303)
+(host-bl-test "edit submit authed -> 303"
+  (dream-status (host-bl-wapp (host-bl-send "POST" "/my-first-post/edit" "Bearer good"
+    "application/x-www-form-urlencoded"
+    "title=My+First+Post&sx_content=(p+%22edited+via+editor%22)&status=published"))) 303)
+(host-bl-test "edit persisted the new content"
+  (contains? (dream-resp-body (host-bl-wapp (host-bl-req "/my-first-post/"))) "edited via editor")
+  true)
+(host-bl-test "edit preserves the slug"
+  (dream-resp-header
+    (host-bl-wapp (host-bl-send "POST" "/my-first-post/edit" "Bearer good"
+      "application/x-www-form-urlencoded" "title=Renamed&sx_content=(p+%22y%22)&status=draft"))
+    "location")
+  "/my-first-post/")
+(host-bl-test "edit malformed body -> 400"
+  (dream-status (host-bl-wapp (host-bl-send "POST" "/my-first-post/edit" "Bearer good"
+    "application/x-www-form-urlencoded" "sx_content=%3Ch1+broken%29"))) 400)
+(host-bl-test "edit missing post -> 404"
+  (dream-status (host-bl-wapp (host-bl-send "GET" "/ghost/edit" "Bearer good" "" ""))) 404)
+
+;; -- auth footer (discoverable login/logout) --
+(host-bl-test "home footer shows a log in link when anonymous"
+  (contains? (dream-resp-body (host-bl-app (host-bl-req "/"))) ">log in</a>") true)
+(host-bl-test "post footer shows a log in link when anonymous"
+  (contains? (dream-resp-body (host-bl-app (host-bl-req "/my-first-post/"))) ">log in</a>") true)
+(host-bl-test "GET /logout -> 303"
+  (dream-status (host-bl-app (host-bl-req "/logout"))) 303)
+
+;; -- relate posts (blog × relations) --
+;; my-first-post and another-one both exist in the write-test store at this point.
+;; Relations are posts now (their symmetry/labels live on relation-posts), so seed
+;; them up front exactly as boot does (serve.sh) before exercising relate, and load
+;; the relation metadata into the in-memory cache the same way.
+(host/blog-seed-types!)
+(host/blog-load-rel-kinds!)
+(host-bl-test "relate no auth -> redirect to login"
+  (dream-status (host-bl-wapp (host-bl-send "POST" "/my-first-post/relate" nil
+    "application/x-www-form-urlencoded" "other=another-one"))) 303)
+(host-bl-test "relate authed -> 303 back to edit"
+  (dream-resp-header (host-bl-wapp (host-bl-send "POST" "/my-first-post/relate" "Bearer good"
+    "application/x-www-form-urlencoded" "other=another-one")) "location")
+  "/my-first-post/edit")
+(host-bl-test "related is symmetric (a -> b)"
+  (contains? (host/blog-related "my-first-post") "another-one") true)
+(host-bl-test "related is symmetric (b -> a)"
+  (contains? (host/blog-related "another-one") "my-first-post") true)
+(host-bl-test "post page shows a Related posts block"
+  (contains? (dream-resp-body (host-bl-wapp (host-bl-req "/my-first-post/"))) "Related posts") true)
+(host-bl-test "post page links the related post"
+  (contains? (dream-resp-body (host-bl-wapp (host-bl-req "/my-first-post/"))) "/another-one/") true)
+(host-bl-test "relate nonexistent other -> no-op"
+  (begin
+    (host-bl-wapp (host-bl-send "POST" "/my-first-post/relate" "Bearer good"
+      "application/x-www-form-urlencoded" "other=ghost-post"))
+    (contains? (host/blog-related "my-first-post") "ghost-post"))
+  false)
+(host-bl-test "unrelate -> removes the link both ways"
+  (begin
+    (host-bl-wapp (host-bl-send "POST" "/my-first-post/unrelate" "Bearer good"
+      "application/x-www-form-urlencoded" "other=another-one"))
+    (list (contains? (host/blog-related "my-first-post") "another-one")
+          (contains? (host/blog-related "another-one") "my-first-post")))
+  (list false false))
+;; (The "delete cleans up related edges" test was removed with the JSON DELETE
+;; /posts endpoint; cascade edge cleanup returns when a browser delete route is
+;; added — see the FOLLOW-UP note in lib/host/blog.sx.)
+
+;; -- relate picker (filterable candidate endpoint + glue + hint) --
+(host/blog-put! "alpha-post" "Alpha Post" "(p \"a\")" "published")
+(host/blog-put! "beta-post" "Beta Post" "(p \"b\")" "published")
+(host/blog-put! "gamma-post" "Gamma Post" "(p \"g\")" "published")
+(host-bl-test "relate-options lists other posts"
+  (contains? (dream-resp-body (host-bl-app (host-bl-req "/alpha-post/relate-options"))) "Beta Post") true)
+(host-bl-test "relate-options excludes the post itself"
+  (contains? (dream-resp-body (host-bl-app (host-bl-req "/alpha-post/relate-options"))) ">Alpha Post<") false)
+(host-bl-test "relate-options filters by q (title substring)"
+  (let ((body (dream-resp-body (host-bl-app (host-bl-req "/alpha-post/relate-options?q=beta")))))
+    (list (contains? body "Beta Post") (contains? body "Gamma Post")))
+  (list true false))
+(host-bl-test "relate-options filter url-decodes q (spaces)"
+  (let ((body (dream-resp-body (host-bl-app (host-bl-req "/alpha-post/relate-options?q=Beta%20Post")))))
+    (list (contains? body "Beta Post") (contains? body "Gamma Post")))
+  (list true false))
+(host-bl-test "relate-options excludes already-related candidates"
+  (begin
+    (host/blog-relate! "alpha-post" "beta-post" "related")
+    (contains? (dream-resp-body (host-bl-app (host-bl-req "/alpha-post/relate-options"))) "Beta Post"))
+  false)
+(host/blog-unrelate! "alpha-post" "beta-post" "related")
+;; The picker is a declarative SX-htmx form (no client JS): the form GETs
+;; relate-options serialising kind + the filter q, swapping the results ul on
+;; "load" and on debounced "input". The SX engine re-binds these triggers on
+;; swapped content, so it works on a full load AND a boosted SPA nav.
+(host-bl-test "picker form is declaratively wired to relate-options (load + debounced input)"
+  (let ((html (render-page (host/blog--relation-editor "alpha-post" "related" true))))
+    (list (contains? html "/alpha-post/relate-options")
+          (contains? html "input delay:200ms, load")
+          (contains? html "rp-related-results")))
+  (list true true true))
+;; the editor server-renders the first page of candidates INTO the picker's results
+;; <ul>, so a re-rendered editor is never briefly empty (no flash). The candidate row
+;; for an existing post appears inside the results ul.
+(host-bl-test "editor server-renders the first page of candidates into the picker"
+  (let ((html (render-page (host/blog--relation-editor "alpha-post" "related" true))))
+    (list (contains? html "id=\"cand-related-")          ;; a candidate row is present
+          (contains? html "Beta Post")))                 ;; an unrelated post is offered
+  (list true true))
+;; Paging is server-driven: a full page carries a "load more" sentinel that, when
+;; revealed, GETs the next page and replaces itself (outerHTML), preserving q.
+(host-bl-test "load-more sentinel: revealed, outerHTML-swap, next offset, preserved q"
+  (let ((html (render-page (host/blog--picker-more "alpha-post" "related" "my q" 20))))
+    (list (contains? html "rp-more")
+          (contains? html "revealed")
+          (contains? html "outerHTML")
+          (contains? html "offset=20")
+          (contains? html "q=my%20q")
+          (contains? html "exponential:1000:30000")))   ;; retries a dropped fetch
+  (list true true true true true true))
+(host-bl-test "relate-options omits the load-more sentinel on a short last page"
+  (contains? (dream-resp-body (host-bl-app (host-bl-req "/alpha-post/relate-options"))) "rp-more")
+  false)
+
+;; -- relate / unrelate keep BOTH lists in sync by re-rendering the kind's editor.
+;;    Regressions: (1) relating a candidate must ADD it to the current-relations
+;;    list (not just delete the candidate row); (2) removing must NOT clear the
+;;    relate picker. Both the candidate's relate form and the remove form target
+;;    #rel-editor-KIND with sx-swap=outerHTML; the handler returns the re-rendered
+;;    editor, so the current list updates and the fresh picker re-loads. --
+(host/blog-relate! "alpha-post" "beta-post" "related")
+;; the editor wraps current list + picker in #rel-editor-KIND; remove re-renders it
+(host-bl-test "relation-editor wires remove to re-render the kind's editor"
+  (let ((html (render-page (host/blog--relation-editor "alpha-post" "related" true))))
+    (list (contains? html "id=\"rel-editor-related\"")           ;; the swap target
+          (contains? html "sx-post=\"/alpha-post/unrelate\"")    ;; AJAX, not plain post
+          (contains? html "sx-target=\"#rel-editor-related\"")
+          (contains? html "sx-swap=\"outerHTML\"")))
+  (list true true true true))
+;; the candidate's relate form targets the SAME editor (so relating re-renders it)
+(host-bl-test "picker candidate relate form re-renders the kind's editor"
+  (let ((html (render-page (host/blog--picker-item "alpha-post" {:slug "gamma-post" :title "Gamma"} "related"))))
+    (list (contains? html "sx-post=\"/alpha-post/relate\"")
+          (contains? html "sx-target=\"#rel-editor-related\"")
+          (contains? html "sx-swap=\"outerHTML\"")))
+  (list true true true))
+;; a POST request to a /:slug/… route, with the :slug route param populated (which
+;; the route matcher would set) plus headers + a form body.
+(define host-bl-relreq
+  (fn (slug action headers other kind)
+    (merge (dream-request "POST" (str "/" slug "/" action) headers
+             (str "other=" other "&kind=" kind))
+           {:params {:slug slug}})))
+;; the AJAX remove (carries SX-Target) returns the re-rendered editor fragment (200,
+;; with the #rel-editor wrapper + the picker) — not an empty body or a redirect.
+(host-bl-test "unrelate (AJAX, SX-Target) returns the re-rendered editor fragment"
+  (let ((resp (host/blog-unrelate-submit
+                (host-bl-relreq "alpha-post" "unrelate"
+                  {:sx-request "true" :sx-target "#rel-editor-related"}
+                  "beta-post" "related"))))
+    (list (dream-status resp)
+          (contains? (dream-resp-body resp) "rel-editor-related")
+          (contains? (dream-resp-body resp) "relate-picker")))
+  (list 200 true true))
+;; relate (AJAX, SX-Target) likewise returns the editor with the new relation listed
+(host/blog-unrelate! "alpha-post" "gamma-post" "related")    ;; clean state
+(host-bl-test "relate (AJAX, SX-Target) returns the editor showing the new relation"
+  (let ((resp (host/blog-relate-submit
+                (host-bl-relreq "alpha-post" "relate"
+                  {:sx-request "true" :sx-target "#rel-editor-related"}
+                  "gamma-post" "related"))))
+    (list (dream-status resp)
+          (contains? (dream-resp-body resp) "/gamma-post/")))   ;; now in the current list
+  (list 200 true))
+(host/blog-unrelate! "alpha-post" "gamma-post" "related")
+;; a plain boosted form / no-JS POST (no SX-Target) still redirects + re-renders,
+;; so the is-a-tag toggle and graceful degradation are unaffected.
+(host-bl-test "unrelate (plain boosted / no-JS, no SX-Target) still redirects"
+  (dream-status (host/blog-unrelate-submit
+                  (host-bl-relreq "alpha-post" "unrelate"
+                    {:sx-request "true"} "beta-post" "related")))
+  303)
+(host/blog-unrelate! "alpha-post" "beta-post" "related")
+(host/blog-put! "hint-post" "Hint Post" "(p \"h\")" "published")
+(host-bl-test "relations section: hint when logged-in + no relations"
+  (contains? (str (host/blog--relations-or-hint "hint-post" true)) "add some") true)
+(host-bl-test "relations section: empty when anonymous + no relations"
+  (= (host/blog--relations-or-hint "hint-post" false) "") true)
+
+;; -- Phase 1: relations carry a kind --
+(host-bl-test "symmetric kind (related) reads from both sides"
+  (begin
+    (host/blog-relate! "alpha-post" "gamma-post" "related")
+    (list (contains? (host/blog-out "alpha-post" "related") "gamma-post")
+          (contains? (host/blog-out "gamma-post" "related") "alpha-post")))
+  (list true true))
+(host-bl-test "directed kind (tagged) writes one direction; inverse via host/blog-in"
+  (begin
+    (host/blog-relate! "alpha-post" "beta-post" "tagged")
+    (list (contains? (host/blog-out "alpha-post" "tagged") "beta-post")
+          (contains? (host/blog-out "beta-post" "tagged") "alpha-post")
+          (contains? (host/blog-in "beta-post" "tagged") "alpha-post")))
+  (list true false true))
+(host-bl-test "unrelate is kind-scoped (related edge survives a tagged unrelate)"
+  (begin
+    (host/blog-unrelate! "alpha-post" "beta-post" "tagged")
+    (list (contains? (host/blog-out "alpha-post" "tagged") "beta-post")
+          (contains? (host/blog-out "alpha-post" "related") "gamma-post")))
+  (list false true))
+(host/blog-unrelate! "alpha-post" "gamma-post" "related")
+(host-bl-test "relate-submit rejects an unknown kind (no-op)"
+  (begin
+    (host-bl-wapp (host-bl-send "POST" "/alpha-post/relate" "Bearer good"
+      "application/x-www-form-urlencoded" "other=beta-post&kind=bogus"))
+    (contains? (host/blog-out "alpha-post" "bogus") "beta-post"))
+  false)
+(host-bl-test "default kind is related (no kind field)"
+  (begin
+    (host-bl-wapp (host-bl-send "POST" "/alpha-post/relate" "Bearer good"
+      "application/x-www-form-urlencoded" "other=beta-post"))
+    (contains? (host/blog-out "alpha-post" "related") "beta-post"))
+  true)
+(host-bl-test "edges are durable: KV row written on relate"
+  (begin
+    (host/blog-relate! "alpha-post" "gamma-post" "tagged")
+    (persist/backend-kv-has? host/blog-store (host/blog--edge-key "alpha-post" "tagged" "gamma-post")))
+  true)
+(host-bl-test "replay rebuilds the graph after an in-memory wipe (restart sim)"
+  (begin
+    (relations/load! (list))                          ;; simulate a fresh process
+    (host/blog-load-edges!)                            ;; replay from the durable store
+    (list (contains? (host/blog-out "alpha-post" "tagged") "gamma-post")
+          (contains? (host/blog-out "alpha-post" "related") "beta-post")
+          (contains? (host/blog-out "beta-post" "related") "alpha-post")))
+  (list true true true))
+(host-bl-test "unrelate deletes the durable KV row"
+  (begin
+    (host/blog-unrelate! "alpha-post" "gamma-post" "tagged")
+    (persist/backend-kv-has? host/blog-store (host/blog--edge-key "alpha-post" "tagged" "gamma-post")))
+  false)
+
+;; -- Phase 2: typing with subsumption (is-a + subtype-of) --
+;; ppost --is-a--> ptutorial ; ptutorial --subtype-of--> particle --subtype-of--> pdoc
+(host/blog-put! "ptutorial" "P Tutorial" "(p \"t\")" "published")
+(host/blog-put! "particle" "P Article" "(p \"a\")" "published")
+(host/blog-put! "pdoc" "P Doc" "(p \"d\")" "published")
+(host/blog-put! "ppost" "P Post" "(p \"p\")" "published")
+(host/blog-relate! "ptutorial" "particle" "subtype-of")
+(host/blog-relate! "particle" "pdoc" "subtype-of")
+(host/blog-relate! "ppost" "ptutorial" "is-a")
+(host-bl-test "types-of = declared type + ALL its subtype-of supertypes"
+  (list (contains? (host/blog-types-of "ppost") "ptutorial")
+        (contains? (host/blog-types-of "ppost") "particle")
+        (contains? (host/blog-types-of "ppost") "pdoc"))
+  (list true true true))
+(host-bl-test "is-a? is transitive THROUGH subtype-of (subsumption)"
+  (list (host/blog-is-a? "ppost" "ptutorial")
+        (host/blog-is-a? "ppost" "pdoc"))
+  (list true true))
+(host-bl-test "is-a? alone does NOT chain (instance-of is not transitive)"
+  (begin
+    (host/blog-put! "pmeta" "P Meta" "(p \"m\")" "published")
+    (host/blog-relate! "pmeta" "ppost" "is-a")        ;; pmeta is-a ppost is-a ptutorial
+    (host/blog-is-a? "pmeta" "ptutorial"))             ;; ... does NOT make pmeta is-a ptutorial
+  false)
+(host-bl-test "is-a? false for an unrelated type"
+  (host/blog-is-a? "ppost" "particle") true)          ;; sanity: this one IS reachable
+(host-bl-test "seed-types: an instance of tag is, transitively, a type"
+  (begin
+    (host/blog-seed-types!)                            ;; type, tag, tag subtype-of type
+    (host/blog-put! "ocaml" "OCaml" "(p \"lang\")" "published")
+    (host/blog-relate! "ocaml" "tag" "is-a")           ;; ocaml is-a tag
+    (list (host/blog-is-a? "ocaml" "tag") (host/blog-is-a? "ocaml" "type")))
+  (list true true))
+(host-bl-test "type-valid? is vacuously true with no schemas (gradual)"
+  (host/blog-type-valid? "ppost" "(p \"anything\")") true)
+
+;; -- relations-as-posts: declaration-driven candidate pools (plans/relations-as-posts.md) --
+;; The picker's candidate set is the down-closure of a relation's anchors. is-a/subtype-of
+;; are anchored by `type`, so they offer the WHOLE type closure — the roots (type/tag/
+;; article) AND the instances — fixing the wrinkle where only instances showed.
+(host-bl-test "is-a candidates = the type closure: roots (type/tag/article) AND instances"
+  (let ((pool (host/blog--candidate-pool "is-a")))
+    (list (contains? pool "type") (contains? pool "tag")
+          (contains? pool "article") (contains? pool "ocaml")))   ;; ocaml is-a tag
+  (list true true true true))
+(host-bl-test "is-a candidates exclude a plain content post (not is-a/subtype-reachable to Type)"
+  (contains? (host/blog--candidate-pool "is-a") "ppost") false)
+(host-bl-test "tagged candidates are anchored by tag (tag + its instances)"
+  (let ((pool (host/blog--candidate-pool "tagged")))
+    (list (contains? pool "tag") (contains? pool "ocaml")))
+  (list true true))
+(host-bl-test "related candidates = every post (no declaration anchors it)"
+  (let ((pool (host/blog--candidate-pool "related")))
+    (list (contains? pool "type") (contains? pool "ppost")))
+  (list true true))
+;; and it flows through to the live picker endpoint: the is-a picker now offers a type root
+(host-bl-test "is-a relate-options offers the type roots (Article)"
+  (contains? (dream-resp-body (host-bl-app (host-bl-req "/ppost/relate-options?kind=is-a"))) "Article")
+  true)
+
+;; -- relations are posts: symmetry + labels read off the relation-posts (slice 2) --
+(host-bl-test "kind-spec reads :rel metadata off the relation-post"
+  (let ((s (host/blog--kind-spec "is-a")))
+    (list (get s :kind) (get s :label) (get s :symmetric) (get s :inverse-label)))
+  (list "is-a" "Types" false "Instances"))
+(host-bl-test "kind-symmetric? reads symmetry off the post (related yes, is-a no)"
+  (list (host/blog--kind-symmetric? "related") (host/blog--kind-symmetric? "is-a"))
+  (list true false))
+(host-bl-test "an unknown kind has no spec, so relate still validates it away"
+  (host/blog--kind-spec "bogus-kind") nil)
+(host-bl-test "rel-kinds is DERIVED from the graph (every post that is-a relation)"
+  (let ((kinds (map (fn (s) (get s :kind)) host/blog-rel-kinds)))
+    (list (contains? kinds "related") (contains? kinds "is-a")
+          (contains? kinds "subtype-of") (contains? kinds "tagged")))
+  (list true true true true))
+
+;; -- relations are TYPED: the target-type constraint is enforced (slice 3) --
+;; A valid object of a relation is one in its declared candidate set (the picker's
+;; pool). So is-a's object must be a type, tagged's must be a tag, related's any post.
+(host-bl-test "valid-object?: is-a accepts a type (article), rejects a plain post (ppost)"
+  (list (host/blog--valid-object? "is-a" "article") (host/blog--valid-object? "is-a" "ppost"))
+  (list true false))
+(host-bl-test "valid-object?: tagged accepts a tag (ocaml); related accepts any post"
+  (list (host/blog--valid-object? "tagged" "ocaml") (host/blog--valid-object? "related" "ppost"))
+  (list true true))
+;; the relate ENDPOINT enforces it: is-a to a type relates; is-a to a non-type no-ops.
+(host/blog-unrelate! "alpha-post" "article" "is-a")
+(host-bl-test "relate-submit: is-a to a type (article) creates the edge"
+  (begin
+    (host/blog-relate-submit (host-bl-relreq "alpha-post" "relate"
+      {:sx-request "true" :sx-target "#rel-editor-is-a"} "article" "is-a"))
+    (contains? (host/blog-out "alpha-post" "is-a") "article"))
+  true)
+(host/blog-unrelate! "alpha-post" "article" "is-a")
+(host-bl-test "relate-submit: is-a to a NON-type (beta-post) is rejected (no edge)"
+  (begin
+    (host/blog-relate-submit (host-bl-relreq "alpha-post" "relate"
+      {:sx-request "true" :sx-target "#rel-editor-is-a"} "beta-post" "is-a"))
+    (contains? (host/blog-out "alpha-post" "is-a") "beta-post"))
+  false)
+
+;; -- Slice 4: type ALGEBRA — intersection (∧) and union (∨) types --
+;; ocaml is-a tag (seeded above); make it is-a article too, so it's in BOTH extents.
+(host/blog-relate! "ocaml" "article" "is-a")
+(host/blog-make-and! "taggy-article" "tag" "article")   ;; tag ∧ article
+(host/blog-make-or!  "tag-or-article" "tag" "article")   ;; tag ∨ article
+(host-bl-test "intersection (∧): a member iff it's an instance of BOTH operands"
+  (list (host/blog-is-a-expr? "ocaml" "taggy-article")   ;; is-a tag AND is-a article
+        (host/blog-is-a-expr? "ppost" "taggy-article"))  ;; neither
+  (list true false))
+(host-bl-test "union (∨): a member iff it's an instance of EITHER operand"
+  (list (host/blog-is-a-expr? "ocaml" "tag-or-article")  ;; is-a tag (and article)
+        (host/blog-is-a-expr? "ppost" "tag-or-article"))  ;; neither tag nor article
+  (list true false))
+(host-bl-test "the extent is the set intersection of the operands' extents"
+  (let ((ext (host/blog-instances-of-expr "taggy-article")))
+    (list (contains? ext "ocaml")                         ;; in tag ∩ article
+          (contains? ext "ppost")))                       ;; in neither
+  (list true false))
+;; algebra is META-CIRCULAR: an operand can itself be an algebraic type.
+(host/blog-make-and! "nested-and" "taggy-article" "tag")  ;; (tag ∧ article) ∧ tag
+(host-bl-test "nested type expression: (tag ∧ article) ∧ tag still admits ocaml"
+  (host/blog-is-a-expr? "ocaml" "nested-and") true)
+
+;; -- Slice 5: refinement types — schemas live ON the type-post --
+;; article's schema (now on the article post) is still enforced for its instances.
+(host/blog-put! "art-test" "Art Test" "(p \"x\")" "published")
+(host/blog-relate! "art-test" "article" "is-a")
+(host-bl-test "article (refinement type, schema on the post) requires an h1"
+  (list (host/blog-type-valid? "art-test" "(p \"no heading\")")              ;; missing h1
+        (host/blog-type-valid? "art-test" "(article (h1 \"H\") (p \"x\"))"))  ;; has h1
+  (list false true))
+;; a NEW refinement type is pure data: give a type-post a :schema and its instances
+;; are validated against it — no code, no hardcoded table.
+(host/blog-seed! "guide" "Guide" "(article (h1 \"Guide\") (p \"A guide.\"))" "published")
+(host/blog-relate! "guide" "type" "subtype-of")
+(host/blog--set-schema! "guide" (list {:block "pre" :msg "a guide needs a code block (pre)"}))
+(host/blog-put! "g1" "G1" "(p \"x\")" "published")
+(host/blog-relate! "g1" "guide" "is-a")
+(host-bl-test "a NEW refinement type validates its instances against its :schema"
+  (list (host/blog-type-valid? "g1" "(p \"no code\")")                       ;; missing pre
+        (host/blog-type-valid? "g1" "(article (pre \"x\") (p \"y\"))"))      ;; has pre
+  (list false true))
+(host-bl-test "the schema is read off the type-post (data, not a hardcoded table)"
+  (contains? (str (host/blog-schema-of "guide")) "code block") true)
+;; editing a refinement type preserves its :schema (put! merges over the record).
+(host/blog-put! "guide" "Guide v2" "(article (h1 \"Guide\") (p \"edited\"))" "published")
+(host-bl-test "editing a type-post preserves its :schema (and metadata survives edits)"
+  (contains? (str (host/blog-schema-of "guide")) "code block") true)
+
+;; -- Phase 3: tags as posts --  (ocaml is-a tag, from the seed-types test above)
+(host-bl-test "is-tag?: a post that is-a tag is a tag; others are not"
+  (list (host/blog-is-tag? "ocaml") (host/blog-is-tag? "ppost"))
+  (list true false))
+(host-bl-test "instances-of tag includes the tag posts"
+  (contains? (host/blog-instances-of "tag") "ocaml") true)
+(host-bl-test "tag a post: it appears in tags + tagged-with (inverse)"
+  (begin
+    (host/blog-relate! "ppost" "ocaml" "tagged")        ;; ppost tagged ocaml
+    (list (contains? (host/blog-tags "ppost") "ocaml")
+          (contains? (host/blog-tagged-with "ocaml") "ppost")))
+  (list true true))
+(host-bl-test "tagged picker offers only tags (kind=tagged)"
+  (let ((body (dream-resp-body (host-bl-app (host-bl-req "/particle/relate-options?kind=tagged")))))
+    (list (contains? body ">OCaml<") (contains? body ">P Article<")))
+  (list true false))
+(host-bl-test "related picker still offers all posts (kind defaults to related)"
+  (contains? (dream-resp-body (host-bl-app (host-bl-req "/particle/relate-options"))) ">P Doc<")
+  true)
+(host-bl-test "is-a-tag toggle marks a post a tag via /relate kind=is-a"
+  (begin
+    (host-bl-wapp (host-bl-send "POST" "/pdoc/relate" "Bearer good"
+      "application/x-www-form-urlencoded" "other=tag&kind=is-a"))
+    (host/blog-is-tag? "pdoc"))
+  true)
+
+;; -- Phase 4: registry-driven render + /tags index --
+(host-bl-test "relation-blocks renders Related + Tags from the registry"
+  (begin
+    (host/blog-relate! "hint-post" "ppost" "related")
+    (host/blog-relate! "hint-post" "ocaml" "tagged")
+    (let ((body (str (host/blog--relation-blocks "hint-post"))))
+      (list (contains? body "Related posts") (contains? body "Tags"))))
+  (list true true))
+(host-bl-test "relation-blocks shows an inverse block (Tagged with this) for a tag"
+  (contains? (str (host/blog--relation-blocks "ocaml")) "Tagged with this") true)
+(host-bl-test "/tags lists the tag posts"
+  (contains? (dream-resp-body (host-bl-app (host-bl-req "/tags"))) "OCaml") true)
+(host-bl-test "/tags is 200 (not shadowed by /:slug)"
+  (dream-status (host-bl-app (host-bl-req "/tags"))) 200)
+
+;; -- Phase 6: gradual schema validation --
+(host/blog-seed-types!)   ;; ensures the "article" type + its schema (requires h1)
+(host-bl-test "all-tags finds nested element tags"
+  (let ((tags (host/blog--all-tags (parse-safe "(article (h1 \"T\") (p \"x\"))"))))
+    (list (contains? tags "h1") (contains? tags "p") (contains? tags "section")))
+  (list true true false))
+(host-bl-test "schema-issues: missing required block -> 1 issue; present -> 0"
+  (let ((sch (host/blog-schema-of "article")))
+    (list (len (host/blog--schema-issues sch "(p \"no heading\")"))
+          (len (host/blog--schema-issues sch "(article (h1 \"yes\"))"))))
+  (list 1 0))
+(host-bl-test "type-valid? enforces an is-a article's schema"
+  (begin
+    (host/blog-put! "art1" "Art 1" "(p \"x\")" "published")
+    (host/blog-relate! "art1" "article" "is-a")
+    (list (host/blog-type-valid? "art1" "(p \"no heading\")")
+          (host/blog-type-valid? "art1" "(article (h1 \"H\") (p \"x\"))")))
+  (list false true))
+
+;; -- metamodel overview (GET /meta) --
+(host-bl-test "type-defs = the subtype hierarchy (type defs), not is-a instances"
+  (let ((defs (host/blog-type-defs)))
+    (list (contains? defs "type") (contains? defs "article") (contains? defs "art1")))
+  (list true true false))
+(host-bl-test "/meta is 200 (not shadowed by /:slug)"
+  (dream-status (host-bl-app (host-bl-req "/meta"))) 200)
+(host-bl-test "/meta lists type definitions + relations + the article's required block"
+  (let ((body (dream-resp-body (host-bl-app (host-bl-req "/meta")))))
+    (list (contains? body "Metamodel") (contains? body "Article")
+          (contains? body "h1") (contains? body "related")
+          (contains? body "symmetric")))
+  (list true true true true true))
+
+;; -- Slice 8: typed scalar fields on a type --
+(host-bl-test "fields-of reads a type's declared fields (seeded on article)"
+  (map (fn (f) (get f :name)) (host/blog-fields-of "article"))
+  (list "subtitle" "hero"))
+(host-bl-test "widget-for: explicit > value-type default > text fallback"
+  (list (host/blog--widget-for {:name "a" :type "URL"})
+        (host/blog--widget-for {:name "b" :type "Text"})
+        (host/blog--widget-for {:name "c" :type "Nonsense"})
+        (host/blog--widget-for {:name "d" :type "String" :widget "custom"}))
+  (list "url" "textarea" "text" "custom"))
+(host-bl-test "set-fields! is idempotent + preserves the rest of the record"
+  (begin
+    (host/blog--set-fields! "article"
+      (list {:name "subtitle" :type "String"} {:name "hero" :type "URL"}))
+    (list (get (host/blog-get "article") :title) (len (host/blog-fields-of "article"))))
+  (list "Article" 2))
+(host-bl-test "a type with no declared fields -> empty list"
+  (host/blog-fields-of "tag") (list))
+(host-bl-test "/meta shows the article's typed fields"
+  (contains? (dream-resp-body (host-bl-app (host-bl-req "/meta"))) "subtitle:String") true)
+
+;; -- Slice 8b: field values + the generic, type-driven edit form --
+(host-bl-test "fields-for-post = union of the post's (transitive) types' fields"
+  (begin
+    (host/blog-put! "fpost" "F Post" "(article (h1 \"F\"))" "published")
+    (host/blog-relate! "fpost" "article" "is-a")
+    (map (fn (f) (get f :name)) (host/blog--fields-for-post "fpost")))
+  (list "subtitle" "hero"))
+(host-bl-test "a post of no typed type has no fields"
+  (host/blog--fields-for-post "hello") (list))
+(host-bl-test "set/get field-values round-trips on an instance"
+  (begin
+    (host/blog--set-field-values! "fpost" {"subtitle" "A subtitle" "hero" "http://x/y.png"})
+    (list (get (host/blog-field-values-of "fpost") "subtitle")
+          (get (host/blog-field-values-of "fpost") "hero")))
+  (list "A subtitle" "http://x/y.png"))
+(host-bl-test "edit form renders one input per field for a typed post"
+  (let ((body (dream-resp-body (host-bl-wapp (host-bl-send "GET" "/fpost/edit" "Bearer good" nil "")))))
+    (list (contains? body "field-subtitle") (contains? body "field-hero") (contains? body "Fields")))
+  (list true true true))
+(host-bl-test "edit-submit stores the typed field values from the form"
+  (begin
+    (host-bl-wapp (host-bl-send "POST" "/fpost/edit" "Bearer good"
+      "application/x-www-form-urlencoded"
+      "sx_content=(article+(h1+%22F%22))&field-subtitle=Saved+Sub&field-hero=http%3A%2F%2Fz%2Fq.png"))
+    (list (get (host/blog-field-values-of "fpost") "subtitle")
+          (get (host/blog-field-values-of "fpost") "hero")))
+  (list "Saved Sub" "http://z/q.png"))
+
+;; -- Slice 8c: render template per type (fields drive the page too) --
+(host-bl-test "instantiate resolves (field name), replacing the placeholder"
+  (list (contains? (str (host/blog--instantiate (parse-safe "(p (field \"subtitle\"))") {"subtitle" "Hi"})) "Hi")
+        (contains? (str (host/blog--instantiate (parse-safe "(p (field \"x\"))") {})) "field"))
+  (list true false))
+(host-bl-test "template-of reads the article's seeded render template"
+  (contains? (host/blog-template-of "article") "field") true)
+(host-bl-test "typed-block renders a typed post's field values"
+  (begin
+    (host/blog--set-field-values! "fpost" {"subtitle" "My Standfirst" "hero" ""})
+    (contains? (str (host/blog--typed-block "fpost")) "My Standfirst"))
+  true)
+(host-bl-test "typed-block is empty for an untyped post"
+  (host/blog--typed-block "hello") "")
+(host-bl-test "post page renders the typed template standfirst"
+  (contains? (dream-resp-body (host-bl-app (host-bl-req "/fpost/"))) "My Standfirst") true)
+
+;; -- metamodel editor: define a type through the UI (POST /meta/new-type) --
+(host-bl-test "/meta has the create-type form"
+  (contains? (dream-resp-body (host-bl-app (host-bl-req "/meta"))) "/meta/new-type") true)
+(host-bl-test "POST /meta/new-type creates a type (subtype-of type) in type-defs"
+  (begin
+    (host-bl-wapp (host-bl-send "POST" "/meta/new-type" "Bearer good"
+      "application/x-www-form-urlencoded" "title=Recipe"))
+    (list (host/blog-exists? "recipe") (contains? (host/blog-type-defs) "recipe")))
+  (list true true))
+(host-bl-test "create-type requires auth (unauthed -> not created)"
+  (begin
+    (host-bl-wapp (host-bl-send "POST" "/meta/new-type" nil
+      "application/x-www-form-urlencoded" "title=Sneaky Type"))
+    (host/blog-exists? "sneaky-type"))
+  false)
+
+;; -- metamodel editor: define a relation through the UI (POST /meta/new-relation) --
+(host-bl-test "/meta has the create-relation form"
+  (contains? (dream-resp-body (host-bl-app (host-bl-req "/meta"))) "/meta/new-relation") true)
+(host-bl-test "POST /meta/new-relation creates + registers a relation (session-scoped)"
+  (begin
+    (host-bl-wapp (host-bl-send "POST" "/meta/new-relation" "Bearer good"
+      "application/x-www-form-urlencoded" "title=Blocks&label=Blocks&symmetric=on"))
+    (list (host/blog-exists? "blocks")
+          (host/blog-is-a? "blocks" "relation")
+          (not (nil? (host/blog--kind-spec "blocks")))
+          (host/blog--kind-symmetric? "blocks")))
+  (list true true true true))
+(host-bl-test "create-relation requires auth (unauthed -> not created)"
+  (begin
+    (host-bl-wapp (host-bl-send "POST" "/meta/new-relation" nil
+      "application/x-www-form-urlencoded" "title=Sneaky Rel"))
+    (host/blog-exists? "sneaky-rel"))
+  false)
+
+;; -- cards-as-types: the blog content block vocabulary --
+(host-bl-test "card-types are seeded as subtypes of card (in type-defs)"
+  (let ((defs (host/blog-type-defs)))
+    (list (contains? defs "card") (contains? defs "card-image") (contains? defs "card-heading")))
+  (list true true true))
+(host-bl-test "a card-type carries its fields"
+  (map (fn (f) (get f :name)) (host/blog-fields-of "card-image"))
+  (list "src" "alt" "caption"))
+(host-bl-test "/meta lists the card vocabulary with fields"
+  (let ((body (dream-resp-body (host-bl-app (host-bl-req "/meta")))))
+    (list (contains? body ">Image</a>") (contains? body "src:URL, alt:String")))
+  (list true true))
+
+;; -- typed Ghost import (the radar genesis-import seam) --
+(host-bl-test "import-post! lands a Ghost post as a typed Article + fields + tags"
+  (begin
+    (host/blog-import-post! {"slug" "g1" "title" "G1" "sx_content" "(article (h1 \"G1\"))"
+                             "status" "published" "custom_excerpt" "A standfirst"
+                             "feature_image" "http://i/h.jpg" "tags" (list "News")})
+    (list (host/blog-is-a? "g1" "article")
+          (get (host/blog-field-values-of "g1") "subtitle")
+          (get (host/blog-field-values-of "g1") "hero")
+          (contains? (host/blog-out "g1" "tagged") "news")))
+  (list true "A standfirst" "http://i/h.jpg" true))
+(host-bl-test "POST /import (text/sx list of Ghost dicts) lands typed posts"
+  (begin
+    (host-bl-wapp (host-bl-send "POST" "/import" "Bearer good" "text/sx"
+      "({:slug \"g2\" :title \"G2\" :sx_content \"(p \\\"b\\\")\" :status \"published\" :custom_excerpt \"S2\"})"))
+    (list (host/blog-is-a? "g2" "article") (get (host/blog-field-values-of "g2") "subtitle")))
+  (list true "S2"))
+(host-bl-test "POST /import rejects a non-list body -> 400"
+  (dream-status (host-bl-wapp (host-bl-send "POST" "/import" "Bearer good" "text/sx" "{:x 1}")))
+  400)
+
+;; -- composition objects: a record with :body renders via the render-fold --
+(host-bl-test "a record's :body renders via the fold, different per context"
+  (begin
+    (host/blog-put! "cdoc" "C" "(p \"fallback\")" "published")
+    (host/blog--set-body! "cdoc"
+      (quote (seq (alt (when (has "auth") (text "MEMBER")) (else (text "ANON")))
+                  (each (items {:name "X"} {:name "Y"}) (field :name)))))
+    (list (host/comp-render (host/blog-body-of "cdoc") {})
+          (host/comp-render (host/blog-body-of "cdoc") {"auth" "y"})))
+  (list "ANON<span>X</span><span>Y</span>" "MEMBER<span>X</span><span>Y</span>"))
+(host-bl-test "post page renders :body (composition) over sx_content"
+  (contains? (dream-resp-body (host-bl-app (host-bl-req "/cdoc/"))) "ANON") true)
+(host-bl-test "a post with no schema'd type is vacuously valid"
+  (host/blog-type-valid? "ppost" "(p \"anything\")") true)
+(host-bl-test "edit-submit rejects content violating the type schema (not saved)"
+  (begin
+    (host-bl-wapp (host-bl-send "POST" "/art1/edit" "Bearer good"
+      "application/x-www-form-urlencoded" "sx_content=(p+%22still+no+heading%22)"))
+    (contains? (dream-resp-body (host-bl-wapp (host-bl-req "/art1/"))) "still no heading"))
+  false)
+(host-bl-test "edit-submit accepts content satisfying the schema -> 303"
+  (dream-status (host-bl-wapp (host-bl-send "POST" "/art1/edit" "Bearer good"
+    "application/x-www-form-urlencoded" "sx_content=(article+(h1+%22Heading%22)+(p+%22body%22))")))
+  303)
+
+;; -- experimental unguarded create-only route (POST /new, no auth) --
+(define host-bl-oapp (host/make-app (list host/blog-open-create-routes host/blog-routes)))
+(host/blog-use-store! (persist/open))
+(host-bl-test "open create no auth -> 303"
+  (dream-status (host-bl-oapp (host-bl-send "POST" "/new" nil
+    "application/x-www-form-urlencoded" "title=Open+Post&sx_content=(p+%22o%22)&status=published")))
+  303)
+(host-bl-test "open-created post renders"
+  (contains? (dream-resp-body (host-bl-oapp (host-bl-req "/open-post/"))) "<p>o</p>")
+  true)
+
+;; ── content-addressing: every object carries a stable CID ───────────
+;; A CID is the hash of the canonical (key-sorted) content; the slug (a name) and
+;; any prior :cid are excluded. Same content -> same CID, across slugs and processes.
+(host/blog-use-store! (persist/open))
+(host/blog-put! "cid-a" "Same Body" "(p \"same\")" "published")
+(host/blog-put! "cid-b" "Same Body" "(p \"same\")" "published")
+(host-bl-test "put! stamps a non-nil CID"
+  (and (not (nil? (host/blog-cid "cid-a"))) (> (len (host/blog-cid "cid-a")) 1)) true)
+(host-bl-test "content-addressed: identical content -> identical CID (slug excluded)"
+  (= (host/blog-cid "cid-a") (host/blog-cid "cid-b")) true)
+(host-bl-test "CID changes when content changes"
+  (let ((before (host/blog-cid "cid-a")))
+    (host/blog-put! "cid-a" "Same Body" "(p \"different now\")" "published")
+    (not (= before (host/blog-cid "cid-a"))))
+  true)
+(host-bl-test "canon excludes :slug and :cid"
+  (= (host/blog--canon {:slug "x" :cid "old" :title "T"})
+     (host/blog--canon {:title "T"}))
+  true)
+(host-bl-test "by-cid reverse lookup finds a slug with that CID"
+  (not (nil? (host/blog-by-cid (host/blog-cid "cid-b")))) true)
+(host-bl-test "by-cid of an unknown CID is nil"
+  (host/blog-by-cid "znope-nope") nil)
+
+(define
+  host-bl-tests-run!
+  (fn ()
+    {:total (+ host-bl-pass host-bl-fail)
+     :passed host-bl-pass :failed host-bl-fail :fails host-bl-fails}))

lib/host/tests/feed.sx

@@ -0,0 +1,132 @@
+;; lib/host/tests/feed.sx — the migrated feed endpoints, GET /feed (read) and
+;; POST /feed (guarded write). Includes a golden test: the host read response
+;; body must equal the feed subsystem's own recent-first stream wrapped in the
+;; standard envelope — the endpoint adds the HTTP/JSON shell and nothing else.
+
+(define host-fd-pass 0)
+(define host-fd-fail 0)
+(define host-fd-fails (list))
+
+(define
+  host-fd-test
+  (fn
+    (name actual expected)
+    (if
+      (= actual expected)
+      (set! host-fd-pass (+ host-fd-pass 1))
+      (begin
+        (set! host-fd-fail (+ host-fd-fail 1))
+        (append! host-fd-fails {:name name :actual actual :expected expected})))))
+
+(define
+  host-fd-req
+  (fn (target) (dream-request "GET" target {} "")))
+
+(define
+  host-fd-app
+  (host/make-app (list host/feed-routes)))
+
+;; ── empty feed ─────────────────────────────────────────────────────
+(feed/reset!)
+(host-fd-test
+  "empty feed 200"
+  (dream-status (host-fd-app (host-fd-req "/feed")))
+  200)
+(host-fd-test
+  "empty feed data ()"
+  (contains? (dream-resp-body (host-fd-app (host-fd-req "/feed"))) ":data ()")
+  true)
+
+;; ── seeded feed ────────────────────────────────────────────────────
+(feed/reset!)
+(feed/post {:actor "alice" :verb "post" :object "p1" :at 1})
+(feed/post {:actor "bob" :verb "post" :object "p2" :at 2})
+(feed/post {:actor "alice" :verb "like" :object "p2" :at 3})
+
+;; recent-first: newest activity (at 3) leads, so its marker precedes the oldest.
+(host-fd-test
+  "timeline recent-first"
+  (let ((body (dream-resp-body (host-fd-app (host-fd-req "/feed")))))
+    (< (index-of body ":at 3") (index-of body ":at 1")))
+  true)
+
+;; actor filter: only alice's two activities.
+(host-fd-test
+  "actor filter count"
+  (feed/count
+    (feed/by-actor (feed/recent (feed/all)) "alice"))
+  2)
+(host-fd-test
+  "actor filter excludes bob"
+  (contains?
+    (dream-resp-body (host-fd-app (host-fd-req "/feed?actor=alice")))
+    "bob")
+  false)
+
+;; limit: cap to a single activity (the most recent).
+(host-fd-test
+  "limit caps results"
+  (contains?
+    (dream-resp-body (host-fd-app (host-fd-req "/feed?limit=1")))
+    ":at 1")
+  false)
+
+;; ── golden: endpoint = subsystem recent stream + envelope ───────────
+(host-fd-test
+  "golden full timeline"
+  (dream-resp-body (host-fd-app (host-fd-req "/feed")))
+  (serialize {:ok true :data (feed/items (feed/recent (feed/all)))}))
+(host-fd-test
+  "golden actor-filtered"
+  (dream-resp-body (host-fd-app (host-fd-req "/feed?actor=alice")))
+  (serialize {:ok true :data (feed/items (feed/by-actor (feed/recent (feed/all)) "alice"))}))
+
+;; ── write: POST /feed (auth + ACL + action) ────────────────────────
+(acl/load! (list (acl-grant "alice" "post" "feed")))
+(define host-fd-resolve (fn (tok) (if (= tok "good") "alice" nil)))
+(define
+  host-fd-wapp
+  (host/make-app
+    (list host/feed-routes (host/feed-write-routes host-fd-resolve))))
+(define
+  host-fd-post
+  (fn (auth body)
+    (dream-request "POST" "/feed" (if auth {:authorization auth} {}) body)))
+
+(feed/reset!)
+(host-fd-test
+  "post no auth -> 401"
+  (dream-status (host-fd-wapp (host-fd-post nil "{}")))
+  401)
+(host-fd-test
+  "post unchanged feed after 401"
+  (feed/size)
+  0)
+(host-fd-test
+  "post authed+permitted -> 201"
+  (dream-status
+    (host-fd-wapp
+      (host-fd-post
+        "Bearer good"
+        "{:actor \"alice\" :verb \"post\" :object \"p9\" :at 9}")))
+  201)
+(host-fd-test "post grew feed" (feed/size) 1)
+(host-fd-test
+  "created activity visible in timeline"
+  (contains?
+    (dream-resp-body (host-fd-wapp (host-fd-req "/feed")))
+    "p9")
+  true)
+(host-fd-test
+  "post non-object body -> 400"
+  (dream-status (host-fd-wapp (host-fd-post "Bearer good" "(1 2)")))
+  400)
+
+(define
+  host-fd-tests-run!
+  (fn
+    ()
+    {:total (+ host-fd-pass host-fd-fail)
+     :passed host-fd-pass
+     :failed host-fd-fail
+     :fails host-fd-fails}))

lib/host/tests/handler.sx

@@ -0,0 +1,86 @@
+;; lib/host/tests/handler.sx — host JSON envelope + request-reading helpers.
+
+(define host-hd-pass 0)
+(define host-hd-fail 0)
+(define host-hd-fails (list))
+
+(define
+  host-hd-test
+  (fn
+    (name actual expected)
+    (if
+      (= actual expected)
+      (set! host-hd-pass (+ host-hd-pass 1))
+      (begin
+        (set! host-hd-fail (+ host-hd-fail 1))
+        (append! host-hd-fails {:name name :actual actual :expected expected})))))
+
+;; ── host/ok ────────────────────────────────────────────────────────
+(host-hd-test "ok status 200" (dream-status (host/ok "x")) 200)
+(host-hd-test
+  "ok content-type sx"
+  (dream-resp-header (host/ok "x") "content-type")
+  "text/sx; charset=utf-8")
+(host-hd-test
+  "ok envelope ok:true"
+  (contains? (dream-resp-body (host/ok "x")) ":ok true")
+  true)
+(host-hd-test
+  "ok envelope carries data"
+  (contains? (dream-resp-body (host/ok "hi")) ":data \"hi\"")
+  true)
+
+;; ── host/ok-status ─────────────────────────────────────────────────
+(host-hd-test "ok-status custom" (dream-status (host/ok-status 201 "y")) 201)
+(host-hd-test
+  "ok-status data"
+  (contains? (dream-resp-body (host/ok-status 201 "y")) ":data \"y\"")
+  true)
+
+;; ── host/error ─────────────────────────────────────────────────────
+(host-hd-test "error status" (dream-status (host/error 404 "nope")) 404)
+(host-hd-test
+  "error ok:false"
+  (contains? (dream-resp-body (host/error 404 "nope")) ":ok false")
+  true)
+(host-hd-test
+  "error message"
+  (contains? (dream-resp-body (host/error 404 "nope")) ":error \"nope\"")
+  true)
+(host-hd-test
+  "error content-type sx"
+  (dream-resp-header (host/error 500 "boom") "content-type")
+  "text/sx; charset=utf-8")
+
+;; ── host/sx-status ─────────────────────────────────────────────────
+(host-hd-test
+  "sx-status arbitrary status"
+  (dream-status (host/sx-status 418 {:a 1}))
+  418)
+(host-hd-test
+  "sx-status serializes body"
+  (contains? (dream-resp-body (host/sx-status 200 {:a 1})) ":a 1")
+  true)
+
+;; ── host/query-int ─────────────────────────────────────────────────
+(define
+  host-hd-req
+  (fn (target) (dream-request "GET" target {} "")))
+
+(host-hd-test
+  "query-int present"
+  (host/query-int (host-hd-req "/x?limit=5") "limit" 10)
+  5)
+(host-hd-test
+  "query-int absent -> fallback"
+  (host/query-int (host-hd-req "/x") "limit" 10)
+  10)
+
+(define
+  host-hd-tests-run!
+  (fn
+    ()
+    {:total (+ host-hd-pass host-hd-fail)
+     :passed host-hd-pass
+     :failed host-hd-fail
+     :fails host-hd-fails}))