; lib/gitea/access.sx — sx-gitea Phase 2: permissions over lib/acl.
;
; Model: each repo exposes three role groups ("read:"/"write:"/"admin:" +
; "repo:<owner>/<name>") with hierarchical action grants (admin > write >
; read). A user-owner is a member of the admin group. Collaborators join
; the group for their role. Org repos add team groups: a team has a role
; and a repo scope ("all" or a name list); team members join the team
; group, the team group joins the covered repos' role groups. Facts are
; derived from forge state and saturated by the acl datalog engine —
; deny-wins and group nesting come for free.
;
; Public visibility is an engine short-circuit: "read" on a public repo is
; always permitted, even anonymously (subject nil never reaches acl).
;
; Auth is bearer tokens in the kv store — Phase 8 federates identity.
;
; Requires: lib/gitea/repo.sx, lib/datalog/* stack,
; lib/acl/{schema,facts,engine}.sx

(define gitea/roles (list "read" "write" "admin"))
(define gitea/role-valid? (fn (r) (contains? gitea/roles r)))

; actions implied by holding a role on a repo
(define
  gitea/role-actions
  (fn
    (role)
    (cond
      ((equal? role "read") (list "read"))
      ((equal? role "write") (list "read" "write"))
      ((equal? role "admin") (list "read" "write" "admin"))
      (else (list)))))

(define gitea/repo-res (fn (owner name) (str "repo:" owner "/" name)))
(define gitea/role-group (fn (res role) (str role ":" res)))
(define gitea/team-id (fn (org team) (str "team:" org "/" team)))

(define
  gitea/split-full
  (fn (full) (let ((i (index-of full "/"))) {:name (substr full (+ i 1)) :owner (substr full 0 i)})))

; ── collaborators ────────────────────────────────────────────────────

(define
  gitea/collab-key
  (fn (owner name user) (str "gitea/collab/" owner "/" name "/" user)))

; upsert: adding an existing collaborator changes their role
(define
  gitea/collab-add!
  (fn
    (forge owner name user role)
    (cond
      ((not (gitea/repo-exists? forge owner name)) {:error "no-such-repo"})
      ((not (gitea/owner-exists? forge user)) {:error "no-such-user"})
      ((not (gitea/role-valid? role)) {:error "invalid-role"})
      (else
        (persist/kv-put
          (gitea/forge-db forge)
          (gitea/collab-key owner name user)
          {:role role :user user})))))

(define
  gitea/collab-get
  (fn
    (forge owner name user)
    (persist/kv-get
      (gitea/forge-db forge)
      (gitea/collab-key owner name user))))

(define
  gitea/collab-role
  (fn
    (forge owner name user)
    (get (or (gitea/collab-get forge owner name user) {}) :role)))

(define
  gitea/collab-remove!
  (fn
    (forge owner name user)
    (if
      (nil? (gitea/collab-get forge owner name user))
      false
      (begin
        (persist/kv-delete
          (gitea/forge-db forge)
          (gitea/collab-key owner name user))
        true))))

(define
  gitea/collabs
  (fn
    (forge owner name)
    (gitea/names-under forge (str "gitea/collab/" owner "/" name "/"))))

; ── teams ────────────────────────────────────────────────────────────
; A team belongs to an org, carries ONE role, and covers either every org
; repo (:repos "all") or an explicit list of repo names.

(define gitea/team-key (fn (org team) (str "gitea/team/" org "/" team)))
(define
  gitea/teammem-key
  (fn (org team user) (str "gitea/teammem/" org "/" team "/" user)))

(define
  gitea/team-create!
  (fn
    (forge org team role)
    (let
      ((orec (gitea/owner-get forge org)))
      (cond
        ((or (nil? orec) (not (gitea/org? orec))) {:error "no-such-org"})
        ((not (gitea/valid-name? team)) {:error "invalid-name"})
        ((not (gitea/role-valid? role)) {:error "invalid-role"})
        (else
          (persist/kv-put-new
            (gitea/forge-db forge)
            (gitea/team-key org team)
            {:name team :org org :repos "all" :role role}))))))

(define
  gitea/team-get
  (fn
    (forge org team)
    (persist/kv-get (gitea/forge-db forge) (gitea/team-key org team))))

(define
  gitea/teams
  (fn (forge org) (gitea/names-under forge (str "gitea/team/" org "/"))))

(define
  gitea/team-set-repos!
  (fn
    (forge org team repos)
    (let
      ((rec (gitea/team-get forge org team)))
      (if
        (nil? rec)
        nil
        (persist/kv-put
          (gitea/forge-db forge)
          (gitea/team-key org team)
          (assoc rec :repos repos))))))

(define
  gitea/team-add-member!
  (fn
    (forge org team user)
    (cond
      ((nil? (gitea/team-get forge org team)) {:error "no-such-team"})
      ((not (gitea/owner-exists? forge user)) {:error "no-such-user"})
      (else
        (persist/kv-put
          (gitea/forge-db forge)
          (gitea/teammem-key org team user)
          {:user user})))))

(define
  gitea/team-remove-member!
  (fn
    (forge org team user)
    (let
      ((k (gitea/teammem-key org team user)))
      (if
        (persist/kv-has? (gitea/forge-db forge) k)
        (begin (persist/kv-delete (gitea/forge-db forge) k) true)
        false))))

(define
  gitea/team-members
  (fn
    (forge org team)
    (gitea/names-under forge (str "gitea/teammem/" org "/" team "/"))))

(define
  gitea/team-delete!
  (fn
    (forge org team)
    (if
      (nil? (gitea/team-get forge org team))
      false
      (let
        ((db (gitea/forge-db forge)))
        (begin
          (for-each
            (fn (u) (persist/kv-delete db (gitea/teammem-key org team u)))
            (gitea/team-members forge org team))
          (persist/kv-delete db (gitea/team-key org team))
          true)))))

(define
  gitea/team-covers?
  (fn
    (trec name)
    (let
      ((repos (get trec :repos)))
      (or (equal? repos "all") (and (list? repos) (contains? repos name))))))

; org admin = member of an admin-role team that covers every repo
(define
  gitea/org-admin?
  (fn
    (forge org user)
    (reduce
      (fn
        (acc tname)
        (or
          acc
          (let
            ((trec (gitea/team-get forge org tname)))
            (and
              (equal? (get trec :role) "admin")
              (equal? (get trec :repos) "all")
              (contains? (gitea/team-members forge org tname) user)))))
      false
      (gitea/teams forge org))))

; ── acl fact derivation ──────────────────────────────────────────────

(define
  gitea/access-facts
  (fn
    (forge)
    (let
      ((facts (list)))
      (begin
        (for-each
          (fn
            (full)
            (let
              ((p (gitea/split-full full)))
              (let
                ((owner (get p :owner)) (name (get p :name)))
                (let
                  ((res (gitea/repo-res owner name))
                    (orec (gitea/owner-get forge owner)))
                  (begin
                    (for-each
                      (fn
                        (role)
                        (for-each
                          (fn
                            (act)
                            (append!
                              facts
                              (acl-grant (gitea/role-group res role) act res)))
                          (gitea/role-actions role)))
                      gitea/roles)
                    (if
                      (and orec (gitea/user? orec))
                      (append!
                        facts
                        (acl-member-of owner (gitea/role-group res "admin")))
                      nil)
                    (for-each
                      (fn
                        (user)
                        (append!
                          facts
                          (acl-member-of
                            user
                            (gitea/role-group
                              res
                              (gitea/collab-role forge owner name user)))))
                      (gitea/collabs forge owner name))
                    (if
                      (and orec (gitea/org? orec))
                      (for-each
                        (fn
                          (tname)
                          (let
                            ((trec (gitea/team-get forge owner tname)))
                            (if
                              (gitea/team-covers? trec name)
                              (append!
                                facts
                                (acl-member-of
                                  (gitea/team-id owner tname)
                                  (gitea/role-group res (get trec :role))))
                              nil)))
                        (gitea/teams forge owner))
                      nil))))))
          (gitea/repos forge))
        (for-each
          (fn
            (owner)
            (let
              ((orec (gitea/owner-get forge owner)))
              (if
                (and orec (gitea/org? orec))
                (for-each
                  (fn
                    (tname)
                    (for-each
                      (fn
                        (user)
                        (append!
                          facts
                          (acl-member-of user (gitea/team-id owner tname))))
                      (gitea/team-members forge owner tname)))
                  (gitea/teams forge owner))
                nil)))
          (gitea/owners forge))
        facts))))

; rebuild the acl db only when derived facts changed (cache in the forge
; handle; forges created before the :cache field just rebuild every call)
(define
  gitea/access-db
  (fn
    (forge)
    (let
      ((facts (gitea/access-facts forge)) (cache (get forge :cache)))
      (if
        (and cache (= (get cache "facts") facts) (get cache "db"))
        (get cache "db")
        (let
          ((db (acl-build-db facts)))
          (begin
            (if
              cache
              (begin
                (dict-set! cache "facts" facts)
                (dict-set! cache "db" db))
              nil)
            db))))))

; ── the permission question ──────────────────────────────────────────

(define
  gitea/can?
  (fn
    (forge subj action owner name)
    (let
      ((rec (gitea/repo-get forge owner name)))
      (cond
        ((nil? rec) false)
        ((and (equal? action "read") (equal? (get rec :visibility) "public"))
          true)
        ((nil? subj) false)
        (else
          (acl-permit?
            (gitea/access-db forge)
            subj
            action
            (gitea/repo-res owner name)))))))

(define
  gitea/visible-repos
  (fn
    (forge subj)
    (filter
      (fn
        (full)
        (let
          ((p (gitea/split-full full)))
          (gitea/can? forge subj "read" (get p :owner) (get p :name))))
      (gitea/repos forge))))

; who may create a repo under this owner?
(define
  gitea/create-allowed?
  (fn
    (forge user owner)
    (let
      ((orec (gitea/owner-get forge owner)))
      (cond
        ((nil? user) false)
        ((nil? orec) false)
        ((gitea/user? orec) (equal? user owner))
        (else (gitea/org-admin? forge owner user))))))

; ── bearer tokens ────────────────────────────────────────────────────

(define gitea/token-key (fn (token) (str "gitea/token/" token)))

(define
  gitea/token-create!
  (fn
    (forge user token)
    (if
      (not (gitea/owner-exists? forge user))
      {:error "no-such-user"}
      (persist/kv-put
        (gitea/forge-db forge)
        (gitea/token-key token)
        {:user user}))))

(define
  gitea/token-user
  (fn
    (forge token)
    (get
      (or
        (persist/kv-get (gitea/forge-db forge) (gitea/token-key token))
        {})
      :user)))

(define
  gitea/token-revoke!
  (fn
    (forge token)
    (persist/kv-delete (gitea/forge-db forge) (gitea/token-key token))))