diff options
| author | Christopher Baines <mail@cbaines.net> | 2025-02-27 09:34:39 +0000 |
|---|---|---|
| committer | Christopher Baines <mail@cbaines.net> | 2025-02-27 09:34:39 +0000 |
| commit | 347a24bf69e30f7a7645f7d5298fe40dbfbd12cf (patch) | |
| tree | 4c2151410d5d5e601c2875e32674bbe2389ee32f | |
| parent | e8625ce145dd6b1f75c1fd248d0063262e99855e (diff) | |
| download | qa-frontpage-347a24bf69e30f7a7645f7d5298fe40dbfbd12cf.tar qa-frontpage-347a24bf69e30f7a7645f7d5298fe40dbfbd12cf.tar.gz | |
Give 404 responses for the issue package changes views
| -rw-r--r-- | guix-qa-frontpage/server.scm | 116 |
1 files 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 |