X-Git-Url: http://git.cielonegro.org/gitweb.cgi?p=Lucu.git;a=blobdiff_plain;f=Network%2FHTTP%2FLucu%2FMultipartForm.hs;h=edba0d50f1e33e589feeb10b57ec71dbe4ebb3da;hp=53174fa94d0a2f0ac448e4a53182800e5da64c43;hb=2089e7b;hpb=a362be1c8664306b970c32e1df9b62081498feb1 diff --git a/Network/HTTP/Lucu/MultipartForm.hs b/Network/HTTP/Lucu/MultipartForm.hs index 53174fa..edba0d5 100644 --- a/Network/HTTP/Lucu/MultipartForm.hs +++ b/Network/HTTP/Lucu/MultipartForm.hs @@ -5,6 +5,7 @@ , RecordWildCards , ScopedTypeVariables , UnicodeSyntax + , ViewPatterns #-} -- |Parse \"multipart/form-data\" based on RFC 2388: -- @@ -23,7 +24,8 @@ import Data.Ascii (Ascii, CIAscii) 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 @@ -207,11 +209,16 @@ getBody ∷ MonadError String m → 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 #-}