server start hadling pongs

This commit is contained in:
nek0 2024-02-02 16:34:50 +01:00
parent baae726e56
commit d2062b2cbe
2 changed files with 17 additions and 11 deletions

View file

@ -90,13 +90,11 @@ disconnectClients = mapM_
close clientSocket
)
timeoutClients
:: [(Maybe UUID, Socket)]
dropClient
:: (Maybe UUID, Socket)
-> IO ()
timeoutClients = mapM_
(\(_, clientSocket) -> do
close clientSocket
)
dropClient =
close . snd
-- | Process incoming connection requests
processRequests :: Game ()
@ -220,11 +218,12 @@ handleMessage stateContainer readerContainer msg = do
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 : currentPlayers
Player clientId freshWizard False (now, uuid) : currentPlayers
let clientSock = fromJust $ lookup (Just clientId) clients
sendMessage (ProvideInitialWizard freshWizard) clientSock
ClientReady -> do
@ -236,6 +235,13 @@ handleMessage stateContainer readerContainer msg = do
unless (null thisPlayers) $
void $ STM.swapTMVar (scPlayers stateContainer) $
(head thisPlayers) {playerReady = True} : otherPlayers
Pong uuid -> do
let client = fromJust $ (lookup (Just clientId) clients)
player <- STM.atomically $ do
players <- STM.readTMVar (scPlayers stateContainer)
pure $ head $ filter (\p -> playerId p == clientId) players
when (snd (playerLastPong player) /= uuid) $
dropClient (Just clientId, client)
_ -> pure ()
sendPings :: Game ()
@ -248,13 +254,13 @@ sendPings = do
players <- liftIO $ STM.atomically $ STM.readTMVar (scPlayers stateContainer)
sockets <- liftIO $ STM.atomically $ STM.readTMVar (scClientSockets stateContainer)
mapM_
(\(Player playerId (Wizard {}) readiness lastPong) -> do
let timeDiff = realToFrac $ diffUTCTime now lastPong
(\(Player playerId (Wizard {}) readiness (lastPongTime, _)) -> do
let timeDiff = realToFrac $ diffUTCTime now lastPongTime
when (readiness && timeDiff > (fromIntegral framesPerPing * recip (fromIntegral fps))) $ do
let clientSock = fromJust (lookup (Just playerId) sockets)
if timeDiff > realToFrac maxTimeout
then
liftIO $ disconnectClients [(Just playerId, clientSock)]
liftIO $ dropClient (Just playerId, clientSock)
else do
random <- liftIO nextRandom
liftIO $ sendMessage

View file

@ -69,7 +69,7 @@ data Player = Player
{ playerId :: UUID
, playerWizard :: Wizard
, playerReady :: Bool
, playerLastPong :: UTCTime
, playerLastPong :: (UTCTime, UUID)
}
deriving (Eq, Show)