Adding preamble to make-xexpr-response

This commit is contained in:
Jay McCarthy 2010-10-19 11:27:50 -07:00
parent 920800531c
commit afd3a90607
3 changed files with 63 additions and 5 deletions

View File

@ -0,0 +1,56 @@
#lang racket
(require tests/eli-tester
web-server/private/timer
web-server/private/connection-manager
web-server/http/response
web-server/http
"../util.rkt")
(define (write-response r [redact? #t])
(define-values (i-port o-port) (make-pipe))
(define conn
(connection 0 (start-timer +inf.0 void)
i-port o-port (current-custodian) #t))
(output-response conn r)
(close-output-port o-port)
(define bs (port->bytes i-port))
(if redact? (redact bs) bs))
(test
(write-response (make-xexpr-response '(a ([href "#"]) "link")))
=>
#"HTTP/1.1 200 Okay\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: Racket\r\nContent-Type: text/html; charset=utf-8\r\nConnection: close\r\nContent-Length: 20\r\n\r\n<a href=\"#\">link</a>"
(write-response (make-xexpr-response '(a ([href "#"]) "link")
#:code 404))
=>
#"HTTP/1.1 404 Okay\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: Racket\r\nContent-Type: text/html; charset=utf-8\r\nConnection: close\r\nContent-Length: 20\r\n\r\n<a href=\"#\">link</a>"
(write-response (make-xexpr-response '(a ([href "#"]) "link")
#:message #"Bad request"))
=>
#"HTTP/1.1 200 Bad request\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: Racket\r\nContent-Type: text/html; charset=utf-8\r\nConnection: close\r\nContent-Length: 20\r\n\r\n<a href=\"#\">link</a>"
(regexp-replace
#"Date: [a-zA-Z0-9:, ]+ GMT\r\n"
(write-response (make-xexpr-response '(a ([href "#"]) "link")
#:seconds 0)
#f)
#"Date: REDACTED GMT\r\n")
=>
#"HTTP/1.1 200 Okay\r\nDate: REDACTED GMT\r\nLast-Modified: Thu, 01 Jan 1970 00:00:00 GMT\r\nServer: Racket\r\nContent-Type: text/html; charset=utf-8\r\nConnection: close\r\nContent-Length: 20\r\n\r\n<a href=\"#\">link</a>"
(write-response (make-xexpr-response '(a ([href "#"]) "link")
#:mime-type #"application/xml"))
=>
#"HTTP/1.1 200 Okay\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: Racket\r\nContent-Type: application/xml\r\nConnection: close\r\nContent-Length: 20\r\n\r\n<a href=\"#\">link</a>"
(write-response (make-xexpr-response '(a ([href "#"]) "link")
#:headers (list (header #"head" #"value"))))
=>
#"HTTP/1.1 200 Okay\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: Racket\r\nContent-Type: text/html; charset=utf-8\r\nConnection: close\r\nContent-Length: 20\r\nhead: value\r\n\r\n<a href=\"#\">link</a>"
(write-response (make-xexpr-response '(a ([href "#"]) "link")
#:preamble #"<<!something XMLy>>"))
=>
#"HTTP/1.1 200 Okay\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: Racket\r\nContent-Type: text/html; charset=utf-8\r\nConnection: close\r\nContent-Length: 39\r\n\r\n<<!something XMLy>><a href=\"#\">link</a>")

View File

@ -77,10 +77,11 @@
#:message [message #"Okay"]
#:seconds [seconds (current-seconds)]
#:mime-type [mime-type TEXT/HTML-MIME-TYPE]
#:headers [hdrs empty])
#:headers [hdrs empty]
#:preamble [preamble #""])
(make-response/full
code message seconds mime-type hdrs
(list (string->bytes/utf-8 (xexpr->string xexpr)))))
(list preamble (string->bytes/utf-8 (xexpr->string xexpr)))))
(provide/contract
[struct response/basic
@ -106,7 +107,7 @@
[response/c contract?]
[make-xexpr-response
((pretty-xexpr/c)
(#:code number? #:message bytes? #:seconds number? #:mime-type bytes? #:headers (listof header?))
(#:code number? #:message bytes? #:seconds number? #:mime-type bytes? #:headers (listof header?) #:preamble bytes?)
. ->* . response/full?)]
[normalize-response ((response/c) (boolean?) . ->* . (or/c response/full? response/incremental?))]
[TEXT/HTML-MIME-TYPE bytes?])

View File

@ -237,13 +237,14 @@ Here is an example typical of what you will find in many applications:
[#:message message bytes? #"Okay"]
[#:seconds seconds number? (current-seconds)]
[#:mime-type mime-type bytes? TEXT/HTML-MIME-TYPE]
[#:headers headers (listof header?) empty])
[#:headers headers (listof header?) empty]
[#:preamble preamble bytes? #""])
response/full?]{
Equivalent to
@racketblock[
(make-response/full
code message seconds mime-type headers
(list (string->bytes/utf-8 (xexpr->string xexpr))))
(list preamble (string->bytes/utf-8 (xexpr->string xexpr))))
]}
@defproc[(normalize-response [response response/c] [close? boolean? #f])