module Network.Salvia.Impl.Server (start) where
import Control.Concurrent.ThreadManager
import Control.Monad.State
import Network.Protocol.Http hiding (accept, hostname)
import Network.Salvia.Impl.Config
import Network.Salvia.Impl.Context
import Network.Salvia.Impl.Handler
import Network.Socket
import System.IO
start :: Config -> Handler p () -> p -> IO ()
start conf handler payload =
do tm <- make
forM_ (listenOn conf) $ \(SockAddrInet port addr) ->
fork tm $
do inet_ntoa addr >>= \a ->
putStrLn ("starting listening server on: " ++ a ++ ":" ++ show port)
s <- socket AF_INET Stream 0
setSocketOption s ReuseAddr 1
let sAddr = SockAddrInet port addr
bindSocket s sAddr
listen s (backlog conf)
forever $
do (sck, cAddr) <- accept s
fork tm $
do hndl <- socketToHandle sck ReadWriteMode
_ <- runHandler handler
Context
{ _cServerHost = hostname conf
, _cAdminMail = adminMail conf
, _cListenOn = listenOn conf
, _cPayload = payload
, _cRequest = emptyRequest
, _cResponse = emptyResponse
, _cRawRequest = emptyRequest
, _cRawResponse = emptyResponse
, _cSocket = sck
, _cHandle = hndl
, _cClientAddr = cAddr
, _cServerAddr = sAddr
, _cQueue = []
}
return ()
waitForAll tm