Commit | Line | Data |
---|---|---|
a9eeb2f4 AW |
1 | ;;;; web-response.test --- HTTP responses -*- mode: scheme; coding: utf-8; -*- |
2 | ;;;; | |
0acc595b | 3 | ;;;; Copyright (C) 2010, 2011 Free Software Foundation, Inc. |
a9eeb2f4 AW |
4 | ;;;; |
5 | ;;;; This library is free software; you can redistribute it and/or | |
6 | ;;;; modify it under the terms of the GNU Lesser General Public | |
7 | ;;;; License as published by the Free Software Foundation; either | |
8 | ;;;; version 3 of the License, or (at your option) any later version. | |
9 | ;;;; | |
10 | ;;;; This library is distributed in the hope that it will be useful, | |
11 | ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
12 | ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU | |
13 | ;;;; Lesser General Public License for more details. | |
14 | ;;;; | |
15 | ;;;; You should have received a copy of the GNU Lesser General Public | |
16 | ;;;; License along with this library; if not, write to the Free Software | |
17 | ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA | |
18 | ||
19 | ||
20 | (define-module (test-suite web-response) | |
21 | #:use-module (web uri) | |
22 | #:use-module (web response) | |
3475fbb5 | 23 | #:use-module (rnrs bytevectors) |
a9eeb2f4 AW |
24 | #:use-module (srfi srfi-19) |
25 | #:use-module (test-suite lib)) | |
26 | ||
27 | ||
28 | ;; The newlines are equivalent to \n. From www.gnu.org. | |
29 | (define example-1 | |
30 | "HTTP/1.1 200 OK\r | |
31 | Date: Wed, 03 Nov 2010 22:27:07 GMT\r | |
32 | Server: Apache/2.0.55\r | |
33 | Accept-Ranges: bytes\r | |
34 | Cache-Control: max-age=543234\r | |
35 | Expires: Thu, 28 Oct 2010 15:33:13 GMT\r | |
36 | Vary: Accept-Encoding\r | |
37 | Content-Encoding: gzip\r | |
38 | Content-Length: 36\r | |
7aa54882 | 39 | Content-Type: text/html; charset=utf-8\r |
a9eeb2f4 AW |
40 | \r |
41 | abcdefghijklmnopqrstuvwxyz0123456789") | |
42 | ||
312e79f8 IP |
43 | (define example-2 |
44 | "HTTP/1.1 200 OK\r | |
45 | Transfer-Encoding: chunked\r | |
46 | Content-Type: text/plain | |
47 | \r | |
48 | 1c\r | |
49 | Lorem ipsum dolor sit amet, \r | |
50 | 1d\r | |
51 | consectetur adipisicing elit,\r | |
52 | 43\r | |
53 | sed do eiusmod tempor incididunt ut labore et dolore magna aliqua.\r | |
54 | 0\r\n") | |
55 | ||
a9eeb2f4 AW |
56 | (define (responses-equal? r1 body1 r2 body2) |
57 | (and (equal? (response-version r1) (response-version r2)) | |
58 | (equal? (response-code r1) (response-code r2)) | |
59 | (equal? (response-reason-phrase r1) (response-reason-phrase r2)) | |
60 | (equal? (response-headers r1) (response-headers r2)) | |
61 | (equal? body1 body2))) | |
62 | ||
63 | (with-test-prefix "example-1" | |
64 | (let ((r #f) (body #f)) | |
65 | (pass-if "read-response" | |
66 | (begin | |
67 | (set! r (read-response (open-input-string example-1))) | |
68 | (response? r))) | |
69 | ||
3475fbb5 | 70 | (pass-if "read-response-body" |
a9eeb2f4 | 71 | (begin |
3475fbb5 | 72 | (set! body (read-response-body r)) |
a9eeb2f4 AW |
73 | #t)) |
74 | ||
75 | (pass-if (equal? (response-version r) '(1 . 1))) | |
76 | ||
77 | (pass-if (equal? (response-code r) 200)) | |
78 | ||
79 | (pass-if (equal? (response-reason-phrase r) "OK")) | |
80 | ||
3475fbb5 AW |
81 | (pass-if (equal? body |
82 | (string->utf8 | |
83 | "abcdefghijklmnopqrstuvwxyz0123456789"))) | |
a9eeb2f4 AW |
84 | |
85 | (pass-if "checking all headers" | |
86 | (equal? | |
87 | (response-headers r) | |
88 | `((date . ,(string->date "Wed, 03 Nov 2010 22:27:07 +0000" | |
89 | "~a, ~d ~b ~Y ~H:~M:~S ~z")) | |
90 | (server . "Apache/2.0.55") | |
94f16a5b | 91 | (accept-ranges . (bytes)) |
a9eeb2f4 AW |
92 | (cache-control . ((max-age . 543234))) |
93 | (expires . ,(string->date "Thu, 28 Oct 2010 15:33:13 GMT +0000" | |
94 | "~a, ~d ~b ~Y ~H:~M:~S ~z")) | |
0bfba83a | 95 | (vary . (accept-encoding)) |
94f16a5b | 96 | (content-encoding . (gzip)) |
a9eeb2f4 | 97 | (content-length . 36) |
0acc595b | 98 | (content-type . (text/html (charset . "utf-8")))))) |
a9eeb2f4 AW |
99 | |
100 | (pass-if "write then read" | |
101 | (call-with-values | |
102 | (lambda () | |
103 | (with-input-from-string | |
104 | (with-output-to-string | |
105 | (lambda () | |
106 | (let ((r (write-response r (current-output-port)))) | |
3475fbb5 | 107 | (write-response-body r body)))) |
a9eeb2f4 AW |
108 | (lambda () |
109 | (let ((r (read-response (current-input-port)))) | |
3475fbb5 | 110 | (values r (read-response-body r)))))) |
a9eeb2f4 AW |
111 | (lambda (r* body*) |
112 | (responses-equal? r body r* body*)))) | |
113 | ||
114 | (pass-if "by accessor" | |
94f16a5b | 115 | (equal? (response-content-encoding r) '(gzip))))) |
312e79f8 IP |
116 | |
117 | (with-test-prefix "example-2" | |
118 | (let* ((r (read-response (open-input-string example-2))) | |
119 | (b (read-response-body r))) | |
120 | (pass-if (equal? '((chunked)) | |
121 | (response-transfer-encoding r))) | |
122 | (pass-if (equal? b | |
123 | (string->utf8 | |
124 | (string-append | |
125 | "Lorem ipsum dolor sit amet, consectetur adipisicing elit," | |
126 | " sed do eiusmod tempor incididunt ut labore et dolore magna aliqua.")))))) |