guix-commits
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

10/33: Refactor opening store connections when processing jobs


From: Christopher Baines
Subject: 10/33: Refactor opening store connections when processing jobs
Date: Wed, 14 Aug 2024 05:01:27 -0400 (EDT)

cbaines pushed a commit to branch master
in repository data-service.

commit b22834dae7f48363cc924e3f5084a2afbd230c7f
Author: Christopher Baines <mail@cbaines.net>
AuthorDate: Thu Jul 18 13:57:50 2024 +0100

    Refactor opening store connections when processing jobs
    
    And set the #:built-in-builders.
---
 guix-data-service/jobs/load-new-guix-revision.scm | 27 +++++++++++++++--------
 1 file changed, 18 insertions(+), 9 deletions(-)

diff --git a/guix-data-service/jobs/load-new-guix-revision.scm 
b/guix-data-service/jobs/load-new-guix-revision.scm
index 2ac5ede..7945a19 100644
--- a/guix-data-service/jobs/load-new-guix-revision.scm
+++ b/guix-data-service/jobs/load-new-guix-revision.scm
@@ -1163,7 +1163,7 @@
          (inferior-and-store-pool
           (make-resource-pool
            (lambda ()
-             (let* ((inferior-store (open-connection))
+             (let* ((inferior-store (open-store-connection))
                     (inferior (start-inferior inferior-store)))
                (ensure-non-blocking-store-connection inferior-store)
                (set-build-options inferior-store #:fallback? #t)
@@ -1450,7 +1450,7 @@
   (define inf-and-store-pool
     (make-resource-pool
      (lambda ()
-       (let* ((inferior-store (open-connection))
+       (let* ((inferior-store (open-store-connection))
               (inferior (start-inferior-for-data-extration
                          inferior-store
                          store-path
@@ -2130,20 +2130,29 @@ SKIP LOCKED")
    (exec-query conn query)))
 
 (define (open-store-connection)
-  (let ((store (open-connection)))
-    (ensure-non-blocking-store-connection store)
+  (let ((store (open-connection #:non-blocking? #t
+                                #:built-in-builders '("download"))))
     (set-build-options store #:fallback? #t)
 
     store))
 
 (prevent-inlining-for-tests open-store-connection)
 
-(define (with-store-connection f)
-  (with-store store
-    (ensure-non-blocking-store-connection store)
-    (set-build-options store #:fallback? #t)
+(define* (with-store-connection proc)
+  (let ((store (open-store-connection)))
+    (define (thunk)
+      (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)
 



reply via email to

[Prev in Thread] Current Thread [Next in Thread]