76 lines
2 KiB
Haskell
76 lines
2 KiB
Haskell
{-# 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
|