Commit | Line | Data |
---|---|---|
119fdd0d CB |
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) | |
5266ff71 | 28 | #:use-module (gnu packages databases) |
119fdd0d CB |
29 | #:use-module (guix gexp) |
30 | #:use-module (guix store) | |
5266ff71 | 31 | #:export (%test-memcached |
02bc41c4 | 32 | %test-mongodb |
69f7cf2b | 33 | %test-postgresql |
02bc41c4 | 34 | %test-mysql)) |
119fdd0d CB |
35 | |
36 | (define %memcached-os | |
37 | (simple-operating-system | |
39d7fdce | 38 | (service dhcp-client-service-type) |
119fdd0d CB |
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. | |
6230e155 | 70 | (test-assert "service running" |
119fdd0d CB |
71 | (marionette-eval |
72 | '(begin | |
73 | (use-modules (gnu services herd)) | |
6230e155 CB |
74 | (match (start-service 'memcached) |
75 | (#f #f) | |
76 | (('service response-parts ...) | |
77 | (match (assq-ref response-parts 'running) | |
78 | ((pid) (number? pid)))))) | |
119fdd0d CB |
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)))) | |
5266ff71 CB |
128 | |
129 | (define %mongodb-os | |
130 | (operating-system | |
131 | (inherit | |
132 | (simple-operating-system | |
39d7fdce | 133 | (service dhcp-client-service-type) |
5266ff71 CB |
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)))) | |
02bc41c4 CB |
210 | |
211 | \f | |
69f7cf2b CB |
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 | |
02bc41c4 CB |
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)))) |