module LaunchDarkly.Server.Evaluate where

import           Control.Lens                        ((%~))
import           Control.Monad                       (mzero, msum)
import           Control.Monad.Extra                 (ifM, anyM, allM, firstJustM)
import           Crypto.Hash.SHA1                    (hash)
import           Data.Scientific                     (Scientific, floatingOrInteger)
import           Data.Either                         (either, fromLeft)
import           Data.Function                       ((&))
import           Data.Aeson.Types                    (Value(..))
import           Data.Maybe                          (maybe, fromJust, isJust, fromMaybe)
import           Data.Text                           (Text)
import           Data.Generics.Product               (getField, field)
import           Data.List                           (genericIndex, null, find)
import qualified Data.Vector as                      V
import qualified Data.Text as                        T
import qualified Data.ByteString as                  B
import qualified Data.ByteString.Base16 as           B16
import           Data.Text.Encoding                  (encodeUtf8)
import           GHC.Natural                         (Natural)
import           Data.Word                           (Word8)
import           Data.ByteString                     (ByteString)

import           LaunchDarkly.Server.Client.Internal (ClientI, Status(Initialized), getStatusI)
import           LaunchDarkly.Server.User.Internal   (UserI, valueOf)
import           LaunchDarkly.Server.Features        (Flag, Segment, Prerequisite, SegmentRule, Clause, VariationOrRollout, Rule, RolloutKind(RolloutKindExperiment))
import           LaunchDarkly.Server.Store.Internal  (LaunchDarklyStoreRead, getFlagC, getSegmentC)
import           LaunchDarkly.Server.Operators       (Op(OpSegmentMatch), getOperation)
import           LaunchDarkly.Server.Events          (EvalEvent, newUnknownFlagEvent, newSuccessfulEvalEvent, processEvalEvents)
import           LaunchDarkly.Server.Details         (EvaluationDetail(..), EvaluationReason(..), EvalErrorKind(..))

setFallback :: EvaluationDetail Value -> Value -> EvaluationDetail Value
setFallback :: EvaluationDetail Value -> Value -> EvaluationDetail Value
setFallback EvaluationDetail Value
detail Value
fallback = case forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"variationIndex" EvaluationDetail Value
detail of
    Maybe Integer
Nothing -> EvaluationDetail Value
detail { $sel:value:EvaluationDetail :: Value
value = Value
fallback }; Maybe Integer
_ -> EvaluationDetail Value
detail

setValue :: EvaluationDetail Value -> a -> EvaluationDetail a
setValue :: forall a. EvaluationDetail Value -> a -> EvaluationDetail a
setValue EvaluationDetail Value
x a
v = EvaluationDetail Value
x { $sel:value:EvaluationDetail :: a
value = a
v }

isError :: EvaluationReason -> Bool
isError :: EvaluationReason -> Bool
isError EvaluationReason
reason = case EvaluationReason
reason of (EvaluationReasonError EvalErrorKind
_) -> Bool
True; EvaluationReason
_ -> Bool
False

evaluateTyped :: ClientI -> Text -> UserI -> a -> (a -> Value) -> Bool -> (Value -> Maybe a) -> IO (EvaluationDetail a)
evaluateTyped :: forall a.
ClientI
-> Text
-> UserI
-> a
-> (a -> Value)
-> Bool
-> (Value -> Maybe a)
-> IO (EvaluationDetail a)
evaluateTyped ClientI
client Text
key UserI
user a
fallback a -> Value
wrap Bool
includeReason Value -> Maybe a
convert = ClientI -> IO Status
getStatusI ClientI
client forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Status
status -> if Status
status forall a. Eq a => a -> a -> Bool
/= Status
Initialized
    then forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall value.
value
-> Maybe Integer -> EvaluationReason -> EvaluationDetail value
EvaluationDetail a
fallback forall a. Maybe a
Nothing forall a b. (a -> b) -> a -> b
$ EvalErrorKind -> EvaluationReason
EvaluationReasonError EvalErrorKind
EvalErrorClientNotReady
    else ClientI
-> Text -> UserI -> Value -> Bool -> IO (EvaluationDetail Value)
evaluateInternalClient ClientI
client Text
key UserI
user (a -> Value
wrap a
fallback) Bool
includeReason forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \EvaluationDetail Value
r -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall b a. b -> (a -> b) -> Maybe a -> b
maybe
        (forall value.
value
-> Maybe Integer -> EvaluationReason -> EvaluationDetail value
EvaluationDetail a
fallback forall a. Maybe a
Nothing forall a b. (a -> b) -> a -> b
$ if EvaluationReason -> Bool
isError (forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"reason" EvaluationDetail Value
r)
            then (forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"reason" EvaluationDetail Value
r) else EvalErrorKind -> EvaluationReason
EvaluationReasonError EvalErrorKind
EvalErrorWrongType)
        (forall a. EvaluationDetail Value -> a -> EvaluationDetail a
setValue EvaluationDetail Value
r) (Value -> Maybe a
convert forall a b. (a -> b) -> a -> b
$ forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"value" EvaluationDetail Value
r)

