carlos / todomvc-bakeoff Public

Clone
git clone https://amadan.net/carlos/todomvc-bakeoff

Plain git — no account needed to clone.

Download

Download this file

1-- | Reading @application/x-www-form-urlencoded@ request bodies.
2module Todo.Form
3 ( Fields
4 , readFields
5 , field
6 ) where
7
8import Data.ByteString qualified as BS
9import Data.Text (Text)
10import Data.Text.Encoding qualified as T
11import Network.HTTP.Types.URI (parseSimpleQuery)
12import Network.Wai (Request, getRequestBodyChunk)
13
14type Fields = [(Text, Text)]
15
16-- | The body's fields, or 'Nothing' if it's bigger than @limit@ bytes.
17-- Bytes that aren't UTF-8 become U+FFFD rather than an error.
18readFields :: Int -> Request -> IO (Maybe Fields)
19readFields limit req = go 0 []
20 where
21 go size chunks = do
22 chunk <- getRequestBodyChunk req
23 let size' = size + BS.length chunk
24 if
25 | BS.null chunk -> pure (Just (decode (BS.concat (reverse chunks))))
26 | size' > limit -> pure Nothing
27 | otherwise -> go size' (chunk : chunks)
28 decode body = [(text k, text v) | (k, v) <- parseSimpleQuery body]
29 text = T.decodeUtf8Lenient
30
31field :: Text -> Fields -> Maybe Text
32field = lookup
33