From d96529effe1e1d773396cdc0985b8e0459fe50b3 Mon Sep 17 00:00:00 2001 From: giles Date: Fri, 3 Jul 2026 13:53:21 +0000 Subject: [PATCH] =?UTF-8?q?sx-gitea=20Phase=204:=20issues=20=E2=80=94=20co?= =?UTF-8?q?ntent-document=20bodies=20+=20relations=20graph=20(TDD,=20360/3?= =?UTF-8?q?60)?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit 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 --- lib/gitea/conformance.sh | 24 +- lib/gitea/issues.sx | 770 ++++++++++++++++++++++++++++++++++++++ lib/gitea/repo.sx | 47 ++- lib/gitea/scoreboard.json | 7 +- lib/gitea/scoreboard.md | 3 +- lib/gitea/tests/issues.sx | 571 ++++++++++++++++++++++++++++ lib/gitea/web.sx | 17 +- lib/gitea/wire.sx | 17 +- 8 files changed, 1423 insertions(+), 33 deletions(-) create mode 100644 lib/gitea/issues.sx create mode 100644 lib/gitea/tests/issues.sx diff --git a/lib/gitea/conformance.sh b/lib/gitea/conformance.sh index 223eefd5..575affaf 100644 --- a/lib/gitea/conformance.sh +++ b/lib/gitea/conformance.sh @@ -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))" diff --git a/lib/gitea/issues.sx b/lib/gitea/issues.sx new file mode 100644 index 00000000..a7bd6841 --- /dev/null +++ b/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 + "
  • #" + (get r :number) + " " + (dream-escape (get r :title)) + " [" + (get r :state) + "]
  • "))) + +(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 + "

    Issues

    ")))))) + +(define + gitea/w-comment-html + (fn + (owner name n i c) + (str + "

    " + (dream-escape (get c :author)) + "

    " + (gitea/md-html (get c :body) (str "c-" owner "-" name "-" n "-" i)) + "
    "))) + +(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 + "

    #" + n + " " + (dream-escape (get rec :title)) + "

    " + "

    " + (get rec :state) + "

    " + "

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

    " + "

    " + (dream-escape (join ", " (get rec :labels))) + "

    " + "

    " + (dream-escape (join ", " (get rec :assignees))) + "

    " + "
    " + (gitea/issue-html owner name rec) + "
    " + "

    Comments

    " + (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))) diff --git a/lib/gitea/repo.sx b/lib/gitea/repo.sx index 1689d194..ee9a1364 100644 --- a/lib/gitea/repo.sx +++ b/lib/gitea/repo.sx @@ -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/"))) diff --git a/lib/gitea/scoreboard.json b/lib/gitea/scoreboard.json index 9a0e2702..ba595c2b 100644 --- a/lib/gitea/scoreboard.json +++ b/lib/gitea/scoreboard.json @@ -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 } diff --git a/lib/gitea/scoreboard.md b/lib/gitea/scoreboard.md index f5221f5a..2a96f95e 100644 --- a/lib/gitea/scoreboard.md +++ b/lib/gitea/scoreboard.md @@ -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** | diff --git a/lib/gitea/tests/issues.sx b/lib/gitea/tests/issues.sx new file mode 100644 index 00000000..5fa8236c --- /dev/null +++ b/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) "

    Heading

    ") + true) +(gitea-issues-test + "issue html code block" + (contains? (gitea/issue-html "alice" "proj" gi-i3) "
    ")
    +  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))
    +    "

    Heading

    ") + 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)) diff --git a/lib/gitea/web.sx b/lib/gitea/web.sx index fd735871..ea9ad0fd 100644 --- a/lib/gitea/web.sx +++ b/lib/gitea/web.sx @@ -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)))) diff --git a/lib/gitea/wire.sx b/lib/gitea/wire.sx index 5776f8f3..90e6ee6b 100644 --- a/lib/gitea/wire.sx +++ b/lib/gitea/wire.sx @@ -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