nearing the solution

2024-11-03 04:40:46 +01:00 · 2024-11-03 04:40:46 +01:00 · e8bdc8a1f7
commit e8bdc8a1f7
parent 473d9dea6e
10 changed files with 181 additions and 161 deletions
--- a/configuration.yaml
+++ b/configuration.yaml
@ -2,6 +2,6 @@ setSocketPath         : "/tmp/wizard.sock"
 setMapRows            : 40
 setMapColumns         : 40
 setSpawnerProbability : 0.01
-setFPS                : 30
+setFPS                : 1
 setClientMaxTimeout   : 5
 setFramesPerPing      : 120
--- a/src-client/Main.hs
+++ b/src-client/Main.hs
@ -15,7 +15,7 @@ import qualified Data.Matrix as M
 import Graphics.Vty
 import Graphics.Vty.CrossPlatform

-import Network.Socket (close)
+import Network.Socket (Socket, close)

 import Options.Applicative

@ -44,8 +44,7 @@ main = do
  mockClientState <- STM.newTMVarIO (ClientState undefined False)
  let mockState = StateContainer undefined mockClientState undefined undefined
  sendMessage IdRequest sock
-  receiveMessage sock messageQueue mockState
-  awaitResponse messageQueue 1
+  awaitResponse sock messageQueue mockState 0
  clientIdMsg <- head <$> STM.atomically (STM.flushTQueue messageQueue)
  let clientId = acClientUUID clientIdMsg
  putStrLn $ "received client UUID: " <> show clientId
@ -57,8 +56,7 @@ main = do

  sendMessage (ClientMessage clientId ClientRequestWizard) sock
  -- threadDelay $ 1 * 10 ^ 6
-  receiveMessage sock messageQueue mockState
-  awaitResponse messageQueue 1
+  awaitResponse sock messageQueue mockState 1
  playerWizard <- head <$> STM.atomically (STM.flushTQueue messageQueue)
  putStrLn $ "received wizard: " <> show (initWizard playerWizard)

@ -85,7 +83,7 @@ main = do
  putStrLn "Shutting down client…"
  showCursor (outputIface vty)
  shutdown vty
-  threadDelay (10 ^ 6)
+  threadDelay (10 ^ 3)
  putStrLn "Closing connection to server…"
  close sock
  putStrLn "bye bye"
@ -112,14 +110,17 @@ welcomeText = mconcat $ map (<> "\n")
  ]

 awaitResponse
-  :: STM.TQueue ServerMessage
+  :: Socket
+  -> STM.TQueue ServerMessage
+  -> StateContainer
  -> Int
  -> IO ()
-awaitResponse _ 10 = error "Tries to communicate with server exceeded"
-awaitResponse messageQueue numTries = do
+awaitResponsea _ _ _ 10 = error "Tries to communicate with server exceeded"
+awaitResponse sock messageQueue mockState numTries = do
+  receiveMessage sock messageQueue mockState
  responsePresent <- not <$> STM.atomically (STM.isEmptyTQueue messageQueue)
  if responsePresent
  then pure ()
  else do
    threadDelay $ 10 ^ 6
-    awaitResponse messageQueue (succ numTries)
+    awaitResponse sock messageQueue mockState (succ numTries)
--- a/src-server/Main.hs
+++ b/src-server/Main.hs
@ -54,6 +54,7 @@ main = do
      putStrLn "starting game…"
      now <- getCurrentTime
      sockList <- STM.newTMVarIO []
+      queueList <- STM.newTMVarIO []
      messageQueue <- STM.newTQueueIO
      serverState <- STM.newTMVarIO (ServerState False False)
      emptyPLayers <- STM.newTMVarIO []
@ -63,7 +64,7 @@ main = do
            setFramesPerPing
            setClientMaxTimeout
            sock
