import Data.ByteString.Base (ByteString, LazyByteString(..))
import qualified Data.ByteString.Char8 as C8
import qualified Data.ByteString.Lazy.Char8 as L8
+import Data.Char
import Data.List
import Data.Maybe
import Network.HTTP.Lucu.Abortion
import qualified Network.HTTP.Lucu.Headers as H
import Network.HTTP.Lucu.HttpVersion
import Network.HTTP.Lucu.Interaction
+import Network.HTTP.Lucu.MultipartForm
import Network.HTTP.Lucu.Parser
import Network.HTTP.Lucu.Postprocess
import Network.HTTP.Lucu.RFC1123DateTime
-- | Computation of @'inputForm' limit@ attempts to read the request
-- body with 'input' and parse it as
--- application\/x-www-form-urlencoded. If the request header
--- \"Content-Type\" is not application\/x-www-form-urlencoded,
--- 'inputForm' makes 'Resource' abort with status \"415 Unsupported
--- Media Type\". If the request has no \"Content-Type\", it aborts
--- with \"400 Bad Request\".
---
--- This action should also support multipart\/form-data somehow, but
--- it is not (yet) done.
+-- application\/x-www-form-urlencoded or multipart\/form-data. If the
+-- request header \"Content-Type\" is neither of them, 'inputForm'
+-- makes 'Resource' abort with status \"415 Unsupported Media
+-- Type\". If the request has no \"Content-Type\", it aborts with
+-- \"400 Bad Request\".
inputForm :: Int -> Resource [(String, String)]
inputForm limit
= limit `seq`
-> abort BadRequest [] (Just "Missing Content-Type")
Just (MIMEType "application" "x-www-form-urlencoded" _)
-> readWWWFormURLEncoded
- Just (MIMEType "multipart" "form-data" _)
- -> readMultipartFormData
+ Just (MIMEType "multipart" "form-data" params)
+ -> readMultipartFormData params
Just cType
-> abort UnsupportedMediaType [] (Just $! "Unsupported media type: "
++ show cType)
= do src <- input limit
return $ parseWWWFormURLEncoded src
- readMultipartFormData -- FIXME: 未對應
- = abort UnsupportedMediaType []
- (Just $! "Sorry, inputForm does not currently support multipart/form-data.")
+ readMultipartFormData params
+ = do case find ((== "boundary") . map toLower . fst) params of
+ Nothing
+ -> abort BadRequest [] (Just "Missing boundary of multipart/form-data")
+ Just (_, boundary)
+ -> do src <- inputLBS limit
+ case parse (multipartFormP boundary) src of
+ (# Success pairs, _ #) -> return pairs
+ (# _, _ #)
+ -> abort BadRequest [] (Just "Unparsable multipart/form-data")
-- | This is just a constant @-1@. It's better to say @'input'
-- 'defaultLimit'@ than to say @'input' (-1)@ but these are exactly