sx-gitea Phase 1: repo — forge core (owners, repo CRUD, per-repo git stores) + dream browse views (TDD, 91/91)
lib/gitea/repo.sx: forge handle over persist kv; owner principals (user/org directory, identity-backed in Phase 2); repo records with visibility/default-branch metadata; per-repo sx-git namespaces (forge/<owner>/<name>) so delete is a prefix purge; ref resolution (branch/tag/cid, annotated tags peeled) and tree-path navigation. lib/gitea/web.sx: dream routes — repo index, repo home, branches, tree/blob/raw browse at any ref, commit log, single-commit diff view, JSON API for repo create/list/delete (201/400/409 semantics). lib/gitea/tests/repo.sx (91 tests) + conformance.sh + scoreboard. Co-Authored-By: Claude Fable 5 <noreply@anthropic.com>
This commit is contained in:
243
lib/gitea/repo.sx
Normal file
243
lib/gitea/repo.sx
Normal file
@@ -0,0 +1,243 @@
|
||||
; 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) {: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))))))
|
||||
Reference in New Issue
Block a user