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