From c037aca51f175704d62e3bcfd1bf2d33ff513f16 Mon Sep 17 00:00:00 2001 From: giles Date: Fri, 3 Jul 2026 12:45:05 +0000 Subject: [PATCH] =?UTF-8?q?sx-gitea=20Phase=201:=20repo=20=E2=80=94=20forg?= =?UTF-8?q?e=20core=20(owners,=20repo=20CRUD,=20per-repo=20git=20stores)?= =?UTF-8?q?=20+=20dream=20browse=20views=20(TDD,=2091/91)?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit 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//) 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 --- lib/gitea/conformance.sh | 149 +++++++++++++ lib/gitea/repo.sx | 243 +++++++++++++++++++++ lib/gitea/scoreboard.json | 8 + lib/gitea/scoreboard.md | 8 + lib/gitea/tests/repo.sx | 448 ++++++++++++++++++++++++++++++++++++++ lib/gitea/web.sx | 391 +++++++++++++++++++++++++++++++++ 6 files changed, 1247 insertions(+) create mode 100644 lib/gitea/conformance.sh create mode 100644 lib/gitea/repo.sx create mode 100644 lib/gitea/scoreboard.json create mode 100644 lib/gitea/scoreboard.md create mode 100644 lib/gitea/tests/repo.sx create mode 100644 lib/gitea/web.sx diff --git a/lib/gitea/conformance.sh b/lib/gitea/conformance.sh new file mode 100644 index 00000000..92ecf4cb --- /dev/null +++ b/lib/gitea/conformance.sh @@ -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 ] diff --git a/lib/gitea/repo.sx b/lib/gitea/repo.sx new file mode 100644 index 00000000..6c05eb0d --- /dev/null +++ b/lib/gitea/repo.sx @@ -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//", +; 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)))))) diff --git a/lib/gitea/scoreboard.json b/lib/gitea/scoreboard.json new file mode 100644 index 00000000..b955b646 --- /dev/null +++ b/lib/gitea/scoreboard.json @@ -0,0 +1,8 @@ +{ + "suites": { + "repo": {"pass": 91, "fail": 0} + }, + "total_pass": 91, + "total_fail": 0, + "total": 91 +} diff --git a/lib/gitea/scoreboard.md b/lib/gitea/scoreboard.md new file mode 100644 index 00000000..f20fee82 --- /dev/null +++ b/lib/gitea/scoreboard.md @@ -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** | diff --git a/lib/gitea/tests/repo.sx b/lib/gitea/tests/repo.sx new file mode 100644 index 00000000..f10a6455 --- /dev/null +++ b/lib/gitea/tests/repo.sx @@ -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")) diff --git a/lib/gitea/web.sx b/lib/gitea/web.sx new file mode 100644 index 00000000..85465230 --- /dev/null +++ b/lib/gitea/web.sx @@ -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 + "" + (dream-escape title) + "" + body + "")))) + +(define + gitea/w-repo-link + (fn + (full) + (str "
  • " (dream-escape full) "
    • "))) + +; ── pages ──────────────────────────────────────────────────────────── + +(define + gitea/w-index + (fn + (forge req) + (gitea/w-page + "repositories" + (str + "

    Repositories

      " + (join "" (map gitea/w-repo-link (gitea/repos forge))) + "
    ")))) + +(define + gitea/w-branch-item + (fn + (owner name b) + (str + "
  • " + (dream-escape b) + "
    • "))) + +(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 + "

    " + (dream-escape (str owner "/" name)) + "

    " + "

    " + (dream-escape (or (get rec :description) "")) + "

    " + "

    visibility: " + (dream-escape (get rec :visibility)) + "

    " + (if + (empty? branches) + "

    empty repository

    " + (str + "

    Branches

      " + (join + "" + (map + (fn (b) (gitea/w-branch-item owner name b)) + branches)) + "
    ")))))))))) + +(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 + "

    Branches

      " + (join + "" + (map + (fn (b) (gitea/w-branch-item owner name b)) + (git/branches (gitea/repo-git forge owner name)))) + "
    ")))))) + +; 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 + "
  • " + (dream-escape n) + "
    • "))))) + +(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 + "

    " + (dream-escape (str (get hit :owner) "/" (get hit :name))) + "

    " + "

    /" + (dream-escape (get hit :path)) + "

    " + "
      " + (join + "" + (map + (fn + (n) + (gitea/w-entry-item + hit + n + (git/entry-kind (git/tree-entry-for tree n)))) + (git/tree-names tree))) + "
    "))))))) + +(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 + "

    " + (dream-escape (get hit :path)) + "

    " + "
    "
+              (dream-escape data)
+              "
    "))))))) + +(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 + "
  • " + (dream-escape (or (git/commit-message obj) "")) + " " + c + "
    • ")))) + +(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 + "

    Commits

      " + (join + "" + (map + (fn (c) (gitea/w-commit-item grepo owner name c)) + (git/log grepo cid))) + "
    "))))))))) + +; 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 "

    Files

      " (join "" (map (fn (p) (str "
    • " (dream-escape p) "
      • ")) (artdag/sort-strings (keys (git/tree-flatten grepo (git/commit-tree obj)))))) "
    ") (str "
    " (dream-escape (git/commit-diff-unified grepo (first parents) cidp)) "
    ")))) + (gitea/w-page + (str "commit " cidp) + (str + "

    " + (dream-escape (or (git/commit-message obj) "")) + "

    " + "

    author: " + (dream-escape (or (git/commit-author obj) "")) + "

    " + "

    cid: " + cidp + "

    " + 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))))