Honor cnfServerV4Addr and cnfServerV6Addr.

[Lucu.git] / Network / HTTP / Lucu / Preprocess.hs

diff --git a/Network/HTTP/Lucu/Preprocess.hs b/Network/HTTP/Lucu/Preprocess.hs
index de5efaae4ac5bce5d23bab1658609092a95f8df4..fc3fcbdfcde6cd01ce13cf36d3df3b44ddd9a45c 100644 (file)
--- a/Network/HTTP/Lucu/Preprocess.hs
+++ b/Network/HTTP/Lucu/Preprocess.hs
@@ -15,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
 import           Network.URI
 
 {-
@@ -79,36 +78,25 @@ preprocess itr
                 preprocessHeader req
     where
       setStatus :: StatusCode -> STM ()
-      setStatus status
-          = status `seq`
-            updateItr itr itrResponse
+      setStatus !status
+          = updateItr itr itrResponse
             $! \ res -> res {
                           resStatus = status
                         }
 
       completeAuthority :: Request -> STM ()
-      completeAuthority req
-          = req `seq`
-            when (uriAuthority (reqURI req) == Nothing)
+      completeAuthority !req
+          = when (uriAuthority (reqURI req) == Nothing)
             $ if reqVersion req == HttpVersion 1 0 then
                   -- HTTP/1.0 なので Config から補完
                   do let conf = itrConfig itr
                          host = cnfServerHost conf
-                         port = case cnfServerPort conf of
-                                  PortNumber n -> Just (fromIntegral n :: Int)
-                                  _            -> Nothing
+                         port = itrLocalPort itr
                          portStr
                               = case port of
-                                  Just 80 -> Just ""
-                                  Just n  -> Just $ ':' : show n
-                                  Nothing -> Nothing
-                     case portStr of
-                       Just str -> updateAuthority host (C8.pack str)
-                       -- FIXME: このエラーの原因は、listen してゐるソ
-                       -- ケットが INET でない故にポート番號が分からな
-                       -- い事だが、その事をどうにかして通知した方が良
-                       -- いと思ふ。stderr？
-                       Nothing  -> setStatus InternalServerError
+                                  80 -> ""
+                                  n  -> ':' : show n
+                     updateAuthority host (C8.pack portStr)
               else
                   case getHeader (C8.pack "Host") req of
                     Just str -> let (host, portStr) = parseHost str