evaluateInternalClient :: ClientI -> Text -> UserI -> Value -> Bool -> IO (EvaluationDetail Value)
evaluateInternalClient :: ClientI
-> Text -> UserI -> Value -> Bool -> IO (EvaluationDetail Value)
evaluateInternalClient ClientI
client Text
key UserI
user Value
fallback Bool
includeReason = do
    (EvaluationDetail Value
reason, Bool
unknown, [EvalEvent]
events) <- forall store (m :: * -> *).
LaunchDarklyStoreRead store m =>
store -> Text -> StoreResultM m (Maybe Flag)
getFlagC (forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"store" ClientI
client) Text
key forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Left Text
err          -> do
            let event :: EvalEvent
event = Text -> Value -> EvaluationReason -> EvalEvent
newUnknownFlagEvent Text
key Value
fallback (EvalErrorKind -> EvaluationReason
EvaluationReasonError forall a b. (a -> b) -> a -> b
$ Text -> EvalErrorKind
EvalErrorExternalStore Text
err)
            forall (f :: * -> *) a. Applicative f => a -> f a
pure (EvalErrorKind -> EvaluationDetail Value
errorDetail forall a b. (a -> b) -> a -> b
$ Text -> EvalErrorKind
EvalErrorExternalStore Text
err, Bool
True, forall (f :: * -> *) a. Applicative f => a -> f a
pure EvalEvent
event)
        Right Maybe Flag
Nothing     -> do
            let event :: EvalEvent
event = Text -> Value -> EvaluationReason -> EvalEvent
newUnknownFlagEvent Text
key Value
fallback (EvalErrorKind -> EvaluationReason
EvaluationReasonError EvalErrorKind
EvalErrorFlagNotFound)
            forall (f :: * -> *) a. Applicative f => a -> f a
pure (EvalErrorKind -> Value -> EvaluationDetail Value
errorDefault EvalErrorKind
EvalErrorFlagNotFound Value
fallback, Bool
True, forall (f :: * -> *) a. Applicative f => a -> f a
pure EvalEvent
event)
        Right (Just Flag
flag) -> do
            (EvaluationDetail Value
reason, [EvalEvent]
events) <- forall (m :: * -> *) store.
(Monad m, LaunchDarklyStoreRead store m) =>
Flag -> UserI -> store -> m (EvaluationDetail Value, [EvalEvent])
evaluateDetail Flag
flag UserI
user forall a b. (a -> b) -> a -> b
$ forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"store" ClientI
client
            let reason' :: EvaluationDetail Value
reason' = EvaluationDetail Value -> Value -> EvaluationDetail Value
setFallback EvaluationDetail Value
reason Value
fallback
            forall (f :: * -> *) a. Applicative f => a -> f a