-          initState = StateContainer (arenaSpawners arena) emptyPLayers serverState now sockList messageQueue
+          initState = StateContainer (arenaSpawners arena) emptyPLayers serverState now sockList queueList messageQueue
      (finalState, finalWrite) <- execRWST
        (do
          terminateGameOnSigint
--- a/src-server/Server/Communication.hs
+++ b/src-server/Server/Communication.hs
@ -16,6 +16,10 @@ import Control.Monad.IO.Class

 import Control.Monad.RWS.Strict

+import Data.List (find)
+
+import Data.Maybe (fromJust)
+
 import Network.Socket as Net

 import System.Posix.Signals
@ -51,12 +55,13 @@ terminateGameOnSigint = do
  sock <- asks rcMainSocket
  serverState <- gets scServerState
  clientList <- gets scClientSockets
+  queueList <- gets scClientQueues
  void $ liftIO $ installHandler
    sigINT
    (CatchOnce $ do
      putStrLn "SIGINT caught, terminating…"
-      clients <- liftIO $ STM.atomically $ STM.readTMVar clientList
-      disconnectClients clientList clients
+      queues <- liftIO $ STM.atomically $ STM.readTMVar queueList
+      disconnectClients clientList queues
      threadDelay (10 ^ 6)
      close sock
      st <- STM.atomically $ STM.readTMVar serverState
@ -68,62 +73,72 @@ terminateGameOnSigint = do

 -- | Disconnect all connected clients gracefully by announcing the server quitting
 disconnectClients
-  :: STM.TMVar [ClientComms]
-  -> [ClientComms]
+  :: STM.TMVar [ClientSocket]
+  -> [ClientQueue]
  -> IO ()
-disconnectClients clientList clients = do
+disconnectClients clientSockets queues = do
  putStrLn "server shutting down. Notifying all clients…"
  mapM_
-    (\client -> do
+    (\queue -> do
      maybe
        (pure ())
        (\uuid -> do
          putStrLn $ "notifying client: " <> show uuid
-          queueMessage ServerQuit uuid clientList
-          dropClient clientList (ccSocket client)
+          queueMessage ServerQuit uuid queues
+          sock <- do
+            socketList <- STM.atomically $ STM.readTMVar clientSockets
+            pure $ fromJust $ find (\s -> csUUID s == Just uuid) socketList
+          dropClient clientSockets (csSocket sock)
        )
-        (ccUUID client)
+        (cqUUID queue)
    )
-    clients
+    queues


 -- | Process incoming connection requests
 processRequests :: Game ()
 processRequests = do
  mainSocket <- asks rcMainSocket
-  queue <- gets scMessageQueue
+  serverQueue <- gets scMessageQueue
  socketList <- gets scClientSockets
+  queueList <- gets scClientQueues
  st <- gets scServerState
-  void $ liftIO $ forkIO $ acceptConnection mainSocket socketList queue st
+  void $ liftIO $ forkIO $ acceptConnection mainSocket socketList queueList serverQueue st
  where
-    acceptConnection mainSocket socketList queue st = do
+    acceptConnection mainSocket socketList queueList serverQueue st = do
      putStrLn "Ready for new connection requests…"
      eSock <- try $ accept mainSocket
      case eSock of
        Left (_ :: SomeException) ->
          putStrLn "Main socket vanished!"
        Right (clientSock, _) -> do
-          messageQueue <- STM.newTQueueIO
+          clientQueue <- STM.newTQueueIO
          sockContainer <- STM.newTMVarIO clientSock
-          clientWriteThreadId <- liftIO $ forkIO $ forever $ do
-            receiveMessage sockContainer queue socketList
-          clientListenThreadId <- liftIO $ forkIO $ forever $ do
-            sendMessageQueue sockContainer messageQueue
+          receiverThreadId <- liftIO $ forkIO $ forever $ do
+            receiveMessage sockContainer serverQueue
+          senderThreadId <- liftIO $ forkIO $ forever $ do
+            sendMessageQueue sockContainer clientQueue
          print clientSock
          liftIO $ STM.atomically $ do
-            list <- STM.takeTMVar socketList
+            slist <- STM.takeTMVar socketList
            STM.putTMVar
              socketList
-              (ClientComms
+              (ClientSocket
                Nothing
                clientSock
-                messageQueue
-                clientWriteThreadId
-                clientListenThreadId
-                : list
+                receiverThreadId
+                senderThreadId
+              : slist
+              )
+            qlist <- STM.takeTMVar queueList
+            STM.putTMVar queueList
+              (ClientQueue
+                Nothing
+                clientQueue
+              : qlist
              )
          putStrLn "accepted new connection"
          -- abortCondition <- serverStop <$> STM.atomically (STM.readTMVar st)
          -- unless abortCondition $
          --   acceptConnection mainSocket socketList queue st
-          acceptConnection mainSocket socketList queue st
+          acceptConnection mainSocket socketList queueList serverQueue st
--- a/src-server/Server/Communication/Handler.hs
+++ b/src-server/Server/Communication/Handler.hs
@ -29,19 +29,20 @@ handleMessage
  -> IO ()
 handleMessage stateContainer readerContainer msg = do
  let clientList = scClientSockets stateContainer
+  queueList <- STM.atomically $ STM.readTMVar $ scClientQueues stateContainer
  clients <- liftIO $ STM.atomically $ STM.readTMVar clientList
  -- putStrLn $ "Handling: " <> show msg
  case msg of
    IdRequest                      -> do
      clientId <- nextRandom
-      let clientIdx = findIndex (isNothing . ccUUID) clients
-          clientSock = ccSocket $ clients !! fromJust clientIdx
+      let clientIdx = findIndex (isNothing . csUUID) clients
+          clientSock = csSocket $ clients !! fromJust clientIdx
          newClients = map
-            (\old@(ClientComms mUUID oldClientSock _ _ _) ->
+            (\old@(ClientSocket mUUID oldClientSock _ _) ->
              if oldClientSock == clientSock && isNothing mUUID
              then
                old
-                  { ccUUID = Just clientId
+                  { csUUID = Just clientId
                  }
              else
                old
@ -49,13 +50,13 @@ handleMessage stateContainer readerContainer msg = do
            clients
      void $ liftIO $ STM.atomically $ STM.swapTMVar clientList newClients
      putStrLn $ "Accepted Client with UUID " <> show clientId
-      queueMessage (AcceptClient clientId) clientId clientList
+      queueMessage (AcceptClient clientId) clientId queueList
    ClientMessage clientId payload ->
      case payload of
        ClientQuit -> do
          putStrLn $ "client has quit the game: " <> show clientId
-          let client = find (\a -> ccUUID a == Just clientId) clients
-          dropClient clientList (ccSocket $ fromJust client)
+          let client = find (\a -> csUUID a == Just clientId) clients
+          dropClient clientList (csSocket $ fromJust client)
        ClientRequestWizard -> do
          putStrLn "initializing new wizard"
          let arena = rcMap readerContainer
@ -67,9 +68,8 @@ 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 clientList
+          queueMessage (ProvideInitialWizard freshWizard) clientId queueList
        ClientReady -> do
-          putStrLn $ "client " <> show clientId <> " is ready!"
          now <- getCurrentTime
          STM.atomically $ do
            currentPlayers <- STM.readTMVar (scPlayers stateContainer)
@ -82,27 +82,27 @@ handleMessage stateContainer readerContainer msg = do
                  , playerLastPong = (now, snd (playerLastPong $ head thisPlayers))
                  }
                  : otherPlayers
-        Pong uuid -> do
-          let mclient = find (\c -> ccUUID c == Just clientId) clients
+          putStrLn $ "client ready: " <> show clientId
+        Pong pongUuid -> do
+          let mclient = find (\c -> csUUID c == Just clientId) clients
+          players <- STM.atomically $ STM.readTMVar (scPlayers stateContainer)
          maybe
-            (putStrLn $ "Who is " <> show uuid <> "?")
-            (\_ -> do
+            (putStrLn $ "Unknown client: " <> show clientId)
+            (const $ do
              mPlayer <- STM.atomically $ do
-                players <- STM.readTMVar (scPlayers stateContainer)
                pure $ find (\p -> playerId p == clientId) players
              maybe
                (pure ())
                (\player ->
-                  if snd (playerLastPong player) /= uuid
+                  if snd (playerLastPong player) /= pongUuid
                  then
-                    putStrLn $ "Pong ID mismatch from " <> show clientId
+                    putStrLn $ "Pong ID mismatch from: " <> show clientId
                  else do
                    now <- getCurrentTime
                    STM.atomically$ do
-                      players <- STM.readTMVar (scPlayers stateContainer)
                      let otherPlayers = filter (\a -> playerId a /= playerId player) players
                          modPlayer = player
-                            { playerLastPong = (now, uuid)
+                            { playerLastPong = (now, pongUuid)
                            }
                      void $ STM.swapTMVar (scPlayers stateContainer) (modPlayer : otherPlayers)
                    sendUpdate stateContainer (rcMap readerContainer) player
--- a/src-server/Server/Communication/Receive.hs
+++ b/src-server/Server/Communication/Receive.hs
@ -1,3 +1,4 @@
+{-# LANGUAGE OverloadedStrings #-}
 module Server.Communication.Receive where

 import Control.Concurrent (threadDelay)
@ -30,43 +31,38 @@ import Server.Types
 receiveMessage
  :: STM.TMVar Socket
  -> STM.TQueue ClientMessage
-  -> STM.TMVar [ClientComms]
  -> IO ()
-receiveMessage sockContainer queue clientList = do
+receiveMessage sockContainer queue = do
  randSleep <- randomRIO (1, 1000)
  threadDelay randSleep
-  msock <- STM.atomically $ STM.tryTakeTMVar sockContainer
+  sock <- STM.atomically $ STM.readTMVar sockContainer
  let maxBufferLength = 4096
+  putStrLn "read socket container for receiving"
+  mMsg <- do
+    ptr <- mallocArray maxBufferLength
+    putStrLn "receiving data"
+    eBufferLength <-
+      try $ recvBuf sock ptr maxBufferLength
+    bufferLength <- case eBufferLength of
+      Left (e :: IOException) -> do
+        -- putStrLn ("Socket vanished, cleaning up after " <> show e)
+        -- dropClient clientList sock
+        pure 0
+      Right len -> pure len
+    free ptr
+    msg <- B.pack <$> peekArray bufferLength ptr
+    putStrLn $ "received data: " <> show msg
+    if bufferLength > 0 && msg /= ""
+    then do
+      putStrLn $ "received message: " <> show msg
+      pure (A.decode' $ B8.fromStrict msg :: Maybe ClientMessage)
+    else
+      pure Nothing
  maybe
    (pure ())
-    (\sock -> do
-      putStrLn "took socket container for receiving"
-      mMsg <- do
-        ptr <- mallocArray maxBufferLength
-        eBufferLength <-
-          try $ recvBuf sock ptr maxBufferLength
-        bufferLength <- case eBufferLength of
-          Left (e :: IOException) -> do
-            -- putStrLn ("Socket vanished, cleaning up after " <> show e)
-            -- dropClient clientList sock
-            pure 0
-          Right len -> pure len
-        msg <- B.pack <$> peekArray bufferLength ptr
-        let mJsonMsg = A.decode' $ B8.fromStrict msg :: Maybe ClientMessage
-        free ptr
-        if bufferLength > 0
-        then
-          pure mJsonMsg
-        else
-          pure Nothing
-      maybe
-        (pure ())
-        (\msg -> do
-          print msg
-          liftIO $ STM.atomically $ STM.writeTQueue queue msg
-          -- when (msg == IdRequest) (threadDelay $ 10 ^ 3)
-        )
-        mMsg
-      STM.atomically $ STM.putTMVar sockContainer sock
+    (\msg -> do
+      print msg
+      liftIO $ STM.atomically $ STM.writeTQueue queue msg
+      -- when (msg == IdRequest) (threadDelay $ 10 ^ 3)
    )
-    msock
+    mMsg
--- a/src-server/Server/Communication/Send.hs
+++ b/src-server/Server/Communication/Send.hs
@ -47,50 +47,44 @@ import Server.Types
 queueMessage
  :: ServerMessage
  -> UUID
-  -> STM.TMVar [ClientComms]
+  -> [ClientQueue]
  -> IO ()
-queueMessage msg uuid clientList = do
-  clients <- STM.atomically $ STM.readTMVar clientList
-  let mQueue = ccQueue <$> find (\client -> ccUUID client == Just uuid) clients
+queueMessage msg uuid queueList = do
+  putStrLn $ "queueing message \"" <> show msg <> "\" for client " <> show uuid <> " …"
+  let mQueue = cqQueue <$> find (\client -> cqUUID client == Just uuid) queueList
  maybe
-    (putStrLn $ "unknown client UUID: " <> show uuid)
+    (putStrLn $ "no queue found for client: " <> show uuid)
    (\queue ->
      STM.atomically $ STM.writeTQueue queue msg
      )
    mQueue
+  putStrLn "message queued!"

 sendMessageQueue
  :: STM.TMVar Socket
  -> STM.TQueue ServerMessage
  -> IO ()
 sendMessageQueue sockContainer queue = do
-  randSleep <- randomRIO (1, 1000)
-  threadDelay randSleep
-  msock <- STM.atomically $ STM.tryTakeTMVar sockContainer
-  maybe
-    (pure ())
-    (\sock -> do
-      putStrLn "took socket container for sending"
-      msgs <- STM.atomically $ STM.flushTQueue queue
-      mapM_
-        (\msg -> do
-          let msgJson = A.encode msg
-              msgVector = VS.fromList $ B.unpack $ B.toStrict ('<' `B8.cons` (msgJson `B8.snoc` '>'))
-          VS.unsafeWith
-            msgVector
-            (\ptr -> do
-              eResult <- try $ void $ sendBuf sock ptr (VS.length msgVector)
-              case eResult of
-                Left (e :: IOException) ->
-                  putStrLn $ "can't reach client after " <> show e
-                Right _ ->
-                  pure ()
-            )
+  msgs <- STM.atomically $ STM.flushTQueue queue
+  mapM_
+    (\msg -> do
+      sock <- STM.atomically $ STM.readTMVar sockContainer
+      putStrLn "read socket container for sending"
+      putStrLn $ "sending message: " <> show msg
+      let msgJson = A.encode msg
+          msgVector = VS.fromList $ B.unpack $ B.toStrict ('<' `B8.cons` (msgJson `B8.snoc` '>'))
+      VS.unsafeWith
+        msgVector
+        (\ptr -> do
+          eResult <- try $ void $ sendBuf sock ptr (VS.length msgVector)
+          case eResult of
+            Left (e :: IOException) ->
+              putStrLn $ "can't reach client after " <> show e
+            Right _ ->
+              pure ()
        )
-        msgs
-      STM.atomically $ STM.putTMVar sockContainer sock
    )
-    msock
+    msgs

 sendPings :: Game ()
 sendPings = do
@ -100,54 +94,59 @@ sendPings = do
  fps <- asks rcFPS
  stateContainer <- get
  players <- liftIO $ STM.atomically $ STM.readTMVar (scPlayers stateContainer)
-  sockets <- liftIO $ STM.atomically $ STM.readTMVar (scClientSockets stateContainer)
+  -- sockets <- liftIO $ STM.atomically $ STM.readTMVar (scClientSockets stateContainer)
  mapM_
    (\player@(Player plId (Wizard {}) readiness (lastPongTime, _)) -> do
      let timeDiff = realToFrac $ diffUTCTime now lastPongTime :: Float
      when (readiness && timeDiff > (fromIntegral framesPerPing * recip (fromIntegral fps))) $ do
-        let clientSock = ccSocket <$> find (\c -> ccUUID c == Just plId) sockets
-        when (isJust clientSock) $
-          if timeDiff > realToFrac maxTimeout
-          then do
-            liftIO $ do
-              putStrLn $ "dropping client because of timeout: " <> show plId
-              dropClient (scClientSockets stateContainer) (fromJust clientSock)
-            put stateContainer
-          else do
+        -- let clientSock = ccSocket <$> find (\c -> ccUUID c == Just plId) sockets
+        -- when (isJust clientSock) $
+          -- if timeDiff > realToFrac maxTimeout
+          -- then do
+          --   liftIO $ do
+          --     putStrLn $ "dropping client because of timeout: " <> show plId
+          --     dropClient (scClientSockets stateContainer) (fromJust clientSock)
+          --   put stateContainer
+          -- else do
            random <- liftIO nextRandom
            let newPong = (now, random)
-            liftIO $ queueMessage
-              ( Ping random
-              )
-              plId
-              (scClientSockets stateContainer)
+            liftIO $ do
+              queues <- STM.atomically $ STM.readTMVar (scClientQueues stateContainer)
+              queueMessage
+                ( Ping random
+                )
+                plId
+                queues
            let newPlayer = player
                  { playerLastPong = newPong
                  }
                otherPlayers = filter (\a -> playerId a /= plId) players
-            liftIO $ void $ STM.atomically $
-              STM.swapTMVar (scPlayers stateContainer) (newPlayer : otherPlayers)
+            liftIO $ do
+              void $ STM.atomically $
+                STM.swapTMVar (scPlayers stateContainer) (newPlayer : otherPlayers)
+              putStrLn "ping!"
    )
    players
  put stateContainer

 -- | Drops the client from internal management and closes its socket, if still present.
 dropClient
-  :: STM.TMVar [ClientComms]
+  :: STM.TMVar [ClientSocket]
  -> Socket
  -> IO ()
 dropClient clientList sock = do
  mClient <- STM.atomically $ do
    clients <- STM.readTMVar clientList
-    let mclient = find (\client -> ccSocket client == sock) clients
-    let reducedClients = filter (\client -> ccSocket client /= sock) clients
+    let mclient = find (\client -> csSocket client == sock) clients
+    let reducedClients = filter (\client -> csSocket client /= sock) clients
    void $ STM.swapTMVar clientList reducedClients
    pure mclient
  maybe
    (putStrLn $ "closing unknown socket: " <> show sock)
    (\client -> do
-      putStrLn $ "dropping client because of closed socket: " <> show (fromJust $ ccUUID client)
-      killThread (ccListener client)
+      putStrLn $ "dropping client because of closed socket: " <> show (fromJust $ csUUID client)
+      killThread (csSender client)
+      killThread (csReceiver client)
    )
    mClient
  close sock
@ -158,11 +157,11 @@ sendUpdate
  -> Player
  -> IO ()
 sendUpdate stateContainer tileMap player = do
-  slice <- buildSlice player
+  let slice = buildSlice player
  sendSlice slice player
  where
-    buildSlice :: Player -> IO MapSlice
-    buildSlice (Player _ (Wizard {..}) _ _) = do
+    buildSlice :: Player -> MapSlice
+    buildSlice (Player _ (Wizard {..}) _ _) =
      let V2 wr wc = wizardPos
          subCoords = (,) <$> [floor wr - 4 .. floor wr + 4] <*> [floor wc - 4 .. floor wc + 4]
          leftBound = wizardRot + (pi / 4)
@ -185,9 +184,12 @@ sendUpdate stateContainer tileMap player = do
                Nothing
            )
            subCoords
-      pure (MapSlice initViewMatrix [])
+      in
+        MapSlice initViewMatrix []
    sendSlice :: MapSlice -> Player -> IO ()
    sendSlice slice (Player playerId wizard _ _) = do
      let msg = TickUpdate slice wizard
      -- print slice
-      liftIO $ queueMessage msg playerId (scClientSockets stateContainer)
+      liftIO $ do
+        queues <- STM.atomically $ STM.readTMVar $ scClientQueues stateContainer
+        queueMessage msg playerId queues
--- a/src-server/Server/Game.hs
+++ b/src-server/Server/Game.hs
@ -36,13 +36,13 @@ runGame = do
      let delta = realToFrac $ diffUTCTime now before
      -- liftIO $ B8.hPutStr stdout $ "tick: " <> fromString (show delta) <> "  \r"
      handleMessages
-      updateSpawners delta
-      updateWizards delta
-      modify'
-        (\s -> s
-          { scServerLastTick = now
-          }
-        )
+      -- updateSpawners delta
+      -- updateWizards delta
+      -- modify'
+      --   (\s -> s
+      --     { scServerLastTick = now
+      --     }
+      --   )
      fps <- asks rcFPS
      sendPings
      let remainingTime = recip (fromIntegral fps) - delta
@ -50,4 +50,3 @@ runGame = do
        liftIO $ threadDelay $ floor $ remainingTime * 10 ^ 6
    )
  liftIO $ threadDelay (10 ^ 6)
-  -- liftIO $ killThread recvThread
--- a/src-server/Server/Game/Update.hs
+++ b/src-server/Server/Game/Update.hs
@ -16,7 +16,7 @@ import Server.Types

 updateSpawners :: Float -> Game ()
 updateSpawners dt =
-  modify' (\sc@(StateContainer spawners _ _ _ _ _) ->
+  modify' (\sc@(StateContainer spawners _ _ _ _ _ _) ->
    let newSpawners = map
          (\spawner -> do
            let newTTL = spawnerReloadTTL spawner - dt
--- a/src-server/Server/Types.hs
+++ b/src-server/Server/Types.hs
@ -63,16 +63,22 @@ data StateContainer = StateContainer
  , scPlayers        :: STM.TMVar [Player]
  , scServerState    :: STM.TMVar ServerState
  , scServerLastTick :: UTCTime
-  , scClientSockets  :: STM.TMVar [ClientComms]
+  , scClientSockets  :: STM.TMVar [ClientSocket]
+  , scClientQueues   :: STM.TMVar [ClientQueue]
  , scMessageQueue   :: STM.TQueue ClientMessage
  }

-data ClientComms = ClientComms
-  { ccUUID     :: Maybe UUID
-  , ccSocket   :: Socket
-  , ccQueue    :: STM.TQueue ServerMessage
-  , ccWriter   :: ThreadId
-  , ccListener :: ThreadId
+data ClientSocket = ClientSocket
+  { csUUID           :: Maybe UUID
+  , csSocket         :: Socket
+  , csSender         :: ThreadId
+  , csReceiver       :: ThreadId
+  }
+  deriving (Eq)
+
+data ClientQueue = ClientQueue
+  { cqUUID           :: Maybe UUID
+  , cqQueue          :: STM.TQueue ServerMessage
  }
  deriving (Eq)