rose-ash/lib/gitea/repo.sx

; 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))))

; everything owned by a repo record, beyond the record itself: its git
; namespace and any per-repo rows other phases hang off it
(define
  gitea/repo-purge-prefixes
  (fn
    (owner name)
    (list
      (str (gitea/repo-ns owner name) "/")
      (str "gitea/collab/" owner "/" name "/")
      (str "gitea/issue/" owner "/" name "/"))))

(define
  gitea/repo-purge-keys
  (fn (owner name) (list (str "gitea/issue-seq/" owner "/" name))))

; delete the record and purge every key the repo owns — a recreated repo
; under the same name must start truly empty (no ghost collaborators,
; issues, or objects)
(define
  gitea/repo-delete!
  (fn
    (forge owner name)
    (if
      (not (gitea/repo-exists? forge owner name))
      false
      (let
        ((db (gitea/forge-db forge))
          (prefixes (gitea/repo-purge-prefixes owner name)))
        (begin
          (for-each
            (fn
              (k)
              (if
                (reduce
                  (fn (acc p) (or acc (starts-with? k p)))
                  false
                  prefixes)
                (persist/kv-delete db k)
                nil))
            (persist/kv-keys db))
          (for-each
            (fn (k) (persist/kv-delete db k))
            (gitea/repo-purge-keys owner name))
          (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))))))