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. EvalEvent -> Rep EvalEvent x) -> (forall x. Rep EvalEvent x -> EvalEvent) -> Generic EvalEvent 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 $cfrom :: forall x. EvalEvent -> Rep EvalEvent x from :: forall x. EvalEvent -> Rep EvalEvent x $cto :: forall x. Rep EvalEvent x -> EvalEvent to :: forall x. Rep EvalEvent x -> EvalEvent Generic, EvalEvent -> EvalEvent -> Bool (EvalEvent -> EvalEvent -> Bool) -> (EvalEvent -> EvalEvent -> Bool) -> Eq EvalEvent forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a $c== :: EvalEvent -> EvalEvent -> Bool == :: EvalEvent -> EvalEvent -> Bool $c/= :: EvalEvent -> EvalEvent -> Bool /= :: EvalEvent -> EvalEvent -> Bool Eq, Int -> EvalEvent -> ShowS [EvalEvent] -> ShowS EvalEvent -> String (Int -> EvalEvent -> ShowS) -> (EvalEvent -> String) -> ([EvalEvent] -> ShowS) -> Show EvalEvent forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a $cshowsPrec :: Int -> EvalEvent -> ShowS showsPrec :: Int -> EvalEvent -> ShowS $cshow :: EvalEvent -> String show :: EvalEvent -> String $cshowList :: [EvalEvent] -> ShowS showList :: [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. EventState -> Rep EventState x) -> (forall x. Rep EventState x -> EventState) -> Generic EventState 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 $cfrom :: forall x. EventState -> Rep EventState x from :: forall x. EventState -> Rep EventState x $cto :: forall x. Rep EventState x -> EventState to :: forall x. Rep EventState x -> EventState Generic) makeEventState :: Config -> IO EventState makeEventState :: Config -> IO EventState makeEventState Config config = do MVar [EventType] events <- [EventType] -> IO (MVar [EventType]) forall a. a -> IO (MVar a) newMVar [] MVar Integer lastKnownServerTime <- Integer -> IO (MVar Integer) forall a. a -> IO (MVar a) newMVar Integer 0 MVar () flush <- IO (MVar ()) forall a. IO (MVar a) newEmptyMVar MVar (KeyMap FlagSummaryContext) summary <- KeyMap FlagSummaryContext -> IO (MVar (KeyMap FlagSummaryContext)) forall a. a -> IO (MVar a) newMVar KeyMap FlagSummaryContext forall a. Monoid a => a mempty MVar Natural startDate <- IO (MVar Natural) forall a. IO (MVar a) newEmptyMVar MVar (LRU Text ()) contextKeyLRU <- LRU Text () -> IO (MVar (LRU Text ())) forall a. a -> IO (MVar a) newMVar (LRU Text () -> IO (MVar (LRU Text ()))) -> LRU Text () -> IO (MVar (LRU Text ())) forall a b. (a -> b) -> a -> b $ Maybe Integer -> LRU Text () forall key val. Ord key => Maybe Integer -> LRU key val newLRU (Maybe Integer -> LRU Text ()) -> Maybe Integer -> LRU Text () forall a b. (a -> b) -> a -> b $ Integer -> Maybe Integer forall a. a -> Maybe a forall (f :: * -> *) a. Applicative f => a -> f a pure (Integer -> Maybe Integer) -> Integer -> Maybe Integer forall a b. (a -> b) -> a -> b $ Natural -> Integer forall a b. (Integral a, Num b) => a -> b fromIntegral (Natural -> Integer) -> Natural -> Integer forall a b. (a -> b) -> a -> b $ forall (f :: Symbol) a s. HasField' f s a => s -> a getField @"contextKeyLRUCapacity" Config config EventState -> IO EventState forall a. a -> IO a forall (f :: * -> *) a. Applicative f => a -> f a pure EventState {MVar Integer MVar Natural MVar [EventType] MVar () MVar (KeyMap FlagSummaryContext) MVar (LRU Text ()) $sel:events:EventState :: MVar [EventType] $sel:lastKnownServerTime:EventState :: MVar Integer $sel:flush:EventState :: MVar () $sel:summary:EventState :: MVar (KeyMap FlagSummaryContext) $sel:startDate:EventState :: MVar Natural $sel:contextKeyLRU:EventState :: MVar (LRU Text ()) events :: MVar [EventType] lastKnownServerTime :: MVar Integer flush :: MVar () summary :: MVar (KeyMap FlagSummaryContext) startDate :: MVar Natural contextKeyLRU :: MVar (LRU Text ()) ..} 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 () -> IO () forall a. a -> IO a forall (f :: * -> *) a. Applicative f => a -> f a pure () else MVar [EventType] -> ([EventType] -> IO [EventType]) -> IO () forall a. MVar a -> (a -> IO a) -> IO () modifyMVar_ (forall (f :: Symbol) a s. HasField' f s a => s -> a getField @"events" EventState state) (([EventType] -> IO [EventType]) -> IO ()) -> ([EventType] -> IO [EventType]) -> IO () forall a b. (a -> b) -> a -> b $ \[EventType] events -> [EventType] -> IO [EventType] forall a. a -> IO a forall (f :: * -> *) a. Applicative f => a -> f a pure ([EventType] -> IO [EventType]) -> [EventType] -> IO [EventType] forall a b. (a -> b) -> a -> b $ case EventType event of EventTypeSummary SummaryEvent _ -> EventType event EventType -> [EventType] -> [EventType] forall a. a -> [a] -> [a] : [EventType] events EventType _ | [EventType] -> Int forall a. [a] -> Int forall (t :: * -> *) a. Foldable t => t a -> Int length [EventType] events Int -> Int -> Bool forall a. Ord a => a -> a -> Bool < Natural -> Int 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 EventType -> [EventType] -> [EventType] forall a. a -> [a] -> [a] : [EventType] events EventType _ -> [EventType] events unixMilliseconds :: IO Natural unixMilliseconds :: IO Natural unixMilliseconds = POSIXTime -> Natural forall b. Integral b => POSIXTime -> b forall a b. (RealFrac a, Integral b) => a -> b round (POSIXTime -> Natural) -> (POSIXTime -> POSIXTime) -> POSIXTime -> Natural forall b c a. (b -> c) -> (a -> b) -> a -> c . (POSIXTime -> POSIXTime -> POSIXTime forall a. Num a => a -> a -> a * POSIXTime 1000) (POSIXTime -> Natural) -> IO POSIXTime -> IO Natural 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 IO Natural -> (Natural -> IO (BaseEvent a)) -> IO (BaseEvent a) forall a b. IO a -> (a -> IO b) -> IO b forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= \Natural now -> BaseEvent a -> IO (BaseEvent a) forall a. a -> IO a forall (f :: * -> *) a. Applicative f => a -> f a pure (BaseEvent a -> IO (BaseEvent a)) -> BaseEvent a -> IO (BaseEvent a) 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 = MVar Natural -> IO (Maybe Natural) forall a. MVar a -> IO (Maybe a) tryTakeMVar (forall (f :: Symbol) a s. HasField' f s a => s -> a getField @"startDate" EventState state) IO (Maybe Natural) -> (Maybe Natural -> IO ()) -> IO () forall a b. IO a -> (a -> IO b) -> IO b forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= \case Maybe Natural Nothing -> () -> IO () forall a. a -> IO a forall (f :: * -> *) a. Applicative f => a -> f a pure () (Just Natural startDate) -> do Natural endDate <- IO Natural unixMilliseconds KeyMap FlagSummaryContext features <- MVar (KeyMap FlagSummaryContext) -> KeyMap FlagSummaryContext -> IO (KeyMap FlagSummaryContext) forall a. MVar a -> a -> IO a swapMVar (forall (f :: Symbol) a s. HasField' f s a => s -> a getField @"summary" EventState state) KeyMap FlagSummaryContext forall a. Monoid a => a mempty Config -> EventState -> EventType -> IO () queueEvent Config config EventState state (EventType -> IO ()) -> EventType -> IO () forall a b. (a -> b) -> a -> b $ SummaryEvent -> EventType EventTypeSummary (SummaryEvent -> EventType) -> SummaryEvent -> EventType forall a b. (a -> b) -> a -> b $ SummaryEvent {Natural KeyMap FlagSummaryContext startDate :: Natural endDate :: Natural features :: KeyMap FlagSummaryContext $sel:startDate:SummaryEvent :: Natural $sel:endDate:SummaryEvent :: Natural $sel:features:SummaryEvent :: KeyMap FlagSummaryContext ..} 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. SummaryEvent -> Rep SummaryEvent x) -> (forall x. Rep SummaryEvent x -> SummaryEvent) -> Generic SummaryEvent 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 $cfrom :: forall x. SummaryEvent -> Rep SummaryEvent x from :: forall x. SummaryEvent -> Rep SummaryEvent x $cto :: forall x. Rep SummaryEvent x -> SummaryEvent to :: forall x. Rep SummaryEvent x -> SummaryEvent Generic, Int -> SummaryEvent -> ShowS [SummaryEvent] -> ShowS SummaryEvent -> String (Int -> SummaryEvent -> ShowS) -> (SummaryEvent -> String) -> ([SummaryEvent] -> ShowS) -> Show SummaryEvent forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a $cshowsPrec :: Int -> SummaryEvent -> ShowS showsPrec :: Int -> SummaryEvent -> ShowS $cshow :: SummaryEvent -> String show :: SummaryEvent -> String $cshowList :: [SummaryEvent] -> ShowS showList :: [SummaryEvent] -> ShowS Show, [SummaryEvent] -> Value [SummaryEvent] -> Encoding SummaryEvent -> Bool SummaryEvent -> Value SummaryEvent -> Encoding (SummaryEvent -> Value) -> (SummaryEvent -> Encoding) -> ([SummaryEvent] -> Value) -> ([SummaryEvent] -> Encoding) -> (SummaryEvent -> Bool) -> ToJSON SummaryEvent forall a. (a -> Value) -> (a -> Encoding) -> ([a] -> Value) -> ([a] -> Encoding) -> (a -> Bool) -> ToJSON a $ctoJSON :: SummaryEvent -> Value toJSON :: SummaryEvent -> Value $ctoEncoding :: SummaryEvent -> Encoding toEncoding :: SummaryEvent -> Encoding $ctoJSONList :: [SummaryEvent] -> Value toJSONList :: [SummaryEvent] -> Value $ctoEncodingList :: [SummaryEvent] -> Encoding toEncodingList :: [SummaryEvent] -> Encoding $comitField :: SummaryEvent -> Bool omitField :: SummaryEvent -> Bool 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. FlagSummaryContext -> Rep FlagSummaryContext x) -> (forall x. Rep FlagSummaryContext x -> FlagSummaryContext) -> Generic FlagSummaryContext 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 $cfrom :: forall x. FlagSummaryContext -> Rep FlagSummaryContext x from :: forall x. FlagSummaryContext -> Rep FlagSummaryContext x $cto :: forall x. Rep FlagSummaryContext x -> FlagSummaryContext to :: forall x. Rep FlagSummaryContext x -> FlagSummaryContext Generic, Int -> FlagSummaryContext -> ShowS [FlagSummaryContext] -> ShowS FlagSummaryContext -> String (Int -> FlagSummaryContext -> ShowS) -> (FlagSummaryContext -> String) -> ([FlagSummaryContext] -> ShowS) -> Show FlagSummaryContext forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a $cshowsPrec :: Int -> FlagSummaryContext -> ShowS showsPrec :: Int -> FlagSummaryContext -> ShowS $cshow :: FlagSummaryContext -> String show :: FlagSummaryContext -> String $cshowList :: [FlagSummaryContext] -> ShowS showList :: [FlagSummaryContext] -> ShowS Show) instance ToJSON FlagSummaryContext where toJSON :: FlagSummaryContext -> Value toJSON FlagSummaryContext ctx = [Pair] -> Value object ([Pair] -> Value) -> [Pair] -> Value forall a b. (a -> b) -> a -> b $ (Pair -> Bool) -> [Pair] -> [Pair] forall a. (a -> Bool) -> [a] -> [a] filter (Value -> Value -> Bool forall a. Eq a => a -> a -> Bool (/=) Value Null (Value -> Bool) -> (Pair -> Value) -> Pair -> Bool forall b c a. (b -> c) -> (a -> b) -> a -> c . Pair -> Value forall a b. (a, b) -> b snd) [ (Key "default", Maybe Value -> Value forall a. ToJSON a => a -> Value toJSON (Maybe Value -> Value) -> Maybe Value -> Value forall a b. (a -> b) -> a -> b $ forall (f :: Symbol) a s. HasField' f s a => s -> a getField @"defaultValue" FlagSummaryContext ctx) , (Key "counters", [CounterContext] -> Value forall a. ToJSON a => a -> Value toJSON ([CounterContext] -> Value) -> [CounterContext] -> Value forall a b. (a -> b) -> a -> b $ KeyMap CounterContext -> [CounterContext] forall v. KeyMap v -> [v] objectValues (KeyMap CounterContext -> [CounterContext]) -> KeyMap CounterContext -> [CounterContext] forall a b. (a -> b) -> a -> b $ forall (f :: Symbol) a s. HasField' f s a => s -> a getField @"counters" FlagSummaryContext ctx) , (Key "contextKinds", HashSet Text -> Value forall a. ToJSON a => a -> Value toJSON (HashSet Text -> Value) -> HashSet Text -> Value 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. CounterContext -> Rep CounterContext x) -> (forall x. Rep CounterContext x -> CounterContext) -> Generic CounterContext 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 $cfrom :: forall x. CounterContext -> Rep CounterContext x from :: forall x. CounterContext -> Rep CounterContext x $cto :: forall x. Rep CounterContext x -> CounterContext to :: forall x. Rep CounterContext x -> CounterContext Generic, Int -> CounterContext -> ShowS [CounterContext] -> ShowS CounterContext -> String (Int -> CounterContext -> ShowS) -> (CounterContext -> String) -> ([CounterContext] -> ShowS) -> Show CounterContext forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a $cshowsPrec :: Int -> CounterContext -> ShowS showsPrec :: Int -> CounterContext -> ShowS $cshow :: CounterContext -> String show :: CounterContext -> String $cshowList :: [CounterContext] -> ShowS showList :: [CounterContext] -> ShowS Show) instance ToJSON CounterContext where toJSON :: CounterContext -> Value toJSON CounterContext context = [Pair] -> Value object ([Pair] -> Value) -> [Pair] -> Value forall a b. (a -> b) -> a -> b $ [ Key "count" Key -> Natural -> Pair forall v. ToJSON v => Key -> v -> Pair forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv .= forall (f :: Symbol) a s. HasField' f s a => s -> a getField @"count" CounterContext context , Key "value" Key -> Value -> Pair forall v. ToJSON v => Key -> v -> Pair forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv .= forall (f :: Symbol) a s. HasField' f s a => s -> a getField @"value" CounterContext context ] [Pair] -> [Pair] -> [Pair] forall a. Semigroup a => a -> a -> a <> (Pair -> Bool) -> [Pair] -> [Pair] forall a. (a -> Bool) -> [a] -> [a] filter (Value -> Value -> Bool forall a. Eq a => a -> a -> Bool (/=) Value Null (Value -> Bool) -> (Pair -> Value) -> Pair -> Bool forall b c a. (b -> c) -> (a -> b) -> a -> c . Pair -> Value forall a b. (a, b) -> b snd) [ Key "version" Key -> Maybe Natural -> Pair forall v. ToJSON v => Key -> v -> Pair forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv .= forall (f :: Symbol) a s. HasField' f s a => s -> a getField @"version" CounterContext context , Key "variation" Key -> Maybe Integer -> Pair forall v. ToJSON v => Key -> v -> Pair forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv .= forall (f :: Symbol) a s. HasField' f s a => s -> a getField @"variation" CounterContext context , Key "unknown" Key -> Maybe Bool -> Pair forall v. ToJSON v => Key -> v -> Pair forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv .= if forall (f :: Symbol) a s. HasField' f s a => s -> a getField @"unknown" CounterContext context then Bool -> Maybe Bool forall a. a -> Maybe a Just Bool True else Maybe Bool forall a. Maybe a Nothing ] data IdentifyEvent = IdentifyEvent { IdentifyEvent -> Text key :: !Text , IdentifyEvent -> Value context :: !Value } deriving ((forall x. IdentifyEvent -> Rep IdentifyEvent x) -> (forall x. Rep IdentifyEvent x -> IdentifyEvent) -> Generic IdentifyEvent 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 $cfrom :: forall x. IdentifyEvent -> Rep IdentifyEvent x from :: forall x. IdentifyEvent -> Rep IdentifyEvent x $cto :: forall x. Rep IdentifyEvent x -> IdentifyEvent to :: forall x. Rep IdentifyEvent x -> IdentifyEvent Generic, [IdentifyEvent] -> Value [IdentifyEvent] -> Encoding IdentifyEvent -> Bool IdentifyEvent -> Value IdentifyEvent -> Encoding (IdentifyEvent -> Value) -> (IdentifyEvent -> Encoding) -> ([IdentifyEvent] -> Value) -> ([IdentifyEvent] -> Encoding) -> (IdentifyEvent -> Bool) -> ToJSON IdentifyEvent forall a. (a -> Value) -> (a -> Encoding) -> ([a] -> Value) -> ([a] -> Encoding) -> (a -> Bool) -> ToJSON a $ctoJSON :: IdentifyEvent -> Value toJSON :: IdentifyEvent -> Value $ctoEncoding :: IdentifyEvent -> Encoding toEncoding :: IdentifyEvent -> Encoding $ctoJSONList :: [IdentifyEvent] -> Value toJSONList :: [IdentifyEvent] -> Value $ctoEncodingList :: [IdentifyEvent] -> Encoding toEncodingList :: [IdentifyEvent] -> Encoding $comitField :: IdentifyEvent -> Bool omitField :: IdentifyEvent -> Bool ToJSON, Int -> IdentifyEvent -> ShowS [IdentifyEvent] -> ShowS IdentifyEvent -> String (Int -> IdentifyEvent -> ShowS) -> (IdentifyEvent -> String) -> ([IdentifyEvent] -> ShowS) -> Show IdentifyEvent forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a $cshowsPrec :: Int -> IdentifyEvent -> ShowS showsPrec :: Int -> IdentifyEvent -> ShowS $cshow :: IdentifyEvent -> String show :: IdentifyEvent -> String $cshowList :: [IdentifyEvent] -> ShowS showList :: [IdentifyEvent] -> ShowS Show) instance EventKind IdentifyEvent where eventKind :: IdentifyEvent -> Text eventKind IdentifyEvent _ = Text "identify" data IndexEvent = IndexEvent {IndexEvent -> Value context :: Value} deriving ((forall x. IndexEvent -> Rep IndexEvent x) -> (forall x. Rep IndexEvent x -> IndexEvent) -> Generic IndexEvent 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 $cfrom :: forall x. IndexEvent -> Rep IndexEvent x from :: forall x. IndexEvent -> Rep IndexEvent x $cto :: forall x. Rep IndexEvent x -> IndexEvent to :: forall x. Rep IndexEvent x -> IndexEvent Generic, [IndexEvent] -> Value [IndexEvent] -> Encoding IndexEvent -> Bool IndexEvent -> Value IndexEvent -> Encoding (IndexEvent -> Value) -> (IndexEvent -> Encoding) -> ([IndexEvent] -> Value) -> ([IndexEvent] -> Encoding) -> (IndexEvent -> Bool) -> ToJSON IndexEvent forall a. (a -> Value) -> (a -> Encoding) -> ([a] -> Value) -> ([a] -> Encoding) -> (a -> Bool) -> ToJSON a $ctoJSON :: IndexEvent -> Value toJSON :: IndexEvent -> Value $ctoEncoding :: IndexEvent -> Encoding toEncoding :: IndexEvent -> Encoding $ctoJSONList :: [IndexEvent] -> Value toJSONList :: [IndexEvent] -> Value $ctoEncodingList :: [IndexEvent] -> Encoding toEncodingList :: [IndexEvent] -> Encoding $comitField :: IndexEvent -> Bool omitField :: IndexEvent -> Bool ToJSON, Int -> IndexEvent -> ShowS [IndexEvent] -> ShowS IndexEvent -> String (Int -> IndexEvent -> ShowS) -> (IndexEvent -> String) -> ([IndexEvent] -> ShowS) -> Show IndexEvent forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a $cshowsPrec :: Int -> IndexEvent -> ShowS showsPrec :: Int -> IndexEvent -> ShowS $cshow :: IndexEvent -> String show :: IndexEvent -> String $cshowList :: [IndexEvent] -> ShowS showList :: [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. FeatureEvent -> Rep FeatureEvent x) -> (forall x. Rep FeatureEvent x -> FeatureEvent) -> Generic FeatureEvent 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 $cfrom :: forall x. FeatureEvent -> Rep FeatureEvent x from :: forall x. FeatureEvent -> Rep FeatureEvent x $cto :: forall x. Rep FeatureEvent x -> FeatureEvent to :: forall x. Rep FeatureEvent x -> FeatureEvent Generic, Int -> FeatureEvent -> ShowS [FeatureEvent] -> ShowS FeatureEvent -> String (Int -> FeatureEvent -> ShowS) -> (FeatureEvent -> String) -> ([FeatureEvent] -> ShowS) -> Show FeatureEvent forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a $cshowsPrec :: Int -> FeatureEvent -> ShowS showsPrec :: Int -> FeatureEvent -> ShowS $cshow :: FeatureEvent -> String show :: FeatureEvent -> String $cshowList :: [FeatureEvent] -> ShowS showList :: [FeatureEvent] -> ShowS Show) instance ToJSON FeatureEvent where toJSON :: FeatureEvent -> Value toJSON FeatureEvent event = [Pair] -> Value object ([Pair] -> Value) -> [Pair] -> Value forall a b. (a -> b) -> a -> b $ (Pair -> Bool) -> [Pair] -> [Pair] forall a. (a -> Bool) -> [a] -> [a] filter (Value -> Value -> Bool forall a. Eq a => a -> a -> Bool (/=) Value Null (Value -> Bool) -> (Pair -> Value) -> Pair -> Bool forall b c a. (b -> c) -> (a -> b) -> a -> c . Pair -> Value forall a b. (a, b) -> b snd) [ (Key "key", Text -> Value forall a. ToJSON a => a -> Value toJSON (Text -> Value) -> Text -> Value forall a b. (a -> b) -> a -> b $ forall (f :: Symbol) a s. HasField' f s a => s -> a getField @"key" FeatureEvent event) , (Key "context", Maybe Value -> Value forall a. ToJSON a => a -> Value toJSON (Maybe Value -> Value) -> Maybe Value -> Value forall a b. (a -> b) -> a -> b $ forall (f :: Symbol) a s. HasField' f s a => s -> a getField @"context" FeatureEvent event) , (Key "contextKeys", Maybe (KeyMap Text) -> Value forall a. ToJSON a => a -> Value toJSON (Maybe (KeyMap Text) -> Value) -> Maybe (KeyMap Text) -> Value forall a b. (a -> b) -> a -> b $ forall (f :: Symbol) a s. HasField' f s a => s -> a getField @"contextKeys" FeatureEvent event) , (Key "value", Value -> Value forall a. ToJSON a => a -> Value toJSON (Value -> Value) -> Value -> Value forall a b. (a -> b) -> a -> b $ forall (f :: Symbol) a s. HasField' f s a => s -> a getField @"value" FeatureEvent event) , (Key "default", Maybe Value -> Value forall a. ToJSON a => a -> Value toJSON (Maybe Value -> Value) -> Maybe Value -> Value forall a b. (a -> b) -> a -> b $ forall (f :: Symbol) a s. HasField' f s a => s -> a getField @"defaultValue" FeatureEvent event) , (Key "version", Maybe Natural -> Value forall a. ToJSON a => a -> Value toJSON (Maybe Natural -> Value) -> Maybe Natural -> Value forall a b. (a -> b) -> a -> b $ forall (f :: Symbol) a s. HasField' f s a => s -> a getField @"version" FeatureEvent event) , (Key "prereqOf", Maybe Text -> Value forall a. ToJSON a => a -> Value toJSON (Maybe Text -> Value) -> Maybe Text -> Value forall a b. (a -> b) -> a -> b $ forall (f :: Symbol) a s. HasField' f s a => s -> a getField @"prereqOf" FeatureEvent event) , (Key "variation", Maybe Integer -> Value forall a. ToJSON a => a -> Value toJSON (Maybe Integer -> Value) -> Maybe Integer -> Value forall a b. (a -> b) -> a -> b $ forall (f :: Symbol) a s. HasField' f s a => s -> a getField @"variation" FeatureEvent event) , (Key "reason", Maybe EvaluationReason -> Value forall a. ToJSON a => a -> Value toJSON (Maybe EvaluationReason -> Value) -> Maybe EvaluationReason -> Value 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) = FeatureEvent -> Value 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" (Value -> Maybe Value forall a. a -> Maybe a Just (Value -> Maybe Value) -> Value -> Maybe Value 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 = Config -> Context -> FeatureEvent -> FeatureEvent forall r. HasField' "context" r (Maybe Value) => Config -> Context -> r -> r addContextToEvent Config config Context context FeatureEvent event FeatureEvent -> (FeatureEvent -> FeatureEvent) -> FeatureEvent forall a b. a -> (a -> b) -> b & forall (f :: Symbol) s a. HasField' f s a => a -> s -> s setField @"contextKeys" Maybe (KeyMap Text) forall a. Maybe a Nothing contextOrContextKeys Bool False Config _ Context context FeatureEvent event = FeatureEvent event {contextKeys = Just $ getKeys context, context = 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 (FeatureEvent -> FeatureEvent) -> FeatureEvent -> FeatureEvent 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 = Maybe Value forall a. Maybe a Nothing , $sel:contextKeys:FeatureEvent :: Maybe (KeyMap Text) contextKeys = Maybe (KeyMap Text) 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 EvaluationReason -> Maybe EvaluationReason forall a. a -> Maybe a forall (f :: * -> *) a. Applicative f => a -> f a pure (EvaluationReason -> Maybe EvaluationReason) -> EvaluationReason -> Maybe EvaluationReason forall a b. (a -> b) -> a -> b $ forall (f :: Symbol) a s. HasField' f s a => s -> a getField @"reason" EvalEvent event else Maybe EvaluationReason 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. CustomEvent -> Rep CustomEvent x) -> (forall x. Rep CustomEvent x -> CustomEvent) -> Generic CustomEvent 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 $cfrom :: forall x. CustomEvent -> Rep CustomEvent x from :: forall x. CustomEvent -> Rep CustomEvent x $cto :: forall x. Rep CustomEvent x -> CustomEvent to :: forall x. Rep CustomEvent x -> CustomEvent Generic, Int -> CustomEvent -> ShowS [CustomEvent] -> ShowS CustomEvent -> String (Int -> CustomEvent -> ShowS) -> (CustomEvent -> String) -> ([CustomEvent] -> ShowS) -> Show CustomEvent forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a $cshowsPrec :: Int -> CustomEvent -> ShowS showsPrec :: Int -> CustomEvent -> ShowS $cshow :: CustomEvent -> String show :: CustomEvent -> String $cshowList :: [CustomEvent] -> ShowS showList :: [CustomEvent] -> ShowS Show) instance ToJSON CustomEvent where toJSON :: CustomEvent -> Value toJSON CustomEvent ctx = [Pair] -> Value object ([Pair] -> Value) -> [Pair] -> Value forall a b. (a -> b) -> a -> b $ (Pair -> Bool) -> [Pair] -> [Pair] forall a. (a -> Bool) -> [a] -> [a] filter (Value -> Value -> Bool forall a. Eq a => a -> a -> Bool (/=) Value Null (Value -> Bool) -> (Pair -> Value) -> Pair -> Bool forall b c a. (b -> c) -> (a -> b) -> a -> c . Pair -> Value forall a b. (a, b) -> b snd) [ (Key "key", Text -> Value forall a. ToJSON a => a -> Value toJSON (Text -> Value) -> Text -> Value forall a b. (a -> b) -> a -> b $ forall (f :: Symbol) a s. HasField' f s a => s -> a getField @"key" CustomEvent ctx) , (Key "contextKeys", KeyMap Text -> Value forall a. ToJSON a => a -> Value toJSON (KeyMap Text -> Value) -> KeyMap Text -> Value forall a b. (a -> b) -> a -> b $ forall (f :: Symbol) a s. HasField' f s a => s -> a getField @"contextKeys" CustomEvent ctx) , (Key "metricValue", Maybe Double -> Value forall a. ToJSON a => a -> Value toJSON (Maybe Double -> Value) -> Maybe Double -> Value forall a b. (a -> b) -> a -> b $ forall (f :: Symbol) a s. HasField' f s a => s -> a getField @"metricValue" CustomEvent ctx) , (Key "data", Maybe Value -> Value forall a. ToJSON a => a -> Value toJSON (Maybe Value -> Value) -> Maybe Value -> Value 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 x. BaseEvent event -> Rep (BaseEvent event) x) -> (forall x. Rep (BaseEvent event) x -> BaseEvent event) -> Generic (BaseEvent event) forall x. Rep (BaseEvent event) x -> BaseEvent event forall x. BaseEvent event -> Rep (BaseEvent event) x 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 $cfrom :: forall event x. BaseEvent event -> Rep (BaseEvent event) x from :: forall x. BaseEvent event -> Rep (BaseEvent event) x $cto :: forall event x. Rep (BaseEvent event) x -> BaseEvent event to :: forall x. Rep (BaseEvent event) x -> BaseEvent event Generic, Int -> BaseEvent event -> ShowS [BaseEvent event] -> ShowS BaseEvent event -> String (Int -> BaseEvent event -> ShowS) -> (BaseEvent event -> String) -> ([BaseEvent event] -> ShowS) -> Show (BaseEvent event) 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 $cshowsPrec :: forall event. Show event => Int -> BaseEvent event -> ShowS showsPrec :: Int -> BaseEvent event -> ShowS $cshow :: forall event. Show event => BaseEvent event -> String show :: BaseEvent event -> String $cshowList :: forall event. Show event => [BaseEvent event] -> ShowS showList :: [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 _ -> String -> KeyMap 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 (KeyMap Value -> Value) -> KeyMap Value -> Value forall a b. (a -> b) -> a -> b $ KeyMap Value -> KeyMap Value -> KeyMap Value forall v. KeyMap v -> KeyMap v -> KeyMap v keyMapUnion (Value -> KeyMap Value fromObject (Value -> KeyMap Value) -> Value -> KeyMap Value forall a b. (a -> b) -> a -> b $ sub -> Value forall a. ToJSON a => a -> Value toJSON (sub -> Value) -> sub -> Value forall a b. (a -> b) -> a -> b $ forall (f :: Symbol) a s. HasField' f s a => s -> a getField @"event" BaseEvent sub event) (KeyMap Value -> KeyMap Value) -> KeyMap Value -> KeyMap Value forall a b. (a -> b) -> a -> b $ [Item (KeyMap Value)] -> KeyMap Value forall l. IsList l => [Item l] -> l fromList [ (Key "creationDate", Natural -> Value forall a. ToJSON a => a -> Value toJSON (Natural -> Value) -> Natural -> Value 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 (Text -> Value) -> Text -> Value forall a b. (a -> b) -> a -> b $ sub -> Text forall a. EventKind a => a -> Text eventKind (sub -> Text) -> sub -> Text 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 -> BaseEvent IdentifyEvent -> Value forall a. ToJSON a => a -> Value toJSON BaseEvent IdentifyEvent x EventTypeFeature BaseEvent FeatureEvent x -> BaseEvent FeatureEvent -> Value forall a. ToJSON a => a -> Value toJSON BaseEvent FeatureEvent x EventTypeSummary SummaryEvent x -> KeyMap Value -> Value Object (KeyMap Value -> Value) -> KeyMap Value -> Value forall a b. (a -> b) -> a -> b $ Text -> Value -> KeyMap Value -> KeyMap Value forall v. Text -> v -> KeyMap v -> KeyMap v insertKey Text "kind" (Text -> Value String Text "summary") (Value -> KeyMap Value fromObject (Value -> KeyMap Value) -> Value -> KeyMap Value forall a b. (a -> b) -> a -> b $ SummaryEvent -> Value forall a. ToJSON a => a -> Value toJSON SummaryEvent x) EventTypeCustom BaseEvent CustomEvent x -> BaseEvent CustomEvent -> Value forall a. ToJSON a => a -> Value toJSON BaseEvent CustomEvent x EventTypeIndex BaseEvent IndexEvent x -> BaseEvent IndexEvent -> Value forall a. ToJSON a => a -> Value toJSON BaseEvent IndexEvent x EventTypeDebug BaseEvent DebugEvent x -> BaseEvent DebugEvent -> Value 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 = Maybe Integer forall a. Maybe a Nothing , $sel:value:EvalEvent :: Value value = Value defaultValue , $sel:defaultValue:EvalEvent :: Maybe Value defaultValue = Value -> Maybe Value forall a. a -> Maybe a forall (f :: * -> *) a. Applicative f => a -> f a pure Value defaultValue , $sel:version:EvalEvent :: Maybe Natural version = Maybe Natural forall a. Maybe a Nothing , $sel:prereqOf:EvalEvent :: Maybe Text prereqOf = Maybe Text 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 = Maybe Natural 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 = Natural -> Maybe Natural forall a. a -> Maybe a Just (Natural -> Maybe Natural) -> Natural -> Maybe Natural 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 [Rule] -> Int -> Rule forall a. HasCallStack => [a] -> Int -> a !! Natural -> Int 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 "-" [ Text -> Maybe Text -> Text forall a. a -> Maybe a -> a fromMaybe Text "" (Maybe Text -> Text) -> Maybe Text -> Text forall a b. (a -> b) -> a -> b $ (Natural -> Text) -> Maybe Natural -> Maybe Text forall a b. (a -> b) -> Maybe a -> Maybe b forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap (String -> Text T.pack (String -> Text) -> (Natural -> String) -> Natural -> Text forall b c a. (b -> c) -> (a -> b) -> a -> c . Natural -> String forall a. Show a => a -> String show) (Maybe Natural -> Maybe Text) -> Maybe Natural -> Maybe Text forall a b. (a -> b) -> a -> b $ forall (f :: Symbol) a s. HasField' f s a => s -> a getField @"version" EvalEvent event , Text -> Maybe Text -> Text forall a. a -> Maybe a -> a fromMaybe Text "" (Maybe Text -> Text) -> Maybe Text -> Text forall a b. (a -> b) -> a -> b $ (Integer -> Text) -> Maybe Integer -> Maybe Text forall a b. (a -> b) -> Maybe a -> Maybe b forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap (String -> Text T.pack (String -> Text) -> (Integer -> String) -> Integer -> Text forall b c a. (b -> c) -> (a -> b) -> a -> c . Integer -> String forall a. Show a => a -> String show) (Maybe Integer -> Maybe Text) -> Maybe Integer -> Maybe Text 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 = [Text] -> HashSet Text forall a. (Eq a, Hashable a) => [a] -> HashSet a HS.fromList ([Text] -> HashSet Text) -> [Text] -> HashSet Text forall a b. (a -> b) -> a -> b $ Context -> [Text] getKinds (Context -> [Text]) -> Context -> [Text] 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 Text -> KeyMap FlagSummaryContext -> Maybe FlagSummaryContext 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 = KeyMap CounterContext forall a. Monoid a => a mempty , $sel:contextKinds:FlagSummaryContext :: HashSet Text contextKinds = HashSet Text forall a. Monoid a => a mempty } leaf :: CounterContext leaf = case Text -> KeyMap CounterContext -> Maybe CounterContext 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 CounterContext -> (CounterContext -> CounterContext) -> CounterContext 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" ((Natural -> Identity Natural) -> CounterContext -> Identity CounterContext) -> (Natural -> Natural) -> CounterContext -> CounterContext forall s t a b. ASetter s t a b -> (a -> b) -> s -> t %~ (Natural 1 Natural -> Natural -> Natural 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 = (FlagSummaryContext -> KeyMap FlagSummaryContext -> KeyMap FlagSummaryContext) -> KeyMap FlagSummaryContext -> FlagSummaryContext -> KeyMap FlagSummaryContext forall a b c. (a -> b -> c) -> b -> a -> c flip (Text -> FlagSummaryContext -> KeyMap FlagSummaryContext -> KeyMap FlagSummaryContext forall v. Text -> v -> KeyMap v -> KeyMap v insertKey (Text -> FlagSummaryContext -> KeyMap FlagSummaryContext -> KeyMap FlagSummaryContext) -> Text -> FlagSummaryContext -> KeyMap FlagSummaryContext -> KeyMap FlagSummaryContext 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 (FlagSummaryContext -> KeyMap FlagSummaryContext) -> FlagSummaryContext -> KeyMap FlagSummaryContext forall a b. (a -> b) -> a -> b $ (FlagSummaryContext root FlagSummaryContext -> (FlagSummaryContext -> FlagSummaryContext) -> FlagSummaryContext 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" ((KeyMap CounterContext -> Identity (KeyMap CounterContext)) -> FlagSummaryContext -> Identity FlagSummaryContext) -> (KeyMap CounterContext -> KeyMap CounterContext) -> FlagSummaryContext -> FlagSummaryContext forall s t a b. ASetter s t a b -> (a -> b) -> s -> t %~ (Text -> CounterContext -> KeyMap CounterContext -> KeyMap CounterContext forall v. Text -> v -> KeyMap v -> KeyMap v insertKey Text key CounterContext leaf) FlagSummaryContext -> (FlagSummaryContext -> FlagSummaryContext) -> FlagSummaryContext 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" ((HashSet Text -> Identity (HashSet Text)) -> FlagSummaryContext -> Identity FlagSummaryContext) -> (HashSet Text -> HashSet Text) -> FlagSummaryContext -> FlagSummaryContext forall s t a b. ASetter s t a b -> (a -> b) -> s -> t %~ (HashSet Text -> HashSet Text -> HashSet Text forall a. Eq 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 = MVar a -> IO (Maybe a) forall a. MVar a -> IO (Maybe a) tryTakeMVar MVar a mvar IO (Maybe a) -> (Maybe a -> IO ()) -> IO () forall a b. IO a -> (a -> IO b) -> IO b forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= \case Just a x -> MVar a -> a -> IO () forall a. MVar a -> a -> IO () putMVar MVar a mvar a x; Maybe a Nothing -> MVar a -> a -> IO () 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 = MVar Natural -> Natural -> IO () forall a. MVar a -> a -> IO () putIfEmptyMVar (forall (f :: Symbol) a s. HasField' f s a => s -> a getField @"startDate" EventState state) Natural now IO () -> IO () -> IO () forall a b. IO a -> IO b -> IO b forall (m :: * -> *) a b. Monad m => m a -> m b -> m b >> MVar (KeyMap FlagSummaryContext) -> (KeyMap FlagSummaryContext -> IO (KeyMap FlagSummaryContext)) -> IO () 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 -> KeyMap FlagSummaryContext -> IO (KeyMap FlagSummaryContext) forall a. a -> IO a forall (f :: * -> *) a. Applicative f => a -> f a pure (KeyMap FlagSummaryContext -> IO (KeyMap FlagSummaryContext)) -> KeyMap FlagSummaryContext -> IO (KeyMap FlagSummaryContext) 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 = Natural -> Maybe Natural -> Natural 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 (Integer -> Natural) -> (Integer -> Integer) -> Integer -> Natural forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> (Integer -> Integer -> Integer forall a. Num a => a -> a -> a * Integer 1000) (Integer -> Natural) -> IO Integer -> IO Natural forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> MVar Integer -> IO Integer forall a. MVar a -> IO a readMVar (forall (f :: Symbol) a s. HasField' f s a => s -> a getField @"lastKnownServerTime" EventState state) Bool -> IO () -> IO () forall (f :: * -> *). Applicative f => Bool -> f () -> f () when Bool trackEvents (IO () -> IO ()) -> IO () -> IO () forall a b. (a -> b) -> a -> b $ Config -> EventState -> EventType -> IO () queueEvent Config config EventState state (EventType -> IO ()) -> EventType -> IO () forall a b. (a -> b) -> a -> b $ BaseEvent FeatureEvent -> EventType EventTypeFeature (BaseEvent FeatureEvent -> EventType) -> BaseEvent FeatureEvent -> EventType forall a b. (a -> b) -> a -> b $ Natural -> FeatureEvent -> BaseEvent FeatureEvent forall event. Natural -> event -> BaseEvent event BaseEvent Natural now FeatureEvent featureEvent Bool -> IO () -> IO () forall (f :: * -> *). Applicative f => Bool -> f () -> f () when (Natural now Natural -> Natural -> Bool forall a. Ord a => a -> a -> Bool < Natural debugEventsUntilDate Bool -> Bool -> Bool && Natural lastKnownServerTime Natural -> Natural -> Bool forall a. Ord a => a -> a -> Bool < Natural debugEventsUntilDate) (IO () -> IO ()) -> IO () -> IO () forall a b. (a -> b) -> a -> b $ Config -> EventState -> EventType -> IO () queueEvent Config config EventState state (EventType -> IO ()) -> EventType -> IO () forall a b. (a -> b) -> a -> b $ BaseEvent DebugEvent -> EventType EventTypeDebug (BaseEvent DebugEvent -> EventType) -> BaseEvent DebugEvent -> EventType forall a b. (a -> b) -> a -> b $ Natural -> DebugEvent -> BaseEvent DebugEvent forall event. Natural -> event -> BaseEvent event BaseEvent Natural now (DebugEvent -> BaseEvent DebugEvent) -> DebugEvent -> BaseEvent DebugEvent forall a b. (a -> b) -> a -> b $ FeatureEvent -> DebugEvent DebugEvent (FeatureEvent -> DebugEvent) -> FeatureEvent -> 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 IO Natural -> (Natural -> IO ()) -> IO () forall a b. IO a -> (a -> IO b) -> IO b forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= \Natural now -> (EvalEvent -> IO ()) -> [EvalEvent] -> IO () 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 Bool -> IO () -> IO () forall (f :: * -> *). Applicative f => Bool -> f () -> f () when Bool noticedContext (IO () -> IO ()) -> IO () -> IO () forall a b. (a -> b) -> a -> b $ Config -> EventState -> EventType -> IO () queueEvent Config config EventState state (BaseEvent IndexEvent -> EventType EventTypeIndex (BaseEvent IndexEvent -> EventType) -> BaseEvent IndexEvent -> EventType forall a b. (a -> b) -> a -> b $ Natural -> IndexEvent -> BaseEvent IndexEvent forall event. Natural -> event -> BaseEvent event BaseEvent Natural now (IndexEvent -> BaseEvent IndexEvent) -> IndexEvent -> BaseEvent IndexEvent 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 = MVar (LRU Text ()) -> (LRU Text () -> IO (LRU Text (), Bool)) -> IO Bool 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) ((LRU Text () -> IO (LRU Text (), Bool)) -> IO Bool) -> (LRU Text () -> IO (LRU Text (), Bool)) -> IO Bool forall a b. (a -> b) -> a -> b $ \LRU Text () cache -> do let key :: Text key = Context -> Text getCanonicalKey Context context case Text -> LRU Text () -> (LRU Text (), Maybe ()) 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 () _) -> (LRU Text (), Bool) -> IO (LRU Text (), Bool) forall a. a -> IO a forall (f :: * -> *) a. Applicative f => a -> f a pure (LRU Text () cache', Bool False) (LRU Text () cache', Maybe () Nothing) -> (LRU Text (), Bool) -> IO (LRU Text (), Bool) forall a. a -> IO a forall (f :: * -> *) a. Applicative f => a -> f a pure (Text -> () -> LRU Text () -> LRU Text () forall key val. Ord key => key -> val -> LRU key val -> LRU key val LRU.insert Text key () LRU Text () cache', Bool True)