10 -- |Parse \"multipart/form-data\" based on RFC 2388:
11 -- <http://www.faqs.org/rfcs/rfc2388.html>
13 -- You usually don't have to use this module directly.
14 module Network.HTTP.Lucu.MultipartForm
16 , parseMultipartFormData
19 import Control.Applicative hiding (many)
20 import Control.Applicative.Unicode hiding ((∅))
21 import Control.Monad.Error
22 import Control.Monad.Unicode
23 import Data.Ascii (Ascii, CIAscii)
24 import qualified Data.Ascii as A
25 import Data.Attoparsec
26 import qualified Data.Attoparsec.Lazy as LP
27 import qualified Data.ByteString as BS
28 import qualified Data.ByteString.Lazy as LS
29 import Data.ByteString.Lazy.Search
33 import qualified Data.Map as M
35 import Data.Monoid.Unicode
36 import Data.Sequence (Seq)
37 import Data.Sequence.Unicode hiding ((∅))
38 import Data.Text (Text)
39 import qualified Data.Text as T
40 import Network.HTTP.Lucu.Headers
41 import Network.HTTP.Lucu.MIMEType
42 import Network.HTTP.Lucu.Parser.Http
43 import Network.HTTP.Lucu.RFC2231
44 import Prelude.Unicode
46 -- |'FormData' represents a form value and possibly an uploaded file
50 -- | @'Nothing'@ for non-file values.
51 fdFileName ∷ !(Maybe Text)
52 -- | MIME Type of this value, defaulted to \"text/plain\".
53 , fdMIMEType ∷ !MIMEType
55 , fdContent ∷ !(LS.ByteString)
60 ptContDispo ∷ !ContDispo
61 , ptContType ∷ !MIMEType
62 , ptBody ∷ !LS.ByteString
68 , dParams ∷ !(Map CIAscii Text)
71 printContDispo ∷ ContDispo → Ascii
74 ( A.toAsciiBuilder (A.fromCIAscii $ dType d)
76 printMIMEParams (dParams d) )
78 -- |Parse \"multipart/form-data\" and return either @'Left' err@ or
79 -- @'Right' result@. Note that there are currently the following
82 -- * Multiple files embedded as \"multipart/mixed\" within the
83 -- \"multipart/form-data\" won't be decomposed.
85 -- * \"Content-Transfer-Encoding\" is always ignored.
87 -- * RFC 2388 says that non-ASCII field names are encoded according
88 -- to the method in RFC 2047
89 -- <http://www.faqs.org/rfcs/rfc2047.html>, but they won't be
91 parseMultipartFormData ∷ Ascii -- ^boundary
92 → LS.ByteString -- ^input
93 → Either String [(Ascii, FormData)]
94 parseMultipartFormData boundary = (mapM partToFormPair =≪) ∘ go
96 go ∷ (Functor m, MonadError String m)
101 = case LP.parse (prologue boundary) src of
105 → throwError $ "Unparsable multipart/form-data: "
106 ⧺ intercalate ", " eCtx
109 go' ∷ (Functor m, MonadError String m)
113 {-# INLINEABLE go' #-}
115 = case LP.parse epilogue src of
119 → do (src', x) ← parsePart boundary src
122 prologue ∷ Ascii → Parser ()
124 = ( (string "--" <?> "prefix")
126 (string (A.toByteString boundary) <?> "boundary")
134 epilogue = ( (string "--" <?> "suffix")
143 parsePart ∷ (Functor m, MonadError String m)
146 → m (LS.ByteString, Part)
147 {-# INLINEABLE parsePart #-}
148 parsePart boundary src
149 = case LP.parse partHeader src of
151 → do dispo ← getContDispo hdrs
152 cType ← fromMaybe defaultCType <$> getContType hdrs
154 ← getBody boundary src'
155 return (src'', Part dispo cType body)
157 → throwError $ "unparsable part: "
158 ⧺ intercalate ", " eCtx
162 defaultCType ∷ MIMEType
163 defaultCType = parseMIMEType "text/plain"
165 partHeader ∷ Parser Headers
166 partHeader = crlf *> headers
168 getContDispo ∷ MonadError String m ⇒ Headers → m ContDispo
169 {-# INLINEABLE getContDispo #-}
171 = case getHeader "Content-Disposition" hdrs of
173 → throwError "Content-Disposition is missing"
175 → case parseOnly p $ A.toByteString str of
177 Left err → throwError $ "malformed Content-Disposition: "
182 p = do dispo ← contentDisposition
186 contentDisposition ∷ Parser ContDispo
188 = (ContDispo <$> (A.toCIAscii <$> token) ⊛ mimeParams)
192 getContType ∷ MonadError String m ⇒ Headers → m (Maybe MIMEType)
193 {-# INLINEABLE getContType #-}
195 = case getHeader "Content-Type" hdrs of
199 → case parseOnly p $ A.toByteString str of
200 Right d → return $ Just d
201 Left err → throwError $ "malformed Content-Type: "
210 getBody ∷ MonadError String m
213 → m (LS.ByteString, LS.ByteString)
214 {-# INLINEABLE getBody #-}
215 getBody (("\r\n--" ⊕) ∘ A.toByteString → boundary) src
216 = case breakOn boundary src of
219 → throwError "missing boundary"
221 → let len = fromIntegral $ BS.length boundary
222 after' = LS.drop len after
224 return (before, after')
226 partToFormPair ∷ MonadError String m ⇒ Part → m (Ascii, FormData)
227 {-# INLINEABLE partToFormPair #-}
228 partToFormPair pt@(Part {..})
229 | dType ptContDispo ≡ "form-data"
230 = do name ← partName pt
232 fdFileName = partFileName pt
233 , fdMIMEType = ptContType
238 = throwError $ "disposition type is not \"form-data\": "
239 ⧺ A.toString (A.fromCIAscii $ dType ptContDispo)
241 partName ∷ MonadError String m ⇒ Part → m Ascii
242 {-# INLINEABLE partName #-}
244 = case M.lookup "name" $ dParams ptContDispo of
246 → case A.fromText name of
248 Nothing → throwError $ "Non-ascii part name: "
251 → throwError $ "form-data without name: "
252 ⧺ A.toString (printContDispo ptContDispo)
254 partFileName ∷ Part → Maybe Text
255 partFileName (Part {..})
256 = M.lookup "filename" $ dParams ptContDispo