host: Phase 3 — relations READ cut-over (get-children/get-parents), 121/121

Migrate the two internal relations read queries onto lib/relations: GET
/internal/data/get-children + /get-parents dispatch to relations/children
and relations/parents. Bridge the Quart (type,id) node key to a graph atom
symbol "type:id" with relation-type as the edge kind; optional child/parent
-type params filter by "type:" prefix. Golden tests pin each endpoint to
subsystem-call + envelope. Ledger entries flipped to :migrated (off-Quart
coverage 27% -> 45%).

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

lib/host/conformance.sh

@@ -46,6 +46,12 @@ MODULES=(
   "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"
@@ -59,6 +65,7 @@ MODULES=(
   "lib/host/sxtp.sx"
   "lib/host/router.sx"
   "lib/host/feed.sx"
+  "lib/host/relations.sx"
   "lib/host/ledger.sx"
 )
 
@@ -69,6 +76,7 @@ SUITES=(
   "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"
   "ledger      host-lg-tests-run!  lib/host/tests/ledger.sx"
 )
 

lib/host/ledger.sx

@@ -18,16 +18,16 @@
 
 ;; ── the catalogue ───────────────────────────────────────────────────
 ;; Reflects the live host: feed reads+writes migrated, /health native, the
-;; internal-only likes/relations data+action endpoints still proxied to Quart.
-;; relations is the next cut-over candidate — it already has a real SX subsystem
-;; (lib/relations); likes has none, so it stays proxied until one exists.
+;; 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.
 (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"    "proxied"  nil)
-    (host/ledger-entry "relations" "GET"  "/internal/data/get-parents"  "relations:get_parents"     "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/relate"    "relations:relate"          "proxied"  nil)
     (host/ledger-entry "relations" "POST" "/internal/actions/unrelate"  "relations:unrelate"        "proxied"  nil)
     (host/ledger-entry "likes"     "GET"  "/internal/data/is-liked"     "likes:is_liked"            "proxied"  nil)

lib/host/relations.sx

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

lib/host/tests/ledger.sx

@@ -37,11 +37,15 @@
   (get (host/ledger-find host/ledger "POST" "/feed") :handler)
   "host/feed-create")
 (host-lg-test "find missing -> nil" (host/ledger-find host/ledger "GET" "/nope") nil)
+(host-lg-test
+  "find migrated relations read -> handler"
+  (get (host/ledger-find host/ledger "GET" "/internal/data/get-children") :handler)
+  "host/relations-children")
 
 ;; ── status queries ──────────────────────────────────────────────────
-(host-lg-test "migrated count" (len (host/ledger-migrated host/ledger)) 2)
+(host-lg-test "migrated count" (len (host/ledger-migrated host/ledger)) 4)
 (host-lg-test "native count" (len (host/ledger-native host/ledger)) 1)
-(host-lg-test "proxied count" (len (host/ledger-proxied host/ledger)) 8)
+(host-lg-test "proxied count" (len (host/ledger-proxied host/ledger)) 6)
 
 ;; ── served? predicate ───────────────────────────────────────────────
 (host-lg-test
@@ -73,11 +77,11 @@
 ;; ── 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) 2)
