wip

Web/Scotty.hs

@@ -25,12 +25,14 @@ module Web.Scotty
     , capture, regex, function, literal
       -- ** Accessing the Request and its fields
     , request, header, headers, body, bodyReader
-    , jsonData, files
+    , jsonData
       -- ** Accessing Path, Form and Query Parameters
     , param, params
     , pathParam, captureParam, formParam, queryParam
     , pathParamMaybe, captureParamMaybe, formParamMaybe, queryParamMaybe
     , pathParams, captureParams, formParams, queryParams
+      -- *** Files
+    , files, filesOpts, Trans.ParseRequestBodyOptions, Trans.defaultParseRequestBodyOptions
       -- ** Modifying the Response and Redirecting
     , status, addHeader, setHeader, redirect
       -- ** Setting Response Body
@@ -234,6 +236,14 @@ request = Trans.request
 files :: ActionM [File ByteString]
 files = Trans.files
 
+-- | Get list of temp files and form parameters decoded from multipart payloads.
+--
+-- NB the temp files are deleted when the continuation exits
+filesOpts :: Trans.ParseRequestBodyOptions
+          -> ([Param] -> [File FilePath] -> ActionM a) -- ^ temp files validation, storage etc
+          -> ActionM a
+filesOpts = Trans.filesOpts
+
 -- | Get a request header. Header name is case-insensitive.
 header :: Text -> ActionM (Maybe Text)
 header = Trans.header
@@ -243,6 +253,8 @@ headers :: ActionM [(Text, Text)]
 headers = Trans.headers
 
 -- | Get the request body.
+--
+-- NB: loads the entire request body in memory
 body :: ActionM ByteString
 body = Trans.body
 
@@ -253,6 +265,8 @@ bodyReader :: ActionM (IO BS.ByteString)
 bodyReader = Trans.bodyReader
 
 -- | Parse the request body as a JSON object and return it. Raises an exception if parse is unsuccessful.
+--
+-- NB: uses 'body' internally
 jsonData :: FromJSON a => ActionM a
 jsonData = Trans.jsonData
 

Web/Scotty/Action.hs

@@ -12,7 +12,8 @@ module Web.Scotty.Action
     , file
     , rawResponse
     , files
-    -- , filesTemp
+    , filesOpts
+    , ParseRequestBodyOptions, defaultParseRequestBodyOptions
     , finish
     , header
     , headers
@@ -72,6 +73,7 @@ import Control.Monad.Trans.Resource (InternalState, withInternalState, runResour
 import           Control.Concurrent.MVar
 
 import qualified Data.Aeson                 as A
+import Data.Bifunctor (bimap, first)
 import Data.Bool (bool)
 import qualified Data.ByteString.Char8      as B
 import qualified Data.ByteString.Lazy.Char8 as BL
@@ -98,7 +100,7 @@ import qualified Network.Wai.Parse as W (File, Param, getRequestBodyType, BackEn
 import           Numeric.Natural
 
 import           Web.Scotty.Internal.Types
-import           Web.Scotty.Internal.WaiParseSafe (ParseRequestBodyOptions, RequestParseException(..), parseRequestBodyEx)
+import           Web.Scotty.Internal.WaiParseSafe (ParseRequestBodyOptions, defaultParseRequestBodyOptions, RequestParseException(..), parseRequestBodyEx)
 import           Web.Scotty.Util (mkResponse, addIfNotPresent, add, replace, lazyTextToStrictByteString, decodeUtf8Lenient)
 import           UnliftIO.Exception (Handler(..), catch, catches, throwIO)
 
@@ -284,13 +286,16 @@ files = ActionT $ envFiles <$> ask
 -- 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
+          -> ([Param] -> [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
+    (ps, fs) <- liftIO $ sinkTempFiles istate prbo req
+    let
+      params' = bimap decodeUtf8Lenient decodeUtf8Lenient <$> ps
+      files' = first decodeUtf8Lenient <$> fs
+    io params' files'
 
 sinkTempFiles :: InternalState
               -> ParseRequestBodyOptions
@@ -315,6 +320,8 @@ headers = do
            | (k,v) <- hs ]
 
 -- | Get the request body.
+--
+-- NB This loads the whole request body in memory at once.
 body :: (MonadIO m) => ActionT m BL.ByteString
 body = ActionT ask >>= (liftIO . envBody)
 
@@ -333,6 +340,8 @@ bodyReader = ActionT $ envBodyChunk <$> ask
 --   422 Unprocessable Entity.
 --
 --   These status codes are as per https://www.restapitutorial.com/httpstatuscodes.html.
+--
+-- NB : Internally this uses 'body'.
 jsonData :: (A.FromJSON a, MonadIO m) => ActionT m a
 jsonData = do
     b <- body

Web/Scotty/Trans.hs

@@ -30,12 +30,15 @@ module Web.Scotty.Trans
     , capture, regex, function, literal
       -- ** Accessing the Request and its fields
     , request, Lazy.header, Lazy.headers, body, bodyReader
-    , jsonData, files
+    , jsonData
+
       -- ** Accessing Path, Form and Query Parameters
     , param, params
     , pathParam, captureParam, formParam, queryParam
     , pathParamMaybe, captureParamMaybe, formParamMaybe, queryParamMaybe
     , pathParams, captureParams, formParams, queryParams
+    -- *** Files
+    , files, filesOpts, ParseRequestBodyOptions, defaultParseRequestBodyOptions
       -- ** Modifying the Response and Redirecting
     , status, Lazy.addHeader, Lazy.setHeader, Lazy.redirect
       -- ** Setting Response Body

examples/upload.hs

@@ -4,11 +4,12 @@ module Main (main) where
 import Web.Scotty
 
 import Control.Monad.IO.Class
+import Data.Foldable (for_)
 import qualified Data.Text.Lazy as TL
 
 import Network.Wai.Middleware.RequestLogger
 import Network.Wai.Middleware.Static
-import Network.Wai.Parse
+import Network.Wai.Parse (fileName, fileContent)
 
 import qualified Text.Blaze.Html5 as H
 import Text.Blaze.Html5.Attributes
@@ -35,10 +36,14 @@ main = scotty 3000 $ do
                         H.input H.! type_ "submit"
 
     post "/upload" $ do
-        fs <- files
-        let fs' = [ (fieldName, BS.unpack (fileName fi), fileContent fi) | (fieldName,fi) <- fs ]
+      filesOpts defaultParseRequestBodyOptions $ \_ fs -> do
+        let
+          -- fs' = [ (fieldName, BS.unpack (fileName fi), fileContent fi) | (fieldName,fi) <- fs ]
+          fpaths = [fileContent fi | (_, fi) <- fs]
         -- write the files to disk, so they will be served by the static middleware
-        liftIO $ sequence_ [ B.writeFile ("uploads" </> fn) fc | (_,fn,fc) <- fs' ]
+        -- liftIO $ sequence_ [ B.writeFile ("uploads" </> fn) fc | (_,fn,fc) <- fs' ]
+        for_ fpaths $ \fpath -> do
+          fc <- B.readFile fpath
         -- generate list of links to the files just uploaded
         html $ mconcat [ mconcat [ TL.fromStrict fName
                                  , ": "