Merge branch 'loops/gitea' into architecture

lib/git/conformance.sh

@@ -0,0 +1,134 @@
+#!/usr/bin/env bash
+# lib/git/conformance.sh — run sx-git test suites, emit scoreboard.json + scoreboard.md.
+
+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
+
+SUITES=(object ref dag worktree diff merge porcelain export import)
+
+OUT_JSON="lib/git/scoreboard.json"
+OUT_MD="lib/git/scoreboard.md"
+
+run_suite() {
+  local suite=$1
+  local file="lib/git/tests/${suite}.sx"
+  local TMP
+  TMP=$(mktemp)
+  cat > "$TMP" << EPOCHS
+(epoch 1)
+(load "spec/stdlib.sx")
+(load "lib/r7rs.sx")
+(load "lib/persist/event.sx")
+(load "lib/persist/backend.sx")
+(load "lib/persist/log.sx")
+(load "lib/persist/kv.sx")
+(load "lib/artdag/dag.sx")
+(load "lib/datalog/tokenizer.sx")
+(load "lib/datalog/parser.sx")
+(load "lib/datalog/unify.sx")
+(load "lib/datalog/db.sx")
+(load "lib/datalog/builtins.sx")
+(load "lib/datalog/aggregates.sx")
+(load "lib/datalog/strata.sx")
+(load "lib/datalog/eval.sx")
+(load "lib/datalog/api.sx")
+(load "lib/datalog/magic.sx")
+(load "lib/git/object.sx")
+(load "lib/git/ref.sx")
+(load "lib/git/dag.sx")
+(load "lib/git/worktree.sx")
+(load "lib/git/diff.sx")
+(load "lib/git/merge.sx")
+(load "lib/git/porcelain.sx")
+(load "lib/git/sha1.sx")
+(load "lib/git/export.sx")
+(load "lib/git/import.sx")
+(epoch 2)
+(eval "(define git-test-pass 0)")
+(eval "(define git-test-fail 0)")
+(eval "(define git-test-failures (list))")
+(eval "(define git-test (fn (name got expected) (if (equal? got expected) (set! git-test-pass (+ git-test-pass 1)) (begin (set! git-test-fail (+ git-test-fail 1)) (set! git-test-failures (append git-test-failures (list (list name (inspect got) (inspect expected)))))))))")
+(epoch 3)
+(load "${file}")
+(epoch 4)
+(eval "(list git-test-pass git-test-fail)")
+EPOCHS
+
+  local OUTPUT
+  OUTPUT=$(timeout 300 "$SX_SERVER" < "$TMP" 2>/dev/null)
+  rm -f "$TMP"
+
+  local LINE
+  LINE=$(echo "$OUTPUT" | awk '/^\(ok-len 4 / {getline; print; exit}')
+  if [ -z "$LINE" ]; then
+    LINE=$(echo "$OUTPUT" | grep -E '^\(ok 4 \([0-9]+ [0-9]+\)\)' | tail -1 \
+            | sed -E 's/^\(ok 4 //; 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}
+  echo "${P} ${F}"
+}
+
+declare -A SUITE_PASS
+declare -A SUITE_FAIL
+TOTAL_PASS=0
+TOTAL_FAIL=0
+
+echo "Running sx-git conformance suite..." >&2
+for s in "${SUITES[@]}"; do
+  read -r p f < <(run_suite "$s")
+  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
+
+# scoreboard.json
+{
+  printf '{\n'
+  printf '  "suites": {\n'
+  first=1
+  for s in "${SUITES[@]}"; do
+    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"
+
+# scoreboard.md
+{
+  printf '# sx-git Conformance Scoreboard\n\n'
+  printf '_Generated by `lib/git/conformance.sh`_\n\n'
+  printf '| Suite | Pass | Fail | Total |\n'
+  printf '|-------|-----:|-----:|------:|\n'
+  for s in "${SUITES[@]}"; do
+    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 ]

lib/git/dag.sx

@@ -0,0 +1,180 @@
+; lib/git/dag.sx — sx-git Phase 3: the commit DAG as queries.
+; The workhorse walks (log, ancestry, reachability, merge-base) run SX-side
+; over parent edges read straight from commit objects. The Datalog bridge
+; exports those edges as (git-parent child parent) facts under a deliberately
+; MINIMAL two-rule ancestor closure (every dl-query re-saturates the ruleset —
+; keep it lean, walk SX-side; see lib/relations/engine.sx for the precedent).
+; Requires: lib/git/object.sx; datalog stack only for the git/dag-db bridge.
+
+(define
+  git/parents
+  (fn
+    (repo cid)
+    (let
+      ((c (git/read repo cid)))
+      (if (git/commit? c) (git/commit-parents c) (list)))))
+
+; ---- DFS postorder over parent edges, visited-set threaded through ----
+; returns (seen acc); acc lists each commit AFTER all its parents.
+(define
+  git/dag-post
+  (fn
+    (repo cid seen acc)
+    (if
+      (has-key? seen cid)
+      (list seen acc)
+      (let
+        ((res (git/dag-post-list repo (git/parents repo cid) (assoc seen cid true) acc)))
+        (list (first res) (append (nth res 1) (list cid)))))))
+
+(define
+  git/dag-post-list
+  (fn
+    (repo cids seen acc)
+    (if
+      (empty? cids)
+      (list seen acc)
+      (let
+        ((res (git/dag-post repo (first cids) seen acc)))
+        (git/dag-post-list
+          repo
+          (rest cids)
+          (first res)
+          (nth res 1))))))
+
+; all commits reachable from cid, INCLUDING cid (parents-first order)
+(define
+  git/reachable
+  (fn
+    (repo cid)
+    (nth (git/dag-post repo cid {} (list)) 1)))
+
+(define
+  git/reachable-all
+  (fn
+    (repo cids)
+    (nth (git/dag-post-list repo cids {} (list)) 1)))
+
+; ---- log: topological, children before parents (reverse DFS postorder) ----
+(define
+  git/log
+  (fn (repo head-cid) (reverse (git/reachable repo head-cid))))
+
+(define
+  git/log-messages
+  (fn
+    (repo head-cid)
+    (map
+      (fn (c) (git/commit-message (git/read repo c)))
+      (git/log repo head-cid))))
+
+; ---- ancestry ----
+; proper ancestors of cid (excludes cid itself unless reachable via a cycle,
+; which a well-formed commit DAG never has)
+(define
+  git/ancestors
+  (fn
+    (repo cid)
+    (nth
+      (git/dag-post-list repo (git/parents repo cid) {} (list))
+      1)))
+
+(define
+  git/dag-member?
+  (fn (x xs) (reduce (fn (acc y) (or acc (equal? x y))) false xs)))
+
+; reflexive, like `git merge-base --is-ancestor A B`: is a an ancestor of b?
+(define
+  git/is-ancestor?
+  (fn
+    (repo a b)
+    (if (equal? a b) true (git/dag-member? a (git/ancestors repo b)))))
+
+; ---- merge-base (LCA) ----
+(define
+  git/dag-set
+  (fn (xs) (reduce (fn (acc x) (assoc acc x true)) {} xs)))
+
+(define
+  git/common-ancestors
+  (fn
+    (repo a b)
+    (let
+      ((sb (git/dag-set (git/reachable repo b))))
+      (filter (fn (c) (has-key? sb c)) (git/reachable repo a)))))
+
+; all best common ancestors: common ancestors dominated by no other common
+; ancestor (c is dominated when it is a proper ancestor of another common d)
+(define
+  git/merge-bases
+  (fn
+    (repo a b)
+    (let
+      ((common (git/common-ancestors repo a b)))
+      (artdag/sort-strings
+        (filter
+          (fn
+            (c)
+            (not
+              (reduce
+                (fn
+                  (acc d)
+                  (or
+                    acc
+                    (and
+                      (not (equal? c d))
+                      (git/dag-member? c (git/ancestors repo d)))))
+                false
+                common)))
+          common)))))
+
+(define
+  git/merge-base
+  (fn
+    (repo a b)
+    (let
+      ((bs (git/merge-bases repo a b)))
+      (if (empty? bs) nil (first bs)))))
+
+; ---- Datalog bridge: parent edges as facts, minimal ancestor closure ----
+(define
+  git/dag-rules
+  (quote
+    ((git-anc X Y <- (git-parent X Y))
+      (git-anc X Y <- (git-parent X Z) (git-anc Z Y)))))
+
+(define
+  git/dag-facts
+  (fn
+    (repo heads)
+    (reduce
+      (fn
+        (acc c)
+        (append
+          acc
+          (map
+            (fn (p) (list (quote git-parent) c p))
+            (git/parents repo c))))
+      (list)
+      (git/reachable-all repo heads))))
+
+(define
+  git/dag-db
+  (fn
+    (repo heads)
+    (dl-program-data (git/dag-facts repo heads) git/dag-rules)))
+
+(define
+  git/ancestors-dl
+  (fn
+    (db cid)
+    (artdag/sort-strings
+      (map
+        (fn (s) (get s :Y))
+        (dl-query db (list (quote git-anc) cid (quote Y)))))))
+
+(define
+  git/is-ancestor-dl?
+  (fn
+    (db a b)
+    (> (len (dl-query db (list (quote git-anc) b a))) 0)))

lib/git/diff.sx

@@ -0,0 +1,427 @@
+; lib/git/diff.sx — sx-git Phase 5: structural tree diff + Myers line diff.
+; Tree diff = files-diff over flattened trees (path -> blob cid). Blob diff =
+; Myers O(ND) shortest edit script over lines, edit script ops
+; {:op "eq"|"del"|"add" :line l}, rendered as unified hunks (context 3).
+; Requires: lib/git/object.sx, lib/git/worktree.sx.
+
+; ---- lines <-> data ----
+(define
+  git/diff-take
+  (fn
+    (xs n)
+    (if
+      (or (= n 0) (empty? xs))
+      (list)
+      (cons (first xs) (git/diff-take (rest xs) (- n 1))))))
+
+(define
+  git/diff-lines
+  (fn
+    (s)
+    (let
+      ((parts (split s "\n")))
+      (if
+        (and
+          (> (len parts) 0)
+          (equal? (nth parts (- (len parts) 1)) ""))
+        (git/diff-take parts (- (len parts) 1))
+        parts))))
+
+; index-keyed dict as an O(1) vector
+(define
+  git/dvec
+  (fn
+    (xs)
+    (reduce
+      (fn (acc p) (assoc acc (str (first p)) (nth p 1)))
+      {}
+      (map-indexed (fn (i x) (list i x)) xs))))
+(define git/dget (fn (v i) (get v (str i))))
+
+; ---- Myers forward pass ----
+; v: dict k(str) -> furthest x on diagonal k. Reads of k±1 always hit the
+; previous round's parity, so in-round writes never corrupt the decision.
+(define
+  git/myers-x
+  (fn
+    (v d k)
+    (if
+      (or
+        (= k (- 0 d))
+        (and
+          (not (= k d))
+          (< (git/dget v (- k 1)) (git/dget v (+ k 1)))))
+      (git/dget v (+ k 1))
+      (+ (git/dget v (- k 1)) 1))))
+
+(define
+  git/myers-snake
+  (fn
+    (av bv n m x y)
+    (if
+      (and (< x n) (< y m) (equal? (git/dget av x) (git/dget bv y)))
+      (git/myers-snake av bv n m (+ x 1) (+ y 1))
+      (list x y))))
+
+; one round d over k = -d, -d+2, ..., d; returns (v done?)
+(define
+  git/myers-round
+  (fn
+    (av bv n m v d k)
+    (if
+      (> k d)
+      (list v false)
+      (let
+        ((sn (git/myers-snake av bv n m (git/myers-x v d k) (- (git/myers-x v d k) k))))
+        (let
+          ((v2 (assoc v (str k) (first sn))))
+          (if
+            (and (>= (first sn) n) (>= (nth sn 1) m))
+            (list v2 true)
+            (git/myers-round av bv n m v2 d (+ k 2))))))))
+
+; trace[d] = v entering round d; returns (trace D)
+(define
+  git/myers-run
+  (fn
+    (av bv n m v d trace)
+    (let
+      ((trace2 (append trace (list v))))
+      (let
+        ((res (git/myers-round av bv n m v d (- 0 d))))
+        (if
+          (nth res 1)
+          (list trace2 d)
+          (git/myers-run av bv n m (first res) (+ d 1) trace2))))))
+
+; ---- Myers backtrack: walk (n,m) back to (0,0), cons ops into forward order ----
+(define
+  git/myers-diag
+  (fn
+    (av x y px py ops)
+    (if
+      (and (> x px) (> y py))
+      (git/myers-diag
+        av
+        (- x 1)
+        (- y 1)
+        px
+        py
+        (cons {:op "eq" :line (git/dget av (- x 1))} ops))
+      (list x y ops))))
+
+(define
+  git/myers-back
+  (fn
+    (av bv trace d x y ops)
+    (if
+      (< d 0)
+      ops
+      (let
+        ((v (nth trace d)))
+        (let
+          ((k (- x y)))
+          (let
+            ((pk (if (or (= k (- 0 d)) (and (not (= k d)) (< (git/dget v (- k 1)) (git/dget v (+ k 1))))) (+ k 1) (- k 1))))
+            (let
+              ((px (git/dget v pk)))
+              (let
+                ((py (- px pk)))
+                (let
+                  ((r (git/myers-diag av x y px py ops)))
+                  (if
+                    (> d 0)
+                    (git/myers-back
+                      av
+                      bv
+                      trace
+                      (- d 1)
+                      px
+                      py
+                      (if
+                        (= (first r) px)
+                        (cons {:op "add" :line (git/dget bv py)} (nth r 2))
+                        (cons {:op "del" :line (git/dget av px)} (nth r 2))))
+                    (nth r 2)))))))))))
+
+; ---- edit script over two strings ----
+(define
+  git/diff-script-lines
+  (fn
+    (al bl)
+    (let
+      ((rt (git/myers-run (git/dvec al) (git/dvec bl) (len al) (len bl) (assoc {} "1" 0) 0 (list))))
+      (git/myers-back
+        (git/dvec al)
+        (git/dvec bl)
+        (first rt)
+        (nth rt 1)
+        (len al)
+        (len bl)
+        (list)))))
+
+(define
+  git/diff-script
+  (fn
+    (a-data b-data)
+    (git/diff-script-lines (git/diff-lines a-data) (git/diff-lines b-data))))
+
+; reconstruction invariants: old = eq+del lines, new = eq+add lines
+(define
+  git/diff-changes
+  (fn
+    (script)
+    (len (filter (fn (o) (not (equal? (get o :op) "eq"))) script))))
+(define
+  git/diff-old-lines
+  (fn
+    (script)
+    (map
+      (fn (o) (get o :line))
+      (filter (fn (o) (not (equal? (get o :op) "add"))) script))))
+
+; ---- unified rendering ----
+(define
+  git/diff-new-lines
+  (fn
+    (script)
+    (map
+      (fn (o) (get o :line))
+      (filter (fn (o) (not (equal? (get o :op) "del"))) script))))
+
+(define
+  git/diff-annotate
+  (fn
+    (script)
+    (nth
+      (reduce
+        (fn
+          (acc o)
+          (let
+            ((a (first acc))
+              (b (nth acc 1))
+              (out (nth acc 2)))
+            (cond
+              ((equal? (get o :op) "eq")
+                (list
+                  (+ a 1)
+                  (+ b 1)
+                  (append out (list (merge o {:a a :b b})))))
+              ((equal? (get o :op) "del")
+                (list
+                  (+ a 1)
+                  b
+                  (append out (list (merge o {:a a :b b})))))
+              (else
+                (list
+                  a
+                  (+ b 1)
+                  (append out (list (merge o {:a a :b b}))))))))
+        (list 1 1 (list))
+        script)
+      2)))
+
+(define
+  git/diff-change-idxs
+  (fn
+    (script)
+    (map
+      (fn (p) (first p))
+      (filter
+        (fn (p) (not (equal? (get (nth p 1) :op) "eq")))
+        (map-indexed (fn (i o) (list i o)) script)))))
+
+(define
+  git/diff-merge-ranges
+  (fn
+    (ranges)
+    (reduce
+      (fn
+        (acc r)
+        (if
+          (empty? acc)
+          (list r)
+          (let
+            ((prev (nth acc (- (len acc) 1))))
+            (if
+              (<= (first r) (+ (nth prev 1) 1))
+              (append
+                (git/diff-take acc (- (len acc) 1))
+                (list
+                  (list
+                    (first prev)
+                    (max (nth prev 1) (nth r 1)))))
+              (append acc (list r))))))
+      (list)
+      ranges)))
+
+(define
+  git/diff-hunk-ranges
+  (fn
+    (script ctx)
+    (git/diff-merge-ranges
+      (map
+        (fn
+          (i)
+          (list
+            (max 0 (- i ctx))
+            (min (- (len script) 1) (+ i ctx))))
+        (git/diff-change-idxs script)))))
+
+(define
+  git/diff-slice
+  (fn
+    (xs from to)
+    (map
+      (fn (p) (nth p 1))
+      (filter
+        (fn (p) (and (>= (first p) from) (<= (first p) to)))
+        (map-indexed (fn (i x) (list i x)) xs)))))
+
+(define
+  git/diff-op-char
+  (fn
+    (op)
+    (cond ((equal? op "eq") " ") ((equal? op "del") "-") (else "+"))))
+
+(define
+  git/diff-hunk-render
+  (fn
+    (ops)
+    (let
+      ((acount (len (filter (fn (o) (not (equal? (get o :op) "add"))) ops)))
+        (bcount
+          (len (filter (fn (o) (not (equal? (get o :op) "del"))) ops))))
+      (let
+        ((astart (if (= acount 0) (- (get (first ops) :a) 1) (get (first ops) :a)))
+          (bstart
+            (if
+              (= bcount 0)
+              (- (get (first ops) :b) 1)
+              (get (first ops) :b))))
+        (str
+          "@@ -"
+          astart
+          ","
+          acount
+          " +"
+          bstart
+          ","
+          bcount
+          " @@\n"
+          (reduce
+            (fn
+              (acc o)
+              (str acc (git/diff-op-char (get o :op)) (get o :line) "\n"))
+            ""
+            ops))))))
+
+; ---- object-level diffs ----
+(define
+  git/diff-unified
+  (fn
+    (a-data b-data)
+    (let
+      ((ann (git/diff-annotate (git/diff-script a-data b-data))))
+      (reduce
+        (fn
+          (acc r)
+          (str
+            acc
+            (git/diff-hunk-render
+              (git/diff-slice ann (first r) (nth r 1)))))
+        ""
+        (git/diff-hunk-ranges ann 3)))))
+
+(define
+  git/blob-diff
+  (fn
+    (repo b1 b2)
+    (git/diff-script
+      (git/blob-data (git/read repo b1))
+      (git/blob-data (git/read repo b2)))))
+
+(define
+  git/tree-diff
+  (fn
+    (repo t1 t2)
+    (git/files-diff (git/tree-flatten repo t1) (git/tree-flatten repo t2))))
+
+; ---- whole-commit unified render: added, deleted, then modified paths ----
+(define
+  git/commit-diff
+  (fn
+    (repo c1 c2)
+    (git/tree-diff
+      repo
+      (git/commit-tree (git/read repo c1))
+      (git/commit-tree (git/read repo c2)))))
+
+(define
+  git/diff-path-data
+  (fn
+    (repo flat path)
+    (if
+      (has-key? flat path)
+      (git/blob-data (git/read repo (get flat path)))
+      "")))
+
+(define
+  git/commit-diff-unified
+  (fn
+    (repo c1 c2)
+    (let
+      ((f1 (git/tree-flatten repo (git/commit-tree (git/read repo c1))))
+        (f2 (git/tree-flatten repo (git/commit-tree (git/read repo c2)))))
+      (let
+        ((d (git/files-diff f1 f2)))
+        (str
+          (reduce
+            (fn
+              (acc p)
+              (str
+                acc
+                "diff --sx a/"
+                p
+                " b/"
+                p
+                "\n--- /dev/null\n+++ b/"
+                p
+                "\n"
+                (git/diff-unified "" (git/diff-path-data repo f2 p))))
+            ""
+            (get d :added))
+          (reduce
+            (fn
+              (acc p)
+              (str
+                acc
+                "diff --sx a/"
+                p
+                " b/"
+                p
+                "\n--- a/"
+                p
+                "\n+++ /dev/null\n"
+                (git/diff-unified (git/diff-path-data repo f1 p) "")))
+            ""
+            (get d :deleted))
+          (reduce
+            (fn
+              (acc p)
+              (str
+                acc
+                "diff --sx a/"
+                p
+                " b/"
+                p
+                "\n--- a/"
+                p
+                "\n+++ b/"
+                p
+                "\n"
+                (git/diff-unified
+                  (git/diff-path-data repo f1 p)
+                  (git/diff-path-data repo f2 p))))
+            ""
+            (get d :modified)))))))

lib/git/export.sx

@@ -0,0 +1,225 @@
+; lib/git/export.sx — git-wire EXPORT ADAPTER (flagged extension).
+; Converts native sx-git objects into byte-exact git loose-object payloads:
+; "<type> <len>\0<body>" with real git SHA-1 identity, golden-verified
+; against git CLI output. This is an adapter at the edge — the base model
+; stays native-CID (sx1:/sha256, typed extensible dicts). zlib/packfiles are
+; host-side concerns and stay out of scope: the adapter emits type+bytes+sha1.
+; Field mapping (commit/tag idents): :author/:email/:time/:tz with committer
+; overrides :committer/:committer-email/:committer-time/:committer-tz;
+; defaults email="<author>@sx", time=0, tz="+0000". Messages get a trailing
+; newline if missing. Extra native fields do NOT survive export (git wire
+; has nowhere to put them) — that loss is the point of native-first.
+; Requires: lib/git/object.sx, lib/git/sha1.sx, lib/artdag/dag.sx.
+
+(define git/export-nul (list->string (list (integer->char 0))))
+
+; ---- tree entry details ----
+; raw tree bytes use "40000" for subtrees (no leading zero); files default
+; to 100644 unless the entry carries an explicit :mode (e.g. "100755")
+(define
+  git/export-mode
+  (fn
+    (e)
+    (if
+      (has-key? e :mode)
+      (get e :mode)
+      (if (equal? (get e :kind) "tree") "40000" "100644"))))
+
+; git sorts tree entries by name bytes with directories keyed as "name/"
+(define
+  git/export-sortkey
+  (fn
+    (tree name)
+    (if
+      (equal? (git/entry-kind (git/tree-entry-for tree name)) "tree")
+      (str name "/")
+      name)))
+
+(define
+  git/export-ins
+  (fn
+    (tree sorted n)
+    (cond
+      ((empty? sorted) (list n))
+      ((artdag/str<? (git/export-sortkey tree n) (git/export-sortkey tree (first sorted)))
+        (cons n sorted))
+      (else (cons (first sorted) (git/export-ins tree (rest sorted) n))))))
+
+(define
+  git/export-sort-names
+  (fn
+    (tree names)
+    (reduce (fn (acc n) (git/export-ins tree acc n)) (list) names)))
+
+; ---- ident + message formatting ----
+(define git/export-or (fn (v dflt) (if (equal? v nil) dflt v)))
+
+(define
+  git/export-author-ident
+  (fn
+    (obj)
+    (let
+      ((name (git/export-or (get obj :author) "sx")))
+      (str
+        name
+        " <"
+        (git/export-or (get obj :email) (str name "@sx"))
+        "> "
+        (git/export-or (get obj :time) 0)
+        " "
+        (git/export-or (get obj :tz) "+0000")))))
+
+(define
+  git/export-committer-ident
+  (fn
+    (obj)
+    (let
+      ((name (git/export-or (get obj :committer) (git/export-or (get obj :author) "sx"))))
+      (str
+        name
+        " <"
+        (git/export-or
+          (get obj :committer-email)
+          (git/export-or (get obj :email) (str name "@sx")))
+        "> "
+        (git/export-or
+          (get obj :committer-time)
+          (git/export-or (get obj :time) 0))
+        " "
+        (git/export-or
+          (get obj :committer-tz)
+          (git/export-or (get obj :tz) "+0000"))))))
+
+(define
+  git/export-message
+  (fn
+    (obj)
+    (let
+      ((m (git/export-or (get obj :message) "")))
+      (let
+        ((n (string-length m)))
+        (if
+          (and
+            (> n 0)
+            (equal? (substring m (- n 1) n) "\n"))
+          m
+          (str m "\n"))))))
+
+; ---- object payloads ----
+(define
+  git/export-entry
+  (fn
+    (type body)
+    (let
+      ((full (str type " " (string-length body) git/export-nul body)))
+      {:type type :sha1 (git/sha1-hex full) :bytes full})))
+
+(define
+  git/export-tree-body
+  (fn
+    (tree table)
+    (reduce
+      (fn
+        (acc name)
+        (let
+          ((e (git/tree-entry-for tree name)))
+          (str
+            acc
+            (git/export-mode e)
+            " "
+            name
+            git/export-nul
+            (git/hex->raw (get (get table (git/entry-cid e)) :sha1)))))
+      ""
+      (git/export-sort-names tree (git/tree-names tree)))))
+
+(define
+  git/export-commit-body
+  (fn
+    (obj table)
+    (str
+      "tree "
+      (get (get table (git/commit-tree obj)) :sha1)
+      "\n"
+      (reduce
+        (fn (acc p) (str acc "parent " (get (get table p) :sha1) "\n"))
+        ""
+        (git/commit-parents obj))
+      "author "
+      (git/export-author-ident obj)
+      "\n"
+      "committer "
+      (git/export-committer-ident obj)
+      "\n"
+      "\n"
+      (git/export-message obj))))
+
+(define
+  git/export-tag-body
+  (fn
+    (obj table)
+    (str
+      "object "
+      (get (get table (git/tag-target obj)) :sha1)
+      "\n"
+      "type "
+      (get (get table (git/tag-target obj)) :type)
+      "\n"
+      "tag "
+      (git/tag-name obj)
+      "\n"
+      "tagger "
+      (git/export-author-ident obj)
+      "\n"
+      "\n"
+      (git/export-message obj))))
+
+; ---- recursive closure export: table cid -> {:type :bytes :sha1} ----
+(define
+  git/export-into
+  (fn
+    (repo cid table)
+    (if
+      (has-key? table cid)
+      table
+      (let
+        ((obj (git/read repo cid)))
+        (cond
+          ((git/blob? obj)
+            (assoc table cid (git/export-entry "blob" (git/blob-data obj))))
+          ((git/tree? obj)
+            (let
+              ((t2 (reduce (fn (tb name) (git/export-into repo (git/entry-cid (git/tree-entry-for obj name)) tb)) table (git/tree-names obj))))
+              (assoc
+                t2
+                cid
+                (git/export-entry "tree" (git/export-tree-body obj t2)))))
+          ((git/commit? obj)
+            (let
+              ((t2 (git/export-into repo (git/commit-tree obj) (reduce (fn (tb p) (git/export-into repo p tb)) table (git/commit-parents obj)))))
+              (assoc
+                t2
+                cid
+                (git/export-entry "commit" (git/export-commit-body obj t2)))))
+          ((git/tag? obj)
+            (let
+              ((t2 (git/export-into repo (git/tag-target obj) table)))
+              (assoc
+                t2
+                cid
+                (git/export-entry "tag" (git/export-tag-body obj t2)))))
+          (else table))))))
+
+(define
+  git/export-closure
+  (fn (repo cid) (git/export-into repo cid {})))
+
+; export one object (with its dependencies): {:type :bytes :sha1}
+(define git/export (fn (repo cid) (get (git/export-closure repo cid) cid)))
+
+(define git/export-sha (fn (repo cid) (get (git/export repo cid) :sha1)))
+
+; host-writable set: {:head <sha1> :objects {sha1 -> {:type :bytes}}}
+(define
+  git/export-set
+  (fn (repo cid) (let ((table (git/export-closure repo cid))) {:head (get (get table cid) :sha1) :objects (reduce (fn (acc c) (let ((e (get table c))) (assoc acc (get e :sha1) {:type (get e :type) :bytes (get e :bytes)}))) {} (keys table))})))

lib/git/import.sx

@@ -0,0 +1,244 @@
+; lib/git/import.sx — git-wire IMPORT (inverse of export.sx).
+; Parses loose-object payloads "<type> <len>\0<body>" back into native
+; objects, bottom-up over an export-set-shaped table {sha1 -> {:bytes ...}}.
+; Wire round-trip (bytes -> native -> bytes) is byte-exact: messages kept
+; verbatim, non-default tree modes preserved as entry :mode, committer
+; fields stored only when they differ from the author (so export's defaults
+; regenerate identical bytes). Native cids of imported blobs/trees with
+; default modes equal the originals'.
+; Requires: lib/git/object.sx, lib/git/sha1.sx, lib/git/export.sx.
+
+; ---- scanning ----
+(define
+  git/import-index-of
+  (fn
+    (s ch i n)
+    (cond
+      ((>= i n) -1)
+      ((equal? (substring s i (+ i 1)) ch) i)
+      (else (git/import-index-of s ch (+ i 1) n)))))
+
+(define
+  git/import-find
+  (fn (s ch from) (git/import-index-of s ch from (string-length s))))
+
+(define
+  git/import-rfind
+  (fn
+    (s ch i)
+    (cond
+      ((< i 0) -1)
+      ((equal? (substring s i (+ i 1)) ch) i)
+      (else (git/import-rfind s ch (- i 1))))))
+
+(define
+  git/import-find2
+  (fn
+    (s i n)
+    (cond
+      ((> (+ i 2) n) -1)
+      ((equal? (substring s i (+ i 2)) "\n\n") i)
+      (else (git/import-find2 s (+ i 1) n)))))
+
+(define
+  git/raw->hex-go
+  (fn
+    (raw i n acc)
+    (if
+      (>= i n)
+      acc
+      (git/raw->hex-go
+        raw
+        (+ i 1)
+        n
+        (str
+          acc
+          (git/sha1-byte-hex (char-code (substring raw i (+ i 1)))))))))
+
+(define
+  git/raw->hex
+  (fn (raw) (git/raw->hex-go raw 0 (string-length raw) "")))
+
+; ---- payload header ----
+(define
+  git/import-payload
+  (fn
+    (bytes)
+    (let
+      ((sp (git/import-find bytes " " 0))
+        (z (git/import-find bytes git/export-nul 0)))
+      {:type (substring bytes 0 sp) :body (substring bytes (+ z 1) (string-length bytes))})))
+
+; ---- tree body: "<mode> <name>\0<20 raw sha>" sequence ----
+(define
+  git/import-tree-entries
+  (fn
+    (body i n acc)
+    (if
+      (>= i n)
+      acc
+      (let
+        ((sp (git/import-find body " " i)))
+        (let
+          ((z (git/import-find body git/export-nul sp)))
+          (git/import-tree-entries
+            body
+            (+ z 21)
+            n
+            (append acc (list {:name (substring body (+ sp 1) z) :sha (git/raw->hex (substring body (+ z 1) (+ z 21))) :mode (substring body i sp)}))))))))
+
+; ---- ident: "name <email> time tz" ----
+(define
+  git/import-ident
+  (fn
+    (line)
+    (let
+      ((lt (git/import-rfind line "<" (- (string-length line) 1)))
+        (gt (git/import-rfind line ">" (- (string-length line) 1))))
+      (let
+        ((rest (substring line (+ gt 2) (string-length line))))
+        (let ((sp (git/import-find rest " " 0))) {:name (substring line 0 (max 0 (- lt 1))) :tz (substring rest (+ sp 1) (string-length rest)) :email (substring line (+ lt 1) gt) :time (parse-int (substring rest 0 sp))})))))
+
+; ---- commit / tag bodies ----
+(define
+  git/import-headers
+  (fn
+    (body)
+    (let
+      ((cut (git/import-find2 body 0 (string-length body))))
+      {:message (substring body (+ cut 2) (string-length body)) :lines (split (substring body 0 cut) "\n")})))
+
+(define
+  git/import-commit-parse
+  (fn
+    (body)
+    (let
+      ((h (git/import-headers body)))
+      (reduce
+        (fn
+          (acc line)
+          (cond
+            ((starts-with? line "tree ")
+              (assoc
+                acc
+                :tree (substring line 5 (string-length line))))
+            ((starts-with? line "parent ")
+              (assoc
+                acc
+                :parents (append
+                  (get acc :parents)
+                  (list (substring line 7 (string-length line))))))
+            ((starts-with? line "author ")
+              (assoc
+                acc
+                :author (git/import-ident
+                  (substring line 7 (string-length line)))))
+            ((starts-with? line "committer ")
+              (assoc
+                acc
+                :committer (git/import-ident
+                  (substring line 10 (string-length line)))))
+            (else acc)))
+        {:message (get h :message) :parents (list)}
+        (get h :lines)))))
+
+(define
+  git/import-tag-parse
+  (fn
+    (body)
+    (let
+      ((h (git/import-headers body)))
+      (reduce
+        (fn
+          (acc line)
+          (cond
+            ((starts-with? line "object ")
+              (assoc
+                acc
+                :object (substring line 7 (string-length line))))
+            ((starts-with? line "tag ")
+              (assoc
+                acc
+                :tag (substring line 4 (string-length line))))
+            ((starts-with? line "tagger ")
+              (assoc
+                acc
+                :tagger (git/import-ident
+                  (substring line 7 (string-length line)))))
+            (else acc)))
+        {:message (get h :message)}
+        (get h :lines)))))
+
+; ident dict -> native commit meta fields
+(define git/import-author-meta (fn (a) {:tz (get a :tz) :email (get a :email) :time (get a :time) :author (get a :name)}))
+
+(define
+  git/import-commit-meta
+  (fn
+    (p)
+    (let
+      ((a (get p :author)) (c (get p :committer)))
+      (merge
+        (merge (git/import-author-meta a) {:message (get p :message)})
+        (if (or (equal? c nil) (= a c)) {} {:committer (get c :name) :committer-tz (get c :tz) :committer-email (get c :email) :committer-time (get c :time)})))))
+
+; ---- bottom-up import over a sha->{:bytes} table; memo: sha -> native cid ----
+(define
+  git/import-sha
+  (fn
+    (repo objects sha memo)
+    (if
+      (has-key? memo sha)
+      memo
+      (let
+        ((p (git/import-payload (get (get objects sha) :bytes))))
+        (cond
+          ((equal? (get p :type) "blob")
+            (assoc memo sha (git/write-blob repo (get p :body))))
+          ((equal? (get p :type) "tree")
+            (let
+              ((res (reduce (fn (acc pe) (let ((m2 (git/import-sha repo objects (get pe :sha) (first acc)))) (list m2 (assoc (nth acc 1) (get pe :name) (let ((base {:kind (if (equal? (get pe :mode) "40000") "tree" "blob") :cid (get m2 (get pe :sha))})) (if (or (equal? (get pe :mode) "40000") (equal? (get pe :mode) "100644")) base (merge base {:mode (get pe :mode)}))))))) (list memo {}) (git/import-tree-entries (get p :body) 0 (string-length (get p :body)) (list)))))
+              (assoc
+                (first res)
+                sha
+                (git/write repo (git/tree (nth res 1))))))
+          ((equal? (get p :type) "commit")
+            (let
+              ((cp (git/import-commit-parse (get p :body))))
+              (let
+                ((m2 (git/import-sha repo objects (get cp :tree) (reduce (fn (mm ps) (git/import-sha repo objects ps mm)) memo (get cp :parents)))))
+                (assoc
+                  m2
+                  sha
+                  (git/write
+                    repo
+                    (git/commit
+                      (get m2 (get cp :tree))
+                      (map (fn (ps) (get m2 ps)) (get cp :parents))
+                      (git/import-commit-meta cp)))))))
+          ((equal? (get p :type) "tag")
+            (let
+              ((tp (git/import-tag-parse (get p :body))))
+              (let
+                ((m2 (git/import-sha repo objects (get tp :object) memo)))
+                (assoc
+                  m2
+                  sha
+                  (git/write
+                    repo
+                    (git/tag
+                      (get m2 (get tp :object))
+                      (get tp :tag)
+                      (merge
+                        (git/import-author-meta (get tp :tagger))
+                        {:message (get tp :message)})))))))
+          (else memo))))))
+
+; import a {:head :objects} set; returns the native cid of the head object
+(define
+  git/import-set
+  (fn
+    (repo set)
+    (get
+      (git/import-sha repo (get set :objects) (get set :head) {})
+      (get set :head))))

lib/git/merge.sx

@@ -0,0 +1,224 @@
+; lib/git/merge.sx — sx-git Phase 6: 3-way merge.
+; Textual diff3: regions (non-eq runs of the Myers script base->side) are
+; clustered by strict base-interval overlap (same-point insertions from both
+; sides also cluster); one-sided clusters apply cleanly, two-sided clusters
+; take the shared result or emit diff3 conflict markers with the base section.
+; Tree merge: per-path 3-way over flattened trees with blob-level textual
+; auto-merge; delete/modify keeps the surviving side and flags the path.
+; Commit merge: up-to-date / fast-forward detection, else merge via merge-base
+; (empty base for unrelated histories).
+; Requires: lib/git/object.sx, dag.sx, worktree.sx, diff.sx.
+
+(define
+  git/m3-concat
+  (fn (ls) (reduce (fn (acc l) (append acc l)) (list) ls)))
+
+; ---- regions: non-eq runs as {:s :e :repl} over base indices ----
+(define
+  git/m3-regions
+  (fn
+    (script)
+    (let
+      ((st (reduce (fn (acc o) (let ((op (get o :op))) (cond ((equal? op "eq") (if (get acc :open) {:repl (list) :s 0 :open false :out (append (get acc :out) (list {:repl (get acc :repl) :e (get acc :bi) :s (get acc :s)})) :bi (+ (get acc :bi) 1)} (assoc acc :bi (+ (get acc :bi) 1)))) ((equal? op "del") (if (get acc :open) (assoc acc :bi (+ (get acc :bi) 1)) (merge acc {:s (get acc :bi) :open true :bi (+ (get acc :bi) 1)}))) (else (if (get acc :open) (assoc acc :repl (append (get acc :repl) (list (get o :line)))) (merge acc {:repl (list (get o :line)) :s (get acc :bi) :open true})))))) {:repl (list) :s 0 :open false :out (list) :bi 0} script)))
+      (if
+        (get st :open)
+        (append (get st :out) (list {:repl (get st :repl) :e (get st :bi) :s (get st :s)}))
+        (get st :out)))))
+
+; ---- stable sort by :s (insert after equals: a-side stays before b-side) ----
+(define
+  git/m3-ins
+  (fn
+    (sorted r)
+    (cond
+      ((empty? sorted) (list r))
+      ((< (get r :s) (get (first sorted) :s)) (cons r sorted))
+      (else (cons (first sorted) (git/m3-ins (rest sorted) r))))))
+
+(define
+  git/m3-sort
+  (fn (rs) (reduce (fn (acc r) (git/m3-ins acc r)) (list) rs)))
+
+; ---- clustering ----
+(define
+  git/m3-has-insert-at?
+  (fn
+    (ms p)
+    (reduce
+      (fn (acc m) (or acc (and (= (get m :s) p) (= (get m :e) p))))
+      false
+      ms)))
+
+(define
+  git/m3-cluster-overlap?
+  (fn
+    (cur r)
+    (or
+      (< (get r :s) (get cur :ce))
+      (and
+        (= (get r :s) (get r :e))
+        (= (get r :s) (get cur :ce))
+        (git/m3-has-insert-at? (get cur :members) (get r :s))))))
+
+(define
+  git/m3-clusters
+  (fn
+    (regions)
+    (let
+      ((res (reduce (fn (acc r) (let ((cur (nth acc 1))) (if (equal? cur nil) (list (first acc) {:ce (get r :e) :members (list r) :cs (get r :s)}) (if (git/m3-cluster-overlap? cur r) (list (first acc) {:ce (max (get cur :ce) (get r :e)) :members (append (get cur :members) (list r)) :cs (get cur :cs)}) (list (append (first acc) (list cur)) {:ce (get r :e) :members (list r) :cs (get r :s)}))))) (list (list) nil) regions)))
+      (if
+        (equal? (nth res 1) nil)
+        (first res)
+        (append (first res) (list (nth res 1)))))))
+
+; ---- apply one side's regions across a base span ----
+(define
+  git/m3-bslice
+  (fn
+    (bv from to)
+    (if
+      (>= from to)
+      (list)
+      (cons (git/dget bv from) (git/m3-bslice bv (+ from 1) to)))))
+
+(define
+  git/m3-apply-side
+  (fn
+    (bv members side cs ce)
+    (let
+      ((res (reduce (fn (acc m) (list (get m :e) (append (nth acc 1) (append (git/m3-bslice bv (first acc) (get m :s)) (get m :repl))))) (list cs (list)) (filter (fn (m) (equal? (get m :side) side)) members))))
+      (append (nth res 1) (git/m3-bslice bv (first res) ce)))))
+
+; ---- evaluate a cluster: clean lines or a conflict block ----
+(define
+  git/m3-eval-cluster
+  (fn
+    (bv cl)
+    (let
+      ((ms (get cl :members)))
+      (let
+        ((has-a (reduce (fn (acc m) (or acc (equal? (get m :side) "a"))) false ms))
+          (has-b
+            (reduce
+              (fn (acc m) (or acc (equal? (get m :side) "b")))
+              false
+              ms))
+          (aout (git/m3-apply-side bv ms "a" (get cl :cs) (get cl :ce)))
+          (bout (git/m3-apply-side bv ms "b" (get cl :cs) (get cl :ce))))
+        (cond
+          ((and has-a has-b (not (= aout bout))) {:conflict true :lines (git/m3-concat (list (list "<<<<<<< ours") aout (list "||||||| base") (git/m3-bslice bv (get cl :cs) (get cl :ce)) (list "=======") bout (list ">>>>>>> theirs")))})
+          (has-a {:conflict false :lines aout})
+          (else {:conflict false :lines bout}))))))
+
+; ---- diff3 over line lists ----
+(define
+  git/merge3-lines
+  (fn
+    (base-lines a-lines b-lines)
+    (let
+      ((bv (git/dvec base-lines)))
+      (let
+        ((all (git/m3-sort (append (map (fn (r) (assoc r :side "a")) (git/m3-regions (git/diff-script-lines base-lines a-lines))) (map (fn (r) (assoc r :side "b")) (git/m3-regions (git/diff-script-lines base-lines b-lines)))))))
+        (let
+          ((res (reduce (fn (acc cl) (let ((ev (git/m3-eval-cluster bv cl))) (list (get cl :ce) (append (nth acc 1) (append (git/m3-bslice bv (first acc) (get cl :cs)) (get ev :lines))) (+ (nth acc 2) (if (get ev :conflict) 1 0))))) (list 0 (list) 0) (git/m3-clusters all))))
+          {:clean (= (nth res 2) 0) :conflicts (nth res 2) :lines (append (nth res 1) (git/m3-bslice bv (first res) (len base-lines)))})))))
+
+(define
+  git/m3-unlines
+  (fn
+    (ls)
+    (if
+      (empty? ls)
+      ""
+      (str
+        (reduce (fn (acc l) (str acc "\n" l)) (first ls) (rest ls))
+        "\n"))))
+
+; textual 3-way over strings: {:clean :conflicts :text}
+(define
+  git/merge3-text
+  (fn
+    (base ours theirs)
+    (let
+      ((r (git/merge3-lines (git/diff-lines base) (git/diff-lines ours) (git/diff-lines theirs))))
+      {:clean (get r :clean) :text (git/m3-unlines (get r :lines)) :conflicts (get r :conflicts)})))
+
+; ---- tree building from path -> blob cid (no data reread) ----
+(define
+  git/tree-from-cids
+  (fn
+    (repo files)
+    (let
+      ((g (git/wt-group files)))
+      (let
+        ((with-blobs (reduce (fn (acc name) (assoc acc name (git/tree-entry "blob" (get (get g :files) name)))) {} (keys (get g :files)))))
+        (let
+          ((entries (reduce (fn (acc dir) (assoc acc dir (git/tree-entry "tree" (git/tree-from-cids repo (get (get g :dirs) dir))))) with-blobs (keys (get g :dirs)))))
+          (git/write repo (git/tree entries)))))))
+
+; ---- per-path 3-way tree merge: {:files path->cid :conflicts (paths)} ----
+(define
+  git/m3-union-paths
+  (fn (fa fb fc) (artdag/sort-strings (keys (merge (merge fa fb) fc)))))
+
+(define
+  git/merge-trees
+  (fn
+    (repo base-t a-t b-t)
+    (let
+      ((fb (if (equal? base-t nil) {} (git/tree-flatten repo base-t)))
+        (fa (git/tree-flatten repo a-t))
+        (ft (git/tree-flatten repo b-t)))
+      (reduce
+        (fn
+          (acc path)
+          (let
+            ((bc (get fb path)) (ac (get fa path)) (tc (get ft path)))
+            (cond
+              ((equal? ac tc)
+                (if
+                  (equal? ac nil)
+                  acc
+                  (assoc acc :files (assoc (get acc :files) path ac))))
+              ((equal? bc ac)
+                (if
+                  (equal? tc nil)
+                  acc
+                  (assoc acc :files (assoc (get acc :files) path tc))))
+              ((equal? bc tc)
+                (if
+                  (equal? ac nil)
+                  acc
+                  (assoc acc :files (assoc (get acc :files) path ac))))
+              ((or (equal? ac nil) (equal? tc nil)) (merge acc {:conflicts (append (get acc :conflicts) (list path)) :files (assoc (get acc :files) path (if (equal? ac nil) tc ac))}))
+              (else
+                (let
+                  ((m (git/merge3-text (if (equal? bc nil) "" (git/blob-data (git/read repo bc))) (git/blob-data (git/read repo ac)) (git/blob-data (git/read repo tc)))))
+                  (let
+                    ((cid (git/write-blob repo (get m :text))))
+                    (if
+                      (get m :clean)
+                      (assoc acc :files (assoc (get acc :files) path cid))
+                      (merge acc {:conflicts (append (get acc :conflicts) (list path)) :files (assoc (get acc :files) path cid)}))))))))
+        {:conflicts (list) :files {}}
+        (git/m3-union-paths fb fa ft)))))
+
+; ---- commit-level merge ----
+; can merging `theirs` into `ours` fast-forward?
+(define git/ff? (fn (repo ours theirs) (git/is-ancestor? repo ours theirs)))
+
+(define
+  git/merge-commits
+  (fn
+    (repo ours theirs)
+    (cond
+      ((git/is-ancestor? repo theirs ours) {:cid ours :result "up-to-date"})
+      ((git/is-ancestor? repo ours theirs) {:cid theirs :result "fast-forward"})
+      (else
+        (let
+          ((mb (git/merge-base repo ours theirs)))
+          (let
+            ((mt (git/merge-trees repo (if (equal? mb nil) nil (git/commit-tree (git/read repo mb))) (git/commit-tree (git/read repo ours)) (git/commit-tree (git/read repo theirs)))))
+            (let
+              ((tc (git/tree-from-cids repo (get mt :files))))
+              (if (empty? (get mt :conflicts)) {:conflicts (list) :tree tc :result "merged"} {:conflicts (get mt :conflicts) :tree tc :result "conflicts"}))))))))

lib/git/object.sx

@@ -0,0 +1,81 @@
+; lib/git/object.sx — sx-git Phase 1: blob/tree/commit/tag as content-addressed
+; TYPED objects over the persist kv store. Identity = host digest of the
+; canonical serialization (artdag/canon: sorted dict keys, escaped strings) —
+; native CIDs, NOT git wire bytes. Objects are plain dicts: typed, extensible;
+; unknown fields round-trip and participate in the CID.
+; Requires: lib/persist/backend.sx, lib/persist/kv.sx, lib/artdag/dag.sx.
+
+; ---- canonical form + content id ----
+(define git/canon (fn (obj) (artdag/canon obj)))
+
+(define
+  git/cid
+  (fn (obj) (str "sx1:" (crypto-sha256 (artdag/canon obj)))))
+
+; ---- repo handle: a persist backend + key prefix (many repos per db) ----
+(define git/repo-named (fn (db name) {:prefix name :db db}))
+(define git/repo (fn (db) (git/repo-named db "git")))
+(define git/repo-db (fn (repo) (get repo :db)))
+(define git/obj-key (fn (repo cid) (str (get repo :prefix) "/obj/" cid)))
+
+; ---- constructors ----
+(define git/blob (fn (data) {:data data :type "blob"}))
+
+; entries: dict of name -> entry, entry = {:kind "blob"|"tree" :cid cid ...}
+(define git/tree (fn (entries) {:type "tree" :entries entries}))
+(define git/tree-entry (fn (kind cid) {:kind kind :cid cid}))
+
+; meta: open dict (:author :message :time ... anything); protected keys win
+(define git/commit (fn (tree parents meta) (merge meta {:type "commit" :tree tree :parents parents})))
+
+(define git/tag (fn (target name meta) (merge meta {:name name :type "tag" :target target})))
+
+; ---- predicates / accessors ----
+(define git/object-type (fn (obj) (get obj :type)))
+(define
+  git/blob?
+  (fn (obj) (and (dict? obj) (equal? (get obj :type) "blob"))))
+(define
+  git/tree?
+  (fn (obj) (and (dict? obj) (equal? (get obj :type) "tree"))))
+(define
+  git/commit?
+  (fn (obj) (and (dict? obj) (equal? (get obj :type) "commit"))))
+(define
+  git/tag?
+  (fn (obj) (and (dict? obj) (equal? (get obj :type) "tag"))))
+
+(define git/blob-data (fn (obj) (get obj :data)))
+(define git/tree-entries (fn (obj) (get obj :entries)))
+(define git/tree-entry-for (fn (obj name) (get (get obj :entries) name)))
+(define
+  git/tree-names
+  (fn (obj) (artdag/sort-strings (keys (get obj :entries)))))
+(define git/entry-cid (fn (entry) (get entry :cid)))
+(define git/entry-kind (fn (entry) (get entry :kind)))
+(define git/commit-tree (fn (obj) (get obj :tree)))
+(define git/commit-parents (fn (obj) (get obj :parents)))
+(define git/commit-author (fn (obj) (get obj :author)))
+(define git/commit-message (fn (obj) (get obj :message)))
+(define git/tag-target (fn (obj) (get obj :target)))
+(define git/tag-name (fn (obj) (get obj :name)))
+
+; ---- object store: write/read/has, keyed by cid ----
+(define
+  git/write
+  (fn
+    (repo obj)
+    (let
+      ((cid (git/cid obj)))
+      (begin (persist/kv-put (get repo :db) (git/obj-key repo cid) obj) cid))))
+
+(define
+  git/read
+  (fn (repo cid) (persist/kv-get (get repo :db) (git/obj-key repo cid))))
+
+(define
+  git/has?
+  (fn (repo cid) (persist/kv-has? (get repo :db) (git/obj-key repo cid))))
+
+; convenience: write a blob straight from data
+(define git/write-blob (fn (repo data) (git/write repo (git/blob data))))

lib/git/porcelain.sx

@@ -0,0 +1,241 @@
+; lib/git/porcelain.sx — sx-git Phase 7: the user-facing verbs.
+; init/add/commit/branch/checkout/tag/reset/merge/log/diff composed from
+; object+ref+dag+worktree+diff+merge. Branch advances go through ref CAS.
+; A conflicted merge parks the other head in <prefix>/MERGE_HEAD (like git's
+; MERGE_HEAD) and stages the marker tree; resolve with git/add! then
+; git/merge-commit!, which writes the two-parent commit and clears it.
+; Requires: all previous lib/git modules.
+
+(define
+  git/init!
+  (fn
+    (db name)
+    (let
+      ((repo (git/repo-named db name)))
+      (begin (git/head-set! repo "main") (git/index-init! repo nil) repo))))
+
+; advance whatever HEAD points at: the branch via CAS, or the detached pin
+(define
+  git/porc-advance!
+  (fn
+    (repo old new)
+    (let
+      ((target (git/head-target repo)))
+      (if
+        (equal? target nil)
+        (git/head-detach! repo new)
+        (git/ref-cas! repo target old new)))))
+
+; commit the index; parent = current HEAD (none on an unborn branch)
+(define
+  git/commit!
+  (fn
+    (repo meta)
+    (let
+      ((tree (git/index-tree! repo)))
+      (let
+        ((parent (git/head repo)))
+        (let
+          ((cid (git/write repo (git/commit tree (if (equal? parent nil) (list) (list parent)) meta))))
+          (begin
+            (git/porc-advance! repo parent cid)
+            (git/index-write! repo {:base tree :staged {}})
+            cid))))))
+
+; branch at HEAD (create-only)
+(define
+  git/branch!
+  (fn (repo name) (git/branch-create! repo name (git/head repo))))
+
+; switch HEAD + index to a branch; returns the materialized files dict
+(define
+  git/checkout!
+  (fn
+    (repo branch)
+    (let
+      ((cid (git/branch-get repo branch)))
+      (begin
+        (git/head-set! repo branch)
+        (git/index-init! repo cid)
+        (if (equal? cid nil) {} (git/commit-files repo cid))))))
+
+(define
+  git/checkout-detached!
+  (fn
+    (repo cid)
+    (begin
+      (git/head-detach! repo cid)
+      (git/index-init! repo cid)
+      (git/commit-files repo cid))))
+
+; annotated tag: tag OBJECT at HEAD, ref points at the tag object
+(define
+  git/tag!
+  (fn
+    (repo name meta)
+    (let
+      ((cid (git/write repo (git/tag (git/head repo) name meta))))
+      (begin (git/tag-set! repo name cid) cid))))
+
+(define
+  git/tag-lightweight!
+  (fn
+    (repo name)
+    (begin (git/tag-set! repo name (git/head repo)) (git/head repo))))
+
+; reset current branch to cid; "soft" keeps the index, "mixed" resets it
+(define
+  git/reset!
+  (fn
+    (repo cid mode)
+    (begin
+      (git/porc-advance! repo (git/head repo) cid)
+      (when (equal? mode "mixed") (git/index-init! repo cid))
+      cid)))
+
+; ---- merge a branch into HEAD ----
+(define
+  git/merge-head-key
+  (fn (repo) (str (get repo :prefix) "/MERGE_HEAD")))
+(define
+  git/merge-in-progress?
+  (fn
+    (repo)
+    (not
+      (equal? (persist/kv-get (get repo :db) (git/merge-head-key repo)) nil))))
+
+(define
+  git/merge!
+  (fn
+    (repo branch meta)
+    (let
+      ((ours (git/head repo)) (theirs (git/branch-get repo branch)))
+      (let
+        ((m (git/merge-commits repo ours theirs)))
+        (cond
+          ((equal? (get m :result) "up-to-date") m)
+          ((equal? (get m :result) "fast-forward")
+            (begin
+              (git/porc-advance! repo ours theirs)
+              (git/index-init! repo theirs)
+              m))
+          ((equal? (get m :result) "merged")
+            (let
+              ((cid (git/write repo (git/commit (get m :tree) (list ours theirs) meta))))
+              (begin
+                (git/porc-advance! repo ours cid)
+                (git/index-write! repo {:base (get m :tree) :staged {}})
+                {:conflicts (list) :cid cid :result "merged"})))
+          (else
+            (begin
+              (persist/kv-put
+                (get repo :db)
+                (git/merge-head-key repo)
+                theirs)
+              (git/index-write! repo {:base (get m :tree) :staged {}})
+              m)))))))
+
+; conclude a conflicted merge: commit the (resolved) index with two parents
+(define
+  git/merge-commit!
+  (fn
+    (repo meta)
+    (let
+      ((theirs (persist/kv-get (get repo :db) (git/merge-head-key repo))))
+      (if
+        (equal? theirs nil)
+        {:error "no merge in progress"}
+        (let
+          ((tree (git/index-tree! repo)))
+          (let
+            ((parent (git/head repo)))
+            (let
+              ((cid (git/write repo (git/commit tree (list parent theirs) meta))))
+              (begin
+                (git/porc-advance! repo parent cid)
+                (git/index-write! repo {:base tree :staged {}})
+                (persist/kv-delete (get repo :db) (git/merge-head-key repo))
+                cid))))))))
+
+; ---- porcelain diff/log ----
+(define
+  git/log-branch
+  (fn (repo branch) (git/log repo (git/branch-get repo branch))))
+
+; unified diff across two path->data dicts (added, deleted, then modified)
+(define
+  git/diff-files-unified
+  (fn
+    (fa fb)
+    (let
+      ((d (git/files-diff (git/files-cids fa) (git/files-cids fb))))
+      (str
+        (reduce
+          (fn
+            (acc p)
+            (str
+              acc
+              "diff --sx a/"
+              p
+              " b/"
+              p
+              "\n--- /dev/null\n+++ b/"
+              p
+              "\n"
+              (git/diff-unified "" (get fb p))))
+          ""
+          (get d :added))
+        (reduce
+          (fn
+            (acc p)
+            (str
+              acc
+              "diff --sx a/"
+              p
+              " b/"
+              p
+              "\n--- a/"
+              p
+              "\n+++ /dev/null\n"
+              (git/diff-unified (get fa p) "")))
+          ""
+          (get d :deleted))
+        (reduce
+          (fn
+            (acc p)
+            (str
+              acc
+              "diff --sx a/"
+              p
+              " b/"
+              p
+              "\n--- a/"
+              p
+              "\n+++ b/"
+              p
+              "\n"
+              (git/diff-unified (get fa p) (get fb p))))
+          ""
+          (get d :modified))))))
+
+(define
+  git/porc-head-files
+  (fn
+    (repo)
+    (let
+      ((h (git/head repo)))
+      (if (equal? h nil) {} (git/commit-files repo h)))))
+
+; staged: HEAD vs index; unstaged: index vs the caller's worktree value
+(define
+  git/diff-staged
+  (fn
+    (repo)
+    (git/diff-files-unified
+      (git/porc-head-files repo)
+      (git/index-files repo))))
+(define
+  git/diff-unstaged
+  (fn
+    (repo worktree-files)
+    (git/diff-files-unified (git/index-files repo) worktree-files)))

lib/git/ref.sx

@@ -0,0 +1,197 @@
+; lib/git/ref.sx — sx-git Phase 2: refs as name -> cid over persist kv.
+; A ref value is {:cid cid} (direct) or {:symref name} (symbolic). Atomic
+; update = persist/kv-cas (old-value expect); create-only = kv-put-new.
+; Every direct-ref move is recorded in an append-only reflog stream
+; (persist log facet), one stream per ref name.
+; Requires: lib/git/object.sx (repo handle), lib/persist/kv.sx, log.sx.
+
+(define git/ref-key (fn (repo name) (str (get repo :prefix) "/ref/" name)))
+(define
+  git/reflog-stream
+  (fn (repo name) (str (get repo :prefix) "/reflog/" name)))
+
+(define
+  git/reflog-record!
+  (fn
+    (repo name old new)
+    (persist/append
+      (get repo :db)
+      (git/reflog-stream repo name)
+      "ref-update"
+      0
+      {:new new :old old})))
+
+; ---- raw ref values ----
+(define
+  git/ref-read
+  (fn (repo name) (persist/kv-get (get repo :db) (git/ref-key repo name))))
+(define git/symref? (fn (v) (and (dict? v) (has-key? v :symref))))
+
+; direct cid or nil — does NOT follow symrefs
+(define
+  git/ref-get
+  (fn
+    (repo name)
+    (let ((v (git/ref-read repo name))) (if (dict? v) (get v :cid) nil))))
+
+; ---- writes ----
+(define
+  git/ref-set!
+  (fn
+    (repo name cid)
+    (let
+      ((old (git/ref-get repo name)))
+      (begin
+        (persist/kv-put (get repo :db) (git/ref-key repo name) {:cid cid})
+        (git/reflog-record! repo name old cid)
+        cid))))
+
+(define
+  git/symref-set!
+  (fn
+    (repo name target)
+    (begin
+      (persist/kv-put (get repo :db) (git/ref-key repo name) {:symref target})
+      target)))
+
+(define
+  git/ref-delete!
+  (fn
+    (repo name)
+    (persist/kv-delete (get repo :db) (git/ref-key repo name))))
+
+; ---- resolution (symref chains, bounded) ----
+(define
+  git/ref-resolve-n
+  (fn
+    (repo name depth)
+    (if
+      (<= depth 0)
+      nil
+      (let
+        ((v (git/ref-read repo name)))
+        (cond
+          ((git/symref? v)
+            (git/ref-resolve-n repo (get v :symref) (- depth 1)))
+          ((dict? v) (get v :cid))
+          (else nil))))))
+
+(define
+  git/ref-resolve
+  (fn (repo name) (git/ref-resolve-n repo name 10)))
+
+; ---- atomic update: expected old cid (nil = must not exist) ----
+(define
+  git/ref-cas!
+  (fn
+    (repo name expected new)
+    (let
+      ((res (persist/kv-cas (get repo :db) (git/ref-key repo name) (if (equal? expected nil) nil {:cid expected}) {:cid new})))
+      (if
+        (and (dict? res) (has-key? res :conflict))
+        {:actual (if (dict? (get res :actual)) (get (get res :actual) :cid) nil) :conflict true}
+        (begin (git/reflog-record! repo name expected new) new)))))
+
+; ---- listing ----
+(define
+  git/ref-names
+  (fn
+    (repo)
+    (let
+      ((pfx (str (get repo :prefix) "/ref/")))
+      (artdag/sort-strings
+        (map
+          (fn (k) (substring k (string-length pfx) (string-length k)))
+          (filter
+            (fn (k) (starts-with? k pfx))
+            (persist/kv-keys (get repo :db))))))))
+
+(define
+  git/refs-under
+  (fn
+    (repo group)
+    (map
+      (fn (n) (substring n (string-length group) (string-length n)))
+      (filter (fn (n) (starts-with? n group)) (git/ref-names repo)))))
+
+; ---- branches ----
+(define git/branch-ref (fn (name) (str "heads/" name)))
+
+(define
+  git/branch-set!
+  (fn (repo name cid) (git/ref-set! repo (git/branch-ref name) cid)))
+(define
+  git/branch-get
+  (fn (repo name) (git/ref-get repo (git/branch-ref name))))
+(define
+  git/branch-cas!
+  (fn
+    (repo name expected new)
+    (git/ref-cas! repo (git/branch-ref name) expected new)))
+(define
+  git/branch-delete!
+  (fn (repo name) (git/ref-delete! repo (git/branch-ref name))))
+(define git/branches (fn (repo) (git/refs-under repo "heads/")))
+
+; create-only: conflict if the branch already exists
+(define
+  git/branch-create!
+  (fn
+    (repo name cid)
+    (let
+      ((res (persist/kv-put-new (get repo :db) (git/ref-key repo (git/branch-ref name)) {:cid cid})))
+      (if
+        (and (dict? res) (has-key? res :conflict))
+        {:actual (get (get res :actual) :cid) :conflict true}
+        (begin (git/reflog-record! repo (git/branch-ref name) nil cid) cid)))))
+
+; ---- lightweight tag refs (annotated tag objects live in the object store) ----
+(define git/tag-refname (fn (name) (str "tags/" name)))
+(define
+  git/tag-set!
+  (fn (repo name cid) (git/ref-set! repo (git/tag-refname name) cid)))
+(define
+  git/tag-get
+  (fn (repo name) (git/ref-get repo (git/tag-refname name))))
+(define git/tag-names (fn (repo) (git/refs-under repo "tags/")))
+
+; ---- HEAD ----
+(define
+  git/head-set!
+  (fn (repo branch) (git/symref-set! repo "HEAD" (git/branch-ref branch))))
+
+(define
+  git/head-detach!
+  (fn
+    (repo cid)
+    (begin
+      (persist/kv-put (get repo :db) (git/ref-key repo "HEAD") {:cid cid})
+      cid)))
+
+(define git/head (fn (repo) (git/ref-resolve repo "HEAD")))
+
+; branch ref name HEAD points at, or nil when detached/unset
+(define
+  git/head-target
+  (fn
+    (repo)
+    (let
+      ((v (git/ref-read repo "HEAD")))
+      (if (git/symref? v) (get v :symref) nil))))
+
+(define
+  git/detached?
+  (fn
+    (repo)
+    (let
+      ((v (git/ref-read repo "HEAD")))
+      (and (dict? v) (has-key? v :cid)))))
+
+; ---- reflog: oldest-first list of {:old :new} ----
+(define
+  git/reflog
+  (fn
+    (repo name)
+    (map
+      (fn (e) (persist/event-data e))
+      (persist/read (get repo :db) (git/reflog-stream repo name)))))

lib/git/scoreboard.json

@@ -0,0 +1,16 @@
+{
+  "suites": {
+    "object": {"pass": 38, "fail": 0},
+    "ref": {"pass": 38, "fail": 0},
+    "dag": {"pass": 30, "fail": 0},
+    "worktree": {"pass": 26, "fail": 0},
+    "diff": {"pass": 27, "fail": 0},
+    "merge": {"pass": 28, "fail": 0},
+    "porcelain": {"pass": 40, "fail": 0},
+    "export": {"pass": 25, "fail": 0},
+    "import": {"pass": 15, "fail": 0}
+  },
+  "total_pass": 267,
+  "total_fail": 0,
+  "total": 267
+}

lib/git/scoreboard.md

@@ -0,0 +1,16 @@
+# sx-git Conformance Scoreboard
+
+_Generated by `lib/git/conformance.sh`_
+
+| Suite | Pass | Fail | Total |
+|-------|-----:|-----:|------:|
+| object | 38 | 0 | 38 |
+| ref | 38 | 0 | 38 |
+| dag | 30 | 0 | 30 |
+| worktree | 26 | 0 | 26 |
+| diff | 27 | 0 | 27 |
+| merge | 28 | 0 | 28 |
+| porcelain | 40 | 0 | 40 |
+| export | 25 | 0 | 25 |
+| import | 15 | 0 | 15 |
+| **Total** | **267** | **0** | **267** |

lib/git/sha1.sx

@@ -0,0 +1,299 @@
+; lib/git/sha1.sx — SHA-1 in pure SX (host bitwise prims, no deps).
+; Exists ONLY for the git-wire export adapter: native sx-git identity stays
+; sx1:/sha256 (object.sx); SHA-1 is what the exported byte format demands.
+; Strings are treated as byte strings (char-code on 1-byte substrings).
+
+(define git/sha1-mask 4294967295)
+(define git/u32 (fn (x) (bitwise-and x git/sha1-mask)))
+
+(define
+  git/rotl
+  (fn
+    (x n)
+    (git/u32
+      (bitwise-or
+        (arithmetic-shift x n)
+        (arithmetic-shift x (- n 32))))))
+
+; ---- byte plumbing ----
+(define
+  git/sha1-take
+  (fn
+    (xs n)
+    (if
+      (or (= n 0) (empty? xs))
+      (list)
+      (cons (first xs) (git/sha1-take (rest xs) (- n 1))))))
+
+(define
+  git/sha1-drop
+  (fn
+    (xs n)
+    (if
+      (or (= n 0) (empty? xs))
+      xs
+      (git/sha1-drop (rest xs) (- n 1)))))
+
+(define
+  git/sha1-sb
+  (fn
+    (s i n acc)
+    (if
+      (>= i n)
+      (reverse acc)
+      (git/sha1-sb
+        s
+        (+ i 1)
+        n
+        (cons (char-code (substring s i (+ i 1))) acc)))))
+
+(define
+  git/sha1-str-bytes
+  (fn (s) (git/sha1-sb s 0 (string-length s) (list))))
+
+(define
+  git/sha1-zeros
+  (fn
+    (k)
+    (if
+      (= k 0)
+      (list)
+      (cons 0 (git/sha1-zeros (- k 1))))))
+
+(define
+  git/sha1-be8
+  (fn
+    (v)
+    (map
+      (fn
+        (sh)
+        (bitwise-and (arithmetic-shift v (- 0 sh)) 255))
+      (list
+        56
+        48
+        40
+        32
+        24
+        16
+        8
+        0))))
+
+; append 0x80, zero-pad to 56 mod 64, then the 64-bit big-endian bit length
+(define
+  git/sha1-pad
+  (fn
+    (bytes)
+    (let
+      ((n (len bytes)))
+      (let
+        ((zeros (remainder (+ (- 56 (remainder (+ n 1) 64)) 64) 64)))
+        (append
+          bytes
+          (append
+            (cons 128 (git/sha1-zeros zeros))
+            (git/sha1-be8 (* n 8))))))))
+
+; ---- message schedule: w as an index-keyed dict ----
+(define
+  git/sha1-w-init-go
+  (fn
+    (bs j w)
+    (if
+      (= j 16)
+      w
+      (git/sha1-w-init-go
+        (git/sha1-drop bs 4)
+        (+ j 1)
+        (assoc
+          w
+          (str j)
+          (bitwise-or
+            (arithmetic-shift (nth bs 0) 24)
+            (bitwise-or
+              (arithmetic-shift (nth bs 1) 16)
+              (bitwise-or
+                (arithmetic-shift (nth bs 2) 8)
+                (nth bs 3)))))))))
+
+(define
+  git/sha1-w-expand
+  (fn
+    (w t)
+    (if
+      (= t 80)
+      w
+      (git/sha1-w-expand
+        (assoc
+          w
+          (str t)
+          (git/rotl
+            (bitwise-xor
+              (bitwise-xor
+                (get w (str (- t 3)))
+                (get w (str (- t 8))))
+              (bitwise-xor
+                (get w (str (- t 14)))
+                (get w (str (- t 16)))))
+            1))
+        (+ t 1)))))
+
+; ---- rounds ----
+(define
+  git/sha1-f
+  (fn
+    (t b c d)
+    (cond
+      ((< t 20)
+        (bitwise-or
+          (bitwise-and b c)
+          (bitwise-and (bitwise-and (bitwise-not b) git/sha1-mask) d)))
+      ((< t 40) (bitwise-xor (bitwise-xor b c) d))
+      ((< t 60)
+        (bitwise-or
+          (bitwise-or (bitwise-and b c) (bitwise-and b d))
+          (bitwise-and c d)))
+      (else (bitwise-xor (bitwise-xor b c) d)))))
+
+(define
+  git/sha1-k
+  (fn
+    (t)
+    (cond
+      ((< t 20) 1518500249)
+      ((< t 40) 1859775393)
+      ((< t 60) 2400959708)
+      (else 3395469782))))
+
+(define
+  git/sha1-rounds
+  (fn
+    (w t a b c d e)
+    (if
+      (= t 80)
+      (list a b c d e)
+      (git/sha1-rounds
+        w
+        (+ t 1)
+        (git/u32
+          (+
+            (+
+              (+ (+ (git/rotl a 5) (git/sha1-f t b c d)) e)
+              (git/sha1-k t))
+            (get w (str t))))
+        a
+        (git/rotl b 30)
+        c
+        d))))
+
+(define
+  git/sha1-blocks
+  (fn
+    (bs hs)
+    (if
+      (empty? bs)
+      hs
+      (let
+        ((w (git/sha1-w-expand (git/sha1-w-init-go (git/sha1-take bs 64) 0 {}) 16)))
+        (let
+          ((r (git/sha1-rounds w 0 (nth hs 0) (nth hs 1) (nth hs 2) (nth hs 3) (nth hs 4))))
+          (git/sha1-blocks
+            (git/sha1-drop bs 64)
+            (list
+              (git/u32 (+ (nth hs 0) (nth r 0)))
+              (git/u32 (+ (nth hs 1) (nth r 1)))
+              (git/u32 (+ (nth hs 2) (nth r 2)))
+              (git/u32 (+ (nth hs 3) (nth r 3)))
+              (git/u32 (+ (nth hs 4) (nth r 4))))))))))
+
+(define
+  git/sha1-words
+  (fn
+    (s)
+    (git/sha1-blocks
+      (git/sha1-pad (git/sha1-str-bytes s))
+      (list 1732584193 4023233417 2562383102 271733878 3285377520))))
+
+; ---- digest forms ----
+(define
+  git/sha1-word-bytes
+  (fn
+    (v)
+    (list
+      (bitwise-and (arithmetic-shift v -24) 255)
+      (bitwise-and (arithmetic-shift v -16) 255)
+      (bitwise-and (arithmetic-shift v -8) 255)
+      (bitwise-and v 255))))
+
+(define
+  git/sha1-digest-bytes
+  (fn
+    (s)
+    (reduce
+      (fn (acc v) (append acc (git/sha1-word-bytes v)))
+      (list)
+      (git/sha1-words s))))
+
+(define git/sha1-hexd "0123456789abcdef")
+(define
+  git/sha1-byte-hex
+  (fn
+    (b)
+    (str
+      (substring
+        git/sha1-hexd
+        (quotient b 16)
+        (+ (quotient b 16) 1))
+      (substring
+        git/sha1-hexd
+        (remainder b 16)
+        (+ (remainder b 16) 1)))))
+
+(define
+  git/sha1-hex
+  (fn
+    (s)
+    (reduce
+      (fn (acc b) (str acc (git/sha1-byte-hex b)))
+      ""
+      (git/sha1-digest-bytes s))))
+
+(define
+  git/sha1-raw
+  (fn
+    (s)
+    (list->string
+      (map (fn (b) (integer->char b)) (git/sha1-digest-bytes s)))))
+
+; hex string -> raw bytes (tree entries embed 20 raw sha bytes)
+(define
+  git/hex-digit-val
+  (fn
+    (c)
+    (let
+      ((v (char-code c)))
+      (if (< v 58) (- v 48) (- v 87)))))
+
+(define
+  git/hex->raw-go
+  (fn
+    (h i n acc)
+    (if
+      (>= i n)
+      (list->string (reverse acc))
+      (git/hex->raw-go
+        h
+        (+ i 2)
+        n
+        (cons
+          (integer->char
+            (+
+              (*
+                16
+                (git/hex-digit-val (substring h i (+ i 1))))
+              (git/hex-digit-val
+                (substring h (+ i 1) (+ i 2)))))
+          acc)))))
+
+(define
+  git/hex->raw
+  (fn (h) (git/hex->raw-go h 0 (string-length h) (list))))

lib/git/tests/dag.sx

@@ -0,0 +1,172 @@
+; Phase 3 — dag: log (topo), ancestry, is-ancestor?, reachability, merge-base,
+; and the minimal Datalog ancestor-closure bridge.
+; Fixtures: a linear chain, a diamond merge, a criss-cross (two LCAs),
+; and two unrelated roots.
+
+(define gdt-db (persist/mem-backend))
+(define gdt (git/repo gdt-db))
+
+(define
+  gdt-commit!
+  (fn
+    (msg parents)
+    (git/write gdt (git/commit (git/write-blob gdt msg) parents {:message msg}))))
+
+; linear chain c1 <- c2 <- c3
+(define gdt-c1 (gdt-commit! "c1" (list)))
+(define gdt-c2 (gdt-commit! "c2" (list gdt-c1)))
+(define gdt-c3 (gdt-commit! "c3" (list gdt-c2)))
+
+; diamond: b1 <- p, b1 <- q, m = merge(p q)
+(define gdt-b1 (gdt-commit! "b1" (list)))
+(define gdt-p (gdt-commit! "p" (list gdt-b1)))
+(define gdt-q (gdt-commit! "q" (list gdt-b1)))
+(define gdt-m (gdt-commit! "m" (list gdt-p gdt-q)))
+
+; criss-cross: base <- a, base <- b; x = merge(a b), y = merge(a b) via
+; distinct messages so x != y
+(define gdt-base (gdt-commit! "base" (list)))
+(define gdt-a (gdt-commit! "a" (list gdt-base)))
+(define gdt-b (gdt-commit! "b" (list gdt-base)))
+(define gdt-x (gdt-commit! "x" (list gdt-a gdt-b)))
+(define gdt-y (gdt-commit! "y" (list gdt-a gdt-b)))
+
+; unrelated root
+(define gdt-lone (gdt-commit! "lone" (list)))
+
+; ---- parents ----
+(git-test
+  "parents of a root commit"
+  (= (git/parents gdt gdt-c1) (list))
+  true)
+(git-test
+  "parents of a merge commit"
+  (= (git/parents gdt gdt-m) (list gdt-p gdt-q))
+  true)
+(git-test
+  "parents of a non-commit cid"
+  (= (git/parents gdt "sx1:junk") (list))
+  true)
+
+; ---- reachability ----
+(git-test
+  "reachable includes self"
+  (git/dag-member? gdt-c3 (git/reachable gdt gdt-c3))
+  true)
+(git-test
+  "reachable spans the chain"
+  (= (git/reachable gdt gdt-c3) (list gdt-c1 gdt-c2 gdt-c3))
+  true)
+(git-test
+  "reachable covers both diamond legs"
+  (len (git/reachable gdt gdt-m))
+  4)
+(git-test
+  "reachable-all merges from several heads without duplicates"
+  (len (git/reachable-all gdt (list gdt-x gdt-y)))
+  5)
+
+; ---- log: children before parents ----
+(git-test
+  "log on a chain is newest-first"
+  (= (git/log gdt gdt-c3) (list gdt-c3 gdt-c2 gdt-c1))
+  true)
+(git-test
+  "log messages read newest-first"
+  (= (git/log-messages gdt gdt-c3) (list "c3" "c2" "c1"))
+  true)
+(git-test
+  "log of a diamond is a valid topo order"
+  (= (git/log gdt gdt-m) (list gdt-m gdt-q gdt-p gdt-b1))
+  true)
+(git-test
+  "log of a root is just the root"
+  (= (git/log gdt gdt-c1) (list gdt-c1))
+  true)
+
+; ---- ancestors / is-ancestor? ----
+(git-test
+  "ancestors excludes self"
+  (git/dag-member? gdt-c3 (git/ancestors gdt gdt-c3))
+  false)
+(git-test
+  "ancestors of the chain tip"
+  (= (git/ancestors gdt gdt-c3) (list gdt-c1 gdt-c2))
+  true)
+(git-test
+  "ancestors of a merge include both legs and the base"
+  (len (git/ancestors gdt gdt-m))
+  3)
+(git-test
+  "is-ancestor? along the chain"
+  (git/is-ancestor? gdt gdt-c1 gdt-c3)
+  true)
+(git-test
+  "is-ancestor? is directed"
+  (git/is-ancestor? gdt gdt-c3 gdt-c1)
+  false)
+(git-test
+  "is-ancestor? is reflexive"
+  (git/is-ancestor? gdt gdt-c2 gdt-c2)
+  true)
+(git-test
+  "is-ancestor? false across unrelated history"
+  (git/is-ancestor? gdt gdt-c1 gdt-lone)
+  false)
+
+; ---- merge-base ----
+(git-test
+  "merge-base of the diamond legs is the base"
+  (git/merge-base gdt gdt-p gdt-q)
+  gdt-b1)
+(git-test
+  "merge-base when one side is an ancestor is that side"
+  (git/merge-base gdt gdt-c1 gdt-c3)
+  gdt-c1)
+(git-test "merge-base with self" (git/merge-base gdt gdt-c3 gdt-c3) gdt-c3)
+(git-test
+  "merge-base of unrelated commits is nil"
+  (git/merge-base gdt gdt-c3 gdt-lone)
+  nil)
+(git-test
+  "merge-base is symmetric"
+  (equal? (git/merge-base gdt gdt-p gdt-q) (git/merge-base gdt gdt-q gdt-p))
+  true)
+(git-test
+  "criss-cross yields BOTH best common ancestors"
+  (=
+    (git/merge-bases gdt gdt-x gdt-y)
+    (artdag/sort-strings (list gdt-a gdt-b)))
+  true)
+(git-test
+  "dominated common ancestor is not a merge-base"
+  (git/dag-member? gdt-base (git/merge-bases gdt gdt-x gdt-y))
+  false)
+
+; ---- Datalog bridge ----
+(git-test
+  "dag-facts exports one fact per parent edge"
+  (len (git/dag-facts gdt (list gdt-m)))
+  4)
+(git-test
+  "datalog ancestors match the SX-side walk"
+  (let
+    ((db (git/dag-db gdt (list gdt-m))))
+    (=
+      (git/ancestors-dl db gdt-m)
+      (artdag/sort-strings (git/ancestors gdt gdt-m))))
+  true)
+(git-test
+  "datalog is-ancestor? positive"
+  (git/is-ancestor-dl? (git/dag-db gdt (list gdt-m)) gdt-b1 gdt-m)
+  true)
+(git-test
+  "datalog is-ancestor? negative"
+  (git/is-ancestor-dl? (git/dag-db gdt (list gdt-m)) gdt-m gdt-b1)
+  false)
+(git-test
+  "datalog closure spans the chain"
+  (=
+    (git/ancestors-dl (git/dag-db gdt (list gdt-c3)) gdt-c3)
+    (artdag/sort-strings (list gdt-c1 gdt-c2)))
+  true)

lib/git/tests/diff.sx

@@ -0,0 +1,164 @@
+; Phase 5 — diff: Myers line diff (edit script + reconstruction invariants),
+; unified hunk rendering, structural tree/commit diff.
+
+(define gdf-db (persist/mem-backend))
+(define gdf (git/repo gdf-db))
+
+; ---- diff-lines ----
+(git-test
+  "lines drop the trailing newline slot"
+  (= (git/diff-lines "a\nb\n") (list "a" "b"))
+  true)
+(git-test
+  "lines without trailing newline"
+  (= (git/diff-lines "a\nb") (list "a" "b"))
+  true)
+(git-test "empty data has no lines" (= (git/diff-lines "") (list)) true)
+
+; ---- Myers edit script ----
+(git-test
+  "identical inputs are all-eq"
+  (git/diff-changes (git/diff-script "a\nb\nc\n" "a\nb\nc\n"))
+  0)
+(git-test
+  "identical inputs keep every line"
+  (len (git/diff-script "a\nb\nc\n" "a\nb\nc\n"))
+  3)
+(git-test
+  "empty vs empty is the empty script"
+  (= (git/diff-script "" "") (list))
+  true)
+(git-test
+  "single line replacement"
+  (= (git/diff-script "a" "b") (list {:op "del" :line "a"} {:op "add" :line "b"}))
+  true)
+(git-test
+  "pure insertion script"
+  (= (git/diff-script "" "a\nb\n") (list {:op "add" :line "a"} {:op "add" :line "b"}))
+  true)
+(git-test
+  "pure deletion script"
+  (= (git/diff-script "a\nb\n" "") (list {:op "del" :line "a"} {:op "del" :line "b"}))
+  true)
+(git-test
+  "middle change keeps flanks eq"
+  (=
+    (git/diff-script "a\nb\nc\n" "a\nx\nc\n")
+    (list {:op "eq" :line "a"} {:op "del" :line "b"} {:op "add" :line "x"} {:op "eq" :line "c"}))
+  true)
+
+; Myers' paper example: ABCABBA -> CBABAC has a shortest edit script of 5
+(git-test
+  "ABCABBA/CBABAC shortest edit distance is 5"
+  (git/diff-changes (git/diff-script "A\nB\nC\nA\nB\nB\nA" "C\nB\nA\nB\nA\nC"))
+  5)
+(git-test
+  "script reconstructs the old side"
+  (=
+    (git/diff-old-lines (git/diff-script "A\nB\nC\nA\nB\nB\nA" "C\nB\nA\nB\nA\nC"))
+    (list "A" "B" "C" "A" "B" "B" "A"))
+  true)
+(git-test
+  "script reconstructs the new side"
+  (=
+    (git/diff-new-lines (git/diff-script "A\nB\nC\nA\nB\nB\nA" "C\nB\nA\nB\nA\nC"))
+    (list "C" "B" "A" "B" "A" "C"))
+  true)
+(git-test
+  "reconstruction holds for asymmetric edits"
+  (let
+    ((a "one\ntwo\nthree\nfour\n") (b "zero\ntwo\nfour\nfive\nsix\n"))
+    (and
+      (= (git/diff-old-lines (git/diff-script a b)) (git/diff-lines a))
+      (= (git/diff-new-lines (git/diff-script a b)) (git/diff-lines b))))
+  true)
+
+; ---- unified rendering ----
+(git-test
+  "unified: middle replacement, full context"
+  (git/diff-unified "a\nb\nc\n" "a\nx\nc\n")
+  "@@ -1,3 +1,3 @@\n a\n-b\n+x\n c\n")
+(git-test
+  "unified: append at end"
+  (git/diff-unified "a\n" "a\nb\n")
+  "@@ -1,1 +1,2 @@\n a\n+b\n")
+(git-test "unified: identical renders empty" (git/diff-unified "x\n" "x\n") "")
+(git-test
+  "unified: creation from empty"
+  (git/diff-unified "" "a\nb\n")
+  "@@ -0,0 +1,2 @@\n+a\n+b\n")
+(git-test
+  "unified: deletion to empty"
+  (git/diff-unified "a\nb\n" "")
+  "@@ -1,2 +0,0 @@\n-a\n-b\n")
+(git-test
+  "unified: context trimmed to 3 lines"
+  (git/diff-unified "l1\nl2\nl3\nl4\nl5\nl6\nl7\nl8\nl9\n" "l1\nl2\nl3\nl4\nX\nl6\nl7\nl8\nl9\n")
+  "@@ -2,7 +2,7 @@\n l2\n l3\n l4\n-l5\n+X\n l6\n l7\n l8\n")
+(git-test
+  "unified: distant changes split into two hunks"
+  (git/diff-unified
+    "l1\nl2\nl3\nl4\nl5\nl6\nl7\nl8\nl9\nl10\nl11\nl12\nl13\nl14\nl15\n"
+    "l1\nX\nl3\nl4\nl5\nl6\nl7\nl8\nl9\nl10\nl11\nl12\nl13\nY\nl15\n")
+  (str
+    "@@ -1,5 +1,5 @@\n l1\n-l2\n+X\n l3\n l4\n l5\n"
+    "@@ -11,5 +11,5 @@\n l11\n l12\n l13\n-l14\n+Y\n l15\n"))
+
+; ---- blob diff over the object store ----
+(git-test
+  "blob-diff reads both blobs"
+  (=
+    (git/blob-diff gdf (git/write-blob gdf "a\n") (git/write-blob gdf "b\n"))
+    (list {:op "del" :line "a"} {:op "add" :line "b"}))
+  true)
+
+; ---- structural tree/commit diff ----
+(define
+  gdf-t1
+  (git/tree-from-files
+    gdf
+    (assoc
+      (assoc (assoc {} "a.txt" "1\n") "b.txt" "2\n")
+      "sub/c.txt"
+      "3\n")))
+(define
+  gdf-t2
+  (git/tree-from-files
+    gdf
+    (assoc
+      (assoc (assoc {} "a.txt" "1\n") "b.txt" "2x\n")
+      "d.txt"
+      "new\n")))
+(define gdf-c1 (git/write gdf (git/commit gdf-t1 (list) {:message "c1"})))
+(define gdf-c2 (git/write gdf (git/commit gdf-t2 (list gdf-c1) {:message "c2"})))
+
+(git-test
+  "tree-diff classifies added/modified/deleted"
+  (= (git/tree-diff gdf gdf-t1 gdf-t2) {:deleted (list "sub/c.txt") :modified (list "b.txt") :added (list "d.txt")})
+  true)
+(git-test
+  "tree-diff of a tree with itself is empty"
+  (= (git/tree-diff gdf gdf-t1 gdf-t1) {:deleted (list) :modified (list) :added (list)})
+  true)
+(git-test
+  "commit-diff goes through the commit trees"
+  (= (git/commit-diff gdf gdf-c1 gdf-c2) {:deleted (list "sub/c.txt") :modified (list "b.txt") :added (list "d.txt")})
+  true)
+
+; ---- whole-commit unified render ----
+(git-test
+  "commit-diff-unified renders adds, deletes, then modifications"
+  (let
+    ((r (git/repo (persist/mem-backend))))
+    (let
+      ((c1 (git/write r (git/commit (git/tree-from-files r (assoc {} "f.txt" "old\n")) (list) {:message "c1"}))))
+      (let
+        ((c2 (git/write r (git/commit (git/tree-from-files r (assoc (assoc {} "f.txt" "new\n") "g.txt" "hi\n")) (list c1) {:message "c2"}))))
+        (git/commit-diff-unified r c1 c2))))
+  (str
+    "diff --sx a/g.txt b/g.txt\n--- /dev/null\n+++ b/g.txt\n@@ -0,0 +1,1 @@\n+hi\n"
+    "diff --sx a/f.txt b/f.txt\n--- a/f.txt\n+++ b/f.txt\n@@ -1,1 +1,1 @@\n-old\n+new\n"))
+(git-test
+  "commit-diff-unified of identical commits is empty"
+  (git/commit-diff-unified gdf gdf-c1 gdf-c1)
+  "")

lib/git/tests/export.sx

@@ -0,0 +1,202 @@
+; Extension — git-wire export adapter. Golden values generated with real git
+; (hash-object/mktree/commit-tree with pinned idents) — the adapter must
+; reproduce byte-exact payloads and SHA-1s.
+
+; ---- SHA-1 vectors ----
+(git-test
+  "sha1 of empty"
+  (git/sha1-hex "")
+  "da39a3ee5e6b4b0d3255bfef95601890afd80709")
+(git-test
+  "sha1 of abc"
+  (git/sha1-hex "abc")
+  "a9993e364706816aba3e25717850c26c9cd0d89d")
+(git-test
+  "sha1 crossing the padding boundary"
+  (git/sha1-hex "abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq")
+  "84983e441c3bd26ebaae4aa1f95129e5e54670f1")
+(define
+  gex-rep
+  (fn
+    (s n)
+    (if (= n 0) "" (str s (gex-rep s (- n 1))))))
+(git-test
+  "sha1 over multiple blocks"
+  (git/sha1-hex (gex-rep "a" 200))
+  "e61cfffe0d9195a525fc6cf06ca2d77119c24a40")
+(git-test
+  "raw digest is 20 bytes"
+  (= (string-length (git/sha1-raw "abc")) 20)
+  true)
+(git-test
+  "hex->raw round-trips through byte codes"
+  (char-code (substring (git/hex->raw "ff00a1") 1 2))
+  0)
+
+; ---- fixture (mirrors the golden git repo exactly) ----
+(define gex-db (persist/mem-backend))
+(define gex (git/repo gex-db))
+(define gex-hello (git/write-blob gex "hello\n"))
+(define gex-sub (git/write-blob gex "sub\n"))
+(define gex-hello2 (git/write-blob gex "hello2\n"))
+(define gex-subtxt (git/write-blob gex "not a dir\n"))
+(define
+  gex-tsub
+  (git/write
+    gex
+    (git/tree (assoc {} "c.txt" (git/tree-entry "blob" gex-sub)))))
+(define
+  gex-t1
+  (git/write
+    gex
+    (git/tree
+      (assoc
+        (assoc {} "a.txt" (git/tree-entry "blob" gex-hello))
+        "sub"
+        (git/tree-entry "tree" gex-tsub)))))
+(define
+  gex-t2
+  (git/write
+    gex
+    (git/tree
+      (assoc
+        (assoc {} "a.txt" (git/tree-entry "blob" gex-hello2))
+        "sub"
+        (git/tree-entry "tree" gex-tsub)))))
+(define
+  gex-t3
+  (git/write
+    gex
+    (git/tree
+      (assoc
+        (assoc
+          (assoc {} "a.txt" (git/tree-entry "blob" gex-hello))
+          "sub"
+          (git/tree-entry "tree" gex-tsub))
+        "sub.txt"
+        (git/tree-entry "blob" gex-subtxt)))))
+(define
+  gex-t4
+  (git/write
+    gex
+    (git/tree
+      (assoc
+        {}
+        "x.sh"
+        (merge (git/tree-entry "blob" gex-hello) {:mode "100755"})))))
+(define gex-c1 (git/write gex (git/commit gex-t1 (list) {:message "c1" :tz "+0000" :email "ada@sx" :time 1700000000 :author "ada"})))
+(define gex-c2 (git/write gex (git/commit gex-t2 (list gex-c1) {:message "c2" :tz "+0000" :email "ada@sx" :time 1700000100 :author "ada"})))
+(define gex-tag (git/write gex (git/tag gex-c1 "v1" {:message "first" :tz "+0000" :email "ada@sx" :time 1700000200 :author "ada"})))
+
+; ---- blob payloads ----
+(git-test
+  "blob export matches git hash-object"
+  (git/export-sha gex gex-hello)
+  "ce013625030ba8dba906f756967f9e9ca394464a")
+(git-test
+  "empty blob is git's famous e69de29"
+  (git/export-sha gex (git/write-blob gex ""))
+  "e69de29bb2d1d6434b8b29ae775ad8c2e48c5391")
+(git-test
+  "blob payload bytes are '<type> <len>NUL<data>'"
+  (equal?
+    (get (git/export gex gex-hello) :bytes)
+    (str "blob 6" git/export-nul "hello\n"))
+  true)
+
+; ---- tree payloads (git sort rules, raw child shas) ----
+(git-test
+  "leaf tree matches git mktree"
+  (git/export-sha gex gex-tsub)
+  "2282cb13a4b7999406280aac69e4fc45260fb909")
+(git-test
+  "nested tree matches git mktree"
+  (git/export-sha gex gex-t1)
+  "77918032f1f02d785d3bc222ab29b4969cd83854")
+(git-test
+  "modified tree matches git mktree"
+  (git/export-sha gex gex-t2)
+  "aaf1022f60da7b14837d52232a75fa3fc2d3e3a7")
+(git-test
+  "directories sort as 'name/': sub.txt before dir sub"
+  (git/export-sha gex gex-t3)
+  "58c19e599aa988a4ee6fba065f8801c700777a3d")
+(git-test
+  "entry :mode override (100755) is honored"
+  (git/export-sha gex gex-t4)
+  "54925a269ee97325d7da275bda4250d83b338e65")
+(git-test
+  "the empty tree is git's 4b825dc"
+  (git/export-sha gex (git/write gex (git/tree {})))
+  "4b825dc642cb6eb9a060e54bf8d69288fbee4904")
+
+; ---- commit payloads ----
+(git-test
+  "root commit matches git commit-tree"
+  (git/export-sha gex gex-c1)
+  "baeeb137fc255e62c1e3b980e70b2d8dd2be6e83")
+(git-test
+  "child commit matches git commit-tree -p"
+  (git/export-sha gex gex-c2)
+  "a8eac1e101bf4f6b7d614a4384592a981a67ce92")
+(git-test
+  "commit body is byte-exact"
+  (get (git/export gex gex-c1) :bytes)
+  (str
+    "commit 127"
+    git/export-nul
+    "tree 77918032f1f02d785d3bc222ab29b4969cd83854\n"
+    "author ada <ada@sx> 1700000000 +0000\n"
+    "committer ada <ada@sx> 1700000000 +0000\n"
+    "\n"
+    "c1\n"))
+
+; ---- tag payload ----
+(git-test
+  "annotated tag matches git hash-object -t tag"
+  (git/export-sha gex gex-tag)
+  "b28ebfd4213f10fd0c2127d1d14a26179fcf12e0")
+(git-test
+  "tag body names the target type"
+  (contains? (get (git/export gex gex-tag) :bytes) "type commit")
+  true)
+
+; ---- closure + set ----
+(git-test
+  "closure of the child commit covers all 8 reachable objects"
+  (len (keys (git/export-closure gex gex-c2)))
+  8)
+(git-test
+  "closure of the tag reaches through the commit"
+  (len (keys (git/export-closure gex gex-tag)))
+  6)
+(git-test
+  "export-set is keyed by git sha with the head marked"
+  (let
+    ((s (git/export-set gex gex-c2)))
+    (list
+      (get s :head)
+      (get
+        (get (get s :objects) "baeeb137fc255e62c1e3b980e70b2d8dd2be6e83")
+        :type)))
+  (list "a8eac1e101bf4f6b7d614a4384592a981a67ce92" "commit"))
+
+; ---- defaults + trailing newline rule ----
+(git-test
+  "idents default deterministically"
+  (contains?
+    (get
+      (git/export gex (git/write gex (git/commit gex-t1 (list) {:message "m\n"})))
+      :bytes)
+    "author sx <sx@sx> 0 +0000")
+  true)
+(git-test
+  "message gains a trailing newline when missing"
+  (let
+    ((e1 (git/export gex (git/write gex (git/commit gex-t1 (list) {:message "m"}))))
+      (e2
+        (git/export
+          gex
+          (git/write gex (git/commit gex-t1 (list) {:message "m\n" :x 1})))))
+    (equal? (get e1 :sha1) (get e2 :sha1)))
+  true)

lib/git/tests/import.sx

@@ -0,0 +1,174 @@
+; Extension — git-wire import (inverse adapter). The law under test:
+; export-set -> import-set -> export-set is BYTE-IDENTICAL (same head sha,
+; same object table), and imported blobs/trees with default modes get the
+; same native cids as the originals.
+
+(define gim-db (persist/mem-backend))
+(define gim (git/repo gim-db))
+(define gim-hello (git/write-blob gim "hello\n"))
+(define gim-sub (git/write-blob gim "sub\n"))
+(define
+  gim-tsub
+  (git/write
+    gim
+    (git/tree (assoc {} "c.txt" (git/tree-entry "blob" gim-sub)))))
+(define
+  gim-t1
+  (git/write
+    gim
+    (git/tree
+      (assoc
+        (assoc {} "a.txt" (git/tree-entry "blob" gim-hello))
+        "sub"
+        (git/tree-entry "tree" gim-tsub)))))
+(define gim-c1 (git/write gim (git/commit gim-t1 (list) {:message "c1" :tz "+0000" :email "ada@sx" :time 1700000000 :author "ada"})))
+(define
+  gim-c2
+  (git/write
+    gim
+    (git/commit
+      (git/write
+        gim
+        (git/tree
+          (assoc
+            (assoc
+              {}
+              "a.txt"
+              (git/tree-entry "blob" (git/write-blob gim "hello2\n")))
+            "sub"
+            (git/tree-entry "tree" gim-tsub))))
+      (list gim-c1)
+      {:message "c2" :tz "+0000" :email "ada@sx" :time 1700000100 :author "ada"})))
+
+; ---- parsing units ----
+(git-test
+  "payload splits type and body"
+  (git/import-payload (str "blob 6" git/export-nul "hello\n"))
+  {:type "blob" :body "hello\n"})
+(git-test
+  "ident parses name/email/time/tz"
+  (= (git/import-ident "ada lovelace <ada@sx> 1700000000 +0100") {:name "ada lovelace" :tz "+0100" :email "ada@sx" :time 1700000000})
+  true)
+(git-test
+  "raw->hex inverts hex->raw"
+  (git/raw->hex (git/hex->raw "ce013625030ba8dba906f756967f9e9ca394464a"))
+  "ce013625030ba8dba906f756967f9e9ca394464a")
+(git-test
+  "tree body parses mode/name/sha triples"
+  (=
+    (map
+      (fn (e) (get e :name))
+      (git/import-tree-entries
+        (get
+          (git/import-payload (get (git/export gim gim-t1) :bytes))
+          :body)
+        0
+        (string-length
+          (get
+            (git/import-payload (get (git/export gim gim-t1) :bytes))
+            :body))
+        (list)))
+    (list "a.txt" "sub"))
+  true)
+
+; ---- the round-trip law ----
+(define gim-set1 (git/export-set gim gim-c2))
+(define gim-fresh (git/repo-named (persist/mem-backend) "imported"))
+(define gim-head (git/import-set gim-fresh gim-set1))
+(define gim-set2 (git/export-set gim-fresh gim-head))
+
+(git-test
+  "wire round-trip: head sha is identical"
+  (get gim-set2 :head)
+  (get gim-set1 :head))
+(git-test
+  "wire round-trip: same number of objects"
+  (=
+    (len (keys (get gim-set2 :objects)))
+    (len (keys (get gim-set1 :objects))))
+  true)
+(git-test
+  "wire round-trip: every sha re-exports byte-identical"
+  (reduce
+    (fn
+      (acc sha)
+      (and
+        acc
+        (equal?
+          (get (get (get gim-set2 :objects) sha) :bytes)
+          (get (get (get gim-set1 :objects) sha) :bytes))))
+    true
+    (keys (get gim-set1 :objects)))
+  true)
+
+; ---- native identity on the wire-expressible subset ----
+(git-test
+  "imported blob has the original native cid"
+  (git/has? gim-fresh gim-hello)
+  true)
+(git-test
+  "imported default-mode tree has the original native cid"
+  (git/has? gim-fresh gim-t1)
+  true)
+(git-test
+  "imported commit graph walks natively"
+  (= (git/log-messages gim-fresh gim-head) (list "c2\n" "c1\n"))
+  true)
+(git-test
+  "imported parents map to native cids"
+  (=
+    (git/parents gim-fresh gim-head)
+    (list
+      (git/cid
+        (git/read gim-fresh (first (git/parents gim-fresh gim-head))))))
+  true)
+
+; ---- mode + tag + committer round-trips ----
+(git-test
+  "non-default mode survives the round-trip"
+  (let
+    ((r (git/repo (persist/mem-backend))))
+    (let
+      ((t (git/write r (git/tree (assoc {} "x.sh" (merge (git/tree-entry "blob" (git/write-blob r "hello\n")) {:mode "100755"}))))))
+      (let
+        ((s1 (git/export-set r t)))
+        (let
+          ((r2 (git/repo-named (persist/mem-backend) "i")))
+          (get (git/export-set r2 (git/import-set r2 s1)) :head)))))
+  "54925a269ee97325d7da275bda4250d83b338e65")
+(git-test
+  "annotated tag round-trips through the wire"
+  (let
+    ((tag (git/write gim (git/tag gim-c1 "v1" {:message "first" :tz "+0000" :email "ada@sx" :time 1700000200 :author "ada"}))))
+    (let
+      ((s1 (git/export-set gim tag)))
+      (let
+        ((r2 (git/repo-named (persist/mem-backend) "i")))
+        (equal?
+          (get (git/export-set r2 (git/import-set r2 s1)) :head)
+          (get s1 :head)))))
+  true)
+(git-test
+  "distinct committer survives the round-trip"
+  (let
+    ((c (git/write gim (git/commit gim-t1 (list) {:message "handoff" :committer "bob" :committer-tz "+0200" :tz "+0000" :committer-email "bob@sx" :email "ada@sx" :committer-time 1700000300 :time 1700000000 :author "ada"}))))
+    (let
+      ((s1 (git/export-set gim c)))
+      (let
+        ((r2 (git/repo-named (persist/mem-backend) "i")))
+        (equal?
+          (get (git/export-set r2 (git/import-set r2 s1)) :head)
+          (get s1 :head)))))
+  true)
+(git-test
+  "multi-line message round-trips byte-exact"
+  (let
+    ((c (git/write gim (git/commit gim-t1 (list) {:message "subject\n\nbody line one\nbody line two\n" :tz "+0000" :email "ada@sx" :time 1 :author "ada"}))))
+    (let
+      ((s1 (git/export-set gim c)))
+      (let
+        ((r2 (git/repo-named (persist/mem-backend) "i")))
+        (equal?
+          (get (git/export-set r2 (git/import-set r2 s1)) :head)
+          (get s1 :head)))))
+  true)

lib/git/tests/merge.sx

@@ -0,0 +1,235 @@
+; Phase 6 — merge: textual diff3 with conflict markers, per-path 3-way tree
+; merge with blob auto-merge, fast-forward/up-to-date detection.
+
+(define gmg-db (persist/mem-backend))
+(define gmg (git/repo gmg-db))
+
+(define
+  gmg-commit!
+  (fn
+    (files parents msg)
+    (git/write
+      gmg
+      (git/commit (git/tree-from-files gmg files) parents {:message msg}))))
+
+; ---- textual 3-way ----
+(git-test "merge3: untouched" (git/merge3-text "x\n" "x\n" "x\n") {:clean true :text "x\n" :conflicts 0})
+(git-test
+  "merge3: ours-only change wins"
+  (get (git/merge3-text "a\nb\n" "a\nB\n" "a\nb\n") :text)
+  "a\nB\n")
+(git-test
+  "merge3: theirs-only change wins"
+  (get (git/merge3-text "a\nb\n" "a\nb\n" "a\nB\n") :text)
+  "a\nB\n")
+(git-test
+  "merge3: identical change on both sides is clean"
+  (git/merge3-text "a\nb\n" "a\nZ\n" "a\nZ\n")
+  {:clean true :text "a\nZ\n" :conflicts 0})
+(git-test
+  "merge3: non-overlapping changes both apply"
+  (git/merge3-text "a\nb\nc\n" "A\nb\nc\n" "a\nb\nC\n")
+  {:clean true :text "A\nb\nC\n" :conflicts 0})
+(git-test
+  "merge3: adjacent line changes merge cleanly"
+  (get (git/merge3-text "l1\nl2\nl3\nl4\n" "l1\nX\nl3\nl4\n" "l1\nl2\nY\nl4\n") :text)
+  "l1\nX\nY\nl4\n")
+(git-test
+  "merge3: append and prepend both apply"
+  (get (git/merge3-text "m\n" "m\ne\n" "s\nm\n") :text)
+  "s\nm\ne\n")
+(git-test
+  "merge3: clean deletion"
+  (get (git/merge3-text "a\nb\nc\n" "a\nc\n" "a\nb\nc\n") :text)
+  "a\nc\n")
+
+(git-test
+  "merge3: overlapping edits conflict with diff3 markers"
+  (git/merge3-text "a\nb\nc\n" "a\nX\nc\n" "a\nY\nc\n")
+  {:clean false :text "a\n<<<<<<< ours\nX\n||||||| base\nb\n=======\nY\n>>>>>>> theirs\nc\n" :conflicts 1})
+(git-test
+  "merge3: delete vs modify conflicts"
+  (git/merge3-text "a\nb\nc\n" "a\nc\n" "a\nY\nc\n")
+  {:clean false :text "a\n<<<<<<< ours\n||||||| base\nb\n=======\nY\n>>>>>>> theirs\nc\n" :conflicts 1})
+(git-test
+  "merge3: same-point insertions with different content conflict"
+  (git/merge3-text "" "A\n" "B\n")
+  {:clean false :text "<<<<<<< ours\nA\n||||||| base\n=======\nB\n>>>>>>> theirs\n" :conflicts 1})
+(git-test
+  "merge3: same-point insertions with the same content are clean"
+  (git/merge3-text "a\n" "a\nx\n" "a\nx\n")
+  {:clean true :text "a\nx\n" :conflicts 0})
+(git-test
+  "merge3: two separated conflicts are counted"
+  (get
+    (git/merge3-text
+      "a\nb\nc\nd\ne\nf\ng\nh\ni\n"
+      "a\nX1\nc\nd\ne\nf\ng\nX2\ni\n"
+      "a\nY1\nc\nd\ne\nf\ng\nY2\ni\n")
+    :conflicts)
+  2)
+
+; ---- tree-from-cids ----
+(git-test
+  "tree-from-cids equals tree-from-files"
+  (equal?
+    (git/tree-from-cids
+      gmg
+      (assoc
+        (assoc {} "a.txt" (git/write-blob gmg "1\n"))
+        "s/b.txt"
+        (git/write-blob gmg "2\n")))
+    (git/tree-from-files
+      gmg
+      (assoc (assoc {} "a.txt" "1\n") "s/b.txt" "2\n")))
+  true)
+
+; ---- tree merge ----
+(define
+  gmg-base-files
+  (assoc (assoc {} "f.txt" "a\nb\nc\n") "g.txt" "same\n"))
+(define gmg-base-tree (git/tree-from-files gmg gmg-base-files))
+
+(git-test
+  "merge-trees: disjoint paths merge clean"
+  (let
+    ((ta (git/tree-from-files gmg (assoc gmg-base-files "ours.txt" "o\n")))
+      (tb (git/tree-from-files gmg (assoc gmg-base-files "theirs.txt" "t\n"))))
+    (let
+      ((m (git/merge-trees gmg gmg-base-tree ta tb)))
+      (list
+        (get m :conflicts)
+        (=
+          (git/tree-files gmg (git/tree-from-cids gmg (get m :files)))
+          (assoc (assoc gmg-base-files "ours.txt" "o\n") "theirs.txt" "t\n")))))
+  (list (list) true))
+(git-test
+  "merge-trees: same file, non-overlapping lines auto-merge"
+  (let
+    ((ta (git/tree-from-files gmg (assoc gmg-base-files "f.txt" "A\nb\nc\n")))
+      (tb (git/tree-from-files gmg (assoc gmg-base-files "f.txt" "a\nb\nC\n"))))
+    (let
+      ((m (git/merge-trees gmg gmg-base-tree ta tb)))
+      (list
+        (get m :conflicts)
+        (git/blob-data (git/read gmg (get (get m :files) "f.txt"))))))
+  (list (list) "A\nb\nC\n"))
+(git-test
+  "merge-trees: overlapping edits flag the path"
+  (let
+    ((ta (git/tree-from-files gmg (assoc gmg-base-files "f.txt" "a\nX\nc\n")))
+      (tb (git/tree-from-files gmg (assoc gmg-base-files "f.txt" "a\nY\nc\n"))))
+    (let
+      ((m (git/merge-trees gmg gmg-base-tree ta tb)))
+      (=
+        (list
+          (get m :conflicts)
+          (contains?
+            (git/blob-data (git/read gmg (get (get m :files) "f.txt")))
+            "<<<<<<< ours"))
+        (list (list "f.txt") true))))
+  true)
+(git-test
+  "merge-trees: both delete is clean"
+  (let
+    ((ta (git/tree-from-files gmg (dissoc gmg-base-files "f.txt")))
+      (tb (git/tree-from-files gmg (dissoc gmg-base-files "f.txt"))))
+    (let
+      ((m (git/merge-trees gmg gmg-base-tree ta tb)))
+      (list (get m :conflicts) (has-key? (get m :files) "f.txt"))))
+  (list (list) false))
+(git-test
+  "merge-trees: delete vs modify keeps the modified side and flags it"
+  (let
+    ((ta (git/tree-from-files gmg (dissoc gmg-base-files "f.txt")))
+      (tb (git/tree-from-files gmg (assoc gmg-base-files "f.txt" "a\nY\nc\n"))))
+    (let
+      ((m (git/merge-trees gmg gmg-base-tree ta tb)))
+      (=
+        (list
+          (get m :conflicts)
+          (git/blob-data (git/read gmg (get (get m :files) "f.txt"))))
+        (list (list "f.txt") "a\nY\nc\n"))))
+  true)
+(git-test
+  "merge-trees: both add the same file identically"
+  (let
+    ((ta (git/tree-from-files gmg (assoc gmg-base-files "n.txt" "n\n")))
+      (tb (git/tree-from-files gmg (assoc gmg-base-files "n.txt" "n\n"))))
+    (get (git/merge-trees gmg gmg-base-tree ta tb) :conflicts))
+  (list))
+(git-test
+  "merge-trees: both add the same file differently"
+  (let
+    ((ta (git/tree-from-files gmg (assoc gmg-base-files "n.txt" "N1\n")))
+      (tb (git/tree-from-files gmg (assoc gmg-base-files "n.txt" "N2\n"))))
+    (=
+      (get (git/merge-trees gmg gmg-base-tree ta tb) :conflicts)
+      (list "n.txt")))
+  true)
+
+; ---- commit-level ----
+(define gmg-c0 (gmg-commit! gmg-base-files (list) "base"))
+(define
+  gmg-ca
+  (gmg-commit! (assoc gmg-base-files "f.txt" "A\nb\nc\n") (list gmg-c0) "ours"))
+(define
+  gmg-cb
+  (gmg-commit!
+    (assoc gmg-base-files "f.txt" "a\nb\nC\n")
+    (list gmg-c0)
+    "theirs"))
+(define
+  gmg-cx
+  (gmg-commit! (assoc gmg-base-files "f.txt" "a\nX\nc\n") (list gmg-c0) "ox"))
+(define
+  gmg-cy
+  (gmg-commit! (assoc gmg-base-files "f.txt" "a\nY\nc\n") (list gmg-c0) "oy"))
+
+(git-test "ff? when ours is behind" (git/ff? gmg gmg-c0 gmg-ca) true)
+(git-test "ff? false for diverged heads" (git/ff? gmg gmg-ca gmg-cb) false)
+(git-test
+  "merge-commits: up-to-date when theirs is an ancestor"
+  (git/merge-commits gmg gmg-ca gmg-c0)
+  {:cid gmg-ca :result "up-to-date"})
+(git-test
+  "merge-commits: fast-forward when ours is an ancestor"
+  (git/merge-commits gmg gmg-c0 gmg-ca)
+  {:cid gmg-ca :result "fast-forward"})
+(git-test
+  "merge-commits: clean 3-way produces the merged tree"
+  (let
+    ((m (git/merge-commits gmg gmg-ca gmg-cb)))
+    (list
+      (get m :result)
+      (get m :conflicts)
+      (=
+        (git/tree-files gmg (get m :tree))
+        (assoc gmg-base-files "f.txt" "A\nb\nC\n"))))
+  (list "merged" (list) true))
+(git-test
+  "merge-commits: conflicting 3-way reports paths and marker tree"
+  (let
+    ((m (git/merge-commits gmg gmg-cx gmg-cy)))
+    (=
+      (list
+        (get m :result)
+        (get m :conflicts)
+        (contains?
+          (get (git/tree-files gmg (get m :tree)) "f.txt")
+          ">>>>>>> theirs"))
+      (list "conflicts" (list "f.txt") true)))
+  true)
+(git-test
+  "merge-commits: unrelated histories merge over an empty base"
+  (let
+    ((r1 (gmg-commit! (assoc {} "x.txt" "x\n") (list) "rx"))
+      (r2 (gmg-commit! (assoc {} "y.txt" "y\n") (list) "ry")))
+    (let
+      ((m (git/merge-commits gmg r1 r2)))
+      (list
+        (get m :result)
+        (=
+          (git/tree-files gmg (get m :tree))
+          (assoc (assoc {} "x.txt" "x\n") "y.txt" "y\n")))))
+  (list "merged" true))

lib/git/tests/object.sx

@@ -0,0 +1,241 @@
+; Phase 1 — object: blob/tree/commit/tag as content-addressed typed objects.
+; Fixture repo: blobs a/b/c, nested tree (a.txt b.txt sub/c.txt), two commits
+; (c2 modifies a.txt, parent c1), tag v1 -> c1. Reused as the assertion target.
+
+(define git-fix-db (persist/mem-backend))
+(define git-fix (git/repo git-fix-db))
+
+(define git-fix-blob-a (git/write-blob git-fix "hello\n"))
+(define git-fix-blob-b (git/write-blob git-fix "world\n"))
+(define git-fix-blob-c (git/write-blob git-fix "sub\n"))
+(define git-fix-blob-a2 (git/write-blob git-fix "hello2\n"))
+
+(define
+  git-fixt-entries3
+  (fn
+    (acid bcid subcid)
+    (assoc
+      (assoc
+        (assoc {} "a.txt" (git/tree-entry "blob" acid))
+        "b.txt"
+        (git/tree-entry "blob" bcid))
+      "sub"
+      (git/tree-entry "tree" subcid))))
+
+(define
+  git-fix-subtree-cid
+  (git/write
+    git-fix
+    (git/tree
+      (assoc {} "c.txt" (git/tree-entry "blob" git-fix-blob-c)))))
+
+(define
+  git-fix-tree1-cid
+  (git/write
+    git-fix
+    (git/tree
+      (git-fixt-entries3 git-fix-blob-a git-fix-blob-b git-fix-subtree-cid))))
+
+(define
+  git-fix-tree2-cid
+  (git/write
+    git-fix
+    (git/tree
+      (git-fixt-entries3 git-fix-blob-a2 git-fix-blob-b git-fix-subtree-cid))))
+
+(define
+  git-fix-commit1-cid
+  (git/write git-fix (git/commit git-fix-tree1-cid (list) {:message "c1" :time 1 :author "ada"})))
+
+(define
+  git-fix-commit2-cid
+  (git/write
+    git-fix
+    (git/commit git-fix-tree2-cid (list git-fix-commit1-cid) {:message "c2" :time 2 :author "ada"})))
+
+(define
+  git-fix-tag-cid
+  (git/write git-fix (git/tag git-fix-commit1-cid "v1" {:message "first" :tagger "ada"})))
+
+; ---- constructors + types ----
+(git-test "blob is typed" (git/object-type (git/blob "x")) "blob")
+(git-test "blob? true on blob" (git/blob? (git/blob "x")) true)
+(git-test
+  "blob? false on commit"
+  (git/blob? (git/commit "t" (list) {}))
+  false)
+(git-test "tree? true on tree" (git/tree? (git/tree {})) true)
+(git-test
+  "commit? true on commit"
+  (git/commit? (git/commit "t" (list) {}))
+  true)
+(git-test "tag? true on tag" (git/tag? (git/tag "c" "v" {})) true)
+(git-test "blob-data reads back" (git/blob-data (git/blob "hi")) "hi")
+
+; ---- cid: deterministic structural identity ----
+(git-test
+  "cid deterministic"
+  (equal? (git/cid (git/blob "same")) (git/cid (git/blob "same")))
+  true)
+(git-test
+  "cid differs by content"
+  (equal? (git/cid (git/blob "a")) (git/cid (git/blob "b")))
+  false)
+(git-test
+  "cid ignores dict insertion order"
+  (equal?
+    (git/cid (assoc (assoc {} :type "blob") :data "x"))
+    (git/cid (assoc (assoc {} :data "x") :type "blob")))
+  true)
+(git-test
+  "cid carries the native scheme prefix"
+  (starts-with? (git/cid (git/blob "x")) "sx1:")
+  true)
+
+; ---- write / read / has ----
+(git-test
+  "write returns the object cid"
+  (equal? git-fix-blob-a (git/cid (git/blob "hello\n")))
+  true)
+(git-test
+  "read round-trips blob data"
+  (git/blob-data (git/read git-fix git-fix-blob-a))
+  "hello\n")
+(git-test
+  "read round-trips structurally"
+  (equal? (git/read git-fix git-fix-blob-a) (git/blob "hello\n"))
+  true)
+(git-test "has? true after write" (git/has? git-fix git-fix-blob-a) true)
+(git-test "has? false for unknown cid" (git/has? git-fix "sx1:nope") false)
+(git-test "read unknown cid gives nil" (git/read git-fix "sx1:nope") nil)
+(git-test
+  "rewrite is idempotent, same cid"
+  (equal? (git/write git-fix (git/blob "hello\n")) git-fix-blob-a)
+  true)
+
+; ---- structural identity across separately built objects ----
+(git-test
+  "separately built identical tree shares the cid"
+  (equal?
+    (git/write
+      git-fix
+      (git/tree
+        (git-fixt-entries3 git-fix-blob-a git-fix-blob-b git-fix-subtree-cid)))
+    git-fix-tree1-cid)
+  true)
+(git-test
+  "changed entry changes the tree cid"
+  (equal? git-fix-tree1-cid git-fix-tree2-cid)
+  false)
+
+; ---- tree accessors ----
+(git-test
+  "tree entry lookup by name"
+  (git/entry-cid
+    (git/tree-entry-for (git/read git-fix git-fix-tree1-cid) "a.txt"))
+  git-fix-blob-a)
+(git-test
+  "tree entry kind"
+  (git/entry-kind
+    (git/tree-entry-for (git/read git-fix git-fix-tree1-cid) "sub"))
+  "tree")
+(git-test
+  "tree-names sorted"
+  (=
+    (git/tree-names (git/read git-fix git-fix-tree1-cid))
+    (list "a.txt" "b.txt" "sub"))
+  true)
+
+; ---- commit accessors ----
+(git-test
+  "commit tree cid"
+  (git/commit-tree (git/read git-fix git-fix-commit1-cid))
+  git-fix-tree1-cid)
+(git-test
+  "root commit has no parents"
+  (git/commit-parents (git/read git-fix git-fix-commit1-cid))
+  (list))
+(git-test
+  "child commit records its parent"
+  (git/commit-parents (git/read git-fix git-fix-commit2-cid))
+  (list git-fix-commit1-cid))
+(git-test
+  "commit author round-trips"
+  (git/commit-author (git/read git-fix git-fix-commit1-cid))
+  "ada")
+(git-test
+  "commit message round-trips"
+  (git/commit-message (git/read git-fix git-fix-commit2-cid))
+  "c2")
+(git-test
+  "commit cids differ across history"
+  (equal? git-fix-commit1-cid git-fix-commit2-cid)
+  false)
+
+; ---- typed extensibility (the reason for native CID) ----
+(git-test
+  "extra commit field round-trips"
+  (get
+    (git/read
+      git-fix
+      (git/write git-fix (git/commit "t" (list) {:message "m" :co-authored-by "claude"})))
+    :co-authored-by)
+  "claude")
+(git-test
+  "extra field changes the cid"
+  (equal?
+    (git/cid (git/commit "t" (list) {:m 1}))
+    (git/cid (git/commit "t" (list) {})))
+  false)
+(git-test
+  "protected keys win over meta"
+  (git/commit-tree (git/commit "t" (list) {:tree "evil"}))
+  "t")
+
+; ---- tag ----
+(git-test
+  "tag target"
+  (git/tag-target (git/read git-fix git-fix-tag-cid))
+  git-fix-commit1-cid)
+(git-test "tag name" (git/tag-name (git/read git-fix git-fix-tag-cid)) "v1")
+(git-test
+  "tag? on read-back"
+  (git/tag? (git/read git-fix git-fix-tag-cid))
+  true)
+
+; ---- full walk: commit -> tree -> subtree -> blob ----
+(git-test
+  "walk commit to nested blob"
+  (git/blob-data
+    (git/read
+      git-fix
+      (git/entry-cid
+        (git/tree-entry-for
+          (git/read
+            git-fix
+            (git/entry-cid
+              (git/tree-entry-for
+                (git/read
+                  git-fix
+                  (git/commit-tree (git/read git-fix git-fix-commit1-cid)))
+                "sub")))
+          "c.txt"))))
+  "sub\n")
+
+; ---- repos are namespaced within one backend ----
+(git-test
+  "objects are invisible across repo namespaces"
+  (let
+    ((db (persist/mem-backend)))
+    (let
+      ((ra (git/repo-named db "a")) (rb (git/repo-named db "b")))
+      (let ((cid (git/write-blob ra "x"))) (git/has? rb cid))))
+  false)
+(git-test
+  "same content, same cid in any repo"
+  (let
+    ((db (persist/mem-backend)))
+    (equal?
+      (git/write-blob (git/repo-named db "a") "x")
+      (git/write-blob (git/repo-named db "b") "x")))
+  true)

lib/git/tests/porcelain.sx

@@ -0,0 +1,261 @@
+; Phase 7 — porcelain: init/add/commit/branch/checkout/tag/reset/merge/log/diff
+; as one end-to-end topology story, plus the conflicted-merge flow.
+
+(define gpc-db (persist/mem-backend))
+(define gpc (git/init! gpc-db "proj"))
+
+; ---- init ----
+(git-test
+  "init points HEAD at an unborn main"
+  (git/head-target gpc)
+  "heads/main")
+(git-test "init has no commits yet" (git/head gpc) nil)
+(git-test
+  "init status is clean and empty"
+  (= (git/status gpc {}) {:untracked (list) :staged {:deleted (list) :modified (list) :added (list)} :unstaged {:deleted (list) :modified (list)}})
+  true)
+
+; ---- first commit on main ----
+(git-test
+  "staged files show before the first commit"
+  (begin
+    (git/add! gpc "README.md" "hello\n")
+    (git/add! gpc "src/main.sx" "(main)\n")
+    (=
+      (get (get (git/status gpc {}) :staged) :added)
+      (list "README.md" "src/main.sx")))
+  true)
+
+(define gpc-c1 (git/commit! gpc {:message "c1" :author "ada"}))
+
+(git-test "commit! advances HEAD through main" (git/head gpc) gpc-c1)
+(git-test "commit! moved the branch ref" (git/branch-get gpc "main") gpc-c1)
+(git-test
+  "the commit carries the author"
+  (git/commit-author (git/read gpc gpc-c1))
+  "ada")
+(git-test
+  "first commit has no parents"
+  (= (git/commit-parents (git/read gpc gpc-c1)) (list))
+  true)
+(git-test
+  "commit materializes the staged files"
+  (=
+    (git/commit-files gpc gpc-c1)
+    (assoc (assoc {} "README.md" "hello\n") "src/main.sx" "(main)\n"))
+  true)
+(git-test "after commit! the index is clean" (git/diff-staged gpc) "")
+(git-test
+  "extensible meta flows through porcelain"
+  (let
+    ((r (git/init! (persist/mem-backend) "x")))
+    (begin
+      (git/add! r "f" "1\n")
+      (get (git/read r (git/commit! r {:message "m" :agent "claude-fable"})) :agent)))
+  "claude-fable")
+
+; ---- branch + checkout ----
+(git-test "branch! forks at HEAD" (git/branch! gpc "feature") gpc-c1)
+(git-test
+  "checkout! returns the materialized worktree"
+  (= (git/checkout! gpc "feature") (git/commit-files gpc gpc-c1))
+  true)
+(git-test "checkout! retargets HEAD" (git/head-target gpc) "heads/feature")
+
+(define
+  gpc-c2
+  (begin
+    (git/add! gpc "src/feature.sx" "(feature)\n")
+    (git/commit! gpc {:message "c2" :author "ada"})))
+
+(git-test
+  "feature moved, main did not"
+  (=
+    (list (git/branch-get gpc "feature") (git/branch-get gpc "main"))
+    (list gpc-c2 gpc-c1))
+  true)
+(git-test
+  "checkout back to main drops the feature file"
+  (has-key? (git/checkout! gpc "main") "src/feature.sx")
+  false)
+
+(define
+  gpc-c3
+  (begin
+    (git/add! gpc "README.md" "hello\nworld\n")
+    (git/commit! gpc {:message "c3" :author "ada"})))
+
+; ---- real merge ----
+(define gpc-m (git/merge! gpc "feature" {:message "merge feature" :author "ada"}))
+
+(git-test
+  "diverged branches produce a merge commit"
+  (get gpc-m :result)
+  "merged")
+(git-test
+  "merge commit has both parents in order"
+  (=
+    (git/commit-parents (git/read gpc (get gpc-m :cid)))
+    (list gpc-c3 gpc-c2))
+  true)
+(git-test
+  "merge result is where HEAD is now"
+  (git/head gpc)
+  (get gpc-m :cid))
+(git-test
+  "merged tree unions both changes"
+  (=
+    (git/commit-files gpc (git/head gpc))
+    (assoc
+      (assoc
+        (assoc {} "README.md" "hello\nworld\n")
+        "src/main.sx"
+        "(main)\n")
+      "src/feature.sx"
+      "(feature)\n"))
+  true)
+(git-test "no merge left in progress" (git/merge-in-progress? gpc) false)
+(git-test
+  "log walks the merged topology newest-first"
+  (=
+    (git/log-messages gpc (git/head gpc))
+    (list "merge feature" "c2" "c3" "c1"))
+  true)
+(git-test
+  "merge-base of the two legs is the fork point"
+  (git/merge-base gpc gpc-c2 gpc-c3)
+  gpc-c1)
+
+; ---- fast-forward + up-to-date ----
+(define gpc-c4 (get gpc-m :cid))
+(define
+  gpc-c5
+  (begin
+    (git/branch! gpc "hotfix")
+    (git/checkout! gpc "hotfix")
+    (git/add! gpc "fix.txt" "patched\n")
+    (git/commit! gpc {:message "c5" :author "ada"})))
+
+(git-test
+  "merging a descendant fast-forwards"
+  (begin
+    (git/checkout! gpc "main")
+    (get (git/merge! gpc "hotfix" {:message "unused"}) :result))
+  "fast-forward")
+(git-test
+  "fast-forward moved main to the hotfix tip"
+  (git/branch-get gpc "main")
+  gpc-c5)
+(git-test
+  "merging it again is up-to-date"
+  (get (git/merge! gpc "hotfix" {:message "unused"}) :result)
+  "up-to-date")
+
+; ---- tags ----
+(git-test
+  "tag! writes an annotated tag object at HEAD"
+  (begin
+    (git/tag! gpc "v1" {:tagger "ada"})
+    (git/tag-target (git/read gpc (git/tag-get gpc "v1"))))
+  gpc-c5)
+(git-test
+  "lightweight tag points straight at the commit"
+  (begin (git/tag-lightweight! gpc "tip") (git/tag-get gpc "tip"))
+  gpc-c5)
+
+; ---- reset ----
+(git-test
+  "soft reset moves the branch but keeps the index"
+  (begin
+    (git/reset! gpc gpc-c4 "soft")
+    (list (git/head gpc) (contains? (git/diff-staged gpc) "+patched")))
+  (list gpc-c4 true))
+(git-test
+  "mixed reset also resets the index"
+  (begin
+    (git/reset! gpc gpc-c5 "mixed")
+    (list (git/head gpc) (git/diff-staged gpc)))
+  (list gpc-c5 ""))
+
+; ---- detached HEAD ----
+(git-test
+  "detached checkout pins the cid"
+  (begin
+    (git/checkout-detached! gpc gpc-c1)
+    (list (git/detached? gpc) (git/head gpc)))
+  (list true gpc-c1))
+(git-test
+  "committing while detached moves only the pin"
+  (let
+    ((c6 (begin (git/add! gpc "scratch.txt" "s\n") (git/commit! gpc {:message "c6"}))))
+    (list (git/head gpc) (git/branch-get gpc "main")))
+  (list (git/head gpc) gpc-c5))
+(git-test
+  "checkout! reattaches to a branch"
+  (begin (git/checkout! gpc "main") (git/head-target gpc))
+  "heads/main")
+
+; ---- unstaged diff ----
+(git-test
+  "diff-unstaged renders worktree edits"
+  (contains?
+    (git/diff-unstaged
+      gpc
+      (assoc (git/commit-files gpc (git/head gpc)) "fix.txt" "patched\nedit\n"))
+    "+edit")
+  true)
+
+; ---- conflicted merge flow ----
+(define gcf (git/init! (persist/mem-backend) "cf"))
+(define
+  gcf-c1
+  (begin (git/add! gcf "f.txt" "a\nb\nc\n") (git/commit! gcf {:message "base"})))
+(define
+  gcf-c2
+  (begin
+    (git/branch! gcf "left")
+    (git/add! gcf "f.txt" "a\nX\nc\n")
+    (git/commit! gcf {:message "ours"})))
+(define
+  gcf-c3
+  (begin
+    (git/checkout! gcf "left")
+    (git/add! gcf "f.txt" "a\nY\nc\n")
+    (git/commit! gcf {:message "theirs"})))
+(define
+  gcf-m
+  (begin (git/checkout! gcf "main") (git/merge! gcf "left" {:message "m"})))
+
+(git-test
+  "conflicting merge reports the paths"
+  (=
+    (list (get gcf-m :result) (get gcf-m :conflicts))
+    (list "conflicts" (list "f.txt")))
+  true)
+(git-test
+  "a conflicted merge is in progress"
+  (git/merge-in-progress? gcf)
+  true)
+(git-test
+  "the conflicted file is staged with markers"
+  (contains? (get (git/index-files gcf) "f.txt") "<<<<<<< ours")
+  true)
+(git-test "HEAD did not move on conflict" (git/head gcf) gcf-c2)
+(git-test
+  "merge-commit! concludes with two parents"
+  (begin
+    (git/add! gcf "f.txt" "a\nXY\nc\n")
+    (let
+      ((mc (git/merge-commit! gcf {:message "resolved"})))
+      (=
+        (list
+          (git/head gcf)
+          (git/commit-parents (git/read gcf mc))
+          (get (git/commit-files gcf mc) "f.txt")
+          (git/merge-in-progress? gcf))
+        (list mc (list gcf-c2 gcf-c3) "a\nXY\nc\n" false))))
+  true)
+(git-test
+  "merge-commit! without a merge in progress errors"
+  (get (git/merge-commit! gcf {:message "x"}) :error)
+  "no merge in progress")

lib/git/tests/ref.sx

@@ -0,0 +1,208 @@
+; Phase 2 — ref: branches/tags/HEAD as name -> cid over persist kv, symbolic
+; refs, CAS updates with old-value expect, reflog.
+
+(define grt-db (persist/mem-backend))
+(define grt (git/repo grt-db))
+(define grt-c1 (git/write-blob grt "one"))
+(define grt-c2 (git/write-blob grt "two"))
+(define grt-c3 (git/write-blob grt "three"))
+
+; ---- direct refs ----
+(git-test "ref-get on unset ref is nil" (git/ref-get grt "heads/none") nil)
+(git-test
+  "ref-set! returns the cid"
+  (git/ref-set! grt "heads/main" grt-c1)
+  grt-c1)
+(git-test "ref-get reads it back" (git/ref-get grt "heads/main") grt-c1)
+(git-test
+  "ref-resolve on a direct ref"
+  (git/ref-resolve grt "heads/main")
+  grt-c1)
+(git-test
+  "ref-resolve on missing ref is nil"
+  (git/ref-resolve grt "nope")
+  nil)
+
+; ---- symbolic refs ----
+(git-test
+  "symref resolves through its target"
+  (begin
+    (git/symref-set! grt "HEAD" "heads/main")
+    (git/ref-resolve grt "HEAD"))
+  grt-c1)
+(git-test
+  "symref chain resolves"
+  (begin
+    (git/symref-set! grt "INDIRECT" "HEAD")
+    (git/ref-resolve grt "INDIRECT"))
+  grt-c1)
+(git-test
+  "symref cycle is bounded, resolves nil"
+  (begin
+    (git/symref-set! grt "LOOPA" "LOOPB")
+    (git/symref-set! grt "LOOPB" "LOOPA")
+    (git/ref-resolve grt "LOOPA"))
+  nil)
+(git-test "ref-get does not follow a symref" (git/ref-get grt "HEAD") nil)
+(git-test
+  "symref? on a raw symref value"
+  (git/symref? (git/ref-read grt "HEAD"))
+  true)
+
+; ---- CAS ----
+(git-test
+  "cas create (expected nil) succeeds"
+  (git/ref-cas! grt "heads/dev" nil grt-c1)
+  grt-c1)
+(git-test
+  "cas create conflicts when the ref exists"
+  (get (git/ref-cas! grt "heads/dev" nil grt-c2) :conflict)
+  true)
+(git-test
+  "cas conflict reports the actual cid"
+  (get (git/ref-cas! grt "heads/dev" grt-c3 grt-c2) :actual)
+  grt-c1)
+(git-test
+  "cas conflict leaves the ref unchanged"
+  (git/ref-get grt "heads/dev")
+  grt-c1)
+(git-test
+  "cas with the right expected value moves the ref"
+  (git/ref-cas! grt "heads/dev" grt-c1 grt-c2)
+  grt-c2)
+(git-test "cas move is visible" (git/ref-get grt "heads/dev") grt-c2)
+
+; ---- delete ----
+(git-test
+  "ref-delete! removes the ref"
+  (begin
+    (git/ref-set! grt "heads/tmp" grt-c1)
+    (git/ref-delete! grt "heads/tmp")
+    (git/ref-get grt "heads/tmp"))
+  nil)
+
+; ---- branch conveniences ----
+(git-test
+  "branch-create! returns the cid"
+  (git/branch-create! grt "feature" grt-c1)
+  grt-c1)
+(git-test
+  "branch-create! conflicts on an existing branch"
+  (get (git/branch-create! grt "feature" grt-c2) :conflict)
+  true)
+(git-test "branch-get" (git/branch-get grt "feature") grt-c1)
+(git-test
+  "branch-cas! moves the branch"
+  (git/branch-cas! grt "feature" grt-c1 grt-c2)
+  grt-c2)
+(git-test
+  "branch-set! moves unconditionally"
+  (git/branch-set! grt "feature" grt-c3)
+  grt-c3)
+(git-test
+  "branch-delete! removes it"
+  (begin (git/branch-delete! grt "feature") (git/branch-get grt "feature"))
+  nil)
+
+; ---- listing ----
+(git-test
+  "branches are listed sorted, tags and HEAD excluded"
+  (let
+    ((db (persist/mem-backend)))
+    (let
+      ((r (git/repo db)))
+      (begin
+        (git/branch-set! r "zeta" "sx1:z")
+        (git/branch-set! r "alpha" "sx1:a")
+        (git/tag-set! r "v1" "sx1:t")
+        (git/head-set! r "alpha")
+        (= (git/branches r) (list "alpha" "zeta")))))
+  true)
+(git-test
+  "tag-names lists tag refs"
+  (let
+    ((db (persist/mem-backend)))
+    (let
+      ((r (git/repo db)))
+      (begin
+        (git/tag-set! r "v2" "sx1:t2")
+        (git/tag-set! r "v1" "sx1:t1")
+        (= (git/tag-names r) (list "v1" "v2")))))
+  true)
+(git-test
+  "tag-get reads a tag ref"
+  (begin (git/tag-set! grt "v1" grt-c1) (git/tag-get grt "v1"))
+  grt-c1)
+
+; ---- HEAD ----
+(git-test
+  "head resolves through the current branch"
+  (begin
+    (git/branch-set! grt "main" grt-c2)
+    (git/head-set! grt "main")
+    (git/head grt))
+  grt-c2)
+(git-test
+  "moving the branch moves head"
+  (begin (git/branch-set! grt "main" grt-c3) (git/head grt))
+  grt-c3)
+(git-test
+  "head-target names the branch ref"
+  (git/head-target grt)
+  "heads/main")
+(git-test "detached? false on a symref HEAD" (git/detached? grt) false)
+(git-test
+  "head-detach! pins a cid"
+  (begin (git/head-detach! grt grt-c1) (git/head grt))
+  grt-c1)
+(git-test "detached? true after detach" (git/detached? grt) true)
+(git-test "head-target nil when detached" (git/head-target grt) nil)
+
+; ---- reflog ----
+(git-test
+  "reflog of an untouched ref is empty"
+  (= (git/reflog grt "heads/quiet") (list))
+  true)
+(git-test
+  "reflog records create and moves oldest-first"
+  (let
+    ((db (persist/mem-backend)))
+    (let
+      ((r (git/repo db)))
+      (begin
+        (git/ref-set! r "heads/x" "sx1:a")
+        (git/ref-set! r "heads/x" "sx1:b")
+        (git/ref-cas! r "heads/x" "sx1:b" "sx1:c")
+        (= (git/reflog r "heads/x") (list {:new "sx1:a" :old nil} {:new "sx1:b" :old "sx1:a"} {:new "sx1:c" :old "sx1:b"})))))
+  true)
+(git-test
+  "branch-create! writes the first reflog entry"
+  (let
+    ((db (persist/mem-backend)))
+    (let
+      ((r (git/repo db)))
+      (begin
+        (git/branch-create! r "b" "sx1:a")
+        (= (git/reflog r "heads/b") (list {:new "sx1:a" :old nil})))))
+  true)
+(git-test
+  "failed cas leaves no reflog entry"
+  (let
+    ((db (persist/mem-backend)))
+    (let
+      ((r (git/repo db)))
+      (begin
+        (git/ref-set! r "heads/x" "sx1:a")
+        (git/ref-cas! r "heads/x" "sx1:wrong" "sx1:b")
+        (len (git/reflog r "heads/x")))))
+  1)
+
+; ---- namespacing ----
+(git-test
+  "refs are invisible across repo namespaces"
+  (let
+    ((db (persist/mem-backend)))
+    (begin
+      (git/branch-set! (git/repo-named db "a") "main" "sx1:a")
+      (git/branch-get (git/repo-named db "b") "main")))
+  nil)

lib/git/tests/worktree.sx

@@ -0,0 +1,253 @@
+; Phase 4 — worktree: tree materialization (files-dict <-> tree objects),
+; index as staged-tree overlay, three-way status.
+
+(define gwt-db (persist/mem-backend))
+(define gwt (git/repo gwt-db))
+
+(define
+  gwt-files
+  (assoc
+    (assoc (assoc {} "a.txt" "hello\n") "b.txt" "world\n")
+    "sub/c.txt"
+    "sub\n"))
+
+(define gwt-tree (git/tree-from-files gwt gwt-files))
+(define gwt-c1 (git/write gwt (git/commit gwt-tree (list) {:message "c1"})))
+
+; fresh repo with the fixture committed, HEAD on main, index clean
+(define
+  gwt-fresh!
+  (fn
+    ()
+    (let
+      ((r (git/repo (persist/mem-backend))))
+      (let
+        ((tc (git/tree-from-files r gwt-files)))
+        (let
+          ((c (git/write r (git/commit tc (list) {:message "c1"}))))
+          (begin
+            (git/branch-set! r "main" c)
+            (git/head-set! r "main")
+            (git/index-init! r c)
+            r))))))
+
+(define gwt-clean {:untracked (list) :staged {:deleted (list) :modified (list) :added (list)} :unstaged {:deleted (list) :modified (list)}})
+
+; ---- tree building + materialization ----
+(git-test
+  "tree-from-files writes a tree object"
+  (git/tree? (git/read gwt gwt-tree))
+  true)
+(git-test
+  "tree-files round-trips the files dict"
+  (= (git/tree-files gwt gwt-tree) gwt-files)
+  true)
+(git-test
+  "tree-from-files is deterministic"
+  (equal? (git/tree-from-files gwt gwt-files) gwt-tree)
+  true)
+(git-test
+  "matches a manually built tree"
+  (equal?
+    (git/write
+      gwt
+      (git/tree
+        (assoc
+          (assoc
+            (assoc
+              {}
+              "a.txt"
+              (git/tree-entry "blob" (git/write-blob gwt "hello\n")))
+            "b.txt"
+            (git/tree-entry "blob" (git/write-blob gwt "world\n")))
+          "sub"
+          (git/tree-entry
+            "tree"
+            (git/write
+              gwt
+              (git/tree
+                (assoc
+                  {}
+                  "c.txt"
+                  (git/tree-entry "blob" (git/write-blob gwt "sub\n")))))))))
+    gwt-tree)
+  true)
+(git-test
+  "flatten lists nested paths"
+  (=
+    (artdag/sort-strings (keys (git/tree-flatten gwt gwt-tree)))
+    (list "a.txt" "b.txt" "sub/c.txt"))
+  true)
+(git-test
+  "flatten maps a path to its blob cid"
+  (get (git/tree-flatten gwt gwt-tree) "a.txt")
+  (git/cid (git/blob "hello\n")))
+(git-test
+  "commit-files materializes through the commit"
+  (= (git/commit-files gwt gwt-c1) gwt-files)
+  true)
+(git-test
+  "deep nesting round-trips"
+  (let
+    ((files (assoc {} "x/y/z.txt" "deep")))
+    (= (git/tree-files gwt (git/tree-from-files gwt files)) files))
+  true)
+(git-test
+  "empty files dict is an empty tree"
+  (= (git/tree-files gwt (git/tree-from-files gwt {})) {})
+  true)
+
+; ---- index ----
+(git-test
+  "default index is empty over no base"
+  (= (git/index-read (git/repo (persist/mem-backend))) {:base nil :staged {}})
+  true)
+(git-test
+  "index-init! bases the index on the commit tree"
+  (let ((r (gwt-fresh!))) (= (git/index-files r) gwt-files))
+  true)
+(git-test
+  "add! stages new content"
+  (let
+    ((r (gwt-fresh!)))
+    (begin
+      (git/add! r "new.txt" "fresh")
+      (get (git/index-files r) "new.txt")))
+  "fresh")
+(git-test
+  "add! overlays an existing path"
+  (let
+    ((r (gwt-fresh!)))
+    (begin (git/add! r "a.txt" "changed") (get (git/index-files r) "a.txt")))
+  "changed")
+(git-test
+  "rm! stages a removal"
+  (let
+    ((r (gwt-fresh!)))
+    (begin (git/rm! r "b.txt") (has-key? (git/index-files r) "b.txt")))
+  false)
+(git-test
+  "unstage! reverts to the base"
+  (let
+    ((r (gwt-fresh!)))
+    (begin
+      (git/add! r "a.txt" "changed")
+      (git/unstage! r "a.txt")
+      (get (git/index-files r) "a.txt")))
+  "hello\n")
+(git-test
+  "index-tree! of a clean index reproduces the commit tree cid"
+  (let
+    ((r (gwt-fresh!)))
+    (equal?
+      (git/index-tree! r)
+      (git/commit-tree (git/read r (git/head r)))))
+  true)
+(git-test
+  "index-tree! materializes staged changes"
+  (let
+    ((r (gwt-fresh!)))
+    (begin
+      (git/add! r "a.txt" "changed")
+      (git/rm! r "b.txt")
+      (=
+        (git/tree-files r (git/index-tree! r))
+        (assoc (assoc {} "a.txt" "changed") "sub/c.txt" "sub\n"))))
+  true)
+
+; ---- status ----
+(git-test
+  "clean repo, clean worktree"
+  (= (git/status (gwt-fresh!) gwt-files) gwt-clean)
+  true)
+(git-test
+  "staged addition"
+  (let
+    ((r (gwt-fresh!)))
+    (begin
+      (git/add! r "new.txt" "fresh")
+      (=
+        (get (get (git/status r gwt-files) :staged) :added)
+        (list "new.txt"))))
+  true)
+(git-test
+  "staged modification"
+  (let
+    ((r (gwt-fresh!)))
+    (begin
+      (git/add! r "a.txt" "changed")
+      (=
+        (get
+          (get (git/status r (assoc gwt-files "a.txt" "changed")) :staged)
+          :modified)
+        (list "a.txt"))))
+  true)
+(git-test
+  "staged deletion"
+  (let
+    ((r (gwt-fresh!)))
+    (begin
+      (git/rm! r "b.txt")
+      (=
+        (get
+          (get (git/status r (dissoc gwt-files "b.txt")) :staged)
+          :deleted)
+        (list "b.txt"))))
+  true)
+(git-test
+  "unstaged modification"
+  (let
+    ((r (gwt-fresh!)))
+    (=
+      (get
+        (get (git/status r (assoc gwt-files "a.txt" "edited")) :unstaged)
+        :modified)
+      (list "a.txt")))
+  true)
+(git-test
+  "unstaged deletion"
+  (let
+    ((r (gwt-fresh!)))
+    (=
+      (get
+        (get (git/status r (dissoc gwt-files "sub/c.txt")) :unstaged)
+        :deleted)
+      (list "sub/c.txt")))
+  true)
+(git-test
+  "untracked file"
+  (let
+    ((r (gwt-fresh!)))
+    (=
+      (get (git/status r (assoc gwt-files "notes.md" "hi")) :untracked)
+      (list "notes.md")))
+  true)
+(git-test
+  "combined status"
+  (let
+    ((r (gwt-fresh!)))
+    (begin
+      (git/add! r "staged.txt" "s")
+      (git/add! r "a.txt" "changed")
+      (git/rm! r "b.txt")
+      (=
+        (git/status
+          r
+          (assoc
+            (assoc
+              (assoc
+                (dissoc (dissoc gwt-files "b.txt") "sub/c.txt")
+                "a.txt"
+                "changed-again")
+              "staged.txt"
+              "s")
+            "wild.txt"
+            "w"))
+        {:untracked (list "wild.txt") :staged {:deleted (list "b.txt") :modified (list "a.txt") :added (list "staged.txt")} :unstaged {:deleted (list "sub/c.txt") :modified (list "a.txt")}})))
+  true)
+(git-test
+  "no HEAD, no index: everything untracked"
+  (let
+    ((r (git/repo (persist/mem-backend))))
+    (= (git/status r (assoc {} "f.txt" "x")) {:untracked (list "f.txt") :staged {:deleted (list) :modified (list) :added (list)} :unstaged {:deleted (list) :modified (list)}}))
+  true)

lib/git/worktree.sx

@@ -0,0 +1,234 @@
+; lib/git/worktree.sx — sx-git Phase 4: tree materialization, index, status.
+; The "worktree" is a VALUE: a dict of path -> file data (no filesystem).
+; The index is a staged-tree overlay {:base <tree-cid|nil> :staged
+; {path -> {:data d} | {:removed true}}} stored in kv at <prefix>/index.
+; status = three-way dict diff: HEAD tree vs index vs worktree.
+; Requires: lib/git/object.sx, lib/git/ref.sx.
+
+(define
+  git/wt-join
+  (fn
+    (segs)
+    (if
+      (empty? segs)
+      ""
+      (reduce (fn (acc s) (str acc "/" s)) (first segs) (rest segs)))))
+
+; ---- tree flattening: tree-cid -> dict path -> blob cid ----
+(define
+  git/wt-flatten-into
+  (fn
+    (repo tree-cid prefix acc)
+    (let
+      ((tree (git/read repo tree-cid)))
+      (reduce
+        (fn
+          (a name)
+          (let
+            ((e (git/tree-entry-for tree name)))
+            (let
+              ((path (if (equal? prefix "") name (str prefix "/" name))))
+              (if
+                (equal? (git/entry-kind e) "tree")
+                (git/wt-flatten-into repo (git/entry-cid e) path a)
+                (assoc a path (git/entry-cid e))))))
+        acc
+        (git/tree-names tree)))))
+
+(define
+  git/tree-flatten
+  (fn (repo tree-cid) (git/wt-flatten-into repo tree-cid "" {})))
+
+; ---- materialization: tree/commit -> dict path -> data ----
+(define
+  git/tree-files
+  (fn
+    (repo tree-cid)
+    (let
+      ((flat (git/tree-flatten repo tree-cid)))
+      (reduce
+        (fn
+          (a p)
+          (assoc a p (git/blob-data (git/read repo (get flat p)))))
+        {}
+        (keys flat)))))
+
+(define
+  git/commit-files
+  (fn
+    (repo commit-cid)
+    (git/tree-files repo (git/commit-tree (git/read repo commit-cid)))))
+
+; ---- inverse: dict path -> data => written tree, returns root tree cid ----
+(define
+  git/wt-group
+  (fn
+    (files)
+    (reduce
+      (fn
+        (acc path)
+        (let
+          ((segs (split path "/")))
+          (if
+            (= (len segs) 1)
+            (assoc
+              acc
+              :files (assoc (get acc :files) path (get files path)))
+            (let
+              ((dir (first segs)))
+              (let
+                ((cur (get (get acc :dirs) dir)))
+                (assoc
+                  acc
+                  :dirs (assoc
+                    (get acc :dirs)
+                    dir
+                    (assoc
+                      (if (dict? cur) cur {})
+                      (git/wt-join (rest segs))
+                      (get files path)))))))))
+      {:files {} :dirs {}}
+      (keys files))))
+
+(define
+  git/tree-from-files
+  (fn
+    (repo files)
+    (let
+      ((g (git/wt-group files)))
+      (let
+        ((with-blobs (reduce (fn (acc name) (assoc acc name (git/tree-entry "blob" (git/write-blob repo (get (get g :files) name))))) {} (keys (get g :files)))))
+        (let
+          ((entries (reduce (fn (acc dir) (assoc acc dir (git/tree-entry "tree" (git/tree-from-files repo (get (get g :dirs) dir))))) with-blobs (keys (get g :dirs)))))
+          (git/write repo (git/tree entries)))))))
+
+; ---- index: staged overlay over a base tree ----
+(define git/index-key (fn (repo) (str (get repo :prefix) "/index")))
+
+(define
+  git/index-read
+  (fn
+    (repo)
+    (let
+      ((v (persist/kv-get (get repo :db) (git/index-key repo))))
+      (if (dict? v) v {:base nil :staged {}}))))
+
+(define
+  git/index-write!
+  (fn
+    (repo idx)
+    (begin (persist/kv-put (get repo :db) (git/index-key repo) idx) idx)))
+
+; reset the index to a commit's tree (nil commit = empty index)
+(define
+  git/index-init!
+  (fn (repo commit-cid) (git/index-write! repo {:base (if (equal? commit-cid nil) nil (git/commit-tree (git/read repo commit-cid))) :staged {}})))
+
+(define
+  git/wt-stage!
+  (fn
+    (repo path entry)
+    (let
+      ((idx (git/index-read repo)))
+      (git/index-write!
+        repo
+        (assoc idx :staged (assoc (get idx :staged) path entry))))))
+
+(define git/add! (fn (repo path data) (git/wt-stage! repo path {:data data})))
+(define git/rm! (fn (repo path) (git/wt-stage! repo path {:removed true})))
+
+(define
+  git/unstage!
+  (fn
+    (repo path)
+    (let
+      ((idx (git/index-read repo)))
+      (git/index-write!
+        repo
+        (assoc idx :staged (dissoc (get idx :staged) path))))))
+
+; apply the overlay: base entries -> overridden/removed by staged
+(define
+  git/wt-overlay
+  (fn
+    (base staged entry-fn)
+    (reduce
+      (fn
+        (acc path)
+        (let
+          ((s (get staged path)))
+          (if
+            (has-key? s :removed)
+            (dissoc acc path)
+            (assoc acc path (entry-fn s)))))
+      base
+      (keys staged))))
+
+; effective index as path -> blob cid
+(define
+  git/index-cids
+  (fn
+    (repo)
+    (let
+      ((idx (git/index-read repo)))
+      (git/wt-overlay
+        (if
+          (equal? (get idx :base) nil)
+          {}
+          (git/tree-flatten repo (get idx :base)))
+        (get idx :staged)
+        (fn (s) (git/cid (git/blob (get s :data))))))))
+
+; effective index as path -> data
+(define
+  git/index-files
+  (fn
+    (repo)
+    (let
+      ((idx (git/index-read repo)))
+      (git/wt-overlay
+        (if
+          (equal? (get idx :base) nil)
+          {}
+          (git/tree-files repo (get idx :base)))
+        (get idx :staged)
+        (fn (s) (get s :data))))))
+
+; write the staged state as a real tree; returns the root tree cid
+(define
+  git/index-tree!
+  (fn (repo) (git/tree-from-files repo (git/index-files repo))))
+
+; ---- status ----
+(define
+  git/files-cids
+  (fn
+    (files)
+    (reduce
+      (fn (acc p) (assoc acc p (git/cid (git/blob (get files p)))))
+      {}
+      (keys files))))
+
+(define git/files-diff (fn (old new) {:deleted (artdag/sort-strings (filter (fn (p) (not (has-key? new p))) (keys old))) :modified (artdag/sort-strings (filter (fn (p) (and (has-key? old p) (not (equal? (get old p) (get new p))))) (keys new))) :added (artdag/sort-strings (filter (fn (p) (not (has-key? old p))) (keys new)))}))
+
+(define
+  git/head-tree-cids
+  (fn
+    (repo)
+    (let
+      ((h (git/head repo)))
+      (if
+        (equal? h nil)
+        {}
+        (git/tree-flatten repo (git/commit-tree (git/read repo h)))))))
+
+; worktree-files: dict path -> data (the caller's working copy value)
+(define
+  git/status
+  (fn
+    (repo worktree-files)
+    (let
+      ((headc (git/head-tree-cids repo))
+        (idxc (git/index-cids repo))
+        (wtc (git/files-cids worktree-files)))
+      (let ((unstaged (git/files-diff idxc wtc))) {:untracked (get unstaged :added) :staged (git/files-diff headc idxc) :unstaged {:deleted (get unstaged :deleted) :modified (get unstaged :modified)}}))))

lib/gitea/README.md

@@ -0,0 +1,61 @@
+# sx-gitea — a federated git forge in plain SX
+
+A git forge built by **composing the x-on-sx subsystems**: every phase
+wires one more substrate onto the forge. No third-party dependencies —
+the whole stack is SX on the OCaml kernel.
+
+Run the suite: `bash lib/gitea/conformance.sh` (per-suite scores in
+`scoreboard.md`). Suites are independent `sx_server` sessions; heavyweight
+substrates (Smalltalk/content, Scheme/flow, APL/feed, Haskell/search) load
+only for the suites that need them.
+
+## Composition map
+
+| Phase | Module | Built on |
+|-------|--------|----------|
+| 1 repo | `repo.sx` | **sx-git** (`lib/git`, native-CID object store), persist kv |
+| 2 access | `access.sx` | **acl** (datalog): repo role groups, collaborators, org teams; bearer tokens |
+| 3 wire | `wire.sx` | git-style smart HTTP: pkt-line framing, upload/receive-pack, CID-verified packs; client (`clone!`/`fetch!`/`push!`) drives any dream app fn |
+| 4 issues | `issues.sx` | **content** (Smalltalk): Markdown bodies as block documents; **relations** (datalog): derived issue graph |
+| 5 pr | `pr.sx` | **sx-git** merge-base diffs + 3-way merge; **flow** (Scheme): durable open→approval→merge lifecycle; merge queue |
+| 6 activity | `activity.sx` | **feed** (APL): timelines/dashboard; **events** (flow): durable at-least-once notifications |
+| 7 search | `search.sx` | **search** (Haskell): tf-idf ranked code/issue/PR search, batched evaluations |
+| 8 fed | `fed.sx` | ForgeFed: AP actors, trust-gated inbox with provenance + materialized federated issues/PRs, mirrors over the wire client, cursor-based delivery |
+| web | `web.sx` | **dream**: routes, auth gating (401/403/404-hides-private), route-pack registry |
+
+## Architectural rules of thumb
+
+- **The kv store is the source of truth.** Owners, repo records, issues,
+  PRs, collaborators, teams, tokens, follows, trust, mirrors — all plain
+  dicts under `gitea/...` keys on one persist backend per forge.
+  Deleting a repo is a prefix purge (no ghost state on recreate).
+- **Derived, not maintained.** The acl database and the relations graph
+  are *derived* from kv state and rebuilt when the derived facts change
+  (cached in the forge handle) — deletions can never dangle.
+- **Instrument in the runtime.** Activity logging wraps the mutation
+  verbs by redefinition (`gitea/base-*!` + wrapper), so every caller
+  emits activity with zero call-site edits.
+- **Everything is testable without sockets.** A forge is a value over a
+  `persist/mem-backend`; `gitea/app` is a pure request→response fn; the
+  wire client federates two in-memory forges directly.
+- **Trust is re-checked, never cached.** Federation operations
+  (inbox, mirror sync, delivery) consult the trust set at use time.
+
+## Per-repo git stores
+
+Each repo's objects/refs live in their own `git/repo-named` namespace
+`forge/<owner>/<name>` — identical content still shares CIDs, but repos
+cannot see each other's objects. All ref moves go through `ref-cas!`;
+concurrent pushes surface as `stale`/`non-fast-forward` per-ref statuses.
+
+## Known limits (deliberate, documented)
+
+- Wire packs carry one object per pkt line (~64KB); side-band chunking
+  is a future extension (`gitea/pkt-fits?` reports it). SHA-1/packfile
+  byte compat for stock git clients lives in `lib/git/{export,import}.sx`
+  and is not yet wired into the HTTP endpoints.
+- Inbox activities are trust-gated but not signature-verified.
+- Reopening a PR restarts its lifecycle flow (a cancelled flow cannot
+  resume); reviews survive.
+- Issue web close/reopen does not emit activity (no actor at the core
+  call sites for `issue-close!`).

lib/gitea/access.sx

@@ -0,0 +1,403 @@
+; lib/gitea/access.sx — sx-gitea Phase 2: permissions over lib/acl.
+;
+; Model: each repo exposes three role groups ("read:"/"write:"/"admin:" +
+; "repo:<owner>/<name>") with hierarchical action grants (admin > write >
+; read). A user-owner is a member of the admin group. Collaborators join
+; the group for their role. Org repos add team groups: a team has a role
+; and a repo scope ("all" or a name list); team members join the team
+; group, the team group joins the covered repos' role groups. Facts are
+; derived from forge state and saturated by the acl datalog engine —
+; deny-wins and group nesting come for free.
+;
+; Public visibility is an engine short-circuit: "read" on a public repo is
+; always permitted, even anonymously (subject nil never reaches acl).
+;
+; Auth is bearer tokens in the kv store — Phase 8 federates identity.
+;
+; Requires: lib/gitea/repo.sx, lib/datalog/* stack,
+; lib/acl/{schema,facts,engine}.sx
+
+(define gitea/roles (list "read" "write" "admin"))
+(define gitea/role-valid? (fn (r) (contains? gitea/roles r)))
+
+; actions implied by holding a role on a repo
+(define
+  gitea/role-actions
+  (fn
+    (role)
+    (cond
+      ((equal? role "read") (list "read"))
+      ((equal? role "write") (list "read" "write"))
+      ((equal? role "admin") (list "read" "write" "admin"))
+      (else (list)))))
+
+(define gitea/repo-res (fn (owner name) (str "repo:" owner "/" name)))
+(define gitea/role-group (fn (res role) (str role ":" res)))
+(define gitea/team-id (fn (org team) (str "team:" org "/" team)))
+
+(define
+  gitea/split-full
+  (fn (full) (let ((i (index-of full "/"))) {:name (substr full (+ i 1)) :owner (substr full 0 i)})))
+
+; ── collaborators ────────────────────────────────────────────────────
+
+(define
+  gitea/collab-key
+  (fn (owner name user) (str "gitea/collab/" owner "/" name "/" user)))
+
+; upsert: adding an existing collaborator changes their role
+(define
+  gitea/collab-add!
+  (fn
+    (forge owner name user role)
+    (cond
+      ((not (gitea/repo-exists? forge owner name)) {:error "no-such-repo"})
+      ((not (gitea/owner-exists? forge user)) {:error "no-such-user"})
+      ((not (gitea/role-valid? role)) {:error "invalid-role"})
+      (else
+        (persist/kv-put
+          (gitea/forge-db forge)
+          (gitea/collab-key owner name user)
+          {:role role :user user})))))
+
+(define
+  gitea/collab-get
+  (fn
+    (forge owner name user)
+    (persist/kv-get
+      (gitea/forge-db forge)
+      (gitea/collab-key owner name user))))
+
+(define
+  gitea/collab-role
+  (fn
+    (forge owner name user)
+    (get (or (gitea/collab-get forge owner name user) {}) :role)))
+
+(define
+  gitea/collab-remove!
+  (fn
+    (forge owner name user)
+    (if
+      (nil? (gitea/collab-get forge owner name user))
+      false
+      (begin
+        (persist/kv-delete
+          (gitea/forge-db forge)
+          (gitea/collab-key owner name user))
+        true))))
+
+(define
+  gitea/collabs
+  (fn
+    (forge owner name)
+    (gitea/names-under forge (str "gitea/collab/" owner "/" name "/"))))
+
+; ── teams ────────────────────────────────────────────────────────────
+; A team belongs to an org, carries ONE role, and covers either every org
+; repo (:repos "all") or an explicit list of repo names.
+
+(define gitea/team-key (fn (org team) (str "gitea/team/" org "/" team)))
+(define
+  gitea/teammem-key
+  (fn (org team user) (str "gitea/teammem/" org "/" team "/" user)))
+
+(define
+  gitea/team-create!
+  (fn
+    (forge org team role)
+    (let
+      ((orec (gitea/owner-get forge org)))
+      (cond
+        ((or (nil? orec) (not (gitea/org? orec))) {:error "no-such-org"})
+        ((not (gitea/valid-name? team)) {:error "invalid-name"})
+        ((not (gitea/role-valid? role)) {:error "invalid-role"})
+        (else
+          (persist/kv-put-new
+            (gitea/forge-db forge)
+            (gitea/team-key org team)
+            {:name team :org org :repos "all" :role role}))))))
+
+(define
+  gitea/team-get
+  (fn
+    (forge org team)
+    (persist/kv-get (gitea/forge-db forge) (gitea/team-key org team))))
+
+(define
+  gitea/teams
+  (fn (forge org) (gitea/names-under forge (str "gitea/team/" org "/"))))
+
+(define
+  gitea/team-set-repos!
+  (fn
+    (forge org team repos)
+    (let
+      ((rec (gitea/team-get forge org team)))
+      (if
+        (nil? rec)
+        nil
+        (persist/kv-put
+          (gitea/forge-db forge)
+          (gitea/team-key org team)
+          (assoc rec :repos repos))))))
+
+(define
+  gitea/team-add-member!
+  (fn
+    (forge org team user)
+    (cond
+      ((nil? (gitea/team-get forge org team)) {:error "no-such-team"})
+      ((not (gitea/owner-exists? forge user)) {:error "no-such-user"})
+      (else
+        (persist/kv-put
+          (gitea/forge-db forge)
+          (gitea/teammem-key org team user)
+          {:user user})))))
+
+(define
+  gitea/team-remove-member!
+  (fn
+    (forge org team user)
+    (let
+      ((k (gitea/teammem-key org team user)))
+      (if
+        (persist/kv-has? (gitea/forge-db forge) k)
+        (begin (persist/kv-delete (gitea/forge-db forge) k) true)
+        false))))
+
+(define
+  gitea/team-members
+  (fn
+    (forge org team)
+    (gitea/names-under forge (str "gitea/teammem/" org "/" team "/"))))
+
+(define
+  gitea/team-delete!
+  (fn
+    (forge org team)
+    (if
+      (nil? (gitea/team-get forge org team))
+      false
+      (let
+        ((db (gitea/forge-db forge)))
+        (begin
+          (for-each
+            (fn (u) (persist/kv-delete db (gitea/teammem-key org team u)))
+            (gitea/team-members forge org team))
+          (persist/kv-delete db (gitea/team-key org team))
+          true)))))
+
+(define
+  gitea/team-covers?
+  (fn
+    (trec name)
+    (let
+      ((repos (get trec :repos)))
+      (or (equal? repos "all") (and (list? repos) (contains? repos name))))))
+
+; org admin = member of an admin-role team that covers every repo
+(define
+  gitea/org-admin?
+  (fn
+    (forge org user)
+    (reduce
+      (fn
+        (acc tname)
+        (or
+          acc
+          (let
+            ((trec (gitea/team-get forge org tname)))
+            (and
+              (equal? (get trec :role) "admin")
+              (equal? (get trec :repos) "all")
+              (contains? (gitea/team-members forge org tname) user)))))
+      false
+      (gitea/teams forge org))))
+
+; ── acl fact derivation ──────────────────────────────────────────────
+
+(define
+  gitea/access-facts
+  (fn
+    (forge)
+    (let
+      ((facts (list)))
+      (begin
+        (for-each
+          (fn
+            (full)
+            (let
+              ((p (gitea/split-full full)))
+              (let
+                ((owner (get p :owner)) (name (get p :name)))
+                (let
+                  ((res (gitea/repo-res owner name))
+                    (orec (gitea/owner-get forge owner)))
+                  (begin
+                    (for-each
+                      (fn
+                        (role)
+                        (for-each
+                          (fn
+                            (act)
+                            (append!
+                              facts
+                              (acl-grant (gitea/role-group res role) act res)))
+                          (gitea/role-actions role)))
+                      gitea/roles)
+                    (if
+                      (and orec (gitea/user? orec))
+                      (append!
+                        facts
+                        (acl-member-of owner (gitea/role-group res "admin")))
+                      nil)
+                    (for-each
+                      (fn
+                        (user)
+                        (append!
+                          facts
+                          (acl-member-of
+                            user
+                            (gitea/role-group
+                              res
+                              (gitea/collab-role forge owner name user)))))
+                      (gitea/collabs forge owner name))
+                    (if
+                      (and orec (gitea/org? orec))
+                      (for-each
+                        (fn
+                          (tname)
+                          (let
+                            ((trec (gitea/team-get forge owner tname)))
+                            (if
+                              (gitea/team-covers? trec name)
+                              (append!
+                                facts
+                                (acl-member-of
+                                  (gitea/team-id owner tname)
+                                  (gitea/role-group res (get trec :role))))
+                              nil)))
+                        (gitea/teams forge owner))
+                      nil))))))
+          (gitea/repos forge))
+        (for-each
+          (fn
+            (owner)
+            (let
+              ((orec (gitea/owner-get forge owner)))
+              (if
+                (and orec (gitea/org? orec))
+                (for-each
+                  (fn
+                    (tname)
+                    (for-each
+                      (fn
+                        (user)
+                        (append!
+                          facts
+                          (acl-member-of user (gitea/team-id owner tname))))
+                      (gitea/team-members forge owner tname)))
+                  (gitea/teams forge owner))
+                nil)))
+          (gitea/owners forge))
+        facts))))
+
+; rebuild the acl db only when derived facts changed (cache in the forge
+; handle; forges created before the :cache field just rebuild every call)
+(define
+  gitea/access-db
+  (fn
+    (forge)
+    (let
+      ((facts (gitea/access-facts forge)) (cache (get forge :cache)))
+      (if
+        (and cache (= (get cache "facts") facts) (get cache "db"))
+        (get cache "db")
+        (let
+          ((db (acl-build-db facts)))
+          (begin
+            (if
+              cache
+              (begin
+                (dict-set! cache "facts" facts)
+                (dict-set! cache "db" db))
+              nil)
+            db))))))
+
+; ── the permission question ──────────────────────────────────────────
+
+(define
+  gitea/can?
+  (fn
+    (forge subj action owner name)
+    (let
+      ((rec (gitea/repo-get forge owner name)))
+      (cond
+        ((nil? rec) false)
+        ((and (equal? action "read") (equal? (get rec :visibility) "public"))
+          true)
+        ((nil? subj) false)
+        (else
+          (acl-permit?
+            (gitea/access-db forge)
+            subj
+            action
+            (gitea/repo-res owner name)))))))
+
+(define
+  gitea/visible-repos
+  (fn
+    (forge subj)
+    (filter
+      (fn
+        (full)
+        (let
+          ((p (gitea/split-full full)))
+          (gitea/can? forge subj "read" (get p :owner) (get p :name))))
+      (gitea/repos forge))))
+
+; who may create a repo under this owner?
+(define
+  gitea/create-allowed?
+  (fn
+    (forge user owner)
+    (let
+      ((orec (gitea/owner-get forge owner)))
+      (cond
+        ((nil? user) false)
+        ((nil? orec) false)
+        ((gitea/user? orec) (equal? user owner))
+        (else (gitea/org-admin? forge owner user))))))
+
+; ── bearer tokens ────────────────────────────────────────────────────
+
+(define gitea/token-key (fn (token) (str "gitea/token/" token)))
+
+(define
+  gitea/token-create!
+  (fn
+    (forge user token)
+    (if
+      (not (gitea/owner-exists? forge user))
+      {:error "no-such-user"}
+      (persist/kv-put
+        (gitea/forge-db forge)
+        (gitea/token-key token)
+        {:user user}))))
+
+(define
+  gitea/token-user
+  (fn
+    (forge token)
+    (get
+      (or
+        (persist/kv-get (gitea/forge-db forge) (gitea/token-key token))
+        {})
+      :user)))
+
+(define
+  gitea/token-revoke!
+  (fn
+    (forge token)
+    (persist/kv-delete (gitea/forge-db forge) (gitea/token-key token))))

lib/gitea/activity.sx

@@ -0,0 +1,579 @@
+; lib/gitea/activity.sx — sx-gitea Phase 6: activity, dashboard, notify.
+;
+; Every noteworthy forge action lands as a feed activity ({:actor :verb
+; :object :at :tags}) in an append-only persist log stream on the forge
+; backend. Instrumentation wraps the existing mutation verbs IN the
+; runtime (repo-create!/issue-create!/issue-comment!/pr-create!/
+; pr-review!/pr-merge! are redefined around their originals), so SX
+; callers and web handlers alike emit activity with zero call-site edits.
+;
+; Timelines are lib/feed queries over that stream (APL-backed filter/
+; rank/take); visibility follows repo access — an activity tagged with a
+; private repo is invisible to non-readers. The dashboard shows what a
+; user follows (users or repos), minus their own actions.
+;
+; Notifications ride lib/events' durable delivery flows: pending
+; activities after a cursor expand to (id recipient body) messages,
+; ev/deliver-messages runs them through the at-least-once digest flow
+; (idempotent by message id), and delivered messages land in per-user kv
+; inboxes; the cursor then advances, so a re-run delivers nothing twice.
+;
+; Requires: lib/gitea/{repo,access,web,issues,pr}.sx and their stacks,
+; lib/apl/runtime.sx + lib/feed/{normalize,stream,api,fanout,dedupe,
+; aggregate,rank,acl,mute,page,notify,home,fed}.sx, and
+; lib/events/notify.sx over the flow stack.
+
+; ── the activity log ─────────────────────────────────────────────────
+
+(define gitea/activity-stream-name "gitea/activity")
+
+(define
+  gitea/act!
+  (fn
+    (forge actor verb object tags at)
+    (persist/append
+      (gitea/forge-db forge)
+      gitea/activity-stream-name
+      verb
+      at
+      (feed/activity actor verb object at tags))))
+
+(define
+  gitea/activity-events
+  (fn
+    (forge)
+    (persist/read (gitea/forge-db forge) gitea/activity-stream-name)))
+
+(define
+  gitea/activity-stream
+  (fn
+    (forge)
+    (feed/stream (map persist/event-data (gitea/activity-events forge)))))
+
+(define
+  gitea/activity-count
+  (fn
+    (forge)
+    (persist/last-seq (gitea/forge-db forge) gitea/activity-stream-name)))
+
+; ── node helpers ─────────────────────────────────────────────────────
+
+(define gitea/pr-node (fn (owner name n) (str "pr:" owner "/" name "#" n)))
+
+; "issue:alice/proj#3" / "pr:alice/proj#3" => {:owner :name :n} | nil
+(define
+  gitea/parse-numbered-node
+  (fn
+    (node)
+    (let
+      ((colon (index-of node ":")) (hash (index-of node "#")))
+      (if
+        (or (< colon 0) (< hash 0))
+        nil
+        (let
+          ((p (gitea/split-full (substr node (+ colon 1) (- hash colon 1)))))
+          {:name (get p :name) :n (parse-int (substr node (+ hash 1))) :owner (get p :owner)})))))
+
+; the repo an activity belongs to, via its tags
+(define
+  gitea/act-repo
+  (fn
+    (a)
+    (first (filter (fn (t) (starts-with? t "repo:")) (get a :tags)))))
+
+(define
+  gitea/act-visible?
+  (fn
+    (forge user a)
+    (let
+      ((r (gitea/act-repo a)))
+      (if
+        (nil? r)
+        true
+        (let
+          ((p (gitea/split-full (substr r 5))))
+          (gitea/can? forge user "read" (get p :owner) (get p :name)))))))
+
+; ── instrumentation: wrap the mutation verbs ─────────────────────────
+
+(define gitea/base-repo-create! gitea/repo-create!)
+(define
+  gitea/repo-create!
+  (fn
+    (forge owner name opts)
+    (let
+      ((res (gitea/base-repo-create! forge owner name opts)))
+      (begin
+        (if
+          (or (get res :error) (get res :conflict))
+          nil
+          (gitea/act!
+            forge
+            owner
+            "create-repo"
+            (gitea/repo-node owner name)
+            (list (gitea/repo-node owner name))
+            (get res :created-at)))
+        res))))
+
+(define gitea/base-issue-create! gitea/issue-create!)
+(define
+  gitea/issue-create!
+  (fn
+    (forge owner name author title body opts)
+    (let
+      ((res (gitea/base-issue-create! forge owner name author title body opts)))
+      (begin
+        (if
+          (get res :error)
+          nil
+          (gitea/act!
+            forge
+            author
+            "open-issue"
+            (gitea/issue-node owner name (get res :number))
+            (list (gitea/repo-node owner name))
+            (get res :created-at)))
+        res))))
+
+(define gitea/base-issue-comment! gitea/issue-comment!)
+(define
+  gitea/issue-comment!
+  (fn
+    (forge owner name n author body opts)
+    (let
+      ((res (gitea/base-issue-comment! forge owner name n author body opts)))
+      (begin
+        (if
+          (get res :error)
+          nil
+          (gitea/act!
+            forge
+            author
+            "comment"
+            (gitea/issue-node owner name n)
+            (list (gitea/repo-node owner name))
+            (get res :at)))
+        res))))
+
+(define gitea/base-pr-create! gitea/pr-create!)
+(define
+  gitea/pr-create!
+  (fn
+    (forge owner name author title source target body opts)
+    (let
+      ((res (gitea/base-pr-create! forge owner name author title source target body opts)))
+      (begin
+        (if
+          (get res :error)
+          nil
+          (gitea/act!
+            forge
+            author
+            "open-pr"
+            (gitea/pr-node owner name (get res :number))
+            (list (gitea/repo-node owner name))
+            (get res :created-at)))
+        res))))
+
+(define gitea/base-pr-review! gitea/pr-review!)
+(define
+  gitea/pr-review!
+  (fn
+    (forge owner name n reviewer verdict body opts)
+    (let
+      ((res (gitea/base-pr-review! forge owner name n reviewer verdict body opts)))
+      (begin
+        (if
+          (get res :error)
+          nil
+          (gitea/act!
+            forge
+            reviewer
+            "review"
+            (gitea/pr-node owner name n)
+            (list (gitea/repo-node owner name))
+            (get res :at)))
+        res))))
+
+(define gitea/base-pr-merge! gitea/pr-merge!)
+(define
+  gitea/pr-merge!
+  (fn
+    (forge owner name n merger opts)
+    (let
+      ((res (gitea/base-pr-merge! forge owner name n merger opts)))
+      (begin
+        (if
+          (get res :error)
+          nil
+          (gitea/act!
+            forge
+            merger
+            "merge-pr"
+            (gitea/pr-node owner name n)
+            (list (gitea/repo-node owner name))
+            (or (get (or opts {}) :time) 0)))
+        res))))
+
+; ── timelines ────────────────────────────────────────────────────────
+
+(define
+  gitea/timeline
+  (fn
+    (forge user n)
+    (feed/items
+      (feed/take
+        (feed/recent
+          (feed/filter
+            (gitea/activity-stream forge)
+            (fn (a) (gitea/act-visible? forge user a))))
+        n))))
+
+(define
+  gitea/repo-timeline
+  (fn
+    (forge owner name n)
+    (let
+      ((node (gitea/repo-node owner name)))
+      (feed/items
+        (feed/take
+          (feed/recent
+            (feed/filter
+              (gitea/activity-stream forge)
+              (fn (a) (contains? (get a :tags) node))))
+          n)))))
+
+(define
+  gitea/user-timeline
+  (fn
+    (forge viewer user n)
+    (feed/items
+      (feed/take
+        (feed/recent
+          (feed/filter
+            (feed/by-actor (gitea/activity-stream forge) user)
+            (fn (a) (gitea/act-visible? forge viewer a))))
+        n))))
+
+; ── follows + dashboard ──────────────────────────────────────────────
+
+(define
+  gitea/follow-key
+  (fn (user target) (str "gitea/follow/" user "/" target)))
+
+(define
+  gitea/follow-target-valid?
+  (fn
+    (forge target)
+    (cond
+      ((not (string? target)) false)
+      ((starts-with? target "user:")
+        (gitea/owner-exists? forge (substr target 5)))
+      ((starts-with? target "repo:")
+        (let
+          ((p (gitea/split-full (substr target 5))))
+          (gitea/repo-exists? forge (get p :owner) (get p :name))))
+      (else false))))
+
+(define
+  gitea/follow!
+  (fn
+    (forge user target)
+    (cond
+      ((not (gitea/owner-exists? forge user)) {:error "no-such-user"})
+      ((not (gitea/follow-target-valid? forge target)) {:error "no-such-target"})
+      (else
+        (persist/kv-put
+          (gitea/forge-db forge)
+          (gitea/follow-key user target)
+          {:target target})))))
+
+(define
+  gitea/unfollow!
+  (fn
+    (forge user target)
+    (let
+      ((k (gitea/follow-key user target)))
+      (if
+        (persist/kv-has? (gitea/forge-db forge) k)
+        (begin (persist/kv-delete (gitea/forge-db forge) k) true)
+        false))))
+
+(define
+  gitea/follows
+  (fn (forge user) (gitea/names-under forge (str "gitea/follow/" user "/"))))
+
+; what the people/repos a user follows have been doing (own actions
+; excluded, private repos only where the VIEWER can read)
+(define
+  gitea/dashboard
+  (fn
+    (forge user n)
+    (let
+      ((follows (gitea/follows forge user)))
+      (feed/items
+        (feed/take
+          (feed/recent
+            (feed/filter
+              (gitea/activity-stream forge)
+              (fn
+                (a)
+                (and
+                  (not (= (get a :actor) user))
+                  (gitea/act-visible? forge user a)
+                  (or
+                    (contains? follows (str "user:" (get a :actor)))
+                    (let
+                      ((r (gitea/act-repo a)))
+                      (and (not (nil? r)) (contains? follows r))))))))
+          n)))))
+
+; ── notifications over lib/events durable delivery ───────────────────
+
+; who should hear about an activity (never its own actor)
+(define
+  gitea/notify-recipients
+  (fn
+    (forge a)
+    (let
+      ((verb (get a :verb))
+        (node (gitea/parse-numbered-node (or (get a :object) ""))))
+      (let
+        ((raw (cond ((nil? node) (list)) ((= verb "comment") (let ((rec (gitea/issue-get forge (get node :owner) (get node :name) (get node :n)))) (if (nil? rec) (list) (concat (list (get rec :author)) (concat (get rec :assignees) (map (fn (c) (get c :author)) (get rec :comments))))))) ((= verb "open-issue") (let ((rec (gitea/issue-get forge (get node :owner) (get node :name) (get node :n)))) (if (nil? rec) (list) (get rec :assignees)))) ((or (= verb "review") (= verb "merge-pr")) (let ((rec (gitea/pr-get forge (get node :owner) (get node :name) (get node :n)))) (if (nil? rec) (list) (list (get rec :author))))) (else (list)))))
+        (artdag/sort-strings
+          (relations-dedup
+            (filter
+              (fn
+                (u)
+                (and
+                  (not (= u (get a :actor)))
+                  (gitea/owner-exists? forge u)))
+              raw)))))))
+
+(define gitea/notify-cursor-key "gitea/notify-cursor")
+
+(define
+  gitea/notify-body
+  (fn (a) (str (get a :actor) " " (get a :verb) " " (get a :object))))
+
+; messages for every activity after the cursor: (id recipient body),
+; id = <pad8 seq>:<recipient> so inbox keys sort chronologically
+(define
+  gitea/pending-notifications
+  (fn
+    (forge)
+    (let
+      ((db (gitea/forge-db forge)))
+      (let
+        ((cursor (persist/kv-get-or db gitea/notify-cursor-key 0)))
+        (let
+          ((events (persist/read-from db gitea/activity-stream-name (+ cursor 1))))
+          {:messages (reduce (fn (acc e) (let ((a (persist/event-data e))) (concat acc (map (fn (u) (list (str (gitea/pad8 (persist/event-seq e)) ":" u) u (gitea/notify-body a))) (gitea/notify-recipients forge a))))) (list) events) :last-seq (reduce (fn (acc e) (persist/event-seq e)) cursor events)})))))
+
+(define gitea/inbox-key (fn (user id) (str "gitea/inbox/" user "/" id)))
+
+; deliver pending notifications through the durable digest flow and file
+; the delivered ones into per-user inboxes; the cursor advance makes a
+; re-run a no-op. => (("delivered"|"failed" id n-or-reason) ...)
+(define
+  gitea/notify!
+  (fn
+    (forge)
+    (let
+      ((p (gitea/pending-notifications forge)))
+      (let
+        ((msgs (get p :messages)))
+        (let
+          ((by-id (reduce (fn (acc m) (assoc acc (first m) m)) {} msgs)))
+          (let
+            ((outcomes (if (empty? msgs) (list) (ev/deliver-messages msgs ev-notify-ok-transport 3 500))))
+            (begin
+              (for-each
+                (fn
+                  (o)
+                  (if
+                    (= (first o) "delivered")
+                    (let
+                      ((m (get by-id (nth o 1))))
+                      (if
+                        (nil? m)
+                        nil
+                        (persist/kv-put
+                          (gitea/forge-db forge)
+                          (gitea/inbox-key (nth m 1) (first m))
+                          {:id (first m) :body (nth m 2)})))
+                    nil))
+                outcomes)
+              (persist/kv-put
+                (gitea/forge-db forge)
+                gitea/notify-cursor-key
+                (get p :last-seq))
+              outcomes)))))))
+
+(define
+  gitea/inbox
+  (fn
+    (forge user)
+    (map
+      (fn
+        (id)
+        (persist/kv-get (gitea/forge-db forge) (gitea/inbox-key user id)))
+      (gitea/names-under forge (str "gitea/inbox/" user "/")))))
+
+(define gitea/inbox-count (fn (forge user) (len (gitea/inbox forge user))))
+
+; ── web ──────────────────────────────────────────────────────────────
+
+(define
+  gitea/w-act-item
+  (fn
+    (a)
+    (str
+      "<li class=\""
+      (get a :verb)
+      "\">"
+      (dream-escape (get a :actor))
+      " "
+      (get a :verb)
+      " "
+      (dream-escape (or (get a :object) ""))
+      "</li>")))
+
+(define
+  gitea/w-activity-page
+  (fn
+    (forge req)
+    (gitea/w-page
+      "activity"
+      (str
+        "<h1>Activity</h1><ul>"
+        (join
+          ""
+          (map
+            gitea/w-act-item
+            (gitea/timeline forge (gitea/w-user forge req) 50)))
+        "</ul>"))))
+
+(define
+  gitea/w-repo-activity-page
+  (fn
+    (forge req)
+    (let
+      ((owner (dream-param req "owner")) (name (dream-param req "name")))
+      (if
+        (not (gitea/w-readable? forge req owner name))
+        (dream-not-found)
+        (gitea/w-page
+          (str owner "/" name " activity")
+          (str
+            "<h1>Activity</h1><ul>"
+            (join
+              ""
+              (map
+                gitea/w-act-item
+                (gitea/repo-timeline forge owner name 50)))
+            "</ul>"))))))
+
+(define
+  gitea/w-api-user-activity
+  (fn
+    (forge req)
+    (let
+      ((user (dream-param req "user")))
+      (if
+        (not (gitea/owner-exists? forge user))
+        (dream-not-found)
+        (dream-json-value
+          (gitea/user-timeline forge (gitea/w-user forge req) user 50))))))
+
+(define
+  gitea/w-api-dashboard
+  (fn
+    (forge req)
+    (let
+      ((user (gitea/w-user forge req)))
+      (if
+        (nil? user)
+        (gitea/w-unauthorized)
+        (dream-json-value (gitea/dashboard forge user 50))))))
+
+(define
+  gitea/w-api-follow
+  (fn
+    (forge req)
+    (let
+      ((user (gitea/w-user forge req)))
+      (if
+        (nil? user)
+        (gitea/w-unauthorized)
+        (let
+          ((res (gitea/follow! forge user (get (dream-json-body req) :target))))
+          (if
+            (get res :error)
+            (gitea/w-json-status 400 {:error (get res :error)})
+            (dream-json-value (gitea/follows forge user))))))))
+
+(define
+  gitea/w-api-unfollow
+  (fn
+    (forge req)
+    (let
+      ((user (gitea/w-user forge req)))
+      (if
+        (nil? user)
+        (gitea/w-unauthorized)
+        (if
+          (gitea/unfollow! forge user (or (dream-param req "**") ""))
+          (dream-json-value (gitea/follows forge user))
+          (dream-not-found))))))
+
+(define
+  gitea/w-api-notifications
+  (fn
+    (forge req)
+    (let
+      ((user (gitea/w-user forge req)))
+      (if
+        (nil? user)
+        (gitea/w-unauthorized)
+        (dream-json-value
+          (map (fn (r) (get r :body)) (gitea/inbox forge user)))))))
+
+(define
+  gitea/w-api-notify-run
+  (fn
+    (forge req)
+    (let
+      ((user (gitea/w-user forge req)))
+      (if (nil? user) (gitea/w-unauthorized) (dream-json-value {:outcomes (len (gitea/notify! forge))})))))
+
+(define
+  gitea/activity-routes
+  (fn
+    (forge)
+    (list
+      (dream-get "/activity" (fn (req) (gitea/w-activity-page forge req)))
+      (dream-get
+        "/:owner/:name/activity"
+        (fn (req) (gitea/w-repo-activity-page forge req)))
+      (dream-get
+        "/api/users/:user/activity"
+        (fn (req) (gitea/w-api-user-activity forge req)))
+      (dream-get
+        "/api/dashboard"
+        (fn (req) (gitea/w-api-dashboard forge req)))
+      (dream-post "/api/follow" (fn (req) (gitea/w-api-follow forge req)))
+      (dream-delete
+        "/api/follow/**"
+        (fn (req) (gitea/w-api-unfollow forge req)))
+      (dream-get
+        "/api/notifications"
+        (fn (req) (gitea/w-api-notifications forge req)))
+      (dream-post
+        "/api/notify/run"
+        (fn (req) (gitea/w-api-notify-run forge req))))))
+
+(set!
+  gitea/route-packs
+  (append gitea/route-packs (list gitea/activity-routes)))

lib/gitea/conformance.sh

@@ -0,0 +1,182 @@
+#!/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 | extra modules (;-sep)
+ISSUES_EXTRAS="lib/relations/schema.sx;lib/relations/engine.sx;lib/relations/api.sx;lib/smalltalk/tokenizer.sx;lib/smalltalk/parser.sx;lib/guest/reflective/class-chain.sx;lib/smalltalk/runtime.sx;lib/guest/reflective/env.sx;lib/smalltalk/eval.sx;lib/content/block.sx;lib/content/doc.sx;lib/content/render.sx;lib/content/api.sx;lib/content/meta.sx;lib/content/text.sx;lib/content/section.sx;lib/content/table.sx;lib/content/markdown.sx;lib/content/md-import.sx;lib/gitea/issues.sx"
+
+PR_EXTRAS="$ISSUES_EXTRAS;lib/guest/lex.sx;lib/guest/reflective/quoting.sx;lib/scheme/parser.sx;lib/scheme/eval.sx;lib/scheme/runtime.sx;lib/flow/spec.sx;lib/flow/store.sx;lib/flow/remote.sx;lib/flow/host.sx;lib/flow/api.sx;lib/gitea/pr.sx"
+SEARCH_EXTRAS_TAIL="lib/haskell/tokenizer.sx;lib/haskell/layout.sx;lib/haskell/parser.sx;lib/haskell/desugar.sx;lib/haskell/runtime.sx;lib/haskell/match.sx;lib/haskell/eval.sx;lib/haskell/map.sx;lib/haskell/set.sx;lib/haskell/testlib.sx;lib/search/tokenize.sx;lib/search/index.sx;lib/search/query.sx;lib/search/parse.sx;lib/search/rank.sx;lib/search/rankq.sx;lib/search/testlib.sx;lib/gitea/search.sx"
+ACT_EXTRAS="$PR_EXTRAS;lib/apl/runtime.sx;lib/feed/normalize.sx;lib/feed/stream.sx;lib/feed/api.sx;lib/feed/fanout.sx;lib/feed/dedupe.sx;lib/feed/aggregate.sx;lib/feed/rank.sx;lib/feed/acl.sx;lib/feed/mute.sx;lib/feed/page.sx;lib/feed/notify.sx;lib/feed/home.sx;lib/feed/fed.sx;lib/events/notify.sx;lib/gitea/activity.sx"
+
+SUITES=(
+  "repo|gitea-repo-pass|gitea-repo-fail|gitea-repo-fails|"
+  "access|gitea-access-pass|gitea-access-fail|gitea-access-fails|"
+  "wire|gitea-wire-pass|gitea-wire-fail|gitea-wire-fails|"
+  "issues|gitea-issues-pass|gitea-issues-fail|gitea-issues-fails|$ISSUES_EXTRAS"
+  "pr|gitea-pr-pass|gitea-pr-fail|gitea-pr-fails|$PR_EXTRAS"
+  "activity|gitea-act-pass|gitea-act-fail|gitea-act-fails|$ACT_EXTRAS"
+  "search|gitea-search-pass|gitea-search-fail|gitea-search-fails|$PR_EXTRAS;$SEARCH_EXTRAS_TAIL"
+  "fed|gitea-fed-pass|gitea-fed-fail|gitea-fed-fails|$ACT_EXTRAS;lib/gitea/fed.sx"
+)
+
+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"
+  "spec/parser.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/datalog/tokenizer.sx"
+  "lib/datalog/parser.sx"
+  "lib/datalog/unify.sx"
+  "lib/datalog/db.sx"
+  "lib/datalog/builtins.sx"
+  "lib/datalog/aggregates.sx"
+  "lib/datalog/strata.sx"
+  "lib/datalog/eval.sx"
+  "lib/datalog/api.sx"
+  "lib/datalog/magic.sx"
+  "lib/acl/schema.sx"
+  "lib/acl/facts.sx"
+  "lib/acl/engine.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/auth.sx"
+  "lib/dream/api.sx"
+  "lib/gitea/repo.sx"
+  "lib/gitea/access.sx"
+  "lib/gitea/web.sx"
+  "lib/gitea/wire.sx"
+)
+
+run_suite() {
+  local suite=$1 passvar=$2 failvar=$3 failsvar=$4 extras=$5
+  local file="lib/gitea/tests/${suite}.sx"
+  local TMP
+  TMP=$(mktemp)
+  {
+    echo "(epoch 1)"
+    for M in "${MODULES[@]}"; do echo "(load \"$M\")"; done
+    if [ -n "$extras" ]; then
+      for M in ${extras//;/ }; do echo "(load \"$M\")"; done
+    fi
+    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 900 "$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 extras <<< "$entry"
+  read -r p f < <(run_suite "$s" "$passvar" "$failvar" "$failsvar" "$extras")
+  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 ]

lib/gitea/fed.sx

@@ -0,0 +1,449 @@
+; lib/gitea/fed.sx — sx-gitea Phase 8: ForgeFed federation.
+;
+; Forges federate as fed-sx-style peers. Each forge carries an instance
+; id; users and repos project as AP actor documents (Person/Repository
+; with inbox/outbox); the outbox is the forge's activity log in an
+; AP-shaped envelope ({:actor "<instance>/user:<u>" :verb :object
+; :published}).
+;
+; Trust is the events-federation pattern: a kv set of peer ids,
+; RE-CHECKED on every operation, so revoking a peer takes effect
+; immediately. Peer transports (dream app fns) live in the forge handle's
+; runtime cache — only the trust set persists.
+;
+; The inbox (POST /api/ap/inbox, {:peer :activity}) accepts activities
+; from trusted peers only. Every accepted activity lands in a federated
+; activity log with :origin provenance; open-issue/comment/open-pr
+; activities also MATERIALIZE: the foreign author becomes a proxy user
+; "<name>@<peer>" (auto-created), and the issue/comment/PR is created
+; locally under that identity — federated issues and PRs with honest
+; provenance. fed-deliver! pushes public-repo activities (cursor-based,
+; never private ones) to every trusted peer's inbox.
+;
+; Cross-instance repo follow = mirror!: clone a trusted peer's repo over
+; the Phase 3 wire client, remember the source, and mirror-sync! to
+; fast-forward — trust re-checked on every sync.
+;
+; Requires: lib/gitea/{repo,access,web,wire,issues,pr,activity}.sx and
+; their stacks.
+
+; ── instance identity ────────────────────────────────────────────────
+
+(define gitea/instance-key "gitea/instance")
+
+(define
+  gitea/instance!
+  (fn
+    (forge id)
+    (persist/kv-put (gitea/forge-db forge) gitea/instance-key {:id id})))
+
+(define
+  gitea/instance-id
+  (fn
+    (forge)
+    (get
+      (or
+        (persist/kv-get (gitea/forge-db forge) gitea/instance-key)
+        {})
+      :id)))
+
+(define
+  gitea/actor-id
+  (fn (forge node) (str (or (gitea/instance-id forge) "local") "/" node)))
+
+; ── peers + trust ────────────────────────────────────────────────────
+
+; transports are live functions — runtime registry in the forge cache
+(define
+  gitea/peers-registry
+  (fn
+    (forge)
+    (let
+      ((cache (get forge :cache)))
+      (begin
+        (if
+          (and cache (nil? (get cache "peers")))
+          (dict-set! cache "peers" {})
+          nil)
+        (or (get cache "peers") {})))))
+
+(define
+  gitea/peer-register!
+  (fn
+    (forge id app token)
+    (let
+      ((cache (get forge :cache)))
+      (begin
+        (dict-set!
+          cache
+          "peers"
+          (assoc (gitea/peers-registry forge) id {:id id :token token :app app}))
+        id))))
+
+(define
+  gitea/peer-get
+  (fn (forge id) (get (gitea/peers-registry forge) id)))
+
+(define gitea/trust-key (fn (id) (str "gitea/trust/" id)))
+
+(define
+  gitea/trust!
+  (fn
+    (forge id)
+    (persist/kv-put (gitea/forge-db forge) (gitea/trust-key id) {:id id})))
+
+(define
+  gitea/untrust!
+  (fn
+    (forge id)
+    (persist/kv-delete (gitea/forge-db forge) (gitea/trust-key id))))
+
+(define
+  gitea/trusted?
+  (fn
+    (forge id)
+    (persist/kv-has? (gitea/forge-db forge) (gitea/trust-key id))))
+
+(define
+  gitea/trusted-peers
+  (fn
+    (forge)
+    (filter
+      (fn (id) (gitea/trusted? forge id))
+      (artdag/sort-strings (keys (gitea/peers-registry forge))))))
+
+; ── AP actor documents ───────────────────────────────────────────────
+
+(define
+  gitea/ap-user
+  (fn
+    (forge user)
+    (let
+      ((rec (gitea/owner-get forge user)))
+      (if (nil? rec) nil {:id (gitea/actor-id forge (str "user:" user)) :type (if (gitea/org? rec) "Group" "Person") :outbox (str "/api/ap/users/" user "/outbox") :preferredUsername user :inbox "/api/ap/inbox"}))))
+
+(define
+  gitea/ap-repo
+  (fn
+    (forge owner name)
+    (let
+      ((rec (gitea/repo-get forge owner name)))
+      (if (nil? rec) nil {:clone (str "/" owner "/" name "/info/refs") :name (str owner "/" name) :id (gitea/actor-id forge (str "repo:" owner "/" name)) :attributedTo (gitea/actor-id forge (str "user:" owner)) :type "Repository" :summary (get rec :description) :inbox "/api/ap/inbox"}))))
+
+; AP-shaped envelope for a feed activity
+(define gitea/ap-activity (fn (forge a) {:published (get a :at) :actor (gitea/actor-id forge (str "user:" (get a :actor))) :object (get a :object) :verb (get a :verb)}))
+
+(define
+  gitea/ap-outbox
+  (fn
+    (forge user n)
+    (map
+      (fn (a) (gitea/ap-activity forge a))
+      (gitea/user-timeline forge nil user n))))
+
+; ── federated activity log (inbound, with provenance) ────────────────
+
+(define gitea/fed-stream-name "gitea/fed-activity")
+
+(define
+  gitea/fed-log
+  (fn
+    (forge)
+    (map
+      persist/event-data
+      (persist/read (gitea/forge-db forge) gitea/fed-stream-name))))
+
+(define
+  gitea/fed-log-append!
+  (fn
+    (forge origin a)
+    (persist/append
+      (gitea/forge-db forge)
+      gitea/fed-stream-name
+      (or (get a :verb) "activity")
+      (or (get a :at) 0)
+      {:activity a :origin origin})))
+
+; local + foreign activities, newest first, foreign tagged :origin
+(define
+  gitea/fed-timeline
+  (fn
+    (forge user n)
+    (feed/items
+      (feed/take
+        (feed/recent
+          (feed/stream
+            (concat
+              (feed/items
+                (feed/filter
+                  (gitea/activity-stream forge)
+                  (fn (a) (gitea/act-visible? forge user a))))
+              (map
+                (fn (e) (assoc (get e :activity) :origin (get e :origin)))
+                (gitea/fed-log forge)))))
+        n))))
+
+; ── inbound materialization ──────────────────────────────────────────
+
+; foreign authors become local proxy users "<name>@<peer>"
+(define
+  gitea/fed-user!
+  (fn
+    (forge name peer)
+    (let
+      ((proxy (str name "@" peer)))
+      (begin
+        (if
+          (gitea/owner-exists? forge proxy)
+          nil
+          (gitea/user-create! forge proxy))
+        proxy))))
+
+; a foreign activity's :actor may be "<instance>/user:<name>" or a bare
+; name — reduce it to the name
+(define
+  gitea/fed-actor-name
+  (fn
+    (actor)
+    (let
+      ((i (index-of (or actor "") "user:")))
+      (if (< i 0) (or actor "") (substr actor (+ i 5))))))
+
+; apply one trusted activity: log it, and materialize the verbs a forge
+; can host locally. => {:accepted true ...} | {:error ...}
+(define
+  gitea/fed-receive!
+  (fn
+    (forge peer a)
+    (if
+      (not (gitea/trusted? forge peer))
+      {:error "untrusted-peer"}
+      (let
+        ((verb (get a :verb))
+          (actor (gitea/fed-actor-name (get a :actor)))
+          (node (gitea/parse-numbered-node (or (get a :object) "")))
+          (detail (or (get a :detail) {})))
+        (begin
+          (gitea/fed-log-append! forge peer a)
+          (cond
+            ((= verb "open-issue")
+              (let
+                ((rp (gitea/split-full (substr (or (gitea/act-repo a) "repo:/") 5))))
+                (let
+                  ((res (gitea/issue-create! forge (get rp :owner) (get rp :name) (gitea/fed-user! forge actor peer) (or (get detail :title) "(federated issue)") (or (get detail :body) "") {:created-at (or (get a :at) 0)})))
+                  (if (get res :error) res {:materialized "issue" :accepted true :number (get res :number)}))))
+            ((= verb "comment")
+              (if
+                (nil? node)
+                {:error "bad-object"}
+                (let
+                  ((res (gitea/issue-comment! forge (get node :owner) (get node :name) (get node :n) (gitea/fed-user! forge actor peer) (or (get detail :body) "") {:at (or (get a :at) 0)})))
+                  (if (get res :error) res {:materialized "comment" :accepted true}))))
+            ((= verb "open-pr")
+              (let
+                ((rp (gitea/split-full (substr (or (gitea/act-repo a) "repo:/") 5))))
+                (let
+                  ((res (gitea/pr-create! forge (get rp :owner) (get rp :name) (gitea/fed-user! forge actor peer) (or (get detail :title) "(federated pr)") (get detail :source) (get detail :target) (or (get detail :body) "") {:created-at (or (get a :at) 0)})))
+                  (if (get res :error) res {:materialized "pr" :accepted true :number (get res :number)}))))
+            (else {:materialized "none" :accepted true})))))))
+
+; ── outbound delivery ────────────────────────────────────────────────
+
+(define gitea/fed-cursor-key "gitea/fed-cursor")
+
+; push public-repo activities after the cursor to every trusted peer's
+; inbox. => {:delivered n :peers (ids)}
+(define
+  gitea/fed-deliver!
+  (fn
+    (forge)
+    (let
+      ((db (gitea/forge-db forge)))
+      (let
+        ((cursor (persist/kv-get-or db gitea/fed-cursor-key 0))
+          (peers (gitea/trusted-peers forge))
+          (me (or (gitea/instance-id forge) "local")))
+        (let
+          ((events (persist/read-from db gitea/activity-stream-name (+ cursor 1))))
+          (let
+            ((public (filter (fn (e) (gitea/act-visible? forge nil (persist/event-data e))) events)))
+            (begin
+              (for-each
+                (fn
+                  (e)
+                  (for-each
+                    (fn
+                      (pid)
+                      (let
+                        ((peer (gitea/peer-get forge pid)))
+                        (if
+                          (nil? peer)
+                          nil
+                          ((get peer :app)
+                            (dream-request
+                              "POST"
+                              "/api/ap/inbox"
+                              (if
+                                (nil? (get peer :token))
+                                {}
+                                {:authorization (str "Bearer " (get peer :token))})
+                              (dream-json-encode {:activity (persist/event-data e) :peer me}))))))
+                    peers))
+                public)
+              (if
+                (empty? events)
+                nil
+                (persist/kv-put
+                  db
+                  gitea/fed-cursor-key
+                  (reduce (fn (acc e) (persist/event-seq e)) cursor events)))
+              {:delivered (len public) :peers peers})))))))
+
+; ── cross-instance repo follow (mirrors) ─────────────────────────────
+
+(define
+  gitea/mirror-key
+  (fn (owner name) (str "gitea/mirror/" owner "/" name)))
+
+(define
+  gitea/peer-remote
+  (fn
+    (forge peer-id owner name)
+    (let
+      ((peer (gitea/peer-get forge peer-id)))
+      (if
+        (nil? peer)
+        nil
+        (gitea/remote (get peer :app) owner name (get peer :token))))))
+
+; clone a trusted peer's repo as owner/name and remember the source
+(define
+  gitea/mirror!
+  (fn
+    (forge owner name peer-id remote-owner remote-name)
+    (cond
+      ((not (gitea/trusted? forge peer-id)) {:error "untrusted-peer"})
+      ((nil? (gitea/peer-get forge peer-id)) {:error "no-such-peer"})
+      (else
+        (let
+          ((remote (gitea/peer-remote forge peer-id remote-owner remote-name)))
+          (let
+            ((res (gitea/clone! forge owner name remote {})))
+            (if
+              (or (get res :error) (get res :conflict))
+              res
+              (begin
+                (persist/kv-put
+                  (gitea/forge-db forge)
+                  (gitea/mirror-key owner name)
+                  {:remote-owner remote-owner :peer peer-id :remote-name remote-name})
+                res))))))))
+
+(define
+  gitea/mirror-of
+  (fn
+    (forge owner name)
+    (persist/kv-get (gitea/forge-db forge) (gitea/mirror-key owner name))))
+
+(define
+  gitea/mirrors
+  (fn (forge) (gitea/names-under forge "gitea/mirror/")))
+
+; re-fetch from the mirror source; trust is re-checked every sync
+(define
+  gitea/mirror-sync!
+  (fn
+    (forge owner name)
+    (let
+      ((m (gitea/mirror-of forge owner name)))
+      (cond
+        ((nil? m) {:error "not-a-mirror"})
+        ((not (gitea/trusted? forge (get m :peer))) {:error "untrusted-peer"})
+        ((nil? (gitea/peer-get forge (get m :peer))) {:error "no-such-peer"})
+        (else
+          (gitea/fetch!
+            (gitea/peer-remote
+              forge
+              (get m :peer)
+              (get m :remote-owner)
+              (get m :remote-name))
+            (gitea/repo-git forge owner name)))))))
+
+; ── web ──────────────────────────────────────────────────────────────
+
+(define
+  gitea/w-ap-user
+  (fn
+    (forge req)
+    (let
+      ((doc (gitea/ap-user forge (dream-param req "user"))))
+      (if (nil? doc) (dream-not-found) (dream-json-value doc)))))
+
+(define
+  gitea/w-ap-repo
+  (fn
+    (forge req)
+    (let
+      ((owner (dream-param req "owner")) (name (dream-param req "name")))
+      (if
+        (not (gitea/w-readable? forge req owner name))
+        (dream-not-found)
+        (dream-json-value (gitea/ap-repo forge owner name))))))
+
+(define
+  gitea/w-ap-outbox
+  (fn
+    (forge req)
+    (let
+      ((user (dream-param req "user")))
+      (if
+        (not (gitea/owner-exists? forge user))
+        (dream-not-found)
+        (dream-json-value (gitea/ap-outbox forge user 50))))))
+
+(define
+  gitea/w-ap-inbox
+  (fn
+    (forge req)
+    (let
+      ((body (dream-json-body req)))
+      (let
+        ((peer (get body :peer)))
+        (cond
+          ((nil? peer) (gitea/w-json-status 400 {:error "missing-peer"}))
+          ((not (gitea/trusted? forge peer)) (gitea/w-forbidden))
+          (else
+            (let
+              ((res (gitea/fed-receive! forge peer (or (get body :activity) {}))))
+              (if
+                (get res :error)
+                (gitea/w-json-status 400 {:error (get res :error)})
+                (dream-json-value res)))))))))
+
+(define
+  gitea/w-fed-timeline
+  (fn
+    (forge req)
+    (dream-json-value
+      (gitea/fed-timeline forge (gitea/w-user forge req) 50))))
+
+(define
+  gitea/fed-routes
+  (fn
+    (forge)
+    (list
+      (dream-get
+        "/api/ap/users/:user"
+        (fn (req) (gitea/w-ap-user forge req)))
+      (dream-get
+        "/api/ap/users/:user/outbox"
+        (fn (req) (gitea/w-ap-outbox forge req)))
+      (dream-get
+        "/api/ap/repos/:owner/:name"
+        (fn (req) (gitea/w-ap-repo forge req)))
+      (dream-post "/api/ap/inbox" (fn (req) (gitea/w-ap-inbox forge req)))
+      (dream-get
+        "/api/fed/timeline"
+        (fn (req) (gitea/w-fed-timeline forge req))))))
+
+(set! gitea/route-packs (append gitea/route-packs (list gitea/fed-routes)))

lib/gitea/issues.sx

@@ -0,0 +1,770 @@
+; lib/gitea/issues.sx — sx-gitea Phase 4: issues.
+;
+; An issue is a kv record: number, title, author, state, label/assignee
+; sets, a Markdown body, and a comment thread (each comment is Markdown
+; too). The Markdown is the stored source of truth; lib/content turns it
+; into a block document (content/from-markdown) and renders HTML
+; (content/html) — content-on-sx's round-trip law keeps the two views of
+; the same body honest.
+;
+; The issue graph (issue->repo, author, assignees, labels, commenters) is
+; DERIVED from the records into lib/relations facts — like the acl db in
+; access.sx, the relations db is rebuilt (cached on fact equality) rather
+; than maintained incrementally, so deleting a repo can never leave
+; dangling edges.
+;
+; Requires: lib/gitea/{repo,access,web}.sx and their stacks, plus
+; lib/relations/{schema,engine,api}.sx and the content stack
+; (lib/smalltalk/* + lib/content/{block,doc,render,api,meta,text,section,
+; table,markdown,md-import}.sx) with content bootstrapped:
+;   (st-bootstrap-classes!) (content/bootstrap!)
+;   (content-bootstrap-markdown!) (content-bootstrap-table!)
+
+; ── numbering / keys ─────────────────────────────────────────────────
+; keys carry zero-padded numbers so lexicographic kv order = issue order
+
+(define
+  gitea/pad8
+  (fn
+    (n)
+    (let
+      ((s (str n)))
+      (str
+        (substr "00000000" 0 (- 8 (string-length s)))
+        s))))
+
+(define
+  gitea/digits-loop
+  (fn
+    (s i)
+    (if
+      (>= i (string-length s))
+      true
+      (let
+        ((c (char-code (char-at s i))))
+        (if
+          (and (>= c 48) (<= c 57))
+          (gitea/digits-loop s (+ i 1))
+          false)))))
+
+(define
+  gitea/digits?
+  (fn
+    (s)
+    (and
+      (string? s)
+      (> (string-length s) 0)
+      (gitea/digits-loop s 0))))
+
+(define
+  gitea/issue-key
+  (fn (owner name n) (str "gitea/issue/" owner "/" name "/" (gitea/pad8 n))))
+
+(define
+  gitea/issue-seq-key
+  (fn (owner name) (str "gitea/issue-seq/" owner "/" name)))
+
+(define
+  gitea/issue-next!
+  (fn
+    (forge owner name)
+    (let
+      ((k (gitea/issue-seq-key owner name)))
+      (let
+        ((n (+ 1 (or (persist/kv-get (gitea/forge-db forge) k) 0))))
+        (begin (persist/kv-put (gitea/forge-db forge) k n) n)))))
+
+; ── sorted-set helpers ───────────────────────────────────────────────
+
+(define
+  gitea/set-add
+  (fn
+    (xs x)
+    (artdag/sort-strings (cons x (filter (fn (e) (not (= e x))) xs)))))
+
+(define gitea/set-remove (fn (xs x) (filter (fn (e) (not (= e x))) xs)))
+
+; ── issue CRUD ───────────────────────────────────────────────────────
+
+(define
+  gitea/issue-create!
+  (fn
+    (forge owner name author title body opts)
+    (cond
+      ((not (gitea/repo-exists? forge owner name)) {:error "no-such-repo"})
+      ((not (gitea/owner-exists? forge author)) {:error "no-such-user"})
+      ((or (not (string? title)) (= title "")) {:error "empty-title"})
+      (else
+        (let
+          ((o (or opts {})))
+          (let
+            ((n (gitea/issue-next! forge owner name)))
+            (let
+              ((rec {:state "open" :comments (list) :title title :body (or body "") :number n :author author :created-at (or (get o :created-at) 0) :assignees (artdag/sort-strings (or (get o :assignees) (list))) :labels (artdag/sort-strings (or (get o :labels) (list)))}))
+              (begin
+                (persist/kv-put
+                  (gitea/forge-db forge)
+                  (gitea/issue-key owner name n)
+                  rec)
+                rec))))))))
+
+(define
+  gitea/issue-get
+  (fn
+    (forge owner name n)
+    (persist/kv-get (gitea/forge-db forge) (gitea/issue-key owner name n))))
+
+(define
+  gitea/issues
+  (fn
+    (forge owner name)
+    (map
+      (fn (s) (parse-int s))
+      (gitea/names-under forge (str "gitea/issue/" owner "/" name "/")))))
+
+(define
+  gitea/issue-records
+  (fn
+    (forge owner name)
+    (map
+      (fn (n) (gitea/issue-get forge owner name n))
+      (gitea/issues forge owner name))))
+
+(define
+  gitea/issue-update!
+  (fn
+    (forge owner name n f)
+    (let
+      ((rec (gitea/issue-get forge owner name n)))
+      (if
+        (nil? rec)
+        nil
+        (persist/kv-put
+          (gitea/forge-db forge)
+          (gitea/issue-key owner name n)
+          (f rec))))))
+
+(define
+  gitea/issue-close!
+  (fn
+    (forge owner name n)
+    (gitea/issue-update!
+      forge
+      owner
+      name
+      n
+      (fn (r) (assoc r :state "closed")))))
+
+(define
+  gitea/issue-reopen!
+  (fn
+    (forge owner name n)
+    (gitea/issue-update!
+      forge
+      owner
+      name
+      n
+      (fn (r) (assoc r :state "open")))))
+
+(define
+  gitea/issue-comment!
+  (fn
+    (forge owner name n author body opts)
+    (cond
+      ((not (gitea/owner-exists? forge author)) {:error "no-such-user"})
+      ((nil? (gitea/issue-get forge owner name n)) {:error "no-such-issue"})
+      (else
+        (let
+          ((comment {:body (or body "") :at (or (get (or opts {}) :at) 0) :author author}))
+          (begin
+            (gitea/issue-update!
+              forge
+              owner
+              name
+              n
+              (fn
+                (r)
+                (assoc
+                  r
+                  :comments (append (get r :comments) (list comment)))))
+            comment))))))
+
+; ── labels / assignees ───────────────────────────────────────────────
+
+(define
+  gitea/issue-label!
+  (fn
+    (forge owner name n label)
+    (if
+      (or (not (string? label)) (= label ""))
+      {:error "invalid-label"}
+      (gitea/issue-update!
+        forge
+        owner
+        name
+        n
+        (fn (r) (assoc r :labels (gitea/set-add (get r :labels) label)))))))
+
+(define
+  gitea/issue-unlabel!
+  (fn
+    (forge owner name n label)
+    (gitea/issue-update!
+      forge
+      owner
+      name
+      n
+      (fn (r) (assoc r :labels (gitea/set-remove (get r :labels) label))))))
+
+(define
+  gitea/issue-assign!
+  (fn
+    (forge owner name n user)
+    (if
+      (not (gitea/owner-exists? forge user))
+      {:error "no-such-user"}
+      (gitea/issue-update!
+        forge
+        owner
+        name
+        n
+        (fn
+          (r)
+          (assoc r :assignees (gitea/set-add (get r :assignees) user)))))))
+
+(define
+  gitea/issue-unassign!
+  (fn
+    (forge owner name n user)
+    (gitea/issue-update!
+      forge
+      owner
+      name
+      n
+      (fn
+        (r)
+        (assoc r :assignees (gitea/set-remove (get r :assignees) user))))))
+
+; ── views over the records ───────────────────────────────────────────
+
+(define
+  gitea/issues-open
+  (fn
+    (forge owner name)
+    (filter
+      (fn (r) (= (get r :state) "open"))
+      (gitea/issue-records forge owner name))))
+
+(define
+  gitea/issues-closed
+  (fn
+    (forge owner name)
+    (filter
+      (fn (r) (= (get r :state) "closed"))
+      (gitea/issue-records forge owner name))))
+
+(define
+  gitea/issues-with-label
+  (fn
+    (forge owner name label)
+    (filter
+      (fn (r) (contains? (get r :labels) label))
+      (gitea/issue-records forge owner name))))
+
+(define
+  gitea/issues-assigned
+  (fn
+    (forge owner name user)
+    (filter
+      (fn (r) (contains? (get r :assignees) user))
+      (gitea/issue-records forge owner name))))
+
+; ── content documents ────────────────────────────────────────────────
+
+(define gitea/md-doc (fn (md id) (content/from-markdown (or md "") id)))
+
+(define gitea/md-html (fn (md id) (content/html (gitea/md-doc md id))))
+
+(define
+  gitea/issue-doc
+  (fn
+    (owner name issue)
+    (gitea/md-doc
+      (get issue :body)
+      (str "issue-" owner "-" name "-" (get issue :number)))))
+
+(define
+  gitea/issue-html
+  (fn (owner name issue) (content/html (gitea/issue-doc owner name issue))))
+
+; ── relations graph (derived) ────────────────────────────────────────
+
+(define gitea/user-node (fn (user) (str "user:" user)))
+(define gitea/repo-node (fn (owner name) (str "repo:" owner "/" name)))
+(define
+  gitea/issue-node
+  (fn (owner name n) (str "issue:" owner "/" name "#" n)))
+(define
+  gitea/label-node
+  (fn (owner name label) (str "label:" owner "/" name "/" label)))
+
+(define
+  gitea/rel-facts
+  (fn
+    (forge)
+    (let
+      ((facts (list)))
+      (begin
+        (for-each
+          (fn
+            (full)
+            (let
+              ((p (gitea/split-full full)))
+              (let
+                ((owner (get p :owner)) (name (get p :name)))
+                (for-each
+                  (fn
+                    (rec)
+                    (let
+                      ((inode (gitea/issue-node owner name (get rec :number))))
+                      (begin
+                        (append!
+                          facts
+                          (relations-rel
+                            inode
+                            (gitea/repo-node owner name)
+                            (quote parent)))
+                        (append!
+                          facts
+                          (relations-rel
+                            inode
+                            (gitea/user-node (get rec :author))
+                            (quote origin)))
+                        (for-each
+                          (fn
+                            (a)
+                            (append!
+                              facts
+                              (relations-rel
+                                (gitea/user-node a)
+                                inode
+                                (quote member))))
+                          (get rec :assignees))
+                        (for-each
+                          (fn
+                            (l)
+                            (append!
+                              facts
+                              (relations-rel
+                                inode
+                                (gitea/label-node owner name l)
+                                (quote link))))
+                          (get rec :labels))
+                        (for-each
+                          (fn
+                            (c)
+                            (append!
+                              facts
+                              (relations-rel
+                                (gitea/user-node (get c :author))
+                                inode
+                                (quote reply))))
+                          (get rec :comments)))))
+                  (gitea/issue-records forge owner name)))))
+          (gitea/repos forge))
+        facts))))
+
+; rebuild only when the derived facts changed (cache in the forge handle)
+(define
+  gitea/rels-db
+  (fn
+    (forge)
+    (let
+      ((facts (gitea/rel-facts forge)) (cache (get forge :cache)))
+      (if
+        (and cache (= (get cache "rel-facts") facts) (get cache "rels-db"))
+        (get cache "rels-db")
+        (let
+          ((db (relations-build-db facts)))
+          (begin
+            (if
+              cache
+              (begin
+                (dict-set! cache "rel-facts" facts)
+                (dict-set! cache "rels-db" db))
+              nil)
+            db))))))
+
+; issues of a repo, by graph (sorted issue node ids)
+(define
+  gitea/repo-issue-nodes
+  (fn
+    (forge owner name)
+    (artdag/sort-strings
+      (relations-parents-of
+        (gitea/rels-db forge)
+        (gitea/repo-node owner name)
+        (quote parent)))))
+
+; issues a user authored
+(define
+  gitea/user-authored
+  (fn
+    (forge user)
+    (artdag/sort-strings
+      (relations-parents-of
+        (gitea/rels-db forge)
+        (gitea/user-node user)
+        (quote origin)))))
+
+; issues assigned to a user
+(define
+  gitea/user-assigned
+  (fn
+    (forge user)
+    (artdag/sort-strings
+      (relations-children-of
+        (gitea/rels-db forge)
+        (gitea/user-node user)
+        (quote member)))))
+
+; issues carrying a label
+(define
+  gitea/label-issues
+  (fn
+    (forge owner name label)
+    (artdag/sort-strings
+      (relations-parents-of
+        (gitea/rels-db forge)
+        (gitea/label-node owner name label)
+        (quote link)))))
+
+; everyone touching an issue: author + assignees + commenters
+(define
+  gitea/issue-participants
+  (fn
+    (forge owner name n)
+    (let
+      ((inode (gitea/issue-node owner name n)) (db (gitea/rels-db forge)))
+      (artdag/sort-strings
+        (relations-dedup
+          (concat
+            (relations-children-of db inode (quote origin))
+            (concat
+              (relations-parents-of db inode (quote member))
+              (relations-parents-of db inode (quote reply)))))))))
+
+; ── web ──────────────────────────────────────────────────────────────
+
+(define
+  gitea/w-issue-n
+  (fn
+    (req)
+    (let
+      ((s (dream-param req "n")))
+      (if (gitea/digits? s) (parse-int s) nil))))
+
+(define
+  gitea/w-issue-item
+  (fn
+    (owner name r)
+    (str
+      "<li class=\""
+      (get r :state)
+      "\"><a href=\"/"
+      owner
+      "/"
+      name
+      "/issues/"
+      (get r :number)
+      "\">#"
+      (get r :number)
+      " "
+      (dream-escape (get r :title))
+      "</a> ["
+      (get r :state)
+      "]</li>")))
+
+(define
+  gitea/w-issues-page
+  (fn
+    (forge req)
+    (let
+      ((owner (dream-param req "owner")) (name (dream-param req "name")))
+      (if
+        (not (gitea/w-readable? forge req owner name))
+        (dream-not-found)
+        (gitea/w-page
+          (str owner "/" name " issues")
+          (str
+            "<h1>Issues</h1><ul>"
+            (join
+              ""
+              (map
+                (fn (r) (gitea/w-issue-item owner name r))
+                (gitea/issue-records forge owner name)))
+            "</ul>"))))))
+
+(define
+  gitea/w-comment-html
+  (fn
+    (owner name n i c)
+    (str
+      "<div class=\"comment\"><p class=\"author\">"
+      (dream-escape (get c :author))
+      "</p>"
+      (gitea/md-html (get c :body) (str "c-" owner "-" name "-" n "-" i))
+      "</div>")))
+
+(define
+  gitea/w-issue-page
+  (fn
+    (forge req)
+    (let
+      ((owner (dream-param req "owner"))
+        (name (dream-param req "name"))
+        (n (gitea/w-issue-n req)))
+      (if
+        (or (nil? n) (not (gitea/w-readable? forge req owner name)))
+        (dream-not-found)
+        (let
+          ((rec (gitea/issue-get forge owner name n)))
+          (if
+            (nil? rec)
+            (dream-not-found)
+            (gitea/w-page
+              (str "#" n " " (get rec :title))
+              (str
+                "<h1>#"
+                n
+                " "
+                (dream-escape (get rec :title))
+                "</h1>"
+                "<p class=\"state\">"
+                (get rec :state)
+                "</p>"
+                "<p class=\"author\">"
+                (dream-escape (get rec :author))
+                "</p>"
+                "<p class=\"labels\">"
+                (dream-escape (join ", " (get rec :labels)))
+                "</p>"
+                "<p class=\"assignees\">"
+                (dream-escape (join ", " (get rec :assignees)))
+                "</p>"
+                "<div class=\"body\">"
+                (gitea/issue-html owner name rec)
+                "</div>"
+                "<h2>Comments</h2>"
+                (join
+                  ""
+                  (map-indexed
+                    (fn (i c) (gitea/w-comment-html owner name n i c))
+                    (get rec :comments)))))))))))
+
+; ── json api ─────────────────────────────────────────────────────────
+
+(define
+  gitea/w-api-issues
+  (fn
+    (forge req)
+    (let
+      ((owner (dream-param req "owner")) (name (dream-param req "name")))
+      (if
+        (not (gitea/w-readable? forge req owner name))
+        (dream-not-found)
+        (dream-json-value
+          (map (fn (r) {:state (get r :state) :title (get r :title) :number (get r :number)}) (gitea/issue-records forge owner name)))))))
+
+; any authenticated reader may open an issue
+(define
+  gitea/w-api-issue-create
+  (fn
+    (forge req)
+    (let
+      ((owner (dream-param req "owner")) (name (dream-param req "name")))
+      (let
+        ((user (gitea/w-user forge req)))
+        (cond
+          ((not (gitea/can? forge user "read" owner name))
+            (if
+              (nil? user)
+              (if
+                (gitea/repo-exists? forge owner name)
+                (if
+                  (equal?
+                    (get (gitea/repo-get forge owner name) :visibility)
+                    "public")
+                  (gitea/w-unauthorized)
+                  (dream-not-found))
+                (dream-not-found))
+              (dream-not-found)))
+          ((nil? user) (gitea/w-unauthorized))
+          (else
+            (let
+              ((body (dream-json-body req)))
+              (let
+                ((res (gitea/issue-create! forge owner name user (get body :title) (or (get body :body) "") {:created-at (or (get body :created-at) 0) :assignees (or (get body :assignees) (list)) :labels (or (get body :labels) (list))})))
+                (if
+                  (get res :error)
+                  (gitea/w-json-status 400 {:error (get res :error)})
+                  (gitea/w-json-status 201 {:title (get res :title) :number (get res :number)}))))))))))
+
+(define
+  gitea/w-api-issue-comment
+  (fn
+    (forge req)
+    (let
+      ((owner (dream-param req "owner"))
+        (name (dream-param req "name"))
+        (n (gitea/w-issue-n req)))
+      (let
+        ((user (gitea/w-user forge req)))
+        (cond
+          ((or (nil? n) (not (gitea/can? forge user "read" owner name)))
+            (dream-not-found))
+          ((nil? user) (gitea/w-unauthorized))
+          (else
+            (let
+              ((body (dream-json-body req)))
+              (let
+                ((res (gitea/issue-comment! forge owner name n user (or (get body :body) "") {:at (or (get body :created-at) 0)})))
+                (if
+                  (get res :error)
+                  (gitea/w-json-status 404 {:error (get res :error)})
+                  (dream-json-value {:author user}))))))))))
+
+; the author or anyone with write may close/reopen
+(define
+  gitea/issue-can-close?
+  (fn
+    (forge user owner name rec)
+    (or
+      (= user (get rec :author))
+      (gitea/can? forge user "write" owner name))))
+
+(define
+  gitea/w-api-issue-state
+  (fn
+    (forge req state)
+    (let
+      ((owner (dream-param req "owner"))
+        (name (dream-param req "name"))
+        (n (gitea/w-issue-n req)))
+      (let
+        ((user (gitea/w-user forge req)))
+        (cond
+          ((or (nil? n) (not (gitea/can? forge user "read" owner name)))
+            (dream-not-found))
+          ((nil? user) (gitea/w-unauthorized))
+          (else
+            (let
+              ((rec (gitea/issue-get forge owner name n)))
+              (cond
+                ((nil? rec) (dream-not-found))
+                ((not (gitea/issue-can-close? forge user owner name rec))
+                  (gitea/w-forbidden))
+                (else
+                  (begin
+                    (gitea/issue-update!
+                      forge
+                      owner
+                      name
+                      n
+                      (fn (r) (assoc r :state state)))
+                    (dream-json-value {:state state :number n})))))))))))
+
+; label + assignee management requires write
+(define
+  gitea/w-api-issue-edit
+  (fn
+    (forge req f)
+    (let
+      ((owner (dream-param req "owner"))
+        (name (dream-param req "name"))
+        (n (gitea/w-issue-n req)))
+      (let
+        ((user (gitea/w-user forge req)))
+        (cond
+          ((or (nil? n) (not (gitea/can? forge user "read" owner name)))
+            (dream-not-found))
+          ((nil? user) (gitea/w-unauthorized))
+          ((not (gitea/can? forge user "write" owner name))
+            (gitea/w-forbidden))
+          ((nil? (gitea/issue-get forge owner name n)) (dream-not-found))
+          (else
+            (let
+              ((res (f owner name n)))
+              (if
+                (and (dict? res) (get res :error))
+                (gitea/w-json-status 400 {:error (get res :error)})
+                (dream-json-value {:number n})))))))))
+
+(define
+  gitea/issue-routes
+  (fn
+    (forge)
+    (list
+      (dream-get
+        "/:owner/:name/issues"
+        (fn (req) (gitea/w-issues-page forge req)))
+      (dream-get
+        "/:owner/:name/issues/:n"
+        (fn (req) (gitea/w-issue-page forge req)))
+      (dream-get
+        "/api/repos/:owner/:name/issues"
+        (fn (req) (gitea/w-api-issues forge req)))
+      (dream-post
+        "/api/repos/:owner/:name/issues"
+        (fn (req) (gitea/w-api-issue-create forge req)))
+      (dream-post
+        "/api/repos/:owner/:name/issues/:n/comments"
+        (fn (req) (gitea/w-api-issue-comment forge req)))
+      (dream-post
+        "/api/repos/:owner/:name/issues/:n/close"
+        (fn (req) (gitea/w-api-issue-state forge req "closed")))
+      (dream-post
+        "/api/repos/:owner/:name/issues/:n/reopen"
+        (fn (req) (gitea/w-api-issue-state forge req "open")))
+      (dream-put
+        "/api/repos/:owner/:name/issues/:n/labels/:label"
+        (fn
+          (req)
+          (gitea/w-api-issue-edit
+            forge
+            req
+            (fn
+              (o r n)
+              (gitea/issue-label! forge o r n (dream-param req "label"))))))
+      (dream-delete
+        "/api/repos/:owner/:name/issues/:n/labels/:label"
+        (fn
+          (req)
+          (gitea/w-api-issue-edit
+            forge
+            req
+            (fn
+              (o r n)
+              (gitea/issue-unlabel! forge o r n (dream-param req "label"))))))
+      (dream-put
+        "/api/repos/:owner/:name/issues/:n/assignees/:user"
+        (fn
+          (req)
+          (gitea/w-api-issue-edit
+            forge
+            req
+            (fn
+              (o r n)
+              (gitea/issue-assign! forge o r n (dream-param req "user"))))))
+      (dream-delete
+        "/api/repos/:owner/:name/issues/:n/assignees/:user"
+        (fn
+          (req)
+          (gitea/w-api-issue-edit
+            forge
+            req
+            (fn
+              (o r n)
+              (gitea/issue-unassign! forge o r n (dream-param req "user")))))))))
+
+(set! gitea/route-packs (append gitea/route-packs (list gitea/issue-routes)))

lib/gitea/pr.sx

@@ -0,0 +1,808 @@
+; lib/gitea/pr.sx — sx-gitea Phase 5: pull requests.
+;
+; A PR is a kv record: source branch -> target branch, title/author/body
+; (Markdown, rendered via content like issues), a review thread (latest
+; verdict per reviewer wins), and a merge outcome. Numbers share the
+; per-repo counter with issues (gitea/issue-next!), GitHub-style.
+;
+; The diff is always LIVE — computed with sx-git from the merge base of
+; the current branch heads to the source head (so a target that moved on
+; never shows spurious deletions), never stored.
+;
+; Lifecycle is a lib/flow durable workflow (deterministic-replay
+; suspend): open -(approval)-> approved -(merge)-> merged. review! resumes
+; the approval suspend when the verdict set first becomes approving;
+; merge!/close! resume/cancel the rest. The flow env lives in the forge
+; handle; the record's :state stays the source of truth (merge re-checks
+; approval live — the flow is the durable journal of the lifecycle).
+;
+; Merging uses git/merge-commits (3-way over the merge base): up-to-date
+; and fast-forward move nothing or just the ref; a true merge writes a
+; two-parent commit; conflicts abort with the conflicting paths. All ref
+; moves go through branch-cas! — a concurrent push surfaces as "stale".
+;
+; The merge queue is a per-repo list of approved PR numbers;
+; queue-process! merges them in order, keeping the failures queued.
+;
+; Requires: lib/gitea/{repo,access,web,issues}.sx and their stacks, plus
+; the flow stack (lib/guest/lex, lib/guest/reflective/{env,quoting},
+; lib/scheme/{parser,eval,runtime}, lib/flow/{spec,store,remote,host,api}).
+
+; ── record plumbing ──────────────────────────────────────────────────
+
+(define
+  gitea/pr-key
+  (fn (owner name n) (str "gitea/pr/" owner "/" name "/" (gitea/pad8 n))))
+
+(define
+  gitea/pr-get
+  (fn
+    (forge owner name n)
+    (persist/kv-get (gitea/forge-db forge) (gitea/pr-key owner name n))))
+
+(define
+  gitea/prs
+  (fn
+    (forge owner name)
+    (map
+      (fn (s) (parse-int s))
+      (gitea/names-under forge (str "gitea/pr/" owner "/" name "/")))))
+
+(define
+  gitea/pr-records
+  (fn
+    (forge owner name)
+    (map
+      (fn (n) (gitea/pr-get forge owner name n))
+      (gitea/prs forge owner name))))
+
+(define
+  gitea/pr-update!
+  (fn
+    (forge owner name n f)
+    (let
+      ((rec (gitea/pr-get forge owner name n)))
+      (if
+        (nil? rec)
+        nil
+        (persist/kv-put
+          (gitea/forge-db forge)
+          (gitea/pr-key owner name n)
+          (f rec))))))
+
+; ── the lifecycle flow ───────────────────────────────────────────────
+
+(define
+  gitea/pr-flow-src
+  "(defflow pr-lifecycle (sequence (flow-node (lambda (x) (suspend (quote approval)))) (flow-node (lambda (x) (suspend (quote merge)))) (flow-node (lambda (x) (quote merged)))))")
+
+(define
+  gitea/flow-env
+  (fn
+    (forge)
+    (let
+      ((cache (get forge :cache)))
+      (if
+        (and cache (get cache "flow-env"))
+        (get cache "flow-env")
+        (let
+          ((env (flow-make-env)))
+          (begin
+            (flow-run-in env gitea/pr-flow-src)
+            (if cache (dict-set! cache "flow-env" env) nil)
+            env))))))
+
+; => flow id (int) | nil
+(define
+  gitea/pr-flow-start!
+  (fn
+    (forge n)
+    (let
+      ((res (flow-run-in (gitea/flow-env forge) (str "(flow/start pr-lifecycle " n ")"))))
+      (if
+        (and (list? res) (>= (len res) 2))
+        (nth res 1)
+        nil))))
+
+(define
+  gitea/flow-pending-tag
+  (fn
+    (forge fid)
+    (let
+      ((pending (flow-run-in (gitea/flow-env forge) "(flow/pending)")))
+      (reduce
+        (fn
+          (acc p)
+          (if
+            (and (list? p) (= (first p) fid))
+            (str (nth p 1))
+            acc))
+        nil
+        pending))))
+
+(define
+  gitea/pr-flow-resume!
+  (fn
+    (forge fid value)
+    (flow-run-in
+      (gitea/flow-env forge)
+      (str "(flow/resume " fid " (quote " value "))"))))
+
+(define
+  gitea/pr-flow-cancel!
+  (fn
+    (forge fid)
+    (flow-run-in (gitea/flow-env forge) (str "(flow/cancel " fid ")"))))
+
+; lifecycle stage as seen from the durable flow
+(define
+  gitea/pr-flow-status
+  (fn
+    (forge rec)
+    (let
+      ((fid (get rec :flow-id)))
+      (if
+        (nil? fid)
+        "none"
+        (let
+          ((st (str (flow-run-in (gitea/flow-env forge) (str "(flow/status " fid ")")))))
+          (cond
+            ((= st "done") "merged")
+            ((= st "cancelled") "closed")
+            ((= st "suspended")
+              (let
+                ((tag (gitea/flow-pending-tag forge fid)))
+                (cond
+                  ((= tag "approval") "review")
+                  ((= tag "merge") "approved")
+                  (else "suspended"))))
+            (else st)))))))
+
+; ── create ───────────────────────────────────────────────────────────
+
+(define
+  gitea/pr-create!
+  (fn
+    (forge owner name author title source target body opts)
+    (cond
+      ((not (gitea/repo-exists? forge owner name)) {:error "no-such-repo"})
+      ((not (gitea/owner-exists? forge author)) {:error "no-such-user"})
+      ((or (not (string? title)) (= title "")) {:error "empty-title"})
+      ((= source target) {:error "same-branch"})
+      (else
+        (let
+          ((grepo (gitea/repo-git forge owner name)))
+          (cond
+            ((nil? (git/branch-get grepo source)) {:error "no-such-source"})
+            ((nil? (git/branch-get grepo target)) {:error "no-such-target"})
+            (else
+              (let
+                ((o (or opts {})))
+                (let
+                  ((n (gitea/issue-next! forge owner name)))
+                  (let
+                    ((rec {:source source :state "open" :title title :merge-cid nil :reviews (list) :body (or body "") :number n :author author :created-at (or (get o :created-at) 0) :target target :flow-id (gitea/pr-flow-start! forge n)}))
+                    (begin
+                      (persist/kv-put
+                        (gitea/forge-db forge)
+                        (gitea/pr-key owner name n)
+                        rec)
+                      rec)))))))))))
+
+; ── live diff (merge base -> source head) ────────────────────────────
+
+(define
+  gitea/pr-heads
+  (fn
+    (forge owner name rec)
+    (let
+      ((grepo (gitea/repo-git forge owner name)))
+      (let
+        ((tcid (git/branch-get grepo (get rec :target)))
+          (scid (git/branch-get grepo (get rec :source))))
+        {:base-cid (if (or (nil? tcid) (nil? scid)) nil (or (git/merge-base grepo tcid scid) tcid)) :grepo grepo :target-cid tcid :source-cid scid}))))
+
+; {:added :modified :deleted} from the merge base to the source head
+(define
+  gitea/pr-diff
+  (fn
+    (forge owner name n)
+    (let
+      ((rec (gitea/pr-get forge owner name n)))
+      (if
+        (nil? rec)
+        nil
+        (let
+          ((h (gitea/pr-heads forge owner name rec)))
+          (if
+            (or (nil? (get h :base-cid)) (nil? (get h :source-cid)))
+            nil
+            (git/commit-diff
+              (get h :grepo)
+              (get h :base-cid)
+              (get h :source-cid))))))))
+
+(define
+  gitea/pr-diff-unified
+  (fn
+    (forge owner name n)
+    (let
+      ((rec (gitea/pr-get forge owner name n)))
+      (if
+        (nil? rec)
+        nil
+        (let
+          ((h (gitea/pr-heads forge owner name rec)))
+          (if
+            (or (nil? (get h :base-cid)) (nil? (get h :source-cid)))
+            nil
+            (git/commit-diff-unified
+              (get h :grepo)
+              (get h :base-cid)
+              (get h :source-cid))))))))
+
+; ── reviews ──────────────────────────────────────────────────────────
+
+(define gitea/pr-verdicts (list "approve" "request-changes"))
+
+; latest verdict per reviewer
+(define
+  gitea/pr-latest-verdicts
+  (fn
+    (rec)
+    (reduce
+      (fn (acc r) (assoc acc (get r :reviewer) (get r :verdict)))
+      {}
+      (get rec :reviews))))
+
+(define
+  gitea/pr-approved?
+  (fn
+    (rec)
+    (let
+      ((latest (gitea/pr-latest-verdicts rec)))
+      (let
+        ((vs (map (fn (k) (get latest k)) (keys latest))))
+        (and
+          (contains? vs "approve")
+          (not (contains? vs "request-changes")))))))
+
+; resume the approval suspend the first time the verdict set approves
+(define
+  gitea/pr-sync-flow!
+  (fn
+    (forge owner name n)
+    (let
+      ((rec (gitea/pr-get forge owner name n)))
+      (if
+        (and
+          rec
+          (gitea/pr-approved? rec)
+          (not (nil? (get rec :flow-id)))
+          (= (gitea/flow-pending-tag forge (get rec :flow-id)) "approval"))
+        (begin
+          (gitea/pr-flow-resume! forge (get rec :flow-id) "approved")
+          true)
+        false))))
+
+(define
+  gitea/pr-review!
+  (fn
+    (forge owner name n reviewer verdict body opts)
+    (let
+      ((rec (gitea/pr-get forge owner name n)))
+      (cond
+        ((nil? rec) {:error "no-such-pr"})
+        ((not (= (get rec :state) "open")) {:error "not-open"})
+        ((not (gitea/owner-exists? forge reviewer)) {:error "no-such-user"})
+        ((= reviewer (get rec :author)) {:error "own-pr"})
+        ((not (contains? gitea/pr-verdicts verdict)) {:error "invalid-verdict"})
+        (else
+          (let
+            ((review {:verdict verdict :body (or body "") :at (or (get (or opts {}) :at) 0) :reviewer reviewer}))
+            (begin
+              (gitea/pr-update!
+                forge
+                owner
+                name
+                n
+                (fn
+                  (r)
+                  (assoc r :reviews (append (get r :reviews) (list review)))))
+              (gitea/pr-sync-flow! forge owner name n)
+              review)))))))
+
+; ── merge ────────────────────────────────────────────────────────────
+
+(define
+  gitea/pr-mark-merged!
+  (fn
+    (forge owner name n cid)
+    (let
+      ((rec (gitea/pr-update! forge owner name n (fn (r) (assoc (assoc r :state "merged") :merge-cid cid)))))
+      (begin
+        (if
+          (and
+            rec
+            (not (nil? (get rec :flow-id)))
+            (= (gitea/flow-pending-tag forge (get rec :flow-id)) "merge"))
+          (gitea/pr-flow-resume! forge (get rec :flow-id) "merged")
+          nil)
+        rec))))
+
+(define
+  gitea/pr-merge!
+  (fn
+    (forge owner name n merger opts)
+    (let
+      ((rec (gitea/pr-get forge owner name n)))
+      (cond
+        ((nil? rec) {:error "no-such-pr"})
+        ((not (= (get rec :state) "open")) {:error "not-open"})
+        ((not (gitea/pr-approved? rec)) {:error "not-approved"})
+        (else
+          (let
+            ((h (gitea/pr-heads forge owner name rec)))
+            (let
+              ((grepo (get h :grepo))
+                (tcid (get h :target-cid))
+                (scid (get h :source-cid)))
+              (cond
+                ((or (nil? tcid) (nil? scid)) {:error "missing-branch"})
+                (else
+                  (let
+                    ((m (git/merge-commits grepo tcid scid)))
+                    (cond
+                      ((= (get m :result) "up-to-date")
+                        (gitea/pr-mark-merged! forge owner name n tcid))
+                      ((= (get m :result) "fast-forward")
+                        (let
+                          ((res (git/branch-cas! grepo (get rec :target) tcid scid)))
+                          (if
+                            (and (dict? res) (get res :conflict))
+                            {:error "stale"}
+                            (gitea/pr-mark-merged! forge owner name n scid))))
+                      ((= (get m :result) "merged")
+                        (let
+                          ((mc (git/write grepo (git/commit (get m :tree) (list tcid scid) {:message (str "Merge PR #" n ": " (get rec :title)) :time (or (get (or opts {}) :time) 0) :author (or merger "")}))))
+                          (let
+                            ((res (git/branch-cas! grepo (get rec :target) tcid mc)))
+                            (if
+                              (and (dict? res) (get res :conflict))
+                              {:error "stale"}
+                              (gitea/pr-mark-merged! forge owner name n mc)))))
+                      (else {:conflicts (get m :conflicts) :error "conflicts"}))))))))))))
+
+; ── close / reopen ───────────────────────────────────────────────────
+
+(define
+  gitea/pr-close!
+  (fn
+    (forge owner name n)
+    (let
+      ((rec (gitea/pr-get forge owner name n)))
+      (if
+        (or (nil? rec) (not (= (get rec :state) "open")))
+        nil
+        (begin
+          (if
+            (nil? (get rec :flow-id))
+            nil
+            (gitea/pr-flow-cancel! forge (get rec :flow-id)))
+          (gitea/pr-update!
+            forge
+            owner
+            name
+            n
+            (fn (r) (assoc r :state "closed"))))))))
+
+; reopening restarts the lifecycle (a cancelled flow cannot resume)
+(define
+  gitea/pr-reopen!
+  (fn
+    (forge owner name n)
+    (let
+      ((rec (gitea/pr-get forge owner name n)))
+      (if
+        (or (nil? rec) (not (= (get rec :state) "closed")))
+        nil
+        (gitea/pr-update!
+          forge
+          owner
+          name
+          n
+          (fn
+            (r)
+            (assoc
+              (assoc r :state "open")
+              :flow-id (gitea/pr-flow-start! forge n))))))))
+
+; ── merge queue ──────────────────────────────────────────────────────
+
+(define
+  gitea/queue-key
+  (fn (owner name) (str "gitea/mergeq/" owner "/" name)))
+
+(define
+  gitea/queue
+  (fn
+    (forge owner name)
+    (persist/kv-get-or
+      (gitea/forge-db forge)
+      (gitea/queue-key owner name)
+      (list))))
+
+(define
+  gitea/queue-add!
+  (fn
+    (forge owner name n)
+    (let
+      ((rec (gitea/pr-get forge owner name n)))
+      (cond
+        ((nil? rec) {:error "no-such-pr"})
+        ((not (= (get rec :state) "open")) {:error "not-open"})
+        ((not (gitea/pr-approved? rec)) {:error "not-approved"})
+        (else
+          (let
+            ((q (gitea/queue forge owner name)))
+            (if
+              (contains? q n)
+              q
+              (persist/kv-put
+                (gitea/forge-db forge)
+                (gitea/queue-key owner name)
+                (append q (list n))))))))))
+
+(define
+  gitea/queue-remove!
+  (fn
+    (forge owner name n)
+    (persist/kv-put
+      (gitea/forge-db forge)
+      (gitea/queue-key owner name)
+      (filter (fn (x) (not (= x n))) (gitea/queue forge owner name)))))
+
+; merge queued PRs in order; merged ones leave the queue, failures stay
+; => ({:number n :merged true} | {:number n :error reason} ...)
+(define
+  gitea/queue-process!
+  (fn
+    (forge owner name merger)
+    (let
+      ((results (map (fn (n) (let ((res (gitea/pr-merge! forge owner name n merger {}))) (if (get res :error) {:error (get res :error) :number n} {:merged true :number n}))) (gitea/queue forge owner name))))
+      (begin
+        (persist/kv-put
+          (gitea/forge-db forge)
+          (gitea/queue-key owner name)
+          (map
+            (fn (r) (get r :number))
+            (filter (fn (r) (get r :error)) results)))
+        results))))
+
+; ── web ──────────────────────────────────────────────────────────────
+
+(define
+  gitea/w-pr-item
+  (fn
+    (owner name r)
+    (str
+      "<li class=\""
+      (get r :state)
+      "\"><a href=\"/"
+      owner
+      "/"
+      name
+      "/pulls/"
+      (get r :number)
+      "\">#"
+      (get r :number)
+      " "
+      (dream-escape (get r :title))
+      "</a> ["
+      (get r :state)
+      "] "
+      (dream-escape (get r :source))
+      " -&gt; "
+      (dream-escape (get r :target))
+      "</li>")))
+
+(define
+  gitea/w-pulls-page
+  (fn
+    (forge req)
+    (let
+      ((owner (dream-param req "owner")) (name (dream-param req "name")))
+      (if
+        (not (gitea/w-readable? forge req owner name))
+        (dream-not-found)
+        (gitea/w-page
+          (str owner "/" name " pull requests")
+          (str
+            "<h1>Pull Requests</h1><ul>"
+            (join
+              ""
+              (map
+                (fn (r) (gitea/w-pr-item owner name r))
+                (gitea/pr-records forge owner name)))
+            "</ul>"))))))
+
+(define
+  gitea/w-review-html
+  (fn
+    (owner name n i r)
+    (str
+      "<div class=\"review "
+      (get r :verdict)
+      "\"><p>"
+      (dream-escape (get r :reviewer))
+      ": "
+      (get r :verdict)
+      "</p>"
+      (gitea/md-html (get r :body) (str "rv-" owner "-" name "-" n "-" i))
+      "</div>")))
+
+(define
+  gitea/w-pull-page
+  (fn
+    (forge req)
+    (let
+      ((owner (dream-param req "owner"))
+        (name (dream-param req "name"))
+        (n (gitea/w-issue-n req)))
+      (if
+        (or (nil? n) (not (gitea/w-readable? forge req owner name)))
+        (dream-not-found)
+        (let
+          ((rec (gitea/pr-get forge owner name n)))
+          (if
+            (nil? rec)
+            (dream-not-found)
+            (gitea/w-page
+              (str "#" n " " (get rec :title))
+              (str
+                "<h1>#"
+                n
+                " "
+                (dream-escape (get rec :title))
+                "</h1>"
+                "<p class=\"state\">"
+                (get rec :state)
+                "</p>"
+                "<p class=\"branches\">"
+                (dream-escape (get rec :source))
+                " -&gt; "
+                (dream-escape (get rec :target))
+                "</p>"
+                "<p class=\"lifecycle\">"
+                (gitea/pr-flow-status forge rec)
+                "</p>"
+                "<div class=\"body\">"
+                (gitea/md-html
+                  (get rec :body)
+                  (str "pr-" owner "-" name "-" n))
+                "</div>"
+                "<h2>Reviews</h2>"
+                (join
+                  ""
+                  (map-indexed
+                    (fn (i r) (gitea/w-review-html owner name n i r))
+                    (get rec :reviews)))
+                "<h2>Diff</h2><pre>"
+                (dream-escape
+                  (or (gitea/pr-diff-unified forge owner name n) ""))
+                "</pre>"))))))))
+
+; ── json api ─────────────────────────────────────────────────────────
+
+(define
+  gitea/w-api-pulls
+  (fn
+    (forge req)
+    (let
+      ((owner (dream-param req "owner")) (name (dream-param req "name")))
+      (if
+        (not (gitea/w-readable? forge req owner name))
+        (dream-not-found)
+        (dream-json-value
+          (map (fn (r) {:source (get r :source) :state (get r :state) :title (get r :title) :number (get r :number) :target (get r :target)}) (gitea/pr-records forge owner name)))))))
+
+(define
+  gitea/w-api-pr-create
+  (fn
+    (forge req)
+    (let
+      ((owner (dream-param req "owner")) (name (dream-param req "name")))
+      (let
+        ((user (gitea/w-user forge req)))
+        (cond
+          ((not (gitea/can? forge user "read" owner name))
+            (if
+              (nil? user)
+              (if
+                (and
+                  (gitea/repo-exists? forge owner name)
+                  (equal?
+                    (get (gitea/repo-get forge owner name) :visibility)
+                    "public"))
+                (gitea/w-unauthorized)
+                (dream-not-found))
+              (dream-not-found)))
+          ((nil? user) (gitea/w-unauthorized))
+          (else
+            (let
+              ((body (dream-json-body req)))
+              (let
+                ((res (gitea/pr-create! forge owner name user (get body :title) (get body :source) (get body :target) (or (get body :body) "") {:created-at (or (get body :created-at) 0)})))
+                (if
+                  (get res :error)
+                  (gitea/w-json-status 400 {:error (get res :error)})
+                  (gitea/w-json-status 201 {:title (get res :title) :number (get res :number)}))))))))))
+
+(define
+  gitea/w-api-pr-review
+  (fn
+    (forge req)
+    (let
+      ((owner (dream-param req "owner"))
+        (name (dream-param req "name"))
+        (n (gitea/w-issue-n req)))
+      (let
+        ((user (gitea/w-user forge req)))
+        (cond
+          ((or (nil? n) (not (gitea/can? forge user "read" owner name)))
+            (dream-not-found))
+          ((nil? user) (gitea/w-unauthorized))
+          (else
+            (let
+              ((body (dream-json-body req)))
+              (let
+                ((res (gitea/pr-review! forge owner name n user (get body :verdict) (or (get body :body) "") {:at (or (get body :created-at) 0)})))
+                (cond
+                  ((equal? (get res :error) "no-such-pr") (dream-not-found))
+                  ((get res :error)
+                    (gitea/w-json-status 400 {:error (get res :error)}))
+                  (else (dream-json-value {:verdict (get res :verdict) :reviewer user})))))))))))
+
+(define
+  gitea/w-api-pr-merge
+  (fn
+    (forge req)
+    (let
+      ((owner (dream-param req "owner"))
+        (name (dream-param req "name"))
+        (n (gitea/w-issue-n req)))
+      (let
+        ((user (gitea/w-user forge req)))
+        (cond
+          ((or (nil? n) (not (gitea/can? forge user "read" owner name)))
+            (dream-not-found))
+          ((nil? user) (gitea/w-unauthorized))
+          ((not (gitea/can? forge user "write" owner name))
+            (gitea/w-forbidden))
+          (else
+            (let
+              ((res (gitea/pr-merge! forge owner name n user {:time (or (get (dream-json-body req) :time) 0)})))
+              (cond
+                ((equal? (get res :error) "no-such-pr") (dream-not-found))
+                ((get res :error)
+                  (gitea/w-json-status 409 {:error (get res :error)}))
+                (else (dream-json-value {:state (get res :state) :merge-cid (get res :merge-cid) :number n}))))))))))
+
+(define
+  gitea/w-api-pr-close
+  (fn
+    (forge req)
+    (let
+      ((owner (dream-param req "owner"))
+        (name (dream-param req "name"))
+        (n (gitea/w-issue-n req)))
+      (let
+        ((user (gitea/w-user forge req)))
+        (cond
+          ((or (nil? n) (not (gitea/can? forge user "read" owner name)))
+            (dream-not-found))
+          ((nil? user) (gitea/w-unauthorized))
+          (else
+            (let
+              ((rec (gitea/pr-get forge owner name n)))
+              (cond
+                ((nil? rec) (dream-not-found))
+                ((not (or (= user (get rec :author)) (gitea/can? forge user "write" owner name)))
+                  (gitea/w-forbidden))
+                (else
+                  (let
+                    ((res (gitea/pr-close! forge owner name n)))
+                    (if
+                      (nil? res)
+                      (gitea/w-json-status 409 {:error "not-open"})
+                      (dream-json-value {:state "closed" :number n}))))))))))))
+
+(define
+  gitea/w-api-queue
+  (fn
+    (forge req)
+    (let
+      ((owner (dream-param req "owner")) (name (dream-param req "name")))
+      (if
+        (not (gitea/w-readable? forge req owner name))
+        (dream-not-found)
+        (dream-json-value (gitea/queue forge owner name))))))
+
+(define
+  gitea/w-api-queue-add
+  (fn
+    (forge req)
+    (let
+      ((owner (dream-param req "owner"))
+        (name (dream-param req "name"))
+        (n (gitea/w-issue-n req)))
+      (let
+        ((user (gitea/w-user forge req)))
+        (cond
+          ((or (nil? n) (not (gitea/can? forge user "read" owner name)))
+            (dream-not-found))
+          ((nil? user) (gitea/w-unauthorized))
+          ((not (gitea/can? forge user "write" owner name))
+            (gitea/w-forbidden))
+          (else
+            (let
+              ((res (gitea/queue-add! forge owner name n)))
+              (if
+                (and (dict? res) (get res :error))
+                (gitea/w-json-status 409 {:error (get res :error)})
+                (dream-json-value (gitea/queue forge owner name))))))))))
+
+(define
+  gitea/w-api-queue-process
+  (fn
+    (forge req)
+    (let
+      ((owner (dream-param req "owner")) (name (dream-param req "name")))
+      (let
+        ((user (gitea/w-user forge req)))
+        (cond
+          ((not (gitea/can? forge user "read" owner name))
+            (dream-not-found))
+          ((nil? user) (gitea/w-unauthorized))
+          ((not (gitea/can? forge user "write" owner name))
+            (gitea/w-forbidden))
+          (else
+            (dream-json-value (gitea/queue-process! forge owner name user))))))))
+
+(define
+  gitea/pr-routes
+  (fn
+    (forge)
+    (list
+      (dream-get
+        "/:owner/:name/pulls"
+        (fn (req) (gitea/w-pulls-page forge req)))
+      (dream-get
+        "/:owner/:name/pulls/:n"
+        (fn (req) (gitea/w-pull-page forge req)))
+      (dream-get
+        "/api/repos/:owner/:name/pulls"
+        (fn (req) (gitea/w-api-pulls forge req)))
+      (dream-post
+        "/api/repos/:owner/:name/pulls"
+        (fn (req) (gitea/w-api-pr-create forge req)))
+      (dream-post
+        "/api/repos/:owner/:name/pulls/:n/reviews"
+        (fn (req) (gitea/w-api-pr-review forge req)))
+      (dream-post
+        "/api/repos/:owner/:name/pulls/:n/merge"
+        (fn (req) (gitea/w-api-pr-merge forge req)))
+      (dream-post
+        "/api/repos/:owner/:name/pulls/:n/close"
+        (fn (req) (gitea/w-api-pr-close forge req)))
+      (dream-get
+        "/api/repos/:owner/:name/merge-queue"
+        (fn (req) (gitea/w-api-queue forge req)))
+      (dream-post
+        "/api/repos/:owner/:name/pulls/:n/enqueue"
+        (fn (req) (gitea/w-api-queue-add forge req)))
+      (dream-post
+        "/api/repos/:owner/:name/merge-queue/process"
+        (fn (req) (gitea/w-api-queue-process forge req))))))
+
+(set! gitea/route-packs (append gitea/route-packs (list gitea/pr-routes)))

lib/gitea/repo.sx

@@ -0,0 +1,270 @@
+; lib/gitea/repo.sx — sx-gitea Phase 1: forge core.
+;
+; The forge is a handle over a persist backend. Owner principals and repo
+; records live in the kv store under "gitea/..."; each repo's git objects
+; and refs live in their own git/repo-named namespace "forge/<owner>/<name>",
+; so deleting a repo is a prefix purge and repos are invisible to each other.
+; Owner principals are a lightweight directory here; Phase 2 (access) backs
+; them with identity users/orgs.
+;
+; Requires: lib/persist/{event,backend,log,kv}.sx, lib/artdag/dag.sx,
+; lib/git/{object,ref,dag,worktree,diff,merge,porcelain}.sx
+
+(define gitea/forge (fn (db) {:cache {} :db db}))
+(define gitea/forge-db (fn (forge) (get forge :db)))
+
+; ── names ────────────────────────────────────────────────────────────
+; Owner and repo names share one rule: nonempty, no "/" or spaces, and not
+; a word the router owns (an owner called "api" would shadow /api routes).
+
+(define
+  gitea/reserved-names
+  (list "api" "tree" "blob" "raw" "commit" "commits" "branches"))
+
+(define
+  gitea/valid-name?
+  (fn
+    (name)
+    (and
+      (string? name)
+      (> (string-length name) 0)
+      (not (contains? name "/"))
+      (not (contains? name " "))
+      (not (contains? gitea/reserved-names name)))))
+
+; ── owners ───────────────────────────────────────────────────────────
+
+(define gitea/owner-key (fn (name) (str "gitea/owner/" name)))
+
+(define
+  gitea/owner-get
+  (fn
+    (forge name)
+    (persist/kv-get (gitea/forge-db forge) (gitea/owner-key name))))
+
+(define
+  gitea/owner-exists?
+  (fn
+    (forge name)
+    (persist/kv-has? (gitea/forge-db forge) (gitea/owner-key name))))
+
+(define
+  gitea/owner-create!
+  (fn
+    (forge kind name)
+    (if
+      (not (gitea/valid-name? name))
+      {:name name :error "invalid-name"}
+      (persist/kv-put-new
+        (gitea/forge-db forge)
+        (gitea/owner-key name)
+        {:name name :kind kind}))))
+
+(define
+  gitea/user-create!
+  (fn (forge name) (gitea/owner-create! forge "user" name)))
+(define
+  gitea/org-create!
+  (fn (forge name) (gitea/owner-create! forge "org" name)))
+
+(define gitea/user? (fn (owner) (equal? (get owner :kind) "user")))
+(define gitea/org? (fn (owner) (equal? (get owner :kind) "org")))
+
+(define
+  gitea/names-under
+  (fn
+    (forge pfx)
+    (artdag/sort-strings
+      (map
+        (fn (k) (substr k (string-length pfx)))
+        (filter
+          (fn (k) (starts-with? k pfx))
+          (persist/kv-keys (gitea/forge-db forge)))))))
+
+(define gitea/owners (fn (forge) (gitea/names-under forge "gitea/owner/")))
+
+; ── repo records ─────────────────────────────────────────────────────
+
+(define gitea/repo-key (fn (owner name) (str "gitea/repo/" owner "/" name)))
+(define gitea/repo-ns (fn (owner name) (str "forge/" owner "/" name)))
+
+(define gitea/repo-record (fn (owner name opts) {:name name :description (or (get opts :description) "") :default-branch (or (get opts :default-branch) "main") :owner owner :created-at (or (get opts :created-at) 0) :visibility (or (get opts :visibility) "public")}))
+
+; create-only: {:error ...} on bad input, {:conflict ...} if it exists,
+; else initialize the git store (HEAD -> unborn heads/main) and return
+; the record.
+(define
+  gitea/repo-create!
+  (fn
+    (forge owner name opts)
+    (cond
+      ((not (gitea/owner-exists? forge owner)) {:error "no-such-owner" :owner owner})
+      ((not (gitea/valid-name? name)) {:name name :error "invalid-name"})
+      (else
+        (let
+          ((rec (gitea/repo-record owner name (or opts {}))))
+          (let
+            ((res (persist/kv-put-new (gitea/forge-db forge) (gitea/repo-key owner name) rec)))
+            (if
+              (get res :conflict)
+              res
+              (begin
+                (git/init! (gitea/forge-db forge) (gitea/repo-ns owner name))
+                rec))))))))
+
+(define
+  gitea/repo-get
+  (fn
+    (forge owner name)
+    (persist/kv-get (gitea/forge-db forge) (gitea/repo-key owner name))))
+
+(define
+  gitea/repo-exists?
+  (fn
+    (forge owner name)
+    (persist/kv-has? (gitea/forge-db forge) (gitea/repo-key owner name))))
+
+(define
+  gitea/repo-update!
+  (fn
+    (forge owner name f)
+    (let
+      ((rec (gitea/repo-get forge owner name)))
+      (if
+        (nil? rec)
+        nil
+        (persist/kv-put
+          (gitea/forge-db forge)
+          (gitea/repo-key owner name)
+          (f rec))))))
+
+; the sx-git handle for a repo's own object/ref namespace
+(define
+  gitea/repo-git
+  (fn
+    (forge owner name)
+    (git/repo-named (gitea/forge-db forge) (gitea/repo-ns owner name))))
+
+; everything owned by a repo record, beyond the record itself: its git
+; namespace and any per-repo rows other phases hang off it
+(define
+  gitea/repo-purge-prefixes
+  (fn
+    (owner name)
+    (list
+      (str (gitea/repo-ns owner name) "/")
+      (str "gitea/collab/" owner "/" name "/")
+      (str "gitea/issue/" owner "/" name "/"))))
+
+(define
+  gitea/repo-purge-keys
+  (fn (owner name) (list (str "gitea/issue-seq/" owner "/" name))))
+
+; delete the record and purge every key the repo owns — a recreated repo
+; under the same name must start truly empty (no ghost collaborators,
+; issues, or objects)
+(define
+  gitea/repo-delete!
+  (fn
+    (forge owner name)
+    (if
+      (not (gitea/repo-exists? forge owner name))
+      false
+      (let
+        ((db (gitea/forge-db forge))
+          (prefixes (gitea/repo-purge-prefixes owner name)))
+        (begin
+          (for-each
+            (fn
+              (k)
+              (if
+                (reduce
+                  (fn (acc p) (or acc (starts-with? k p)))
+                  false
+                  prefixes)
+                (persist/kv-delete db k)
+                nil))
+            (persist/kv-keys db))
+          (for-each
+            (fn (k) (persist/kv-delete db k))
+            (gitea/repo-purge-keys owner name))
+          (persist/kv-delete db (gitea/repo-key owner name))
+          true)))))
+
+(define gitea/repos (fn (forge) (gitea/names-under forge "gitea/repo/")))
+
+(define
+  gitea/repos-for
+  (fn (forge owner) (gitea/names-under forge (str "gitea/repo/" owner "/"))))
+
+; ── ref resolution / tree navigation (shared by browse views) ────────
+
+; follow annotated tag objects down to the commit they name
+(define
+  gitea/peel-to-commit
+  (fn
+    (grepo cid)
+    (let
+      ((obj (git/read grepo cid)))
+      (cond
+        ((nil? obj) nil)
+        ((git/tag? obj) (gitea/peel-to-commit grepo (git/tag-target obj)))
+        (else cid)))))
+
+; a browse ref is a branch name, a tag name, or a raw cid — in that order
+(define
+  gitea/resolve-ref
+  (fn
+    (grepo refname)
+    (let
+      ((b (git/branch-get grepo refname)))
+      (if
+        b
+        (gitea/peel-to-commit grepo b)
+        (let
+          ((t (git/tag-get grepo refname)))
+          (if
+            t
+            (gitea/peel-to-commit grepo t)
+            (if
+              (git/has? grepo refname)
+              (gitea/peel-to-commit grepo refname)
+              nil)))))))
+
+(define
+  gitea/path-segs
+  (fn (path) (filter (fn (s) (not (equal? s ""))) (split path "/"))))
+
+; walk tree entries by path segments => {:kind "tree"|"blob" :cid cid} | nil
+(define
+  gitea/entry-at
+  (fn
+    (grepo tree-cid segs)
+    (if
+      (empty? segs)
+      {:kind "tree" :cid tree-cid}
+      (let
+        ((tree (git/read grepo tree-cid)))
+        (if
+          (not (git/tree? tree))
+          nil
+          (let
+            ((entry (git/tree-entry-for tree (first segs))))
+            (cond
+              ((nil? entry) nil)
+              ((empty? (rest segs)) {:kind (git/entry-kind entry) :cid (git/entry-cid entry)})
+              ((equal? (git/entry-kind entry) "tree")
+                (gitea/entry-at grepo (git/entry-cid entry) (rest segs)))
+              (else nil))))))))
+
+; entry at path under a COMMIT's tree ("" => the root tree)
+(define
+  gitea/tree-at
+  (fn
+    (grepo commit-cid path)
+    (let
+      ((c (git/read grepo commit-cid)))
+      (if
+        (not (git/commit? c))
+        nil
+        (gitea/entry-at grepo (git/commit-tree c) (gitea/path-segs path))))))

lib/gitea/scoreboard.json

@@ -0,0 +1,15 @@
+{
+  "suites": {
+    "repo": {"pass": 91, "fail": 0},
+    "access": {"pass": 103, "fail": 0},
+    "wire": {"pass": 78, "fail": 0},
+    "issues": {"pass": 88, "fail": 0},
+    "pr": {"pass": 100, "fail": 0},
+    "activity": {"pass": 60, "fail": 0},
+    "search": {"pass": 35, "fail": 0},
+    "fed": {"pass": 60, "fail": 0}
+  },
+  "total_pass": 615,
+  "total_fail": 0,
+  "total": 615
+}

lib/gitea/scoreboard.md

@@ -0,0 +1,15 @@
+# sx-gitea Conformance Scoreboard
+
+_Generated by `lib/gitea/conformance.sh`_
+
+| Suite | Pass | Fail | Total |
+|-------|-----:|-----:|------:|
+| repo | 91 | 0 | 91 |
+| access | 103 | 0 | 103 |
+| wire | 78 | 0 | 78 |
+| issues | 88 | 0 | 88 |
+| pr | 100 | 0 | 100 |
+| activity | 60 | 0 | 60 |
+| search | 35 | 0 | 35 |
+| fed | 60 | 0 | 60 |
+| **Total** | **615** | **0** | **615** |

lib/gitea/search.sx

@@ -0,0 +1,383 @@
+; lib/gitea/search.sx — sx-gitea Phase 7: code + issue/PR search.
+;
+; search-on-sx (haskell-on-sx) does the heavy lifting: the forge builds a
+; document corpus SX-side — code files from the default branch head
+; (path + blob text), issues (title + body + comment bodies), PRs (title
+; + body + review bodies) — embeds it as one Haskell program, and asks
+; searchRankTfIdf for ranked doc ids. Queries speak the search query
+; language (terms, AND/OR/NOT, "phrases").
+;
+; Cost model: ONE evaluation parses the Haskell search layers (~seconds),
+; extra queries are nearly free. So the core primitive is
+; gitea/search-multi — ANY number of corpora and queries in a single
+; evaluation (each corpus becomes an idxN binding) — and everything else
+; sugars over it. Only the six layers searchRankTfIdf needs are compiled
+; (tokenize/index/query/parse/rank/rankq), not the full search/src.
+;
+; Requires: lib/gitea/{repo,access,web,issues,pr}.sx and their stacks,
+; lib/haskell/* + lib/search/{tokenize,index,query,parse,rank,rankq,
+; testlib}.sx (search-hk->sx, hk-core, hk-eval-program).
+
+; ── corpus ───────────────────────────────────────────────────────────
+
+(define
+  gitea/code-docs
+  (fn
+    (forge owner name)
+    (let
+      ((rec (gitea/repo-get forge owner name)))
+      (if
+        (nil? rec)
+        (list)
+        (let
+          ((grepo (gitea/repo-git forge owner name)))
+          (let
+            ((head-cid (git/branch-get grepo (get rec :default-branch))))
+            (if
+              (nil? head-cid)
+              (list)
+              (let
+                ((files (git/commit-files grepo head-cid)))
+                (map
+                  (fn (p) {:text (str p " " (get files p)) :kind "code" :ref p})
+                  (artdag/sort-strings (keys files)))))))))))
+
+(define
+  gitea/issue-docs
+  (fn
+    (forge owner name)
+    (map (fn (r) {:text (str (get r :title) " " (get r :body) " " (join " " (map (fn (c) (get c :body)) (get r :comments)))) :kind "issue" :ref (str (get r :number))}) (gitea/issue-records forge owner name))))
+
+(define
+  gitea/pr-search-docs
+  (fn
+    (forge owner name)
+    (map (fn (r) {:text (str (get r :title) " " (get r :body) " " (join " " (map (fn (v) (get v :body)) (get r :reviews)))) :kind "pr" :ref (str (get r :number))}) (gitea/pr-records forge owner name))))
+
+(define gitea/search-kinds-all (list "code" "issue" "pr"))
+
+(define
+  gitea/repo-docs
+  (fn
+    (forge owner name kinds)
+    (filter
+      (fn (d) (contains? kinds (get d :kind)))
+      (concat
+        (gitea/code-docs forge owner name)
+        (concat
+          (gitea/issue-docs forge owner name)
+          (gitea/pr-search-docs forge owner name))))))
+
+(define
+  gitea/visible-docs
+  (fn
+    (forge user kinds)
+    (reduce
+      (fn
+        (acc full)
+        (let
+          ((p (gitea/split-full full)))
+          (concat
+            acc
+            (map
+              (fn (d) (assoc d :repo full))
+              (gitea/repo-docs forge (get p :owner) (get p :name) kinds)))))
+      (list)
+      (gitea/visible-repos forge user))))
+
+; ── haskell program assembly ─────────────────────────────────────────
+
+; only the layers searchRankTfIdf needs — parsing is the dominant cost
+(define
+  gitea/search-src
+  (str
+    search/tokenize-src
+    "\n"
+    search/index-src
+    "\n"
+    search/query-src
+    "\n"
+    search/parse-src
+    "\n"
+    search/rank-src
+    "\n"
+    search/rankq-src
+    "\n"))
+
+(define
+  gitea/hk-escape
+  (fn
+    (s)
+    (replace
+      (replace (replace (replace (or s "") "\\" "\\\\") "\"" "\\\"") "\n" "\\n")
+      "\t"
+      "\\t")))
+
+; <name> = indexDoc k "text_k" ( ... (indexDoc 1 "text_1" emptyIndex))
+(define
+  gitea/index-binding
+  (fn
+    (idxname docs)
+    (str
+      idxname
+      " = "
+      (reduce
+        (fn
+          (acc pair)
+          (str
+            "indexDoc "
+            (first pair)
+            " \""
+            (gitea/hk-escape (get (nth pair 1) :text))
+            "\" ("
+            acc
+            ")"))
+        "emptyIndex"
+        (map-indexed (fn (i d) (list (+ i 1) d)) docs))
+      "\n")))
+
+(define
+  gitea/hk-search-eval
+  (fn
+    (extra)
+    (search-hk->sx
+      (hk-deep-force
+        (get
+          (hk-eval-program (hk-core (str gitea/search-src extra)))
+          "result")))))
+
+; THE core: corpora = (docs ...), specs = ({:corpus i :query q :n n} ...).
+; One haskell evaluation; => one ranked {:kind :ref (:repo)} list per spec.
+(define
+  gitea/search-multi
+  (fn
+    (corpora specs)
+    (let
+      ((bindings (join "" (map-indexed (fn (i docs) (gitea/index-binding (str "idx" i) docs)) corpora)))
+        (exprs
+          (map
+            (fn
+              (s)
+              (if
+                (empty? (nth corpora (get s :corpus)))
+                "[]"
+                (str
+                  "take "
+                  (get s :n)
+                  " (searchRankTfIdf \""
+                  (gitea/hk-escape (get s :query))
+                  "\" idx"
+                  (get s :corpus)
+                  ")")))
+            specs)))
+      (let
+        ((id-lists (gitea/hk-search-eval (str bindings "result = [" (join ", " exprs) "]\n"))))
+        (map-indexed
+          (fn
+            (si ids)
+            (let
+              ((docs (nth corpora (get (nth specs si) :corpus))))
+              (map
+                (fn
+                  (i)
+                  (let
+                    ((d (nth docs (- i 1))))
+                    (if (get d :repo) {:repo (get d :repo) :kind (get d :kind) :ref (get d :ref)} {:kind (get d :kind) :ref (get d :ref)})))
+                ids)))
+          id-lists)))))
+
+; many queries against ONE corpus, still one evaluation
+(define
+  gitea/search-many
+  (fn
+    (docs queries n)
+    (if
+      (empty? docs)
+      (map (fn (q) (list)) queries)
+      (gitea/search-multi (list docs) (map (fn (q) {:n n :query q :corpus 0}) queries)))))
+
+; ── repo-scoped search ───────────────────────────────────────────────
+
+(define
+  gitea/search-repo
+  (fn
+    (forge owner name query kinds n)
+    (first
+      (gitea/search-many
+        (gitea/repo-docs forge owner name kinds)
+        (list query)
+        n))))
+
+(define
+  gitea/search-code
+  (fn
+    (forge owner name query n)
+    (gitea/search-repo forge owner name query (list "code") n)))
+
+(define
+  gitea/search-issues
+  (fn
+    (forge owner name query n)
+    (gitea/search-repo forge owner name query (list "issue") n)))
+
+(define
+  gitea/search-prs
+  (fn
+    (forge owner name query n)
+    (gitea/search-repo forge owner name query (list "pr") n)))
+
+; ── global search over visible repos ─────────────────────────────────
+
+(define
+  gitea/search-visible
+  (fn
+    (forge user query kinds n)
+    (first
+      (gitea/search-many
+        (gitea/visible-docs forge user kinds)
+        (list query)
+        n))))
+
+; ── web ──────────────────────────────────────────────────────────────
+
+(define gitea/w-query-param (fn (req name) (get (get req :query) name)))
+
+(define
+  gitea/w-search-kinds
+  (fn
+    (req)
+    (let
+      ((k (gitea/w-query-param req "kind")))
+      (if
+        (contains? gitea/search-kinds-all k)
+        (list k)
+        gitea/search-kinds-all))))
+
+(define
+  gitea/w-search-item
+  (fn
+    (owner name r)
+    (let
+      ((kind (get r :kind)) (ref (get r :ref)))
+      (cond
+        ((= kind "code")
+          (str
+            "<li class=\"code\"><a href=\"/"
+            owner
+            "/"
+            name
+            "/blob/main/"
+            ref
+            "\">"
+            (dream-escape ref)
+            "</a></li>"))
+        ((= kind "issue")
+          (str
+            "<li class=\"issue\"><a href=\"/"
+            owner
+            "/"
+            name
+            "/issues/"
+            ref
+            "\">#"
+            ref
+            "</a></li>"))
+        (else
+          (str
+            "<li class=\"pr\"><a href=\"/"
+            owner
+            "/"
+            name
+            "/pulls/"
+            ref
+            "\">#"
+            ref
+            "</a></li>"))))))
+
+(define
+  gitea/w-search-page
+  (fn
+    (forge req)
+    (let
+      ((owner (dream-param req "owner"))
+        (name (dream-param req "name"))
+        (q (gitea/w-query-param req "q")))
+      (cond
+        ((not (gitea/w-readable? forge req owner name)) (dream-not-found))
+        ((or (nil? q) (= q ""))
+          (gitea/w-json-status 400 {:error "missing-query"}))
+        (else
+          (gitea/w-page
+            (str "search: " q)
+            (str
+              "<h1>Search</h1><p>"
+              (dream-escape q)
+              "</p><ul>"
+              (join
+                ""
+                (map
+                  (fn (r) (gitea/w-search-item owner name r))
+                  (gitea/search-repo
+                    forge
+                    owner
+                    name
+                    q
+                    (gitea/w-search-kinds req)
+                    20)))
+              "</ul>")))))))
+
+(define
+  gitea/w-api-search-repo
+  (fn
+    (forge req)
+    (let
+      ((owner (dream-param req "owner"))
+        (name (dream-param req "name"))
+        (q (gitea/w-query-param req "q")))
+      (cond
+        ((not (gitea/w-readable? forge req owner name)) (dream-not-found))
+        ((or (nil? q) (= q ""))
+          (gitea/w-json-status 400 {:error "missing-query"}))
+        (else
+          (dream-json-value
+            (gitea/search-repo
+              forge
+              owner
+              name
+              q
+              (gitea/w-search-kinds req)
+              20)))))))
+
+(define
+  gitea/w-api-search
+  (fn
+    (forge req)
+    (let
+      ((q (gitea/w-query-param req "q")))
+      (if
+        (or (nil? q) (= q ""))
+        (gitea/w-json-status 400 {:error "missing-query"})
+        (dream-json-value
+          (gitea/search-visible
+            forge
+            (gitea/w-user forge req)
+            q
+            (gitea/w-search-kinds req)
+            20))))))
+
+(define
+  gitea/search-routes
+  (fn
+    (forge)
+    (list
+      (dream-get
+        "/:owner/:name/search"
+        (fn (req) (gitea/w-search-page forge req)))
+      (dream-get
+        "/api/repos/:owner/:name/search"
+        (fn (req) (gitea/w-api-search-repo forge req)))
+      (dream-get "/api/search" (fn (req) (gitea/w-api-search forge req))))))
+
+(set!
+  gitea/route-packs
+  (append gitea/route-packs (list gitea/search-routes)))

lib/gitea/tests/access.sx

@@ -0,0 +1,546 @@
+; lib/gitea/tests/access.sx — Phase 2: visibility, collaborators, org
+; teams, acl-backed can?, tokens, and auth-gated web routes.
+
+(define gitea-access-pass 0)
+(define gitea-access-fail 0)
+(define gitea-access-fails (list))
+
+(define
+  gitea-access-test
+  (fn
+    (name actual expected)
+    (if
+      (= actual expected)
+      (set! gitea-access-pass (+ gitea-access-pass 1))
+      (begin
+        (set! gitea-access-fail (+ gitea-access-fail 1))
+        (set!
+          gitea-access-fails
+          (append gitea-access-fails (list {:name name :expected (inspect expected) :actual (inspect actual)})))))))
+
+(define ga-db (persist/mem-backend))
+(define ga-forge (gitea/forge ga-db))
+
+(gitea/user-create! ga-forge "alice")
+(gitea/user-create! ga-forge "bob")
+(gitea/user-create! ga-forge "carol")
+(gitea/user-create! ga-forge "eve")
+(gitea/org-create! ga-forge "acme")
+
+(gitea/repo-create! ga-forge "alice" "pub" {})
+(gitea/repo-create! ga-forge "alice" "sec" {:visibility "private"})
+(gitea/repo-create! ga-forge "acme" "app" {:visibility "private"})
+
+; ── can? basics ──────────────────────────────────────────────────────
+
+(gitea-access-test
+  "public read anon"
+  (gitea/can? ga-forge nil "read" "alice" "pub")
+  true)
+(gitea-access-test
+  "public read any user"
+  (gitea/can? ga-forge "eve" "read" "alice" "pub")
+  true)
+(gitea-access-test
+  "public write anon denied"
+  (gitea/can? ga-forge nil "write" "alice" "pub")
+  false)
+(gitea-access-test
+  "public write stranger denied"
+  (gitea/can? ga-forge "eve" "write" "alice" "pub")
+  false)
+(gitea-access-test
+  "private read anon denied"
+  (gitea/can? ga-forge nil "read" "alice" "sec")
+  false)
+(gitea-access-test
+  "private read stranger denied"
+  (gitea/can? ga-forge "eve" "read" "alice" "sec")
+  false)
+(gitea-access-test
+  "owner reads private"
+  (gitea/can? ga-forge "alice" "read" "alice" "sec")
+  true)
+(gitea-access-test
+  "owner writes private"
+  (gitea/can? ga-forge "alice" "write" "alice" "sec")
+  true)
+(gitea-access-test
+  "owner admins private"
+  (gitea/can? ga-forge "alice" "admin" "alice" "sec")
+  true)
+(gitea-access-test
+  "owner admins public"
+  (gitea/can? ga-forge "alice" "admin" "alice" "pub")
+  true)
+(gitea-access-test
+  "missing repo denied"
+  (gitea/can? ga-forge "alice" "read" "alice" "nope")
+  false)
+
+; ── collaborators ────────────────────────────────────────────────────
+
+(gitea-access-test
+  "collab-add! bob write"
+  (get (gitea/collab-add! ga-forge "alice" "sec" "bob" "write") :role)
+  "write")
+(gitea-access-test
+  "collab-role"
+  (gitea/collab-role ga-forge "alice" "sec" "bob")
+  "write")
+(gitea-access-test
+  "collabs list"
+  (gitea/collabs ga-forge "alice" "sec")
+  (list "bob"))
+(gitea-access-test
+  "write collab reads"
+  (gitea/can? ga-forge "bob" "read" "alice" "sec")
+  true)
+(gitea-access-test
+  "write collab writes"
+  (gitea/can? ga-forge "bob" "write" "alice" "sec")
+  true)
+(gitea-access-test
+  "write collab cannot admin"
+  (gitea/can? ga-forge "bob" "admin" "alice" "sec")
+  false)
+
+(gitea/collab-add! ga-forge "alice" "sec" "carol" "read")
+(gitea-access-test
+  "read collab reads"
+  (gitea/can? ga-forge "carol" "read" "alice" "sec")
+  true)
+(gitea-access-test
+  "read collab cannot write"
+  (gitea/can? ga-forge "carol" "write" "alice" "sec")
+  false)
+
+(gitea/collab-add! ga-forge "alice" "sec" "carol" "write")
+(gitea-access-test
+  "collab upsert to write"
+  (gitea/can? ga-forge "carol" "write" "alice" "sec")
+  true)
+
+(gitea-access-test
+  "collab-add! missing repo"
+  (get (gitea/collab-add! ga-forge "alice" "nope" "bob" "read") :error)
+  "no-such-repo")
+(gitea-access-test
+  "collab-add! missing user"
+  (get (gitea/collab-add! ga-forge "alice" "sec" "zeb" "read") :error)
+  "no-such-user")
+(gitea-access-test
+  "collab-add! bad role"
+  (get (gitea/collab-add! ga-forge "alice" "sec" "bob" "boss") :error)
+  "invalid-role")
+
+(gitea-access-test
+  "collab-remove! carol"
+  (gitea/collab-remove! ga-forge "alice" "sec" "carol")
+  true)
+(gitea-access-test
+  "removed collab cannot write"
+  (gitea/can? ga-forge "carol" "write" "alice" "sec")
+  false)
+(gitea-access-test
+  "removed collab cannot read private"
+  (gitea/can? ga-forge "carol" "read" "alice" "sec")
+  false)
+(gitea-access-test
+  "collab-remove! again false"
+  (gitea/collab-remove! ga-forge "alice" "sec" "carol")
+  false)
+
+; ── teams ────────────────────────────────────────────────────────────
+
+(gitea-access-test
+  "team-create! owners"
+  (get (gitea/team-create! ga-forge "acme" "owners" "admin") :role)
+  "admin")
+(gitea-access-test
+  "team-create! duplicate conflicts"
+  (get (gitea/team-create! ga-forge "acme" "owners" "read") :conflict)
+  true)
+(gitea-access-test
+  "team-create! on user rejected"
+  (get (gitea/team-create! ga-forge "alice" "crew" "read") :error)
+  "no-such-org")
+(gitea-access-test
+  "team-create! bad role"
+  (get (gitea/team-create! ga-forge "acme" "crew" "boss") :error)
+  "invalid-role")
+
+(gitea/team-add-member! ga-forge "acme" "owners" "alice")
+(gitea-access-test
+  "team-members"
+  (gitea/team-members ga-forge "acme" "owners")
+  (list "alice"))
+(gitea-access-test
+  "team-add-member! missing team"
+  (get (gitea/team-add-member! ga-forge "acme" "ghosts" "bob") :error)
+  "no-such-team")
+(gitea-access-test
+  "team-add-member! missing user"
+  (get (gitea/team-add-member! ga-forge "acme" "owners" "zeb") :error)
+  "no-such-user")
+
+(gitea-access-test
+  "owners member admins org repo"
+  (gitea/can? ga-forge "alice" "admin" "acme" "app")
+  true)
+(gitea-access-test
+  "owners member reads org repo"
+  (gitea/can? ga-forge "alice" "read" "acme" "app")
+  true)
+(gitea-access-test
+  "non-member cannot read org private"
+  (gitea/can? ga-forge "bob" "read" "acme" "app")
+  false)
+(gitea-access-test
+  "org-admin? alice"
+  (gitea/org-admin? ga-forge "acme" "alice")
+  true)
+(gitea-access-test
+  "org-admin? bob"
+  (gitea/org-admin? ga-forge "acme" "bob")
+  false)
+
+(gitea/team-create! ga-forge "acme" "devs" "write")
+(gitea/team-set-repos! ga-forge "acme" "devs" (list "app"))
+(gitea/team-add-member! ga-forge "acme" "devs" "bob")
+
+(gitea-access-test
+  "devs member writes covered repo"
+  (gitea/can? ga-forge "bob" "write" "acme" "app")
+  true)
+(gitea-access-test
+  "devs member cannot admin"
+  (gitea/can? ga-forge "bob" "admin" "acme" "app")
+  false)
+(gitea-access-test
+  "org-admin? devs member"
+  (gitea/org-admin? ga-forge "acme" "bob")
+  false)
+
+(gitea/repo-create! ga-forge "acme" "site" {:visibility "private"})
+
+(gitea-access-test
+  "scoped team does not cover new repo"
+  (gitea/can? ga-forge "bob" "read" "acme" "site")
+  false)
+(gitea-access-test
+  "all-repos team covers new repo"
+  (gitea/can? ga-forge "alice" "admin" "acme" "site")
+  true)
+
+(gitea/team-set-repos! ga-forge "acme" "devs" "all")
+(gitea-access-test
+  "widened team covers site"
+  (gitea/can? ga-forge "bob" "write" "acme" "site")
+  true)
+(gitea/team-set-repos! ga-forge "acme" "devs" (list "app"))
+(gitea-access-test
+  "re-narrowed team loses site"
+  (gitea/can? ga-forge "bob" "write" "acme" "site")
+  false)
+
+(gitea/team-remove-member! ga-forge "acme" "devs" "bob")
+(gitea-access-test
+  "removed member loses access"
+  (gitea/can? ga-forge "bob" "write" "acme" "app")
+  false)
+(gitea/team-add-member! ga-forge "acme" "devs" "bob")
+
+(gitea-access-test
+  "team-delete!"
+  (gitea/team-delete! ga-forge "acme" "devs")
+  true)
+(gitea-access-test
+  "deleted team gone"
+  (gitea/teams ga-forge "acme")
+  (list "owners"))
+(gitea-access-test
+  "deleted team members purged"
+  (gitea/team-members ga-forge "acme" "devs")
+  (list))
+(gitea-access-test
+  "deleted team access revoked"
+  (gitea/can? ga-forge "bob" "write" "acme" "app")
+  false)
+(gitea-access-test
+  "team-delete! missing false"
+  (gitea/team-delete! ga-forge "acme" "devs")
+  false)
+
+; ── visibility ───────────────────────────────────────────────────────
+
+(gitea-access-test
+  "visible anon"
+  (gitea/visible-repos ga-forge nil)
+  (list "alice/pub"))
+(gitea-access-test
+  "visible eve"
+  (gitea/visible-repos ga-forge "eve")
+  (list "alice/pub"))
+(gitea-access-test
+  "visible bob (collab on sec)"
+  (gitea/visible-repos ga-forge "bob")
+  (list "alice/pub" "alice/sec"))
+(gitea-access-test
+  "visible alice (owner + org admin)"
+  (gitea/visible-repos ga-forge "alice")
+  (list "acme/app" "acme/site" "alice/pub" "alice/sec"))
+
+; ── create permission ────────────────────────────────────────────────
+
+(gitea-access-test
+  "create under self"
+  (gitea/create-allowed? ga-forge "alice" "alice")
+  true)
+(gitea-access-test
+  "create under other user"
+  (gitea/create-allowed? ga-forge "bob" "alice")
+  false)
+(gitea-access-test
+  "create anon"
+  (gitea/create-allowed? ga-forge nil "alice")
+  false)
+(gitea-access-test
+  "org admin creates in org"
+  (gitea/create-allowed? ga-forge "alice" "acme")
+  true)
+(gitea-access-test
+  "non-admin cannot create in org"
+  (gitea/create-allowed? ga-forge "eve" "acme")
+  false)
+(gitea-access-test
+  "create under unknown owner"
+  (gitea/create-allowed? ga-forge "alice" "zeb")
+  false)
+
+; ── tokens ───────────────────────────────────────────────────────────
+
+(gitea/token-create! ga-forge "alice" "tok-a")
+(gitea/token-create! ga-forge "bob" "tok-b")
+(gitea/token-create! ga-forge "eve" "tok-e")
+
+(gitea-access-test
+  "token resolves user"
+  (gitea/token-user ga-forge "tok-a")
+  "alice")
+(gitea-access-test "unknown token" (gitea/token-user ga-forge "tok-zzz") nil)
+(gitea-access-test
+  "token for unknown user"
+  (get (gitea/token-create! ga-forge "zeb" "tok-z") :error)
+  "no-such-user")
+(gitea/token-create! ga-forge "carol" "tok-c")
+(gitea/token-revoke! ga-forge "tok-c")
+(gitea-access-test "revoked token" (gitea/token-user ga-forge "tok-c") nil)
+
+; ── auth-gated web routes ────────────────────────────────────────────
+
+; content in the private repo, to browse
+(define ga-gsec (gitea/repo-git ga-forge "alice" "sec"))
+(git/add! ga-gsec "secret.txt" "s3cret\n")
+(git/commit! ga-gsec {:message "hide" :time 1 :author "alice"})
+
+(define ga-app (gitea/app ga-forge))
+(define ga-hdr (fn (tok) (if (nil? tok) {} {:authorization (str "Bearer " tok)})))
+(define
+  ga-get
+  (fn (target tok) (ga-app (dream-request "GET" target (ga-hdr tok) ""))))
+(define
+  ga-post
+  (fn
+    (target tok body)
+    (ga-app (dream-request "POST" target (ga-hdr tok) body))))
+(define
+  ga-put
+  (fn
+    (target tok body)
+    (ga-app (dream-request "PUT" target (ga-hdr tok) body))))
+(define
+  ga-del
+  (fn
+    (target tok)
+    (ga-app (dream-request "DELETE" target (ga-hdr tok) ""))))
+
+(gitea-access-test
+  "web: public repo anon"
+  (dream-status (ga-get "/alice/pub" nil))
+  200)
+(gitea-access-test
+  "web: private repo anon hidden"
+  (dream-status (ga-get "/alice/sec" nil))
+  404)
+(gitea-access-test
+  "web: private repo stranger hidden"
+  (dream-status (ga-get "/alice/sec" "tok-e"))
+  404)
+(gitea-access-test
+  "web: private repo collab"
+  (dream-status (ga-get "/alice/sec" "tok-b"))
+  200)
+(gitea-access-test
+  "web: private repo owner"
+  (dream-status (ga-get "/alice/sec" "tok-a"))
+  200)
+
+(gitea-access-test
+  "web: private tree anon hidden"
+  (dream-status (ga-get "/alice/sec/tree/main" nil))
+  404)
+(gitea-access-test
+  "web: private tree collab"
+  (dream-status (ga-get "/alice/sec/tree/main" "tok-b"))
+  200)
+(gitea-access-test
+  "web: private raw stranger hidden"
+  (dream-status (ga-get "/alice/sec/raw/main/secret.txt" "tok-e"))
+  404)
+(gitea-access-test
+  "web: private raw collab exact"
+  (dream-resp-body (ga-get "/alice/sec/raw/main/secret.txt" "tok-b"))
+  "s3cret\n")
+(gitea-access-test
+  "web: private commits owner"
+  (dream-status (ga-get "/alice/sec/commits/main" "tok-a"))
+  200)
+
+(gitea-access-test
+  "web: index anon shows public"
+  (contains? (dream-resp-body (ga-get "/" nil)) "alice/pub")
+  true)
+(gitea-access-test
+  "web: index anon hides private"
+  (contains? (dream-resp-body (ga-get "/" nil)) "alice/sec")
+  false)
+(gitea-access-test
+  "web: index owner shows private"
+  (contains? (dream-resp-body (ga-get "/" "tok-a")) "alice/sec")
+  true)
+
+(gitea-access-test
+  "web: api repos anon"
+  (dream-json-parse (dream-resp-body (ga-get "/api/repos" nil)))
+  (list "alice/pub"))
+(gitea-access-test
+  "web: api repos owner"
+  (dream-json-parse (dream-resp-body (ga-get "/api/repos" "tok-a")))
+  (list "acme/app" "acme/site" "alice/pub" "alice/sec"))
+
+(gitea-access-test
+  "web: create anon 401"
+  (dream-status (ga-post "/api/repos" nil (dream-json-encode {:name "x" :owner "alice"})))
+  401)
+(gitea-access-test
+  "web: create for other user 403"
+  (dream-status
+    (ga-post "/api/repos" "tok-b" (dream-json-encode {:name "x" :owner "alice"})))
+  403)
+(gitea-access-test
+  "web: create own 201"
+  (dream-status
+    (ga-post "/api/repos" "tok-a" (dream-json-encode {:name "x" :owner "alice"})))
+  201)
+(gitea-access-test
+  "web: org admin create 201"
+  (dream-status
+    (ga-post "/api/repos" "tok-a" (dream-json-encode {:name "tools" :owner "acme"})))
+  201)
+(gitea-access-test
+  "web: org non-admin create 403"
+  (dream-status
+    (ga-post "/api/repos" "tok-e" (dream-json-encode {:name "z" :owner "acme"})))
+  403)
+(gitea-access-test
+  "web: create unknown owner 400"
+  (dream-status
+    (ga-post "/api/repos" "tok-a" (dream-json-encode {:name "z" :owner "zeb"})))
+  400)
+
+(gitea-access-test
+  "web: delete anon public 401"
+  (dream-status (ga-del "/api/repos/alice/x" nil))
+  401)
+(gitea-access-test
+  "web: delete anon private hidden 404"
+  (dream-status (ga-del "/api/repos/alice/sec" nil))
+  404)
+(gitea-access-test
+  "web: delete stranger private hidden 404"
+  (dream-status (ga-del "/api/repos/alice/sec" "tok-e"))
+  404)
+(gitea-access-test
+  "web: delete non-admin 403"
+  (dream-status (ga-del "/api/repos/alice/x" "tok-b"))
+  403)
+(gitea-access-test
+  "web: delete admin 200"
+  (dream-status (ga-del "/api/repos/alice/x" "tok-a"))
+  200)
+(gitea-access-test
+  "web: deleted repo gone"
+  (dream-status (ga-del "/api/repos/alice/x" "tok-a"))
+  404)
+
+(gitea-access-test
+  "web: collab put anon 401"
+  (dream-status (ga-put "/api/repos/alice/pub/collab/eve" nil "{}"))
+  401)
+(gitea-access-test
+  "web: collab put non-admin 403"
+  (dream-status
+    (ga-put
+      "/api/repos/alice/pub/collab/eve"
+      "tok-b"
+      (dream-json-encode {:role "write"})))
+  403)
+(gitea-access-test
+  "web: collab put on hidden repo 404"
+  (dream-status
+    (ga-put
+      "/api/repos/alice/sec/collab/eve"
+      "tok-e"
+      (dream-json-encode {:role "write"})))
+  404)
+(gitea-access-test
+  "web: collab put admin 200"
+  (dream-status
+    (ga-put
+      "/api/repos/alice/pub/collab/eve"
+      "tok-a"
+      (dream-json-encode {:role "write"})))
+  200)
+(gitea-access-test
+  "web: collab granted write"
+  (gitea/can? ga-forge "eve" "write" "alice" "pub")
+  true)
+(gitea-access-test
+  "web: collab put bad role 400"
+  (dream-status
+    (ga-put
+      "/api/repos/alice/pub/collab/eve"
+      "tok-a"
+      (dream-json-encode {:role "boss"})))
+  400)
+(gitea-access-test
+  "web: collab put unknown user 400"
+  (dream-status
+    (ga-put
+      "/api/repos/alice/pub/collab/zeb"
+      "tok-a"
+      (dream-json-encode {:role "read"})))
+  400)
+(gitea-access-test
+  "web: collab delete admin 200"
+  (dream-status (ga-del "/api/repos/alice/pub/collab/eve" "tok-a"))
+  200)
+(gitea-access-test
+  "web: collab revoked"
+  (gitea/can? ga-forge "eve" "write" "alice" "pub")
+  false)
+(gitea-access-test
+  "web: collab delete missing 404"
+  (dream-status (ga-del "/api/repos/alice/pub/collab/eve" "tok-a"))
+  404)

lib/gitea/tests/activity.sx

@@ -0,0 +1,432 @@
+; lib/gitea/tests/activity.sx — Phase 6: instrumented activity log, feed
+; timelines with visibility, follows + dashboard, durable notifications
+; into per-user inboxes, and the activity web routes.
+
+(st-bootstrap-classes!)
+(content/bootstrap!)
+(content-bootstrap-markdown!)
+(content-bootstrap-table!)
+
+(define gitea-act-pass 0)
+(define gitea-act-fail 0)
+(define gitea-act-fails (list))
+
+(define
+  gitea-act-test
+  (fn
+    (name actual expected)
+    (if
+      (= actual expected)
+      (set! gitea-act-pass (+ gitea-act-pass 1))
+      (begin
+        (set! gitea-act-fail (+ gitea-act-fail 1))
+        (set! gitea-act-fails (append gitea-act-fails (list {:name name :expected (inspect expected) :actual (inspect actual)})))))))
+
+; ── setup + instrumented history ─────────────────────────────────────
+; activity ledger (seq/at/actor/verb):
+;  1 @5  alice create-repo  repo:alice/proj   (public)
+;  2 @6  alice create-repo  repo:alice/sec    (private)
+;  3 @10 alice open-issue   issue:alice/proj#1
+;  4 @11 bob   comment      issue:alice/proj#1
+;  5 @12 bob   open-pr      pr:alice/proj#2
+;  6 @13 carol review       pr:alice/proj#2
+;  7 @14 alice merge-pr     pr:alice/proj#2
+;  8 @20 alice open-issue   issue:alice/sec#1 (private)
+;  9 @21 alice open-issue   issue:alice/proj#3 (assignee bob)
+
+(define ga-db (persist/mem-backend))
+(define ga-forge (gitea/forge ga-db))
+(gitea/user-create! ga-forge "alice")
+(gitea/user-create! ga-forge "bob")
+(gitea/user-create! ga-forge "carol")
+(gitea/user-create! ga-forge "eve")
+(gitea/token-create! ga-forge "alice" "tok-a")
+(gitea/token-create! ga-forge "bob" "tok-b")
+(gitea/token-create! ga-forge "carol" "tok-c")
+
+(gitea/repo-create! ga-forge "alice" "proj" {:created-at 5})
+(gitea/repo-create! ga-forge "alice" "sec" {:created-at 6 :visibility "private"})
+(gitea/collab-add! ga-forge "alice" "sec" "bob" "read")
+
+(define ga-g (gitea/repo-git ga-forge "alice" "proj"))
+(git/add! ga-g "README.md" "base\n")
+(git/commit! ga-g {:message "c1" :time 1 :author "alice"})
+(git/branch! ga-g "feat")
+(git/checkout! ga-g "feat")
+(git/add! ga-g "f.txt" "feature\n")
+(git/commit! ga-g {:message "c2" :time 2 :author "bob"})
+(git/checkout! ga-g "main")
+
+(gitea/issue-create!
+  ga-forge
+  "alice"
+  "proj"
+  "alice"
+  "First issue"
+  "body"
+  {:created-at 10})
+(gitea/issue-comment!
+  ga-forge
+  "alice"
+  "proj"
+  1
+  "bob"
+  "a comment"
+  {:at 11})
+(gitea/pr-create!
+  ga-forge
+  "alice"
+  "proj"
+  "bob"
+  "Feature"
+  "feat"
+  "main"
+  ""
+  {:created-at 12})
+(gitea/pr-review!
+  ga-forge
+  "alice"
+  "proj"
+  2
+  "carol"
+  "approve"
+  "lgtm"
+  {:at 13})
+(gitea/pr-merge! ga-forge "alice" "proj" 2 "alice" {:time 14})
+(gitea/issue-create!
+  ga-forge
+  "alice"
+  "sec"
+  "alice"
+  "Secret issue"
+  ""
+  {:created-at 20})
+(gitea/issue-create!
+  ga-forge
+  "alice"
+  "proj"
+  "alice"
+  "Assigned issue"
+  ""
+  {:assignees (list "bob") :created-at 21})
+
+(gitea-act-test "activity count" (gitea/activity-count ga-forge) 9)
+
+; failed mutations emit nothing
+(gitea/issue-create! ga-forge "alice" "none" "alice" "x" "" {})
+(gitea/pr-review!
+  ga-forge
+  "alice"
+  "proj"
+  2
+  "bob"
+  "approve"
+  ""
+  {})
+(gitea-act-test
+  "errors emit no activity"
+  (gitea/activity-count ga-forge)
+  9)
+
+; ── timelines ────────────────────────────────────────────────────────
+
+(gitea-act-test
+  "anon timeline hides private"
+  (len (gitea/timeline ga-forge nil 50))
+  7)
+(gitea-act-test
+  "owner timeline sees all"
+  (len (gitea/timeline ga-forge "alice" 50))
+  9)
+(gitea-act-test
+  "timeline newest first"
+  (get (first (gitea/timeline ga-forge nil 50)) :verb)
+  "open-issue")
+(gitea-act-test
+  "timeline take"
+  (len (gitea/timeline ga-forge "alice" 2))
+  2)
+
+(gitea-act-test
+  "repo timeline proj"
+  (len (gitea/repo-timeline ga-forge "alice" "proj" 50))
+  7)
+(gitea-act-test
+  "repo timeline sec"
+  (len (gitea/repo-timeline ga-forge "alice" "sec" 50))
+  2)
+(gitea-act-test
+  "repo timeline order"
+  (get (first (gitea/repo-timeline ga-forge "alice" "proj" 50)) :at)
+  21)
+
+(gitea-act-test
+  "user timeline bob"
+  (len (gitea/user-timeline ga-forge nil "bob" 50))
+  2)
+(gitea-act-test
+  "user timeline bob order"
+  (get (first (gitea/user-timeline ga-forge nil "bob" 50)) :verb)
+  "open-pr")
+(gitea-act-test
+  "user timeline alice anon"
+  (len (gitea/user-timeline ga-forge nil "alice" 50))
+  4)
+(gitea-act-test
+  "user timeline alice as collab"
+  (len (gitea/user-timeline ga-forge "bob" "alice" 50))
+  6)
+
+; ── follows + dashboard ──────────────────────────────────────────────
+
+(gitea/follow! ga-forge "carol" "user:alice")
+(gitea-act-test
+  "follows list"
+  (gitea/follows ga-forge "carol")
+  (list "user:alice"))
+(gitea-act-test
+  "follow unknown follower"
+  (get (gitea/follow! ga-forge "zeb" "user:alice") :error)
+  "no-such-user")
+(gitea-act-test
+  "follow unknown user target"
+  (get (gitea/follow! ga-forge "carol" "user:zeb") :error)
+  "no-such-target")
+(gitea-act-test
+  "follow unknown repo target"
+  (get (gitea/follow! ga-forge "carol" "repo:alice/none") :error)
+  "no-such-target")
+(gitea-act-test
+  "follow malformed target"
+  (get (gitea/follow! ga-forge "carol" "alice") :error)
+  "no-such-target")
+
+(gitea-act-test
+  "dashboard follows a user"
+  (len (gitea/dashboard ga-forge "carol" 50))
+  4)
+(gitea-act-test
+  "dashboard first actor"
+  (get (first (gitea/dashboard ga-forge "carol" 50)) :actor)
+  "alice")
+
+(gitea/follow! ga-forge "bob" "repo:alice/proj")
+(gitea-act-test
+  "dashboard follows a repo, excludes own actions"
+  (len (gitea/dashboard ga-forge "bob" 50))
+  5)
+
+(gitea-act-test
+  "unfollow"
+  (gitea/unfollow! ga-forge "carol" "user:alice")
+  true)
+(gitea-act-test
+  "dashboard after unfollow"
+  (len (gitea/dashboard ga-forge "carol" 50))
+  0)
+(gitea-act-test
+  "unfollow twice"
+  (gitea/unfollow! ga-forge "carol" "user:alice")
+  false)
+
+; ── notifications ────────────────────────────────────────────────────
+
+(gitea-act-test
+  "recipients of a comment"
+  (gitea/notify-recipients
+    ga-forge
+    (feed/activity
+      "bob"
+      "comment"
+      "issue:alice/proj#1"
+      11
+      (list "repo:alice/proj")))
+  (list "alice"))
+(gitea-act-test
+  "recipients of a review"
+  (gitea/notify-recipients
+    ga-forge
+    (feed/activity
+      "carol"
+      "review"
+      "pr:alice/proj#2"
+      13
+      (list "repo:alice/proj")))
+  (list "bob"))
+(gitea-act-test
+  "recipients exclude the actor"
+  (gitea/notify-recipients
+    ga-forge
+    (feed/activity
+      "alice"
+      "comment"
+      "issue:alice/proj#1"
+      30
+      (list "repo:alice/proj")))
+  (list "bob"))
+
+(define ga-pend (gitea/pending-notifications ga-forge))
+(gitea-act-test
+  "pending message count"
+  (len (get ga-pend :messages))
+  4)
+(gitea-act-test "pending last seq" (get ga-pend :last-seq) 9)
+
+(define ga-out1 (gitea/notify! ga-forge))
+(gitea-act-test
+  "notify delivers all"
+  (len (filter (fn (o) (= (first o) "delivered")) ga-out1))
+  4)
+(gitea-act-test "inbox alice" (gitea/inbox-count ga-forge "alice") 1)
+(gitea-act-test
+  "inbox alice body"
+  (get (first (gitea/inbox ga-forge "alice")) :body)
+  "bob comment issue:alice/proj#1")
+(gitea-act-test "inbox bob" (gitea/inbox-count ga-forge "bob") 3)
+
+(gitea-act-test "notify rerun is a no-op" (gitea/notify! ga-forge) (list))
+(gitea-act-test
+  "inboxes stable after rerun"
+  (gitea/inbox-count ga-forge "bob")
+  3)
+
+; a fresh comment (carol) notifies the author and the other commenter
+(gitea/issue-comment!
+  ga-forge
+  "alice"
+  "proj"
+  1
+  "carol"
+  "me too"
+  {:at 30})
+(define ga-out2 (gitea/notify! ga-forge))
+(gitea-act-test "incremental delivery" (len ga-out2) 2)
+(gitea-act-test
+  "inbox alice grows"
+  (gitea/inbox-count ga-forge "alice")
+  2)
+(gitea-act-test
+  "inbox bob grows"
+  (gitea/inbox-count ga-forge "bob")
+  4)
+
+; ── web ──────────────────────────────────────────────────────────────
+
+(define ga-app (gitea/app ga-forge))
+(define ga-hdr (fn (tok) (if (nil? tok) {} {:authorization (str "Bearer " tok)})))
+(define
+  ga-get
+  (fn (target tok) (ga-app (dream-request "GET" target (ga-hdr tok) ""))))
+(define
+  ga-post
+  (fn
+    (target tok body)
+    (ga-app (dream-request "POST" target (ga-hdr tok) body))))
+(define
+  ga-del
+  (fn
+    (target tok)
+    (ga-app (dream-request "DELETE" target (ga-hdr tok) ""))))
+
+(gitea-act-test
+  "activity page 200"
+  (dream-status (ga-get "/activity" nil))
+  200)
+(gitea-act-test
+  "activity page shows merges"
+  (contains? (dream-resp-body (ga-get "/activity" nil)) "merge-pr")
+  true)
+(gitea-act-test
+  "activity page hides private from anon"
+  (contains? (dream-resp-body (ga-get "/activity" nil)) "alice/sec")
+  false)
+(gitea-act-test
+  "activity page shows private to owner"
+  (contains? (dream-resp-body (ga-get "/activity" "tok-a")) "alice/sec")
+  true)
+
+(gitea-act-test
+  "repo activity page 200"
+  (dream-status (ga-get "/alice/proj/activity" nil))
+  200)
+(gitea-act-test
+  "repo activity shows pr open"
+  (contains? (dream-resp-body (ga-get "/alice/proj/activity" nil)) "open-pr")
+  true)
+(gitea-act-test
+  "private repo activity anon 404"
+  (dream-status (ga-get "/alice/sec/activity" nil))
+  404)
+(gitea-act-test
+  "private repo activity collab 200"
+  (dream-status (ga-get "/alice/sec/activity" "tok-b"))
+  200)
+
+(gitea-act-test
+  "api user activity len"
+  (len
+    (dream-json-parse
+      (dream-resp-body (ga-get "/api/users/bob/activity" nil))))
+  2)
+(gitea-act-test
+  "api user activity unknown 404"
+  (dream-status (ga-get "/api/users/zeb/activity" nil))
+  404)
+
+(gitea-act-test
+  "api dashboard anon 401"
+  (dream-status (ga-get "/api/dashboard" nil))
+  401)
+(gitea-act-test
+  "api dashboard bob"
+  (len
+    (dream-json-parse (dream-resp-body (ga-get "/api/dashboard" "tok-b"))))
+  6)
+
+(gitea-act-test
+  "api follow anon 401"
+  (dream-status (ga-post "/api/follow" nil (dream-json-encode {:target "user:bob"})))
+  401)
+(gitea-act-test
+  "api follow 200"
+  (dream-status
+    (ga-post "/api/follow" "tok-c" (dream-json-encode {:target "user:bob"})))
+  200)
+(gitea-act-test
+  "api follow recorded"
+  (gitea/follows ga-forge "carol")
+  (list "user:bob"))
+(gitea-act-test
+  "api follow bad target 400"
+  (dream-status
+    (ga-post "/api/follow" "tok-c" (dream-json-encode {:target "nope"})))
+  400)
+(gitea-act-test
+  "api unfollow 200"
+  (dream-status (ga-del "/api/follow/user:bob" "tok-c"))
+  200)
+(gitea-act-test
+  "api unfollow missing 404"
+  (dream-status (ga-del "/api/follow/user:bob" "tok-c"))
+  404)
+
+(gitea-act-test
+  "api notifications anon 401"
+  (dream-status (ga-get "/api/notifications" nil))
+  401)
+(gitea-act-test
+  "api notifications bodies"
+  (contains?
+    (dream-json-parse
+      (dream-resp-body (ga-get "/api/notifications" "tok-a")))
+    "bob comment issue:alice/proj#1")
+  true)
+
+(gitea-act-test
+  "api notify run anon 401"
+  (dream-status (ga-post "/api/notify/run" nil "{}"))
+  401)
+(gitea-act-test
+  "api notify run 200"
+  (dream-status (ga-post "/api/notify/run" "tok-a" "{}"))
+  200)

lib/gitea/tests/fed.sx

@@ -0,0 +1,371 @@
+; lib/gitea/tests/fed.sx — Phase 8: ForgeFed. Two in-memory forges:
+; AP actor docs + outbox, trust-gated inbox with provenance log and
+; materialized federated issues/comments/PRs (proxy users), cursor-based
+; outbound delivery, cross-instance repo mirrors, federated timeline.
+
+(st-bootstrap-classes!)
+(content/bootstrap!)
+(content-bootstrap-markdown!)
+(content-bootstrap-table!)
+
+(define gitea-fed-pass 0)
+(define gitea-fed-fail 0)
+(define gitea-fed-fails (list))
+
+(define
+  gitea-fed-test
+  (fn
+    (name actual expected)
+    (if
+      (= actual expected)
+      (set! gitea-fed-pass (+ gitea-fed-pass 1))
+      (begin
+        (set! gitea-fed-fail (+ gitea-fed-fail 1))
+        (set! gitea-fed-fails (append gitea-fed-fails (list {:name name :expected (inspect expected) :actual (inspect actual)})))))))
+
+; ── forge A ──────────────────────────────────────────────────────────
+
+(define gf-dbA (persist/mem-backend))
+(define gf-A (gitea/forge gf-dbA))
+(gitea/instance! gf-A "forge-a")
+(gitea/user-create! gf-A "alice")
+(gitea/org-create! gf-A "acme")
+(gitea/repo-create! gf-A "alice" "lib" {:created-at 1})
+(gitea/repo-create! gf-A "alice" "hid" {:created-at 2 :visibility "private"})
+
+(define gf-gA (gitea/repo-git gf-A "alice" "lib"))
+(git/add! gf-gA "README.md" "the lib\n")
+(git/commit! gf-gA {:message "c1" :time 3 :author "alice"})
+
+(gitea/issue-create!
+  gf-A
+  "alice"
+  "lib"
+  "alice"
+  "Public issue"
+  "hello"
+  {:created-at 4})
+(gitea/issue-create!
+  gf-A
+  "alice"
+  "hid"
+  "alice"
+  "Hidden issue"
+  "shh"
+  {:created-at 5})
+
+; ── forge B ──────────────────────────────────────────────────────────
+
+(define gf-dbB (persist/mem-backend))
+(define gf-B (gitea/forge gf-dbB))
+(gitea/instance! gf-B "forge-b")
+(gitea/user-create! gf-B "bob")
+(gitea/repo-create! gf-B "bob" "hub" {:created-at 10})
+
+(define gf-gB (gitea/repo-git gf-B "bob" "hub"))
+(git/add! gf-gB "main.txt" "hub main\n")
+(git/commit! gf-gB {:message "h1" :time 11 :author "bob"})
+(git/branch! gf-gB "feat")
+(git/checkout! gf-gB "feat")
+(git/add! gf-gB "feat.txt" "hub feat\n")
+(git/commit! gf-gB {:message "h2" :time 12 :author "bob"})
+(git/checkout! gf-gB "main")
+
+(define gf-appA (gitea/app gf-A))
+(define gf-appB (gitea/app gf-B))
+(gitea/peer-register! gf-B "forge-a" gf-appA nil)
+(gitea/peer-register! gf-A "forge-b" gf-appB nil)
+
+; ── identity + actor documents ───────────────────────────────────────
+
+(gitea-fed-test "instance id" (gitea/instance-id gf-A) "forge-a")
+(gitea-fed-test
+  "actor id"
+  (gitea/actor-id gf-A "user:alice")
+  "forge-a/user:alice")
+
+(gitea-fed-test
+  "ap user type"
+  (get (gitea/ap-user gf-A "alice") :type)
+  "Person")
+(gitea-fed-test
+  "ap user id"
+  (get (gitea/ap-user gf-A "alice") :id)
+  "forge-a/user:alice")
+(gitea-fed-test
+  "ap org type"
+  (get (gitea/ap-user gf-A "acme") :type)
+  "Group")
+(gitea-fed-test "ap user missing" (gitea/ap-user gf-A "zeb") nil)
+
+(gitea-fed-test
+  "ap repo type"
+  (get (gitea/ap-repo gf-A "alice" "lib") :type)
+  "Repository")
+(gitea-fed-test
+  "ap repo attribution"
+  (get (gitea/ap-repo gf-A "alice" "lib") :attributedTo)
+  "forge-a/user:alice")
+(gitea-fed-test
+  "ap repo clone endpoint"
+  (get (gitea/ap-repo gf-A "alice" "lib") :clone)
+  "/alice/lib/info/refs")
+
+(gitea-fed-test
+  "outbox is ap-shaped"
+  (get (first (gitea/ap-outbox gf-A "alice" 10)) :actor)
+  "forge-a/user:alice")
+(gitea-fed-test
+  "outbox hides private repos"
+  (len (gitea/ap-outbox gf-A "alice" 10))
+  2)
+
+; ── trust ────────────────────────────────────────────────────────────
+
+(gitea-fed-test "untrusted by default" (gitea/trusted? gf-B "forge-a") false)
+(gitea-fed-test
+  "inbox rejects untrusted"
+  (get (gitea/fed-receive! gf-B "forge-a" {:verb "open-issue"}) :error)
+  "untrusted-peer")
+(gitea-fed-test
+  "rejected activity not logged"
+  (len (gitea/fed-log gf-B))
+  0)
+
+(gitea/trust! gf-B "forge-a")
+(gitea-fed-test "trusted after trust!" (gitea/trusted? gf-B "forge-a") true)
+(gitea-fed-test "trusted peers" (gitea/trusted-peers gf-B) (list "forge-a"))
+
+; ── inbound materialization ──────────────────────────────────────────
+
+(define gf-r1 (gitea/fed-receive! gf-B "forge-a" {:actor "forge-a/user:alice" :detail {:title "Fed issue" :body "opened from forge-a"} :object "issue:bob/hub#0" :at 50 :tags (list "repo:bob/hub") :verb "open-issue"}))
+
+(gitea-fed-test "fed issue accepted" (get gf-r1 :materialized) "issue")
+(gitea-fed-test "fed issue number" (get gf-r1 :number) 1)
+(gitea-fed-test
+  "proxy user created"
+  (gitea/owner-exists? gf-B "alice@forge-a")
+  true)
+(gitea-fed-test
+  "fed issue author"
+  (get (gitea/issue-get gf-B "bob" "hub" 1) :author)
+  "alice@forge-a")
+(gitea-fed-test
+  "fed issue title"
+  (get (gitea/issue-get gf-B "bob" "hub" 1) :title)
+  "Fed issue")
+(gitea-fed-test
+  "fed log provenance"
+  (get (first (gitea/fed-log gf-B)) :origin)
+  "forge-a")
+
+(define gf-owners-before (len (gitea/owners gf-B)))
+(define gf-r2 (gitea/fed-receive! gf-B "forge-a" {:actor "forge-a/user:alice" :detail {:body "following up"} :object "issue:bob/hub#1" :at 51 :tags (list "repo:bob/hub") :verb "comment"}))
+
+(gitea-fed-test "fed comment accepted" (get gf-r2 :materialized) "comment")
+(gitea-fed-test
+  "fed comment recorded"
+  (len (get (gitea/issue-get gf-B "bob" "hub" 1) :comments))
+  1)
+(gitea-fed-test
+  "proxy user reused"
+  (len (gitea/owners gf-B))
+  gf-owners-before)
+
+(define gf-r3 (gitea/fed-receive! gf-B "forge-a" {:actor "forge-a/user:alice" :detail {:source "feat" :title "Fed PR" :body "take my branch" :target "main"} :object "pr:bob/hub#0" :at 52 :tags (list "repo:bob/hub") :verb "open-pr"}))
+
+(gitea-fed-test "fed pr accepted" (get gf-r3 :materialized) "pr")
+(gitea-fed-test
+  "fed pr author"
+  (get (gitea/pr-get gf-B "bob" "hub" (get gf-r3 :number)) :author)
+  "alice@forge-a")
+(gitea-fed-test
+  "fed pr branches"
+  (get (gitea/pr-get gf-B "bob" "hub" (get gf-r3 :number)) :source)
+  "feat")
+
+(gitea-fed-test
+  "unknown verb still logged"
+  (get (gitea/fed-receive! gf-B "forge-a" {:actor "forge-a/user:alice" :object "repo:bob/hub" :at 53 :tags (list "repo:bob/hub") :verb "star"}) :materialized)
+  "none")
+(gitea-fed-test
+  "comment with bad object"
+  (get (gitea/fed-receive! gf-B "forge-a" {:actor "forge-a/user:alice" :object "nonsense" :at 54 :verb "comment"}) :error)
+  "bad-object")
+(gitea-fed-test "fed log grows" (len (gitea/fed-log gf-B)) 5)
+
+; ── inbox over the wire ──────────────────────────────────────────────
+
+(define
+  gf-postB
+  (fn
+    (body)
+    (gf-appB (dream-request "POST" "/api/ap/inbox" {} body))))
+
+(gitea-fed-test
+  "web inbox missing peer 400"
+  (dream-status (gf-postB (dream-json-encode {:activity {}})))
+  400)
+(gitea-fed-test
+  "web inbox untrusted 403"
+  (dream-status (gf-postB (dream-json-encode {:activity {} :peer "forge-x"})))
+  403)
+(gitea-fed-test
+  "web inbox trusted 200"
+  (dream-status (gf-postB (dream-json-encode {:activity {:actor "forge-a/user:alice" :detail {:body "via web"} :object "issue:bob/hub#1" :at 55 :tags (list "repo:bob/hub") :verb "comment"} :peer "forge-a"})))
+  200)
+(gitea-fed-test
+  "web inbox materialized"
+  (len (get (gitea/issue-get gf-B "bob" "hub" 1) :comments))
+  2)
+
+; ── mirrors (cross-instance repo follow) ─────────────────────────────
+
+(define gf-m1 (gitea/mirror! gf-B "bob" "libmirror" "forge-a" "alice" "lib"))
+(gitea-fed-test "mirror clones" (get gf-m1 :owner) "bob")
+(gitea-fed-test
+  "mirror branch matches upstream"
+  (git/branch-get (gitea/repo-git gf-B "bob" "libmirror") "main")
+  (git/branch-get gf-gA "main"))
+(gitea-fed-test
+  "mirror recorded"
+  (get (gitea/mirror-of gf-B "bob" "libmirror") :peer)
+  "forge-a")
+(gitea-fed-test "mirrors list" (gitea/mirrors gf-B) (list "bob/libmirror"))
+
+(git/checkout! gf-gA "main")
+(git/add! gf-gA "more.txt" "more\n")
+(define gf-c2 (git/commit! gf-gA {:message "c2" :time 6 :author "alice"}))
+
+(gitea-fed-test
+  "mirror-sync pulls new commits"
+  (get (gitea/mirror-sync! gf-B "bob" "libmirror") :stored)
+  3)
+(gitea-fed-test
+  "mirror advanced"
+  (git/branch-get (gitea/repo-git gf-B "bob" "libmirror") "main")
+  gf-c2)
+
+(gitea/untrust! gf-B "forge-a")
+(gitea-fed-test
+  "sync of untrusted peer refused"
+  (get (gitea/mirror-sync! gf-B "bob" "libmirror") :error)
+  "untrusted-peer")
+(gitea-fed-test
+  "mirror of untrusted peer refused"
+  (get (gitea/mirror! gf-B "bob" "another" "forge-a" "alice" "lib") :error)
+  "untrusted-peer")
+(gitea/trust! gf-B "forge-a")
+(gitea-fed-test
+  "sync ok after re-trust"
+  (get (gitea/mirror-sync! gf-B "bob" "libmirror") :stored)
+  0)
+(gitea-fed-test
+  "non-mirror sync refused"
+  (get (gitea/mirror-sync! gf-B "bob" "hub") :error)
+  "not-a-mirror")
+
+; ── outbound delivery ────────────────────────────────────────────────
+
+(gitea/trust! gf-A "forge-b")
+(define gf-d1 (gitea/fed-deliver! gf-A))
+
+; A's public activity so far: create-repo lib, open-issue lib#1,
+; comment... none; private create/issue excluded
+(gitea-fed-test
+  "deliver pushes public only"
+  (get gf-d1 :delivered)
+  2)
+(gitea-fed-test
+  "deliver reaches trusted peers"
+  (get gf-d1 :peers)
+  (list "forge-b"))
+(gitea-fed-test
+  "peer logged deliveries"
+  (len (gitea/fed-log gf-B))
+  8)
+(gitea-fed-test
+  "delivered origin"
+  (get
+    (first
+      (filter
+        (fn (e) (= (get (get e :activity) :verb) "create-repo"))
+        (gitea/fed-log gf-B)))
+    :origin)
+  "forge-a")
+
+(gitea-fed-test
+  "second deliver is a no-op"
+  (get (gitea/fed-deliver! gf-A) :delivered)
+  0)
+
+(gitea/issue-comment!
+  gf-A
+  "alice"
+  "lib"
+  1
+  "alice"
+  "one more"
+  {:at 7})
+(gitea-fed-test
+  "incremental deliver"
+  (get (gitea/fed-deliver! gf-A) :delivered)
+  1)
+
+; ── federated timeline ───────────────────────────────────────────────
+
+(define gf-tl (gitea/fed-timeline gf-B nil 100))
+(gitea-fed-test
+  "fed timeline mixes local and foreign"
+  (>
+    (len (filter (fn (a) (= (get a :origin) "forge-a")) gf-tl))
+    0)
+  true)
+(gitea-fed-test
+  "local activities carry no origin"
+  (>
+    (len
+      (filter
+        (fn
+          (a)
+          (and (nil? (get a :origin)) (= (get a :verb) "create-repo")))
+        gf-tl))
+    0)
+  true)
+
+; ── actor docs over the wire ─────────────────────────────────────────
+
+(define
+  gf-getA
+  (fn (target) (gf-appA (dream-request "GET" target {} ""))))
+
+(gitea-fed-test
+  "web ap user 200"
+  (dream-status (gf-getA "/api/ap/users/alice"))
+  200)
+(gitea-fed-test
+  "web ap user type"
+  (get
+    (dream-json-parse (dream-resp-body (gf-getA "/api/ap/users/alice")))
+    :type)
+  "Person")
+(gitea-fed-test
+  "web ap user missing 404"
+  (dream-status (gf-getA "/api/ap/users/zeb"))
+  404)
+(gitea-fed-test
+  "web ap repo 200"
+  (dream-status (gf-getA "/api/ap/repos/alice/lib"))
+  200)
+(gitea-fed-test
+  "web ap private repo hidden"
+  (dream-status (gf-getA "/api/ap/repos/alice/hid"))
+  404)
+(gitea-fed-test
+  "web outbox 200"
+  (dream-status (gf-getA "/api/ap/users/alice/outbox"))
+  200)
+(gitea-fed-test
+  "web fed timeline 200"
+  (dream-status (gf-getA "/api/fed/timeline"))
+  200)

lib/gitea/tests/issues.sx

@@ -0,0 +1,571 @@
+; lib/gitea/tests/issues.sx — Phase 4: issue CRUD, comments, labels,
+; assignees, content-document bodies (Markdown round-trip + HTML render),
+; the derived relations graph, repo-delete purge regression, and the
+; issue web routes + JSON API.
+
+(st-bootstrap-classes!)
+(content/bootstrap!)
+(content-bootstrap-markdown!)
+(content-bootstrap-table!)
+
+(define gitea-issues-pass 0)
+(define gitea-issues-fail 0)
+(define gitea-issues-fails (list))
+
+(define
+  gitea-issues-test
+  (fn
+    (name actual expected)
+    (if
+      (= actual expected)
+      (set! gitea-issues-pass (+ gitea-issues-pass 1))
+      (begin
+        (set! gitea-issues-fail (+ gitea-issues-fail 1))
+        (set!
+          gitea-issues-fails
+          (append gitea-issues-fails (list {:name name :expected (inspect expected) :actual (inspect actual)})))))))
+
+; ── helpers ──────────────────────────────────────────────────────────
+
+(gitea-issues-test "pad8" (gitea/pad8 7) "00000007")
+(gitea-issues-test "pad8 wide" (gitea/pad8 12345) "00012345")
+(gitea-issues-test "digits? yes" (gitea/digits? "123") true)
+(gitea-issues-test "digits? no" (gitea/digits? "12a") false)
+(gitea-issues-test "digits? empty" (gitea/digits? "") false)
+
+; ── setup ────────────────────────────────────────────────────────────
+
+(define gi-db (persist/mem-backend))
+(define gi-forge (gitea/forge gi-db))
+(gitea/user-create! gi-forge "alice")
+(gitea/user-create! gi-forge "bob")
+(gitea/user-create! gi-forge "carol")
+(gitea/user-create! gi-forge "eve")
+(gitea/repo-create! gi-forge "alice" "proj" {})
+(gitea/repo-create! gi-forge "alice" "sec" {:visibility "private"})
+(gitea/collab-add! gi-forge "alice" "sec" "bob" "read")
+(gitea/token-create! gi-forge "alice" "tok-a")
+(gitea/token-create! gi-forge "bob" "tok-b")
+(gitea/token-create! gi-forge "eve" "tok-e")
+
+; ── issue CRUD ───────────────────────────────────────────────────────
+
+(define
+  gi-i1
+  (gitea/issue-create!
+    gi-forge
+    "alice"
+    "proj"
+    "alice"
+    "Crash on boot"
+    "It crashes."
+    {:created-at 10}))
+
+(gitea-issues-test "create number" (get gi-i1 :number) 1)
+(gitea-issues-test "create state" (get gi-i1 :state) "open")
+(gitea-issues-test "create title" (get gi-i1 :title) "Crash on boot")
+(gitea-issues-test "create author" (get gi-i1 :author) "alice")
+(gitea-issues-test "create created-at" (get gi-i1 :created-at) 10)
+
+(define
+  gi-i2
+  (gitea/issue-create!
+    gi-forge
+    "alice"
+    "proj"
+    "bob"
+    "Add docs"
+    "Docs please."
+    {}))
+(gitea-issues-test "second number" (get gi-i2 :number) 2)
+
+(gitea-issues-test
+  "issue-get"
+  (get (gitea/issue-get gi-forge "alice" "proj" 1) :title)
+  "Crash on boot")
+(gitea-issues-test
+  "issues list"
+  (gitea/issues gi-forge "alice" "proj")
+  (list 1 2))
+(gitea-issues-test
+  "issue-records len"
+  (len (gitea/issue-records gi-forge "alice" "proj"))
+  2)
+
+(gitea-issues-test
+  "create on missing repo"
+  (get
+    (gitea/issue-create! gi-forge "alice" "none" "alice" "t" "" {})
+    :error)
+  "no-such-repo")
+(gitea-issues-test
+  "create by missing user"
+  (get
+    (gitea/issue-create! gi-forge "alice" "proj" "zeb" "t" "" {})
+    :error)
+  "no-such-user")
+(gitea-issues-test
+  "create empty title"
+  (get
+    (gitea/issue-create! gi-forge "alice" "proj" "alice" "" "" {})
+    :error)
+  "empty-title")
+
+(gitea/issue-close! gi-forge "alice" "proj" 2)
+(gitea-issues-test
+  "close!"
+  (get (gitea/issue-get gi-forge "alice" "proj" 2) :state)
+  "closed")
+(gitea/issue-reopen! gi-forge "alice" "proj" 2)
+(gitea-issues-test
+  "reopen!"
+  (get (gitea/issue-get gi-forge "alice" "proj" 2) :state)
+  "open")
+(gitea-issues-test
+  "close missing"
+  (gitea/issue-close! gi-forge "alice" "proj" 99)
+  nil)
+(gitea/issue-close! gi-forge "alice" "proj" 2)
+
+; ── comments ─────────────────────────────────────────────────────────
+
+(gitea-issues-test
+  "comment author"
+  (get
+    (gitea/issue-comment!
+      gi-forge
+      "alice"
+      "proj"
+      1
+      "bob"
+      "Repro *here*."
+      {:at 11})
+    :author)
+  "bob")
+(gitea/issue-comment!
+  gi-forge
+  "alice"
+  "proj"
+  1
+  "carol"
+  "Same for me."
+  {:at 12})
+
+(gitea-issues-test
+  "comments appended"
+  (len (get (gitea/issue-get gi-forge "alice" "proj" 1) :comments))
+  2)
+(gitea-issues-test
+  "comment order"
+  (get
+    (first
+      (get (gitea/issue-get gi-forge "alice" "proj" 1) :comments))
+    :body)
+  "Repro *here*.")
+(gitea-issues-test
+  "comment on missing issue"
+  (get
+    (gitea/issue-comment!
+      gi-forge
+      "alice"
+      "proj"
+      99
+      "bob"
+      "x"
+      {})
+    :error)
+  "no-such-issue")
+(gitea-issues-test
+  "comment by missing user"
+  (get
+    (gitea/issue-comment!
+      gi-forge
+      "alice"
+      "proj"
+      1
+      "zeb"
+      "x"
+      {})
+    :error)
+  "no-such-user")
+
+; ── labels / assignees ───────────────────────────────────────────────
+
+(gitea/issue-label! gi-forge "alice" "proj" 1 "ui")
+(gitea/issue-label! gi-forge "alice" "proj" 1 "bug")
+(gitea-issues-test
+  "labels sorted"
+  (get (gitea/issue-get gi-forge "alice" "proj" 1) :labels)
+  (list "bug" "ui"))
+(gitea/issue-label! gi-forge "alice" "proj" 1 "bug")
+(gitea-issues-test
+  "label idempotent"
+  (get (gitea/issue-get gi-forge "alice" "proj" 1) :labels)
+  (list "bug" "ui"))
+(gitea/issue-unlabel! gi-forge "alice" "proj" 1 "bug")
+(gitea-issues-test
+  "unlabel"
+  (get (gitea/issue-get gi-forge "alice" "proj" 1) :labels)
+  (list "ui"))
+(gitea-issues-test
+  "invalid label"
+  (get (gitea/issue-label! gi-forge "alice" "proj" 1 "") :error)
+  "invalid-label")
+
+(gitea/issue-assign! gi-forge "alice" "proj" 2 "carol")
+(gitea-issues-test
+  "assign"
+  (get (gitea/issue-get gi-forge "alice" "proj" 2) :assignees)
+  (list "carol"))
+(gitea-issues-test
+  "assign unknown user"
+  (get (gitea/issue-assign! gi-forge "alice" "proj" 2 "zeb") :error)
+  "no-such-user")
+
+; ── views ────────────────────────────────────────────────────────────
+
+(gitea-issues-test
+  "issues-open"
+  (len (gitea/issues-open gi-forge "alice" "proj"))
+  1)
+(gitea-issues-test
+  "issues-closed"
+  (len (gitea/issues-closed gi-forge "alice" "proj"))
+  1)
+(gitea-issues-test
+  "issues-with-label"
+  (map
+    (fn (r) (get r :number))
+    (gitea/issues-with-label gi-forge "alice" "proj" "ui"))
+  (list 1))
+(gitea-issues-test
+  "issues-assigned"
+  (map
+    (fn (r) (get r :number))
+    (gitea/issues-assigned gi-forge "alice" "proj" "carol"))
+  (list 2))
+
+; ── content documents ────────────────────────────────────────────────
+
+(define gi-md "# Heading\n\npara text.\n\n```sx\n(+ 1 2)\n```")
+(define
+  gi-i3
+  (gitea/issue-create!
+    gi-forge
+    "alice"
+    "proj"
+    "alice"
+    "With md body"
+    gi-md
+    {}))
+(define gi-doc (gitea/issue-doc "alice" "proj" gi-i3))
+
+(gitea-issues-test "issue doc block count" (content/count gi-doc) 3)
+(gitea-issues-test
+  "issue doc types"
+  (content/types gi-doc)
+  (list "heading" "text" "code"))
+(gitea-issues-test
+  "issue html heading"
+  (contains? (gitea/issue-html "alice" "proj" gi-i3) "<h1>Heading</h1>")
+  true)
+(gitea-issues-test
+  "issue html code block"
+  (contains? (gitea/issue-html "alice" "proj" gi-i3) "<pre><code")
+  true)
+(gitea-issues-test "markdown round trip" (content/markdown gi-doc) gi-md)
+(gitea-issues-test
+  "comment md renders"
+  (contains? (gitea/md-html "Repro *here*." "t1") "<p>")
+  true)
+
+; ── relations graph ──────────────────────────────────────────────────
+
+(gitea-issues-test
+  "repo issue nodes"
+  (gitea/repo-issue-nodes gi-forge "alice" "proj")
+  (list "issue:alice/proj#1" "issue:alice/proj#2" "issue:alice/proj#3"))
+(gitea-issues-test
+  "authored by alice"
+  (gitea/user-authored gi-forge "alice")
+  (list "issue:alice/proj#1" "issue:alice/proj#3"))
+(gitea-issues-test
+  "authored by bob"
+  (gitea/user-authored gi-forge "bob")
+  (list "issue:alice/proj#2"))
+(gitea-issues-test
+  "assigned to carol"
+  (gitea/user-assigned gi-forge "carol")
+  (list "issue:alice/proj#2"))
+(gitea-issues-test
+  "label issues"
+  (gitea/label-issues gi-forge "alice" "proj" "ui")
+  (list "issue:alice/proj#1"))
+(gitea-issues-test
+  "participants incl commenters"
+  (gitea/issue-participants gi-forge "alice" "proj" 1)
+  (list "user:alice" "user:bob" "user:carol"))
+(gitea-issues-test
+  "participants author+assignee"
+  (gitea/issue-participants gi-forge "alice" "proj" 2)
+  (list "user:bob" "user:carol"))
+
+; ── repo delete purges issue state ───────────────────────────────────
+
+(gitea/repo-create! gi-forge "alice" "tmp" {})
+(gitea/issue-create! gi-forge "alice" "tmp" "alice" "Ghost?" "" {})
+(gitea/collab-add! gi-forge "alice" "tmp" "carol" "write")
+(gitea/repo-delete! gi-forge "alice" "tmp")
+(gitea/repo-create! gi-forge "alice" "tmp" {})
+
+(gitea-issues-test
+  "recreated repo has no ghost issues"
+  (gitea/issues gi-forge "alice" "tmp")
+  (list))
+(gitea-issues-test
+  "recreated repo has no ghost collabs"
+  (gitea/collabs gi-forge "alice" "tmp")
+  (list))
+(gitea-issues-test
+  "issue numbering restarts"
+  (get
+    (gitea/issue-create! gi-forge "alice" "tmp" "alice" "Fresh" "" {})
+    :number)
+  1)
+(gitea/repo-delete! gi-forge "alice" "tmp")
+(gitea-issues-test
+  "deleted repo leaves no issue edges"
+  (gitea/repo-issue-nodes gi-forge "alice" "tmp")
+  (list))
+
+; ── web routes ───────────────────────────────────────────────────────
+
+(define gi-app (gitea/app gi-forge))
+(define gi-hdr (fn (tok) (if (nil? tok) {} {:authorization (str "Bearer " tok)})))
+(define
+  gi-get
+  (fn (target tok) (gi-app (dream-request "GET" target (gi-hdr tok) ""))))
+(define
+  gi-post
+  (fn
+    (target tok body)
+    (gi-app (dream-request "POST" target (gi-hdr tok) body))))
+(define
+  gi-put
+  (fn
+    (target tok body)
+    (gi-app (dream-request "PUT" target (gi-hdr tok) body))))
+(define
+  gi-del
+  (fn
+    (target tok)
+    (gi-app (dream-request "DELETE" target (gi-hdr tok) ""))))
+
+(gitea-issues-test
+  "issues page 200"
+  (dream-status (gi-get "/alice/proj/issues" nil))
+  200)
+(gitea-issues-test
+  "issues page lists title"
+  (contains?
+    (dream-resp-body (gi-get "/alice/proj/issues" nil))
+    "Crash on boot")
+  true)
+(gitea-issues-test
+  "issues page shows state"
+  (contains? (dream-resp-body (gi-get "/alice/proj/issues" nil)) "[closed]")
+  true)
+
+(gitea-issues-test
+  "issue page 200"
+  (dream-status (gi-get "/alice/proj/issues/1" nil))
+  200)
+(gitea-issues-test
+  "issue page shows author"
+  (contains? (dream-resp-body (gi-get "/alice/proj/issues/1" nil)) "alice")
+  true)
+(gitea-issues-test
+  "issue page renders body html"
+  (contains?
+    (dream-resp-body (gi-get "/alice/proj/issues/3" nil))
+    "<h1>Heading</h1>")
+  true)
+(gitea-issues-test
+  "issue page renders comments"
+  (contains?
+    (dream-resp-body (gi-get "/alice/proj/issues/1" nil))
+    "Same for me.")
+  true)
+(gitea-issues-test
+  "issue page bad number 404"
+  (dream-status (gi-get "/alice/proj/issues/abc" nil))
+  404)
+(gitea-issues-test
+  "issue page missing 404"
+  (dream-status (gi-get "/alice/proj/issues/99" nil))
+  404)
+(gitea-issues-test
+  "private issues anon 404"
+  (dream-status (gi-get "/alice/sec/issues" nil))
+  404)
+(gitea-issues-test
+  "private issues collab 200"
+  (dream-status (gi-get "/alice/sec/issues" "tok-b"))
+  200)
+
+(gitea-issues-test
+  "api issues len"
+  (len
+    (dream-json-parse
+      (dream-resp-body (gi-get "/api/repos/alice/proj/issues" nil))))
+  3)
+(gitea-issues-test
+  "api issues first number"
+  (get
+    (first
+      (dream-json-parse
+        (dream-resp-body (gi-get "/api/repos/alice/proj/issues" nil))))
+    :number)
+  1)
+
+(gitea-issues-test
+  "api create anon 401"
+  (dream-status
+    (gi-post
+      "/api/repos/alice/proj/issues"
+      nil
+      (dream-json-encode {:title "t"})))
+  401)
+(gitea-issues-test
+  "api create reader 201"
+  (dream-status
+    (gi-post
+      "/api/repos/alice/proj/issues"
+      "tok-e"
+      (dream-json-encode {:title "From eve" :body "hi"})))
+  201)
+(gitea-issues-test
+  "api created number"
+  (len (gitea/issues gi-forge "alice" "proj"))
+  4)
+(gitea-issues-test
+  "api create on private hidden 404"
+  (dream-status
+    (gi-post
+      "/api/repos/alice/sec/issues"
+      "tok-e"
+      (dream-json-encode {:title "x"})))
+  404)
+(gitea-issues-test
+  "api create empty title 400"
+  (dream-status
+    (gi-post
+      "/api/repos/alice/proj/issues"
+      "tok-e"
+      (dream-json-encode {:title ""})))
+  400)
+
+(gitea-issues-test
+  "api comment 200"
+  (dream-status
+    (gi-post
+      "/api/repos/alice/proj/issues/4/comments"
+      "tok-b"
+      (dream-json-encode {:body "noted"})))
+  200)
+(gitea-issues-test
+  "api comment recorded"
+  (len (get (gitea/issue-get gi-forge "alice" "proj" 4) :comments))
+  1)
+(gitea-issues-test
+  "api comment anon 401"
+  (dream-status
+    (gi-post
+      "/api/repos/alice/proj/issues/4/comments"
+      nil
+      (dream-json-encode {:body "x"})))
+  401)
+(gitea-issues-test
+  "api comment missing issue 404"
+  (dream-status
+    (gi-post
+      "/api/repos/alice/proj/issues/99/comments"
+      "tok-b"
+      (dream-json-encode {:body "x"})))
+  404)
+
+; eve authored #4 and may close it without write; reopen as alice (write)
+(gitea-issues-test
+  "api close by author 200"
+  (dream-status (gi-post "/api/repos/alice/proj/issues/4/close" "tok-e" "{}"))
+  200)
+(gitea-issues-test
+  "api close applied"
+  (get (gitea/issue-get gi-forge "alice" "proj" 4) :state)
+  "closed")
+(gitea-issues-test
+  "api reopen by write 200"
+  (dream-status
+    (gi-post "/api/repos/alice/proj/issues/4/reopen" "tok-a" "{}"))
+  200)
+
+; issue #5: authored by alice — eve (reader, not author) may not close
+(gitea/issue-create!
+  gi-forge
+  "alice"
+  "proj"
+  "alice"
+  "Owner issue"
+  ""
+  {})
+(gitea-issues-test
+  "api close by stranger 403"
+  (dream-status (gi-post "/api/repos/alice/proj/issues/5/close" "tok-e" "{}"))
+  403)
+
+(gitea-issues-test
+  "api label put by write 200"
+  (dream-status
+    (gi-put "/api/repos/alice/proj/issues/5/labels/bug" "tok-a" "{}"))
+  200)
+(gitea-issues-test
+  "api label applied"
+  (get (gitea/issue-get gi-forge "alice" "proj" 5) :labels)
+  (list "bug"))
+(gitea-issues-test
+  "api label by reader 403"
+  (dream-status
+    (gi-put "/api/repos/alice/proj/issues/5/labels/x" "tok-e" "{}"))
+  403)
+(gitea-issues-test
+  "api label delete 200"
+  (dream-status (gi-del "/api/repos/alice/proj/issues/5/labels/bug" "tok-a"))
+  200)
+(gitea-issues-test
+  "api label removed"
+  (get (gitea/issue-get gi-forge "alice" "proj" 5) :labels)
+  (list))
+
+(gitea-issues-test
+  "api assign 200"
+  (dream-status
+    (gi-put "/api/repos/alice/proj/issues/5/assignees/bob" "tok-a" "{}"))
+  200)
+(gitea-issues-test
+  "api assign applied"
+  (get (gitea/issue-get gi-forge "alice" "proj" 5) :assignees)
+  (list "bob"))
+(gitea-issues-test
+  "api assign unknown user 400"
+  (dream-status
+    (gi-put "/api/repos/alice/proj/issues/5/assignees/zeb" "tok-a" "{}"))
+  400)
+(gitea-issues-test
+  "api unassign 200"
+  (dream-status
+    (gi-del "/api/repos/alice/proj/issues/5/assignees/bob" "tok-a"))
+  200)
+(gitea-issues-test
+  "api unassign applied"
+  (get (gitea/issue-get gi-forge "alice" "proj" 5) :assignees)
+  (list))

lib/gitea/tests/pr.sx

@@ -0,0 +1,865 @@
+; lib/gitea/tests/pr.sx — Phase 5: PR records, live merge-base diffs,
+; review threads (latest verdict per reviewer), the durable flow
+; lifecycle, all four merge shapes (merge/ff/up-to-date/conflicts), the
+; merge queue, and the PR web routes + JSON API.
+
+(st-bootstrap-classes!)
+(content/bootstrap!)
+(content-bootstrap-markdown!)
+(content-bootstrap-table!)
+
+(define gitea-pr-pass 0)
+(define gitea-pr-fail 0)
+(define gitea-pr-fails (list))
+
+(define
+  gitea-pr-test
+  (fn
+    (name actual expected)
+    (if
+      (= actual expected)
+      (set! gitea-pr-pass (+ gitea-pr-pass 1))
+      (begin
+        (set! gitea-pr-fail (+ gitea-pr-fail 1))
+        (set! gitea-pr-fails (append gitea-pr-fails (list {:name name :expected (inspect expected) :actual (inspect actual)})))))))
+
+; ── setup: repo with diverged branches ───────────────────────────────
+
+(define gp-db (persist/mem-backend))
+(define gp-forge (gitea/forge gp-db))
+(gitea/user-create! gp-forge "alice")
+(gitea/user-create! gp-forge "bob")
+(gitea/user-create! gp-forge "carol")
+(gitea/user-create! gp-forge "eve")
+(gitea/repo-create! gp-forge "alice" "proj" {})
+(gitea/repo-create! gp-forge "alice" "sec" {:visibility "private"})
+(gitea/token-create! gp-forge "alice" "tok-a")
+(gitea/token-create! gp-forge "bob" "tok-b")
+(gitea/token-create! gp-forge "carol" "tok-c")
+(gitea/token-create! gp-forge "eve" "tok-e")
+
+(define gp-g (gitea/repo-git gp-forge "alice" "proj"))
+(git/add! gp-g "README.md" "base\n")
+(git/add! gp-g "lib.txt" "lib\n")
+(define gp-c1 (git/commit! gp-g {:message "c1" :time 1 :author "alice"}))
+(git/branch! gp-g "feat")
+(git/checkout! gp-g "feat")
+(git/add! gp-g "feature.txt" "feature line\n")
+(define gp-c2 (git/commit! gp-g {:message "c2 feature" :time 2 :author "bob"}))
+(git/checkout! gp-g "main")
+(git/add! gp-g "other.txt" "other\n")
+(define gp-c3 (git/commit! gp-g {:message "c3 other" :time 3 :author "alice"}))
+
+; ── create / validate ────────────────────────────────────────────────
+
+(define
+  gp-pr1
+  (gitea/pr-create!
+    gp-forge
+    "alice"
+    "proj"
+    "bob"
+    "Add feature"
+    "feat"
+    "main"
+    "Adds a *feature*."
+    {:created-at 5}))
+
+(gitea-pr-test "pr number" (get gp-pr1 :number) 1)
+(gitea-pr-test "pr state" (get gp-pr1 :state) "open")
+(gitea-pr-test "pr source" (get gp-pr1 :source) "feat")
+(gitea-pr-test "pr target" (get gp-pr1 :target) "main")
+(gitea-pr-test "pr has flow id" (nil? (get gp-pr1 :flow-id)) false)
+(gitea-pr-test
+  "flow starts at review"
+  (gitea/pr-flow-status gp-forge gp-pr1)
+  "review")
+
+(gitea-pr-test
+  "unknown source"
+  (get
+    (gitea/pr-create!
+      gp-forge
+      "alice"
+      "proj"
+      "bob"
+      "t"
+      "nope"
+      "main"
+      ""
+      {})
+    :error)
+  "no-such-source")
+(gitea-pr-test
+  "unknown target"
+  (get
+    (gitea/pr-create!
+      gp-forge
+      "alice"
+      "proj"
+      "bob"
+      "t"
+      "feat"
+      "nope"
+      ""
+      {})
+    :error)
+  "no-such-target")
+(gitea-pr-test
+  "same branch"
+  (get
+    (gitea/pr-create!
+      gp-forge
+      "alice"
+      "proj"
+      "bob"
+      "t"
+      "main"
+      "main"
+      ""
+      {})
+    :error)
+  "same-branch")
+(gitea-pr-test
+  "empty title"
+  (get
+    (gitea/pr-create!
+      gp-forge
+      "alice"
+      "proj"
+      "bob"
+      ""
+      "feat"
+      "main"
+      ""
+      {})
+    :error)
+  "empty-title")
+(gitea-pr-test
+  "missing repo"
+  (get
+    (gitea/pr-create!
+      gp-forge
+      "alice"
+      "none"
+      "bob"
+      "t"
+      "feat"
+      "main"
+      ""
+      {})
+    :error)
+  "no-such-repo")
+(gitea-pr-test
+  "missing author"
+  (get
+    (gitea/pr-create!
+      gp-forge
+      "alice"
+      "proj"
+      "zeb"
+      "t"
+      "feat"
+      "main"
+      ""
+      {})
+    :error)
+  "no-such-user")
+
+(gitea-pr-test
+  "prs list"
+  (gitea/prs gp-forge "alice" "proj")
+  (list 1))
+
+; numbers are shared with issues
+(gitea-pr-test
+  "shared counter with issues"
+  (get
+    (gitea/issue-create!
+      gp-forge
+      "alice"
+      "proj"
+      "alice"
+      "An issue"
+      ""
+      {})
+    :number)
+  2)
+
+; ── live diff against the merge base ─────────────────────────────────
+
+(gitea-pr-test
+  "diff added"
+  (get (gitea/pr-diff gp-forge "alice" "proj" 1) :added)
+  (list "feature.txt"))
+(gitea-pr-test
+  "diff no spurious deletions"
+  (get (gitea/pr-diff gp-forge "alice" "proj" 1) :deleted)
+  (list))
+(gitea-pr-test
+  "diff unified shows addition"
+  (contains?
+    (gitea/pr-diff-unified gp-forge "alice" "proj" 1)
+    "+feature line")
+  true)
+(gitea-pr-test
+  "diff of missing pr"
+  (gitea/pr-diff gp-forge "alice" "proj" 99)
+  nil)
+
+; ── reviews ──────────────────────────────────────────────────────────
+
+(gitea/pr-review!
+  gp-forge
+  "alice"
+  "proj"
+  1
+  "carol"
+  "request-changes"
+  "needs tests"
+  {:at 6})
+(gitea-pr-test
+  "changes requested blocks approval"
+  (gitea/pr-approved? (gitea/pr-get gp-forge "alice" "proj" 1))
+  false)
+(gitea-pr-test
+  "flow still at review"
+  (gitea/pr-flow-status
+    gp-forge
+    (gitea/pr-get gp-forge "alice" "proj" 1))
+  "review")
+
+(gitea-pr-test
+  "author cannot review own pr"
+  (get
+    (gitea/pr-review!
+      gp-forge
+      "alice"
+      "proj"
+      1
+      "bob"
+      "approve"
+      ""
+      {})
+    :error)
+  "own-pr")
+(gitea-pr-test
+  "invalid verdict"
+  (get
+    (gitea/pr-review!
+      gp-forge
+      "alice"
+      "proj"
+      1
+      "carol"
+      "meh"
+      ""
+      {})
+    :error)
+  "invalid-verdict")
+(gitea-pr-test
+  "unknown reviewer"
+  (get
+    (gitea/pr-review!
+      gp-forge
+      "alice"
+      "proj"
+      1
+      "zeb"
+      "approve"
+      ""
+      {})
+    :error)
+  "no-such-user")
+(gitea-pr-test
+  "review missing pr"
+  (get
+    (gitea/pr-review!
+      gp-forge
+      "alice"
+      "proj"
+      99
+      "carol"
+      "approve"
+      ""
+      {})
+    :error)
+  "no-such-pr")
+
+(gitea/pr-review!
+  gp-forge
+  "alice"
+  "proj"
+  1
+  "carol"
+  "approve"
+  "looks good now"
+  {:at 7})
+(gitea-pr-test
+  "latest verdict wins"
+  (gitea/pr-approved? (gitea/pr-get gp-forge "alice" "proj" 1))
+  true)
+(gitea-pr-test
+  "reviews accumulate"
+  (len (get (gitea/pr-get gp-forge "alice" "proj" 1) :reviews))
+  2)
+(gitea-pr-test
+  "flow advanced to approved"
+  (gitea/pr-flow-status
+    gp-forge
+    (gitea/pr-get gp-forge "alice" "proj" 1))
+  "approved")
+
+; ── merge: true 3-way ────────────────────────────────────────────────
+
+(gitea-pr-test
+  "unapproved merge rejected"
+  (get
+    (gitea/pr-merge! gp-forge "alice" "proj" 2 "alice" {})
+    :error)
+  "no-such-pr")
+
+(define
+  gp-m1
+  (gitea/pr-merge! gp-forge "alice" "proj" 1 "alice" {:time 8}))
+
+(gitea-pr-test "merge state" (get gp-m1 :state) "merged")
+(gitea-pr-test "merge cid recorded" (nil? (get gp-m1 :merge-cid)) false)
+(gitea-pr-test
+  "main moved to merge commit"
+  (git/branch-get gp-g "main")
+  (get gp-m1 :merge-cid))
+(gitea-pr-test
+  "merge commit has two parents"
+  (git/commit-parents (git/read gp-g (get gp-m1 :merge-cid)))
+  (list gp-c3 gp-c2))
+(gitea-pr-test
+  "merged tree keeps target file"
+  (get (gitea/tree-at gp-g (get gp-m1 :merge-cid) "other.txt") :kind)
+  "blob")
+(gitea-pr-test
+  "merged tree gains source file"
+  (get (gitea/tree-at gp-g (get gp-m1 :merge-cid) "feature.txt") :kind)
+  "blob")
+(gitea-pr-test
+  "flow reports merged"
+  (gitea/pr-flow-status
+    gp-forge
+    (gitea/pr-get gp-forge "alice" "proj" 1))
+  "merged")
+(gitea-pr-test
+  "merge twice rejected"
+  (get
+    (gitea/pr-merge! gp-forge "alice" "proj" 1 "alice" {})
+    :error)
+  "not-open")
+(gitea-pr-test
+  "review after merge rejected"
+  (get
+    (gitea/pr-review!
+      gp-forge
+      "alice"
+      "proj"
+      1
+      "carol"
+      "approve"
+      ""
+      {})
+    :error)
+  "not-open")
+
+; ── merge: fast-forward ──────────────────────────────────────────────
+
+(git/checkout! gp-g "main")
+(git/branch! gp-g "hot")
+(git/checkout! gp-g "hot")
+(git/add! gp-g "hotfix.txt" "fix\n")
+(define gp-c4 (git/commit! gp-g {:message "hotfix" :time 9 :author "bob"}))
+(git/checkout! gp-g "main")
+
+(define
+  gp-pr3
+  (gitea/pr-create!
+    gp-forge
+    "alice"
+    "proj"
+    "bob"
+    "Hotfix"
+    "hot"
+    "main"
+    ""
+    {}))
+(gitea-pr-test "pr3 number" (get gp-pr3 :number) 3)
+(gitea/pr-review!
+  gp-forge
+  "alice"
+  "proj"
+  3
+  "carol"
+  "approve"
+  ""
+  {})
+(define
+  gp-m3
+  (gitea/pr-merge! gp-forge "alice" "proj" 3 "alice" {}))
+(gitea-pr-test "ff merge state" (get gp-m3 :state) "merged")
+(gitea-pr-test
+  "ff moves main to source head"
+  (git/branch-get gp-g "main")
+  gp-c4)
+(gitea-pr-test "ff merge-cid is source head" (get gp-m3 :merge-cid) gp-c4)
+
+; ── merge: up-to-date ────────────────────────────────────────────────
+
+(git/checkout! gp-g "main")
+(git/branch! gp-g "same")
+(define
+  gp-pr4
+  (gitea/pr-create!
+    gp-forge
+    "alice"
+    "proj"
+    "bob"
+    "No-op"
+    "same"
+    "main"
+    ""
+    {}))
+(gitea/pr-review!
+  gp-forge
+  "alice"
+  "proj"
+  4
+  "carol"
+  "approve"
+  ""
+  {})
+(define
+  gp-m4
+  (gitea/pr-merge! gp-forge "alice" "proj" 4 "alice" {}))
+(gitea-pr-test "up-to-date merge state" (get gp-m4 :state) "merged")
+(gitea-pr-test "up-to-date leaves main" (git/branch-get gp-g "main") gp-c4)
+
+; ── merge: conflicts ─────────────────────────────────────────────────
+
+(git/checkout! gp-g "main")
+(git/branch! gp-g "conf")
+(git/checkout! gp-g "conf")
+(git/add! gp-g "lib.txt" "conf version\n")
+(git/commit! gp-g {:message "conf change" :time 10 :author "bob"})
+(git/checkout! gp-g "main")
+(git/add! gp-g "lib.txt" "main version\n")
+(git/commit! gp-g {:message "main change" :time 11 :author "alice"})
+
+(define
+  gp-pr5
+  (gitea/pr-create!
+    gp-forge
+    "alice"
+    "proj"
+    "bob"
+    "Conflicting"
+    "conf"
+    "main"
+    ""
+    {}))
+(gitea/pr-review!
+  gp-forge
+  "alice"
+  "proj"
+  5
+  "carol"
+  "approve"
+  ""
+  {})
+(define
+  gp-m5
+  (gitea/pr-merge! gp-forge "alice" "proj" 5 "alice" {}))
+(gitea-pr-test "conflict merge errors" (get gp-m5 :error) "conflicts")
+(gitea-pr-test "conflict paths" (get gp-m5 :conflicts) (list "lib.txt"))
+(gitea-pr-test
+  "conflict leaves pr open"
+  (get (gitea/pr-get gp-forge "alice" "proj" 5) :state)
+  "open")
+(gitea-pr-test
+  "conflict leaves flow at approved"
+  (gitea/pr-flow-status
+    gp-forge
+    (gitea/pr-get gp-forge "alice" "proj" 5))
+  "approved")
+
+; ── close / reopen ───────────────────────────────────────────────────
+
+(gitea/pr-close! gp-forge "alice" "proj" 5)
+(gitea-pr-test
+  "close state"
+  (get (gitea/pr-get gp-forge "alice" "proj" 5) :state)
+  "closed")
+(gitea-pr-test
+  "close cancels flow"
+  (gitea/pr-flow-status
+    gp-forge
+    (gitea/pr-get gp-forge "alice" "proj" 5))
+  "closed")
+(gitea-pr-test
+  "merge closed pr rejected"
+  (get
+    (gitea/pr-merge! gp-forge "alice" "proj" 5 "alice" {})
+    :error)
+  "not-open")
+(gitea-pr-test
+  "close twice"
+  (gitea/pr-close! gp-forge "alice" "proj" 5)
+  nil)
+
+(gitea/pr-reopen! gp-forge "alice" "proj" 5)
+(gitea-pr-test
+  "reopen state"
+  (get (gitea/pr-get gp-forge "alice" "proj" 5) :state)
+  "open")
+(gitea-pr-test
+  "reopen restarts lifecycle"
+  (gitea/pr-flow-status
+    gp-forge
+    (gitea/pr-get gp-forge "alice" "proj" 5))
+  "review")
+
+; ── merge queue ──────────────────────────────────────────────────────
+
+(git/checkout! gp-g "main")
+(git/branch! gp-g "q1")
+(git/checkout! gp-g "q1")
+(git/add! gp-g "q1.txt" "one\n")
+(git/commit! gp-g {:message "q1" :time 12 :author "bob"})
+(git/checkout! gp-g "main")
+(git/branch! gp-g "q2")
+(git/checkout! gp-g "q2")
+(git/add! gp-g "q2.txt" "two\n")
+(git/commit! gp-g {:message "q2" :time 13 :author "bob"})
+(git/checkout! gp-g "main")
+(git/branch! gp-g "q3")
+(git/checkout! gp-g "q3")
+(git/add! gp-g "q3.txt" "three\n")
+(git/commit! gp-g {:message "q3" :time 14 :author "bob"})
+(git/checkout! gp-g "main")
+
+(define
+  gp-pr6
+  (gitea/pr-create!
+    gp-forge
+    "alice"
+    "proj"
+    "bob"
+    "Queue one"
+    "q1"
+    "main"
+    ""
+    {}))
+(define
+  gp-pr7
+  (gitea/pr-create!
+    gp-forge
+    "alice"
+    "proj"
+    "bob"
+    "Queue two"
+    "q2"
+    "main"
+    ""
+    {}))
+(define
+  gp-pr8
+  (gitea/pr-create!
+    gp-forge
+    "alice"
+    "proj"
+    "bob"
+    "Queue three"
+    "q3"
+    "main"
+    ""
+    {}))
+(gitea/pr-review!
+  gp-forge
+  "alice"
+  "proj"
+  6
+  "carol"
+  "approve"
+  ""
+  {})
+(gitea/pr-review!
+  gp-forge
+  "alice"
+  "proj"
+  7
+  "carol"
+  "approve"
+  ""
+  {})
+; pr8 stays unapproved; pr5 (reopened, approved, conflicting) joins the queue
+
+(gitea-pr-test
+  "queue starts empty"
+  (gitea/queue gp-forge "alice" "proj")
+  (list))
+(gitea-pr-test
+  "queue rejects unapproved"
+  (get (gitea/queue-add! gp-forge "alice" "proj" 8) :error)
+  "not-approved")
+(gitea-pr-test
+  "queue rejects missing"
+  (get (gitea/queue-add! gp-forge "alice" "proj" 99) :error)
+  "no-such-pr")
+
+(gitea/queue-add! gp-forge "alice" "proj" 6)
+(gitea/queue-add! gp-forge "alice" "proj" 6)
+(gitea/queue-add! gp-forge "alice" "proj" 7)
+(gitea/queue-add! gp-forge "alice" "proj" 5)
+(gitea-pr-test
+  "queue dedups"
+  (gitea/queue gp-forge "alice" "proj")
+  (list 6 7 5))
+
+(define gp-qres (gitea/queue-process! gp-forge "alice" "proj" "alice"))
+(gitea-pr-test "queue processed all" (len gp-qres) 3)
+(gitea-pr-test
+  "queue pr6 merged"
+  (get (nth gp-qres 0) :merged)
+  true)
+(gitea-pr-test
+  "queue pr7 merged"
+  (get (nth gp-qres 1) :merged)
+  true)
+(gitea-pr-test
+  "queue pr5 conflicts"
+  (get (nth gp-qres 2) :error)
+  "conflicts")
+(gitea-pr-test
+  "failures stay queued"
+  (gitea/queue gp-forge "alice" "proj")
+  (list 5))
+(gitea-pr-test
+  "pr6 state merged"
+  (get (gitea/pr-get gp-forge "alice" "proj" 6) :state)
+  "merged")
+(gitea-pr-test
+  "pr7 state merged"
+  (get (gitea/pr-get gp-forge "alice" "proj" 7) :state)
+  "merged")
+(gitea-pr-test
+  "main has both queue files"
+  (get (gitea/tree-at gp-g (git/branch-get gp-g "main") "q2.txt") :kind)
+  "blob")
+
+(gitea/queue-remove! gp-forge "alice" "proj" 5)
+(gitea-pr-test "queue-remove!" (gitea/queue gp-forge "alice" "proj") (list))
+
+; ── web routes ───────────────────────────────────────────────────────
+
+(define gp-app (gitea/app gp-forge))
+(define gp-hdr (fn (tok) (if (nil? tok) {} {:authorization (str "Bearer " tok)})))
+(define
+  gp-get
+  (fn (target tok) (gp-app (dream-request "GET" target (gp-hdr tok) ""))))
+(define
+  gp-post
+  (fn
+    (target tok body)
+    (gp-app (dream-request "POST" target (gp-hdr tok) body))))
+
+(gitea-pr-test
+  "pulls page 200"
+  (dream-status (gp-get "/alice/proj/pulls" nil))
+  200)
+(gitea-pr-test
+  "pulls page shows title"
+  (contains?
+    (dream-resp-body (gp-get "/alice/proj/pulls" nil))
+    "Add feature")
+  true)
+(gitea-pr-test
+  "pulls page shows state"
+  (contains? (dream-resp-body (gp-get "/alice/proj/pulls" nil)) "[merged]")
+  true)
+
+(gitea-pr-test
+  "pull page 200"
+  (dream-status (gp-get "/alice/proj/pulls/1" nil))
+  200)
+(gitea-pr-test
+  "pull page shows branches"
+  (contains?
+    (dream-resp-body (gp-get "/alice/proj/pulls/1" nil))
+    "feat -> main")
+  true)
+(gitea-pr-test
+  "pull page renders body"
+  (contains? (dream-resp-body (gp-get "/alice/proj/pulls/1" nil)) "<p>")
+  true)
+(gitea-pr-test
+  "pull page shows review verdict"
+  (contains?
+    (dream-resp-body (gp-get "/alice/proj/pulls/1" nil))
+    "carol: approve")
+  true)
+(gitea-pr-test
+  "pull page shows lifecycle"
+  (contains? (dream-resp-body (gp-get "/alice/proj/pulls/1" nil)) "merged")
+  true)
+(gitea-pr-test
+  "pull page bad number 404"
+  (dream-status (gp-get "/alice/proj/pulls/abc" nil))
+  404)
+(gitea-pr-test
+  "pull page missing 404"
+  (dream-status (gp-get "/alice/proj/pulls/99" nil))
+  404)
+(gitea-pr-test
+  "private pulls anon 404"
+  (dream-status (gp-get "/alice/sec/pulls" nil))
+  404)
+
+(gitea-pr-test
+  "api pulls len"
+  (len
+    (dream-json-parse
+      (dream-resp-body (gp-get "/api/repos/alice/proj/pulls" nil))))
+  7)
+(gitea-pr-test
+  "api pulls first source"
+  (get
+    (first
+      (dream-json-parse
+        (dream-resp-body (gp-get "/api/repos/alice/proj/pulls" nil))))
+    :source)
+  "feat")
+
+(gitea-pr-test
+  "api create anon 401"
+  (dream-status
+    (gp-post "/api/repos/alice/proj/pulls" nil (dream-json-encode {:source "q3" :title "t" :target "main"})))
+  401)
+(gitea-pr-test
+  "api create 201"
+  (dream-status
+    (gp-post
+      "/api/repos/alice/proj/pulls"
+      "tok-e"
+      (dream-json-encode {:source "q3" :title "Eve PR" :body "please" :target "main"})))
+  201)
+(gitea-pr-test
+  "api create bad source 400"
+  (dream-status
+    (gp-post
+      "/api/repos/alice/proj/pulls"
+      "tok-e"
+      (dream-json-encode {:source "zz" :title "t" :target "main"})))
+  400)
+
+; eve's PR is #9
+(gitea-pr-test
+  "api review 200"
+  (dream-status
+    (gp-post
+      "/api/repos/alice/proj/pulls/9/reviews"
+      "tok-c"
+      (dream-json-encode {:verdict "approve" :body "ok"})))
+  200)
+(gitea-pr-test
+  "api self-review 400"
+  (dream-status
+    (gp-post
+      "/api/repos/alice/proj/pulls/9/reviews"
+      "tok-e"
+      (dream-json-encode {:verdict "approve"})))
+  400)
+(gitea-pr-test
+  "api review anon 401"
+  (dream-status
+    (gp-post
+      "/api/repos/alice/proj/pulls/9/reviews"
+      nil
+      (dream-json-encode {:verdict "approve"})))
+  401)
+(gitea-pr-test
+  "api review missing pr 404"
+  (dream-status
+    (gp-post
+      "/api/repos/alice/proj/pulls/99/reviews"
+      "tok-c"
+      (dream-json-encode {:verdict "approve"})))
+  404)
+
+(gitea-pr-test
+  "api merge reader 403"
+  (dream-status (gp-post "/api/repos/alice/proj/pulls/9/merge" "tok-e" "{}"))
+  403)
+(gitea-pr-test
+  "api merge anon 401"
+  (dream-status (gp-post "/api/repos/alice/proj/pulls/9/merge" nil "{}"))
+  401)
+(gitea-pr-test
+  "api merge write 200"
+  (dream-status (gp-post "/api/repos/alice/proj/pulls/9/merge" "tok-a" "{}"))
+  200)
+(gitea-pr-test
+  "api merge applied"
+  (get (gitea/pr-get gp-forge "alice" "proj" 9) :state)
+  "merged")
+
+; reopened conflicting pr 5 still conflicts over the api
+(gitea-pr-test
+  "api merge conflict 409"
+  (dream-status (gp-post "/api/repos/alice/proj/pulls/5/merge" "tok-a" "{}"))
+  409)
+
+; eve authors #10 and may close it herself; carol (reader) may not
+(gp-post "/api/repos/alice/proj/pulls" "tok-e" (dream-json-encode {:source "conf" :title "To close" :target "main"}))
+(gitea-pr-test
+  "api close by reader 403"
+  (dream-status (gp-post "/api/repos/alice/proj/pulls/10/close" "tok-c" "{}"))
+  403)
+(gitea-pr-test
+  "api close by author 200"
+  (dream-status (gp-post "/api/repos/alice/proj/pulls/10/close" "tok-e" "{}"))
+  200)
+(gitea-pr-test
+  "api close applied"
+  (get (gitea/pr-get gp-forge "alice" "proj" 10) :state)
+  "closed")
+(gitea-pr-test
+  "api close again 409"
+  (dream-status (gp-post "/api/repos/alice/proj/pulls/10/close" "tok-e" "{}"))
+  409)
+
+; queue over the api: pr5 is approved (reviews survive reopen)
+(gitea-pr-test
+  "api enqueue reader 403"
+  (dream-status
+    (gp-post "/api/repos/alice/proj/pulls/5/enqueue" "tok-e" "{}"))
+  403)
+(gitea-pr-test
+  "api enqueue 200"
+  (dream-status
+    (gp-post "/api/repos/alice/proj/pulls/5/enqueue" "tok-a" "{}"))
+  200)
+(gitea-pr-test
+  "api queue json"
+  (dream-json-parse
+    (dream-resp-body (gp-get "/api/repos/alice/proj/merge-queue" nil)))
+  (list 5))
+(gitea-pr-test
+  "api queue process 200"
+  (dream-status
+    (gp-post "/api/repos/alice/proj/merge-queue/process" "tok-a" "{}"))
+  200)
+(gitea-pr-test
+  "api queue process reports conflict"
+  (get
+    (first
+      (dream-json-parse
+        (dream-resp-body
+          (gp-post "/api/repos/alice/proj/merge-queue/process" "tok-a" "{}"))))
+    :error)
+  "conflicts")

lib/gitea/tests/repo.sx

@@ -0,0 +1,454 @@
+; lib/gitea/tests/repo.sx — Phase 1: forge core (owners, repo CRUD, git
+; wiring, ref/tree navigation) and the dream browse views + JSON API.
+; Mutating API calls authenticate as alice (Phase 2 gates them).
+
+(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" {})
+
+(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
+  "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)
+
+(gitea/repo-create! gt-forge "alice" "hidden" {:visibility "private"})
+(gitea-repo-test
+  "private visibility stored"
+  (get (gitea/repo-get gt-forge "alice" "hidden") :visibility)
+  "private")
+
+; ── 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 {} ""))))
+
+(gitea/token-create! gt-forge "alice" "tok-alice")
+(define gt-auth {:authorization "Bearer tok-alice"})
+(define
+  gt-posta
+  (fn (target body) (gt-app (dream-request "POST" target gt-auth body))))
+(define
+  gt-dela
+  (fn (target) (gt-app (dream-request "DELETE" target gt-auth ""))))
+
+(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 (as alice) ──────────────────────────────────────────────
+
+(gitea-repo-test
+  "api repos json (anon: public only)"
+  (dream-json-parse (dream-resp-body (gt-get "/api/repos")))
+  (list "acme/proj" "alice/proj"))
+
+(gitea-repo-test
+  "api create 201"
+  (dream-status (gt-posta "/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-posta "/api/repos" (dream-json-encode {:name "web" :owner "alice"})))
+  409)
+(gitea-repo-test
+  "api create unknown owner 400"
+  (dream-status (gt-posta "/api/repos" (dream-json-encode {:name "web" :owner "zeb"})))
+  400)
+(gitea-repo-test
+  "api create bad name 400"
+  (dream-status (gt-posta "/api/repos" (dream-json-encode {:name "b d" :owner "alice"})))
+  400)
+(gitea-repo-test
+  "api delete 200"
+  (dream-status (gt-dela "/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-dela "/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/hidden" "alice/proj"))

lib/gitea/tests/search.sx

@@ -0,0 +1,266 @@
+; lib/gitea/tests/search.sx — Phase 7: code + issue/PR search over
+; search-on-sx. All SX-level queries run as ONE haskell evaluation
+; (gitea/search-multi over five corpora); the web tests add one
+; evaluation per request.
+
+(st-bootstrap-classes!)
+(content/bootstrap!)
+(content-bootstrap-markdown!)
+(content-bootstrap-table!)
+
+(define gitea-search-pass 0)
+(define gitea-search-fail 0)
+(define gitea-search-fails (list))
+
+(define
+  gitea-search-test
+  (fn
+    (name actual expected)
+    (if
+      (= actual expected)
+      (set! gitea-search-pass (+ gitea-search-pass 1))
+      (begin
+        (set! gitea-search-fail (+ gitea-search-fail 1))
+        (set!
+          gitea-search-fails
+          (append gitea-search-fails (list {:name name :expected (inspect expected) :actual (inspect actual)})))))))
+
+; ── escaping ─────────────────────────────────────────────────────────
+
+(gitea-search-test "hk-escape quotes" (gitea/hk-escape "a\"b") "a\\\"b")
+(gitea-search-test "hk-escape newline" (gitea/hk-escape "a\nb") "a\\nb")
+(gitea-search-test "hk-escape backslash" (gitea/hk-escape "a\\b") "a\\\\b")
+(gitea-search-test "hk-escape nil" (gitea/hk-escape nil) "")
+
+; ── setup ────────────────────────────────────────────────────────────
+
+(define gs-db (persist/mem-backend))
+(define gs-forge (gitea/forge gs-db))
+(gitea/user-create! gs-forge "alice")
+(gitea/user-create! gs-forge "bob")
+(gitea/token-create! gs-forge "alice" "tok-a")
+(gitea/repo-create! gs-forge "alice" "proj" {})
+(gitea/repo-create! gs-forge "alice" "sec" {:visibility "private"})
+(gitea/repo-create! gs-forge "alice" "empty" {})
+
+(define gs-g (gitea/repo-git gs-forge "alice" "proj"))
+(git/add! gs-g "README.md" "SX forge documentation overview")
+(git/add! gs-g "src/main.sx" "(define forge-main entry) banana runtime")
+(git/add! gs-g "docs/guide.md" "how to search the forge")
+(git/commit! gs-g {:message "c1" :time 1 :author "alice"})
+(git/branch! gs-g "feat")
+(git/checkout! gs-g "feat")
+(git/add! gs-g "src/extra.sx" "cherry helpers")
+(git/commit! gs-g {:message "c2" :time 2 :author "alice"})
+(git/checkout! gs-g "main")
+
+(define gs-gs (gitea/repo-git gs-forge "alice" "sec"))
+(git/add! gs-gs "secret.txt" "banana secret stash")
+(git/commit! gs-gs {:message "s1" :time 3 :author "alice"})
+
+(gitea/issue-create!
+  gs-forge
+  "alice"
+  "proj"
+  "alice"
+  "Crash in search"
+  "the search crashes on banana input"
+  {:created-at 10})
+(gitea/issue-comment!
+  gs-forge
+  "alice"
+  "proj"
+  1
+  "bob"
+  "reproduced with cherry too"
+  {:at 11})
+(gitea/issue-create!
+  gs-forge
+  "alice"
+  "proj"
+  "alice"
+  "Docs update"
+  "documentation needs love"
+  {:created-at 12})
+(gitea/pr-create!
+  gs-forge
+  "alice"
+  "proj"
+  "bob"
+  "Improve search ranking"
+  "feat"
+  "main"
+  "tfidf ranking for results"
+  {})
+
+; ── corpus construction ──────────────────────────────────────────────
+
+(define gs-corp-code (gitea/repo-docs gs-forge "alice" "proj" (list "code")))
+(define
+  gs-corp-ip
+  (gitea/repo-docs gs-forge "alice" "proj" (list "issue" "pr")))
+(define
+  gs-corp-all
+  (gitea/repo-docs gs-forge "alice" "proj" gitea/search-kinds-all))
+(define gs-corp-anon (gitea/visible-docs gs-forge nil gitea/search-kinds-all))
+(define
+  gs-corp-own
+  (gitea/visible-docs gs-forge "alice" gitea/search-kinds-all))
+
+(gitea-search-test "code docs" (len gs-corp-code) 3)
+(gitea-search-test "issue+pr docs" (len gs-corp-ip) 3)
+(gitea-search-test "all docs" (len gs-corp-all) 6)
+(gitea-search-test
+  "empty repo corpus"
+  (gitea/code-docs gs-forge "alice" "empty")
+  (list))
+(gitea-search-test
+  "anon corpus excludes private"
+  (len (filter (fn (d) (= (get d :repo) "alice/sec")) gs-corp-anon))
+  0)
+(gitea-search-test
+  "owner corpus includes private"
+  (len (filter (fn (d) (= (get d :repo) "alice/sec")) gs-corp-own))
+  1)
+
+; ── ONE evaluation, thirteen queries over five corpora ───────────────
+
+(define
+  gs-R
+  (gitea/search-multi
+    (list gs-corp-code gs-corp-ip gs-corp-all gs-corp-anon gs-corp-own)
+    (list
+      {:n 20 :query "banana" :corpus 0}
+      {:n 20 :query "forge" :corpus 0}
+      {:n 20 :query "banana OR cherry" :corpus 0}
+      {:n 20 :query "nosuchterm" :corpus 0}
+      {:n 20 :query "banana" :corpus 1}
+      {:n 20 :query "cherry" :corpus 1}
+      {:n 20 :query "ranking" :corpus 1}
+      {:n 20 :query "search AND banana" :corpus 1}
+      {:n 20 :query "documentation" :corpus 1}
+      {:n 20 :query "search" :corpus 2}
+      {:n 2 :query "search" :corpus 2}
+      {:n 20 :query "banana" :corpus 3}
+      {:n 20 :query "banana" :corpus 4})))
+
+(gitea-search-test
+  "code: unique term"
+  (nth gs-R 0)
+  (list {:kind "code" :ref "src/main.sx"}))
+(gitea-search-test
+  "code: common term hits all three"
+  (len (nth gs-R 1))
+  3)
+(gitea-search-test "code: OR query" (nth gs-R 2) (list {:kind "code" :ref "src/main.sx"}))
+(gitea-search-test "code: no hits" (nth gs-R 3) (list))
+
+(gitea-search-test
+  "issues: body term"
+  (nth gs-R 4)
+  (list {:kind "issue" :ref "1"}))
+(gitea-search-test
+  "issues: comment text indexed"
+  (nth gs-R 5)
+  (list {:kind "issue" :ref "1"}))
+(gitea-search-test "prs: body term" (nth gs-R 6) (list {:kind "pr" :ref "3"}))
+(gitea-search-test
+  "issues: AND query"
+  (nth gs-R 7)
+  (list {:kind "issue" :ref "1"}))
+(gitea-search-test
+  "issues: title+body of second"
+  (len (filter (fn (r) (= r {:kind "issue" :ref "2"})) (nth gs-R 8)))
+  1)
+
+(gitea-search-test
+  "mixed kinds found"
+  (len (nth gs-R 9))
+  3)
+(gitea-search-test
+  "take-n limits results"
+  (len (nth gs-R 10))
+  2)
+
+(gitea-search-test
+  "global anon excludes private"
+  (len
+    (filter (fn (r) (= (get r :repo) "alice/sec")) (nth gs-R 11)))
+  0)
+(gitea-search-test
+  "global anon finds public code+issue"
+  (len (nth gs-R 11))
+  2)
+(gitea-search-test
+  "global owner sees private"
+  (len
+    (filter (fn (r) (= (get r :repo) "alice/sec")) (nth gs-R 12)))
+  1)
+(gitea-search-test
+  "global owner total"
+  (len (nth gs-R 12))
+  3)
+
+; empty corpora short-circuit without an evaluation
+(gitea-search-test
+  "empty corpus searches empty"
+  (gitea/search-repo
+    gs-forge
+    "alice"
+    "empty"
+    "banana"
+    gitea/search-kinds-all
+    10)
+  (list))
+
+; ── web (one haskell evaluation per request) ─────────────────────────
+
+(define gs-app (gitea/app gs-forge))
+(define gs-hdr (fn (tok) (if (nil? tok) {} {:authorization (str "Bearer " tok)})))
+(define
+  gs-get
+  (fn (target tok) (gs-app (dream-request "GET" target (gs-hdr tok) ""))))
+
+(define gs-page (gs-get "/alice/proj/search?q=banana" nil))
+(gitea-search-test "search page 200" (dream-status gs-page) 200)
+(gitea-search-test
+  "search page links the hit"
+  (contains? (dream-resp-body gs-page) "src/main.sx")
+  true)
+
+(gitea-search-test
+  "search page kind filter"
+  (contains?
+    (dream-resp-body (gs-get "/alice/proj/search?q=banana&kind=issue" nil))
+    "issues/1")
+  true)
+(gitea-search-test
+  "search page missing q 400"
+  (dream-status (gs-get "/alice/proj/search" nil))
+  400)
+(gitea-search-test
+  "private search anon 404"
+  (dream-status (gs-get "/alice/sec/search?q=banana" nil))
+  404)
+
+(gitea-search-test
+  "api repo search"
+  (dream-json-parse
+    (dream-resp-body
+      (gs-get "/api/repos/alice/proj/search?q=cherry&kind=issue" nil)))
+  (list {:kind "issue" :ref "1"}))
+(gitea-search-test
+  "api repo search missing q 400"
+  (dream-status (gs-get "/api/repos/alice/proj/search" nil))
+  400)
+
+(define gs-glob-anon (gs-get "/api/search?q=banana" nil))
+(gitea-search-test
+  "api global anon count"
+  (len (dream-json-parse (dream-resp-body gs-glob-anon)))
+  2)
+(define gs-glob-own (gs-get "/api/search?q=banana" "tok-a"))
+(gitea-search-test
+  "api global authed count"
+  (len (dream-json-parse (dream-resp-body gs-glob-own)))
+  3)

lib/gitea/tests/wire.sx

@@ -0,0 +1,490 @@
+; lib/gitea/tests/wire.sx — Phase 3: pkt-line framing, object closure,
+; smart-HTTP endpoints (info/refs, upload-pack, receive-pack), and the
+; client (ls-remote/clone!/fetch!/push!) syncing two in-memory forges.
+
+(define gitea-wire-pass 0)
+(define gitea-wire-fail 0)
+(define gitea-wire-fails (list))
+
+(define
+  gitea-wire-test
+  (fn
+    (name actual expected)
+    (if
+      (= actual expected)
+      (set! gitea-wire-pass (+ gitea-wire-pass 1))
+      (begin
+        (set! gitea-wire-fail (+ gitea-wire-fail 1))
+        (set! gitea-wire-fails (append gitea-wire-fails (list {:name name :expected (inspect expected) :actual (inspect actual)})))))))
+
+; ── pkt-line framing ─────────────────────────────────────────────────
+
+(gitea-wire-test "hex4 small" (gitea/hex4 5) "0005")
+(gitea-wire-test "hex4 max" (gitea/hex4 65535) "ffff")
+(gitea-wire-test "hex4-parse" (gitea/hex4-parse "001a") 26)
+(gitea-wire-test
+  "hex4 round trip"
+  (gitea/hex4-parse (gitea/hex4 4242))
+  4242)
+(gitea-wire-test "pkt frames with length" (gitea/pkt "hi") "0006hi")
+(gitea-wire-test
+  "pkt-sections round trip"
+  (gitea/pkt-sections (gitea/pkt-render (list (list "a" "bc") (list "z"))))
+  (list (list "a" "bc") (list "z")))
+(gitea-wire-test "pkt-sections empty" (gitea/pkt-sections "") (list))
+(gitea-wire-test
+  "pkt-sections flush only"
+  (gitea/pkt-sections "0000")
+  (list (list)))
+(gitea-wire-test "pkt-fits? small" (gitea/pkt-fits? "x") true)
+
+(define
+  gw-big
+  (reduce
+    (fn (acc i) (str acc acc))
+    "xxxxxxxxxx"
+    (list
+      1
+      2
+      3
+      4
+      5
+      6
+      7
+      8
+      9
+      10
+      11
+      12
+      13)))
+(gitea-wire-test "pkt-fits? huge payload" (gitea/pkt-fits? gw-big) false)
+
+; ── forge A with history ─────────────────────────────────────────────
+
+(define gw-db (persist/mem-backend))
+(define gw-forge (gitea/forge gw-db))
+(gitea/user-create! gw-forge "alice")
+(gitea/user-create! gw-forge "bob")
+(gitea/user-create! gw-forge "rope")
+(gitea/token-create! gw-forge "alice" "tok-a")
+(gitea/token-create! gw-forge "bob" "tok-b")
+(gitea/token-create! gw-forge "rope" "tok-r")
+(gitea/repo-create! gw-forge "alice" "lib" {})
+(gitea/collab-add! gw-forge "alice" "lib" "rope" "read")
+
+(define gw-ga (gitea/repo-git gw-forge "alice" "lib"))
+(git/add! gw-ga "README.md" "hello\n")
+(git/add! gw-ga "src/a.txt" "alpha\n")
+(define gw-c1 (git/commit! gw-ga {:message "init" :time 1 :author "alice"}))
+(git/add! gw-ga "src/a.txt" "alpha2\n")
+(define gw-c2 (git/commit! gw-ga {:message "more" :time 2 :author "alice"}))
+(git/tag! gw-ga "v1" {:message "rel" :time 3})
+(define gw-tag-cid (git/tag-get gw-ga "v1"))
+(git/branch-create! gw-ga "dev" gw-c1)
+
+; ── closure ──────────────────────────────────────────────────────────
+
+; c1 = commit + root tree + src tree + 2 blobs
+(gitea-wire-test
+  "closure of c1"
+  (len (gitea/closure-list gw-ga (list gw-c1)))
+  5)
+; c2 adds commit + new root + new src + new blob
+(gitea-wire-test
+  "closure of c2"
+  (len (gitea/closure-list gw-ga (list gw-c2)))
+  9)
+(gitea-wire-test
+  "pack-cids c2 given c1"
+  (len (gitea/pack-cids gw-ga (list gw-c2) (list gw-c1)))
+  4)
+(gitea-wire-test
+  "pack includes tip commit"
+  (contains? (gitea/pack-cids gw-ga (list gw-c2) (list gw-c1)) gw-c2)
+  true)
+(gitea-wire-test
+  "pack excludes had commit"
+  (contains? (gitea/pack-cids gw-ga (list gw-c2) (list gw-c1)) gw-c1)
+  false)
+(gitea-wire-test
+  "closure through tag object"
+  (len (gitea/closure-list gw-ga (list gw-tag-cid)))
+  10)
+(gitea-wire-test
+  "closure-complete? tip"
+  (gitea/closure-complete? gw-ga (list gw-c2))
+  true)
+(gitea-wire-test
+  "closure-complete? missing cid"
+  (gitea/closure-complete? gw-ga (list "sx1:doesnotexist"))
+  false)
+(gitea-wire-test
+  "obj-refs of commit"
+  (len (gitea/obj-refs (git/read gw-ga gw-c2)))
+  2)
+
+; ── pack line verification ───────────────────────────────────────────
+
+(gitea-wire-test
+  "pack-line parses and verifies"
+  (get (gitea/pack-line-parse (gitea/pack-line gw-ga gw-c1)) :cid)
+  gw-c1)
+(gitea-wire-test
+  "pack-line tamper detected"
+  (get
+    (gitea/pack-line-parse (str gw-c1 " " (serialize (git/blob "evil"))))
+    :error)
+  "cid-mismatch")
+(gitea-wire-test
+  "unpack! rejects tampered pack"
+  (get
+    (gitea/unpack!
+      gw-ga
+      (list (str gw-c1 " " (serialize (git/blob "evil")))))
+    :error)
+  "cid-mismatch")
+
+; ── server endpoints ─────────────────────────────────────────────────
+
+(define gw-app (gitea/forge-app gw-forge))
+(define gw-hdr (fn (tok) (if (nil? tok) {} {:authorization (str "Bearer " tok)})))
+(define
+  gw-get
+  (fn (target tok) (gw-app (dream-request "GET" target (gw-hdr tok) ""))))
+(define
+  gw-post
+  (fn
+    (target tok body)
+    (gw-app (dream-request "POST" target (gw-hdr tok) body))))
+
+(gitea-wire-test
+  "info/refs 200"
+  (dream-status (gw-get "/alice/lib/info/refs" nil))
+  200)
+(gitea-wire-test
+  "info/refs advertises main"
+  (contains?
+    (dream-resp-body (gw-get "/alice/lib/info/refs" nil))
+    (str gw-c2 " heads/main"))
+  true)
+(gitea-wire-test
+  "info/refs advertises dev"
+  (contains?
+    (dream-resp-body (gw-get "/alice/lib/info/refs" nil))
+    (str gw-c1 " heads/dev"))
+  true)
+(gitea-wire-test
+  "info/refs advertises tag"
+  (contains?
+    (dream-resp-body (gw-get "/alice/lib/info/refs" nil))
+    (str gw-tag-cid " tags/v1"))
+  true)
+(gitea-wire-test
+  "info/refs advertises HEAD"
+  (contains?
+    (dream-resp-body (gw-get "/alice/lib/info/refs" nil))
+    "@ heads/main")
+  true)
+(gitea-wire-test
+  "info/refs unknown repo 404"
+  (dream-status (gw-get "/alice/none/info/refs" nil))
+  404)
+
+(define
+  gw-up-body
+  (fn
+    (wants haves)
+    (gitea/pkt-render
+      (list
+        (concat
+          (map (fn (c) (str "want " c)) wants)
+          (map (fn (c) (str "have " c)) haves))))))
+
+(define
+  gw-up-lines
+  (fn
+    (resp)
+    (let
+      ((s (gitea/pkt-sections (dream-resp-body resp))))
+      (if (empty? s) (list) (first s)))))
+
+(gitea-wire-test
+  "upload-pack full clone size"
+  (len
+    (gw-up-lines
+      (gw-post
+        "/alice/lib/git-upload-pack"
+        nil
+        (gw-up-body (list gw-c2) (list)))))
+  9)
+(gitea-wire-test
+  "upload-pack incremental size"
+  (len
+    (gw-up-lines
+      (gw-post
+        "/alice/lib/git-upload-pack"
+        nil
+        (gw-up-body (list gw-c2) (list gw-c1)))))
+  4)
+(gitea-wire-test
+  "upload-pack lines all verify"
+  (len
+    (filter
+      (fn (l) (get (gitea/pack-line-parse l) :error))
+      (gw-up-lines
+        (gw-post
+          "/alice/lib/git-upload-pack"
+          nil
+          (gw-up-body (list gw-c2) (list))))))
+  0)
+
+(gitea-wire-test
+  "receive-pack anon 401"
+  (dream-status
+    (gw-post
+      "/alice/lib/git-receive-pack"
+      nil
+      (gitea/pkt-render (list (list) (list)))))
+  401)
+(gitea-wire-test
+  "receive-pack read-only 403"
+  (dream-status
+    (gw-post
+      "/alice/lib/git-receive-pack"
+      "tok-r"
+      (gitea/pkt-render (list (list) (list)))))
+  403)
+
+; private repo wire gating
+(gitea/repo-create! gw-forge "alice" "priv" {:visibility "private"})
+(define gw-gp (gitea/repo-git gw-forge "alice" "priv"))
+(git/add! gw-gp "p.txt" "private\n")
+(git/commit! gw-gp {:message "p" :time 1 :author "alice"})
+
+(gitea-wire-test
+  "private info/refs anon 404"
+  (dream-status (gw-get "/alice/priv/info/refs" nil))
+  404)
+(gitea-wire-test
+  "private info/refs owner 200"
+  (dream-status (gw-get "/alice/priv/info/refs" "tok-a"))
+  200)
+(gitea-wire-test
+  "private upload-pack anon 404"
+  (dream-status
+    (gw-post "/alice/priv/git-upload-pack" nil (gw-up-body (list) (list))))
+  404)
+
+; ── client: ls-remote ────────────────────────────────────────────────
+
+(define gw-remote-anon (gitea/remote gw-app "alice" "lib" nil))
+(define gw-remote-bob (gitea/remote gw-app "alice" "lib" "tok-b"))
+(define gw-remote-rope (gitea/remote gw-app "alice" "lib" "tok-r"))
+
+(define gw-ls (gitea/ls-remote gw-remote-anon))
+(gitea-wire-test "ls-remote head" (get gw-ls :head) "heads/main")
+(gitea-wire-test "ls-remote main" (get (get gw-ls :refs) "heads/main") gw-c2)
+(gitea-wire-test "ls-remote dev" (get (get gw-ls :refs) "heads/dev") gw-c1)
+(gitea-wire-test
+  "ls-remote tag"
+  (get (get gw-ls :refs) "tags/v1")
+  gw-tag-cid)
+(gitea-wire-test
+  "ls-remote unknown repo"
+  (gitea/ls-remote (gitea/remote gw-app "alice" "none" nil))
+  nil)
+
+; ── client: clone into forge B ───────────────────────────────────────
+
+(define gw-db2 (persist/mem-backend))
+(define gw-forge2 (gitea/forge gw-db2))
+(gitea/user-create! gw-forge2 "bob")
+
+(define
+  gw-clone
+  (gitea/clone! gw-forge2 "bob" "lib" gw-remote-anon {}))
+(gitea-wire-test "clone returns record" (get gw-clone :owner) "bob")
+
+(define gw-gb (gitea/repo-git gw-forge2 "bob" "lib"))
+(gitea-wire-test "clone main" (git/branch-get gw-gb "main") gw-c2)
+(gitea-wire-test "clone dev" (git/branch-get gw-gb "dev") gw-c1)
+(gitea-wire-test "clone tag" (git/tag-get gw-gb "v1") gw-tag-cid)
+(gitea-wire-test "clone HEAD" (git/head-target gw-gb) "heads/main")
+(gitea-wire-test
+  "clone default branch recorded"
+  (get (gitea/repo-get gw-forge2 "bob" "lib") :default-branch)
+  "main")
+(gitea-wire-test "clone log" (git/log gw-gb gw-c2) (list gw-c2 gw-c1))
+(gitea-wire-test
+  "clone blob content"
+  (git/blob-data
+    (git/read gw-gb (get (gitea/tree-at gw-gb gw-c2 "src/a.txt") :cid)))
+  "alpha2\n")
+(gitea-wire-test
+  "clone closure complete"
+  (gitea/closure-complete? gw-gb (list gw-c2))
+  true)
+(gitea-wire-test
+  "clone again conflicts"
+  (get
+    (gitea/clone! gw-forge2 "bob" "lib" gw-remote-anon {})
+    :conflict)
+  true)
+(gitea-wire-test
+  "clone unreachable remote errors"
+  (get
+    (gitea/clone!
+      gw-forge2
+      "bob"
+      "ghost"
+      (gitea/remote gw-app "alice" "none" nil)
+      {})
+    :error)
+  404)
+(gitea-wire-test
+  "failed clone leaves no repo"
+  (gitea/repo-exists? gw-forge2 "bob" "ghost")
+  false)
+
+; ── client: fetch after upstream moves ───────────────────────────────
+
+(git/add! gw-ga "src/c.txt" "gamma\n")
+(define gw-c3 (git/commit! gw-ga {:message "third" :time 4 :author "alice"}))
+
+(define gw-fetch1 (gitea/fetch! gw-remote-anon gw-gb))
+(gitea-wire-test
+  "fetch stores new objects"
+  (> (get gw-fetch1 :stored) 0)
+  true)
+(gitea-wire-test "fetch moves main" (git/branch-get gw-gb "main") gw-c3)
+(gitea-wire-test
+  "fetch closure complete"
+  (gitea/closure-complete? gw-gb (list gw-c3))
+  true)
+(gitea-wire-test
+  "fetch up-to-date is no-op"
+  (get (gitea/fetch! gw-remote-anon gw-gb) :stored)
+  0)
+
+; ── client: push ─────────────────────────────────────────────────────
+
+; bob gets write on the upstream, commits locally, pushes
+(gitea/collab-add! gw-forge "alice" "lib" "bob" "write")
+(git/checkout! gw-gb "main")
+(git/add! gw-gb "src/b.txt" "beta\n")
+(define gw-c4 (git/commit! gw-gb {:message "from-bob" :time 5 :author "bob"}))
+
+(gitea-wire-test
+  "push ok"
+  (get (gitea/push! gw-remote-bob gw-gb "heads/main") :ok)
+  true)
+(gitea-wire-test
+  "push moved upstream main"
+  (git/branch-get gw-ga "main")
+  gw-c4)
+(gitea-wire-test
+  "upstream has pushed objects"
+  (gitea/closure-complete? gw-ga (list gw-c4))
+  true)
+
+; push auth: anon 401, read-only 403
+(gitea-wire-test
+  "push anon rejected"
+  (get (gitea/push! gw-remote-anon gw-gb "heads/main") :error)
+  401)
+(gitea-wire-test
+  "push read-only rejected"
+  (get (gitea/push! gw-remote-rope gw-gb "heads/main") :error)
+  403)
+
+; non-fast-forward: upstream moves on while bob commits on the old tip
+(git/checkout! gw-ga "main")
+(git/add! gw-ga "src/d.txt" "delta\n")
+(define gw-c5 (git/commit! gw-ga {:message "upstream-moves" :time 6 :author "alice"}))
+
+(git/add! gw-gb "src/e.txt" "eps\n")
+(define gw-c4b (git/commit! gw-gb {:message "bob-diverges" :time 7 :author "bob"}))
+
+(gitea-wire-test
+  "push non-fast-forward rejected"
+  (get (gitea/push! gw-remote-bob gw-gb "heads/main") :ng)
+  "non-fast-forward")
+(gitea-wire-test
+  "upstream main unchanged after ng"
+  (git/branch-get gw-ga "main")
+  gw-c5)
+
+; recover: fetch (mirror moves local main to upstream), rebuild, push
+(gitea/fetch! gw-remote-bob gw-gb)
+(gitea-wire-test
+  "fetch after ng syncs main"
+  (git/branch-get gw-gb "main")
+  gw-c5)
+(git/checkout! gw-gb "main")
+(git/add! gw-gb "src/e.txt" "eps\n")
+(define gw-c6 (git/commit! gw-gb {:message "bob-rebased" :time 8 :author "bob"}))
+(gitea-wire-test
+  "push after sync ok"
+  (get (gitea/push! gw-remote-bob gw-gb "heads/main") :ok)
+  true)
+(gitea-wire-test
+  "upstream at bob's rebased tip"
+  (git/branch-get gw-ga "main")
+  gw-c6)
+
+; branch create / delete over the wire
+(git/branch-create! gw-gb "feat" gw-c6)
+(gitea-wire-test
+  "push new branch"
+  (get (gitea/push! gw-remote-bob gw-gb "heads/feat") :ok)
+  true)
+(gitea-wire-test
+  "upstream sees new branch"
+  (git/branch-get gw-ga "feat")
+  gw-c6)
+(gitea-wire-test
+  "push delete branch"
+  (get (gitea/push-delete! gw-remote-bob gw-gb "heads/feat") :ok)
+  true)
+(gitea-wire-test "upstream branch deleted" (git/branch-get gw-ga "feat") nil)
+
+; tag push
+(git/tag-lightweight! gw-gb "v2")
+(gitea-wire-test
+  "push tag"
+  (get (gitea/push! gw-remote-bob gw-gb "tags/v2") :ok)
+  true)
+(gitea-wire-test "upstream sees tag" (git/tag-get gw-ga "v2") gw-c6)
+
+; guard rails
+(gitea-wire-test
+  "push unknown local ref"
+  (get (gitea/push! gw-remote-bob gw-gb "heads/nope") :error)
+  "no-such-local-ref")
+(gitea-wire-test
+  "apply-cmd rejects non-shared ref"
+  (gitea/apply-cmd! gw-ga {:name "bogus/x" :new gw-c1 :old "-"})
+  "ng bogus/x invalid-ref")
+(gitea-wire-test
+  "apply-cmd rejects missing objects"
+  (gitea/apply-cmd! gw-ga {:name "heads/zzz" :new "sx1:missing" :old "-"})
+  "ng heads/zzz missing-objects")
+
+; private repo full round trip with credentials
+(define gw-remote-priv (gitea/remote gw-app "alice" "priv" "tok-a"))
+(gitea/user-create! gw-forge2 "alice")
+(define
+  gw-pclone
+  (gitea/clone! gw-forge2 "alice" "priv" gw-remote-priv {:visibility "private"}))
+(gitea-wire-test "private clone with token" (get gw-pclone :owner) "alice")
+(gitea-wire-test
+  "private clone anon fails"
+  (get
+    (gitea/clone!
+      gw-forge2
+      "alice"
+      "priv2"
+      (gitea/remote gw-app "alice" "priv" nil)
+      {})
+    :error)
+  404)

lib/gitea/web.sx

@@ -0,0 +1,520 @@
+; lib/gitea/web.sx — sx-gitea Phases 1+2: browse views over dream, gated
+; by access control.
+;
+; 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 JSON API for repo create/list/delete and collaborator management.
+;
+; Gating: every repo route requires "read" (a miss is a 404 — private
+; repos are indistinguishable from absent ones); mutations require the
+; caller to authenticate (bearer token) and hold the right role: create
+; needs the owner (or org admin), delete and collaborator management need
+; "admin". 401 = no credentials, 403 = authenticated but not allowed.
+;
+; Later modules (wire, issues, pr, activity, ...) extend the app by
+; appending a routes pack to gitea/route-packs at load time; gitea/app
+; serves them all, with every /api/* route hoisted ahead of the wildcard
+; /:owner/:name patterns so a pack can never be shadowed.
+;
+; Requires: lib/gitea/{repo,access}.sx, lib/dream/{types,router,middleware,
+; error,html,json,auth,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>")))
+
+; ── auth helpers ─────────────────────────────────────────────────────
+
+(define
+  gitea/w-user
+  (fn
+    (forge req)
+    (let
+      ((tok (dream-bearer-token req)))
+      (if (nil? tok) nil (gitea/token-user forge tok)))))
+
+(define
+  gitea/w-json-status
+  (fn (status v) (dream-response status {:content-type "application/json"} (dream-json-encode v))))
+
+(define
+  gitea/w-unauthorized
+  (fn () (gitea/w-json-status 401 {:error "unauthorized"})))
+(define
+  gitea/w-forbidden
+  (fn () (gitea/w-json-status 403 {:error "forbidden"})))
+
+; can the requester read this repo? (false covers missing repos too)
+(define
+  gitea/w-readable?
+  (fn
+    (forge req owner name)
+    (gitea/can? forge (gitea/w-user forge req) "read" owner name)))
+
+; ── pages ────────────────────────────────────────────────────────────
+
+(define
+  gitea/w-index
+  (fn
+    (forge req)
+    (gitea/w-page
+      "repositories"
+      (str
+        "<h1>Repositories</h1><ul>"
+        (join
+          ""
+          (map
+            gitea/w-repo-link
+            (gitea/visible-repos forge (gitea/w-user forge req))))
+        "</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")))
+      (if
+        (not (gitea/w-readable? forge req owner name))
+        (dream-not-found)
+        (let
+          ((rec (gitea/repo-get forge owner name))
+            (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/w-readable? forge req 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 (unreadable 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/w-readable? forge req 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/w-readable? forge req 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/w-readable? forge req 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-api-repos
+  (fn
+    (forge req)
+    (dream-json-value (gitea/visible-repos forge (gitea/w-user forge req)))))
+
+(define
+  gitea/w-api-repo-create
+  (fn
+    (forge req)
+    (let
+      ((user (gitea/w-user forge req)))
+      (if
+        (nil? user)
+        (gitea/w-unauthorized)
+        (let
+          ((body (dream-json-body req)))
+          (let
+            ((owner (get body :owner)))
+            (cond
+              ((not (gitea/owner-exists? forge owner))
+                (gitea/w-json-status 400 {:error "no-such-owner"}))
+              ((not (gitea/create-allowed? forge user owner))
+                (gitea/w-forbidden))
+              (else
+                (let
+                  ((res (gitea/repo-create! forge 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)
+    (let
+      ((owner (dream-param req "owner")) (name (dream-param req "name")))
+      (let
+        ((user (gitea/w-user forge req)))
+        (cond
+          ((not (gitea/can? forge user "read" owner name))
+            (dream-not-found))
+          ((nil? user) (gitea/w-unauthorized))
+          ((not (gitea/can? forge user "admin" owner name))
+            (gitea/w-forbidden))
+          (else
+            (begin
+              (gitea/repo-delete! forge owner name)
+              (dream-json-value {:deleted true}))))))))
+
+(define
+  gitea/w-api-collab-put
+  (fn
+    (forge req)
+    (let
+      ((owner (dream-param req "owner"))
+        (name (dream-param req "name"))
+        (cuser (dream-param req "user")))
+      (let
+        ((user (gitea/w-user forge req)))
+        (cond
+          ((not (gitea/can? forge user "read" owner name))
+            (dream-not-found))
+          ((nil? user) (gitea/w-unauthorized))
+          ((not (gitea/can? forge user "admin" owner name))
+            (gitea/w-forbidden))
+          (else
+            (let
+              ((role (or (get (dream-json-body req) :role) "read")))
+              (let
+                ((res (gitea/collab-add! forge owner name cuser role)))
+                (if
+                  (get res :error)
+                  (gitea/w-json-status 400 {:error (get res :error)})
+                  (dream-json-value {:role role :user cuser}))))))))))
+
+(define
+  gitea/w-api-collab-delete
+  (fn
+    (forge req)
+    (let
+      ((owner (dream-param req "owner"))
+        (name (dream-param req "name"))
+        (cuser (dream-param req "user")))
+      (let
+        ((user (gitea/w-user forge req)))
+        (cond
+          ((not (gitea/can? forge user "read" owner name))
+            (dream-not-found))
+          ((nil? user) (gitea/w-unauthorized))
+          ((not (gitea/can? forge user "admin" owner name))
+            (gitea/w-forbidden))
+          ((gitea/collab-remove! forge owner name cuser)
+            (dream-json-value {:deleted true}))
+          (else (dream-not-found)))))))
+
+; ── routes ───────────────────────────────────────────────────────────
+
+(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-put
+        "/api/repos/:owner/:name/collab/:user"
+        (fn (req) (gitea/w-api-collab-put forge req)))
+      (dream-delete
+        "/api/repos/:owner/:name/collab/:user"
+        (fn (req) (gitea/w-api-collab-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))))))
+
+; extension point: wire/issues/pr/activity/... append their packs at load
+(define gitea/route-packs (list gitea/routes))
+
+; every /api/* route (from any pack) dispatches before the wildcard
+; /:owner/:name patterns, so later packs can add API endpoints freely
+(define
+  gitea/all-routes
+  (fn
+    (forge)
+    (let
+      ((rs (reduce (fn (acc pack) (concat acc (pack forge))) (list) gitea/route-packs)))
+      (concat
+        (filter (fn (r) (starts-with? (dream-route-path r) "/api/")) rs)
+        (filter
+          (fn (r) (not (starts-with? (dream-route-path r) "/api/")))
+          rs)))))
+
+(define gitea/app (fn (forge) (dream-make-app (gitea/all-routes forge))))

lib/gitea/wire.sx

@@ -0,0 +1,554 @@
+; lib/gitea/wire.sx — sx-gitea Phase 3: smart-HTTP wire protocol.
+;
+; git-style smart HTTP over the NATIVE sx-git object model: pkt-line
+; framing (byte-compatible with git's framing), ref advertisement,
+; upload-pack (clone/fetch) and receive-pack (push). Objects travel as
+; "<cid> <serialized-sx>" pkt lines — the receiver re-derives the CID
+; from the bytes, so a pack can't lie about its contents. SHA-1/packfile
+; byte compat for stock git clients stays in lib/git/{export,import}.sx.
+;
+; Endpoints (registered on gitea/route-packs):
+;   GET  /:owner/:name/info/refs         read-gated ref advertisement
+;   POST /:owner/:name/git-upload-pack   read-gated;  wants/haves -> pack
+;   POST /:owner/:name/git-receive-pack  write-gated; commands+pack -> statuses
+;
+; A client (gitea/remote over any dream app fn) provides ls-remote /
+; clone! / fetch! / push! / push-delete! — two in-memory forges can sync
+; with no sockets anywhere.
+;
+; Limits: one object per pkt line => objects over ~64KB need side-band
+; chunking (future extension); gitea/pkt-fits? reports this.
+;
+; Requires: lib/gitea/{repo,access,web}.sx and their stacks, plus
+; sx-parse (spec/parser.sx on the OCaml server host).
+
+; ── pkt-line framing ─────────────────────────────────────────────────
+
+(define gitea/hex-chars "0123456789abcdef")
+
+(define
+  gitea/hex4
+  (fn
+    (n)
+    (str
+      (char-at gitea/hex-chars (mod (quotient n 4096) 16))
+      (char-at gitea/hex-chars (mod (quotient n 256) 16))
+      (char-at gitea/hex-chars (mod (quotient n 16) 16))
+      (char-at gitea/hex-chars (mod n 16)))))
+
+(define gitea/hex-val (fn (c) (index-of gitea/hex-chars (lower c))))
+
+(define
+  gitea/hex4-parse
+  (fn
+    (s)
+    (+
+      (* 4096 (gitea/hex-val (char-at s 0)))
+      (* 256 (gitea/hex-val (char-at s 1)))
+      (* 16 (gitea/hex-val (char-at s 2)))
+      (gitea/hex-val (char-at s 3)))))
+
+(define gitea/pkt-max 65531)
+(define gitea/pkt-fits? (fn (s) (<= (string-length s) gitea/pkt-max)))
+
+(define
+  gitea/pkt
+  (fn
+    (s)
+    (if
+      (gitea/pkt-fits? s)
+      (str (gitea/hex4 (+ (string-length s) 4)) s)
+      (error "gitea/pkt: payload exceeds pkt-line limit"))))
+
+(define gitea/pkt-flush "0000")
+
+; frame a list of line-lists, flush after each section
+(define
+  gitea/pkt-render
+  (fn
+    (sections)
+    (join
+      ""
+      (map
+        (fn (lines) (str (join "" (map gitea/pkt lines)) gitea/pkt-flush))
+        sections))))
+
+; parse framed data into sections (lists of lines) split on flush pkts
+(define
+  gitea/pkt-sections-loop
+  (fn
+    (data i cur sections)
+    (if
+      (>= i (string-length data))
+      (reverse (if (empty? cur) sections (cons (reverse cur) sections)))
+      (let
+        ((n (gitea/hex4-parse (substr data i 4))))
+        (if
+          (= n 0)
+          (gitea/pkt-sections-loop
+            data
+            (+ i 4)
+            (list)
+            (cons (reverse cur) sections))
+          (gitea/pkt-sections-loop
+            data
+            (+ i n)
+            (cons (substr data (+ i 4) (- n 4)) cur)
+            sections))))))
+
+(define
+  gitea/pkt-sections
+  (fn (data) (gitea/pkt-sections-loop data 0 (list) (list))))
+
+; ── object closure ───────────────────────────────────────────────────
+
+; cids an object references
+(define
+  gitea/obj-refs
+  (fn
+    (obj)
+    (cond
+      ((git/commit? obj)
+        (cons (git/commit-tree obj) (git/commit-parents obj)))
+      ((git/tree? obj)
+        (map
+          (fn (n) (git/entry-cid (git/tree-entry-for obj n)))
+          (git/tree-names obj)))
+      ((git/tag? obj) (list (git/tag-target obj)))
+      (else (list)))))
+
+; walk from pending cids; returns {:seen {cid true} :missing (cids)}
+(define
+  gitea/closure-walk
+  (fn
+    (grepo pending seen missing)
+    (if
+      (empty? pending)
+      {:seen seen :missing (reverse missing)}
+      (let
+        ((cid (first pending)) (more (rest pending)))
+        (if
+          (get seen cid)
+          (gitea/closure-walk grepo more seen missing)
+          (let
+            ((obj (git/read grepo cid)))
+            (if
+              (nil? obj)
+              (gitea/closure-walk grepo more seen (cons cid missing))
+              (gitea/closure-walk
+                grepo
+                (concat (gitea/obj-refs obj) more)
+                (assoc seen cid true)
+                missing))))))))
+
+(define
+  gitea/closure
+  (fn
+    (grepo cids)
+    (get (gitea/closure-walk grepo cids {} (list)) :seen)))
+
+(define
+  gitea/closure-list
+  (fn (grepo cids) (artdag/sort-strings (keys (gitea/closure grepo cids)))))
+
+(define
+  gitea/closure-complete?
+  (fn
+    (grepo cids)
+    (empty?
+      (get (gitea/closure-walk grepo cids {} (list)) :missing))))
+
+; objects needed to bring someone with `haves` up to `wants`
+(define
+  gitea/pack-cids
+  (fn
+    (grepo wants haves)
+    (let
+      ((have-set (gitea/closure grepo haves)))
+      (filter
+        (fn (c) (not (get have-set c)))
+        (gitea/closure-list grepo wants)))))
+
+; ── wire object encoding ─────────────────────────────────────────────
+
+(define
+  gitea/pack-line
+  (fn (grepo cid) (str cid " " (serialize (git/read grepo cid)))))
+
+; parse "<cid> <sx>" and verify the cid matches the bytes
+(define
+  gitea/pack-line-parse
+  (fn
+    (line)
+    (let
+      ((sp (index-of line " ")))
+      (if
+        (< sp 0)
+        {:error "malformed"}
+        (let
+          ((cid (substr line 0 sp))
+            (obj (first (sx-parse (substr line (+ sp 1))))))
+          (if (= (git/cid obj) cid) {:obj obj :cid cid} {:error "cid-mismatch" :cid cid}))))))
+
+; verify + store every pack line; => {:stored n} | {:error ...}
+(define
+  gitea/unpack!
+  (fn
+    (grepo lines)
+    (reduce
+      (fn
+        (acc line)
+        (if
+          (get acc :error)
+          acc
+          (let
+            ((p (gitea/pack-line-parse line)))
+            (if
+              (get p :error)
+              p
+              (begin (git/write grepo (get p :obj)) {:stored (+ (get acc :stored) 1)})))))
+      {:stored 0}
+      lines)))
+
+; ── server: ref advertisement ────────────────────────────────────────
+
+(define
+  gitea/shared-ref?
+  (fn (name) (or (starts-with? name "heads/") (starts-with? name "tags/"))))
+
+(define
+  gitea/wire-refs
+  (fn
+    (grepo)
+    (filter (fn (n) (gitea/shared-ref? n)) (git/ref-names grepo))))
+
+(define
+  gitea/w-info-refs
+  (fn
+    (forge req)
+    (let
+      ((owner (dream-param req "owner")) (name (dream-param req "name")))
+      (if
+        (not (gitea/w-readable? forge req owner name))
+        (dream-not-found)
+        (let
+          ((grepo (gitea/repo-git forge owner name)))
+          (let
+            ((head-line (let ((target (git/head-target grepo))) (if (nil? target) (list) (list (str "@ " target)))))
+              (ref-lines
+                (map
+                  (fn (n) (str (git/ref-get grepo n) " " n))
+                  (gitea/wire-refs grepo))))
+            (dream-text
+              (gitea/pkt-render (list (concat head-line ref-lines))))))))))
+
+; ── server: upload-pack (clone/fetch) ────────────────────────────────
+
+(define
+  gitea/want-lines
+  (fn
+    (lines prefix)
+    (map
+      (fn (l) (substr l (string-length prefix)))
+      (filter (fn (l) (starts-with? l prefix)) lines))))
+
+(define
+  gitea/w-upload-pack
+  (fn
+    (forge req)
+    (let
+      ((owner (dream-param req "owner")) (name (dream-param req "name")))
+      (if
+        (not (gitea/w-readable? forge req owner name))
+        (dream-not-found)
+        (let
+          ((grepo (gitea/repo-git forge owner name))
+            (sections (gitea/pkt-sections (dream-body req))))
+          (let
+            ((lines (if (empty? sections) (list) (first sections))))
+            (let
+              ((wants (gitea/want-lines lines "want "))
+                (haves (gitea/want-lines lines "have ")))
+              (dream-text
+                (gitea/pkt-render
+                  (list
+                    (map
+                      (fn (c) (gitea/pack-line grepo c))
+                      (gitea/pack-cids grepo wants haves))))))))))))
+
+; ── server: receive-pack (push) ──────────────────────────────────────
+
+(define gitea/zero-ref "-")
+
+; "<old> <new> <refname>" — old/new are cids or "-"
+(define
+  gitea/cmd-parse
+  (fn
+    (line)
+    (let
+      ((a (index-of line " ")))
+      (let ((b (index-of (substr line (+ a 1)) " "))) {:name (substr line (+ a 1 b 1)) :new (substr line (+ a 1) b) :old (substr line 0 a)}))))
+
+; apply one ref command; => "ok <name>" | "ng <name> <reason>"
+(define
+  gitea/apply-cmd!
+  (fn
+    (grepo cmd)
+    (let
+      ((old (get cmd :old)) (new (get cmd :new)) (name (get cmd :name)))
+      (cond
+        ((not (gitea/shared-ref? name)) (str "ng " name " invalid-ref"))
+        ((equal? new gitea/zero-ref)
+          (if
+            (=
+              (git/ref-get grepo name)
+              (if (equal? old gitea/zero-ref) nil old))
+            (begin (git/ref-delete! grepo name) (str "ok " name))
+            (str "ng " name " stale")))
+        ((not (gitea/closure-complete? grepo (list new)))
+          (str "ng " name " missing-objects"))
+        ((and (not (equal? old gitea/zero-ref)) (starts-with? name "heads/") (not (git/is-ancestor? grepo old new)))
+          (str "ng " name " non-fast-forward"))
+        (else
+          (let
+            ((res (git/ref-cas! grepo name (if (equal? old gitea/zero-ref) nil old) new)))
+            (if
+              (and (dict? res) (get res :conflict))
+              (str "ng " name " stale")
+              (str "ok " name))))))))
+
+(define
+  gitea/w-receive-pack
+  (fn
+    (forge req)
+    (let
+      ((owner (dream-param req "owner")) (name (dream-param req "name")))
+      (let
+        ((user (gitea/w-user forge req)))
+        (cond
+          ((not (gitea/can? forge user "read" owner name))
+            (dream-not-found))
+          ((nil? user) (gitea/w-unauthorized))
+          ((not (gitea/can? forge user "write" owner name))
+            (gitea/w-forbidden))
+          (else
+            (let
+              ((grepo (gitea/repo-git forge owner name))
+                (sections (gitea/pkt-sections (dream-body req))))
+              (let
+                ((cmds (if (empty? sections) (list) (first sections)))
+                  (objs
+                    (if
+                      (< (len sections) 2)
+                      (list)
+                      (nth sections 1))))
+                (let
+                  ((unpack (gitea/unpack! grepo objs)))
+                  (if
+                    (get unpack :error)
+                    (dream-text
+                      (gitea/pkt-render
+                        (list (list (str "unpack " (get unpack :error))))))
+                    (dream-text
+                      (gitea/pkt-render
+                        (list
+                          (cons
+                            "unpack ok"
+                            (map
+                              (fn
+                                (c)
+                                (gitea/apply-cmd! grepo (gitea/cmd-parse c)))
+                              cmds)))))))))))))))
+
+; ── routes ───────────────────────────────────────────────────────────
+
+(define
+  gitea/wire-routes
+  (fn
+    (forge)
+    (list
+      (dream-get
+        "/:owner/:name/info/refs"
+        (fn (req) (gitea/w-info-refs forge req)))
+      (dream-post
+        "/:owner/:name/git-upload-pack"
+        (fn (req) (gitea/w-upload-pack forge req)))
+      (dream-post
+        "/:owner/:name/git-receive-pack"
+        (fn (req) (gitea/w-receive-pack forge req))))))
+
+(set! gitea/route-packs (append gitea/route-packs (list gitea/wire-routes)))
+
+; back-compat aliases from before the route-pack registry
+(define gitea/forge-routes gitea/all-routes)
+(define gitea/forge-app gitea/app)
+
+; ── client ───────────────────────────────────────────────────────────
+; A remote is any dream app fn plus repo coordinates and a token — the
+; same code drives an in-memory forge or (later) a real HTTP transport.
+
+(define gitea/remote (fn (app owner name token) {:name name :token token :owner owner :app app}))
+
+(define
+  gitea/remote-call
+  (fn
+    (remote method suffix body)
+    ((get remote :app)
+      (dream-request
+        method
+        (str "/" (get remote :owner) "/" (get remote :name) suffix)
+        (if (nil? (get remote :token)) {} {:authorization (str "Bearer " (get remote :token))})
+        body))))
+
+; => {:head "heads/..."|nil :refs {name cid}} | nil when unreachable
+(define
+  gitea/ls-remote
+  (fn
+    (remote)
+    (let
+      ((resp (gitea/remote-call remote "GET" "/info/refs" "")))
+      (if
+        (not (= (dream-status resp) 200))
+        nil
+        (let
+          ((lines (let ((s (gitea/pkt-sections (dream-resp-body resp)))) (if (empty? s) (list) (first s)))))
+          (reduce
+            (fn
+              (acc l)
+              (let
+                ((sp (index-of l " ")))
+                (if
+                  (starts-with? l "@ ")
+                  (assoc acc :head (substr l 2))
+                  (assoc
+                    acc
+                    :refs (assoc
+                      (get acc :refs)
+                      (substr l (+ sp 1))
+                      (substr l 0 sp))))))
+            {:refs {} :head nil}
+            lines))))))
+
+; fetch the closure of `wants` (minus `haves`) into grepo
+(define
+  gitea/fetch-pack!
+  (fn
+    (remote grepo wants haves)
+    (let
+      ((resp (gitea/remote-call remote "POST" "/git-upload-pack" (gitea/pkt-render (list (concat (map (fn (c) (str "want " c)) wants) (map (fn (c) (str "have " c)) haves)))))))
+      (if
+        (not (= (dream-status resp) 200))
+        {:error (dream-status resp)}
+        (let
+          ((s (gitea/pkt-sections (dream-resp-body resp))))
+          (gitea/unpack! grepo (if (empty? s) (list) (first s))))))))
+
+; mirror-style fetch: pull missing objects, retarget local heads/tags
+; => {:refs ... :stored n} | {:error status}
+(define
+  gitea/fetch!
+  (fn
+    (remote grepo)
+    (let
+      ((ls (gitea/ls-remote remote)))
+      (if
+        (nil? ls)
+        {:error 404}
+        (let
+          ((refs (get ls :refs)))
+          (let
+            ((wants (filter (fn (c) (not (git/has? grepo c))) (map (fn (n) (get refs n)) (keys refs))))
+              (haves
+                (filter
+                  (fn (c) (not (nil? c)))
+                  (map
+                    (fn (b) (git/branch-get grepo b))
+                    (git/branches grepo)))))
+            (let
+              ((res (if (empty? wants) {:stored 0} (gitea/fetch-pack! remote grepo wants haves))))
+              (if
+                (get res :error)
+                res
+                (begin
+                  (for-each
+                    (fn (n) (git/ref-set! grepo n (get refs n)))
+                    (keys refs))
+                  {:refs refs :stored (get res :stored)})))))))))
+
+; clone a remote into this forge as owner/name; the repo is removed
+; again if the remote turns out to be unreachable
+(define
+  gitea/clone!
+  (fn
+    (forge owner name remote opts)
+    (let
+      ((rec (gitea/repo-create! forge owner name (or opts {}))))
+      (if
+        (or (get rec :error) (get rec :conflict))
+        rec
+        (let
+          ((grepo (gitea/repo-git forge owner name)))
+          (let
+            ((res (gitea/fetch! remote grepo)))
+            (if
+              (get res :error)
+              (begin (gitea/repo-delete! forge owner name) res)
+              (let
+                ((head (get (gitea/ls-remote remote) :head)))
+                (begin
+                  (if
+                    (and head (starts-with? head "heads/"))
+                    (let
+                      ((branch (substr head (string-length "heads/"))))
+                      (begin
+                        (git/head-set! grepo branch)
+                        (gitea/repo-update!
+                          forge
+                          owner
+                          name
+                          (fn (r) (assoc r :default-branch branch)))
+                        nil))
+                    nil)
+                  rec)))))))))
+
+; push one ref; => {:ok true} | {:ng reason} | {:error status}
+(define
+  gitea/push-cmd!
+  (fn
+    (remote grepo refname new)
+    (let
+      ((ls (gitea/ls-remote remote)))
+      (if
+        (nil? ls)
+        {:error 404}
+        (let
+          ((old (or (get (get ls :refs) refname) gitea/zero-ref)))
+          (let
+            ((pack (if (equal? new gitea/zero-ref) (list) (gitea/pack-cids grepo (list new) (if (equal? old gitea/zero-ref) (list) (list old))))))
+            (let
+              ((resp (gitea/remote-call remote "POST" "/git-receive-pack" (gitea/pkt-render (list (list (str old " " new " " refname)) (map (fn (c) (gitea/pack-line grepo c)) pack))))))
+              (if
+                (not (= (dream-status resp) 200))
+                {:error (dream-status resp)}
+                (let
+                  ((lines (let ((s (gitea/pkt-sections (dream-resp-body resp)))) (if (empty? s) (list) (first s)))))
+                  (let
+                    ((status (first (filter (fn (l) (or (starts-with? l "ok ") (starts-with? l "ng "))) lines))))
+                    (cond
+                      ((nil? status) {:error "no-status"})
+                      ((starts-with? status "ok ") {:ok true})
+                      (else {:ng (substr status (+ (index-of (substr status 3) " ") 4))}))))))))))))
+
+(define
+  gitea/push!
+  (fn
+    (remote grepo refname)
+    (let
+      ((new (git/ref-get grepo refname)))
+      (if (nil? new) {:error "no-such-local-ref"} (gitea/push-cmd! remote grepo refname new)))))
+
+(define
+  gitea/push-delete!
+  (fn
+    (remote grepo refname)
+    (gitea/push-cmd! remote grepo refname gitea/zero-ref)))