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>

lib/host/blog.sx

@@ -517,6 +517,35 @@
   (fn (slug template)
     (let ((r (host/blog-get slug)))
       (when r (host/blog--write! slug (merge r {:template template}))))))
+
+;; ── composition objects (plans/composition-objects.md) ──────────────
+;; A record may carry a :body — a composition node (seq/par/alt/each over object refs)
+;; rendered by the render-fold (lib/host/compose.sx) against a context. When present it
+;; supersedes :sx-content. This is fold #1; the same object renders differently per context.
+(define host/blog-body-of (fn (slug) (get (host/blog-get slug) :body)))
+(define host/blog--set-body!
+  (fn (slug body)
+    (let ((r (host/blog-get slug)))
+      (when r (host/blog--write! slug (merge r {:body body}))))))
+;; Seed a live demo of the composition fold: one object, rendered by host/comp-render, that
+;; shows seq + alt(when auth) + row(par) + each — and renders DIFFERENTLY logged-in vs out.
+(define host/blog-seed-compose-demo!
+  (fn ()
+    (begin
+      (host/blog-seed! "compose-demo" "Composition Demo"
+        "(article (h1 \"Composition Demo\") (p \"Rendered via the composition fold.\"))" "published")
+      (host/blog--set-body! "compose-demo"
+        (quote (seq
+          (text "<p>This whole page is <b>one composition object</b>, rendered by the fold — it renders differently depending on context.</p>")
+          (alt (when (has "auth") (text "<p style=\"color:green\"><b>Members:</b> you are logged in.</p>"))
+               (else (text "<p style=\"color:#999\"><i>Log in to see the member-only block.</i></p>")))
+          (text "<h3>Two columns (par)</h3>")
+          (row (text "<div style=\"flex:1;border:1px solid #ccc;padding:0.5em\">Column A</div>")
+               (text "<div style=\"flex:1;border:1px solid #ccc;padding:0.5em\">Column B</div>"))
+          (text "<h3>A list (each)</h3><ul>")
+          (each (items {:name "Revel Show" :date "Aug"} {:name "Pub Night" :date "Jun"})
+            (seq (text "<li>") (field :name) (text " — ") (field :date) (text "</li>")))
+          (text "</ul>")))))))
 ;; replace every (field "name") node in a parsed template tree with values[name] ("" if
 ;; absent). Pure: a tree-walk over the already-parsed template + pre-fetched values.
 (define host/blog--instantiate
@@ -1095,7 +1124,12 @@
           ;; the quasiquote. IO must run in the handler body, never while the page
           ;; tree is built (a perform there raises VmSuspended under http-listen).
           (let ((principal (host/current-principal req)))
-            (let ((body-html (host/blog-render r))
+            (let (;; composition objects: a record with a :body renders via the render-fold
+                  ;; (host/comp-render) against a context (auth from the principal); else the
+                  ;; legacy sx_content path. The SAME object renders differently per context.
+                  (body-html (if (get r :body)
+                               (host/comp-render (get r :body) (if (nil? principal) {} {"auth" "yes"}))
+                               (host/blog-render r)))
                   ;; all relation blocks (Related, Tags, Types, Tagged-with-this …)
                   ;; come from iterating the registry — one section, registry-driven.
                   (relations (host/blog--relations-or-hint slug (not (nil? principal))))

lib/host/conformance.sh

@@ -92,6 +92,7 @@ MODULES=(
   "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/serve.sh

@@ -86,6 +86,7 @@ MODULES=(
   "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"
 )
@@ -152,6 +153,11 @@ EPOCH=1
   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)"

lib/host/tests/blog.sx

@@ -737,6 +737,19 @@
 (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)"