-- | This module contains the core functionality of the SDK.
module LaunchDarkly.Server.Client
    ( Client
    , makeClient
    , clientVersion
    , boolVariation
    , boolVariationDetail
    , stringVariation
    , stringVariationDetail
    , intVariation
    , intVariationDetail
    , doubleVariation
    , doubleVariationDetail
    , jsonVariation
    , jsonVariationDetail
    , EvaluationDetail (..)
    , EvaluationReason (..)
    , EvalErrorKind (..)
    , allFlagsState
    , AllFlagsState
    , secureModeHash
    , close
    , flushEvents
    , identify
    , track
    , Status (..)
    , getStatus
    ) where

import Control.Concurrent (forkFinally, killThread)
import Control.Concurrent.MVar (newEmptyMVar, putMVar, takeMVar)
import Control.Monad (forM_, void)
import Control.Monad.Fix (mfix)
import Control.Monad.IO.Class (liftIO)
import Control.Monad.Logger (LoggingT, logDebug, logWarn)
import Data.Aeson (ToJSON, Value (..), object, toJSON, (.=))
import Data.Generics.Product (getField)
import qualified Data.HashSet as HS
import Data.IORef (newIORef, readIORef, writeIORef)
import Data.Maybe (fromMaybe)
import Data.Scientific (fromFloatDigits, toRealFloat)
import Data.Text (Text)
import Data.Text.Encoding (encodeUtf8)
import GHC.Generics (Generic)
import GHC.Natural (Natural)
import Network.HTTP.Client (newManager)
import qualified Network.HTTP.Client as Http
import Network.HTTP.Client.TLS (tlsManagerSettings)
import System.Clock (TimeSpec (..))

import LaunchDarkly.AesonCompat (KeyMap, emptyObject, filterObject, insertKey, mapValues)
import LaunchDarkly.Server.Client.Internal (Client (..), clientVersion, getStatusI)
import LaunchDarkly.Server.Client.Status (Status (..))
import LaunchDarkly.Server.Config.ClientContext (ClientContext (..))
import LaunchDarkly.Server.Config.HttpConfiguration (HttpConfiguration (..))
import LaunchDarkly.Server.Config.Internal (ApplicationInfo, Config, getApplicationInfoHeader, shouldSendEvents)
import LaunchDarkly.Server.Context (getValue)
import LaunchDarkly.Server.Context.Internal (Context (Invalid), getCanonicalKey, getKey, getKeys, redactContext)
import LaunchDarkly.Server.DataSource.Internal (DataSource (..), DataSourceFactory, DataSourceUpdates (..), defaultDataSourceUpdates, nullDataSourceFactory)
import LaunchDarkly.Server.Details (EvalErrorKind (..), EvaluationDetail (..), EvaluationReason (..))
import LaunchDarkly.Server.Evaluate (evaluateDetail, evaluateTyped)
import LaunchDarkly.Server.Events (CustomEvent (..), EventType (..), IdentifyEvent (..), makeBaseEvent, makeEventState, maybeIndexContext, noticeContext, queueEvent, unixMilliseconds)
import LaunchDarkly.Server.Features (isClientSideOnlyFlag, isInExperiment)
import LaunchDarkly.Server.Network.Eventing (eventThread)
import LaunchDarkly.Server.Network.Polling (pollingThread)
import LaunchDarkly.Server.Network.Streaming (streamingThread)
import LaunchDarkly.Server.Store.Internal (getAllFlagsC, makeStoreIO)

import Crypto.Hash.SHA256 (hash)
import Crypto.MAC.HMAC (hmac)
import Data.ByteArray.Encoding (Base (Base16), convertToBase)
import Data.ByteString (ByteString)
import Data.Text.Encoding (decodeUtf8)
import Network.HTTP.Types (HeaderName)

networkDataSourceFactory :: (ClientContext -> DataSourceUpdates -> LoggingT IO ()) -> DataSourceFactory
networkDataSourceFactory :: (ClientContext -> DataSourceUpdates -> LoggingT IO ())
-> DataSourceFactory
networkDataSourceFactory ClientContext -> DataSourceUpdates -> LoggingT IO ()
threadF ClientContext
clientContext DataSourceUpdates
dataSourceUpdates = do
    IORef Bool
initialized <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. a -> IO (IORef a)
newIORef Bool
False
    MVar ThreadId
thread <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a. IO (MVar a)
newEmptyMVar
    MVar ()
sync <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a. IO (MVar a)
newEmptyMVar

    let dataSourceIsInitialized :: IO Bool
dataSourceIsInitialized = forall a. IORef a -> IO a
readIORef IORef Bool
initialized

        dataSourceStart :: IO ()
dataSourceStart = do
            forall a. MVar a -> a -> IO ()
