sx-gitea Phase 2: access — acl-backed permissions, collaborators, teams, auth-gated routes (TDD, 194/194)
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>
This commit is contained in:
403
lib/gitea/access.sx
Normal file
403
lib/gitea/access.sx
Normal file
@@ -0,0 +1,403 @@
|
||||
; 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))))
|
||||
Reference in New Issue
Block a user