diff options
| -rw-r--r-- | guix-data-service/web/build-server/controller.scm | 84 |
1 files changed, 48 insertions, 36 deletions
diff --git a/guix-data-service/web/build-server/controller.scm b/guix-data-service/web/build-server/controller.scm index bbc4a93..babf59d 100644 --- a/guix-data-service/web/build-server/controller.scm +++ b/guix-data-service/web/build-server/controller.scm @@ -120,10 +120,32 @@ (define build-server-id (string->number build-server-id-string)) - (define (spawn-fiber-for-build-handler handler - statuses - data - build-ids) + (define (call-via-thread-pool-channel handler) + (spawn-fiber + (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)) + (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 (delete-duplicates (filter-map @@ -138,26 +160,7 @@ data) =))) (unless (null? ids) - (spawn-fiber - (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))))))))) + (handler ids)))) (define (handle-derivation-events conn items) (if (null? items) @@ -223,23 +226,32 @@ conn filtered-items))))))) - (spawn-fiber-for-build-handler - handle-removing-blocking-build-entries-for-successful-builds - '("succeeded") + (with-build-ids-for-status items - build-ids) + build-ids + '("succeeded") + (lambda (ids) + (call-via-thread-pool-channel + (lambda (conn) + (handle-removing-blocking-build-entries-for-successful-builds conn ids))))) - (spawn-fiber-for-build-handler - handle-blocked-builds-entries-for-scheduled-builds - '("scheduled") + (with-build-ids-for-status items - build-ids) + build-ids + '("scheduled") + (lambda (ids) + (call-via-thread-pool-channel + (lambda (conn) + (handle-blocked-builds-entries-for-scheduled-builds conn ids))))) - (spawn-fiber-for-build-handler - handle-populating-blocked-builds-for-build-failures - '("failed" "failed-dependency" "canceled") + (with-build-ids-for-status 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) (render-json |