DoAndIfThenElse
, FlexibleContexts
, OverloadedStrings
+ , QuasiQuotes
, RecordWildCards
, ScopedTypeVariables
, UnicodeSyntax
, ViewPatterns
#-}
-- |Parse \"multipart/form-data\" based on RFC 2388:
--- <http://www.faqs.org/rfcs/rfc2388.html>
---
--- You usually don't have to use this module directly.
+-- <http://tools.ietf.org/html/rfc2388>
module Network.HTTP.Lucu.MultipartForm
( FormData(..)
, parseMultipartFormData
import Data.ByteString.Lazy.Search
import Data.Foldable
import Data.List
-import Data.Map (Map)
import qualified Data.Map as M
import Data.Maybe
import Data.Monoid.Unicode
import Data.Text (Text)
import qualified Data.Text as T
import Network.HTTP.Lucu.Headers
-import Network.HTTP.Lucu.MIMEType
+import Network.HTTP.Lucu.MIMEParams
+import Network.HTTP.Lucu.MIMEType (MIMEType)
+import qualified Network.HTTP.Lucu.MIMEType as MT
+import Network.HTTP.Lucu.MIMEType.TH
+import Network.HTTP.Lucu.Parser
import Network.HTTP.Lucu.Parser.Http
-import Network.HTTP.Lucu.RFC2231
import Prelude.Unicode
-- |'FormData' represents a form value and possibly an uploaded file
data ContDispo
= ContDispo {
dType ∷ !CIAscii
- , dParams ∷ !(Map CIAscii Text)
+ , dParams ∷ !MIMEParams
}
printContDispo ∷ ContDispo → Ascii
--
-- * \"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 won't be
--- decoded.
+-- * RFC 2388 (<http://tools.ietf.org/html/rfc2388#section-3>) says
+-- that non-ASCII field names are encoded according to the method in
+-- RFC 2047 (<http://tools.ietf.org/html/rfc2047>), but they won't
+-- be decoded.
parseMultipartFormData ∷ Ascii -- ^boundary
→ LS.ByteString -- ^input
→ Either String [(Ascii, FormData)]
"prologue"
epilogue ∷ Parser ()
-epilogue = ( (string "--" <?> "suffix")
- *>
- crlf
- *>
- endOfInput
- )
+epilogue = finishOff ((string "--" <?> "suffix") *> crlf)
<?>
"epilogue"
⧺ e
where
defaultCType ∷ MIMEType
- defaultCType = parseMIMEType "text/plain"
+ defaultCType = [mimeType| text/plain |]
partHeader ∷ Parser Headers
partHeader = crlf *> headers
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 MT.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
partName ∷ MonadError String m ⇒ Part → m Ascii
{-# INLINEABLE partName #-}
partName (Part {..})
- = case M.lookup "name" $ dParams ptContDispo of
+ = case M.lookup "name" params of
Just name
→ case A.fromText name of
Just a → return a
Nothing
→ throwError $ "form-data without name: "
⧺ A.toString (printContDispo ptContDispo)
+ where
+ params = case dParams ptContDispo of
+ MIMEParams m → m
partFileName ∷ Part → Maybe Text
-partFileName (Part {..})
- = M.lookup "filename" $ dParams ptContDispo
+partFileName (dParams ∘ ptContDispo → MIMEParams m)
+ = M.lookup "filename" m