putMVar MVar ThreadId
thread forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. IO a -> (Either SomeException a -> IO ()) -> IO ThreadId
forkFinally (ClientContext -> LoggingT IO () -> IO ()
runLogger ClientContext
clientContext forall a b. (a -> b) -> a -> b
$ ClientContext -> DataSourceUpdates -> LoggingT IO ()
threadF ClientContext
clientContext DataSourceUpdates
dataSourceUpdates) (\Either SomeException ()
_ -> forall a. MVar a -> a -> IO ()
putMVar MVar ()
sync ())
            forall a. IORef a -> a -> IO ()
writeIORef IORef Bool
initialized Bool
True

        dataSourceStop :: IO ()
dataSourceStop = ClientContext -> LoggingT IO () -> IO ()
runLogger ClientContext
clientContext forall a b. (a -> b) -> a -> b
$ do
            $(logDebug) Text
"Killing download thread"
            forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ ThreadId -> IO ()
killThread forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. MVar a -> IO a
takeMVar MVar ThreadId
thread
            $(logDebug) Text
"Waiting on download thread to die"
            forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall a. MVar a -> IO a
takeMVar MVar ()
sync

    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ DataSource {IO Bool
IO ()
$sel:dataSourceStop:DataSource :: IO ()
$sel:dataSourceStart:DataSource :: IO ()
$sel:dataSourceIsInitialized:DataSource :: IO Bool
dataSourceStop :: IO ()
dataSourceStart :: IO ()
dataSourceIsInitialized :: IO Bool
..}

makeHttpConfiguration :: Config -> IO HttpConfiguration
makeHttpConfiguration :: Config -> IO HttpConfiguration
makeHttpConfiguration Config
config = do
    Manager
tlsManager <- ManagerSettings -> IO Manager
newManager ManagerSettings
tlsManagerSettings
    let headers :: [(HeaderName, ByteString)]
headers =
            [ (HeaderName
"Authorization", Text -> ByteString
encodeUtf8 forall a b. (a -> b) -> a -> b
$ forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"key" Config
config)
            , (HeaderName
"User-Agent", ByteString
"HaskellServerClient/" forall a. Semigroup a => a -> a -> a
<> Text -> ByteString
encodeUtf8 Text
clientVersion)
            ]
        defaultRequestHeaders :: [(HeaderName, ByteString)]
defaultRequestHeaders = [(HeaderName, ByteString)]
-> Maybe ApplicationInfo -> [(HeaderName, ByteString)]
addTagsHeader [(HeaderName, ByteString)]
headers (forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"applicationInfo" Config
config)
        defaultRequestTimeout :: ResponseTimeout
defaultRequestTimeout = Int -> ResponseTimeout
Http.responseTimeoutMicro forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"requestTimeoutSeconds" Config
config forall a. Num a => a -> a -> a
* Natural
1000000
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ HttpConfiguration {[(HeaderName, ByteString)]
ResponseTimeout
Manager
$sel:tlsManager:HttpConfiguration :: Manager
$sel:defaultRequestTimeout:HttpConfiguration :: ResponseTimeout
$sel:defaultRequestHeaders:HttpConfiguration :: [(HeaderName, ByteString)]
defaultRequestTimeout :: ResponseTimeout
defaultRequestHeaders :: [(HeaderName, ByteString)]
tlsManager :: Manager
..}
  where
    addTagsHeader :: [(HeaderName, ByteString)] -> Maybe ApplicationInfo -> [(HeaderName, ByteString)]
    addTagsHeader :: [(HeaderName, ByteString)]
-> Maybe ApplicationInfo -> [(HeaderName, ByteString)]
addTagsHeader [(HeaderName, ByteString)]
headers Maybe ApplicationInfo
Nothing = [(HeaderName, ByteString)]
headers
    addTagsHeader [(HeaderName, ByteString)]
headers (Just ApplicationInfo
info) = case ApplicationInfo -> Maybe Text
getApplicationInfoHeader ApplicationInfo
info of
        Maybe Text
Nothing -> [(HeaderName, ByteString)]
headers
        Just Text
header -> (HeaderName
"X-LaunchDarkly-Tags", Text -> ByteString
encodeUtf8 Text
header) forall a. a -> [a] -> [a]
: [(HeaderName, ByteString)]
headers

makeClientContext :: Config -> IO ClientContext
makeClientContext :: Config -> IO ClientContext
makeClientContext Config
config = do
    let runLogger :: LoggingT IO () -> IO ()
runLogger = forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"logger" Config
config
    HttpConfiguration
httpConfiguration <- Config -> IO HttpConfiguration
makeHttpConfiguration Config
config
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ClientContext {HttpConfiguration
LoggingT IO () -> IO ()
$sel:httpConfiguration:ClientContext :: HttpConfiguration
httpConfiguration :: HttpConfiguration
runLogger :: LoggingT IO () -> IO ()
$sel:runLogger:ClientContext :: LoggingT IO () -> IO ()
..}

