sx-gitea Phase 8: fed — ForgeFed federation (TDD, 615/615 all suites)
lib/gitea/fed.sx: forges federate as peers. Each forge carries an instance id; users and repos project as AP actor documents (Person/ Group/Repository with inbox/outbox + clone endpoint); the outbox is the activity log in an AP-shaped envelope. Trust follows the events-federation pattern — a kv set of peer ids RE-CHECKED on every operation (inbox, mirror sync, delivery), so revoking a peer takes effect immediately; peer transports (dream app fns) live only in the runtime cache. Inbox (POST /api/ap/inbox, trust-gated): every accepted activity lands in a federated log with :origin provenance; open-issue/comment/open-pr MATERIALIZE — the foreign author becomes an auto-created proxy user '<name>@<peer>' and the issue/comment/PR is created locally under that identity. fed-deliver! pushes public-repo activities (cursor-based, never private) to every trusted peer's inbox. Cross-instance repo follow = mirror!/mirror-sync! over the Phase 3 wire client. fed-timeline merges local + foreign activities with provenance tags. Suite: two in-memory forges federating end to end — actor docs, trust lifecycle, materialization, proxy-user reuse, wire inbox 400/403/200, mirrors (clone/sync/trust-revocation), cursor delivery, timelines. Adds lib/gitea/README.md (composition map, architectural rules, known limits). Final scoreboard: 615/615 across repo/access/wire/issues/pr/ activity/search/fed. Co-Authored-By: Claude Fable 5 <noreply@anthropic.com>
This commit is contained in:
449
lib/gitea/fed.sx
Normal file
449
lib/gitea/fed.sx
Normal file
@@ -0,0 +1,449 @@
|
||||
; lib/gitea/fed.sx — sx-gitea Phase 8: ForgeFed federation.
|
||||
;
|
||||
; Forges federate as fed-sx-style peers. Each forge carries an instance
|
||||
; id; users and repos project as AP actor documents (Person/Repository
|
||||
; with inbox/outbox); the outbox is the forge's activity log in an
|
||||
; AP-shaped envelope ({:actor "<instance>/user:<u>" :verb :object
|
||||
; :published}).
|
||||
;
|
||||
; Trust is the events-federation pattern: a kv set of peer ids,
|
||||
; RE-CHECKED on every operation, so revoking a peer takes effect
|
||||
; immediately. Peer transports (dream app fns) live in the forge handle's
|
||||
; runtime cache — only the trust set persists.
|
||||
;
|
||||
; The inbox (POST /api/ap/inbox, {:peer :activity}) accepts activities
|
||||
; from trusted peers only. Every accepted activity lands in a federated
|
||||
; activity log with :origin provenance; open-issue/comment/open-pr
|
||||
; activities also MATERIALIZE: the foreign author becomes a proxy user
|
||||
; "<name>@<peer>" (auto-created), and the issue/comment/PR is created
|
||||
; locally under that identity — federated issues and PRs with honest
|
||||
; provenance. fed-deliver! pushes public-repo activities (cursor-based,
|
||||
; never private ones) to every trusted peer's inbox.
|
||||
;
|
||||
; Cross-instance repo follow = mirror!: clone a trusted peer's repo over
|
||||
; the Phase 3 wire client, remember the source, and mirror-sync! to
|
||||
; fast-forward — trust re-checked on every sync.
|
||||
;
|
||||
; Requires: lib/gitea/{repo,access,web,wire,issues,pr,activity}.sx and
|
||||
; their stacks.
|
||||
|
||||
; ── instance identity ────────────────────────────────────────────────
|
||||
|
||||
(define gitea/instance-key "gitea/instance")
|
||||
|
||||
(define
|
||||
gitea/instance!
|
||||
(fn
|
||||
(forge id)
|
||||
(persist/kv-put (gitea/forge-db forge) gitea/instance-key {:id id})))
|
||||
|
||||
(define
|
||||
gitea/instance-id
|
||||
(fn
|
||||
(forge)
|
||||
(get
|
||||
(or
|
||||
(persist/kv-get (gitea/forge-db forge) gitea/instance-key)
|
||||
{})
|
||||
:id)))
|
||||
|
||||
(define
|
||||
gitea/actor-id
|
||||
(fn (forge node) (str (or (gitea/instance-id forge) "local") "/" node)))
|
||||
|
||||
; ── peers + trust ────────────────────────────────────────────────────
|
||||
|
||||
; transports are live functions — runtime registry in the forge cache
|
||||
(define
|
||||
gitea/peers-registry
|
||||
(fn
|
||||
(forge)
|
||||
(let
|
||||
((cache (get forge :cache)))
|
||||
(begin
|
||||
(if
|
||||
(and cache (nil? (get cache "peers")))
|
||||
(dict-set! cache "peers" {})
|
||||
nil)
|
||||
(or (get cache "peers") {})))))
|
||||
|
||||
(define
|
||||
gitea/peer-register!
|
||||
(fn
|
||||
(forge id app token)
|
||||
(let
|
||||
((cache (get forge :cache)))
|
||||
(begin
|
||||
(dict-set!
|
||||
cache
|
||||
"peers"
|
||||
(assoc (gitea/peers-registry forge) id {:id id :token token :app app}))
|
||||
id))))
|
||||
|
||||
(define
|
||||
gitea/peer-get
|
||||
(fn (forge id) (get (gitea/peers-registry forge) id)))
|
||||
|
||||
(define gitea/trust-key (fn (id) (str "gitea/trust/" id)))
|
||||
|
||||
(define
|
||||
gitea/trust!
|
||||
(fn
|
||||
(forge id)
|
||||
(persist/kv-put (gitea/forge-db forge) (gitea/trust-key id) {:id id})))
|
||||
|
||||
(define
|
||||
gitea/untrust!
|
||||
(fn
|
||||
(forge id)
|
||||
(persist/kv-delete (gitea/forge-db forge) (gitea/trust-key id))))
|
||||
|
||||
(define
|
||||
gitea/trusted?
|
||||
(fn
|
||||
(forge id)
|
||||
(persist/kv-has? (gitea/forge-db forge) (gitea/trust-key id))))
|
||||
|
||||
(define
|
||||
gitea/trusted-peers
|
||||
(fn
|
||||
(forge)
|
||||
(filter
|
||||
(fn (id) (gitea/trusted? forge id))
|
||||
(artdag/sort-strings (keys (gitea/peers-registry forge))))))
|
||||
|
||||
; ── AP actor documents ───────────────────────────────────────────────
|
||||
|
||||
(define
|
||||
gitea/ap-user
|
||||
(fn
|
||||
(forge user)
|
||||
(let
|
||||
((rec (gitea/owner-get forge user)))
|
||||
(if (nil? rec) nil {:id (gitea/actor-id forge (str "user:" user)) :type (if (gitea/org? rec) "Group" "Person") :outbox (str "/api/ap/users/" user "/outbox") :preferredUsername user :inbox "/api/ap/inbox"}))))
|
||||
|
||||
(define
|
||||
gitea/ap-repo
|
||||
(fn
|
||||
(forge owner name)
|
||||
(let
|
||||
((rec (gitea/repo-get forge owner name)))
|
||||
(if (nil? rec) nil {:clone (str "/" owner "/" name "/info/refs") :name (str owner "/" name) :id (gitea/actor-id forge (str "repo:" owner "/" name)) :attributedTo (gitea/actor-id forge (str "user:" owner)) :type "Repository" :summary (get rec :description) :inbox "/api/ap/inbox"}))))
|
||||
|
||||
; AP-shaped envelope for a feed activity
|
||||
(define gitea/ap-activity (fn (forge a) {:published (get a :at) :actor (gitea/actor-id forge (str "user:" (get a :actor))) :object (get a :object) :verb (get a :verb)}))
|
||||
|
||||
(define
|
||||
gitea/ap-outbox
|
||||
(fn
|
||||
(forge user n)
|
||||
(map
|
||||
(fn (a) (gitea/ap-activity forge a))
|
||||
(gitea/user-timeline forge nil user n))))
|
||||
|
||||
; ── federated activity log (inbound, with provenance) ────────────────
|
||||
|
||||
(define gitea/fed-stream-name "gitea/fed-activity")
|
||||
|
||||
(define
|
||||
gitea/fed-log
|
||||
(fn
|
||||
(forge)
|
||||
(map
|
||||
persist/event-data
|
||||
(persist/read (gitea/forge-db forge) gitea/fed-stream-name))))
|
||||
|
||||
(define
|
||||
gitea/fed-log-append!
|
||||
(fn
|
||||
(forge origin a)
|
||||
(persist/append
|
||||
(gitea/forge-db forge)
|
||||
gitea/fed-stream-name
|
||||
(or (get a :verb) "activity")
|
||||
(or (get a :at) 0)
|
||||
{:activity a :origin origin})))
|
||||
|
||||
; local + foreign activities, newest first, foreign tagged :origin
|
||||
(define
|
||||
gitea/fed-timeline
|
||||
(fn
|
||||
(forge user n)
|
||||
(feed/items
|
||||
(feed/take
|
||||
(feed/recent
|
||||
(feed/stream
|
||||
(concat
|
||||
(feed/items
|
||||
(feed/filter
|
||||
(gitea/activity-stream forge)
|
||||
(fn (a) (gitea/act-visible? forge user a))))
|
||||
(map
|
||||
(fn (e) (assoc (get e :activity) :origin (get e :origin)))
|
||||
(gitea/fed-log forge)))))
|
||||
n))))
|
||||
|
||||
; ── inbound materialization ──────────────────────────────────────────
|
||||
|
||||
; foreign authors become local proxy users "<name>@<peer>"
|
||||
(define
|
||||
gitea/fed-user!
|
||||
(fn
|
||||
(forge name peer)
|
||||
(let
|
||||
((proxy (str name "@" peer)))
|
||||
(begin
|
||||
(if
|
||||
(gitea/owner-exists? forge proxy)
|
||||
nil
|
||||
(gitea/user-create! forge proxy))
|
||||
proxy))))
|
||||
|
||||
; a foreign activity's :actor may be "<instance>/user:<name>" or a bare
|
||||
; name — reduce it to the name
|
||||
(define
|
||||
gitea/fed-actor-name
|
||||
(fn
|
||||
(actor)
|
||||
(let
|
||||
((i (index-of (or actor "") "user:")))
|
||||
(if (< i 0) (or actor "") (substr actor (+ i 5))))))
|
||||
|
||||
; apply one trusted activity: log it, and materialize the verbs a forge
|
||||
; can host locally. => {:accepted true ...} | {:error ...}
|
||||
(define
|
||||
gitea/fed-receive!
|
||||
(fn
|
||||
(forge peer a)
|
||||
(if
|
||||
(not (gitea/trusted? forge peer))
|
||||
{:error "untrusted-peer"}
|
||||
(let
|
||||
((verb (get a :verb))
|
||||
(actor (gitea/fed-actor-name (get a :actor)))
|
||||
(node (gitea/parse-numbered-node (or (get a :object) "")))
|
||||
(detail (or (get a :detail) {})))
|
||||
(begin
|
||||
(gitea/fed-log-append! forge peer a)
|
||||
(cond
|
||||
((= verb "open-issue")
|
||||
(let
|
||||
((rp (gitea/split-full (substr (or (gitea/act-repo a) "repo:/") 5))))
|
||||
(let
|
||||
((res (gitea/issue-create! forge (get rp :owner) (get rp :name) (gitea/fed-user! forge actor peer) (or (get detail :title) "(federated issue)") (or (get detail :body) "") {:created-at (or (get a :at) 0)})))
|
||||
(if (get res :error) res {:materialized "issue" :accepted true :number (get res :number)}))))
|
||||
((= verb "comment")
|
||||
(if
|
||||
(nil? node)
|
||||
{:error "bad-object"}
|
||||
(let
|
||||
((res (gitea/issue-comment! forge (get node :owner) (get node :name) (get node :n) (gitea/fed-user! forge actor peer) (or (get detail :body) "") {:at (or (get a :at) 0)})))
|
||||
(if (get res :error) res {:materialized "comment" :accepted true}))))
|
||||
((= verb "open-pr")
|
||||
(let
|
||||
((rp (gitea/split-full (substr (or (gitea/act-repo a) "repo:/") 5))))
|
||||
(let
|
||||
((res (gitea/pr-create! forge (get rp :owner) (get rp :name) (gitea/fed-user! forge actor peer) (or (get detail :title) "(federated pr)") (get detail :source) (get detail :target) (or (get detail :body) "") {:created-at (or (get a :at) 0)})))
|
||||
(if (get res :error) res {:materialized "pr" :accepted true :number (get res :number)}))))
|
||||
(else {:materialized "none" :accepted true})))))))
|
||||
|
||||
; ── outbound delivery ────────────────────────────────────────────────
|
||||
|
||||
(define gitea/fed-cursor-key "gitea/fed-cursor")
|
||||
|
||||
; push public-repo activities after the cursor to every trusted peer's
|
||||
; inbox. => {:delivered n :peers (ids)}
|
||||
(define
|
||||
gitea/fed-deliver!
|
||||
(fn
|
||||
(forge)
|
||||
(let
|
||||
((db (gitea/forge-db forge)))
|
||||
(let
|
||||
((cursor (persist/kv-get-or db gitea/fed-cursor-key 0))
|
||||
(peers (gitea/trusted-peers forge))
|
||||
(me (or (gitea/instance-id forge) "local")))
|
||||
(let
|
||||
((events (persist/read-from db gitea/activity-stream-name (+ cursor 1))))
|
||||
(let
|
||||
((public (filter (fn (e) (gitea/act-visible? forge nil (persist/event-data e))) events)))
|
||||
(begin
|
||||
(for-each
|
||||
(fn
|
||||
(e)
|
||||
(for-each
|
||||
(fn
|
||||
(pid)
|
||||
(let
|
||||
((peer (gitea/peer-get forge pid)))
|
||||
(if
|
||||
(nil? peer)
|
||||
nil
|
||||
((get peer :app)
|
||||
(dream-request
|
||||
"POST"
|
||||
"/api/ap/inbox"
|
||||
(if
|
||||
(nil? (get peer :token))
|
||||
{}
|
||||
{:authorization (str "Bearer " (get peer :token))})
|
||||
(dream-json-encode {:activity (persist/event-data e) :peer me}))))))
|
||||
peers))
|
||||
public)
|
||||
(if
|
||||
(empty? events)
|
||||
nil
|
||||
(persist/kv-put
|
||||
db
|
||||
gitea/fed-cursor-key
|
||||
(reduce (fn (acc e) (persist/event-seq e)) cursor events)))
|
||||
{:delivered (len public) :peers peers})))))))
|
||||
|
||||
; ── cross-instance repo follow (mirrors) ─────────────────────────────
|
||||
|
||||
(define
|
||||
gitea/mirror-key
|
||||
(fn (owner name) (str "gitea/mirror/" owner "/" name)))
|
||||
|
||||
(define
|
||||
gitea/peer-remote
|
||||
(fn
|
||||
(forge peer-id owner name)
|
||||
(let
|
||||
((peer (gitea/peer-get forge peer-id)))
|
||||
(if
|
||||
(nil? peer)
|
||||
nil
|
||||
(gitea/remote (get peer :app) owner name (get peer :token))))))
|
||||
|
||||
; clone a trusted peer's repo as owner/name and remember the source
|
||||
(define
|
||||
gitea/mirror!
|
||||
(fn
|
||||
(forge owner name peer-id remote-owner remote-name)
|
||||
(cond
|
||||
((not (gitea/trusted? forge peer-id)) {:error "untrusted-peer"})
|
||||
((nil? (gitea/peer-get forge peer-id)) {:error "no-such-peer"})
|
||||
(else
|
||||
(let
|
||||
((remote (gitea/peer-remote forge peer-id remote-owner remote-name)))
|
||||
(let
|
||||
((res (gitea/clone! forge owner name remote {})))
|
||||
(if
|
||||
(or (get res :error) (get res :conflict))
|
||||
res
|
||||
(begin
|
||||
(persist/kv-put
|
||||
(gitea/forge-db forge)
|
||||
(gitea/mirror-key owner name)
|
||||
{:remote-owner remote-owner :peer peer-id :remote-name remote-name})
|
||||
res))))))))
|
||||
|
||||
(define
|
||||
gitea/mirror-of
|
||||
(fn
|
||||
(forge owner name)
|
||||
(persist/kv-get (gitea/forge-db forge) (gitea/mirror-key owner name))))
|
||||
|
||||
(define
|
||||
gitea/mirrors
|
||||
(fn (forge) (gitea/names-under forge "gitea/mirror/")))
|
||||
|
||||
; re-fetch from the mirror source; trust is re-checked every sync
|
||||
(define
|
||||
gitea/mirror-sync!
|
||||
(fn
|
||||
(forge owner name)
|
||||
(let
|
||||
((m (gitea/mirror-of forge owner name)))
|
||||
(cond
|
||||
((nil? m) {:error "not-a-mirror"})
|
||||
((not (gitea/trusted? forge (get m :peer))) {:error "untrusted-peer"})
|
||||
((nil? (gitea/peer-get forge (get m :peer))) {:error "no-such-peer"})
|
||||
(else
|
||||
(gitea/fetch!
|
||||
(gitea/peer-remote
|
||||
forge
|
||||
(get m :peer)
|
||||
(get m :remote-owner)
|
||||
(get m :remote-name))
|
||||
(gitea/repo-git forge owner name)))))))
|
||||
|
||||
; ── web ──────────────────────────────────────────────────────────────
|
||||
|
||||
(define
|
||||
gitea/w-ap-user
|
||||
(fn
|
||||
(forge req)
|
||||
(let
|
||||
((doc (gitea/ap-user forge (dream-param req "user"))))
|
||||
(if (nil? doc) (dream-not-found) (dream-json-value doc)))))
|
||||
|
||||
(define
|
||||
gitea/w-ap-repo
|
||||
(fn
|
||||
(forge req)
|
||||
(let
|
||||
((owner (dream-param req "owner")) (name (dream-param req "name")))
|
||||
(if
|
||||
(not (gitea/w-readable? forge req owner name))
|
||||
(dream-not-found)
|
||||
(dream-json-value (gitea/ap-repo forge owner name))))))
|
||||
|
||||
(define
|
||||
gitea/w-ap-outbox
|
||||
(fn
|
||||
(forge req)
|
||||
(let
|
||||
((user (dream-param req "user")))
|
||||
(if
|
||||
(not (gitea/owner-exists? forge user))
|
||||
(dream-not-found)
|
||||
(dream-json-value (gitea/ap-outbox forge user 50))))))
|
||||
|
||||
(define
|
||||
gitea/w-ap-inbox
|
||||
(fn
|
||||
(forge req)
|
||||
(let
|
||||
((body (dream-json-body req)))
|
||||
(let
|
||||
((peer (get body :peer)))
|
||||
(cond
|
||||
((nil? peer) (gitea/w-json-status 400 {:error "missing-peer"}))
|
||||
((not (gitea/trusted? forge peer)) (gitea/w-forbidden))
|
||||
(else
|
||||
(let
|
||||
((res (gitea/fed-receive! forge peer (or (get body :activity) {}))))
|
||||
(if
|
||||
(get res :error)
|
||||
(gitea/w-json-status 400 {:error (get res :error)})
|
||||
(dream-json-value res)))))))))
|
||||
|
||||
(define
|
||||
gitea/w-fed-timeline
|
||||
(fn
|
||||
(forge req)
|
||||
(dream-json-value
|
||||
(gitea/fed-timeline forge (gitea/w-user forge req) 50))))
|
||||
|
||||
(define
|
||||
gitea/fed-routes
|
||||
(fn
|
||||
(forge)
|
||||
(list
|
||||
(dream-get
|
||||
"/api/ap/users/:user"
|
||||
(fn (req) (gitea/w-ap-user forge req)))
|
||||
(dream-get
|
||||
"/api/ap/users/:user/outbox"
|
||||
(fn (req) (gitea/w-ap-outbox forge req)))
|
||||
(dream-get
|
||||
"/api/ap/repos/:owner/:name"
|
||||
(fn (req) (gitea/w-ap-repo forge req)))
|
||||
(dream-post "/api/ap/inbox" (fn (req) (gitea/w-ap-inbox forge req)))
|
||||
(dream-get
|
||||
"/api/fed/timeline"
|
||||
(fn (req) (gitea/w-fed-timeline forge req))))))
|
||||
|
||||
(set! gitea/route-packs (append gitea/route-packs (list gitea/fed-routes)))
|
||||
Reference in New Issue
Block a user