pure (EvaluationDetail Value
reason', Bool
False, forall a b c. (a -> b -> c) -> b -> a -> c
flip (:) [EvalEvent]
events forall a b. (a -> b) -> a -> b
$ Flag
-> Maybe Integer
-> Value
-> Maybe Value
-> EvaluationReason
-> Maybe Text
-> EvalEvent
newSuccessfulEvalEvent Flag
flag (forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"variationIndex" EvaluationDetail Value
reason')
                (forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"value" EvaluationDetail Value
reason') (forall a. a -> Maybe a
Just Value
fallback) (forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"reason" EvaluationDetail Value
reason') forall a. Maybe a
Nothing)
    ConfigI
-> EventState -> UserI -> Bool -> [EvalEvent] -> Bool -> IO ()
processEvalEvents (forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"config" ClientI
client) (forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"events" ClientI
client) UserI
user Bool
includeReason [EvalEvent]
events Bool
unknown
    forall (f :: * -> *) a. Applicative f => a -> f a
pure EvaluationDetail Value
reason

getOffValue :: Flag -> EvaluationReason -> EvaluationDetail Value
getOffValue :: Flag -> EvaluationReason -> EvaluationDetail Value
getOffValue Flag
flag EvaluationReason
reason = case forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"offVariation" Flag
flag of
    Just Integer
offVariation -> Flag -> Integer -> EvaluationReason -> EvaluationDetail Value
getVariation Flag
flag Integer
offVariation EvaluationReason
reason
    Maybe Integer
Nothing -> EvaluationDetail { $sel:value:EvaluationDetail :: Value
value = Value
Null, $sel:variationIndex:EvaluationDetail :: Maybe Integer
variationIndex = forall (m :: * -> *) a. MonadPlus m => m a
mzero, $sel:reason:EvaluationDetail :: EvaluationReason
reason = EvaluationReason
reason }

getVariation :: Flag -> Integer -> EvaluationReason -> EvaluationDetail Value
getVariation :: Flag -> Integer -> EvaluationReason -> EvaluationDetail Value
getVariation Flag
flag Integer
index EvaluationReason
reason
    | Int
idx forall a. Ord a => a -> a -> Bool
< Int
0 = EvaluationDetail { $sel:value:EvaluationDetail :: Value
value = Value
Null, $sel:variationIndex:EvaluationDetail :: Maybe Integer
variationIndex = forall (m :: * -> *) a. MonadPlus m => m a
mzero, $sel:reason:EvaluationDetail :: EvaluationReason
reason = EvalErrorKind -> EvaluationReason
EvaluationReasonError EvalErrorKind
EvalErrorKindMalformedFlag }
    | Int
idx forall a. Ord a => a -> a -> Bool
>= forall (t :: * -> *) a. Foldable t => t a -> Int
length [Value]
variations = EvaluationDetail { $sel:value:EvaluationDetail :: Value
value = Value
Null, $sel:variationIndex:EvaluationDetail :: Maybe Integer
variationIndex = forall (m :: * -> *) a. MonadPlus m => m a
mzero, $sel:reason:EvaluationDetail :: EvaluationReason
reason = EvalErrorKind -> EvaluationReason
EvaluationReasonError EvalErrorKind
EvalErrorKindMalformedFlag }
    | Bool
otherwise = EvaluationDetail { $sel:value:EvaluationDetail :: Value
value = forall i a. Integral i => [a] -> i -> a
genericIndex [Value]
variations Integer
index, $sel:variationIndex:EvaluationDetail :: Maybe Integer
variationIndex = forall (f :: * -> *) a. Applicative f => a -> f a
pure Integer
index, $sel:reason:EvaluationDetail :: EvaluationReason
reason = EvaluationReason
reason }
  where idx :: Int
idx = forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
index
        variations :: [Value]
variations = forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"variations" Flag
flag

evaluateDetail :: (Monad m, LaunchDarklyStoreRead store m) => Flag -> UserI -> store
    -> m (EvaluationDetail Value, [EvalEvent])
evaluateDetail :: forall (m :: * -> *) store.
(Monad m, LaunchDarklyStoreRead store m) =>
Flag -> UserI -> store -> m (EvaluationDetail Value, [EvalEvent])
evaluateDetail Flag
flag UserI
user store
store = if forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"on" Flag
flag
    then forall (m :: * -> *) store.
(Monad m, LaunchDarklyStoreRead store m) =>
Flag -> UserI -> store -> m (Maybe EvaluationReason, [EvalEvent])
checkPrerequisites Flag
flag UserI
user store
store forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        (Maybe EvaluationReason
Nothing, [EvalEvent]
events)     -> forall (m :: * -> *) store.
(Monad m, LaunchDarklyStoreRead store m) =>
Flag -> UserI -> store -> m (EvaluationDetail Value)
evaluateInternal Flag
flag UserI
user store
store forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\EvaluationDetail Value
x -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (EvaluationDetail Value
x, [EvalEvent]
events))
        (Just EvaluationReason
reason, [EvalEvent]
events) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (Flag -> EvaluationReason -> EvaluationDetail Value
getOffValue Flag
flag EvaluationReason
reason, [EvalEvent]
events)
    else forall (f :: * -> *) a. Applicative f => a -> f a
pure (Flag -> EvaluationReason -> EvaluationDetail Value
getOffValue Flag
flag EvaluationReason
EvaluationReasonOff, [])

status :: Prerequisite -> EvaluationDetail a -> Flag -> Bool
status :: forall a. Prerequisite -> EvaluationDetail a -> Flag -> Bool
status Prerequisite
prereq EvaluationDetail a
result Flag
prereqFlag = forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"on" Flag
prereqFlag Bool -> Bool -> Bool
&& (forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"variationIndex" EvaluationDetail a
result) forall a. Eq a => a -> a -> Bool
==
    forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"variation" Prerequisite
prereq)

checkPrerequisite :: (Monad m, LaunchDarklyStoreRead store m) => store -> UserI -> Flag -> Prerequisite
    -> m (Maybe EvaluationReason, [EvalEvent])