-- | Create a new instance of the LaunchDarkly client.
makeClient :: Config -> IO Client
makeClient :: Config -> IO Client
makeClient Config
config = forall (m :: * -> *) a. MonadFix m => (a -> m a) -> m a
mfix forall a b. (a -> b) -> a -> b
$ \Client
client -> do
    IORef Status
status <- forall a. a -> IO (IORef a)
newIORef Status
Uninitialized
    StoreHandle IO
store <- Maybe PersistentDataStore -> TimeSpec -> IO (StoreHandle IO)
makeStoreIO (forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"storeBackend" Config
config) (Int64 -> Int64 -> TimeSpec
TimeSpec (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"storeTTLSeconds" Config
config) Int64
0)
    Manager
manager <- case forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"manager" Config
config of
        Just Manager
manager -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Manager
manager
        Maybe Manager
Nothing -> ManagerSettings -> IO Manager
newManager ManagerSettings
tlsManagerSettings
    EventState
events <- Config -> IO EventState
makeEventState Config
config

    ClientContext
clientContext <- Config -> IO ClientContext
makeClientContext Config
config

    let dataSourceUpdates :: DataSourceUpdates
dataSourceUpdates = IORef Status -> StoreHandle IO -> DataSourceUpdates
defaultDataSourceUpdates IORef Status
status StoreHandle IO
store
    DataSource
dataSource <- Config -> DataSourceFactory
dataSourceFactory Config
config ClientContext
clientContext DataSourceUpdates
dataSourceUpdates
    Maybe (ThreadId, MVar ())
eventThreadPair <-
        if Bool -> Bool
not (Config -> Bool
shouldSendEvents Config
config)
            then forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
            else do
                MVar ()
sync <- forall a. IO (MVar a)
newEmptyMVar
                ThreadId
thread <- forall a. IO a -> (Either SomeException a -> IO ()) -> IO ThreadId
forkFinally (ClientContext -> LoggingT IO () -> IO ()
runLogger ClientContext
clientContext forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
(MonadIO m, MonadLogger m, MonadMask m) =>
Manager -> Client -> ClientContext -> m ()
eventThread Manager
manager Client
client ClientContext
clientContext) (\Either SomeException ()
_ -> forall a. MVar a -> a -> IO ()
putMVar MVar ()
sync ())
                forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure (ThreadId
thread, MVar ()
sync)

    DataSource -> IO ()
dataSourceStart DataSource
dataSource

    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Client {Maybe (ThreadId, MVar ())
IORef Status
StoreHandle IO
DataSource
Config
EventState
$sel:dataSource:Client :: DataSource
$sel:eventThreadPair:Client :: Maybe (ThreadId, MVar ())
$sel:events:Client :: EventState
$sel:status:Client :: IORef Status
$sel:store:Client :: StoreHandle IO
$sel:config:Client :: Config
eventThreadPair :: Maybe (ThreadId, MVar ())
dataSource :: DataSource
events :: EventState
store :: StoreHandle IO
status :: IORef Status
config :: Config
..}

dataSourceFactory :: Config -> DataSourceFactory
dataSourceFactory :: Config -> DataSourceFactory
dataSourceFactory Config
config =
    if forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"offline" Config
config Bool -> Bool -> Bool
|| forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"useLdd" Config
config
        then DataSourceFactory
nullDataSourceFactory
        else case forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"dataSourceFactory" Config
config of
            Just DataSourceFactory
factory ->
                DataSourceFactory
factory
            Maybe DataSourceFactory
Nothing ->
                let dataSourceThread :: ClientContext -> DataSourceUpdates -> LoggingT IO ()
dataSourceThread =
                        if forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"streaming" Config
config
                            then forall (m :: * -> *).
(MonadIO m, MonadLogger m, MonadMask m) =>
Text -> Int -> ClientContext -> DataSourceUpdates -> m ()
streamingThread (forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"streamURI" Config
config) (forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"initialRetryDelay" Config
config)
                            else forall (m :: * -> *).
(MonadIO m, MonadLogger m, MonadMask m) =>
Text -> Natural -> ClientContext -> DataSourceUpdates -> m ()
pollingThread (forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"baseURI" Config
config) (forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"pollIntervalSeconds" Config
config)
                 in (ClientContext -> DataSourceUpdates -> LoggingT IO ())
-> DataSourceFactory
networkDataSourceFactory ClientContext -> DataSourceUpdates -> LoggingT IO ()
dataSourceThread

clientRunLogger :: Client -> (LoggingT IO () -> IO ())
clientRunLogger :: Client -> LoggingT IO () -> IO ()
clientRunLogger Client
client = forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"logger" forall a b. (a -> b) -> a -> b
$ forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"config" Client
client

-- | Return the initialization status of the Client
getStatus :: Client -> IO Status
getStatus :: Client -> IO Status
getStatus Client
client = Client -> IO Status
getStatusI Client
client

