;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2017-2018, 2020-2021, 2024 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.

(define-module (test-store-database)
  #:use-module (guix tests)
  #:use-module (guix store)
  #:use-module (guix store database)
  #:use-module (guix build store-copy)
  #:use-module ((</td></tr></table>
<table class='tabs'><tr><td>
<a class='active' href='/guix/about/'>about</a><a href='/guix/'>summary</a><a href='/guix/refs/?id=05fb1e0017030f1c0cbc7e9a1adeccca57ef1d9d'>refs</a><a href='/guix/log/'>log</a><a href='/guix/tree/?id=05fb1e0017030f1c0cbc7e9a1adeccca57ef1d9d'>tree</a><a href='/guix/commit/?id=05fb1e0017030f1c0cbc7e9a1adeccca57ef1d9d'>commit</a><a href='/guix/diff/?id=05fb1e0017030f1c0cbc7e9a1adeccca57ef1d9d'>diff</a></td><td class='form'><form class='right' method='get' action='/guix/log/'>
<input type='hidden' name='id' value='05fb1e0017030f1c0cbc7e9a1adeccca57ef1d9d'/><select name='qt'>
<option value='grep'>log msg</option>
<option value='author'>author</option>
<option value='committer'>committer</option>
<option value='range'>range</option>
</select>
<input class='txt' type='search' size='10' name='q' value=''/>
<input type='submit' value='search'/>
</form>
</td></tr></table>
<div class='content'><div id='summary'><pre>
;; -*- mode: scheme; -*-
;; This is an operating system configuration template for a &quot;Docker image&quot;
;; setup, so it has barely any services at all.

(use-modules (gnu))

(operating-system
  (host-name &quot;komputilo&quot;)
  (timezone &quot;Europe/Berlin&quot;)
  (locale &quot;en_US.utf8&quot;)

  ;; This is where user accounts are specified.  The &quot;root&quot; account is
  ;; implicit, and is initially created with the empty password.
  (users (cons (user-account
                (name &quot;alice&quot;)
                (comment &quot;Bob&apos;s sister&quot;)
                (group &quot;users&quot;)
                (supplementary-groups &apos;(&quot;wheel&quot;
                                        &quot;audio&quot; &quot;video&quot;)))
               %base-user-accounts))

  ;; Globally-installed packages.
  (packages %base-packages)

  ;; Because the system will run in a Docker container, we may omit many
  ;; things that would normally be required in an operating system
  ;; configuration file.  These things include:
  ;;
  ;;   * bootloader
  ;;   * file-systems
  ;;   * services such as mingetty, udevd, slim, networking, dhcp
  ;;
  ;; Either these things are simply not required, or Docker provides
  ;; similar services for us.

  ;; This will be ignored.
  (bootloader (bootloader-configuration
               (bootloader grub-bootloader)
               (targets &apos;(&quot;does-not-matter&quot;))))
  ;; This will be ignored, too.
  (file-systems (list (file-system
                        (device &quot;does-not-matter&quot;)
                        (mount-point &quot;/&quot;)
                        (type &quot;does-not-matter&quot;))))

  ;; Guix is all you need!
  (services (list (service guix-service-type))))
</pre>
</div></div> <!-- class=content -->
                         <div class=footer>generated by
                             <a href="https://git.zx2c4.com/cgit/about/">
                                 cgit
                             </a>
                         </div>
                        </div> <!-- id=cgit -->
</body>
</html>
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 ()
         (with-database db-file db
           (register-valid-path db #: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-equal "register-valid-path with incorrect size"
  'out-of-range
  (call-with-temporary-output-file
   (lambda (db-file port)
     (delete-file db-file)
     (catch #t
       (lambda ()
         (with-database db-file db
           (register-valid-path db #:path "/gnu/foo"
                                #:references '("/gnu/bar")
                                #:deriver "/gnu/foo.drv"
                                #:hash (string-append "sha256:" (make-string 64 #\e))
                                #:nar-size -1234))
         #f)
       (lambda (key . _)
         key)))))

(test-end "store-database")