checkPrerequisite :: forall (m :: * -> *) store.
(Monad m, LaunchDarklyStoreRead store m) =>
store
-> UserI
-> Flag
-> Prerequisite
-> m (Maybe EvaluationReason, [EvalEvent])
checkPrerequisite store
store UserI
user Flag
flag Prerequisite
prereq = forall store (m :: * -> *).
LaunchDarklyStoreRead store m =>
store -> Text -> StoreResultM m (Maybe Flag)
getFlagC store
store (forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"key" Prerequisite
prereq) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Left Text
err                -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ EvalErrorKind -> EvaluationReason
EvaluationReasonError forall a b. (a -> b) -> a -> b
$ Text -> EvalErrorKind
EvalErrorExternalStore Text
err, [])
    Right Maybe Flag
Nothing           -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Text -> EvaluationReason
EvaluationReasonPrerequisiteFailed (forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"key" Prerequisite
prereq), [])
    Right (Just Flag
prereqFlag) -> forall (m :: * -> *) store.
(Monad m, LaunchDarklyStoreRead store m) =>
Flag -> UserI -> store -> m (EvaluationDetail Value, [EvalEvent])
evaluateDetail Flag
prereqFlag UserI
user store
store forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(EvaluationDetail Value
r, [EvalEvent]
events) -> let
        event :: EvalEvent
event = Flag
-> Maybe Integer
-> Value
-> Maybe Value
-> EvaluationReason
-> Maybe Text
-> EvalEvent
newSuccessfulEvalEvent Flag
prereqFlag (forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"variationIndex" EvaluationDetail Value
r) (forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"value" EvaluationDetail Value
r) forall a. Maybe a
Nothing
            (forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"reason" EvaluationDetail Value
r) (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"key" Flag
flag)
        in if forall a. Prerequisite -> EvaluationDetail a -> Flag -> Bool
status Prerequisite
prereq EvaluationDetail Value
r Flag
prereqFlag then forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. Maybe a
Nothing, EvalEvent
event forall a. a -> [a] -> [a]
: [EvalEvent]
events) else
            forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Text -> EvaluationReason
EvaluationReasonPrerequisiteFailed (forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"key" Prerequisite
prereq), EvalEvent
event forall a. a -> [a] -> [a]
: [EvalEvent]
events)

sequenceUntil :: Monad m => (a -> Bool) -> [m a] -> m [a]
sequenceUntil :: forall (m :: * -> *) a. Monad m => (a -> Bool) -> [m a] -> m [a]
sequenceUntil a -> Bool
_ []     = forall (m :: * -> *) a. Monad m => a -> m a
return []
sequenceUntil a -> Bool
p (m a
m:[m a]
ms) = m a
m forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a
a -> if a -> Bool
p a
a then forall (m :: * -> *) a. Monad m => a -> m a
return [a
a] else
    forall (m :: * -> *) a. Monad m => (a -> Bool) -> [m a] -> m [a]
sequenceUntil a -> Bool
p [m a]
ms forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \[a]
as -> forall (m :: * -> *) a. Monad m => a -> m a
return (a
aforall a. a -> [a] -> [a]
:[a]
as)

checkPrerequisites :: (Monad m, LaunchDarklyStoreRead store m) => Flag -> UserI -> store
    -> m (Maybe EvaluationReason, [EvalEvent])
checkPrerequisites :: forall (m :: * -> *) store.
(Monad m, LaunchDarklyStoreRead store m) =>
Flag -> UserI -> store -> m (Maybe EvaluationReason, [EvalEvent])
checkPrerequisites Flag
flag UserI
user store
store = let p :: [Prerequisite]
p = forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"prerequisites" Flag
flag in if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Prerequisite]
p then forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. Maybe a
Nothing, []) else do
    [(Maybe EvaluationReason, [EvalEvent])]
evals <- forall (m :: * -> *) a. Monad m => (a -> Bool) -> [m a] -> m [a]
sequenceUntil (forall a. Maybe a -> Bool
isJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall (m :: * -> *) store.
(Monad m, LaunchDarklyStoreRead store m) =>
store
-> UserI
-> Flag
-> Prerequisite
-> m (Maybe EvaluationReason, [EvalEvent])
checkPrerequisite store
store UserI
user Flag
flag) [Prerequisite]
p
    forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(Maybe EvaluationReason, [EvalEvent])]
evals, forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall a b. (a, b) -> b
snd [(Maybe EvaluationReason, [EvalEvent])]
evals)

evaluateInternal :: (Monad m, LaunchDarklyStoreRead store m) => Flag -> UserI -> store -> m (EvaluationDetail Value)
evaluateInternal :: forall (m :: * -> *) store.
(Monad m, LaunchDarklyStoreRead store m) =>
Flag -> UserI -> store -> m (EvaluationDetail Value)
evaluateInternal Flag
flag UserI
user store
store = m (EvaluationDetail Value)
result where
    checkTarget :: Target -> Maybe (EvaluationDetail Value)
