blob: 26005abe2e140a0559a58b11d0b2876cef6ce48b (
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
129
130
131
|
(.require
[library
[lux (.except)
[control
pipe
["[0]" monad (.only do)]
["[0]" maybe]
["[0]" try (.only Try)]
[concurrency
["[0]" async (.only Async)]
["[0]" frp]]]
[data
["[0]" number
["n" nat]]
["[0]" text
["[0]" encoding]]
[format
["[0]" context (.only Context Property)]
["[0]" json (.only JSON)
["<[1]>" \\parser]]]
[collection
["[0]" list (.use "[1]#[0]" functor mix)]
["[0]" dictionary]]]
[meta
[macro
["^" pattern]]]
[world
["[0]" binary (.only Binary)]]]]
["[0]" // (.only Body Response Server)
["[1][0]" response]
["[1][0]" query]
["[1][0]" cookie]])
(def (merge inputs)
(-> (List Binary) Binary)
(let [[_ output] (try.trusted
(monad.mix try.monad
(function (_ input [offset output])
(let [amount (binary.size input)]
(at try.functor each (|>> [(n.+ amount offset)])
(binary.copy amount 0 input offset output))))
[0 (|> inputs
(list#each binary.size)
(list#mix n.+ 0)
binary.empty)]
inputs))]
output))
(def (read_text_body body)
(-> Body (Async (Try Text)))
(do async.monad
[blobs (frp.list body)]
(in (at encoding.utf8 decoded (merge blobs)))))
(def failure
(//response.bad_request ""))
(def .public (json reader server)
(All (_ a) (-> (<json>.Reader a) (-> a Server) Server))
(function (_ (^.let request [identification protocol resource message]))
(do async.monad
[?raw (read_text_body (the //.#body message))]
(when (do try.monad
[raw ?raw
content (at json.codec decoded 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 (_ (^.let request [identification protocol resource message]))
(do async.monad
[?raw (read_text_body (the //.#body message))]
(when ?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 (the //.#uri resource)
[uri query] (|> full
(text.split_by "?")
(maybe.else [full ""]))]
(when (do try.monad
[query (//query.parameters query)
input (context.result query property)]
(in [[identification protocol (has //.#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 (_ (^.let request [identification protocol resource message]))
(do async.monad
[?body (read_text_body (the //.#body message))]
(when (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 (_ (^.let request [identification protocol resource message]))
(when (do try.monad
[cookies (|> (the //.#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))))
|
