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

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

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

        dataSourceStop :: IO ()
dataSourceStop = ClientContext -> LoggingT IO () -> IO ()
runLogger ClientContext
clientContext (LoggingT IO () -> IO ()) -> LoggingT IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
            $(LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc -> Text -> LogLevel -> Text -> LoggingT IO ()
(Text -> LoggingT IO ())
-> (Text -> Text) -> Text -> LoggingT IO ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
id :: forall a. a -> a
logDebug) "Killing download thread"
            IO () -> LoggingT IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> LoggingT IO ()) -> IO () -> LoggingT IO ()
forall a b. (a -> b) -> a -> b
$ ThreadId -> IO ()
killThread (ThreadId -> IO ()) -> IO ThreadId -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< MVar ThreadId -> IO ThreadId
forall a. MVar a -> IO a
takeMVar MVar ThreadId
thread
            $(LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc -> Text -> LogLevel -> Text -> LoggingT IO ()
(Text -> LoggingT IO ())
-> (Text -> Text) -> Text -> LoggingT IO ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
id :: forall a. a -> a
logDebug) "Waiting on download thread to die"
            IO () -> LoggingT IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> LoggingT IO ()) -> IO () -> LoggingT IO ()
forall a b. (a -> b) -> a -> b
$ IO () -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ MVar () -> IO ()
forall a. MVar a -> IO a
takeMVar MVar ()
sync

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

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

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

-- | Create a new instance of the LaunchDarkly client.
makeClient :: Config -> IO Client
makeClient :: Config -> IO Client
makeClient config :: Config
config = (Client -> IO Client) -> IO Client
forall (m :: * -> *) a. MonadFix m => (a -> m a) -> m a
mfix ((Client -> IO Client) -> IO Client)
-> (Client -> IO Client) -> IO Client
forall a b. (a -> b) -> a -> b
$ \client :: Client
client -> do
    IORef Status
status <- Status -> IO (IORef Status)
forall a. a -> IO (IORef a)
newIORef Status
Uninitialized
    StoreHandle IO
store <- Maybe PersistentDataStore -> TimeSpec -> IO (StoreHandle IO)
makeStoreIO (Config -> Maybe PersistentDataStore
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"storeBackend" Config
config) (Int64 -> Int64 -> TimeSpec
TimeSpec (Natural -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Natural -> Int64) -> Natural -> Int64
forall a b. (a -> b) -> a -> b
$ Config -> Natural
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"storeTTLSeconds" Config
config) 0)
    Manager
manager <- case Config -> Maybe Manager
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"manager" Config
config of
        Just manager :: Manager
manager -> Manager -> IO Manager
forall (f :: * -> *) a. Applicative f => a -> f a
pure Manager
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 Maybe (ThreadId, MVar ()) -> IO (Maybe (ThreadId, MVar ()))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (ThreadId, MVar ())
forall a. Maybe a
Nothing
            else do
                MVar ()
sync <- IO (MVar ())
forall a. IO (MVar a)
newEmptyMVar
                ThreadId
thread <- IO () -> (Either SomeException () -> IO ()) -> IO ThreadId
forall a. IO a -> (Either SomeException a -> IO ()) -> IO ThreadId
forkFinally (ClientContext -> LoggingT IO () -> IO ()
runLogger ClientContext
clientContext (LoggingT IO () -> IO ()) -> LoggingT IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Manager -> Client -> ClientContext -> LoggingT IO ()
forall (m :: * -> *).
(MonadIO m, MonadLogger m, MonadMask m) =>
Manager -> Client -> ClientContext -> m ()
eventThread Manager
manager Client
client ClientContext
clientContext) (\_ -> MVar () -> () -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar ()
sync ())
                Maybe (ThreadId, MVar ()) -> IO (Maybe (ThreadId, MVar ()))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (ThreadId, MVar ()) -> IO (Maybe (ThreadId, MVar ())))
-> Maybe (ThreadId, MVar ()) -> IO (Maybe (ThreadId, MVar ()))
forall a b. (a -> b) -> a -> b
$ (ThreadId, MVar ()) -> Maybe (ThreadId, MVar ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ThreadId
thread, MVar ()
sync)

    DataSource -> IO ()
