blob: 74f81eaf9cd5ad47e6a1bc0cc93fdb709c8381b6 (
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
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
|
(use-modules (srfi srfi-71)
(rnrs bytevectors)
(ice-9 binary-ports)
(ice-9 textual-ports)
(tests)
(fibers)
(fibers channels)
(unit-test)
(web uri)
(web client)
(web request)
(web response)
(knots web-server)
(knots non-blocking))
(run-fibers-for-tests
(lambda ()
(let* ((web-server
(run-knots-web-server
(lambda (request)
(values '((content-type . (text/plain)))
"Hello, World!"))
#:port 0)) ;; Bind to any port
(port
(web-server-port web-server))
(uri
(build-uri 'http #:host "127.0.0.1" #:port port)))
(assert-equal
200
(response-code
(http-get
uri
#:port (non-blocking-open-socket-for-uri uri)))))))
(run-fibers-for-tests
(lambda ()
(let* ((web-server
(run-knots-web-server
(lambda (request)
(values '((content-type . (text/plain))
(content-length . 3))
(lambda (port)
(display "foo" port))))
#:port 0)) ;; Bind to any port
(port
(web-server-port web-server))
(uri
(build-uri 'http #:host "127.0.0.1" #:port port)))
(let ((response
body
(http-get
uri
#:port (non-blocking-open-socket-for-uri uri))))
(assert-equal
"foo"
body)))))
(run-fibers-for-tests
(lambda ()
(let* ((web-server
(run-knots-web-server
(lambda (request)
(values '((content-type . (text/plain
(charset . "utf-8"))))
(lambda (port)
(display "☺" port))))
#:port 0)) ;; Bind to any port
(port
(web-server-port web-server))
(uri
(build-uri 'http #:host "127.0.0.1" #:port port)))
(let ((response
body
(http-get
uri
#:port (non-blocking-open-socket-for-uri uri))))
(assert-equal
"☺"
body)))))
(run-fibers-for-tests
(lambda ()
(let* ((web-server
(run-knots-web-server
(lambda (request)
(values '((content-type . (text/plain
(charset . "utf-8")))
(content-length . 3))
(lambda (port)
(display "☺" port))))
#:port 0)) ;; Bind to any port
(port
(web-server-port web-server))
(uri
(build-uri 'http #:host "127.0.0.1" #:port port)))
(let ((response
body
(http-get
uri
;; TODO Remove once using Guile 3.0.10
#:streaming? #t
#:port (non-blocking-open-socket-for-uri uri))))
(assert-equal
"☺"
(utf8->string
(get-bytevector-n body 3)))))))
;; Test hanlding of exceptions when writing the response to a client
(run-fibers-for-tests
(lambda ()
(let* ((exception-handled-sucecssfully-channel
(make-channel))
(port-closed-channel (make-channel))
(web-server
(run-knots-web-server
(lambda (request)
;; TODO Not sure why buffering makes a difference here
(setvbuf (request-port request) 'none)
(get-message port-closed-channel)
(values '((content-type . (text/plain)))
"Hello, World!"))
#:write-response-exception-handler
(lambda (exn request)
(spawn-fiber
(lambda ()
(put-message exception-handled-sucecssfully-channel
#t)))
#f)
#:port 0)) ;; Bind to any port
(port
(web-server-port web-server))
(uri
(build-uri 'http #:host "127.0.0.1" #:port port)))
(let ((request-port (non-blocking-open-socket-for-uri uri)))
(write-request
(build-request uri)
request-port)
(close-port request-port))
(put-message port-closed-channel #t)
(assert-equal (get-message exception-handled-sucecssfully-channel)
#t))))
(display "web-server test finished successfully\n")
|