Bugfix

Ditz-issue: 8959dadc07db1bd363283dee401073f6e48dc7fa

diff --git a/Network/HTTP/Lucu/DefaultPage.hs b/Network/HTTP/Lucu/DefaultPage.hs
index c315424414857aba8b5ffe0d1047dac10c0db5bb..360a2686137a6a76539eafadede328bc4451d796 100644 (file)
--- a/Network/HTTP/Lucu/DefaultPage.hs
+++ b/Network/HTTP/Lucu/DefaultPage.hs
@@ -10,7 +10,7 @@ module Network.HTTP.Lucu.DefaultPage
     , mkDefaultPage
     )
     where
-import qualified Blaze.ByteString.Builder.ByteString as BB
+import qualified Blaze.ByteString.Builder.Char.Utf8 as BB
 import Control.Arrow
 import Control.Arrow.ArrowList
 import Control.Arrow.ListArrow
@@ -21,7 +21,6 @@ import qualified Data.Ascii as A
 import Data.Maybe
 import qualified Data.Text as T
 import qualified Data.Text.Lazy as Lazy
-import qualified Data.Text.Lazy.Encoding as Lazy
 import Network.HTTP.Lucu.Config
 import Network.HTTP.Lucu.Headers
 import Network.HTTP.Lucu.Interaction
@@ -55,8 +54,7 @@ writeDefaultPage !itr
                        let conf = itrConfig itr
                            page = getDefaultPage conf reqM res
 
-                       putTMVar (itrBodyToSend itr)
-                                (BB.fromLazyByteString $ Lazy.encodeUtf8 page)
+                       putTMVar (itrBodyToSend itr) (BB.fromLazyText page)
 
 mkDefaultPage ∷ (ArrowXml a) ⇒ Config → StatusCode → a b XmlTree → a b XmlTree
 {-# INLINEABLE mkDefaultPage #-}

diff --git a/Network/HTTP/Lucu/RFC2231.hs b/Network/HTTP/Lucu/RFC2231.hs
index 0f2eb136d7a00da9303f3fb7aa59834634ddf111..9856f474eb94281b8280fc9110780fe43643a278 100644 (file)
--- a/Network/HTTP/Lucu/RFC2231.hs
+++ b/Network/HTTP/Lucu/RFC2231.hs
@@ -32,8 +32,8 @@ import Data.Sequence.Unicode hiding ((∅))
 import Data.Text (Text)
 import qualified Data.Text as T
 import qualified Data.Text.ICU.Convert as TC
-import Data.Text.ICU.Error
 import Data.Text.Encoding
+import Data.Text.ICU.Error
 import Data.Traversable
 import Data.Word
 import Network.HTTP.Lucu.Parser.Http

diff --git a/Network/HTTP/Lucu/Resource.hs b/Network/HTTP/Lucu/Resource.hs
index 0caf6ceb7dbf6479e8dfa4141609872f0381e945..a54e04061c4ca9051a9cc4f71761a748d67e1153 100644 (file)
--- a/Network/HTTP/Lucu/Resource.hs
+++ b/Network/HTTP/Lucu/Resource.hs
@@ -652,7 +652,8 @@ input limit
                             -- 成功。itr 内にチャンクを置いたままにする
                             -- とメモリの無駄になるので除去。
                             chunk ← readItr itrReceivedBody seqToLBS itr
-                            writeItr itrReceivedBody (∅) itr
+                            writeItr itrReceivedBody    (∅) itr
+                            writeItr itrReceivedBodyLen 0   itr
                             return chunk
 
                driftTo DecidingHeader
@@ -715,7 +716,8 @@ inputChunk limit
                                          $ retry
                             -- 成功
                             chunk ← readItr itrReceivedBody seqToLBS itr
-                            writeItr itrReceivedBody (∅) itr
+                            writeItr itrReceivedBody    (∅) itr
+                            writeItr itrReceivedBodyLen 0   itr
                             return chunk
                when (Lazy.null chunk)
                    $ driftTo DecidingHeader