giles
c037aca51f
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>
392 lines
12 KiB
Plaintext
392 lines
12 KiB
Plaintext
; 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))))
|