blob: e5f75717d63e605ed3224a09d50fa183653cdf6d (
about) (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
|
(define-module (rodion tests services)
#:use-module (gnu tests)
#:use-module (gnu system)
#:use-module (gnu system vm)
#:use-module (gnu services)
#:use-module (gnu services networking)
#:use-module (gnu services databases)
#:use-module (gnu packages databases)
#:use-module (guix monads)
#:use-module (guix store)
#:use-module (guix profiles)
#:use-module (rodion services miniflux)
#:use-module (guix gexp))
(define retry-on-error
#~(lambda* (f #:key times delay)
(let loop ((attempt 1))
(match (catch
#t
(lambda ()
(cons #t
(f)))
(lambda args
(cons #f
args)))
((#t . return-value)
return-value)
((#f . error-args)
(if (>= attempt times)
error-args
(begin
(sleep delay)
(loop (+ 1 attempt)))))))))
(define %miniflux-os
(simple-operating-system
(service dhcp-client-service-type)
(service postgresql-service-type
(postgresql-configuration
(postgresql postgresql-15)))
(service miniflux-service-type
(miniflux-configuration
(listen-addr "0.0.0.0:8080")))))
(define* (run-miniflux-test name test-os)
(define os
(marionette-operating-system
test-os
#:imported-modules '((gnu services herd)
(guix combinators))))
(define forwarded-port 8080)
(define vm
(virtual-machine
(operating-system os)
(memory-size 512)
(port-forwardings `((8080 . ,forwarded-port)))))
(define test
(with-imported-modules '((gnu build marionette))
#~(begin
(use-modules (srfi srfi-64)
(srfi srfi-11)
(gnu build marionette)
(web client)
(web uri)
(web response)
(ice-9 match))
(define marionette
(make-marionette (list #$vm)))
(test-runner-current (system-test-runner #$output))
(test-begin #$name)
(test-assert #$(string-append name " service running")
(marionette-eval
'(begin
(use-modules (gnu services herd))
(match (start-service '#$(string->symbol name))
(#f #f)
(('service response-parts ...)
(match (assq-ref response-parts 'running)
((#t) #t)
((pid) (number? pid))))))
marionette))
(test-assert "Miniflux TCP port ready, IPv4"
(wait-for-tcp-port #$forwarded-port marionette))
(test-assert "Miniflux login page is opened"
(begin
(wait-for-tcp-port #$forwarded-port marionette)
(#$retry-on-error
(lambda ()
(let-values (((response text)
(http-get
#$(format #f "http://localhost:~A/" forwarded-port)
#:decode-body? #t)))
(string-contains text "<title>Sign In - Miniflux</title>")))
#:times 10
#:delay 5)))
(test-end))))
(gexp->derivation "miniflux-test" test))
(define %test-miniflux
(system-test
(name "miniflux")
(description "Connect to a running Miniflux service.")
(value (run-miniflux-test name %miniflux-os))))
(define (system-test->manifest-entry test)
"Return a manifest entry for TEST, a system test."
(manifest-entry
(name (string-append "test." (system-test-name test)))
(version "0")
(item test)))
(manifest (map system-test->manifest-entry (list %test-miniflux)))
|
