module LaunchDarkly.Server.Events where

import Control.Concurrent.MVar (MVar, modifyMVar, modifyMVar_, newEmptyMVar, newMVar, putMVar, readMVar, swapMVar, tryTakeMVar)
import Control.Lens ((%~), (&))
import Control.Monad (when)
import Data.Aeson (ToJSON, Value (..), object, toJSON, (.=))
import Data.Cache.LRU (LRU, newLRU)
import qualified Data.Cache.LRU as LRU
import Data.Generics.Product (HasField', field, getField, setField)
import qualified Data.HashSet as HS
import Data.Maybe (fromMaybe)
import Data.Text (Text)
import qualified Data.Text as T
import Data.Time.Clock.POSIX (getPOSIXTime)
import GHC.Exts (fromList)
import GHC.Generics (Generic)
import GHC.Natural (Natural, naturalFromInteger)

import LaunchDarkly.AesonCompat (KeyMap, insertKey, keyMapUnion, lookupKey, objectValues)
import LaunchDarkly.Server.Config.Internal (Config, shouldSendEvents)
import LaunchDarkly.Server.Context (Context)
import LaunchDarkly.Server.Context.Internal (getCanonicalKey, getKeys, getKinds, redactContext)
import LaunchDarkly.Server.Details (EvaluationReason (..))
import LaunchDarkly.Server.Features (Flag)

data EvalEvent = EvalEvent
    { EvalEvent -> Text
key :: !Text
    , EvalEvent -> Context
context :: !Context
    , EvalEvent -> Maybe Integer
variation :: !(Maybe Integer)
    , EvalEvent -> Value
value :: !Value
    , EvalEvent -> Maybe Value
defaultValue :: !(Maybe Value)
    , EvalEvent -> Maybe Natural
version :: !(Maybe Natural)
    , EvalEvent -> Maybe Text
prereqOf :: !(Maybe Text)
    , EvalEvent -> EvaluationReason
reason :: !EvaluationReason
    , EvalEvent -> Bool
trackEvents :: !Bool
    , EvalEvent -> Bool
forceIncludeReason :: !Bool
    , EvalEvent -> Bool
debug :: !Bool
    , EvalEvent -> Maybe Natural
debugEventsUntilDate :: !(Maybe Natural)
    }
    deriving (forall x. Rep EvalEvent x -> EvalEvent
forall x. EvalEvent -> Rep EvalEvent x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep EvalEvent x -> EvalEvent
$cfrom :: forall x. EvalEvent -> Rep EvalEvent x
Generic, EvalEvent -> EvalEvent -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EvalEvent -> EvalEvent -> Bool
$c/= :: EvalEvent -> EvalEvent -> Bool
== :: EvalEvent -> EvalEvent -> Bool
$c== :: EvalEvent -> EvalEvent -> Bool
Eq, Int -> EvalEvent -> ShowS
[EvalEvent] -> ShowS
EvalEvent -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EvalEvent] -> ShowS
$cshowList :: [EvalEvent] -> ShowS
show :: EvalEvent -> String
$cshow :: EvalEvent -> String
showsPrec :: Int -> EvalEvent -> ShowS
$cshowsPrec :: Int -> EvalEvent -> ShowS
Show)

data EventState = EventState
    { EventState -> MVar [EventType]
events :: !(MVar [EventType])
    , EventState -> MVar Integer
lastKnownServerTime :: !(MVar Integer)
    , EventState -> MVar ()
flush :: !(MVar ())
    , EventState -> MVar (KeyMap FlagSummaryContext)
summary :: !(MVar (KeyMap FlagSummaryContext))
    , EventState -> MVar Natural
startDate :: !(MVar Natural)
    , EventState -> MVar (LRU Text ())
contextKeyLRU :: !(MVar (LRU Text ()))
    }
    deriving (forall x. Rep EventState x -> EventState
forall x. EventState -> Rep EventState x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep EventState x -> EventState
$cfrom :: forall x. EventState -> Rep EventState x
Generic)

makeEventState :: Config -> IO EventState
makeEventState :: Config -> IO EventState
makeEventState Config
config = do
    MVar [EventType]
events <- forall a. a -> IO (MVar a)
newMVar []
    MVar Integer
lastKnownServerTime <- forall a. a -> IO (MVar a)
newMVar Integer
0
    MVar ()
flush <- forall a. IO (MVar a)
newEmptyMVar
    MVar (KeyMap FlagSummaryContext)
summary <- forall a. a -> IO (MVar a)
newMVar forall a. Monoid a => a
mempty
    MVar Natural
startDate <- forall a. IO (MVar a)
newEmptyMVar
    MVar (LRU Text ())
contextKeyLRU <- forall a. a -> IO (MVar a)
newMVar forall a b. (a -> b) -> a -> b
$ forall key val. Ord key => Maybe Integer -> LRU key val
newLRU forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure 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 @"contextKeyLRUCapacity" Config
config
    forall (f :: * -> *) a. Applicative f => a -> f a
