Make the build event handling code more generic

So that triggering a check for substitutes can be integrated in.
This commit is contained in:
Christopher Baines 2023-06-06 12:32:53 +01:00
parent 68850065d7
commit 7524d23b44

View file

@ -120,10 +120,32 @@
(define build-server-id (define build-server-id
(string->number build-server-id-string)) (string->number build-server-id-string))
(define (spawn-fiber-for-build-handler handler (define (call-via-thread-pool-channel handler)
statuses (spawn-fiber
data (lambda ()
build-ids) (parallel-via-thread-pool-channel
(with-postgresql-connection
"build-event-handler-conn"
(lambda (conn)
(with-exception-handler
(lambda (exn)
(simple-format
(current-error-port)
"exception in build event handler: ~A\n"
exn))
(lambda ()
(with-throw-handler #t
(lambda ()
(handler conn))
(lambda _
(display (backtrace) (current-error-port))
(display "\n" (current-error-port)))))
#:unwind? #t)))))))
(define (with-build-ids-for-status data
build-ids
statuses
handler)
(let ((ids (let ((ids
(delete-duplicates (delete-duplicates
(filter-map (filter-map
@ -138,26 +160,7 @@
data) data)
=))) =)))
(unless (null? ids) (unless (null? ids)
(spawn-fiber (handler ids))))
(lambda ()
(parallel-via-thread-pool-channel
(with-postgresql-connection
"build-event-handler-conn"
(lambda (conn)
(with-exception-handler
(lambda (exn)
(simple-format
(current-error-port)
"exception in build event handler: ~A\n"
exn))
(lambda ()
(with-throw-handler #t
(lambda ()
(handler conn ids))
(lambda _
(display (backtrace) (current-error-port))
(display "\n" (current-error-port)))))
#:unwind? #t)))))))))
(define (handle-derivation-events conn items) (define (handle-derivation-events conn items)
(if (null? items) (if (null? items)
@ -223,23 +226,32 @@
conn conn
filtered-items))))))) filtered-items)))))))
(spawn-fiber-for-build-handler (with-build-ids-for-status
handle-removing-blocking-build-entries-for-successful-builds items
build-ids
'("succeeded") '("succeeded")
items (lambda (ids)
build-ids) (call-via-thread-pool-channel
(lambda (conn)
(handle-removing-blocking-build-entries-for-successful-builds conn ids)))))
(spawn-fiber-for-build-handler (with-build-ids-for-status
handle-blocked-builds-entries-for-scheduled-builds items
build-ids
'("scheduled") '("scheduled")
items (lambda (ids)
build-ids) (call-via-thread-pool-channel
(lambda (conn)
(handle-blocked-builds-entries-for-scheduled-builds conn ids)))))
(spawn-fiber-for-build-handler (with-build-ids-for-status
handle-populating-blocked-builds-for-build-failures
'("failed" "failed-dependency" "canceled")
items items
build-ids))) build-ids
'("failed" "failed-dependency" "canceled")
(lambda (ids)
(call-via-thread-pool-channel
(lambda (conn)
(handle-populating-blocked-builds-for-build-failures conn ids)))))))
(if (any-invalid-query-parameters? parsed-query-parameters) (if (any-invalid-query-parameters? parsed-query-parameters)
(render-json (render-json