From 34ae1d4de4bbf04a5df3cc79fec39f4d821df2f3 Mon Sep 17 00:00:00 2001
From: nek0 <nek0@nek0.eu>
Date: Wed, 1 May 2024 23:52:49 +0200
Subject: [PATCH] restructure

---
 src-server/Server/Communication.hs         | 255 +--------------------
 src-server/Server/Communication/Handler.hs | 130 +++++++++++
 src-server/Server/Communication/Receive.hs |  55 +++++
 src-server/Server/Communication/Send.hs    | 127 ++++++++++
 src-server/Server/Game.hs                  |  64 +-----
 src-server/Server/Game/Update.hs           |  75 ++++++
 wizard-wipeout.cabal                       |   4 +
 7 files changed, 400 insertions(+), 310 deletions(-)
 create mode 100644 src-server/Server/Communication/Handler.hs
 create mode 100644 src-server/Server/Communication/Receive.hs
 create mode 100644 src-server/Server/Communication/Send.hs
 create mode 100644 src-server/Server/Game/Update.hs

diff --git a/src-server/Server/Communication.hs b/src-server/Server/Communication.hs
index bf0de9f..79e6a86 100644
--- a/src-server/Server/Communication.hs
+++ b/src-server/Server/Communication.hs
@@ -1,5 +1,8 @@
 {-# LANGUAGE OverloadedStrings #-}
-module Server.Communication where
+module Server.Communication
+  ( module Server.Communication
+  , module S
+  ) where
 
 import Control.Concurrent
 
@@ -13,24 +16,6 @@ import Control.Monad.IO.Class
 
 import Control.Monad.RWS.Strict
 
-import qualified Data.Aeson as A
-
-import qualified Data.ByteString as B
-import qualified Data.ByteString.Lazy.Char8 as B8
-
-import Data.List
-
-import Data.Maybe
-
-import Data.UUID hiding (null)
-import Data.UUID.V4
-
-import Data.Time
-
-import qualified Data.Vector.Storable as VS
-
-import Foreign hiding (void)
-
 import Network.Socket as Net
 
 import System.Posix.Signals
@@ -39,8 +24,10 @@ import System.Posix.Signals
 
 import Library.Types
 
+import Server.Communication.Handler as S
+import Server.Communication.Receive as S
+import Server.Communication.Send as S
 import Server.Types
-import Server.Util
 
 -- | Function which determines whether the given filePath is a supported socket path and
 --   subsequently creates a socket in said location.
@@ -97,26 +84,6 @@ disconnectClients clientList clients = do
     )
     clients
 
--- | Drops the client from internal management and closes its socket, if still present.
-dropClient
-  :: STM.TMVar [ClientComms]
-  -> 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
-    void $ STM.swapTMVar clientList reducedClients
-    pure mclient
-  maybe
-    (putStrLn $ "closing unknown socket: " <> show sock)
-    (\client -> do
-      putStrLn $ "dropping client: " <> show (fromJust $ ccUUID client)
-      killThread (ccListener client)
-    )
-    mclient
-  close sock
 
 -- | Process incoming connection requests
 processRequests :: Game ()
@@ -143,211 +110,3 @@ processRequests = do
           abortCondition <- serverStop <$> STM.atomically (STM.readTMVar st)
           unless abortCondition $
             acceptConnection mainSocket socketList queue st
