{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE RecursiveDo #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
module Alpaca.NetCode.Internal.Server
( runServerWith'
, ServerConfig (..)
, defaultServerConfig
) where
import Control.Applicative
import Control.Concurrent (forkIO, killThread, threadDelay)
import Control.Concurrent.STM as STM
import Control.Monad (forM_, forever, join, when, forM)
import Data.Coerce (coerce)
import Data.IntMap (IntMap)
import qualified Data.IntMap as IM
import Data.List (dropWhileEnd, foldl')
import qualified Data.Map as M
import Data.Maybe (catMaybes, fromMaybe, isJust, isNothing)
import Data.Time (getCurrentTime)
import Flat
import Prelude
import Alpaca.NetCode.Internal.Common
data ServerConfig = ServerConfig
{
ServerConfig -> Int
scTickRate :: Int
, ServerConfig -> Float
scClientTimeout :: Float
} deriving (Int -> ServerConfig -> ShowS
[ServerConfig] -> ShowS
ServerConfig -> String
(Int -> ServerConfig -> ShowS)
-> (ServerConfig -> String)
-> ([ServerConfig] -> ShowS)
-> Show ServerConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ServerConfig] -> ShowS
$cshowList :: [ServerConfig] -> ShowS
show :: ServerConfig -> String
$cshow :: ServerConfig -> String
showsPrec :: Int -> ServerConfig -> ShowS
$cshowsPrec :: Int -> ServerConfig -> ShowS
Show, ReadPrec [ServerConfig]
ReadPrec ServerConfig
Int -> ReadS ServerConfig
ReadS [ServerConfig]
(Int -> ReadS ServerConfig)
-> ReadS [ServerConfig]
-> ReadPrec ServerConfig
-> ReadPrec [ServerConfig]
-> Read ServerConfig
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ServerConfig]
$creadListPrec :: ReadPrec [ServerConfig]
readPrec :: ReadPrec ServerConfig
$creadPrec :: ReadPrec ServerConfig
readList :: ReadS [ServerConfig]
$creadList :: ReadS [ServerConfig]
readsPrec :: Int -> ReadS ServerConfig
$creadsPrec :: Int -> ReadS ServerConfig
Read, ServerConfig -> ServerConfig -> Bool
(ServerConfig -> ServerConfig -> Bool)
-> (ServerConfig -> ServerConfig -> Bool) -> Eq ServerConfig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ServerConfig -> ServerConfig -> Bool
$c/= :: ServerConfig -> ServerConfig -> Bool
== :: ServerConfig -> ServerConfig -> Bool
$c== :: ServerConfig -> ServerConfig -> Bool
Eq, Eq ServerConfig
Eq ServerConfig
-> (ServerConfig -> ServerConfig -> Ordering)
-> (ServerConfig -> ServerConfig -> Bool)
-> (ServerConfig -> ServerConfig -> Bool)
-> (ServerConfig -> ServerConfig -> Bool)
-> (ServerConfig -> ServerConfig -> Bool)
-> (ServerConfig -> ServerConfig -> ServerConfig)
-> (ServerConfig -> ServerConfig -> ServerConfig)
-> Ord ServerConfig
ServerConfig -> ServerConfig -> Bool
ServerConfig -> ServerConfig -> Ordering
ServerConfig -> ServerConfig -> ServerConfig
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ServerConfig -> ServerConfig -> ServerConfig
$cmin :: ServerConfig -> ServerConfig -> ServerConfig
max :: ServerConfig -> ServerConfig -> ServerConfig
$cmax :: ServerConfig -> ServerConfig -> ServerConfig
>= :: ServerConfig -> ServerConfig -> Bool
$c>= :: ServerConfig -> ServerConfig -> Bool
> :: ServerConfig -> ServerConfig -> Bool
$c> :: ServerConfig -> ServerConfig -> Bool
<= :: ServerConfig -> ServerConfig -> Bool
$c<= :: ServerConfig -> ServerConfig -> Bool
< :: ServerConfig -> ServerConfig -> Bool
$c< :: ServerConfig -> ServerConfig -> Bool
compare :: ServerConfig -> ServerConfig -> Ordering
$ccompare :: ServerConfig -> ServerConfig -> Ordering
$cp1Ord :: Eq ServerConfig
Ord)
defaultServerConfig ::
Int
-> ServerConfig
defaultServerConfig :: Int -> ServerConfig
defaultServerConfig Int
tickRate = ServerConfig :: Int -> Float -> ServerConfig
ServerConfig
{ scTickRate :: Int
scTickRate = Int
tickRate
, scClientTimeout :: Float
scClientTimeout = Float
5
}
runServerWith' ::
forall input clientAddress.
( Eq input
, Flat input
, Show clientAddress
, Ord clientAddress
) =>
(NetMsg input -> clientAddress -> IO ()) ->
(IO (NetMsg input, clientAddress)) ->
Maybe SimNetConditions ->
ServerConfig ->
input ->
IO ()
runServerWith' :: (NetMsg input -> clientAddress -> IO ())
-> IO (NetMsg input, clientAddress)
-> Maybe SimNetConditions
-> ServerConfig
-> input
-> IO ()
runServerWith' NetMsg input -> clientAddress -> IO ()
sendToClient' IO (NetMsg input, clientAddress)
recvFromClient' Maybe SimNetConditions
simNetConditionsMay ServerConfig
serverConfig input
input0 = Int -> (Float -> IO Float -> (UTCTime -> STM ()) -> IO ()) -> IO ()
forall a b.
Real a =>
a -> (Float -> IO Float -> (UTCTime -> STM ()) -> IO b) -> IO b
playCommon (ServerConfig -> Int
scTickRate ServerConfig
serverConfig) ((Float -> IO Float -> (UTCTime -> STM ()) -> IO ()) -> IO ())
-> (Float -> IO Float -> (UTCTime -> STM ()) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Float
tickTime IO Float
getTime UTCTime -> STM ()
resetTime -> IO () -> IO ()
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
((NetMsg input, clientAddress) -> IO ()
sendToClient'', IO (NetMsg input, clientAddress)
recvFromClient) <- ((NetMsg input, clientAddress) -> IO ())
-> IO (NetMsg input, clientAddress)
-> Maybe SimNetConditions
-> IO
((NetMsg input, clientAddress) -> IO (),
IO (NetMsg input, clientAddress))
forall msg.
(msg -> IO ())
-> IO msg -> Maybe SimNetConditions -> IO (msg -> IO (), IO msg)
simulateNetConditions
((NetMsg input -> clientAddress -> IO ())
-> (NetMsg input, clientAddress) -> IO ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry NetMsg input -> clientAddress -> IO ()
sendToClient')
IO (NetMsg input, clientAddress)
recvFromClient'
Maybe SimNetConditions
simNetConditionsMay
let sendToClient :: NetMsg input -> clientAddress -> IO ()
sendToClient = ((NetMsg input, clientAddress) -> IO ())
-> NetMsg input -> clientAddress -> IO ()
forall a b c. ((a, b) -> c) -> a -> b -> c
curry (NetMsg input, clientAddress) -> IO ()
sendToClient''
String -> IO ()
debugStrLn String
"Waiting for clients"
TVar (IntMap (Map PlayerId input))
authInputsTVar :: TVar (IntMap (M.Map PlayerId input)) <- IntMap (Map PlayerId input)
-> IO (TVar (IntMap (Map PlayerId input)))
forall a. a -> IO (TVar a)
newTVarIO (Int -> Map PlayerId input -> IntMap (Map PlayerId input)
forall a. Int -> a -> IntMap a
IM.singleton Int
0 Map PlayerId input
forall k a. Map k a
M.empty)
TVar Tick
nextTickTVar :: TVar Tick <- Tick -> IO (TVar Tick)
forall a. a -> IO (TVar a)
newTVarIO Tick
1
TVar (Map clientAddress PlayerData)
playersTVar :: TVar (M.Map clientAddress PlayerData) <- Map clientAddress PlayerData
-> IO (TVar (Map clientAddress PlayerData))
forall a. a -> IO (TVar a)
newTVarIO Map clientAddress PlayerData
forall k a. Map k a
M.empty
TVar PlayerId
nextPlayerIdTVar :: TVar PlayerId <- PlayerId -> IO (TVar PlayerId)
forall a. a -> IO (TVar a)
newTVarIO PlayerId
0
ThreadId
msgProcessingTID <- IO () -> IO ThreadId
forkIO (IO () -> IO ThreadId) -> IO () -> IO ThreadId
forall a b. (a -> b) -> a -> b
$
IO () -> IO ()
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
(NetMsg input
msg, clientAddress
sender) <- IO (NetMsg input, clientAddress)
recvFromClient
Maybe Float
serverReceiveTimeMay <- case NetMsg input
msg of
Msg_Connected{} -> do
String -> IO ()
debugStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Server received unexpected Msg_Connected from " String -> ShowS
forall a. [a] -> [a] -> [a]
++ clientAddress -> String
forall a. Show a => a -> String
show clientAddress
sender String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
". Ignoring."
Maybe Float -> IO (Maybe Float)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Float
forall a. Maybe a
Nothing
Msg_AuthInput{} -> do
String -> IO ()
debugStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Server received unexpected Msg_AuthInput from " String -> ShowS
forall a. [a] -> [a] -> [a]
++ clientAddress -> String
forall a. Show a => a -> String
show clientAddress
sender String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
". Ignoring."
Maybe Float -> IO (Maybe Float)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Float
forall a. Maybe a
Nothing
Msg_HeartbeatResponse{} -> do
String -> IO ()
debugStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Server received unexpected Msg_HeartbeatResponse from " String -> ShowS
forall a. [a] -> [a] -> [a]
++ clientAddress -> String
forall a. Show a => a -> String
show clientAddress
sender String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
". Ignoring."
Maybe Float -> IO (Maybe Float)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Float
forall a. Maybe a
Nothing
Msg_HintInput{} -> do
String -> IO ()
debugStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Server received unexpected Msg_HintInput from " String -> ShowS
forall a. [a] -> [a] -> [a]
++ clientAddress -> String
forall a. Show a => a -> String
show clientAddress
sender String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
". Perhaps you meant to send a Msg_SubmitInput. Ignoring."
Maybe Float -> IO (Maybe Float)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Float
forall a. Maybe a
Nothing
Msg_Connect Float
clientSendTime -> do
UTCTime
currentTimeUTC <- IO UTCTime
getCurrentTime
Float
currentTime <- IO Float
getTime
IO (IO (Maybe Float)) -> IO (Maybe Float)
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (IO (IO (Maybe Float)) -> IO (Maybe Float))
-> IO (IO (Maybe Float)) -> IO (Maybe Float)
forall a b. (a -> b) -> a -> b
$
STM (IO (Maybe Float)) -> IO (IO (Maybe Float))
forall a. STM a -> IO a
atomically (STM (IO (Maybe Float)) -> IO (IO (Maybe Float)))
-> STM (IO (Maybe Float)) -> IO (IO (Maybe Float))
forall a b. (a -> b) -> a -> b
$ do
Maybe PlayerData
playerMay <- clientAddress -> Map clientAddress PlayerData -> Maybe PlayerData
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup clientAddress
sender (Map clientAddress PlayerData -> Maybe PlayerData)
-> STM (Map clientAddress PlayerData) -> STM (Maybe PlayerData)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TVar (Map clientAddress PlayerData)
-> STM (Map clientAddress PlayerData)
forall a. TVar a -> STM a
readTVar TVar (Map clientAddress PlayerData)
playersTVar
(PlayerId
pid, Maybe String
debugMsg, Float
serverReceiveTime) <- case Maybe PlayerData
playerMay of
Maybe PlayerData
Nothing -> do
PlayerId
pid <- TVar PlayerId -> STM PlayerId
forall a. TVar a -> STM a
readTVar TVar PlayerId
nextPlayerIdTVar
TVar PlayerId -> PlayerId -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar PlayerId
nextPlayerIdTVar (PlayerId
pid PlayerId -> PlayerId -> PlayerId
forall a. Num a => a -> a -> a
+ PlayerId
1)
Map clientAddress PlayerData
players <- TVar (Map clientAddress PlayerData)
-> STM (Map clientAddress PlayerData)
forall a. TVar a -> STM a
readTVar TVar (Map clientAddress PlayerData)
playersTVar
let isFirstConnection :: Bool
isFirstConnection = Map clientAddress PlayerData -> Bool
forall k a. Map k a -> Bool
M.null Map clientAddress PlayerData
players
Float
serverReceiveTime <-
if Bool
isFirstConnection
then do
UTCTime -> STM ()
resetTime UTCTime
currentTimeUTC
Float -> STM Float
forall (m :: * -> *) a. Monad m => a -> m a
return Float
0
else Float -> STM Float
forall (m :: * -> *) a. Monad m => a -> m a
return Float
currentTime
TVar (Map clientAddress PlayerData)
-> Map clientAddress PlayerData -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar (Map clientAddress PlayerData)
playersTVar (clientAddress
-> PlayerData
-> Map clientAddress PlayerData
-> Map clientAddress PlayerData
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert clientAddress
sender (PlayerData :: PlayerId -> Tick -> Float -> PlayerData
PlayerData{playerId :: PlayerId
playerId = PlayerId
pid, maxAuthTick :: Tick
maxAuthTick = Tick
0, lastMesgRcvTime :: Float
lastMesgRcvTime = Float
serverReceiveTime}) Map clientAddress PlayerData
players)
(PlayerId, Maybe String, Float)
-> STM (PlayerId, Maybe String, Float)
forall (m :: * -> *) a. Monad m => a -> m a
return (PlayerId
pid, String -> Maybe String
forall a. a -> Maybe a
Just (String
"Connected " String -> ShowS
forall a. [a] -> [a] -> [a]
++ clientAddress -> String
forall a. Show a => a -> String
show clientAddress
sender String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" as " String -> ShowS
forall a. [a] -> [a] -> [a]
++ PlayerId -> String
forall a. Show a => a -> String
show PlayerId
pid), Float
serverReceiveTime)
Just PlayerData{Float
PlayerId
Tick
lastMesgRcvTime :: Float
maxAuthTick :: Tick
playerId :: PlayerId
lastMesgRcvTime :: PlayerData -> Float
maxAuthTick :: PlayerData -> Tick
playerId :: PlayerData -> PlayerId
..} -> do
(PlayerId, Maybe String, Float)
-> STM (PlayerId, Maybe String, Float)
forall (m :: * -> *) a. Monad m => a -> m a
return (PlayerId
playerId, Maybe String
forall a. Maybe a
Nothing, Float
currentTime)
IO (Maybe Float) -> STM (IO (Maybe Float))
forall (m :: * -> *) a. Monad m => a -> m a
return (IO (Maybe Float) -> STM (IO (Maybe Float)))
-> IO (Maybe Float) -> STM (IO (Maybe Float))
forall a b. (a -> b) -> a -> b
$ do
NetMsg input -> clientAddress -> IO ()
sendToClient (PlayerId -> NetMsg input
forall input. PlayerId -> NetMsg input
Msg_Connected PlayerId
pid) clientAddress
sender
NetMsg input -> clientAddress -> IO ()
sendToClient (Float -> Float -> NetMsg input
forall input. Float -> Float -> NetMsg input
Msg_HeartbeatResponse Float
clientSendTime Float
serverReceiveTime) clientAddress
sender
(String -> IO ()) -> Maybe String -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ String -> IO ()
debugStrLn Maybe String
debugMsg
Maybe Float -> IO (Maybe Float)
forall (m :: * -> *) a. Monad m => a -> m a
return (Float -> Maybe Float
forall a. a -> Maybe a
Just Float
serverReceiveTime)
Msg_Heartbeat Float
clientSendTime -> do
Float
serverReceiveTime <- IO Float
getTime
Bool
isConnected <- STM Bool -> IO Bool
forall a. STM a -> IO a
atomically (Maybe PlayerData -> Bool
forall a. Maybe a -> Bool
isJust (Maybe PlayerData -> Bool)
-> (Map clientAddress PlayerData -> Maybe PlayerData)
-> Map clientAddress PlayerData
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. clientAddress -> Map clientAddress PlayerData -> Maybe PlayerData
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup clientAddress
sender (Map clientAddress PlayerData -> Bool)
-> STM (Map clientAddress PlayerData) -> STM Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TVar (Map clientAddress PlayerData)
-> STM (Map clientAddress PlayerData)
forall a. TVar a -> STM a
readTVar TVar (Map clientAddress PlayerData)
playersTVar)
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
isConnected (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ NetMsg input -> clientAddress -> IO ()
sendToClient (Float -> Float -> NetMsg input
forall input. Float -> Float -> NetMsg input
Msg_HeartbeatResponse Float
clientSendTime Float
serverReceiveTime) clientAddress
sender
Maybe Float -> IO (Maybe Float)
forall (m :: * -> *) a. Monad m => a -> m a
return (Float -> Maybe Float
forall a. a -> Maybe a
Just Float
serverReceiveTime)
Msg_Ack Tick
clientMaxAuthTick -> do
STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ TVar (Map clientAddress PlayerData)
-> (Map clientAddress PlayerData -> Map clientAddress PlayerData)
-> STM ()
forall a. TVar a -> (a -> a) -> STM ()
modifyTVar TVar (Map clientAddress PlayerData)
playersTVar ((PlayerData -> Maybe PlayerData)
-> clientAddress
-> Map clientAddress PlayerData
-> Map clientAddress PlayerData
forall k a. Ord k => (a -> Maybe a) -> k -> Map k a -> Map k a
M.update (\PlayerData
pd -> PlayerData -> Maybe PlayerData
forall a. a -> Maybe a
Just (PlayerData -> Maybe PlayerData) -> PlayerData -> Maybe PlayerData
forall a b. (a -> b) -> a -> b
$ PlayerData
pd{maxAuthTick :: Tick
maxAuthTick = Tick
clientMaxAuthTick}) clientAddress
sender)
Float -> Maybe Float
forall a. a -> Maybe a
Just (Float -> Maybe Float) -> IO Float -> IO (Maybe Float)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Float
getTime
Msg_SubmitInput [(Tick, input)]
submittedInputs -> do
[Maybe String]
msgMay <- STM [Maybe String] -> IO [Maybe String]
forall a. STM a -> IO a
atomically (STM [Maybe String] -> IO [Maybe String])
-> STM [Maybe String] -> IO [Maybe String]
forall a b. (a -> b) -> a -> b
$ do
Maybe PlayerData
playerMay <- clientAddress -> Map clientAddress PlayerData -> Maybe PlayerData
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup clientAddress
sender (Map clientAddress PlayerData -> Maybe PlayerData)
-> STM (Map clientAddress PlayerData) -> STM (Maybe PlayerData)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TVar (Map clientAddress PlayerData)
-> STM (Map clientAddress PlayerData)
forall a. TVar a -> STM a
readTVar TVar (Map clientAddress PlayerData)
playersTVar
case Maybe PlayerData
playerMay of
Maybe PlayerData
Nothing -> [Maybe String] -> STM [Maybe String]
forall (m :: * -> *) a. Monad m => a -> m a
return [String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ String
"Got Msg_SubmitInput from client that is not yet connected " String -> ShowS
forall a. [a] -> [a] -> [a]
++ clientAddress -> String
forall a. Show a => a -> String
show clientAddress
sender]
Just PlayerData{Float
PlayerId
Tick
lastMesgRcvTime :: Float
maxAuthTick :: Tick
playerId :: PlayerId
lastMesgRcvTime :: PlayerData -> Float
maxAuthTick :: PlayerData -> Tick
playerId :: PlayerData -> PlayerId
..} -> [(Tick, input)]
-> ((Tick, input) -> STM (Maybe String)) -> STM [Maybe String]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [(Tick, input)]
submittedInputs (((Tick, input) -> STM (Maybe String)) -> STM [Maybe String])
-> ((Tick, input) -> STM (Maybe String)) -> STM [Maybe String]
forall a b. (a -> b) -> a -> b
$ \(Tick
tick, input
input) -> do
Tick
nextTick <- TVar Tick -> STM Tick
forall a. TVar a -> STM a
readTVar TVar Tick
nextTickTVar
if Tick
tick Tick -> Tick -> Bool
forall a. Ord a => a -> a -> Bool
< Tick
nextTick
then
Maybe String -> STM (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe String -> STM (Maybe String))
-> Maybe String -> STM (Maybe String)
forall a b. (a -> b) -> a -> b
$
String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$
String
"Late Msg_Input from " String -> ShowS
forall a. [a] -> [a] -> [a]
++ PlayerId -> String
forall a. Show a => a -> String
show PlayerId
playerId
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" for "
String -> ShowS
forall a. [a] -> [a] -> [a]
++ Tick -> String
forall a. Show a => a -> String
show Tick
tick
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" but already simulated up to "
String -> ShowS
forall a. [a] -> [a] -> [a]
++ Tick -> String
forall a. Show a => a -> String
show (Tick
nextTick Tick -> Tick -> Tick
forall a. Num a => a -> a -> a
- Tick
1)
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
". Ignoring."
else do
IntMap (Map PlayerId input)
inputs <- TVar (IntMap (Map PlayerId input))
-> STM (IntMap (Map PlayerId input))
forall a. TVar a -> STM a
readTVar TVar (IntMap (Map PlayerId input))
authInputsTVar
let inptsAtTick :: Map PlayerId input
inptsAtTick = Map PlayerId input
-> Maybe (Map PlayerId input) -> Map PlayerId input
forall a. a -> Maybe a -> a
fromMaybe Map PlayerId input
forall k a. Map k a
M.empty (IntMap (Map PlayerId input)
inputs IntMap (Map PlayerId input) -> Int -> Maybe (Map PlayerId input)
forall a. IntMap a -> Int -> Maybe a
IM.!? Tick -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Tick
tick)
case Map PlayerId input
inptsAtTick Map PlayerId input -> PlayerId -> Maybe input
forall k a. Ord k => Map k a -> k -> Maybe a
M.!? PlayerId
playerId of
Just input
existingInput
| input
existingInput input -> input -> Bool
forall a. Eq a => a -> a -> Bool
== input
input -> Maybe String -> STM (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe String
forall a. Maybe a
Nothing
| Bool
otherwise ->
Maybe String -> STM (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe String -> STM (Maybe String))
-> Maybe String -> STM (Maybe String)
forall a b. (a -> b) -> a -> b
$
String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$
String
"Received inputs from " String -> ShowS
forall a. [a] -> [a] -> [a]
++ PlayerId -> String
forall a. Show a => a -> String
show PlayerId
playerId String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" for " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Tick -> String
forall a. Show a => a -> String
show Tick
tick
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" but already have inputs for that time with a DIFFERENT value! Ignoring."
Maybe input
Nothing -> do
TVar (IntMap (Map PlayerId input))
-> IntMap (Map PlayerId input) -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar (IntMap (Map PlayerId input))
authInputsTVar (IntMap (Map PlayerId input) -> STM ())
-> IntMap (Map PlayerId input) -> STM ()
forall a b. (a -> b) -> a -> b
$
Int
-> Map PlayerId input
-> IntMap (Map PlayerId input)
-> IntMap (Map PlayerId input)
forall a. Int -> a -> IntMap a -> IntMap a
IM.insert
(Tick -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Tick
tick)
(PlayerId -> input -> Map PlayerId input -> Map PlayerId input
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert PlayerId
playerId input
input Map PlayerId input
inptsAtTick)
IntMap (Map PlayerId input)
inputs
Maybe String -> STM (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe String
forall a. Maybe a
Nothing
(String -> IO ()) -> [String] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ String -> IO ()
debugStrLn ([Maybe String] -> [String]
forall a. [Maybe a] -> [a]
catMaybes [Maybe String]
msgMay)
Float -> Maybe Float
forall a. a -> Maybe a
Just (Float -> Maybe Float) -> IO Float -> IO (Maybe Float)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Float
getTime
Maybe Float -> (Float -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe Float
serverReceiveTimeMay ((Float -> IO ()) -> IO ()) -> (Float -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Float
serverReceiveTime ->
STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$
TVar (Map clientAddress PlayerData)
-> (Map clientAddress PlayerData -> Map clientAddress PlayerData)
-> STM ()
forall a. TVar a -> (a -> a) -> STM ()
modifyTVar
TVar (Map clientAddress PlayerData)
playersTVar
( (PlayerData -> Maybe PlayerData)
-> clientAddress
-> Map clientAddress PlayerData
-> Map clientAddress PlayerData
forall k a. Ord k => (a -> Maybe a) -> k -> Map k a -> Map k a
M.update
(\PlayerData
player -> PlayerData -> Maybe PlayerData
forall a. a -> Maybe a
Just PlayerData
player{lastMesgRcvTime :: Float
lastMesgRcvTime = Float
serverReceiveTime})
clientAddress
sender
)
STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
Map clientAddress PlayerData
players <- TVar (Map clientAddress PlayerData)
-> STM (Map clientAddress PlayerData)
forall a. TVar a -> STM a
readTVar TVar (Map clientAddress PlayerData)
playersTVar
Bool -> STM ()
STM.check (Bool -> STM ()) -> Bool -> STM ()
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Map clientAddress PlayerData -> Bool
forall k a. Map k a -> Bool
M.null Map clientAddress PlayerData
players
String -> IO ()
debugStrLn String
"Client connected. Starting game."
ThreadId
disconnectTID <- IO () -> IO ThreadId
forkIO (IO () -> IO ThreadId) -> IO () -> IO ThreadId
forall a b. (a -> b) -> a -> b
$
IO () -> IO ()
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
Float
oldestMsgRcvTime <- STM Float -> IO Float
forall a. STM a -> IO a
atomically ([Float] -> Float
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum ([Float] -> Float)
-> (Map clientAddress PlayerData -> [Float])
-> Map clientAddress PlayerData
-> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PlayerData -> Float) -> [PlayerData] -> [Float]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PlayerData -> Float
lastMesgRcvTime ([PlayerData] -> [Float])
-> (Map clientAddress PlayerData -> [PlayerData])
-> Map clientAddress PlayerData
-> [Float]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map clientAddress PlayerData -> [PlayerData]
forall k a. Map k a -> [a]
M.elems (Map clientAddress PlayerData -> Float)
-> STM (Map clientAddress PlayerData) -> STM Float
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TVar (Map clientAddress PlayerData)
-> STM (Map clientAddress PlayerData)
forall a. TVar a -> STM a
readTVar TVar (Map clientAddress PlayerData)
playersTVar)
let disconnectTime :: Float
disconnectTime = Float
oldestMsgRcvTime Float -> Float -> Float
forall a. Num a => a -> a -> a
+ ServerConfig -> Float
scClientTimeout ServerConfig
serverConfig
Float
t <- IO Float
getTime
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Float
t Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
< Float
disconnectTime) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
Int -> IO ()
threadDelay (Float -> Int
forall a b. (RealFrac a, Integral b) => a -> b
round (((Float
disconnectTime Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
t) Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
0.01) Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
1000000))
Float
currentTime <- IO Float
getTime
Map clientAddress PlayerData
kickedPlayers <- STM (Map clientAddress PlayerData)
-> IO (Map clientAddress PlayerData)
forall a. STM a -> IO a
atomically (STM (Map clientAddress PlayerData)
-> IO (Map clientAddress PlayerData))
-> STM (Map clientAddress PlayerData)
-> IO (Map clientAddress PlayerData)
forall a b. (a -> b) -> a -> b
$ do
Map clientAddress PlayerData
players <- TVar (Map clientAddress PlayerData)
-> STM (Map clientAddress PlayerData)
forall a. TVar a -> STM a
readTVar TVar (Map clientAddress PlayerData)
playersTVar
let (Map clientAddress PlayerData
retainedPlayers, Map clientAddress PlayerData
kickedPlayers) = (PlayerData -> Bool)
-> Map clientAddress PlayerData
-> (Map clientAddress PlayerData, Map clientAddress PlayerData)
forall a k. (a -> Bool) -> Map k a -> (Map k a, Map k a)
M.partition (\PlayerData{Float
PlayerId
Tick
lastMesgRcvTime :: Float
maxAuthTick :: Tick
playerId :: PlayerId
lastMesgRcvTime :: PlayerData -> Float
maxAuthTick :: PlayerData -> Tick
playerId :: PlayerData -> PlayerId
..} -> Float
lastMesgRcvTime Float -> Float -> Float
forall a. Num a => a -> a -> a
+ ServerConfig -> Float
scClientTimeout ServerConfig
serverConfig Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
> Float
currentTime) Map clientAddress PlayerData
players
TVar (Map clientAddress PlayerData)
-> Map clientAddress PlayerData -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar (Map clientAddress PlayerData)
playersTVar Map clientAddress PlayerData
retainedPlayers
Map clientAddress PlayerData -> STM (Map clientAddress PlayerData)
forall (m :: * -> *) a. Monad m => a -> m a
return Map clientAddress PlayerData
kickedPlayers
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Map clientAddress PlayerData -> Bool
forall k a. Map k a -> Bool
M.null Map clientAddress PlayerData
kickedPlayers)) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
debugStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Disconnect players due to timeout: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Word8] -> String
forall a. Show a => a -> String
show [Word8
pid | PlayerData{playerId :: PlayerData -> PlayerId
playerId = PlayerId Word8
pid} <- Map clientAddress PlayerData -> [PlayerData]
forall k a. Map k a -> [a]
M.elems Map clientAddress PlayerData
kickedPlayers]
ThreadId
simTID <- IO () -> IO ThreadId
forkIO (IO () -> IO ThreadId) -> IO () -> IO ThreadId
forall a b. (a -> b) -> a -> b
$
IO () -> IO ()
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
Float
currTime <- IO Float
getTime
let targetTick :: Tick
targetTick = Float -> Tick
forall a b. (RealFrac a, Integral b) => a -> b
floor (Float -> Tick) -> Float -> Tick
forall a b. (a -> b) -> a -> b
$ Float
currTime Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
tickTime
STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
Tick
nextAuthTick <- TVar Tick -> STM Tick
forall a. TVar a -> STM a
readTVar TVar Tick
nextTickTVar
TVar Tick -> Tick -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar Tick
nextTickTVar (Tick
targetTick Tick -> Tick -> Tick
forall a. Num a => a -> a -> a
+ Tick
1)
Map clientAddress PlayerData
knownPlayers <- TVar (Map clientAddress PlayerData)
-> STM (Map clientAddress PlayerData)
forall a. TVar a -> STM a
readTVar TVar (Map clientAddress PlayerData)
playersTVar
IntMap (Map PlayerId input)
authInputs <- TVar (IntMap (Map PlayerId input))
-> STM (IntMap (Map PlayerId input))
forall a. TVar a -> STM a
readTVar TVar (IntMap (Map PlayerId input))
authInputsTVar
let nextAuthTickInputs :: Map PlayerId input
nextAuthTickInputs = IntMap (Map PlayerId input)
authInputs IntMap (Map PlayerId input) -> Int -> Map PlayerId input
forall a. IntMap a -> Int -> a
IM.! Tick -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Tick
nextAuthTick Tick -> Tick -> Tick
forall a. Num a => a -> a -> a
- Tick
1)
TVar (IntMap (Map PlayerId input))
-> IntMap (Map PlayerId input) -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar (IntMap (Map PlayerId input))
authInputsTVar (IntMap (Map PlayerId input) -> STM ())
-> IntMap (Map PlayerId input) -> STM ()
forall a b. (a -> b) -> a -> b
$
(IntMap (Map PlayerId input), Map PlayerId input)
-> IntMap (Map PlayerId input)
forall a b. (a, b) -> a
fst ((IntMap (Map PlayerId input), Map PlayerId input)
-> IntMap (Map PlayerId input))
-> (IntMap (Map PlayerId input), Map PlayerId input)
-> IntMap (Map PlayerId input)
forall a b. (a -> b) -> a -> b
$
((IntMap (Map PlayerId input), Map PlayerId input)
-> Tick -> (IntMap (Map PlayerId input), Map PlayerId input))
-> (IntMap (Map PlayerId input), Map PlayerId input)
-> [Tick]
-> (IntMap (Map PlayerId input), Map PlayerId input)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl'
( \(IntMap (Map PlayerId input)
authInputs', Map PlayerId input
prevInputs) Tick
currTick ->
let
currInputsRaw :: Map PlayerId input
currInputsRaw = Map PlayerId input
-> Maybe (Map PlayerId input) -> Map PlayerId input
forall a. a -> Maybe a -> a
fromMaybe Map PlayerId input
forall k a. Map k a
M.empty (Int -> IntMap (Map PlayerId input) -> Maybe (Map PlayerId input)
forall a. Int -> IntMap a -> Maybe a
IM.lookup (Tick -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Tick
currTick) IntMap (Map PlayerId input)
authInputs)
currInputs :: Map PlayerId input
currInputs =
[(PlayerId, input)] -> Map PlayerId input
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
[ ( PlayerId
pidInt
, input -> Maybe input -> input
forall a. a -> Maybe a -> a
fromMaybe
input
input0
( Map PlayerId input
currInputsRaw Map PlayerId input -> PlayerId -> Maybe input
forall k a. Ord k => Map k a -> k -> Maybe a
M.!? PlayerId
pid
Maybe input -> Maybe input -> Maybe input
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Map PlayerId input
prevInputs Map PlayerId input -> PlayerId -> Maybe input
forall k a. Ord k => Map k a -> k -> Maybe a
M.!? PlayerId
pid
)
)
| PlayerId
pid <- PlayerData -> PlayerId
playerId (PlayerData -> PlayerId) -> [PlayerData] -> [PlayerId]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map clientAddress PlayerData -> [PlayerData]
forall k a. Map k a -> [a]
M.elems Map clientAddress PlayerData
knownPlayers
, let pidInt :: PlayerId
pidInt = PlayerId -> PlayerId
coerce PlayerId
pid
]
in (Int
-> Map PlayerId input
-> IntMap (Map PlayerId input)
-> IntMap (Map PlayerId input)
forall a. Int -> a -> IntMap a -> IntMap a
IM.insert (Tick -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Tick
currTick) Map PlayerId input
currInputs IntMap (Map PlayerId input)
authInputs', Map PlayerId input
currInputs)
)
(IntMap (Map PlayerId input)
authInputs, Map PlayerId input
nextAuthTickInputs)
[Tick
nextAuthTick .. Tick
targetTick]
Map clientAddress PlayerData
knownPlayers <- STM (Map clientAddress PlayerData)
-> IO (Map clientAddress PlayerData)
forall a. STM a -> IO a
atomically (STM (Map clientAddress PlayerData)
-> IO (Map clientAddress PlayerData))
-> STM (Map clientAddress PlayerData)
-> IO (Map clientAddress PlayerData)
forall a b. (a -> b) -> a -> b
$ TVar (Map clientAddress PlayerData)
-> STM (Map clientAddress PlayerData)
forall a. TVar a -> STM a
readTVar TVar (Map clientAddress PlayerData)
playersTVar
(IntMap (Map PlayerId input)
authInputs, Tick
nextAuthTick) <- STM (IntMap (Map PlayerId input), Tick)
-> IO (IntMap (Map PlayerId input), Tick)
forall a. STM a -> IO a
atomically (STM (IntMap (Map PlayerId input), Tick)
-> IO (IntMap (Map PlayerId input), Tick))
-> STM (IntMap (Map PlayerId input), Tick)
-> IO (IntMap (Map PlayerId input), Tick)
forall a b. (a -> b) -> a -> b
$ do
IntMap (Map PlayerId input)
authInputs <- TVar (IntMap (Map PlayerId input))
-> STM (IntMap (Map PlayerId input))
forall a. TVar a -> STM a
readTVar TVar (IntMap (Map PlayerId input))
authInputsTVar
Tick
nextAuthTick <- TVar Tick -> STM Tick
forall a. TVar a -> STM a
readTVar TVar Tick
nextTickTVar
(IntMap (Map PlayerId input), Tick)
-> STM (IntMap (Map PlayerId input), Tick)
forall (m :: * -> *) a. Monad m => a -> m a
return (IntMap (Map PlayerId input)
authInputs, Tick
nextAuthTick)
[(clientAddress, PlayerData)]
-> ((clientAddress, PlayerData) -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Map clientAddress PlayerData -> [(clientAddress, PlayerData)]
forall k a. Map k a -> [(k, a)]
M.assocs Map clientAddress PlayerData
knownPlayers) (((clientAddress, PlayerData) -> IO ()) -> IO ())
-> ((clientAddress, PlayerData) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(clientAddress
sock, PlayerData
playerData) -> do
let lastAuthTick :: Tick
lastAuthTick = PlayerData -> Tick
maxAuthTick PlayerData
playerData
(IntMap (Map PlayerId input)
_, Maybe (Map PlayerId input)
_, IntMap (Map PlayerId input)
inputsToSendIntMap') = Int
-> IntMap (Map PlayerId input)
-> (IntMap (Map PlayerId input), Maybe (Map PlayerId input),
IntMap (Map PlayerId input))
forall a. Int -> IntMap a -> (IntMap a, Maybe a, IntMap a)
IM.splitLookup (Tick -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Tick
lastAuthTick) IntMap (Map PlayerId input)
authInputs
(IntMap (Map PlayerId input)
inputsToSendIntMap, Maybe (Map PlayerId input)
firstHint, IntMap (Map PlayerId input)
_) = Int
-> IntMap (Map PlayerId input)
-> (IntMap (Map PlayerId input), Maybe (Map PlayerId input),
IntMap (Map PlayerId input))
forall a. Int -> IntMap a -> (IntMap a, Maybe a, IntMap a)
IM.splitLookup (Tick -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Tick
nextAuthTick) IntMap (Map PlayerId input)
inputsToSendIntMap'
inputsToSend :: [Map PlayerId input]
inputsToSend = Int -> [Map PlayerId input] -> [Map PlayerId input]
forall a. Int -> [a] -> [a]
take Int
maxRequestAuthInputs ([Map PlayerId input] -> [Map PlayerId input])
-> [Map PlayerId input] -> [Map PlayerId input]
forall a b. (a -> b) -> a -> b
$ IntMap (Map PlayerId input) -> [Map PlayerId input]
forall a. IntMap a -> [a]
IM.elems IntMap (Map PlayerId input)
inputsToSendIntMap
hintsToSendCount :: Int
hintsToSendCount = Int
maxRequestAuthInputs Int -> Int -> Int
forall a. Num a => a -> a -> a
- IntMap (Map PlayerId input) -> Int
forall a. IntMap a -> Int
IM.size IntMap (Map PlayerId input)
inputsToSendIntMap
hintsToSend :: [Map PlayerId input]
hintsToSend =
(Maybe (Map PlayerId input) -> Map PlayerId input)
-> [Maybe (Map PlayerId input)] -> [Map PlayerId input]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Map PlayerId input
-> Maybe (Map PlayerId input) -> Map PlayerId input
forall a. a -> Maybe a -> a
fromMaybe Map PlayerId input
forall k a. Map k a
M.empty) ([Maybe (Map PlayerId input)] -> [Map PlayerId input])
-> [Maybe (Map PlayerId input)] -> [Map PlayerId input]
forall a b. (a -> b) -> a -> b
$
(Maybe (Map PlayerId input) -> Bool)
-> [Maybe (Map PlayerId input)] -> [Maybe (Map PlayerId input)]
forall a. (a -> Bool) -> [a] -> [a]
dropWhileEnd Maybe (Map PlayerId input) -> Bool
forall a. Maybe a -> Bool
isNothing ([Maybe (Map PlayerId input)] -> [Maybe (Map PlayerId input)])
-> [Maybe (Map PlayerId input)] -> [Maybe (Map PlayerId input)]
forall a b. (a -> b) -> a -> b
$
Int -> [Maybe (Map PlayerId input)] -> [Maybe (Map PlayerId input)]
forall a. Int -> [a] -> [a]
take Int
hintsToSendCount ([Maybe (Map PlayerId input)] -> [Maybe (Map PlayerId input)])
-> [Maybe (Map PlayerId input)] -> [Maybe (Map PlayerId input)]
forall a b. (a -> b) -> a -> b
$
Maybe (Map PlayerId input)
firstHint Maybe (Map PlayerId input)
-> [Maybe (Map PlayerId input)] -> [Maybe (Map PlayerId input)]
forall a. a -> [a] -> [a]
:
[ IntMap (Map PlayerId input)
authInputs IntMap (Map PlayerId input) -> Int -> Maybe (Map PlayerId input)
forall a. IntMap a -> Int -> Maybe a
IM.!? Tick -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Tick
hintTick
| Tick
hintTick <- [Tick -> Tick
forall a. Enum a => a -> a
succ Tick
nextAuthTick ..]
]
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [Map PlayerId input] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Map PlayerId input]
inputsToSend) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
NetMsg input -> clientAddress -> IO ()
sendToClient
( Tick
-> CompactMaps PlayerId input
-> CompactMaps PlayerId input
-> NetMsg input
forall input.
Tick
-> CompactMaps PlayerId input
-> CompactMaps PlayerId input
-> NetMsg input
Msg_AuthInput
(Tick
lastAuthTick Tick -> Tick -> Tick
forall a. Num a => a -> a -> a
+ Tick
1)
([Map PlayerId input] -> CompactMaps PlayerId input
forall key value.
Eq key =>
[Map key value] -> CompactMaps key value
toCompactMaps [Map PlayerId input]
inputsToSend)
([Map PlayerId input] -> CompactMaps PlayerId input
forall key value.
Eq key =>
[Map key value] -> CompactMaps key value
toCompactMaps [Map PlayerId input]
hintsToSend)
)
clientAddress
sock
Float
currTime' <- IO Float
getTime
let nextTick :: Tick
nextTick = Tick
targetTick Tick -> Tick -> Tick
forall a. Num a => a -> a -> a
+ Tick
1
nextTickTime :: Float
nextTickTime = Tick -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Tick
nextTick Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
tickTime
timeTillNextTick :: Float
timeTillNextTick = Float
nextTickTime Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
currTime'
Int -> IO ()
threadDelay (Int -> IO ()) -> Int -> IO ()
forall a b. (a -> b) -> a -> b
$ Float -> Int
forall a b. (RealFrac a, Integral b) => a -> b
round (Float -> Int) -> Float -> Int
forall a b. (a -> b) -> a -> b
$ Float
1000000 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
timeTillNextTick
STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
Map clientAddress PlayerData
players <- TVar (Map clientAddress PlayerData)
-> STM (Map clientAddress PlayerData)
forall a. TVar a -> STM a
readTVar TVar (Map clientAddress PlayerData)
playersTVar
Bool -> STM ()
STM.check (Bool -> STM ()) -> Bool -> STM ()
forall a b. (a -> b) -> a -> b
$ Map clientAddress PlayerData -> Bool
forall k a. Map k a -> Bool
M.null Map clientAddress PlayerData
players
String -> IO ()
debugStrLn String
"No more clients, Stopping game!"
(ThreadId -> IO ()) -> [ThreadId] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ThreadId -> IO ()
killThread [ThreadId
msgProcessingTID, ThreadId
disconnectTID, ThreadId
simTID]
data PlayerData = PlayerData
{
PlayerData -> PlayerId
playerId :: PlayerId
,
PlayerData -> Tick
maxAuthTick :: Tick
,
PlayerData -> Float
lastMesgRcvTime :: Float
}