diff --git a/Web/Scotty/Action.hs b/Web/Scotty/Action.hs index 6c3ed4b..580d841 100644 --- a/Web/Scotty/Action.hs +++ b/Web/Scotty/Action.hs @@ -80,7 +80,9 @@ import qualified Data.ByteString.Char8 as B import qualified Data.ByteString.Lazy.Char8 as BL import qualified Data.CaseInsensitive as CI import Data.Traversable (for) +import qualified Data.HashMap.Strict as HashMap import Data.Int +import Data.List (foldl') import Data.Maybe (maybeToList) import qualified Data.Text as T import Data.Text.Encoding as STE @@ -102,7 +104,7 @@ import qualified Network.Wai.Parse as W (FileInfo(..), ParseRequestBodyOptions, import Numeric.Natural -import Web.FormUrlEncoded (FromForm, urlDecodeAsForm) +import Web.FormUrlEncoded (Form(..), FromForm(..)) import Web.Scotty.Internal.Types import Web.Scotty.Util (mkResponse, addIfNotPresent, add, replace, lazyTextToStrictByteString, decodeUtf8Lenient) import UnliftIO.Exception (Handler(..), catch, catches, throwIO) @@ -170,11 +172,10 @@ scottyExceptionHandler = Handler $ \case , "Body: " <> bs , "Error: " <> BL.fromStrict (encodeUtf8 err) ] - MalformedForm bs err -> do + MalformedForm err -> do status status400 raw $ BL.unlines [ "formData: malformed" - , "Body: " <> bs , "Error: " <> BL.fromStrict (encodeUtf8 err) ] PathParameterNotFound k -> do @@ -367,14 +368,20 @@ jsonData = do -- -- The form is parsed using 'urlDecodeAsForm'. If that returns 'Left', the -- status is set to 400 and an exception is thrown. --- --- NB : Internally this uses 'body'. -formData :: (FromForm a, MonadIO m) => ActionT m a +formData :: (FromForm a, MonadUnliftIO m) => ActionT m a formData = do - b <- body - case urlDecodeAsForm b of - Left err -> throwIO $ MalformedForm b err + form <- paramListToForm <$> formParams + case fromForm form of + Left err -> throwIO $ MalformedForm err Right value -> return value + where + -- This rather contrived implementation uses cons and reverse to avoid quadratic complexity (e.g. using HashMap.insertWith (++)). + -- It iterates over all parameters, prepending values for duplicate keys and reverses all hashmap entries afterwards. + paramListToForm :: [Param] -> Form + paramListToForm = Form . fmap reverse . foldl' (\f (k, v) -> HashMap.alter (prependValue v) k f) HashMap.empty + + prependValue :: a -> Maybe [a] -> Maybe [a] + prependValue v = Just . maybe [v] (v :) -- | Get a parameter. First looks in captures, then form data, then query parameters. -- diff --git a/Web/Scotty/Internal/Types.hs b/Web/Scotty/Internal/Types.hs index c591241..588c0df 100644 --- a/Web/Scotty/Internal/Types.hs +++ b/Web/Scotty/Internal/Types.hs @@ -147,7 +147,7 @@ data ScottyException = RequestTooLarge | MalformedJSON LBS8.ByteString T.Text | FailedToParseJSON LBS8.ByteString T.Text - | MalformedForm LBS8.ByteString T.Text + | MalformedForm T.Text | PathParameterNotFound T.Text | QueryParameterNotFound T.Text | FormFieldNotFound T.Text diff --git a/scotty.cabal b/scotty.cabal index 81d58d5..bd311a2 100644 --- a/scotty.cabal +++ b/scotty.cabal @@ -90,6 +90,7 @@ Library transformers >= 0.3.0.0 && < 0.7, transformers-base >= 0.4.1 && < 0.5, unliftio >= 0.2, + unordered-containers >= 0.2.10.0 && < 0.3, wai >= 3.0.0 && < 3.3, wai-extra >= 3.1.14, warp >= 3.0.13