Download this file
| 1 | -- | Reading @application/x-www-form-urlencoded@ request bodies. |
| 2 | module Todo.Form |
| 3 | ( Fields |
| 4 | , readFields |
| 5 | , field |
| 6 | ) where |
| 7 | |
| 8 | import Data.ByteString qualified as BS |
| 9 | import Data.Text (Text) |
| 10 | import Data.Text.Encoding qualified as T |
| 11 | import Network.HTTP.Types.URI (parseSimpleQuery) |
| 12 | import Network.Wai (Request, getRequestBodyChunk) |
| 13 | |
| 14 | type 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. |
| 18 | readFields :: Int -> Request -> IO (Maybe Fields) |
| 19 | readFields 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 | |
| 31 | field :: Text -> Fields -> Maybe Text |
| 32 | field = lookup |
| 33 | |