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

Refactor opening store connections when processing jobs

Browse source 
And set the #:built-in-builders.
This commit is contained in:
Christopher Baines 2024-07-18 13:57:50 +01:00
parent e81c6377bf
commit b22834dae7
1 changed files with 18 additions and 9 deletions
Download patch file Download diff file Expand all files Collapse all files

27
guix-data-service/jobs/load-new-guix-revision.scm
View file

@ -1163,7 +1163,7 @@
(inferior-and-store-pool (inferior-and-store-pool
(make-resource-pool (make-resource-pool
(lambda () (lambda ()
(let* ((inferior-store (open-connection)) (let* ((inferior-store (open-store-connection))
(inferior (start-inferior inferior-store))) (inferior (start-inferior inferior-store)))
(ensure-non-blocking-store-connection inferior-store) (ensure-non-blocking-store-connection inferior-store)
(set-build-options inferior-store #:fallback? #t) (set-build-options inferior-store #:fallback? #t)
@ -1450,7 +1450,7 @@
(define inf-and-store-pool (define inf-and-store-pool
(make-resource-pool (make-resource-pool
(lambda () (lambda ()
(let* ((inferior-store (open-connection)) (let* ((inferior-store (open-store-connection))
(inferior (start-inferior-for-data-extration (inferior (start-inferior-for-data-extration
inferior-store inferior-store
store-path store-path
@ -2130,20 +2130,29 @@ SKIP LOCKED")
(exec-query conn query))) (exec-query conn query)))
(define (open-store-connection) (define (open-store-connection)
(let ((store (open-connection))) (let ((store (open-connection #:non-blocking? #t
(ensure-non-blocking-store-connection store) #:built-in-builders '("download"))))
(set-build-options store #:fallback? #t) (set-build-options store #:fallback? #t)
store)) store))
(prevent-inlining-for-tests open-store-connection) (prevent-inlining-for-tests open-store-connection)
(define (with-store-connection f) (define* (with-store-connection proc)
(with-store store (let ((store (open-store-connection)))
(ensure-non-blocking-store-connection store) (define (thunk)
(set-build-options store #:fallback? #t) (parameterize ((current-store-protocol-version
(store-connection-version store)))
(call-with-values (lambda () (proc store))
(lambda results
(close-connection store)
(apply values results)))))
(with-exception-handler (lambda (exception)
(close-connection store)
(raise-exception exception))
thunk)))
(f store)))
(prevent-inlining-for-tests with-store-connection) (prevent-inlining-for-tests with-store-connection)