database: 'db-add-build' is now idempotent.

Fixes <https://bugs.gnu.org/28094>.
Reported by Ricardo Wurmus <rekado@elephly.net>.

* src/cuirass/database.scm (SQLITE_CONSTRAINT)
(SQLITE_CONSTRAINT_PRIMARYKEY): New variables.
(db-add-build): Catch 'sqlite-error, and swallow
SQLITE_CONSTRAINT_PRIMARYKEY errors.
* tests/database.scm ("db-add-build"): New test.

2 files changed, 36 insertions, 6 deletions

diff --git a/src/cuirass/database.scm b/src/cuirass/database.scm
index 804b8c2..31f78b1 100644
--- a/src/cuirass/database.scm
+++ b/src/cuirass/database.scm
@@ -181,15 +181,35 @@ string."
             ((char=? char #\')  (loop (cons* char char chars)))
             (else (loop (cons char chars)))))))
 
+;; Extended error codes (see <sqlite3.h>).
+;; XXX: This should be defined by (sqlite3).
+(define SQLITE_CONSTRAINT 19)
+(define SQLITE_CONSTRAINT_PRIMARYKEY
+  (logior SQLITE_CONSTRAINT (ash 6 8)))
+
 (define (db-add-build db build)
-  "Store BUILD in database DB."
-  (sqlite-exec db "\
+  "Store BUILD in database DB.  This is idempotent."
+  (let ((derivation (assq-ref build #:derivation))
+        (eval-id    (assq-ref build #:eval-id))
+        (log        (assq-ref build #:log))
+        (output     (assq-ref build #:output)))
+   (catch 'sqlite-error
+     (lambda ()
+       (sqlite-exec db "\
 INSERT INTO Builds (derivation, evaluation, log, output)\
   VALUES ('~A', '~A', '~A', '~A');"
-               (assq-ref build #:derivation)
-               (assq-ref build #:eval-id)
-               (assq-ref build #:log)
-               (assq-ref build #:output))
+                    derivation eval-id log output))
+     (lambda (key who code message . rest)
+       ;; If we get a primary-key-constraint-violated error, that means we have
+       ;; already inserted the same (derivation,eval-id,log) tuple, which we
+       ;; can safely ignore.
+       (unless (= code SQLITE_CONSTRAINT_PRIMARYKEY)
+         (format (current-error-port)
+                 "error: failed to add build (~s, ~s, ~s, ~s) to database: ~a~%"
+                 derivation eval-id log output
+                 message)
+         (apply throw key who code rest)))))
+
   (last-insert-rowid db))
 
 (define (db-get-stamp db spec)
diff --git a/tests/database.scm b/tests/database.scm
index 7f3b972..46b245e 100644
--- a/tests/database.scm
+++ b/tests/database.scm
@@ -78,6 +78,16 @@ INSERT INTO Evaluations (specification, revision) VALUES (3, 3);")
   (test-assert "db-get-derivation"
     (db-get-derivation (%db) (%id)))
 
+  (test-assert "db-add-build"
+    (let ((build `((#:derivation . "/foo.drv")
+                   (#:eval-id . 42)
+                   (#:log . "log")
+                   (#:output . "/foo"))))
+      (db-add-build (%db) build)
+
+      ;; This should be idempotent, see <https://bugs.gnu.org/28094>.
+      (db-add-build (%db) build)))
+
   (test-assert "db-close"
     (db-close (%db)))