, RecordWildCards
, ScopedTypeVariables
, UnicodeSyntax
+ , ViewPatterns
#-}
-- |Parse \"multipart/form-data\" based on RFC 2388:
-- <http://www.faqs.org/rfcs/rfc2388.html>
import qualified Data.Ascii as A
import Data.Attoparsec
import qualified Data.Attoparsec.Lazy as LP
-import qualified Data.ByteString.Lazy.Char8 as LS
+import qualified Data.ByteString as BS
+import qualified Data.ByteString.Lazy as LS
import Data.ByteString.Lazy.Search
import Data.Foldable
import Data.List
import qualified Data.Text as T
import Network.HTTP.Lucu.Headers
import Network.HTTP.Lucu.MIMEType
+import Network.HTTP.Lucu.Parser
import Network.HTTP.Lucu.Parser.Http
import Network.HTTP.Lucu.RFC2231
import Prelude.Unicode
-- name.
data FormData
= FormData {
+ -- | @'Nothing'@ for non-file values.
fdFileName ∷ !(Maybe Text)
+ -- | MIME Type of this value, defaulted to \"text/plain\".
, fdMIMEType ∷ !MIMEType
+ -- | The form value.
, fdContent ∷ !(LS.ByteString)
}
-- limitations:
--
-- * Multiple files embedded as \"multipart/mixed\" within the
--- \"multipart/form-data\" aren't decomposed.
+-- \"multipart/form-data\" won't be decomposed.
--
--- * \"Content-Transfer-Encoding\"s are always ignored.
+-- * \"Content-Transfer-Encoding\" is always ignored.
--
-- * RFC 2388 says that non-ASCII field names are encoded according
-- to the method in RFC 2047
--- <http://www.faqs.org/rfcs/rfc2047.html>, but they aren't
+-- <http://www.faqs.org/rfcs/rfc2047.html>, but they won't be
-- decoded.
parseMultipartFormData ∷ Ascii -- ^boundary
→ LS.ByteString -- ^input
"prologue"
epilogue ∷ Parser ()
-epilogue = ( (string "--" <?> "suffix")
- *>
- crlf
- *>
- endOfInput
- )
+epilogue = finishOff ((string "--" <?> "suffix") *> crlf)
<?>
"epilogue"
Nothing
→ throwError "Content-Disposition is missing"
Just str
- → case parseOnly p $ A.toByteString str of
+ → case parseOnly (finishOff contentDisposition) $ A.toByteString str of
Right d → return d
Left err → throwError $ "malformed Content-Disposition: "
⧺ A.toString str
⧺ ": "
⧺ err
- where
- p = do dispo ← contentDisposition
- endOfInput
- return dispo
contentDisposition ∷ Parser ContDispo
contentDisposition
Nothing
→ return Nothing
Just str
- → case parseOnly p $ A.toByteString str of
+ → case parseOnly (finishOff mimeType) $ A.toByteString str of
Right d → return $ Just d
Left err → throwError $ "malformed Content-Type: "
⧺ A.toString str
⧺ ": "
⧺ err
- where
- p = do t ← mimeType
- endOfInput
- return t
getBody ∷ MonadError String m
⇒ Ascii
→ LS.ByteString
→ m (LS.ByteString, LS.ByteString)
{-# INLINEABLE getBody #-}
-getBody boundary src
- = case breakFindAfter (A.toByteString boundary) src of
- ((before, after), True)
- → return (before, after)
- _ → throwError "missing boundary"
+getBody (("\r\n--" ⊕) ∘ A.toByteString → boundary) src
+ = case breakOn boundary src of
+ (before, after)
+ | LS.null after
+ → throwError "missing boundary"
+ | otherwise
+ → let len = fromIntegral $ BS.length boundary
+ after' = LS.drop len after
+ in
+ return (before, after')
partToFormPair ∷ MonadError String m ⇒ Part → m (Ascii, FormData)
{-# INLINEABLE partToFormPair #-}