store: database: Remove with-statement and associated code.

I think using dynamic-wind to finalize all statements is the wrong
approach. Firstly it would be good to allow reseting statements rather than
finalizing them. Then for the problem of handling errors, the approach I've
settled on in the build coordinator is to close the database connection, since
that'll trigger guile-sqlite3 to finalize all the cached statements.

This reverts commit 5d6e225528.

* .dir-locals.el (scheme-mode): Remove with-statement.
* guix/store/database.scm (call-with-statement): Remove procedure.
(with-statement): Remove syntax rule.
(call-with-transaction, last-insert-row-id, path-id, update-or-insert,
add-references): Don't use with-statement.

Change-Id: I2fd976b3f12ec8105cc56350933a953cf53647e8
This commit is contained in:
Christopher Baines 2024-02-18 13:19:54 +00:00
parent 22fa92cf28
commit b914fb9b70
No known key found for this signature in database
GPG key ID: 5E28A33B0B84F577
2 changed files with 27 additions and 36 deletions

View file

@ -131,7 +131,6 @@
(eval . (put 'with-database 'scheme-indent-function 2)) (eval . (put 'with-database 'scheme-indent-function 2))
(eval . (put 'call-with-database 'scheme-indent-function 1)) (eval . (put 'call-with-database 'scheme-indent-function 1))
(eval . (put 'call-with-transaction 'scheme-indent-function 1)) (eval . (put 'call-with-transaction 'scheme-indent-function 1))
(eval . (put 'with-statement 'scheme-indent-function 3))
(eval . (put 'call-with-retrying-transaction 'scheme-indent-function 1)) (eval . (put 'call-with-retrying-transaction 'scheme-indent-function 1))
(eval . (put 'call-with-container 'scheme-indent-function 1)) (eval . (put 'call-with-container 'scheme-indent-function 1))

View file

