module Network.Salvia.Core.Main (start) where import Control.Concurrent (forkIO) import Control.Monad.State import Network.Salvia.Core.Config (listenAddr, listenPort, backlog, HttpdConfig) import Network.Salvia.Core.Context (mkContext) import Network.Salvia.Core.Handler (Handler) import Network.Socket import System.IO -------- HTTP deamon implementation ------------------------------------------- {- | Start a webserver with a specific server configuration and default handler. The server will go into an infinite loop and will repeatedly accept client connections on the address and port specified in the configuration. For every connection the specified handler will be executed with the client address and socket stored in the handler context. -} start :: HttpdConfig -> Handler () -> IO () start config httpHandler = server (listenAddr config) (listenPort config) (backlog config) tcpHandler where tcpHandler handle addr = fst `liftM` runStateT httpHandler (mkContext config addr handle) {- Start a listening TCP server on the specified address/port combination and handle every connection with a custom handler. -} server :: HostAddress -> PortNumber -> Int -> (Handle -> SockAddr -> IO ()) -> IO () server addr port blog handler = do sock <- socket AF_INET Stream 0 setSocketOption sock ReuseAddr 1 bindSocket sock $ SockAddrInet port addr listen sock blog acceptLoop sock handler {- Accept connections on the listening socket and pass execution to the application specific connection handler. -} acceptLoop :: Socket -> (Handle -> SockAddr -> IO ()) -> IO () acceptLoop sock handler = do forever $ do (sock', addr) <- accept sock forkIO $ do h <- socketToHandle sock' ReadWriteMode handler h addr putStrLn "quiting"