module LaunchDarkly.Server.Events where

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

import           LaunchDarkly.Server.Config.Internal (ConfigI, shouldSendEvents)
import           LaunchDarkly.Server.User.Internal   (UserI, userSerializeRedacted)
import           LaunchDarkly.Server.Details         (EvaluationReason(..))
import           LaunchDarkly.Server.Features        (Flag)

data ContextKind = ContextKindUser | ContextKindAnonymousUser
    deriving (ContextKind -> ContextKind -> Bool
(ContextKind -> ContextKind -> Bool)
-> (ContextKind -> ContextKind -> Bool) -> Eq ContextKind
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ContextKind -> ContextKind -> Bool
$c/= :: ContextKind -> ContextKind -> Bool
== :: ContextKind -> ContextKind -> Bool
$c== :: ContextKind -> ContextKind -> Bool
Eq, Int -> ContextKind -> ShowS
[ContextKind] -> ShowS
ContextKind -> String
(Int -> ContextKind -> ShowS)
-> (ContextKind -> String)
-> ([ContextKind] -> ShowS)
-> Show ContextKind
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ContextKind] -> ShowS
$cshowList :: [ContextKind] -> ShowS
show :: ContextKind -> String
$cshow :: ContextKind -> String
showsPrec :: Int -> ContextKind -> ShowS
$cshowsPrec :: Int -> ContextKind -> ShowS
Show)

instance ToJSON ContextKind where
  toJSON :: ContextKind -> Value
toJSON ContextKind
contextKind = Text -> Value
String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ case ContextKind
contextKind of
      ContextKind
ContextKindUser          -> Text
"user" 
      ContextKind
ContextKindAnonymousUser -> Text
"anonymousUser"

userGetContextKind :: UserI -> ContextKind
userGetContextKind :: UserI -> ContextKind
userGetContextKind UserI
user = if (UserI -> Bool
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"anonymous" UserI
user)
    then ContextKind
ContextKindAnonymousUser else ContextKind
ContextKindUser

