source: project/release/4/http-client/trunk/tests/run.scm @ 33904

Last change on this file since 33904 was 33904, checked in by sjamaan, 3 years ago

http-client: Add tests for redirects, fix 303 GET switching

File size: 12.9 KB
Line 
1(use extras)
2
3(include "testlib.scm")
4
5(test-begin "http-client")
6
7;; TODO: This is messy and hard to read
8(test-group "simple GET requests"
9  (test-group "an empty response"
10    (let* ((log (with-server-response
11                 (lambda ()
12                   (test "Response is the empty string"
13                         ""
14                         (with-input-from-request
15                          "http://example.com/some/path#more"
16                          #f read-string)))
17                 "HTTP/1.0 200 OK\r\nContent-Length: 0\r\n"))
18           (req (log-request log)))
19
20      (test "Request method" 'GET (request-method req))
21      (test "URI is path without fragment"
22            "/some/path" (uri->string (request-uri req)))
23      (test "host header gets set"
24            '("example.com" . #f)
25            (header-value 'host (request-headers req)))
26      (test "HTTP request is version 1.1"
27            '(1 1)
28            (list (request-major req) (request-minor req)))))
29
30  (test-group "a response with trailing garbage"
31    (with-server-response
32     (lambda ()
33       (test "Response excludes garbage data"
34             "foo"
35             (with-input-from-request
36              "http://example.com" #f read-string)))
37     (conc "HTTP/1.0 200 OK\r\nContent-Length: 3\r\n"
38           "\r\nfoobar")))
39
40  ;; This is (mostly) an intarweb test...
41  (test-group "a short chunked response with trailing garbage"
42    (with-server-response
43     (lambda ()
44       (test "Response is the chunked data"
45             "one, two three"
46             (with-input-from-request "http://example.com"
47                                      #f read-string)))
48     (conc "HTTP/1.1 200 OK\r\nTransfer-Encoding: chunked\r\n"
49           "\r\n5\r\none, \r\n2\r\ntw\r\n7\r\no three\r\n0\r\n"
50           "IGNORED TRAILING GARBAGE")))
51
52  (test-group "400 series"
53    (with-server-response
54     (lambda ()
55       (test-error* "404 results in client error"
56                    (exn http client-error)
57                    (with-input-from-request "http://example.com" #f #f)))
58     (conc "HTTP/1.0 404 Not Found\r\n"))))
59
60
61(test-group "request body encoding"
62  (test-group "simple string body"
63    (let* ((log (with-server-response
64                 (lambda ()
65                   (test "Response is read back"
66                         "Your response, sir"
67                         (with-input-from-request
68                          "http://example.com" "testing" read-string)))
69                 "HTTP/1.0 200 OK\r\n\r\nYour response, sir"))
70           (req (log-request log)))
71
72      (test "Request method" 'POST (request-method req))
73      (test "Content type is not set"
74            #f
75            (header-value 'content-type (request-headers req)))
76      (test "Content-length is string length"
77            7 (header-value 'content-length (request-headers req)))
78      (test "String was sent as body" "testing" (log-body log))))
79
80  (test-group "string body with custom request method"
81    (let* ((log (with-server-response
82                 (lambda ()
83                   (let* ((uri (uri-reference "http://example.com"))
84                          (req (make-request uri: uri method: 'LALA)))
85                     (test "Response is read back"
86                           "Your response, sir"
87                           (with-input-from-request
88                            req "testing" read-string))))
89                 "HTTP/1.0 200 OK\r\n\r\nYour response, sir"))
90           (req (log-request log)))
91
92      (test "Request method is custom" 'LALA (request-method req))
93      (test "Content type is not set"
94            #f
95            (header-value 'content-type (request-headers req)))
96      (test "Content-length is string length"
97            7 (header-value 'content-length (request-headers req)))
98      (test "String was sent as body" "testing" (log-body log))))
99
100  (test-group "alist form data body"
101    (let* ((log (with-server-response
102                 (lambda ()
103                   (with-input-from-request
104                    "http://example.com"
105                    '((lala . "testing")
106                      (another . "data")
107                      ("more" . stuff))
108                    read-string))
109                 "HTTP/1.0 200 OK\r\n\r\n"))
110           (req (log-request log)))
111
112      (test "Request method" 'POST (request-method req))
113      (test "Content type is form encoding"
114            'application/x-www-form-urlencoded
115            (header-value 'content-type (request-headers req)))
116      (test "Content-length was set correctly"
117            36 (header-value 'content-length (request-headers req)))
118      (test "Body was sent correctly"
119            "lala=testing&another=data&more=stuff" (log-body log))))
120
121  (test-group "alist form data body with file port"
122    (let* ((string-port (open-input-string "the file's contents"))
123           (log (with-server-response
124                 (lambda ()
125                   (with-input-from-request
126                    "http://example.com"
127                    `((lala . "testing")
128                      (the-file file: ,string-port
129                                filename: "str")
130                      ("more" . stuff))
131                    read-string))
132                 "HTTP/1.0 200 OK\r\n\r\n"))
133           (req (log-request log))
134           (h (request-headers req))
135           (boundary (header-param 'boundary 'content-type h))
136           (expected-data
137            (conc
138             "--" boundary "\r\n"
139             "Content-Disposition: form-data; name=\"lala\"\r\n\r\n"
140             "testing\r\n"
141             "--" boundary "\r\n"
142             "Content-Disposition: form-data; name=\"the-file\"; "
143             "filename=\"str\"\r\n"
144             "Content-Type: application/octet-stream\r\n\r\n"
145             "the file's contents\r\n"
146             "--" boundary "\r\n"
147             "Content-Disposition: form-data; name=\"more\"\r\n\r\n"
148             "stuff\r\n"
149             "--" boundary "--\r\n")))
150
151      (test "Request method" 'POST (request-method req))
152      (test "Content type is multipart"
153            'multipart/form-data
154            (header-value 'content-type h))
155      (test "Content-length was not set"
156            #f (header-value 'content-length h))
157      (test "Body contains the file and other data, delimited by the boundary"
158            expected-data (log-body log)))))
159
160(test-group "Redirects"
161  (test-group "single permanent GET redirect"
162    (let* ((logs (with-server-responses
163                  (lambda ()
164                    (test "Final response matches final request"
165                          "Got here"
166                          (with-input-from-request
167                           "http://example.com/some/path#more"
168                           #f read-string)))
169                  (conc "HTTP/1.0 301 Moved Permanently\r\n"
170                        "Location: http://example.org/different/path\r\n"
171                        "Content-Length: 8\r\n\r\nIgnored!")
172                  (conc "HTTP/1.0 200 OK\r\nContent-Length: 8\r\n\r\n"
173                        "Got here")))
174           (req1 (log-request (car logs)))
175           (req2 (log-request (cadr logs))))
176
177      (test "Redirected URI is new path"
178            "/different/path" (uri->string (request-uri req2)))
179      (test "host header gets set on second request"
180            '("example.org" . #f)
181            (header-value 'host (request-headers req2)))
182      (test "HTTP request is version 1.1 (even though response was 1.0)"
183            '(1 1)
184            (list (request-major req2) (request-minor req2)))))
185
186  (test-group "single permanent POST redirect"
187    (let* ((logs (with-server-responses
188                  (lambda ()
189                    (test "Final response matches final request"
190                          "Got here"
191                          (with-input-from-request
192                           "http://example.com/some/path#more"
193                           '((foo . "bar")) read-string)))
194                  (conc "HTTP/1.0 301 Moved Permanently\r\n"
195                        "Location: http://example.org/different/path\r\n"
196                        "Content-Length: 8\r\n\r\nIgnored!")
197                  (conc "HTTP/1.0 200 OK\r\nContent-Length: 8\r\n\r\n"
198                        "Got here")))
199           (req1 (log-request (car logs)))
200           (req2 (log-request (cadr logs))))
201
202      (test "Redirected URI is new path"
203            "/different/path" (uri->string (request-uri req2)))
204      (test "HTTP method is still POST" 'POST (request-method req2))
205      (test "Correct content-length on both requests"
206            '(7 7)
207            (list (header-value 'content-length (request-headers req1))
208                  (header-value 'content-length (request-headers req2))))
209      (test "Body got sent to target" "foo=bar" (log-body (cadr logs)))))
210
211  (test-group "single \"see other\" POST redirect"
212    (let* ((logs (with-server-responses
213                  (lambda ()
214                    (test "Final response matches final request"
215                          "Got here"
216                          (with-input-from-request
217                           "http://example.com/some/path#more"
218                           '((foo . "bar")) read-string)))
219                  (conc "HTTP/1.0 303 See Other\r\n"
220                        "Location: http://example.org/different/path\r\n"
221                        "Content-Length: 8\r\n\r\nIgnored!")
222                  (conc "HTTP/1.0 200 OK\r\nContent-Length: 8\r\n\r\n"
223                        "Got here")))
224           (req1 (log-request (car logs)))
225           (req2 (log-request (cadr logs))))
226
227      (test "Redirected URI is new path"
228            "/different/path" (uri->string (request-uri req2)))
229      (test "HTTP method switched to GET" 'GET (request-method req2))
230      (test "Zero content-length on target"
231            0
232            (header-value 'content-length (request-headers req2)))
233      (test "No body got sent to target" "" (log-body (cadr logs)))))
234
235  (test-group "Multiple redirects, just below maximum"
236    (parameterize ((max-redirect-depth 3))
237      (let* ((logs (with-server-responses
238                    (lambda ()
239                      (test "Final response matches final request"
240                            "Got here"
241                            (with-input-from-request
242                             "http://example.com/some/path#more"
243                             #f read-string)))
244                    (conc "HTTP/1.0 301 Moved Permanently\r\n"
245                          "Location: http://example.org/different/path\r\n"
246                          "Content-Length: 8\r\n\r\nIgnored!")
247                    (conc "HTTP/1.0 301 Moved Permanently\r\n"
248                          "Location: http://example.org/new/path\r\n"
249                          "Content-Length: 8\r\n\r\nIgnored!")
250                    (conc "HTTP/1.0 301 Moved Permanently\r\n"
251                          "Location: http://example.net/newer/path\r\n"
252                          "Content-Length: 8\r\n\r\nIgnored!")
253                    (conc "HTTP/1.0 200 OK\r\nContent-Length: 8\r\n\r\n"
254                          "Got here")))
255             (req (log-request (last logs))))
256
257        (test "Redirected URI is new path"
258              "/newer/path" (uri->string (request-uri req)))
259        (test "host header gets set on last request"
260              '("example.net" . #f)
261              (header-value 'host (request-headers req)))
262        (test "HTTP request is still version 1.1"
263              '(1 1) (list (request-major req) (request-minor req))))))
264
265  (test-group "Exceeding maximum redirects"
266    (parameterize ((max-redirect-depth 2))
267      (test-error* "results in a client redirect error"
268                   (exn http redirect-depth-exceeded)
269                   (with-server-responses
270                    (lambda ()
271                      (with-input-from-request "http://example.com"
272                                               #f read-string))
273                    (conc "HTTP/1.0 301 Moved Permanently\r\n"
274                          "Location: http://example.org/different/path\r\n"
275                          "Content-Length: 8\r\n\r\nIgnored!")
276                    (conc "HTTP/1.0 301 Moved Permanently\r\n"
277                          "Location: http://example.org/new/path\r\n"
278                          "Content-Length: 8\r\n\r\nIgnored!")
279                    (conc "HTTP/1.0 301 Moved Permanently\r\n"
280                          "Location: http://example.net/newer/path\r\n"
281                          "Content-Length: 8\r\n\r\nIgnored!")
282                    (conc "HTTP/1.0 200 OK\r\nContent-Length: 19\r\n\r\n"
283                          "Should not get here"))))))
284
285(test-group "error handling"
286  (with-server-responses
287   (lambda ()
288     (test-error* "Invalid uri"
289                  (exn http bad-uri)
290                  (with-input-from-request "%" #f read-string))))
291  ;; TODO: Why shouldn't empty POST be allowed?
292  (with-server-responses
293   (lambda ()
294     (test-error* "Invalid form data"
295                  (exn http form-data-error)
296                  (with-input-from-request
297                   "http://example.com" '() read-string)))))
298
299
300(test-end "http-client")
301
302(test-exit)
Note: See TracBrowser for help on using the repository browser.