-- | This module is for configuration of the SDK.

module LaunchDarkly.Server.Config
    ( Config
    , makeConfig
    , configSetKey
    , configSetBaseURI
    , configSetStreamURI
    , configSetEventsURI
    , configSetStreaming
    , configSetAllAttributesPrivate
    , configSetPrivateAttributeNames
    , configSetFlushIntervalSeconds
    , configSetPollIntervalSeconds
    , configSetUserKeyLRUCapacity
    , configSetInlineUsersInEvents
    , configSetEventsCapacity
    , configSetLogger
    , configSetSendEvents
    , configSetOffline
    , configSetRequestTimeoutSeconds
    , configSetStoreBackend
    , configSetStoreTTL
    , configSetUseLdd
    ) where

import Control.Monad.Logger                (LoggingT, runStdoutLoggingT)
import Data.Generics.Product               (setField)
import Data.Set                            (Set)
import Data.Text                           (Text)
import Data.Monoid                         (mempty)
import GHC.Natural                         (Natural)

import LaunchDarkly.Server.Config.Internal (Config(..), mapConfig, ConfigI(..))
import LaunchDarkly.Server.Store           (StoreInterface)

-- | Create a default configuration from a given SDK key.
makeConfig :: Text -> Config
makeConfig :: Text -> Config
makeConfig Text
key = ConfigI -> Config
Config (ConfigI -> Config) -> ConfigI -> Config
forall a b. (a -> b) -> a -> b
$ ConfigI :: Text
-> Text
-> Text
-> Text
-> Maybe StoreInterface
-> Natural
-> Bool
-> Bool
-> Set Text
-> Natural
-> Natural
-> Natural
-> Bool
-> Natural
-> (LoggingT IO () -> IO ())
-> Bool
-> Bool
-> Natural
-> Bool
-> ConfigI
ConfigI
    { $sel:key:ConfigI :: Text
key                   = Text
key
    , $sel:baseURI:ConfigI :: Text
baseURI               = Text
"https://app.launchdarkly.com"
    , $sel:streamURI:ConfigI :: Text
streamURI             = Text
"https://stream.launchdarkly.com"
    , $sel:eventsURI:ConfigI :: Text
eventsURI             = Text
"https://events.launchdarkly.com"
    , $sel:storeBackend:ConfigI :: Maybe StoreInterface
storeBackend          = Maybe StoreInterface
forall a. Maybe a
Nothing
    , $sel:storeTTLSeconds:ConfigI :: Natural
storeTTLSeconds       = Natural
10
    , $sel:streaming:ConfigI :: Bool
streaming             = Bool
True
    , $sel:allAttributesPrivate:ConfigI :: Bool
allAttributesPrivate  = Bool
False
    , $sel:privateAttributeNames:ConfigI :: Set Text
privateAttributeNames = Set Text
forall a. Monoid a => a
mempty
    , $sel:flushIntervalSeconds:ConfigI :: Natural
flushIntervalSeconds  = Natural
5
    , $sel:pollIntervalSeconds:ConfigI :: Natural
pollIntervalSeconds   = Natural
30
    , $sel:userKeyLRUCapacity:ConfigI :: Natural
userKeyLRUCapacity    = Natural
1000
    , $sel:inlineUsersInEvents:ConfigI :: Bool
inlineUsersInEvents   = Bool
False
    , $sel:eventsCapacity:ConfigI :: Natural
eventsCapacity        = Natural
10000
    , $sel:logger:ConfigI :: LoggingT IO () -> IO ()
logger                = LoggingT IO () -> IO ()
forall (m :: * -> *) a. MonadIO m => LoggingT m a -> m a
runStdoutLoggingT
    , $sel:sendEvents:ConfigI :: Bool
sendEvents            = Bool
True
    , $sel:offline:ConfigI :: Bool
offline               = Bool
False
    , $sel:requestTimeoutSeconds:ConfigI :: Natural
requestTimeoutSeconds = Natural
30
    , $sel:useLdd:ConfigI :: Bool
useLdd                = Bool
False
    }