-- TODO(mmk) This method exists in multiple places. Should we move this into a
-- util file?
fromObject :: Value -> KeyMap Value
fromObject :: Value -> KeyMap Value
fromObject Value
x = case Value
x of (Object KeyMap Value
o) -> KeyMap Value
o; Value
_ -> forall a. HasCallStack => String -> a
error String
"expected object"

-- |
-- AllFlagsState captures the state of all feature flag keys as evaluated for
-- a specific context. This includes their values, as well as other metadata.
data AllFlagsState = AllFlagsState
    { AllFlagsState -> KeyMap Value
evaluations :: !(KeyMap Value)
    , AllFlagsState -> KeyMap FlagState
state :: !(KeyMap FlagState)
    , AllFlagsState -> Bool
valid :: !Bool
    }
    deriving (Int -> AllFlagsState -> ShowS
[AllFlagsState] -> ShowS
AllFlagsState -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AllFlagsState] -> ShowS
$cshowList :: [AllFlagsState] -> ShowS
show :: AllFlagsState -> String
$cshow :: AllFlagsState -> String
showsPrec :: Int -> AllFlagsState -> ShowS
$cshowsPrec :: Int -> AllFlagsState -> ShowS
Show, forall x. Rep AllFlagsState x -> AllFlagsState
forall x. AllFlagsState -> Rep AllFlagsState x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AllFlagsState x -> AllFlagsState
$cfrom :: forall x. AllFlagsState -> Rep AllFlagsState x
Generic)

instance ToJSON AllFlagsState where
    toJSON :: AllFlagsState -> Value
toJSON AllFlagsState
state =
        KeyMap Value -> Value
Object forall a b. (a -> b) -> a -> b
$
            forall v. Text -> v -> KeyMap v -> KeyMap v
insertKey Text
"$flagsState" (forall a. ToJSON a => a -> Value
toJSON forall a b. (a -> b) -> a -> b
$ forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"state" AllFlagsState
state) forall a b. (a -> b) -> a -> b
$
                forall v. Text -> v -> KeyMap v -> KeyMap v
insertKey
                    Text
"$valid"
                    (forall a. ToJSON a => a -> Value
toJSON forall a b. (a -> b) -> a -> b
$ forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"valid" AllFlagsState
state)
                    (Value -> KeyMap Value
fromObject forall a b. (a -> b) -> a -> b
$ forall a. ToJSON a => a -> Value
toJSON forall a b. (a -> b) -> a -> b
$ forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"evaluations" AllFlagsState
state)

data FlagState = FlagState
    { FlagState -> Maybe Natural
version :: !(Maybe Natural)
    , FlagState -> Maybe Integer
variation :: !(Maybe Integer)
    , FlagState -> Maybe EvaluationReason
reason :: !(Maybe EvaluationReason)
    , FlagState -> Bool
trackEvents :: !Bool
    , FlagState -> Bool
trackReason :: !Bool
    , FlagState -> Maybe Natural
debugEventsUntilDate :: !(Maybe Natural)
    }
    deriving (Int -> FlagState -> ShowS
[FlagState] -> ShowS
FlagState -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FlagState] -> ShowS
$cshowList :: [FlagState] -> ShowS
show :: FlagState -> String
$cshow :: FlagState -> String
showsPrec :: Int -> FlagState -> ShowS
$cshowsPrec :: Int -> FlagState -> ShowS
Show, forall x. Rep FlagState x -> FlagState
forall x. FlagState -> Rep FlagState x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FlagState x -> FlagState
$cfrom :: forall x. FlagState -> Rep FlagState x
Generic)

instance ToJSON FlagState where
    toJSON :: FlagState -> Value
toJSON FlagState
state =
        [Pair] -> Value
object forall a b. (a -> b) -> a -> b
$
            forall a. (a -> Bool) -> [a] -> [a]
filter
                (forall a. Eq a => a -> a -> Bool
(/=) Value
Null forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd)
                [ Key
"version" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"version" FlagState
state
                , Key
"variation" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"variation" FlagState
state
                , Key
"trackEvents" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= if forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"trackEvents" FlagState
state then forall a. a -> Maybe a
Just Bool
True else forall a. Maybe a
Nothing
                , Key
"trackReason" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= if forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"trackReason" FlagState
state then forall a. a -> Maybe a
Just Bool
True else forall a. Maybe a
Nothing
                , Key
"reason" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"reason" FlagState
state
                , Key
"debugEventsUntilDate" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"debugEventsUntilDate" FlagState
state
                ]

