correct handling of handles

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