-- | Set the SDK key used to authenticate with LaunchDarkly.
configSetKey :: Text -> Config -> Config
configSetKey :: Text -> Config -> Config
configSetKey = (ConfigI -> ConfigI) -> Config -> Config
mapConfig ((ConfigI -> ConfigI) -> Config -> Config)
-> (Text -> ConfigI -> ConfigI) -> Text -> Config -> Config
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasField' "key" s a => a -> s -> s
forall (f :: Symbol) s a. HasField' f s a => a -> s -> s
setField @"key"

-- | The base URI of the main LaunchDarkly service. This should not normally be
-- changed except for testing.
configSetBaseURI :: Text -> Config -> Config
configSetBaseURI :: Text -> Config -> Config
configSetBaseURI = (ConfigI -> ConfigI) -> Config -> Config
mapConfig ((ConfigI -> ConfigI) -> Config -> Config)
-> (Text -> ConfigI -> ConfigI) -> Text -> Config -> Config
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasField' "baseURI" s a => a -> s -> s
forall (f :: Symbol) s a. HasField' f s a => a -> s -> s
setField @"baseURI"

-- | The base URI of the LaunchDarkly streaming service. This should not
-- normally be changed except for testing.
configSetStreamURI :: Text -> Config -> Config
configSetStreamURI :: Text -> Config -> Config
configSetStreamURI = (ConfigI -> ConfigI) -> Config -> Config
mapConfig ((ConfigI -> ConfigI) -> Config -> Config)
-> (Text -> ConfigI -> ConfigI) -> Text -> Config -> Config
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasField' "streamURI" s a => a -> s -> s
forall (f :: Symbol) s a. HasField' f s a => a -> s -> s
setField @"streamURI"

-- | The base URI of the LaunchDarkly service that accepts analytics events.
-- This should not normally be changed except for testing.
configSetEventsURI :: Text -> Config -> Config
configSetEventsURI :: Text -> Config -> Config
configSetEventsURI = (ConfigI -> ConfigI) -> Config -> Config
mapConfig ((ConfigI -> ConfigI) -> Config -> Config)
-> (Text -> ConfigI -> ConfigI) -> Text -> Config -> Config
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasField' "eventsURI" s a => a -> s -> s
forall (f :: Symbol) s a. HasField' f s a => a -> s -> s
setField @"eventsURI"

-- | Configures a handle to an external store such as Redis.
configSetStoreBackend :: Maybe StoreInterface -> Config -> Config
configSetStoreBackend :: Maybe StoreInterface -> Config -> Config
configSetStoreBackend = (ConfigI -> ConfigI) -> Config -> Config
mapConfig ((ConfigI -> ConfigI) -> Config -> Config)
-> (Maybe StoreInterface -> ConfigI -> ConfigI)
-> Maybe StoreInterface
-> Config
-> Config
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasField' "storeBackend" s a => a -> s -> s
forall (f :: Symbol) s a. HasField' f s a => a -> s -> s
setField @"storeBackend"

-- | When a store backend is configured, control how long values should be
-- cached in memory before going back to the backend.
configSetStoreTTL :: Natural -> Config -> Config
configSetStoreTTL :: Natural -> Config -> Config
configSetStoreTTL = (ConfigI -> ConfigI) -> Config -> Config
mapConfig ((ConfigI -> ConfigI) -> Config -> Config)
-> (Natural -> ConfigI -> ConfigI) -> Natural -> Config -> Config
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasField' "storeTTLSeconds" s a => a -> s -> s
forall (f :: Symbol) s a. HasField' f s a => a -> s -> s
setField @"storeTTLSeconds"

-- | Sets whether streaming mode should be enabled. By default, streaming is
-- enabled. It should only be disabled on the advice of LaunchDarkly support.
configSetStreaming :: Bool -> Config -> Config
configSetStreaming :: Bool -> Config -> Config
configSetStreaming = (ConfigI -> ConfigI) -> Config -> Config
mapConfig ((ConfigI -> ConfigI) -> Config -> Config)
-> (Bool -> ConfigI -> ConfigI) -> Bool -> Config -> Config
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasField' "streaming" s a => a -> s -> s
forall (f :: Symbol) s a. HasField' f s a => a -> s -> s
setField @"streaming"