checkTarget Target
target = if forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem (forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"key" UserI
user) (forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"values" Target
target)
        then forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Flag -> Integer -> EvaluationReason -> EvaluationDetail Value
getVariation Flag
flag (forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"variation" Target
target) EvaluationReason
EvaluationReasonTargetMatch else forall a. Maybe a
Nothing
    checkRule :: (Natural, Rule) -> m (Maybe (EvaluationDetail Value))
checkRule (Natural
ruleIndex, Rule
rule) = forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
ifM (forall (m :: * -> *) store.
(Monad m, LaunchDarklyStoreRead store m) =>
Rule -> UserI -> store -> m Bool
ruleMatchesUser Rule
rule UserI
user store
store)
        (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Flag
-> VariationOrRollout
-> UserI
-> EvaluationReason
-> EvaluationDetail Value
getValueForVariationOrRollout Flag
flag (forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"variationOrRollout" Rule
rule) UserI
user
            EvaluationReasonRuleMatch { $sel:ruleIndex:EvaluationReasonOff :: Natural
ruleIndex = Natural
ruleIndex, $sel:ruleId:EvaluationReasonOff :: Text
ruleId = forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"id" Rule
rule, $sel:inExperiment:EvaluationReasonOff :: Bool
inExperiment = Bool
False })
        (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing)
    fallthrough :: EvaluationDetail Value
fallthrough = Flag
-> VariationOrRollout
-> UserI
-> EvaluationReason
-> EvaluationDetail Value
getValueForVariationOrRollout Flag
flag (forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"fallthrough" Flag
flag) UserI
user (Bool -> EvaluationReason
EvaluationReasonFallthrough Bool
False)
    result :: m (EvaluationDetail Value)
result = let
        ruleMatch :: [m (Maybe (EvaluationDetail Value))]
ruleMatch   = (Natural, Rule) -> m (Maybe (EvaluationDetail Value))
checkRule forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b. [a] -> [b] -> [(a, b)]
zip [Natural
0..] (forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"rules" Flag
flag)
        targetMatch :: [m (Maybe (EvaluationDetail Value))]
targetMatch = forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. Target -> Maybe (EvaluationDetail Value)
checkTarget forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"targets" Flag
flag
        in forall a. a -> Maybe a -> a
fromMaybe EvaluationDetail Value
fallthrough forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a b.
Monad m =>
(a -> m (Maybe b)) -> [a] -> m (Maybe b)
firstJustM forall a. a -> a
Prelude.id ([m (Maybe (EvaluationDetail Value))]
ruleMatch forall a. [a] -> [a] -> [a]
++ [m (Maybe (EvaluationDetail Value))]
targetMatch)

errorDefault :: EvalErrorKind -> Value -> EvaluationDetail Value
errorDefault :: EvalErrorKind -> Value -> EvaluationDetail Value
errorDefault EvalErrorKind
kind Value
v = EvaluationDetail { $sel:value:EvaluationDetail :: Value
value = Value
v, $sel:variationIndex:EvaluationDetail :: Maybe Integer
variationIndex = forall (m :: * -> *) a. MonadPlus m => m a
mzero, $sel:reason:EvaluationDetail :: EvaluationReason
reason = EvalErrorKind -> EvaluationReason
EvaluationReasonError EvalErrorKind
kind }

errorDetail :: EvalErrorKind -> EvaluationDetail Value
errorDetail :: EvalErrorKind -> EvaluationDetail Value
errorDetail EvalErrorKind
kind = EvalErrorKind -> Value -> EvaluationDetail Value
errorDefault EvalErrorKind
kind Value
Null

getValueForVariationOrRollout :: Flag -> VariationOrRollout -> UserI -> EvaluationReason -> EvaluationDetail Value
getValueForVariationOrRollout :: Flag
-> VariationOrRollout
-> UserI
-> EvaluationReason
-> EvaluationDetail Value
getValueForVariationOrRollout Flag
flag VariationOrRollout
vr UserI
user EvaluationReason
reason =
    case VariationOrRollout
