finally fixed communication

src-server/Server/Communication.hs

@@ -60,8 +60,7 @@ terminateGameOnSigint = do
     sigINT
     (CatchOnce $ do
       putStrLn "SIGINT caught, terminating…"
-      queues <- liftIO $ STM.atomically $ STM.readTMVar queueList
+      disconnectClients clientList queueList
-      disconnectClients clientList queues
       threadDelay (10 ^ 6)
       close sock
       st <- STM.atomically $ STM.readTMVar serverState
@@ -74,17 +73,18 @@ terminateGameOnSigint = do
 -- | Disconnect all connected clients gracefully by announcing the server quitting
 disconnectClients
   :: STM.TMVar [ClientSocket]
-  -> [ClientQueue]
+  -> STM.TMVar [ClientQueue]
   -> IO ()
-disconnectClients clientSockets queues = do
+disconnectClients clientSockets queueList = do
   putStrLn "server shutting down. Notifying all clients…"
+  queues <- STM.atomically $ STM.readTMVar queueList
   mapM_
     (\queue -> do
       maybe
         (pure ())
         (\uuid -> do
           putStrLn $ "notifying client: " <> show uuid
-          queueMessage ServerQuit uuid queues
+          queueMessage ServerQuit uuid queueList
           sock <- do
             socketList <- STM.atomically $ STM.readTMVar clientSockets
             pure $ fromJust $ find (\s -> csUUID s == Just uuid) socketList
@@ -114,10 +114,14 @@ processRequests = do
         Right (clientSock, _) -> do
           clientQueue <- STM.newTQueueIO
           sockContainer <- STM.newTMVarIO clientSock
-          receiverThreadId <- liftIO $ forkIO $ forever $ do
+          receiverThreadId <- liftIO $ do
-            receiveMessage sockContainer serverQueue
+            t <- forkIO $ forever $ receiveMessage sockContainer serverQueue
-          senderThreadId <- liftIO $ forkIO $ forever $ do
+            putStrLn "enabled listener thread"
-            sendMessageQueue sockContainer clientQueue
+            pure t
+          senderThreadId <- liftIO $ do
+            t <- forkIO $ forever $ sendMessageQueue sockContainer clientQueue
+            putStrLn "enabled sender thread"
+            pure t
           print clientSock
           liftIO $ STM.atomically $ do
             slist <- STM.takeTMVar socketList

src-server/Server/Communication/Handler.hs

@@ -53,7 +53,7 @@ handleMessage stateContainer readerContainer msg = do
           void $ STM.swapTMVar socketList newSocks
           void $ STM.swapTMVar queueList newQueues
         putStrLn $ "Accepted Client with UUID: " <> show clientId
-        queueMessage (AcceptClient clientId) clientId newQueues
+        queueMessage (AcceptClient clientId) clientId queueList
       else
         putStrLn $ "Unable to assign ID to Socket and queue: " <> show clientId
     ClientMessage clientId payload ->
@@ -73,7 +73,7 @@ handleMessage stateContainer readerContainer msg = do
             currentPlayers <- STM.readTMVar (scPlayers stateContainer)
             void $ STM.swapTMVar (scPlayers stateContainer) $
               Player clientId freshWizard False (now, uuid) : currentPlayers
-          queueMessage (ProvideInitialWizard freshWizard) clientId queues
+          queueMessage (ProvideInitialWizard freshWizard) clientId queueList
         ClientReady -> do
           now <- getCurrentTime
           STM.atomically $ do

src-server/Server/Communication/Receive.hs

@@ -33,11 +33,11 @@ receiveMessage
   -> STM.TQueue ClientMessage
   -> IO ()
 receiveMessage sockContainer queue = do
-  randSleep <- randomRIO (1, 1000)
+  -- randSleep <- randomRIO (1, 1000)
-  threadDelay randSleep
+  -- threadDelay randSleep
-  sock <- STM.atomically $ STM.takeTMVar sockContainer
+  sock <- STM.atomically $ STM.readTMVar sockContainer
   let maxBufferLength = 4096
-  putStrLn "took socket container for receiving"
+  putStrLn "read socket container for receiving"
   mMsg <- do
     ptr <- mallocArray maxBufferLength
     putStrLn "receiving data"

src-server/Server/Communication/Send.hs

@@ -28,7 +28,7 @@ import qualified Data.Vector.Storable as VS
 
 import Data.List
 
-import Data.UUID
+import Data.UUID hiding (null)
 import Data.UUID.V4
 
 import Linear
@@ -47,9 +47,10 @@ import Server.Types
 queueMessage
   :: ServerMessage
   -> UUID
-  -> [ClientQueue]
+  -> STM.TMVar [ClientQueue]
   -> IO ()
-queueMessage msg uuid queueList = do
+queueMessage msg uuid queueListContainer = do
+  queueList <- STM.atomically $ STM.readTMVar queueListContainer
   putStrLn $ "queueing message \"" <> show msg <> "\" for client " <> show uuid <> " …"
   let mQueue = cqQueue <$> find (\client -> cqUUID client == Just uuid) queueList
   maybe
@@ -65,9 +66,10 @@ sendMessageQueue
   -> STM.TQueue ServerMessage
   -> IO ()
 sendMessageQueue sockContainer queue = do
-  randTime <- randomRIO (1, 1000)
+  -- randTime <- randomRIO (1, 1000)
-  threadDelay randTime
+  -- threadDelay randTime
   msgs <- STM.atomically $ STM.flushTQueue queue
+  unless (null msgs) $ putStrLn $ "messages in queue: " <> show msgs
   mapM_
     (\msg -> do
       sock <- STM.atomically $ STM.readTMVar sockContainer
@@ -113,7 +115,7 @@ sendPings = do
             random <- liftIO nextRandom
             let newPong = (now, random)
             liftIO $ do
-              queues <- STM.atomically $ STM.readTMVar (scClientQueues stateContainer)
+              let queues = scClientQueues stateContainer
               queueMessage
                 ( Ping random
                 )
@@ -193,5 +195,5 @@ sendUpdate stateContainer tileMap player = do
       let msg = TickUpdate slice wizard
       -- print slice
       liftIO $ do
-        queues <- STM.atomically $ STM.readTMVar $ scClientQueues stateContainer
+        let queues = scClientQueues stateContainer
         queueMessage msg playerId queues