dataSourceStart DataSource
dataSource

    Client -> IO Client
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Client -> IO Client) -> Client -> IO Client
forall a b. (a -> b) -> a -> b
$ $WClient :: Config
-> StoreHandle IO
-> IORef Status
-> EventState
-> Maybe (ThreadId, MVar ())
-> DataSource
-> Client
Client {..}

dataSourceFactory :: Config -> DataSourceFactory
dataSourceFactory :: Config -> DataSourceFactory
dataSourceFactory config :: Config
config =
    if Config -> Bool
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"offline" Config
config Bool -> Bool -> Bool
|| Config -> Bool
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"useLdd" Config
config
        then DataSourceFactory
nullDataSourceFactory
        else case Config -> Maybe DataSourceFactory
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"dataSourceFactory" Config
config of
            Just factory :: DataSourceFactory
factory ->
                DataSourceFactory
factory
            Nothing ->
                let dataSourceThread :: ClientContext -> DataSourceUpdates -> LoggingT IO ()
dataSourceThread =
                        if Config -> Bool
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"streaming" Config
config
                            then Text -> Int -> ClientContext -> DataSourceUpdates -> LoggingT IO ()
forall (m :: * -> *).
(MonadIO m, MonadLogger m, MonadMask m) =>
Text -> Int -> ClientContext -> DataSourceUpdates -> m ()
streamingThread (Config -> Text
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"streamURI" Config
config) (Config -> Int
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"initialRetryDelay" Config
config)
                            else Text
-> Natural -> ClientContext -> DataSourceUpdates -> LoggingT IO ()
forall (m :: * -> *).
(MonadIO m, MonadLogger m, MonadMask m) =>
Text -> Natural -> ClientContext -> DataSourceUpdates -> m ()
pollingThread (Config -> Text
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"baseURI" Config
config) (Config -> Natural
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
client = forall a s. HasField' "logger" s a => s -> a
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"logger" (Config -> LoggingT IO () -> IO ())
-> Config -> LoggingT IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Client -> Config
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 = 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 x :: Value
x = case Value
x of (Object o :: KeyMap Value
o) -> KeyMap Value
o; _ -> String -> KeyMap Value
forall a. HasCallStack => String -> a
error "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
(Int -> AllFlagsState -> ShowS)
-> (AllFlagsState -> String)
-> ([AllFlagsState] -> ShowS)
-> Show AllFlagsState
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. AllFlagsState -> Rep AllFlagsState x)
-> (forall x. Rep AllFlagsState x -> AllFlagsState)
-> Generic AllFlagsState
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 state :: AllFlagsState
state =
        KeyMap Value -> Value
Object (KeyMap Value -> Value) -> KeyMap Value -> Value
forall a b. (a -> b) -> a -> b
$
            Text -> Value -> KeyMap Value -> KeyMap Value
forall v. Text -> v -> HashMap Text v -> HashMap Text v
insertKey "$flagsState" (KeyMap FlagState -> Value
forall a. ToJSON a => a -> Value
toJSON (KeyMap FlagState -> Value) -> KeyMap FlagState -> Value
forall a b. (a -> b) -> a -> b
$ AllFlagsState -> KeyMap FlagState
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"state" AllFlagsState
state) (KeyMap Value -> KeyMap Value) -> KeyMap Value -> KeyMap Value
forall a b. (a -> b) -> a -> b
$
                Text -> Value -> KeyMap Value -> KeyMap Value
forall v. Text -> v -> HashMap Text v -> HashMap Text v
insertKey
                    "$valid"
                    (Bool -> Value
forall a. ToJSON a => a -> Value
toJSON (Bool -> Value) -> Bool -> Value
forall a b. (a -> b) -> a -> b
$ AllFlagsState -> Bool
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"valid" AllFlagsState
state)
                    (Value -> KeyMap Value
fromObject (Value -> KeyMap Value) -> Value -> KeyMap Value
forall a b. (a -> b) -> a -> b
$ KeyMap Value -> Value
forall a. ToJSON a => a -> Value
toJSON (KeyMap Value -> Value) -> KeyMap Value -> Value
forall a b. (a -> b) -> a -> b
$ AllFlagsState -> KeyMap Value
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
(Int -> FlagState -> ShowS)
-> (FlagState -> String)
-> ([FlagState] -> ShowS)
-> Show FlagState
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. FlagState -> Rep FlagState x)
-> (forall x. Rep FlagState x -> FlagState) -> Generic FlagState
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 state :: FlagState
state =
        [Pair] -> Value
