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

Retry processing background queue jobs on exception

Browse source
This commit is contained in:
Christopher Baines 2025-07-01 13:33:22 +01:00
parent f1e444babe
commit 8640958af7
1 changed files with 48 additions and 45 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -235,55 +235,58 @@ port. Also, the port used can be changed by passing the --port option.\n"
(while (not (check-startup-completed startup-completed)) (while (not (check-startup-completed startup-completed))
(sleep 1)) (sleep 1))
(with-exception-handler (while
(lambda _ #f)
(lambda ()
(with-exception-handler (with-exception-handler
(lambda (exn) (lambda _ #t)
(simple-format
#t
"exception when processing the background jobs queue")
(print-backtrace-and-exception/knots
exn)
(raise-exception exn))
(lambda () (lambda ()
(let ((build-ids (with-exception-handler
(call-with-resource-from-pool (background-connection-pool) (lambda (exn)
(lambda (conn) (simple-format
(select-background-processing-build-ids conn))))) #t
(unless (null? build-ids) "exception when processing the background jobs queue")
(simple-format #t "processing ~A builds from the background queue\n" (print-backtrace-and-exception/knots
(length build-ids))) exn)
(fibers-batch-for-each (raise-exception exn))
(lambda (build-id) (lambda ()
(call-with-resource-from-pool (background-connection-pool) (let ((build-ids
(lambda (conn) (call-with-resource-from-pool (background-connection-pool)
(let ((status (select-latest-build-status-by-build-id (lambda (conn)
conn (select-background-processing-build-ids conn)))))
build-id))) (unless (null? build-ids)
(cond (simple-format #t "processing ~A builds from the background queue\n"
((string=? status "succeeded") (length build-ids)))
(handle-removing-blocking-build-entries-for-successful-builds (fibers-batch-for-each
conn (lambda (build-id)
(list build-id))) (call-with-resource-from-pool (background-connection-pool)
((string=? status "scheduled") (lambda (conn)
(handle-blocked-builds-entries-for-scheduled-builds (let ((status (select-latest-build-status-by-build-id
conn conn
(list build-id))) build-id)))
((member status '("failed" (cond
"failed-dependency" ((string=? status "succeeded")
"canceled")) (handle-removing-blocking-build-entries-for-successful-builds
(handle-populating-blocked-builds-for-build-failures conn
(list build-id)))
((string=? status "scheduled")
(handle-blocked-builds-entries-for-scheduled-builds
conn
(list build-id)))
((member status '("failed"
"failed-dependency"
"canceled"))
(handle-populating-blocked-builds-for-build-failures
conn
(list build-id)))))
(delete-background-processing-entries-for-build-ids
conn conn
(list build-id))))) (list build-id)))))
(delete-background-processing-entries-for-build-ids (assq-ref (resource-pool-stats (background-connection-pool)
conn #:timeout #f)
(list build-id))))) 'resources)
(assq-ref (resource-pool-stats (background-connection-pool) build-ids))
#:timeout #f) #f)))
'resources) #:unwind? #t)
build-ids))))) (sleep 20)))
#:unwind? #t))
#:parallel? #t) #:parallel? #t)
(spawn-fiber (spawn-fiber