pure EventState {MVar Integer
MVar Natural
MVar [EventType]
MVar ()
MVar (KeyMap FlagSummaryContext)
MVar (LRU Text ())
contextKeyLRU :: MVar (LRU Text ())
startDate :: MVar Natural
summary :: MVar (KeyMap FlagSummaryContext)
flush :: MVar ()
lastKnownServerTime :: MVar Integer
events :: MVar [EventType]
$sel:contextKeyLRU:EventState :: MVar (LRU Text ())
$sel:startDate:EventState :: MVar Natural
$sel:summary:EventState :: MVar (KeyMap FlagSummaryContext)
$sel:flush:EventState :: MVar ()
$sel:lastKnownServerTime:EventState :: MVar Integer
$sel:events:EventState :: MVar [EventType]
..}

queueEvent :: Config -> EventState -> EventType -> IO ()
queueEvent :: Config -> EventState -> EventType -> IO ()
queueEvent Config
config EventState
state EventType
event =
    if Bool -> Bool
not (Config -> Bool
shouldSendEvents Config
config)
        then forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        else forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ (forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"events" EventState
state) forall a b. (a -> b) -> a -> b
$ \[EventType]
events ->
            forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ case EventType
event of
                EventTypeSummary SummaryEvent
_ -> EventType
event forall a. a -> [a] -> [a]
: [EventType]
events
                EventType
_ | forall (t :: * -> *) a. Foldable t => t a -> Int
length [EventType]
events forall a. Ord a => a -> a -> Bool
< forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"eventsCapacity" Config
config) -> EventType
event forall a. a -> [a] -> [a]
: [EventType]
events
                EventType
_ -> [EventType]
events

unixMilliseconds :: IO Natural
unixMilliseconds :: IO Natural
unixMilliseconds = forall a b. (RealFrac a, Integral b) => a -> b
round forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Num a => a -> a -> a
* POSIXTime
1000) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO POSIXTime
getPOSIXTime

makeBaseEvent :: a -> IO (BaseEvent a)
makeBaseEvent :: forall a. a -> IO (BaseEvent a)
makeBaseEvent a
child = IO Natural
unixMilliseconds forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Natural
now -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ BaseEvent {$sel:creationDate:BaseEvent :: Natural
creationDate = Natural
now, $sel:event:BaseEvent :: a
event = a
child}

processSummary :: Config -> EventState -> IO ()
processSummary :: Config -> EventState -> IO ()
processSummary Config
config EventState
state =
    forall a. MVar a -> IO (Maybe a)
tryTakeMVar (forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"startDate" EventState
state) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Maybe Natural
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        (Just Natural
startDate) -> do
            Natural
endDate <- IO Natural
unixMilliseconds
            KeyMap FlagSummaryContext
features <- forall a. MVar a -> a -> IO a
swapMVar (forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"summary" EventState
state) forall a. Monoid a => a
mempty
            Config -> EventState -> EventType -> IO ()
queueEvent Config
config EventState
state forall a b. (a -> b) -> a -> b
$ SummaryEvent -> EventType
EventTypeSummary forall a b. (a -> b) -> a -> b
$ SummaryEvent {Natural
KeyMap FlagSummaryContext
$sel:features:SummaryEvent :: KeyMap FlagSummaryContext
$sel:endDate:SummaryEvent :: Natural
$sel:startDate:SummaryEvent :: Natural
features :: KeyMap FlagSummaryContext
endDate :: Natural
startDate :: Natural
..}

class EventKind a where
    eventKind :: a -> Text

data SummaryEvent = SummaryEvent
    { SummaryEvent -> Natural
startDate :: !Natural
    , SummaryEvent -> Natural
endDate :: !Natural
    , SummaryEvent -> KeyMap FlagSummaryContext
features :: !(KeyMap FlagSummaryContext)
    }
    deriving (forall x. Rep SummaryEvent x -> SummaryEvent
forall x. SummaryEvent -> Rep SummaryEvent x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SummaryEvent x -> SummaryEvent
$cfrom :: forall x. SummaryEvent -> Rep SummaryEvent x
Generic, Int -> SummaryEvent -> ShowS
[SummaryEvent] -> ShowS
SummaryEvent -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SummaryEvent] -> ShowS
$cshowList :: [SummaryEvent] -> ShowS
show :: SummaryEvent -> String
$cshow :: SummaryEvent -> String
showsPrec :: Int -> SummaryEvent -> ShowS
$cshowsPrec :: Int -> SummaryEvent -> ShowS
Show, [SummaryEvent] -> Encoding
[SummaryEvent] -> Value
SummaryEvent -> Encoding
SummaryEvent -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [SummaryEvent] -> Encoding
$ctoEncodingList :: [SummaryEvent] -> Encoding
toJSONList :: [SummaryEvent] -> Value
$ctoJSONList :: [SummaryEvent] -> Value
toEncoding :: SummaryEvent -> Encoding
$ctoEncoding :: SummaryEvent -> Encoding
toJSON :: SummaryEvent -> Value
$ctoJSON :: SummaryEvent -> Value
ToJSON)

instance EventKind SummaryEvent where
    eventKind :: SummaryEvent -> Text
eventKind SummaryEvent
_ = Text
"summary"

