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)