-- | Sets whether or not all user attributes (other than the key) should be
-- hidden from LaunchDarkly. If this is true, all user attribute values will be
-- private, not just the attributes specified in PrivateAttributeNames.
configSetAllAttributesPrivate :: Bool -> Config -> Config
configSetAllAttributesPrivate :: Bool -> Config -> Config
configSetAllAttributesPrivate = (ConfigI -> ConfigI) -> Config -> Config
mapConfig ((ConfigI -> ConfigI) -> Config -> Config)
-> (Bool -> ConfigI -> ConfigI) -> Bool -> Config -> Config
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasField' "allAttributesPrivate" s a => a -> s -> s
forall (f :: Symbol) s a. HasField' f s a => a -> s -> s
setField @"allAttributesPrivate"

-- | Marks a set of user attribute names private. Any users sent to LaunchDarkly
-- with this configuration active will have attributes with these names removed.
configSetPrivateAttributeNames :: Set Text -> Config -> Config
configSetPrivateAttributeNames :: Set Text -> Config -> Config
configSetPrivateAttributeNames = (ConfigI -> ConfigI) -> Config -> Config
mapConfig ((ConfigI -> ConfigI) -> Config -> Config)
-> (Set Text -> ConfigI -> ConfigI) -> Set Text -> Config -> Config
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasField' "privateAttributeNames" s a => a -> s -> s
forall (f :: Symbol) s a. HasField' f s a => a -> s -> s
setField @"privateAttributeNames"

-- | The time between flushes of the event buffer. Decreasing the flush interval
-- means that the event buffer is less likely to reach capacity.
configSetFlushIntervalSeconds :: Natural -> Config -> Config
configSetFlushIntervalSeconds :: Natural -> Config -> Config
configSetFlushIntervalSeconds = (ConfigI -> ConfigI) -> Config -> Config
mapConfig ((ConfigI -> ConfigI) -> Config -> Config)
-> (Natural -> ConfigI -> ConfigI) -> Natural -> Config -> Config
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasField' "flushIntervalSeconds" s a => a -> s -> s
forall (f :: Symbol) s a. HasField' f s a => a -> s -> s
setField @"flushIntervalSeconds"

-- | The polling interval (when streaming is disabled).
configSetPollIntervalSeconds :: Natural -> Config -> Config
configSetPollIntervalSeconds :: Natural -> Config -> Config
configSetPollIntervalSeconds = (ConfigI -> ConfigI) -> Config -> Config
mapConfig ((ConfigI -> ConfigI) -> Config -> Config)
-> (Natural -> ConfigI -> ConfigI) -> Natural -> Config -> Config
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasField' "pollIntervalSeconds" s a => a -> s -> s
forall (f :: Symbol) s a. HasField' f s a => a -> s -> s
setField @"pollIntervalSeconds"

-- | The number of user keys that the event processor can remember at any one
-- time, so that duplicate user details will not be sent in analytics events.
configSetUserKeyLRUCapacity :: Natural -> Config -> Config
configSetUserKeyLRUCapacity :: Natural -> Config -> Config
configSetUserKeyLRUCapacity = (ConfigI -> ConfigI) -> Config -> Config
mapConfig ((ConfigI -> ConfigI) -> Config -> Config)
-> (Natural -> ConfigI -> ConfigI) -> Natural -> Config -> Config
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasField' "userKeyLRUCapacity" s a => a -> s -> s
forall (f :: Symbol) s a. HasField' f s a => a -> s -> s
setField @"userKeyLRUCapacity"

-- | Set to true if you need to see the full user details in every analytics
-- event.
configSetInlineUsersInEvents :: Bool -> Config -> Config
configSetInlineUsersInEvents :: Bool -> Config -> Config
configSetInlineUsersInEvents = (ConfigI -> ConfigI) -> Config -> Config
mapConfig ((ConfigI -> ConfigI) -> Config -> Config)
-> (Bool -> ConfigI -> ConfigI) -> Bool -> Config -> Config
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasField' "inlineUsersInEvents" s a => a -> s -> s
forall (f :: Symbol) s a. HasField' f s a => a -> s -> s
setField @"inlineUsersInEvents"

