{-# LANGUAGE NumericUnderscores #-}

-- | This module is for configuration of the SDK.
module LaunchDarkly.Server.Config
    ( Config
    , makeConfig
    , configSetKey
    , configSetBaseURI
    , configSetStreamURI
    , configSetEventsURI
    , configSetStreaming
    , configSetInitialRetryDelay
    , configSetAllAttributesPrivate
    , configSetPrivateAttributeNames
    , configSetFlushIntervalSeconds
    , configSetPollIntervalSeconds
    , configSetContextKeyLRUCapacity
    , configSetUserKeyLRUCapacity
    , configSetEventsCapacity
    , configSetLogger
    , configSetManager
    , configSetSendEvents
    , configSetOffline
    , configSetRequestTimeoutSeconds
    , configSetStoreBackend
    , configSetStoreTTL
    , configSetUseLdd
    , configSetDataSourceFactory
    , configSetApplicationInfo
    , ApplicationInfo
    , makeApplicationInfo
    , withApplicationValue
    ) where

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

import LaunchDarkly.Server.Config.Internal (ApplicationInfo, Config (..), makeApplicationInfo, withApplicationValue)
import LaunchDarkly.Server.DataSource.Internal (DataSourceFactory)
import LaunchDarkly.Server.Reference (Reference)
import LaunchDarkly.Server.Store (PersistentDataStore)

-- | Create a default configuration from a given SDK key.
makeConfig :: Text -> Config
makeConfig :: Text -> Config
makeConfig key :: Text
key =
    $WConfig :: Text
-> Text
-> Text
-> Text
-> Maybe PersistentDataStore
-> Natural
-> Bool
-> Int
-> Bool
-> Set Reference
-> Natural
-> Natural
-> Natural
-> Natural
-> (LoggingT IO () -> IO ())
-> Bool
-> Bool
-> Natural
-> Bool
-> Maybe DataSourceFactory
-> Maybe Manager
-> Maybe ApplicationInfo
-> Config
Config
        { $sel:key:Config :: Text
key = Text
key
        , $sel:baseURI:Config :: Text
baseURI = "https://sdk.launchdarkly.com"
        , $sel:streamURI:Config :: Text
streamURI = "https://stream.launchdarkly.com"
        , $sel:eventsURI:Config :: Text
eventsURI = "https://events.launchdarkly.com"
        , $sel:storeBackend:Config :: Maybe PersistentDataStore
storeBackend = Maybe PersistentDataStore
forall a. Maybe a
Nothing
        , $sel:storeTTLSeconds:Config :: Natural
storeTTLSeconds = 10
        , $sel:streaming:Config :: Bool
streaming = Bool
True
        , $sel:initialRetryDelay:Config :: Int
initialRetryDelay = 1_000
        , $sel:allAttributesPrivate:Config :: Bool
allAttributesPrivate = Bool
False
        , $sel:privateAttributeNames:Config :: Set Reference
privateAttributeNames = Set Reference
forall a. Monoid a => a
mempty
        , $sel:flushIntervalSeconds:Config :: Natural
flushIntervalSeconds = 5
        , $sel:pollIntervalSeconds:Config :: Natural
pollIntervalSeconds = 30
        , $sel:contextKeyLRUCapacity:Config :: Natural
contextKeyLRUCapacity = 1_000
        , $sel:eventsCapacity:Config :: Natural
eventsCapacity = 10_000
        , $sel:logger:Config :: LoggingT IO () -> IO ()
logger = LoggingT IO () -> IO ()
forall (m :: * -> *) a. MonadIO m => LoggingT m a -> m a
runStdoutLoggingT
        , $sel:sendEvents:Config :: Bool
sendEvents = Bool
True
        , $sel:offline:Config :: Bool
offline = Bool
False
        , $sel:requestTimeoutSeconds:Config :: Natural
requestTimeoutSeconds = 30
        , $sel:useLdd:Config :: Bool
useLdd = Bool
False
        , $sel:dataSourceFactory:Config :: Maybe DataSourceFactory
dataSourceFactory = Maybe DataSourceFactory
forall a. Maybe a
Nothing
        , $sel:manager:Config :: Maybe Manager
manager = Maybe Manager
forall a. Maybe a
Nothing
        , $sel:applicationInfo:Config :: Maybe ApplicationInfo
applicationInfo = Maybe ApplicationInfo
forall a. Maybe a
Nothing
        }

-- | Set the SDK key used to authenticate with LaunchDarkly.
configSetKey :: Text -> Config -> Config
configSetKey :: Text -> Config -> Config
configSetKey = 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 = 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 -> Config -> Config)
-> (Text -> Text) -> Text -> Config -> Config
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
(==) '/')