-
-
--- | Sends a specified message through given socket to the client
-sendMessage
-  :: ServerMessage
-  -> UUID
-  -> STM.TMVar [ClientComms]
-  -> IO ()
-sendMessage msg uuid clientList = do
-  clients <- STM.atomically $ STM.readTMVar clientList
-  let mSock = ccSocket <$> find (\client -> ccUUID client == Just uuid) clients
-      msgJson = A.encode msg
-      msgVector = VS.fromList $ B.unpack $ B.toStrict $ ('<' `B8.cons` (msgJson `B8.snoc` '>'))
-  -- putStrLn $ "Sending: " <> B8.unpack msgJson
-  maybe
-    (putStrLn $ "unknown client UUID: " <> show uuid)
-    (\sock ->
-      VS.unsafeWith
-        msgVector
-        (\ptr -> do
-          eResult <- try $ void $ sendBuf sock ptr (VS.length msgVector)
-          case eResult of
-            Left (_ :: IOException) ->
-              putStrLn $ "cant reach client " <> show uuid
-            Right _ ->
-              pure ()
-        )
-      )
-    mSock
-
--- | handle received messages
-handleMessages :: Game ()
-handleMessages = do
-  queue <- gets scMessageQueue
-  serverState <- get
-  readerContainer <- ask
-  liftIO $ do
-    msgs <- STM.atomically $ do
-      emptyState <- STM.isEmptyTQueue queue
-      if emptyState
-      then
-        pure []
-      else
-        STM.flushTQueue queue
-    void $ do
-      mapM_
-        (handleMessage serverState readerContainer)
-        msgs
-
--- | receive a 'ClientMessage'
-receiveMessage
-  :: Socket
-  -> STM.TQueue ClientMessage
-  -> STM.TMVar [ClientComms]
-  -> IO ()
-receiveMessage sock queue clientList = do
-  let maxBufferLength = 4096
-  mMsg <- do
-    ptr <- mallocArray maxBufferLength
-    eBufferLength <-
-      try $ recvBuf sock ptr maxBufferLength
-    bufferLength <- case eBufferLength of
-      Left (_ :: IOException) -> do
-        putStrLn "Socket vanished, cleaning up…"
-        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
-      liftIO $ STM.atomically $ STM.writeTQueue queue msg
-      -- when (msg == IdRequest) (threadDelay $ 10 ^ 3)
-    )
-    mMsg
-
--- | function for translating 'ClientMessage's into server actions
-handleMessage
-  :: StateContainer
-  -> ReaderContainer
-  -> ClientMessage
-  -> IO ()
-handleMessage stateContainer readerContainer msg = do
-  let clientList = scClientSockets 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
-          newClients = map
-            (\old@(ClientComms mUUID oldClientSock _) ->
-              if oldClientSock == clientSock && isNothing mUUID
-              then
-                old
-                  { ccUUID = Just clientId
-                  }
-              else
-                old
-            )
-            clients
-      void $ liftIO $ STM.atomically $ STM.swapTMVar clientList newClients
-      putStrLn $ "Accepted Client with UUID " <> show clientId
-      sendMessage (AcceptClient clientId) clientId clientList
-    ClientMessage clientId payload ->
-      case payload of
-        ClientQuit -> do
-          putStrLn $ "client " <> show clientId <> " has quit the game"
-          let client = find (\a -> ccUUID a == Just clientId) clients
-          dropClient clientList (ccSocket $ fromJust client)
-        ClientRequestWizard -> do
-          putStrLn "initializing new wizard"
-          let arena = rcMap readerContainer
-          initPos <- rollInitPosition arena
-          now <- liftIO getCurrentTime
-          uuid <- nextRandom
-          let freshWizard = newWizard initPos
-          STM.atomically $ do
-            currentPlayers <- STM.readTMVar (scPlayers stateContainer)
-            void $ STM.swapTMVar (scPlayers stateContainer) $
-              Player clientId freshWizard False (now, uuid) : currentPlayers
-          sendMessage (ProvideInitialWizard freshWizard) clientId clientList
-        ClientReady -> do
-          putStrLn $ "client " <> show clientId <> " is ready!"
-          now <- getCurrentTime
-          STM.atomically $ do
-            currentPlayers <- STM.readTMVar (scPlayers stateContainer)
-            let (thisPlayers, otherPlayers) =
-                  partition (\p -> playerId p == clientId) currentPlayers
-            unless (null thisPlayers) $
-              void $ STM.swapTMVar (scPlayers stateContainer) $
-                (head thisPlayers)
-                  { playerReady = True
-                  , playerLastPong = (now, snd (playerLastPong $ head thisPlayers))
-                  }
-                  : otherPlayers
-        Pong uuid -> do
-          let mclient = find (\c -> ccUUID c == Just clientId) clients
-          maybe
-            (putStrLn $ "Who is " <> show uuid <> "?")
-            (\_ -> 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
-                  then
-                    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)
-                            }
-                      void $ STM.swapTMVar (scPlayers stateContainer) (modPlayer : otherPlayers)
-                )
-                mPlayer
-            )
-            mclient
-
-sendPings :: Game ()
-sendPings = do
-  now <- liftIO getCurrentTime
-  maxTimeout <- asks rcClientMaxTimeout
-  framesPerPing <- asks rcFramesPerPing
-  fps <- asks rcFPS
-  stateContainer <- get
-  players <- liftIO $ STM.atomically $ STM.readTMVar (scPlayers 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 $ dropClient (scClientSockets stateContainer) (fromJust clientSock)
-            put stateContainer
-          else do
-            random <- liftIO nextRandom
-            let newPong = (now, random)
-            liftIO $ sendMessage
-              ( Ping random
-              )
-              plId
-              (scClientSockets stateContainer)
-            let newPlayer = player
-                  { playerLastPong = newPong
-                  }
-                otherPlayers = filter (\a -> playerId a /= plId) players
-            liftIO $ void $ STM.atomically $
-              STM.swapTMVar (scPlayers stateContainer) (newPlayer : otherPlayers)
-    )
-    players
-  put stateContainer
diff --git a/src-server/Server/Communication/Handler.hs b/src-server/Server/Communication/Handler.hs
new file mode 100644
index 0000000..e75f400
--- /dev/null
+++ b/src-server/Server/Communication/Handler.hs
@@ -0,0 +1,130 @@
+module Server.Communication.Handler where
+
+import qualified Control.Concurrent.STM as STM
+
+import Control.Monad
+
+import Control.Monad.Reader
+import Control.Monad.State
+
+import Data.List
+
+import Data.Maybe
+
+import Data.Time
+
+import Data.UUID.V4
+
+import Library.Types
+
+import Server.Communication.Send
+import Server.Types
+import Server.Util
+
+-- | function for translating 'ClientMessage's into server actions
+handleMessage
+  :: StateContainer
+  -> ReaderContainer
+  -> ClientMessage
+  -> IO ()
+handleMessage stateContainer readerContainer msg = do
+  let clientList = scClientSockets 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
+          newClients = map
+            (\old@(ClientComms mUUID oldClientSock _) ->
+              if oldClientSock == clientSock && isNothing mUUID
+              then
+                old
+                  { ccUUID = Just clientId
+                  }
+              else
+                old
+            )
+            clients
+      void $ liftIO $ STM.atomically $ STM.swapTMVar clientList newClients
+      putStrLn $ "Accepted Client with UUID " <> show clientId
+      sendMessage (AcceptClient clientId) clientId clientList
+    ClientMessage clientId payload ->
+      case payload of
+        ClientQuit -> do
+          putStrLn $ "client " <> show clientId <> " has quit the game"
+          let client = find (\a -> ccUUID a == Just clientId) clients
+          dropClient clientList (ccSocket $ fromJust client)
+        ClientRequestWizard -> do
+          putStrLn "initializing new wizard"
+          let arena = rcMap readerContainer
+          initPos <- rollInitPosition arena
+          now <- liftIO getCurrentTime
+          uuid <- nextRandom
+          let freshWizard = newWizard initPos
+          STM.atomically $ do
+            currentPlayers <- STM.readTMVar (scPlayers stateContainer)
+            void $ STM.swapTMVar (scPlayers stateContainer) $
+              Player clientId freshWizard False (now, uuid) : currentPlayers
+          sendMessage (ProvideInitialWizard freshWizard) clientId clientList
+        ClientReady -> do
+          putStrLn $ "client " <> show clientId <> " is ready!"
+          now <- getCurrentTime
+          STM.atomically $ do
+            currentPlayers <- STM.readTMVar (scPlayers stateContainer)
+            let (thisPlayers, otherPlayers) =
+                  partition (\p -> playerId p == clientId) currentPlayers
+            unless (null thisPlayers) $
+              void $ STM.swapTMVar (scPlayers stateContainer) $
+                (head thisPlayers)
+                  { playerReady = True
+                  , playerLastPong = (now, snd (playerLastPong $ head thisPlayers))
+                  }
+                  : otherPlayers
+        Pong uuid -> do
+          let mclient = find (\c -> ccUUID c == Just clientId) clients
+          maybe
+            (putStrLn $ "Who is " <> show uuid <> "?")
+            (\_ -> 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
+                  then
+                    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)
+                            }
+                      void $ STM.swapTMVar (scPlayers stateContainer) (modPlayer : otherPlayers)
+                )
+                mPlayer
+            )
+            mclient
+
+-- | handle received messages
+handleMessages :: Game ()
+handleMessages = do
+  queue <- gets scMessageQueue
+  serverState <- get
+  readerContainer <- ask
+  liftIO $ do
+    msgs <- STM.atomically $ do
+      emptyState <- STM.isEmptyTQueue queue
+      if emptyState
+      then
+        pure []
+      else
+        STM.flushTQueue queue
+    void $ do
+      mapM_
+        (handleMessage serverState readerContainer)
+        msgs
diff --git a/src-server/Server/Communication/Receive.hs b/src-server/Server/Communication/Receive.hs
new file mode 100644
index 0000000..5813b3d
--- /dev/null
+++ b/src-server/Server/Communication/Receive.hs
@@ -0,0 +1,55 @@
+module Server.Communication.Receive where
+
+import qualified Control.Concurrent.STM as STM
+
+import Control.Exception
+
+import Control.Monad.IO.Class
+
+import qualified Data.Aeson as A
+
+import qualified Data.ByteString as B
+import qualified Data.ByteString.Lazy.Char8 as B8
+
+import Foreign.Marshal
+
+import Network.Socket
+
+import Library.Types
+
+import Server.Communication.Send
+import Server.Types
+
+-- | receive a 'ClientMessage'
+receiveMessage
+  :: Socket
+  -> STM.TQueue ClientMessage
+  -> STM.TMVar [ClientComms]
+  -> IO ()
+receiveMessage sock queue clientList = do
+  let maxBufferLength = 4096
+  mMsg <- do
+    ptr <- mallocArray maxBufferLength
+    eBufferLength <-
+      try $ recvBuf sock ptr maxBufferLength
+    bufferLength <- case eBufferLength of
+      Left (_ :: IOException) -> do
+        putStrLn "Socket vanished, cleaning up…"
+        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
+      liftIO $ STM.atomically $ STM.writeTQueue queue msg
+      -- when (msg == IdRequest) (threadDelay $ 10 ^ 3)
+    )
+    mMsg
diff --git a/src-server/Server/Communication/Send.hs b/src-server/Server/Communication/Send.hs
new file mode 100644
index 0000000..921cb46
--- /dev/null
+++ b/src-server/Server/Communication/Send.hs
@@ -0,0 +1,127 @@
+module Server.Communication.Send where
+
+import Control.Concurrent
+
+import qualified Control.Concurrent.STM as STM
+
+import Control.Exception
+
+import Control.Monad
+
+import Control.Monad.Reader
+
+import Control.Monad.State
+
+import qualified Data.Aeson as A
+
+import Data.Maybe
+
+import qualified Data.ByteString as B
+import qualified Data.ByteString.Lazy.Char8 as B8
+
+import Data.Time
+
+import qualified Data.Vector.Storable as VS
+
+import Data.List
+
+import Data.UUID
+import Data.UUID.V4
+
+import Network.Socket
+
+-- internal imports
+
+import Library.Types
+
+import Server.Types
+
+-- | Sends a specified message through given socket to the client
+sendMessage
+  :: ServerMessage
+  -> UUID
+  -> STM.TMVar [ClientComms]
+  -> IO ()
+sendMessage msg uuid clientList = do
+  clients <- STM.atomically $ STM.readTMVar clientList
+  let mSock = ccSocket <$> find (\client -> ccUUID client == Just uuid) clients
+      msgJson = A.encode msg
+      msgVector = VS.fromList $ B.unpack $ B.toStrict ('<' `B8.cons` (msgJson `B8.snoc` '>'))
+  -- putStrLn $ "Sending: " <> B8.unpack msgJson
+  maybe
+    (putStrLn $ "unknown client UUID: " <> show uuid)
+    (\sock ->
+      VS.unsafeWith
+        msgVector
+        (\ptr -> do
+          eResult <- try $ void $ sendBuf sock ptr (VS.length msgVector)
+          case eResult of
+            Left (_ :: IOException) ->
+              putStrLn $ "cant reach client " <> show uuid
+            Right _ ->
+              pure ()
+        )
+      )
+    mSock
+
+sendPings :: Game ()
+sendPings = do
+  now <- liftIO getCurrentTime
+  maxTimeout <- asks rcClientMaxTimeout
+  framesPerPing <- asks rcFramesPerPing
+  fps <- asks rcFPS
+  stateContainer <- get
+  players <- liftIO $ STM.atomically $ STM.readTMVar (scPlayers 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 $ dropClient (scClientSockets stateContainer) (fromJust clientSock)
+            put stateContainer
+          else do
+            random <- liftIO nextRandom
+            let newPong = (now, random)
+            liftIO $ sendMessage
+              ( Ping random
+              )
+              plId
+              (scClientSockets stateContainer)
+            let newPlayer = player
+                  { playerLastPong = newPong
+                  }
+                otherPlayers = filter (\a -> playerId a /= plId) players
+            liftIO $ void $ STM.atomically $
+              STM.swapTMVar (scPlayers stateContainer) (newPlayer : otherPlayers)
+    )
+    players
+  put stateContainer
+
+-- | Drops the client from internal management and closes its socket, if still present.
+dropClient
+  :: STM.TMVar [ClientComms]
+  -> 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
+    void $ STM.swapTMVar clientList reducedClients
+    pure mclient
+  maybe
+    (putStrLn $ "closing unknown socket: " <> show sock)
+    (\client -> do
+      putStrLn $ "dropping client: " <> show (fromJust $ ccUUID client)
+      killThread (ccListener client)
+    )
+    mClient
+  close sock
+
+sendUpdates
+  :: Game ()
+sendUpdates = pure ()
diff --git a/src-server/Server/Game.hs b/src-server/Server/Game.hs
index 8f2559f..04f29c7 100644
--- a/src-server/Server/Game.hs
+++ b/src-server/Server/Game.hs
@@ -21,8 +21,7 @@ import System.IO (stdout)
 
 -- internal imports
 
