giles
1f7f98d0ce
lib/gitea/access.sx: repo role groups (admin>write>read) as acl facts saturated by the datalog engine; user-owner => admin; collaborators (per-repo role, upsert); org teams (one role, 'all' or scoped repo list); org-admin?; visible-repos; create-allowed?; bearer tokens in kv. Facts derived from forge state, acl db cached in the forge handle and rebuilt only when facts change. lib/gitea/web.sx: every repo route now requires read (404 hides private repos); repo create needs owner/org-admin, delete + collaborator API need admin (401 no credentials / 403 not allowed); index + /api/repos list only visible repos; PUT/DELETE collab endpoints. tests/access.sx (103) + repo suite updated for gating (91). Fixed a web.sx corruption from the known sx_find_all/sx_replace_node path mismatch by rewriting via sx_write_file; suite timeout 300->600s. Co-Authored-By: Claude Fable 5 <noreply@anthropic.com>
244 lines
7.4 KiB
Plaintext
244 lines
7.4 KiB
Plaintext
; lib/gitea/repo.sx — sx-gitea Phase 1: forge core.
|
|
;
|
|
; The forge is a handle over a persist backend. Owner principals and repo
|
|
; records live in the kv store under "gitea/..."; each repo's git objects
|
|
; and refs live in their own git/repo-named namespace "forge/<owner>/<name>",
|
|
; so deleting a repo is a prefix purge and repos are invisible to each other.
|
|
; Owner principals are a lightweight directory here; Phase 2 (access) backs
|
|
; them with identity users/orgs.
|
|
;
|
|
; 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) {:cache {} :db db}))
|
|
(define gitea/forge-db (fn (forge) (get forge :db)))
|
|
|
|
; ── names ────────────────────────────────────────────────────────────
|
|
; Owner and repo names share one rule: nonempty, no "/" or spaces, and not
|
|
; a word the router owns (an owner called "api" would shadow /api routes).
|
|
|
|
(define
|
|
gitea/reserved-names
|
|
(list "api" "tree" "blob" "raw" "commit" "commits" "branches"))
|
|
|
|
(define
|
|
gitea/valid-name?
|
|
(fn
|
|
(name)
|
|
(and
|
|
(string? name)
|
|
(> (string-length name) 0)
|
|
(not (contains? name "/"))
|
|
(not (contains? name " "))
|
|
(not (contains? gitea/reserved-names name)))))
|
|
|
|
; ── owners ───────────────────────────────────────────────────────────
|
|
|
|
(define gitea/owner-key (fn (name) (str "gitea/owner/" name)))
|
|
|
|
(define
|
|
gitea/owner-get
|
|
(fn
|
|
(forge name)
|
|
(persist/kv-get (gitea/forge-db forge) (gitea/owner-key name))))
|
|
|
|
(define
|
|
gitea/owner-exists?
|
|
(fn
|
|
(forge name)
|
|
(persist/kv-has? (gitea/forge-db forge) (gitea/owner-key name))))
|
|
|
|
(define
|
|
gitea/owner-create!
|
|
(fn
|
|
(forge kind name)
|
|
(if
|
|
(not (gitea/valid-name? name))
|
|
{:name name :error "invalid-name"}
|
|
(persist/kv-put-new
|
|
(gitea/forge-db forge)
|
|
(gitea/owner-key name)
|
|
{:name name :kind kind}))))
|
|
|
|
(define
|
|
gitea/user-create!
|
|
(fn (forge name) (gitea/owner-create! forge "user" name)))
|
|
(define
|
|
gitea/org-create!
|
|
(fn (forge name) (gitea/owner-create! forge "org" name)))
|
|
|
|
(define gitea/user? (fn (owner) (equal? (get owner :kind) "user")))
|
|
(define gitea/org? (fn (owner) (equal? (get owner :kind) "org")))
|
|
|
|
(define
|
|
gitea/names-under
|
|
(fn
|
|
(forge pfx)
|
|
(artdag/sort-strings
|
|
(map
|
|
(fn (k) (substr k (string-length pfx)))
|
|
(filter
|
|
(fn (k) (starts-with? k pfx))
|
|
(persist/kv-keys (gitea/forge-db forge)))))))
|
|
|
|
(define gitea/owners (fn (forge) (gitea/names-under forge "gitea/owner/")))
|
|
|
|
; ── repo records ─────────────────────────────────────────────────────
|
|
|
|
(define gitea/repo-key (fn (owner name) (str "gitea/repo/" owner "/" name)))
|
|
(define gitea/repo-ns (fn (owner name) (str "forge/" owner "/" name)))
|
|
|
|
(define gitea/repo-record (fn (owner name opts) {:name name :description (or (get opts :description) "") :default-branch (or (get opts :default-branch) "main") :owner owner :created-at (or (get opts :created-at) 0) :visibility (or (get opts :visibility) "public")}))
|
|
|
|
; create-only: {:error ...} on bad input, {:conflict ...} if it exists,
|
|
; else initialize the git store (HEAD -> unborn heads/main) and return
|
|
; the record.
|
|
(define
|
|
gitea/repo-create!
|
|
(fn
|
|
(forge owner name opts)
|
|
(cond
|
|
((not (gitea/owner-exists? forge owner)) {:error "no-such-owner" :owner owner})
|
|
((not (gitea/valid-name? name)) {:name name :error "invalid-name"})
|
|
(else
|
|
(let
|
|
((rec (gitea/repo-record owner name (or opts {}))))
|
|
(let
|
|
((res (persist/kv-put-new (gitea/forge-db forge) (gitea/repo-key owner name) rec)))
|
|
(if
|
|
(get res :conflict)
|
|
res
|
|
(begin
|
|
(git/init! (gitea/forge-db forge) (gitea/repo-ns owner name))
|
|
rec))))))))
|
|
|
|
(define
|
|
gitea/repo-get
|
|
(fn
|
|
(forge owner name)
|
|
(persist/kv-get (gitea/forge-db forge) (gitea/repo-key owner name))))
|
|
|
|
(define
|
|
gitea/repo-exists?
|
|
(fn
|
|
(forge owner name)
|
|
(persist/kv-has? (gitea/forge-db forge) (gitea/repo-key owner name))))
|
|
|
|
(define
|
|
gitea/repo-update!
|
|
(fn
|
|
(forge owner name f)
|
|
(let
|
|
((rec (gitea/repo-get forge owner name)))
|
|
(if
|
|
(nil? rec)
|
|
nil
|
|
(persist/kv-put
|
|
(gitea/forge-db forge)
|
|
(gitea/repo-key owner name)
|
|
(f rec))))))
|
|
|
|
; the sx-git handle for a repo's own object/ref namespace
|
|
(define
|
|
gitea/repo-git
|
|
(fn
|
|
(forge owner name)
|
|
(git/repo-named (gitea/forge-db forge) (gitea/repo-ns owner name))))
|
|
|
|
; delete the record and purge every git key under the repo's namespace
|
|
(define
|
|
gitea/repo-delete!
|
|
(fn
|
|
(forge owner name)
|
|
(if
|
|
(not (gitea/repo-exists? forge owner name))
|
|
false
|
|
(let
|
|
((db (gitea/forge-db forge)))
|
|
(let
|
|
((pfx (str (gitea/repo-ns owner name) "/")))
|
|
(begin
|
|
(for-each
|
|
(fn (k) (persist/kv-delete db k))
|
|
(filter (fn (k) (starts-with? k pfx)) (persist/kv-keys db)))
|
|
(persist/kv-delete db (gitea/repo-key owner name))
|
|
true))))))
|
|
|
|
(define gitea/repos (fn (forge) (gitea/names-under forge "gitea/repo/")))
|
|
|
|
(define
|
|
gitea/repos-for
|
|
(fn (forge owner) (gitea/names-under forge (str "gitea/repo/" owner "/"))))
|
|
|
|
; ── ref resolution / tree navigation (shared by browse views) ────────
|
|
|
|
; follow annotated tag objects down to the commit they name
|
|
(define
|
|
gitea/peel-to-commit
|
|
(fn
|
|
(grepo cid)
|
|
(let
|
|
((obj (git/read grepo cid)))
|
|
(cond
|
|
((nil? obj) nil)
|
|
((git/tag? obj) (gitea/peel-to-commit grepo (git/tag-target obj)))
|
|
(else cid)))))
|
|
|
|
; a browse ref is a branch name, a tag name, or a raw cid — in that order
|
|
(define
|
|
gitea/resolve-ref
|
|
(fn
|
|
(grepo refname)
|
|
(let
|
|
((b (git/branch-get grepo refname)))
|
|
(if
|
|
b
|
|
(gitea/peel-to-commit grepo b)
|
|
(let
|
|
((t (git/tag-get grepo refname)))
|
|
(if
|
|
t
|
|
(gitea/peel-to-commit grepo t)
|
|
(if
|
|
(git/has? grepo refname)
|
|
(gitea/peel-to-commit grepo refname)
|
|
nil)))))))
|
|
|
|
(define
|
|
gitea/path-segs
|
|
(fn (path) (filter (fn (s) (not (equal? s ""))) (split path "/"))))
|
|
|
|
; walk tree entries by path segments => {:kind "tree"|"blob" :cid cid} | nil
|
|
(define
|
|
gitea/entry-at
|
|
(fn
|
|
(grepo tree-cid segs)
|
|
(if
|
|
(empty? segs)
|
|
{:kind "tree" :cid tree-cid}
|
|
(let
|
|
((tree (git/read grepo tree-cid)))
|
|
(if
|
|
(not (git/tree? tree))
|
|
nil
|
|
(let
|
|
((entry (git/tree-entry-for tree (first segs))))
|
|
(cond
|
|
((nil? entry) nil)
|
|
((empty? (rest segs)) {:kind (git/entry-kind entry) :cid (git/entry-cid entry)})
|
|
((equal? (git/entry-kind entry) "tree")
|
|
(gitea/entry-at grepo (git/entry-cid entry) (rest segs)))
|
|
(else nil))))))))
|
|
|
|
; entry at path under a COMMIT's tree ("" => the root tree)
|
|
(define
|
|
gitea/tree-at
|
|
(fn
|
|
(grepo commit-cid path)
|
|
(let
|
|
((c (git/read grepo commit-cid)))
|
|
(if
|
|
(not (git/commit? c))
|
|
nil
|
|
(gitea/entry-at grepo (git/commit-tree c) (gitea/path-segs path))))))
|