aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorChristopher Baines <mail@cbaines.net>2023-02-21 11:20:04 +0000
committerChristopher Baines <mail@cbaines.net>2023-02-21 11:37:55 +0000
commit9920e359bb0c8e9c97f8eaf53219578d49b4a984 (patch)
tree02ab334638f20ee79413fc210d7b9bb4105a3213
parentf1e089aed137b2589a1b3228399fca14e6a734f9 (diff)
downloadbuild-coordinator-9920e359bb0c8e9c97f8eaf53219578d49b4a984.tar
build-coordinator-9920e359bb0c8e9c97f8eaf53219578d49b4a984.tar.gz
Provide a mechanism to gracefully abort transactions
-rw-r--r--guix-build-coordinator/datastore.scm1
-rw-r--r--guix-build-coordinator/datastore/sqlite.scm19
2 files changed, 16 insertions, 4 deletions
diff --git a/guix-build-coordinator/datastore.scm b/guix-build-coordinator/datastore.scm
index 66440bf..f2372b5 100644
--- a/guix-build-coordinator/datastore.scm
+++ b/guix-build-coordinator/datastore.scm
@@ -13,6 +13,7 @@
(re-export datastore-initialise-metrics!)
(re-export datastore-update-metrics!)
(re-export datastore-update)
+(re-export make-transaction-rollback-exception)
(re-export datastore-call-with-transaction)
(re-export datastore-store-derivation)
(re-export datastore-insert-build)
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 ()