-- |
-- Returns an object that encapsulates the state of all feature flags for a
-- given context. This includes the flag values, and also metadata that can be
-- used on the front end.
--
-- The most common use case for this method is to bootstrap a set of
-- client-side feature flags from a back-end service.
--
-- The first parameter will limit to only flags that are marked for use with
-- the client-side SDK (by default, all flags are included).
--
-- The second parameter will include evaluation reasons in the state.
--
-- The third parameter will omit any metadata that is normally only used for
-- event generation, such as flag versions and evaluation reasons, unless the
-- flag has event tracking or debugging turned on
--
-- For more information, see the Reference Guide:
-- https://docs.launchdarkly.com/sdk/features/all-flags#haskell
allFlagsState :: Client -> Context -> Bool -> Bool -> Bool -> IO (AllFlagsState)
allFlagsState :: Client -> Context -> Bool -> Bool -> Bool -> IO AllFlagsState
allFlagsState Client
client Context
context Bool
client_side_only Bool
with_reasons Bool
details_only_for_tracked_flags = do
    Either Text (KeyMap Flag)
status <- forall store (m :: * -> *).
LaunchDarklyStoreRead store m =>
store -> StoreResultM m (KeyMap Flag)
getAllFlagsC forall a b. (a -> b) -> a -> b
$ forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"store" Client
client
    case Either Text (KeyMap Flag)
status of
        Left Text
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure AllFlagsState {$sel:evaluations:AllFlagsState :: KeyMap Value
evaluations = forall v. KeyMap v
emptyObject, $sel:state:AllFlagsState :: KeyMap FlagState
state = forall v. KeyMap v
emptyObject, $sel:valid:AllFlagsState :: Bool
valid = Bool
False}
        Right KeyMap Flag
flags -> do
            KeyMap Flag
filtered <- forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ (forall v. (v -> Bool) -> KeyMap v -> KeyMap v
filterObject (\Flag
flag -> (Bool -> Bool
not Bool
client_side_only) Bool -> Bool -> Bool
|| Flag -> Bool
isClientSideOnlyFlag Flag
flag) KeyMap Flag
flags)
            KeyMap (Flag, EvaluationDetail Value)
details <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\Flag
flag -> (\(EvaluationDetail Value, [EvalEvent])
detail -> (Flag
flag, forall a b. (a, b) -> a
fst (EvaluationDetail Value, [EvalEvent])
detail)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (m :: * -> *) store.
(Monad m, LaunchDarklyStoreRead store m) =>
Flag
-> Context
-> HashSet Text
-> store
-> m (EvaluationDetail Value, [EvalEvent])
evaluateDetail Flag
flag Context
context forall a. HashSet a
HS.empty forall a b. (a -> b) -> a -> b
$ forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"store" Client
client)) KeyMap Flag
filtered
            KeyMap Value
evaluations <- forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall v1 v2. (v1 -> v2) -> KeyMap v1 -> KeyMap v2
mapValues (forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"value" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) KeyMap (Flag, EvaluationDetail Value)
details
            Natural
now <- IO Natural
unixMilliseconds
            KeyMap FlagState
state <-
                forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
                    forall v1 v2. (v1 -> v2) -> KeyMap v1 -> KeyMap v2
