{-# LANGUAGE OverloadedStrings #-} module Server.Communication where import Control.Monad import Control.Monad.IO.Class import Control.Monad.RWS.Strict import Network.Socket as Net import System.IO import System.Posix.Signals -- internal imports import Server.Types import Server.Util -- | Function which determines whether the given filePath is a supported socket path and -- subsequently creates a socket in said location. bindSocket :: FilePath -- ^ File Path for socket to be created (e.g.: "/tmp/wizard.sock") -> IO Socket -- ^ resulting Socket bindSocket path = do let sockAddr = SockAddrUnix path unless (isSupportedSockAddr sockAddr) (error $ "invalid socket path " <> path) -- aremoveIfExists path sock <- socket AF_UNIX Stream defaultProtocol bind sock sockAddr Net.listen sock 5 pure sock -- | Function that installs a handler on SIGINT to close and remove the given socket terminateSocketOnSigint :: Socket -- ^ Socket to terminate on termination -> IO () terminateSocketOnSigint sock = void $ installHandler keyboardSignal (CatchOnce $ do (SockAddrUnix path) <- getSocketName sock close' sock removeIfExists path -- Raise SIGINT again so it does not get blocked raiseSignal keyboardSignal ) Nothing -- | Process incoming connection requests processRequests :: Game processRequests = do mainSocket <- asks rcMainSocket clientSock <- liftIO $ do (clientSock, _) <- accept mainSocket putStrLn $ "accepted new connection" pure clientSock modify' (\st -> st {scClientSockets = clientSock : scClientSockets st} ) -- | process incomeing messages from clients processMessages :: Game processMessages = do clientSocks <- gets scClientSockets mapM_ (\clientSocket -> liftIO $ do connectionHandle <- socketToHandle clientSocket ReadMode hSetBuffering connectionHandle LineBuffering messages <- hGetContents' connectionHandle print messages ) clientSocks