gnu/tests/guix.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2019 Christopher Baines <mail@cbaines.net>
   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 (gnu tests guix)
  20   #:use-module (gnu tests)
  21   #:use-module (gnu system)
  22   #:use-module (gnu system file-systems)
  23   #:use-module (gnu system shadow)
  24   #:use-module (gnu system vm)
  25   #:use-module (gnu services)
  26   #:use-module (gnu services guix)
  27   #:use-module (gnu services databases)
  28   #:use-module (gnu services shepherd)
  29   #:use-module (gnu services networking)
  30   #:use-module (gnu packages databases)
  31   #:use-module (guix packages)
  32   #:use-module (guix modules)
  33   #:use-module (guix records)
  34   #:use-module (guix gexp)
  35   #:use-module (guix store)
  36   #:use-module (guix utils)
  37   #:use-module (ice-9 match)
  38   #:export (%test-guix-data-service))
  39
  40 \f
  41 ;;;
  42 ;;; Guix Data Service
  43 ;;;
  44
  45 (define guix-data-service-initial-database-setup-service
  46   (let ((user "guix_data_service")
  47         (name "guix_data_service"))
  48     (define start-gexp
  49       #~(lambda ()
  50           (let ((pid (primitive-fork))
  51                 (postgres (getpwnam "postgres")))
  52             (if (eq? pid 0)
  53                 (dynamic-wind
  54                   (const #t)
  55                   (lambda ()
  56                     (setgid (passwd:gid postgres))
  57                     (setuid (passwd:uid postgres))
  58                     (primitive-exit
  59                      (if (and
  60                           (zero?
  61                            (system* #$(file-append postgresql "/bin/createuser")
  62                                     #$user))
  63                           (zero?
  64                            (system* #$(file-append postgresql "/bin/createdb")
  65                                     "-O" #$user #$name)))
  66                          0
  67                          1)))
  68                   (lambda ()
  69                     (primitive-exit 1)))
  70                 (zero? (cdr (waitpid pid)))))))
  71
  72     (shepherd-service
  73      (requirement '(postgres))
  74      (provision '(guix-data-service-initial-database-setup))
  75      (start start-gexp)
  76      (stop #~(const #f))
  77      (respawn? #f)
  78      (one-shot? #t)
  79      (documentation "Setup Guix Data Service database."))))
  80
  81 (define %guix-data-service-os
  82   (simple-operating-system
  83    (service dhcp-client-service-type)
  84    (service postgresql-service-type
  85             (postgresql-configuration
  86              (config-file
  87               (postgresql-config-file
  88                (hba-file
  89                 (plain-file "pg_hba.conf"
  90                             "
  91 local   all     all                     trust
  92 host    all     all     127.0.0.1/32    trust
  93 host    all     all     ::1/128         trust"))))))
  94    (service guix-data-service-type
  95             (guix-data-service-configuration
  96              (host "0.0.0.0")))
  97    (simple-service 'guix-data-service-database-setup
  98                    shepherd-root-service-type
  99                    (list guix-data-service-initial-database-setup-service))))
 100
 101 (define (run-guix-data-service-test)
 102   (define os
 103     (marionette-operating-system
 104      %guix-data-service-os
 105      #:imported-modules '((gnu services herd)
 106                           (guix combinators))))
 107
 108   (define forwarded-port 8080)
 109
 110   (define vm
 111     (virtual-machine
 112      (operating-system os)
 113      (memory-size 1024)
 114      (port-forwardings `((,forwarded-port . 8765)))))
 115
 116   (define test
 117     (with-imported-modules '((gnu build marionette))
 118       #~(begin
 119           (use-modules (srfi srfi-11) (srfi srfi-64)
 120                        (gnu build marionette)
 121                        (web uri)
 122                        (web client)
 123                        (web response))
 124
 125           (define marionette
 126             (make-marionette (list #$vm)))
 127
 128           (mkdir #$output)
 129           (chdir #$output)
 130
 131           (test-begin "guix-data-service")
 132
 133           (test-assert "service running"
 134             (marionette-eval
 135              '(begin
 136                 (use-modules (gnu services herd))
 137                 (match (start-service 'guix-data-service)
 138                   (#f #f)
 139                   (('service response-parts ...)
 140                    (match (assq-ref response-parts 'running)
 141                      ((pid) (number? pid))))))
 142              marionette))
 143
 144           (test-assert "process jobs service running"
 145             (marionette-eval
 146              '(begin
 147                 (use-modules (gnu services herd))
 148                 (match (start-service 'guix-data-service-process-jobs)
 149                   (#f #f)
 150                   (('service response-parts ...)
 151                    (match (assq-ref response-parts 'running)
 152                      ((pid) (number? pid))))))
 153              marionette))
 154
 155           (test-equal "http-get"
 156             200
 157             (let-values
 158                 (((response text)
 159                   (http-get #$(simple-format
 160                                #f "http://localhost:~A/healthcheck" forwarded-port)
 161                             #:decode-body? #t)))
 162               (response-code response)))
 163
 164           (test-end)
 165           (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
 166
 167   (gexp->derivation "guix-data-service-test" test))
 168
 169 (define %test-guix-data-service
 170   (system-test
 171    (name "guix-data-service")
 172    (description "Connect to a running Guix Data Service.")
 173    (value (run-guix-data-service-test))))