X-Git-Url: http://git.cielonegro.org/gitweb.cgi?p=Lucu.git;a=blobdiff_plain;f=Network%2FHTTP%2FLucu%2FMultipartForm.hs;h=98699e43ca37d2e2a2978236130f50b6a705c04a;hp=2d1b3470f1cf62a797a1336c183e8d54999589b9;hb=90fca0675b1694e69b8e431c989343855cbd125d;hpb=c9a269666f2d60d9c5ba817e1c43b45f6d77de22 diff --git a/Network/HTTP/Lucu/MultipartForm.hs b/Network/HTTP/Lucu/MultipartForm.hs index 2d1b347..98699e4 100644 --- a/Network/HTTP/Lucu/MultipartForm.hs +++ b/Network/HTTP/Lucu/MultipartForm.hs @@ -33,6 +33,7 @@ import Data.Collections import Data.Convertible.Base import Data.Convertible.Instances.Ascii () import Data.Convertible.Utils +import Data.Default import Data.List (intercalate) import Data.Maybe import Data.Monoid.Unicode @@ -40,9 +41,7 @@ import Data.Sequence (Seq) import Data.Text (Text) import Network.HTTP.Lucu.Headers 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.MIMEType import Network.HTTP.Lucu.Parser import Network.HTTP.Lucu.Parser.Http import Network.HTTP.Lucu.Utils @@ -87,8 +86,8 @@ deriveAttempts [ ([t| ContDispo |], [t| Ascii |]) , ([t| ContDispo |], [t| AsciiBuilder |]) ] --- |Parse \"multipart/form-data\" and return either @'Left' err@ or --- @'Right' result@. Note that there are currently the following +-- |Parse \"multipart/form-data\" to a list of @(name, +-- formData)@. Note that there are currently the following -- limitations: -- -- * Multiple files embedded as \"multipart/mixed\" within the @@ -97,9 +96,9 @@ deriveAttempts [ ([t| ContDispo |], [t| Ascii |]) -- * \"Content-Transfer-Encoding\" is always ignored. -- -- * RFC 2388 () says --- that non-ASCII field names are encoded according to the method in --- RFC 2047 (), but they won't --- be decoded. +-- that non-ASCII field names are encoded according to the method +-- in RFC 2047 (), but this +-- function currently doesn't decode them. parseMultipartFormData ∷ Ascii -- ^boundary → LS.ByteString -- ^input → Either String [(Ascii, FormData)] @@ -170,7 +169,8 @@ parsePart boundary src defaultCType = [mimeType| text/plain |] partHeader ∷ Parser Headers -partHeader = crlf *> headers +{-# INLINE partHeader #-} +partHeader = crlf *> def getContDispo ∷ MonadError String m ⇒ Headers → m ContDispo {-# INLINEABLE getContDispo #-} @@ -187,8 +187,9 @@ getContDispo hdrs ⊕ err contentDisposition ∷ Parser ContDispo +{-# INLINEABLE contentDisposition #-} contentDisposition - = (ContDispo <$> (cs <$> token) ⊛ mimeParams) + = (ContDispo <$> (cs <$> token) ⊛ def) "contentDisposition" @@ -199,7 +200,7 @@ getContType hdrs Nothing → return Nothing Just str - → case parseOnly (finishOff MT.mimeType) $ cs str of + → case parseOnly (finishOff def) $ cs str of Right d → return $ Just d Left err → throwError $ "malformed Content-Type: " ⊕ cs str