cbaines/guix-data-service
1
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Process queued build events in parallel

Browse source
This commit is contained in:
Christopher Baines 2025-07-01 13:07:44 +01:00
parent 61780fe7ea
commit f1e444babe
1 changed files with 17 additions and 11 deletions
Download patch file Download diff file Expand all files Collapse all files

28
guix-data-service/web/server.scm
View file

@ -35,6 +35,7 @@
#:use-module (knots) #:use-module (knots)
#:use-module (knots web-server) #:use-module (knots web-server)
#:use-module (knots thread-pool) #:use-module (knots thread-pool)
#:use-module (knots parallelism)
#:use-module (knots resource-pool) #:use-module (knots resource-pool)
#:use-module (prometheus) #:use-module (prometheus)
#:use-module (guix-data-service utils) #:use-module (guix-data-service utils)
@ -246,15 +247,17 @@ port. Also, the port used can be changed by passing the --port option.\n"
exn) exn)
(raise-exception exn)) (raise-exception exn))
(lambda () (lambda ()
(call-with-resource-from-pool (background-connection-pool) (let ((build-ids
(lambda (conn) (call-with-resource-from-pool (background-connection-pool)
(let ((build-ids (lambda (conn)
(select-background-processing-build-ids conn))) (select-background-processing-build-ids conn)))))
(unless (null? build-ids) (unless (null? build-ids)
(simple-format #t "processing ~A builds from the background queue\n" (simple-format #t "processing ~A builds from the background queue\n"
(length build-ids))) (length build-ids)))
(for-each (fibers-batch-for-each
(lambda (build-id) (lambda (build-id)
(call-with-resource-from-pool (background-connection-pool)
(lambda (conn)
(let ((status (select-latest-build-status-by-build-id (let ((status (select-latest-build-status-by-build-id
conn conn
build-id))) build-id)))
@ -275,8 +278,11 @@ port. Also, the port used can be changed by passing the --port option.\n"
(list build-id))))) (list build-id)))))
(delete-background-processing-entries-for-build-ids (delete-background-processing-entries-for-build-ids
conn conn
(list build-id))) (list build-id)))))
build-ids))))))) (assq-ref (resource-pool-stats (background-connection-pool)
#:timeout #f)
'resources)
build-ids)))))
#:unwind? #t)) #:unwind? #t))
#:parallel? #t) #:parallel? #t)