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

403
lib/gitea/access.sx Normal file
View 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))))

View File

@@ -22,6 +22,7 @@ VERBOSE="${1:-}"
# suite name | pass counter | fail counter | failures list
SUITES=(
"repo|gitea-repo-pass|gitea-repo-fail|gitea-repo-fails"
"access|gitea-access-pass|gitea-access-fail|gitea-access-fails"
)
OUT_JSON="lib/gitea/scoreboard.json"
@@ -44,14 +45,29 @@ MODULES=(
"lib/git/diff.sx"
"lib/git/merge.sx"
"lib/git/porcelain.sx"
"lib/datalog/tokenizer.sx"
"lib/datalog/parser.sx"
"lib/datalog/unify.sx"
"lib/datalog/db.sx"
"lib/datalog/builtins.sx"
"lib/datalog/aggregates.sx"
"lib/datalog/strata.sx"
"lib/datalog/eval.sx"
"lib/datalog/api.sx"
"lib/datalog/magic.sx"
"lib/acl/schema.sx"
"lib/acl/facts.sx"
"lib/acl/engine.sx"
"lib/dream/types.sx"
"lib/dream/router.sx"
"lib/dream/middleware.sx"
"lib/dream/error.sx"
"lib/dream/html.sx"
"lib/dream/json.sx"
"lib/dream/auth.sx"
"lib/dream/api.sx"
"lib/gitea/repo.sx"
"lib/gitea/access.sx"
"lib/gitea/web.sx"
)
@@ -72,7 +88,7 @@ run_suite() {
} > "$TMP"
local OUTPUT
OUTPUT=$(timeout 300 "$SX_SERVER" < "$TMP" 2>/dev/null)
OUTPUT=$(timeout 600 "$SX_SERVER" < "$TMP" 2>/dev/null)
rm -f "$TMP"
local LINE

View File

@@ -10,7 +10,7 @@
; Requires: lib/persist/{event,backend,log,kv}.sx, lib/artdag/dag.sx,
; lib/git/{object,ref,dag,worktree,diff,merge,porcelain}.sx
(define gitea/forge (fn (db) {:db db}))
(define gitea/forge (fn (db) {:cache {} :db db}))
(define gitea/forge-db (fn (forge) (get forge :db)))
; ── names ────────────────────────────────────────────────────────────

View File

@@ -1,8 +1,9 @@
{
"suites": {
"repo": {"pass": 91, "fail": 0}
"repo": {"pass": 91, "fail": 0},
"access": {"pass": 103, "fail": 0}
},
"total_pass": 91,
"total_pass": 194,
"total_fail": 0,
"total": 91
"total": 194
}

View File

@@ -5,4 +5,5 @@ _Generated by `lib/gitea/conformance.sh`_
| Suite | Pass | Fail | Total |
|-------|-----:|-----:|------:|
| repo | 91 | 0 | 91 |
| **Total** | **91** | **0** | **91** |
| access | 103 | 0 | 103 |
| **Total** | **194** | **0** | **194** |

546
lib/gitea/tests/access.sx Normal file
View File

