From: pho <pho@cielonegro.org>
Date: Sat, 6 Oct 2007 04:26:52 +0000 (+0900)
Subject: Optimization
X-Git-Tag: RELEASE-0_2_1~24
X-Git-Url: https://git.cielonegro.org/gitweb.cgi?a=commitdiff_plain;h=15aa04a569fb13fb0793389f78f52b0255083cef;p=Lucu.git

Optimization

darcs-hash:20071006042652-62b54-27eecc2bc5a40307ae62ee99050030ce1db2d050.gz
---

diff --git a/Network/HTTP/Lucu/Abortion.hs b/Network/HTTP/Lucu/Abortion.hs
index 9ff629d..0a5ed07 100644
--- a/Network/HTTP/Lucu/Abortion.hs
+++ b/Network/HTTP/Lucu/Abortion.hs
@@ -16,8 +16,9 @@ import           Control.Arrow.ArrowIO
 import           Control.Concurrent.STM
 import           Control.Exception
 import           Control.Monad.Trans
-import           GHC.Conc (unsafeIOToSTM)
+import           Data.ByteString.Base (ByteString)
 import           Data.Dynamic
+import           GHC.Conc (unsafeIOToSTM)
 import           Network.HTTP.Lucu.Config
 import           Network.HTTP.Lucu.DefaultPage
 import           Network.HTTP.Lucu.Headers
@@ -60,24 +61,24 @@ data Abortion = Abortion {
 -- > abort MovedPermanently
 -- >       [("Location", "http://example.net/")]
 -- >       (Just "It has been moved to example.net")
-abort :: MonadIO m => StatusCode -> [ (String, String) ] -> Maybe String -> m a
+abort :: MonadIO m => StatusCode -> [ (ByteString, ByteString) ] -> Maybe String -> m a
 abort status headers msg
     = status `seq` headers `seq` msg `seq`
-      let abo = Abortion status headers msg
+      let abo = Abortion status (toHeaders headers) msg
           exc = DynException (toDyn abo)
       in
         liftIO $ throwIO exc
 
 -- |Computation of @'abortSTM' status headers msg@ just computes
 -- 'abort' in a 'Control.Monad.STM.STM' monad.
-abortSTM :: StatusCode -> [ (String, String) ] -> Maybe String -> STM a
+abortSTM :: StatusCode -> [ (ByteString, ByteString) ] -> Maybe String -> STM a
 abortSTM status headers msg
     = status `seq` headers `seq` msg `seq`
       unsafeIOToSTM $! abort status headers msg
 
 -- | Computation of @'abortA' -< (status, (headers, msg))@ just
 -- computes 'abort' in an 'Control.Arrow.ArrowIO.ArrowIO'.
-abortA :: ArrowIO a => a (StatusCode, ([ (String, String) ], Maybe String)) c
+abortA :: ArrowIO a => a (StatusCode, ([ (ByteString, ByteString) ], Maybe String)) c
 abortA 
     = arrIO3 abort
 
@@ -99,7 +100,7 @@ abortPage conf reqM res abo
         Nothing
             -> let res'  = res { resStatus = aboStatus abo }
                    res'' = foldl (.) id [setHeader name value
-                                             | (name, value) <- aboHeaders abo]
+                                             | (name, value) <- fromHeaders $ aboHeaders abo]
                            $ res'
                in
                  getDefaultPage conf reqM res''
diff --git a/Network/HTTP/Lucu/Config.hs b/Network/HTTP/Lucu/Config.hs
index 3d256ed..0784384 100644
--- a/Network/HTTP/Lucu/Config.hs
+++ b/Network/HTTP/Lucu/Config.hs
@@ -5,6 +5,8 @@ module Network.HTTP.Lucu.Config
     )
     where
 
+import           Data.ByteString.Base (ByteString)
+import qualified Data.ByteString.Char8 as C8
 import           Network
 import           Network.BSD
 import           Network.HTTP.Lucu.MIMEType.Guess
