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:
149
lib/gitea/conformance.sh
Normal file
149
lib/gitea/conformance.sh
Normal file
@@ -0,0 +1,149 @@
|
||||
#!/usr/bin/env bash
|
||||
# lib/gitea/conformance.sh — run sx-gitea test suites, emit scoreboard.json + scoreboard.md.
|
||||
#
|
||||
# Usage:
|
||||
# bash lib/gitea/conformance.sh # run all suites
|
||||
# bash lib/gitea/conformance.sh -v # also print failure details
|
||||
|
||||
set -uo pipefail
|
||||
cd "$(git rev-parse --show-toplevel)"
|
||||
|
||||
SX_SERVER="${SX_SERVER:-hosts/ocaml/_build/default/bin/sx_server.exe}"
|
||||
if [ ! -x "$SX_SERVER" ]; then
|
||||
SX_SERVER="/root/rose-ash/hosts/ocaml/_build/default/bin/sx_server.exe"
|
||||
fi
|
||||
if [ ! -x "$SX_SERVER" ]; then
|
||||
echo "ERROR: sx_server.exe not found." >&2
|
||||
exit 1
|
||||
fi
|
||||
|
||||
VERBOSE="${1:-}"
|
||||
|
||||
# suite name | pass counter | fail counter | failures list
|
||||
SUITES=(
|
||||
"repo|gitea-repo-pass|gitea-repo-fail|gitea-repo-fails"
|
||||
)
|
||||
|
||||
OUT_JSON="lib/gitea/scoreboard.json"
|
||||
OUT_MD="lib/gitea/scoreboard.md"
|
||||
|
||||
# Library load order: kernel stdlib, persist, artdag canon, sx-git, dream
|
||||
# (types/router/middleware/error/html/json/api), then the gitea modules.
|
||||
MODULES=(
|
||||
"spec/stdlib.sx"
|
||||
"lib/r7rs.sx"
|
||||
"lib/persist/event.sx"
|
||||
"lib/persist/backend.sx"
|
||||
"lib/persist/log.sx"
|
||||
"lib/persist/kv.sx"
|
||||
"lib/artdag/dag.sx"
|
||||
"lib/git/object.sx"
|
||||
"lib/git/ref.sx"
|
||||
"lib/git/dag.sx"
|
||||
"lib/git/worktree.sx"
|
||||
"lib/git/diff.sx"
|
||||
"lib/git/merge.sx"
|
||||
"lib/git/porcelain.sx"
|
||||
"lib/dream/types.sx"
|
||||
"lib/dream/router.sx"
|
||||
"lib/dream/middleware.sx"
|
||||
"lib/dream/error.sx"
|
||||
"lib/dream/html.sx"
|
||||
"lib/dream/json.sx"
|
||||
"lib/dream/api.sx"
|
||||
"lib/gitea/repo.sx"
|
||||
"lib/gitea/web.sx"
|
||||
)
|
||||
|
||||
run_suite() {
|
||||
local suite=$1 passvar=$2 failvar=$3 failsvar=$4
|
||||
local file="lib/gitea/tests/${suite}.sx"
|
||||
local TMP
|
||||
TMP=$(mktemp)
|
||||
{
|
||||
echo "(epoch 1)"
|
||||
for M in "${MODULES[@]}"; do echo "(load \"$M\")"; done
|
||||
echo "(epoch 2)"
|
||||
echo "(load \"${file}\")"
|
||||
echo "(epoch 3)"
|
||||
echo "(eval \"(list ${passvar} ${failvar})\")"
|
||||
echo "(epoch 4)"
|
||||
echo "(eval \"(inspect ${failsvar})\")"
|
||||
} > "$TMP"
|
||||
|
||||
local OUTPUT
|
||||
OUTPUT=$(timeout 300 "$SX_SERVER" < "$TMP" 2>/dev/null)
|
||||
rm -f "$TMP"
|
||||
|
||||
local LINE
|
||||
LINE=$(echo "$OUTPUT" | awk '/^\(ok-len 3 / {getline; print; exit}')
|
||||
if [ -z "$LINE" ]; then
|
||||
LINE=$(echo "$OUTPUT" | grep -E '^\(ok 3 \([0-9]+ [0-9]+\)\)' | tail -1 \
|
||||
| sed -E 's/^\(ok 3 //; s/\)$//')
|
||||
fi
|
||||
|
||||
local P F
|
||||
P=$(echo "$LINE" | sed -E 's/^\(([0-9]+) ([0-9]+)\).*/\1/')
|
||||
F=$(echo "$LINE" | sed -E 's/^\(([0-9]+) ([0-9]+)\).*/\2/')
|
||||
P=${P:-0}
|
||||
F=${F:-0}
|
||||
|
||||
if [ -n "$VERBOSE" ] && [ "$F" != "0" ]; then
|
||||
echo " --- ${suite} failures ---" >&2
|
||||
echo "$OUTPUT" | awk '/^\(ok(-len)? 4 /,0' | head -40 >&2
|
||||
fi
|
||||
|
||||
echo "${P} ${F}"
|
||||
}
|
||||
|
||||
declare -A SUITE_PASS
|
||||
declare -A SUITE_FAIL
|
||||
TOTAL_PASS=0
|
||||
TOTAL_FAIL=0
|
||||
|
||||
echo "Running sx-gitea conformance suite..." >&2
|
||||
for entry in "${SUITES[@]}"; do
|
||||
IFS='|' read -r s passvar failvar failsvar <<< "$entry"
|
||||
read -r p f < <(run_suite "$s" "$passvar" "$failvar" "$failsvar")
|
||||
SUITE_PASS[$s]=$p
|
||||
SUITE_FAIL[$s]=$f
|
||||
TOTAL_PASS=$((TOTAL_PASS + p))
|
||||
TOTAL_FAIL=$((TOTAL_FAIL + f))
|
||||
printf " %-12s %d/%d\n" "$s" "$p" "$((p+f))" >&2
|
||||
done
|
||||
|
||||
{
|
||||
printf '{\n'
|
||||
printf ' "suites": {\n'
|
||||
first=1
|
||||
for entry in "${SUITES[@]}"; do
|
||||
IFS='|' read -r s _ _ _ <<< "$entry"
|
||||
if [ $first -eq 0 ]; then printf ',\n'; fi
|
||||
printf ' "%s": {"pass": %d, "fail": %d}' "$s" "${SUITE_PASS[$s]}" "${SUITE_FAIL[$s]}"
|
||||
first=0
|
||||
done
|
||||
printf '\n },\n'
|
||||
printf ' "total_pass": %d,\n' "$TOTAL_PASS"
|
||||
printf ' "total_fail": %d,\n' "$TOTAL_FAIL"
|
||||
printf ' "total": %d\n' "$((TOTAL_PASS + TOTAL_FAIL))"
|
||||
printf '}\n'
|
||||
} > "$OUT_JSON"
|
||||
|
||||
{
|
||||
printf '# sx-gitea Conformance Scoreboard\n\n'
|
||||
printf '_Generated by `lib/gitea/conformance.sh`_\n\n'
|
||||
printf '| Suite | Pass | Fail | Total |\n'
|
||||
printf '|-------|-----:|-----:|------:|\n'
|
||||
for entry in "${SUITES[@]}"; do
|
||||
IFS='|' read -r s _ _ _ <<< "$entry"
|
||||
p=${SUITE_PASS[$s]}
|
||||
f=${SUITE_FAIL[$s]}
|
||||
printf '| %s | %d | %d | %d |\n' "$s" "$p" "$f" "$((p+f))"
|
||||
done
|
||||
printf '| **Total** | **%d** | **%d** | **%d** |\n' "$TOTAL_PASS" "$TOTAL_FAIL" "$((TOTAL_PASS + TOTAL_FAIL))"
|
||||
} > "$OUT_MD"
|
||||
|
||||
echo "Wrote $OUT_JSON and $OUT_MD" >&2
|
||||
echo "Total: $TOTAL_PASS pass, $TOTAL_FAIL fail" >&2
|
||||
|
||||
[ "$TOTAL_FAIL" -eq 0 ]
|
||||
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))))))
|
||||
8
lib/gitea/scoreboard.json
Normal file
8
lib/gitea/scoreboard.json
Normal file
@@ -0,0 +1,8 @@
|
||||
{
|
||||
"suites": {
|
||||
"repo": {"pass": 91, "fail": 0}
|
||||
},
|
||||
"total_pass": 91,
|
||||
"total_fail": 0,
|
||||
"total": 91
|
||||
}
|
||||
8
lib/gitea/scoreboard.md
Normal file
8
lib/gitea/scoreboard.md
Normal file
@@ -0,0 +1,8 @@
|
||||
# sx-gitea Conformance Scoreboard
|
||||
|
||||
_Generated by `lib/gitea/conformance.sh`_
|
||||
|
||||
| Suite | Pass | Fail | Total |
|
||||
|-------|-----:|-----:|------:|
|
||||
| repo | 91 | 0 | 91 |
|
||||
| **Total** | **91** | **0** | **91** |
|
||||
448
lib/gitea/tests/repo.sx
Normal file
448
lib/gitea/tests/repo.sx
Normal file
@@ -0,0 +1,448 @@
|
||||
; lib/gitea/tests/repo.sx — Phase 1: forge core (owners, repo CRUD, git
|
||||
; wiring, ref/tree navigation) and the dream browse views + JSON API.
|
||||
|
||||
(define gitea-repo-pass 0)
|
||||
(define gitea-repo-fail 0)
|
||||
(define gitea-repo-fails (list))
|
||||
|
||||
; compare with = (structural), not equal? — map/filter-derived lists fail
|
||||
; equal? against literals even when they print identically
|
||||
(define
|
||||
gitea-repo-test
|
||||
(fn
|
||||
(name actual expected)
|
||||
(if
|
||||
(= actual expected)
|
||||
(set! gitea-repo-pass (+ gitea-repo-pass 1))
|
||||
(begin
|
||||
(set! gitea-repo-fail (+ gitea-repo-fail 1))
|
||||
(set! gitea-repo-fails (append gitea-repo-fails (list {:name name :expected (inspect expected) :actual (inspect actual)})))))))
|
||||
|
||||
(define gt-db (persist/mem-backend))
|
||||
(define gt-forge (gitea/forge gt-db))
|
||||
|
||||
; ── owners ───────────────────────────────────────────────────────────
|
||||
|
||||
(gitea-repo-test
|
||||
"user-create returns user record"
|
||||
(get (gitea/user-create! gt-forge "alice") :kind)
|
||||
"user")
|
||||
(gitea-repo-test
|
||||
"org-create returns org record"
|
||||
(get (gitea/org-create! gt-forge "acme") :kind)
|
||||
"org")
|
||||
(gitea-repo-test
|
||||
"owner-get finds alice"
|
||||
(get (gitea/owner-get gt-forge "alice") :name)
|
||||
"alice")
|
||||
(gitea-repo-test "owner-exists?" (gitea/owner-exists? gt-forge "alice") true)
|
||||
(gitea-repo-test
|
||||
"user? on user"
|
||||
(gitea/user? (gitea/owner-get gt-forge "alice"))
|
||||
true)
|
||||
(gitea-repo-test
|
||||
"org? on org"
|
||||
(gitea/org? (gitea/owner-get gt-forge "acme"))
|
||||
true)
|
||||
(gitea-repo-test
|
||||
"user? on org"
|
||||
(gitea/user? (gitea/owner-get gt-forge "acme"))
|
||||
false)
|
||||
(gitea-repo-test
|
||||
"duplicate owner conflicts"
|
||||
(get (gitea/user-create! gt-forge "alice") :conflict)
|
||||
true)
|
||||
(gitea-repo-test
|
||||
"owner name with slash rejected"
|
||||
(get (gitea/user-create! gt-forge "a/b") :error)
|
||||
"invalid-name")
|
||||
(gitea-repo-test
|
||||
"owner name empty rejected"
|
||||
(get (gitea/user-create! gt-forge "") :error)
|
||||
"invalid-name")
|
||||
(gitea-repo-test
|
||||
"reserved owner name rejected"
|
||||
(get (gitea/user-create! gt-forge "api") :error)
|
||||
"invalid-name")
|
||||
(gitea-repo-test
|
||||
"owners sorted"
|
||||
(gitea/owners gt-forge)
|
||||
(list "acme" "alice"))
|
||||
|
||||
; ── repo CRUD ────────────────────────────────────────────────────────
|
||||
|
||||
(define gt-rec (gitea/repo-create! gt-forge "alice" "proj" {:description "demo" :created-at 42}))
|
||||
|
||||
(gitea-repo-test "repo-create owner" (get gt-rec :owner) "alice")
|
||||
(gitea-repo-test "repo-create name" (get gt-rec :name) "proj")
|
||||
(gitea-repo-test
|
||||
"repo-create default visibility"
|
||||
(get gt-rec :visibility)
|
||||
"public")
|
||||
(gitea-repo-test
|
||||
"repo-create default branch"
|
||||
(get gt-rec :default-branch)
|
||||
"main")
|
||||
(gitea-repo-test
|
||||
"repo-create keeps created-at"
|
||||
(get gt-rec :created-at)
|
||||
42)
|
||||
(gitea-repo-test
|
||||
"repo-get description"
|
||||
(get (gitea/repo-get gt-forge "alice" "proj") :description)
|
||||
"demo")
|
||||
(gitea-repo-test
|
||||
"repo-exists?"
|
||||
(gitea/repo-exists? gt-forge "alice" "proj")
|
||||
true)
|
||||
(gitea-repo-test
|
||||
"repo-get missing"
|
||||
(gitea/repo-get gt-forge "alice" "nope")
|
||||
nil)
|
||||
(gitea-repo-test
|
||||
"repo-create unknown owner"
|
||||
(get (gitea/repo-create! gt-forge "bob" "x" {}) :error)
|
||||
"no-such-owner")
|
||||
(gitea-repo-test
|
||||
"repo-create duplicate conflicts"
|
||||
(get (gitea/repo-create! gt-forge "alice" "proj" {}) :conflict)
|
||||
true)
|
||||
(gitea-repo-test
|
||||
"repo-create bad name"
|
||||
(get (gitea/repo-create! gt-forge "alice" "ba d" {}) :error)
|
||||
"invalid-name")
|
||||
(gitea-repo-test
|
||||
"repos lists alice/proj"
|
||||
(gitea/repos gt-forge)
|
||||
(list "alice/proj"))
|
||||
|
||||
(gitea/repo-create! gt-forge "acme" "proj" {:visibility "private"})
|
||||
|
||||
(gitea-repo-test
|
||||
"same name under two owners"
|
||||
(gitea/repos gt-forge)
|
||||
(list "acme/proj" "alice/proj"))
|
||||
(gitea-repo-test
|
||||
"repos-for alice"
|
||||
(gitea/repos-for gt-forge "alice")
|
||||
(list "proj"))
|
||||
(gitea-repo-test
|
||||
"private visibility stored"
|
||||
(get (gitea/repo-get gt-forge "acme" "proj") :visibility)
|
||||
"private")
|
||||
(gitea-repo-test
|
||||
"repo-update! description"
|
||||
(begin
|
||||
(gitea/repo-update!
|
||||
gt-forge
|
||||
"alice"
|
||||
"proj"
|
||||
(fn (r) (assoc r :description "rewritten")))
|
||||
(get (gitea/repo-get gt-forge "alice" "proj") :description))
|
||||
"rewritten")
|
||||
(gitea-repo-test
|
||||
"repo-update! missing repo"
|
||||
(gitea/repo-update! gt-forge "alice" "nope" (fn (r) r))
|
||||
nil)
|
||||
|
||||
; ── git store wiring ─────────────────────────────────────────────────
|
||||
|
||||
(define gt-grepo (gitea/repo-git gt-forge "alice" "proj"))
|
||||
|
||||
(gitea-repo-test "new repo HEAD unborn" (git/head gt-grepo) nil)
|
||||
(gitea-repo-test
|
||||
"new repo HEAD targets main"
|
||||
(git/head-target gt-grepo)
|
||||
"heads/main")
|
||||
(gitea-repo-test "new repo has no branches" (git/branches gt-grepo) (list))
|
||||
|
||||
(git/add! gt-grepo "README.md" "hello forge")
|
||||
(git/add! gt-grepo "src/a.txt" "alpha\n")
|
||||
(git/add! gt-grepo "src/b.txt" "beta\n")
|
||||
(define gt-c1 (git/commit! gt-grepo {:message "init" :time 1 :author "alice"}))
|
||||
|
||||
(gitea-repo-test
|
||||
"commit! advances main"
|
||||
(git/branch-get gt-grepo "main")
|
||||
gt-c1)
|
||||
|
||||
(git/add! gt-grepo "src/a.txt" "alpha2\n")
|
||||
(define gt-c2 (git/commit! gt-grepo {:message "tweak a" :time 2 :author "alice"}))
|
||||
|
||||
(gitea-repo-test
|
||||
"log newest first"
|
||||
(git/log gt-grepo gt-c2)
|
||||
(list gt-c2 gt-c1))
|
||||
(gitea-repo-test "branches lists main" (git/branches gt-grepo) (list "main"))
|
||||
|
||||
(define gt-grepo2 (gitea/repo-git gt-forge "acme" "proj"))
|
||||
|
||||
(gitea-repo-test
|
||||
"objects invisible across repos"
|
||||
(git/has? gt-grepo2 gt-c1)
|
||||
false)
|
||||
|
||||
; ── ref resolution ───────────────────────────────────────────────────
|
||||
|
||||
(gitea-repo-test "resolve branch" (gitea/resolve-ref gt-grepo "main") gt-c2)
|
||||
|
||||
(git/tag-lightweight! gt-grepo "v1")
|
||||
(gitea-repo-test
|
||||
"resolve lightweight tag"
|
||||
(gitea/resolve-ref gt-grepo "v1")
|
||||
gt-c2)
|
||||
|
||||
(git/tag! gt-grepo "v2" {:message "release" :time 3})
|
||||
(gitea-repo-test
|
||||
"resolve annotated tag peels to commit"
|
||||
(gitea/resolve-ref gt-grepo "v2")
|
||||
gt-c2)
|
||||
|
||||
(gitea-repo-test "resolve raw cid" (gitea/resolve-ref gt-grepo gt-c1) gt-c1)
|
||||
(gitea-repo-test
|
||||
"resolve unknown ref"
|
||||
(gitea/resolve-ref gt-grepo "nope")
|
||||
nil)
|
||||
|
||||
; ── tree navigation ──────────────────────────────────────────────────
|
||||
|
||||
(gitea-repo-test
|
||||
"tree-at root is tree"
|
||||
(get (gitea/tree-at gt-grepo gt-c2 "") :kind)
|
||||
"tree")
|
||||
(gitea-repo-test
|
||||
"tree-at file is blob"
|
||||
(get (gitea/tree-at gt-grepo gt-c2 "src/a.txt") :kind)
|
||||
"blob")
|
||||
(gitea-repo-test
|
||||
"tree-at file cid matches content"
|
||||
(get (gitea/tree-at gt-grepo gt-c2 "src/a.txt") :cid)
|
||||
(git/cid (git/blob "alpha2\n")))
|
||||
(gitea-repo-test
|
||||
"tree-at dir is tree"
|
||||
(get (gitea/tree-at gt-grepo gt-c2 "src") :kind)
|
||||
"tree")
|
||||
(gitea-repo-test
|
||||
"tree-at missing path"
|
||||
(gitea/tree-at gt-grepo gt-c2 "src/zzz")
|
||||
nil)
|
||||
(gitea-repo-test
|
||||
"tree-at path through blob"
|
||||
(gitea/tree-at gt-grepo gt-c2 "README.md/x")
|
||||
nil)
|
||||
(gitea-repo-test
|
||||
"tree-at non-commit cid"
|
||||
(gitea/tree-at gt-grepo (git/cid (git/blob "alpha2\n")) "")
|
||||
nil)
|
||||
|
||||
; ── browse views ─────────────────────────────────────────────────────
|
||||
|
||||
(define gt-app (gitea/app gt-forge))
|
||||
(define
|
||||
gt-get
|
||||
(fn (target) (gt-app (dream-request "GET" target {} ""))))
|
||||
(define
|
||||
gt-post
|
||||
(fn (target body) (gt-app (dream-request "POST" target {} body))))
|
||||
(define
|
||||
gt-del
|
||||
(fn (target) (gt-app (dream-request "DELETE" target {} ""))))
|
||||
|
||||
(gitea-repo-test "GET / status" (dream-status (gt-get "/")) 200)
|
||||
(gitea-repo-test
|
||||
"GET / lists repos"
|
||||
(contains? (dream-resp-body (gt-get "/")) "alice/proj")
|
||||
true)
|
||||
|
||||
(gitea-repo-test
|
||||
"repo home status"
|
||||
(dream-status (gt-get "/alice/proj"))
|
||||
200)
|
||||
(gitea-repo-test
|
||||
"repo home shows description"
|
||||
(contains? (dream-resp-body (gt-get "/alice/proj")) "rewritten")
|
||||
true)
|
||||
(gitea-repo-test
|
||||
"repo home shows branch"
|
||||
(contains? (dream-resp-body (gt-get "/alice/proj")) "main")
|
||||
true)
|
||||
(gitea-repo-test
|
||||
"empty repo home"
|
||||
(contains? (dream-resp-body (gt-get "/acme/proj")) "empty repository")
|
||||
true)
|
||||
(gitea-repo-test
|
||||
"unknown repo 404"
|
||||
(dream-status (gt-get "/nobody/none"))
|
||||
404)
|
||||
|
||||
(gitea-repo-test
|
||||
"branches page lists main"
|
||||
(contains? (dream-resp-body (gt-get "/alice/proj/branches")) "main")
|
||||
true)
|
||||
(gitea-repo-test
|
||||
"branches page unknown repo 404"
|
||||
(dream-status (gt-get "/nobody/none/branches"))
|
||||
404)
|
||||
|
||||
(gitea-repo-test
|
||||
"tree root status"
|
||||
(dream-status (gt-get "/alice/proj/tree/main"))
|
||||
200)
|
||||
(gitea-repo-test
|
||||
"tree root lists src"
|
||||
(contains? (dream-resp-body (gt-get "/alice/proj/tree/main")) "src")
|
||||
true)
|
||||
(gitea-repo-test
|
||||
"tree root lists README"
|
||||
(contains? (dream-resp-body (gt-get "/alice/proj/tree/main")) "README.md")
|
||||
true)
|
||||
(gitea-repo-test
|
||||
"tree subdir lists a.txt"
|
||||
(contains? (dream-resp-body (gt-get "/alice/proj/tree/main/src")) "a.txt")
|
||||
true)
|
||||
(gitea-repo-test
|
||||
"tree at tag"
|
||||
(dream-status (gt-get "/alice/proj/tree/v1"))
|
||||
200)
|
||||
(gitea-repo-test
|
||||
"tree bad ref 404"
|
||||
(dream-status (gt-get "/alice/proj/tree/nope"))
|
||||
404)
|
||||
(gitea-repo-test
|
||||
"tree on blob path 404"
|
||||
(dream-status (gt-get "/alice/proj/tree/main/README.md"))
|
||||
404)
|
||||
|
||||
(gitea-repo-test
|
||||
"blob status"
|
||||
(dream-status (gt-get "/alice/proj/blob/main/src/a.txt"))
|
||||
200)
|
||||
(gitea-repo-test
|
||||
"blob shows content"
|
||||
(contains?
|
||||
(dream-resp-body (gt-get "/alice/proj/blob/main/src/a.txt"))
|
||||
"alpha2")
|
||||
true)
|
||||
(gitea-repo-test
|
||||
"blob on tree path 404"
|
||||
(dream-status (gt-get "/alice/proj/blob/main/src"))
|
||||
404)
|
||||
(gitea-repo-test
|
||||
"raw body exact"
|
||||
(dream-resp-body (gt-get "/alice/proj/raw/main/src/a.txt"))
|
||||
"alpha2\n")
|
||||
(gitea-repo-test
|
||||
"raw missing file 404"
|
||||
(dream-status (gt-get "/alice/proj/raw/main/zzz"))
|
||||
404)
|
||||
|
||||
(gitea-repo-test
|
||||
"commits status"
|
||||
(dream-status (gt-get "/alice/proj/commits/main"))
|
||||
200)
|
||||
(gitea-repo-test
|
||||
"commits show newest message"
|
||||
(contains? (dream-resp-body (gt-get "/alice/proj/commits/main")) "tweak a")
|
||||
true)
|
||||
(gitea-repo-test
|
||||
"commits show oldest message"
|
||||
(contains? (dream-resp-body (gt-get "/alice/proj/commits/main")) "init")
|
||||
true)
|
||||
(gitea-repo-test
|
||||
"commits bad ref 404"
|
||||
(dream-status (gt-get "/alice/proj/commits/nope"))
|
||||
404)
|
||||
|
||||
(gitea-repo-test
|
||||
"commit view message"
|
||||
(contains?
|
||||
(dream-resp-body (gt-get (str "/alice/proj/commit/" gt-c2)))
|
||||
"tweak a")
|
||||
true)
|
||||
(gitea-repo-test
|
||||
"commit view diff content"
|
||||
(contains?
|
||||
(dream-resp-body (gt-get (str "/alice/proj/commit/" gt-c2)))
|
||||
"alpha2")
|
||||
true)
|
||||
(gitea-repo-test
|
||||
"root commit lists files"
|
||||
(contains?
|
||||
(dream-resp-body (gt-get (str "/alice/proj/commit/" gt-c1)))
|
||||
"README.md")
|
||||
true)
|
||||
(gitea-repo-test
|
||||
"commit bad cid 404"
|
||||
(dream-status (gt-get "/alice/proj/commit/zzz"))
|
||||
404)
|
||||
|
||||
; ── json api ─────────────────────────────────────────────────────────
|
||||
|
||||
(gitea-repo-test
|
||||
"api repos json"
|
||||
(dream-json-parse (dream-resp-body (gt-get "/api/repos")))
|
||||
(list "acme/proj" "alice/proj"))
|
||||
|
||||
(gitea-repo-test
|
||||
"api create 201"
|
||||
(dream-status (gt-post "/api/repos" (dream-json-encode {:name "web" :owner "alice"})))
|
||||
201)
|
||||
(gitea-repo-test
|
||||
"api create persisted"
|
||||
(gitea/repo-exists? gt-forge "alice" "web")
|
||||
true)
|
||||
(gitea-repo-test
|
||||
"api create duplicate 409"
|
||||
(dream-status (gt-post "/api/repos" (dream-json-encode {:name "web" :owner "alice"})))
|
||||
409)
|
||||
(gitea-repo-test
|
||||
"api create unknown owner 400"
|
||||
(dream-status (gt-post "/api/repos" (dream-json-encode {:name "web" :owner "zeb"})))
|
||||
400)
|
||||
(gitea-repo-test
|
||||
"api create bad name 400"
|
||||
(dream-status (gt-post "/api/repos" (dream-json-encode {:name "b d" :owner "alice"})))
|
||||
400)
|
||||
(gitea-repo-test
|
||||
"api delete 200"
|
||||
(dream-status (gt-del "/api/repos/alice/web"))
|
||||
200)
|
||||
(gitea-repo-test
|
||||
"api delete gone"
|
||||
(gitea/repo-exists? gt-forge "alice" "web")
|
||||
false)
|
||||
(gitea-repo-test
|
||||
"api delete missing 404"
|
||||
(dream-status (gt-del "/api/repos/alice/web"))
|
||||
404)
|
||||
|
||||
; ── delete purges the git namespace ──────────────────────────────────
|
||||
|
||||
(gitea/repo-create! gt-forge "alice" "tmp" {})
|
||||
(define gt-gtmp (gitea/repo-git gt-forge "alice" "tmp"))
|
||||
(git/add! gt-gtmp "f.txt" "data")
|
||||
(git/commit! gt-gtmp {:message "x" :time 9})
|
||||
|
||||
(gitea-repo-test
|
||||
"delete returns true"
|
||||
(gitea/repo-delete! gt-forge "alice" "tmp")
|
||||
true)
|
||||
(gitea-repo-test
|
||||
"delete removes record"
|
||||
(gitea/repo-get gt-forge "alice" "tmp")
|
||||
nil)
|
||||
(gitea-repo-test
|
||||
"delete purges git keys"
|
||||
(len
|
||||
(filter
|
||||
(fn (k) (starts-with? k "forge/alice/tmp/"))
|
||||
(persist/kv-keys gt-db)))
|
||||
0)
|
||||
(gitea-repo-test
|
||||
"delete missing returns false"
|
||||
(gitea/repo-delete! gt-forge "alice" "tmp")
|
||||
false)
|
||||
(gitea-repo-test
|
||||
"other repos survive delete"
|
||||
(gitea/repos gt-forge)
|
||||
(list "acme/proj" "alice/proj"))
|
||||
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