| 1 | ;;; GNU Guix --- Functional package management for GNU |
| 2 | ;;; Copyright © 2017, 2018, 2020, 2021 Ludovic Courtès <ludo@gnu.org> |
| 3 | ;;; |
| 4 | ;;; This file is part of GNU Guix. |
| 5 | ;;; |
| 6 | ;;; GNU Guix is free software; you can redistribute it and/or modify it |
| 7 | ;;; under the terms of the GNU General Public License as published by |
| 8 | ;;; the Free Software Foundation; either version 3 of the License, or (at |
| 9 | ;;; your option) any later version. |
| 10 | ;;; |
| 11 | ;;; GNU Guix is distributed in the hope that it will be useful, but |
| 12 | ;;; WITHOUT ANY WARRANTY; without even the implied warranty of |
| 13 | ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
| 14 | ;;; GNU General Public License for more details. |
| 15 | ;;; |
| 16 | ;;; You should have received a copy of the GNU General Public License |
| 17 | ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. |
| 18 | |
| 19 | (define-module (test-store-database) |
| 20 | #:use-module (guix tests) |
| 21 | #:use-module (guix store) |
| 22 | #:use-module (guix store database) |
| 23 | #:use-module (guix build store-copy) |
| 24 | #:use-module ((guix utils) #:select (call-with-temporary-output-file)) |
| 25 | #:use-module ((guix build utils) |
| 26 | #:select (mkdir-p delete-file-recursively)) |
| 27 | #:use-module (srfi srfi-26) |
| 28 | #:use-module (srfi srfi-64)) |
| 29 | |
| 30 | ;; Test the (guix store database) module. |
| 31 | |
| 32 | (define %store |
| 33 | (open-connection-for-tests)) |
| 34 | |
| 35 | \f |
| 36 | (test-begin "store-database") |
| 37 | |
| 38 | (test-assert "register-items" |
| 39 | (let ((file (string-append (%store-prefix) "/" (make-string 32 #\f) |
| 40 | "-fake"))) |
| 41 | (when (valid-path? %store file) |
| 42 | (delete-paths %store (list file))) |
| 43 | (false-if-exception (delete-file file)) |
| 44 | |
| 45 | (let ((ref (add-text-to-store %store "ref-of-fake" (random-text))) |
| 46 | (drv (string-append file ".drv"))) |
| 47 | (call-with-output-file file |
| 48 | (cut display "This is a fake store item.\n" <>)) |
| 49 | (reset-timestamps file) |
| 50 | (with-database (store-database-file) db |
| 51 | (register-items db (list (store-info file drv (list ref))))) |
| 52 | |
| 53 | (and (valid-path? %store file) |
| 54 | (equal? (references %store file) (list ref)) |
| 55 | (null? (valid-derivers %store file)) |
| 56 | (null? (referrers %store file)) |
| 57 | (list (stat:mtime (lstat file)) |
| 58 | (stat:mtime (lstat ref))))))) |
| 59 | |
| 60 | (test-equal "register-items, directory" |
| 61 | '(1 1 1) |
| 62 | (let ((file (string-append (%store-prefix) "/" (make-string 32 #\f) |
| 63 | "-fake-directory"))) |
| 64 | (when (valid-path? %store file) |
| 65 | (delete-paths %store (list file))) |
| 66 | (false-if-exception (delete-file-recursively file)) |
| 67 | |
| 68 | (let ((drv (string-append file ".drv"))) |
| 69 | (mkdir-p (string-append file "/a")) |
| 70 | (call-with-output-file (string-append file "/a/b") |
| 71 | (const #t)) |
| 72 | (reset-timestamps file) |
| 73 | (with-database (store-database-file) db |
| 74 | (register-items db (list (store-info file drv '())))) |
| 75 | |
| 76 | (and (valid-path? %store file) |
| 77 | (null? (references %store file)) |
| 78 | (null? (valid-derivers %store file)) |
| 79 | (null? (referrers %store file)) |
| 80 | (list (stat:mtime (lstat file)) |
| 81 | (stat:mtime (lstat (string-append file "/a"))) |
| 82 | (stat:mtime (lstat (string-append file "/a/b")))))))) |
| 83 | |
| 84 | (test-equal "new database" |
| 85 | (list 1 2) |
| 86 | (call-with-temporary-output-file |
| 87 | (lambda (db-file port) |
| 88 | (delete-file db-file) |
| 89 | (with-database db-file db |
| 90 | (sqlite-register db |
| 91 | #:path "/gnu/foo" |
| 92 | #:references '() |
| 93 | #:deriver "/gnu/foo.drv" |
| 94 | #:hash (string-append "sha256:" (make-string 64 #\e)) |
| 95 | #:nar-size 1234) |
| 96 | (sqlite-register db |
| 97 | #:path "/gnu/bar" |
| 98 | #:references '("/gnu/foo") |
| 99 | #:deriver "/gnu/bar.drv" |
| 100 | #:hash (string-append "sha256:" (make-string 64 #\a)) |
| 101 | #:nar-size 4321) |
| 102 | (let ((path-id (@@ (guix store database) path-id))) |
| 103 | (list (path-id db "/gnu/foo") |
| 104 | (path-id db "/gnu/bar"))))))) |
| 105 | |
| 106 | (test-assert "sqlite-register with unregistered references" |
| 107 | ;; Make sure we get a "NOT NULL constraint failed: Refs.reference" error |
| 108 | ;; when we try to add references that are not registered yet. Better safe |
| 109 | ;; than sorry. |
| 110 | (call-with-temporary-output-file |
| 111 | (lambda (db-file port) |
| 112 | (delete-file db-file) |
| 113 | (catch 'sqlite-error |
| 114 | (lambda () |
| 115 | (with-database db-file db |
| 116 | (sqlite-register db #:path "/gnu/foo" |
| 117 | #:references '("/gnu/bar") |
| 118 | #:deriver "/gnu/foo.drv" |
| 119 | #:hash (string-append "sha256:" (make-string 64 #\e)) |
| 120 | #:nar-size 1234)) |
| 121 | #f) |
| 122 | (lambda args |
| 123 | (pk 'welcome-exception! args) |
| 124 | #t))))) |
| 125 | |
| 126 | (test-equal "sqlite-register with incorrect size" |
| 127 | 'out-of-range |
| 128 | (call-with-temporary-output-file |
| 129 | (lambda (db-file port) |
| 130 | (delete-file db-file) |
| 131 | (catch #t |
| 132 | (lambda () |
| 133 | (with-database db-file db |
| 134 | (sqlite-register db #:path "/gnu/foo" |
| 135 | #:references '("/gnu/bar") |
| 136 | #:deriver "/gnu/foo.drv" |
| 137 | #:hash (string-append "sha256:" (make-string 64 #\e)) |
| 138 | #:nar-size -1234)) |
| 139 | #f) |
| 140 | (lambda (key . _) |
| 141 | key))))) |
| 142 | |
| 143 | (test-end "store-database") |