data FlagSummaryContext = FlagSummaryContext
    { FlagSummaryContext -> Maybe Value
defaultValue :: Maybe Value
    , FlagSummaryContext -> KeyMap CounterContext
counters :: KeyMap CounterContext
    , FlagSummaryContext -> HashSet Text
contextKinds :: HS.HashSet Text
    }
    deriving (forall x. Rep FlagSummaryContext x -> FlagSummaryContext
forall x. FlagSummaryContext -> Rep FlagSummaryContext x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FlagSummaryContext x -> FlagSummaryContext
$cfrom :: forall x. FlagSummaryContext -> Rep FlagSummaryContext x
Generic, Int -> FlagSummaryContext -> ShowS
[FlagSummaryContext] -> ShowS
FlagSummaryContext -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FlagSummaryContext] -> ShowS
$cshowList :: [FlagSummaryContext] -> ShowS
show :: FlagSummaryContext -> String
$cshow :: FlagSummaryContext -> String
showsPrec :: Int -> FlagSummaryContext -> ShowS
$cshowsPrec :: Int -> FlagSummaryContext -> ShowS
Show)

instance ToJSON FlagSummaryContext where
    toJSON :: FlagSummaryContext -> Value
toJSON FlagSummaryContext
ctx =
        [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
"default", 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 @"defaultValue" FlagSummaryContext
ctx)
                , (Key
"counters", forall a. ToJSON a => a -> Value
toJSON forall a b. (a -> b) -> a -> b
$ forall v. KeyMap v -> [v]
objectValues forall a b. (a -> b) -> a -> b
$ forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"counters" FlagSummaryContext
ctx)
                , (Key
"contextKinds", 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 @"contextKinds" FlagSummaryContext
ctx)
                ]

data CounterContext = CounterContext
    { CounterContext -> Natural
count :: !Natural
    , CounterContext -> Maybe Natural
version :: !(Maybe Natural)
    , CounterContext -> Maybe Integer
variation :: !(Maybe Integer)
    , CounterContext -> Value
value :: !Value
    , CounterContext -> Bool
unknown :: !Bool
    }
    deriving (forall x. Rep CounterContext x -> CounterContext
forall x. CounterContext -> Rep CounterContext x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CounterContext x -> CounterContext
$cfrom :: forall x. CounterContext -> Rep CounterContext x
Generic, Int -> CounterContext -> ShowS
[CounterContext] -> ShowS
CounterContext -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CounterContext] -> ShowS
$cshowList :: [CounterContext] -> ShowS
show :: CounterContext -> String
$cshow :: CounterContext -> String
showsPrec :: Int -> CounterContext -> ShowS
$cshowsPrec :: Int -> CounterContext -> ShowS
Show)

instance ToJSON CounterContext where
    toJSON :: CounterContext -> Value
toJSON CounterContext
context =
        [Pair] -> Value
object forall a b. (a -> b) -> a -> b
$
            [ Key
"count" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"count" CounterContext
context
            , Key
"value" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"value" CounterContext
context
            ]
                forall a. Semigroup a => a -> a -> a
<> 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" CounterContext
context
                    , 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" CounterContext
context
                    , Key
"unknown" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= if forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"unknown" CounterContext
context then forall a. a -> Maybe a
Just Bool
True else forall a. Maybe a
Nothing
                    ]

data IdentifyEvent = IdentifyEvent
    { IdentifyEvent -> Text
key :: !Text
    , IdentifyEvent -> Value
context :: !Value
    }
    deriving (forall x. Rep IdentifyEvent x -> IdentifyEvent
forall x. IdentifyEvent -> Rep IdentifyEvent x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep IdentifyEvent x -> IdentifyEvent
$cfrom :: forall x. IdentifyEvent -> Rep IdentifyEvent x
Generic, [IdentifyEvent] -> Encoding
[IdentifyEvent] -> Value
IdentifyEvent -> Encoding
IdentifyEvent -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [IdentifyEvent] -> Encoding
$ctoEncodingList :: [IdentifyEvent] -> Encoding
toJSONList :: [IdentifyEvent] -> Value
$ctoJSONList :: [IdentifyEvent] -> Value
toEncoding :: IdentifyEvent -> Encoding
$ctoEncoding :: IdentifyEvent -> Encoding
toJSON :: IdentifyEvent -> Value
$ctoJSON :: IdentifyEvent -> Value
ToJSON, Int -> IdentifyEvent -> ShowS
[IdentifyEvent] -> ShowS
IdentifyEvent -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IdentifyEvent] -> ShowS
$cshowList :: [IdentifyEvent] -> ShowS
show :: IdentifyEvent -> String
$cshow :: IdentifyEvent -> String
showsPrec :: Int -> IdentifyEvent -> ShowS
$cshowsPrec :: Int -> IdentifyEvent -> ShowS
Show)

instance EventKind IdentifyEvent where
    eventKind :: IdentifyEvent -> Text
eventKind IdentifyEvent
_ = Text
"identify"

data IndexEvent = IndexEvent {IndexEvent -> Value
context :: Value} deriving (forall x. Rep IndexEvent x -> IndexEvent
forall x. IndexEvent -> Rep IndexEvent x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep IndexEvent x -> IndexEvent
$cfrom :: forall x. IndexEvent -> Rep IndexEvent x
Generic, [IndexEvent] -> Encoding
[IndexEvent] -> Value
IndexEvent -> Encoding
IndexEvent -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [IndexEvent] -> Encoding
$ctoEncodingList :: [IndexEvent] -> Encoding
toJSONList :: [IndexEvent] -> Value
$ctoJSONList :: [IndexEvent] -> Value
toEncoding :: IndexEvent -> Encoding
$ctoEncoding :: IndexEvent -> Encoding
toJSON :: IndexEvent -> Value
$ctoJSON :: IndexEvent -> Value
ToJSON, Int -> IndexEvent -> ShowS
[IndexEvent] -> ShowS
IndexEvent -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IndexEvent] -> ShowS
$cshowList :: [IndexEvent] -> ShowS
show :: IndexEvent -> String
$cshow :: IndexEvent -> String
showsPrec :: Int -> IndexEvent -> ShowS
$cshowsPrec :: Int -> IndexEvent -> ShowS
Show)

