From: PHO <pho@cielonegro.org>
Date: Mon, 31 Oct 2011 16:28:48 +0000 (+0900)
Subject: bugfix
X-Git-Url: https://git.cielonegro.org/gitweb.cgi?a=commitdiff_plain;h=2089e7b8c07ae67292073b4113eb14d858a4a2c0;p=Lucu.git

bugfix

Ditz-issue: 8959dadc07db1bd363283dee401073f6e48dc7fa
---

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:
 -- <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
@@ -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 #-}
diff --git a/examples/SSL.hs b/examples/SSL.hs
index 48b2381..6df2ab7 100644
--- a/examples/SSL.hs
+++ b/examples/SSL.hs
@@ -41,12 +41,12 @@ helloWorld
     = emptyResource {
         resGet
           = Just $ do setContentType $ parseMIMEType "text/plain"
-                      outputChunk "getRemoteCertificate = "
+                      putChunk "getRemoteCertificate = "
                       cert ← do cert ← getRemoteCertificate
                                 case cert of
                                   Just c  → liftIO $ Lazy.pack <$> printX509 c
                                   Nothing → return "Nothing"
-                      outputChunk cert
+                      putChunks cert
       }
 
 genCert ∷ KeyPair k ⇒ k → IO X509