X-Git-Url: http://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;f=Network%2FHTTP%2FLucu%2FHttpd.hs;h=d180202759a903fe8a478eae1ecaf28d5b50c1e1;hb=6126eb9cbe5b38c300d855d96d2238831e59b5dd;hp=d9f28f110e5f1c668a3fc9f539b9f2c4981e3959;hpb=0214f070b80791323430e21b53bcbe8a77b71b23;p=Lucu.git

diff --git a/Network/HTTP/Lucu/Httpd.hs b/Network/HTTP/Lucu/Httpd.hs
index d9f28f1..d180202 100644
--- a/Network/HTTP/Lucu/Httpd.hs
+++ b/Network/HTTP/Lucu/Httpd.hs
@@ -8,6 +8,7 @@ module Network.HTTP.Lucu.Httpd
 import           Control.Concurrent
 import           Control.Exception
 import           Control.Monad
+import           Data.Maybe
 import           Network.BSD
 import           Network.Socket
 import           Network.HTTP.Lucu.Config
@@ -56,55 +57,37 @@ runHttpd cnf tree fbs
     = withSocketsDo $
       do _ <- installHandler sigPIPE Ignore Nothing
 
-         -- FIXME: TERRIBLE CODE. NEED MAJOR REWRITE.
-         case cnfSSLConfig cnf of
-           Nothing
-               -> return ()
-           Just scnf
-               -> do case cnfServerV4Addr cnf of
-                       Nothing
-                           -> return ()
-                       Just v4addr
-                           -> do so <- listenOn AF_INET v4addr (sslServerPort scnf)
-                                 p  <- socketPort so
-                                 -- FIXME: Don't throw away the thread
-                                 -- ID as we can't kill it later
-                                 -- then. [1]
-                                 _  <- forkIO $ httpLoop p (sslContext scnf, so)
-                                 return ()
-
-                     case cnfServerV6Addr cnf of
-                       Nothing
-                           -> return ()
-                       Just v6addr
-                           -> do so <- listenOn AF_INET6 v6addr (sslServerPort scnf)
-                                 p  <- socketPort so
-                                 -- FIXME: [1]
-                                 _  <- forkIO $ httpLoop p (sslContext scnf, so)
-                                 return ()
-         
-         case cnfServerV4Addr cnf of
-           Nothing
-               -> return ()
-           Just v4addr
-               -> do so <- listenOn AF_INET v4addr (cnfServerPort cnf)
-                     p  <- socketPort so
-                     -- FIXME: [1]
-                     _  <- forkIO $ httpLoop p so
-                     return ()
-
-         case cnfServerV6Addr cnf of
-           Nothing
-               -> return ()
-           Just v6addr
-               -> do so <- listenOn AF_INET6 v6addr (cnfServerPort cnf)
-                     p  <- socketPort so
-                     -- FIXME: [1]
-                     _  <- forkIO $ httpLoop p so
-                     return ()
+         let launchers
+                 = catMaybes
+                   [ do scnf <- cnfSSLConfig    cnf
+                        addr <- cnfServerV4Addr cnf
+                        return ( do so <- listenOn AF_INET addr (sslServerPort scnf)
+                                    launchListener (sslContext scnf, so)
+                               )
+                   , do scnf <- cnfSSLConfig    cnf
+                        addr <- cnfServerV6Addr cnf
+                        return ( do so <- listenOn AF_INET6 addr (sslServerPort scnf)
+                                    launchListener (sslContext scnf, so)
+                               )
+                   , do addr <- cnfServerV4Addr cnf
+                        return ( launchListener =<< listenOn AF_INET addr (cnfServerPort cnf)
+                               )
+                   , do addr <- cnfServerV6Addr cnf
+                        return ( launchListener =<< listenOn AF_INET6 addr (cnfServerPort cnf)
+                               )
+                   ]
 
+         sequence_ launchers
          waitForever
     where
+      launchListener :: SocketLike s => s -> IO ()
+      launchListener so
+          = do p <- SL.socketPort so
+               -- FIXME: Don't throw away the thread ID as we can't
+               -- kill it later then. [1]
+               _ <- forkIO $ httpLoop p so
+               return ()
+
       listenOn :: Family -> HostName -> ServiceName -> IO Socket
       listenOn fam host srv
           = do proto <- getProtocolNumber "tcp"
@@ -118,7 +101,7 @@ runHttpd cnf tree fbs
                let addr = head addrs
                bracketOnError
                    (socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr))
-                   (sClose)
+                   sClose
                    (\ sock ->
                         do setSocketOption sock ReuseAddr 1
                            bindSocket sock (addrAddress addr)