@@ -0,0 +1,546 @@
; lib/gitea/tests/access.sx — Phase 2: visibility, collaborators, org
; teams, acl-backed can?, tokens, and auth-gated web routes.
(define gitea-access-pass 0)
(define gitea-access-fail 0)
(define gitea-access-fails (list))
(define
gitea-access-test
(fn
(name actual expected)
(if
(= actual expected)
(set! gitea-access-pass (+ gitea-access-pass 1))
(begin
(set! gitea-access-fail (+ gitea-access-fail 1))
(set!
gitea-access-fails
(append gitea-access-fails (list {:name name :expected (inspect expected) :actual (inspect actual)})))))))
(define ga-db (persist/mem-backend))
(define ga-forge (gitea/forge ga-db))
(gitea/user-create! ga-forge "alice")
(gitea/user-create! ga-forge "bob")
(gitea/user-create! ga-forge "carol")
(gitea/user-create! ga-forge "eve")
(gitea/org-create! ga-forge "acme")
(gitea/repo-create! ga-forge "alice" "pub" {})
(gitea/repo-create! ga-forge "alice" "sec" {:visibility "private"})
(gitea/repo-create! ga-forge "acme" "app" {:visibility "private"})
; ── can? basics ──────────────────────────────────────────────────────
(gitea-access-test
"public read anon"
(gitea/can? ga-forge nil "read" "alice" "pub")
true)
(gitea-access-test
"public read any user"
(gitea/can? ga-forge "eve" "read" "alice" "pub")
true)
(gitea-access-test
"public write anon denied"
(gitea/can? ga-forge nil "write" "alice" "pub")
false)
(gitea-access-test
"public write stranger denied"
(gitea/can? ga-forge "eve" "write" "alice" "pub")
false)
(gitea-access-test
"private read anon denied"
(gitea/can? ga-forge nil "read" "alice" "sec")
false)
(gitea-access-test
"private read stranger denied"
(gitea/can? ga-forge "eve" "read" "alice" "sec")
false)
(gitea-access-test
"owner reads private"
(gitea/can? ga-forge "alice" "read" "alice" "sec")
true)
(gitea-access-test
"owner writes private"
(gitea/can? ga-forge "alice" "write" "alice" "sec")
true)
(gitea-access-test
"owner admins private"
(gitea/can? ga-forge "alice" "admin" "alice" "sec")
true)
(gitea-access-test
"owner admins public"
(gitea/can? ga-forge "alice" "admin" "alice" "pub")
true)
(gitea-access-test
"missing repo denied"
(gitea/can? ga-forge "alice" "read" "alice" "nope")
false)
; ── collaborators ────────────────────────────────────────────────────
(gitea-access-test
"collab-add! bob write"
(get (gitea/collab-add! ga-forge "alice" "sec" "bob" "write") :role)
"write")
(gitea-access-test
"collab-role"
(gitea/collab-role ga-forge "alice" "sec" "bob")
"write")
(gitea-access-test
"collabs list"
(gitea/collabs ga-forge "alice" "sec")
(list "bob"))
(gitea-access-test
"write collab reads"
(gitea/can? ga-forge "bob" "read" "alice" "sec")
true)
(gitea-access-test
"write collab writes"
(gitea/can? ga-forge "bob" "write" "alice" "sec")
true)
(gitea-access-test
"write collab cannot admin"
(gitea/can? ga-forge "bob" "admin" "alice" "sec")
false)
(gitea/collab-add! ga-forge "alice" "sec" "carol" "read")
(gitea-access-test
"read collab reads"
(gitea/can? ga-forge "carol" "read" "alice" "sec")
true)
(gitea-access-test
"read collab cannot write"
(gitea/can? ga-forge "carol" "write" "alice" "sec")
false)
(gitea/collab-add! ga-forge "alice" "sec" "carol" "write")
(gitea-access-test
"collab upsert to write"
(gitea/can? ga-forge "carol" "write" "alice" "sec")
true)
(gitea-access-test
"collab-add! missing repo"
(get (gitea/collab-add! ga-forge "alice" "nope" "bob" "read") :error)
"no-such-repo")
(gitea-access-test
"collab-add! missing user"
(get (gitea/collab-add! ga-forge "alice" "sec" "zeb" "read") :error)
"no-such-user")
(gitea-access-test
"collab-add! bad role"
(get (gitea/collab-add! ga-forge "alice" "sec" "bob" "boss") :error)
"invalid-role")
(gitea-access-test
"collab-remove! carol"
(gitea/collab-remove! ga-forge "alice" "sec" "carol")
true)
(gitea-access-test
"removed collab cannot write"
(gitea/can? ga-forge "carol" "write" "alice" "sec")
false)
(gitea-access-test
"removed collab cannot read private"
(gitea/can? ga-forge "carol" "read" "alice" "sec")
false)
(gitea-access-test
"collab-remove! again false"
(gitea/collab-remove! ga-forge "alice" "sec" "carol")
false)
; ── teams ────────────────────────────────────────────────────────────
(gitea-access-test
"team-create! owners"
(get (gitea/team-create! ga-forge "acme" "owners" "admin") :role)
"admin")
(gitea-access-test
"team-create! duplicate conflicts"
(get (gitea/team-create! ga-forge "acme" "owners" "read") :conflict)
true)
(gitea-access-test
"team-create! on user rejected"
(get (gitea/team-create! ga-forge "alice" "crew" "read") :error)
"no-such-org")
(gitea-access-test
"team-create! bad role"
(get (gitea/team-create! ga-forge "acme" "crew" "boss") :error)
"invalid-role")
(gitea/team-add-member! ga-forge "acme" "owners" "alice")
(gitea-access-test
"team-members"
(gitea/team-members ga-forge "acme" "owners")
(list "alice"))
(gitea-access-test
"team-add-member! missing team"
(get (gitea/team-add-member! ga-forge "acme" "ghosts" "bob") :error)
"no-such-team")
(gitea-access-test
"team-add-member! missing user"
(get (gitea/team-add-member! ga-forge "acme" "owners" "zeb") :error)
"no-such-user")
(gitea-access-test
"owners member admins org repo"
(gitea/can? ga-forge "alice" "admin" "acme" "app")
true)
(gitea-access-test
"owners member reads org repo"
(gitea/can? ga-forge "alice" "read" "acme" "app")
true)
(gitea-access-test
"non-member cannot read org private"
(gitea/can? ga-forge "bob" "read" "acme" "app")
false)
(gitea-access-test
"org-admin? alice"
(gitea/org-admin? ga-forge "acme" "alice")
true)
(gitea-access-test
"org-admin? bob"
(gitea/org-admin? ga-forge "acme" "bob")
false)
(gitea/team-create! ga-forge "acme" "devs" "write")
(gitea/team-set-repos! ga-forge "acme" "devs" (list "app"))
(gitea/team-add-member! ga-forge "acme" "devs" "bob")
(gitea-access-test
"devs member writes covered repo"
(gitea/can? ga-forge "bob" "write" "acme" "app")
true)
(gitea-access-test
"devs member cannot admin"
(gitea/can? ga-forge "bob" "admin" "acme" "app")
false)
(gitea-access-test
"org-admin? devs member"
(gitea/org-admin? ga-forge "acme" "bob")
false)
(gitea/repo-create! ga-forge "acme" "site" {:visibility "private"})
(gitea-access-test
"scoped team does not cover new repo"
(gitea/can? ga-forge "bob" "read" "acme" "site")
false)
(gitea-access-test
"all-repos team covers new repo"
(gitea/can? ga-forge "alice" "admin" "acme" "site")
true)
(gitea/team-set-repos! ga-forge "acme" "devs" "all")
(gitea-access-test
"widened team covers site"
(gitea/can? ga-forge "bob" "write" "acme" "site")
true)
(gitea/team-set-repos! ga-forge "acme" "devs" (list "app"))
(gitea-access-test
"re-narrowed team loses site"
(gitea/can? ga-forge "bob" "write" "acme" "site")
false)
(gitea/team-remove-member! ga-forge "acme" "devs" "bob")
(gitea-access-test
"removed member loses access"
(gitea/can? ga-forge "bob" "write" "acme" "app")
false)
(gitea/team-add-member! ga-forge "acme" "devs" "bob")
(gitea-access-test
"team-delete!"
(gitea/team-delete! ga-forge "acme" "devs")
true)
(gitea-access-test
"deleted team gone"
(gitea/teams ga-forge "acme")
(list "owners"))
(gitea-access-test
"deleted team members purged"
(gitea/team-members ga-forge "acme" "devs")
(list))
(gitea-access-test
"deleted team access revoked"
(gitea/can? ga-forge "bob" "write" "acme" "app")
false)
(gitea-access-test
"team-delete! missing false"
(gitea/team-delete! ga-forge "acme" "devs")
false)
; ── visibility ───────────────────────────────────────────────────────
(gitea-access-test
"visible anon"
(gitea/visible-repos ga-forge nil)
(list "alice/pub"))
(gitea-access-test
"visible eve"
(gitea/visible-repos ga-forge "eve")
(list "alice/pub"))
(gitea-access-test
"visible bob (collab on sec)"
(gitea/visible-repos ga-forge "bob")
(list "alice/pub" "alice/sec"))
(gitea-access-test
"visible alice (owner + org admin)"
(gitea/visible-repos ga-forge "alice")
(list "acme/app" "acme/site" "alice/pub" "alice/sec"))
; ── create permission ────────────────────────────────────────────────
(gitea-access-test
"create under self"
(gitea/create-allowed? ga-forge "alice" "alice")
true)
(gitea-access-test
"create under other user"
(gitea/create-allowed? ga-forge "bob" "alice")
false)
(gitea-access-test
"create anon"
(gitea/create-allowed? ga-forge nil "alice")
false)
(gitea-access-test
"org admin creates in org"
(gitea/create-allowed? ga-forge "alice" "acme")
true)
(gitea-access-test
"non-admin cannot create in org"
(gitea/create-allowed? ga-forge "eve" "acme")
false)
(gitea-access-test
"create under unknown owner"
(gitea/create-allowed? ga-forge "alice" "zeb")
false)
; ── tokens ───────────────────────────────────────────────────────────
(gitea/token-create! ga-forge "alice" "tok-a")
(gitea/token-create! ga-forge "bob" "tok-b")
(gitea/token-create! ga-forge "eve" "tok-e")
(gitea-access-test
"token resolves user"
(gitea/token-user ga-forge "tok-a")
"alice")
(gitea-access-test "unknown token" (gitea/token-user ga-forge "tok-zzz") nil)
(gitea-access-test
"token for unknown user"
(get (gitea/token-create! ga-forge "zeb" "tok-z") :error)
"no-such-user")
(gitea/token-create! ga-forge "carol" "tok-c")
(gitea/token-revoke! ga-forge "tok-c")
(gitea-access-test "revoked token" (gitea/token-user ga-forge "tok-c") nil)
; ── auth-gated web routes ────────────────────────────────────────────
; content in the private repo, to browse
(define ga-gsec (gitea/repo-git ga-forge "alice" "sec"))
(git/add! ga-gsec "secret.txt" "s3cret\n")
(git/commit! ga-gsec {:message "hide" :time 1 :author "alice"})
(define ga-app (gitea/app ga-forge))
(define ga-hdr (fn (tok) (if (nil? tok) {} {:authorization (str "Bearer " tok)})))
(define
ga-get
(fn (target tok) (ga-app (dream-request "GET" target (ga-hdr tok) ""))))
(define
ga-post
(fn
(target tok body)
(ga-app (dream-request "POST" target (ga-hdr tok) body))))
(define
ga-put
(fn
(target tok body)
(ga-app (dream-request "PUT" target (ga-hdr tok) body))))
(define
ga-del
(fn
(target tok)
(ga-app (dream-request "DELETE" target (ga-hdr tok) ""))))
(gitea-access-test
"web: public repo anon"
(dream-status (ga-get "/alice/pub" nil))
200)
(gitea-access-test
"web: private repo anon hidden"
(dream-status (ga-get "/alice/sec" nil))
404)
(gitea-access-test
"web: private repo stranger hidden"
(dream-status (ga-get "/alice/sec" "tok-e"))
404)
(gitea-access-test
"web: private repo collab"
(dream-status (ga-get "/alice/sec" "tok-b"))
200)
(gitea-access-test
"web: private repo owner"
(dream-status (ga-get "/alice/sec" "tok-a"))
200)
(gitea-access-test
"web: private tree anon hidden"
(dream-status (ga-get "/alice/sec/tree/main" nil))
404)
(gitea-access-test
"web: private tree collab"
(dream-status (ga-get "/alice/sec/tree/main" "tok-b"))
200)
(gitea-access-test
"web: private raw stranger hidden"
(dream-status (ga-get "/alice/sec/raw/main/secret.txt" "tok-e"))
404)
(gitea-access-test
"web: private raw collab exact"
(dream-resp-body (ga-get "/alice/sec/raw/main/secret.txt" "tok-b"))
"s3cret\n")
(gitea-access-test
"web: private commits owner"
(dream-status (ga-get "/alice/sec/commits/main" "tok-a"))
200)
(gitea-access-test
"web: index anon shows public"
(contains? (dream-resp-body (ga-get "/" nil)) "alice/pub")
true)
(gitea-access-test
"web: index anon hides private"
(contains? (dream-resp-body (ga-get "/" nil)) "alice/sec")
false)
(gitea-access-test
"web: index owner shows private"
(contains? (dream-resp-body (ga-get "/" "tok-a")) "alice/sec")
true)
(gitea-access-test
"web: api repos anon"
(dream-json-parse (dream-resp-body (ga-get "/api/repos" nil)))
(list "alice/pub"))
(gitea-access-test
"web: api repos owner"
(dream-json-parse (dream-resp-body (ga-get "/api/repos" "tok-a")))
(list "acme/app" "acme/site" "alice/pub" "alice/sec"))
(gitea-access-test
"web: create anon 401"
(dream-status (ga-post "/api/repos" nil (dream-json-encode {:name "x" :owner "alice"})))
401)
(gitea-access-test
"web: create for other user 403"
(dream-status
(ga-post "/api/repos" "tok-b" (dream-json-encode {:name "x" :owner "alice"})))
403)
(gitea-access-test
"web: create own 201"
(dream-status
(ga-post "/api/repos" "tok-a" (dream-json-encode {:name "x" :owner "alice"})))
201)
(gitea-access-test
"web: org admin create 201"
(dream-status
(ga-post "/api/repos" "tok-a" (dream-json-encode {:name "tools" :owner "acme"})))
201)
(gitea-access-test
"web: org non-admin create 403"
(dream-status
(ga-post "/api/repos" "tok-e" (dream-json-encode {:name "z" :owner "acme"})))
403)
(gitea-access-test
"web: create unknown owner 400"
(dream-status
(ga-post "/api/repos" "tok-a" (dream-json-encode {:name "z" :owner "zeb"})))
400)
(gitea-access-test
"web: delete anon public 401"
(dream-status (ga-del "/api/repos/alice/x" nil))
401)
(gitea-access-test
"web: delete anon private hidden 404"
(dream-status (ga-del "/api/repos/alice/sec" nil))
404)
(gitea-access-test
"web: delete stranger private hidden 404"
(dream-status (ga-del "/api/repos/alice/sec" "tok-e"))
404)
(gitea-access-test
"web: delete non-admin 403"
(dream-status (ga-del "/api/repos/alice/x" "tok-b"))
403)
(gitea-access-test
"web: delete admin 200"
(dream-status (ga-del "/api/repos/alice/x" "tok-a"))
200)
(gitea-access-test
"web: deleted repo gone"
(dream-status (ga-del "/api/repos/alice/x" "tok-a"))
404)
(gitea-access-test
"web: collab put anon 401"
(dream-status (ga-put "/api/repos/alice/pub/collab/eve" nil "{}"))
401)
(gitea-access-test
"web: collab put non-admin 403"
(dream-status
(ga-put
"/api/repos/alice/pub/collab/eve"
"tok-b"
(dream-json-encode {:role "write"})))
403)
(gitea-access-test
"web: collab put on hidden repo 404"
(dream-status
(ga-put
"/api/repos/alice/sec/collab/eve"
"tok-e"
(dream-json-encode {:role "write"})))
404)
(gitea-access-test
"web: collab put admin 200"
(dream-status
(ga-put
"/api/repos/alice/pub/collab/eve"
"tok-a"
(dream-json-encode {:role "write"})))
200)
(gitea-access-test
"web: collab granted write"
(gitea/can? ga-forge "eve" "write" "alice" "pub")
true)
(gitea-access-test
"web: collab put bad role 400"
(dream-status
(ga-put
"/api/repos/alice/pub/collab/eve"
"tok-a"
(dream-json-encode {:role "boss"})))
400)
(gitea-access-test
"web: collab put unknown user 400"
(dream-status
(ga-put
"/api/repos/alice/pub/collab/zeb"
"tok-a"
(dream-json-encode {:role "read"})))
400)
(gitea-access-test
"web: collab delete admin 200"
(dream-status (ga-del "/api/repos/alice/pub/collab/eve" "tok-a"))
200)
(gitea-access-test
"web: collab revoked"
(gitea/can? ga-forge "eve" "write" "alice" "pub")
false)
(gitea-access-test
"web: collab delete missing 404"
(dream-status (ga-del "/api/repos/alice/pub/collab/eve" "tok-a"))
404)

