giles
80174c7197
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>
99 lines
3.0 KiB
Plaintext
99 lines
3.0 KiB
Plaintext
;; 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)))
|