module ProjectM36.Server.Config where
import ProjectM36.Client

data ServerConfig = ServerConfig { ServerConfig -> PersistenceStrategy
persistenceStrategy :: PersistenceStrategy,
                                   ServerConfig -> Bool
checkFS :: Bool,
                                   ServerConfig -> DatabaseName
databaseName :: DatabaseName,
                                   ServerConfig -> RemoteServerAddress
bindAddress :: RemoteServerAddress,
                                   ServerConfig -> [DatabaseName]
ghcPkgPaths :: [String], -- used for AtomFunction dynamic compilation
                                   ServerConfig -> Int
perRequestTimeout :: Int,
                                   ServerConfig -> Bool
testMode :: Bool -- used exclusively for automated testing of the server, thus not accessible from the command line
                                   }
                    deriving (Int -> ServerConfig -> ShowS
[ServerConfig] -> ShowS
ServerConfig -> DatabaseName
forall a.
(Int -> a -> ShowS)
-> (a -> DatabaseName) -> ([a] -> ShowS) -> Show a
showList :: [ServerConfig] -> ShowS
$cshowList :: [ServerConfig] -> ShowS
show :: ServerConfig -> DatabaseName
$cshow :: ServerConfig -> DatabaseName
showsPrec :: Int -> ServerConfig -> ShowS
$cshowsPrec :: Int -> ServerConfig -> ShowS
Show)

data WebsocketServerConfig = WebsocketServerConfig { WebsocketServerConfig -> ServerConfig
wsServerConfig :: ServerConfig,
                                                     WebsocketServerConfig -> Maybe DatabaseName
tlsCertificatePath :: Maybe String,
                                                     WebsocketServerConfig -> Maybe DatabaseName
tlsKeyPath :: Maybe String
                                                     }
                              deriving (Int -> WebsocketServerConfig -> ShowS
[WebsocketServerConfig] -> ShowS
WebsocketServerConfig -> DatabaseName
forall a.
(Int -> a -> ShowS)
-> (a -> DatabaseName) -> ([a] -> ShowS) -> Show a
showList :: [WebsocketServerConfig] -> ShowS
$cshowList :: [WebsocketServerConfig] -> ShowS
show :: WebsocketServerConfig -> DatabaseName
$cshow :: WebsocketServerConfig -> DatabaseName
showsPrec :: Int -> WebsocketServerConfig -> ShowS
$cshowsPrec :: Int -> WebsocketServerConfig -> ShowS
Show)

defaultServerConfig :: ServerConfig
defaultServerConfig :: ServerConfig
defaultServerConfig =
  ServerConfig { persistenceStrategy :: PersistenceStrategy
persistenceStrategy = PersistenceStrategy
NoPersistence,
                 checkFS :: Bool
checkFS = Bool
True,
                 databaseName :: DatabaseName
databaseName = DatabaseName
"base", 
                 bindAddress :: RemoteServerAddress
bindAddress = DatabaseName -> Port -> RemoteServerAddress
RemoteServerHostAddress DatabaseName
"127.0.0.1" Port
6543,
                 ghcPkgPaths :: [DatabaseName]
ghcPkgPaths = [],
                 perRequestTimeout :: Int
perRequestTimeout = Int
0,
                 testMode :: Bool
testMode = Bool
False
               }