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.
This commit is contained in:
Ludovic Courtès 2017-08-26 10:42:40 +02:00
parent 6f85bc04f3
commit 72f2b6b77c
2 changed files with 36 additions and 6 deletions

View File

@ -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)

View File

@ -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)))