Code clean-up (and close ditz/lucu-1)

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

diff --git a/Network/HTTP/Lucu/Httpd.hs b/Network/HTTP/Lucu/Httpd.hs
index d9f28f110e5f1c668a3fc9f539b9f2c4981e3959..0bb92b1635c74a1498b1ee2936f807d6153d356d 100644 (file)
--- 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"