--------------------------------------------------------------------------------
-- |
-- Module : Database.EventStore.Internal.Settings
-- Copyright : (C) 2017 Yorick Laupa
-- License : (see the file LICENSE)
--
-- Maintainer : Yorick Laupa <yo.eight@gmail.com>
-- Stability : provisional
-- Portability : non-portable
--
--------------------------------------------------------------------------------
module Database.EventStore.Internal.Settings where

--------------------------------------------------------------------------------
import Network.Connection (TLSSettings)

--------------------------------------------------------------------------------
import Database.EventStore.Internal.Logger
import Database.EventStore.Internal.Prelude

--------------------------------------------------------------------------------
-- Flag
--------------------------------------------------------------------------------
-- | Indicates either a 'Package' contains 'Credentials' data or not.
data Flag
    = None
    | Authenticated
    deriving Int -> Flag -> ShowS
[Flag] -> ShowS
Flag -> String
(Int -> Flag -> ShowS)
-> (Flag -> String) -> ([Flag] -> ShowS) -> Show Flag
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Flag] -> ShowS
$cshowList :: [Flag] -> ShowS
show :: Flag -> String
$cshow :: Flag -> String
showsPrec :: Int -> Flag -> ShowS
$cshowsPrec :: Int -> Flag -> ShowS
Show

--------------------------------------------------------------------------------
-- | Maps a 'Flag' into a 'Word8' understandable by the server.
flagWord8 :: Flag -> Word8
flagWord8 :: Flag -> Word8
flagWord8 Flag
None          = Word8
0x00
flagWord8 Flag
Authenticated = Word8
0x01

--------------------------------------------------------------------------------
-- Credentials
--------------------------------------------------------------------------------
-- | Holds login and password information.
data Credentials
    = Credentials
      { Credentials -> ByteString
credLogin    :: !ByteString
      , Credentials -> ByteString
credPassword :: !ByteString
      }
    deriving (Credentials -> Credentials -> Bool
(Credentials -> Credentials -> Bool)
-> (Credentials -> Credentials -> Bool) -> Eq Credentials
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Credentials -> Credentials -> Bool
$c/= :: Credentials -> Credentials -> Bool
== :: Credentials -> Credentials -> Bool
$c== :: Credentials -> Credentials -> Bool
Eq, Int -> Credentials -> ShowS
[Credentials] -> ShowS
Credentials -> String
(Int -> Credentials -> ShowS)
-> (Credentials -> String)
-> ([Credentials] -> ShowS)
-> Show Credentials
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Credentials] -> ShowS
$cshowList :: [Credentials] -> ShowS
show :: Credentials -> String
$cshow :: Credentials -> String
showsPrec :: Int -> Credentials -> ShowS
$cshowsPrec :: Int -> Credentials -> ShowS
Show)

--------------------------------------------------------------------------------
-- | Creates a 'Credentials' given a login and a password.
credentials :: ByteString -- ^ Login
            -> ByteString -- ^ Password
            -> Credentials
credentials :: ByteString -> ByteString -> Credentials
credentials = ByteString -> ByteString -> Credentials
Credentials

--------------------------------------------------------------------------------
-- | Represents reconnection strategy.
data Retry
    = AtMost Int
    | KeepRetrying

--------------------------------------------------------------------------------
-- | Indicates how many times we should try to reconnect to the server. A value
--   less than or equal to 0 means no retry.
atMost :: Int -> Retry
atMost :: Int -> Retry
atMost = Int -> Retry
AtMost

--------------------------------------------------------------------------------
-- | Indicates we should try to reconnect to the server until the end of the
--   Universe.
keepRetrying :: Retry
keepRetrying :: Retry
keepRetrying = Retry
KeepRetrying

