diff options
| author | Christopher Baines <mail@cbaines.net> | 2023-05-24 17:29:53 +0100 |
|---|---|---|
| committer | Christopher Baines <mail@cbaines.net> | 2023-05-24 17:29:53 +0100 |
| commit | b0fe6c630ec98a8c314ce8c59af64a7d77181fbe (patch) | |
| tree | 06967f3a68508dc973d8bac39c1999badd611bcd /guix-qa-frontpage | |
| parent | 5b5281e4a02c6d3e9070a1379b902216a77f7b82 (diff) | |
| download | qa-frontpage-b0fe6c630ec98a8c314ce8c59af64a7d77181fbe.tar qa-frontpage-b0fe6c630ec98a8c314ce8c59af64a7d77181fbe.tar.gz | |
Redirect from the issue page to a branch
When this issue is a request to merge a branch.
Diffstat (limited to 'guix-qa-frontpage')
| -rw-r--r-- | guix-qa-frontpage/server.scm | 34 |
1 files changed, 29 insertions, 5 deletions
diff --git a/guix-qa-frontpage/server.scm b/guix-qa-frontpage/server.scm index 5626eb5..f2d1750 100644 --- a/guix-qa-frontpage/server.scm +++ b/guix-qa-frontpage/server.scm @@ -54,6 +54,18 @@ start-refresh-patch-branches-data-thread)) +(define (branch-for-issue database issue-number) + (let ((branches + (with-sqlite-cache + database + 'list-non-master-branches + list-non-master-branches + #:ttl 6000))) + (find (lambda (branch) + (= (assoc-ref (cdr branch) "issue_number") + issue-number)) + branches))) + (define* (make-controller assets-directory database metrics-registry #:key (patch-issues-to-show 200)) @@ -372,12 +384,24 @@ builds-missing? change-details comparison-details))) - (render-html - #:sxml (general-not-found - "Issue not found" - "This could mean the issue does not exist, it + (or + (and=> (branch-for-issue database + (string->number number)) + (match-lambda + ((name . details) + (list + (build-response + #:code 301 + #:headers `((location . ,(string->uri + (string-append + "https://qa.guix.gnu.org/branch/" name))))) + #f)))) + (render-html + #:sxml (general-not-found + "Issue not found" + "This could mean the issue does not exist, it has no patches or has been closed.") - #:code 404)))) + #:code 404))))) ((method path ...) (render-html #:sxml (general-not-found |