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