sx-gitea Phase 5: pr — merge-base diffs, reviews, flow lifecycle, 3-way merge, merge queue (TDD, 460/460)
lib/gitea/pr.sx: PRs as kv records sharing the per-repo number counter with issues. Diffs are LIVE, computed from the merge base of the current branch heads to the source head via sx-git (no spurious deletions when the target moves on). Reviews: latest verdict per reviewer wins; authors cannot review their own PR; approved? = some approve and no outstanding request-changes. Lifecycle is a lib/flow durable workflow (deterministic-replay suspend): open -(approval)-> approved -(merge)-> merged; review! resumes the approval suspend when the verdict set first approves, merge! resumes the rest, close! cancels, reopen! starts a fresh flow. The flow env lives in the forge handle; the record's :state stays the source of truth. Merge via git/merge-commits over the merge base: up-to-date, fast- forward (ref move only), true two-parent merge commit, or conflicts with the conflicting paths. Every ref move is branch-cas! — concurrent pushes surface as 'stale'. Merge queue: approved PRs merge in order, failures stay queued. Web: pulls list + PR page (body html, reviews, lifecycle, unified diff), JSON API for create/review/merge (409 on conflicts/stale)/close (author or write)/enqueue/queue-process. Co-Authored-By: Claude Fable 5 <noreply@anthropic.com>
This commit is contained in:
@@ -22,11 +22,14 @@ VERBOSE="${1:-}"
|
|||||||
# suite name | pass counter | fail counter | failures list | extra modules (;-sep)
|
# 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"
|
ISSUES_EXTRAS="lib/relations/schema.sx;lib/relations/engine.sx;lib/relations/api.sx;lib/smalltalk/tokenizer.sx;lib/smalltalk/parser.sx;lib/guest/reflective/class-chain.sx;lib/smalltalk/runtime.sx;lib/guest/reflective/env.sx;lib/smalltalk/eval.sx;lib/content/block.sx;lib/content/doc.sx;lib/content/render.sx;lib/content/api.sx;lib/content/meta.sx;lib/content/text.sx;lib/content/section.sx;lib/content/table.sx;lib/content/markdown.sx;lib/content/md-import.sx;lib/gitea/issues.sx"
|
||||||
|
|
||||||
|
PR_EXTRAS="$ISSUES_EXTRAS;lib/guest/lex.sx;lib/guest/reflective/quoting.sx;lib/scheme/parser.sx;lib/scheme/eval.sx;lib/scheme/runtime.sx;lib/flow/spec.sx;lib/flow/store.sx;lib/flow/remote.sx;lib/flow/host.sx;lib/flow/api.sx;lib/gitea/pr.sx"
|
||||||
|
|
||||||
SUITES=(
|
SUITES=(
|
||||||
"repo|gitea-repo-pass|gitea-repo-fail|gitea-repo-fails|"
|
"repo|gitea-repo-pass|gitea-repo-fail|gitea-repo-fails|"
|
||||||
"access|gitea-access-pass|gitea-access-fail|gitea-access-fails|"
|
"access|gitea-access-pass|gitea-access-fail|gitea-access-fails|"
|
||||||
"wire|gitea-wire-pass|gitea-wire-fail|gitea-wire-fails|"
|
"wire|gitea-wire-pass|gitea-wire-fail|gitea-wire-fails|"
|
||||||
"issues|gitea-issues-pass|gitea-issues-fail|gitea-issues-fails|$ISSUES_EXTRAS"
|
"issues|gitea-issues-pass|gitea-issues-fail|gitea-issues-fails|$ISSUES_EXTRAS"
|
||||||
|
"pr|gitea-pr-pass|gitea-pr-fail|gitea-pr-fails|$PR_EXTRAS"
|
||||||
)
|
)
|
||||||
|
|
||||||
OUT_JSON="lib/gitea/scoreboard.json"
|
OUT_JSON="lib/gitea/scoreboard.json"
|
||||||
|
|||||||
808
lib/gitea/pr.sx
Normal file
808
lib/gitea/pr.sx
Normal file
@@ -0,0 +1,808 @@
|
|||||||
|
; lib/gitea/pr.sx — sx-gitea Phase 5: pull requests.
|
||||||
|
;
|
||||||
|
; A PR is a kv record: source branch -> target branch, title/author/body
|
||||||
|
; (Markdown, rendered via content like issues), a review thread (latest
|
||||||
|
; verdict per reviewer wins), and a merge outcome. Numbers share the
|
||||||
|
; per-repo counter with issues (gitea/issue-next!), GitHub-style.
|
||||||
|
;
|
||||||
|
; The diff is always LIVE — computed with sx-git from the merge base of
|
||||||
|
; the current branch heads to the source head (so a target that moved on
|
||||||
|
; never shows spurious deletions), never stored.
|
||||||
|
;
|
||||||
|
; Lifecycle is a lib/flow durable workflow (deterministic-replay
|
||||||
|
; suspend): open -(approval)-> approved -(merge)-> merged. review! resumes
|
||||||
|
; the approval suspend when the verdict set first becomes approving;
|
||||||
|
; merge!/close! resume/cancel the rest. The flow env lives in the forge
|
||||||
|
; handle; the record's :state stays the source of truth (merge re-checks
|
||||||
|
; approval live — the flow is the durable journal of the lifecycle).
|
||||||
|
;
|
||||||
|
; Merging uses git/merge-commits (3-way over the merge base): up-to-date
|
||||||
|
; and fast-forward move nothing or just the ref; a true merge writes a
|
||||||
|
; two-parent commit; conflicts abort with the conflicting paths. All ref
|
||||||
|
; moves go through branch-cas! — a concurrent push surfaces as "stale".
|
||||||
|
;
|
||||||
|
; The merge queue is a per-repo list of approved PR numbers;
|
||||||
|
; queue-process! merges them in order, keeping the failures queued.
|
||||||
|
;
|
||||||
|
; Requires: lib/gitea/{repo,access,web,issues}.sx and their stacks, plus
|
||||||
|
; the flow stack (lib/guest/lex, lib/guest/reflective/{env,quoting},
|
||||||
|
; lib/scheme/{parser,eval,runtime}, lib/flow/{spec,store,remote,host,api}).
|
||||||
|
|
||||||
|
; ── record plumbing ──────────────────────────────────────────────────
|
||||||
|
|
||||||
|
(define
|
||||||
|
gitea/pr-key
|
||||||
|
(fn (owner name n) (str "gitea/pr/" owner "/" name "/" (gitea/pad8 n))))
|
||||||
|
|
||||||
|
(define
|
||||||
|
gitea/pr-get
|
||||||
|
(fn
|
||||||
|
(forge owner name n)
|
||||||
|
(persist/kv-get (gitea/forge-db forge) (gitea/pr-key owner name n))))
|
||||||
|
|
||||||
|
(define
|
||||||
|
gitea/prs
|
||||||
|
(fn
|
||||||
|
(forge owner name)
|
||||||
|
(map
|
||||||
|
(fn (s) (parse-int s))
|
||||||
|
(gitea/names-under forge (str "gitea/pr/" owner "/" name "/")))))
|
||||||
|
|
||||||
|
(define
|
||||||
|
gitea/pr-records
|
||||||
|
(fn
|
||||||
|
(forge owner name)
|
||||||
|
(map
|
||||||
|
(fn (n) (gitea/pr-get forge owner name n))
|
||||||
|
(gitea/prs forge owner name))))
|
||||||
|
|
||||||
|
(define
|
||||||
|
gitea/pr-update!
|
||||||
|
(fn
|
||||||
|
(forge owner name n f)
|
||||||
|
(let
|
||||||
|
((rec (gitea/pr-get forge owner name n)))
|
||||||
|
(if
|
||||||
|
(nil? rec)
|
||||||
|
nil
|
||||||
|
(persist/kv-put
|
||||||
|
(gitea/forge-db forge)
|
||||||
|
(gitea/pr-key owner name n)
|
||||||
|
(f rec))))))
|
||||||
|
|
||||||
|
; ── the lifecycle flow ───────────────────────────────────────────────
|
||||||
|
|
||||||
|
(define
|
||||||
|
gitea/pr-flow-src
|
||||||
|
"(defflow pr-lifecycle (sequence (flow-node (lambda (x) (suspend (quote approval)))) (flow-node (lambda (x) (suspend (quote merge)))) (flow-node (lambda (x) (quote merged)))))")
|
||||||
|
|
||||||
|
(define
|
||||||
|
gitea/flow-env
|
||||||
|
(fn
|
||||||
|
(forge)
|
||||||
|
(let
|
||||||
|
((cache (get forge :cache)))
|
||||||
|
(if
|
||||||
|
(and cache (get cache "flow-env"))
|
||||||
|
(get cache "flow-env")
|
||||||
|
(let
|
||||||
|
((env (flow-make-env)))
|
||||||
|
(begin
|
||||||
|
(flow-run-in env gitea/pr-flow-src)
|
||||||
|
(if cache (dict-set! cache "flow-env" env) nil)
|
||||||
|
env))))))
|
||||||
|
|
||||||
|
; => flow id (int) | nil
|
||||||
|
(define
|
||||||
|
gitea/pr-flow-start!
|
||||||
|
(fn
|
||||||
|
(forge n)
|
||||||
|
(let
|
||||||
|
((res (flow-run-in (gitea/flow-env forge) (str "(flow/start pr-lifecycle " n ")"))))
|
||||||
|
(if
|
||||||
|
(and (list? res) (>= (len res) 2))
|
||||||
|
(nth res 1)
|
||||||
|
nil))))
|
||||||
|
|
||||||
|
(define
|
||||||
|
gitea/flow-pending-tag
|
||||||
|
(fn
|
||||||
|
(forge fid)
|
||||||
|
(let
|
||||||
|
((pending (flow-run-in (gitea/flow-env forge) "(flow/pending)")))
|
||||||
|
(reduce
|
||||||
|
(fn
|
||||||
|
(acc p)
|
||||||
|
(if
|
||||||
|
(and (list? p) (= (first p) fid))
|
||||||
|
(str (nth p 1))
|
||||||
|
acc))
|
||||||
|
nil
|
||||||
|
pending))))
|
||||||
|
|
||||||
|
(define
|
||||||
|
gitea/pr-flow-resume!
|
||||||
|
(fn
|
||||||
|
(forge fid value)
|
||||||
|
(flow-run-in
|
||||||
|
(gitea/flow-env forge)
|
||||||
|
(str "(flow/resume " fid " (quote " value "))"))))
|
||||||
|
|
||||||
|
(define
|
||||||
|
gitea/pr-flow-cancel!
|
||||||
|
(fn
|
||||||
|
(forge fid)
|
||||||
|
(flow-run-in (gitea/flow-env forge) (str "(flow/cancel " fid ")"))))
|
||||||
|
|
||||||
|
; lifecycle stage as seen from the durable flow
|
||||||
|
(define
|
||||||
|
gitea/pr-flow-status
|
||||||
|
(fn
|
||||||
|
(forge rec)
|
||||||
|
(let
|
||||||
|
((fid (get rec :flow-id)))
|
||||||
|
(if
|
||||||
|
(nil? fid)
|
||||||
|
"none"
|
||||||
|
(let
|
||||||
|
((st (str (flow-run-in (gitea/flow-env forge) (str "(flow/status " fid ")")))))
|
||||||
|
(cond
|
||||||
|
((= st "done") "merged")
|
||||||
|
((= st "cancelled") "closed")
|
||||||
|
((= st "suspended")
|
||||||
|
(let
|
||||||
|
((tag (gitea/flow-pending-tag forge fid)))
|
||||||
|
(cond
|
||||||
|
((= tag "approval") "review")
|
||||||
|
((= tag "merge") "approved")
|
||||||
|
(else "suspended"))))
|
||||||
|
(else st)))))))
|
||||||
|
|
||||||
|
; ── create ───────────────────────────────────────────────────────────
|
||||||
|
|
||||||
|
(define
|
||||||
|
gitea/pr-create!
|
||||||
|
(fn
|
||||||
|
(forge owner name author title source target body opts)
|
||||||
|
(cond
|
||||||
|
((not (gitea/repo-exists? forge owner name)) {:error "no-such-repo"})
|
||||||
|
((not (gitea/owner-exists? forge author)) {:error "no-such-user"})
|
||||||
|
((or (not (string? title)) (= title "")) {:error "empty-title"})
|
||||||
|
((= source target) {:error "same-branch"})
|
||||||
|
(else
|
||||||
|
(let
|
||||||
|
((grepo (gitea/repo-git forge owner name)))
|
||||||
|
(cond
|
||||||
|
((nil? (git/branch-get grepo source)) {:error "no-such-source"})
|
||||||
|
((nil? (git/branch-get grepo target)) {:error "no-such-target"})
|
||||||
|
(else
|
||||||
|
(let
|
||||||
|
((o (or opts {})))
|
||||||
|
(let
|
||||||
|
((n (gitea/issue-next! forge owner name)))
|
||||||
|
(let
|
||||||
|
((rec {:source source :state "open" :title title :merge-cid nil :reviews (list) :body (or body "") :number n :author author :created-at (or (get o :created-at) 0) :target target :flow-id (gitea/pr-flow-start! forge n)}))
|
||||||
|
(begin
|
||||||
|
(persist/kv-put
|
||||||
|
(gitea/forge-db forge)
|
||||||
|
(gitea/pr-key owner name n)
|
||||||
|
rec)
|
||||||
|
rec)))))))))))
|
||||||
|
|
||||||
|
; ── live diff (merge base -> source head) ────────────────────────────
|
||||||
|
|
||||||
|
(define
|
||||||
|
gitea/pr-heads
|
||||||
|
(fn
|
||||||
|
(forge owner name rec)
|
||||||
|
(let
|
||||||
|
((grepo (gitea/repo-git forge owner name)))
|
||||||
|
(let
|
||||||
|
((tcid (git/branch-get grepo (get rec :target)))
|
||||||
|
(scid (git/branch-get grepo (get rec :source))))
|
||||||
|
{:base-cid (if (or (nil? tcid) (nil? scid)) nil (or (git/merge-base grepo tcid scid) tcid)) :grepo grepo :target-cid tcid :source-cid scid}))))
|
||||||
|
|
||||||
|
; {:added :modified :deleted} from the merge base to the source head
|
||||||
|
(define
|
||||||
|
gitea/pr-diff
|
||||||
|
(fn
|
||||||
|
(forge owner name n)
|
||||||
|
(let
|
||||||
|
((rec (gitea/pr-get forge owner name n)))
|
||||||
|
(if
|
||||||
|
(nil? rec)
|
||||||
|
nil
|
||||||
|
(let
|
||||||
|
((h (gitea/pr-heads forge owner name rec)))
|
||||||
|
(if
|
||||||
|
(or (nil? (get h :base-cid)) (nil? (get h :source-cid)))
|
||||||
|
nil
|
||||||
|
(git/commit-diff
|
||||||
|
(get h :grepo)
|
||||||
|
(get h :base-cid)
|
||||||
|
(get h :source-cid))))))))
|
||||||
|
|
||||||
|
(define
|
||||||
|
gitea/pr-diff-unified
|
||||||
|
(fn
|
||||||
|
(forge owner name n)
|
||||||
|
(let
|
||||||
|
((rec (gitea/pr-get forge owner name n)))
|
||||||
|
(if
|
||||||
|
(nil? rec)
|
||||||
|
nil
|
||||||
|
(let
|
||||||
|
((h (gitea/pr-heads forge owner name rec)))
|
||||||
|
(if
|
||||||
|
(or (nil? (get h :base-cid)) (nil? (get h :source-cid)))
|
||||||
|
nil
|
||||||
|
(git/commit-diff-unified
|
||||||
|
(get h :grepo)
|
||||||
|
(get h :base-cid)
|
||||||
|
(get h :source-cid))))))))
|
||||||
|
|
||||||
|
; ── reviews ──────────────────────────────────────────────────────────
|
||||||
|
|
||||||
|
(define gitea/pr-verdicts (list "approve" "request-changes"))
|
||||||
|
|
||||||
|
; latest verdict per reviewer
|
||||||
|
(define
|
||||||
|
gitea/pr-latest-verdicts
|
||||||
|
(fn
|
||||||
|
(rec)
|
||||||
|
(reduce
|
||||||
|
(fn (acc r) (assoc acc (get r :reviewer) (get r :verdict)))
|
||||||
|
{}
|
||||||
|
(get rec :reviews))))
|
||||||
|
|
||||||
|
(define
|
||||||
|
gitea/pr-approved?
|
||||||
|
(fn
|
||||||
|
(rec)
|
||||||
|
(let
|
||||||
|
((latest (gitea/pr-latest-verdicts rec)))
|
||||||
|
(let
|
||||||
|
((vs (map (fn (k) (get latest k)) (keys latest))))
|
||||||
|
(and
|
||||||
|
(contains? vs "approve")
|
||||||
|
(not (contains? vs "request-changes")))))))
|
||||||
|
|
||||||
|
; resume the approval suspend the first time the verdict set approves
|
||||||
|
(define
|
||||||
|
gitea/pr-sync-flow!
|
||||||
|
(fn
|
||||||
|
(forge owner name n)
|
||||||
|
(let
|
||||||
|
((rec (gitea/pr-get forge owner name n)))
|
||||||
|
(if
|
||||||
|
(and
|
||||||
|
rec
|
||||||
|
(gitea/pr-approved? rec)
|
||||||
|
(not (nil? (get rec :flow-id)))
|
||||||
|
(= (gitea/flow-pending-tag forge (get rec :flow-id)) "approval"))
|
||||||
|
(begin
|
||||||
|
(gitea/pr-flow-resume! forge (get rec :flow-id) "approved")
|
||||||
|
true)
|
||||||
|
false))))
|
||||||
|
|
||||||
|
(define
|
||||||
|
gitea/pr-review!
|
||||||
|
(fn
|
||||||
|
(forge owner name n reviewer verdict body opts)
|
||||||
|
(let
|
||||||
|
((rec (gitea/pr-get forge owner name n)))
|
||||||
|
(cond
|
||||||
|
((nil? rec) {:error "no-such-pr"})
|
||||||
|
((not (= (get rec :state) "open")) {:error "not-open"})
|
||||||
|
((not (gitea/owner-exists? forge reviewer)) {:error "no-such-user"})
|
||||||
|
((= reviewer (get rec :author)) {:error "own-pr"})
|
||||||
|
((not (contains? gitea/pr-verdicts verdict)) {:error "invalid-verdict"})
|
||||||
|
(else
|
||||||
|
(let
|
||||||
|
((review {:verdict verdict :body (or body "") :at (or (get (or opts {}) :at) 0) :reviewer reviewer}))
|
||||||
|
(begin
|
||||||
|
(gitea/pr-update!
|
||||||
|
forge
|
||||||
|
owner
|
||||||
|
name
|
||||||
|
n
|
||||||
|
(fn
|
||||||
|
(r)
|
||||||
|
(assoc r :reviews (append (get r :reviews) (list review)))))
|
||||||
|
(gitea/pr-sync-flow! forge owner name n)
|
||||||
|
review)))))))
|
||||||
|
|
||||||
|
; ── merge ────────────────────────────────────────────────────────────
|
||||||
|
|
||||||
|
(define
|
||||||
|
gitea/pr-mark-merged!
|
||||||
|
(fn
|
||||||
|
(forge owner name n cid)
|
||||||
|
(let
|
||||||
|
((rec (gitea/pr-update! forge owner name n (fn (r) (assoc (assoc r :state "merged") :merge-cid cid)))))
|
||||||
|
(begin
|
||||||
|
(if
|
||||||
|
(and
|
||||||
|
rec
|
||||||
|
(not (nil? (get rec :flow-id)))
|
||||||
|
(= (gitea/flow-pending-tag forge (get rec :flow-id)) "merge"))
|
||||||
|
(gitea/pr-flow-resume! forge (get rec :flow-id) "merged")
|
||||||
|
nil)
|
||||||
|
rec))))
|
||||||
|
|
||||||
|
(define
|
||||||
|
gitea/pr-merge!
|
||||||
|
(fn
|
||||||
|
(forge owner name n merger opts)
|
||||||
|
(let
|
||||||
|
((rec (gitea/pr-get forge owner name n)))
|
||||||
|
(cond
|
||||||
|
((nil? rec) {:error "no-such-pr"})
|
||||||
|
((not (= (get rec :state) "open")) {:error "not-open"})
|
||||||
|
((not (gitea/pr-approved? rec)) {:error "not-approved"})
|
||||||
|
(else
|
||||||
|
(let
|
||||||
|
((h (gitea/pr-heads forge owner name rec)))
|
||||||
|
(let
|
||||||
|
((grepo (get h :grepo))
|
||||||
|
(tcid (get h :target-cid))
|
||||||
|
(scid (get h :source-cid)))
|
||||||
|
(cond
|
||||||
|
((or (nil? tcid) (nil? scid)) {:error "missing-branch"})
|
||||||
|
(else
|
||||||
|
(let
|
||||||
|
((m (git/merge-commits grepo tcid scid)))
|
||||||
|
(cond
|
||||||
|
((= (get m :result) "up-to-date")
|
||||||
|
(gitea/pr-mark-merged! forge owner name n tcid))
|
||||||
|
((= (get m :result) "fast-forward")
|
||||||
|
(let
|
||||||
|
((res (git/branch-cas! grepo (get rec :target) tcid scid)))
|
||||||
|
(if
|
||||||
|
(and (dict? res) (get res :conflict))
|
||||||
|
{:error "stale"}
|
||||||
|
(gitea/pr-mark-merged! forge owner name n scid))))
|
||||||
|
((= (get m :result) "merged")
|
||||||
|
(let
|
||||||
|
((mc (git/write grepo (git/commit (get m :tree) (list tcid scid) {:message (str "Merge PR #" n ": " (get rec :title)) :time (or (get (or opts {}) :time) 0) :author (or merger "")}))))
|
||||||
|
(let
|
||||||
|
((res (git/branch-cas! grepo (get rec :target) tcid mc)))
|
||||||
|
(if
|
||||||
|
(and (dict? res) (get res :conflict))
|
||||||
|
{:error "stale"}
|
||||||
|
(gitea/pr-mark-merged! forge owner name n mc)))))
|
||||||
|
(else {:conflicts (get m :conflicts) :error "conflicts"}))))))))))))
|
||||||
|
|
||||||
|
; ── close / reopen ───────────────────────────────────────────────────
|
||||||
|
|
||||||
|
(define
|
||||||
|
gitea/pr-close!
|
||||||
|
(fn
|
||||||
|
(forge owner name n)
|
||||||
|
(let
|
||||||
|
((rec (gitea/pr-get forge owner name n)))
|
||||||
|
(if
|
||||||
|
(or (nil? rec) (not (= (get rec :state) "open")))
|
||||||
|
nil
|
||||||
|
(begin
|
||||||
|
(if
|
||||||
|
(nil? (get rec :flow-id))
|
||||||
|
nil
|
||||||
|
(gitea/pr-flow-cancel! forge (get rec :flow-id)))
|
||||||
|
(gitea/pr-update!
|
||||||
|
forge
|
||||||
|
owner
|
||||||
|
name
|
||||||
|
n
|
||||||
|
(fn (r) (assoc r :state "closed"))))))))
|
||||||
|
|
||||||
|
; reopening restarts the lifecycle (a cancelled flow cannot resume)
|
||||||
|
(define
|
||||||
|
gitea/pr-reopen!
|
||||||
|
(fn
|
||||||
|
(forge owner name n)
|
||||||
|
(let
|
||||||
|
((rec (gitea/pr-get forge owner name n)))
|
||||||
|
(if
|
||||||
|
(or (nil? rec) (not (= (get rec :state) "closed")))
|
||||||
|
nil
|
||||||
|
(gitea/pr-update!
|
||||||
|
forge
|
||||||
|
owner
|
||||||
|
name
|
||||||
|
n
|
||||||
|
(fn
|
||||||
|
(r)
|
||||||
|
(assoc
|
||||||
|
(assoc r :state "open")
|
||||||
|
:flow-id (gitea/pr-flow-start! forge n))))))))
|
||||||
|
|
||||||
|
; ── merge queue ──────────────────────────────────────────────────────
|
||||||
|
|
||||||
|
(define
|
||||||
|
gitea/queue-key
|
||||||
|
(fn (owner name) (str "gitea/mergeq/" owner "/" name)))
|
||||||
|
|
||||||
|
(define
|
||||||
|
gitea/queue
|
||||||
|
(fn
|
||||||
|
(forge owner name)
|
||||||
|
(persist/kv-get-or
|
||||||
|
(gitea/forge-db forge)
|
||||||
|
(gitea/queue-key owner name)
|
||||||
|
(list))))
|
||||||
|
|
||||||
|
(define
|
||||||
|
gitea/queue-add!
|
||||||
|
(fn
|
||||||
|
(forge owner name n)
|
||||||
|
(let
|
||||||
|
((rec (gitea/pr-get forge owner name n)))
|
||||||
|
(cond
|
||||||
|
((nil? rec) {:error "no-such-pr"})
|
||||||
|
((not (= (get rec :state) "open")) {:error "not-open"})
|
||||||
|
((not (gitea/pr-approved? rec)) {:error "not-approved"})
|
||||||
|
(else
|
||||||
|
(let
|
||||||
|
((q (gitea/queue forge owner name)))
|
||||||
|
(if
|
||||||
|
(contains? q n)
|
||||||
|
q
|
||||||
|
(persist/kv-put
|
||||||
|
(gitea/forge-db forge)
|
||||||
|
(gitea/queue-key owner name)
|
||||||
|
(append q (list n))))))))))
|
||||||
|
|
||||||
|
(define
|
||||||
|
gitea/queue-remove!
|
||||||
|
(fn
|
||||||
|
(forge owner name n)
|
||||||
|
(persist/kv-put
|
||||||
|
(gitea/forge-db forge)
|
||||||
|
(gitea/queue-key owner name)
|
||||||
|
(filter (fn (x) (not (= x n))) (gitea/queue forge owner name)))))
|
||||||
|
|
||||||
|
; merge queued PRs in order; merged ones leave the queue, failures stay
|
||||||
|
; => ({:number n :merged true} | {:number n :error reason} ...)
|
||||||
|
(define
|
||||||
|
gitea/queue-process!
|
||||||
|
(fn
|
||||||
|
(forge owner name merger)
|
||||||
|
(let
|
||||||
|
((results (map (fn (n) (let ((res (gitea/pr-merge! forge owner name n merger {}))) (if (get res :error) {:error (get res :error) :number n} {:merged true :number n}))) (gitea/queue forge owner name))))
|
||||||
|
(begin
|
||||||
|
(persist/kv-put
|
||||||
|
(gitea/forge-db forge)
|
||||||
|
(gitea/queue-key owner name)
|
||||||
|
(map
|
||||||
|
(fn (r) (get r :number))
|
||||||
|
(filter (fn (r) (get r :error)) results)))
|
||||||
|
results))))
|
||||||
|
|
||||||
|
; ── web ──────────────────────────────────────────────────────────────
|
||||||
|
|
||||||
|
(define
|
||||||
|
gitea/w-pr-item
|
||||||
|
(fn
|
||||||
|
(owner name r)
|
||||||
|
(str
|
||||||
|
"<li class=\""
|
||||||
|
(get r :state)
|
||||||
|
"\"><a href=\"/"
|
||||||
|
owner
|
||||||
|
"/"
|
||||||
|
name
|
||||||
|
"/pulls/"
|
||||||
|
(get r :number)
|
||||||
|
"\">#"
|
||||||
|
(get r :number)
|
||||||
|
" "
|
||||||
|
(dream-escape (get r :title))
|
||||||
|
"</a> ["
|
||||||
|
(get r :state)
|
||||||
|
"] "
|
||||||
|
(dream-escape (get r :source))
|
||||||
|
" -> "
|
||||||
|
(dream-escape (get r :target))
|
||||||
|
"</li>")))
|
||||||
|
|
||||||
|
(define
|
||||||
|
gitea/w-pulls-page
|
||||||
|
(fn
|
||||||
|
(forge req)
|
||||||
|
(let
|
||||||
|
((owner (dream-param req "owner")) (name (dream-param req "name")))
|
||||||
|
(if
|
||||||
|
(not (gitea/w-readable? forge req owner name))
|
||||||
|
(dream-not-found)
|
||||||
|
(gitea/w-page
|
||||||
|
(str owner "/" name " pull requests")
|
||||||
|
(str
|
||||||
|
"<h1>Pull Requests</h1><ul>"
|
||||||
|
(join
|
||||||
|
""
|
||||||
|
(map
|
||||||
|
(fn (r) (gitea/w-pr-item owner name r))
|
||||||
|
(gitea/pr-records forge owner name)))
|
||||||
|
"</ul>"))))))
|
||||||
|
|
||||||
|
(define
|
||||||
|
gitea/w-review-html
|
||||||
|
(fn
|
||||||
|
(owner name n i r)
|
||||||
|
(str
|
||||||
|
"<div class=\"review "
|
||||||
|
(get r :verdict)
|
||||||
|
"\"><p>"
|
||||||
|
(dream-escape (get r :reviewer))
|
||||||
|
": "
|
||||||
|
(get r :verdict)
|
||||||
|
"</p>"
|
||||||
|
(gitea/md-html (get r :body) (str "rv-" owner "-" name "-" n "-" i))
|
||||||
|
"</div>")))
|
||||||
|
|
||||||
|
(define
|
||||||
|
gitea/w-pull-page
|
||||||
|
(fn
|
||||||
|
(forge req)
|
||||||
|
(let
|
||||||
|
((owner (dream-param req "owner"))
|
||||||
|
(name (dream-param req "name"))
|
||||||
|
(n (gitea/w-issue-n req)))
|
||||||
|
(if
|
||||||
|
(or (nil? n) (not (gitea/w-readable? forge req owner name)))
|
||||||
|
(dream-not-found)
|
||||||
|
(let
|
||||||
|
((rec (gitea/pr-get forge owner name n)))
|
||||||
|
(if
|
||||||
|
(nil? rec)
|
||||||
|
(dream-not-found)
|
||||||
|
(gitea/w-page
|
||||||
|
(str "#" n " " (get rec :title))
|
||||||
|
(str
|
||||||
|
"<h1>#"
|
||||||
|
n
|
||||||
|
" "
|
||||||
|
(dream-escape (get rec :title))
|
||||||
|
"</h1>"
|
||||||
|
"<p class=\"state\">"
|
||||||
|
(get rec :state)
|
||||||
|
"</p>"
|
||||||
|
"<p class=\"branches\">"
|
||||||
|
(dream-escape (get rec :source))
|
||||||
|
" -> "
|
||||||
|
(dream-escape (get rec :target))
|
||||||
|
"</p>"
|
||||||
|
"<p class=\"lifecycle\">"
|
||||||
|
(gitea/pr-flow-status forge rec)
|
||||||
|
"</p>"
|
||||||
|
"<div class=\"body\">"
|
||||||
|
(gitea/md-html
|
||||||
|
(get rec :body)
|
||||||
|
(str "pr-" owner "-" name "-" n))
|
||||||
|
"</div>"
|
||||||
|
"<h2>Reviews</h2>"
|
||||||
|
(join
|
||||||
|
""
|
||||||
|
(map-indexed
|
||||||
|
(fn (i r) (gitea/w-review-html owner name n i r))
|
||||||
|
(get rec :reviews)))
|
||||||
|
"<h2>Diff</h2><pre>"
|
||||||
|
(dream-escape
|
||||||
|
(or (gitea/pr-diff-unified forge owner name n) ""))
|
||||||
|
"</pre>"))))))))
|
||||||
|
|
||||||
|
; ── json api ─────────────────────────────────────────────────────────
|
||||||
|
|
||||||
|
(define
|
||||||
|
gitea/w-api-pulls
|
||||||
|
(fn
|
||||||
|
(forge req)
|
||||||
|
(let
|
||||||
|
((owner (dream-param req "owner")) (name (dream-param req "name")))
|
||||||
|
(if
|
||||||
|
(not (gitea/w-readable? forge req owner name))
|
||||||
|
(dream-not-found)
|
||||||
|
(dream-json-value
|
||||||
|
(map (fn (r) {:source (get r :source) :state (get r :state) :title (get r :title) :number (get r :number) :target (get r :target)}) (gitea/pr-records forge owner name)))))))
|
||||||
|
|
||||||
|
(define
|
||||||
|
gitea/w-api-pr-create
|
||||||
|
(fn
|
||||||
|
(forge req)
|
||||||
|
(let
|
||||||
|
((owner (dream-param req "owner")) (name (dream-param req "name")))
|
||||||
|
(let
|
||||||
|
((user (gitea/w-user forge req)))
|
||||||
|
(cond
|
||||||
|
((not (gitea/can? forge user "read" owner name))
|
||||||
|
(if
|
||||||
|
(nil? user)
|
||||||
|
(if
|
||||||
|
(and
|
||||||
|
(gitea/repo-exists? forge owner name)
|
||||||
|
(equal?
|
||||||
|
(get (gitea/repo-get forge owner name) :visibility)
|
||||||
|
"public"))
|
||||||
|
(gitea/w-unauthorized)
|
||||||
|
(dream-not-found))
|
||||||
|
(dream-not-found)))
|
||||||
|
((nil? user) (gitea/w-unauthorized))
|
||||||
|
(else
|
||||||
|
(let
|
||||||
|
((body (dream-json-body req)))
|
||||||
|
(let
|
||||||
|
((res (gitea/pr-create! forge owner name user (get body :title) (get body :source) (get body :target) (or (get body :body) "") {:created-at (or (get body :created-at) 0)})))
|
||||||
|
(if
|
||||||
|
(get res :error)
|
||||||
|
(gitea/w-json-status 400 {:error (get res :error)})
|
||||||
|
(gitea/w-json-status 201 {:title (get res :title) :number (get res :number)}))))))))))
|
||||||
|
|
||||||
|
(define
|
||||||
|
gitea/w-api-pr-review
|
||||||
|
(fn
|
||||||
|
(forge req)
|
||||||
|
(let
|
||||||
|
((owner (dream-param req "owner"))
|
||||||
|
(name (dream-param req "name"))
|
||||||
|
(n (gitea/w-issue-n req)))
|
||||||
|
(let
|
||||||
|
((user (gitea/w-user forge req)))
|
||||||
|
(cond
|
||||||
|
((or (nil? n) (not (gitea/can? forge user "read" owner name)))
|
||||||
|
(dream-not-found))
|
||||||
|
((nil? user) (gitea/w-unauthorized))
|
||||||
|
(else
|
||||||
|
(let
|
||||||
|
((body (dream-json-body req)))
|
||||||
|
(let
|
||||||
|
((res (gitea/pr-review! forge owner name n user (get body :verdict) (or (get body :body) "") {:at (or (get body :created-at) 0)})))
|
||||||
|
(cond
|
||||||
|
((equal? (get res :error) "no-such-pr") (dream-not-found))
|
||||||
|
((get res :error)
|
||||||
|
(gitea/w-json-status 400 {:error (get res :error)}))
|
||||||
|
(else (dream-json-value {:verdict (get res :verdict) :reviewer user})))))))))))
|
||||||
|
|
||||||
|
(define
|
||||||
|
gitea/w-api-pr-merge
|
||||||
|
(fn
|
||||||
|
(forge req)
|
||||||
|
(let
|
||||||
|
((owner (dream-param req "owner"))
|
||||||
|
(name (dream-param req "name"))
|
||||||
|
(n (gitea/w-issue-n req)))
|
||||||
|
(let
|
||||||
|
((user (gitea/w-user forge req)))
|
||||||
|
(cond
|
||||||
|
((or (nil? n) (not (gitea/can? forge user "read" owner name)))
|
||||||
|
(dream-not-found))
|
||||||
|
((nil? user) (gitea/w-unauthorized))
|
||||||
|
((not (gitea/can? forge user "write" owner name))
|
||||||
|
(gitea/w-forbidden))
|
||||||
|
(else
|
||||||
|
(let
|
||||||
|
((res (gitea/pr-merge! forge owner name n user {:time (or (get (dream-json-body req) :time) 0)})))
|
||||||
|
(cond
|
||||||
|
((equal? (get res :error) "no-such-pr") (dream-not-found))
|
||||||
|
((get res :error)
|
||||||
|
(gitea/w-json-status 409 {:error (get res :error)}))
|
||||||
|
(else (dream-json-value {:state (get res :state) :merge-cid (get res :merge-cid) :number n}))))))))))
|
||||||
|
|
||||||
|
(define
|
||||||
|
gitea/w-api-pr-close
|
||||||
|
(fn
|
||||||
|
(forge req)
|
||||||
|
(let
|
||||||
|
((owner (dream-param req "owner"))
|
||||||
|
(name (dream-param req "name"))
|
||||||
|
(n (gitea/w-issue-n req)))
|
||||||
|
(let
|
||||||
|
((user (gitea/w-user forge req)))
|
||||||
|
(cond
|
||||||
|
((or (nil? n) (not (gitea/can? forge user "read" owner name)))
|
||||||
|
(dream-not-found))
|
||||||
|
((nil? user) (gitea/w-unauthorized))
|
||||||
|
(else
|
||||||
|
(let
|
||||||
|
((rec (gitea/pr-get forge owner name n)))
|
||||||
|
(cond
|
||||||
|
((nil? rec) (dream-not-found))
|
||||||
|
((not (or (= user (get rec :author)) (gitea/can? forge user "write" owner name)))
|
||||||
|
(gitea/w-forbidden))
|
||||||
|
(else
|
||||||
|
(let
|
||||||
|
((res (gitea/pr-close! forge owner name n)))
|
||||||
|
(if
|
||||||
|
(nil? res)
|
||||||
|
(gitea/w-json-status 409 {:error "not-open"})
|
||||||
|
(dream-json-value {:state "closed" :number n}))))))))))))
|
||||||
|
|
||||||
|
(define
|
||||||
|
gitea/w-api-queue
|
||||||
|
(fn
|
||||||
|
(forge req)
|
||||||
|
(let
|
||||||
|
((owner (dream-param req "owner")) (name (dream-param req "name")))
|
||||||
|
(if
|
||||||
|
(not (gitea/w-readable? forge req owner name))
|
||||||
|
(dream-not-found)
|
||||||
|
(dream-json-value (gitea/queue forge owner name))))))
|
||||||
|
|
||||||
|
(define
|
||||||
|
gitea/w-api-queue-add
|
||||||
|
(fn
|
||||||
|
(forge req)
|
||||||
|
(let
|
||||||
|
((owner (dream-param req "owner"))
|
||||||
|
(name (dream-param req "name"))
|
||||||
|
(n (gitea/w-issue-n req)))
|
||||||
|
(let
|
||||||
|
((user (gitea/w-user forge req)))
|
||||||
|
(cond
|
||||||
|
((or (nil? n) (not (gitea/can? forge user "read" owner name)))
|
||||||
|
(dream-not-found))
|
||||||
|
((nil? user) (gitea/w-unauthorized))
|
||||||
|
((not (gitea/can? forge user "write" owner name))
|
||||||
|
(gitea/w-forbidden))
|
||||||
|
(else
|
||||||
|
(let
|
||||||
|
((res (gitea/queue-add! forge owner name n)))
|
||||||
|
(if
|
||||||
|
(and (dict? res) (get res :error))
|
||||||
|
(gitea/w-json-status 409 {:error (get res :error)})
|
||||||
|
(dream-json-value (gitea/queue forge owner name))))))))))
|
||||||
|
|
||||||
|
(define
|
||||||
|
gitea/w-api-queue-process
|
||||||
|
(fn
|
||||||
|
(forge req)
|
||||||
|
(let
|
||||||
|
((owner (dream-param req "owner")) (name (dream-param req "name")))
|
||||||
|
(let
|
||||||
|
((user (gitea/w-user forge req)))
|
||||||
|
(cond
|
||||||
|
((not (gitea/can? forge user "read" owner name))
|
||||||
|
(dream-not-found))
|
||||||
|
((nil? user) (gitea/w-unauthorized))
|
||||||
|
((not (gitea/can? forge user "write" owner name))
|
||||||
|
(gitea/w-forbidden))
|
||||||
|
(else
|
||||||
|
(dream-json-value (gitea/queue-process! forge owner name user))))))))
|
||||||
|
|
||||||
|
(define
|
||||||
|
gitea/pr-routes
|
||||||
|
(fn
|
||||||
|
(forge)
|
||||||
|
(list
|
||||||
|
(dream-get
|
||||||
|
"/:owner/:name/pulls"
|
||||||
|
(fn (req) (gitea/w-pulls-page forge req)))
|
||||||
|
(dream-get
|
||||||
|
"/:owner/:name/pulls/:n"
|
||||||
|
(fn (req) (gitea/w-pull-page forge req)))
|
||||||
|
(dream-get
|
||||||
|
"/api/repos/:owner/:name/pulls"
|
||||||
|
(fn (req) (gitea/w-api-pulls forge req)))
|
||||||
|
(dream-post
|
||||||
|
"/api/repos/:owner/:name/pulls"
|
||||||
|
(fn (req) (gitea/w-api-pr-create forge req)))
|
||||||
|
(dream-post
|
||||||
|
"/api/repos/:owner/:name/pulls/:n/reviews"
|
||||||
|
(fn (req) (gitea/w-api-pr-review forge req)))
|
||||||
|
(dream-post
|
||||||
|
"/api/repos/:owner/:name/pulls/:n/merge"
|
||||||
|
(fn (req) (gitea/w-api-pr-merge forge req)))
|
||||||
|
(dream-post
|
||||||
|
"/api/repos/:owner/:name/pulls/:n/close"
|
||||||
|
(fn (req) (gitea/w-api-pr-close forge req)))
|
||||||
|
(dream-get
|
||||||
|
"/api/repos/:owner/:name/merge-queue"
|
||||||
|
(fn (req) (gitea/w-api-queue forge req)))
|
||||||
|
(dream-post
|
||||||
|
"/api/repos/:owner/:name/pulls/:n/enqueue"
|
||||||
|
(fn (req) (gitea/w-api-queue-add forge req)))
|
||||||
|
(dream-post
|
||||||
|
"/api/repos/:owner/:name/merge-queue/process"
|
||||||
|
(fn (req) (gitea/w-api-queue-process forge req))))))
|
||||||
|
|
||||||
|
(set! gitea/route-packs (append gitea/route-packs (list gitea/pr-routes)))
|
||||||
@@ -3,9 +3,10 @@
|
|||||||
"repo": {"pass": 91, "fail": 0},
|
"repo": {"pass": 91, "fail": 0},
|
||||||
"access": {"pass": 103, "fail": 0},
|
"access": {"pass": 103, "fail": 0},
|
||||||
"wire": {"pass": 78, "fail": 0},
|
"wire": {"pass": 78, "fail": 0},
|
||||||
"issues": {"pass": 88, "fail": 0}
|
"issues": {"pass": 88, "fail": 0},
|
||||||
|
"pr": {"pass": 100, "fail": 0}
|
||||||
},
|
},
|
||||||
"total_pass": 360,
|
"total_pass": 460,
|
||||||
"total_fail": 0,
|
"total_fail": 0,
|
||||||
"total": 360
|
"total": 460
|
||||||
}
|
}
|
||||||
|
|||||||
@@ -8,4 +8,5 @@ _Generated by `lib/gitea/conformance.sh`_
|
|||||||
| access | 103 | 0 | 103 |
|
| access | 103 | 0 | 103 |
|
||||||
| wire | 78 | 0 | 78 |
|
| wire | 78 | 0 | 78 |
|
||||||
| issues | 88 | 0 | 88 |
|
| issues | 88 | 0 | 88 |
|
||||||
| **Total** | **360** | **0** | **360** |
|
| pr | 100 | 0 | 100 |
|
||||||
|
| **Total** | **460** | **0** | **460** |
|
||||||
|
|||||||
865
lib/gitea/tests/pr.sx
Normal file
865
lib/gitea/tests/pr.sx
Normal file
@@ -0,0 +1,865 @@
|
|||||||
|
; lib/gitea/tests/pr.sx — Phase 5: PR records, live merge-base diffs,
|
||||||
|
; review threads (latest verdict per reviewer), the durable flow
|
||||||
|
; lifecycle, all four merge shapes (merge/ff/up-to-date/conflicts), the
|
||||||
|
; merge queue, and the PR web routes + JSON API.
|
||||||
|
|
||||||
|
(st-bootstrap-classes!)
|
||||||
|
(content/bootstrap!)
|
||||||
|
(content-bootstrap-markdown!)
|
||||||
|
(content-bootstrap-table!)
|
||||||
|
|
||||||
|
(define gitea-pr-pass 0)
|
||||||
|
(define gitea-pr-fail 0)
|
||||||
|
(define gitea-pr-fails (list))
|
||||||
|
|
||||||
|
(define
|
||||||
|
gitea-pr-test
|
||||||
|
(fn
|
||||||
|
(name actual expected)
|
||||||
|
(if
|
||||||
|
(= actual expected)
|
||||||
|
(set! gitea-pr-pass (+ gitea-pr-pass 1))
|
||||||
|
(begin
|
||||||
|
(set! gitea-pr-fail (+ gitea-pr-fail 1))
|
||||||
|
(set! gitea-pr-fails (append gitea-pr-fails (list {:name name :expected (inspect expected) :actual (inspect actual)})))))))
|
||||||
|
|
||||||
|
; ── setup: repo with diverged branches ───────────────────────────────
|
||||||
|
|
||||||
|
(define gp-db (persist/mem-backend))
|
||||||
|
(define gp-forge (gitea/forge gp-db))
|
||||||
|
(gitea/user-create! gp-forge "alice")
|
||||||
|
(gitea/user-create! gp-forge "bob")
|
||||||
|
(gitea/user-create! gp-forge "carol")
|
||||||
|
(gitea/user-create! gp-forge "eve")
|
||||||
|
(gitea/repo-create! gp-forge "alice" "proj" {})
|
||||||
|
(gitea/repo-create! gp-forge "alice" "sec" {:visibility "private"})
|
||||||
|
(gitea/token-create! gp-forge "alice" "tok-a")
|
||||||
|
(gitea/token-create! gp-forge "bob" "tok-b")
|
||||||
|
(gitea/token-create! gp-forge "carol" "tok-c")
|
||||||
|
(gitea/token-create! gp-forge "eve" "tok-e")
|
||||||
|
|
||||||
|
(define gp-g (gitea/repo-git gp-forge "alice" "proj"))
|
||||||
|
(git/add! gp-g "README.md" "base\n")
|
||||||
|
(git/add! gp-g "lib.txt" "lib\n")
|
||||||
|
(define gp-c1 (git/commit! gp-g {:message "c1" :time 1 :author "alice"}))
|
||||||
|
(git/branch! gp-g "feat")
|
||||||
|
(git/checkout! gp-g "feat")
|
||||||
|
(git/add! gp-g "feature.txt" "feature line\n")
|
||||||
|
(define gp-c2 (git/commit! gp-g {:message "c2 feature" :time 2 :author "bob"}))
|
||||||
|
(git/checkout! gp-g "main")
|
||||||
|
(git/add! gp-g "other.txt" "other\n")
|
||||||
|
(define gp-c3 (git/commit! gp-g {:message "c3 other" :time 3 :author "alice"}))
|
||||||
|
|
||||||
|
; ── create / validate ────────────────────────────────────────────────
|
||||||
|
|
||||||
|
(define
|
||||||
|
gp-pr1
|
||||||
|
(gitea/pr-create!
|
||||||
|
gp-forge
|
||||||
|
"alice"
|
||||||
|
"proj"
|
||||||
|
"bob"
|
||||||
|
"Add feature"
|
||||||
|
"feat"
|
||||||
|
"main"
|
||||||
|
"Adds a *feature*."
|
||||||
|
{:created-at 5}))
|
||||||
|
|
||||||
|
(gitea-pr-test "pr number" (get gp-pr1 :number) 1)
|
||||||
|
(gitea-pr-test "pr state" (get gp-pr1 :state) "open")
|
||||||
|
(gitea-pr-test "pr source" (get gp-pr1 :source) "feat")
|
||||||
|
(gitea-pr-test "pr target" (get gp-pr1 :target) "main")
|
||||||
|
(gitea-pr-test "pr has flow id" (nil? (get gp-pr1 :flow-id)) false)
|
||||||
|
(gitea-pr-test
|
||||||
|
"flow starts at review"
|
||||||
|
(gitea/pr-flow-status gp-forge gp-pr1)
|
||||||
|
"review")
|
||||||
|
|
||||||
|
(gitea-pr-test
|
||||||
|
"unknown source"
|
||||||
|
(get
|
||||||
|
(gitea/pr-create!
|
||||||
|
gp-forge
|
||||||
|
"alice"
|
||||||
|
"proj"
|
||||||
|
"bob"
|
||||||
|
"t"
|
||||||
|
"nope"
|
||||||
|
"main"
|
||||||
|
""
|
||||||
|
{})
|
||||||
|
:error)
|
||||||
|
"no-such-source")
|
||||||
|
(gitea-pr-test
|
||||||
|
"unknown target"
|
||||||
|
(get
|
||||||
|
(gitea/pr-create!
|
||||||
|
gp-forge
|
||||||
|
"alice"
|
||||||
|
"proj"
|
||||||
|
"bob"
|
||||||
|
"t"
|
||||||
|
"feat"
|
||||||
|
"nope"
|
||||||
|
""
|
||||||
|
{})
|
||||||
|
:error)
|
||||||
|
"no-such-target")
|
||||||
|
(gitea-pr-test
|
||||||
|
"same branch"
|
||||||
|
(get
|
||||||
|
(gitea/pr-create!
|
||||||
|
gp-forge
|
||||||
|
"alice"
|
||||||
|
"proj"
|
||||||
|
"bob"
|
||||||
|
"t"
|
||||||
|
"main"
|
||||||
|
"main"
|
||||||
|
""
|
||||||
|
{})
|
||||||
|
:error)
|
||||||
|
"same-branch")
|
||||||
|
(gitea-pr-test
|
||||||
|
"empty title"
|
||||||
|
(get
|
||||||
|
(gitea/pr-create!
|
||||||
|
gp-forge
|
||||||
|
"alice"
|
||||||
|
"proj"
|
||||||
|
"bob"
|
||||||
|
""
|
||||||
|
"feat"
|
||||||
|
"main"
|
||||||
|
""
|
||||||
|
{})
|
||||||
|
:error)
|
||||||
|
"empty-title")
|
||||||
|
(gitea-pr-test
|
||||||
|
"missing repo"
|
||||||
|
(get
|
||||||
|
(gitea/pr-create!
|
||||||
|
gp-forge
|
||||||
|
"alice"
|
||||||
|
"none"
|
||||||
|
"bob"
|
||||||
|
"t"
|
||||||
|
"feat"
|
||||||
|
"main"
|
||||||
|
""
|
||||||
|
{})
|
||||||
|
:error)
|
||||||
|
"no-such-repo")
|
||||||
|
(gitea-pr-test
|
||||||
|
"missing author"
|
||||||
|
(get
|
||||||
|
(gitea/pr-create!
|
||||||
|
gp-forge
|
||||||
|
"alice"
|
||||||
|
"proj"
|
||||||
|
"zeb"
|
||||||
|
"t"
|
||||||
|
"feat"
|
||||||
|
"main"
|
||||||
|
""
|
||||||
|
{})
|
||||||
|
:error)
|
||||||
|
"no-such-user")
|
||||||
|
|
||||||
|
(gitea-pr-test
|
||||||
|
"prs list"
|
||||||
|
(gitea/prs gp-forge "alice" "proj")
|
||||||
|
(list 1))
|
||||||
|
|
||||||
|
; numbers are shared with issues
|
||||||
|
(gitea-pr-test
|
||||||
|
"shared counter with issues"
|
||||||
|
(get
|
||||||
|
(gitea/issue-create!
|
||||||
|
gp-forge
|
||||||
|
"alice"
|
||||||
|
"proj"
|
||||||
|
"alice"
|
||||||
|
"An issue"
|
||||||
|
""
|
||||||
|
{})
|
||||||
|
:number)
|
||||||
|
2)
|
||||||
|
|
||||||
|
; ── live diff against the merge base ─────────────────────────────────
|
||||||
|
|
||||||
|
(gitea-pr-test
|
||||||
|
"diff added"
|
||||||
|
(get (gitea/pr-diff gp-forge "alice" "proj" 1) :added)
|
||||||
|
(list "feature.txt"))
|
||||||
|
(gitea-pr-test
|
||||||
|
"diff no spurious deletions"
|
||||||
|
(get (gitea/pr-diff gp-forge "alice" "proj" 1) :deleted)
|
||||||
|
(list))
|
||||||
|
(gitea-pr-test
|
||||||
|
"diff unified shows addition"
|
||||||
|
(contains?
|
||||||
|
(gitea/pr-diff-unified gp-forge "alice" "proj" 1)
|
||||||
|
"+feature line")
|
||||||
|
true)
|
||||||
|
(gitea-pr-test
|
||||||
|
"diff of missing pr"
|
||||||
|
(gitea/pr-diff gp-forge "alice" "proj" 99)
|
||||||
|
nil)
|
||||||
|
|
||||||
|
; ── reviews ──────────────────────────────────────────────────────────
|
||||||
|
|
||||||
|
(gitea/pr-review!
|
||||||
|
gp-forge
|
||||||
|
"alice"
|
||||||
|
"proj"
|
||||||
|
1
|
||||||
|
"carol"
|
||||||
|
"request-changes"
|
||||||
|
"needs tests"
|
||||||
|
{:at 6})
|
||||||
|
(gitea-pr-test
|
||||||
|
"changes requested blocks approval"
|
||||||
|
(gitea/pr-approved? (gitea/pr-get gp-forge "alice" "proj" 1))
|
||||||
|
false)
|
||||||
|
(gitea-pr-test
|
||||||
|
"flow still at review"
|
||||||
|
(gitea/pr-flow-status
|
||||||
|
gp-forge
|
||||||
|
(gitea/pr-get gp-forge "alice" "proj" 1))
|
||||||
|
"review")
|
||||||
|
|
||||||
|
(gitea-pr-test
|
||||||
|
"author cannot review own pr"
|
||||||
|
(get
|
||||||
|
(gitea/pr-review!
|
||||||
|
gp-forge
|
||||||
|
"alice"
|
||||||
|
"proj"
|
||||||
|
1
|
||||||
|
"bob"
|
||||||
|
"approve"
|
||||||
|
""
|
||||||
|
{})
|
||||||
|
:error)
|
||||||
|
"own-pr")
|
||||||
|
(gitea-pr-test
|
||||||
|
"invalid verdict"
|
||||||
|
(get
|
||||||
|
(gitea/pr-review!
|
||||||
|
gp-forge
|
||||||
|
"alice"
|
||||||
|
"proj"
|
||||||
|
1
|
||||||
|
"carol"
|
||||||
|
"meh"
|
||||||
|
""
|
||||||
|
{})
|
||||||
|
:error)
|
||||||
|
"invalid-verdict")
|
||||||
|
(gitea-pr-test
|
||||||
|
"unknown reviewer"
|
||||||
|
(get
|
||||||
|
(gitea/pr-review!
|
||||||
|
gp-forge
|
||||||
|
"alice"
|
||||||
|
"proj"
|
||||||
|
1
|
||||||
|
"zeb"
|
||||||
|
"approve"
|
||||||
|
""
|
||||||
|
{})
|
||||||
|
:error)
|
||||||
|
"no-such-user")
|
||||||
|
(gitea-pr-test
|
||||||
|
"review missing pr"
|
||||||
|
(get
|
||||||
|
(gitea/pr-review!
|
||||||
|
gp-forge
|
||||||
|
"alice"
|
||||||
|
"proj"
|
||||||
|
99
|
||||||
|
"carol"
|
||||||
|
"approve"
|
||||||
|
""
|
||||||
|
{})
|
||||||
|
:error)
|
||||||
|
"no-such-pr")
|
||||||
|
|
||||||
|
(gitea/pr-review!
|
||||||
|
gp-forge
|
||||||
|
"alice"
|
||||||
|
"proj"
|
||||||
|
1
|
||||||
|
"carol"
|
||||||
|
"approve"
|
||||||
|
"looks good now"
|
||||||
|
{:at 7})
|
||||||
|
(gitea-pr-test
|
||||||
|
"latest verdict wins"
|
||||||
|
(gitea/pr-approved? (gitea/pr-get gp-forge "alice" "proj" 1))
|
||||||
|
true)
|
||||||
|
(gitea-pr-test
|
||||||
|
"reviews accumulate"
|
||||||
|
(len (get (gitea/pr-get gp-forge "alice" "proj" 1) :reviews))
|
||||||
|
2)
|
||||||
|
(gitea-pr-test
|
||||||
|
"flow advanced to approved"
|
||||||
|
(gitea/pr-flow-status
|
||||||
|
gp-forge
|
||||||
|
(gitea/pr-get gp-forge "alice" "proj" 1))
|
||||||
|
"approved")
|
||||||
|
|
||||||
|
; ── merge: true 3-way ────────────────────────────────────────────────
|
||||||
|
|
||||||
|
(gitea-pr-test
|
||||||
|
"unapproved merge rejected"
|
||||||
|
(get
|
||||||
|
(gitea/pr-merge! gp-forge "alice" "proj" 2 "alice" {})
|
||||||
|
:error)
|
||||||
|
"no-such-pr")
|
||||||
|
|
||||||
|
(define
|
||||||
|
gp-m1
|
||||||
|
(gitea/pr-merge! gp-forge "alice" "proj" 1 "alice" {:time 8}))
|
||||||
|
|
||||||
|
(gitea-pr-test "merge state" (get gp-m1 :state) "merged")
|
||||||
|
(gitea-pr-test "merge cid recorded" (nil? (get gp-m1 :merge-cid)) false)
|
||||||
|
(gitea-pr-test
|
||||||
|
"main moved to merge commit"
|
||||||
|
(git/branch-get gp-g "main")
|
||||||
|
(get gp-m1 :merge-cid))
|
||||||
|
(gitea-pr-test
|
||||||
|
"merge commit has two parents"
|
||||||
|
(git/commit-parents (git/read gp-g (get gp-m1 :merge-cid)))
|
||||||
|
(list gp-c3 gp-c2))
|
||||||
|
(gitea-pr-test
|
||||||
|
"merged tree keeps target file"
|
||||||
|
(get (gitea/tree-at gp-g (get gp-m1 :merge-cid) "other.txt") :kind)
|
||||||
|
"blob")
|
||||||
|
(gitea-pr-test
|
||||||
|
"merged tree gains source file"
|
||||||
|
(get (gitea/tree-at gp-g (get gp-m1 :merge-cid) "feature.txt") :kind)
|
||||||
|
"blob")
|
||||||
|
(gitea-pr-test
|
||||||
|
"flow reports merged"
|
||||||
|
(gitea/pr-flow-status
|
||||||
|
gp-forge
|
||||||
|
(gitea/pr-get gp-forge "alice" "proj" 1))
|
||||||
|
"merged")
|
||||||
|
(gitea-pr-test
|
||||||
|
"merge twice rejected"
|
||||||
|
(get
|
||||||
|
(gitea/pr-merge! gp-forge "alice" "proj" 1 "alice" {})
|
||||||
|
:error)
|
||||||
|
"not-open")
|
||||||
|
(gitea-pr-test
|
||||||
|
"review after merge rejected"
|
||||||
|
(get
|
||||||
|
(gitea/pr-review!
|
||||||
|
gp-forge
|
||||||
|
"alice"
|
||||||
|
"proj"
|
||||||
|
1
|
||||||
|
"carol"
|
||||||
|
"approve"
|
||||||
|
""
|
||||||
|
{})
|
||||||
|
:error)
|
||||||
|
"not-open")
|
||||||
|
|
||||||
|
; ── merge: fast-forward ──────────────────────────────────────────────
|
||||||
|
|
||||||
|
(git/checkout! gp-g "main")
|
||||||
|
(git/branch! gp-g "hot")
|
||||||
|
(git/checkout! gp-g "hot")
|
||||||
|
(git/add! gp-g "hotfix.txt" "fix\n")
|
||||||
|
(define gp-c4 (git/commit! gp-g {:message "hotfix" :time 9 :author "bob"}))
|
||||||
|
(git/checkout! gp-g "main")
|
||||||
|
|
||||||
|
(define
|
||||||
|
gp-pr3
|
||||||
|
(gitea/pr-create!
|
||||||
|
gp-forge
|
||||||
|
"alice"
|
||||||
|
"proj"
|
||||||
|
"bob"
|
||||||
|
"Hotfix"
|
||||||
|
"hot"
|
||||||
|
"main"
|
||||||
|
""
|
||||||
|
{}))
|
||||||
|
(gitea-pr-test "pr3 number" (get gp-pr3 :number) 3)
|
||||||
|
(gitea/pr-review!
|
||||||
|
gp-forge
|
||||||
|
"alice"
|
||||||
|
"proj"
|
||||||
|
3
|
||||||
|
"carol"
|
||||||
|
"approve"
|
||||||
|
""
|
||||||
|
{})
|
||||||
|
(define
|
||||||
|
gp-m3
|
||||||
|
(gitea/pr-merge! gp-forge "alice" "proj" 3 "alice" {}))
|
||||||
|
(gitea-pr-test "ff merge state" (get gp-m3 :state) "merged")
|
||||||
|
(gitea-pr-test
|
||||||
|
"ff moves main to source head"
|
||||||
|
(git/branch-get gp-g "main")
|
||||||
|
gp-c4)
|
||||||
|
(gitea-pr-test "ff merge-cid is source head" (get gp-m3 :merge-cid) gp-c4)
|
||||||
|
|
||||||
|
; ── merge: up-to-date ────────────────────────────────────────────────
|
||||||
|
|
||||||
|
(git/checkout! gp-g "main")
|
||||||
|
(git/branch! gp-g "same")
|
||||||
|
(define
|
||||||
|
gp-pr4
|
||||||
|
(gitea/pr-create!
|
||||||
|
gp-forge
|
||||||
|
"alice"
|
||||||
|
"proj"
|
||||||
|
"bob"
|
||||||
|
"No-op"
|
||||||
|
"same"
|
||||||
|
"main"
|
||||||
|
""
|
||||||
|
{}))
|
||||||
|
(gitea/pr-review!
|
||||||
|
gp-forge
|
||||||
|
"alice"
|
||||||
|
"proj"
|
||||||
|
4
|
||||||
|
"carol"
|
||||||
|
"approve"
|
||||||
|
""
|
||||||
|
{})
|
||||||
|
(define
|
||||||
|
gp-m4
|
||||||
|
(gitea/pr-merge! gp-forge "alice" "proj" 4 "alice" {}))
|
||||||
|
(gitea-pr-test "up-to-date merge state" (get gp-m4 :state) "merged")
|
||||||
|
(gitea-pr-test "up-to-date leaves main" (git/branch-get gp-g "main") gp-c4)
|
||||||
|
|
||||||
|
; ── merge: conflicts ─────────────────────────────────────────────────
|
||||||
|
|
||||||
|
(git/checkout! gp-g "main")
|
||||||
|
(git/branch! gp-g "conf")
|
||||||
|
(git/checkout! gp-g "conf")
|
||||||
|
(git/add! gp-g "lib.txt" "conf version\n")
|
||||||
|
(git/commit! gp-g {:message "conf change" :time 10 :author "bob"})
|
||||||
|
(git/checkout! gp-g "main")
|
||||||
|
(git/add! gp-g "lib.txt" "main version\n")
|
||||||
|
(git/commit! gp-g {:message "main change" :time 11 :author "alice"})
|
||||||
|
|
||||||
|
(define
|
||||||
|
gp-pr5
|
||||||
|
(gitea/pr-create!
|
||||||
|
gp-forge
|
||||||
|
"alice"
|
||||||
|
"proj"
|
||||||
|
"bob"
|
||||||
|
"Conflicting"
|
||||||
|
"conf"
|
||||||
|
"main"
|
||||||
|
""
|
||||||
|
{}))
|
||||||
|
(gitea/pr-review!
|
||||||
|
gp-forge
|
||||||
|
"alice"
|
||||||
|
"proj"
|
||||||
|
5
|
||||||
|
"carol"
|
||||||
|
"approve"
|
||||||
|
""
|
||||||
|
{})
|
||||||
|
(define
|
||||||
|
gp-m5
|
||||||
|
(gitea/pr-merge! gp-forge "alice" "proj" 5 "alice" {}))
|
||||||
|
(gitea-pr-test "conflict merge errors" (get gp-m5 :error) "conflicts")
|
||||||
|
(gitea-pr-test "conflict paths" (get gp-m5 :conflicts) (list "lib.txt"))
|
||||||
|
(gitea-pr-test
|
||||||
|
"conflict leaves pr open"
|
||||||
|
(get (gitea/pr-get gp-forge "alice" "proj" 5) :state)
|
||||||
|
"open")
|
||||||
|
(gitea-pr-test
|
||||||
|
"conflict leaves flow at approved"
|
||||||
|
(gitea/pr-flow-status
|
||||||
|
gp-forge
|
||||||
|
(gitea/pr-get gp-forge "alice" "proj" 5))
|
||||||
|
"approved")
|
||||||
|
|
||||||
|
; ── close / reopen ───────────────────────────────────────────────────
|
||||||
|
|
||||||
|
(gitea/pr-close! gp-forge "alice" "proj" 5)
|
||||||
|
(gitea-pr-test
|
||||||
|
"close state"
|
||||||
|
(get (gitea/pr-get gp-forge "alice" "proj" 5) :state)
|
||||||
|
"closed")
|
||||||
|
(gitea-pr-test
|
||||||
|
"close cancels flow"
|
||||||
|
(gitea/pr-flow-status
|
||||||
|
gp-forge
|
||||||
|
(gitea/pr-get gp-forge "alice" "proj" 5))
|
||||||
|
"closed")
|
||||||
|
(gitea-pr-test
|
||||||
|
"merge closed pr rejected"
|
||||||
|
(get
|
||||||
|
(gitea/pr-merge! gp-forge "alice" "proj" 5 "alice" {})
|
||||||
|
:error)
|
||||||
|
"not-open")
|
||||||
|
(gitea-pr-test
|
||||||
|
"close twice"
|
||||||
|
(gitea/pr-close! gp-forge "alice" "proj" 5)
|
||||||
|
nil)
|
||||||
|
|
||||||
|
(gitea/pr-reopen! gp-forge "alice" "proj" 5)
|
||||||
|
(gitea-pr-test
|
||||||
|
"reopen state"
|
||||||
|
(get (gitea/pr-get gp-forge "alice" "proj" 5) :state)
|
||||||
|
"open")
|
||||||
|
(gitea-pr-test
|
||||||
|
"reopen restarts lifecycle"
|
||||||
|
(gitea/pr-flow-status
|
||||||
|
gp-forge
|
||||||
|
(gitea/pr-get gp-forge "alice" "proj" 5))
|
||||||
|
"review")
|
||||||
|
|
||||||
|
; ── merge queue ──────────────────────────────────────────────────────
|
||||||
|
|
||||||
|
(git/checkout! gp-g "main")
|
||||||
|
(git/branch! gp-g "q1")
|
||||||
|
(git/checkout! gp-g "q1")
|
||||||
|
(git/add! gp-g "q1.txt" "one\n")
|
||||||
|
(git/commit! gp-g {:message "q1" :time 12 :author "bob"})
|
||||||
|
(git/checkout! gp-g "main")
|
||||||
|
(git/branch! gp-g "q2")
|
||||||
|
(git/checkout! gp-g "q2")
|
||||||
|
(git/add! gp-g "q2.txt" "two\n")
|
||||||
|
(git/commit! gp-g {:message "q2" :time 13 :author "bob"})
|
||||||
|
(git/checkout! gp-g "main")
|
||||||
|
(git/branch! gp-g "q3")
|
||||||
|
(git/checkout! gp-g "q3")
|
||||||
|
(git/add! gp-g "q3.txt" "three\n")
|
||||||
|
(git/commit! gp-g {:message "q3" :time 14 :author "bob"})
|
||||||
|
(git/checkout! gp-g "main")
|
||||||
|
|
||||||
|
(define
|
||||||
|
gp-pr6
|
||||||
|
(gitea/pr-create!
|
||||||
|
gp-forge
|
||||||
|
"alice"
|
||||||
|
"proj"
|
||||||
|
"bob"
|
||||||
|
"Queue one"
|
||||||
|
"q1"
|
||||||
|
"main"
|
||||||
|
""
|
||||||
|
{}))
|
||||||
|
(define
|
||||||
|
gp-pr7
|
||||||
|
(gitea/pr-create!
|
||||||
|
gp-forge
|
||||||
|
"alice"
|
||||||
|
"proj"
|
||||||
|
"bob"
|
||||||
|
"Queue two"
|
||||||
|
"q2"
|
||||||
|
"main"
|
||||||
|
""
|
||||||
|
{}))
|
||||||
|
(define
|
||||||
|
gp-pr8
|
||||||
|
(gitea/pr-create!
|
||||||
|
gp-forge
|
||||||
|
"alice"
|
||||||
|
"proj"
|
||||||
|
"bob"
|
||||||
|
"Queue three"
|
||||||
|
"q3"
|
||||||
|
"main"
|
||||||
|
""
|
||||||
|
{}))
|
||||||
|
(gitea/pr-review!
|
||||||
|
gp-forge
|
||||||
|
"alice"
|
||||||
|
"proj"
|
||||||
|
6
|
||||||
|
"carol"
|
||||||
|
"approve"
|
||||||
|
""
|
||||||
|
{})
|
||||||
|
(gitea/pr-review!
|
||||||
|
gp-forge
|
||||||
|
"alice"
|
||||||
|
"proj"
|
||||||
|
7
|
||||||
|
"carol"
|
||||||
|
"approve"
|
||||||
|
""
|
||||||
|
{})
|
||||||
|
; pr8 stays unapproved; pr5 (reopened, approved, conflicting) joins the queue
|
||||||
|
|
||||||
|
(gitea-pr-test
|
||||||
|
"queue starts empty"
|
||||||
|
(gitea/queue gp-forge "alice" "proj")
|
||||||
|
(list))
|
||||||
|
(gitea-pr-test
|
||||||
|
"queue rejects unapproved"
|
||||||
|
(get (gitea/queue-add! gp-forge "alice" "proj" 8) :error)
|
||||||
|
"not-approved")
|
||||||
|
(gitea-pr-test
|
||||||
|
"queue rejects missing"
|
||||||
|
(get (gitea/queue-add! gp-forge "alice" "proj" 99) :error)
|
||||||
|
"no-such-pr")
|
||||||
|
|
||||||
|
(gitea/queue-add! gp-forge "alice" "proj" 6)
|
||||||
|
(gitea/queue-add! gp-forge "alice" "proj" 6)
|
||||||
|
(gitea/queue-add! gp-forge "alice" "proj" 7)
|
||||||
|
(gitea/queue-add! gp-forge "alice" "proj" 5)
|
||||||
|
(gitea-pr-test
|
||||||
|
"queue dedups"
|
||||||
|
(gitea/queue gp-forge "alice" "proj")
|
||||||
|
(list 6 7 5))
|
||||||
|
|
||||||
|
(define gp-qres (gitea/queue-process! gp-forge "alice" "proj" "alice"))
|
||||||
|
(gitea-pr-test "queue processed all" (len gp-qres) 3)
|
||||||
|
(gitea-pr-test
|
||||||
|
"queue pr6 merged"
|
||||||
|
(get (nth gp-qres 0) :merged)
|
||||||
|
true)
|
||||||
|
(gitea-pr-test
|
||||||
|
"queue pr7 merged"
|
||||||
|
(get (nth gp-qres 1) :merged)
|
||||||
|
true)
|
||||||
|
(gitea-pr-test
|
||||||
|
"queue pr5 conflicts"
|
||||||
|
(get (nth gp-qres 2) :error)
|
||||||
|
"conflicts")
|
||||||
|
(gitea-pr-test
|
||||||
|
"failures stay queued"
|
||||||
|
(gitea/queue gp-forge "alice" "proj")
|
||||||
|
(list 5))
|
||||||
|
(gitea-pr-test
|
||||||
|
"pr6 state merged"
|
||||||
|
(get (gitea/pr-get gp-forge "alice" "proj" 6) :state)
|
||||||
|
"merged")
|
||||||
|
(gitea-pr-test
|
||||||
|
"pr7 state merged"
|
||||||
|
(get (gitea/pr-get gp-forge "alice" "proj" 7) :state)
|
||||||
|
"merged")
|
||||||
|
(gitea-pr-test
|
||||||
|
"main has both queue files"
|
||||||
|
(get (gitea/tree-at gp-g (git/branch-get gp-g "main") "q2.txt") :kind)
|
||||||
|
"blob")
|
||||||
|
|
||||||
|
(gitea/queue-remove! gp-forge "alice" "proj" 5)
|
||||||
|
(gitea-pr-test "queue-remove!" (gitea/queue gp-forge "alice" "proj") (list))
|
||||||
|
|
||||||
|
; ── web routes ───────────────────────────────────────────────────────
|
||||||
|
|
||||||
|
(define gp-app (gitea/app gp-forge))
|
||||||
|
(define gp-hdr (fn (tok) (if (nil? tok) {} {:authorization (str "Bearer " tok)})))
|
||||||
|
(define
|
||||||
|
gp-get
|
||||||
|
(fn (target tok) (gp-app (dream-request "GET" target (gp-hdr tok) ""))))
|
||||||
|
(define
|
||||||
|
gp-post
|
||||||
|
(fn
|
||||||
|
(target tok body)
|
||||||
|
(gp-app (dream-request "POST" target (gp-hdr tok) body))))
|
||||||
|
|
||||||
|
(gitea-pr-test
|
||||||
|
"pulls page 200"
|
||||||
|
(dream-status (gp-get "/alice/proj/pulls" nil))
|
||||||
|
200)
|
||||||
|
(gitea-pr-test
|
||||||
|
"pulls page shows title"
|
||||||
|
(contains?
|
||||||
|
(dream-resp-body (gp-get "/alice/proj/pulls" nil))
|
||||||
|
"Add feature")
|
||||||
|
true)
|
||||||
|
(gitea-pr-test
|
||||||
|
"pulls page shows state"
|
||||||
|
(contains? (dream-resp-body (gp-get "/alice/proj/pulls" nil)) "[merged]")
|
||||||
|
true)
|
||||||
|
|
||||||
|
(gitea-pr-test
|
||||||
|
"pull page 200"
|
||||||
|
(dream-status (gp-get "/alice/proj/pulls/1" nil))
|
||||||
|
200)
|
||||||
|
(gitea-pr-test
|
||||||
|
"pull page shows branches"
|
||||||
|
(contains?
|
||||||
|
(dream-resp-body (gp-get "/alice/proj/pulls/1" nil))
|
||||||
|
"feat -> main")
|
||||||
|
true)
|
||||||
|
(gitea-pr-test
|
||||||
|
"pull page renders body"
|
||||||
|
(contains? (dream-resp-body (gp-get "/alice/proj/pulls/1" nil)) "<p>")
|
||||||
|
true)
|
||||||
|
(gitea-pr-test
|
||||||
|
"pull page shows review verdict"
|
||||||
|
(contains?
|
||||||
|
(dream-resp-body (gp-get "/alice/proj/pulls/1" nil))
|
||||||
|
"carol: approve")
|
||||||
|
true)
|
||||||
|
(gitea-pr-test
|
||||||
|
"pull page shows lifecycle"
|
||||||
|
(contains? (dream-resp-body (gp-get "/alice/proj/pulls/1" nil)) "merged")
|
||||||
|
true)
|
||||||
|
(gitea-pr-test
|
||||||
|
"pull page bad number 404"
|
||||||
|
(dream-status (gp-get "/alice/proj/pulls/abc" nil))
|
||||||
|
404)
|
||||||
|
(gitea-pr-test
|
||||||
|
"pull page missing 404"
|
||||||
|
(dream-status (gp-get "/alice/proj/pulls/99" nil))
|
||||||
|
404)
|
||||||
|
(gitea-pr-test
|
||||||
|
"private pulls anon 404"
|
||||||
|
(dream-status (gp-get "/alice/sec/pulls" nil))
|
||||||
|
404)
|
||||||
|
|
||||||
|
(gitea-pr-test
|
||||||
|
"api pulls len"
|
||||||
|
(len
|
||||||
|
(dream-json-parse
|
||||||
|
(dream-resp-body (gp-get "/api/repos/alice/proj/pulls" nil))))
|
||||||
|
7)
|
||||||
|
(gitea-pr-test
|
||||||
|
"api pulls first source"
|
||||||
|
(get
|
||||||
|
(first
|
||||||
|
(dream-json-parse
|
||||||
|
(dream-resp-body (gp-get "/api/repos/alice/proj/pulls" nil))))
|
||||||
|
:source)
|
||||||
|
"feat")
|
||||||
|
|
||||||
|
(gitea-pr-test
|
||||||
|
"api create anon 401"
|
||||||
|
(dream-status
|
||||||
|
(gp-post "/api/repos/alice/proj/pulls" nil (dream-json-encode {:source "q3" :title "t" :target "main"})))
|
||||||
|
401)
|
||||||
|
(gitea-pr-test
|
||||||
|
"api create 201"
|
||||||
|
(dream-status
|
||||||
|
(gp-post
|
||||||
|
"/api/repos/alice/proj/pulls"
|
||||||
|
"tok-e"
|
||||||
|
(dream-json-encode {:source "q3" :title "Eve PR" :body "please" :target "main"})))
|
||||||
|
201)
|
||||||
|
(gitea-pr-test
|
||||||
|
"api create bad source 400"
|
||||||
|
(dream-status
|
||||||
|
(gp-post
|
||||||
|
"/api/repos/alice/proj/pulls"
|
||||||
|
"tok-e"
|
||||||
|
(dream-json-encode {:source "zz" :title "t" :target "main"})))
|
||||||
|
400)
|
||||||
|
|
||||||
|
; eve's PR is #9
|
||||||
|
(gitea-pr-test
|
||||||
|
"api review 200"
|
||||||
|
(dream-status
|
||||||
|
(gp-post
|
||||||
|
"/api/repos/alice/proj/pulls/9/reviews"
|
||||||
|
"tok-c"
|
||||||
|
(dream-json-encode {:verdict "approve" :body "ok"})))
|
||||||
|
200)
|
||||||
|
(gitea-pr-test
|
||||||
|
"api self-review 400"
|
||||||
|
(dream-status
|
||||||
|
(gp-post
|
||||||
|
"/api/repos/alice/proj/pulls/9/reviews"
|
||||||
|
"tok-e"
|
||||||
|
(dream-json-encode {:verdict "approve"})))
|
||||||
|
400)
|
||||||
|
(gitea-pr-test
|
||||||
|
"api review anon 401"
|
||||||
|
(dream-status
|
||||||
|
(gp-post
|
||||||
|
"/api/repos/alice/proj/pulls/9/reviews"
|
||||||
|
nil
|
||||||
|
(dream-json-encode {:verdict "approve"})))
|
||||||
|
401)
|
||||||
|
(gitea-pr-test
|
||||||
|
"api review missing pr 404"
|
||||||
|
(dream-status
|
||||||
|
(gp-post
|
||||||
|
"/api/repos/alice/proj/pulls/99/reviews"
|
||||||
|
"tok-c"
|
||||||
|
(dream-json-encode {:verdict "approve"})))
|
||||||
|
404)
|
||||||
|
|
||||||
|
(gitea-pr-test
|
||||||
|
"api merge reader 403"
|
||||||
|
(dream-status (gp-post "/api/repos/alice/proj/pulls/9/merge" "tok-e" "{}"))
|
||||||
|
403)
|
||||||
|
(gitea-pr-test
|
||||||
|
"api merge anon 401"
|
||||||
|
(dream-status (gp-post "/api/repos/alice/proj/pulls/9/merge" nil "{}"))
|
||||||
|
401)
|
||||||
|
(gitea-pr-test
|
||||||
|
"api merge write 200"
|
||||||
|
(dream-status (gp-post "/api/repos/alice/proj/pulls/9/merge" "tok-a" "{}"))
|
||||||
|
200)
|
||||||
|
(gitea-pr-test
|
||||||
|
"api merge applied"
|
||||||
|
(get (gitea/pr-get gp-forge "alice" "proj" 9) :state)
|
||||||
|
"merged")
|
||||||
|
|
||||||
|
; reopened conflicting pr 5 still conflicts over the api
|
||||||
|
(gitea-pr-test
|
||||||
|
"api merge conflict 409"
|
||||||
|
(dream-status (gp-post "/api/repos/alice/proj/pulls/5/merge" "tok-a" "{}"))
|
||||||
|
409)
|
||||||
|
|
||||||
|
; eve authors #10 and may close it herself; carol (reader) may not
|
||||||
|
(gp-post "/api/repos/alice/proj/pulls" "tok-e" (dream-json-encode {:source "conf" :title "To close" :target "main"}))
|
||||||
|
(gitea-pr-test
|
||||||
|
"api close by reader 403"
|
||||||
|
(dream-status (gp-post "/api/repos/alice/proj/pulls/10/close" "tok-c" "{}"))
|
||||||
|
403)
|
||||||
|
(gitea-pr-test
|
||||||
|
"api close by author 200"
|
||||||
|
(dream-status (gp-post "/api/repos/alice/proj/pulls/10/close" "tok-e" "{}"))
|
||||||
|
200)
|
||||||
|
(gitea-pr-test
|
||||||
|
"api close applied"
|
||||||
|
(get (gitea/pr-get gp-forge "alice" "proj" 10) :state)
|
||||||
|
"closed")
|
||||||
|
(gitea-pr-test
|
||||||
|
"api close again 409"
|
||||||
|
(dream-status (gp-post "/api/repos/alice/proj/pulls/10/close" "tok-e" "{}"))
|
||||||
|
409)
|
||||||
|
|
||||||
|
; queue over the api: pr5 is approved (reviews survive reopen)
|
||||||
|
(gitea-pr-test
|
||||||
|
"api enqueue reader 403"
|
||||||
|
(dream-status
|
||||||
|
(gp-post "/api/repos/alice/proj/pulls/5/enqueue" "tok-e" "{}"))
|
||||||
|
403)
|
||||||
|
(gitea-pr-test
|
||||||
|
"api enqueue 200"
|
||||||
|
(dream-status
|
||||||
|
(gp-post "/api/repos/alice/proj/pulls/5/enqueue" "tok-a" "{}"))
|
||||||
|
200)
|
||||||
|
(gitea-pr-test
|
||||||
|
"api queue json"
|
||||||
|
(dream-json-parse
|
||||||
|
(dream-resp-body (gp-get "/api/repos/alice/proj/merge-queue" nil)))
|
||||||
|
(list 5))
|
||||||
|
(gitea-pr-test
|
||||||
|
"api queue process 200"
|
||||||
|
(dream-status
|
||||||
|
(gp-post "/api/repos/alice/proj/merge-queue/process" "tok-a" "{}"))
|
||||||
|
200)
|
||||||
|
(gitea-pr-test
|
||||||
|
"api queue process reports conflict"
|
||||||
|
(get
|
||||||
|
(first
|
||||||
|
(dream-json-parse
|
||||||
|
(dream-resp-body
|
||||||
|
(gp-post "/api/repos/alice/proj/merge-queue/process" "tok-a" "{}"))))
|
||||||
|
:error)
|
||||||
|
"conflicts")
|
||||||
Reference in New Issue
Block a user