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
-  void $ liftIO $ forkIO $ acceptConnection mainSocket socketList serverState
   where
-    acceptConnection mainSocket socketList serverState = whileM_
+    acceptConnection mainSocket socketList = do
-      (not . serverStop <$> liftIO (STM.atomically $ STM.readTMVar serverState))
+      (clientSock, _) <- accept mainSocket
-      (do
+      putStrLn "accepted new connection"
-        (clientSock, _) <- accept mainSocket
+      liftIO $ STM.atomically $ do
-        putStrLn "accepted new connection"
+        list <- STM.takeTMVar socketList
-        liftIO $ STM.atomically $ do
+        STM.putTMVar socketList ((clientSock, Nothing) : list)
-          list <- STM.takeTMVar socketList
+      acceptConnection mainSocket socketList
-          STM.putTMVar socketList ((clientSock, Nothing) : list)
-      )
 
 -- | process incoming messages from clients
 processMessages :: Game ()
 processMessages = do
   clientsVar <- gets scClientSockets
-  clients <- liftIO $ STM.atomically $ STM.readTMVar $ clientsVar
+  clients <- liftIO $ STM.atomically $ STM.readTMVar clientsVar
-  newClients <- mapM
+  newClients <- foldM
-    (\client@(clientSocket, mThread) ->
+    (\acc (clientSocket, mThread) ->
-      if isNothing mThread
+      case mThread of
-      then liftIO $ do
+      Nothing -> liftIO $ do
-        connectionHandle <- socketToHandle clientSocket ReadMode
         thread <- forkIO
-          (listenTo connectionHandle)
+          (listenTo clientSocket)
-        pure (clientSocket, Just thread)
+        pure $ (clientSocket, Just thread) : acc
-      else
+      Just _ -> liftIO $ do
-        pure client
+        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