instance EventKind IndexEvent where
    eventKind :: IndexEvent -> Text
eventKind IndexEvent
_ = Text
"index"

data FeatureEvent = FeatureEvent
    { FeatureEvent -> Text
key :: !Text
    , FeatureEvent -> Maybe Value
context :: !(Maybe Value)
    , FeatureEvent -> Maybe (KeyMap Text)
contextKeys :: !(Maybe (KeyMap Text))
    , FeatureEvent -> Value
value :: !Value
    , FeatureEvent -> Maybe Value
defaultValue :: !(Maybe Value)
    , FeatureEvent -> Maybe Natural
version :: !(Maybe Natural)
    , FeatureEvent -> Maybe Text
prereqOf :: !(Maybe Text)
    , FeatureEvent -> Maybe Integer
variation :: !(Maybe Integer)
    , FeatureEvent -> Maybe EvaluationReason
reason :: !(Maybe EvaluationReason)
    }
    deriving (forall x. Rep FeatureEvent x -> FeatureEvent
forall x. FeatureEvent -> Rep FeatureEvent x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FeatureEvent x -> FeatureEvent
$cfrom :: forall x. FeatureEvent -> Rep FeatureEvent x
Generic, Int -> FeatureEvent -> ShowS
[FeatureEvent] -> ShowS
FeatureEvent -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FeatureEvent] -> ShowS
$cshowList :: [FeatureEvent] -> ShowS
show :: FeatureEvent -> String
$cshow :: FeatureEvent -> String
showsPrec :: Int -> FeatureEvent -> ShowS
$cshowsPrec :: Int -> FeatureEvent -> ShowS
Show)

instance ToJSON FeatureEvent where
    toJSON :: FeatureEvent -> Value
toJSON FeatureEvent
event =
        [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
"key", 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 @"key" FeatureEvent
event)
                , (Key
"context", 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 @"context" FeatureEvent
event)
                , (Key
"contextKeys", 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 @"contextKeys" FeatureEvent
event)
                , (Key
"value", 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 @"value" FeatureEvent
event)
                , (Key
"default", 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 @"defaultValue" FeatureEvent
event)
                , (Key
"version", 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 @"version" FeatureEvent
event)
                , (Key
"prereqOf", 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 @"prereqOf" FeatureEvent
event)
                , (Key
"variation", 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 @"variation" FeatureEvent
event)
                , (Key
"reason", 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 @"reason" FeatureEvent
event)
                ]

instance EventKind FeatureEvent where
    eventKind :: FeatureEvent -> Text
eventKind FeatureEvent
_ = Text
"feature"

newtype DebugEvent = DebugEvent FeatureEvent

instance EventKind DebugEvent where
    eventKind :: DebugEvent -> Text
eventKind DebugEvent
_ = Text
"debug"

instance ToJSON DebugEvent where
    toJSON :: DebugEvent -> Value
toJSON (DebugEvent FeatureEvent
x) = forall a. ToJSON a => a -> Value
toJSON FeatureEvent
x

