X-Git-Url: http://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;f=Network%2FHTTP%2FLucu%2FDefaultPage.hs;h=f53501f707f1b36d2dec25f021607a42e694e9cf;hb=15aa04a569fb13fb0793389f78f52b0255083cef;hp=b4413ce96b1a7017399bc65a9893b1a2b3954da6;hpb=0dc3d31312a12f2b085242841b29eb0d96e9c4ac;p=Lucu.git diff --git a/Network/HTTP/Lucu/DefaultPage.hs b/Network/HTTP/Lucu/DefaultPage.hs index b4413ce..f53501f 100644 --- a/Network/HTTP/Lucu/DefaultPage.hs +++ b/Network/HTTP/Lucu/DefaultPage.hs @@ -9,7 +9,8 @@ import Control.Arrow import Control.Arrow.ArrowList import Control.Concurrent.STM import Control.Monad -import qualified Data.ByteString.Lazy.Char8 as B +import qualified Data.ByteString.Char8 as C8 +import qualified Data.ByteString.Lazy.Char8 as L8 import Data.Maybe import Network import Network.HTTP.Lucu.Config @@ -47,11 +48,11 @@ writeDefaultPage itr -- Content-Type が正しくなければ補完できない。 res <- readItr itr itrResponse id - when (getHeader "Content-Type" res == Just defaultPageContentType) + when (getHeader (C8.pack "Content-Type") res == Just defaultPageContentType) $ do reqM <- readItr itr itrRequest id let conf = itrConfig itr - page = B.pack $ getDefaultPage conf reqM res + page = L8.pack $ getDefaultPage conf reqM res writeTVar (itrBodyToSend itr) $ page @@ -61,9 +62,9 @@ mkDefaultPage :: (ArrowXml a) => Config -> StatusCode -> a b XmlTree -> a b XmlT mkDefaultPage conf status msgA = conf `seq` status `seq` msgA `seq` let (# sCode, sMsg #) = statusCode status - sig = cnfServerSoftware conf + sig = C8.unpack (cnfServerSoftware conf) ++ " at " - ++ cnfServerHost conf + ++ C8.unpack (cnfServerHost conf) ++ ( case cnfServerPort conf of Service serv -> ", service " ++ serv PortNumber num -> ", port " ++ show num @@ -164,6 +165,6 @@ getMsg req res uriPath uri loc :: String - loc = fromJust $! getHeader "Location" res + loc = C8.unpack $! fromJust $! getHeader (C8.pack "Location") res {-# SPECIALIZE getMsg :: Maybe Request -> Response -> IOSArrow b XmlTree #-} \ No newline at end of file