diff options
-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 |