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
|
#lang racket/base
(require racket/contract
racket/match
web-server/http/request-structs
"status-code.rkt")
(module+ test
(require rackunit))
(define TEXT/HTML-MIME-TYPE #"text/html; charset=utf-8")
(define APPLICATION/JSON-MIME-TYPE #"application/json; charset=utf-8")
(struct response (code message seconds mime headers output))
(define (response/full code message seconds mime headers body)
(response code
(infer-response-message code message)
seconds
mime
(list* (make-header #"Content-Length"
(string->bytes/utf-8
(number->string
(for/fold ([len 0])
([b (in-list body)])
(+ len (bytes-length b))))))
headers)
(lambda (op)
(for ([b (in-list body)])
(write-bytes b op)))))
(define (response/output output
#:code [code 200]
#:message [message #f]
#:seconds [seconds (current-seconds)]
#:mime-type [mime-type TEXT/HTML-MIME-TYPE]
#:headers [headers '()])
(response code
(infer-response-message code message)
seconds
mime-type
headers
output))
(module+ test
(let ([output (lambda (op) void)])
;; check message as bytes
(let [(resp (response/output output
#:code 123
#:message #"bites!"))]
(check-equal? (response-code resp) 123)
(check-equal? (response-message resp) #"bites!"))
;; check message as #f
(let [(resp (response/output output
#:code 200
#:message #f))]
(check-equal? (response-code resp) 200)
(check-equal? (response-message resp) #"OK"))
;; check message not supplied, but code supplied
(let [(resp (response/output output
#:code 200))]
(check-equal? (response-code resp) 200)
(check-equal? (response-message resp) #"OK"))
;; check code not supplied, message supplied
(let [(resp (response/output output
#:message #"bite this"))]
(check-equal? (response-code resp) 200)
(check-equal? (response-message resp) #"bite this"))
;; check neither message nor code supplied
(let [(resp (response/output output))]
(check-equal? (response-code resp) 200)
(check-equal? (response-message resp) #"OK"))
;; check non-standard status code
(let [(resp (response/output output #:code 123))]
(check-equal? (response-code resp) 123)
(check-equal? (response-message resp) #"OK"))))
(define/final-prop response-code/c
(integer-in 100 999))
(provide response-code/c)
(provide/contract
[struct response
([code response-code/c]
[message bytes?]
[seconds real?]
[mime (or/c #f bytes?)]
[headers (listof header?)]
[output (output-port? . -> . any)])]
[response/full (-> response-code/c (or/c #f bytes?) real? (or/c #f bytes?) (listof header?) (listof bytes?) response?)]
[response/output (->* ((-> output-port? any))
(#:code response-code/c
#:message bytes?
#:seconds real?
#:mime-type (or/c bytes? #f)
#:headers (listof header?))
response?)]
[TEXT/HTML-MIME-TYPE bytes?]
[APPLICATION/JSON-MIME-TYPE bytes?])
|
