rose-ash/lib/gitea/fed.sx

; 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)))