mapValues
                        ( \(Flag
flag, EvaluationDetail Value
detail) -> do
                            let reason' :: EvaluationReason
reason' = forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"reason" EvaluationDetail Value
detail
                                inExperiment :: Bool
inExperiment = Flag -> EvaluationReason -> Bool
isInExperiment Flag
flag EvaluationReason
reason'
                                isDebugging :: Bool
isDebugging = Natural
now forall a. Ord a => a -> a -> Bool
< forall a. a -> Maybe a -> a
fromMaybe Natural
0 (forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"debugEventsUntilDate" Flag
flag)
                                trackReason' :: Bool
trackReason' = Bool
inExperiment
                                trackEvents' :: Bool
trackEvents' = forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"trackEvents" Flag
flag
                                omitDetails :: Bool
omitDetails = Bool
details_only_for_tracked_flags Bool -> Bool -> Bool
&& (Bool -> Bool
not (Bool
trackEvents' Bool -> Bool -> Bool
|| Bool
trackReason' Bool -> Bool -> Bool
|| Bool
isDebugging))
                            FlagState
                                { $sel:version:FlagState :: Maybe Natural
version = if Bool
omitDetails then forall a. Maybe a
Nothing else forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"version" Flag
flag
                                , $sel:variation:FlagState :: Maybe Integer
variation = forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"variationIndex" EvaluationDetail Value
detail
                                , $sel:reason:FlagState :: Maybe EvaluationReason
reason = if Bool
omitDetails Bool -> Bool -> Bool
|| ((Bool -> Bool
not Bool
with_reasons) Bool -> Bool -> Bool
&& (Bool -> Bool
not Bool
trackReason')) then forall a. Maybe a
Nothing else forall a. a -> Maybe a
Just EvaluationReason
reason'
                                , $sel:trackEvents:FlagState :: Bool
trackEvents = Bool
trackEvents' Bool -> Bool -> Bool
|| Bool
inExperiment
                                , $sel:trackReason:FlagState :: Bool
trackReason = Bool
trackReason'
                                , $sel:debugEventsUntilDate:FlagState :: Maybe Natural
debugEventsUntilDate = forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"debugEventsUntilDate" Flag
flag
                                }
                        )
                        KeyMap (Flag, EvaluationDetail Value)
details
            forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ AllFlagsState {$sel:evaluations:AllFlagsState :: KeyMap Value
evaluations = KeyMap Value
evaluations, $sel:state:AllFlagsState :: KeyMap FlagState
state = KeyMap FlagState
state, $sel:valid:AllFlagsState :: Bool
valid = Bool
True}

-- | Identify reports details about a context.
identify :: Client -> Context -> IO ()
identify :: Client -> Context -> IO ()
identify Client
client (Invalid Text
err) = Client -> LoggingT IO () -> IO ()
clientRunLogger Client
client forall a b. (a -> b) -> a -> b
$ $(logWarn) forall a b. (a -> b) -> a -> b
$ Text
"identify called with an invalid context: " forall a. Semigroup a => a -> a -> a
<> Text
err
identify Client
client Context
context = case (Text -> Context -> Value
getValue Text
"key" Context
context) of
    (String Text
"") -> Client -> LoggingT IO () -> IO ()
clientRunLogger Client
client forall a b. (a -> b) -> a -> b
$ $(logWarn) Text
"identify called with empty key"
    Value
_ -> do
        let redacted :: Value
redacted = Config -> Context -> Value
redactContext (forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"config" Client
client) Context
context
        BaseEvent IdentifyEvent
x <- forall a. a -> IO (BaseEvent a)
makeBaseEvent forall a b. (a -> b) -> a -> b
$ IdentifyEvent {$sel:key:IdentifyEvent :: Text
key = Context -> Text
getKey Context
context, $sel:context:IdentifyEvent :: Value
context = Value
redacted}
        Bool
_ <- EventState -> Context -> IO Bool
noticeContext (forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"events" Client
client) Context
context
        Config -> EventState -> EventType -> IO ()
queueEvent (forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"config" Client
client) (forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"events" Client
client) (BaseEvent IdentifyEvent -> EventType
EventTypeIdentify BaseEvent IdentifyEvent
x)

-- |
-- Track reports that a context has performed an event. Custom data can be
-- attached to the event, and / or a numeric value.
--
-- The numeric value is used by the LaunchDarkly experimentation feature in
-- numeric custom metrics, and will also be returned as part of the custom
-- event for Data Export.
track :: Client -> Context -> Text -> Maybe Value -> Maybe Double -> IO ()
track :: Client -> Context -> Text -> Maybe Value -> Maybe Double -> IO ()
track Client
client (Invalid Text
err) Text
_ Maybe Value
_ Maybe Double
_ = Client -> LoggingT IO () -> IO ()
clientRunLogger Client
client forall a b. (a -> b) -> a -> b
$ $(logWarn) forall a b. (a -> b) -> a -> b
$ Text
"track called with invalid context: " forall a. Semigroup a => a -> a -> a
<> Text
err
track Client
client Context
context Text
key Maybe Value
value Maybe Double
metric = do
    BaseEvent CustomEvent
x <-
        forall a. a -> IO (BaseEvent a)
makeBaseEvent forall a b. (a -> b) -> a -> b
$
            CustomEvent
                { $sel:key:CustomEvent :: Text
key = Text
key
                , $sel:contextKeys:CustomEvent :: KeyMap Text
contextKeys = Context -> KeyMap Text
getKeys Context
context
                , $sel:metricValue:CustomEvent :: Maybe Double
metricValue = Maybe Double
metric
                , $sel:value:CustomEvent :: Maybe Value
value = Maybe Value
value
                }
    let config :: Config
config = (forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"config" Client
client)
        events :: EventState
events = (forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"events" Client
client)
    Config -> EventState -> EventType -> IO ()
queueEvent Config
config EventState
events (BaseEvent CustomEvent -> EventType
EventTypeCustom BaseEvent CustomEvent
x)
    IO Natural
unixMilliseconds forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Natural
now -> Natural -> Config -> Context -> EventState -> IO ()
maybeIndexContext Natural
now Config
config Context
context EventState
events

-- |
-- Generates the secure mode hash value for a context.
--
-- For more information, see the Reference Guide:
-- <https://docs.launchdarkly.com/sdk/features/secure-mode#haskell>.
secureModeHash :: Client -> Context -> Text
secureModeHash :: Client -> Context -> Text
secureModeHash Client
client Context
context =
    let config :: Config
config = forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"config" Client
client
        sdkKey :: Text
sdkKey = forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"key" Config
config
     in ByteString -> Text
decodeUtf8 forall a b. (a -> b) -> a -> b
$ forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
Base -> bin -> bout
convertToBase Base
Base16 forall a b. (a -> b) -> a -> b
$ (ByteString -> ByteString)
-> Int -> ByteString -> ByteString -> ByteString
hmac ByteString -> ByteString
hash Int
64 (Text -> ByteString
encodeUtf8 Text
sdkKey) (Text -> ByteString
encodeUtf8 forall a b. (a -> b) -> a -> b
$ Context -> Text
getCanonicalKey Context
context)

-- |
-- Flush tells the client that all pending analytics events (if any) should
-- be delivered as soon as possible. Flushing is asynchronous, so this method
-- will return before it is complete.
flushEvents :: Client -> IO ()
flushEvents :: Client -> IO ()
flushEvents Client
client = forall a. MVar a -> a -> IO ()
putMVar (forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"flush" forall a b. (a -> b) -> a -> b
$ forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"events" Client
client) ()

-- |
-- Close shuts down the LaunchDarkly client. After calling this, the
-- LaunchDarkly client should no longer be used. The method will block until
-- all pending analytics events have been sent.
close :: Client -> IO ()
close :: Client -> IO ()
close Client
client = Client -> LoggingT IO () -> IO ()
clientRunLogger Client
client forall a b. (a -> b) -> a -> b
$ do
    $(logDebug) Text
"Setting client status to ShuttingDown"
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. IORef a -> a -> IO ()
writeIORef (forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"status" Client
client) Status
ShuttingDown
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ DataSource -> IO ()
dataSourceStop forall a b. (a -> b) -> a -> b
$ forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"dataSource" Client
client
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"eventThreadPair" Client
client) forall a b. (a -> b) -> a -> b
$ \(ThreadId
_, MVar ()
sync) -> do
        $(logDebug) Text
"Triggering event flush"
        forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Client -> IO ()
flushEvents Client
client
        $(logDebug) Text
"Waiting on event thread to die"
        forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall a. MVar a -> IO a
takeMVar MVar ()
sync
    $(logDebug) Text
"Client background resources destroyed"

type ValueConverter a = (a -> Value, Value -> Maybe a)

reorderStuff :: ValueConverter a -> Bool -> Client -> Text -> Context -> a -> IO (EvaluationDetail a)
reorderStuff :: forall a.
ValueConverter a
-> Bool
-> Client
-> Text
-> Context
-> a
-> IO (EvaluationDetail a)
reorderStuff ValueConverter a
converter Bool
includeReason Client
client Text
key Context
context a
fallback = forall a.
Client
-> Text
-> Context
-> a
-> (a -> Value)
-> Bool
-> (Value -> Maybe a)
-> IO (EvaluationDetail a)
evaluateTyped Client
client Text
key Context
context a
fallback (forall a b. (a, b) -> a
fst ValueConverter a
converter) Bool
includeReason (forall a b. (a, b) -> b
snd ValueConverter a
converter)

dropReason :: (Text -> Context -> a -> IO (EvaluationDetail a)) -> Text -> Context -> a -> IO a
dropReason :: forall a.
(Text -> Context -> a -> IO (EvaluationDetail a))
-> Text -> Context -> a -> IO a
dropReason = (((forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"value") forall b c a. (b -> c) -> (a -> b) -> a -> c
.) forall b c a. (b -> c) -> (a -> b) -> a -> c
.) forall b c a. (b -> c) -> (a -> b) -> a -> c
.)