@ -130,25 +130,22 @@ (define* (call-with-transaction db proc #:key restartable?)
the transaction, otherwise commit the transaction after it finishes. the transaction, otherwise commit the transaction after it finishes.
RESTARTABLE? may be set to a non-#f value when it is safe to run PROC multiple RESTARTABLE? may be set to a non-#f value when it is safe to run PROC multiple
times. This may reduce contention for the database somewhat." times. This may reduce contention for the database somewhat."
(define (exec sql)
(with-statement db sql stmt
(sqlite-fold cons '() stmt)))
;; We might use begin immediate here so that if we need to retry, we figure ;; We might use begin immediate here so that if we need to retry, we figure
;; that out immediately rather than because some SQLITE_BUSY exception gets ;; that out immediately rather than because some SQLITE_BUSY exception gets
;; thrown partway through PROC - in which case the part already executed ;; thrown partway through PROC - in which case the part already executed
;; (which may contain side-effects!) might have to be executed again for ;; (which may contain side-effects!) might have to be executed again for
;; every retry. ;; every retry.
(exec (if restartable? "begin;" "begin immediate;")) (sqlite-exec db (if restartable? "begin;" "begin immediate;"))
(catch #t (catch #t
(lambda () (lambda ()
(let-values ((result (proc))) (let-values ((result (proc)))
(exec "commit;") (sqlite-exec db "commit;")
(apply values result))) (apply values result)))
(lambda args (lambda args
;; The roll back may or may not have occurred automatically when the ;; The roll back may or may not have occurred automatically when the
;; error was generated. If it has occurred, this does nothing but signal ;; error was generated. If it has occurred, this does nothing but signal
;; an error. If it hasn't occurred, this needs to be done. ;; an error. If it hasn't occurred, this needs to be done.
(false-if-exception (exec "rollback;")) (false-if-exception (sqlite-exec db "rollback;"))
(apply throw args)))) (apply throw args))))
(define* (call-with-retrying-transaction db proc #:key restartable?) (define* (call-with-retrying-transaction db proc #:key restartable?)
@ -170,26 +167,14 @@ (define-syntax with-database
((_ file db exp ...) ((_ file db exp ...)
(call-with-database file (lambda (db) exp ...))))) (call-with-database file (lambda (db) exp ...)))))
(define (call-with-statement db sql proc)
(let ((stmt (sqlite-prepare db sql #:cache? #t)))
(dynamic-wind
(const #t)
(lambda ()
(proc stmt))
(lambda ()
(sqlite-finalize stmt)))))
(define-syntax-rule (with-statement db sql stmt exp ...)
"Run EXP... with STMT bound to a prepared statement corresponding to the sql
string SQL for DB."
(call-with-statement db sql
(lambda (stmt) exp ...)))
(define (last-insert-row-id db) (define (last-insert-row-id db)
;; XXX: (sqlite3) currently lacks bindings for 'sqlite3_last_insert_rowid'. ;; XXX: (sqlite3) currently lacks bindings for 'sqlite3_last_insert_rowid'.
;; Work around that. ;; Work around that.
(with-statement db "SELECT last_insert_rowid();" stmt (let* ((stmt (sqlite-prepare db "SELECT last_insert_rowid();"
(match (sqlite-fold cons '() stmt) #:cache? #t))
(result (sqlite-fold cons '() stmt)))
(sqlite-finalize stmt)
(match result
((#(id)) id) ((#(id)) id)
(_ #f)))) (_ #f))))
@ -199,11 +184,13 @@ (define path-id-sql
(define* (path-id db path) (define* (path-id db path)
"If PATH exists in the 'ValidPaths' table, return its numerical "If PATH exists in the 'ValidPaths' table, return its numerical
identifier. Otherwise, return #f." identifier. Otherwise, return #f."
(with-statement db path-id-sql stmt (let ((stmt (sqlite-prepare db path-id-sql #:cache? #t)))
(sqlite-bind-arguments stmt #:path path) (sqlite-bind-arguments stmt #:path path)
(match (sqlite-fold cons '() stmt) (let ((result (sqlite-fold cons '() stmt)))
((#(id) . _) id) (sqlite-finalize stmt)
(_ #f)))) (match result
((#(id) . _) id)
(_ #f)))))
(define update-sql (define update-sql
"UPDATE ValidPaths SET hash = :hash, registrationTime = :time, deriver = "UPDATE ValidPaths SET hash = :hash, registrationTime = :time, deriver =
@ -235,17 +222,20 @@ (define* (update-or-insert db #:key path deriver hash nar-size time)
(let ((id (path-id db path))) (let ((id (path-id db path)))
(if id (if id
(with-statement db update-sql stmt (let ((stmt (sqlite-prepare db update-sql #:cache? #t)))
(sqlite-bind-arguments stmt #:id id (sqlite-bind-arguments stmt #:id id
#:deriver deriver #:deriver deriver
#:hash hash #:size nar-size #:time time) #:hash hash #:size nar-size #:time time)
(sqlite-fold cons '() stmt)) (sqlite-fold cons '() stmt)
(with-statement db insert-sql stmt (sqlite-finalize stmt)
(last-insert-row-id db))
(let ((stmt (sqlite-prepare db insert-sql #:cache? #t)))
(sqlite-bind-arguments stmt (sqlite-bind-arguments stmt
#:path path #:deriver deriver #:path path #:deriver deriver
#:hash hash #:size nar-size #:time time) #:hash hash #:size nar-size #:time time)
(sqlite-fold cons '() stmt))) (sqlite-fold cons '() stmt) ;execute it
(last-insert-row-id db))) (sqlite-finalize stmt)
(last-insert-row-id db)))))
(define add-reference-sql (define add-reference-sql
"INSERT OR REPLACE INTO Refs (referrer, reference) VALUES (:referrer, :reference);") "INSERT OR REPLACE INTO Refs (referrer, reference) VALUES (:referrer, :reference);")
@ -253,13 +243,15 @@ (define add-reference-sql
(define (add-references db referrer references) (define (add-references db referrer references)
"REFERRER is the id of the referring store item, REFERENCES is a list "REFERRER is the id of the referring store item, REFERENCES is a list
ids of items referred to." ids of items referred to."
(with-statement db add-reference-sql stmt (let ((stmt (sqlite-prepare db add-reference-sql #:cache? #t)))
(for-each (lambda (reference) (for-each (lambda (reference)
(sqlite-reset stmt) (sqlite-reset stmt)
(sqlite-bind-arguments stmt #:referrer referrer (sqlite-bind-arguments stmt #:referrer referrer
#:reference reference) #:reference reference)
(sqlite-fold cons '() stmt)) (sqlite-fold cons '() stmt) ;execute it
references))) (last-insert-row-id db))
references)
(sqlite-finalize stmt)))
(define (timestamp) (define (timestamp)
"Return a timestamp, either the current time of SOURCE_DATE_EPOCH." "Return a timestamp, either the current time of SOURCE_DATE_EPOCH."