-- | The capacity of the events buffer. The client buffers up to this many
-- events in memory before flushing. If the capacity is exceeded before the
-- buffer is flushed, events will be discarded.
configSetEventsCapacity :: Natural -> Config -> Config
configSetEventsCapacity :: Natural -> Config -> Config
configSetEventsCapacity = (ConfigI -> ConfigI) -> Config -> Config
mapConfig ((ConfigI -> ConfigI) -> Config -> Config)
-> (Natural -> ConfigI -> ConfigI) -> Natural -> Config -> Config
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasField' "eventsCapacity" s a => a -> s -> s
forall (f :: Symbol) s a. HasField' f s a => a -> s -> s
setField @"eventsCapacity"

-- | Set the logger to be used by the client.
configSetLogger :: (LoggingT IO () -> IO ()) -> Config -> Config
configSetLogger :: (LoggingT IO () -> IO ()) -> Config -> Config
configSetLogger = (ConfigI -> ConfigI) -> Config -> Config
mapConfig ((ConfigI -> ConfigI) -> Config -> Config)
-> ((LoggingT IO () -> IO ()) -> ConfigI -> ConfigI)
-> (LoggingT IO () -> IO ())
-> Config
-> Config
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasField' "logger" s a => a -> s -> s
forall (f :: Symbol) s a. HasField' f s a => a -> s -> s
setField @"logger"

-- | Sets whether to send analytics events back to LaunchDarkly. By default, the
-- client will send events. This differs from Offline in that it only affects
-- sending events, not streaming or polling for events from the server.
configSetSendEvents :: Bool -> Config -> Config
configSetSendEvents :: Bool -> Config -> Config
configSetSendEvents = (ConfigI -> ConfigI) -> Config -> Config
mapConfig ((ConfigI -> ConfigI) -> Config -> Config)
-> (Bool -> ConfigI -> ConfigI) -> Bool -> Config -> Config
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasField' "sendEvents" s a => a -> s -> s
forall (f :: Symbol) s a. HasField' f s a => a -> s -> s
setField @"sendEvents"

-- | Sets whether this client is offline. An offline client will not make any
-- network connections to LaunchDarkly, and will return default values for all
-- feature flags.
configSetOffline :: Bool -> Config -> Config
configSetOffline :: Bool -> Config -> Config
configSetOffline = (ConfigI -> ConfigI) -> Config -> Config
mapConfig ((ConfigI -> ConfigI) -> Config -> Config)
-> (Bool -> ConfigI -> ConfigI) -> Bool -> Config -> Config
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasField' "offline" s a => a -> s -> s
forall (f :: Symbol) s a. HasField' f s a => a -> s -> s
setField @"offline"

-- | Sets how long an the HTTP client should wait before a response is returned.
configSetRequestTimeoutSeconds :: Natural -> Config -> Config
configSetRequestTimeoutSeconds :: Natural -> Config -> Config
configSetRequestTimeoutSeconds = (ConfigI -> ConfigI) -> Config -> Config
mapConfig ((ConfigI -> ConfigI) -> Config -> Config)
-> (Natural -> ConfigI -> ConfigI) -> Natural -> Config -> Config
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasField' "requestTimeoutSeconds" s a => a -> s -> s
forall (f :: Symbol) s a. HasField' f s a => a -> s -> s
setField @"requestTimeoutSeconds"

-- | Sets whether this client should use the LaunchDarkly relay in daemon mode.
-- In this mode, the client does not subscribe to the streaming or polling API,
-- but reads data only from the feature store. See:
-- https://docs.launchdarkly.com/docs/the-relay-proxy
configSetUseLdd :: Bool -> Config -> Config
configSetUseLdd :: Bool -> Config -> Config
configSetUseLdd = (ConfigI -> ConfigI) -> Config -> Config
mapConfig ((ConfigI -> ConfigI) -> Config -> Config)
-> (Bool -> ConfigI -> ConfigI) -> Bool -> Config -> Config
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasField' "useLdd" s a => a -> s -> s
forall (f :: Symbol) s a. HasField' f s a => a -> s -> s
setField @"useLdd"