X-Git-Url: http://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;f=Network%2FHTTP%2FLucu%2FMultipartForm.hs;h=a04b4a059f9a28c7e10b3ffc6b7f144b30df0252;hb=9b2a30d;hp=53174fa94d0a2f0ac448e4a53182800e5da64c43;hpb=a362be1c8664306b970c32e1df9b62081498feb1;p=Lucu.git

diff --git a/Network/HTTP/Lucu/MultipartForm.hs b/Network/HTTP/Lucu/MultipartForm.hs
index 53174fa..a04b4a0 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:
 -- <http://www.faqs.org/rfcs/rfc2388.html>
@@ -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
@@ -45,8 +47,11 @@ import Prelude.Unicode
 -- name.
 data FormData
     = FormData {
+        -- | @'Nothing'@ for non-file values.
         fdFileName ∷ !(Maybe Text)
+        -- | MIME Type of this value, defaulted to \"text/plain\".
       , fdMIMEType ∷ !MIMEType
+        -- | The form value.
       , fdContent  ∷ !(LS.ByteString)
       }
 
@@ -75,13 +80,13 @@ printContDispo d
 -- limitations:
 --
 --   * Multiple files embedded as \"multipart/mixed\" within the
---     \"multipart/form-data\" aren't decomposed.
+--     \"multipart/form-data\" won't be decomposed.
 --
---   * \"Content-Transfer-Encoding\"s are always ignored.
+--   * \"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 aren't
+--     <http://www.faqs.org/rfcs/rfc2047.html>, but they won't be
 --     decoded.
 parseMultipartFormData ∷ Ascii -- ^boundary
                        → LS.ByteString -- ^input
@@ -207,11 +212,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 #-}