events: federated free/busy across trusted peers + 10 tests
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 1m4s

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) <noreply@anthropic.com>
This commit is contained in:
2026-06-07 05:32:04 +00:00
parent 80174c7197
commit 29127d8613
5 changed files with 159 additions and 9 deletions

View File

@@ -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})))