relations: Phase 4 federation (erel trust-gating, peer_rel/trust, fed-sx mock transport, revocation) + 22 tests

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>

lib/relations/engine.sx

@@ -1,12 +1,22 @@
 ;; lib/relations/engine.sx — recursive reachability + roots/leaves + cycles.
 ;;
-;; The whole engine is one Datalog ruleset. Reachability is the bottom-up
-;; transitive closure acl-on-sx uses for inheritance, but parameterised by Kind
-;; so closures never leak across kinds: `reach` carries the kind as its first
-;; argument, so a `parent` walk can never cross a `reply` edge.
+;; The whole engine is one Datalog ruleset, derived from the EFFECTIVE relation
+;; `erel`, not raw `rel`. `erel` unions local edges with trust-gated federated
+;; edges:
 ;;
-;;   reach(K,X,Y) :- rel(X,Y,K).                  ; one hop
-;;   reach(K,X,Y) :- rel(X,Z,K), reach(K,Z,Y).    ; transitive
+;;   erel(S,D,K) :- rel(S,D,K).                       ; local edge, always
+;;   erel(S,D,K) :- peer_rel(P,S,D,K), trust(P).      ; peer edge, gated by trust
+;;
+;; Trust is a body literal, re-checked every query, so revoking trust (or a peer
+;; link) takes effect on the next saturation. Trust is NOT transitive — only a
+;; peer's own links, under a local trust(P) fact, bind. With no peer_rel/trust
+;; facts, erel ≡ rel, so non-federated behaviour is unchanged.
+;;
+;; Reachability is the bottom-up transitive closure acl-on-sx uses for
+;; inheritance, parameterised by Kind so closures never leak across kinds:
+;;
+;;   reach(K,X,Y) :- erel(X,Y,K).                  ; one hop
+;;   reach(K,X,Y) :- erel(X,Z,K), reach(K,Z,Y).    ; transitive
 ;;
 ;; `reach_any` is the kind-agnostic closure (any edge, any kind) used for
 ;; mixed-kind reachability — distinct from single-kind `reach`.
@@ -19,14 +29,16 @@
 (define
   relations-rules
   (quote
-    ((reach K X Y <- (rel X Y K))
-      (reach K X Y <- (rel X Z K) (reach K Z Y))
-      (reach_any X Y <- (rel X Y K))
-      (reach_any X Y <- (rel X Z K) (reach_any Z Y))
-      (rnode K X <- (rel X Y K))
-      (rnode K Y <- (rel X Y K))
-      (has_parent K Y <- (rel X Y K))
-      (has_child K X <- (rel X Y K))
+    ((erel S D K <- (rel S D K))
+      (erel S D K <- (peer_rel P S D K) (trust P))
+      (reach K X Y <- (erel X Y K))
+      (reach K X Y <- (erel X Z K) (reach K Z Y))
+      (reach_any X Y <- (erel X Y K))
+      (reach_any X Y <- (erel X Z K) (reach_any Z Y))
+      (rnode K X <- (erel X Y K))
+      (rnode K Y <- (erel X Y K))
+      (has_parent K Y <- (erel X Y K))
+      (has_child K X <- (erel X Y K))
       (root K X <- (rnode K X) {:neg (has_parent K X)})
       (leaf K X <- (rnode K X) {:neg (has_child K X)}))))
 
@@ -35,6 +47,33 @@
   relations-pluck
   (fn (substs key) (map (fn (s) (get s key)) substs)))
 
+;; Direct children: every Dst with an effective edge erel(node, Dst, kind).
+(define
+  relations-children-of
+  (fn
+    (db node kind)
+    (relations-pluck
+      (dl-query db (list (quote erel) node (quote Dst) kind))
+      :Dst)))
+
+;; Direct parents: every Src with an effective edge erel(Src, node, kind).
+(define
+  relations-parents-of
+  (fn
+    (db node kind)
+    (relations-pluck
+      (dl-query db (list (quote erel) (quote Src) node kind))
+      :Src)))
+
+;; Directly related: neighbours in either direction under kind.
+(define
+  relations-related
+  (fn
+    (db node kind)
+    (append
+      (relations-children-of db node kind)
+      (relations-parents-of db node kind))))
+
 ;; Transitive descendants of node under kind (everything reachable forward).
 (define
   relations-descendants