boolConverter :: ValueConverter Bool
boolConverter :: ValueConverter Bool
boolConverter = (,) Bool -> Value
Bool forall a b. (a -> b) -> a -> b
$ \case Bool Bool
x -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
x; Value
_ -> forall a. Maybe a
Nothing

stringConverter :: ValueConverter Text
stringConverter :: ValueConverter Text
stringConverter = (,) Text -> Value
String forall a b. (a -> b) -> a -> b
$ \case String Text
x -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
x; Value
_ -> forall a. Maybe a
Nothing

intConverter :: ValueConverter Int
intConverter :: ValueConverter Int
intConverter = (,) (Scientific -> Value
Number forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral) forall a b. (a -> b) -> a -> b
$ \case Number Scientific
x -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. (RealFrac a, Integral b) => a -> b
truncate Scientific
x; Value
_ -> forall a. Maybe a
Nothing

doubleConverter :: ValueConverter Double
doubleConverter :: ValueConverter Double
doubleConverter = (,) (Scientific -> Value
Number forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. RealFloat a => a -> Scientific
fromFloatDigits) forall a b. (a -> b) -> a -> b
$ \case Number Scientific
x -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. RealFloat a => Scientific -> a
toRealFloat Scientific
x; Value
_ -> forall a. Maybe a
Nothing

jsonConverter :: ValueConverter Value
jsonConverter :: ValueConverter Value
jsonConverter = (,) forall a. a -> a
id forall (f :: * -> *) a. Applicative f => a -> f a
pure

-- | Evaluate a Boolean typed flag.
boolVariation :: Client -> Text -> Context -> Bool -> IO Bool
boolVariation :: Client -> Text -> Context -> Bool -> IO Bool
boolVariation = forall a.
(Text -> Context -> a -> IO (EvaluationDetail a))
-> Text -> Context -> a -> IO a
dropReason forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a.
ValueConverter a
-> Bool
-> Client
-> Text
-> Context
-> a
-> IO (EvaluationDetail a)
reorderStuff ValueConverter Bool
boolConverter Bool
False

