module LaunchDarkly.Server.Client
( Client
, makeClient
, clientVersion
, boolVariation
, boolVariationDetail
, stringVariation
, stringVariationDetail
, intVariation
, intVariationDetail
, doubleVariation
, doubleVariationDetail
, jsonVariation
, jsonVariationDetail
, EvaluationDetail(..)
, EvaluationReason(..)
, EvalErrorKind(..)
, allFlags
, 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_)
import Control.Monad.IO.Class (liftIO)
import Control.Monad.Logger (LoggingT, logDebug)
import Data.IORef (newIORef, writeIORef)
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HM
import Data.Text (Text)
import Data.Aeson (Value(..))
import Data.Generics.Product (getField, setField)
import Data.Scientific (toRealFloat, fromFloatDigits)
import Network.HTTP.Client (newManager)
import Network.HTTP.Client.TLS (tlsManagerSettings)
import System.Clock (TimeSpec(..))
import LaunchDarkly.Server.Config.Internal (Config(..), shouldSendEvents)
import LaunchDarkly.Server.Client.Internal
import LaunchDarkly.Server.User.Internal (User(..), userSerializeRedacted)
import LaunchDarkly.Server.Details (EvaluationDetail(..), EvaluationReason(..), EvalErrorKind(..))
import LaunchDarkly.Server.Events (IdentifyEvent(..), CustomEvent(..), AliasEvent(..), EventType(..), makeBaseEvent, queueEvent, makeEventState, addUserToEvent, userGetContextKind)
import LaunchDarkly.Server.Network.Eventing (eventThread)
import LaunchDarkly.Server.Network.Streaming (streamingThread)
import LaunchDarkly.Server.Network.Polling (pollingThread)
import LaunchDarkly.Server.Store.Internal (makeStoreIO, getAllFlagsC)
import LaunchDarkly.Server.Evaluate (evaluateTyped, evaluateDetail)
makeClient :: Config -> IO Client
makeClient :: Config -> IO Client
makeClient (Config 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
eventThreadPair :: Maybe a
eventThreadPair = Maybe a
forall a. Maybe a
Nothing
downloadThreadPair :: Maybe a
downloadThreadPair = Maybe a
forall a. Maybe a
Nothing
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 <- ManagerSettings -> IO Manager
newManager ManagerSettings
tlsManagerSettings
EventState
events <- ConfigI -> IO EventState
makeEventState ConfigI
config
let client :: ClientI
client = ClientI :: ConfigI
-> StoreHandle IO
-> IORef Status
-> EventState
-> Maybe (ThreadId, MVar ())
-> Maybe (ThreadId, MVar ())
-> ClientI
ClientI {Maybe (ThreadId, MVar ())
IORef Status
StoreHandle IO
ConfigI
EventState
forall a. Maybe a
$sel:eventThreadPair:ClientI :: Maybe (ThreadId, MVar ())
$sel:downloadThreadPair:ClientI :: Maybe (ThreadId, MVar ())
$sel:events:ClientI :: EventState
$sel:status:ClientI :: IORef Status
$sel:store:ClientI :: StoreHandle IO
$sel:config:ClientI :: ConfigI
events :: EventState
store :: StoreHandle IO
status :: IORef Status
downloadThreadPair :: forall a. Maybe a
eventThreadPair :: forall a. Maybe a
config :: ConfigI
..}
downloadThreadF :: Manager -> ClientI -> LoggingT IO ()
downloadThreadF = if ConfigI -> Bool
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"streaming" ConfigI
config then Manager -> ClientI -> LoggingT IO ()
forall (m :: * -> *).
(MonadIO m, MonadLogger m, MonadMask m) =>
Manager -> ClientI -> m ()
streamingThread else Manager -> ClientI -> LoggingT IO ()
forall (m :: * -> *).
(MonadIO m, MonadLogger m, MonadMask m) =>
Manager -> ClientI -> m ()
pollingThread
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 (LoggingT IO () -> IO ()
runLogger (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)
Maybe (ThreadId, MVar ())
downloadThreadPair' <- 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 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 (LoggingT IO () -> IO ()
runLogger (LoggingT IO () -> IO ()) -> LoggingT IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Manager -> ClientI -> LoggingT IO ()
downloadThreadF 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)
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
$ Maybe (ThreadId, MVar ()) -> ClientI -> ClientI
forall (f :: Symbol) s a. HasField' f s a => a -> s -> s
setField @"downloadThreadPair" Maybe (ThreadId, MVar ())
downloadThreadPair'
(ClientI -> ClientI) -> ClientI -> ClientI
forall a b. (a -> b) -> a -> b
$ Maybe (ThreadId, MVar ()) -> ClientI -> ClientI
forall (f :: Symbol) s a. HasField' f s a => a -> s -> s
setField @"eventThreadPair" Maybe (ThreadId, MVar ())
eventThreadPair' ClientI
client
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
allFlags :: Client -> User -> IO (HashMap Text Value)
allFlags :: Client -> User -> IO (HashMap Text Value)
allFlags (Client ClientI
client) (User UserI
user) = do
Either Text (HashMap Text Flag)
status <- StoreHandle IO -> StoreResultM IO (HashMap Text Flag)
forall store (m :: * -> *).
LaunchDarklyStoreRead store m =>
store -> StoreResultM m (HashMap Text Flag)
getAllFlagsC (StoreHandle IO -> StoreResultM IO (HashMap Text Flag))
-> StoreHandle IO -> StoreResultM IO (HashMap Text 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 (HashMap Text Flag)
status of
Left Text
_ -> HashMap Text Value -> IO (HashMap Text Value)
forall (f :: * -> *) a. Applicative f => a -> f a
pure HashMap Text Value
forall k v. HashMap k v
HM.empty
Right HashMap Text Flag
flags -> do
HashMap Text (EvaluationDetail Value, [EvalEvent])
evals <- (Flag -> IO (EvaluationDetail Value, [EvalEvent]))
-> HashMap Text Flag
-> IO (HashMap Text (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) HashMap Text Flag
flags
HashMap Text Value -> IO (HashMap Text Value)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HashMap Text Value -> IO (HashMap Text Value))
-> HashMap Text Value -> IO (HashMap Text Value)
forall a b. (a -> b) -> a -> b
$ ((EvaluationDetail Value, [EvalEvent]) -> Value)
-> HashMap Text (EvaluationDetail Value, [EvalEvent])
-> HashMap Text Value
forall v1 v2 k. (v1 -> v2) -> HashMap k v1 -> HashMap k v2
HM.map (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) HashMap Text (EvaluationDetail Value, [EvalEvent])
evals
identify :: Client -> User -> IO ()
identify :: Client -> User -> IO ()
identify (Client ClientI
client) (User UserI
user) = 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' }
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
}
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 CustomEvent -> EventType
EventTypeCustom BaseEvent CustomEvent
x)
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 ()
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
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
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 @"downloadThreadPair" ClientI
client) (((ThreadId, MVar ()) -> LoggingT IO ()) -> LoggingT IO ())
-> ((ThreadId, MVar ()) -> LoggingT IO ()) -> LoggingT IO ()
forall a b. (a -> b) -> a -> b
$ \(ThreadId
thread, 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 ()
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
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
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 ()
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
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
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 ()
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
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 ()
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
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 ()
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
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