aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--guix-qa-frontpage/server.scm34
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