Cosmetic changes suggested by hlint.

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

diff --git a/Network/HTTP/Lucu/Httpd.hs b/Network/HTTP/Lucu/Httpd.hs
index d9f28f110e5f1c668a3fc9f539b9f2c4981e3959..d180202759a903fe8a478eae1ecaf28d5b50c1e1 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"
@@ -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)