module LaunchDarkly.Server.Client
( Client
, makeClient
, clientVersion
, boolVariation
, boolVariationDetail
, stringVariation
, stringVariationDetail
, intVariation
, intVariationDetail
, doubleVariation
, doubleVariationDetail
, jsonVariation
, jsonVariationDetail
, EvaluationDetail(..)
, EvaluationReason(..)
, EvalErrorKind(..)
, allFlags
, allFlagsState
, AllFlagsState
, close
, flushEvents
, identify
, track
, alias
, Status(..)
, getStatus
) where
import Control.Concurrent (forkFinally, killThread)
import Control.Concurrent.MVar (putMVar, takeMVar, newEmptyMVar)
import Control.Monad (void, forM_, unless)
import Control.Monad.IO.Class (liftIO)
import Control.Monad.Logger (LoggingT, logDebug, logWarn)
import Control.Monad.Fix (mfix)
import Data.IORef (newIORef, writeIORef, readIORef)
import Data.Maybe (fromMaybe)
import Data.Text (Text)
import qualified Data.Text as T
import Data.Text.Encoding (encodeUtf8)
import Data.Aeson (Value(..), toJSON, ToJSON, (.=), object)
import Data.Generics.Product (getField)
import Data.Scientific (toRealFloat, fromFloatDigits)
import qualified Network.HTTP.Client as Http
import GHC.Generics (Generic)
import GHC.Natural (Natural)
import Network.HTTP.Client (newManager)
import Network.HTTP.Client.TLS (tlsManagerSettings)
import System.Clock (TimeSpec(..))
import LaunchDarkly.Server.Client.Internal (Client(..), ClientI(..), getStatusI, clientVersion)
import LaunchDarkly.Server.Client.Status (Status(..))
import LaunchDarkly.Server.Config.ClientContext (ClientContext(..))
import LaunchDarkly.Server.Config.HttpConfiguration (HttpConfiguration(..))
import LaunchDarkly.Server.Config.Internal (ConfigI, Config(..), shouldSendEvents, getApplicationInfoHeader, ApplicationInfo)
import LaunchDarkly.Server.DataSource.Internal (DataSource(..), DataSourceFactory, DataSourceUpdates(..), defaultDataSourceUpdates, nullDataSourceFactory)
import LaunchDarkly.Server.Details (EvaluationDetail(..), EvaluationReason(..), EvalErrorKind(..))
import LaunchDarkly.Server.Evaluate (evaluateTyped, evaluateDetail)
import LaunchDarkly.Server.Events (IdentifyEvent(..), CustomEvent(..), AliasEvent(..), EventType(..), makeBaseEvent, queueEvent, makeEventState, addUserToEvent, userGetContextKind, maybeIndexUser, unixMilliseconds, noticeUser)
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 (makeStoreIO, getAllFlagsC)
import LaunchDarkly.Server.User.Internal (User(..), userSerializeRedacted)
import LaunchDarkly.AesonCompat (KeyMap, insertKey, emptyObject, mapValues, filterObject)
import Data.ByteString (ByteString)
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 :: ConfigI -> IO HttpConfiguration
makeHttpConfiguration :: ConfigI -> IO HttpConfiguration
makeHttpConfiguration ConfigI
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" ConfigI
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" ConfigI
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" ConfigI
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 :: ConfigI -> IO ClientContext
makeClientContext :: ConfigI -> IO ClientContext
makeClientContext ConfigI
config = do
let runLogger :: LoggingT IO () -> IO ()
runLogger = forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"logger" ConfigI
config
HttpConfiguration
httpConfiguration <- ConfigI -> IO HttpConfiguration
makeHttpConfiguration ConfigI
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 ()
..}
makeClient :: Config -> IO Client
makeClient :: Config -> IO Client
makeClient (Config ConfigI
config) = forall (m :: * -> *) a. MonadFix m => (a -> m a) -> m a
mfix forall a b. (a -> b) -> a -> b
$ \(Client ClientI
client) -> do
IORef Status
status <- forall a. a -> IO (IORef a)
newIORef Status
Uninitialized
StoreHandle IO
store <- Maybe StoreInterface -> TimeSpec -> IO (StoreHandle IO)
makeStoreIO (forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"storeBackend" ConfigI
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" ConfigI
config) Int64
0)
Manager
manager <- case forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"manager" ConfigI
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 <- ConfigI -> IO EventState
makeEventState ConfigI
config
ClientContext
clientContext <- ConfigI -> IO ClientContext
makeClientContext ConfigI
config
let dataSourceUpdates :: DataSourceUpdates
dataSourceUpdates = IORef Status -> StoreHandle IO -> DataSourceUpdates
defaultDataSourceUpdates IORef Status
status StoreHandle IO
store
DataSource
dataSource <- ConfigI -> DataSourceFactory
dataSourceFactory ConfigI
config ClientContext
clientContext DataSourceUpdates
dataSourceUpdates
Maybe (ThreadId, MVar ())
eventThreadPair <- if Bool -> Bool
not (ConfigI -> Bool
shouldSendEvents ConfigI
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 -> ClientI -> ClientContext -> m ()
eventThread Manager
manager ClientI
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
$ ClientI -> Client
Client forall a b. (a -> b) -> a -> b
$ ClientI{Maybe (ThreadId, MVar ())
IORef Status
StoreHandle IO
DataSource
ConfigI
EventState
$sel:dataSource:ClientI :: DataSource
$sel:eventThreadPair:ClientI :: Maybe (ThreadId, MVar ())
$sel:events:ClientI :: EventState
$sel:status:ClientI :: IORef Status
$sel:store:ClientI :: StoreHandle IO
$sel:config:ClientI :: ConfigI
eventThreadPair :: Maybe (ThreadId, MVar ())
dataSource :: DataSource
events :: EventState
store :: StoreHandle IO
status :: IORef Status
config :: ConfigI
..}
dataSourceFactory :: ConfigI -> DataSourceFactory
dataSourceFactory :: ConfigI -> DataSourceFactory
dataSourceFactory ConfigI
config =
if forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"offline" ConfigI
config Bool -> Bool -> Bool
|| forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"useLdd" ConfigI
config then
DataSourceFactory
nullDataSourceFactory
else
case forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"dataSourceFactory" ConfigI
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" ConfigI
config then
forall (m :: * -> *).
(MonadIO m, MonadLogger m, MonadMask m) =>
Text -> ClientContext -> DataSourceUpdates -> m ()
streamingThread (forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"streamURI" ConfigI
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" ConfigI
config) (forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"pollIntervalSeconds" ConfigI
config)
in (ClientContext -> DataSourceUpdates -> LoggingT IO ())
-> DataSourceFactory
networkDataSourceFactory ClientContext -> DataSourceUpdates -> LoggingT IO ()
dataSourceThread
clientRunLogger :: ClientI -> (LoggingT IO () -> IO ())
clientRunLogger :: ClientI -> LoggingT IO () -> IO ()
clientRunLogger ClientI
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" ClientI
client
getStatus :: Client -> IO Status
getStatus :: Client -> IO Status
getStatus (Client ClientI
client) = ClientI -> IO Status
getStatusI ClientI
client
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"
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
]
allFlagsState :: Client -> User -> Bool -> Bool -> Bool -> IO (AllFlagsState)
allFlagsState :: Client -> User -> Bool -> Bool -> Bool -> IO AllFlagsState
allFlagsState (Client ClientI
client) (User UserI
user) 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" ClientI
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 -> UserI -> store -> m (EvaluationDetail Value, [EvalEvent])
evaluateDetail Flag
flag UserI
user forall a b. (a -> b) -> a -> b
$ forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"store" ClientI
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 }
allFlags :: Client -> User -> IO (KeyMap Value)
allFlags :: Client -> User -> IO (KeyMap Value)
allFlags (Client ClientI
client) (User UserI
user) = 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" ClientI
client
case Either Text (KeyMap Flag)
status of
Left Text
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall v. KeyMap v
emptyObject
Right KeyMap Flag
flags -> do
KeyMap (EvaluationDetail Value, [EvalEvent])
evals <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\Flag
flag -> forall (m :: * -> *) store.
(Monad m, LaunchDarklyStoreRead store m) =>
Flag -> UserI -> store -> m (EvaluationDetail Value, [EvalEvent])
evaluateDetail Flag
flag UserI
user forall a b. (a -> b) -> a -> b
$ forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"store" ClientI
client) KeyMap Flag
flags
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) -> a
fst) KeyMap (EvaluationDetail Value, [EvalEvent])
evals
identify :: Client -> User -> IO ()
identify :: Client -> User -> IO ()
identify (Client ClientI
client) (User UserI
user)
| Text -> Bool
T.null (forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"key" UserI
user) = ClientI -> LoggingT IO () -> IO ()
clientRunLogger ClientI
client forall a b. (a -> b) -> a -> b
$ $(logWarn) Text
"identify called with empty user key!"
| Bool
otherwise = do
let user' :: Value
user' = ConfigI -> UserI -> Value
userSerializeRedacted (forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"config" ClientI
client) UserI
user
BaseEvent IdentifyEvent
x <- forall a. a -> IO (BaseEvent a)
makeBaseEvent forall a b. (a -> b) -> a -> b
$ IdentifyEvent { $sel:key:IdentifyEvent :: Text
key = forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"key" UserI
user, $sel:user:IdentifyEvent :: Value
user = Value
user' }
Bool
_ <- EventState -> UserI -> IO Bool
noticeUser (forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"events" ClientI
client) UserI
user
ConfigI -> EventState -> EventType -> IO ()
queueEvent (forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"config" ClientI
client) (forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"events" ClientI
client) (BaseEvent IdentifyEvent -> EventType
EventTypeIdentify BaseEvent IdentifyEvent
x)
track :: Client -> User -> Text -> Maybe Value -> Maybe Double -> IO ()
track :: Client -> User -> Text -> Maybe Value -> Maybe Double -> IO ()
track (Client ClientI
client) (User UserI
user) 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
$ forall r.
(HasField' "user" r (Maybe Value),
HasField' "userKey" r (Maybe Text)) =>
ConfigI -> UserI -> r -> r
addUserToEvent (forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"config" ClientI
client) UserI
user CustomEvent
{ $sel:key:CustomEvent :: Text
key = Text
key
, $sel:user:CustomEvent :: Maybe Value
user = forall a. Maybe a
Nothing
, $sel:userKey:CustomEvent :: Maybe Text
userKey = forall a. Maybe a
Nothing
, $sel:metricValue:CustomEvent :: Maybe Double
metricValue = Maybe Double
metric
, $sel:value:CustomEvent :: Maybe Value
value = Maybe Value
value
, $sel:contextKind:CustomEvent :: ContextKind
contextKind = UserI -> ContextKind
userGetContextKind UserI
user
}
let config :: ConfigI
config = (forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"config" ClientI
client)
events :: EventState
events = (forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"events" ClientI
client)
ConfigI -> EventState -> EventType -> IO ()
queueEvent ConfigI
config EventState
events (BaseEvent CustomEvent -> EventType
EventTypeCustom BaseEvent CustomEvent
x)
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"inlineUsersInEvents" ConfigI
config) forall a b. (a -> b) -> a -> b
$
IO Natural
unixMilliseconds forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Natural
now -> Natural -> ConfigI -> UserI -> EventState -> IO ()
maybeIndexUser Natural
now ConfigI
config UserI
user EventState
events
alias :: Client -> User -> User -> IO ()
alias :: Client -> User -> User -> IO ()
alias (Client ClientI
client) (User UserI
currentUser) (User UserI
previousUser) = do
BaseEvent AliasEvent
x <- forall a. a -> IO (BaseEvent a)
makeBaseEvent forall a b. (a -> b) -> a -> b
$ AliasEvent
{ $sel:key:AliasEvent :: Text
key = forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"key" UserI
currentUser
, $sel:contextKind:AliasEvent :: ContextKind
contextKind = UserI -> ContextKind
userGetContextKind UserI
currentUser
, $sel:previousKey:AliasEvent :: Text
previousKey = forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"key" UserI
previousUser
, $sel:previousContextKind:AliasEvent :: ContextKind
previousContextKind = UserI -> ContextKind
userGetContextKind UserI
previousUser
}
ConfigI -> EventState -> EventType -> IO ()
queueEvent (forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"config" ClientI
client) (forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"events" ClientI
client) (BaseEvent AliasEvent -> EventType
EventTypeAlias BaseEvent AliasEvent
x)
flushEvents :: Client -> IO ()
flushEvents :: Client -> IO ()
flushEvents (Client ClientI
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" ClientI
client) ()
close :: Client -> IO ()
close :: Client -> IO ()
close outer :: Client
outer@(Client ClientI
client) = ClientI -> LoggingT IO () -> IO ()
clientRunLogger ClientI
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" ClientI
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" ClientI
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" ClientI
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
outer
$(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 -> User -> a -> IO (EvaluationDetail a)
reorderStuff :: forall a.
ValueConverter a
-> Bool -> Client -> Text -> User -> a -> IO (EvaluationDetail a)
reorderStuff ValueConverter a
converter Bool
includeReason (Client ClientI
client) Text
key (User UserI
user) a
fallback = forall a.
ClientI
-> Text
-> UserI
-> a
-> (a -> Value)
-> Bool
-> (Value -> Maybe a)
-> IO (EvaluationDetail a)
evaluateTyped ClientI
client Text
key UserI
user 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 -> User -> a -> IO (EvaluationDetail a)) -> Text -> User -> a -> IO a
dropReason :: forall a.
(Text -> User -> a -> IO (EvaluationDetail a))
-> Text -> User -> 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
boolVariation :: Client -> Text -> User -> Bool -> IO Bool
boolVariation :: Client -> Text -> User -> Bool -> IO Bool
boolVariation = forall a.
(Text -> User -> a -> IO (EvaluationDetail a))
-> Text -> User -> a -> IO a
dropReason forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a.
ValueConverter a
-> Bool -> Client -> Text -> User -> a -> IO (EvaluationDetail a)
reorderStuff ValueConverter Bool
boolConverter Bool
False
boolVariationDetail :: Client -> Text -> User -> Bool -> IO (EvaluationDetail Bool)
boolVariationDetail :: Client -> Text -> User -> Bool -> IO (EvaluationDetail Bool)
boolVariationDetail = forall a.
ValueConverter a
-> Bool -> Client -> Text -> User -> a -> IO (EvaluationDetail a)
reorderStuff ValueConverter Bool
boolConverter Bool
True
stringVariation :: Client -> Text -> User -> Text -> IO Text
stringVariation :: Client -> Text -> User -> Text -> IO Text
stringVariation = forall a.
(Text -> User -> a -> IO (EvaluationDetail a))
-> Text -> User -> a -> IO a
dropReason forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a.
ValueConverter a
-> Bool -> Client -> Text -> User -> a -> IO (EvaluationDetail a)
reorderStuff ValueConverter Text
stringConverter Bool
False
stringVariationDetail :: Client -> Text -> User -> Text -> IO (EvaluationDetail Text)
stringVariationDetail :: Client -> Text -> User -> Text -> IO (EvaluationDetail Text)
stringVariationDetail = forall a.
ValueConverter a
-> Bool -> Client -> Text -> User -> a -> IO (EvaluationDetail a)
reorderStuff ValueConverter Text
stringConverter Bool
True
intVariation :: Client -> Text -> User -> Int -> IO Int
intVariation :: Client -> Text -> User -> Int -> IO Int
intVariation = forall a.
(Text -> User -> a -> IO (EvaluationDetail a))
-> Text -> User -> a -> IO a
dropReason forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a.
ValueConverter a
-> Bool -> Client -> Text -> User -> a -> IO (EvaluationDetail a)
reorderStuff ValueConverter Int
intConverter Bool
False
intVariationDetail :: Client -> Text -> User -> Int -> IO (EvaluationDetail Int)
intVariationDetail :: Client -> Text -> User -> Int -> IO (EvaluationDetail Int)
intVariationDetail = forall a.
ValueConverter a
-> Bool -> Client -> Text -> User -> a -> IO (EvaluationDetail a)
reorderStuff ValueConverter Int
intConverter Bool
True
doubleVariation :: Client -> Text -> User -> Double -> IO Double
doubleVariation :: Client -> Text -> User -> Double -> IO Double
doubleVariation = forall a.
(Text -> User -> a -> IO (EvaluationDetail a))
-> Text -> User -> a -> IO a
dropReason forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a.
ValueConverter a
-> Bool -> Client -> Text -> User -> a -> IO (EvaluationDetail a)
reorderStuff ValueConverter Double
doubleConverter Bool
False
doubleVariationDetail :: Client -> Text -> User -> Double -> IO (EvaluationDetail Double)
doubleVariationDetail :: Client -> Text -> User -> Double -> IO (EvaluationDetail Double)
doubleVariationDetail = forall a.
ValueConverter a
-> Bool -> Client -> Text -> User -> a -> IO (EvaluationDetail a)
reorderStuff ValueConverter Double
doubleConverter Bool
True
jsonVariation :: Client -> Text -> User -> Value -> IO Value
jsonVariation :: Client -> Text -> User -> Value -> IO Value
jsonVariation = forall a.
(Text -> User -> a -> IO (EvaluationDetail a))
-> Text -> User -> a -> IO a
dropReason forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a.
ValueConverter a
-> Bool -> Client -> Text -> User -> a -> IO (EvaluationDetail a)
reorderStuff ValueConverter Value
jsonConverter Bool
False
jsonVariationDetail :: Client -> Text -> User -> Value -> IO (EvaluationDetail Value)
jsonVariationDetail :: Client -> Text -> User -> Value -> IO (EvaluationDetail Value)
jsonVariationDetail = forall a.
ValueConverter a
-> Bool -> Client -> Text -> User -> a -> IO (EvaluationDetail a)
reorderStuff ValueConverter Value
jsonConverter Bool
True