correct handling of handles

This commit is contained in:
nek0 2023-12-10 09:53:56 +01:00
parent cda2ffaed4
commit b9d28aa946

View file

@ -74,40 +74,39 @@ processRequests :: Game ()
processRequests = do
mainSocket <- asks rcMainSocket
socketList <- gets scClientSockets
serverState <- gets scServerState
void $ liftIO $ forkIO $ acceptConnection mainSocket socketList serverState
void $ liftIO $ forkIO $ acceptConnection mainSocket socketList
where
acceptConnection mainSocket socketList serverState = whileM_
(not . serverStop <$> liftIO (STM.atomically $ STM.readTMVar serverState))
(do
acceptConnection mainSocket socketList = do
(clientSock, _) <- accept mainSocket
putStrLn "accepted new connection"
liftIO $ STM.atomically $ do
list <- STM.takeTMVar socketList
STM.putTMVar socketList ((clientSock, Nothing) : list)
)
acceptConnection mainSocket socketList
-- | process incoming messages from clients
processMessages :: Game ()
processMessages = do
clientsVar <- gets scClientSockets
clients <- liftIO $ STM.atomically $ STM.readTMVar $ clientsVar
newClients <- mapM
(\client@(clientSocket, mThread) ->
if isNothing mThread
then liftIO $ do
connectionHandle <- socketToHandle clientSocket ReadMode
clients <- liftIO $ STM.atomically $ STM.readTMVar clientsVar
newClients <- foldM
(\acc (clientSocket, mThread) ->
case mThread of
Nothing -> liftIO $ do
thread <- forkIO
(listenTo connectionHandle)
pure (clientSocket, Just thread)
else
pure client
(listenTo clientSocket)
pure $ (clientSocket, Just thread) : acc
Just _ -> liftIO $ do
pure acc
)
[]
clients
liftIO $ STM.atomically $ do
void $ STM.swapTMVar clientsVar newClients
where
listenTo connectionHandle = do
listenTo clientSocket = do
connectionHandle <- socketToHandle clientSocket ReadMode
hSetBuffering connectionHandle LineBuffering
message <- hGetContents' connectionHandle
putStr message
hClose connectionHandle