object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$
            (Pair -> Bool) -> [Pair] -> [Pair]
forall a. (a -> Bool) -> [a] -> [a]
filter
                (Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
(/=) Value
Null (Value -> Bool) -> (Pair -> Value) -> Pair -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pair -> Value
forall a b. (a, b) -> b
snd)
                [ "version" Text -> Maybe Natural -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= FlagState -> Maybe Natural
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"version" FlagState
state
                , "variation" Text -> Maybe Integer -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= FlagState -> Maybe Integer
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"variation" FlagState
state
                , "trackEvents" Text -> Maybe Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= if FlagState -> Bool
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"trackEvents" FlagState
state then Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True else Maybe Bool
forall a. Maybe a
Nothing
                , "trackReason" Text -> Maybe Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= if FlagState -> Bool
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"trackReason" FlagState
state then Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True else Maybe Bool
forall a. Maybe a
Nothing
                , "reason" Text -> Maybe EvaluationReason -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= FlagState -> Maybe EvaluationReason
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"reason" FlagState
state
                , "debugEventsUntilDate" Text -> Maybe Natural -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= FlagState -> Maybe Natural
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
client context :: Context
context client_side_only :: Bool
client_side_only with_reasons :: Bool
with_reasons details_only_for_tracked_flags :: Bool
details_only_for_tracked_flags = do
    Either Text (KeyMap Flag)
status <- StoreHandle IO -> StoreResultM IO (KeyMap Flag)
forall store (m :: * -> *).
LaunchDarklyStoreRead store m =>
store -> StoreResultM m (KeyMap Flag)
getAllFlagsC (StoreHandle IO -> StoreResultM IO (KeyMap Flag))
-> StoreHandle IO -> StoreResultM IO (KeyMap Flag)
forall a b. (a -> b) -> a -> b
$ Client -> StoreHandle IO
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"store" Client
client
    case Either Text (KeyMap Flag)
status of
        Left _ -> AllFlagsState -> IO AllFlagsState
forall (f :: * -> *) a. Applicative f => a -> f a
pure $WAllFlagsState :: KeyMap Value -> KeyMap FlagState -> Bool -> AllFlagsState
AllFlagsState {$sel:evaluations:AllFlagsState :: KeyMap Value
evaluations = KeyMap Value
forall v. KeyMap v
emptyObject, $sel:state:AllFlagsState :: KeyMap FlagState
state = KeyMap FlagState
forall v. KeyMap v
emptyObject, $sel:valid:AllFlagsState :: Bool
valid = Bool
False}
        Right flags :: KeyMap Flag
flags -> do
            KeyMap Flag
filtered <- KeyMap Flag -> IO (KeyMap Flag)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (KeyMap Flag -> IO (KeyMap Flag))
-> KeyMap Flag -> IO (KeyMap Flag)
forall a b. (a -> b) -> a -> b
$ ((Flag -> Bool) -> KeyMap Flag -> KeyMap Flag
forall v. (v -> Bool) -> HashMap Text v -> HashMap Text v
filterObject (\flag :: Flag
flag -> (Bool -> Bool
not Bool
client_side_only) Bool -> Bool -> Bool
|| Flag -> Bool
isClientSideOnlyFlag Flag
flag) KeyMap Flag
flags)
            HashMap Text (Flag, EvaluationDetail Value)
details <- (Flag -> IO (Flag, EvaluationDetail Value))
-> KeyMap Flag -> IO (HashMap Text (Flag, EvaluationDetail Value))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\flag :: Flag
flag -> (\detail :: (EvaluationDetail Value, [EvalEvent])
detail -> (Flag
flag, (EvaluationDetail Value, [EvalEvent]) -> EvaluationDetail Value
forall a b. (a, b) -> a
fst (EvaluationDetail Value, [EvalEvent])
detail)) ((EvaluationDetail Value, [EvalEvent])
 -> (Flag, EvaluationDetail Value))
-> IO (EvaluationDetail Value, [EvalEvent])
-> IO (Flag, EvaluationDetail Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Flag
-> Context
-> HashSet Text
-> StoreHandle IO
-> IO (EvaluationDetail Value, [EvalEvent])
forall (m :: * -> *) store.
(Monad m, LaunchDarklyStoreRead store m) =>
Flag
-> Context
-> HashSet Text
-> store
-> m (EvaluationDetail Value, [EvalEvent])
evaluateDetail Flag
flag Context
context HashSet Text
forall a. HashSet a
HS.empty (StoreHandle IO -> IO (EvaluationDetail Value, [EvalEvent]))
-> StoreHandle IO -> IO (EvaluationDetail Value, [EvalEvent])
forall a b. (a -> b) -> a -> b
$ Client -> StoreHandle IO
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"store" Client
client)) KeyMap Flag
filtered
            KeyMap Value
