wizard-wipeout/src-server/Server/Types.hs

{-# LANGUAGE DeriveGeneric #-}
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