-
Notifications
You must be signed in to change notification settings - Fork 7
/
response.rkt
74 lines (69 loc) · 2.15 KB
/
response.rkt
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
#lang racket/base
(provide make-response
response?)
(require racket/class
racket/contract
racket/function
json
(only-in argo
json-pretty-print)
(only-in (file "util.rkt")
bytes->string))
(define response%
(class object%
(super-new)
(init-field code
headers
body/raw)
(define/public (has-body?)
(not (bytes=? body/raw #"")))
(define/public (as-jsexpr)
(bytes->jsexpr body/raw))
(define/public (body-is-well-formed?)
(cond [(bytes=? #"" body/raw)
#f]
[else
(with-handlers ([exn:fail? (const #f)])
(begin0
#t
(send this as-jsexpr)))]))
(define/public (get-code)
code)
(define/public (get-headers)
headers)
(define/public (body-is-string?)
(string? (bytes->string body/raw)))
(define/public (body-bytes-length)
(bytes-length body/raw))
(define/public (get-body/raw)
body/raw)
(define/public (render port)
(for ([h (hash-keys headers)])
(displayln (format "~a: ~a" h (hash-ref headers h))
port))
(when (send this has-body?)
(define content
(cond [(send this body-is-well-formed?)
(json-pretty-print (send this as-jsexpr))]
[(send this body-is-string?)
(bytes->string body/raw)]
[else
(format "(~d bytes of binary or malformed UTF-8 content)"
(bytes-length body/raw))]))
(displayln content port)))))
(define (response? x)
(and (object? x)
(is-a? x response%)))
(define/contract (make-response code headers body)
((integer-in 100 599) (and/c immutable? (hash/c symbol? string?)) bytes? . -> . response?)
(define (lowercase k v)
(cons (string->symbol
(string-downcase
(symbol->string k)))
v))
(define headers/lowercased
(make-immutable-hash (hash-map headers lowercase)))
(new response%
[code code]
[headers headers/lowercased]
[body/raw body]))