addContextToEvent :: (HasField' "context" r (Maybe Value)) => Config -> Context -> r -> r
addContextToEvent :: forall r.
HasField' "context" r (Maybe Value) =>
Config -> Context -> r -> r
addContextToEvent Config
config Context
context r
event = forall (f :: Symbol) s a. HasField' f s a => a -> s -> s
setField @"context" (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Config -> Context -> Value
redactContext Config
config Context
context) r
event

contextOrContextKeys :: Bool -> Config -> Context -> FeatureEvent -> FeatureEvent
contextOrContextKeys :: Bool -> Config -> Context -> FeatureEvent -> FeatureEvent
contextOrContextKeys Bool
True Config
config Context
context FeatureEvent
event = forall r.
HasField' "context" r (Maybe Value) =>
Config -> Context -> r -> r
addContextToEvent Config
config Context
context FeatureEvent
event forall a b. a -> (a -> b) -> b
& forall (f :: Symbol) s a. HasField' f s a => a -> s -> s
setField @"contextKeys" forall a. Maybe a
Nothing
contextOrContextKeys Bool
False Config
_ Context
context FeatureEvent
event = FeatureEvent
event {$sel:contextKeys:FeatureEvent :: Maybe (KeyMap Text)
contextKeys = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Context -> KeyMap Text
getKeys Context
context, $sel:context:FeatureEvent :: Maybe Value
context = forall a. Maybe a
Nothing}

makeFeatureEvent :: Config -> Context -> Bool -> EvalEvent -> FeatureEvent
makeFeatureEvent :: Config -> Context -> Bool -> EvalEvent -> FeatureEvent
makeFeatureEvent Config
config Context
context Bool
includeReason EvalEvent
event =
    Bool -> Config -> Context -> FeatureEvent -> FeatureEvent
contextOrContextKeys Bool
False Config
config Context
context forall a b. (a -> b) -> a -> b
$
        FeatureEvent
            { $sel:key:FeatureEvent :: Text
key = forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"key" EvalEvent
event
            , $sel:context:FeatureEvent :: Maybe Value
context = forall a. Maybe a
Nothing
            , $sel:contextKeys:FeatureEvent :: Maybe (KeyMap Text)
contextKeys = forall a. Maybe a
Nothing
            , $sel:value:FeatureEvent :: Value
value = forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"value" EvalEvent
event
            , $sel:defaultValue:FeatureEvent :: Maybe Value
defaultValue = forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"defaultValue" EvalEvent
event
            , $sel:version:FeatureEvent :: Maybe Natural
version = forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"version" EvalEvent
event
            , $sel:prereqOf:FeatureEvent :: Maybe Text
prereqOf = forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"prereqOf" EvalEvent
event
            , $sel:variation:FeatureEvent :: Maybe Integer
variation = forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"variation" EvalEvent
event
            , $sel:reason:FeatureEvent :: Maybe EvaluationReason
reason =
                if Bool
includeReason Bool -> Bool -> Bool
|| forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"forceIncludeReason" EvalEvent
event
                    then forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"reason" EvalEvent
event
                    else forall a. Maybe a
Nothing
            }

data CustomEvent = CustomEvent
    { CustomEvent -> Text
key :: !Text
    , CustomEvent -> KeyMap Text
contextKeys :: !(KeyMap Text)
    , CustomEvent -> Maybe Double
metricValue :: !(Maybe Double)
    , CustomEvent -> Maybe Value
value :: !(Maybe Value)
    }
    deriving (forall x. Rep CustomEvent x -> CustomEvent
forall x. CustomEvent -> Rep CustomEvent x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CustomEvent x -> CustomEvent
$cfrom :: forall x. CustomEvent -> Rep CustomEvent x
Generic, Int -> CustomEvent -> ShowS
[CustomEvent] -> ShowS
CustomEvent -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CustomEvent] -> ShowS
$cshowList :: [CustomEvent] -> ShowS
show :: CustomEvent -> String
$cshow :: CustomEvent -> String
showsPrec :: Int -> CustomEvent -> ShowS
$cshowsPrec :: Int -> CustomEvent -> ShowS
Show)

instance ToJSON CustomEvent where
    toJSON :: CustomEvent -> Value
toJSON CustomEvent
ctx =
        [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
"key", 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 @"key" CustomEvent
ctx)
                , (Key
"contextKeys", 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 @"contextKeys" CustomEvent
ctx)
                , (Key
"metricValue", 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 @"metricValue" CustomEvent
ctx)
                , (Key
"data", 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 @"value" CustomEvent
ctx)
                ]

instance EventKind CustomEvent where
    eventKind :: CustomEvent -> Text
eventKind CustomEvent
_ = Text
"custom"

data BaseEvent event = BaseEvent
    { forall event. BaseEvent event -> Natural
creationDate :: Natural
    , forall event. BaseEvent event -> event
event :: event
    }
    deriving (forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall event x. Rep (BaseEvent event) x -> BaseEvent event
forall event x. BaseEvent event -> Rep (BaseEvent event) x
$cto :: forall event x. Rep (BaseEvent event) x -> BaseEvent event
$cfrom :: forall event x. BaseEvent event -> Rep (BaseEvent event) x
Generic, Int -> BaseEvent event -> ShowS
forall event. Show event => Int -> BaseEvent event -> ShowS
forall event. Show event => [BaseEvent event] -> ShowS
forall event. Show event => BaseEvent event -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BaseEvent event] -> ShowS
$cshowList :: forall event. Show event => [BaseEvent event] -> ShowS
show :: BaseEvent event -> String
$cshow :: forall event. Show event => BaseEvent event -> String
showsPrec :: Int -> BaseEvent event -> ShowS
$cshowsPrec :: forall event. Show event => Int -> BaseEvent event -> ShowS
Show)

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"

instance (EventKind sub, ToJSON sub) => ToJSON (BaseEvent sub) where
    toJSON :: BaseEvent sub -> Value
toJSON BaseEvent sub
event =
        KeyMap Value -> Value
Object forall a b. (a -> b) -> a -> b
$
            forall v. KeyMap v -> KeyMap v -> KeyMap v
keyMapUnion (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 @"event" BaseEvent sub
event) forall a b. (a -> b) -> a -> b
$
                forall l. IsList l => [Item l] -> l
fromList
                    [ (Key
"creationDate", 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 @"creationDate" BaseEvent sub
event)
                    , (Key
"kind", Text -> Value
String forall a b. (a -> b) -> a -> b
$ forall a. EventKind a => a -> Text
eventKind forall a b. (a -> b) -> a -> b
$ forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"event" BaseEvent sub
event)
                    ]

data EventType
    = EventTypeIdentify !(BaseEvent IdentifyEvent)
    | EventTypeFeature !(BaseEvent FeatureEvent)
    | EventTypeSummary !SummaryEvent
    | EventTypeCustom !(BaseEvent CustomEvent)
    | EventTypeIndex !(BaseEvent IndexEvent)
    | EventTypeDebug !(BaseEvent DebugEvent)

