aboutsummaryrefslogtreecommitdiff
path: root/guix-qa-frontpage/manage-builds.scm
diff options
context:
space:
mode:
authorChristopher Baines <mail@cbaines.net>2024-04-23 11:02:59 +0100
committerChristopher Baines <mail@cbaines.net>2024-04-23 11:02:59 +0100
commita5c41fb01a978a195a5a0d984863790916b6c8a0 (patch)
tree4a205425f75967a384f57808fc76c5c3525e79e0 /guix-qa-frontpage/manage-builds.scm
parent7156a36dec07d35c6b885a61727e34c98ebfdd68 (diff)
downloadqa-frontpage-master.tar
qa-frontpage-master.tar.gz
Handle issues.guix GraphQL queries failing betterHEADmaster
Diffstat (limited to 'guix-qa-frontpage/manage-builds.scm')
-rw-r--r--guix-qa-frontpage/manage-builds.scm90
1 files changed, 49 insertions, 41 deletions
diff --git a/guix-qa-frontpage/manage-builds.scm b/guix-qa-frontpage/manage-builds.scm
index b8b0189..1d9a512 100644
--- a/guix-qa-frontpage/manage-builds.scm
+++ b/guix-qa-frontpage/manage-builds.scm
@@ -390,47 +390,55 @@
branches))
(define (submit-branch-builds)
- (let* ((branches
- (take*
- (filter
- (match-lambda
- ((name . details)
- (->bool (assoc-ref details "issue_number"))))
- (with-sqlite-cache
- database
- 'list-non-master-branches
- list-non-master-branches
- #:ttl 0))
- 2))
- (branch-names
- (map car branches)))
-
- (let* ((branches-with-builds-previously-submitted
- (select-from-builds-to-cancel-later
- database
- "branch"))
- (branches-with-builds-to-cancel
- (lset-difference
- string=?
- branches-with-builds-previously-submitted
- branch-names)))
- (unless (null? branches-with-builds-to-cancel)
- (cancel-branch-builds branches-with-builds-to-cancel)))
-
- (let* ((substitute-availability
- systems-with-low-substitute-availability
- package-reproducibility
- (with-sqlite-cache
- database
- 'master-branch-data
- master-branch-data
- #:ttl 6000
- #:version 2)))
- (if (null? systems-with-low-substitute-availability)
- (submit-builds branch-names)
- (simple-format
- (current-error-port)
- "waiting for master branch substitutes before submitting branch builds\n")))))
+ (let ((all-branches
+ (with-sqlite-cache
+ database
+ 'list-non-master-branches
+ list-non-master-branches
+ #:ttl 0)))
+ (if (assq-ref all-branches 'exception)
+ (simple-format
+ (current-error-port)
+ "unable to submit branch builds, exception in list-non-master-branches: ~A\n"
+ (assq-ref all-branches 'exception))
+
+ (let* ((branches
+ (take*
+ (filter
+ (match-lambda
+ ((name . details)
+ (->bool (assoc-ref details "issue_number"))))
+ all-branches)
+ 2))
+ (branch-names
+ (map car branches)))
+
+ (let* ((branches-with-builds-previously-submitted
+ (select-from-builds-to-cancel-later
+ database
+ "branch"))
+ (branches-with-builds-to-cancel
+ (lset-difference
+ string=?
+ branches-with-builds-previously-submitted
+ branch-names)))
+ (unless (null? branches-with-builds-to-cancel)
+ (cancel-branch-builds branches-with-builds-to-cancel)))
+
+ (let* ((substitute-availability
+ systems-with-low-substitute-availability
+ package-reproducibility
+ (with-sqlite-cache
+ database
+ 'master-branch-data
+ master-branch-data
+ #:ttl 6000
+ #:version 2)))
+ (if (null? systems-with-low-substitute-availability)
+ (submit-builds branch-names)
+ (simple-format
+ (current-error-port)
+ "waiting for master branch substitutes before submitting branch builds\n")))))))
(call-with-new-thread
(lambda ()