events: federated free/busy across trusted peers + 10 tests
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 1m4s
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:
@@ -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})))
|
||||
|
||||
Reference in New Issue
Block a user