instance ToJSON EventType where
    toJSON :: EventType -> Value
toJSON EventType
event = case EventType
event of
        EventTypeIdentify BaseEvent IdentifyEvent
x -> forall a. ToJSON a => a -> Value
toJSON BaseEvent IdentifyEvent
x
        EventTypeFeature BaseEvent FeatureEvent
x -> forall a. ToJSON a => a -> Value
toJSON BaseEvent FeatureEvent
x
        EventTypeSummary SummaryEvent
x -> KeyMap Value -> Value
Object forall a b. (a -> b) -> a -> b
$ forall v. Text -> v -> KeyMap v -> KeyMap v
insertKey Text
"kind" (Text -> Value
String Text
"summary") (Value -> KeyMap Value
fromObject forall a b. (a -> b) -> a -> b
$ forall a. ToJSON a => a -> Value
toJSON SummaryEvent
x)
        EventTypeCustom BaseEvent CustomEvent
x -> forall a. ToJSON a => a -> Value
toJSON BaseEvent CustomEvent
x
        EventTypeIndex BaseEvent IndexEvent
x -> forall a. ToJSON a => a -> Value
toJSON BaseEvent IndexEvent
x
        EventTypeDebug BaseEvent DebugEvent
x -> forall a. ToJSON a => a -> Value
toJSON BaseEvent DebugEvent
x

newUnknownFlagEvent :: Text -> Value -> EvaluationReason -> Context -> EvalEvent
newUnknownFlagEvent :: Text -> Value -> EvaluationReason -> Context -> EvalEvent
newUnknownFlagEvent Text
key Value
defaultValue EvaluationReason
reason Context
context =
    EvalEvent
        { $sel:key:EvalEvent :: Text
key = Text
key
        , $sel:context:EvalEvent :: Context
context = Context
context
        , $sel:variation:EvalEvent :: Maybe Integer
variation = forall a. Maybe a
Nothing
        , $sel:value:EvalEvent :: Value
value = Value
defaultValue
        , $sel:defaultValue:EvalEvent :: Maybe Value
defaultValue = forall (f :: * -> *) a. Applicative f => a -> f a
pure Value
defaultValue
        , $sel:version:EvalEvent :: Maybe Natural
version = forall a. Maybe a
Nothing
        , $sel:prereqOf:EvalEvent :: Maybe Text
prereqOf = forall a. Maybe a
Nothing
        , $sel:reason:EvalEvent :: EvaluationReason
reason = EvaluationReason
reason
        , $sel:trackEvents:EvalEvent :: Bool
trackEvents = Bool
False
        , $sel:forceIncludeReason:EvalEvent :: Bool
forceIncludeReason = Bool
False
        , $sel:debug:EvalEvent :: Bool
debug = Bool
False
        , $sel:debugEventsUntilDate:EvalEvent :: Maybe Natural
debugEventsUntilDate = forall a. Maybe a
Nothing
        }

newSuccessfulEvalEvent :: Flag -> Maybe Integer -> Value -> Maybe Value -> EvaluationReason -> Maybe Text -> Context -> EvalEvent
newSuccessfulEvalEvent :: Flag
-> Maybe Integer
-> Value
-> Maybe Value
-> EvaluationReason
-> Maybe Text
-> Context
-> EvalEvent
newSuccessfulEvalEvent Flag
flag Maybe Integer
variation Value
value Maybe Value
defaultValue EvaluationReason
reason Maybe Text
prereqOf Context
context =
    EvalEvent
        { $sel:key:EvalEvent :: Text
key = forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"key" Flag
flag
        , $sel:context:EvalEvent :: Context
context = Context
context
        , $sel:variation:EvalEvent :: Maybe Integer
variation = Maybe Integer
variation
        , $sel:value:EvalEvent :: Value
value = Value
value
        , $sel:defaultValue:EvalEvent :: Maybe Value
defaultValue = Maybe Value
defaultValue
        , $sel:version:EvalEvent :: Maybe Natural
version = 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:prereqOf:EvalEvent :: Maybe Text
prereqOf = Maybe Text
prereqOf
        , $sel:reason:EvalEvent :: EvaluationReason
reason = EvaluationReason
reason
        , $sel:trackEvents:EvalEvent :: Bool
trackEvents = forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"trackEvents" Flag
flag Bool -> Bool -> Bool
|| Bool
shouldForceReason
        , $sel:forceIncludeReason:EvalEvent :: Bool
forceIncludeReason = Bool
shouldForceReason
        , $sel:debug:EvalEvent :: Bool
debug = Bool
False
        , $sel:debugEventsUntilDate:EvalEvent :: Maybe Natural
debugEventsUntilDate = forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"debugEventsUntilDate" Flag
flag
        }
  where
    shouldForceReason :: Bool
shouldForceReason = case EvaluationReason
reason of
        (EvaluationReasonFallthrough Bool
inExperiment) ->
            Bool
inExperiment Bool -> Bool -> Bool
|| forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"trackEventsFallthrough" Flag
flag
        (EvaluationReasonRuleMatch Natural
idx Text
_ Bool
inExperiment) ->
            Bool
inExperiment Bool -> Bool -> Bool
|| forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"trackEvents" (forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"rules" Flag
flag forall a. [a] -> Int -> a
!! forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
idx)
        EvaluationReason
