diff --git a/src-server/Server/Communication.hs b/src-server/Server/Communication.hs index 1a8b38d..4fb20e9 100644 --- a/src-server/Server/Communication.hs +++ b/src-server/Server/Communication.hs @@ -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 - (clientSock, _) <- accept mainSocket - putStrLn "accepted new connection" - liftIO $ STM.atomically $ do - list <- STM.takeTMVar socketList - STM.putTMVar socketList ((clientSock, Nothing) : list) - ) + 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