[no subject]

[Ludovic Courtès]

branch: master
commit 72f2b6b77cc4e3d7629bdf34e6daee05398b8de1
Author: Ludovic Courtès <address@hidden>
Date:   Sat Aug 26 10:42:40 2017 +0200

    database: 'db-add-build' is now idempotent.
    
    Fixes <https://bugs.gnu.org/28094>.
    Reported by Ricardo Wurmus <address@hidden>.
    
    * 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.
---
 src/cuirass/database.scm | 32 ++++++++++++++++++++++++++------
 tests/database.scm       | 10 ++++++++++
 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)))