blob: 6d9e94b8e3e7cf8dfeee2f2a1fff3451376eb1ed (
plain)
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
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
|
(.module:
[library
[lux #*
[control
pipe
["." monad (#+ do)]
["." maybe]
["." try (#+ Try)]
[concurrency
["." async (#+ Async)]
["." frp]]
[parser
["<.>" json]]]
[data
["." number
["n" nat]]
["." text
["." encoding]]
[format
["." json (#+ JSON)]
["." context (#+ Context Property)]]
[collection
["." list ("#\." functor fold)]
["." dictionary]]]
[world
["." binary (#+ Binary)]]]]
["." // (#+ Body Response Server)
["#." response]
["#." query]
["#." cookie]])
(def: (merge inputs)
(-> (List Binary) Binary)
(let [[_ output] (try.trusted
(monad.fold try.monad
(function (_ input [offset output])
(let [amount (binary.size input)]
(\ try.functor map (|>> [(n.+ amount offset)])
(binary.copy amount 0 input offset output))))
[0 (|> inputs
(list\map binary.size)
(list\fold n.+ 0)
binary.empty)]
inputs))]
output))
(def: (read_text_body body)
(-> Body (Async (Try Text)))
(do async.monad
[blobs (frp.list body)]
(in (\ encoding.utf8 decode (merge blobs)))))
(def: failure (//response.bad_request ""))
(def: .public (json reader server)
(All [a] (-> (<json>.Reader a) (-> a Server) Server))
(function (_ (^@ request [identification protocol resource message]))
(do async.monad
[?raw (read_text_body (get@ #//.body message))]
(case (do try.monad
[raw ?raw
content (\ json.codec decode raw)]
(json.result content reader))
(#try.Success input)
(server input request)
(#try.Failure error)
(async.resolved ..failure)))))
(def: .public (text server)
(-> (-> Text Server) Server)
(function (_ (^@ request [identification protocol resource message]))
(do async.monad
[?raw (read_text_body (get@ #//.body message))]
(case ?raw
(#try.Success content)
(server content request)
(#try.Failure error)
(async.resolved ..failure)))))
(def: .public (query property server)
(All [a] (-> (Property a) (-> a Server) Server))
(function (_ [identification protocol resource message])
(let [full (get@ #//.uri resource)
[uri query] (|> full
(text.split_by "?")
(maybe.else [full ""]))]
(case (do try.monad
[query (//query.parameters query)
input (context.result query property)]
(in [[identification protocol (set@ #//.uri uri resource) message]
input]))
(#try.Success [request input])
(server input request)
(#try.Failure error)
(async.resolved ..failure)))))
(def: .public (form property server)
(All [a] (-> (Property a) (-> a Server) Server))
(function (_ (^@ request [identification protocol resource message]))
(do async.monad
[?body (read_text_body (get@ #//.body message))]
(case (do try.monad
[body ?body
form (//query.parameters body)]
(context.result form property))
(#try.Success input)
(server input request)
(#try.Failure error)
(async.resolved ..failure)))))
(def: .public (cookies property server)
(All [a] (-> (Property a) (-> a Server) Server))
(function (_ (^@ request [identification protocol resource message]))
(case (do try.monad
[cookies (|> (get@ #//.headers message)
(dictionary.value "Cookie")
(maybe.else "")
//cookie.get)]
(context.result cookies property))
(#try.Success input)
(server input request)
(#try.Failure error)
(async.resolved ..failure))))
|
