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-build-coordinator
  39             %test-guix-data-service))
  40
  41 ;;;
  42 ;;; Guix Build Coordinator
  43 ;;;
  44
  45 (define %guix-build-coordinator-os
  46   (simple-operating-system
  47    (service dhcp-client-service-type)
  48    (service guix-build-coordinator-service-type)))
  49
  50 (define (run-guix-build-coordinator-test)
  51   (define os
  52     (marionette-operating-system
  53      %guix-build-coordinator-os
  54      #:imported-modules '((gnu services herd)
  55                           (guix combinators))))
  56
  57   (define forwarded-port 8745)
  58
  59   (define vm
  60     (virtual-machine
  61      (operating-system os)
  62      (memory-size 1024)
  63      (port-forwardings `((,forwarded-port . 8745)))))
  64
  65   (define test
  66     (with-imported-modules '((gnu build marionette))
  67       #~(begin
  68           (use-modules (srfi srfi-11) (srfi srfi-64)
  69                        (gnu build marionette)
  70                        (web uri)
  71                        (web client)
  72                        (web response))
  73
  74           (define marionette
  75             (make-marionette (list #$vm)))
  76
  77           (mkdir #$output)
  78           (chdir #$output)
  79
  80           (test-begin "guix-build-coordinator")
  81
  82           (test-assert "service running"
  83             (marionette-eval
  84              '(begin
  85                 (use-modules (gnu services herd))
  86                 (match (start-service 'guix-build-coordinator)
  87                   (#f #f)
  88                   (('service response-parts ...)
  89                    (match (assq-ref response-parts 'running)
  90                      ((pid) (number? pid))))))
  91              marionette))
  92
  93           (test-equal "http-get"
  94             200
  95             (let-values
  96                 (((response text)
  97                   (http-get #$(simple-format
  98                                #f "http://localhost:~A/metrics" forwarded-port)
  99                             #:decode-body? #t)))
 100               (response-code response)))
 101
 102           (test-end)
 103           (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
 104
 105   (gexp->derivation "guix-build-coordinator-test" test))
 106
 107 (define %test-guix-build-coordinator
 108   (system-test
 109    (name "guix-build-coordinator")
 110    (description "Connect to a running Guix Build Coordinator.")
 111    (value (run-guix-build-coordinator-test))))
 112
 113 \f
 114 ;;;
 115 ;;; Guix Data Service
 116 ;;;
 117
 118 (define guix-data-service-initial-database-setup-service
 119   (let ((user "guix_data_service")
 120         (name "guix_data_service"))
 121     (define start-gexp
 122       #~(lambda ()
 123           (let ((pid (primitive-fork))
 124                 (postgres (getpwnam "postgres")))
 125             (if (eq? pid 0)
 126                 (dynamic-wind
 127                   (const #t)
 128                   (lambda ()
 129                     (setgid (passwd:gid postgres))
 130                     (setuid (passwd:uid postgres))
 131                     (primitive-exit
 132                      (if (and
 133                           (zero?
 134                            (system* #$(file-append postgresql "/bin/createuser")
 135                                     #$user))
 136                           (zero?
 137                            (system* #$(file-append postgresql "/bin/createdb")
 138                                     "-O" #$user #$name)))
 139                          0
 140                          1)))
 141                   (lambda ()
 142                     (primitive-exit 1)))
 143                 (zero? (cdr (waitpid pid)))))))
 144
 145     (shepherd-service
 146      (requirement '(postgres))
 147      (provision '(guix-data-service-initial-database-setup))
 148      (start start-gexp)
 149      (stop #~(const #f))
 150      (respawn? #f)
 151      (one-shot? #t)
 152      (documentation "Setup Guix Data Service database."))))
 153
 154 (define %guix-data-service-os
 155   (simple-operating-system
 156    (service dhcp-client-service-type)
 157    (service postgresql-service-type
 158             (postgresql-configuration
 159              (postgresql postgresql-10)
 160              (config-file
 161               (postgresql-config-file
 162                (hba-file
 163                 (plain-file "pg_hba.conf"
 164                             "
 165 local   all     all                     trust
 166 host    all     all     127.0.0.1/32    trust
 167 host    all     all     ::1/128         trust"))))))
 168    (service guix-data-service-type
 169             (guix-data-service-configuration
 170              (host "0.0.0.0")))
 171    (simple-service 'guix-data-service-database-setup
 172                    shepherd-root-service-type
 173                    (list guix-data-service-initial-database-setup-service))))
 174
 175 (define (run-guix-data-service-test)
 176   (define os
 177     (marionette-operating-system
 178      %guix-data-service-os
 179      #:imported-modules '((gnu services herd)
 180                           (guix combinators))))
 181
 182   (define forwarded-port 8080)
 183
 184   (define vm
 185     (virtual-machine
 186      (operating-system os)
 187      (memory-size 1024)
 188      (port-forwardings `((,forwarded-port . 8765)))))
 189
 190   (define test
 191     (with-imported-modules '((gnu build marionette))
 192       #~(begin
 193           (use-modules (srfi srfi-11) (srfi srfi-64)
 194                        (gnu build marionette)
 195                        (web uri)
 196                        (web client)
 197                        (web response))
 198
 199           (define marionette
 200             (make-marionette (list #$vm)))
 201
 202           (mkdir #$output)
 203           (chdir #$output)
 204
 205           (test-begin "guix-data-service")
 206
 207           (test-assert "service running"
 208             (marionette-eval
 209              '(begin
 210                 (use-modules (gnu services herd))
 211                 (match (start-service 'guix-data-service)
 212                   (#f #f)
 213                   (('service response-parts ...)
 214                    (match (assq-ref response-parts 'running)
 215                      ((pid) (number? pid))))))
 216              marionette))
 217
 218           (test-assert "process jobs service running"
 219             (marionette-eval
 220              '(begin
 221                 (use-modules (gnu services herd))
 222                 (match (start-service 'guix-data-service-process-jobs)
 223                   (#f #f)
 224                   (('service response-parts ...)
 225                    (match (assq-ref response-parts 'running)
 226                      ((pid) (number? pid))))))
 227              marionette))
 228
 229           (test-equal "http-get"
 230             200
 231             (let-values
 232                 (((response text)
 233                   (http-get #$(simple-format
 234                                #f "http://localhost:~A/healthcheck" forwarded-port)
 235                             #:decode-body? #t)))
 236               (response-code response)))
 237
 238           (test-end)
 239           (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
 240
 241   (gexp->derivation "guix-data-service-test" test))
 242
 243 (define %test-guix-data-service
 244   (system-test
 245    (name "guix-data-service")
 246    (description "Connect to a running Guix Data Service.")
 247    (value (run-guix-data-service-test))))