branch: master
commit 1f31134d33ba6b30e375c9debe792a6c85363313
Author: Ludovic Courtès <l...@gnu.org>
Date: Wed Feb 14 16:40:50 2018 +0100
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'.
---
src/cuirass/database.scm | 26 +++++++++++++++++++-------
tests/database.scm | 1 +
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"
