/
processors.rkt
88 lines (80 loc) · 2.82 KB
/
processors.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
75
76
77
78
79
80
81
82
83
84
85
86
87
88
#lang typed/racket
#|
this module provides the basic middleware for rkt-http, as well as the
basic tools for writing them
|#
(provide no-op
request-map-ref
request-map-set
header-map-ref)
(require typed/net/url)
(require "private/shared.rkt"
"private/processors.rkt"
"parsers.rkt"
"private/typed-conversions.rkt")
(define-syntax (create-processor stx)
(syntax-case stx ()
[(_ [name thunk] ...)
#'(begin
(provide default-processors name ...)
(define name thunk) ...
(: default-processors : (Listof Processor))
(define default-processors (list name ...)))]))
;; request only processor to lowercase all header field names
(define in:lowercase-headers
(make-processor/parameter
(lambda: ([a-req : req])
(define cur-headers (request-map-ref a-req 'header))
(if (not (hash? cur-headers)) ;; no headers given
a-req
(cond
[cur-headers
(define: new-headers : (HashTable Any Any)
(for/hash ([(k v) (in-hash cur-headers)])
(values (string->symbol (string-downcase (~a k))) v)))
(request-map-set a-req 'header new-headers)]
[else a-req])))
values))
;; processor to control redirecting
(define RETRY-LIMIT 10)
(define: in:redirect : Processor
(make-processor/parameter
(lambda: ([client : (req -> resp)])
(lambda: ([a-req : req])
(let: loop : resp ([count : Natural 0] [a-req : req a-req])
(define a-resp (client a-req))
(if (or (not (= 301 (resp-code a-resp))) (= count RETRY-LIMIT))
a-resp
(loop (add1 count)
(struct-copy req a-req
[uri (string->url (~a (header-map-ref a-resp 'location)))]))))))))
;; request only processor to handle setting the content-type header
(define in:content-type
(make-processor/parameter
(lambda: ([a-req : req])
(define ctype (request-map-ref a-req 'content-type))
(cond
[ctype
(define parsed-ctype
(if (string? ctype)
ctype
(string-append "application/" (~a ctype))))
(request-map-set a-req 'content-type parsed-ctype)]
[else a-req]))
values))
;; processor to convert xexprs and that ilk to strings given the content type
(define in:body-convert
(make-processor/parameter
(compose json-request-body-converter xml-request-body-converter)
(compose json-resp-body-converter xml-resp-body-converter)))
;; a no-op processor
(: no-op : BasicProcessor)
(define no-op (make-processor values))
(create-processor
[lowercase-headers in:lowercase-headers]
[redirect in:redirect]
;; header processor
[content-type in:content-type]
;; final processing
[body-convert in:body-convert]
[retry (make-processor/parameter values)])