You've already forked guix-tribes
70 lines
3.2 KiB
Scheme
70 lines
3.2 KiB
Scheme
(define-module (tests tribes-system-node)
|
|
#:use-module (gnu services)
|
|
#:use-module (guix gexp)
|
|
#:use-module (srfi srfi-1)
|
|
#:use-module (srfi srfi-13)
|
|
#:use-module (srfi srfi-64)
|
|
#:use-module (tribes services tribes)
|
|
#:use-module (tribes services vinyl)
|
|
#:use-module (tribes system node)
|
|
#:export (run-tests))
|
|
|
|
(define node-module (resolve-module '(tribes system node)))
|
|
(define edge-cache-vcl-text (module-ref node-module 'edge-cache-vcl-text))
|
|
(define edge-cache-vcl (module-ref node-module 'edge-cache-vcl))
|
|
(define edge-services (module-ref node-module 'edge-services))
|
|
|
|
(define (contains? haystack needle)
|
|
(and (string-contains haystack needle) #t))
|
|
|
|
(define (run-tests)
|
|
(test-begin "tribes-system-node")
|
|
|
|
(let ((vcl (edge-cache-vcl-text (tribes-edge-configuration)
|
|
(tribes-configuration))))
|
|
(test-assert "edge cache backend uses short connect timeout"
|
|
(contains? vcl ".connect_timeout = 1s;"))
|
|
(test-assert "edge cache backend uses bounded first-byte timeout"
|
|
(contains? vcl ".first_byte_timeout = 5s;"))
|
|
(test-assert "edge cache retries only GET/HEAD 5xx backend responses"
|
|
(contains? vcl
|
|
"if ((bereq.method == \"GET\" || bereq.method == \"HEAD\") &&\n beresp.status >= 500 && beresp.status <= 599 &&\n bereq.retries < 5)"))
|
|
(test-assert "edge cache retries only GET/HEAD backend errors"
|
|
(contains? vcl
|
|
"sub vcl_backend_error {\n if ((bereq.method == \"GET\" || bereq.method == \"HEAD\") &&\n bereq.retries < 5)"))
|
|
(test-assert "edge cache does not cache exhausted 5xx responses"
|
|
(contains? vcl
|
|
"if (beresp.status >= 500 && beresp.status <= 599) {\n set beresp.uncacheable = true;\n set beresp.ttl = 0s;"))
|
|
(test-assert "edge cache keeps unsafe methods as pass-through"
|
|
(contains? vcl
|
|
"if (req.method != \"GET\" && req.method != \"HEAD\") {\n return (pass);"))
|
|
(let ((rendered (edge-cache-vcl (tribes-edge-configuration)
|
|
(tribes-configuration))))
|
|
(test-equal "edge cache renders expected VCL file name"
|
|
"tribes-edge-cache.vcl"
|
|
(plain-file-name rendered))
|
|
(test-equal "edge cache renders expected VCL file content"
|
|
vcl
|
|
(plain-file-content rendered))))
|
|
|
|
(let* ((config (tribes-node-configuration
|
|
(tribes (tribes-configuration
|
|
(host "example.invalid")))
|
|
(edge (tribes-edge-configuration
|
|
(certificate-email "ops@example.invalid")))))
|
|
(services (edge-services config))
|
|
(vinyl-service (find (lambda (service)
|
|
(eq? (service-kind service) vinyl-service-type))
|
|
services))
|
|
(edge-vinyl (find (lambda (config)
|
|
(string=? (vinyl-configuration-name config)
|
|
"tribes-edge"))
|
|
(service-value vinyl-service))))
|
|
(test-equal "edge vinyl permits five graceful retries"
|
|
'((max_retries . 5))
|
|
(vinyl-configuration-parameters edge-vinyl)))
|
|
|
|
(test-end "tribes-system-node"))
|
|
|
|
(run-tests)
|