From d6edfc8f8f474ccb1c200f2135384646f11c8fb5 Mon Sep 17 00:00:00 2001 From: Christopher Baines Date: Fri, 12 Jan 2024 14:55:30 +0000 Subject: Add more options when updating build priorities Computing new derived priorities is slow, so these options allow skipping that if you know what you're doing. For example, if you're updating a batch of related builds and you want them all to have the same priorities and derived priorities, you can now do that much quicker. --- guix-build-coordinator/client-communication.scm | 42 ++++++++++++++++++------- guix-build-coordinator/coordinator.scm | 14 ++++++--- guix-build-coordinator/datastore/sqlite.scm | 14 +++++---- scripts/guix-build-coordinator.in | 25 +++++++++++++-- 4 files changed, 71 insertions(+), 24 deletions(-) diff --git a/guix-build-coordinator/client-communication.scm b/guix-build-coordinator/client-communication.scm index 8b2b9a2..4ce0bbf 100644 --- a/guix-build-coordinator/client-communication.scm +++ b/guix-build-coordinator/client-communication.scm @@ -192,13 +192,22 @@ "") "true"))))))) (('POST "build" uuid "update-priority") - (update-build-priority - build-coordinator - uuid - (assoc-ref body "new_priority")) + (let ((query-parameters (request-query-parameters request))) + (update-build-priority + build-coordinator + uuid + (assoc-ref body "new_priority") + #:skip-updating-derived-priorities? + (string=? (or + (assq-ref query-parameters + 'skip-updating-derived-priorities) + "") + "true") + #:override-derived-priority + (assoc-ref body "override_derived_priority")) - (render-json - `((result . "build-priority-updated")))) + (render-json + `((result . "build-priority-updated"))))) (('GET "builds" "blocking") (let ((query-parameters (request-query-parameters request))) (render-json @@ -771,14 +780,23 @@ "&skip-updating-derived-priorities=true" "")))) -(define (send-update-build-priority-request - coordinator-uri - build-id - new-priority) +(define* (send-update-build-priority-request + coordinator-uri + build-id + new-priority + #:key skip-updating-derived-priorities? + override-derived-priority) (send-request coordinator-uri 'POST - (string-append "/build/" build-id "/update-priority") - `((new_priority . ,new-priority)))) + (string-append "/build/" build-id "/update-priority" + (if skip-updating-derived-priorities? + "?skip-updating-derived-priorities=true" + "")) + `((new_priority . ,new-priority) + ,@(if override-derived-priority + `((override_derived_priority + . ,override-derived-priority)) + '())))) (define (request-build-details coordinator-uri uuid) diff --git a/guix-build-coordinator/coordinator.scm b/guix-build-coordinator/coordinator.scm index 906f6ee..916ed92 100644 --- a/guix-build-coordinator/coordinator.scm +++ b/guix-build-coordinator/coordinator.scm @@ -850,7 +850,9 @@ (perform-operation))) (perform-operation))) -(define (update-build-priority build-coordinator uuid new-priority) +(define* (update-build-priority build-coordinator uuid new-priority + #:key skip-updating-derived-priorities? + override-derived-priority) (define datastore (build-coordinator-datastore build-coordinator)) (datastore-call-with-transaction @@ -865,9 +867,13 @@ (raise-exception (make-client-error 'build-already-processed)))) - (datastore-update-build-priority datastore - uuid - new-priority))) + (datastore-update-build-priority + datastore + uuid + new-priority + #:skip-updating-derived-priorities? + skip-updating-derived-priorities? + #:override-derived-priority override-derived-priority))) (trigger-build-allocation build-coordinator) diff --git a/guix-build-coordinator/datastore/sqlite.scm b/guix-build-coordinator/datastore/sqlite.scm index 888775e..f10af88 100644 --- a/guix-build-coordinator/datastore/sqlite.scm +++ b/guix-build-coordinator/datastore/sqlite.scm @@ -1638,7 +1638,8 @@ WHERE build_id = :build_id" (apply (lambda* (uuid new-priority - #:key skip-updating-other-build-derived-priorities) + #:key skip-updating-derived-priorities? + override-derived-priority) (let ((build-id old-priority (call-with-worker-thread @@ -1664,8 +1665,9 @@ WHERE build_id = :build_id" db build-id)) (new-derived-priority - (max new-priority - (get-derived-priority db build-id)))) + (or override-derived-priority + (max new-priority + (get-derived-priority db build-id))))) (unless (eq? old-derived-priority new-derived-priority) @@ -1674,7 +1676,7 @@ WHERE build_id = :build_id" new-derived-priority)) (unless (or all-inputs-built? - skip-updating-other-build-derived-priorities) + skip-updating-derived-priorities?) (when (> new-derived-priority old-derived-priority) (update-unprocessed-builds-with-higher-derived-priorities @@ -1687,8 +1689,8 @@ WHERE build_id = :build_id" ;; transaction, but since there could be lots of builds to update the ;; priority of, and a new derived priority has to be calculated for ;; each one, it's better to handle it afterwards. - (when (< new-priority - old-priority) + (when (and (not skip-updating-derived-priorities?) + (< new-priority old-priority)) (datastore-update-unprocessed-builds-with-lower-derived-priorities datastore uuid diff --git a/scripts/guix-build-coordinator.in b/scripts/guix-build-coordinator.in index 4ceace0..23a356f 100644 --- a/scripts/guix-build-coordinator.in +++ b/scripts/guix-build-coordinator.in @@ -40,6 +40,7 @@ (srfi srfi-71) (ice-9 match) (ice-9 streams) + (ice-9 exceptions) (ice-9 suspendable-ports) (web uri) (fibers) @@ -313,6 +314,16 @@ (alist-cons 'new-priority (string->number arg) (alist-delete 'new-priority result)))) + (option '("override-derived-priority") #t #f + (lambda (opt name arg result) + (alist-cons 'override-derived-priority + (string->number arg) + (alist-delete 'override-derived-priority result)))) + (option '("skip-updating-derived-priorities") #f #f + (lambda (opt name _ result) + (alist-cons 'skip-updating-derived-priorities + #t + result))) %common-build-filtering-options)) (define %build-update-priority-option-defaults @@ -725,10 +736,20 @@ tags: (send-update-build-priority-request (assq-ref opts 'coordinator) id - (assq-ref opts 'new-priority)) + (assq-ref opts 'new-priority) + #:skip-updating-derived-priorities? + (assq-ref opts 'skip-updating-derived-priorities) + #:override-derived-priority + (assq-ref opts 'override-derived-priority)) (report)) #:times 6 - #:delay 5)) + #:delay 5 + #:ignore + (lambda (exn) + (member (assoc-ref (exception-message exn) + "error") + '("build-already-canceled" + "build-already-processed"))))) matching-builds))))) ((build-id) (send-update-build-priority-request (assq-ref opts 'coordinator) -- cgit v1.2.3