[bug#31755] [PATCH 02/19] database: Fail registration when encountering unregistered references.

["Ludovic Courtès" <ludo@gnu.org>]

* guix/store/database.scm (add-reference-sql): Remove nested SELECT.
(add-references): Expect REFERENCES to be a list of ids.
(sqlite-register): Call 'path-id' for each of REFERENCES and pass it to
'add-references'.
* tests/store-database.scm ("register-path with unregistered references"):
New test.
---
 guix/store/database.scm  | 18 +++++++++++-------
 tests/store-database.scm | 20 ++++++++++++++++++++
 2 files changed, 31 insertions(+), 7 deletions(-)

diff --git a/guix/store/database.scm b/guix/store/database.scm
index e81ab3dc9..d5e34ef04 100644
--- a/guix/store/database.scm
+++ b/guix/store/database.scm
@@ -27,6 +27,7 @@
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-11)
   #:use-module (srfi srfi-19)
+  #:use-module (srfi srfi-26)
   #:use-module (rnrs io ports)
   #:use-module (ice-9 match)
   #:use-module (system foreign)
@@ -139,13 +140,11 @@ of course. Returns the row id of the row that was modified or inserted."
           (last-insert-row-id db)))))
 
 (define add-reference-sql
-  "INSERT OR IGNORE INTO Refs (referrer, reference) SELECT :referrer, id
-FROM ValidPaths WHERE path = :reference")
+  "INSERT INTO Refs (referrer, reference) VALUES (:referrer, :reference);")
 
 (define (add-references db referrer references)
   "REFERRER is the id of the referring store item, REFERENCES is a list
-containing store items being referred to.  Note that all of the store items in
-REFERENCES must already be registered."
+ids of items referred to."
   (let ((stmt (sqlite-prepare db add-reference-sql #:cache? #t)))
     (for-each (lambda (reference)
                 (sqlite-reset stmt)
@@ -164,15 +163,20 @@ path of some store item, REFERENCES is a list of string paths which the store
 item PATH refers to (they need to be already registered!), DERIVER is a string
 path of the derivation that created the store item PATH, HASH is the
 base16-encoded sha256 hash of the store item denoted by PATH (prefixed with
-\"sha256:\") after being converted to nar form, and nar-size is the size in
-bytes of the store item denoted by PATH after being converted to nar form."
+\"sha256:\") after being converted to nar form, and NAR-SIZE is the size in
+bytes of the store item denoted by PATH after being converted to nar form.
+
+Every store item in REFERENCES must already be registered."
   (with-database db-file db
     (let ((id (update-or-insert db #:path path
                                 #:deriver deriver
                                 #:hash hash
                                 #:nar-size nar-size
                                 #:time (time-second (current-time time-utc)))))
-      (add-references db id references))))
+      ;; Call 'path-id' on each of REFERENCES.  This ensures we get a
+      ;; "non-NULL constraint" failure if one of REFERENCES is unregistered.
+      (add-references db id
+                      (map (cut path-id db <>) references)))))
 
 \f
 ;;;
diff --git a/tests/store-database.scm b/tests/store-database.scm
index 794736859..9562055fd 100644
--- a/tests/store-database.scm
+++ b/tests/store-database.scm
@@ -74,4 +74,24 @@
          (list (path-id db "/gnu/foo")
                (path-id db "/gnu/bar")))))))
 
+(test-assert "register-path with unregistered references"
+  ;; Make sure we get a "NOT NULL constraint failed: Refs.reference" error
+  ;; when we try to add references that are not registered yet.  Better safe
+  ;; than sorry.
+  (call-with-temporary-output-file
+   (lambda (db-file port)
+     (delete-file db-file)
+     (catch 'sqlite-error
+       (lambda ()
+         (sqlite-register #:db-file db-file
+                          #:path "/gnu/foo"
+                          #:references '("/gnu/bar")
+                          #:deriver "/gnu/foo.drv"
+                          #:hash (string-append "sha256:" (make-string 64 #\e))
+                          #:nar-size 1234)
+         #f)
+       (lambda args
+         (pk 'welcome-exception! args)
+         #t)))))
+
 (test-end "store-database")
-- 
2.17.1