evaluations <- KeyMap Value -> IO (KeyMap Value)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (KeyMap Value -> IO (KeyMap Value))
-> KeyMap Value -> IO (KeyMap Value)
forall a b. (a -> b) -> a -> b
$ ((Flag, EvaluationDetail Value) -> Value)
-> HashMap Text (Flag, EvaluationDetail Value) -> KeyMap Value
forall v1 v2. (v1 -> v2) -> HashMap Text v1 -> HashMap Text v2
mapValues (forall a s. HasField' "value" s a => s -> a
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"value" (EvaluationDetail Value -> Value)
-> ((Flag, EvaluationDetail Value) -> EvaluationDetail Value)
-> (Flag, EvaluationDetail Value)
-> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Flag, EvaluationDetail Value) -> EvaluationDetail Value
forall a b. (a, b) -> b
snd) HashMap Text (Flag, EvaluationDetail Value)
details
            Natural
now <- IO Natural
unixMilliseconds
            KeyMap FlagState
state <-
                KeyMap FlagState -> IO (KeyMap FlagState)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (KeyMap FlagState -> IO (KeyMap FlagState))
-> KeyMap FlagState -> IO (KeyMap FlagState)
forall a b. (a -> b) -> a -> b
$
                    ((Flag, EvaluationDetail Value) -> FlagState)
-> HashMap Text (Flag, EvaluationDetail Value) -> KeyMap FlagState
forall v1 v2. (v1 -> v2) -> HashMap Text v1 -> HashMap Text v2
mapValues
                        ( \(flag :: Flag
flag, detail :: EvaluationDetail Value
detail) -> do
                            let reason' :: EvaluationReason
reason' = EvaluationDetail Value -> EvaluationReason
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 Natural -> Natural -> Bool
forall a. Ord a => a -> a -> Bool
< Natural -> Maybe Natural -> Natural
forall a. a -> Maybe a -> a
fromMaybe 0 (Flag -> Maybe Natural
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"debugEventsUntilDate" Flag
flag)
                                trackReason' :: Bool
trackReason' = Bool
inExperiment
                                trackEvents' :: Bool
trackEvents' = Flag -> Bool
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))
                            $WFlagState :: Maybe Natural
-> Maybe Integer
-> Maybe EvaluationReason
-> Bool
-> Bool
-> Maybe Natural
-> FlagState
FlagState
                                { $sel:version:FlagState :: Maybe Natural
version = if Bool
omitDetails then Maybe Natural
forall a. Maybe a
Nothing else Natural -> Maybe Natural
forall a. a -> Maybe a
Just (Natural -> Maybe Natural) -> Natural -> Maybe Natural
forall a b. (a -> b) -> a -> b
$ Flag -> Natural
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"version" Flag
flag
                                , $sel:variation:FlagState :: Maybe Integer
variation = EvaluationDetail Value -> Maybe Integer
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 Maybe EvaluationReason
forall a. Maybe a
Nothing else EvaluationReason -> Maybe EvaluationReason
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 = Flag -> Maybe Natural
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"debugEventsUntilDate" Flag
flag
                                }
                        )
                        HashMap Text (Flag, EvaluationDetail Value)
