multipart 0.1.2 → 0.1.3

raw patch · 4 files changed

+44/−102 lines, 4 filesdep +stringsearchdep ~bytestringPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: stringsearch

Dependency ranges changed: bytestring

API changes (from Hackage documentation)

Files

• CHANGELOG.md +4/−0
• Network/Multipart.hs +26/−89
• Network/Multipart/Header.hs +11/−11
• multipart.cabal +3/−2

@@ -1,5 +1,9 @@ # Changelog +### 0.1.3++* Improve performance of parsing multipart body. Thanks to Ali Abrar.+ ### 0.1.2  * Expose `Network.Multipart.Header`

@@ -1,3 +1,4 @@+{-# LANGUAGE OverloadedStrings #-} -- #hide  -----------------------------------------------------------------------------@@ -32,7 +33,6 @@     ) where  import Control.Monad-import Data.Int (Int64) import Data.List (intersperse) import Data.Maybe import System.IO (Handle)@@ -41,6 +41,7 @@  import qualified Data.ByteString.Lazy.Char8 as BS import Data.ByteString.Lazy.Char8 (ByteString)+import Data.ByteString.Lazy.Search (breakOn)  -- -- * Multi-part stuff.@@ -65,14 +66,11 @@                   -> IO MultiPart hGetMultipartBody b = liftM (parseMultipartBody b) . BS.hGetContents -- parseBodyPart :: ByteString -> Maybe BodyPart-parseBodyPart s =-    do-    let (hdr,bdy) = splitAtEmptyLine s-    hs <- parseM pHeaders "<input>" (BS.unpack hdr)-    return $ BodyPart hs bdy+parseBodyPart s = do+  let (hdr,bdy) = splitAtEmptyLine s+  hs <- parseM pHeaders "<input>" (BS.unpack hdr)+  return $ BodyPart hs bdy  showMultipartBody :: String -> MultiPart -> ByteString showMultipartBody b (MultiPart bs) =@@ -84,7 +82,6 @@ showBodyPart (BodyPart hs c) =     unlinesCRLF $ [BS.pack (n++": "++v) | (HeaderName n,v) <- hs] ++ [BS.empty,c] - -- -- * Splitting into multipart parts. --@@ -105,9 +102,9 @@ dropPreamble :: ByteString -- ^ The boundary, without the initial dashes              -> ByteString              -> ByteString-dropPreamble b s | BS.null s = BS.empty-                 | isBoundary b s = dropLine s-                 | otherwise = dropPreamble b (dropLine s)+dropPreamble b s = case splitAtBoundary b s of+  Nothing -> BS.empty+  Just (_,_,v) -> v  -- | Split a string at the first boundary line. splitAtBoundary :: ByteString -- ^ The boundary, without the initial dashes@@ -118,35 +115,23 @@                    --   before and the CRLF (if any) after the boundary line                    --   are not included in any of the strings returned.                    --   Returns 'Nothing' if there is no boundary.-splitAtBoundary b s = spl 0-  where-  spl i = case findCRLF (BS.drop i s) of-              Nothing -> Nothing-              Just (j,l) | isBoundary b s2 -> Just (s1,d,s3)-                         | otherwise -> spl (i+j+l)-                  where-                  s1 = BS.take (i+j) s-                  s2 = BS.drop (i+j+l) s-                  (d,s3) = splitAtCRLF s2---- | Check whether a string starts with two dashes followed by---   the given boundary string.-isBoundary :: ByteString -- ^ The boundary, without the initial dashes-           -> ByteString-           -> Bool-isBoundary b s = startsWithDashes s && b `BS.isPrefixOf` BS.drop 2 s+splitAtBoundary b s =+  let bcrlf = BS.append "\r\n--" b+      (before, t) = breakOn (BS.toStrict bcrlf) s+  in case BS.stripPrefix bcrlf t of+       Nothing -> Nothing+       Just t' ->+         let after = case BS.stripPrefix "\r\n" t' of+               Nothing -> t'+               Just t'' -> t''+         in  Just (before, bcrlf, after)  -- | Check whether a string for which 'isBoundary' returns true --   has two dashes after the boudary string. isClose :: ByteString -- ^ The boundary, without the initial dashes         -> ByteString         -> Bool-isClose b s = startsWithDashes (BS.drop (2+BS.length b) s)---- | Checks whether a string starts with two dashes.-startsWithDashes :: ByteString -> Bool-startsWithDashes s = BS.pack "--" `BS.isPrefixOf` s-+isClose b s = BS.isPrefixOf (BS.append "--" (BS.append b "--")) s  -- -- * RFC 2046 CRLF@@ -158,63 +143,15 @@ unlinesCRLF :: [ByteString] -> ByteString unlinesCRLF = BS.concat . intersperse crlf --- | Drop everything up to and including the first CRLF.-dropLine :: ByteString -> ByteString-dropLine s = snd (splitAtCRLF s)- -- | Split a string at the first empty line. The CRLF (if any) before the --   empty line is included in the first result. The CRLF after the --   empty line is not included in the result. --   If there is no empty line, the entire input is returned --   as the first result. splitAtEmptyLine :: ByteString -> (ByteString, ByteString)-splitAtEmptyLine s | startsWithCRLF s = (BS.empty, dropCRLF s)-                   | otherwise = spl 0-  where-  spl i = case findCRLF (BS.drop i s) of-              Nothing -> (s, BS.empty)-              Just (j,l) | startsWithCRLF s2 -> (s1, dropCRLF s2)-                         | otherwise -> spl (i+j+l)-                where (s1,s2) = BS.splitAt (i+j+l) s---- | Split a string at the first CRLF. The CRLF is not included---   in any of the returned strings.---   If there is no CRLF, the entire input is returned---   as the first string.-splitAtCRLF :: ByteString -- ^ String to split.-            -> (ByteString,ByteString)-splitAtCRLF s = case findCRLF s of-                  Nothing -> (s,BS.empty)-                  Just (i,l) -> (s1, BS.drop l s2)-                      where (s1,s2) = BS.splitAt i s---- | Get the index and length of the first CRLF, if any.-findCRLF :: ByteString -- ^ String to split.-         -> Maybe (Int64,Int64)-findCRLF s =-    case findCRorLF s of-              Nothing -> Nothing-              Just j | BS.null (BS.drop (j+1) s) -> Just (j,1)-              Just j -> case (BS.index s j, BS.index s (j+1)) of-                           ('\n','\r') -> Just (j,2)-                           ('\r','\n') -> Just (j,2)-                           _           -> Just (j,1)--findCRorLF :: ByteString -> Maybe Int64-findCRorLF s = BS.findIndex (\c -> c == '\n' || c == '\r') s--startsWithCRLF :: ByteString -> Bool-startsWithCRLF s = not (BS.null s) && (c == '\n' || c == '\r')-  where c = BS.index s 0---- | Drop an initial CRLF, if any. If the string is empty,---   nothing is done. If the string does not start with CRLF,---   the first character is dropped.-dropCRLF :: ByteString -> ByteString-dropCRLF s | BS.null s = BS.empty-           | BS.null (BS.drop 1 s) = BS.empty-           | c0 == '\n' && c1 == '\r' = BS.drop 2 s-           | c0 == '\r' && c1 == '\n' = BS.drop 2 s-           | otherwise = BS.drop 1 s-  where c0 = BS.index s 0-        c1 = BS.index s 1+splitAtEmptyLine s =+  let blank = "\r\n\r\n"+      (before, after) = breakOn (BS.toStrict blank) s+  in case BS.stripPrefix blank after of+       Nothing -> (before, after)+       Just after' -> (BS.append before "\r\n", after')

@@ -46,7 +46,7 @@ import Control.Monad import Data.Char import Data.List-import Data.Monoid+import qualified Data.Monoid as M  import Text.ParserCombinators.Parsec @@ -142,7 +142,7 @@ --   See <http://www.ietf.org/rfc/rfc2046.txt> for more --   information about MIME media types. data ContentType =-	ContentType {+    ContentType {                      -- | The top-level media type, the general type                      --   of the data. Common examples are                      --   \"text\", \"image\", \"audio\", \"video\",@@ -165,9 +165,9 @@              && ctParameters x == ctParameters y  instance Ord ContentType where-    x `compare` y = mconcat [ctType x `caseInsensitiveCompare` ctType y,-                             ctSubtype x `caseInsensitiveCompare` ctSubtype y,-                             ctParameters x `compare` ctParameters y]+    x `compare` y = M.mconcat [ctType x `caseInsensitiveCompare` ctType y,+                               ctSubtype x `caseInsensitiveCompare` ctSubtype y,+                               ctParameters x `compare` ctParameters y]  instance HeaderValue ContentType where     parseHeaderValue =@@ -197,7 +197,7 @@ --  data ContentTransferEncoding =-	ContentTransferEncoding String+    ContentTransferEncoding String     deriving (Show, Read, Eq, Ord)  instance HeaderValue ContentTransferEncoding where@@ -215,7 +215,7 @@ --  data ContentDisposition =-	ContentDisposition String [(String, String)]+    ContentDisposition String [(String, String)]     deriving (Show, Read, Eq, Ord)  instance HeaderValue ContentDisposition where@@ -271,9 +271,9 @@  literalString :: Parser String literalString = do _ <- char '\"'-		   str <- many (noneOf "\"\\" <|> quoted_pair)-		   _ <- char '\"'-		   return str+                   str <- many (noneOf "\"\\" <|> quoted_pair)+                   _ <- char '\"'+                   return str  -- No web browsers seem to implement RFC 2046 correctly, -- since they do not escape double quotes and backslashes@@ -306,4 +306,4 @@  quoted_pair :: Parser Char quoted_pair = do _ <- char '\\'-		 p_text+                 p_text

@@ -1,5 +1,5 @@ name:                multipart-version:             0.1.2+version:             0.1.3 synopsis:            HTTP multipart split out of the cgi package description:         HTTP multipart split out of the cgi package copyright:           Bjorn Bringert, Andy Gill, Anders Kaseorg, Ian Lynagh, Erik Meijer, Sven Panne, Jeremy Shaw@@ -29,5 +29,6 @@     Network.Multipart.Header   build-depends:       base >= 3 && < 5-    , bytestring+    , bytestring >= 0.10.8.0 && < 0.11     , parsec >= 2.0+    , stringsearch