-
Notifications
You must be signed in to change notification settings - Fork 26
/
Snap.Internal.Http.Parser.hs.html
292 lines (291 loc) · 28.2 KB
/
Snap.Internal.Http.Parser.hs.html
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
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
<html><style type="text/css">
span.lineno { color: white; background: #aaaaaa; border-right: solid white 12px }
span.nottickedoff { background: yellow}
span.istickedoff { background: white }
span.tickonlyfalse { margin: -1px; border: 1px solid #f20913; background: #f20913 }
span.tickonlytrue { margin: -1px; border: 1px solid #60de51; background: #60de51 }
span.funcount { font-size: small; color: orange; z-index: 2; position: absolute; right: 20 }
span.decl { font-weight: bold }
span.spaces { background: white }
</style>
<pre>
<span class="lineno"> 1 </span>{-# LANGUAGE BangPatterns #-}
<span class="lineno"> 2 </span>{-# LANGUAGE DeriveDataTypeable #-}
<span class="lineno"> 3 </span>{-# LANGUAGE OverloadedStrings #-}
<span class="lineno"> 4 </span>{-# LANGUAGE PackageImports #-}
<span class="lineno"> 5 </span>{-# LANGUAGE RankNTypes #-}
<span class="lineno"> 6 </span>{-# LANGUAGE ViewPatterns #-}
<span class="lineno"> 7 </span>
<span class="lineno"> 8 </span>module Snap.Internal.Http.Parser
<span class="lineno"> 9 </span> ( IRequest(..)
<span class="lineno"> 10 </span> , HttpParseException
<span class="lineno"> 11 </span> , parseRequest
<span class="lineno"> 12 </span> , readChunkedTransferEncoding
<span class="lineno"> 13 </span> , iterParser
<span class="lineno"> 14 </span> , parseCookie
<span class="lineno"> 15 </span> , parseUrlEncoded
<span class="lineno"> 16 </span> , strictize
<span class="lineno"> 17 </span> ) where
<span class="lineno"> 18 </span>
<span class="lineno"> 19 </span>
<span class="lineno"> 20 </span>------------------------------------------------------------------------------
<span class="lineno"> 21 </span>import Control.Arrow (second)
<span class="lineno"> 22 </span>import Control.Exception
<span class="lineno"> 23 </span>import Control.Monad (liftM)
<span class="lineno"> 24 </span>import Control.Monad.Trans
<span class="lineno"> 25 </span>import Data.Attoparsec hiding (many, Result(..))
<span class="lineno"> 26 </span>import Data.Attoparsec.Enumerator
<span class="lineno"> 27 </span>import Data.ByteString.Char8 (ByteString)
<span class="lineno"> 28 </span>import qualified Data.ByteString.Char8 as S
<span class="lineno"> 29 </span>import qualified Data.ByteString.Unsafe as S
<span class="lineno"> 30 </span>import Data.ByteString.Internal (w2c)
<span class="lineno"> 31 </span>import qualified Data.ByteString.Lazy.Char8 as L
<span class="lineno"> 32 </span>import qualified Data.ByteString.Nums.Careless.Hex as Cvt
<span class="lineno"> 33 </span>import Data.Char
<span class="lineno"> 34 </span>import Data.List (foldl')
<span class="lineno"> 35 </span>import Data.Int
<span class="lineno"> 36 </span>import Data.Map (Map)
<span class="lineno"> 37 </span>import qualified Data.Map as Map
<span class="lineno"> 38 </span>import Data.Maybe (catMaybes)
<span class="lineno"> 39 </span>import Data.Typeable
<span class="lineno"> 40 </span>import Prelude hiding (head, take, takeWhile)
<span class="lineno"> 41 </span>----------------------------------------------------------------------------
<span class="lineno"> 42 </span>import Snap.Internal.Http.Types
<span class="lineno"> 43 </span>import Snap.Internal.Debug
<span class="lineno"> 44 </span>import Snap.Internal.Iteratee.Debug
<span class="lineno"> 45 </span>import Snap.Internal.Parsing hiding (pHeaders)
<span class="lineno"> 46 </span>import Snap.Iteratee hiding (map, take)
<span class="lineno"> 47 </span>
<span class="lineno"> 48 </span>
<span class="lineno"> 49 </span>------------------------------------------------------------------------------
<span class="lineno"> 50 </span>-- | an internal version of the headers part of an HTTP request
<span class="lineno"> 51 </span>data <span class="nottickedoff">IRequest</span> = IRequest
<span class="lineno"> 52 </span> { iMethod :: Method
<span class="lineno"> 53 </span> , iRequestUri :: ByteString
<span class="lineno"> 54 </span> , iHttpVersion :: (Int,Int)
<span class="lineno"> 55 </span> , iRequestHeaders :: [(ByteString, ByteString)]
<span class="lineno"> 56 </span> }
<span class="lineno"> 57 </span>
<span class="lineno"> 58 </span>
<span class="lineno"> 59 </span>------------------------------------------------------------------------------
<span class="lineno"> 60 </span>instance Show IRequest where
<span class="lineno"> 61 </span> <span class="decl"><span class="istickedoff">show (IRequest m u v r) =</span>
<span class="lineno"> 62 </span><span class="spaces"> </span><span class="istickedoff">concat [ show m</span>
<span class="lineno"> 63 </span><span class="spaces"> </span><span class="istickedoff">, " "</span>
<span class="lineno"> 64 </span><span class="spaces"> </span><span class="istickedoff">, show u</span>
<span class="lineno"> 65 </span><span class="spaces"> </span><span class="istickedoff">, " "</span>
<span class="lineno"> 66 </span><span class="spaces"> </span><span class="istickedoff">, show v</span>
<span class="lineno"> 67 </span><span class="spaces"> </span><span class="istickedoff">, " "</span>
<span class="lineno"> 68 </span><span class="spaces"> </span><span class="istickedoff">, show r ]</span></span>
<span class="lineno"> 69 </span>
<span class="lineno"> 70 </span>
<span class="lineno"> 71 </span>------------------------------------------------------------------------------
<span class="lineno"> 72 </span>data HttpParseException = HttpParseException String deriving (<span class="decl"><span class="istickedoff">Typeable</span></span>, <span class="decl"><span class="istickedoff"><span class="decl"><span class="nottickedoff">Show</span></span></span></span>)
<span class="lineno"> 73 </span>instance Exception HttpParseException
<span class="lineno"> 74 </span>
<span class="lineno"> 75 </span>------------------------------------------------------------------------------
<span class="lineno"> 76 </span>parseRequest :: (Monad m) => Iteratee ByteString m (Maybe IRequest)
<span class="lineno"> 77 </span><span class="decl"><span class="istickedoff">parseRequest = do</span>
<span class="lineno"> 78 </span><span class="spaces"> </span><span class="istickedoff">eof <- isEOF</span>
<span class="lineno"> 79 </span><span class="spaces"> </span><span class="istickedoff">if eof</span>
<span class="lineno"> 80 </span><span class="spaces"> </span><span class="istickedoff">then return Nothing</span>
<span class="lineno"> 81 </span><span class="spaces"> </span><span class="istickedoff">else do</span>
<span class="lineno"> 82 </span><span class="spaces"> </span><span class="istickedoff">line <- pLine</span>
<span class="lineno"> 83 </span><span class="spaces"> </span><span class="istickedoff">if S.null line</span>
<span class="lineno"> 84 </span><span class="spaces"> </span><span class="istickedoff">then parseRequest</span>
<span class="lineno"> 85 </span><span class="spaces"> </span><span class="istickedoff">else do</span>
<span class="lineno"> 86 </span><span class="spaces"> </span><span class="istickedoff">let (!mStr,!s) = bSp line</span>
<span class="lineno"> 87 </span><span class="spaces"> </span><span class="istickedoff">let (!uri,!vStr) = bSp s</span>
<span class="lineno"> 88 </span><span class="spaces"></span><span class="istickedoff"></span>
<span class="lineno"> 89 </span><span class="spaces"> </span><span class="istickedoff">!method <- methodFromString mStr</span>
<span class="lineno"> 90 </span><span class="spaces"></span><span class="istickedoff"></span>
<span class="lineno"> 91 </span><span class="spaces"> </span><span class="istickedoff">let ver@(!_,!_) = pVer vStr</span>
<span class="lineno"> 92 </span><span class="spaces"></span><span class="istickedoff"></span>
<span class="lineno"> 93 </span><span class="spaces"> </span><span class="istickedoff">hdrs <- pHeaders</span>
<span class="lineno"> 94 </span><span class="spaces"> </span><span class="istickedoff">return $ Just $ IRequest method uri ver hdrs</span>
<span class="lineno"> 95 </span><span class="spaces"></span><span class="istickedoff"></span>
<span class="lineno"> 96 </span><span class="spaces"> </span><span class="istickedoff">where</span>
<span class="lineno"> 97 </span><span class="spaces"> </span><span class="istickedoff">pVer s = if <span class="tickonlytrue">S.isPrefixOf "HTTP/" s</span></span>
<span class="lineno"> 98 </span><span class="spaces"> </span><span class="istickedoff">then let (a,b) = bDot $ S.drop 5 s</span>
<span class="lineno"> 99 </span><span class="spaces"> </span><span class="istickedoff">in (read $ S.unpack a, read $ S.unpack b)</span>
<span class="lineno"> 100 </span><span class="spaces"> </span><span class="istickedoff">else <span class="nottickedoff">(1,0)</span></span>
<span class="lineno"> 101 </span><span class="spaces"></span><span class="istickedoff"></span>
<span class="lineno"> 102 </span><span class="spaces"> </span><span class="istickedoff">isSp = (== ' ')</span>
<span class="lineno"> 103 </span><span class="spaces"> </span><span class="istickedoff">bSp = splitWith isSp</span>
<span class="lineno"> 104 </span><span class="spaces"> </span><span class="istickedoff">isDot = (== '.')</span>
<span class="lineno"> 105 </span><span class="spaces"> </span><span class="istickedoff">bDot = splitWith isDot</span></span>
<span class="lineno"> 106 </span>
<span class="lineno"> 107 </span>
<span class="lineno"> 108 </span>------------------------------------------------------------------------------
<span class="lineno"> 109 </span>pLine :: (Monad m) => Iteratee ByteString m ByteString
<span class="lineno"> 110 </span><span class="decl"><span class="istickedoff">pLine = continue $ k S.empty</span>
<span class="lineno"> 111 </span><span class="spaces"> </span><span class="istickedoff">where</span>
<span class="lineno"> 112 </span><span class="spaces"> </span><span class="istickedoff">k _ EOF = throwError $</span>
<span class="lineno"> 113 </span><span class="spaces"> </span><span class="istickedoff">HttpParseException <span class="nottickedoff">"parse error: expected line ending in crlf"</span></span>
<span class="lineno"> 114 </span><span class="spaces"> </span><span class="istickedoff">k !pre (Chunks xs) =</span>
<span class="lineno"> 115 </span><span class="spaces"> </span><span class="istickedoff">if S.null b</span>
<span class="lineno"> 116 </span><span class="spaces"> </span><span class="istickedoff">then continue $ k a</span>
<span class="lineno"> 117 </span><span class="spaces"> </span><span class="istickedoff">else yield a (Chunks [S.drop 2 b])</span>
<span class="lineno"> 118 </span><span class="spaces"> </span><span class="istickedoff">where</span>
<span class="lineno"> 119 </span><span class="spaces"> </span><span class="istickedoff">(!a,!b) = S.breakSubstring "\r\n" s</span>
<span class="lineno"> 120 </span><span class="spaces"> </span><span class="istickedoff">!s = S.append pre s'</span>
<span class="lineno"> 121 </span><span class="spaces"> </span><span class="istickedoff">!s' = S.concat xs</span></span>
<span class="lineno"> 122 </span>
<span class="lineno"> 123 </span>
<span class="lineno"> 124 </span>------------------------------------------------------------------------------
<span class="lineno"> 125 </span>splitWith :: (Char -> Bool) -> ByteString -> (ByteString,ByteString)
<span class="lineno"> 126 </span><span class="decl"><span class="istickedoff">splitWith !f !s = let (!a,!b) = S.break f s</span>
<span class="lineno"> 127 </span><span class="spaces"> </span><span class="istickedoff">!b' = S.dropWhile f b</span>
<span class="lineno"> 128 </span><span class="spaces"> </span><span class="istickedoff">in (a, b')</span></span>
<span class="lineno"> 129 </span>
<span class="lineno"> 130 </span>
<span class="lineno"> 131 </span>------------------------------------------------------------------------------
<span class="lineno"> 132 </span>pHeaders :: Monad m => Iteratee ByteString m [(ByteString,ByteString)]
<span class="lineno"> 133 </span><span class="decl"><span class="istickedoff">pHeaders = do</span>
<span class="lineno"> 134 </span><span class="spaces"> </span><span class="istickedoff">f <- go id</span>
<span class="lineno"> 135 </span><span class="spaces"> </span><span class="istickedoff">return $! f []</span>
<span class="lineno"> 136 </span><span class="spaces"> </span><span class="istickedoff">where</span>
<span class="lineno"> 137 </span><span class="spaces"> </span><span class="istickedoff">go !dlistSoFar = {-# SCC "pHeaders/go" #-} do</span>
<span class="lineno"> 138 </span><span class="spaces"> </span><span class="istickedoff">line <- pLine</span>
<span class="lineno"> 139 </span><span class="spaces"> </span><span class="istickedoff">if S.null line</span>
<span class="lineno"> 140 </span><span class="spaces"> </span><span class="istickedoff">then return dlistSoFar</span>
<span class="lineno"> 141 </span><span class="spaces"> </span><span class="istickedoff">else do</span>
<span class="lineno"> 142 </span><span class="spaces"> </span><span class="istickedoff">let (!k,!v) = pOne line</span>
<span class="lineno"> 143 </span><span class="spaces"> </span><span class="istickedoff">vf <- pCont id</span>
<span class="lineno"> 144 </span><span class="spaces"> </span><span class="istickedoff">let vs = vf []</span>
<span class="lineno"> 145 </span><span class="spaces"> </span><span class="istickedoff">let !v' = S.concat (v:vs)</span>
<span class="lineno"> 146 </span><span class="spaces"> </span><span class="istickedoff">go (dlistSoFar . ((k,v'):))</span>
<span class="lineno"> 147 </span><span class="spaces"></span><span class="istickedoff"></span>
<span class="lineno"> 148 </span><span class="spaces"> </span><span class="istickedoff">where</span>
<span class="lineno"> 149 </span><span class="spaces"> </span><span class="istickedoff">pOne s = let (k,v) = splitWith (== ':') s</span>
<span class="lineno"> 150 </span><span class="spaces"> </span><span class="istickedoff">in (trim k, trim v)</span>
<span class="lineno"> 151 </span><span class="spaces"></span><span class="istickedoff"></span>
<span class="lineno"> 152 </span><span class="spaces"> </span><span class="istickedoff">isCont c = c == ' ' || c == '\t'</span>
<span class="lineno"> 153 </span><span class="spaces"></span><span class="istickedoff"></span>
<span class="lineno"> 154 </span><span class="spaces"> </span><span class="istickedoff">pCont !dlist = do</span>
<span class="lineno"> 155 </span><span class="spaces"> </span><span class="istickedoff">mbS <- peek</span>
<span class="lineno"> 156 </span><span class="spaces"> </span><span class="istickedoff">maybe <span class="nottickedoff">(return dlist)</span></span>
<span class="lineno"> 157 </span><span class="spaces"> </span><span class="istickedoff">(\s -> if S.null s</span>
<span class="lineno"> 158 </span><span class="spaces"> </span><span class="istickedoff">then head >> pCont dlist</span>
<span class="lineno"> 159 </span><span class="spaces"> </span><span class="istickedoff">else if isCont $ w2c $ S.unsafeHead s</span>
<span class="lineno"> 160 </span><span class="spaces"> </span><span class="istickedoff">then procCont dlist</span>
<span class="lineno"> 161 </span><span class="spaces"> </span><span class="istickedoff">else return dlist)</span>
<span class="lineno"> 162 </span><span class="spaces"> </span><span class="istickedoff">mbS</span>
<span class="lineno"> 163 </span><span class="spaces"></span><span class="istickedoff"></span>
<span class="lineno"> 164 </span><span class="spaces"> </span><span class="istickedoff">procCont !dlist = do</span>
<span class="lineno"> 165 </span><span class="spaces"> </span><span class="istickedoff">line <- pLine</span>
<span class="lineno"> 166 </span><span class="spaces"> </span><span class="istickedoff">let !t = trim line</span>
<span class="lineno"> 167 </span><span class="spaces"> </span><span class="istickedoff">pCont (dlist . (" ":) . (t:))</span></span>
<span class="lineno"> 168 </span>
<span class="lineno"> 169 </span>
<span class="lineno"> 170 </span>------------------------------------------------------------------------------
<span class="lineno"> 171 </span>methodFromString :: (Monad m) => ByteString -> Iteratee ByteString m Method
<span class="lineno"> 172 </span><span class="decl"><span class="istickedoff">methodFromString "GET" = return GET</span>
<span class="lineno"> 173 </span><span class="spaces"></span><span class="istickedoff">methodFromString "POST" = return POST</span>
<span class="lineno"> 174 </span><span class="spaces"></span><span class="istickedoff">methodFromString "HEAD" = return HEAD</span>
<span class="lineno"> 175 </span><span class="spaces"></span><span class="istickedoff">methodFromString "PUT" = return PUT</span>
<span class="lineno"> 176 </span><span class="spaces"></span><span class="istickedoff">methodFromString "DELETE" = return DELETE</span>
<span class="lineno"> 177 </span><span class="spaces"></span><span class="istickedoff">methodFromString "TRACE" = return TRACE</span>
<span class="lineno"> 178 </span><span class="spaces"></span><span class="istickedoff">methodFromString "OPTIONS" = return OPTIONS</span>
<span class="lineno"> 179 </span><span class="spaces"></span><span class="istickedoff">methodFromString "CONNECT" = return CONNECT</span>
<span class="lineno"> 180 </span><span class="spaces"></span><span class="istickedoff">methodFromString s = </span>
<span class="lineno"> 181 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">throwError $ HttpParseException $ "Bad method '" ++ S.unpack s ++ "'"</span></span></span>
<span class="lineno"> 182 </span>
<span class="lineno"> 183 </span>
<span class="lineno"> 184 </span>------------------------------------------------------------------------------
<span class="lineno"> 185 </span>readChunkedTransferEncoding :: (MonadIO m) =>
<span class="lineno"> 186 </span> Enumeratee ByteString ByteString m a
<span class="lineno"> 187 </span><span class="decl"><span class="istickedoff">readChunkedTransferEncoding =</span>
<span class="lineno"> 188 </span><span class="spaces"> </span><span class="istickedoff">chunkParserToEnumeratee $</span>
<span class="lineno"> 189 </span><span class="spaces"> </span><span class="istickedoff">iterateeDebugWrapper <span class="nottickedoff">"pGetTransferChunk"</span> $</span>
<span class="lineno"> 190 </span><span class="spaces"> </span><span class="istickedoff">iterParser pGetTransferChunk</span></span>
<span class="lineno"> 191 </span>
<span class="lineno"> 192 </span>
<span class="lineno"> 193 </span>------------------------------------------------------------------------------
<span class="lineno"> 194 </span>chunkParserToEnumeratee :: (MonadIO m) =>
<span class="lineno"> 195 </span> Iteratee ByteString m (Maybe ByteString)
<span class="lineno"> 196 </span> -> Enumeratee ByteString ByteString m a
<span class="lineno"> 197 </span><span class="decl"><span class="istickedoff">chunkParserToEnumeratee getChunk client = do</span>
<span class="lineno"> 198 </span><span class="spaces"> </span><span class="istickedoff">mbB <- getChunk</span>
<span class="lineno"> 199 </span><span class="spaces"> </span><span class="istickedoff">maybe finishIt sendBS mbB</span>
<span class="lineno"> 200 </span><span class="spaces"></span><span class="istickedoff"></span>
<span class="lineno"> 201 </span><span class="spaces"> </span><span class="istickedoff">where</span>
<span class="lineno"> 202 </span><span class="spaces"> </span><span class="istickedoff">sendBS s = do</span>
<span class="lineno"> 203 </span><span class="spaces"> </span><span class="istickedoff">step <- lift $ runIteratee $ enumBS s client</span>
<span class="lineno"> 204 </span><span class="spaces"> </span><span class="istickedoff">chunkParserToEnumeratee getChunk step</span>
<span class="lineno"> 205 </span><span class="spaces"></span><span class="istickedoff"></span>
<span class="lineno"> 206 </span><span class="spaces"> </span><span class="istickedoff">finishIt = lift $ runIteratee $ enumEOF client</span></span>
<span class="lineno"> 207 </span>
<span class="lineno"> 208 </span>
<span class="lineno"> 209 </span>------------------------------------------------------------------------------
<span class="lineno"> 210 </span>-- parse functions
<span class="lineno"> 211 </span>------------------------------------------------------------------------------
<span class="lineno"> 212 </span>
<span class="lineno"> 213 </span>------------------------------------------------------------------------------
<span class="lineno"> 214 </span>pGetTransferChunk :: Parser (Maybe ByteString)
<span class="lineno"> 215 </span><span class="decl"><span class="istickedoff">pGetTransferChunk = do</span>
<span class="lineno"> 216 </span><span class="spaces"> </span><span class="istickedoff">!hex <- liftM fromHex $ (takeWhile (isHexDigit . w2c))</span>
<span class="lineno"> 217 </span><span class="spaces"> </span><span class="istickedoff">takeTill ((== '\r') . w2c)</span>
<span class="lineno"> 218 </span><span class="spaces"> </span><span class="istickedoff">crlf</span>
<span class="lineno"> 219 </span><span class="spaces"> </span><span class="istickedoff">if hex <= 0</span>
<span class="lineno"> 220 </span><span class="spaces"> </span><span class="istickedoff">then return Nothing</span>
<span class="lineno"> 221 </span><span class="spaces"> </span><span class="istickedoff">else do</span>
<span class="lineno"> 222 </span><span class="spaces"> </span><span class="istickedoff">x <- take hex</span>
<span class="lineno"> 223 </span><span class="spaces"> </span><span class="istickedoff">crlf</span>
<span class="lineno"> 224 </span><span class="spaces"> </span><span class="istickedoff">return $ Just x</span>
<span class="lineno"> 225 </span><span class="spaces"> </span><span class="istickedoff">where</span>
<span class="lineno"> 226 </span><span class="spaces"> </span><span class="istickedoff">fromHex :: ByteString -> Int</span>
<span class="lineno"> 227 </span><span class="spaces"> </span><span class="istickedoff">fromHex s = Cvt.hex (L.fromChunks [s])</span></span>
<span class="lineno"> 228 </span>
<span class="lineno"> 229 </span>
<span class="lineno"> 230 </span>------------------------------------------------------------------------------
<span class="lineno"> 231 </span>-- COOKIE PARSING
<span class="lineno"> 232 </span>------------------------------------------------------------------------------
<span class="lineno"> 233 </span>
<span class="lineno"> 234 </span>-- these definitions try to mirror RFC-2068 (the HTTP/1.1 spec) and RFC-2109
<span class="lineno"> 235 </span>-- (cookie spec): please point out any errors!
<span class="lineno"> 236 </span>
<span class="lineno"> 237 </span>------------------------------------------------------------------------------
<span class="lineno"> 238 </span>pCookies :: Parser [Cookie]
<span class="lineno"> 239 </span><span class="decl"><span class="istickedoff">pCookies = do</span>
<span class="lineno"> 240 </span><span class="spaces"> </span><span class="istickedoff">-- grab kvps and turn to strict bytestrings</span>
<span class="lineno"> 241 </span><span class="spaces"> </span><span class="istickedoff">kvps <- pAvPairs</span>
<span class="lineno"> 242 </span><span class="spaces"></span><span class="istickedoff"></span>
<span class="lineno"> 243 </span><span class="spaces"> </span><span class="istickedoff">return $ map toCookie $ filter (not . S.isPrefixOf "$" . fst) kvps</span>
<span class="lineno"> 244 </span><span class="spaces"></span><span class="istickedoff"></span>
<span class="lineno"> 245 </span><span class="spaces"> </span><span class="istickedoff">where</span>
<span class="lineno"> 246 </span><span class="spaces"> </span><span class="istickedoff">toCookie (nm,val) = Cookie nm val Nothing Nothing Nothing</span></span>
<span class="lineno"> 247 </span>
<span class="lineno"> 248 </span>
<span class="lineno"> 249 </span>------------------------------------------------------------------------------
<span class="lineno"> 250 </span>parseCookie :: ByteString -> Maybe [Cookie]
<span class="lineno"> 251 </span><span class="decl"><span class="istickedoff">parseCookie = parseToCompletion pCookies</span></span>
<span class="lineno"> 252 </span>
<span class="lineno"> 253 </span>
<span class="lineno"> 254 </span>------------------------------------------------------------------------------
<span class="lineno"> 255 </span>-- application/x-www-form-urlencoded
<span class="lineno"> 256 </span>------------------------------------------------------------------------------
<span class="lineno"> 257 </span>
<span class="lineno"> 258 </span>------------------------------------------------------------------------------
<span class="lineno"> 259 </span>parseUrlEncoded :: ByteString -> Map ByteString [ByteString]
<span class="lineno"> 260 </span><span class="decl"><span class="istickedoff">parseUrlEncoded s = foldl' (\m (k,v) -> Map.insertWith' (++) k [v] m)</span>
<span class="lineno"> 261 </span><span class="spaces"> </span><span class="istickedoff">Map.empty</span>
<span class="lineno"> 262 </span><span class="spaces"> </span><span class="istickedoff">decoded</span>
<span class="lineno"> 263 </span><span class="spaces"> </span><span class="istickedoff">where</span>
<span class="lineno"> 264 </span><span class="spaces"> </span><span class="istickedoff">breakApart = (second (S.drop 1)) . S.break (== '=')</span>
<span class="lineno"> 265 </span><span class="spaces"></span><span class="istickedoff"></span>
<span class="lineno"> 266 </span><span class="spaces"> </span><span class="istickedoff">parts :: [(ByteString,ByteString)]</span>
<span class="lineno"> 267 </span><span class="spaces"> </span><span class="istickedoff">parts = map breakApart $ S.split '&' s</span>
<span class="lineno"> 268 </span><span class="spaces"></span><span class="istickedoff"></span>
<span class="lineno"> 269 </span><span class="spaces"> </span><span class="istickedoff">urldecode = parseToCompletion pUrlEscaped</span>
<span class="lineno"> 270 </span><span class="spaces"></span><span class="istickedoff"></span>
<span class="lineno"> 271 </span><span class="spaces"> </span><span class="istickedoff">decodeOne (a,b) = do</span>
<span class="lineno"> 272 </span><span class="spaces"> </span><span class="istickedoff">a' <- urldecode a</span>
<span class="lineno"> 273 </span><span class="spaces"> </span><span class="istickedoff">b' <- urldecode b</span>
<span class="lineno"> 274 </span><span class="spaces"> </span><span class="istickedoff">return (a',b')</span>
<span class="lineno"> 275 </span><span class="spaces"></span><span class="istickedoff"></span>
<span class="lineno"> 276 </span><span class="spaces"> </span><span class="istickedoff">decoded = catMaybes $ map decodeOne parts</span></span>
<span class="lineno"> 277 </span>
<span class="lineno"> 278 </span>
</pre>
</html>