database: Make 'db-add-derivation' idempotent.

* src/cuirass/database.scm (db-add-derivation): Catch 'sqlite-error and
handle SQLITE_CONSTRAINT_PRIMARYKEY.
(SQLITE_CONSTRAINT_UNIQUE): New variable.
* tests/database.scm ("database")["db-add-derivation"]: Add extra call to
'db-add-derivation'.

2 files changed, 20 insertions, 7 deletions

diff --git a/src/cuirass/database.scm b/src/cuirass/database.scm
index d3e2666..dd3e5a2 100644
--- a/src/cuirass/database.scm
+++ b/src/cuirass/database.scm
@@ -216,15 +216,25 @@ INSERT OR IGNORE INTO Specifications (repo_name, url, load_path, file, \
 
 (define (db-add-derivation db job)
   "Store a derivation result in database DB and return its ID."
-  (sqlite-exec db "\
+  (catch 'sqlite-error
+    (lambda ()
+      (sqlite-exec db "\
 INSERT INTO Derivations (derivation, job_name, system, nix_name, evaluation)\
   VALUES ("
-               (assq-ref job #:derivation) ", "
-               (assq-ref job #:job-name) ", "
-               (assq-ref job #:system) ", "
-               (assq-ref job #:nix-name) ", "
-               (assq-ref job #:eval-id) ");")
-  (last-insert-rowid db))
+                   (assq-ref job #:derivation) ", "
+                   (assq-ref job #:job-name) ", "
+                   (assq-ref job #:system) ", "
+                   (assq-ref job #:nix-name) ", "
+                   (assq-ref job #:eval-id) ");")
+      (last-insert-rowid db))
+    (lambda (key who code message . rest)
+      ;; If we get a unique-constraint-failed error, that means we have
+      ;; already inserted the same (derivation,eval-id) tuple.  That happens
+      ;; when several jobs produce the same derivation, and we can ignore it.
+      (if (= code SQLITE_CONSTRAINT_PRIMARYKEY)
+          (sqlite-exec db "SELECT * FROM Derivations WHERE derivation="
+                       (assq-ref job #:derivation) ";")
+          (apply throw key who code rest)))))
 
 (define (db-get-derivation db id)
   "Retrieve a job in database DB which corresponds to ID."
@@ -261,6 +271,8 @@ string."
 (define SQLITE_CONSTRAINT 19)
 (define SQLITE_CONSTRAINT_PRIMARYKEY
   (logior SQLITE_CONSTRAINT (ash 6 8)))
+(define SQLITE_CONSTRAINT_UNIQUE
+  (logior SQLITE_CONSTRAINT (ash 8 8)))
 
 (define-enumeration build-status
   ;; Build status as expected by Hydra's API.  Note: the negative values are
diff --git a/tests/database.scm b/tests/database.scm
index 306068b..902c94e 100644
--- a/tests/database.scm
+++ b/tests/database.scm
@@ -106,6 +106,7 @@ INSERT INTO Evaluations (specification, revision) VALUES (3, 3);")
     (let* ((job (make-dummy-job))
            (key (assq-ref job #:derivation)))
       (db-add-derivation (%db) job)
+      (db-add-derivation (%db) job)               ;idempotent
       (%id key)))
 
   (test-assert "db-get-derivation"