diff --git a/lib/events/conformance.conf b/lib/events/conformance.conf index ccf66cde..13d8d740 100644 --- a/lib/events/conformance.conf +++ b/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!)" ) diff --git a/lib/events/federation.sx b/lib/events/federation.sx new file mode 100644 index 00000000..07088f95 --- /dev/null +++ b/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))) diff --git a/lib/events/scoreboard.json b/lib/events/scoreboard.json index cdfff23a..49375fcd 100644 --- a/lib/events/scoreboard.json +++ b/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" } diff --git a/lib/events/scoreboard.md b/lib/events/scoreboard.md index 99460ce0..cf407cca 100644 --- a/lib/events/scoreboard.md +++ b/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 | diff --git a/lib/events/tests/federation.sx b/lib/events/tests/federation.sx new file mode 100644 index 00000000..6ba375d0 --- /dev/null +++ b/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}))) diff --git a/plans/events-on-sx.md b/plans/events-on-sx.md index 90725c5d..7c2402c0 100644 --- a/plans/events-on-sx.md +++ b/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