me
/
guix
Archived
1
0
Fork 0
Code

store: database: Rename a couple of procedures. 

These names should be more descriptive.

* guix/store/database.scm (path-id): Rename to select-valid-path-id.
(sqlite-register): Rename to register-valid-path.
(register-items): Update accordingly.

Change-Id: I6d4a14d4cde9d71ab34d6ffdbfbfde51b2c0e1db
master
Christopher Baines 2024-02-19 15:44:15 +00:00
parent c6cc9aeb87
commit c9cd16c630
No known key found for this signature in database
GPG Key ID: 5E28A33B0B84F577
3 changed files with 46 additions and 44 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

35
guix/store/database.scm
View File

@ -40,8 +40,10 @@
store-database-file store-database-file
call-with-database call-with-database
with-database with-database
path-id
sqlite-register valid-path-id
register-valid-path
register-items register-items
%epoch %epoch
reset-timestamps reset-timestamps
@ -181,9 +183,9 @@ If FILE doesn't exist, create it and initialize it as a new database. Pass
(vector-ref (sqlite-step-and-reset stmt) (vector-ref (sqlite-step-and-reset stmt)
0))) 0)))
(define* (path-id db path) (define (valid-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.
identifier. Otherwise, return #f." Otherwise, return #f."
(let ((stmt (sqlite-prepare (let ((stmt (sqlite-prepare
db db
" "
@ -249,7 +251,7 @@ Every store item in REFERENCES must already be registered."
(assert-integer "sqlite-register" (cut >= <> 0) #:time registration-time) (assert-integer "sqlite-register" (cut >= <> 0) #:time registration-time)
(define id (define id
(let ((existing-id (path-id db path))) (let ((existing-id (valid-path-id db path)))
(if existing-id (if existing-id
(let ((stmt (sqlite-prepare (let ((stmt (sqlite-prepare
db db
@ -284,7 +286,8 @@ VALUES (:path, :hash, :time, :deriver, :size)"
;; Call 'path-id' on each of REFERENCES. This ensures we get a ;; Call 'path-id' on each of REFERENCES. This ensures we get a
;; "non-NULL constraint" failure if one of REFERENCES is unregistered. ;; "non-NULL constraint" failure if one of REFERENCES is unregistered.
(add-references db id (add-references db id
(map (cut path-id db <>) references))) (map (cut valid-path-id db <>) references)))
;;; ;;;
@ -361,18 +364,18 @@ typically by adding them as temp-roots."
;; When TO-REGISTER is already registered, skip it. This makes a ;; When TO-REGISTER is already registered, skip it. This makes a
;; significant differences when 'register-closures' is called ;; significant differences when 'register-closures' is called
;; consecutively for overlapping closures such as 'system' and 'bootcfg'. ;; consecutively for overlapping closures such as 'system' and 'bootcfg'.
(unless (path-id db to-register) (unless (valid-path-id db to-register)
(let-values (((hash nar-size) (nar-sha256 real-file-name))) (let-values (((hash nar-size) (nar-sha256 real-file-name)))
(call-with-retrying-transaction db (call-with-retrying-transaction db
(lambda () (lambda ()
(sqlite-register db #:path to-register (register-valid-path db #:path to-register
#:references (store-info-references item) #:references (store-info-references item)
#:deriver (store-info-deriver item) #:deriver (store-info-deriver item)
#:hash (string-append #:hash (string-append
"sha256:" "sha256:"
(bytevector->base16-string hash)) (bytevector->base16-string hash))
#:nar-size nar-size #:nar-size nar-size
#:time registration-time)))))) #:time registration-time))))))
(let* ((prefix (format #f "registering ~a items" (length items))) (let* ((prefix (format #f "registering ~a items" (length items)))
(progress (progress-reporter/bar (length items) (progress (progress-reporter/bar (length items)

2
tests/pack.scm
View File

@ -209,7 +209,7 @@
(and (every valid-file? (and (every valid-file?
'("α" "λ") '("α" "λ")
'("alpha" "lambda")) '("alpha" "lambda"))
(integer? (path-id db #$tree))))))))))) (integer? (valid-path-id db #$tree)))))))))))
(built-derivations (list check)))) (built-derivations (list check))))
(unless store (test-skip 1)) (unless store (test-skip 1))

53
tests/store-database.scm
View File

@ -87,23 +87,22 @@
(lambda (db-file port) (lambda (db-file port)
(delete-file db-file) (delete-file db-file)
(with-database db-file db (with-database db-file db
(sqlite-register db (register-valid-path db
#:path "/gnu/foo" #:path "/gnu/foo"
#:references '() #:references '()
#:deriver "/gnu/foo.drv" #:deriver "/gnu/foo.drv"
#:hash (string-append "sha256:" (make-string 64 #\e)) #:hash (string-append "sha256:" (make-string 64 #\e))
#:nar-size 1234) #:nar-size 1234)
(sqlite-register db (register-valid-path db
#:path "/gnu/bar" #:path "/gnu/bar"
#:references '("/gnu/foo") #:references '("/gnu/foo")
#:deriver "/gnu/bar.drv" #:deriver "/gnu/bar.drv"
#:hash (string-append "sha256:" (make-string 64 #\a)) #:hash (string-append "sha256:" (make-string 64 #\a))
#:nar-size 4321) #:nar-size 4321)
(let ((path-id (@@ (guix store database) path-id))) (list (valid-path-id db "/gnu/foo")
(list (path-id db "/gnu/foo") (valid-path-id db "/gnu/bar"))))))
(path-id db "/gnu/bar")))))))
(test-assert "sqlite-register with unregistered references" (test-assert "register-valid-path with unregistered references"
;; Make sure we get a "NOT NULL constraint failed: Refs.reference" error ;; 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 ;; when we try to add references that are not registered yet. Better safe
;; than sorry. ;; than sorry.
@ -113,17 +112,17 @@
(catch 'sqlite-error (catch 'sqlite-error
(lambda () (lambda ()
(with-database db-file db (with-database db-file db
(sqlite-register db #:path "/gnu/foo" (register-valid-path db #:path "/gnu/foo"
#:references '("/gnu/bar") #:references '("/gnu/bar")
#:deriver "/gnu/foo.drv" #:deriver "/gnu/foo.drv"
#:hash (string-append "sha256:" (make-string 64 #\e)) #:hash (string-append "sha256:" (make-string 64 #\e))
#:nar-size 1234)) #:nar-size 1234))
#f) #f)
(lambda args (lambda args
(pk 'welcome-exception! args) (pk 'welcome-exception! args)
#t))))) #t)))))
(test-equal "sqlite-register with incorrect size" (test-equal "register-valid-path with incorrect size"
'out-of-range 'out-of-range
(call-with-temporary-output-file (call-with-temporary-output-file
(lambda (db-file port) (lambda (db-file port)
@ -131,11 +130,11 @@
(catch #t (catch #t
(lambda () (lambda ()
(with-database db-file db (with-database db-file db
(sqlite-register db #:path "/gnu/foo" (register-valid-path db #:path "/gnu/foo"
#:references '("/gnu/bar") #:references '("/gnu/bar")
#:deriver "/gnu/foo.drv" #:deriver "/gnu/foo.drv"
#:hash (string-append "sha256:" (make-string 64 #\e)) #:hash (string-append "sha256:" (make-string 64 #\e))
#:nar-size -1234)) #:nar-size -1234))
#f) #f)
(lambda (key . _) (lambda (key . _)
key))))) key)))))