giles
1f7f98d0ce
lib/gitea/access.sx: repo role groups (admin>write>read) as acl facts saturated by the datalog engine; user-owner => admin; collaborators (per-repo role, upsert); org teams (one role, 'all' or scoped repo list); org-admin?; visible-repos; create-allowed?; bearer tokens in kv. Facts derived from forge state, acl db cached in the forge handle and rebuilt only when facts change. lib/gitea/web.sx: every repo route now requires read (404 hides private repos); repo create needs owner/org-admin, delete + collaborator API need admin (401 no credentials / 403 not allowed); index + /api/repos list only visible repos; PUT/DELETE collab endpoints. tests/access.sx (103) + repo suite updated for gating (91). Fixed a web.sx corruption from the known sx_find_all/sx_replace_node path mismatch by rewriting via sx_write_file; suite timeout 300->600s. Co-Authored-By: Claude Fable 5 <noreply@anthropic.com>
404 lines
12 KiB
Plaintext
404 lines
12 KiB
Plaintext
; 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))))
|