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)
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)
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 <- 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) (\Either SomeException ()
_ -> 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
$(Int
String
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 ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
id :: forall a. a -> a
logDebug) Text
"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
$(Int
String
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 ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
id :: forall a. a -> a
logDebug) Text
"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{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 defaultRequestHeaders :: [(HeaderName, ByteString)]
defaultRequestHeaders = [ (HeaderName
"Authorization", Text -> ByteString
encodeUtf8 (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ ConfigI -> Text
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"key" ConfigI
config)
, (HeaderName
"User-Agent" , ByteString
"HaskellServerClient/" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Text -> ByteString
encodeUtf8 Text
clientVersion)
]
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
$ ConfigI -> Natural
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"requestTimeoutSeconds" ConfigI
config Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
* Natural
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
$ HttpConfiguration :: [(HeaderName, ByteString)]
-> ResponseTimeout -> Manager -> HttpConfiguration
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
..}
makeClientContext :: ConfigI -> IO ClientContext
makeClientContext :: ConfigI -> IO ClientContext
makeClientContext ConfigI
config = do
let runLogger :: LoggingT IO () -> IO ()
runLogger = ConfigI -> LoggingT IO () -> IO ()
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"logger" ConfigI
config
HttpConfiguration
httpConfiguration <- ConfigI -> IO HttpConfiguration
makeHttpConfiguration ConfigI
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
$ ClientContext :: (LoggingT IO () -> IO ()) -> HttpConfiguration -> ClientContext
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) = (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 ClientI
client) -> do
IORef Status
status <- Status -> IO (IORef Status)
forall a. a -> IO (IORef a)
newIORef Status
Uninitialized
StoreHandle IO
store <- Maybe StoreInterface -> TimeSpec -> IO (StoreHandle IO)
makeStoreIO (ConfigI -> Maybe StoreInterface
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"storeBackend" ConfigI
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
$ ConfigI -> Natural
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"storeTTLSeconds" ConfigI
config) Int64
0)
Manager
manager <- case ConfigI -> Maybe Manager
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"manager" ConfigI
config of
Just Manager
manager -> Manager -> IO 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 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 -> ClientI -> LoggingT IO ()
forall (m :: * -> *).
(MonadIO m, MonadLogger m, MonadMask m) =>
Manager -> ClientI -> m ()
eventThread Manager
manager ClientI
client) (\Either SomeException ()
_ -> 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
$ ClientI -> Client
Client (ClientI -> Client) -> ClientI -> Client
forall a b. (a -> b) -> a -> b
$ ClientI :: ConfigI
-> StoreHandle IO
-> IORef Status
-> EventState
-> Maybe (ThreadId, MVar ())
-> DataSource
-> ClientI
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 ConfigI -> Bool
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"offline" ConfigI
config Bool -> Bool -> Bool
|| ConfigI -> Bool
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"useLdd" ConfigI
config then
DataSourceFactory
nullDataSourceFactory
else
case ConfigI -> Maybe DataSourceFactory
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 ConfigI -> Bool
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"streaming" ConfigI
config then
Text -> ClientContext -> DataSourceUpdates -> LoggingT IO ()
forall (m :: * -> *).
(MonadIO m, MonadLogger m, MonadMask m) =>
Text -> ClientContext -> DataSourceUpdates -> m ()
streamingThread (ConfigI -> Text
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"streamURI" ConfigI
config)
else
Text
-> Natural -> ClientContext -> DataSourceUpdates -> LoggingT IO ()
forall (m :: * -> *).
(MonadIO m, MonadLogger m, MonadMask m) =>
Text -> Natural -> ClientContext -> DataSourceUpdates -> m ()
pollingThread (ConfigI -> Text
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"baseURI" ConfigI
config) (ConfigI -> Natural
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 a s. HasField' "logger" s a => s -> a
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"logger" (ConfigI -> LoggingT IO () -> IO ())
-> ConfigI -> LoggingT IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ ClientI -> ConfigI
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
_ -> String -> KeyMap 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
(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 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 -> KeyMap v -> KeyMap v
insertKey Text
"$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 -> KeyMap v -> KeyMap v
insertKey Text
"$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 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)
[ Key
"version" Key -> Maybe Natural -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= FlagState -> Maybe Natural
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"version" FlagState
state
, Key
"variation" Key -> Maybe Integer -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= FlagState -> Maybe Integer
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"variation" FlagState
state
, Key
"trackEvents" Key -> Maybe Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> 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
, Key
"trackReason" Key -> Maybe Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> 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
, Key
"reason" Key -> Maybe EvaluationReason -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= FlagState -> Maybe EvaluationReason
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"reason" FlagState
state
, Key
"debugEventsUntilDate" Key -> Maybe Natural -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= FlagState -> Maybe Natural
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 <- 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
$ ClientI -> StoreHandle IO
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"store" ClientI
client
case Either Text (KeyMap Flag)
status of
Left Text
_ -> AllFlagsState -> IO AllFlagsState
forall (f :: * -> *) a. Applicative f => a -> f a
pure AllFlagsState :: 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 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) -> 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 <- (Flag -> IO (Flag, EvaluationDetail Value))
-> KeyMap Flag -> IO (KeyMap (Flag, EvaluationDetail Value))
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, (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
-> UserI
-> StoreHandle IO
-> IO (EvaluationDetail Value, [EvalEvent])
forall (m :: * -> *) store.
(Monad m, LaunchDarklyStoreRead store m) =>
Flag -> UserI -> store -> m (EvaluationDetail Value, [EvalEvent])
evaluateDetail Flag
flag UserI
user (StoreHandle IO -> IO (EvaluationDetail Value, [EvalEvent]))
-> StoreHandle IO -> IO (EvaluationDetail Value, [EvalEvent])
forall a b. (a -> b) -> a -> b
$ ClientI -> StoreHandle IO
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"store" ClientI
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)
-> KeyMap (Flag, EvaluationDetail Value) -> KeyMap Value
forall v1 v2. (v1 -> v2) -> KeyMap v1 -> KeyMap 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) KeyMap (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)
-> KeyMap (Flag, EvaluationDetail Value) -> KeyMap FlagState
forall v1 v2. (v1 -> v2) -> KeyMap v1 -> KeyMap v2
mapValues (\(Flag
flag, 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 Natural
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))
FlagState :: 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
}) KeyMap (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
$ AllFlagsState :: 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 }
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 <- 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
$ ClientI -> StoreHandle IO
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"store" ClientI
client
case Either Text (KeyMap Flag)
status of
Left Text
_ -> KeyMap Value -> IO (KeyMap Value)
forall (f :: * -> *) a. Applicative f => a -> f a
pure KeyMap Value
forall v. KeyMap v
emptyObject
Right KeyMap Flag
flags -> do
KeyMap (EvaluationDetail Value, [EvalEvent])
evals <- (Flag -> IO (EvaluationDetail Value, [EvalEvent]))
-> KeyMap Flag -> IO (KeyMap (EvaluationDetail Value, [EvalEvent]))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\Flag
flag -> Flag
-> UserI
-> StoreHandle IO
-> IO (EvaluationDetail Value, [EvalEvent])
forall (m :: * -> *) store.
(Monad m, LaunchDarklyStoreRead store m) =>
Flag -> UserI -> store -> m (EvaluationDetail Value, [EvalEvent])
evaluateDetail Flag
flag UserI
user (StoreHandle IO -> IO (EvaluationDetail Value, [EvalEvent]))
-> StoreHandle IO -> IO (EvaluationDetail Value, [EvalEvent])
forall a b. (a -> b) -> a -> b
$ ClientI -> StoreHandle IO
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"store" ClientI
client) KeyMap Flag
flags
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
$ ((EvaluationDetail Value, [EvalEvent]) -> Value)
-> KeyMap (EvaluationDetail Value, [EvalEvent]) -> KeyMap Value
forall v1 v2. (v1 -> v2) -> KeyMap v1 -> KeyMap 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)
-> ((EvaluationDetail Value, [EvalEvent])
-> EvaluationDetail Value)
-> (EvaluationDetail Value, [EvalEvent])
-> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (EvaluationDetail Value, [EvalEvent]) -> EvaluationDetail Value
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 (UserI -> Text
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"key" UserI
user) = ClientI -> LoggingT IO () -> IO ()
clientRunLogger ClientI
client (LoggingT IO () -> IO ()) -> LoggingT IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ $(Int
String
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 ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
id :: forall a. a -> a
logWarn) Text
"identify called with empty user key!"
| Bool
otherwise = do
let user' :: Value
user' = ConfigI -> UserI -> Value
userSerializeRedacted (ClientI -> ConfigI
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"config" ClientI
client) UserI
user
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
$ IdentifyEvent :: Text -> Value -> IdentifyEvent
IdentifyEvent { $sel:key:IdentifyEvent :: Text
key = UserI -> Text
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 (ClientI -> EventState
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"events" ClientI
client) UserI
user
ConfigI -> EventState -> EventType -> IO ()
queueEvent (ClientI -> ConfigI
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"config" ClientI
client) (ClientI -> EventState
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 <- 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
$ ConfigI -> UserI -> CustomEvent -> CustomEvent
forall r.
(HasField' "user" r (Maybe Value),
HasField' "userKey" r (Maybe Text)) =>
ConfigI -> UserI -> r -> r
addUserToEvent (ClientI -> ConfigI
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"config" ClientI
client) UserI
user CustomEvent :: Text
-> Maybe Value
-> Maybe Text
-> Maybe Double
-> Maybe Value
-> ContextKind
-> CustomEvent
CustomEvent
{ $sel:key:CustomEvent :: Text
key = Text
key
, $sel:user:CustomEvent :: Maybe Value
user = Maybe Value
forall a. Maybe a
Nothing
, $sel:userKey:CustomEvent :: Maybe Text
userKey = Maybe Text
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 = (ClientI -> ConfigI
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"config" ClientI
client)
events :: EventState
events = (ClientI -> EventState
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)
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ConfigI -> Bool
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"inlineUsersInEvents" ConfigI
config) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
IO Natural
unixMilliseconds IO Natural -> (Natural -> IO ()) -> IO ()
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 <- AliasEvent -> IO (BaseEvent AliasEvent)
forall a. a -> IO (BaseEvent a)
makeBaseEvent (AliasEvent -> IO (BaseEvent AliasEvent))
-> AliasEvent -> IO (BaseEvent AliasEvent)
forall a b. (a -> b) -> a -> b
$ AliasEvent :: Text -> ContextKind -> Text -> ContextKind -> AliasEvent
AliasEvent
{ $sel:key:AliasEvent :: Text
key = UserI -> Text
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 = UserI -> Text
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 (ClientI -> ConfigI
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"config" ClientI
client) (ClientI -> EventState
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) = 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
$ ClientI -> EventState
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 (LoggingT IO () -> IO ()) -> LoggingT IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
$(Int
String
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 ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
id :: forall a. a -> a
logDebug) Text
"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 (ClientI -> IORef Status
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"status" ClientI
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
$ ClientI -> DataSource
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"dataSource" ClientI
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_ (ClientI -> Maybe (ThreadId, MVar ())
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"eventThreadPair" ClientI
client) (((ThreadId, MVar ()) -> LoggingT IO ()) -> LoggingT IO ())
-> ((ThreadId, MVar ()) -> LoggingT IO ()) -> LoggingT IO ()
forall a b. (a -> b) -> a -> b
$ \(ThreadId
_, MVar ()
sync) -> do
$(Int
String
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 ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
id :: forall a. a -> a
logDebug) Text
"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
outer
$(Int
String
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 ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
id :: forall a. a -> a
logDebug) Text
"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
$(Int
String
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 ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
id :: forall a. a -> a
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 :: 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 = ClientI
-> Text
-> UserI
-> a
-> (a -> Value)
-> Bool
-> (Value -> Maybe a)
-> IO (EvaluationDetail a)
forall a.
ClientI
-> Text
-> UserI
-> a
-> (a -> Value)
-> Bool
-> (Value -> Maybe a)
-> IO (EvaluationDetail a)
evaluateTyped ClientI
client Text
key UserI
user 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 -> User -> a -> IO (EvaluationDetail a)) -> Text -> User -> a -> IO a
dropReason :: (Text -> User -> a -> IO (EvaluationDetail a))
-> Text -> User -> 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)
-> (User -> a -> IO (EvaluationDetail a)) -> User -> a -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((User -> a -> IO (EvaluationDetail a)) -> User -> a -> IO a)
-> (Text -> User -> a -> IO (EvaluationDetail a))
-> Text
-> User
-> 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 Bool
x -> Bool -> Maybe Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
x; Value
_ -> 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 Text
x -> Text -> Maybe Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
x; Value
_ -> 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 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; Value
_ -> 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 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; Value
_ -> 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
boolVariation :: Client -> Text -> User -> Bool -> IO Bool
boolVariation :: Client -> Text -> User -> Bool -> IO Bool
boolVariation = (Text -> User -> Bool -> IO (EvaluationDetail Bool))
-> Text -> User -> Bool -> IO Bool
forall a.
(Text -> User -> a -> IO (EvaluationDetail a))
-> Text -> User -> a -> IO a
dropReason ((Text -> User -> Bool -> IO (EvaluationDetail Bool))
-> Text -> User -> Bool -> IO Bool)
-> (Client -> Text -> User -> Bool -> IO (EvaluationDetail Bool))
-> Client
-> Text
-> User
-> Bool
-> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValueConverter Bool
-> Bool
-> Client
-> Text
-> User
-> Bool
-> IO (EvaluationDetail Bool)
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 = ValueConverter Bool
-> Bool
-> Client
-> Text
-> User
-> Bool
-> IO (EvaluationDetail Bool)
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 = (Text -> User -> Text -> IO (EvaluationDetail Text))
-> Text -> User -> Text -> IO Text
forall a.
(Text -> User -> a -> IO (EvaluationDetail a))
-> Text -> User -> a -> IO a
dropReason ((Text -> User -> Text -> IO (EvaluationDetail Text))
-> Text -> User -> Text -> IO Text)
-> (Client -> Text -> User -> Text -> IO (EvaluationDetail Text))
-> Client
-> Text
-> User
-> Text
-> IO Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValueConverter Text
-> Bool
-> Client
-> Text
-> User
-> Text
-> IO (EvaluationDetail Text)
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 = ValueConverter Text
-> Bool
-> Client
-> Text
-> User
-> Text
-> IO (EvaluationDetail Text)
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 = (Text -> User -> Int -> IO (EvaluationDetail Int))
-> Text -> User -> Int -> IO Int
forall a.
(Text -> User -> a -> IO (EvaluationDetail a))
-> Text -> User -> a -> IO a
dropReason ((Text -> User -> Int -> IO (EvaluationDetail Int))
-> Text -> User -> Int -> IO Int)
-> (Client -> Text -> User -> Int -> IO (EvaluationDetail Int))
-> Client
-> Text
-> User
-> Int
-> IO Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValueConverter Int
-> Bool
-> Client
-> Text
-> User
-> Int
-> IO (EvaluationDetail Int)
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 = ValueConverter Int
-> Bool
-> Client
-> Text
-> User
-> Int
-> IO (EvaluationDetail Int)
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 = (Text -> User -> Double -> IO (EvaluationDetail Double))
-> Text -> User -> Double -> IO Double
forall a.
(Text -> User -> a -> IO (EvaluationDetail a))
-> Text -> User -> a -> IO a
dropReason ((Text -> User -> Double -> IO (EvaluationDetail Double))
-> Text -> User -> Double -> IO Double)
-> (Client
-> Text -> User -> Double -> IO (EvaluationDetail Double))
-> Client
-> Text
-> User
-> Double
-> IO Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValueConverter Double
-> Bool
-> Client
-> Text
-> User
-> Double
-> IO (EvaluationDetail Double)
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 = ValueConverter Double
-> Bool
-> Client
-> Text
-> User
-> Double
-> IO (EvaluationDetail Double)
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 = (Text -> User -> Value -> IO (EvaluationDetail Value))
-> Text -> User -> Value -> IO Value
forall a.
(Text -> User -> a -> IO (EvaluationDetail a))
-> Text -> User -> a -> IO a
dropReason ((Text -> User -> Value -> IO (EvaluationDetail Value))
-> Text -> User -> Value -> IO Value)
-> (Client -> Text -> User -> Value -> IO (EvaluationDetail Value))
-> Client
-> Text
-> User
-> Value
-> IO Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValueConverter Value
-> Bool
-> Client
-> Text
-> User
-> Value
-> IO (EvaluationDetail Value)
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 = ValueConverter Value
-> Bool
-> Client
-> Text
-> User
-> Value
-> IO (EvaluationDetail Value)
forall a.
ValueConverter a
-> Bool -> Client -> Text -> User -> a -> IO (EvaluationDetail a)
reorderStuff ValueConverter Value
jsonConverter Bool
True