events: Phase 4 federation — trust-gated peer agenda merge + 13 tests
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 17s
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 17s
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>
This commit is contained in:
155
lib/events/tests/federation.sx
Normal file
155
lib/events/tests/federation.sx
Normal file
@@ -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})))
|
||||
Reference in New Issue
Block a user