From: PHO Date: Tue, 4 Oct 2011 06:01:52 +0000 (+0900) Subject: Bugfix X-Git-Url: https://git.cielonegro.org/gitweb.cgi?a=commitdiff_plain;h=a19fa7dbe9bfcd75db8b42e113fabcf97e40d8bd;p=Lucu.git Bugfix Ditz-issue: 8959dadc07db1bd363283dee401073f6e48dc7fa --- diff --git a/Network/HTTP/Lucu/DefaultPage.hs b/Network/HTTP/Lucu/DefaultPage.hs index c315424..360a268 100644 --- 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 0f2eb13..9856f47 100644 --- 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 0caf6ce..a54e040 100644 --- 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