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 (field, getField)
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, getKinds, redactContext, redactContextRedactAnonymous)
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
$cto :: forall x. Rep EvalEvent x -> EvalEvent
$cfrom :: forall x. EvalEvent -> Rep EvalEvent x
Generic, EvalEvent -> EvalEvent -> Bool
(EvalEvent -> EvalEvent -> Bool)
-> (EvalEvent -> EvalEvent -> Bool) -> Eq EvalEvent
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
(Int -> EvalEvent -> ShowS)
-> (EvalEvent -> String)
-> ([EvalEvent] -> ShowS)
-> Show EvalEvent
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. 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
$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
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 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 (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
$ Config -> Natural
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"contextKeyLRUCapacity" Config
config
    EventState -> IO EventState
forall (f :: * -> *) a. Applicative f => a -> f a
pure $WEventState :: MVar [EventType]
-> MVar Integer
-> MVar ()
-> MVar (KeyMap FlagSummaryContext)
-> MVar Natural
-> MVar (LRU Text ())
-> EventState
EventState {..}

queueEvent :: Config -> EventState -> EventType -> IO ()
queueEvent :: Config -> EventState -> EventType -> IO ()
queueEvent config :: Config
config state :: EventState
state event :: EventType
event =
    if Bool -> Bool
not (Config -> Bool
shouldSendEvents Config
config)
        then () -> IO ()
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_ (EventState -> MVar [EventType]
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
$ \events :: [EventType]
events ->
            [EventType] -> IO [EventType]
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 _ -> EventType
event EventType -> [EventType] -> [EventType]
forall a. a -> [a] -> [a]
: [EventType]
events
                _ | [EventType] -> 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 (Config -> Natural
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]
events

unixMilliseconds :: IO Natural
unixMilliseconds :: IO Natural
unixMilliseconds = POSIXTime -> Natural
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
* 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 :: a -> IO (BaseEvent a)
makeBaseEvent child :: a
child = IO Natural
unixMilliseconds IO Natural -> (Natural -> IO (BaseEvent a)) -> IO (BaseEvent a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \now :: Natural
now -> BaseEvent a -> IO (BaseEvent 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 :: forall event. Natural -> event -> BaseEvent event
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
config state :: EventState
state =
    MVar Natural -> IO (Maybe Natural)
forall a. MVar a -> IO (Maybe a)
tryTakeMVar (EventState -> MVar Natural
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"startDate" EventState
state) IO (Maybe Natural) -> (Maybe Natural -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Nothing -> () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        (Just startDate :: 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 (EventState -> MVar (KeyMap FlagSummaryContext)
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
$ $WSummaryEvent :: Natural -> Natural -> KeyMap FlagSummaryContext -> SummaryEvent
SummaryEvent {..}

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
$cto :: forall x. Rep SummaryEvent x -> SummaryEvent
$cfrom :: forall x. SummaryEvent -> Rep SummaryEvent x
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
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
(SummaryEvent -> Value)
-> (SummaryEvent -> Encoding)
-> ([SummaryEvent] -> Value)
-> ([SummaryEvent] -> Encoding)
-> ToJSON SummaryEvent
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 _ = "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
$cto :: forall x. Rep FlagSummaryContext x -> FlagSummaryContext
$cfrom :: forall x. FlagSummaryContext -> Rep FlagSummaryContext x
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
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 ctx :: 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)
                [ ("default", Maybe Value -> Value
forall a. ToJSON a => a -> Value
toJSON (Maybe Value -> Value) -> Maybe Value -> Value
forall a b. (a -> b) -> a -> b
$ FlagSummaryContext -> Maybe Value
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"defaultValue" FlagSummaryContext
ctx)
                , ("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. HashMap Text v -> [v]
objectValues (KeyMap CounterContext -> [CounterContext])
-> KeyMap CounterContext -> [CounterContext]
forall a b. (a -> b) -> a -> b
$ FlagSummaryContext -> KeyMap CounterContext
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"counters" FlagSummaryContext
ctx)
                , ("contextKinds", HashSet Text -> Value
forall a. ToJSON a => a -> Value
toJSON (HashSet Text -> Value) -> HashSet Text -> Value
forall a b. (a -> b) -> a -> b
$ FlagSummaryContext -> HashSet Text
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
$cto :: forall x. Rep CounterContext x -> CounterContext
$cfrom :: forall x. CounterContext -> Rep CounterContext x
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
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 context :: CounterContext
context =
        [Pair] -> Value
object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$
            [ "count" Text -> Natural -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= CounterContext -> Natural
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"count" CounterContext
context
            , "value" Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= CounterContext -> Value
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)
                    [ "version" Text -> Maybe Natural -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= CounterContext -> Maybe Natural
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"version" CounterContext
context
                    , "variation" Text -> Maybe Integer -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= CounterContext -> Maybe Integer
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"variation" CounterContext
context
                    , "unknown" Text -> Maybe Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= if CounterContext -> Bool
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
$cto :: forall x. Rep IdentifyEvent x -> IdentifyEvent
$cfrom :: forall x. IdentifyEvent -> Rep IdentifyEvent x
Generic, [IdentifyEvent] -> Encoding
[IdentifyEvent] -> Value
IdentifyEvent -> Encoding
IdentifyEvent -> Value
(IdentifyEvent -> Value)
-> (IdentifyEvent -> Encoding)
-> ([IdentifyEvent] -> Value)
-> ([IdentifyEvent] -> Encoding)
-> ToJSON IdentifyEvent
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
(Int -> IdentifyEvent -> ShowS)
-> (IdentifyEvent -> String)
-> ([IdentifyEvent] -> ShowS)
-> Show IdentifyEvent
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 _ = "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
$cto :: forall x. Rep IndexEvent x -> IndexEvent
$cfrom :: forall x. IndexEvent -> Rep IndexEvent x
Generic, [IndexEvent] -> Encoding
[IndexEvent] -> Value
IndexEvent -> Encoding
IndexEvent -> Value
(IndexEvent -> Value)
-> (IndexEvent -> Encoding)
-> ([IndexEvent] -> Value)
-> ([IndexEvent] -> Encoding)
-> ToJSON IndexEvent
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
(Int -> IndexEvent -> ShowS)
-> (IndexEvent -> String)
-> ([IndexEvent] -> ShowS)
-> Show IndexEvent
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 _ = "index"

data FeatureEvent = FeatureEvent
    { FeatureEvent -> Text
key :: !Text
    , FeatureEvent -> Value
context :: !Value
    , 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
$cto :: forall x. Rep FeatureEvent x -> FeatureEvent
$cfrom :: forall x. FeatureEvent -> Rep FeatureEvent x
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
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 event :: 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", Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ FeatureEvent -> Text
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"key" FeatureEvent
event)
                , ("context", Value -> Value
forall a. ToJSON a => a -> Value
toJSON (Value -> Value) -> Value -> Value
forall a b. (a -> b) -> a -> b
$ FeatureEvent -> Value
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"context" FeatureEvent
event)
                , ("value", Value -> Value
forall a. ToJSON a => a -> Value
toJSON (Value -> Value) -> Value -> Value
forall a b. (a -> b) -> a -> b
$ FeatureEvent -> Value
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"value" FeatureEvent
event)
                , ("default", Maybe Value -> Value
forall a. ToJSON a => a -> Value
toJSON (Maybe Value -> Value) -> Maybe Value -> Value
forall a b. (a -> b) -> a -> b
$ FeatureEvent -> Maybe Value
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"defaultValue" FeatureEvent
event)
                , ("version", Maybe Natural -> Value
forall a. ToJSON a => a -> Value
toJSON (Maybe Natural -> Value) -> Maybe Natural -> Value
forall a b. (a -> b) -> a -> b
$ FeatureEvent -> Maybe Natural
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"version" FeatureEvent
event)
                , ("prereqOf", Maybe Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Maybe Text -> Value) -> Maybe Text -> Value
forall a b. (a -> b) -> a -> b
$ FeatureEvent -> Maybe Text
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"prereqOf" FeatureEvent
event)
                , ("variation", Maybe Integer -> Value
forall a. ToJSON a => a -> Value
toJSON (Maybe Integer -> Value) -> Maybe Integer -> Value
forall a b. (a -> b) -> a -> b
$ FeatureEvent -> Maybe Integer
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"variation" FeatureEvent
event)
                , ("reason", Maybe EvaluationReason -> Value
forall a. ToJSON a => a -> Value
toJSON (Maybe EvaluationReason -> Value)
-> Maybe EvaluationReason -> Value
forall a b. (a -> b) -> a -> b
$ FeatureEvent -> Maybe EvaluationReason
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"reason" FeatureEvent
event)
                ]

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

newtype DebugEvent = DebugEvent FeatureEvent

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

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

makeDebugEvent :: Config -> Context -> Bool -> EvalEvent -> DebugEvent
makeDebugEvent :: Config -> Context -> Bool -> EvalEvent -> DebugEvent
makeDebugEvent config :: Config
config context :: Context
context includeReason :: Bool
includeReason event :: EvalEvent
event =
    FeatureEvent -> DebugEvent
DebugEvent (FeatureEvent -> DebugEvent) -> FeatureEvent -> DebugEvent
forall a b. (a -> b) -> a -> b
$ Value -> Bool -> EvalEvent -> FeatureEvent
makeFeatureEventWithContextPayload (Config -> Context -> Value
redactContext Config
config Context
context) Bool
includeReason EvalEvent
event

makeFeatureEvent :: Config -> Context -> Bool -> EvalEvent -> FeatureEvent
makeFeatureEvent :: Config -> Context -> Bool -> EvalEvent -> FeatureEvent
makeFeatureEvent config :: Config
config context :: Context
context includeReason :: Bool
includeReason event :: EvalEvent
event =
    Value -> Bool -> EvalEvent -> FeatureEvent
makeFeatureEventWithContextPayload (Config -> Context -> Value
redactContextRedactAnonymous Config
config Context
context) Bool
includeReason EvalEvent
event

makeFeatureEventWithContextPayload :: Value -> Bool -> EvalEvent -> FeatureEvent
makeFeatureEventWithContextPayload :: Value -> Bool -> EvalEvent -> FeatureEvent
makeFeatureEventWithContextPayload context :: Value
context includeReason :: Bool
includeReason event :: EvalEvent
event =
    $WFeatureEvent :: Text
-> Value
-> Value
-> Maybe Value
-> Maybe Natural
-> Maybe Text
-> Maybe Integer
-> Maybe EvaluationReason
-> FeatureEvent
FeatureEvent
        { $sel:key:FeatureEvent :: Text
key = EvalEvent -> Text
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"key" EvalEvent
event
        , $sel:context:FeatureEvent :: Value
context = Value
context
        , $sel:value:FeatureEvent :: Value
value = EvalEvent -> Value
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"value" EvalEvent
event
        , $sel:defaultValue:FeatureEvent :: Maybe Value
defaultValue = EvalEvent -> Maybe Value
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"defaultValue" EvalEvent
event
        , $sel:version:FeatureEvent :: Maybe Natural
version = EvalEvent -> Maybe Natural
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"version" EvalEvent
event
        , $sel:prereqOf:FeatureEvent :: Maybe Text
prereqOf = EvalEvent -> Maybe Text
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"prereqOf" EvalEvent
event
        , $sel:variation:FeatureEvent :: Maybe Integer
variation = EvalEvent -> Maybe Integer
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
|| EvalEvent -> Bool
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"forceIncludeReason" EvalEvent
event
                then EvaluationReason -> Maybe EvaluationReason
forall (f :: * -> *) a. Applicative f => a -> f a
pure (EvaluationReason -> Maybe EvaluationReason)
-> EvaluationReason -> Maybe EvaluationReason
forall a b. (a -> b) -> a -> b
$ EvalEvent -> EvaluationReason
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
$cto :: forall x. Rep CustomEvent x -> CustomEvent
$cfrom :: forall x. CustomEvent -> Rep CustomEvent x
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
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 ctx :: 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", Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ CustomEvent -> Text
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"key" CustomEvent
ctx)
                , ("contextKeys", KeyMap Text -> Value
forall a. ToJSON a => a -> Value
toJSON (KeyMap Text -> Value) -> KeyMap Text -> Value
forall a b. (a -> b) -> a -> b
$ CustomEvent -> KeyMap Text
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"contextKeys" CustomEvent
ctx)
                , ("metricValue", Maybe Double -> Value
forall a. ToJSON a => a -> Value
toJSON (Maybe Double -> Value) -> Maybe Double -> Value
forall a b. (a -> b) -> a -> b
$ CustomEvent -> Maybe Double
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"metricValue" CustomEvent
ctx)
                , ("data", Maybe Value -> Value
forall a. ToJSON a => a -> Value
toJSON (Maybe Value -> Value) -> Maybe Value -> Value
forall a b. (a -> b) -> a -> b
$ CustomEvent -> Maybe Value
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"value" CustomEvent
ctx)
                ]

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

data BaseEvent event = BaseEvent
    { BaseEvent event -> Natural
creationDate :: Natural
    , 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
$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
[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
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 x :: Value
x = case Value
x of (Object o :: KeyMap Value
o) -> KeyMap Value
o; _ -> String -> KeyMap Value
forall a. HasCallStack => String -> a
error "expected object"

instance (EventKind sub, ToJSON sub) => ToJSON (BaseEvent sub) where
    toJSON :: BaseEvent sub -> Value
toJSON event :: 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. HashMap Text v -> HashMap Text v -> HashMap Text 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
$ BaseEvent sub -> sub
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
                    [ ("creationDate", Natural -> Value
forall a. ToJSON a => a -> Value
toJSON (Natural -> Value) -> Natural -> Value
forall a b. (a -> b) -> a -> b
$ BaseEvent sub -> Natural
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"creationDate" BaseEvent sub
event)
                    , ("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
$ BaseEvent sub -> sub
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 event :: EventType
event = case EventType
event of
        EventTypeIdentify x :: BaseEvent IdentifyEvent
x -> BaseEvent IdentifyEvent -> Value
forall a. ToJSON a => a -> Value
toJSON BaseEvent IdentifyEvent
x
        EventTypeFeature x :: BaseEvent FeatureEvent
x -> BaseEvent FeatureEvent -> Value
forall a. ToJSON a => a -> Value
toJSON BaseEvent FeatureEvent
x
        EventTypeSummary x :: 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 -> HashMap Text v -> HashMap Text v
insertKey "kind" (Text -> Value
String "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 x :: BaseEvent CustomEvent
x -> BaseEvent CustomEvent -> Value
forall a. ToJSON a => a -> Value
toJSON BaseEvent CustomEvent
x
        EventTypeIndex x :: BaseEvent IndexEvent
x -> BaseEvent IndexEvent -> Value
forall a. ToJSON a => a -> Value
toJSON BaseEvent IndexEvent
x
        EventTypeDebug x :: 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 key :: Text
key defaultValue :: Value
defaultValue reason :: EvaluationReason
reason context :: Context
context =
    $WEvalEvent :: Text
-> Context
-> Maybe Integer
-> Value
-> Maybe Value
-> Maybe Natural
-> Maybe Text
-> EvaluationReason
-> Bool
-> Bool
-> Bool
-> Maybe Natural
-> EvalEvent
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 (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
flag variation :: Maybe Integer
variation value :: Value
value defaultValue :: Maybe Value
defaultValue reason :: EvaluationReason
reason prereqOf :: Maybe Text
prereqOf context :: Context
context =
    $WEvalEvent :: Text
-> Context
-> Maybe Integer
-> Value
-> Maybe Value
-> Maybe Natural
-> Maybe Text
-> EvaluationReason
-> Bool
-> Bool
-> Bool
-> Maybe Natural
-> EvalEvent
EvalEvent
        { $sel:key:EvalEvent :: Text
key = Flag -> Text
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
$ Flag -> Natural
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 = Flag -> Bool
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 = Flag -> Maybe Natural
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"debugEventsUntilDate" Flag
flag
        }
  where
    shouldForceReason :: Bool
shouldForceReason = case EvaluationReason
reason of
        (EvaluationReasonFallthrough inExperiment :: Bool
inExperiment) ->
            Bool
inExperiment Bool -> Bool -> Bool
|| Flag -> Bool
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"trackEventsFallthrough" Flag
flag
        (EvaluationReasonRuleMatch idx :: Natural
idx _ inExperiment :: Bool
inExperiment) ->
            Bool
inExperiment Bool -> Bool -> Bool
|| Rule -> Bool
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"trackEvents" (Flag -> [Rule]
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"rules" Flag
flag [Rule] -> Int -> Rule
forall a. [a] -> Int -> a
!! Natural -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
idx)
        _ -> Bool
False

makeSummaryKey :: EvalEvent -> Text
makeSummaryKey :: EvalEvent -> Text
makeSummaryKey event :: EvalEvent
event =
    Text -> [Text] -> Text
T.intercalate
        "-"
        [ Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe "" (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ (Natural -> Text) -> Maybe Natural -> Maybe Text
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
$ EvalEvent -> Maybe Natural
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 "" (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ (Integer -> Text) -> Maybe Integer -> Maybe Text
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
$ EvalEvent -> Maybe Integer
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 summaryContext :: KeyMap FlagSummaryContext
summaryContext event :: EvalEvent
event unknown :: 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
$ EvalEvent -> Context
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 -> HashMap Text v -> Maybe v
lookupKey (EvalEvent -> Text
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"key" EvalEvent
event) KeyMap FlagSummaryContext
summaryContext of
        (Just x :: FlagSummaryContext
x) -> FlagSummaryContext
x
        Nothing ->
            FlagSummaryContext :: Maybe Value
-> KeyMap CounterContext -> HashSet Text -> FlagSummaryContext
FlagSummaryContext
                { $sel:defaultValue:FlagSummaryContext :: Maybe Value
defaultValue = (EvalEvent -> Maybe Value
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 -> HashMap Text v -> Maybe v
lookupKey Text
key (FlagSummaryContext -> KeyMap CounterContext
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"counters" FlagSummaryContext
root) of
        (Just x :: CounterContext
x) -> CounterContext
x CounterContext
-> (CounterContext -> CounterContext) -> CounterContext
forall a b. a -> (a -> b) -> b
& forall s t a b. HasField "count" s t a b => Lens s t a 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
%~ (1 Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
+)
        Nothing ->
            $WCounterContext :: Natural
-> Maybe Natural
-> Maybe Integer
-> Value
-> Bool
-> CounterContext
CounterContext
                { $sel:count:CounterContext :: Natural
count = 1
                , $sel:version:CounterContext :: Maybe Natural
version = EvalEvent -> Maybe Natural
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"version" EvalEvent
event
                , $sel:variation:CounterContext :: Maybe Integer
variation = EvalEvent -> Maybe Integer
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"variation" EvalEvent
event
                , $sel:value:CounterContext :: Value
value = EvalEvent -> 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 -> HashMap Text v -> HashMap Text v
insertKey (Text
 -> FlagSummaryContext
 -> KeyMap FlagSummaryContext
 -> KeyMap FlagSummaryContext)
-> Text
-> FlagSummaryContext
-> KeyMap FlagSummaryContext
-> KeyMap FlagSummaryContext
forall a b. (a -> b) -> a -> b
$ EvalEvent -> Text
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 s t a b. HasField "counters" s t a b => Lens s t a 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 -> HashMap Text v -> HashMap Text v
insertKey Text
key CounterContext
leaf) FlagSummaryContext
-> (FlagSummaryContext -> FlagSummaryContext) -> FlagSummaryContext
forall a b. a -> (a -> b) -> b
& forall s t a b. HasField "contextKinds" s t a b => Lens s t a 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, Hashable a) => HashSet a -> HashSet a -> HashSet a
HS.union HashSet Text
contextKinds))

putIfEmptyMVar :: MVar a -> a -> IO ()
putIfEmptyMVar :: MVar a -> a -> IO ()
putIfEmptyMVar mvar :: MVar a
mvar value :: 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 (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case Just x :: a
x -> MVar a -> a -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar a
mvar a
x; 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 now :: Natural
now state :: EventState
state event :: EvalEvent
event unknown :: Bool
unknown =
    MVar Natural -> Natural -> IO ()
forall a. MVar a -> a -> IO ()
putIfEmptyMVar (EventState -> MVar Natural
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"startDate" EventState
state) Natural
now
        IO () -> IO () -> IO ()
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_ (EventState -> MVar (KeyMap FlagSummaryContext)
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"summary" EventState
state) (\summary :: KeyMap FlagSummaryContext
summary -> KeyMap FlagSummaryContext -> IO (KeyMap FlagSummaryContext)
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 now :: Natural
now config :: Config
config state :: EventState
state context :: Context
context includeReason :: Bool
includeReason unknown :: Bool
unknown event :: EvalEvent
event = do
    let featureEvent :: FeatureEvent
featureEvent = Config -> Context -> Bool -> EvalEvent -> FeatureEvent
makeFeatureEvent Config
config Context
context Bool
includeReason EvalEvent
event
        trackEvents :: Bool
trackEvents = EvalEvent -> Bool
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 0 (EvalEvent -> Maybe Natural
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
* 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 (EventState -> MVar Integer
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
$
                    Config -> Context -> Bool -> EvalEvent -> DebugEvent
makeDebugEvent Config
config Context
context Bool
includeReason EvalEvent
event
    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
config state :: EventState
state context :: Context
context includeReason :: Bool
includeReason events :: [EvalEvent]
events unknown :: Bool
unknown =
    IO Natural
unixMilliseconds IO Natural -> (Natural -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \now :: 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 now :: Natural
now config :: Config
config context :: Context
context state :: 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 :: Value -> IndexEvent
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 state :: EventState
state context :: 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 (EventState -> MVar (LRU Text ())
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
$ \cache :: 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
        (cache' :: LRU Text ()
cache', Just _) -> (LRU Text (), Bool) -> IO (LRU Text (), Bool)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (LRU Text ()
cache', Bool
False)
        (cache' :: LRU Text ()
cache', Nothing) -> (LRU Text (), Bool) -> IO (LRU Text (), Bool)
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)