blob: 03c78fca834e77a16f26e48740731ab6e8fc1850 (
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
|
(.module:
[lux #*
[control
pipe
["." monad (#+ do)]
[concurrency
["." promise (#+ Promise)]
["." frp]]
[security
["." integrity (#+ Dirty)]]]
[data
["." maybe]
["." error (#+ Error)]
["." number]
["." text
format
["." encoding]]
[format
["." json (#+ JSON)]
["." context (#+ Context Property)]]
[collection
[list ("list/." Functor<List> Fold<List>)]
["." dictionary]]]
[world
["." binary (#+ Binary)]]]
["." // (#+ Body Response Server)
["//." response]
["//." query]
["//." cookie]])
(def: (merge inputs)
(-> (List Binary) Binary)
(let [[_ output] (error.assume
(monad.fold error.Monad<Error>
(function (_ input [offset output])
(let [amount (binary.size input)]
(:: error.Functor<Error> map (|>> [(n/+ amount offset)])
(binary.copy amount 0 input offset output))))
[0 (|> inputs
(list/map binary.size)
(list/fold n/+ 0)
binary.create)]
inputs))]
output))
(def: (read-text-body body)
(-> Body (Promise (Error Text)))
(do promise.Monad<Promise>
[blobs (frp.consume body)]
(wrap (encoding.from-utf8 (merge blobs)))))
(def: failure (//response.bad-request ""))
(def: #export (json server)
(-> (-> (Dirty JSON) Server) Server)
(function (_ request)
(let [[identification protocol resource message] (integrity.trust request)]
(do promise.Monad<Promise>
[?raw (read-text-body (get@ #//.body message))]
(case (do error.Monad<Error>
[raw ?raw]
(:: json.Codec<Text,JSON> decode raw))
(#error.Success content)
(server (integrity.taint content) request)
(#error.Failure error)
(promise.resolved ..failure))))))
(def: #export (text server)
(-> (-> (Dirty Text) Server) Server)
(function (_ request)
(let [[identification protocol resource message] (integrity.trust request)]
(do promise.Monad<Promise>
[?raw (read-text-body (get@ #//.body message))]
(case ?raw
(#error.Success content)
(server (integrity.taint content) request)
(#error.Failure error)
(promise.resolved ..failure))))))
(def: #export (query property server)
(All [a] (-> (Property a) (-> (Dirty a) Server) Server))
(function (_ request)
(let [[identification protocol resource message] (integrity.trust request)
full (get@ #//.uri resource)
[uri query] (|> full
(text.split-with "?")
(maybe.default [full ""]))]
(case (do error.Monad<Error>
[query (//query.parameters query)
input (context.run query property)]
(wrap [(integrity.taint [identification protocol (set@ #//.uri uri resource) message])
input]))
(#error.Success [request input])
(server (integrity.taint input) request)
(#error.Failure error)
(promise.resolved ..failure)))))
(def: #export (form property server)
(All [a] (-> (Property a) (-> (Dirty a) Server) Server))
(function (_ request)
(let [[identification protocol resource message] (integrity.trust request)]
(do promise.Monad<Promise>
[?body (read-text-body (get@ #//.body message))]
(case (do error.Monad<Error>
[body ?body
form (//query.parameters body)]
(context.run form property))
(#error.Success input)
(server (integrity.taint input) request)
(#error.Failure error)
(promise.resolved ..failure))))))
(def: #export (cookies property server)
(All [a] (-> (Property a) (-> (Dirty a) Server) Server))
(function (_ request)
(let [[identification protocol resource message] (integrity.trust request)]
(case (do error.Monad<Error>
[cookies (|> (get@ #//.headers message)
(dictionary.get "Cookie")
(maybe.default "")
//cookie.get)]
(context.run cookies property))
(#error.Success input)
(server (integrity.taint input) request)
(#error.Failure error)
(promise.resolved ..failure)))))
|
