From 07189c7e76ba4bb171b4537db0d45ddd41eb53b6 Mon Sep 17 00:00:00 2001 From: nek0 Date: Sun, 3 Nov 2024 11:51:13 +0100 Subject: [PATCH] finally fixed communication --- src-server/Server/Communication.hs | 22 +++++++++++++--------- src-server/Server/Communication/Handler.hs | 4 ++-- src-server/Server/Communication/Receive.hs | 8 ++++---- src-server/Server/Communication/Send.hs | 16 +++++++++------- 4 files changed, 28 insertions(+), 22 deletions(-) diff --git a/src-server/Server/Communication.hs b/src-server/Server/Communication.hs index a197dee..2d07693 100644 --- a/src-server/Server/Communication.hs +++ b/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 queues + disconnectClients clientList queueList 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 - receiveMessage sockContainer serverQueue - senderThreadId <- liftIO $ forkIO $ forever $ do - sendMessageQueue sockContainer clientQueue + receiverThreadId <- liftIO $ do + t <- forkIO $ forever $ receiveMessage sockContainer serverQueue + putStrLn "enabled listener thread" + 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 diff --git a/src-server/Server/Communication/Handler.hs b/src-server/Server/Communication/Handler.hs index e242afd..da9b74a 100644 --- a/src-server/Server/Communication/Handler.hs +++ b/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 diff --git a/src-server/Server/Communication/Receive.hs b/src-server/Server/Communication/Receive.hs index 597f282..4187668 100644 --- a/src-server/Server/Communication/Receive.hs +++ b/src-server/Server/Communication/Receive.hs @@ -33,11 +33,11 @@ receiveMessage -> STM.TQueue ClientMessage -> IO () receiveMessage sockContainer queue = do - randSleep <- randomRIO (1, 1000) - threadDelay randSleep - sock <- STM.atomically $ STM.takeTMVar sockContainer + -- randSleep <- randomRIO (1, 1000) + -- threadDelay randSleep + 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" diff --git a/src-server/Server/Communication/Send.hs b/src-server/Server/Communication/Send.hs index 1273da8..19afb62 100644 --- a/src-server/Server/Communication/Send.hs +++ b/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) - threadDelay randTime + -- randTime <- randomRIO (1, 1000) + -- 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