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:
2026-07-03 13:21:57 +00:00
parent c037aca51f
commit 1f7f98d0ce
8 changed files with 1166 additions and 84 deletions

View File

@@ -1,12 +1,18 @@
; lib/gitea/web.sx — sx-gitea Phase 1: browse views over dream.
; lib/gitea/web.sx — sx-gitea Phases 1+2: browse views over dream, gated
; by access control.
;
; Pure request -> response handlers: repo list, repo home, tree/blob/raw
; browse at any ref (branch, tag, or cid), commit log, single-commit diff,
; plus a small JSON API for repo create/list/delete. No auth yet — Phase 2
; (access) gates these routes.
; plus a JSON API for repo create/list/delete and collaborator management.
;
; Requires: lib/gitea/repo.sx, lib/dream/{types,router,middleware,error,
; html,json,api}.sx
; Gating: every repo route requires "read" (a miss is a 404 — private
; repos are indistinguishable from absent ones); mutations require the
; caller to authenticate (bearer token) and hold the right role: create
; needs the owner (or org admin), delete and collaborator management need
; "admin". 401 = no credentials, 403 = authenticated but not allowed.
;
; Requires: lib/gitea/{repo,access}.sx, lib/dream/{types,router,middleware,
; error,html,json,auth,api}.sx
; ── html scaffolding ─────────────────────────────────────────────────
@@ -28,6 +34,34 @@
(full)
(str "<li><a href=\"/" full "\">" (dream-escape full) "</a></li>")))
; ── auth helpers ─────────────────────────────────────────────────────
(define
gitea/w-user
(fn
(forge req)
(let
((tok (dream-bearer-token req)))
(if (nil? tok) nil (gitea/token-user forge tok)))))
(define
gitea/w-json-status
(fn (status v) (dream-response status {:content-type "application/json"} (dream-json-encode v))))
(define
gitea/w-unauthorized
(fn () (gitea/w-json-status 401 {:error "unauthorized"})))
(define
gitea/w-forbidden
(fn () (gitea/w-json-status 403 {:error "forbidden"})))
; can the requester read this repo? (false covers missing repos too)
(define
gitea/w-readable?
(fn
(forge req owner name)
(gitea/can? forge (gitea/w-user forge req) "read" owner name)))
; ── pages ────────────────────────────────────────────────────────────
(define
@@ -38,7 +72,11 @@
"repositories"
(str
"<h1>Repositories</h1><ul>"
(join "" (map gitea/w-repo-link (gitea/repos forge)))
(join
""
(map
gitea/w-repo-link
(gitea/visible-repos forge (gitea/w-user forge req))))
"</ul>"))))
(define
@@ -62,36 +100,35 @@
(forge req)
(let
((owner (dream-param req "owner")) (name (dream-param req "name")))
(let
((rec (gitea/repo-get forge owner name)))
(if
(nil? rec)
(dream-not-found)
(let
((branches (git/branches (gitea/repo-git forge owner name))))
(gitea/w-page
(str owner "/" name)
(str
"<h1>"
(dream-escape (str owner "/" name))
"</h1>"
"<p>"
(dream-escape (or (get rec :description) ""))
"</p>"
"<p>visibility: "
(dream-escape (get rec :visibility))
"</p>"
(if
(empty? branches)
"<p>empty repository</p>"
(str
"<h2>Branches</h2><ul>"
(join
""
(map
(fn (b) (gitea/w-branch-item owner name b))
branches))
"</ul>"))))))))))
(if
(not (gitea/w-readable? forge req owner name))
(dream-not-found)
(let
((rec (gitea/repo-get forge owner name))
(branches (git/branches (gitea/repo-git forge owner name))))
(gitea/w-page
(str owner "/" name)
(str
"<h1>"
(dream-escape (str owner "/" name))
"</h1>"
"<p>"
(dream-escape (or (get rec :description) ""))
"</p>"
"<p>visibility: "
(dream-escape (get rec :visibility))
"</p>"
(if
(empty? branches)
"<p>empty repository</p>"
(str
"<h2>Branches</h2><ul>"
(join
""
(map
(fn (b) (gitea/w-branch-item owner name b))
branches))
"</ul>")))))))))
(define
gitea/w-branches
@@ -100,7 +137,7 @@
(let
((owner (dream-param req "owner")) (name (dream-param req "name")))
(if
(not (gitea/repo-exists? forge owner name))
(not (gitea/w-readable? forge req owner name))
(dream-not-found)
(gitea/w-page
(str owner "/" name " branches")
@@ -114,7 +151,7 @@
"</ul>"))))))
; resolve the owner/name/ref/** of a browse request down to a tree entry;
; nil on any miss (unknown repo, bad ref, bad path)
; nil on any miss (unreadable repo, bad ref, bad path)
(define
gitea/w-entry
(fn
@@ -125,7 +162,7 @@
(ref (dream-param req "ref"))
(path (or (dream-param req "**") "")))
(if
(not (gitea/repo-exists? forge owner name))
(not (gitea/w-readable? forge req owner name))
nil
(let
((grepo (gitea/repo-git forge owner name)))
@@ -258,7 +295,7 @@
(name (dream-param req "name"))
(ref (dream-param req "ref")))
(if
(not (gitea/repo-exists? forge owner name))
(not (gitea/w-readable? forge req owner name))
(dream-not-found)
(let
((grepo (gitea/repo-git forge owner name)))
@@ -289,7 +326,7 @@
(name (dream-param req "name"))
(cidp (dream-param req "cid")))
(if
(not (gitea/repo-exists? forge owner name))
(not (gitea/w-readable? forge req owner name))
(dream-not-found)
(let
((grepo (gitea/repo-git forge owner name)))
@@ -318,38 +355,104 @@
; ── json api ─────────────────────────────────────────────────────────
(define
gitea/w-json-status
(fn (status v) (dream-response status {:content-type "application/json"} (dream-json-encode v))))
(define
gitea/w-api-repos
(fn (forge req) (dream-json-value (gitea/repos forge))))
(fn
(forge req)
(dream-json-value (gitea/visible-repos forge (gitea/w-user forge req)))))
(define
gitea/w-api-repo-create
(fn
(forge req)
(let
((body (dream-json-body req)))
(let
((res (gitea/repo-create! forge (get body :owner) (get body :name) {:description (or (get body :description) "") :created-at (or (get body :created-at) 0) :visibility (or (get body :visibility) "public")})))
(cond
((get res :conflict) (gitea/w-json-status 409 {:error "exists"}))
((get res :error) (gitea/w-json-status 400 {:error (get res :error)}))
(else (gitea/w-json-status 201 {:name (get res :name) :owner (get res :owner) :visibility (get res :visibility)})))))))
((user (gitea/w-user forge req)))
(if
(nil? user)
(gitea/w-unauthorized)
(let
((body (dream-json-body req)))
(let
((owner (get body :owner)))
(cond
((not (gitea/owner-exists? forge owner))
(gitea/w-json-status 400 {:error "no-such-owner"}))
((not (gitea/create-allowed? forge user owner))
(gitea/w-forbidden))
(else
(let
((res (gitea/repo-create! forge owner (get body :name) {:description (or (get body :description) "") :created-at (or (get body :created-at) 0) :visibility (or (get body :visibility) "public")})))
(cond
((get res :conflict)
(gitea/w-json-status 409 {:error "exists"}))
((get res :error)
(gitea/w-json-status 400 {:error (get res :error)}))
(else (gitea/w-json-status 201 {:name (get res :name) :owner (get res :owner) :visibility (get res :visibility)}))))))))))))
(define
gitea/w-api-repo-delete
(fn
(forge req)
(if
(gitea/repo-delete!
forge
(dream-param req "owner")
(dream-param req "name"))
(dream-json-value {:deleted true})
(dream-not-found))))
(let
((owner (dream-param req "owner")) (name (dream-param req "name")))
(let
((user (gitea/w-user forge req)))
(cond
((not (gitea/can? forge user "read" owner name))
(dream-not-found))
((nil? user) (gitea/w-unauthorized))
((not (gitea/can? forge user "admin" owner name))
(gitea/w-forbidden))
(else
(begin
(gitea/repo-delete! forge owner name)
(dream-json-value {:deleted true}))))))))
(define
gitea/w-api-collab-put
(fn
(forge req)
(let
((owner (dream-param req "owner"))
(name (dream-param req "name"))
(cuser (dream-param req "user")))
(let
((user (gitea/w-user forge req)))
(cond
((not (gitea/can? forge user "read" owner name))
(dream-not-found))
((nil? user) (gitea/w-unauthorized))
((not (gitea/can? forge user "admin" owner name))
(gitea/w-forbidden))
(else
(let
((role (or (get (dream-json-body req) :role) "read")))
(let
((res (gitea/collab-add! forge owner name cuser role)))
(if
(get res :error)
(gitea/w-json-status 400 {:error (get res :error)})
(dream-json-value {:role role :user cuser}))))))))))
(define
gitea/w-api-collab-delete
(fn
(forge req)
(let
((owner (dream-param req "owner"))
(name (dream-param req "name"))
(cuser (dream-param req "user")))
(let
((user (gitea/w-user forge req)))
(cond
((not (gitea/can? forge user "read" owner name))
(dream-not-found))
((nil? user) (gitea/w-unauthorized))
((not (gitea/can? forge user "admin" owner name))
(gitea/w-forbidden))
((gitea/collab-remove! forge owner name cuser)
(dream-json-value {:deleted true}))
(else (dream-not-found)))))))
; ── routes ───────────────────────────────────────────────────────────
; /api/* is listed first so an owner segment can never shadow it (owner
@@ -368,6 +471,12 @@
(dream-delete
"/api/repos/:owner/:name"
(fn (req) (gitea/w-api-repo-delete forge req)))
(dream-put
"/api/repos/:owner/:name/collab/:user"
(fn (req) (gitea/w-api-collab-put forge req)))
(dream-delete
"/api/repos/:owner/:name/collab/:user"
(fn (req) (gitea/w-api-collab-delete forge req)))
(dream-get "/:owner/:name" (fn (req) (gitea/w-repo-home forge req)))
(dream-get
"/:owner/:name/branches"