diff --git a/lib/gitea/access.sx b/lib/gitea/access.sx new file mode 100644 index 00000000..c2bc45aa --- /dev/null +++ b/lib/gitea/access.sx @@ -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:/") 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)))) diff --git a/lib/gitea/conformance.sh b/lib/gitea/conformance.sh index 92ecf4cb..2d623098 100644 --- a/lib/gitea/conformance.sh +++ b/lib/gitea/conformance.sh @@ -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 diff --git a/lib/gitea/repo.sx b/lib/gitea/repo.sx index 6c05eb0d..1689d194 100644 --- a/lib/gitea/repo.sx +++ b/lib/gitea/repo.sx @@ -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 ──────────────────────────────────────────────────────────── diff --git a/lib/gitea/scoreboard.json b/lib/gitea/scoreboard.json index b955b646..f0a8b0ea 100644 --- a/lib/gitea/scoreboard.json +++ b/lib/gitea/scoreboard.json @@ -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 } diff --git a/lib/gitea/scoreboard.md b/lib/gitea/scoreboard.md index f20fee82..d1158d40 100644 --- a/lib/gitea/scoreboard.md +++ b/lib/gitea/scoreboard.md @@ -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** | diff --git a/lib/gitea/tests/access.sx b/lib/gitea/tests/access.sx new file mode 100644 index 00000000..238fb04a --- /dev/null +++ b/lib/gitea/tests/access.sx @@ -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) diff --git a/lib/gitea/tests/repo.sx b/lib/gitea/tests/repo.sx index f10a6455..58cbe9bc 100644 --- a/lib/gitea/tests/repo.sx +++ b/lib/gitea/tests/repo.sx @@ -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")) diff --git a/lib/gitea/web.sx b/lib/gitea/web.sx index 85465230..fd735871 100644 --- a/lib/gitea/web.sx +++ b/lib/gitea/web.sx @@ -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 "
  • " (dream-escape full) "
    • "))) +; ── 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 "

    Repositories

    ")))) (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 - "

    " - (dream-escape (str owner "/" name)) - "

    " - "

    " - (dream-escape (or (get rec :description) "")) - "

    " - "

    visibility: " - (dream-escape (get rec :visibility)) - "

    " - (if - (empty? branches) - "

    empty repository

    " - (str - "

    Branches

    ")))))))))) + (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 + "

    " + (dream-escape (str owner "/" name)) + "

    " + "

    " + (dream-escape (or (get rec :description) "")) + "

    " + "

    visibility: " + (dream-escape (get rec :visibility)) + "

    " + (if + (empty? branches) + "

    empty repository

    " + (str + "

    Branches

    "))))))))) (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 @@ "")))))) ; 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"