Commit | Line | Data |
---|---|---|
a9eeb2f4 AW |
1 | ;;;; web-response.test --- HTTP responses -*- mode: scheme; coding: utf-8; -*- |
2 | ;;;; | |
93c4fa21 | 3 | ;;;; Copyright (C) 2010, 2011, 2012, 2013 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) |
75d6c59f | 24 | #:use-module (rnrs io ports) |
a9eeb2f4 AW |
25 | #:use-module (srfi srfi-19) |
26 | #:use-module (test-suite lib)) | |
27 | ||
28 | ||
29 | ;; The newlines are equivalent to \n. From www.gnu.org. | |
30 | (define example-1 | |
31 | "HTTP/1.1 200 OK\r | |
32 | Date: Wed, 03 Nov 2010 22:27:07 GMT\r | |
33 | Server: Apache/2.0.55\r | |
34 | Accept-Ranges: bytes\r | |
35 | Cache-Control: max-age=543234\r | |
36 | Expires: Thu, 28 Oct 2010 15:33:13 GMT\r | |
37 | Vary: Accept-Encoding\r | |
38 | Content-Encoding: gzip\r | |
39 | Content-Length: 36\r | |
7aa54882 | 40 | Content-Type: text/html; charset=utf-8\r |
a9eeb2f4 AW |
41 | \r |
42 | abcdefghijklmnopqrstuvwxyz0123456789") | |
43 | ||
312e79f8 IP |
44 | (define example-2 |
45 | "HTTP/1.1 200 OK\r | |
46 | Transfer-Encoding: chunked\r | |
47 | Content-Type: text/plain | |
48 | \r | |
49 | 1c\r | |
50 | Lorem ipsum dolor sit amet, \r | |
51 | 1d\r | |
52 | consectetur adipisicing elit,\r | |
53 | 43\r | |
54 | sed do eiusmod tempor incididunt ut labore et dolore magna aliqua.\r | |
55 | 0\r\n") | |
56 | ||
a9eeb2f4 AW |
57 | (define (responses-equal? r1 body1 r2 body2) |
58 | (and (equal? (response-version r1) (response-version r2)) | |
59 | (equal? (response-code r1) (response-code r2)) | |
60 | (equal? (response-reason-phrase r1) (response-reason-phrase r2)) | |
61 | (equal? (response-headers r1) (response-headers r2)) | |
62 | (equal? body1 body2))) | |
63 | ||
64 | (with-test-prefix "example-1" | |
65 | (let ((r #f) (body #f)) | |
66 | (pass-if "read-response" | |
67 | (begin | |
68 | (set! r (read-response (open-input-string example-1))) | |
69 | (response? r))) | |
cb17c442 | 70 | |
3475fbb5 | 71 | (pass-if "read-response-body" |
a9eeb2f4 | 72 | (begin |
3475fbb5 | 73 | (set! body (read-response-body r)) |
a9eeb2f4 | 74 | #t)) |
cb17c442 LC |
75 | |
76 | (pass-if-equal '(1 . 1) (response-version r)) | |
77 | (pass-if-equal 200 (response-code r)) | |
78 | (pass-if-equal "OK" (response-reason-phrase r)) | |
79 | ||
80 | (pass-if-equal (string->utf8 "abcdefghijklmnopqrstuvwxyz0123456789") | |
81 | body) | |
82 | ||
83 | (pass-if-equal "checking all headers" | |
84 | `((date . ,(string->date "Wed, 03 Nov 2010 22:27:07 +0000" | |
85 | "~a, ~d ~b ~Y ~H:~M:~S ~z")) | |
86 | (server . "Apache/2.0.55") | |
87 | (accept-ranges . (bytes)) | |
88 | (cache-control . ((max-age . 543234))) | |
89 | (expires . ,(string->date "Thu, 28 Oct 2010 15:33:13 GMT +0000" | |
90 | "~a, ~d ~b ~Y ~H:~M:~S ~z")) | |
91 | (vary . (accept-encoding)) | |
92 | (content-encoding . (gzip)) | |
93 | (content-length . 36) | |
94 | (content-type . (text/html (charset . "utf-8")))) | |
95 | (response-headers r)) | |
96 | ||
a9eeb2f4 AW |
97 | (pass-if "write then read" |
98 | (call-with-values | |
99 | (lambda () | |
100 | (with-input-from-string | |
101 | (with-output-to-string | |
102 | (lambda () | |
103 | (let ((r (write-response r (current-output-port)))) | |
3475fbb5 | 104 | (write-response-body r body)))) |
a9eeb2f4 AW |
105 | (lambda () |
106 | (let ((r (read-response (current-input-port)))) | |
3475fbb5 | 107 | (values r (read-response-body r)))))) |
a9eeb2f4 AW |
108 | (lambda (r* body*) |
109 | (responses-equal? r body r* body*)))) | |
110 | ||
cb17c442 LC |
111 | (pass-if-equal "by accessor" |
112 | '(gzip) | |
75d6c59f LC |
113 | (response-content-encoding r)) |
114 | ||
115 | (pass-if-equal "response-body-port" | |
93c4fa21 | 116 | `("UTF-8" ,body) |
75d6c59f LC |
117 | (with-fluids ((%default-port-encoding #f)) |
118 | (let* ((r (read-response (open-input-string example-1))) | |
119 | (p (response-body-port r))) | |
120 | (list (port-encoding p) (get-bytevector-all p))))))) | |
312e79f8 IP |
121 | |
122 | (with-test-prefix "example-2" | |
cb17c442 LC |
123 | (let* ((r (read-response (open-input-string example-2))) |
124 | (b (read-response-body r))) | |
125 | (pass-if-equal '((chunked)) | |
126 | (response-transfer-encoding r)) | |
127 | (pass-if-equal | |
128 | (string->utf8 | |
129 | (string-append | |
130 | "Lorem ipsum dolor sit amet, consectetur adipisicing elit," | |
131 | " sed do eiusmod tempor incididunt ut labore et dolore magna aliqua.")) | |
75d6c59f LC |
132 | b) |
133 | (pass-if-equal "response-body-port" | |
134 | `("ISO-8859-1" ,(utf8->string b)) ; no `charset', hence ISO-8859-1 | |
135 | (with-fluids ((%default-port-encoding #f)) | |
136 | (let* ((r (read-response (open-input-string example-2))) | |
137 | (p (response-body-port r))) | |
138 | (list (port-encoding p) (get-string-all p))))))) |