details
            AllFlagsState -> IO AllFlagsState
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AllFlagsState -> IO AllFlagsState)
-> AllFlagsState -> IO AllFlagsState
forall a b. (a -> b) -> a -> b
$ $WAllFlagsState :: KeyMap Value -> KeyMap FlagState -> Bool -> AllFlagsState
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
client (Invalid err :: Text
err) = Client -> LoggingT IO () -> IO ()
clientRunLogger Client
client (LoggingT IO () -> IO ()) -> LoggingT IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ $(LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc -> Text -> LogLevel -> Text -> LoggingT IO ()
(Text -> LoggingT IO ())
-> (Text -> Text) -> Text -> LoggingT IO ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
id :: forall a. a -> a
logWarn) (Text -> LoggingT IO ()) -> Text -> LoggingT IO ()
forall a b. (a -> b) -> a -> b
$ "identify called with an invalid context: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
err
identify client :: Client
client context :: Context
context = case (Text -> Context -> Value
getValue "key" Context
context) of
    (String "") -> Client -> LoggingT IO () -> IO ()
clientRunLogger Client
client (LoggingT IO () -> IO ()) -> LoggingT IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ $(LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc -> Text -> LogLevel -> Text -> LoggingT IO ()
(Text -> LoggingT IO ())
-> (Text -> Text) -> Text -> LoggingT IO ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
id :: forall a. a -> a
logWarn) "identify called with empty key"
    _ -> do
        let redacted :: Value
redacted = Config -> Context -> Value
redactContext (Client -> Config
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"config" Client
client) Context
context
        BaseEvent IdentifyEvent
x <- IdentifyEvent -> IO (BaseEvent IdentifyEvent)
forall a. a -> IO (BaseEvent a)
makeBaseEvent (IdentifyEvent -> IO (BaseEvent IdentifyEvent))
-> IdentifyEvent -> IO (BaseEvent IdentifyEvent)
forall a b. (a -> b) -> a -> b
$ $WIdentifyEvent :: Text -> Value -> IdentifyEvent
IdentifyEvent {$sel:key:IdentifyEvent :: Text
key = Context -> Text
getKey Context
context, $sel:context:IdentifyEvent :: Value
context = Value
redacted}
        Bool
_ <- EventState -> Context -> IO Bool
noticeContext (Client -> EventState
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"events" Client
client) Context
context
        Config -> EventState -> EventType -> IO ()
