[bug#69292] [PATCH 1/6] store: database: Remove call-with-savepoint and associated code.

[Christopher Baines <mail@cbaines.net>]

While care does need to be taken with making updates or inserts to the
ValidPaths table, I think that trying to ensure this within update-or-insert
is the wrong approach. Instead, when working with the store database, only one
connection should be used to make changes to the database and those changes
should happen in transactions that ideally begin immediately.

This reverts commit 37545de4a3bf59611c184b31506fe9a16abe4c8b.

* .dir-locals.el (scheme-mode): Remove entries for call-with-savepoint and
call-with-retrying-savepoint.
* guix/store/database.scm (call-with-savepoint, call-with-retrying-savepoint):
Remove procedures.
(update-or-insert): Remove use of call-with-savepoint.

Change-Id: I2f986e8623d8235a90c40d5f219c1292c1ab157b
---
 .dir-locals.el          |  2 --
 guix/store/database.scm | 75 +++++++----------------------------------
 2 files changed, 13 insertions(+), 64 deletions(-)

diff --git a/.dir-locals.el b/.dir-locals.el
index d18e6ba760..f135eb69a5 100644
--- a/.dir-locals.el
+++ b/.dir-locals.el
@@ -133,8 +133,6 @@
    (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-savepoint 'scheme-indent-function 1))
-   (eval . (put 'call-with-retrying-savepoint 'scheme-indent-function 1))
 
    (eval . (put 'call-with-container 'scheme-indent-function 1))
    (eval . (put 'container-excursion 'scheme-indent-function 1))
diff --git a/guix/store/database.scm b/guix/store/database.scm
index 2968f13492..3093fd816a 100644
--- a/guix/store/database.scm
+++ b/guix/store/database.scm
@@ -151,39 +151,11 @@ (define* (call-with-transaction db proc #:key restartable?)
       (false-if-exception (exec "rollback;"))
       (apply throw args))))
 
-(define* (call-with-savepoint db proc
-                              #:optional (savepoint-name "SomeSavepoint"))
-  "Call PROC after creating a savepoint named SAVEPOINT-NAME.  If PROC exits
-abnormally, rollback to that savepoint.  In all cases, remove the savepoint
-prior to returning."
-  (define (exec sql)
-    (with-statement db sql stmt
-      (sqlite-fold cons '() stmt)))
-
-  (dynamic-wind
-    (lambda ()
-      (exec (string-append "SAVEPOINT " savepoint-name ";")))
-    (lambda ()
-      (catch #t
-        proc
-        (lambda args
-          (exec (string-append "ROLLBACK TO " savepoint-name ";"))
-          (apply throw args))))
-    (lambda ()
-      (exec (string-append "RELEASE " savepoint-name ";")))))
-
 (define* (call-with-retrying-transaction db proc #:key restartable?)
   (call-with-SQLITE_BUSY-retrying
    (lambda ()
      (call-with-transaction db proc #:restartable? restartable?))))
 
-(define* (call-with-retrying-savepoint db proc
-                                       #:optional (savepoint-name
-                                                   "SomeSavepoint"))
-  (call-with-SQLITE_BUSY-retrying
-   (lambda ()
-     (call-with-savepoint db proc savepoint-name))))
-
 (define %default-database-file
   ;; Default location of the store database.
   (string-append %store-database-directory "/db.sqlite"))
@@ -261,40 +233,19 @@ (define* (update-or-insert db #:key path deriver hash nar-size time)
   (assert-integer "update-or-insert" positive? #:nar-size nar-size)
   (assert-integer "update-or-insert" (cut >= <> 0) #:time time)
 
-  ;; It's important that querying the path-id and the insert/update operation
-  ;; take place in the same transaction, as otherwise some other
-  ;; process/thread/fiber could register the same path between when we check
-  ;; whether it's already registered and when we register it, resulting in
-  ;; duplicate paths (which, due to a 'unique' constraint, would cause an
-  ;; exception to be thrown). With the default journaling mode this will
-  ;; prevent writes from occurring during that sensitive time, but with WAL
-  ;; mode it will instead arrange to return SQLITE_BUSY when a write occurs
-  ;; between the start of a read transaction and its upgrading to a write
-  ;; transaction (see https://sqlite.org/rescode.html#busy_snapshot).
-  ;; Experimentally, it seems this SQLITE_BUSY will ignore a busy_timeout and
-  ;; immediately return (makes sense, since waiting won't change anything).
-
-  ;; Note that when that kind of SQLITE_BUSY error is returned, it will keep
-  ;; being returned every time we try to upgrade the same outermost
-  ;; transaction to a write transaction.  So when retrying, we have to restart
-  ;; the *outermost* write transaction.  We can't inherently tell whether
-  ;; we're the outermost write transaction, so we leave the retry-handling to
-  ;; the caller.
-  (call-with-savepoint db
-    (lambda ()
-      (let ((id (path-id db path)))
-        (if id
-            (with-statement db update-sql stmt
-              (sqlite-bind-arguments stmt #:id id
-                                     #:deriver deriver
-                                     #:hash hash #:size nar-size #:time time)
-              (sqlite-fold cons '() stmt))
-            (with-statement db insert-sql stmt
-              (sqlite-bind-arguments stmt
-                                     #:path path #:deriver deriver
-                                     #:hash hash #:size nar-size #:time time)
-              (sqlite-fold cons '() stmt)))
-        (last-insert-row-id db)))))
+  (let ((id (path-id db path)))
+    (if id
+        (with-statement db update-sql stmt
+          (sqlite-bind-arguments stmt #:id id
+                                 #:deriver deriver
+                                 #:hash hash #:size nar-size #:time time)
+          (sqlite-fold cons '() stmt))
+        (with-statement db insert-sql stmt
+          (sqlite-bind-arguments stmt
+                                 #:path path #:deriver deriver
+                                 #:hash hash #:size nar-size #:time time)
+          (sqlite-fold cons '() stmt)))
+    (last-insert-row-id db)))
 
 (define add-reference-sql
   "INSERT OR REPLACE INTO Refs (referrer, reference) VALUES (:referrer, :reference);")

base-commit: f4af19b037826cad90bbcfe400ad864f028cc7d8
-- 
2.41.0