--------------------------------------------------------------------------------
-- | Global 'Connection' settings
data Settings
    = Settings
      { Settings -> NominalDiffTime
s_heartbeatInterval :: NominalDiffTime
        -- ^ Maximum delay of inactivity before the client sends a heartbeat
        --   request.
      , Settings -> NominalDiffTime
s_heartbeatTimeout :: NominalDiffTime
        -- ^ Maximum delay the server has to issue a heartbeat response.
      , Settings -> Bool
s_requireMaster :: Bool
        -- ^ On a cluster settings. Requires the master node when performing a
        --   write operation.
      , Settings -> Retry
s_retry :: Retry
        -- ^ Retry strategy when failing to connect.
      , Settings -> NominalDiffTime
s_reconnect_delay :: NominalDiffTime
        -- ^ Delay before issuing a new connection request.
      , Settings -> Maybe TLSSettings
s_ssl :: Maybe TLSSettings
        -- ^ SSL settings.
      , Settings -> LogType
s_loggerType :: LogType
        -- ^ Type of logging to use.
      , Settings -> LoggerFilter
s_loggerFilter :: LoggerFilter
        -- ^ Restriction of what would be logged.
      , Settings -> Bool
s_loggerDetailed :: Bool
        -- ^ Detailed logging output. Currently, it also indicates the location
        --   where the log occurred.
      , Settings -> NominalDiffTime
s_operationTimeout :: NominalDiffTime
        -- ^ Delay in which an operation will be retried if no response arrived.
      , Settings -> Retry
s_operationRetry :: Retry
        -- ^ Retry strategy when an operation timeout.
      , Settings -> MonitoringBackend
s_monitoring :: MonitoringBackend
        -- ^ Monitoring backend abstraction. You could implement one targetting
        --   `ekg-core` for example. We will expose an `ekg-core` implementation
        --   as soon as `ekg-core` supports GHC 8.8.*.
      , Settings -> Maybe Text
s_defaultConnectionName :: Maybe Text
        -- ^ Default connection name.
      , Settings -> Maybe Credentials
s_defaultUserCredentials :: Maybe Credentials
        -- ^ 'Credentials' to use for operations where other 'Credentials' are
        --   not explicitly supplied.
      }

--------------------------------------------------------------------------------
-- | Default global settings.
--
--   * 's_heartbeatInterval'      = 750 ms
--   * 's_heartbeatTimeout'       = 1500 ms
--   * 's_requireMaster'          = 'True'
--   * 's_retry'                  = 'atMost' 3
--   * 's_reconnect_delay'        = 3 seconds
--   * 's_ssl'                    = 'Nothing'
--   * 's_loggerType'             = 'LogNone'
--   * 's_loggerFilter'           = 'LoggerLevel' 'LevelInfo'
--   * 's_loggerDetailed'         = 'False'
--   * 's_operationTimeout'       = 10 seconds
--   * 's_operationRetry'         = 'atMost' 3
--   * 's_monitoring'             = 'noopMonitoringBackend'
--   * 's_defaultConnectionName'  = 'Nothing'
--   * 's_defaultUserCredentials' = 'Nothing'
defaultSettings :: Settings
defaultSettings :: Settings
defaultSettings  = Settings :: NominalDiffTime
-> NominalDiffTime
-> Bool
-> Retry
-> NominalDiffTime
-> Maybe TLSSettings
-> LogType
-> LoggerFilter
-> Bool
-> NominalDiffTime
-> Retry
-> MonitoringBackend
-> Maybe Text
-> Maybe Credentials
-> Settings
Settings
                   { s_heartbeatInterval :: NominalDiffTime
s_heartbeatInterval      = Float -> NominalDiffTime
msDiffTime Float
750  -- 750ms
                   , s_heartbeatTimeout :: NominalDiffTime
s_heartbeatTimeout       = Float -> NominalDiffTime
msDiffTime Float
1500 -- 1500ms
                   , s_requireMaster :: Bool
s_requireMaster          = Bool
True
                   , s_retry :: Retry
s_retry                  = Int -> Retry
atMost Int
3
                   , s_reconnect_delay :: NominalDiffTime
s_reconnect_delay        = NominalDiffTime
3
                   , s_ssl :: Maybe TLSSettings
s_ssl                    = Maybe TLSSettings
forall a. Maybe a
Nothing
                   , s_loggerType :: LogType
s_loggerType             = LogType
LogNone
                   , s_loggerFilter :: LoggerFilter
s_loggerFilter           = LogLevel -> LoggerFilter
LoggerLevel LogLevel
LevelInfo
                   , s_loggerDetailed :: Bool
s_loggerDetailed         = Bool
False
                   , s_operationTimeout :: NominalDiffTime
s_operationTimeout       = NominalDiffTime
10 -- secs
                   , s_operationRetry :: Retry
s_operationRetry         = Int -> Retry
atMost Int
3
                   , s_monitoring :: MonitoringBackend
s_monitoring             = MonitoringBackend
noopMonitoringBackend
                   , s_defaultConnectionName :: Maybe Text
s_defaultConnectionName  = Maybe Text
forall a. Maybe a
Nothing
                   , s_defaultUserCredentials :: Maybe Credentials
s_defaultUserCredentials = Maybe Credentials
forall a. Maybe a
Nothing
                   }

