sx-gitea Phase 4: issues — content-document bodies + relations graph (TDD, 360/360)

lib/gitea/issues.sx: issues as kv records (zero-padded per-repo
numbering, title/author/state, sorted label+assignee sets, Markdown
body, comment thread). Bodies and comments are content-on-sx documents:
content/from-markdown -> block doc -> content/html for pages, with the
round-trip law asserted in the suite. The issue graph (issue->repo
parent, author origin, assignee member, label link, commenter reply) is
DERIVED into lib/relations facts and rebuilt on fact change — same
pattern as the acl db, so deleting a repo can never dangle edges.

Views: open/closed/by-label/by-assignee; graph queries: repo-issue-nodes,
user-authored, user-assigned, label-issues, issue-participants.

Web: issues list + issue page (rendered HTML body + comments), JSON API:
create (any authenticated reader), comment, close/reopen (author or
write), label/assignee management (write). All read-gated like the rest.

Infra: gitea/route-packs registry — wire/issues append their routes at
load; gitea/app serves all packs. repo-delete! now purges collab/issue/
issue-seq rows too (ghost-state regression tested). Conformance runner
gains per-suite extra modules; the issues suite loads relations +
smalltalk + content (~5s).

Co-Authored-By: Claude Fable 5 <noreply@anthropic.com>
This commit is contained in:
2026-07-03 13:53:21 +00:00
parent 83a8a2f8db
commit d96529effe
8 changed files with 1423 additions and 33 deletions

View File

@@ -19,11 +19,14 @@ fi
VERBOSE="${1:-}"
# suite name | pass counter | fail counter | failures list
# 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"
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"
"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"
)
OUT_JSON="lib/gitea/scoreboard.json"
@@ -75,13 +78,16 @@ MODULES=(
)
run_suite() {
local suite=$1 passvar=$2 failvar=$3 failsvar=$4
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)"
@@ -122,8 +128,8 @@ TOTAL_FAIL=0
echo "Running sx-gitea conformance suite..." >&2
for entry in "${SUITES[@]}"; do
IFS='|' read -r s passvar failvar failsvar <<< "$entry"
read -r p f < <(run_suite "$s" "$passvar" "$failvar" "$failsvar")
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))
@@ -136,7 +142,7 @@ done
printf ' "suites": {\n'
first=1
for entry in "${SUITES[@]}"; do
IFS='|' read -r s _ _ _ <<< "$entry"
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
@@ -154,7 +160,7 @@ done
printf '| Suite | Pass | Fail | Total |\n'
printf '|-------|-----:|-----:|------:|\n'
for entry in "${SUITES[@]}"; do
IFS='|' read -r s _ _ _ <<< "$entry"
IFS='|' read -r s _ _ _ _ <<< "$entry"
p=${SUITE_PASS[$s]}
f=${SUITE_FAIL[$s]}
printf '| %s | %d | %d | %d |\n' "$s" "$p" "$f" "$((p+f))"

770
lib/gitea/issues.sx Normal file
View File

@@ -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)))

View File

@@ -145,7 +145,24 @@
(forge owner name)
(git/repo-named (gitea/forge-db forge) (gitea/repo-ns owner name))))
; delete the record and purge every git key under the repo's namespace
; 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
@@ -154,15 +171,25 @@
(not (gitea/repo-exists? forge owner name))
false
(let
((db (gitea/forge-db forge)))
(let
((pfx (str (gitea/repo-ns owner name) "/")))
(begin
(for-each
(fn (k) (persist/kv-delete db k))
(filter (fn (k) (starts-with? k pfx)) (persist/kv-keys db)))
(persist/kv-delete db (gitea/repo-key owner name))
true))))))
((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/")))

View File

@@ -2,9 +2,10 @@
"suites": {
"repo": {"pass": 91, "fail": 0},
"access": {"pass": 103, "fail": 0},
"wire": {"pass": 78, "fail": 0}
"wire": {"pass": 78, "fail": 0},
"issues": {"pass": 88, "fail": 0}
},
"total_pass": 272,
"total_pass": 360,
"total_fail": 0,
"total": 272
"total": 360
}

View File

@@ -7,4 +7,5 @@ _Generated by `lib/gitea/conformance.sh`_
| repo | 91 | 0 | 91 |
| access | 103 | 0 | 103 |
| wire | 78 | 0 | 78 |
| **Total** | **272** | **0** | **272** |
| issues | 88 | 0 | 88 |
| **Total** | **360** | **0** | **360** |

571
lib/gitea/tests/issues.sx Normal file
View File

@@ -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))

View File

@@ -11,6 +11,9 @@
; needs the owner (or org admin), delete and collaborator management need
; "admin". 401 = no credentials, 403 = authenticated but not allowed.
;
; Later modules (wire, issues, ...) extend the app by appending a routes
; pack to gitea/route-packs at load time; gitea/app serves them all.
;
; Requires: lib/gitea/{repo,access}.sx, lib/dream/{types,router,middleware,
; error,html,json,auth,api}.sx
@@ -497,4 +500,16 @@
"/:owner/:name/raw/:ref/**"
(fn (req) (gitea/w-raw forge req))))))
(define gitea/app (fn (forge) (dream-make-app (gitea/routes forge))))
; extension point: wire/issues/... append their packs at load time
(define gitea/route-packs (list gitea/routes))
(define
gitea/all-routes
(fn
(forge)
(reduce
(fn (acc pack) (concat acc (pack forge)))
(list)
gitea/route-packs)))
(define gitea/app (fn (forge) (dream-make-app (gitea/all-routes forge))))

View File

@@ -7,7 +7,7 @@
; 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 (added to the web routes by gitea/forge-routes):
; 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
@@ -19,7 +19,8 @@
; 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.
; Requires: lib/gitea/{repo,access,web}.sx and their stacks, plus
; sx-parse (spec/parser.sx on the OCaml server host).
; ── pkt-line framing ─────────────────────────────────────────────────
@@ -359,7 +360,7 @@
(gitea/apply-cmd! grepo (gitea/cmd-parse c)))
cmds)))))))))))))))
; ── routes: web + wire ───────────────────────────────────────────────
; ── routes ───────────────────────────────────────────────────────────
(define
gitea/wire-routes
@@ -376,13 +377,11 @@
"/:owner/:name/git-receive-pack"
(fn (req) (gitea/w-receive-pack forge req))))))
(define
gitea/forge-routes
(fn (forge) (concat (gitea/routes forge) (gitea/wire-routes forge))))
(set! gitea/route-packs (append gitea/route-packs (list gitea/wire-routes)))
(define
gitea/forge-app
(fn (forge) (dream-make-app (gitea/forge-routes forge))))
; 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