View File

@@ -1,5 +1,6 @@
; lib/gitea/tests/repo.sx — Phase 1: forge core (owners, repo CRUD, git
; wiring, ref/tree navigation) and the dream browse views + JSON API.
; Mutating API calls authenticate as alice (Phase 2 gates them).
(define gitea-repo-pass 0)
(define gitea-repo-fail 0)
@@ -116,7 +117,7 @@
(gitea/repos gt-forge)
(list "alice/proj"))
(gitea/repo-create! gt-forge "acme" "proj" {:visibility "private"})
(gitea/repo-create! gt-forge "acme" "proj" {})
(gitea-repo-test
"same name under two owners"
@@ -126,10 +127,6 @@
"repos-for alice"
(gitea/repos-for gt-forge "alice")
(list "proj"))
(gitea-repo-test
"private visibility stored"
(get (gitea/repo-get gt-forge "acme" "proj") :visibility)
"private")
(gitea-repo-test
"repo-update! description"
(begin
@@ -145,6 +142,12 @@
(gitea/repo-update! gt-forge "alice" "nope" (fn (r) r))
nil)
(gitea/repo-create! gt-forge "alice" "hidden" {:visibility "private"})
(gitea-repo-test
"private visibility stored"
(get (gitea/repo-get gt-forge "alice" "hidden") :visibility)
"private")
; ── git store wiring ─────────────────────────────────────────────────
(define gt-grepo (gitea/repo-git gt-forge "alice" "proj"))
@@ -241,12 +244,15 @@
(define
gt-get
(fn (target) (gt-app (dream-request "GET" target {} ""))))
(gitea/token-create! gt-forge "alice" "tok-alice")
(define gt-auth {:authorization "Bearer tok-alice"})
(define
gt-post
(fn (target body) (gt-app (dream-request "POST" target {} body))))
gt-posta
(fn (target body) (gt-app (dream-request "POST" target gt-auth body))))
(define
gt-del
(fn (target) (gt-app (dream-request "DELETE" target {} ""))))
gt-dela
(fn (target) (gt-app (dream-request "DELETE" target gt-auth ""))))
(gitea-repo-test "GET / status" (dream-status (gt-get "/")) 200)
(gitea-repo-test
@@ -376,16 +382,16 @@
(dream-status (gt-get "/alice/proj/commit/zzz"))
404)
; ── json api ─────────────────────────────────────────────────────────
; ── json api (as alice) ──────────────────────────────────────────────
(gitea-repo-test
"api repos json"
"api repos json (anon: public only)"
(dream-json-parse (dream-resp-body (gt-get "/api/repos")))
(list "acme/proj" "alice/proj"))
(gitea-repo-test
"api create 201"
(dream-status (gt-post "/api/repos" (dream-json-encode {:name "web" :owner "alice"})))
(dream-status (gt-posta "/api/repos" (dream-json-encode {:name "web" :owner "alice"})))
201)
(gitea-repo-test
"api create persisted"
@@ -393,19 +399,19 @@
true)
(gitea-repo-test
"api create duplicate 409"
(dream-status (gt-post "/api/repos" (dream-json-encode {:name "web" :owner "alice"})))
(dream-status (gt-posta "/api/repos" (dream-json-encode {:name "web" :owner "alice"})))
409)
(gitea-repo-test
"api create unknown owner 400"
(dream-status (gt-post "/api/repos" (dream-json-encode {:name "web" :owner "zeb"})))
(dream-status (gt-posta "/api/repos" (dream-json-encode {:name "web" :owner "zeb"})))
400)
(gitea-repo-test
"api create bad name 400"
(dream-status (gt-post "/api/repos" (dream-json-encode {:name "b d" :owner "alice"})))
(dream-status (gt-posta "/api/repos" (dream-json-encode {:name "b d" :owner "alice"})))
400)
(gitea-repo-test
"api delete 200"
(dream-status (gt-del "/api/repos/alice/web"))
(dream-status (gt-dela "/api/repos/alice/web"))
200)
(gitea-repo-test
"api delete gone"
@@ -413,7 +419,7 @@
false)
(gitea-repo-test
"api delete missing 404"
(dream-status (gt-del "/api/repos/alice/web"))
(dream-status (gt-dela "/api/repos/alice/web"))
404)
; ── delete purges the git namespace ──────────────────────────────────
@@ -445,4 +451,4 @@
(gitea-repo-test
"other repos survive delete"
(gitea/repos gt-forge)
(list "acme/proj" "alice/proj"))
(list "acme/proj" "alice/hidden" "alice/proj"))

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"