-> UserI -> Text -> Text -> (Maybe Integer, Bool)
variationIndexForUser VariationOrRollout
vr UserI
user (forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"key" Flag
flag) (forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"salt" Flag
flag) of
        (Maybe Integer
Nothing, Bool
_)           -> EvalErrorKind -> EvaluationDetail Value
errorDetail EvalErrorKind
EvalErrorKindMalformedFlag
        (Just Integer
x, Bool
inExperiment) -> (Flag -> Integer -> EvaluationReason -> EvaluationDetail Value
getVariation Flag
flag Integer
x EvaluationReason
reason) forall a b. a -> (a -> b) -> b
& forall (field :: Symbol) s t a b.
HasField field s t a b =>
Lens s t a b
field @"reason" forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Bool -> EvaluationReason -> EvaluationReason
setInExperiment Bool
inExperiment

setInExperiment :: Bool -> EvaluationReason -> EvaluationReason
setInExperiment :: Bool -> EvaluationReason -> EvaluationReason
setInExperiment Bool
inExperiment EvaluationReason
reason = case EvaluationReason
reason of
    EvaluationReasonFallthrough Bool
_         -> Bool -> EvaluationReason
EvaluationReasonFallthrough Bool
inExperiment
    EvaluationReasonRuleMatch Natural
index Text
idx Bool
_ -> Natural -> Text -> Bool -> EvaluationReason
EvaluationReasonRuleMatch Natural
index Text
idx Bool
inExperiment
    EvaluationReason
x                                     -> EvaluationReason
x

ruleMatchesUser :: Monad m => LaunchDarklyStoreRead store m => Rule -> UserI -> store -> m Bool
ruleMatchesUser :: forall (m :: * -> *) store.
(Monad m, LaunchDarklyStoreRead store m) =>
Rule -> UserI -> store -> m Bool
ruleMatchesUser Rule
rule UserI
user store
store =
    forall (m :: * -> *) a. Monad m => (a -> m Bool) -> [a] -> m Bool
allM (\Clause
clause -> forall (m :: * -> *) store.
(Monad m, LaunchDarklyStoreRead store m) =>
store -> Clause -> UserI -> m Bool
clauseMatchesUser store
store Clause
clause UserI
user) (forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"clauses" Rule
rule)

variationIndexForUser :: VariationOrRollout -> UserI -> Text -> Text -> (Maybe Integer, Bool)
variationIndexForUser :: VariationOrRollout
-> UserI -> Text -> Text -> (Maybe Integer, Bool)
variationIndexForUser VariationOrRollout
vor UserI
user Text
key Text
salt
    | (Just Integer
variation) <- forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"variation" VariationOrRollout
vor = (forall (f :: * -> *) a. Applicative f => a -> f a
pure Integer
variation, Bool
False)
    | (Just Rollout
rollout) <- forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"rollout" VariationOrRollout
vor = let
        isExperiment :: Bool
isExperiment = (forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"kind" Rollout
rollout) forall a. Eq a => a -> a -> Bool
== RolloutKind
RolloutKindExperiment
        variations :: [WeightedVariation]
variations = forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"variations" Rollout
rollout
        bucket :: Float
bucket = UserI -> Text -> Text -> Text -> Maybe Int -> Float
bucketUser UserI
user Text
key (forall a. a -> Maybe a -> a
fromMaybe Text
"key" forall a b. (a -> b) -> a -> b
$ forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"bucketBy" Rollout
rollout) Text
salt (forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"seed" Rollout
rollout)
        c :: Either (Maybe Integer, Bool) Float
-> WeightedVariation -> Either (Maybe Integer, Bool) Float
c Either (Maybe Integer, Bool) Float
acc WeightedVariation
i = Either (Maybe Integer, Bool) Float
acc forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Float
acc -> let t :: Float
t = Float
acc forall a. Num a => a -> a -> a
+ ((forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"weight" WeightedVariation
i) forall a. Fractional a => a -> a -> a
/ Float
100000.0) in
            if Float
bucket forall a. Ord a => a -> a -> Bool
< Float
t then forall a b. a -> Either a b
Left (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"variation" WeightedVariation
i, (Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"untracked" WeightedVariation
i) Bool -> Bool -> Bool
&& Bool
isExperiment) else forall a b. b -> Either a b
Right Float
t
        in if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [WeightedVariation]
variations then (forall a. Maybe a
Nothing, Bool
False) else forall a b. a -> Either a b -> a
fromLeft
            (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"variation" forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
last [WeightedVariation]
variations, (Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"untracked" forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
last [WeightedVariation]
variations) Bool -> Bool -> Bool
&& Bool
isExperiment) forall a b. (a -> b) -> a -> b
$
            forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Either (Maybe Integer, Bool) Float
-> WeightedVariation -> Either (Maybe Integer, Bool) Float
c (forall a b. b -> Either a b
Right (Float
0.0 :: Float)) [WeightedVariation]
variations
    | Bool
otherwise = (forall a. Maybe a
Nothing, Bool
False)

-- Bucketing -------------------------------------------------------------------

