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:
391
lib/gitea/web.sx
Normal file
391
lib/gitea/web.sx
Normal file
@@ -0,0 +1,391 @@
|
||||
; lib/gitea/web.sx — sx-gitea Phase 1: browse views over dream.
|
||||
;
|
||||
; 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.
|
||||
;
|
||||
; Requires: lib/gitea/repo.sx, lib/dream/{types,router,middleware,error,
|
||||
; html,json,api}.sx
|
||||
|
||||
; ── html scaffolding ─────────────────────────────────────────────────
|
||||
|
||||
(define
|
||||
gitea/w-page
|
||||
(fn
|
||||
(title body)
|
||||
(dream-html
|
||||
(str
|
||||
"<!doctype html><html><head><title>"
|
||||
(dream-escape title)
|
||||
"</title></head><body>"
|
||||
body
|
||||
"</body></html>"))))
|
||||
|
||||
(define
|
||||
gitea/w-repo-link
|
||||
(fn
|
||||
(full)
|
||||
(str "<li><a href=\"/" full "\">" (dream-escape full) "</a></li>")))
|
||||
|
||||
; ── pages ────────────────────────────────────────────────────────────
|
||||
|
||||
(define
|
||||
gitea/w-index
|
||||
(fn
|
||||
(forge req)
|
||||
(gitea/w-page
|
||||
"repositories"
|
||||
(str
|
||||
"<h1>Repositories</h1><ul>"
|
||||
(join "" (map gitea/w-repo-link (gitea/repos forge)))
|
||||
"</ul>"))))
|
||||
|
||||
(define
|
||||
gitea/w-branch-item
|
||||
(fn
|
||||
(owner name b)
|
||||
(str
|
||||
"<li><a href=\"/"
|
||||
owner
|
||||
"/"
|
||||
name
|
||||
"/tree/"
|
||||
b
|
||||
"\">"
|
||||
(dream-escape b)
|
||||
"</a></li>")))
|
||||
|
||||
(define
|
||||
gitea/w-repo-home
|
||||
(fn
|
||||
(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>"))))))))))
|
||||
|
||||
(define
|
||||
gitea/w-branches
|
||||
(fn
|
||||
(forge req)
|
||||
(let
|
||||
((owner (dream-param req "owner")) (name (dream-param req "name")))
|
||||
(if
|
||||
(not (gitea/repo-exists? forge owner name))
|
||||
(dream-not-found)
|
||||
(gitea/w-page
|
||||
(str owner "/" name " branches")
|
||||
(str
|
||||
"<h1>Branches</h1><ul>"
|
||||
(join
|
||||
""
|
||||
(map
|
||||
(fn (b) (gitea/w-branch-item owner name b))
|
||||
(git/branches (gitea/repo-git forge owner name))))
|
||||
"</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)
|
||||
(define
|
||||
gitea/w-entry
|
||||
(fn
|
||||
(forge req)
|
||||
(let
|
||||
((owner (dream-param req "owner"))
|
||||
(name (dream-param req "name"))
|
||||
(ref (dream-param req "ref"))
|
||||
(path (or (dream-param req "**") "")))
|
||||
(if
|
||||
(not (gitea/repo-exists? forge owner name))
|
||||
nil
|
||||
(let
|
||||
((grepo (gitea/repo-git forge owner name)))
|
||||
(let
|
||||
((cid (gitea/resolve-ref grepo ref)))
|
||||
(if
|
||||
(nil? cid)
|
||||
nil
|
||||
(let
|
||||
((entry (gitea/tree-at grepo cid path)))
|
||||
(if (nil? entry) nil {:name name :path path :grepo grepo :entry entry :owner owner :ref ref})))))))))
|
||||
|
||||
(define
|
||||
gitea/w-entry-item
|
||||
(fn
|
||||
(hit n kind)
|
||||
(let
|
||||
((base (if (equal? kind "tree") "tree" "blob")))
|
||||
(let
|
||||
((sub (if (equal? (get hit :path) "") n (str (get hit :path) "/" n))))
|
||||
(str
|
||||
"<li class=\""
|
||||
kind
|
||||
"\"><a href=\"/"
|
||||
(get hit :owner)
|
||||
"/"
|
||||
(get hit :name)
|
||||
"/"
|
||||
base
|
||||
"/"
|
||||
(get hit :ref)
|
||||
"/"
|
||||
sub
|
||||
"\">"
|
||||
(dream-escape n)
|
||||
"</a></li>")))))
|
||||
|
||||
(define
|
||||
gitea/w-tree
|
||||
(fn
|
||||
(forge req)
|
||||
(let
|
||||
((hit (gitea/w-entry forge req)))
|
||||
(if
|
||||
(or (nil? hit) (not (equal? (get (get hit :entry) :kind) "tree")))
|
||||
(dream-not-found)
|
||||
(let
|
||||
((tree (git/read (get hit :grepo) (get (get hit :entry) :cid))))
|
||||
(gitea/w-page
|
||||
(str (get hit :owner) "/" (get hit :name) ": /" (get hit :path))
|
||||
(str
|
||||
"<h1>"
|
||||
(dream-escape (str (get hit :owner) "/" (get hit :name)))
|
||||
"</h1>"
|
||||
"<h2>/"
|
||||
(dream-escape (get hit :path))
|
||||
"</h2>"
|
||||
"<ul>"
|
||||
(join
|
||||
""
|
||||
(map
|
||||
(fn
|
||||
(n)
|
||||
(gitea/w-entry-item
|
||||
hit
|
||||
n
|
||||
(git/entry-kind (git/tree-entry-for tree n))))
|
||||
(git/tree-names tree)))
|
||||
"</ul>")))))))
|
||||
|
||||
(define
|
||||
gitea/w-blob
|
||||
(fn
|
||||
(forge req)
|
||||
(let
|
||||
((hit (gitea/w-entry forge req)))
|
||||
(if
|
||||
(or (nil? hit) (not (equal? (get (get hit :entry) :kind) "blob")))
|
||||
(dream-not-found)
|
||||
(let
|
||||
((data (git/blob-data (git/read (get hit :grepo) (get (get hit :entry) :cid)))))
|
||||
(gitea/w-page
|
||||
(str (get hit :owner) "/" (get hit :name) ": " (get hit :path))
|
||||
(str
|
||||
"<h1>"
|
||||
(dream-escape (get hit :path))
|
||||
"</h1>"
|
||||
"<pre>"
|
||||
(dream-escape data)
|
||||
"</pre>")))))))
|
||||
|
||||
(define
|
||||
gitea/w-raw
|
||||
(fn
|
||||
(forge req)
|
||||
(let
|
||||
((hit (gitea/w-entry forge req)))
|
||||
(if
|
||||
(or (nil? hit) (not (equal? (get (get hit :entry) :kind) "blob")))
|
||||
(dream-not-found)
|
||||
(dream-text
|
||||
(git/blob-data
|
||||
(git/read (get hit :grepo) (get (get hit :entry) :cid))))))))
|
||||
|
||||
(define
|
||||
gitea/w-commit-item
|
||||
(fn
|
||||
(grepo owner name c)
|
||||
(let
|
||||
((obj (git/read grepo c)))
|
||||
(str
|
||||
"<li><a href=\"/"
|
||||
owner
|
||||
"/"
|
||||
name
|
||||
"/commit/"
|
||||
c
|
||||
"\">"
|
||||
(dream-escape (or (git/commit-message obj) ""))
|
||||
"</a> <code>"
|
||||
c
|
||||
"</code></li>"))))
|
||||
|
||||
(define
|
||||
gitea/w-commits
|
||||
(fn
|
||||
(forge req)
|
||||
(let
|
||||
((owner (dream-param req "owner"))
|
||||
(name (dream-param req "name"))
|
||||
(ref (dream-param req "ref")))
|
||||
(if
|
||||
(not (gitea/repo-exists? forge owner name))
|
||||
(dream-not-found)
|
||||
(let
|
||||
((grepo (gitea/repo-git forge owner name)))
|
||||
(let
|
||||
((cid (gitea/resolve-ref grepo ref)))
|
||||
(if
|
||||
(nil? cid)
|
||||
(dream-not-found)
|
||||
(gitea/w-page
|
||||
(str owner "/" name " commits")
|
||||
(str
|
||||
"<h1>Commits</h1><ol>"
|
||||
(join
|
||||
""
|
||||
(map
|
||||
(fn (c) (gitea/w-commit-item grepo owner name c))
|
||||
(git/log grepo cid)))
|
||||
"</ol>")))))))))
|
||||
|
||||
; single commit: message/author/parents, plus the diff against the first
|
||||
; parent (root commits list their files instead)
|
||||
(define
|
||||
gitea/w-commit
|
||||
(fn
|
||||
(forge req)
|
||||
(let
|
||||
((owner (dream-param req "owner"))
|
||||
(name (dream-param req "name"))
|
||||
(cidp (dream-param req "cid")))
|
||||
(if
|
||||
(not (gitea/repo-exists? forge owner name))
|
||||
(dream-not-found)
|
||||
(let
|
||||
((grepo (gitea/repo-git forge owner name)))
|
||||
(let
|
||||
((obj (git/read grepo cidp)))
|
||||
(if
|
||||
(or (nil? obj) (not (git/commit? obj)))
|
||||
(dream-not-found)
|
||||
(let
|
||||
((parents (git/commit-parents obj)))
|
||||
(let
|
||||
((detail (if (empty? parents) (str "<h3>Files</h3><ul>" (join "" (map (fn (p) (str "<li>" (dream-escape p) "</li>")) (artdag/sort-strings (keys (git/tree-flatten grepo (git/commit-tree obj)))))) "</ul>") (str "<pre>" (dream-escape (git/commit-diff-unified grepo (first parents) cidp)) "</pre>"))))
|
||||
(gitea/w-page
|
||||
(str "commit " cidp)
|
||||
(str
|
||||
"<h1>"
|
||||
(dream-escape (or (git/commit-message obj) ""))
|
||||
"</h1>"
|
||||
"<p>author: "
|
||||
(dream-escape (or (git/commit-author obj) ""))
|
||||
"</p>"
|
||||
"<p>cid: <code>"
|
||||
cidp
|
||||
"</code></p>"
|
||||
detail)))))))))))
|
||||
|
||||
; ── 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))))
|
||||
|
||||
(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)})))))))
|
||||
|
||||
(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))))
|
||||
|
||||
; ── routes ───────────────────────────────────────────────────────────
|
||||
; /api/* is listed first so an owner segment can never shadow it (owner
|
||||
; names matching router words are rejected by gitea/valid-name? anyway).
|
||||
|
||||
(define
|
||||
gitea/routes
|
||||
(fn
|
||||
(forge)
|
||||
(list
|
||||
(dream-get "/" (fn (req) (gitea/w-index forge req)))
|
||||
(dream-get "/api/repos" (fn (req) (gitea/w-api-repos forge req)))
|
||||
(dream-post
|
||||
"/api/repos"
|
||||
(fn (req) (gitea/w-api-repo-create forge req)))
|
||||
(dream-delete
|
||||
"/api/repos/:owner/:name"
|
||||
(fn (req) (gitea/w-api-repo-delete forge req)))
|
||||
(dream-get "/:owner/:name" (fn (req) (gitea/w-repo-home forge req)))
|
||||
(dream-get
|
||||
"/:owner/:name/branches"
|
||||
(fn (req) (gitea/w-branches forge req)))
|
||||
(dream-get
|
||||
"/:owner/:name/commits/:ref"
|
||||
(fn (req) (gitea/w-commits forge req)))
|
||||
(dream-get
|
||||
"/:owner/:name/commit/:cid"
|
||||
(fn (req) (gitea/w-commit forge req)))
|
||||
(dream-get
|
||||
"/:owner/:name/tree/:ref/**"
|
||||
(fn (req) (gitea/w-tree forge req)))
|
||||
(dream-get
|
||||
"/:owner/:name/blob/:ref/**"
|
||||
(fn (req) (gitea/w-blob forge req)))
|
||||
(dream-get
|
||||
"/:owner/:name/raw/:ref/**"
|
||||
(fn (req) (gitea/w-raw forge req))))))
|
||||
|
||||
(define gitea/app (fn (forge) (dream-make-app (gitea/routes forge))))
|
||||
Reference in New Issue
Block a user