diff options
| author | Christopher Baines <mail@cbaines.net> | 2023-04-09 22:04:12 +0100 |
|---|---|---|
| committer | Christopher Baines <mail@cbaines.net> | 2023-04-09 22:04:12 +0100 |
| commit | 2933f17dda123ccfe78a8b4f678e536acc0223e1 (patch) | |
| tree | 8021335de536c7014f0c7887efd9e3b1eb22aaa1 /guix-qa-frontpage | |
| parent | daccc0ce970916cf75981824b66be1a142626818 (diff) | |
| download | qa-frontpage-2933f17dda123ccfe78a8b4f678e536acc0223e1.tar qa-frontpage-2933f17dda123ccfe78a8b4f678e536acc0223e1.tar.gz | |
Refactor submitting builds for issues
So that the code may be used for an individual issue.
Diffstat (limited to 'guix-qa-frontpage')
| -rw-r--r-- | guix-qa-frontpage/manage-builds.scm | 144 |
1 files changed, 81 insertions, 63 deletions
diff --git a/guix-qa-frontpage/manage-builds.scm b/guix-qa-frontpage/manage-builds.scm index ada9591..77514c5 100644 --- a/guix-qa-frontpage/manage-builds.scm +++ b/guix-qa-frontpage/manage-builds.scm @@ -14,6 +14,8 @@ builds-missing-for-derivation-changes? + submit-builds-for-issue + start-submit-patch-builds-thread start-submit-branch-builds-thread start-submit-master-branch-system-tests-thread)) @@ -26,6 +28,75 @@ "powerpc64le-linux" "i586-gnu")) +(define* (submit-builds-for-issue + database + build-coordinator + guix-data-service + issue-number + #:key priority + build-limit) + (simple-format + #t + "considering submitting builds for issue ~A\n" + issue-number) + + (let ((derivation-changes-url + (and=> + (get-issue-branch-base-and-target-refs issue-number) + (lambda (base-and-target-refs) + (patch-series-derivation-changes-url + base-and-target-refs + #:systems %systems-to-submit-builds-for))))) + + (if derivation-changes-url + (let ((derivation-changes-data + change-details + (with-exception-handler + (lambda (exn) + (simple-format + (current-error-port) + "failed fetching derivation changes for issue ~A: ~A\n" + issue-number + exn) + + (values #f #f)) + (lambda () + (with-sqlite-cache + database + 'derivation-changes + derivation-changes + #:args + (list derivation-changes-url) + #:ttl (* 60 20))) + #:unwind? #t))) + + (when derivation-changes-data + (let ((target-commit + (assoc-ref + (assoc-ref + (assoc-ref change-details + "revisions") + "target") + "commit"))) + + (submit-builds-for-category build-coordinator + guix-data-service + 'issue + issue-number + derivation-changes-data + target-commit + #:build-limit build-limit + #:priority priority + #:build-count-priority-penalty + (lambda (build-count) + (cond + ((< build-count 10) 0) + ((< build-count 100) 50) + ((< build-count 300) 100) + (else 150))))))) + (simple-format #t "no derivation changes url for issue ~A\n" + issue-number)))) + (define* (start-submit-patch-builds-thread database build-coordinator guix-data-service @@ -47,69 +118,16 @@ (n-par-for-each 4 (match-lambda - ((issue-number . series) - (simple-format #t - "considering submitting builds for issue ~A\n" - issue-number) - - (let ((derivation-changes-url - (and=> - (get-issue-branch-base-and-target-refs issue-number) - (lambda (base-and-target-refs) - (patch-series-derivation-changes-url - base-and-target-refs - #:systems %systems-to-submit-builds-for))))) - - (if derivation-changes-url - (let ((derivation-changes-data - change-details - (with-exception-handler - (lambda (exn) - (simple-format - (current-error-port) - "failed fetching derivation changes for issue ~A: ~A\n" - issue-number - exn) - - (values #f #f)) - (lambda () - (with-sqlite-cache - database - 'derivation-changes - derivation-changes - #:args - (list derivation-changes-url) - #:ttl (* 60 20))) - #:unwind? #t))) - - (when derivation-changes-data - (let ((target-commit - (assoc-ref - (assoc-ref - (assoc-ref change-details - "revisions") - "target") - "commit"))) - - (submit-builds-for-category build-coordinator - guix-data-service - 'issue - issue-number - derivation-changes-data - target-commit - #:build-limit - (* (length %systems-to-submit-builds-for) - 600) - #:priority priority-for-change - #:build-count-priority-penalty - (lambda (build-count) - (cond - ((< build-count 10) 0) - ((< build-count 100) 50) - ((< build-count 300) 100) - (else 150))))))) - (simple-format #t "no derivation changes url for issue ~A\n" - issue-number))))) + ((issue-number . _) + (submit-builds-for-issue + database + build-coordinator + guix-data-service + issue-number + #:priority priority-for-change + #:build-limit + (* (length %systems-to-submit-builds-for) + 600)))) (take series series-count)))) (call-with-new-thread |