host: Phase 3 — relations WRITE cut-over (attach/detach-child), 132/132

Migrate the container relations write actions onto lib/relations: POST
/internal/actions/attach-child + /detach-child dispatch to relations/relate
and relations/unrelate over the same "type:id" node model, behind the
auth+ACL pipeline (wrap-errors . require-auth . require-permission), mirroring
POST /feed. Closed-loop test: attach -> visible via get-children -> detach ->
gone; 401/403/400 guards. Ledger now models the full relations surface (7
endpoints): container reads+writes migrated, typed relate/unrelate/can-relate
proxied (registry+cardinality validation not in lib/relations). Off-Quart
coverage 45% -> 50%.

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

lib/host/ledger.sx

@@ -18,18 +18,24 @@
 
 ;; ── the catalogue ───────────────────────────────────────────────────
 ;; Reflects the live host: feed reads+writes migrated, /health native, the
-;; relations READ endpoints migrated onto lib/relations (see lib/host/relations.sx),
-;; relations writes + the internal-only likes data+action endpoints still proxied
-;; to Quart. likes has no SX subsystem, so it stays proxied until one exists.
+;; 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 "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/relate"    "relations:relate"          "proxied"  nil)
-    (host/ledger-entry "relations" "POST" "/internal/actions/unrelate"  "relations:unrelate"        "proxied"  nil)
+    (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)

lib/host/relations.sx