-- |
-- 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 = 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 -> Config -> Config)
-> (Text -> Text) -> Text -> Config -> Config
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
(==) '/')

-- |
-- 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 = 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 -> Config -> Config)
-> (Text -> Text) -> Text -> Config -> Config
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
(==) '/')

-- | Configures a handle to an external store such as Redis.
configSetStoreBackend :: Maybe PersistentDataStore -> Config -> Config
configSetStoreBackend :: Maybe PersistentDataStore -> Config -> Config
configSetStoreBackend = 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 = 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 = forall s a. HasField' "streaming" s a => a -> s -> s
forall (f :: Symbol) s a. HasField' f s a => a -> s -> s
setField @"streaming"

-- |
-- The initial delay in milliseconds before reconnecting after an error in the
-- SSE client. Defaults to 1 second.
--
-- This only applies to the streaming connection. Providing a non-positive
-- integer is a no-op.
configSetInitialRetryDelay :: Int -> Config -> Config
configSetInitialRetryDelay :: Int -> Config -> Config
configSetInitialRetryDelay seconds :: Int
seconds config :: Config
config
    | Int
seconds Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 0 = Config
config
    | Bool
otherwise = Int -> Config -> Config
forall (f :: Symbol) s a. HasField' f s a => a -> s -> s
setField @"initialRetryDelay" Int
seconds Config
config

-- |
-- Sets whether or not all context attributes (other than the key) should be
-- hidden from LaunchDarkly. If this is true, all context attribute values will
-- be private, not just the attributes specified in PrivateAttributeNames.
configSetAllAttributesPrivate :: Bool -> Config -> Config
configSetAllAttributesPrivate :: Bool -> Config -> Config
configSetAllAttributesPrivate = 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 context attribute names private. Any contexts sent to
-- LaunchDarkly with this configuration active will have attributes with these
-- names removed.
configSetPrivateAttributeNames :: Set Reference -> Config -> Config
configSetPrivateAttributeNames :: Set Reference -> Config -> Config
configSetPrivateAttributeNames = 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 = 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 = 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 context keys that the event processor can remember at any
-- one time, so that duplicate context details will not be sent in analytics
-- events.
configSetContextKeyLRUCapacity :: Natural -> Config -> Config
configSetContextKeyLRUCapacity :: Natural -> Config -> Config
configSetContextKeyLRUCapacity = forall s a. HasField' "contextKeyLRUCapacity" s a => a -> s -> s
forall (f :: Symbol) s a. HasField' f s a => a -> s -> s
setField @"contextKeyLRUCapacity"

{-# DEPRECATED configSetUserKeyLRUCapacity "Use configSetContextKeyLRUCapacity instead" #-}

-- |
-- Deprecated historically named function which proxies to
-- 'configSetContextKeyLRUCapacity'.
configSetUserKeyLRUCapacity :: Natural -> Config -> Config
configSetUserKeyLRUCapacity :: Natural -> Config -> Config
configSetUserKeyLRUCapacity = Natural -> Config -> Config
configSetContextKeyLRUCapacity

-- |
-- 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 = 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 = 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 = 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 = 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 = 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 = 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 = 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 = 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 -> Config -> Config)
-> (Manager -> Maybe Manager) -> Manager -> Config -> Config
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Manager -> Maybe Manager
forall a. a -> Maybe a
Just

-- |
-- An object that allows configuration of application metadata.
--
-- Application metadata may be used in LaunchDarkly analytics or other product
-- features, but does not affect feature flag evaluations.
--
-- If you want to set non-default values for any of these fields, provide the
-- appropriately configured dict to the 'Config' object.
configSetApplicationInfo :: ApplicationInfo -> Config -> Config
configSetApplicationInfo :: ApplicationInfo -> Config -> Config
configSetApplicationInfo = forall s a. HasField' "applicationInfo" s a => a -> s -> s
forall (f :: Symbol) s a. HasField' f s a => a -> s -> s
setField @"applicationInfo" (Maybe ApplicationInfo -> Config -> Config)
-> (ApplicationInfo -> Maybe ApplicationInfo)
-> ApplicationInfo
-> Config
-> Config
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ApplicationInfo -> Maybe ApplicationInfo
forall a. a -> Maybe a
Just