module LaunchDarkly.Server.Config.Internal
    ( Config(..)
    , mapConfig
    , ConfigI(..)
    , shouldSendEvents
    ) where

import Control.Monad.Logger               (LoggingT)
import Data.Generics.Product              (getField)
import Data.Text                          (Text)
import Data.Set                           (Set)
import GHC.Natural                        (Natural)
import GHC.Generics                       (Generic)

import LaunchDarkly.Server.Store          (StoreInterface)

mapConfig :: (ConfigI -> ConfigI) -> Config -> Config
mapConfig :: (ConfigI -> ConfigI) -> Config -> Config
mapConfig ConfigI -> ConfigI
f (Config ConfigI
c) = ConfigI -> Config
Config (ConfigI -> Config) -> ConfigI -> Config
forall a b. (a -> b) -> a -> b
$ ConfigI -> ConfigI
f ConfigI
c

shouldSendEvents :: ConfigI -> Bool
shouldSendEvents :: ConfigI -> Bool
shouldSendEvents ConfigI
config = (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ ConfigI -> Bool
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"offline" ConfigI
config) Bool -> Bool -> Bool
&& (ConfigI -> Bool
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"sendEvents" ConfigI
config)

-- | Config allows advanced configuration of the LaunchDarkly client.
newtype Config = Config ConfigI

data ConfigI = ConfigI
    { ConfigI -> Text
key                   :: !Text
    , ConfigI -> Text
baseURI               :: !Text
    , ConfigI -> Text
streamURI             :: !Text
    , ConfigI -> Text
eventsURI             :: !Text
    , ConfigI -> Maybe StoreInterface
storeBackend          :: !(Maybe StoreInterface)
    , ConfigI -> Natural
storeTTLSeconds       :: !Natural
    , ConfigI -> Bool
streaming             :: !Bool
    , ConfigI -> Bool
allAttributesPrivate  :: !Bool
    , ConfigI -> Set Text
privateAttributeNames :: !(Set Text)
    , ConfigI -> Natural
flushIntervalSeconds  :: !Natural
    , ConfigI -> Natural
pollIntervalSeconds   :: !Natural
    , ConfigI -> Natural
userKeyLRUCapacity    :: !Natural
    , ConfigI -> Bool
inlineUsersInEvents   :: !Bool
    , ConfigI -> Natural
eventsCapacity        :: !Natural
    , ConfigI -> LoggingT IO () -> IO ()
logger                :: !(LoggingT IO () -> IO ())
    , ConfigI -> Bool
sendEvents            :: !Bool
    , ConfigI -> Bool
offline               :: !Bool
    , ConfigI -> Natural
requestTimeoutSeconds :: !Natural
    , ConfigI -> Bool
useLdd                :: !Bool
    } deriving ((forall x. ConfigI -> Rep ConfigI x)
-> (forall x. Rep ConfigI x -> ConfigI) -> Generic ConfigI
forall x. Rep ConfigI x -> ConfigI
forall x. ConfigI -> Rep ConfigI x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ConfigI x -> ConfigI
$cfrom :: forall x. ConfigI -> Rep ConfigI x
Generic)