From 347a24bf69e30f7a7645f7d5298fe40dbfbd12cf Mon Sep 17 00:00:00 2001 From: Christopher Baines Date: Thu, 27 Feb 2025 09:34:39 +0000 Subject: Give 404 responses for the issue package changes views --- guix-qa-frontpage/server.scm | 116 +++++++++++++++++++++++++++---------------- 1 file changed, 72 insertions(+), 44 deletions(-) diff --git a/guix-qa-frontpage/server.scm b/guix-qa-frontpage/server.scm index 219b9de..0639f19 100644 --- a/guix-qa-frontpage/server.scm +++ b/guix-qa-frontpage/server.scm @@ -686,54 +686,82 @@ has no patches or has been closed.") #:code 404))))) (('GET "issue" number "package-changes") - (let ((revisions - derivation-changes - cross-derivation-changes - substitute-availability - up-to-date-with-master - master-branch-systems-with-low-substitute-availability - (with-sqlite-cache - database - 'issue-data - issue-data - #:args - (list (string->number number)) - #:version 3 - #:ttl 6000))) - (render-html - #:sxml - (issue-package-changes-view number - derivation-changes - (or - (and=> - (uri-query (request-uri request)) - parse-query-string) - '()))))) - (('GET "issue" number "package-cross-changes") - (let ((revisions - derivation-changes - cross-derivation-changes - substitute-availability - up-to-date-with-master - master-branch-systems-with-low-substitute-availability - (with-sqlite-cache - database - 'issue-data - issue-data - #:args - (list (string->number number)) - #:version 3 - #:ttl 6000))) - (render-html - #:sxml - (issue-package-cross-changes-view number - "x86_64-linux" - cross-derivation-changes + (let ((series (with-sqlite-cache + database + 'latest-patchwork-series-for-issue + latest-patchwork-series-for-issue + #:args (list (string->number number)) + #:ttl 1800))) + (if series + (let ((revisions + derivation-changes + cross-derivation-changes + substitute-availability + up-to-date-with-master + master-branch-systems-with-low-substitute-availability + (with-sqlite-cache + database + 'issue-data + issue-data + #:args + (list (string->number number)) + #:version 3 + #:ttl 6000))) + (render-html + #:sxml + (issue-package-changes-view number + derivation-changes (or (and=> (uri-query (request-uri request)) parse-query-string) - '()))))) + '())))) + (render-html + #:sxml (general-not-found + "Issue not found" + "This could mean the issue is not recent enough + to be considered by QA,does not exist, it +has no patches or has been closed.") + #:code 404)))) + (('GET "issue" number "package-cross-changes") + (let ((series (with-sqlite-cache + database + 'latest-patchwork-series-for-issue + latest-patchwork-series-for-issue + #:args (list (string->number number)) + #:ttl 1800))) + (if series + (let ((revisions + derivation-changes + cross-derivation-changes + substitute-availability + up-to-date-with-master + master-branch-systems-with-low-substitute-availability + (with-sqlite-cache + database + 'issue-data + issue-data + #:args + (list (string->number number)) + #:version 3 + #:ttl 6000))) + (render-html + #:sxml + (issue-package-cross-changes-view number + "x86_64-linux" + cross-derivation-changes + (or + (and=> + (uri-query (request-uri request)) + parse-query-string) + '())))) + (render-html + #:sxml (general-not-found + "Issue not found" + "This could mean the issue is not recent enough + to be considered by QA,does not exist, it +has no patches or has been closed.") + #:code 404)))) (('GET "issue" number "prepare-review") (let ((revisions derivation-changes -- cgit v1.2.3