@@ -56,3 +56,77 @@
   (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.
+(define host/relations-attach
+  (fn (req)
+    (let ((p (dream-json-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.
+(define host/relations-detach
+  (fn (req)
+    (let ((p (dream-json-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/tests/ledger.sx

@@ -41,11 +41,19 @@
   "find migrated relations read -> handler"
   (get (host/ledger-find host/ledger "GET" "/internal/data/get-children") :handler)
   "host/relations-children")
+(host-lg-test
+  "find migrated relations write -> handler"
+  (get (host/ledger-find host/ledger "POST" "/internal/actions/attach-child") :handler)
+  "host/relations-attach")
+(host-lg-test
+  "typed relate still proxied"
+  (get (host/ledger-find host/ledger "POST" "/internal/actions/relate") :status)
+  "proxied")
 
 ;; ── status queries ──────────────────────────────────────────────────
-(host-lg-test "migrated count" (len (host/ledger-migrated host/ledger)) 4)
+(host-lg-test "migrated count" (len (host/ledger-migrated host/ledger)) 6)
 (host-lg-test "native count" (len (host/ledger-native host/ledger)) 1)
-(host-lg-test "proxied count" (len (host/ledger-proxied host/ledger)) 6)
+(host-lg-test "proxied count" (len (host/ledger-proxied host/ledger)) 7)
 
 ;; ── served? predicate ───────────────────────────────────────────────
 (host-lg-test
@@ -62,7 +70,7 @@
   false)
 
 ;; ── domain queries ──────────────────────────────────────────────────
-(host-lg-test "relations domain count" (len (host/ledger-by-domain host/ledger "relations")) 4)
+(host-lg-test "relations domain count" (len (host/ledger-by-domain host/ledger "relations")) 7)
 (host-lg-test "likes domain count" (len (host/ledger-by-domain host/ledger "likes")) 4)
 (host-lg-test "domains count" (len (host/ledger-domains host/ledger)) 4)
 (host-lg-test
@@ -76,12 +84,12 @@
 
 ;; ── coverage ────────────────────────────────────────────────────────
 (define host-lg-cov (host/ledger-coverage host/ledger))
-(host-lg-test "coverage total" (get host-lg-cov :total) 11)
-(host-lg-test "coverage migrated" (get host-lg-cov :migrated) 4)
-(host-lg-test "coverage proxied" (get host-lg-cov :proxied) 6)
+(host-lg-test "coverage total" (get host-lg-cov :total) 14)
+(host-lg-test "coverage migrated" (get host-lg-cov :migrated) 6)
+(host-lg-test "coverage proxied" (get host-lg-cov :proxied) 7)
 (host-lg-test "coverage native" (get host-lg-cov :native) 1)
-(host-lg-test "coverage served" (get host-lg-cov :served) 5)
-(host-lg-test "coverage percent" (get host-lg-cov :percent) 45)
+(host-lg-test "coverage served" (get host-lg-cov :served) 7)
+(host-lg-test "coverage percent" (get host-lg-cov :percent) 50)
 
 (define
   host-lg-tests-run!

lib/host/tests/relations.sx

@@ -102,6 +102,74 @@
       (host/-rel-strings (relations/parents (host-rl-sym "list:7") (host-rl-sym "member"))))
     "}"))
 
+;; ── writes: attach-child / detach-child (auth + ACL + closed loop) ──
+(acl/load!
+  (list
+    (acl-grant "carol" "relate" "relations")
+    (acl-grant "carol" "unrelate" "relations")))
+;; carol is permitted; dave authenticates but has no grant.
+(define host-rl-resolve
+  (fn (tok)
+    (cond ((= tok "good") "carol") ((= tok "weak") "dave") (true nil))))
+(define host-rl-wapp
+  (host/make-app
+    (list host/relations-routes (host/relations-write-routes host-rl-resolve))))
+(define host-rl-post
+  (fn (action auth body)
+    (dream-request "POST" (str "/internal/actions/" action)
+      (if auth {:authorization auth} {}) body)))
+(define host-rl-edge
+  "{\"parent-type\":\"org\",\"parent-id\":\"2\",\"child-type\":\"list\",\"child-id\":\"5\",\"relation-type\":\"member\"}")
+(define host-rl-org2
+  "/internal/data/get-children?parent-type=org&parent-id=2&relation-type=member")
+
+(relations/load! (list))
+
+;; auth gate
+(host-rl-test
+  "attach no auth -> 401"
+  (dream-status (host-rl-wapp (host-rl-post "attach-child" nil "{}")))
+  401)
+(host-rl-test
+  "attach authed-but-unpermitted -> 403"
+  (dream-status (host-rl-wapp (host-rl-post "attach-child" "Bearer weak" host-rl-edge)))
+  403)
+(host-rl-test
+  "graph unchanged after 403"
+  (len (relations/children (host-rl-sym "org:2") (host-rl-sym "member")))
+  0)
+
+;; permitted attach -> 201, and visible through the migrated read
+(host-rl-test
+  "attach authed+permitted -> 201"
+  (dream-status (host-rl-wapp (host-rl-post "attach-child" "Bearer good" host-rl-edge)))
+  201)
+(host-rl-test
+  "attached edge visible via get-children"
+  (contains? (dream-resp-body (host-rl-app (host-rl-req host-rl-org2))) "list:5")
+  true)
+
+;; detach -> 200, and gone from the read
+(host-rl-test
+  "detach authed+permitted -> 200"
+  (dream-status (host-rl-wapp (host-rl-post "detach-child" "Bearer good" host-rl-edge)))
+  200)
+(host-rl-test
+  "detached edge gone from get-children"
+  (contains? (dream-resp-body (host-rl-app (host-rl-req host-rl-org2))) "list:5")
+  false)
+
+;; bad payloads
+(host-rl-test
+  "attach non-object body -> 400"
+  (dream-status (host-rl-wapp (host-rl-post "attach-child" "Bearer good" "[1,2]")))
+  400)
+(host-rl-test
+  "attach missing param -> 400"
+  (dream-status
+    (host-rl-wapp (host-rl-post "attach-child" "Bearer good" "{\"parent-type\":\"org\"}")))
+  400)
+
 (define
   host-rl-tests-run!
   (fn

plans/host-on-sx.md

@@ -36,10 +36,10 @@ host — no `ocaml-on-sx` dependency.
 
 ## Status (rolling)
 
-`bash lib/host/conformance.sh` → **121/121** (7 suites: handler, middleware, sxtp,
+`bash lib/host/conformance.sh` → **132/132** (7 suites: handler, middleware, sxtp,
 router, feed, relations, ledger). Phases 1 & 2 DONE; Phase 3 (strangler ledger)
-underway — ledger module + `relations` READ cut-over landed (45% off Quart);
-relations writes + golden harness next.
+underway — ledger module + `relations` container cut-over landed (reads + guarded
+writes, 50% off Quart). Golden-response harness vs live Quart next.
 
 ## Ground rules
 
@@ -116,13 +116,15 @@ lib/host/sxtp.sx                        subsystem APIs (feed/search/commerce/…
       the live state: feed reads+writes migrated, `/health` native, the
       internal-only `relations`/`likes` data+action endpoints proxied.
 - [ ] golden-response harness vs the live Quart responses
-- [~] cut over a whole domain (`relations`) as proof — READ side DONE
-      (`lib/host/relations.sx`): `GET /internal/data/get-children` + `/get-parents`
-      dispatch to `lib/relations` (`relations/children`/`parents`). Node model:
-      graph atom = symbol `"type:id"`, edge = relation-type; optional child/parent
-      `-type` param filters by `"type:"` prefix. Golden tests pin each endpoint to
-      `subsystem-call + envelope`. Ledger entries flipped to `:migrated`. WRITE side
-      (`relate`/`unrelate` actions, behind auth+ACL like POST /feed) next.
+- [x] cut over a whole domain (`relations`) as proof — the CONTAINER relations are
+      fully on the host (`lib/host/relations.sx`): reads `GET .../get-children` +
+      `/get-parents` → `relations/children`/`parents`; writes `POST
+      .../attach-child` + `/detach-child` → `relations/relate`/`unrelate`, behind
+      the auth+ACL pipeline (mirrors POST /feed). Node model: graph atom = symbol
+      `"type:id"`, edge = relation-type; `child`/`parent-type` params filter by
+      `"type:"` prefix. Closed-loop test: attach → visible via get-children →
+      detach → gone. The TYPED actions (`relate`/`unrelate`/`can-relate`) stay
+      proxied by design — registry + cardinality validation lib/relations lacks.
 
 ## Phase 4 — Dream framework layer (gated)
 - [ ] gate: `ocaml-on-sx` Phases 1–5 + minimal stdlib green
@@ -196,6 +198,23 @@ lib/host/sxtp.sx                        subsystem APIs (feed/search/commerce/…
   same as the feed reads. NEXT: relations WRITE actions (`relate`/`unrelate`)
   behind the auth+ACL pipeline (mirroring POST /feed).
 
+- **Phase 3 — relations WRITE cut-over (DONE, 132/132).** `lib/host/relations.sx`
+  gains `host/relations-attach`/`-detach` (`POST .../attach-child` + `/detach-child`)
+  and `host/relations-write-routes` — the write side of the container reads,
+  dispatching to `relations/relate`/`unrelate` over the same `"type:id"` node
+  model so an attach is immediately visible through `get-children`. Each runs
+  behind the host pipeline `wrap-errors ∘ require-auth ∘ require-permission`
+  (`"relate"`/`"unrelate"` on `"relations"`) — exactly the POST /feed stack. The
+  relations test suite proves the closed loop end-to-end: 401 unauth, 403 authed-
+  but-unpermitted (graph unchanged), 201 attach → child visible via the migrated
+  read → 200 detach → child gone; 400 on bad/short payloads. The ledger now models
+  the full relations surface (7 endpoints): container reads+writes `:migrated`,
+  typed `relate`/`unrelate`/`can-relate` `:proxied` (registry/cardinality
+  validation not in lib/relations). Off-Quart coverage 45% → **50%** (7/14).
+  `relations` is the first whole *coherent feature* (container relations) fully
+  off Quart. NEXT: golden-response harness vs live Quart, then survey the next
+  domain (blog/likes proxied — likes needs an SX subsystem first).
+
 ## Blockers
 
 - **Live wiring to the native OCaml HTTP server** (Phase 3/4): the prod server in