queueEvent (Client -> Config
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"config" Client
client) (Client -> EventState
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
client (Invalid err :: Text
err) _ _ _ = Client -> LoggingT IO () -> IO ()
clientRunLogger Client
client (LoggingT IO () -> IO ()) -> LoggingT IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ $(LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc -> Text -> LogLevel -> Text -> LoggingT IO ()
(Text -> LoggingT IO ())
-> (Text -> Text) -> Text -> LoggingT IO ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
id :: forall a. a -> a
logWarn) (Text -> LoggingT IO ()) -> Text -> LoggingT IO ()
forall a b. (a -> b) -> a -> b
$ "track called with invalid context: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
err
track client :: Client
client context :: Context
context key :: Text
key value :: Maybe Value
value metric :: Maybe Double
metric = do
    BaseEvent CustomEvent
x <-
        CustomEvent -> IO (BaseEvent CustomEvent)
forall a. a -> IO (BaseEvent a)
makeBaseEvent (CustomEvent -> IO (BaseEvent CustomEvent))
-> CustomEvent -> IO (BaseEvent CustomEvent)
forall a b. (a -> b) -> a -> b
$
            $WCustomEvent :: Text -> KeyMap Text -> Maybe Double -> Maybe Value -> CustomEvent
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 = (Client -> Config
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"config" Client
client)
        events :: EventState
events = (Client -> EventState
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 IO Natural -> (Natural -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \now :: 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
client context :: Context
context =
    let config :: Config
config = Client -> Config
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"config" Client
client
        sdkKey :: Text
sdkKey = Config -> Text
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"key" Config
config
     in ByteString -> Text
decodeUtf8 (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ Base -> ByteString -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
Base -> bin -> bout
convertToBase Base
Base16 (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ (ByteString -> ByteString)
-> Int -> ByteString -> ByteString -> ByteString
hmac ByteString -> ByteString
hash 64 (Text -> ByteString
encodeUtf8 Text
sdkKey) (Text -> ByteString
encodeUtf8 (Text -> ByteString) -> Text -> ByteString
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
client = MVar () -> () -> IO ()
forall a. MVar a -> a -> IO ()
putMVar (forall a s. HasField' "flush" s a => s -> a
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"flush" (EventState -> MVar ()) -> EventState -> MVar ()
forall a b. (a -> b) -> a -> b
$ Client -> EventState
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 = Client -> LoggingT IO () -> IO ()
clientRunLogger Client
client (LoggingT IO () -> IO ()) -> LoggingT IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    $(LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc -> Text -> LogLevel -> Text -> LoggingT IO ()
(Text -> LoggingT IO ())
-> (Text -> Text) -> Text -> LoggingT IO ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
id :: forall a. a -> a
logDebug) "Setting client status to ShuttingDown"
    IO () -> LoggingT IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> LoggingT IO ()) -> IO () -> LoggingT IO ()
forall a b. (a -> b) -> a -> b
$ IORef Status -> Status -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (Client -> IORef Status
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"status" Client
client) Status
ShuttingDown
    IO () -> LoggingT IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> LoggingT IO ()) -> IO () -> LoggingT IO ()
forall a b. (a -> b) -> a -> b
$ DataSource -> IO ()
dataSourceStop (DataSource -> IO ()) -> DataSource -> IO ()
forall a b. (a -> b) -> a -> b
$ Client -> DataSource
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"dataSource" Client
client
    Maybe (ThreadId, MVar ())
-> ((ThreadId, MVar ()) -> LoggingT IO ()) -> LoggingT IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Client -> Maybe (ThreadId, MVar ())
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"eventThreadPair" Client
client) (((ThreadId, MVar ()) -> LoggingT IO ()) -> LoggingT IO ())
-> ((ThreadId, MVar ()) -> LoggingT IO ()) -> LoggingT IO ()
forall a b. (a -> b) -> a -> b
$ \(_, sync :: MVar ()
sync) -> do
        $(LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc -> Text -> LogLevel -> Text -> LoggingT IO ()
(Text -> LoggingT IO ())
-> (Text -> Text) -> Text -> LoggingT IO ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
id :: forall a. a -> a
logDebug) "Triggering event flush"
        IO () -> LoggingT IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> LoggingT IO ()) -> IO () -> LoggingT IO ()
forall a b. (a -> b) -> a -> b
$ Client -> IO ()
flushEvents Client
client
        $(LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc -> Text -> LogLevel -> Text -> LoggingT IO ()
(Text -> LoggingT IO ())
-> (Text -> Text) -> Text -> LoggingT IO ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
id :: forall a. a -> a
logDebug) "Waiting on event thread to die"
        IO () -> LoggingT IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> LoggingT IO ()) -> IO () -> LoggingT IO ()
forall a b. (a -> b) -> a -> b
$ IO () -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ MVar () -> IO ()
forall a. MVar a -> IO a
takeMVar MVar ()
sync
    $(LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc -> Text -> LogLevel -> Text -> LoggingT IO ()
(Text -> LoggingT IO ())
-> (Text -> Text) -> Text -> LoggingT IO ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
id :: forall a. a -> a
logDebug) "Client background resources destroyed"

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

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

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

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

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

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

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

jsonConverter :: ValueConverter Value
jsonConverter :: ValueConverter Value
jsonConverter = (,) Value -> Value
forall a. a -> a
id Value -> Maybe Value
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 = (Text -> Context -> Bool -> IO (EvaluationDetail Bool))
-> Text -> Context -> Bool -> IO Bool
forall a.
(Text -> Context -> a -> IO (EvaluationDetail a))
-> Text -> Context -> a -> IO a
dropReason ((Text -> Context -> Bool -> IO (EvaluationDetail Bool))
 -> Text -> Context -> Bool -> IO Bool)
-> (Client
    -> Text -> Context -> Bool -> IO (EvaluationDetail Bool))
-> Client
-> Text
-> Context
-> Bool
-> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValueConverter Bool
-> Bool
-> Client
-> Text
-> Context
-> Bool
-> IO (EvaluationDetail Bool)
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 = ValueConverter Bool
-> Bool
-> Client
-> Text
-> Context
-> Bool
-> IO (EvaluationDetail Bool)
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 = (Text -> Context -> Text -> IO (EvaluationDetail Text))
-> Text -> Context -> Text -> IO Text
forall a.
(Text -> Context -> a -> IO (EvaluationDetail a))
-> Text -> Context -> a -> IO a
dropReason ((Text -> Context -> Text -> IO (EvaluationDetail Text))
 -> Text -> Context -> Text -> IO Text)
-> (Client
    -> Text -> Context -> Text -> IO (EvaluationDetail Text))
-> Client
-> Text
-> Context
-> Text
-> IO Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValueConverter Text
-> Bool
-> Client
-> Text
-> Context
-> Text
-> IO (EvaluationDetail Text)
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 = ValueConverter Text
-> Bool
-> Client
-> Text
-> Context
-> Text
-> IO (EvaluationDetail Text)
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 = (Text -> Context -> Int -> IO (EvaluationDetail Int))
-> Text -> Context -> Int -> IO Int
forall a.
(Text -> Context -> a -> IO (EvaluationDetail a))
-> Text -> Context -> a -> IO a
dropReason ((Text -> Context -> Int -> IO (EvaluationDetail Int))
 -> Text -> Context -> Int -> IO Int)
-> (Client -> Text -> Context -> Int -> IO (EvaluationDetail Int))
-> Client
-> Text
-> Context
-> Int
-> IO Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValueConverter Int
-> Bool
-> Client
-> Text
-> Context
-> Int
-> IO (EvaluationDetail Int)
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 = ValueConverter Int
-> Bool
-> Client
-> Text
-> Context
-> Int
-> IO (EvaluationDetail Int)
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 = (Text -> Context -> Double -> IO (EvaluationDetail Double))
-> Text -> Context -> Double -> IO Double
forall a.
(Text -> Context -> a -> IO (EvaluationDetail a))
-> Text -> Context -> a -> IO a
dropReason ((Text -> Context -> Double -> IO (EvaluationDetail Double))
 -> Text -> Context -> Double -> IO Double)
-> (Client
    -> Text -> Context -> Double -> IO (EvaluationDetail Double))
-> Client
-> Text
-> Context
-> Double
-> IO Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValueConverter Double
-> Bool
-> Client
-> Text
-> Context
-> Double
-> IO (EvaluationDetail Double)
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 = ValueConverter Double
-> Bool
-> Client
-> Text
-> Context
-> Double
-> IO (EvaluationDetail Double)
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 = (Text -> Context -> Value -> IO (EvaluationDetail Value))
-> Text -> Context -> Value -> IO Value
forall a.
(Text -> Context -> a -> IO (EvaluationDetail a))
-> Text -> Context -> a -> IO a
dropReason ((Text -> Context -> Value -> IO (EvaluationDetail Value))
 -> Text -> Context -> Value -> IO Value)
-> (Client
    -> Text -> Context -> Value -> IO (EvaluationDetail Value))
-> Client
-> Text
-> Context
-> Value
-> IO Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValueConverter Value
-> Bool
-> Client
-> Text
-> Context
-> Value
-> IO (EvaluationDetail Value)
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 = ValueConverter Value
-> Bool
-> Client
-> Text
-> Context
-> Value
-> IO (EvaluationDetail Value)
forall a.
ValueConverter a
-> Bool
-> Client
-> Text
-> Context
-> a
-> IO (EvaluationDetail a)
reorderStuff ValueConverter Value
jsonConverter Bool
True