From 06de9a7e9aad492ca390f490bd2547d2e008ab45 Mon Sep 17 00:00:00 2001 From: Marco Zocca Date: Fri, 29 Dec 2023 14:22:07 +0100 Subject: [PATCH] traverse multipart req bodies only on demand --- Web/Scotty/Action.hs | 50 +++++++++++++++++++++++++---- Web/Scotty/Body.hs | 45 ++++++++++++-------------- Web/Scotty/Internal/Types.hs | 23 +++++++------ Web/Scotty/Internal/WaiParseSafe.hs | 16 ++++----- Web/Scotty/Route.hs | 22 ++++++------- Web/Scotty/Trans.hs | 12 +++---- Web/Scotty/Util.hs | 23 +++++++++++-- test/Web/ScottySpec.hs | 29 ++++++++++------- 8 files changed, 139 insertions(+), 81 deletions(-) diff --git a/Web/Scotty/Action.hs b/Web/Scotty/Action.hs index 74189bb..98fd57b 100644 --- a/Web/Scotty/Action.hs +++ b/Web/Scotty/Action.hs @@ -12,7 +12,7 @@ module Web.Scotty.Action , file , rawResponse , files - , filesTemp + -- , filesTemp , finish , header , headers @@ -67,6 +67,7 @@ import Control.Monad (when) import Control.Monad.IO.Class (MonadIO(..)) import UnliftIO (MonadUnliftIO(..)) import Control.Monad.Reader (MonadReader(..), ReaderT(..)) +import Control.Monad.Trans.Resource (InternalState, withInternalState, runResourceT) import Control.Concurrent.MVar @@ -91,15 +92,19 @@ import Network.HTTP.Types import Network.HTTP.Types.Status #endif import Network.Wai (Request, Response, StreamingBody, Application, requestHeaders) +import Network.Wai.Handler.Warp (InvalidRequest(..)) +import qualified Network.Wai.Parse as W (File, Param, getRequestBodyType, BackEnd, lbsBackEnd, tempFileBackEnd, sinkRequestBody, RequestBodyType(..)) import Numeric.Natural import Web.Scotty.Internal.Types +import Web.Scotty.Internal.WaiParseSafe (ParseRequestBodyOptions, RequestParseException(..), parseRequestBodyEx) import Web.Scotty.Util (mkResponse, addIfNotPresent, add, replace, lazyTextToStrictByteString, decodeUtf8Lenient) import UnliftIO.Exception (Handler(..), catch, catches, throwIO) import Network.Wai.Internal (ResponseReceived(..)) + -- | Evaluate a route, catch all exceptions (user-defined ones, internal and all remaining, in this order) -- and construct the 'Response' -- @@ -114,7 +119,9 @@ runAction mh env action = do ok <- flip runReaderT env $ runAM $ tryNext $ action `catches` concat [ [actionErrorHandler] , maybeToList mh - , [statusErrorHandler, scottyExceptionHandler, someExceptionHandler] + , [statusErrorHandler + , scottyExceptionHandler + , someExceptionHandler] ] res <- getResponse env return $ bool Nothing (Just $ mkResponse res) ok @@ -170,12 +177,26 @@ scottyExceptionHandler = Handler $ \case FailedToParseParameter k v e -> do status status400 text $ T.unwords [ "Failed to parse parameter", k, v, ":", e] + -- WarpRequestException we -> case we of + -- RequestHeaderFieldsTooLarge -> do + -- status status413 + -- _ -> status status200 -- TODO XXXXXXXXXXX + -- WaiRequestParseException _ -> do + -- status status413 + -- text "wai-extra says no" -- TODO XXXXXXXXXXXX -- | Uncaught exceptions turn into HTTP 500 Server Error codes someExceptionHandler :: MonadIO m => ErrorHandler m someExceptionHandler = Handler $ \case (_ :: E.SomeException) -> status status500 +-- warpInvalidRequestHandler :: MonadIO m => ErrorHandler m +-- warpInvalidRequestHandler = Handler $ \case +-- RequestHeaderFieldsTooLarge -> do +-- status status413 +-- _ -> do +-- status status200 -- TODO XXXXXXXXXXXXXX + -- | Throw a "500 Server Error" 'StatusError', which can be caught with 'catch'. -- -- Uncaught exceptions turn into HTTP 500 responses. @@ -258,9 +279,26 @@ request = ActionT $ envReq <$> ask files :: Monad m => ActionT m [File BL.ByteString] files = ActionT $ envFiles <$> ask --- | Get list of temp files decoded from multipart payloads. -filesTemp :: Monad m => ActionT m [File FilePath] -filesTemp = ActionT $ envTempFiles <$> ask +-- | Get list of temp files and form parameters decoded from multipart payloads. +-- +-- NB the temp files are deleted when the continuation exits +filesOpts :: MonadUnliftIO m => + ParseRequestBodyOptions + -> (([W.Param], [W.File FilePath]) -> ActionT m b) -- ^ temp files validation, storage etc + -> ActionT m b +filesOpts prbo io = do + req <- getRequest + runResourceT $ withInternalState $ \istate -> do + out <- liftIO $ sinkTempFiles istate prbo req + io out + +sinkTempFiles :: InternalState + -> ParseRequestBodyOptions + -> Request + -> IO ([W.Param], [W.File FilePath]) +sinkTempFiles istate o = parseRequestBodyEx o (W.tempFileBackEnd istate) + + -- | Get a request header. Header name is case-insensitive. header :: (Monad m) => T.Text -> ActionT m (Maybe T.Text) @@ -316,7 +354,7 @@ param :: (Parsable a, MonadIO m) => T.Text -> ActionT m a param k = do val <- ActionT $ (lookup k . getParams) <$> ask case val of - Nothing -> raiseStatus status500 $ "Param: " <> k <> " not found!" -- FIXME + Nothing -> raiseStatus status500 $ "Param: " <> k <> " not found!" Just v -> either (const next) return $ parseParam (TL.fromStrict v) {-# DEPRECATED param "(#204) Not a good idea to treat all parameters identically. Use captureParam, formParam and queryParam instead. "#-} diff --git a/Web/Scotty/Body.hs b/Web/Scotty/Body.hs index 84077e6..328af92 100644 --- a/Web/Scotty/Body.hs +++ b/Web/Scotty/Body.hs @@ -1,5 +1,6 @@ -{-# LANGUAGE FlexibleContexts, FlexibleInstances, RecordWildCards, - OverloadedStrings, MultiWayIf #-} +{-# LANGUAGE MultiWayIf #-} +{-# language OverloadedStrings #-} +{-# language ScopedTypeVariables #-} module Web.Scotty.Body ( newBodyInfo, cloneBodyInfo @@ -13,21 +14,23 @@ module Web.Scotty.Body ( import Control.Concurrent.MVar import Control.Monad.IO.Class -import Control.Exception (catch) import Control.Monad.Trans.Resource (InternalState) import Data.Bifunctor (first, bimap) import qualified Data.ByteString as BS import qualified Data.ByteString.Char8 as B import qualified Data.ByteString.Lazy.Char8 as BL -import Data.Maybe import qualified GHC.Exception as E (throw) import Network.Wai (Request(..), getRequestBodyChunk) +import qualified Network.Wai.Handler.Warp as Warp (InvalidRequest(..)) import qualified Network.Wai.Parse as W (File, Param, getRequestBodyType, BackEnd, lbsBackEnd, tempFileBackEnd, sinkRequestBody, RequestBodyType(..)) +import UnliftIO (MonadUnliftIO(..)) +import UnliftIO.Exception (Handler(..), catch, catches, throwIO) + import Web.Scotty.Action (Param) -import Web.Scotty.Internal.Types (BodyInfo(..), BodyChunkBuffer(..), BodyPartiallyStreamed(..), RouteOptions(..), File) -import Web.Scotty.Util (readRequestBody, strictByteStringToLazyText, decodeUtf8Lenient) +import Web.Scotty.Internal.Types (BodyInfo(..), BodyChunkBuffer(..), BodyPartiallyStreamed(..), RouteOptions(..), File, ScottyException(..)) +import Web.Scotty.Util (readRequestBody, decodeUtf8Lenient) -import Web.Scotty.Internal.WaiParseSafe (parseRequestBodyEx, defaultParseRequestBodyOptions, RequestParseException(..), ParseRequestBodyOptions(..)) +import Web.Scotty.Internal.WaiParseSafe (parseRequestBodyEx, RequestParseException(..), ParseRequestBodyOptions(..)) -- | Make a new BodyInfo with readProgress at 0 and an empty BodyChunkBuffer. newBodyInfo :: (MonadIO m) => Request -> m BodyInfo @@ -44,30 +47,22 @@ cloneBodyInfo (BodyInfo _ chunkBufferVar getChunk) = liftIO $ do return $ BodyInfo cleanReadProgressVar chunkBufferVar getChunk -- | Get the form params and files from the request. --- Only reads the whole body if the request is URL-encoded -getFormParamsAndFilesAction :: InternalState -> ParseRequestBodyOptions -> Request -> BodyInfo -> RouteOptions -> IO ([Param], [File BL.ByteString], [File FilePath]) -getFormParamsAndFilesAction istate prbo req bodyInfo opts = do +-- Only reads the request body if the request is URL-encoded (= has 'application/x-www-form-urlencoded' MIME type) +getFormParamsAndFilesAction :: Request -> BodyInfo -> RouteOptions -> IO ([Param], [File BL.ByteString]) +getFormParamsAndFilesAction req bodyInfo opts = do let bs2t = decodeUtf8Lenient convertBoth = bimap bs2t bs2t convertKey = first bs2t case W.getRequestBodyType req of - Just W.UrlEncoded -> do - bs <- getBodyAction bodyInfo opts - let wholeBody = BL.toChunks bs - (formparams, fs) <- parseRequestBody wholeBody W.lbsBackEnd req -- NB this loads the whole body into memory - return (convertBoth <$> formparams, convertKey <$> fs, []) - Just (W.Multipart _) -> do - (formparams, fs) <- sinkTempFiles istate prbo req - return (convertBoth <$> formparams, [], convertKey <$> fs) - Nothing -> do - return ([], [], []) + Just W.UrlEncoded -> do + bs <- getBodyAction bodyInfo opts + let wholeBody = BL.toChunks bs + (formparams, fs) <- parseRequestBody wholeBody W.lbsBackEnd req -- NB this loads the whole body into memory + return (convertBoth <$> formparams, convertKey <$> fs) + _ -> return ([], []) + -sinkTempFiles :: InternalState -- global, to be initialized with the server - -> ParseRequestBodyOptions -- " " with user input - -> Request - -> IO ([W.Param], [W.File FilePath]) -sinkTempFiles istate o = parseRequestBodyEx o (W.tempFileBackEnd istate) -- | Retrieve the entire body, using the cached chunks in the BodyInfo and reading any other -- chunks if they still exist. diff --git a/Web/Scotty/Internal/Types.hs b/Web/Scotty/Internal/Types.hs index 6eacfe0..5439d42 100644 --- a/Web/Scotty/Internal/Types.hs +++ b/Web/Scotty/Internal/Types.hs @@ -38,17 +38,17 @@ import Network.HTTP.Types import Network.Wai hiding (Middleware, Application) import qualified Network.Wai as Wai -import Network.Wai.Handler.Warp (Settings, defaultSettings) +import qualified Network.Wai.Handler.Warp as W (Settings, defaultSettings, InvalidRequest(..)) import Network.Wai.Parse (FileInfo) import UnliftIO.Exception (Handler(..), catch, catches) -import Web.Scotty.Internal.WaiParseSafe (ParseRequestBodyOptions(..), defaultParseRequestBodyOptions) +import qualified Web.Scotty.Internal.WaiParseSafe as WPS (ParseRequestBodyOptions(..), defaultParseRequestBodyOptions, RequestParseException(..)) --------------------- Options ----------------------- data Options = Options { verbose :: Int -- ^ 0 = silent, 1(def) = startup banner - , settings :: Settings -- ^ Warp 'Settings' + , settings :: W.Settings -- ^ Warp 'Settings' -- Note: to work around an issue in warp, -- the default FD cache duration is set to 0 -- so changes to static files are always picked @@ -61,7 +61,7 @@ instance Default Options where def = defaultOptions defaultOptions :: Options -defaultOptions = Options 1 defaultSettings +defaultOptions = Options 1 W.defaultSettings newtype RouteOptions = RouteOptions { maxRequestBodySize :: Maybe Kilobytes -- max allowed request size in KB } @@ -97,15 +97,14 @@ data ScottyState m = , routes :: [BodyInfo -> Middleware m] , handler :: Maybe (ErrorHandler m) , routeOptions :: RouteOptions - , parseRequestBodyOpts :: ParseRequestBodyOptions - , resourcetState :: InternalState + , parseRequestBodyOpts :: WPS.ParseRequestBodyOptions } -- instance Default (ScottyState m) where -- def = defaultScottyState -defaultScottyState :: InternalState -> ScottyState m -defaultScottyState = ScottyState [] [] Nothing defaultRouteOptions defaultParseRequestBodyOptions +defaultScottyState :: ScottyState m +defaultScottyState = ScottyState [] [] Nothing defaultRouteOptions WPS.defaultParseRequestBodyOptions addMiddleware :: Wai.Middleware -> ScottyState m -> ScottyState m addMiddleware m s@(ScottyState {middlewares = ms}) = s { middlewares = m:ms } @@ -161,14 +160,16 @@ data ScottyException | QueryParameterNotFound Text | FormFieldNotFound Text | FailedToParseParameter Text Text Text + | WarpRequestException W.InvalidRequest -- from warp + | WaiRequestParseException WPS.RequestParseException -- from wai-extra deriving (Show, Typeable) instance E.Exception ScottyException ------------------ Scotty Actions ------------------- type Param = (Text, Text) +-- | Type parameter @t@ is the file content. Could be @()@ when not needed or a @FilePath@ for temp files instead. type File t = (Text, FileInfo t) --- type FileTemp = (Text, FileInfo FilePath) data ActionEnv = Env { envReq :: Request , envPathParams :: [Param] @@ -177,10 +178,12 @@ data ActionEnv = Env { envReq :: Request , envBody :: IO LBS8.ByteString , envBodyChunk :: IO BS.ByteString , envFiles :: [File LBS8.ByteString] - , envTempFiles :: [File FilePath] , envResponse :: TVar ScottyResponse } +getRequest :: Monad m => ActionT m Request +getRequest = ActionT $ asks envReq + getResponse :: MonadIO m => ActionEnv -> m ScottyResponse getResponse ae = liftIO $ readTVarIO (envResponse ae) diff --git a/Web/Scotty/Internal/WaiParseSafe.hs b/Web/Scotty/Internal/WaiParseSafe.hs index 6f75223..33332ab 100644 --- a/Web/Scotty/Internal/WaiParseSafe.hs +++ b/Web/Scotty/Internal/WaiParseSafe.hs @@ -9,8 +9,8 @@ module Web.Scotty.Internal.WaiParseSafe where import Network.Wai.Parse (getRequestBodyType, fileContent, File, FileInfo(..), Param, BackEnd, RequestBodyType(..)) import qualified Control.Exception as E -import Control.Monad (guard, unless, when) -import Control.Monad.Trans.Resource (InternalState, allocate, register, release, runInternalState) +import Control.Monad (unless, when) +-- import Control.Monad.Trans.Resource (InternalState, allocate, register, release, runInternalState) import Data.Bifunctor (bimap) import qualified Data.ByteString as S import qualified Data.ByteString.Char8 as S8 @@ -160,18 +160,18 @@ takeLines'' -> Maybe Int -> Source -> IO [S.ByteString] -takeLines'' lines lineLength maxLines src = do +takeLines'' lns lineLength maxLines src = do case maxLines of Just maxLines' -> - when (length lines > maxLines') $ - E.throwIO $ TooManyHeaderLines (length lines) + when (length lns > maxLines') $ + E.throwIO $ TooManyHeaderLines (length lns) Nothing -> return () res <- takeLine lineLength src case res of - Nothing -> return lines + Nothing -> return lns Just l - | S.null l -> return lines - | otherwise -> takeLines'' (l:lines) lineLength maxLines src + | S.null l -> return lns + | otherwise -> takeLines'' (l:lns) lineLength maxLines src diff --git a/Web/Scotty/Route.hs b/Web/Scotty/Route.hs index 157dd7b..0d85ffb 100644 --- a/Web/Scotty/Route.hs +++ b/Web/Scotty/Route.hs @@ -80,7 +80,7 @@ options = addroute OPTIONS -- | Add a route that matches regardless of the HTTP verb. matchAny :: (MonadUnliftIO m) => RoutePattern -> ActionT m () -> ScottyT m () -matchAny pat action = ScottyT $ MS.modify $ \s -> addRoute (route (resourcetState s) (parseRequestBodyOpts s) (routeOptions s) (handler s) Nothing pat action) s +matchAny pat action = ScottyT $ MS.modify $ \s -> addRoute (route (routeOptions s) (handler s) Nothing pat action) s -- | Specify an action to take if nothing else is found. Note: this _always_ matches, -- so should generally be the last route specified. @@ -104,14 +104,12 @@ let server = S.get "/foo/:bar" (S.pathParam "bar" >>= S.text) -} addroute :: (MonadUnliftIO m) => StdMethod -> RoutePattern -> ActionT m () -> ScottyT m () addroute method pat action = ScottyT $ MS.modify $ \s -> - addRoute (route (resourcetState s) (parseRequestBodyOpts s) (routeOptions s) (handler s) (Just method) pat action) s + addRoute (route (routeOptions s) (handler s) (Just method) pat action) s route :: (MonadUnliftIO m) => - InternalState - -> ParseRequestBodyOptions - -> RouteOptions + RouteOptions -> Maybe (ErrorHandler m) -> Maybe StdMethod -> RoutePattern -> ActionT m () -> BodyInfo -> Middleware m -route istate prbo opts h method pat action bodyInfo app req = +route opts h method pat action bodyInfo app req = let tryNext = app req -- We match all methods in the case where 'method' is 'Nothing'. -- See https://github.com/scotty-web/scotty/issues/196 and 'matchAny' @@ -129,7 +127,7 @@ route istate prbo opts h method pat action bodyInfo app req = -- without messing up the state of the original BodyInfo. clonedBodyInfo <- cloneBodyInfo bodyInfo - env <- mkEnv istate prbo clonedBodyInfo req captures opts + env <- mkEnv clonedBodyInfo req captures opts res <- runAction h env action maybe tryNext return res Nothing -> tryNext @@ -159,19 +157,17 @@ path = T.cons '/' . T.intercalate "/" . pathInfo -- | Parse the request and construct the initial 'ActionEnv' with a default 200 OK response mkEnv :: MonadIO m => - InternalState - -> ParseRequestBodyOptions - -> BodyInfo + BodyInfo -> Request -> [Param] -> RouteOptions -> m ActionEnv -mkEnv istate prbo bodyInfo req captureps opts = do - (formps, bodyFiles, tempFiles) <- liftIO $ getFormParamsAndFilesAction istate prbo req bodyInfo opts +mkEnv bodyInfo req captureps opts = do + (formps, bodyFiles) <- liftIO $ getFormParamsAndFilesAction req bodyInfo opts let queryps = parseEncodedParams $ queryString req responseInit <- liftIO $ newTVarIO defaultScottyResponse - return $ Env req captureps formps queryps (getBodyAction bodyInfo opts) (getBodyChunkAction bodyInfo) bodyFiles tempFiles responseInit + return $ Env req captureps formps queryps (getBodyAction bodyInfo opts) (getBodyChunkAction bodyInfo) bodyFiles responseInit parseEncodedParams :: Query -> [Param] diff --git a/Web/Scotty/Trans.hs b/Web/Scotty/Trans.hs index ecf5141..e4f4784 100644 --- a/Web/Scotty/Trans.hs +++ b/Web/Scotty/Trans.hs @@ -68,7 +68,7 @@ import Control.Monad.State.Strict (execState, modify) import Control.Monad.IO.Class import Control.Monad.Trans.Resource (runResourceT, withInternalState, InternalState) -import Network.HTTP.Types (status404, status413, status500) +import Network.HTTP.Types (status200, status404, status413, status500) import Network.Socket (Socket) import qualified Network.Wai as W (Application, Middleware, Response, responseBuilder) import Network.Wai.Handler.Warp (Port, runSettings, runSettingsSocket, setPort, getPort) @@ -81,7 +81,7 @@ import Web.Scotty.Util (socketDescription) import Web.Scotty.Body (newBodyInfo) import UnliftIO (MonadUnliftIO(..)) -import UnliftIO.Exception (Handler(..), catch) +import UnliftIO.Exception (Handler(..), catch, catches) -- | Run a scotty application using the warp server. @@ -123,12 +123,12 @@ scottySocketT opts sock runActionToIO s = do -- | Turn a scotty application into a WAI 'Application', which can be -- run with any WAI handler. -- NB: scottyApp === scottyAppT id -scottyAppT :: (Monad m, MonadUnliftIO n) +scottyAppT :: (Monad m, Monad n) => (m W.Response -> IO W.Response) -- ^ Run monad 'm' into 'IO', called at each action. -> ScottyT m () -> n W.Application -scottyAppT runActionToIO defs = runResourceT $ withInternalState $ \istate -> do - let s = execState (runS defs) (defaultScottyState istate) +scottyAppT runActionToIO defs = do + let s = execState (runS defs) defaultScottyState let rapp req callback = do bodyInfo <- newBodyInfo req resp <- runActionToIO (applyAll notFoundApp ([midd bodyInfo | midd <- routes s]) req) @@ -136,7 +136,7 @@ scottyAppT runActionToIO defs = runResourceT $ withInternalState $ \istate -> do callback resp return $ applyAll rapp (middlewares s) ---- | Exception handler in charge of 'ScottyException' that's not caught by 'scottyExceptionHandler' +-- | Exception handler in charge of 'ScottyException' that's not caught by 'scottyExceptionHandler' unhandledExceptionHandler :: MonadIO m => ScottyException -> m W.Response unhandledExceptionHandler = \case RequestTooLarge -> return $ W.responseBuilder status413 ct "Request is too big Jim!" diff --git a/Web/Scotty/Util.hs b/Web/Scotty/Util.hs index cd278f9..694acc2 100644 --- a/Web/Scotty/Util.hs +++ b/Web/Scotty/Util.hs @@ -71,7 +71,7 @@ socketDescription sock = do SockAddrUnix u -> return $ "unix socket " ++ u _ -> fmap (\port -> "port " ++ show port) $ socketPort sock --- | return request body or throw a 'RequestException' if request body too big +-- | return request body or throw a 'ScottyException' if request body too big readRequestBody :: IO B.ByteString -- ^ body chunk reader -> ([B.ByteString] -> IO [B.ByteString]) -> Maybe Kilobytes -- ^ max body size @@ -88,14 +88,33 @@ readRequestBody rbody prefix maxSize = do checkBodyLength = \case Just maxSize' -> do bodySoFar <- prefix [] + -- when (bodySoFar `isBigger` maxSize') (throwIO RequestTooLarge) when (bodySoFar `isBigger` maxSize') readUntilEmpty Nothing -> return () isBigger bodySoFar maxSize' = (B.length . B.concat $ bodySoFar) > maxSize' * 1024 -- XXX this looks both inefficient and wrong readUntilEmpty = do b <- rbody if B.null b - then throwIO RequestTooLarge + then do + throwIO RequestTooLarge else readUntilEmpty +-- readRequestBody' rbody prefix maxSize = grow 0 +-- where +-- grow len = do +-- b <- rbody +-- if B.null b +-- then prefix [] +-- else +-- case maxSize of +-- Nothing -> return () +-- Just maxs -> +-- let +-- lincr = B.length b +-- len' = len + lincr +-- in +-- if len' > maxs +-- then throwIO RequestTooLarge +-- else grow len' diff --git a/test/Web/ScottySpec.hs b/test/Web/ScottySpec.hs index fcbe860..19bbf85 100644 --- a/test/Web/ScottySpec.hs +++ b/test/Web/ScottySpec.hs @@ -133,17 +133,24 @@ spec = do let large = TLE.encodeUtf8 . TL.pack . concat $ [show c | c <- ([1..4500]::[Integer])] smol = TLE.encodeUtf8 . TL.pack . concat $ [show c | c <- ([1..50]::[Integer])] - withApp (Scotty.setMaxRequestBodySize 1 >> Scotty.matchAny "/upload" (do status status200)) $ do - it "should return 200 OK if the request body size is below 1 KB" $ do - request "POST" "/upload" [("Content-Type","multipart/form-data; boundary=--33")] - smol `shouldRespondWith` 200 - it "should return 413 (Content Too Large) if the request body size is above 1 KB" $ do - request "POST" "/upload" [("Content-Type","multipart/form-data; boundary=--33")] - large `shouldRespondWith` 413 - context "(counterexample)" $ - withApp (Scotty.post "/" $ status status200) $ do - it "doesn't throw an uncaught exception if the body is large" $ do - request "POST" "/" [("Content-Type","multipart/form-data; boundary=--33")] + withApp (Scotty.setMaxRequestBodySize 1 >> Scotty.post "/upload" (do status status200)) $ do + context "application/x-www-form-urlencoded" $ do + it "should return 200 OK if the request body size is below 1 KB" $ do + request "POST" "/upload" [("Content-Type","application/x-www-form-urlencoded")] + smol `shouldRespondWith` 200 + it "should return 413 (Content Too Large) if the request body size is above 1 KB" $ do + request "POST" "/upload" [("Content-Type","application/x-www-form-urlencoded")] + large `shouldRespondWith` 413 + + withApp (Scotty.post "/" $ status status200) $ do + context "(counterexample)" $ do + it "doesn't throw an uncaught exception if the body is large" $ do + request "POST" "/" [("Content-Type","application/x-www-form-urlencoded")] + large `shouldRespondWith` 200 + withApp (Scotty.setMaxRequestBodySize 1 >> Scotty.post "/upload" (do status status200)) $ do + context "multipart/form-data; boundary=--33" $ do + it "should return 200 OK if the request body size is above 1 KB (since multipart form bodies are only traversed or parsed on demand)" $ do + request "POST" "/upload" [("Content-Type","multipart/form-data; boundary=--33")] large `shouldRespondWith` 200 describe "middleware" $ do