blob: ed1b120eaceeb8111c8112c3adc7a20ea80909b8 (
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
|
;;; guix-web - Web interface for GNU Guix
;;; Copyright © 2014 David Thompson <davet@gnu.org>
;;;
;;; This program is free software: you can redistribute it and/or
;;; modify it under the terms of the GNU Affero General Public License
;;; as published by the Free Software Foundation, either version 3 of
;;; the License, or (at your option) any later version.
;;;
;;; This program is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;;; Affero General Public License for more details.
;;;
;;; You should have received a copy of the GNU Affero General Public
;;; License along with this program. If not, see
;;; <http://www.gnu.org/licenses/>.
(define-module (tests guix-web render)
#:use-module (ice-9 match)
#:use-module (srfi srfi-64)
#:use-module (web response)
#:use-module (web uri)
#:use-module (json)
#:use-module (guix-web render))
(define render-to-string
(match-lambda
((headers render-proc)
(list headers (call-with-output-string render-proc)))))
(test-begin "render")
(test-equal "render-html"
'(((content-type . (text/html)))
"<!DOCTYPE html><html><head><title>guix-web</title></head></html>")
(render-to-string
(render-html '(html (head (title "guix-web"))))))
(test-equal "render-json"
'(((content-type . (application/json)))
"{\"foo\" : [1, 2, 3]}")
(render-to-string
(render-json (json (object ("foo" (1 2 3)))))))
(test-equal "not-found"
(list (build-response #:code 404)
"Resource not found: http://localhost/foo")
(not-found (string->uri "http://localhost/foo")))
(test-equal "unprocessable-entity"
(list (build-response #:code 422) "")
(unprocessable-entity))
(test-equal "created"
(list (build-response #:code 201) "")
(created))
(test-equal "redirect"
(list (build-response
#:code 301
#:headers `((content-type . (text/html))
(location . ,(string->uri "http://localhost/foo/bar"))))
"Redirect to http://localhost/foo/bar")
(redirect '("foo" "bar")))
(test-end)
(exit (= (test-runner-fail-count (test-runner-current)) 0))
|