data EvalEvent = EvalEvent
    { EvalEvent -> Text
key                  :: !Text
    , EvalEvent -> Maybe Natural
variation            :: !(Maybe Natural)
    , 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 ()
flush      :: !(MVar ())
    , EventState
-> MVar
     (HashMap Text (FlagSummaryContext (HashMap Text CounterContext)))
summary    :: !(MVar (HashMap Text (FlagSummaryContext (HashMap Text CounterContext))))
    , EventState -> MVar Natural
startDate  :: !(MVar Natural)
    , EventState -> MVar (LRU Text ())
userKeyLRU :: !(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 :: ConfigI -> IO EventState
makeEventState :: ConfigI -> IO EventState
makeEventState ConfigI
config = do
    MVar [EventType]
events     <- [EventType] -> IO (MVar [EventType])
forall a. a -> IO (MVar a)
newMVar []
    MVar ()
flush      <- IO (MVar ())
forall a. IO (MVar a)
newEmptyMVar
    MVar
  (HashMap Text (FlagSummaryContext (HashMap Text CounterContext)))
summary    <- HashMap Text (FlagSummaryContext (HashMap Text CounterContext))
-> IO
     (MVar
        (HashMap Text (FlagSummaryContext (HashMap Text CounterContext))))
forall a. a -> IO (MVar a)
newMVar HashMap Text (FlagSummaryContext (HashMap Text CounterContext))
forall a. Monoid a => a
mempty
    MVar Natural
startDate  <- IO (MVar Natural)
forall a. IO (MVar a)
newEmptyMVar
    MVar (LRU Text ())
userKeyLRU <- 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
$ ConfigI -> Natural
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"userKeyLRUCapacity" ConfigI
config
    EventState -> IO EventState
forall (f :: * -> *) a. Applicative f => a -> f a
pure EventState :: MVar [EventType]
-> MVar ()
-> MVar
     (HashMap Text (FlagSummaryContext (HashMap Text CounterContext)))
-> MVar Natural
-> MVar (LRU Text ())
-> EventState
EventState{MVar Natural
MVar [EventType]
MVar ()
MVar
  (HashMap Text (FlagSummaryContext (HashMap Text CounterContext)))
MVar (LRU Text ())
userKeyLRU :: MVar (LRU Text ())
startDate :: MVar Natural
summary :: MVar
  (HashMap Text (FlagSummaryContext (HashMap Text CounterContext)))
flush :: MVar ()
events :: MVar [EventType]
$sel:userKeyLRU:EventState :: MVar (LRU Text ())
$sel:startDate:EventState :: MVar Natural
$sel:summary:EventState :: MVar
  (HashMap Text (FlagSummaryContext (HashMap Text CounterContext)))
$sel:flush:EventState :: MVar ()
$sel:events:EventState :: MVar [EventType]
..}

convertFeatures :: HashMap Text (FlagSummaryContext (HashMap Text CounterContext))
    -> HashMap Text (FlagSummaryContext [CounterContext])
convertFeatures :: HashMap Text (FlagSummaryContext (HashMap Text CounterContext))
-> HashMap Text (FlagSummaryContext [CounterContext])
convertFeatures HashMap Text (FlagSummaryContext (HashMap Text CounterContext))
summary = (((FlagSummaryContext (HashMap Text CounterContext)
  -> FlagSummaryContext [CounterContext])
 -> HashMap Text (FlagSummaryContext (HashMap Text CounterContext))
 -> HashMap Text (FlagSummaryContext [CounterContext]))
-> HashMap Text (FlagSummaryContext (HashMap Text CounterContext))
-> (FlagSummaryContext (HashMap Text CounterContext)
    -> FlagSummaryContext [CounterContext])
-> HashMap Text (FlagSummaryContext [CounterContext])
forall a b c. (a -> b -> c) -> b -> a -> c
flip (FlagSummaryContext (HashMap Text CounterContext)
 -> FlagSummaryContext [CounterContext])
-> HashMap Text (FlagSummaryContext (HashMap Text CounterContext))
-> HashMap Text (FlagSummaryContext [CounterContext])
forall v1 v2 k. (v1 -> v2) -> HashMap k v1 -> HashMap k v2
HM.map) HashMap Text (FlagSummaryContext (HashMap Text CounterContext))
summary ((FlagSummaryContext (HashMap Text CounterContext)
  -> FlagSummaryContext [CounterContext])
 -> HashMap Text (FlagSummaryContext [CounterContext]))
-> (FlagSummaryContext (HashMap Text CounterContext)
    -> FlagSummaryContext [CounterContext])
-> HashMap Text (FlagSummaryContext [CounterContext])
forall a b. (a -> b) -> a -> b
$ \FlagSummaryContext (HashMap Text CounterContext)
context -> FlagSummaryContext (HashMap Text CounterContext)
context FlagSummaryContext (HashMap Text CounterContext)
-> (FlagSummaryContext (HashMap Text CounterContext)
    -> FlagSummaryContext [CounterContext])
-> FlagSummaryContext [CounterContext]
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" ((HashMap Text CounterContext -> Identity [CounterContext])
 -> FlagSummaryContext (HashMap Text CounterContext)
 -> Identity (FlagSummaryContext [CounterContext]))
-> (HashMap Text CounterContext -> [CounterContext])
-> FlagSummaryContext (HashMap Text CounterContext)
-> FlagSummaryContext [CounterContext]
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ HashMap Text CounterContext -> [CounterContext]
forall k v. HashMap k v -> [v]
HM.elems

queueEvent :: ConfigI -> EventState -> EventType -> IO ()
queueEvent :: ConfigI -> EventState -> EventType -> IO ()
queueEvent ConfigI
config EventState
state EventType
event = if Bool -> Bool
not (ConfigI -> Bool
shouldSendEvents ConfigI
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
$ \[EventType]
events ->
    if [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 (ConfigI -> Natural
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"eventsCapacity" ConfigI
config) then [EventType] -> IO [EventType]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (EventType
event EventType -> [EventType] -> [EventType]
forall a. a -> [a] -> [a]
: [EventType]
events) else [EventType] -> IO [EventType]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [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
* 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 :: a -> IO (BaseEvent a)
makeBaseEvent 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
>>= \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 :: ConfigI -> EventState -> IO ()
processSummary :: ConfigI -> EventState -> IO ()
processSummary ConfigI
config 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
    Maybe Natural
Nothing          -> () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    (Just Natural
startDate) -> do
        Natural
endDate  <- IO Natural
unixMilliseconds
        HashMap Text (FlagSummaryContext [CounterContext])
features <- HashMap Text (FlagSummaryContext (HashMap Text CounterContext))
-> HashMap Text (FlagSummaryContext [CounterContext])
convertFeatures (HashMap Text (FlagSummaryContext (HashMap Text CounterContext))
 -> HashMap Text (FlagSummaryContext [CounterContext]))
-> IO
     (HashMap Text (FlagSummaryContext (HashMap Text CounterContext)))
-> IO (HashMap Text (FlagSummaryContext [CounterContext]))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MVar
  (HashMap Text (FlagSummaryContext (HashMap Text CounterContext)))
-> HashMap Text (FlagSummaryContext (HashMap Text CounterContext))
-> IO
     (HashMap Text (FlagSummaryContext (HashMap Text CounterContext)))
forall a. MVar a -> a -> IO a
swapMVar (EventState
-> MVar
     (HashMap Text (FlagSummaryContext (HashMap Text CounterContext)))
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"summary" EventState
state) HashMap Text (FlagSummaryContext (HashMap Text CounterContext))
forall a. Monoid a => a
mempty
        SummaryEvent -> IO (BaseEvent SummaryEvent)
forall a. a -> IO (BaseEvent a)
makeBaseEvent SummaryEvent :: Natural
-> Natural
-> HashMap Text (FlagSummaryContext [CounterContext])
-> SummaryEvent
SummaryEvent {Natural
HashMap Text (FlagSummaryContext [CounterContext])
$sel:features:SummaryEvent :: HashMap Text (FlagSummaryContext [CounterContext])
$sel:endDate:SummaryEvent :: Natural
$sel:startDate:SummaryEvent :: Natural
features :: HashMap Text (FlagSummaryContext [CounterContext])
endDate :: Natural
startDate :: Natural
..} IO (BaseEvent SummaryEvent)
-> (BaseEvent SummaryEvent -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ConfigI -> EventState -> EventType -> IO ()
queueEvent ConfigI
config EventState
state (EventType -> IO ())
-> (BaseEvent SummaryEvent -> EventType)
-> BaseEvent SummaryEvent
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BaseEvent SummaryEvent -> EventType
EventTypeSummary

class EventKind a where
    eventKind :: a -> Text

data SummaryEvent = SummaryEvent
    { SummaryEvent -> Natural
startDate :: !Natural
    , SummaryEvent -> Natural
endDate   :: !Natural
    , SummaryEvent -> HashMap Text (FlagSummaryContext [CounterContext])
features  :: !(HashMap Text (FlagSummaryContext [CounterContext]))
    } 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 SummaryEvent
_ = Text
"summary"

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

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

data CounterContext = CounterContext
    { CounterContext -> Natural
count     :: !Natural
    , CounterContext -> Maybe Natural
version   :: !(Maybe Natural)
    , CounterContext -> Maybe Natural
variation :: !(Maybe Natural)
    , 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, [CounterContext] -> Encoding
[CounterContext] -> Value
CounterContext -> Encoding
CounterContext -> Value
(CounterContext -> Value)
-> (CounterContext -> Encoding)
-> ([CounterContext] -> Value)
-> ([CounterContext] -> Encoding)
-> ToJSON CounterContext
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [CounterContext] -> Encoding
$ctoEncodingList :: [CounterContext] -> Encoding
toJSONList :: [CounterContext] -> Value
$ctoJSONList :: [CounterContext] -> Value
toEncoding :: CounterContext -> Encoding
$ctoEncoding :: CounterContext -> Encoding
toJSON :: CounterContext -> Value
$ctoJSON :: CounterContext -> Value
ToJSON)

data IdentifyEvent = IdentifyEvent
    { IdentifyEvent -> Text
key  :: !Text
    , IdentifyEvent -> Value
user :: !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 IdentifyEvent
_ = Text
"identify"

data IndexEvent = IndexEvent { IndexEvent -> Value
user :: 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 IndexEvent
_ = Text
"index"

data FeatureEvent = FeatureEvent
    { FeatureEvent -> Text
key          :: !Text
    , FeatureEvent -> Maybe Value
user         :: !(Maybe Value)
    , FeatureEvent -> Maybe Text
userKey      :: !(Maybe Text)
    , FeatureEvent -> Value
value        :: !Value
    , FeatureEvent -> Maybe Value
defaultValue :: !(Maybe Value)
    , FeatureEvent -> Maybe Natural
version      :: !(Maybe Natural)
    , FeatureEvent -> Maybe Natural
variation    :: !(Maybe Natural)
    , FeatureEvent -> Maybe EvaluationReason
reason       :: !(Maybe EvaluationReason)
    , FeatureEvent -> ContextKind
contextKind  :: !ContextKind
    } 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 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)
        [ (Text
"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)
        , (Text
"user",        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 @"user"         FeatureEvent
event)
        , (Text
"userKey",     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 @"userKey"      FeatureEvent
event)
        , (Text
"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)
        , (Text
"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)
        , (Text
"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)
        , (Text
"variation",   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 @"variation"    FeatureEvent
event)
        , (Text
"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)
        , (Text
"contextKind", let c :: ContextKind
c = (FeatureEvent -> ContextKind
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"contextKind" FeatureEvent
event) in
            if ContextKind
c ContextKind -> ContextKind -> Bool
forall a. Eq a => a -> a -> Bool
== ContextKind
ContextKindUser then Value
Null else ContextKind -> Value
forall a. ToJSON a => a -> Value
toJSON ContextKind
c)
        ]

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

addUserToEvent :: (HasField' "user" r (Maybe Value), HasField' "userKey" r (Maybe Text)) => ConfigI -> UserI -> r -> r
addUserToEvent :: ConfigI -> UserI -> r -> r
addUserToEvent ConfigI
config UserI
user r
event = if ConfigI -> Bool
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"inlineUsersInEvents" ConfigI
config
    then Maybe Value -> r -> r
forall (f :: Symbol) s a. HasField' f s a => a -> s -> s
setField @"user" (Value -> Maybe Value
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ ConfigI -> UserI -> Value
userSerializeRedacted ConfigI
config UserI
user) r
event
    else Maybe Text -> r -> r
forall (f :: Symbol) s a. HasField' f s a => a -> s -> s
setField @"userKey" (Text -> Maybe Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ UserI -> Text
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"key" UserI
user) r
event

makeFeatureEvent :: ConfigI -> UserI -> Bool -> EvalEvent -> FeatureEvent
makeFeatureEvent :: ConfigI -> UserI -> Bool -> EvalEvent -> FeatureEvent
makeFeatureEvent ConfigI
config UserI
user Bool
includeReason EvalEvent
event = ConfigI -> UserI -> FeatureEvent -> FeatureEvent
forall r.
(HasField' "user" r (Maybe Value),
 HasField' "userKey" r (Maybe Text)) =>
ConfigI -> UserI -> r -> r
addUserToEvent ConfigI
config UserI
user (FeatureEvent -> FeatureEvent) -> FeatureEvent -> FeatureEvent
forall a b. (a -> b) -> a -> b
$ FeatureEvent :: Text
-> Maybe Value
-> Maybe Text
-> Value
-> Maybe Value
-> Maybe Natural
-> Maybe Natural
-> Maybe EvaluationReason
-> ContextKind
-> 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:user:FeatureEvent :: Maybe Value
user         = Maybe Value
forall a. Maybe a
Nothing
    , $sel:userKey:FeatureEvent :: Maybe Text
userKey      = Maybe Text
forall a. Maybe a
Nothing
    , $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:variation:FeatureEvent :: Maybe Natural
variation    = EvalEvent -> Maybe Natural
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
    , $sel:contextKind:FeatureEvent :: ContextKind
contextKind  = UserI -> ContextKind
userGetContextKind UserI
user
    }

data CustomEvent = CustomEvent
    { CustomEvent -> Text
key         :: !Text
    , CustomEvent -> Maybe Value
user        :: !(Maybe Value)
    , CustomEvent -> Maybe Text
userKey     :: !(Maybe Text)
    , CustomEvent -> Maybe Double
metricValue :: !(Maybe Double)
    , CustomEvent -> Maybe Value
value       :: !(Maybe Value)
    , CustomEvent -> ContextKind
contextKind :: !ContextKind
    } 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 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)
        [ (Text
"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)
        , (Text
"user",        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 @"user"        CustomEvent
ctx)
        , (Text
"userKey",     Maybe Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Maybe Text -> Value) -> Maybe Text -> Value
forall a b. (a -> b) -> a -> b
$ CustomEvent -> Maybe Text
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"userKey"     CustomEvent
ctx)
        , (Text
"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)
        , (Text
"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)
        , (Text
"contextKind", let c :: ContextKind
c = (CustomEvent -> ContextKind
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"contextKind" CustomEvent
ctx) in
            if ContextKind
c ContextKind -> ContextKind -> Bool
forall a. Eq a => a -> a -> Bool
== ContextKind
ContextKindUser then Value
Null else ContextKind -> Value
forall a. ToJSON a => a -> Value
toJSON ContextKind
c)
        ]

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

data AliasEvent = AliasEvent
    { AliasEvent -> Text
key                 :: !Text
    , AliasEvent -> ContextKind
contextKind         :: !ContextKind
    , AliasEvent -> Text
previousKey         :: !Text
    , AliasEvent -> ContextKind
previousContextKind :: !ContextKind
    }
    deriving ((forall x. AliasEvent -> Rep AliasEvent x)
-> (forall x. Rep AliasEvent x -> AliasEvent) -> Generic AliasEvent
forall x. Rep AliasEvent x -> AliasEvent
forall x. AliasEvent -> Rep AliasEvent x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AliasEvent x -> AliasEvent
$cfrom :: forall x. AliasEvent -> Rep AliasEvent x
Generic, Int -> AliasEvent -> ShowS
[AliasEvent] -> ShowS
AliasEvent -> String
(Int -> AliasEvent -> ShowS)
-> (AliasEvent -> String)
-> ([AliasEvent] -> ShowS)
-> Show AliasEvent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AliasEvent] -> ShowS
$cshowList :: [AliasEvent] -> ShowS
show :: AliasEvent -> String
$cshow :: AliasEvent -> String
showsPrec :: Int -> AliasEvent -> ShowS
$cshowsPrec :: Int -> AliasEvent -> ShowS
Show)

instance ToJSON AliasEvent where
    toJSON :: AliasEvent -> Value
toJSON AliasEvent
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)
        [ (Text
"key",                 Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ AliasEvent -> Text
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"key"                 AliasEvent
ctx)
        , (Text
"contextKind",         ContextKind -> Value
forall a. ToJSON a => a -> Value
toJSON (ContextKind -> Value) -> ContextKind -> Value
forall a b. (a -> b) -> a -> b
$ AliasEvent -> ContextKind
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"contextKind"         AliasEvent
ctx)
        , (Text
"previousKey",         Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ AliasEvent -> Text
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"previousKey"         AliasEvent
ctx)
        , (Text
"previousContextKind", ContextKind -> Value
forall a. ToJSON a => a -> Value
toJSON (ContextKind -> Value) -> ContextKind -> Value
forall a b. (a -> b) -> a -> b
$ AliasEvent -> ContextKind
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"previousContextKind" AliasEvent
ctx)
        ]

instance EventKind AliasEvent where
    eventKind :: AliasEvent -> Text
eventKind AliasEvent
_ = Text
"alias"

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 -> HashMap Text Value
fromObject :: Value -> HashMap Text Value
fromObject Value
x = case Value
x of (Object HashMap Text Value
o) -> HashMap Text Value
o; Value
_ -> String -> HashMap Text 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 = HashMap Text Value -> Value
Object (HashMap Text Value -> Value) -> HashMap Text Value -> Value
forall a b. (a -> b) -> a -> b
$ HashMap Text Value -> HashMap Text Value -> HashMap Text Value
forall k v.
(Eq k, Hashable k) =>
HashMap k v -> HashMap k v -> HashMap k v
HM.union (Value -> HashMap Text Value
fromObject (Value -> HashMap Text Value) -> Value -> HashMap Text 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) (HashMap Text Value -> HashMap Text Value)
-> HashMap Text Value -> HashMap Text Value
forall a b. (a -> b) -> a -> b
$ [Pair] -> HashMap Text Value
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList
        [ (Text
"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)
        , (Text
"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  !(BaseEvent SummaryEvent)
    | EventTypeCustom   !(BaseEvent CustomEvent)
    | EventTypeIndex    !(BaseEvent IndexEvent)
    | EventTypeDebug    !(BaseEvent DebugEvent)
    | EventTypeAlias    !(BaseEvent AliasEvent)

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  BaseEvent SummaryEvent
x -> BaseEvent SummaryEvent -> Value
forall a. ToJSON a => a -> Value
toJSON BaseEvent 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
        EventTypeAlias    BaseEvent AliasEvent
x -> BaseEvent AliasEvent -> Value
forall a. ToJSON a => a -> Value
toJSON BaseEvent AliasEvent
x

newUnknownFlagEvent :: Text -> Value -> EvaluationReason -> EvalEvent
newUnknownFlagEvent :: Text -> Value -> EvaluationReason -> EvalEvent
newUnknownFlagEvent Text
key Value
defaultValue EvaluationReason
reason = EvalEvent :: Text
-> Maybe Natural
-> Value
-> Maybe Value
-> Maybe Natural
-> Maybe Text
-> EvaluationReason
-> Bool
-> Bool
-> Bool
-> Maybe Natural
-> EvalEvent
EvalEvent
    { $sel:key:EvalEvent :: Text
key                  = Text
key
    , $sel:variation:EvalEvent :: Maybe Natural
variation            = Maybe Natural
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 Natural -> Value -> Maybe Value -> EvaluationReason -> Maybe Text -> EvalEvent
newSuccessfulEvalEvent :: Flag
-> Maybe Natural
-> Value
-> Maybe Value
-> EvaluationReason
-> Maybe Text
-> EvalEvent
newSuccessfulEvalEvent Flag
flag Maybe Natural
variation Value
value Maybe Value
defaultValue EvaluationReason
reason Maybe Text
prereqOf = EvalEvent :: Text
-> Maybe Natural
-> 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:variation:EvalEvent :: Maybe Natural
variation            = Maybe Natural
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
        EvaluationReason
EvaluationReasonFallthrough       -> Flag -> Bool
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"trackEventsFallthrough" Flag
flag
        (EvaluationReasonRuleMatch Natural
idx Text
_) -> 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)
        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 (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 Text
"" (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 @"variation" EvalEvent
event
    ]

summarizeEvent :: (HashMap Text (FlagSummaryContext (HashMap Text CounterContext)))
    -> EvalEvent -> Bool -> (HashMap Text (FlagSummaryContext (HashMap Text CounterContext)))
summarizeEvent :: HashMap Text (FlagSummaryContext (HashMap Text CounterContext))
-> EvalEvent
-> Bool
-> HashMap Text (FlagSummaryContext (HashMap Text CounterContext))
summarizeEvent HashMap Text (FlagSummaryContext (HashMap Text CounterContext))
context EvalEvent
event Bool
unknown = HashMap Text (FlagSummaryContext (HashMap Text CounterContext))
result where
    key :: Text
key = EvalEvent -> Text
makeSummaryKey EvalEvent
event
    root :: FlagSummaryContext (HashMap Text CounterContext)
root = case Text
-> HashMap Text (FlagSummaryContext (HashMap Text CounterContext))
-> Maybe (FlagSummaryContext (HashMap Text CounterContext))
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup (EvalEvent -> Text
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"key" EvalEvent
event) HashMap Text (FlagSummaryContext (HashMap Text CounterContext))
context of
        (Just FlagSummaryContext (HashMap Text CounterContext)
x) -> FlagSummaryContext (HashMap Text CounterContext)
x; Maybe (FlagSummaryContext (HashMap Text CounterContext))
Nothing  -> Maybe Value
-> HashMap Text CounterContext
-> FlagSummaryContext (HashMap Text CounterContext)
forall a. Maybe Value -> a -> FlagSummaryContext a
FlagSummaryContext (EvalEvent -> Maybe Value
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"defaultValue" EvalEvent
event) HashMap Text CounterContext
forall a. Monoid a => a
mempty
    leaf :: CounterContext
leaf = case Text -> HashMap Text CounterContext -> Maybe CounterContext
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup Text
key (FlagSummaryContext (HashMap Text CounterContext)
-> HashMap Text CounterContext
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"counters" FlagSummaryContext (HashMap Text CounterContext)
root) of
        (Just 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
%~ (Natural
1 Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
+)
        Maybe CounterContext
Nothing  -> CounterContext :: Natural
-> Maybe Natural
-> Maybe Natural
-> Value
-> Bool
-> CounterContext
CounterContext
            { $sel:count:CounterContext :: Natural
count     = Natural
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 Natural
variation = EvalEvent -> Maybe Natural
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 :: HashMap Text (FlagSummaryContext (HashMap Text CounterContext))
result = (FlagSummaryContext (HashMap Text CounterContext)
 -> HashMap Text (FlagSummaryContext (HashMap Text CounterContext))
 -> HashMap Text (FlagSummaryContext (HashMap Text CounterContext)))
-> HashMap Text (FlagSummaryContext (HashMap Text CounterContext))
-> FlagSummaryContext (HashMap Text CounterContext)
-> HashMap Text (FlagSummaryContext (HashMap Text CounterContext))
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Text
-> FlagSummaryContext (HashMap Text CounterContext)
-> HashMap Text (FlagSummaryContext (HashMap Text CounterContext))
-> HashMap Text (FlagSummaryContext (HashMap Text CounterContext))
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HM.insert (Text
 -> FlagSummaryContext (HashMap Text CounterContext)
 -> HashMap Text (FlagSummaryContext (HashMap Text CounterContext))
 -> HashMap Text (FlagSummaryContext (HashMap Text CounterContext)))
-> Text
-> FlagSummaryContext (HashMap Text CounterContext)
-> HashMap Text (FlagSummaryContext (HashMap Text CounterContext))
-> HashMap Text (FlagSummaryContext (HashMap Text CounterContext))
forall a b. (a -> b) -> a -> b
$ EvalEvent -> Text
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"key" EvalEvent
event) HashMap Text (FlagSummaryContext (HashMap Text CounterContext))
context (FlagSummaryContext (HashMap Text CounterContext)
 -> HashMap Text (FlagSummaryContext (HashMap Text CounterContext)))
-> FlagSummaryContext (HashMap Text CounterContext)
-> HashMap Text (FlagSummaryContext (HashMap Text CounterContext))
forall a b. (a -> b) -> a -> b
$
        FlagSummaryContext (HashMap Text CounterContext)
root FlagSummaryContext (HashMap Text CounterContext)
-> (FlagSummaryContext (HashMap Text CounterContext)
    -> FlagSummaryContext (HashMap Text CounterContext))
-> FlagSummaryContext (HashMap Text CounterContext)
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" ((HashMap Text CounterContext
  -> Identity (HashMap Text CounterContext))
 -> FlagSummaryContext (HashMap Text CounterContext)
 -> Identity (FlagSummaryContext (HashMap Text CounterContext)))
-> (HashMap Text CounterContext -> HashMap Text CounterContext)
-> FlagSummaryContext (HashMap Text CounterContext)
-> FlagSummaryContext (HashMap Text CounterContext)
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Text
-> CounterContext
-> HashMap Text CounterContext
-> HashMap Text CounterContext
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HM.insert Text
key CounterContext
leaf

putIfEmptyMVar :: MVar a -> a -> IO ()
putIfEmptyMVar :: 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 (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 (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
  (HashMap Text (FlagSummaryContext (HashMap Text CounterContext)))
-> (HashMap Text (FlagSummaryContext (HashMap Text CounterContext))
    -> IO
         (HashMap Text (FlagSummaryContext (HashMap Text CounterContext))))
-> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ (EventState
-> MVar
     (HashMap Text (FlagSummaryContext (HashMap Text CounterContext)))
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"summary" EventState
state) (\HashMap Text (FlagSummaryContext (HashMap Text CounterContext))
summary -> HashMap Text (FlagSummaryContext (HashMap Text CounterContext))
-> IO
     (HashMap Text (FlagSummaryContext (HashMap Text CounterContext)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HashMap Text (FlagSummaryContext (HashMap Text CounterContext))
 -> IO
      (HashMap Text (FlagSummaryContext (HashMap Text CounterContext))))
-> HashMap Text (FlagSummaryContext (HashMap Text CounterContext))
-> IO
     (HashMap Text (FlagSummaryContext (HashMap Text CounterContext)))
forall a b. (a -> b) -> a -> b
$ HashMap Text (FlagSummaryContext (HashMap Text CounterContext))
-> EvalEvent
-> Bool
-> HashMap Text (FlagSummaryContext (HashMap Text CounterContext))
summarizeEvent HashMap Text (FlagSummaryContext (HashMap Text CounterContext))
summary EvalEvent
event Bool
unknown)

processEvalEvent :: Natural -> ConfigI -> EventState -> UserI -> Bool -> Bool -> EvalEvent -> IO ()
processEvalEvent :: Natural
-> ConfigI
-> EventState
-> UserI
-> Bool
-> Bool
-> EvalEvent
-> IO ()
processEvalEvent Natural
now ConfigI
config EventState
state UserI
user Bool
includeReason Bool
unknown EvalEvent
event = do
    let featureEvent :: FeatureEvent
featureEvent = ConfigI -> UserI -> Bool -> EvalEvent -> FeatureEvent
makeFeatureEvent ConfigI
config UserI
user Bool
includeReason EvalEvent
event
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (EvalEvent -> Bool
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"trackEvents" EvalEvent
event) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        ConfigI -> EventState -> EventType -> IO ()
queueEvent ConfigI
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 -> BaseEvent FeatureEvent)
-> FeatureEvent -> BaseEvent FeatureEvent
forall a b. (a -> b) -> a -> b
$ 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 -> Maybe Natural -> Natural
forall a. a -> Maybe a -> a
fromMaybe Natural
0 (EvalEvent -> Maybe Natural
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"debugEventsUntilDate" EvalEvent
event)) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        ConfigI -> EventState -> EventType -> IO ()
queueEvent ConfigI
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
featureEvent
    Natural -> EventState -> EvalEvent -> Bool -> IO ()
runSummary Natural
now EventState
state EvalEvent
event Bool
unknown
    Natural -> ConfigI -> UserI -> EventState -> IO ()
maybeIndexUser Natural
now ConfigI
config UserI
user EventState
state

processEvalEvents :: ConfigI -> EventState -> UserI -> Bool -> [EvalEvent] -> Bool -> IO ()
processEvalEvents :: ConfigI
-> EventState -> UserI -> Bool -> [EvalEvent] -> Bool -> IO ()
processEvalEvents ConfigI
config EventState
state UserI
user Bool
includeReason [EvalEvent]
events Bool
unknown = IO Natural
unixMilliseconds IO Natural -> (Natural -> IO ()) -> IO ()
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
-> ConfigI
-> EventState
-> UserI
-> Bool
-> Bool
-> EvalEvent
-> IO ()
processEvalEvent Natural
now ConfigI
config EventState
state UserI
user Bool
includeReason Bool
unknown) [EvalEvent]
events

maybeIndexUser :: Natural -> ConfigI -> UserI -> EventState -> IO ()
maybeIndexUser :: Natural -> ConfigI -> UserI -> EventState -> IO ()
maybeIndexUser Natural
now ConfigI
config UserI
user EventState
state = MVar (LRU Text ()) -> (LRU Text () -> IO (LRU Text ())) -> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ (EventState -> MVar (LRU Text ())
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"userKeyLRU" EventState
state) ((LRU Text () -> IO (LRU Text ())) -> IO ())
-> (LRU Text () -> IO (LRU Text ())) -> IO ()
forall a b. (a -> b) -> a -> b
$ \LRU Text ()
cache ->
    let key :: Text
key = UserI -> Text
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"key" UserI
user in 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 () -> IO (LRU Text ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure LRU Text ()
cache'
        (LRU Text ()
cache', Maybe ()
Nothing) -> do
            ConfigI -> EventState -> EventType -> IO ()
queueEvent ConfigI
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:user:IndexEvent :: Value
user = ConfigI -> UserI -> Value
userSerializeRedacted ConfigI
config UserI
user })
            LRU Text () -> IO (LRU Text ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure (LRU Text () -> IO (LRU Text ()))
-> LRU Text () -> IO (LRU Text ())
forall a b. (a -> b) -> a -> b
$ 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'