Wrap transactions with some error handling

To rollback when they fail.

1 files changed, 64 insertions, 22 deletions

diff --git a/guix-build-coordinator/datastore/sqlite.scm b/guix-build-coordinator/datastore/sqlite.scm
index 431f74c..41688e1 100644
--- a/guix-build-coordinator/datastore/sqlite.scm
+++ b/guix-build-coordinator/datastore/sqlite.scm
@@ -165,8 +165,15 @@ WHERE agent_id = :agent_id AND password = :password")))
    (slot-ref datastore 'worker-thread-channel)
    (lambda (db)
      (sqlite-exec db "BEGIN TRANSACTION;")
-     (insert-derivation-and-return-outputs db derivation)
-     (sqlite-exec db "COMMIT TRANSACTION;")))
+     (with-exception-handler
+         (lambda (key . args)
+           (simple-format (current-error-port)
+                          "error: sqlite: ~A ~A\n"
+                          key args)
+           (sqlite-exec db "ROLLBACK TRANSACTION;"))
+       (lambda ()
+         (insert-derivation-and-return-outputs db derivation)
+         (sqlite-exec db "COMMIT TRANSACTION;")))))
   #t)
 
 (define-method (datastore-store-build
@@ -178,8 +185,15 @@ WHERE agent_id = :agent_id AND password = :password")))
    (slot-ref datastore 'worker-thread-channel)
    (lambda (db)
      (sqlite-exec db "BEGIN TRANSACTION;")
-     (insert-build db uuid derivation-name priority)
-     (sqlite-exec db "COMMIT TRANSACTION;")))
+     (with-exception-handler
+         (lambda (key . args)
+           (simple-format (current-error-port)
+                          "error: sqlite: ~A ~A\n"
+                          key args)
+           (sqlite-exec db "ROLLBACK TRANSACTION;"))
+       (lambda ()
+         (insert-build db uuid derivation-name priority)
+         (sqlite-exec db "COMMIT TRANSACTION;")))))
   #t)
 
 (define-method (datastore-store-build-result
@@ -226,10 +240,17 @@ UPDATE builds SET processed = 1 WHERE uuid = '" build-id "'")))
    (slot-ref datastore 'worker-thread-channel)
    (lambda (db)
      (sqlite-exec db "BEGIN TRANSACTION;")
-     (insert-build-result db build-id agent-id result failure-reason)
-     (remove-build-allocation db build-id agent-id)
-     (mark-build-as-processed db build-id)
-     (sqlite-exec db "COMMIT TRANSACTION;")))
+     (with-exception-handler
+         (lambda (key . args)
+           (simple-format (current-error-port)
+                          "error: sqlite: ~A ~A\n"
+                          key args)
+           (sqlite-exec db "ROLLBACK TRANSACTION;"))
+       (lambda ()
+         (insert-build-result db build-id agent-id result failure-reason)
+         (remove-build-allocation db build-id agent-id)
+         (mark-build-as-processed db build-id)
+         (sqlite-exec db "COMMIT TRANSACTION;")))))
   #t)
 
 (define (insert-setup-failure-and-remove-allocation
@@ -285,13 +306,20 @@ INSERT INTO setup_failure_missing_inputs (
    (slot-ref datastore 'worker-thread-channel)
    (lambda (db)
      (sqlite-exec db "BEGIN TRANSACTION;")
-     (let ((setup-failure-id
-            (insert-setup-failure-and-remove-allocation db
-                                                        build-id
-                                                        agent-id
-                                                        "missing_inputs")))
-       (insert-missing-inputs db setup-failure-id missing-inputs))
-     (sqlite-exec db "COMMIT TRANSACTION;")))
+     (with-exception-handler
+         (lambda (key . args)
+           (simple-format (current-error-port)
+                          "error: sqlite: ~A ~A\n"
+                          key args)
+           (sqlite-exec db "ROLLBACK TRANSACTION;"))
+       (lambda ()
+         (let ((setup-failure-id
+                (insert-setup-failure-and-remove-allocation db
+                                                            build-id
+                                                            agent-id
+                                                            "missing_inputs")))
+           (insert-missing-inputs db setup-failure-id missing-inputs))
+         (sqlite-exec db "COMMIT TRANSACTION;")))))
   #t)
 
 (define-method (datastore-store-setup-failure
@@ -427,10 +455,17 @@ INSERT INTO build_allocation_plan (build_id, agent_id, ordering) VALUES "
    (slot-ref datastore 'worker-thread-channel)
    (lambda (db)
      (sqlite-exec db "BEGIN TRANSACTION;")
-     (clear-current-plan db)
-     (unless (null? planned-builds)
-       (insert-new-plan db planned-builds))
-     (sqlite-exec db "COMMIT TRANSACTION;")))
+     (with-exception-handler
+         (lambda (key . args)
+           (simple-format (current-error-port)
+                          "error: sqlite: ~A ~A\n"
+                          key args)
+           (sqlite-exec db "ROLLBACK TRANSACTION;"))
+       (lambda ()
+         (clear-current-plan db)
+         (unless (null? planned-builds)
+           (insert-new-plan db planned-builds))
+         (sqlite-exec db "COMMIT TRANSACTION;")))))
   #t)
 
 (define-method (datastore-allocate-builds-to-agent
@@ -472,9 +507,16 @@ WHERE build_id IN ("
    (slot-ref datastore 'worker-thread-channel)
    (lambda (db)
      (sqlite-exec db "BEGIN TRANSACTION;")
-     (insert-to-allocated-builds db agent-id build-ids)
-     (remove-builds-from-plan db build-ids)
-     (sqlite-exec db "COMMIT TRANSACTION;")))
+     (with-exception-handler
+         (lambda (key . args)
+           (simple-format (current-error-port)
+                          "error: sqlite: ~A ~A\n"
+                          key args)
+           (sqlite-exec db "ROLLBACK TRANSACTION;"))
+       (lambda ()
+         (insert-to-allocated-builds db agent-id build-ids)
+         (remove-builds-from-plan db build-ids)
+         (sqlite-exec db "COMMIT TRANSACTION;")))))
   #t)
 
 (define-method (datastore-list-allocation-plan-builds