events: Phase 4 federation — trust-gated peer agenda merge + 13 tests

federation.sx: a peer publishes a schedule; ev/federated-agenda merges local
(origin :local) with trusted peers' agendas, sorted by start, tagged with
:origin provenance. Trust is a peer-id set re-checked per merge; untrusted
peers contribute nothing. Real transport slots behind ev/peer-agenda.
209/209 green — all four plan phases implemented.

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

lib/events/conformance.conf

@@ -41,6 +41,7 @@ PRELOADS=(
   lib/events/notify.sx
   lib/events/api.sx
   lib/events/reminders.sx
+  lib/events/federation.sx
 )
 
 SUITES=(
@@ -51,4 +52,5 @@ SUITES=(
   "ticket:lib/events/tests/ticket.sx:(ev-ticket-tests-run!)"
   "notify:lib/events/tests/notify.sx:(ev-notify-tests-run!)"
   "reminders:lib/events/tests/reminders.sx:(ev-reminders-tests-run!)"
+  "federation:lib/events/tests/federation.sx:(ev-federation-tests-run!)"
 )

lib/events/federation.sx

@@ -0,0 +1,98 @@
+;; lib/events/federation.sx — cross-instance calendar federation (trust-gated).
+;;
+;; A peer is another events instance that publishes a schedule (an events
+;; store). We merge a peer's agenda into ours ONLY if we trust it — trust is a
+;; set of peer ids, re-checked on every merge, so revoking a peer takes effect
+;; immediately. Merged occurrences carry :origin provenance (:local for ours, or
+;; the peer id) so a consumer always knows where a slot came from.
+;;
+;; This is the trust-gated stub: peers publish plain schedules and we fold the
+;; trusted ones into a single sorted agenda. Real transport (fed-sx / signed
+;; fetch) slots in behind `ev/peer-agenda` without changing the merge.
+
+(define ev/peer (fn (id store) {:id id :store store}))
+(define ev/peer-id (fn (p) (get p :id)))
+(define ev/peer-store (fn (p) (get p :store)))
+
+(define
+  ev-fed-member?
+  (fn
+    (x xs)
+    (cond
+      ((empty? xs) false)
+      ((= x (first xs)) true)
+      (else (ev-fed-member? x (rest xs))))))
+
+;; Do we trust this peer id? (trust is a list of trusted peer ids.)
+(define ev/trusts? (fn (trust peer-id) (ev-fed-member? peer-id trust)))
+
+;; The trusted subset of a peer list.
+(define
+  ev/trusted-peers
+  (fn
+    (peers trust)
+    (filter (fn (p) (ev/trusts? trust (ev/peer-id p))) peers)))
+
+;; Tag occurrences with provenance.
+(define ev-tag-origin (fn (occs origin) (map (fn (o) {:id (get o :id) :start (get o :start) :end (get o :end) :origin origin}) occs)))
+
+;; A peer's agenda over [ws, we), tagged with the peer's id as :origin.
+(define
+  ev/peer-agenda
+  (fn
+    (peer ws we)
+    (ev-tag-origin (ev/agenda (ev/peer-store peer) ws we) (ev/peer-id peer))))
+
+;; ---- merge (sorted by start, then origin for ties) ----
+
+(define
+  ev-fed-before?
+  (fn
+    (a c)
+    (cond
+      ((< (get a :start) (get c :start)) true)
+      ((> (get a :start) (get c :start)) false)
+      (else (< (str (get a :origin)) (str (get c :origin)))))))
+
+(define
+  ev-fed-insert
+  (fn
+    (x sorted)
+    (cond
+      ((empty? sorted) (list x))
+      ((ev-fed-before? x (first sorted)) (cons x sorted))
+      (else (cons (first sorted) (ev-fed-insert x (rest sorted)))))))
+
+(define
+  ev-fed-sort
+  (fn (xs) (reduce (fn (acc x) (ev-fed-insert x acc)) (list) xs)))
+
+;; Local agenda (origin :local) merged with every TRUSTED peer's agenda,
+;; sorted by start. Untrusted peers contribute nothing.
+(define
+  ev/federated-agenda
+  (fn
+    (local-store peers trust ws we)
+    (let
+      ((acc (list)))
+      (begin
+        (for-each
+          (fn (o) (append! acc o))
+          (ev-tag-origin (ev/agenda local-store ws we) :local))
+        (for-each
+          (fn
+            (peer)
+            (when
+              (ev/trusts? trust (ev/peer-id peer))
+              (for-each
+                (fn (o) (append! acc o))
+                (ev/peer-agenda peer ws we))))
+          peers)
+        (ev-fed-sort acc)))))
+
+;; Filter a federated agenda to occurrences from one origin.
+(define
+  ev/from-origin
+  (fn
+    (agenda origin)
+    (filter (fn (o) (= (get o :origin) origin)) agenda)))

lib/events/scoreboard.json

@@ -1,8 +1,8 @@
 {
   "lang": "events",
-  "total_passed": 196,
+  "total_passed": 209,
   "total_failed": 0,
-  "total": 196,
+  "total": 209,
   "suites": [
     {"name":"calendar","passed":37,"failed":0,"total":37},
     {"name":"availability","passed":22,"failed":0,"total":22},
@@ -10,7 +10,8 @@
     {"name":"booking","passed":61,"failed":0,"total":61},
     {"name":"ticket","passed":31,"failed":0,"total":31},
     {"name":"notify","passed":7,"failed":0,"total":7},
-    {"name":"reminders","passed":14,"failed":0,"total":14}
+    {"name":"reminders","passed":14,"failed":0,"total":14},
+    {"name":"federation","passed":13,"failed":0,"total":13}
   ],
-  "generated": "2026-06-07T04:34:36+00:00"
+  "generated": "2026-06-07T04:58:42+00:00"
 }

lib/events/scoreboard.md

@@ -1,6 +1,6 @@
 # events scoreboard
 
-**196 / 196 passing** (0 failure(s)).
+**209 / 209 passing** (0 failure(s)).
 
 | Suite | Passed | Total | Status |
 |-------|--------|-------|--------|
@@ -11,3 +11,4 @@
 | ticket | 31 | 31 | ok |
 | notify | 7 | 7 | ok |
 | reminders | 14 | 14 | ok |
+| federation | 13 | 13 | ok |

lib/events/tests/federation.sx

@@ -0,0 +1,155 @@
+;; lib/events/tests/federation.sx — trust-gated cross-instance agenda merge.
+
+(define ev-fd-pass 0)
+(define ev-fd-fail 0)
+(define ev-fd-failures (list))
+
+(define
+  ev-fd-check!
+  (fn
+    (name got expected)
+    (if
+      (= got expected)
+      (set! ev-fd-pass (+ ev-fd-pass 1))
+      (do
+        (set! ev-fd-fail (+ ev-fd-fail 1))
+        (append!
+          ev-fd-failures
+          (str name "\n    expected: " expected "\n    got:      " got))))))
+
+;; Local schedule + two peers. Distinct start times make ordering legible.
+(define
+  ev-fd-local
+  (fn
+    ()
+    (ev/schedule
+      (ev/empty)
+      (quote yoga)
+      (ev-dt 2026 6 1 9 0)
+      60
+      nil
+      20)))
+
+(define
+  ev-fd-berlin
+  (fn
+    ()
+    (ev/peer
+      (quote berlin)
+      (ev/schedule
+        (ev/empty)
+        (quote meetup)
+        (ev-dt 2026 6 1 12 0)
+        90
+        nil
+        100)))) 
+
+(define
+  ev-fd-paris
+  (fn
+    ()
+    (ev/peer
+      (quote paris)
+      (ev/schedule
+        (ev/empty)
+        (quote salon)
+        (ev-dt 2026 6 1 15 0)
+        60
+        nil
+        30))))
+
+(define
+  ev-fd-run-all!
+  (fn
+    ()
+    (let
+      ((local (ev-fd-local))
+        (peers (list (ev-fd-berlin) (ev-fd-paris)))
+        (ws (ev-date 2026 6 1))
+        (we (ev-date 2026 6 2)))
+      (do
+        (ev-fd-check!
+          "trusts a peer in the trust set"
+          (ev/trusts? (list (quote berlin)) (quote berlin))
+          true)
+        (ev-fd-check!
+          "does not trust a peer outside the set"
+          (ev/trusts? (list (quote berlin)) (quote paris))
+          false)
+        (ev-fd-check!
+          "trusted-peers filters to the trust set"
+          (map ev/peer-id (ev/trusted-peers peers (list (quote berlin))))
+          (list (quote berlin)))
+        (let
+          ((fed (ev/federated-agenda local peers (list (quote berlin)) ws we)))
+          (do
+            (ev-fd-check!
+              "merge includes local + trusted peer only"
+              (map (fn (o) (list (get o :origin) (get o :id))) fed)
+              (list
+                (list :local (quote yoga))
+                (list (quote berlin) (quote meetup))))
+            (ev-fd-check!
+              "merge is sorted by start"
+              (map (fn (o) (get o :start)) fed)
+              (list
+                (ev-dt 2026 6 1 9 0)
+                (ev-dt 2026 6 1 12 0)))
+            (ev-fd-check!
+              "untrusted peer (paris) contributes nothing"
+              (len (ev/from-origin fed (quote paris)))
+              0)
+            (ev-fd-check!
+              "local occurrences tagged :local"
+              (map (fn (o) (get o :id)) (ev/from-origin fed :local))
+              (list (quote yoga)))
+            (ev-fd-check!
+              "peer occurrences tagged with the peer id"
+              (map
+                (fn (o) (get o :id))
+                (ev/from-origin fed (quote berlin)))
+              (list (quote meetup)))))
+        (let
+          ((fed2 (ev/federated-agenda local peers (list (quote berlin) (quote paris)) ws we)))
+          (ev-fd-check!
+            "trusting both peers merges all three, sorted"
+            (map (fn (o) (list (get o :origin) (get o :id))) fed2)
+            (list
+              (list :local (quote yoga))
+              (list (quote berlin) (quote meetup))
+              (list (quote paris) (quote salon)))))
+        (let
+          ((fed3 (ev/federated-agenda local peers (list) ws we)))
+          (do
+            (ev-fd-check!
+              "empty trust yields only local occurrences"
+              (map (fn (o) (get o :origin)) fed3)
+              (list :local))
+            (ev-fd-check!
+              "empty trust still includes local"
+              (len fed3)
+              1)))
+        (let
+          ((rpeer (ev/peer (quote tokyo) (ev/schedule (ev/empty) (quote standup) (ev-dt 2026 6 1 8 0) 15 {:freq :daily :count 3} 5))))
+          (let
+            ((pa (ev/peer-agenda rpeer ws (ev-date 2026 6 4))))
+            (do
+              (ev-fd-check!
+                "peer recurrence expands in the window"
+                (len pa)
+                3)
+              (ev-fd-check!
+                "every peer occurrence is tagged with the peer id"
+                (map (fn (o) (get o :origin)) pa)
+                (list (quote tokyo) (quote tokyo) (quote tokyo))))))))))
+
+(define
+  ev-federation-tests-run!
+  (fn
+    ()
+    (do
+      (set! ev-fd-pass 0)
+      (set! ev-fd-fail 0)
+      (set! ev-fd-failures (list))
+      (ev-fd-run-all!)
+      {:failures ev-fd-failures :total (+ ev-fd-pass ev-fd-fail) :passed ev-fd-pass :failed ev-fd-fail})))

plans/events-on-sx.md

@@ -18,7 +18,7 @@ capacity rules, transactional booking, and a flow-driven notification dispatcher
 
 ## Status (rolling)
 
-`bash lib/events/conformance.sh` → **196/196** (Phases 1-2 + Phase 3: notification flows + reminders)
+`bash lib/events/conformance.sh` → **209/209** (Phases 1-4 complete: calendar, booking, notify, federation)
 
 ## Ground rules
 
@@ -79,11 +79,22 @@ lib/events/api.sx ── (events/schedule) (events/book) (events/agenda) ──
   (request→dispatch→resume, idempotent, bounded retry) is the extraction seam.**
 
 ## Phase 4 — Federation
-- [ ] cross-instance events (peer calendar) — trust-gated stub
-- [ ] tests: federated agenda merge
+- [x] cross-instance events (peer calendar) — trust-gated stub
+- [x] tests: federated agenda merge
+- [ ] federated availability/free-busy across trusted peers
+- [ ] real transport behind `ev/peer-agenda` (fed-sx / signed fetch)
 
 ## Progress log
 
+- 2026-06-07 — **Phase 4: federation (trust-gated stub).** `federation.sx`:
+  a peer publishes a schedule (events store); `ev/federated-agenda` merges the
+  local agenda (origin :local) with every TRUSTED peer's agenda, sorted by
+  start, each occurrence tagged with :origin provenance. Trust is a peer-id set
+  re-checked per merge (revocation is immediate); untrusted peers contribute
+  nothing. `ev/peer`, `ev/trusts?`, `ev/trusted-peers`, `ev/peer-agenda`
+  (expands the peer's recurrence in-window), `ev/from-origin` (filter by
+  source). Real transport slots behind `ev/peer-agenda` unchanged. +13 tests,
+  **209/209 green — all four plan phases implemented.**
 - 2026-06-07 — Reminders + digests from the agenda. `reminders.sx` bridges
   calendar + durable rosters to notify: `ev/occurrence-reminders` (one per
   booked attendee, fires `lead` before start, idempotency key