WIP limit parsing of multipart uploads

Web/Scotty.hs

@@ -46,7 +46,7 @@ import Network.Socket (Socket)
 import Network.Wai (Application, Middleware, Request, StreamingBody)
 import Network.Wai.Handler.Warp (Port)
 
-import Web.Scotty.Internal.Types (ScottyT, ActionT, Param, RoutePattern, Options, File, Kilobytes)
+import Web.Scotty.Internal.Types (ScottyT, ActionT, Param, RoutePattern, Options, File, FileMem, Kilobytes)
 
 type ScottyM = ScottyT Text IO
 type ActionM = ActionT Text IO
@@ -174,7 +174,7 @@ request :: ActionM Request
 request = Trans.request
 
 -- | Get list of uploaded files.
-files :: ActionM [File]
+files :: ActionM [FileMem]
 files = Trans.files
 
 -- | Get a request header. Header name is case-insensitive.

Web/Scotty/Action.hs

@@ -165,8 +165,8 @@ request :: Monad m => ActionT e m Request
 request = ActionT $ liftM getReq ask
 
 -- | Get list of uploaded files.
-files :: Monad m => ActionT e m [File]
-files = ActionT $ liftM getFiles ask
+files :: Monad m => ActionT e m [FileMem]
+files = ActionT $ liftM getFilesMem ask
 
 -- | Get a request header. Header name is case-insensitive.
 header :: (ScottyError e, Monad m) => T.Text -> ActionT e m (Maybe T.Text)

Web/Scotty/Internal/Types.hs

@@ -131,13 +131,17 @@ instance Exception ScottyException
 ------------------ Scotty Actions -------------------
 type Param = (Text, Text)
 
-type File = (Text, FileInfo ByteString)
+-- type File = (Text, FileInfo (Either ByteString FilePath))
+type File i = (Text, FileInfo i)
+type FileMem = File ByteString
+type FileDisk = File FilePath
 
 data ActionEnv = Env { getReq       :: Request
                      , getParams    :: [Param]
                      , getBody      :: IO ByteString
                      , getBodyChunk :: IO BS.ByteString
-                     , getFiles     :: [File]
+                     , getFilesMem  :: [FileMem]
+                     , getFilesDisk :: [FileDisk]
                      }
 
 data RequestBodyState = BodyUntouched

Web/Scotty/Route.hs

@@ -11,11 +11,12 @@ import           Control.Concurrent.MVar
 import           Control.Exception (throw, catch)
 import           Control.Monad.IO.Class
 import qualified Control.Monad.State as MS
+import           Control.Monad.Trans.Resource (runResourceT, withInternalState)
 
 import qualified Data.ByteString.Char8 as B
 import qualified Data.ByteString.Lazy.Char8 as BL
 
-import           Data.Maybe (fromMaybe, isJust)
+import           Data.Maybe (fromMaybe)
 import           Data.String (fromString)
 import qualified Data.Text.Lazy as T
 import qualified Data.Text as TS
@@ -138,11 +139,12 @@ path = T.fromStrict . TS.cons '/' . TS.intercalate "/" . pathInfo
 -- Once read, they can't be read again. We read them into a lazy Bytestring, so Scotty
 -- user can get the raw body, even if they also want to call wai-extra's parsing routines.
 parseRequestBody :: MonadIO m
-                 => [B.ByteString]
+                 => Parse.ParseRequestBodyOptions
+                 -> [B.ByteString]
                  -> Parse.BackEnd y
                  -> Request
                  -> m ([Parse.Param], [Parse.File y])
-parseRequestBody bl s r =
+parseRequestBody opts bl s r =
     case Parse.getRequestBodyType r of
         Nothing -> return ([], [])
         Just rbt -> do
@@ -151,9 +153,9 @@ parseRequestBody bl s r =
             let provider = modifyMVar mvar $ \bsold -> case bsold of
                                                 []     -> return ([], B.empty)
                                                 (b:bs) -> return (bs, b)
-            liftIO $ Parse.sinkRequestBody s rbt provider
+            liftIO $ Parse.sinkRequestBodyEx opts s rbt provider
 
-mkEnv :: forall m. MonadIO m => Request -> [Param] -> RouteOptions ->m ActionEnv
+mkEnv :: forall m. MonadIO m => Request -> [Param] -> RouteOptions -> m ActionEnv
 mkEnv req captures opts = do
     bodyState <- liftIO $ newMVar BodyUntouched
 
@@ -187,19 +189,27 @@ mkEnv req captures opts = do
                  putMVar bodyState $ BodyCached b chunks
                  return b
 
-        shouldParseBody = isJust $ Parse.getRequestBodyType req
-
-    (formparams, fs) <- if shouldParseBody
-      then liftIO $ do wholeBody <- BL.toChunks `fmap` bs
-                       parseRequestBody wholeBody Parse.lbsBackEnd req
-      else return ([], [])
+    (formparams, fsm, fsd) <-
+      case Parse.getRequestBodyType req of
+        Just Parse.UrlEncoded -> liftIO $ do
+          wholeBody <- BL.toChunks `fmap` bs
+          (fp, fsm) <- parseRequestBody Parse.noLimitParseRequestBodyOptions wholeBody Parse.lbsBackEnd req
+          pure (fp, fsm, [])
+        Just (Parse.Multipart _) -> liftIO $ do
+          wholeBody <- BL.toChunks `fmap` bs -- XXX very much unsure we should be traversing the body here
+          (fp, fsd) <- runResourceT (withInternalState $ \ istate ->
+            parseRequestBody Parse.defaultParseRequestBodyOptions wholeBody (Parse.tempFileBackEnd istate) req)
+          pure (fp, [], fsd)
+        Nothing -> pure ([], [], [])
 
     let
         convert (k, v) = (strictByteStringToLazyText k, strictByteStringToLazyText v)
+        toLazies fs = [ (strictByteStringToLazyText k, fi) | (k, fi) <- fs ]
         parameters =  captures ++ map convert formparams ++ queryparams
         queryparams = parseEncodedParams $ rawQueryString req
 
-    return $ Env req parameters bs safeBodyReader [ (strictByteStringToLazyText k, fi) | (k,fi) <- fs ]
+    return $ Env req parameters bs safeBodyReader (toLazies fsm) (toLazies fsd)
+
 
 parseEncodedParams :: B.ByteString -> [Param]
 parseEncodedParams bs = [ (T.fromStrict k, T.fromStrict $ fromMaybe "" v) | (k,v) <- parseQueryText bs ]

scotty.cabal

@@ -87,6 +87,7 @@ Library
                        mtl                   >= 2.1.2    && < 2.4,
                        network               >= 2.6.0.2  && < 3.2,
                        regex-compat          >= 0.95.1   && < 0.96,
+                       resourcet             >= 0.4.6,
                        text                  >= 0.11.3.1 && < 2.1,
                        time                  >= 1.8,
                        transformers          >= 0.3.0.0  && < 0.7,