--------------------------------------------------------------------------------
-- | Default SSL settings based on 'defaultSettings'.
defaultSSLSettings :: TLSSettings -> Settings
defaultSSLSettings :: TLSSettings -> Settings
defaultSSLSettings TLSSettings
tls = Settings
defaultSettings { s_ssl :: Maybe TLSSettings
s_ssl = TLSSettings -> Maybe TLSSettings
forall a. a -> Maybe a
Just TLSSettings
tls }

--------------------------------------------------------------------------------
-- | Millisecond timespan
msDiffTime :: Float -> NominalDiffTime
msDiffTime :: Float -> NominalDiffTime
msDiffTime Float
n = Rational -> NominalDiffTime
forall a. Fractional a => Rational -> a
fromRational (Rational -> NominalDiffTime) -> Rational -> NominalDiffTime
forall a b. (a -> b) -> a -> b
$ Float -> Rational
forall a. Real a => a -> Rational
toRational (Float
n Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
1000)

--------------------------------------------------------------------------------
-- | Monitoring backend abstraction. Gathers all the metrics currently tracked
--   by the client. Used only by the TCP interface. Be careful as
--   'MonitoringBackend' is used in a very tight loop. Each
--   function must not throw any exception or the client will end in a broken
--   state.
data MonitoringBackend =
    MonitoringBackend
    { MonitoringBackend -> IO ()
monitoringBackendIncrPkgCount :: IO ()
      -- ^ Called every time a TCP package is sent. We mean high-level TCP
      --   package, used in EventStore TCP protocol.
    , MonitoringBackend -> IO ()
monitoringBackendIncrConnectionDrop :: IO ()
      -- ^ Called every time the client has lost the connection.
    , MonitoringBackend -> Int -> IO ()
monitoringBackendAddDataTransmitted :: Int -> IO ()
      -- ^ When the client sends a TCP package, it calls that function by
      --   passing the size of the payload. The goal is to have a distrubtion
      --   of the amount of data exchanged with the server.
    , MonitoringBackend -> IO ()
monitoringBackendIncrForceReconnect :: IO ()
      -- ^ Called every time the client is asked by a node to connect to
      --   another node. It happens only in cluster connection setting.
    , MonitoringBackend -> IO ()
monitoringBackendIncrHeartbeatTimeouts :: IO ()
      -- ^ Called every time the client detects a heartbeat timeout from the
      --   server.
    }

--------------------------------------------------------------------------------
-- | A 'MonitoringBackend' that does nothing.
noopMonitoringBackend :: MonitoringBackend
noopMonitoringBackend :: MonitoringBackend
noopMonitoringBackend =
    MonitoringBackend :: IO ()
-> IO () -> (Int -> IO ()) -> IO () -> IO () -> MonitoringBackend
MonitoringBackend
    { monitoringBackendIncrPkgCount :: IO ()
monitoringBackendIncrPkgCount = () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    , monitoringBackendIncrConnectionDrop :: IO ()
monitoringBackendIncrConnectionDrop = () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    , monitoringBackendAddDataTransmitted :: Int -> IO ()
monitoringBackendAddDataTransmitted = IO () -> Int -> IO ()
forall a b. a -> b -> a
const (() -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
    , monitoringBackendIncrForceReconnect :: IO ()
monitoringBackendIncrForceReconnect = () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    , monitoringBackendIncrHeartbeatTimeouts :: IO ()
monitoringBackendIncrHeartbeatTimeouts = () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    }