-(host-lg-test "coverage proxied" (get host-lg-cov :proxied) 8)
+(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 native" (get host-lg-cov :native) 1)
-(host-lg-test "coverage served" (get host-lg-cov :served) 3)
-(host-lg-test "coverage percent" (get host-lg-cov :percent) 27)
+(host-lg-test "coverage served" (get host-lg-cov :served) 5)
+(host-lg-test "coverage percent" (get host-lg-cov :percent) 45)
 
 (define
   host-lg-tests-run!

lib/host/tests/relations.sx

@@ -0,0 +1,112 @@
+;; lib/host/tests/relations.sx — the migrated relations read endpoints,
+;; GET /internal/data/get-children and /get-parents, dispatching to lib/relations.
+;; Golden tests pin each endpoint to "subsystem call + standard envelope": the
+;; host adds the HTTP/JSON shell over relations/children|parents and nothing else
+;; (golden derived from the same subsystem call, so result order matches).
+
+(define host-rl-pass 0)
+(define host-rl-fail 0)
+(define host-rl-fails (list))
+
+(define
+  host-rl-test
+  (fn
+    (name actual expected)
+    (if
+      (= actual expected)
+      (set! host-rl-pass (+ host-rl-pass 1))
+      (begin
+        (set! host-rl-fail (+ host-rl-fail 1))
+        (append! host-rl-fails {:name name :actual actual :expected expected})))))
+
+(define host-rl-req (fn (target) (dream-request "GET" target {} "")))
+(define host-rl-app (host/make-app (list host/relations-routes)))
+(define host-rl-sym (fn (s) (string->symbol s)))
+
+;; ── seed a known graph ──────────────────────────────────────────────
+;; org:1 --member--> list:7, list:8 ; org:1 --owner--> page:9
+(relations/load! (list))
+(relations/relate (host-rl-sym "org:1") (host-rl-sym "list:7") (host-rl-sym "member"))
+(relations/relate (host-rl-sym "org:1") (host-rl-sym "list:8") (host-rl-sym "member"))
+(relations/relate (host-rl-sym "org:1") (host-rl-sym "page:9") (host-rl-sym "owner"))
+
+;; ── get-children ────────────────────────────────────────────────────
+(define host-rl-kids
+  "/internal/data/get-children?parent-type=org&parent-id=1&relation-type=member")
+(host-rl-test "children 200" (dream-status (host-rl-app (host-rl-req host-rl-kids))) 200)
+(host-rl-test
+  "children has list:7"
+  (contains? (dream-resp-body (host-rl-app (host-rl-req host-rl-kids))) "list:7")
+  true)
+(host-rl-test
+  "children has list:8"
+  (contains? (dream-resp-body (host-rl-app (host-rl-req host-rl-kids))) "list:8")
+  true)
+(host-rl-test
+  "children excludes other-kind page:9"
+  (contains? (dream-resp-body (host-rl-app (host-rl-req host-rl-kids))) "page:9")
+  false)
+(host-rl-test
+  "children count via subsystem"
+  (len (relations/children (host-rl-sym "org:1") (host-rl-sym "member")))
+  2)
+
+;; child-type filter narrows by node prefix.
+(host-rl-test
+  "children child-type=list keeps both"
+  (contains?
+    (dream-resp-body (host-rl-app (host-rl-req (str host-rl-kids "&child-type=list"))))
+    "list:8")
+  true)
+(host-rl-test
+  "children child-type=page filters all out"
+  (contains?
+    (dream-resp-body (host-rl-app (host-rl-req (str host-rl-kids "&child-type=page"))))
+    "list:7")
+  false)
+
+;; ── get-parents ─────────────────────────────────────────────────────
+(define host-rl-par
+  "/internal/data/get-parents?child-type=list&child-id=7&relation-type=member")
+(host-rl-test "parents 200" (dream-status (host-rl-app (host-rl-req host-rl-par))) 200)
+(host-rl-test
+  "parents has org:1"
+  (contains? (dream-resp-body (host-rl-app (host-rl-req host-rl-par))) "org:1")
+  true)
+
+;; ── missing required params -> 400 ──────────────────────────────────
+(host-rl-test
+  "children missing param -> 400"
+  (dream-status (host-rl-app (host-rl-req "/internal/data/get-children?parent-type=org")))
+  400)
+(host-rl-test
+  "parents missing param -> 400"
+  (dream-status (host-rl-app (host-rl-req "/internal/data/get-parents?child-type=list")))
+  400)
+
+;; ── golden: endpoint = subsystem call + envelope ────────────────────
+(host-rl-test
+  "golden children"
+  (dream-resp-body (host-rl-app (host-rl-req host-rl-kids)))
+  (str
+    "{\"ok\":true,\"data\":"
+    (dream-json-encode
+      (host/-rel-strings (relations/children (host-rl-sym "org:1") (host-rl-sym "member"))))
+    "}"))
+(host-rl-test
+  "golden parents"
+  (dream-resp-body (host-rl-app (host-rl-req host-rl-par)))
+  (str
+    "{\"ok\":true,\"data\":"
+    (dream-json-encode
+      (host/-rel-strings (relations/parents (host-rl-sym "list:7") (host-rl-sym "member"))))
+    "}"))
+
+(define
+  host-rl-tests-run!
+  (fn
+    ()
+    {:total (+ host-rl-pass host-rl-fail)
+     :passed host-rl-pass
+     :failed host-rl-fail
+     :fails host-rl-fails}))