_ -> Bool
False

makeSummaryKey :: EvalEvent -> Text
makeSummaryKey :: EvalEvent -> Text
makeSummaryKey EvalEvent
event =
    Text -> [Text] -> Text
T.intercalate
        Text
"-"
        [ forall a. a -> Maybe a -> a
fromMaybe Text
"" forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) forall a b. (a -> b) -> a -> b
$ forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"version" EvalEvent
event
        , forall a. a -> Maybe a -> a
fromMaybe Text
"" forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) forall a b. (a -> b) -> a -> b
$ forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"variation" EvalEvent
event
        ]

summarizeEvent :: KeyMap FlagSummaryContext -> EvalEvent -> Bool -> KeyMap FlagSummaryContext
summarizeEvent :: KeyMap FlagSummaryContext
-> EvalEvent -> Bool -> KeyMap FlagSummaryContext
summarizeEvent KeyMap FlagSummaryContext
summaryContext EvalEvent
event Bool
unknown = KeyMap FlagSummaryContext
result
  where
    key :: Text
key = EvalEvent -> Text
makeSummaryKey EvalEvent
event
    contextKinds :: HashSet Text
contextKinds = forall a. (Eq a, Hashable a) => [a] -> HashSet a
HS.fromList forall a b. (a -> b) -> a -> b
$ Context -> [Text]
getKinds forall a b. (a -> b) -> a -> b
$ forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"context" EvalEvent
event
    root :: FlagSummaryContext
root = case forall v. Text -> KeyMap v -> Maybe v
lookupKey (forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"key" EvalEvent
event) KeyMap FlagSummaryContext
summaryContext of
        (Just FlagSummaryContext
x) -> FlagSummaryContext
x
        Maybe FlagSummaryContext
Nothing ->
            FlagSummaryContext
                { $sel:defaultValue:FlagSummaryContext :: Maybe Value
defaultValue = (forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"defaultValue" EvalEvent
event)
                , $sel:counters:FlagSummaryContext :: KeyMap CounterContext
counters = forall a. Monoid a => a
mempty
                , $sel:contextKinds:FlagSummaryContext :: HashSet Text
contextKinds = forall a. Monoid a => a
mempty
                }
    leaf :: CounterContext
leaf = case forall v. Text -> KeyMap v -> Maybe v
lookupKey Text
key (forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"counters" FlagSummaryContext
root) of
        (Just CounterContext
x) -> CounterContext
x forall a b. a -> (a -> b) -> b
& forall (field :: Symbol) s t a b.
HasField field s t a b =>
Lens s t a b
field @"count" forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Natural
1 forall a. Num a => a -> a -> a
+)
        Maybe CounterContext
Nothing ->
            CounterContext
                { $sel:count:CounterContext :: Natural
count = Natural
1
                , $sel:version:CounterContext :: Maybe Natural
version = forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"version" EvalEvent
event
                , $sel:variation:CounterContext :: Maybe Integer
variation = forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"variation" EvalEvent
event
                , $sel:value:CounterContext :: Value
value = forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"value" EvalEvent
event
                , $sel:unknown:CounterContext :: Bool
unknown = Bool
unknown
                }
    result :: KeyMap FlagSummaryContext
result = forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall v. Text -> v -> KeyMap v -> KeyMap v
insertKey forall a b. (a -> b) -> a -> b
$ forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"key" EvalEvent
event) KeyMap FlagSummaryContext
summaryContext forall a b. (a -> b) -> a -> b
$ (FlagSummaryContext
root forall a b. a -> (a -> b) -> b
& forall (field :: Symbol) s t a b.
HasField field s t a b =>
Lens s t a b
field @"counters" forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (forall v. Text -> v -> KeyMap v -> KeyMap v
insertKey Text
key CounterContext
leaf) forall a b. a -> (a -> b) -> b
& forall (field :: Symbol) s t a b.
HasField field s t a b =>
Lens s t a b
field @"contextKinds" forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (forall a. (Eq a, Hashable a) => HashSet a -> HashSet a -> HashSet a
HS.union HashSet Text
contextKinds))

putIfEmptyMVar :: MVar a -> a -> IO ()
putIfEmptyMVar :: forall a. MVar a -> a -> IO ()
putIfEmptyMVar MVar a
mvar a
value = forall a. MVar a -> IO (Maybe a)
tryTakeMVar MVar a
mvar forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case Just a
x -> forall a. MVar a -> a -> IO ()
putMVar MVar a
mvar a
x; Maybe a
Nothing -> forall a. MVar a -> a -> IO ()
putMVar MVar a
mvar a
value

runSummary :: Natural -> EventState -> EvalEvent -> Bool -> IO ()
runSummary :: Natural -> EventState -> EvalEvent -> Bool -> IO ()
runSummary Natural
now EventState
state EvalEvent
event Bool
unknown =
    forall a. MVar a -> a -> IO ()
putIfEmptyMVar (forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"startDate" EventState
state) Natural
now
        forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ (forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"summary" EventState
state) (\KeyMap FlagSummaryContext
summary -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ KeyMap FlagSummaryContext
-> EvalEvent -> Bool -> KeyMap FlagSummaryContext
summarizeEvent KeyMap FlagSummaryContext
summary EvalEvent
event Bool
unknown)

