gnu/tests/databases.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2017 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 databases)
  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 databases)
  27   #:use-module (gnu services networking)
  28   #:use-module (gnu packages databases)
  29   #:use-module (guix gexp)
  30   #:use-module (guix store)
  31   #:export (%test-memcached
  32             %test-mongodb
  33             %test-postgresql
  34             %test-mysql))
  35
  36 (define %memcached-os
  37   (simple-operating-system
  38    (service dhcp-client-service-type)
  39    (service memcached-service-type)))
  40
  41 (define* (run-memcached-test #:optional (port 11211))
  42   "Run tests in %MEMCACHED-OS, forwarding PORT."
  43   (define os
  44     (marionette-operating-system
  45      %memcached-os
  46      #:imported-modules '((gnu services herd)
  47                           (guix combinators))))
  48
  49   (define vm
  50     (virtual-machine
  51      (operating-system os)
  52      (port-forwardings `((11211 . ,port)))))
  53
  54   (define test
  55     (with-imported-modules '((gnu build marionette))
  56       #~(begin
  57           (use-modules (srfi srfi-11) (srfi srfi-64)
  58                        (gnu build marionette)
  59                        (ice-9 rdelim))
  60
  61           (define marionette
  62             (make-marionette (list #$vm)))
  63
  64           (mkdir #$output)
  65           (chdir #$output)
  66
  67           (test-begin "memcached")
  68
  69           ;; Wait for memcached to be up and running.
  70           (test-assert "service running"
  71             (marionette-eval
  72              '(begin
  73                 (use-modules (gnu services herd))
  74                 (match (start-service 'memcached)
  75                   (#f #f)
  76                   (('service response-parts ...)
  77                    (match (assq-ref response-parts 'running)
  78                      ((pid) (number? pid))))))
  79              marionette))
  80
  81           (let* ((ai (car (getaddrinfo "localhost"
  82                                        #$(number->string port))))
  83                  (s  (socket (addrinfo:fam ai)
  84                              (addrinfo:socktype ai)
  85                              (addrinfo:protocol ai)))
  86                  (key "testkey")
  87                  (value "guix"))
  88             (connect s (addrinfo:addr ai))
  89
  90             (test-equal "set"
  91               "STORED\r"
  92               (begin
  93                 (simple-format s "set ~A 0 60 ~A\r\n~A\r\n"
  94                                key
  95                                (string-length value)
  96                                value)
  97                 (read-line s)))
  98
  99             (test-equal "get"
 100               (simple-format #f "VALUE ~A 0 ~A\r~A\r"
 101                              key
 102                              (string-length value)
 103                              value)
 104               (begin
 105                 (simple-format s "get ~A\r\n" key)
 106                 (string-append
 107                  (read-line s)
 108                  (read-line s))))
 109
 110             (close-port s))
 111
 112           ;; There should be a log file in here.
 113           (test-assert "log file"
 114             (marionette-eval
 115              '(file-exists? "/var/log/memcached")
 116              marionette))
 117
 118           (test-end)
 119           (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
 120
 121   (gexp->derivation "memcached-test" test))
 122
 123 (define %test-memcached
 124   (system-test
 125    (name "memcached")
 126    (description "Connect to a running MEMCACHED server.")
 127    (value (run-memcached-test))))
 128
 129 (define %mongodb-os
 130   (operating-system
 131     (inherit
 132      (simple-operating-system
 133       (service dhcp-client-service-type)
 134       (service mongodb-service-type)))
 135     (packages (cons* mongodb
 136                      %base-packages))))
 137
 138 (define* (run-mongodb-test #:optional (port 27017))
 139   "Run tests in %MONGODB-OS, forwarding PORT."
 140   (define os
 141     (marionette-operating-system
 142      %mongodb-os
 143      #:imported-modules '((gnu services herd)
 144                           (guix combinators))))
 145
 146   (define vm
 147     (virtual-machine
 148      (operating-system os)
 149      (memory-size 1024)
 150      (disk-image-size (* 1024 (expt 2 20)))
 151      (port-forwardings `((27017 . ,port)))))
 152
 153   (define test
 154     (with-imported-modules '((gnu build marionette))
 155       #~(begin
 156           (use-modules (srfi srfi-11) (srfi srfi-64)
 157                        (gnu build marionette)
 158                        (ice-9 popen)
 159                        (ice-9 rdelim))
 160
 161           (define marionette
 162             (make-marionette (list #$vm)))
 163
 164           (mkdir #$output)
 165           (chdir #$output)
 166
 167           (test-begin "mongodb")
 168
 169           (test-assert "service running"
 170             (marionette-eval
 171              '(begin
 172                 (use-modules (gnu services herd))
 173                 (match (start-service 'mongodb)
 174                   (#f #f)
 175                   (('service response-parts ...)
 176                    (match (assq-ref response-parts 'running)
 177                      ((pid) (number? pid))))))
 178              marionette))
 179
 180           (test-eq "test insert"
 181             0
 182             (system* (string-append #$mongodb "/bin/mongo")
 183                      "test"
 184                      "--eval"
 185                      "db.testCollection.insert({data: 'test-data'})"))
 186
 187           (test-equal "test find"
 188             "test-data"
 189             (let* ((port (open-pipe*
 190                           OPEN_READ
 191                           (string-append #$mongodb "/bin/mongo")
 192                           "test"
 193                           "--quiet"
 194                           "--eval"
 195                           "db.testCollection.findOne().data"))
 196                    (output (read-line port))
 197                    (status (close-pipe port)))
 198               output))
 199
 200           (test-end)
 201           (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
 202
 203   (gexp->derivation "mongodb-test" test))
 204
 205 (define %test-mongodb
 206   (system-test
 207    (name "mongodb")
 208    (description "Connect to a running MONGODB server.")
 209    (value (run-mongodb-test))))
 210
 211 \f
 212 ;;;
 213 ;;; The PostgreSQL service.
 214 ;;;
 215
 216 (define %postgresql-os
 217   (simple-operating-system
 218    (service postgresql-service-type)))
 219
 220 (define (run-postgresql-test)
 221   "Run tests in %POSTGRESQL-OS."
 222   (define os
 223     (marionette-operating-system
 224      %postgresql-os
 225      #:imported-modules '((gnu services herd)
 226                           (guix combinators))))
 227
 228   (define vm
 229     (virtual-machine
 230      (operating-system os)
 231      (memory-size 512)))
 232
 233   (define test
 234     (with-imported-modules '((gnu build marionette))
 235       #~(begin
 236           (use-modules (srfi srfi-64)
 237                        (gnu build marionette))
 238
 239           (define marionette
 240             (make-marionette (list #$vm)))
 241
 242           (mkdir #$output)
 243           (chdir #$output)
 244
 245           (test-begin "postgresql")
 246
 247           (test-assert "service running"
 248             (marionette-eval
 249              '(begin
 250                 (use-modules (gnu services herd))
 251                 (start-service 'postgres))
 252              marionette))
 253
 254           (test-end)
 255           (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
 256
 257   (gexp->derivation "postgresql-test" test))
 258
 259 (define %test-postgresql
 260   (system-test
 261    (name "postgresql")
 262    (description "Start the PostgreSQL service.")
 263    (value (run-postgresql-test))))
 264
 265 \f
 266 ;;;
 267 ;;; The MySQL service.
 268 ;;;
 269
 270 (define %mysql-os
 271   (simple-operating-system
 272    (mysql-service)))
 273
 274 (define* (run-mysql-test)
 275   "Run tests in %MYSQL-OS."
 276   (define os
 277     (marionette-operating-system
 278      %mysql-os
 279      #:imported-modules '((gnu services herd)
 280                           (guix combinators))))
 281
 282   (define vm
 283     (virtual-machine
 284      (operating-system os)
 285      (memory-size 512)))
 286
 287   (define test
 288     (with-imported-modules '((gnu build marionette))
 289       #~(begin
 290           (use-modules (srfi srfi-11) (srfi srfi-64)
 291                        (gnu build marionette))
 292
 293           (define marionette
 294             (make-marionette (list #$vm)))
 295
 296           (mkdir #$output)
 297           (chdir #$output)
 298
 299           (test-begin "mysql")
 300
 301           (test-assert "service running"
 302             (marionette-eval
 303              '(begin
 304                 (use-modules (gnu services herd))
 305                 (match (start-service 'mysql)
 306                   (#f #f)
 307                   (('service response-parts ...)
 308                    (match (assq-ref response-parts 'running)
 309                      ((pid) (number? pid))))))
 310              marionette))
 311
 312           (test-end)
 313           (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
 314
 315   (gexp->derivation "mysql-test" test))
 316
 317 (define %test-mysql
 318   (system-test
 319    (name "mysql")
 320    (description "Start the MySQL service.")
 321    (value (run-mysql-test))))