-- | Evaluate a Boolean typed flag, and return an explanation.
boolVariationDetail :: Client -> Text -> Context -> Bool -> IO (EvaluationDetail Bool)
boolVariationDetail :: Client -> Text -> Context -> Bool -> IO (EvaluationDetail Bool)
boolVariationDetail = forall a.
ValueConverter a
-> Bool
-> Client
-> Text
-> Context
-> a
-> IO (EvaluationDetail a)
reorderStuff ValueConverter Bool
boolConverter Bool
True

-- | Evaluate a String typed flag.
stringVariation :: Client -> Text -> Context -> Text -> IO Text
stringVariation :: Client -> Text -> Context -> Text -> IO Text
stringVariation = forall a.
(Text -> Context -> a -> IO (EvaluationDetail a))
-> Text -> Context -> a -> IO a
dropReason forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a.
ValueConverter a
-> Bool
-> Client
-> Text
-> Context
-> a
-> IO (EvaluationDetail a)
reorderStuff ValueConverter Text
stringConverter Bool
False

-- | Evaluate a String typed flag, and return an explanation.
stringVariationDetail :: Client -> Text -> Context -> Text -> IO (EvaluationDetail Text)
stringVariationDetail :: Client -> Text -> Context -> Text -> IO (EvaluationDetail Text)
stringVariationDetail = forall a.
ValueConverter a
-> Bool
-> Client
-> Text
-> Context
-> a
-> IO (EvaluationDetail a)
reorderStuff ValueConverter Text
stringConverter Bool
True

-- | Evaluate a Number typed flag, and truncate the result.
intVariation :: Client -> Text -> Context -> Int -> IO Int
intVariation :: Client -> Text -> Context -> Int -> IO Int
intVariation = forall a.
(Text -> Context -> a -> IO (EvaluationDetail a))
-> Text -> Context -> a -> IO a
dropReason forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a.
ValueConverter a
-> Bool
-> Client
-> Text
-> Context
-> a
-> IO (EvaluationDetail a)
reorderStuff ValueConverter Int
intConverter Bool
False

-- |
-- Evaluate a Number typed flag, truncate the result, and return an
-- explanation.
intVariationDetail :: Client -> Text -> Context -> Int -> IO (EvaluationDetail Int)
intVariationDetail :: Client -> Text -> Context -> Int -> IO (EvaluationDetail Int)
intVariationDetail = forall a.
ValueConverter a
-> Bool
-> Client
-> Text
-> Context
-> a
-> IO (EvaluationDetail a)
reorderStuff ValueConverter Int
intConverter Bool
True

-- | Evaluate a Number typed flag.
doubleVariation :: Client -> Text -> Context -> Double -> IO Double
doubleVariation :: Client -> Text -> Context -> Double -> IO Double
doubleVariation = forall a.
(Text -> Context -> a -> IO (EvaluationDetail a))
-> Text -> Context -> a -> IO a
dropReason forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a.
ValueConverter a
-> Bool
-> Client
-> Text
-> Context
-> a
-> IO (EvaluationDetail a)
reorderStuff ValueConverter Double
doubleConverter Bool
False

-- | Evaluate a Number typed flag, and return an explanation.
doubleVariationDetail :: Client -> Text -> Context -> Double -> IO (EvaluationDetail Double)
doubleVariationDetail :: Client -> Text -> Context -> Double -> IO (EvaluationDetail Double)
doubleVariationDetail = forall a.
ValueConverter a
-> Bool
-> Client
-> Text
-> Context
-> a
-> IO (EvaluationDetail a)
reorderStuff ValueConverter Double
doubleConverter Bool
True

-- | Evaluate a JSON typed flag.
jsonVariation :: Client -> Text -> Context -> Value -> IO Value
jsonVariation :: Client -> Text -> Context -> Value -> IO Value
jsonVariation = forall a.
(Text -> Context -> a -> IO (EvaluationDetail a))
-> Text -> Context -> a -> IO a
dropReason forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a.
ValueConverter a
-> Bool
-> Client
-> Text
-> Context
-> a
-> IO (EvaluationDetail a)
reorderStuff ValueConverter Value
jsonConverter Bool
False

-- | Evaluate a JSON typed flag, and return an explanation.
jsonVariationDetail :: Client -> Text -> Context -> Value -> IO (EvaluationDetail Value)
jsonVariationDetail :: Client -> Text -> Context -> Value -> IO (EvaluationDetail Value)
jsonVariationDetail = forall a.
ValueConverter a
-> Bool
-> Client
-> Text
-> Context
-> a
-> IO (EvaluationDetail a)
reorderStuff ValueConverter Value
jsonConverter Bool
True