wizard-wipeout/src-server/Server/Types.hs
2024-12-12 09:09:17 +01:00

112 lines
2.5 KiB
Haskell

{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE StrictData #-}
module Server.Types where
import Control.Concurrent
import qualified Control.Concurrent.STM as STM
import Control.Monad.RWS.Strict
import qualified Data.Aeson as Aeson
import Data.Time.Clock
import Data.UUID
import GHC.Generics
import Network.Socket
import Options.Applicative as O
--internal imports
import Library.Types
data Settings = Settings
{ setSocketPath :: !FilePath
, setMapRows :: !Int
, setMapColumns :: !Int
, setSpawnerProbability :: !Float
, setFPS :: !Int
, setClientMaxTimeout :: !Float
, setFramesPerPing :: !Int
, setLogLevel :: !LogLevel
}
deriving (Show, Generic)
instance Aeson.FromJSON Settings
data LogLevel
= Error
| Warning
| Info
| Verbose
deriving (Show, Generic, Eq, Ord)
instance Aeson.FromJSON LogLevel
newtype Options = Options
{ optConfLoc :: FilePath
}
options :: O.Parser Options
options = Options
<$> strOption
( long "configuration"
<> short 'c'
<> metavar "FILEPATH"
<> help "Location of the configuration YAML-file"
)
data ReaderContainer = ReaderContainer
{ rcMap :: !ServerMap
, rcFPS :: !Int
, rcFramesPerPing :: !Int
, rcClientMaxTimeout :: !Float
, rcMainSocket :: !Socket
, rcLogLevel :: !LogLevel
}
deriving (Eq, Show)
data StateContainer = StateContainer
{ scSpawners :: ![Spawner]
, scPlayers :: !(STM.TMVar [Player])
, scServerState :: !(STM.TMVar ServerState)
, scServerLastTick :: !UTCTime
, scClientSockets :: !(STM.TMVar [ClientSocket])
, scClientQueues :: !(STM.TMVar [ClientQueue])
, scMessageQueue :: !(STM.TQueue ClientMessage)
}
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)
data Player = Player
{ playerId :: !UUID
, playerWizard :: !Wizard
, playerReady :: !Bool
, playerLastPong :: !(UTCTime, UUID)
}
deriving (Eq, Show)
-- | Data object for storing the server's state
data ServerState = ServerState
{ serverGameOver :: !Bool -- ^ global game over state (only one contestant left)
, serverStop :: !Bool -- ^ Server shutdown
}
deriving (Show, Eq)
type Game = RWST ReaderContainer String StateContainer IO