processEvalEvent :: Natural -> Config -> EventState -> Context -> Bool -> Bool -> EvalEvent -> IO ()
processEvalEvent :: Natural
-> Config
-> EventState
-> Context
-> Bool
-> Bool
-> EvalEvent
-> IO ()
processEvalEvent Natural
now Config
config EventState
state Context
context Bool
includeReason Bool
unknown EvalEvent
event = do
    let featureEvent :: FeatureEvent
featureEvent = Config -> Context -> Bool -> EvalEvent -> FeatureEvent
makeFeatureEvent Config
config Context
context Bool
includeReason EvalEvent
event
        trackEvents :: Bool
trackEvents = forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"trackEvents" EvalEvent
event
        debugEventsUntilDate :: Natural
debugEventsUntilDate = forall a. a -> Maybe a -> a
fromMaybe Natural
0 (forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"debugEventsUntilDate" EvalEvent
event)
    Natural
lastKnownServerTime <- Integer -> Natural
naturalFromInteger forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. Num a => a -> a -> a
* Integer
1000) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. MVar a -> IO a
readMVar (forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"lastKnownServerTime" EventState
state)
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
trackEvents forall a b. (a -> b) -> a -> b
$
        Config -> EventState -> EventType -> IO ()
queueEvent Config
config EventState
state forall a b. (a -> b) -> a -> b
$
            BaseEvent FeatureEvent -> EventType
EventTypeFeature forall a b. (a -> b) -> a -> b
$
                forall event. Natural -> event -> BaseEvent event
BaseEvent Natural
now FeatureEvent
featureEvent
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Natural
now forall a. Ord a => a -> a -> Bool
< Natural
debugEventsUntilDate Bool -> Bool -> Bool
&& Natural
lastKnownServerTime forall a. Ord a => a -> a -> Bool
< Natural
debugEventsUntilDate) forall a b. (a -> b) -> a -> b
$
        Config -> EventState -> EventType -> IO ()
queueEvent Config
config EventState
state forall a b. (a -> b) -> a -> b
$
            BaseEvent DebugEvent -> EventType
EventTypeDebug forall a b. (a -> b) -> a -> b
$
                forall event. Natural -> event -> BaseEvent event
BaseEvent Natural
now forall a b. (a -> b) -> a -> b
$
                    FeatureEvent -> DebugEvent
DebugEvent forall a b. (a -> b) -> a -> b
$
                        Bool -> Config -> Context -> FeatureEvent -> FeatureEvent
contextOrContextKeys Bool
True Config
config Context
context FeatureEvent
featureEvent
    Natural -> EventState -> EvalEvent -> Bool -> IO ()
runSummary Natural
now EventState
state EvalEvent
event Bool
unknown
    Natural -> Config -> Context -> EventState -> IO ()
maybeIndexContext Natural
now Config
config Context
context EventState
state

processEvalEvents :: Config -> EventState -> Context -> Bool -> [EvalEvent] -> Bool -> IO ()
processEvalEvents :: Config
-> EventState -> Context -> Bool -> [EvalEvent] -> Bool -> IO ()
processEvalEvents Config
config EventState
state Context
context Bool
includeReason [EvalEvent]
events Bool
unknown =
    IO Natural
unixMilliseconds forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Natural
now -> forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Natural
-> Config
-> EventState
-> Context
-> Bool
-> Bool
-> EvalEvent
-> IO ()
processEvalEvent Natural
now Config
config EventState
state Context
context Bool
includeReason Bool
unknown) [EvalEvent]
events

maybeIndexContext :: Natural -> Config -> Context -> EventState -> IO ()
maybeIndexContext :: Natural -> Config -> Context -> EventState -> IO ()
maybeIndexContext Natural
now Config
config Context
context EventState
state = do
    Bool
noticedContext <- EventState -> Context -> IO Bool
noticeContext EventState
state Context
context
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
noticedContext forall a b. (a -> b) -> a -> b
$
        Config -> EventState -> EventType -> IO ()
queueEvent Config
config EventState
state (BaseEvent IndexEvent -> EventType
EventTypeIndex forall a b. (a -> b) -> a -> b
$ forall event. Natural -> event -> BaseEvent event
BaseEvent Natural
now forall a b. (a -> b) -> a -> b
$ IndexEvent {$sel:context:IndexEvent :: Value
context = Config -> Context -> Value
redactContext Config
config Context
context})

noticeContext :: EventState -> Context -> IO Bool
noticeContext :: EventState -> Context -> IO Bool
noticeContext EventState
state Context
context = forall a b. MVar a -> (a -> IO (a, b)) -> IO b
modifyMVar (forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"contextKeyLRU" EventState
state) forall a b. (a -> b) -> a -> b
$ \LRU Text ()
cache -> do
    let key :: Text
key = Context -> Text
getCanonicalKey Context
context
    case forall key val.
Ord key =>
key -> LRU key val -> (LRU key val, Maybe val)
LRU.lookup Text
key LRU Text ()
cache of
        (LRU Text ()
cache', Just ()
_) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (LRU Text ()
cache', Bool
False)
        (LRU Text ()
cache', Maybe ()
Nothing) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall key val. Ord key => key -> val -> LRU key val -> LRU key val
LRU.insert Text
key () LRU Text ()
cache', Bool
True)