Provide a mechanism to gracefully abort transactions

1 files changed, 15 insertions, 4 deletions

diff --git a/guix-build-coordinator/datastore/sqlite.scm b/guix-build-coordinator/datastore/sqlite.scm
index f5da1ab..c9d53d1 100644
--- a/guix-build-coordinator/datastore/sqlite.scm
+++ b/guix-build-coordinator/datastore/sqlite.scm
@@ -23,6 +23,7 @@
             datastore-initialise-metrics!
             datastore-update-metrics!
             datastore-update
+            make-transaction-rollback-exception
             datastore-call-with-transaction
             datastore-store-derivation
             datastore-build-exists-for-derivation-outputs?
@@ -383,6 +384,11 @@ PRAGMA optimize;")))))
                            (lambda (duration)
                              (log-delay proc duration))))
 
+(define-exception-type &transaction-rollback-exception &exception
+  make-transaction-rollback-exception
+  transaction-rollback-exception?
+  (return-value transaction-rollback-exception-return-value))
+
 (define %current-transaction-proc
   (make-parameter #f))
 
@@ -408,10 +414,15 @@ PRAGMA optimize;")))))
                             "BEGIN TRANSACTION;"))
         (with-exception-handler
             (lambda (exn)
-              (simple-format (current-error-port)
-                             "error: sqlite rolling back transaction\n")
-              (sqlite-exec db "ROLLBACK TRANSACTION;")
-              (raise-exception exn))
+              (if (transaction-rollback-exception? exn)
+                  (begin
+                    (sqlite-exec db "ROLLBACK TRANSACTION;")
+                    (transaction-rollback-exception-return-value exn))
+                  (begin
+                    (simple-format (current-error-port)
+                                   "error: sqlite rolling back transaction\n")
+                    (sqlite-exec db "ROLLBACK TRANSACTION;")
+                    (raise-exception exn))))
           (lambda ()
             (call-with-values
                 (lambda ()