From 29127d8613699c58f13788ae25a87daf1eb54e11 Mon Sep 17 00:00:00 2001 From: giles Date: Sun, 7 Jun 2026 05:32:04 +0000 Subject: [PATCH] events: federated free/busy across trusted peers + 10 tests MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Peers publish busy intervals per actor (iCal free/busy model — privacy- preserving, not event details). ev/peer-with-busy, ev/peer-busy; ev/federated-busy unions local availability-db busy + trusted peers' published busy (sorted); ev/federated-free? answers cross-instance availability, half-open, trust-gated (untrusted peers ignored). 219/219 green. Co-Authored-By: Claude Opus 4.8 (1M context) --- lib/events/federation.sx | 69 +++++++++++++++++++++++++++++- lib/events/scoreboard.json | 8 ++-- lib/events/scoreboard.md | 4 +- lib/events/tests/federation.sx | 76 ++++++++++++++++++++++++++++++++++ plans/events-on-sx.md | 11 ++++- 5 files changed, 159 insertions(+), 9 deletions(-) diff --git a/lib/events/federation.sx b/lib/events/federation.sx index 07088f95..f021a941 100644 --- a/lib/events/federation.sx +++ b/lib/events/federation.sx @@ -9,10 +9,20 @@ ;; 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. +;; +;; Federated FREE/BUSY follows the iCal model: a peer publishes BUSY intervals +;; for an actor (not event details — privacy-preserving), and we union local + +;; trusted-peer busy to answer "is this actor free?" across instances. + +(define ev/peer (fn (id store) {:id id :busy (list) :store store})) + +;; A peer that also publishes free/busy: `busy` is a list of +;; (actor ((start end) ...)) pairs. +(define ev/peer-with-busy (fn (id store busy) {:id id :busy busy :store store})) -(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/peer-busy-table (fn (p) (get p :busy))) (define ev-fed-member? @@ -96,3 +106,60 @@ (fn (agenda origin) (filter (fn (o) (= (get o :origin) origin)) agenda))) + +;; ---- federated free/busy ---- + +;; A peer's published busy intervals for `actor` ((start end) ...), or empty. +(define + ev/peer-busy + (fn + (peer actor) + (let + ((row (ev-fed-assoc actor (ev/peer-busy-table peer)))) + (if (nil? row) (list) (first (rest row)))))) + +(define + ev-fed-assoc + (fn + (k pairs) + (cond + ((empty? pairs) nil) + ((= (first (first pairs)) k) (first pairs)) + (else (ev-fed-assoc k (rest pairs)))))) + +;; All busy intervals for `actor` across the LOCAL availability db plus every +;; TRUSTED peer's published free/busy, merged and sorted by start. +;; `local-db` is an availability db (see availability.sx ev-build-avail). +(define + ev/federated-busy + (fn + (local-db peers trust actor) + (let + ((acc (list))) + (begin + (for-each (fn (iv) (append! acc iv)) (ev-busy local-db actor)) + (for-each + (fn + (peer) + (when + (ev/trusts? trust (ev/peer-id peer)) + (for-each + (fn (iv) (append! acc iv)) + (ev/peer-busy peer actor)))) + peers) + (ev-sort-lists acc))))) + +;; Half-open overlap of interval (s e) with window [qs, qe). +(define + ev-fed-overlaps? + (fn (iv qs qe) (and (< (first iv) qe) (< qs (first (rest iv)))))) + +;; Is `actor` free across [qs, qe) considering local + trusted-peer busy? +(define + ev/federated-free? + (fn + (local-db peers trust actor qs qe) + (not + (some + (fn (iv) (ev-fed-overlaps? iv qs qe)) + (ev/federated-busy local-db peers trust actor))))) diff --git a/lib/events/scoreboard.json b/lib/events/scoreboard.json index 49375fcd..c13c16f4 100644 --- a/lib/events/scoreboard.json +++ b/lib/events/scoreboard.json @@ -1,8 +1,8 @@ { "lang": "events", - "total_passed": 209, + "total_passed": 219, "total_failed": 0, - "total": 209, + "total": 219, "suites": [ {"name":"calendar","passed":37,"failed":0,"total":37}, {"name":"availability","passed":22,"failed":0,"total":22}, @@ -11,7 +11,7 @@ {"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":"federation","passed":13,"failed":0,"total":13} + {"name":"federation","passed":23,"failed":0,"total":23} ], - "generated": "2026-06-07T04:58:42+00:00" + "generated": "2026-06-07T05:31:56+00:00" } diff --git a/lib/events/scoreboard.md b/lib/events/scoreboard.md index cf407cca..577d6039 100644 --- a/lib/events/scoreboard.md +++ b/lib/events/scoreboard.md @@ -1,6 +1,6 @@ # events scoreboard -**209 / 209 passing** (0 failure(s)). +**219 / 219 passing** (0 failure(s)). | Suite | Passed | Total | Status | |-------|--------|-------|--------| @@ -11,4 +11,4 @@ | ticket | 31 | 31 | ok | | notify | 7 | 7 | ok | | reminders | 14 | 14 | ok | -| federation | 13 | 13 | ok | +| federation | 23 | 23 | ok | diff --git a/lib/events/tests/federation.sx b/lib/events/tests/federation.sx index 6ba375d0..166c10a8 100644 --- a/lib/events/tests/federation.sx +++ b/lib/events/tests/federation.sx @@ -143,6 +143,81 @@ (map (fn (o) (get o :origin)) pa) (list (quote tokyo) (quote tokyo) (quote tokyo)))))))))) +;; ---- federated free/busy ---- +(define + ev-fd-fb-run-all! + (fn + () + (let + ((local-db + (ev-avail-db + (list (ev-occ (quote yoga) (ev-dt 2026 6 1 9 0) 60)) + (list (list (quote nia) (str (quote yoga) "@" (ev-dt 2026 6 1 9 0)))))) + (berlin + (ev/peer-with-busy + (quote berlin) + (ev/empty) + (list + (list (quote nia) + (list (list (ev-dt 2026 6 1 14 0) (ev-dt 2026 6 1 15 0))))))) + (paris + (ev/peer-with-busy + (quote paris) + (ev/empty) + (list + (list (quote nia) + (list (list (ev-dt 2026 6 1 11 0) (ev-dt 2026 6 1 12 0)))))))) + (let + ((peers (list berlin paris))) + (do + ;; peer-busy reads a peer's published intervals + (ev-fd-check! + "peer-busy returns published intervals for an actor" + (ev/peer-busy berlin (quote nia)) + (list (list (ev-dt 2026 6 1 14 0) (ev-dt 2026 6 1 15 0)))) + (ev-fd-check! + "peer-busy empty for an actor with nothing published" + (ev/peer-busy berlin (quote zed)) + (list)) + ;; federated-busy unions local + trusted-peer busy, sorted + (ev-fd-check! + "federated-busy unions local + trusted peer, sorted" + (ev/federated-busy local-db (list berlin) (list (quote berlin)) (quote nia)) + (list + (list (ev-dt 2026 6 1 9 0) (ev-dt 2026 6 1 10 0)) + (list (ev-dt 2026 6 1 14 0) (ev-dt 2026 6 1 15 0)))) + (ev-fd-check! + "untrusted peer busy is excluded from federated-busy" + (ev/federated-busy local-db peers (list (quote berlin)) (quote nia)) + (list + (list (ev-dt 2026 6 1 9 0) (ev-dt 2026 6 1 10 0)) + (list (ev-dt 2026 6 1 14 0) (ev-dt 2026 6 1 15 0)))) + ;; federated-free? considers both local and trusted-peer commitments + (ev-fd-check! + "free locally and on peers in an open window" + (ev/federated-free? local-db peers (list (quote berlin)) (quote nia) (ev-dt 2026 6 1 16 0) (ev-dt 2026 6 1 17 0)) + true) + (ev-fd-check! + "not free during a LOCAL booking" + (ev/federated-free? local-db peers (list (quote berlin)) (quote nia) (ev-dt 2026 6 1 9 30) (ev-dt 2026 6 1 9 45)) + false) + (ev-fd-check! + "not free during a TRUSTED PEER busy interval" + (ev/federated-free? local-db peers (list (quote berlin)) (quote nia) (ev-dt 2026 6 1 14 30) (ev-dt 2026 6 1 14 45)) + false) + (ev-fd-check! + "free during an UNTRUSTED peer's busy interval (paris not trusted)" + (ev/federated-free? local-db peers (list (quote berlin)) (quote nia) (ev-dt 2026 6 1 11 15) (ev-dt 2026 6 1 11 45)) + true) + (ev-fd-check! + "not free once paris is trusted too" + (ev/federated-free? local-db peers (list (quote berlin) (quote paris)) (quote nia) (ev-dt 2026 6 1 11 15) (ev-dt 2026 6 1 11 45)) + false) + (ev-fd-check! + "federated-free? half-open at a busy edge" + (ev/federated-free? local-db peers (list (quote berlin)) (quote nia) (ev-dt 2026 6 1 15 0) (ev-dt 2026 6 1 16 0)) + true)))))) + (define ev-federation-tests-run! (fn @@ -152,4 +227,5 @@ (set! ev-fd-fail 0) (set! ev-fd-failures (list)) (ev-fd-run-all!) + (ev-fd-fb-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 7c2402c0..376bb418 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` → **209/209** (Phases 1-4 complete: calendar, booking, notify, federation) +`bash lib/events/conformance.sh` → **219/219** (Phases 1-4 + ext: federated free/busy) ## Ground rules @@ -81,11 +81,18 @@ lib/events/api.sx ── (events/schedule) (events/book) (events/agenda) ── ## Phase 4 — Federation - [x] cross-instance events (peer calendar) — trust-gated stub - [x] tests: federated agenda merge -- [ ] federated availability/free-busy across trusted peers +- [x] federated availability/free-busy across trusted peers - [ ] real transport behind `ev/peer-agenda` (fed-sx / signed fetch) ## Progress log +- 2026-06-07 — Federated free/busy (extension). Peers publish BUSY intervals + per actor (iCal free/busy model — privacy-preserving, not event details). + `ev/peer-with-busy`, `ev/peer-busy`; `ev/federated-busy` unions local + availability-db busy + trusted peers' published busy (sorted); + `ev/federated-free?` answers "is X free in [qs,qe)?" across instances, + half-open, trust-gated (untrusted peers' busy ignored; revocation immediate). + +10 tests, 219/219 green. - 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