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

{-# 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