hexCharToNumber :: Word8 -> Maybe Natural
hexCharToNumber :: Word8 -> Maybe Natural
hexCharToNumber Word8
w = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ if
    | Word8
48 forall a. Ord a => a -> a -> Bool
<= Word8
w Bool -> Bool -> Bool
&& Word8
w forall a. Ord a => a -> a -> Bool
<= Word8
57  -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Word8
w forall a. Num a => a -> a -> a
- Word8
48
    | Word8
65 forall a. Ord a => a -> a -> Bool
<= Word8
w Bool -> Bool -> Bool
&& Word8
w forall a. Ord a => a -> a -> Bool
<= Word8
70  -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Word8
w forall a. Num a => a -> a -> a
- Word8
55
    | Word8
97 forall a. Ord a => a -> a -> Bool
<= Word8
w Bool -> Bool -> Bool
&& Word8
w forall a. Ord a => a -> a -> Bool
<= Word8
102 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Word8
w forall a. Num a => a -> a -> a
- Word8
87
    | Bool
otherwise           -> forall a. Maybe a
Nothing

hexStringToNumber :: ByteString -> Maybe Natural
hexStringToNumber :: ByteString -> Maybe Natural
hexStringToNumber ByteString
bytes = forall a. (a -> Word8 -> a) -> a -> ByteString -> a
B.foldl' Maybe Natural -> Word8 -> Maybe Natural
step (forall a. a -> Maybe a
Just Natural
0) ByteString
bytes where
    step :: Maybe Natural -> Word8 -> Maybe Natural
step Maybe Natural
acc Word8
x = Maybe Natural
acc forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Natural
acc' -> Word8 -> Maybe Natural
hexCharToNumber Word8
x forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Num a => a -> a -> a
(+) (Natural
acc' forall a. Num a => a -> a -> a
* Natural
16)

bucketUser :: UserI -> Text -> Text -> Text -> Maybe Int -> Float
bucketUser :: UserI -> Text -> Text -> Text -> Maybe Int -> Float
bucketUser UserI
user Text
key Text
attribute Text
salt Maybe Int
seed = forall a. a -> Maybe a -> a
fromMaybe Float
0 forall a b. (a -> b) -> a -> b
$ do
    let secondarySuffix :: Text
secondarySuffix = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" (Text -> Text -> Text
T.append Text
".") forall a b. (a -> b) -> a -> b
$ forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"secondary" UserI
user
    ByteString
i <- UserI -> Text -> Maybe Value
valueOf UserI
user Text
attribute forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> Maybe Text
bucketableStringValue forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Text
x -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
B.take Int
15 forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
B16.encode forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
hash forall a b. (a -> b) -> a -> b
$ Text -> ByteString
encodeUtf8 forall a b. (a -> b) -> a -> b
$
        case Maybe Int
seed of
            Maybe Int
Nothing    -> [Text] -> Text
T.concat [Text
key, Text
".", Text
salt, Text
".", Text
x, Text
secondarySuffix]
            Just Int
seed' -> [Text] -> Text
T.concat [String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Int
seed', Text
".", Text
x, Text
secondarySuffix]
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ((forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ ByteString -> Maybe Natural
hexStringToNumber ByteString
i) :: Float) forall a. Fractional a => a -> a -> a
/ (Float
0xFFFFFFFFFFFFFFF)

floatingOrInteger' :: Scientific -> Either Double Integer
floatingOrInteger' :: Scientific -> Either Double Integer
floatingOrInteger' = forall r i. (RealFloat r, Integral i) => Scientific -> Either r i
floatingOrInteger

bucketableStringValue :: Value -> Maybe Text
bucketableStringValue :: Value -> Maybe Text
bucketableStringValue (String Text
x) = forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
x
bucketableStringValue (Number Scientific
s) = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const forall a. Maybe a
Nothing) (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) (Scientific -> Either Double Integer
floatingOrInteger' Scientific
s)
bucketableStringValue Value
_          = forall a. Maybe a
Nothing

-- Clause ----------------------------------------------------------------------

maybeNegate :: Clause -> Bool -> Bool
maybeNegate :: Clause -> Bool -> Bool
maybeNegate Clause
clause Bool
value = if forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"negate" Clause
clause then Bool -> Bool
not Bool
value else Bool
value

matchAny :: (Value -> Value -> Bool) -> Value -> [Value] -> Bool
matchAny :: (Value -> Value -> Bool) -> Value -> [Value] -> Bool
matchAny Value -> Value -> Bool
op Value
value = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Value -> Value -> Bool
op Value
value)

