-- | 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
    , configSetManager
    , configSetSendEvents
    , configSetOffline
    , configSetRequestTimeoutSeconds
    , configSetStoreBackend
    , configSetStoreTTL
    , configSetUseLdd
    , configSetDataSourceFactory
    ) where

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

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

-- | 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
-> Maybe DataSourceFactory
-> Maybe Manager
-> 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
    , $sel:dataSourceFactory:ConfigI :: Maybe DataSourceFactory
dataSourceFactory     = Maybe DataSourceFactory
forall a. Maybe a
Nothing 
    , $sel:manager:ConfigI :: Maybe Manager
manager               = Maybe Manager
forall a. Maybe a
Nothing
    }

-- | 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" (Text -> ConfigI -> ConfigI)
-> (Text -> Text) -> Text -> ConfigI -> ConfigI
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> Text
dropWhileEnd (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
(==) Char
'/')

-- | 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" (Text -> ConfigI -> ConfigI)
-> (Text -> Text) -> Text -> ConfigI -> ConfigI
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> Text
dropWhileEnd (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
(==) Char
'/')

-- | 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" (Text -> ConfigI -> ConfigI)
-> (Text -> Text) -> Text -> ConfigI -> ConfigI
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> Text
dropWhileEnd (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
(==) Char
'/')

-- | 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 Proxy 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/home/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"

-- | Sets a data source to use instead of the default network based data source 
-- see "LaunchDarkly.Server.Integrations.FileData"
configSetDataSourceFactory :: Maybe DataSourceFactory -> Config -> Config
configSetDataSourceFactory :: Maybe DataSourceFactory -> Config -> Config
configSetDataSourceFactory = (ConfigI -> ConfigI) -> Config -> Config
mapConfig ((ConfigI -> ConfigI) -> Config -> Config)
-> (Maybe DataSourceFactory -> ConfigI -> ConfigI)
-> Maybe DataSourceFactory
-> Config
-> Config
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasField' "dataSourceFactory" s a => a -> s -> s
forall (f :: Symbol) s a. HasField' f s a => a -> s -> s
setField @"dataSourceFactory"

-- | Sets the 'Manager' to use with the client. If not set explicitly a new
-- 'Manager' will be created when creating the client.
configSetManager :: Manager -> Config -> Config
configSetManager :: Manager -> Config -> Config
configSetManager = (ConfigI -> ConfigI) -> Config -> Config
mapConfig ((ConfigI -> ConfigI) -> Config -> Config)
-> (Manager -> ConfigI -> ConfigI) -> Manager -> Config -> Config
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasField' "manager" s a => a -> s -> s
forall (f :: Symbol) s a. HasField' f s a => a -> s -> s
setField @"manager" (Maybe Manager -> ConfigI -> ConfigI)
-> (Manager -> Maybe Manager) -> Manager -> ConfigI -> ConfigI
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Manager -> Maybe Manager
forall a. a -> Maybe a
Just