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:
770
lib/gitea/issues.sx
Normal file
770
lib/gitea/issues.sx
Normal 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)))
|
||||
Reference in New Issue
Block a user