clauseMatchesUserNoSegments :: Clause -> UserI -> Bool
clauseMatchesUserNoSegments :: Clause -> UserI -> Bool
clauseMatchesUserNoSegments Clause
clause UserI
user = case UserI -> Text -> Maybe Value
valueOf UserI
user forall a b. (a -> b) -> a -> b
$ forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"attribute" Clause
clause of
    Maybe Value
Nothing        -> Bool
False
    Just (Value
Null)    -> Bool
False
    Just (Array Array
a) -> Clause -> Bool -> Bool
maybeNegate Clause
clause forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> Vector a -> Bool
V.any (\Value
x -> (Value -> Value -> Bool) -> Value -> [Value] -> Bool
matchAny Value -> Value -> Bool
f Value
x [Value]
v) Array
a
    Just Value
x         -> Clause -> Bool -> Bool
maybeNegate Clause
clause forall a b. (a -> b) -> a -> b
$ (Value -> Value -> Bool) -> Value -> [Value] -> Bool
matchAny Value -> Value -> Bool
f Value
x [Value]
v
    where
        f :: Value -> Value -> Bool
f = Op -> Value -> Value -> Bool
getOperation forall a b. (a -> b) -> a -> b
$ forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"op" Clause
clause
        v :: [Value]
v = forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"values" Clause
clause

clauseMatchesUser :: (Monad m, LaunchDarklyStoreRead store m) => store -> Clause -> UserI -> m Bool
clauseMatchesUser :: forall (m :: * -> *) store.
(Monad m, LaunchDarklyStoreRead store m) =>
store -> Clause -> UserI -> m Bool
clauseMatchesUser store
store Clause
clause UserI
user
    | forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"op" Clause
clause forall a. Eq a => a -> a -> Bool
== Op
OpSegmentMatch = do
        let values :: [Text]
values = [ Text
x | String Text
x <- forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"values" Clause
clause]
        Bool
x <- forall (m :: * -> *) a. Monad m => (a -> m Bool) -> [a] -> m Bool
anyM (\Text
k -> forall store (m :: * -> *).
LaunchDarklyStoreRead store m =>
store -> Text -> StoreResultM m (Maybe Segment)
getSegmentC store
store Text
k forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either Text (Maybe Segment) -> Bool
checkSegment) [Text]
values
        forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Clause -> Bool -> Bool
maybeNegate Clause
clause Bool
x
    | Bool
otherwise = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Clause -> UserI -> Bool
clauseMatchesUserNoSegments Clause
clause UserI
user
    where
        checkSegment :: Either Text (Maybe Segment) -> Bool
        checkSegment :: Either Text (Maybe Segment) -> Bool
checkSegment (Right (Just Segment
segment)) = Segment -> UserI -> Bool
segmentContainsUser Segment
segment UserI
user
        checkSegment Either Text (Maybe Segment)
_                      = Bool
False

-- Segment ---------------------------------------------------------------------

segmentRuleMatchesUser :: SegmentRule -> UserI -> Text -> Text -> Bool
segmentRuleMatchesUser :: SegmentRule -> UserI -> Text -> Text -> Bool
segmentRuleMatchesUser SegmentRule
rule UserI
user Text
key Text
salt = Bool -> Bool -> Bool
(&&)
    (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (forall a b c. (a -> b -> c) -> b -> a -> c
flip Clause -> UserI -> Bool
clauseMatchesUserNoSegments UserI
user) (forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"clauses" SegmentRule
rule))
    (forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True) (forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"weight" SegmentRule
rule) forall a b. (a -> b) -> a -> b
$ \Float
weight ->
        UserI -> Text -> Text -> Text -> Maybe Int -> Float
bucketUser UserI
user Text
key (forall a. a -> Maybe a -> a
fromMaybe Text
"key" forall a b. (a -> b) -> a -> b
$ forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"bucketBy" SegmentRule
rule) Text
salt forall a. Maybe a
Nothing forall a. Ord a => a -> a -> Bool
< Float
weight forall a. Fractional a => a -> a -> a
/ Float
100000.0)

segmentContainsUser :: Segment -> UserI -> Bool
segmentContainsUser :: Segment -> UserI -> Bool
segmentContainsUser Segment
segment UserI
user
    | forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem (forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"key" UserI
user) (forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"included" Segment
segment) = Bool
True
    | forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem (forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"key" UserI
user) (forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"excluded" Segment
segment) = Bool
False
    | Just SegmentRule
_ <- forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find
        (\SegmentRule
r -> SegmentRule -> UserI -> Text -> Text -> Bool
segmentRuleMatchesUser SegmentRule
r UserI
user (forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"key" Segment
segment) (forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"salt" Segment
segment))
        (forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"rules" Segment
segment) = Bool
True
    | Bool
otherwise = Bool
False