mirror of
git://git.savannah.gnu.org/guix/guix-cuirass.git
synced 2023-12-14 06:03:04 +01:00
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:
parent
6f85bc04f3
commit
72f2b6b77c
2 changed files with 36 additions and 6 deletions
|
@ -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)
|
||||
|
|
|
@ -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)))
|
||||
|
||||
|
|
Loading…
Reference in a new issue