Optimization

[Lucu.git] / Network / HTTP / Lucu / Resource / Tree.hs

diff --git a/Network/HTTP/Lucu/Resource/Tree.hs b/Network/HTTP/Lucu/Resource/Tree.hs
index 149fa9d92d3b5101a27f5ba6c334133a3921fe34..bb12dd0ee5c49bb7c3fdce0d58c6e090626eaeb0 100644 (file)
--- 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)