@@ -15,10 +17,10 @@ import           System.IO.Unsafe
 -- 'defaultConfig' or setup your own configuration to run the httpd.
 data Config = Config {
     -- |A string which will be sent to clients as \"Server\" field.
-      cnfServerSoftware :: !String
+      cnfServerSoftware :: !ByteString
     -- |The host name of the server. This value will be used in
     -- built-in pages like \"404 Not Found\".
-    , cnfServerHost :: !HostName
+    , cnfServerHost :: !ByteString
     -- |A port ID to listen to HTTP clients.
     , cnfServerPort :: !PortID
     -- |The maximum number of requests to accept in one connection
@@ -59,8 +61,8 @@ data Config = Config {
 -- 'cnfServerPort'.
 defaultConfig :: Config
 defaultConfig = Config {
-                  cnfServerSoftware              = "Lucu/1.0"
-                , cnfServerHost                  = unsafePerformIO getHostName
+                  cnfServerSoftware              = C8.pack "Lucu/1.0"
+                , cnfServerHost                  = C8.pack (unsafePerformIO getHostName)
                 , cnfServerPort                  = Service "http"
                 , cnfMaxPipelineDepth            = 100
                 , cnfMaxEntityLength             = 16 * 1024 * 1024 -- 16 MiB
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
diff --git a/Network/HTTP/Lucu/Headers.hs b/Network/HTTP/Lucu/Headers.hs
index 65a4940..c97c93c 100644
--- a/Network/HTTP/Lucu/Headers.hs
+++ b/Network/HTTP/Lucu/Headers.hs
@@ -1,51 +1,139 @@
 module Network.HTTP.Lucu.Headers
     ( Headers
     , HasHeaders(..)
+
+    , noCaseCmp
+    , noCaseEq
+
     , emptyHeaders
+    , toHeaders
+    , fromHeaders
+
     , headersP
     , hPutHeaders
     )
     where
 
+import           Data.ByteString.Base (ByteString, toForeignPtr, w2c, inlinePerformIO)
+import qualified Data.ByteString.Char8 as C8
 import           Data.Char
 import           Data.List
+import           Data.Map (Map)
+import qualified Data.Map as M
+import           Data.Word
+import           Foreign.ForeignPtr
+import           Foreign.Ptr
+import           Foreign.Storable
 import           Network.HTTP.Lucu.Parser
 import           Network.HTTP.Lucu.Parser.Http
 import           Network.HTTP.Lucu.Utils
 import           System.IO
 
-type Headers = [ (String, String) ]
+type Headers = Map NCBS ByteString
+newtype NCBS = NCBS ByteString
+
+toNCBS :: ByteString -> NCBS
+toNCBS = NCBS
+{-# INLINE toNCBS #-}
+
+fromNCBS :: NCBS -> ByteString
+fromNCBS (NCBS x) = x
+{-# INLINE fromNCBS #-}
+
+instance Eq NCBS where
+    (NCBS a) == (NCBS b) = a == b
+
+instance Ord NCBS where
+    (NCBS a) `compare` (NCBS b) = a `noCaseCmp` b
+
+instance Show NCBS where
+    show (NCBS x) = show x
+
+noCaseCmp :: ByteString -> ByteString -> Ordering
+noCaseCmp a b = toForeignPtr a `cmp` toForeignPtr b
+    where
+      cmp :: (ForeignPtr Word8, Int, Int) -> (ForeignPtr Word8, Int, Int) -> Ordering
+      cmp (x1, s1, l1) (x2, s2, l2)
+          | l1 == 0  && l2 == 0               = EQ
+          | x1 == x2 && s1 == s2 && l1 == l2  = EQ
+          | otherwise
+              = inlinePerformIO $
+                withForeignPtr x1 $ \ p1 ->
+                withForeignPtr x2 $ \ p2 ->
+                noCaseCmp' (p1 `plusPtr` s1) l1 (p2 `plusPtr` s2) l2
+{-# INLINE noCaseCmp #-}
+
+-- もし先頭の文字列が等しければ、短い方が小さい。
+noCaseCmp' :: Ptr Word8 -> Int -> Ptr Word8 -> Int -> IO Ordering
+noCaseCmp' p1 l1 p2 l2
+    | l1 == 0 && l2 == 0 = return EQ
+    | l1 == 0 && l1 /= 0 = return LT
+    | l1 /= 0 && l2 == 0 = return GT
+    | otherwise
+        = do c1 <- peek p1
+             c2 <- peek p2
+             case toLower (w2c c1) `compare` toLower (w2c c2) of
+               EQ -> noCaseCmp' (p1 `plusPtr` 1) (l1 - 1) (p2 `plusPtr` 1) (l2 - 1)
+               x  -> return x
+
+
+noCaseEq :: ByteString -> ByteString -> Bool
+noCaseEq a b = toForeignPtr a `cmp` toForeignPtr b
+    where
+      cmp :: (ForeignPtr Word8, Int, Int) -> (ForeignPtr Word8, Int, Int) -> Bool
+      cmp (x1, s1, l1) (x2, s2, l2)
+          | l1 /= l2                          = False
+          | l1 == 0  && l2 == 0               = True
+          | x1 == x2 && s1 == s2 && l1 == l2  = True
+          | otherwise
+              = inlinePerformIO $
+                withForeignPtr x1 $ \ p1 ->
+                withForeignPtr x2 $ \ p2 ->
+                noCaseEq' (p1 `plusPtr` s1) (p2 `plusPtr` s2) l1
+
+
+noCaseEq' :: Ptr Word8 -> Ptr Word8 -> Int -> IO Bool
+noCaseEq' p1 p2 l
+    | l == 0    = return True
+    | otherwise
+        = do c1 <- peek p1
+             c2 <- peek p2
+             if toLower (w2c c1) == toLower (w2c c2) then
+                 noCaseEq' (p1 `plusPtr` 1) (p2 `plusPtr` 1) (l - 1)
+               else
+                 return False
+
 
 class HasHeaders a where
     getHeaders :: a -> Headers
     setHeaders :: a -> Headers -> a
 
-    getHeader :: String -> a -> Maybe String
+    getHeader :: ByteString -> a -> Maybe ByteString
     getHeader key a
         = key `seq` a `seq`
-          fmap snd $ find (noCaseEq' key . fst) (getHeaders a)
+          M.lookup (toNCBS key) (getHeaders a)
 
-    deleteHeader :: String -> a -> a
+    deleteHeader :: ByteString -> a -> a
     deleteHeader key a
         = key `seq` a `seq`
-          setHeaders a $ filter (not . noCaseEq' key . fst) (getHeaders a)
-
-    addHeader :: String -> String -> a -> a
-    addHeader key val a
-        = key `seq` val `seq` a `seq`
-          setHeaders a $ (getHeaders a) ++ [(key, val)]
+          setHeaders a $ M.delete (toNCBS key) (getHeaders a)
 
-    setHeader :: String -> String -> a -> a
+    setHeader :: ByteString -> ByteString -> a -> a
     setHeader key val a
         = key `seq` val `seq` a `seq`
-          let list    = getHeaders a
-              deleted = filter (not . noCaseEq' key . fst) list
-              added   = deleted ++ [(key, val)]
-          in 
-            setHeaders a added
+          setHeaders a $ M.insert (toNCBS key) val (getHeaders a)
+
 
 emptyHeaders :: Headers
-emptyHeaders = []
+emptyHeaders = M.empty
+
+
+toHeaders :: [(ByteString, ByteString)] -> Headers
+toHeaders xs = M.fromList [(toNCBS a, b) | (a, b) <- xs]
+
+
+fromHeaders :: Headers -> [(ByteString, ByteString)]
+fromHeaders hs = [(fromNCBS a, b) | (a, b) <- M.toList hs]
 
 
 {-
@@ -62,9 +150,9 @@ emptyHeaders = []
 headersP :: Parser Headers
 headersP = do xs <- many header
               crlf
-              return xs
+              return (M.fromList xs)
     where
-      header :: Parser (String, String)
+      header :: Parser (NCBS, ByteString)
       header = do name <- token
                   char ':'
                   -- FIXME: これは多少インチキだが、RFC 2616 のこの部分
@@ -76,7 +164,8 @@ headersP = do xs <- many header
                   contents <- many (lws <|> many1 text)
                   crlf
                   let value = foldr (++) "" contents
-                  return (name, normalize value)
+                      norm  = normalize value
+                  return (toNCBS $ C8.pack name, C8.pack norm)
 
       normalize :: String -> String
       normalize = trimBody . trim isWhiteSpace
@@ -95,12 +184,12 @@ headersP = do xs <- many header
 hPutHeaders :: Handle -> Headers -> IO ()
 hPutHeaders h hds
     = h `seq` hds `seq`
-      mapM_ putH hds >> hPutStr h "\r\n"
+      mapM_ putH (M.toList hds) >> hPutStr h "\r\n"
     where
-      putH :: (String, String) -> IO ()
+      putH :: (NCBS, ByteString) -> IO ()
       putH (name, value)
           = name `seq` value `seq`
-            do hPutStr h name
-               hPutStr h ": "
-               hPutStr h value
-               hPutStr h "\r\n"
+            do C8.hPutStr h (fromNCBS name)
+               C8.hPutStr h (C8.pack ": ")
+               C8.hPutStr h value
+               C8.hPutStr h (C8.pack "\r\n")
diff --git a/Network/HTTP/Lucu/Interaction.hs b/Network/HTTP/Lucu/Interaction.hs
index 91979c9..3445219 100644
--- a/Network/HTTP/Lucu/Interaction.hs
+++ b/Network/HTTP/Lucu/Interaction.hs
@@ -15,12 +15,14 @@ module Network.HTTP.Lucu.Interaction
     where
 
 import           Control.Concurrent.STM
-import qualified Data.ByteString.Lazy.Char8 as B
-import           Data.ByteString.Lazy.Char8 (ByteString)
+import           Data.ByteString.Base (ByteString, LazyByteString)
+import           Data.ByteString.Char8 as C8
+import qualified Data.ByteString.Lazy.Char8 as L8
 import qualified Data.Sequence as S
 import           Data.Sequence (Seq)
 import           Network.Socket
 import           Network.HTTP.Lucu.Config
+import           Network.HTTP.Lucu.Headers
 import           Network.HTTP.Lucu.HttpVersion
 import           Network.HTTP.Lucu.Request
 import           Network.HTTP.Lucu.Response
@@ -43,14 +45,14 @@ data Interaction = Interaction {
     , itrReqChunkIsOver    :: !(TVar Bool)
     , itrReqBodyWanted     :: !(TVar (Maybe Int))
     , itrReqBodyWasteAll   :: !(TVar Bool)
-    , itrReceivedBody      :: !(TVar ByteString) -- Resource が受領した部分は削除される
+    , itrReceivedBody      :: !(TVar LazyByteString) -- Resource が受領した部分は削除される
 
     , itrWillReceiveBody   :: !(TVar Bool)
     , itrWillChunkBody     :: !(TVar Bool)
     , itrWillDiscardBody   :: !(TVar Bool)
     , itrWillClose         :: !(TVar Bool)
 
-    , itrBodyToSend :: !(TVar ByteString)
+    , itrBodyToSend :: !(TVar LazyByteString)
     , itrBodyIsNull :: !(TVar Bool)
 
     , itrState :: !(TVar InteractionState)
@@ -75,8 +77,8 @@ newInteractionQueue :: IO InteractionQueue
 newInteractionQueue = newTVarIO S.empty
 
 
-defaultPageContentType :: String
-defaultPageContentType = "application/xhtml+xml"
+defaultPageContentType :: ByteString
+defaultPageContentType = C8.pack "application/xhtml+xml"
 
 
 newInteraction :: Config -> SockAddr -> Maybe Request -> IO Interaction
@@ -86,7 +88,7 @@ newInteraction conf addr req
          responce <- newTVarIO $ Response {
                        resVersion = HttpVersion 1 1
                      , resStatus  = Ok
-                     , resHeaders = [("Content-Type", defaultPageContentType)]
+                     , resHeaders = toHeaders [(C8.pack "Content-Type", defaultPageContentType)]
                      }
 
          requestHasBody     <- newTVarIO False
@@ -98,14 +100,14 @@ newInteraction conf addr req
          reqChunkIsOver     <- newTVarIO False   -- 最後のチャンクを讀み終へた
          reqBodyWanted      <- newTVarIO Nothing -- Resource が要求してゐるチャンク長
          reqBodyWasteAll    <- newTVarIO False   -- 殘りの body を讀み捨てよと云ふ要求
-         receivedBody       <- newTVarIO B.empty
+         receivedBody       <- newTVarIO L8.empty
 
          willReceiveBody   <- newTVarIO False
          willChunkBody     <- newTVarIO False
          willDiscardBody   <- newTVarIO False
          willClose         <- newTVarIO False
 
-         bodyToSend <- newTVarIO B.empty
+         bodyToSend <- newTVarIO L8.empty
          bodyIsNull <- newTVarIO True -- 一度でも bodyToSend が空でなくなったら False
 
          state <- newTVarIO ExaminingRequest
diff --git a/Network/HTTP/Lucu/Postprocess.hs b/Network/HTTP/Lucu/Postprocess.hs
index 062a3bf..6e8a5e6 100644
--- a/Network/HTTP/Lucu/Postprocess.hs
+++ b/Network/HTTP/Lucu/Postprocess.hs
@@ -6,7 +6,9 @@ module Network.HTTP.Lucu.Postprocess
 
 import           Control.Concurrent.STM
 import           Control.Monad
-import           Data.Char
+import           Data.ByteString.Base (ByteString)
+import qualified Data.ByteString.Char8 as C8
+import           Data.IORef
 import           Data.Maybe
 import           GHC.Conc (unsafeIOToSTM)
 import           Network.HTTP.Lucu.Abortion
@@ -18,6 +20,7 @@ import           Network.HTTP.Lucu.RFC1123DateTime
 import           Network.HTTP.Lucu.Request
 import           Network.HTTP.Lucu.Response
 import           System.Time
+import           System.IO.Unsafe
 
 {-
   
@@ -64,11 +67,11 @@ postprocess itr
                         $ Just ("The status code is not good for a final status: "
                                 ++ show sc)
 
-         when (sc == MethodNotAllowed && getHeader "Allow" res == Nothing)
+         when (sc == MethodNotAllowed && getHeader (C8.pack "Allow") res == Nothing)
                   $ abortSTM InternalServerError []
                         $ Just ("The status was " ++ show sc ++ " but no Allow header.")
 
-         when (sc /= NotModified && isRedirection sc && getHeader "Location" res == Nothing)
+         when (sc /= NotModified && isRedirection sc && getHeader (C8.pack "Location") res == Nothing)
                   $ abortSTM InternalServerError []
                         $ Just ("The status code was " ++ show sc ++ " but no Location header.")
 
@@ -97,37 +100,40 @@ postprocess itr
                                           status == ResetContent ||
                                           status == NotModified    )
 
-               updateRes itr $! deleteHeader "Content-Length"
-               updateRes itr $! deleteHeader "Transfer-Encoding"
+               updateRes itr $! deleteHeader (C8.pack "Content-Length")
+               updateRes itr $! deleteHeader (C8.pack "Transfer-Encoding")
 
-               cType <- readHeader itr "Content-Type"
+               cType <- readHeader itr (C8.pack "Content-Type")
                when (cType == Nothing)
-                        $ updateRes itr $ setHeader "Content-Type" defaultPageContentType
+                        $ updateRes itr $ setHeader (C8.pack "Content-Type") defaultPageContentType
 
                if canHaveBody then
                    when (reqVer == HttpVersion 1 1)
-                            $ do updateRes itr $! setHeader "Transfer-Encoding" "chunked"
+                            $ do updateRes itr $! setHeader (C8.pack "Transfer-Encoding") (C8.pack "chunked")
                                  writeItr itr itrWillChunkBody True
                  else
                    -- body 関連のヘッダを削除。但し HEAD なら Content-* は殘す
                    when (reqMethod req /= HEAD)
-                            $ do updateRes itr $! deleteHeader "Content-Type"
-                                 updateRes itr $! deleteHeader "Etag"
-                                 updateRes itr $! deleteHeader "Last-Modified"
-
-               conn <- readHeader itr "Connection"
-               case fmap (map toLower) conn of
-                 Just "close" -> writeItr itr itrWillClose True
-                 _            -> return ()
+                            $ do updateRes itr $! deleteHeader (C8.pack "Content-Type")
+                                 updateRes itr $! deleteHeader (C8.pack "Etag")
+                                 updateRes itr $! deleteHeader (C8.pack "Last-Modified")
+
+               conn <- readHeader itr (C8.pack "Connection")
+               case conn of
+                 Nothing    -> return ()
+                 Just value -> if value `noCaseEq` C8.pack "close" then
+                                   writeItr itr itrWillClose True
+                               else
+                                   return ()
 
                willClose <- readItr itr itrWillClose id
                when willClose
-                        $ updateRes itr $! setHeader "Connection" "close"
+                        $ updateRes itr $! setHeader (C8.pack "Connection") (C8.pack "close")
 
                when (reqMethod req == HEAD || not canHaveBody)
                         $ writeTVar (itrWillDiscardBody itr) True
 
-      readHeader :: Interaction -> String -> STM (Maybe String)
+      readHeader :: Interaction -> ByteString -> STM (Maybe ByteString)
       readHeader itr name
           = itr `seq` name `seq`
             readItr itr itrResponse $ getHeader name
@@ -144,12 +150,29 @@ completeUnconditionalHeaders conf res
       return res >>= compServer >>= compDate >>= return
       where
         compServer res
-            = case getHeader "Server" res of
-                Nothing -> return $ addHeader "Server" (cnfServerSoftware conf) res
+            = case getHeader (C8.pack "Server") res of
+                Nothing -> return $ setHeader (C8.pack "Server") (cnfServerSoftware conf) res
                 Just _  -> return res
 
         compDate res
-            = case getHeader "Date" res of
-                Nothing -> do time <- getClockTime
-                              return $ addHeader "Date" (formatHTTPDateTime time) res
-                Just _  -> return res
\ No newline at end of file
+            = case getHeader (C8.pack "Date") res of
+                Nothing -> do date <- getCurrentDate
+                              return $ setHeader (C8.pack "Date") date res
+                Just _  -> return res
+
+
+cache :: IORef (ClockTime, ByteString)
+cache = unsafePerformIO $
+        newIORef (TOD 0 0, undefined)
+{-# NOINLINE cache #-}
+
+getCurrentDate :: IO ByteString
+getCurrentDate = do now@(TOD curSec _)           <- getClockTime
+                    (TOD cachedSec _, cachedStr) <- readIORef cache
+
+                    if curSec == cachedSec then
+                        return cachedStr
+                      else
+                        do let dateStr = C8.pack $ formatHTTPDateTime now
+                           writeIORef cache (now, dateStr)
+                           return dateStr
\ No newline at end of file
diff --git a/Network/HTTP/Lucu/Preprocess.hs b/Network/HTTP/Lucu/Preprocess.hs
index 37b1a75..ef66898 100644
--- a/Network/HTTP/Lucu/Preprocess.hs
+++ b/Network/HTTP/Lucu/Preprocess.hs
@@ -5,6 +5,8 @@ module Network.HTTP.Lucu.Preprocess
 
 import           Control.Concurrent.STM
 import           Control.Monad
+import           Data.ByteString.Base (ByteString)
+import qualified Data.ByteString.Char8 as C8
 import           Data.Char
 import           Data.Maybe
 import           Network.HTTP.Lucu.Config
@@ -13,7 +15,6 @@ import           Network.HTTP.Lucu.HttpVersion
 import           Network.HTTP.Lucu.Interaction
 import           Network.HTTP.Lucu.Request
 import           Network.HTTP.Lucu.Response
-import           Network.HTTP.Lucu.Utils
 import           Network
 import           Network.URI
 
@@ -74,7 +75,7 @@ preprocess itr
                   PUT  -> writeItr itr itrRequestHasBody True
                   _    -> setStatus NotImplemented
                   
-                mapM_ (preprocessHeader itr) (reqHeaders req)
+                preprocessHeader itr req
     where
       setStatus :: StatusCode -> STM ()
       setStatus status
@@ -101,24 +102,24 @@ preprocess itr
                                   Just n  -> Just $ ":" ++ show n
                                   Nothing -> Nothing
                      case portStr of
-                       Just str -> updateAuthority host str
+                       Just str -> updateAuthority host (C8.pack str)
                        -- FIXME: このエラーの原因は、listen してゐるソ
                        -- ケットが INET でない故にポート番號が分からな
                        -- い事だが、その事をどうにかして通知した方が良
                        -- いと思ふ。stderr？
                        Nothing  -> setStatus InternalServerError
               else
-                  do case getHeader "Host" req of
+                  do case getHeader (C8.pack "Host") req of
                        Just str -> let (host, portStr) = parseHost str
                                    in updateAuthority host portStr
                        Nothing  -> setStatus BadRequest
 
 
-      parseHost :: String -> (String, String)
-      parseHost = break (== ':')
+      parseHost :: ByteString -> (ByteString, ByteString)
+      parseHost = C8.break (== ':')
 
 
-      updateAuthority :: String -> String -> STM ()
+      updateAuthority :: ByteString -> ByteString -> STM ()
       updateAuthority host portStr
           = host `seq` portStr `seq`
             updateItr itr itrRequest
@@ -127,41 +128,45 @@ preprocess itr
                                           in uri {
                                                uriAuthority = Just URIAuth {
                                                                    uriUserInfo = ""
-                                                                 , uriRegName  = host
-                                                                 , uriPort     = portStr
+                                                                 , uriRegName  = C8.unpack host
+                                                                 , uriPort     = C8.unpack portStr
                                                               }
                                              }
                                }
                 
 
-      preprocessHeader :: Interaction -> (String, String) -> STM ()
-      preprocessHeader itr (name, value)
-          = itr `seq` name `seq` value `seq`
-            case map toLower name of
-
-              "expect"
-                  -> if value `noCaseEq'` "100-continue" then
-                         writeItr itr itrExpectedContinue True
-                     else
-                         setStatus ExpectationFailed
-
-              "transfer-encoding"
-                  -> case map toLower value of
-                       "identity" -> return ()
-                       "chunked"  -> writeItr itr itrRequestIsChunked True
-                       _          -> setStatus NotImplemented
-
-              "content-length"
-                  -> if all isDigit value then
-                         do let len = read value
-                            writeItr itr itrReqChunkLength    $ Just len
-                            writeItr itr itrReqChunkRemaining $ Just len
-                     else
-                         setStatus BadRequest
-
-              "connection"
-                  -> case map toLower value of
-                       "close"      -> writeItr itr itrWillClose True
-                       _            -> return ()
-
-              _ -> return ()
\ No newline at end of file
+      preprocessHeader :: Interaction -> Request -> STM ()
+      preprocessHeader itr req
+          = itr `seq` req `seq`
+            do case getHeader (C8.pack "Expect") req of
+                 Nothing    -> return ()
+                 Just value -> if value `noCaseEq` C8.pack "100-continue" then
+                                   writeItr itr itrExpectedContinue True
+                               else
+                                   setStatus ExpectationFailed
+
+               case getHeader (C8.pack "Transfer-Encoding") req of
+                 Nothing    -> return ()
+                 Just value -> if value `noCaseEq` C8.pack "identity" then
+                                   return ()
+                               else
+                                   if value `noCaseEq` C8.pack "chunked" then
+                                       writeItr itr itrRequestIsChunked True
+                                   else
+                                       setStatus NotImplemented
+
+               case getHeader (C8.pack "Content-Length") req of
+                 Nothing    -> return ()
+                 Just value -> if C8.all isDigit value then
+                                   do let Just (len, _) = C8.readInt value
+                                      writeItr itr itrReqChunkLength    $ Just len
+                                      writeItr itr itrReqChunkRemaining $ Just len
+                               else
+                                   setStatus BadRequest
+
+               case getHeader (C8.pack "Connection") req of
+                 Nothing    -> return ()
+                 Just value -> if value `noCaseEq` C8.pack "close" then
+                                   writeItr itr itrWillClose True
+                               else
+                                   return ()
diff --git a/Network/HTTP/Lucu/RFC1123DateTime.hs b/Network/HTTP/Lucu/RFC1123DateTime.hs
index e9300a5..4606baf 100644
--- a/Network/HTTP/Lucu/RFC1123DateTime.hs
+++ b/Network/HTTP/Lucu/RFC1123DateTime.hs
@@ -9,6 +9,7 @@ module Network.HTTP.Lucu.RFC1123DateTime
     where
 
 import           Control.Monad
+import           Data.ByteString.Base (LazyByteString)
 import           Network.HTTP.Lucu.Format
 import           Network.HTTP.Lucu.Parser
 import           System.Time
@@ -63,9 +64,9 @@ formatHTTPDateTime time
 -- ...but currently this function only supports the RFC 1123
 -- format. This is a violation of RFC 2616 so this should be fixed
 -- later. What a bother!
-parseHTTPDateTime :: String -> Maybe ClockTime
+parseHTTPDateTime :: LazyByteString -> Maybe ClockTime
 parseHTTPDateTime src
-    = case parseStr httpDateTime src of
+    = case parse httpDateTime src of
         (# Success ct, _ #) -> Just ct
         (# _         , _ #) -> Nothing
 
diff --git a/Network/HTTP/Lucu/Resource.hs b/Network/HTTP/Lucu/Resource.hs
index 44db0dc..bf75de8 100644
--- a/Network/HTTP/Lucu/Resource.hs
+++ b/Network/HTTP/Lucu/Resource.hs
@@ -134,8 +134,9 @@ module Network.HTTP.Lucu.Resource
 import           Control.Concurrent.STM
 import           Control.Monad.Reader
 import           Data.Bits
-import           Data.ByteString.Base (LazyByteString)
-import qualified Data.ByteString.Lazy.Char8 as B
+import           Data.ByteString.Base (ByteString, LazyByteString(..))
+import qualified Data.ByteString.Char8 as C8
+import qualified Data.ByteString.Lazy.Char8 as L8
 import           Data.List
 import           Data.Maybe
 import           Network.HTTP.Lucu.Abortion
@@ -291,7 +292,7 @@ getQueryForm = do reqURI <- getRequestURI
 -- case-insensitive. Note that this action is not intended to be used
 -- so frequently: there should be actions like 'getContentType' for
 -- every common headers.
-getHeader :: String -> Resource (Maybe String)
+getHeader :: ByteString -> Resource (Maybe ByteString)
 getHeader name = name `seq`
                  do req <- getRequest
                     return $! H.getHeader name req
@@ -299,22 +300,22 @@ getHeader name = name `seq`
 -- |Get a list of 'Network.HTTP.Lucu.MIMEType.MIMEType' enumerated on
 -- header \"Accept\".
 getAccept :: Resource [MIMEType]
-getAccept = do acceptM <- getHeader "Accept"
+getAccept = do acceptM <- getHeader (C8.pack "Accept")
                case acceptM of
                  Nothing 
                      -> return []
                  Just accept
-                     -> case parseStr mimeTypeListP accept of
+                     -> case parse mimeTypeListP (LPS [accept]) of
                           (# Success xs, _ #) -> return xs
                           (# _         , _ #) -> abort BadRequest []
-                                                 (Just $ "Unparsable Accept: " ++ accept)
+                                                 (Just $ "Unparsable Accept: " ++ C8.unpack accept)
 
 -- |Get a list of @(contentCoding, qvalue)@ enumerated on header
 -- \"Accept-Encoding\". The list is sorted in descending order by
 -- qvalue.
 getAcceptEncoding :: Resource [(String, Maybe Double)]
 getAcceptEncoding
-    = do accEncM <- getHeader "Accept-Encoding"
+    = do accEncM <- getHeader (C8.pack "Accept-Encoding")
          case accEncM of
            Nothing
                -- HTTP/1.0 には Accept-Encoding が無い場合の規定が無い
@@ -325,36 +326,37 @@ getAcceptEncoding
                      case ver of
                        HttpVersion 1 0 -> return [("identity", Nothing)]
                        HttpVersion 1 1 -> return [("*"       , Nothing)]
-           Just ""
-               -- identity のみが許される。
-               -> return [("identity", Nothing)]
-           Just accEnc
-               -> case parseStr acceptEncodingListP accEnc of
-                    (# Success x, _ #) -> return $ reverse $ sortBy orderAcceptEncodings x
-                    (# _        , _ #) -> abort BadRequest []
-                                          (Just $ "Unparsable Accept-Encoding: " ++ accEnc)
+           Just value
+               -> if C8.null value then
+                      -- identity のみが許される。
+                      return [("identity", Nothing)]
+                  else
+                      case parse acceptEncodingListP (LPS [value]) of
+                        (# Success x, _ #) -> return $ reverse $ sortBy orderAcceptEncodings x
+                        (# _        , _ #) -> abort BadRequest []
+                                              (Just $ "Unparsable Accept-Encoding: " ++ C8.unpack value)
 
 -- |Check whether a given content-coding is acceptable.
 isEncodingAcceptable :: String -> Resource Bool
 isEncodingAcceptable coding
     = do accList <- getAcceptEncoding
          return (flip any accList $ \ (c, q) ->
-                     (c == "*" || c `noCaseEq` coding) && q /= Just 0)
+                     (c == "*" || C8.pack c `H.noCaseEq` C8.pack coding) && q /= Just 0)
 
 
 -- |Get the header \"Content-Type\" as
 -- 'Network.HTTP.Lucu.MIMEType.MIMEType'.
 getContentType :: Resource (Maybe MIMEType)
 getContentType
-    = do cTypeM <- getHeader "Content-Type"
+    = do cTypeM <- getHeader (C8.pack "Content-Type")
          case cTypeM of
            Nothing
                -> return Nothing
            Just cType
-               -> case parseStr mimeTypeP cType of
+               -> case parse mimeTypeP (LPS [cType]) of
                     (# Success t, _ #) -> return $ Just t
                     (# _        , _ #) -> abort BadRequest []
-                                          (Just $ "Unparsable Content-Type: " ++ cType)
+                                          (Just $ "Unparsable Content-Type: " ++ C8.unpack cType)
 
 
 {- ExaminingRequest 時に使用するアクション群 -}
@@ -380,7 +382,7 @@ foundEntity tag timeStamp
 
          method <- getMethod
          when (method == GET || method == HEAD)
-                  $ setHeader' "Last-Modified" $! formatHTTPDateTime timeStamp
+                  $ setHeader' (C8.pack "Last-Modified") (C8.pack $ formatHTTPDateTime timeStamp)
          when (method == POST)
                   $ abort InternalServerError []
                         (Just "Illegal computation of foundEntity for POST request.")
@@ -402,25 +404,27 @@ foundETag tag
       
          method <- getMethod
          when (method == GET || method == HEAD)
-                  $ setHeader' "ETag" $! show tag
+                  $ setHeader' (C8.pack "ETag") (C8.pack $ show tag)
          when (method == POST)
                   $ abort InternalServerError []
                         (Just "Illegal computation of foundETag for POST request.")
 
          -- If-Match があればそれを見る。
-         ifMatch <- getHeader "If-Match"
+         ifMatch <- getHeader (C8.pack "If-Match")
          case ifMatch of
-           Nothing   -> return ()
-           Just "*"  -> return ()
-           Just list -> case parseStr eTagListP list of
-                          (# Success tags, _ #)
-                              -- tags の中に一致するものが無ければ
-                              -- PreconditionFailed で終了。
-                              -> when (not $ any (== tag) tags)
-                                 $ abort PreconditionFailed []
-                                       $! Just ("The entity tag doesn't match: " ++ list)
-                          (# _, _ #)
-                              -> abort BadRequest [] $! Just ("Unparsable If-Match: " ++ fromJust ifMatch)
+           Nothing    -> return ()
+           Just value -> if value == C8.pack "*" then
+                             return ()
+                         else
+                             case parse eTagListP (LPS [value]) of
+                               (# Success tags, _ #)
+                                 -- tags の中に一致するものが無ければ
+                                 -- PreconditionFailed で終了。
+                                 -> when (not $ any (== tag) tags)
+                                    $ abort PreconditionFailed []
+                                          $! Just ("The entity tag doesn't match: " ++ C8.unpack value)
+                               (# _, _ #)
+                                   -> abort BadRequest [] $! Just ("Unparsable If-Match: " ++ C8.unpack value)
 
          let statusForNoneMatch = if method == GET || method == HEAD then
                                       NotModified
@@ -428,16 +432,18 @@ foundETag tag
                                       PreconditionFailed
 
          -- If-None-Match があればそれを見る。
-         ifNoneMatch <- getHeader "If-None-Match"
+         ifNoneMatch <- getHeader (C8.pack "If-None-Match")
          case ifNoneMatch of
-           Nothing   -> return ()
-           Just "*"  -> abort statusForNoneMatch [] $! Just ("The entity tag matches: *")
-           Just list -> case parseStr eTagListP list of
-                          (# Success tags, _ #)
-                              -> when (any (== tag) tags)
-                                 $ abort statusForNoneMatch [] $! Just ("The entity tag matches: " ++ list)
-                          (# _, _ #)
-                              -> abort BadRequest [] $! Just ("Unparsable If-None-Match: " ++ list)
+           Nothing    -> return ()
+           Just value -> if value == C8.pack "*" then
+                             abort statusForNoneMatch [] $! Just ("The entity tag matches: *")
+                         else
+                             case parse eTagListP (LPS [value]) of
+                               (# Success tags, _ #)
+                                   -> when (any (== tag) tags)
+                                      $ abort statusForNoneMatch [] $! Just ("The entity tag matches: " ++ C8.unpack value)
+                               (# _, _ #)
+                                   -> abort BadRequest [] $! Just ("Unparsable If-None-Match: " ++ C8.unpack value)
 
          driftTo GettingBody
 
@@ -458,7 +464,7 @@ foundTimeStamp timeStamp
 
          method <- getMethod
          when (method == GET || method == HEAD)
-                  $ setHeader' "Last-Modified" $! formatHTTPDateTime timeStamp
+                  $ setHeader' (C8.pack "Last-Modified") (C8.pack $ formatHTTPDateTime timeStamp)
          when (method == POST)
                   $ abort InternalServerError []
                         (Just "Illegal computation of foundTimeStamp for POST request.")
@@ -469,25 +475,25 @@ foundTimeStamp timeStamp
                                        PreconditionFailed
 
          -- If-Modified-Since があればそれを見る。
-         ifModSince <- getHeader "If-Modified-Since"
+         ifModSince <- getHeader (C8.pack "If-Modified-Since")
          case ifModSince of
-           Just str -> case parseHTTPDateTime str of
+           Just str -> case parseHTTPDateTime (LPS [str]) of
                          Just lastTime
                              -> when (timeStamp <= lastTime)
                                 $ abort statusForIfModSince []
-                                      $! Just ("The entity has not been modified since " ++ str)
+                                      $! Just ("The entity has not been modified since " ++ C8.unpack str)
                          Nothing
                              -> return () -- 不正な時刻は無視
            Nothing  -> return ()
 
          -- If-Unmodified-Since があればそれを見る。
-         ifUnmodSince <- getHeader "If-Unmodified-Since"
+         ifUnmodSince <- getHeader (C8.pack "If-Unmodified-Since")
          case ifUnmodSince of
-           Just str -> case parseHTTPDateTime str of
+           Just str -> case parseHTTPDateTime (LPS [str]) of
                          Just lastTime
                              -> when (timeStamp > lastTime)
                                 $ abort PreconditionFailed []
-                                      $! Just  ("The entity has not been modified since " ++ str)
+                                      $! Just  ("The entity has not been modified since " ++ C8.unpack str)
                          Nothing
                              -> return () -- 不正な時刻は無視
            Nothing  -> return ()
@@ -513,7 +519,7 @@ foundNoEntity msgM
 
          -- エンティティが存在しないと云ふ事は、"*" も含めたどのやうな
          -- If-Match: 條件も滿たさない。
-         ifMatch <- getHeader "If-Match"
+         ifMatch <- getHeader (C8.pack "If-Match")
          when (ifMatch /= Nothing)
                   $ abort PreconditionFailed [] msgM
 
@@ -538,7 +544,7 @@ foundNoEntity msgM
 -- use it whenever possible.
 input :: Int -> Resource String
 input limit = limit `seq`
-              inputLBS limit >>= return . B.unpack
+              inputLBS limit >>= return . L8.unpack
 
 
 -- | This is mostly the same as 'input' but is more
@@ -558,7 +564,7 @@ inputLBS limit
                         askForInput itr
                     else
                         do driftTo DecidingHeader
-                           return B.empty
+                           return L8.empty
          return chunk
     where
       askForInput :: Interaction -> Resource LazyByteString
@@ -584,7 +590,7 @@ inputLBS limit
                chunk <- liftIO $! atomically
                         $! do chunk       <- readItr itr itrReceivedBody id
                               chunkIsOver <- readItr itr itrReqChunkIsOver id
-                              if B.length chunk < fromIntegral actualLimit then
+                              if L8.length chunk < fromIntegral actualLimit then
                                   -- 要求された量に滿たなくて、まだ殘り
                                   -- があるなら再試行。
                                   unless chunkIsOver
@@ -597,7 +603,7 @@ inputLBS limit
                                              $ tooLarge actualLimit
                               -- 成功。itr 内にチャンクを置いたままにす
                               -- るとメモリの無駄になるので除去。
-                              writeItr itr itrReceivedBody B.empty
+                              writeItr itr itrReceivedBody L8.empty
                               return chunk
                driftTo DecidingHeader
                return chunk
@@ -623,7 +629,7 @@ inputLBS limit
 -- should use it whenever possible.
 inputChunk :: Int -> Resource String
 inputChunk limit = limit `seq`
-                   inputChunkLBS limit >>= return . B.unpack
+                   inputChunkLBS limit >>= return . L8.unpack
 
 
 -- | This is mostly the same as 'inputChunk' but is more
@@ -638,7 +644,7 @@ inputChunkLBS limit
                         askForInput itr
                     else
                         do driftTo DecidingHeader
-                           return B.empty
+                           return L8.empty
          return chunk
     where
       askForInput :: Interaction -> Resource LazyByteString
@@ -660,14 +666,14 @@ inputChunkLBS limit
                         $ do chunk <- readItr itr itrReceivedBody id
                              -- 要求された量に滿たなくて、まだ殘りがあ
                              -- るなら再試行。
-                             when (B.length chunk < fromIntegral actualLimit)
+                             when (L8.length chunk < fromIntegral actualLimit)
                                       $ do chunkIsOver <- readItr itr itrReqChunkIsOver id
                                            unless chunkIsOver
                                                       $ retry
                              -- 成功
-                             writeItr itr itrReceivedBody B.empty
+                             writeItr itr itrReceivedBody L8.empty
                              return chunk
-               when (B.null chunk)
+               when (L8.null chunk)
                         $ driftTo DecidingHeader
                return chunk
 
@@ -740,13 +746,13 @@ setStatus code
 -- 20 bytes long. In this case the client shall only accept the first
 -- 10 bytes of response body and thinks that the residual 10 bytes is
 -- a part of header of the next response.
-setHeader :: String -> String -> Resource ()
+setHeader :: ByteString -> ByteString -> Resource ()
 setHeader name value
     = name `seq` value `seq`
       driftTo DecidingHeader >> setHeader' name value
          
 
-setHeader' :: String -> String -> Resource ()
+setHeader' :: ByteString -> ByteString -> Resource ()
 setHeader' name value
     = name `seq` value `seq`
       do itr <- getInteraction
@@ -772,13 +778,13 @@ redirect code uri
 -- \"Content-Type\" to @mType@.
 setContentType :: MIMEType -> Resource ()
 setContentType mType
-    = setHeader "Content-Type" $! show mType
+    = setHeader (C8.pack "Content-Type") (C8.pack $ show mType)
 
 -- | Computation of @'setLocation' uri@ sets the response header
 -- \"Location\" to @uri@.
 setLocation :: URI -> Resource ()
 setLocation uri
-    = setHeader "Location" $ uriToString id uri $ ""
+    = setHeader (C8.pack "Location") (C8.pack $ uriToString id uri $ "")
 
 -- |Computation of @'setContentEncoding' codings@ sets the response
 -- header \"Content-Encoding\" to @codings@.
@@ -788,7 +794,7 @@ setContentEncoding codings
          let tr = case ver of
                     HttpVersion 1 0 -> unnormalizeCoding
                     HttpVersion 1 1 -> id
-         setHeader "Content-Encoding" $ joinWith ", " $ map tr codings
+         setHeader (C8.pack "Content-Encoding") (C8.pack $ joinWith ", " $ map tr codings)
 
 
 {- DecidingBody 時に使用するアクション群 -}
@@ -801,7 +807,7 @@ setContentEncoding codings
 -- Note that 'outputLBS' is more efficient than 'output' so you should
 -- use it whenever possible.
 output :: String -> Resource ()
-output str = outputLBS $! B.pack str
+output str = outputLBS $! L8.pack str
 {-# INLINE output #-}
 
 -- | This is mostly the same as 'output' but is more efficient.
@@ -818,7 +824,7 @@ outputLBS str = do outputChunkLBS str
 -- Note that 'outputChunkLBS' is more efficient than 'outputChunk' so
 -- you should use it whenever possible.
 outputChunk :: String -> Resource ()
-outputChunk str = outputChunkLBS $! B.pack str
+outputChunk str = outputChunkLBS $! L8.pack str
 {-# INLINE outputChunk #-}
 
 -- | This is mostly the same as 'outputChunk' but is more efficient.
@@ -839,30 +845,30 @@ outputChunkLBS str
          unless (discardBody)
                     $ sendChunks str limit
 
-         unless (B.null str)
+         unless (L8.null str)
                     $ liftIO $ atomically $
                       writeItr itr itrBodyIsNull False
     where
       -- チャンクの大きさは Config で制限されてゐる。もし例へば
-      -- "/dev/zero" を B.readFile して作った LazyByteString をそのまま
+      -- "/dev/zero" を L8.readFile して作った LazyByteString をそのまま
       -- ResponseWriter に渡したりすると大變な事が起こる。何故なら
       -- ResponseWriter は Transfer-Encoding: chunked の時、ヘッダを書
       -- く爲にチャンクの大きさを測る。
       sendChunks :: LazyByteString -> Int -> Resource ()
       sendChunks str limit
-          | B.null str = return ()
-          | otherwise  = do let (chunk, remaining) = B.splitAt (fromIntegral limit) str
-                            itr <- getInteraction
-                            liftIO $ atomically $ 
-                                   do buf <- readItr itr itrBodyToSend id
-                                      if B.null buf then
-                                          -- バッファが消化された
-                                          writeItr itr itrBodyToSend chunk
-                                        else
-                                          -- 消化されるのを待つ
-                                          retry
-                            -- 殘りのチャンクについて繰り返す
-                            sendChunks remaining limit
+          | L8.null str = return ()
+          | otherwise   = do let (chunk, remaining) = L8.splitAt (fromIntegral limit) str
+                             itr <- getInteraction
+                             liftIO $ atomically $ 
+                                    do buf <- readItr itr itrBodyToSend id
+                                       if L8.null buf then
+                                           -- バッファが消化された
+                                           writeItr itr itrBodyToSend chunk
+                                         else
+                                           -- 消化されるのを待つ
+                                           retry
+                             -- 殘りのチャンクについて繰り返す
+                             sendChunks remaining limit
 
 {-
 
diff --git a/Network/HTTP/Lucu/Resource/Tree.hs b/Network/HTTP/Lucu/Resource/Tree.hs
index 149fa9d..bb12dd0 100644
--- a/Network/HTTP/Lucu/Resource/Tree.hs
+++ b/Network/HTTP/Lucu/Resource/Tree.hs
@@ -15,6 +15,7 @@ import           Control.Concurrent
 import           Control.Concurrent.STM
 import           Control.Exception
 import           Control.Monad
+import qualified Data.ByteString.Char8 as C8
 import           Data.Dynamic
 import           Data.List
 import qualified Data.Map as M
@@ -22,6 +23,7 @@ import           Data.Map (Map)
 import           Data.Maybe
 import           Network.HTTP.Lucu.Abortion
 import           Network.HTTP.Lucu.Config
+import           Network.HTTP.Lucu.Headers (emptyHeaders, fromHeaders)
 import           Network.HTTP.Lucu.Request
 import           Network.HTTP.Lucu.Resource
 import           Network.HTTP.Lucu.Response
@@ -195,7 +197,7 @@ runResource def itr
 
       notAllowed :: Resource ()
       notAllowed = do setStatus MethodNotAllowed
-                      setHeader "Allow" $ joinWith ", " allowedMethods
+                      setHeader (C8.pack "Allow") (C8.pack $ joinWith ", " allowedMethods)
 
       allowedMethods :: [String]
       allowedMethods = nub $ foldr (++) [] [ methods resGet    ["GET"]
@@ -213,14 +215,14 @@ runResource def itr
       processException :: Exception -> IO ()
       processException exc
           = do let abo = case exc of
-                           ErrorCall    msg  -> Abortion InternalServerError [] $ Just msg
-                           IOException  ioE  -> Abortion InternalServerError [] $ Just $ formatIOE ioE
+                           ErrorCall    msg  -> Abortion InternalServerError emptyHeaders $ Just msg
+                           IOException  ioE  -> Abortion InternalServerError emptyHeaders $ Just $ formatIOE ioE
                            DynException dynE -> case fromDynamic dynE of
                                                   Just (abo :: Abortion) -> abo
                                                   Nothing
-                                                      -> Abortion InternalServerError []
+                                                      -> Abortion InternalServerError emptyHeaders
                                                          $ Just $ show exc
-                           _                 -> Abortion InternalServerError [] $ Just $ show exc
+                           _                 -> Abortion InternalServerError emptyHeaders $ Just $ show exc
                    conf = itrConfig itr
                -- まだ DecidingHeader 以前の状態だったら、この途中終了
                -- を應答に反映させる餘地がある。さうでなければ stderr
@@ -231,9 +233,7 @@ runResource def itr
                if state <= DecidingHeader then
                    flip runRes itr
                       $ do setStatus $ aboStatus abo
-                           -- FIXME: 同じ名前で複數の値があった時は、こ
-                           -- れではまずいと思ふ。
-                           mapM_ (\ (name, value) -> setHeader name value) $ aboHeaders abo
+                           mapM_ (\ (name, value) -> setHeader name value) $ fromHeaders $ aboHeaders abo
                            output $ abortPage conf reqM res abo
                  else
                    when (cnfDumpTooLateAbortionToStderr $ itrConfig itr)
diff --git a/Network/HTTP/Lucu/ResponseWriter.hs b/Network/HTTP/Lucu/ResponseWriter.hs
index be9f370..a676e15 100644
--- a/Network/HTTP/Lucu/ResponseWriter.hs
+++ b/Network/HTTP/Lucu/ResponseWriter.hs
@@ -12,6 +12,7 @@ import qualified Data.Sequence as S
 import           Data.Sequence (ViewR(..))
 import           Network.HTTP.Lucu.Config
 import           Network.HTTP.Lucu.Format
+import           Network.HTTP.Lucu.Headers
 import           Network.HTTP.Lucu.HttpVersion
 import           Network.HTTP.Lucu.Interaction
 import           Network.HTTP.Lucu.Postprocess
@@ -106,7 +107,7 @@ responseWriter cnf h tQueue readerTID
             do let cont = Response {
                             resVersion = HttpVersion 1 1
                           , resStatus  = Continue
-                          , resHeaders = []
+                          , resHeaders = emptyHeaders
                           }
                cont' <- completeUnconditionalHeaders cnf cont
                hPutResponse h cont'
diff --git a/Network/HTTP/Lucu/Utils.hs b/Network/HTTP/Lucu/Utils.hs
index 0c29836..b679a93 100644
--- a/Network/HTTP/Lucu/Utils.hs
+++ b/Network/HTTP/Lucu/Utils.hs
@@ -4,8 +4,6 @@ module Network.HTTP.Lucu.Utils
     ( splitBy
     , joinWith
     , trim
-    , noCaseEq
-    , noCaseEq'
     , isWhiteSpace
     , quoteStr
     , parseWWWFormURLEncoded
@@ -40,22 +38,6 @@ trim p = p `seq` trimTail . trimHead
       trimHead = dropWhile p
       trimTail = reverse . trimHead . reverse
 
--- |@'noCaseEq' a b@ is equivalent to @('Prelude.map'
--- 'Data.Char.toLower' a) == ('Prelude.map' 'Data.Char.toLower'
--- b)@. See 'noCaseEq''.
-noCaseEq :: String -> String -> Bool
-noCaseEq a b
-    = (map toLower a) == (map toLower b)
-{-# INLINE noCaseEq #-}
-
--- |@'noCaseEq'' a b@ is a variant of 'noCaseEq' which first checks
--- the length of two strings to avoid possibly unnecessary comparison.
-noCaseEq' :: String -> String -> Bool
-noCaseEq' a b
-    | length a /= length b = False
-    | otherwise            = noCaseEq a b
-{-# INLINE noCaseEq' #-}
-
 -- |@'isWhiteSpace' c@ is 'Prelude.True' iff c is one of SP, HT, CR
 -- and LF.
 isWhiteSpace :: Char -> Bool