-import Library.Types
-
+import Server.Game.Update
 import Server.Communication
 import Server.Types
 
@@ -39,6 +38,7 @@ runGame = do
       handleMessages
       updateSpawners delta
       updateWizards delta
+      sendUpdates
       modify'
         (\s -> s
           { scServerLastTick = now
@@ -52,63 +52,3 @@ runGame = do
     )
   liftIO $ threadDelay (10 ^ 6)
   -- liftIO $ killThread recvThread
-
-updateSpawners :: Float -> Game ()
-updateSpawners dt =
-  modify' (\sc@(StateContainer spawners _ _ _ _ _) ->
-    let newSpawners = map
-          (\spawner -> do
-            let newTTL = spawnerReloadTTL spawner - dt
-            if newTTL < 0 && spawnerState spawner == SpawnerEmpty
-            then spawner
-              { spawnerReloadTTL = fromIntegral $ spawnerReloadTime spawner
-              , spawnerState     = SpawnerFull
-              }
-            else spawner
-              { spawnerReloadTTL = spawnerReloadTTL spawner - dt
-              }
-          )
-          spawners
-    in sc
-      { scSpawners = newSpawners
-      }
-    )
-
-updateWizards :: Float -> Game ()
-updateWizards dt = do
-  playersVar <- gets scPlayers
-  players <- liftIO $ STM.atomically $ STM.readTMVar playersVar
-  let newPlayers = map
-        (\player@(Player pId wizard@(Wizard _ _ health _ _ effects) readiness lastPong) ->
-          let newEffects = foldl
-                (\acc effect@(Effect _ ttl) ->
-                  if ttl - dt < 0
-                  then acc
-                  else effect
-                    { effectTTL = ttl - dt
-                    } : acc
-                )
-                []
-                effects
-              effectDamage = foldl
-                (\acc (Effect kind _) ->
-                  if kind `elem` harmingAfflictions
-                  then acc + 1
-                  else acc
-                )
-                0
-                effects
-          in
-            if readiness
-            then
-              player
-                { playerWizard = wizard
-                  { wizardEffects = newEffects
-                  , wizardHealth  = health - effectDamage
-                  }
-                }
-            else
-              player
-        )
-        players
-  void $ liftIO $ STM.atomically $ STM.swapTMVar playersVar newPlayers
diff --git a/src-server/Server/Game/Update.hs b/src-server/Server/Game/Update.hs
new file mode 100644
index 0000000..0e65454
--- /dev/null
+++ b/src-server/Server/Game/Update.hs
@@ -0,0 +1,75 @@
+module Server.Game.Update where
+
+import qualified Control.Concurrent.STM as STM
+
+import Control.Monad
+
+import Control.Monad.Reader
+
+import Control.Monad.State
+
+-- internal imports
+
+import Library.Types
+
+import Server.Types
+
+updateSpawners :: Float -> Game ()
+updateSpawners dt =
+  modify' (\sc@(StateContainer spawners _ _ _ _ _) ->
+    let newSpawners = map
+          (\spawner -> do
+            let newTTL = spawnerReloadTTL spawner - dt
+            if newTTL < 0 && spawnerState spawner == SpawnerEmpty
+            then spawner
+              { spawnerReloadTTL = fromIntegral $ spawnerReloadTime spawner
+              , spawnerState     = SpawnerFull
+              }
+            else spawner
+              { spawnerReloadTTL = spawnerReloadTTL spawner - dt
+              }
+          )
+          spawners
+    in sc
+      { scSpawners = newSpawners
+      }
+    )
+
+updateWizards :: Float -> Game ()
+updateWizards dt = do
+  playersVar <- gets scPlayers
+  players <- liftIO $ STM.atomically $ STM.readTMVar playersVar
+  let newPlayers = map
+        (\player@(Player pId wizard@(Wizard _ _ health _ _ effects) readiness lastPong) ->
+          let newEffects = foldl
+                (\acc effect@(Effect _ ttl) ->
+                  if ttl - dt < 0
+                  then acc
+                  else effect
+                    { effectTTL = ttl - dt
+                    } : acc
+                )
+                []
+                effects
+              effectDamage = foldl
+                (\acc (Effect kind _) ->
+                  if kind `elem` harmingAfflictions
+                  then acc + 1
+                  else acc
+                )
+                0
+                effects
+          in
+            if readiness
+            then
+              player
+                { playerWizard = wizard
+                  { wizardEffects = newEffects
+                  , wizardHealth  = health - effectDamage
+                  }
+                }
+            else
+              player
+        )
+        players
+  void $ liftIO $ STM.atomically $ STM.swapTMVar playersVar newPlayers
diff --git a/wizard-wipeout.cabal b/wizard-wipeout.cabal
index 0b67857..7267314 100644
--- a/wizard-wipeout.cabal
+++ b/wizard-wipeout.cabal
@@ -63,7 +63,11 @@ executable wizard-wipeout-server
     import:           warnings
     main-is:          Main.hs
     other-modules:    Server.Communication
+                      Server.Communication.Handler
+                      Server.Communication.Receive
+                      Server.Communication.Send
                       Server.Game
+                      Server.Game.Update
                       Server.Map
                       Server.Types
                       Server.Util