{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE ViewPatterns #-}

module LaunchDarkly.Server.Evaluate where

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

import Data.Either.Extra (mapRight)
import Data.Foldable (foldlM)
import Data.List.Extra (firstJust)
import LaunchDarkly.Server.Client.Internal (Client, Status (Initialized), getStatusI)
import LaunchDarkly.Server.Context (getIndividualContext, getValueForReference)
import LaunchDarkly.Server.Context.Internal (Context (Invalid), getKey, getKinds)
import LaunchDarkly.Server.Details (EvalErrorKind (..), EvaluationDetail (..), EvaluationReason (..))
import LaunchDarkly.Server.Events (EvalEvent, newSuccessfulEvalEvent, newUnknownFlagEvent, processEvalEvents)
import LaunchDarkly.Server.Features (Clause, Flag, Prerequisite, RolloutKind (RolloutKindExperiment), Rule, Segment (..), SegmentRule, SegmentTarget (..), Target, VariationOrRollout)
import LaunchDarkly.Server.Operators (Op (OpSegmentMatch), getOperation)
import LaunchDarkly.Server.Reference (getComponents, getError, isValid, makeLiteral, makeReference)
import LaunchDarkly.Server.Store.Internal (LaunchDarklyStoreRead, getFlagC, getSegmentC)

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 :: Client -> Text -> Context -> a -> (a -> Value) -> Bool -> (Value -> Maybe a) -> IO (EvaluationDetail a)
evaluateTyped :: forall a.
Client
-> Text
-> Context
-> a
-> (a -> Value)
-> Bool
-> (Value -> Maybe a)
-> IO (EvaluationDetail a)
evaluateTyped Client
client Text
key Context
context a
fallback a -> Value
wrap Bool
includeReason Value -> Maybe a
convert =
    Client -> IO Status
getStatusI Client
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
                Client
-> Text -> Context -> Value -> Bool -> IO (EvaluationDetail Value)
evaluateInternalClient Client
client Text
key Context
context (a -> Value
wrap a
fallback) Bool
includeReason forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \EvaluationDetail Value
detail ->
                    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
detail) then (forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"reason" EvaluationDetail Value
detail) else EvalErrorKind -> EvaluationReason
EvaluationReasonError EvalErrorKind
EvalErrorWrongType)
                            (forall a. EvaluationDetail Value -> a -> EvaluationDetail a
setValue EvaluationDetail Value
detail)
                            (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
detail)

evaluateInternalClient :: Client -> Text -> Context -> Value -> Bool -> IO (EvaluationDetail Value)
evaluateInternalClient :: Client
-> Text -> Context -> Value -> Bool -> IO (EvaluationDetail Value)
evaluateInternalClient Client
_ Text
_ (Invalid Text
_) Value
fallback Bool
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ EvalErrorKind -> Value -> EvaluationDetail Value
errorDefault EvalErrorKind
EvalErrorInvalidContext Value
fallback
evaluateInternalClient Client
client Text
key Context
context Value
fallback Bool
includeReason = do
    (EvaluationDetail Value
detail, 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" Client
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 -> Context -> EvalEvent
newUnknownFlagEvent Text
key Value
fallback (EvalErrorKind -> EvaluationReason
EvaluationReasonError forall a b. (a -> b) -> a -> b
$ Text -> EvalErrorKind
EvalErrorExternalStore Text
err) Context
context
                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 -> Context -> EvalEvent
newUnknownFlagEvent Text
key Value
fallback (EvalErrorKind -> EvaluationReason
EvaluationReasonError EvalErrorKind
EvalErrorFlagNotFound) Context
context
                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
detail, [EvalEvent]
events) <- forall (m :: * -> *) store.
(Monad m, LaunchDarklyStoreRead store m) =>
Flag
-> Context
-> HashSet Text
-> store
-> m (EvaluationDetail Value, [EvalEvent])
evaluateDetail Flag
flag Context
context forall a. HashSet a
HS.empty forall a b. (a -> b) -> a -> b
$ forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"store" Client
client
                let detail' :: EvaluationDetail Value
detail' = EvaluationDetail Value -> Value -> EvaluationDetail Value
setFallback EvaluationDetail Value
detail Value
fallback
                forall (f :: * -> *) a. Applicative f => a -> f a
pure
                    ( EvaluationDetail Value
detail'
                    , 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
-> Context
-> EvalEvent
newSuccessfulEvalEvent
                            Flag
flag
                            (forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"variationIndex" EvaluationDetail Value
detail')
                            (forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"value" EvaluationDetail Value
detail')
                            (forall a. a -> Maybe a
Just Value
fallback)
                            (forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"reason" EvaluationDetail Value
detail')
                            forall a. Maybe a
Nothing
                            Context
context
                    )
    Config
-> EventState -> Context -> Bool -> [EvalEvent] -> Bool -> IO ()
processEvalEvents (forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"config" Client
client) (forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"events" Client
client) Context
context Bool
includeReason [EvalEvent]
events Bool
unknown
    forall (f :: * -> *) a. Applicative f => a -> f a
pure EvaluationDetail Value
detail

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 -> Context -> HS.HashSet Text -> store -> m (EvaluationDetail Value, [EvalEvent])
evaluateDetail :: forall (m :: * -> *) store.
(Monad m, LaunchDarklyStoreRead store m) =>
Flag
-> Context
-> HashSet Text
-> store
-> m (EvaluationDetail Value, [EvalEvent])
evaluateDetail flag :: Flag
flag@(forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"on" -> Bool
False) Context
_ HashSet Text
_ store
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure (Flag -> EvaluationReason -> EvaluationDetail Value
getOffValue Flag
flag EvaluationReason
EvaluationReasonOff, [])
evaluateDetail Flag
flag Context
context HashSet Text
seenFlags store
store
    | forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
HS.member (forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"key" Flag
flag) HashSet Text
seenFlags = forall (f :: * -> *) a. Applicative f => a -> f a
pure (Flag -> EvaluationReason -> EvaluationDetail Value
getOffValue Flag
flag forall a b. (a -> b) -> a -> b
$ EvalErrorKind -> EvaluationReason
EvaluationReasonError EvalErrorKind
EvalErrorKindMalformedFlag, [])
    | Bool
otherwise =
        forall (m :: * -> *) store.
(Monad m, LaunchDarklyStoreRead store m) =>
Flag
-> Context
-> HashSet Text
-> store
-> m (Maybe (EvaluationDetail Value), [EvalEvent])
checkPrerequisites Flag
flag Context
context (forall a. (Eq a, Hashable a) => a -> HashSet a -> HashSet a
HS.insert (forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"key" Flag
flag) HashSet Text
seenFlags) store
store forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            (Maybe (EvaluationDetail Value)
Nothing, [EvalEvent]
events) -> forall (m :: * -> *) store.
(Monad m, LaunchDarklyStoreRead store m) =>
Flag -> Context -> store -> m (EvaluationDetail Value)
evaluateInternal Flag
flag Context
context 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 EvaluationDetail Value
detail, [EvalEvent]
events) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (EvaluationDetail Value
detail, [EvalEvent]
events)

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)

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
a forall a. a -> [a] -> [a]
: [a]
as)

checkPrerequisites :: (Monad m, LaunchDarklyStoreRead store m) => Flag -> Context -> HS.HashSet Text -> store -> m (Maybe (EvaluationDetail Value), [EvalEvent])
checkPrerequisites :: forall (m :: * -> *) store.
(Monad m, LaunchDarklyStoreRead store m) =>
Flag
-> Context
-> HashSet Text
-> store
-> m (Maybe (EvaluationDetail Value), [EvalEvent])
checkPrerequisites Flag
flag Context
context HashSet Text
seenFlags 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 (EvaluationDetail Value), [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
-> Context
-> Flag
-> HashSet Text
-> Prerequisite
-> m (Maybe (EvaluationDetail Value), [EvalEvent])
checkPrerequisite store
store Context
context Flag
flag HashSet Text
seenFlags) [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 (EvaluationDetail Value), [EvalEvent])]
evals, forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall a b. (a, b) -> b
snd [(Maybe (EvaluationDetail Value), [EvalEvent])]
evals)

checkPrerequisite :: (Monad m, LaunchDarklyStoreRead store m) => store -> Context -> Flag -> HS.HashSet Text -> Prerequisite -> m (Maybe (EvaluationDetail Value), [EvalEvent])
checkPrerequisite :: forall (m :: * -> *) store.
(Monad m, LaunchDarklyStoreRead store m) =>
store
-> Context
-> Flag
-> HashSet Text
-> Prerequisite
-> m (Maybe (EvaluationDetail Value), [EvalEvent])
checkPrerequisite store
store Context
context Flag
flag HashSet Text
seenFlags Prerequisite
prereq =
    if forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
HS.member (forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"key" Prerequisite
prereq) HashSet Text
seenFlags
        then forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ EvalErrorKind -> EvaluationDetail Value
errorDetail EvalErrorKind
EvalErrorKindMalformedFlag, [])
        else
            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
$ Flag -> EvaluationReason -> EvaluationDetail Value
getOffValue Flag
flag 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
$ Flag -> EvaluationReason -> EvaluationDetail Value
getOffValue Flag
flag 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
-> Context
-> HashSet Text
-> store
-> m (EvaluationDetail Value, [EvalEvent])
evaluateDetail Flag
prereqFlag Context
context HashSet Text
seenFlags store
store forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Flag
-> (EvaluationDetail Value, [EvalEvent])
-> m (Maybe (EvaluationDetail Value), [EvalEvent])
process Flag
prereqFlag)
  where
    process :: Flag
-> (EvaluationDetail Value, [EvalEvent])
-> m (Maybe (EvaluationDetail Value), [EvalEvent])
process Flag
prereqFlag (EvaluationDetail Value
detail, [EvalEvent]
events)
        | EvaluationReason -> Bool
isError (forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"reason" EvaluationDetail Value
detail) = forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ EvalErrorKind -> EvaluationDetail Value
errorDetail EvalErrorKind
EvalErrorKindMalformedFlag, forall a. Monoid a => a
mempty)
        | Bool
otherwise =
            let event :: EvalEvent
event = Flag
-> Maybe Integer
-> Value
-> Maybe Value
-> EvaluationReason
-> Maybe Text
-> Context
-> EvalEvent
newSuccessfulEvalEvent Flag
prereqFlag (forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"variationIndex" EvaluationDetail Value
detail) (forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"value" EvaluationDetail Value
detail) forall a. Maybe a
Nothing (forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"reason" EvaluationDetail Value
detail) (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) Context
context
             in if forall a. Prerequisite -> EvaluationDetail a -> Flag -> Bool
status Prerequisite
prereq EvaluationDetail Value
detail 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
$ Flag -> EvaluationReason -> EvaluationDetail Value
getOffValue Flag
flag 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)

evaluateInternal :: (Monad m, LaunchDarklyStoreRead store m) => Flag -> Context -> store -> m (EvaluationDetail Value)
evaluateInternal :: forall (m :: * -> *) store.
(Monad m, LaunchDarklyStoreRead store m) =>
Flag -> Context -> store -> m (EvaluationDetail Value)
evaluateInternal Flag
flag Context
context store
store = m (EvaluationDetail Value)
result
  where
    fallthrough :: EvaluationDetail Value
fallthrough = Flag
-> VariationOrRollout
-> Context
-> EvaluationReason
-> EvaluationDetail Value
getValueForVariationOrRollout Flag
flag (forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"fallthrough" Flag
flag) Context
context (Bool -> EvaluationReason
EvaluationReasonFallthrough Bool
False)
    result :: m (EvaluationDetail Value)
result =
        let
            targetEvaluationResults :: [m (Maybe (EvaluationDetail Value))]
targetEvaluationResults = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Context -> Flag -> [Maybe (EvaluationDetail Value)]
checkTargets Context
context Flag
flag
            ruleEvaluationResults :: [m (Maybe (EvaluationDetail Value))]
ruleEvaluationResults = (forall (m :: * -> *) store.
(Monad m, LaunchDarklyStoreRead store m) =>
Flag
-> Context
-> store
-> (Natural, Rule)
-> m (Maybe (EvaluationDetail Value))
checkRule Flag
flag Context
context store
store) 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)
         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))]
targetEvaluationResults forall a. [a] -> [a] -> [a]
++ [m (Maybe (EvaluationDetail Value))]
ruleEvaluationResults)

checkRule :: (Monad m, LaunchDarklyStoreRead store m) => Flag -> Context -> store -> (Natural, Rule) -> m (Maybe (EvaluationDetail Value))
checkRule :: forall (m :: * -> *) store.
(Monad m, LaunchDarklyStoreRead store m) =>
Flag
-> Context
-> store
-> (Natural, Rule)
-> m (Maybe (EvaluationDetail Value))
checkRule Flag
flag Context
context store
store (Natural
ruleIndex, Rule
rule) =
    forall (m :: * -> *) store.
(Monad m, LaunchDarklyStoreRead store m) =>
Rule -> Context -> store -> m (Either Text Bool)
ruleMatchesContext Rule
rule Context
context store
store
        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
. \case
            Left Text
_ -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ EvalErrorKind -> EvaluationDetail Value
errorDetail EvalErrorKind
EvalErrorKindMalformedFlag
            Right Bool
True -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Flag
-> VariationOrRollout
-> Context
-> EvaluationReason
-> EvaluationDetail Value
getValueForVariationOrRollout Flag
flag (forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"variationOrRollout" Rule
rule) Context
context 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}
            Right Bool
False -> forall a. Maybe a
Nothing

checkTargets :: Context -> Flag -> [Maybe (EvaluationDetail Value)]
checkTargets :: Context -> Flag -> [Maybe (EvaluationDetail Value)]
checkTargets Context
context Flag
flag =
    let userTargets :: [Target]
userTargets = forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"targets" Flag
flag
        contextTargets :: [Target]
contextTargets = forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"contextTargets" Flag
flag
     in case [Target]
contextTargets of
            [] -> Context -> Text -> Flag -> Target -> Maybe (EvaluationDetail Value)
checkTarget Context
context Text
"user" Flag
flag forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Target]
userTargets
            [Target]
_ -> Context
-> Flag -> [Target] -> [Target] -> [Maybe (EvaluationDetail Value)]
checkContextTargets Context
context Flag
flag [Target]
userTargets [Target]
contextTargets

checkContextTargets :: Context -> Flag -> [Target] -> [Target] -> [Maybe (EvaluationDetail Value)]
checkContextTargets :: Context
-> Flag -> [Target] -> [Target] -> [Maybe (EvaluationDetail Value)]
checkContextTargets Context
context Flag
flag [Target]
userTargets [Target]
contextTargets =
    Context
-> Flag -> [Target] -> Target -> Maybe (EvaluationDetail Value)
checkContextTarget Context
context Flag
flag [Target]
userTargets forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Target]
contextTargets

checkContextTarget :: Context -> Flag -> [Target] -> Target -> Maybe (EvaluationDetail Value)
checkContextTarget :: Context
-> Flag -> [Target] -> Target -> Maybe (EvaluationDetail Value)
checkContextTarget Context
context Flag
flag [Target]
userTargets Target
contextTarget =
    let contextKind :: Text
contextKind = forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"contextKind" Target
contextTarget
        values :: HashSet Text
values = forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"values" Target
contextTarget
     in if Text
contextKind forall a. Eq a => a -> a -> Bool
== Text
"user" Bool -> Bool -> Bool
&& forall a. HashSet a -> Bool
HS.null HashSet Text
values
            then -- If the context target doesn't have any values specified, we are supposed to fall back to the user targets
                forall a b. (a -> Maybe b) -> [a] -> Maybe b
firstJust forall a. a -> a
Prelude.id forall a b. (a -> b) -> a -> b
$ (Context -> Text -> Flag -> Target -> Maybe (EvaluationDetail Value)
checkTarget Context
context Text
"user" Flag
flag) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Target]
userTargets
            else Context -> Text -> Flag -> Target -> Maybe (EvaluationDetail Value)
checkTarget Context
context Text
contextKind Flag
flag Target
contextTarget

checkTarget :: Context -> Text -> Flag -> Target -> Maybe (EvaluationDetail Value)
checkTarget :: Context -> Text -> Flag -> Target -> Maybe (EvaluationDetail Value)
checkTarget Context
context Text
contextKind Flag
flag Target
target =
    case Text -> Context -> Maybe Context
getIndividualContext Text
contextKind Context
context of
        Maybe Context
Nothing -> forall a. Maybe a
Nothing
        Just Context
ctx ->
            if forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem (Context -> Text
getKey Context
ctx) (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

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 -> Context -> EvaluationReason -> EvaluationDetail Value
getValueForVariationOrRollout :: Flag
-> VariationOrRollout
-> Context
-> EvaluationReason
-> EvaluationDetail Value
getValueForVariationOrRollout Flag
flag VariationOrRollout
vr Context
context EvaluationReason
reason =
    case VariationOrRollout
-> Context -> Text -> Text -> (Maybe Integer, Bool)
variationIndexForContext VariationOrRollout
vr Context
context (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

ruleMatchesContext :: Monad m => LaunchDarklyStoreRead store m => Rule -> Context -> store -> m (Either Text Bool)
ruleMatchesContext :: forall (m :: * -> *) store.
(Monad m, LaunchDarklyStoreRead store m) =>
Rule -> Context -> store -> m (Either Text Bool)
ruleMatchesContext Rule
rule Context
context store
store = forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldlM (forall (m :: * -> *) store.
(Monad m, LaunchDarklyStoreRead store m) =>
store
-> Context -> Either Text Bool -> Clause -> m (Either Text Bool)
checkRule store
store Context
context) (forall a b. b -> Either a b
Right Bool
True) [Clause]
clauses
  where
    clauses :: [Clause]
clauses = forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"clauses" Rule
rule
    checkRule :: Monad m => LaunchDarklyStoreRead store m => store -> Context -> Either Text Bool -> Clause -> m (Either Text Bool)
    checkRule :: forall (m :: * -> *) store.
(Monad m, LaunchDarklyStoreRead store m) =>
store
-> Context -> Either Text Bool -> Clause -> m (Either Text Bool)
checkRule store
_ Context
_ (Left Text
e) Clause
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left Text
e
    checkRule store
_ Context
_ (Right Bool
False) Clause
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right Bool
False
    checkRule store
store Context
context Either Text Bool
_ Clause
clause = forall (m :: * -> *) store.
(Monad m, LaunchDarklyStoreRead store m) =>
store -> Clause -> Context -> HashSet Text -> m (Either Text Bool)
clauseMatchesContext store
store Clause
clause Context
context forall a. HashSet a
HS.empty

variationIndexForContext :: VariationOrRollout -> Context -> Text -> Text -> (Maybe Integer, Bool)
variationIndexForContext :: VariationOrRollout
-> Context -> Text -> Text -> (Maybe Integer, Bool)
variationIndexForContext VariationOrRollout
vor Context
context 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
            isRolloutExperiment :: Bool
isRolloutExperiment = (forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"kind" Rollout
rollout) forall a. Eq a => a -> a -> Bool
== RolloutKind
RolloutKindExperiment
            bucketBy :: Text
bucketBy = forall a. a -> Maybe a -> a
fromMaybe Text
"key" forall a b. (a -> b) -> a -> b
$ if Bool
isRolloutExperiment then forall a. Maybe a
Nothing else forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"bucketBy" Rollout
rollout
            variations :: [WeightedVariation]
variations = forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"variations" Rollout
rollout
            bucket :: Maybe Float
bucket = Context
-> Maybe Text -> Text -> Text -> Text -> Maybe Int -> Maybe Float
bucketContext Context
context (forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"contextKind" Rollout
rollout) Text
key Text
bucketBy Text
salt (forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"seed" Rollout
rollout)
            isExperiment :: Bool
isExperiment = Bool
isRolloutExperiment Bool -> Bool -> Bool
&& (forall a. Maybe a -> Bool
isJust Maybe Float
bucket)
            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 case Maybe Float
bucket of
                            Just Float
v | Float
v forall a. Ord a => a -> a -> Bool
>= Float
t -> forall a b. b -> Either a b
Right Float
t
                            Maybe Float
_ -> 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)
         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)

bucketContext :: Context -> Maybe Text -> Text -> Text -> Text -> Maybe Int -> Maybe Float
bucketContext :: Context
-> Maybe Text -> Text -> Text -> Text -> Maybe Int -> Maybe Float
bucketContext Context
context Maybe Text
kind Text
key Text
attribute Text
salt Maybe Int
seed =
    let bucketBy :: Reference
bucketBy = case Maybe Text
kind of
            Maybe Text
Nothing -> Text -> Reference
makeLiteral Text
attribute
            Just Text
_ -> Text -> Reference
makeReference Text
attribute
     in case Text -> Context -> Maybe Context
getIndividualContext (forall a. a -> Maybe a -> a
fromMaybe Text
"user" Maybe Text
kind) Context
context of
            Maybe Context
Nothing -> forall a. Maybe a
Nothing
            Just Context
ctx ->
                let bucketableString :: Maybe Text
bucketableString = Value -> Maybe Text
bucketableStringValue forall a b. (a -> b) -> a -> b
$ Reference -> Context -> Value
getValueForReference Reference
bucketBy Context
ctx
                 in forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Maybe Text -> Text -> Text -> Maybe Int -> Float
calculateBucketValue Maybe Text
bucketableString Text
key Text
salt Maybe Int
seed

calculateBucketValue :: (Maybe Text) -> Text -> Text -> Maybe Int -> Float
calculateBucketValue :: Maybe Text -> Text -> Text -> Maybe Int -> Float
calculateBucketValue Maybe Text
Nothing Text
_ Text
_ Maybe Int
_ = Float
0
calculateBucketValue (Just Text
text) Text
key Text
salt Maybe Int
seed =
    let seed' :: Text
seed' = case Maybe Int
seed of
            Maybe Int
Nothing -> [Text] -> Text
T.concat [Text
key, Text
".", Text
salt, Text
".", Text
text]
            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
text]
        byteString :: ByteString
byteString = 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
$ Text
seed'
     in ((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
byteString) :: 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

-- For a given clause, determine if the provided value matches that clause.
--
-- The operation to be check and the values to compare against are both extract from within the Clause itself.
matchAnyClauseValue :: Clause -> Value -> Bool
matchAnyClauseValue :: Clause -> Value -> Bool
matchAnyClauseValue Clause
clause Value
contextValue = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Value -> Value -> Bool
f Value
contextValue) [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

-- If attribute is "kind", then we treat operator and values as a match expression against a list of all individual
-- kinds in the context. That is, for a multi-kind context with kinds of "org" and "user", it is a match if either
-- of those strings is a match with Operator and Values.
clauseMatchesByKind :: Clause -> Context -> Bool
clauseMatchesByKind :: Clause -> Context -> Bool
clauseMatchesByKind Clause
clause Context
context = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Text -> Bool -> Bool
f Bool
False (Context -> [Text]
getKinds Context
context)
  where
    f :: Text -> Bool -> Bool
f Text
kind Bool
result
        | Bool
result forall a. Eq a => a -> a -> Bool
== Bool
True = Bool
True
        | Bool
otherwise = Clause -> Value -> Bool
matchAnyClauseValue Clause
clause (Text -> Value
String Text
kind)

clauseMatchesContextNoSegments :: Clause -> Context -> Either Text Bool
clauseMatchesContextNoSegments :: Clause -> Context -> Either Text Bool
clauseMatchesContextNoSegments Clause
clause Context
context
    | Reference -> Bool
isValid (forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"attribute" Clause
clause) forall a. Eq a => a -> a -> Bool
== Bool
False = forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ Reference -> Text
getError forall a b. (a -> b) -> a -> b
$ forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"attribute" Clause
clause
    | [Text
"kind"] forall a. Eq a => a -> a -> Bool
== Reference -> [Text]
getComponents (forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"attribute" Clause
clause) = forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Clause -> Bool -> Bool
maybeNegate Clause
clause forall a b. (a -> b) -> a -> b
$ Clause -> Context -> Bool
clauseMatchesByKind Clause
clause Context
context
    | Bool
otherwise = case Text -> Context -> Maybe Context
getIndividualContext (forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"contextKind" Clause
clause) Context
context of
        Maybe Context
Nothing -> forall a b. b -> Either a b
Right Bool
False
        Just Context
ctx -> case Reference -> Context -> Value
getValueForReference (forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"attribute" Clause
clause) Context
ctx of
            Value
Null -> forall a b. b -> Either a b
Right Bool
False
            Array Array
a -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Clause -> Bool -> Bool
maybeNegate Clause
clause forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> Vector a -> Bool
V.any (Clause -> Value -> Bool
matchAnyClauseValue Clause
clause) Array
a
            Value
x -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Clause -> Bool -> Bool
maybeNegate Clause
clause forall a b. (a -> b) -> a -> b
$ Clause -> Value -> Bool
matchAnyClauseValue Clause
clause Value
x

clauseMatchesContext :: (Monad m, LaunchDarklyStoreRead store m) => store -> Clause -> Context -> HS.HashSet Text -> m (Either Text Bool)
clauseMatchesContext :: forall (m :: * -> *) store.
(Monad m, LaunchDarklyStoreRead store m) =>
store -> Clause -> Context -> HashSet Text -> m (Either Text Bool)
clauseMatchesContext store
store Clause
clause Context
context HashSet Text
seenSegments
    | forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"op" Clause
clause forall a. Eq a => a -> a -> Bool
== Op
OpSegmentMatch =
        let values :: [Text]
values = [Text
x | String Text
x <- forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"values" Clause
clause]
         in forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldlM (forall (m :: * -> *) store.
(Monad m, LaunchDarklyStoreRead store m) =>
store
-> Context
-> HashSet Text
-> Either Text Bool
-> Text
-> m (Either Text Bool)
checkSegment store
store Context
context HashSet Text
seenSegments) (forall a b. b -> Either a b
Right Bool
False) [Text]
values 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 b c a. (b -> c) -> Either a b -> Either a c
mapRight (Clause -> Bool -> Bool
maybeNegate Clause
clause)
    | Bool
otherwise = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Clause -> Context -> Either Text Bool
clauseMatchesContextNoSegments Clause
clause Context
context

checkSegment :: (Monad m, LaunchDarklyStoreRead store m) => store -> Context -> HS.HashSet Text -> Either Text Bool -> Text -> m (Either Text Bool)
checkSegment :: forall (m :: * -> *) store.
(Monad m, LaunchDarklyStoreRead store m) =>
store
-> Context
-> HashSet Text
-> Either Text Bool
-> Text
-> m (Either Text Bool)
checkSegment store
_ Context
_ HashSet Text
_ (Left Text
e) Text
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left Text
e
checkSegment store
_ Context
_ HashSet Text
_ (Right Bool
True) Text
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right Bool
True
checkSegment store
store Context
context HashSet Text
seenSegments Either Text Bool
_ Text
value =
    forall store (m :: * -> *).
LaunchDarklyStoreRead store m =>
store -> Text -> StoreResultM m (Maybe Segment)
getSegmentC store
store Text
value forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Right (Just Segment
segment) -> forall (m :: * -> *) store.
(Monad m, LaunchDarklyStoreRead store m) =>
store -> Segment -> Context -> HashSet Text -> m (Either Text Bool)
segmentContainsContext store
store Segment
segment Context
context HashSet Text
seenSegments
        Either Text (Maybe Segment)
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right Bool
False

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

segmentRuleMatchesContext :: (Monad m, LaunchDarklyStoreRead store m) => store -> SegmentRule -> Context -> Text -> Text -> HS.HashSet Text -> m (Either Text Bool)
segmentRuleMatchesContext :: forall (m :: * -> *) store.
(Monad m, LaunchDarklyStoreRead store m) =>
store
-> SegmentRule
-> Context
-> Text
-> Text
-> HashSet Text
-> m (Either Text Bool)
segmentRuleMatchesContext store
store SegmentRule
rule Context
context Text
key Text
salt HashSet Text
seenSegments =
    forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldlM (forall (m :: * -> *) store.
(Monad m, LaunchDarklyStoreRead store m) =>
store -> Either Text Bool -> Clause -> m (Either Text Bool)
checkClause store
store) (forall a b. b -> Either a b
Right Bool
True) (forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"clauses" SegmentRule
rule) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Either Text Bool
result ->
        forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ case Either Text Bool
result of
            Left Text
_ -> Either Text Bool
result
            Right Bool
False -> Either Text Bool
result
            Either Text Bool
_ ->
                forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$
                    ( 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 ->
                        let bucket :: Maybe Float
bucket = Context
-> Maybe Text -> Text -> Text -> Text -> Maybe Int -> Maybe Float
bucketContext Context
context (forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"rolloutContextKind" SegmentRule
rule) 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
                         in case Maybe Float
bucket of
                                Just Float
v | Float
v forall a. Ord a => a -> a -> Bool
>= (Float
weight forall a. Fractional a => a -> a -> a
/ Float
100000.0) -> Bool
False
                                Maybe Float
_ -> Bool
True
                    )
  where
    checkClause :: (Monad m, LaunchDarklyStoreRead store m) => store -> Either Text Bool -> Clause -> m (Either Text Bool)
    checkClause :: forall (m :: * -> *) store.
(Monad m, LaunchDarklyStoreRead store m) =>
store -> Either Text Bool -> Clause -> m (Either Text Bool)
checkClause store
_ (Left Text
e) Clause
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left Text
e
    checkClause store
_ (Right Bool
False) Clause
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right Bool
False
    checkClause store
store Either Text Bool
_ Clause
clause = forall (m :: * -> *) store.
(Monad m, LaunchDarklyStoreRead store m) =>
store -> Clause -> Context -> HashSet Text -> m (Either Text Bool)
clauseMatchesContext store
store Clause
clause Context
context HashSet Text
seenSegments

segmentContainsContext :: (Monad m, LaunchDarklyStoreRead store m) => store -> Segment -> Context -> HS.HashSet Text -> m (Either Text Bool)
segmentContainsContext :: forall (m :: * -> *) store.
(Monad m, LaunchDarklyStoreRead store m) =>
store -> Segment -> Context -> HashSet Text -> m (Either Text Bool)
segmentContainsContext store
store (Segment {HashSet Text
$sel:included:Segment :: Segment -> HashSet Text
included :: HashSet Text
included, [SegmentTarget]
$sel:includedContexts:Segment :: Segment -> [SegmentTarget]
includedContexts :: [SegmentTarget]
includedContexts, HashSet Text
$sel:excluded:Segment :: Segment -> HashSet Text
excluded :: HashSet Text
excluded, [SegmentTarget]
$sel:excludedContexts:Segment :: Segment -> [SegmentTarget]
excludedContexts :: [SegmentTarget]
excludedContexts, Text
$sel:key:Segment :: Segment -> Text
key :: Text
key, Text
$sel:salt:Segment :: Segment -> Text
salt :: Text
salt, [SegmentRule]
$sel:rules:Segment :: Segment -> [SegmentRule]
rules :: [SegmentRule]
rules}) Context
context HashSet Text
seenSegments
    | forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
HS.member Text
key HashSet Text
seenSegments = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left Text
"segment rule caused a circular reference; this is probably a temporary condition"
    | HashSet Text -> Text -> Context -> Bool
contextKeyInTargetList HashSet Text
included Text
"user" Context
context = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right Bool
True
    | (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (forall a b c. (a -> b -> c) -> b -> a -> c
flip SegmentTarget -> Context -> Bool
contextKeyInSegmentTarget Context
context) [SegmentTarget]
includedContexts) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right Bool
True
    | HashSet Text -> Text -> Context -> Bool
contextKeyInTargetList HashSet Text
excluded Text
"user" Context
context = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right Bool
False
    | (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (forall a b c. (a -> b -> c) -> b -> a -> c
flip SegmentTarget -> Context -> Bool
contextKeyInSegmentTarget Context
context) [SegmentTarget]
excludedContexts) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right Bool
False
    | Bool
otherwise = forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldlM (forall (m :: * -> *) store.
(Monad m, LaunchDarklyStoreRead store m) =>
store -> Either Text Bool -> SegmentRule -> m (Either Text Bool)
checkRules store
store) (forall a b. b -> Either a b
Right Bool
False) [SegmentRule]
rules
  where
    checkRules :: (Monad m, LaunchDarklyStoreRead store m) => store -> Either Text Bool -> SegmentRule -> m (Either Text Bool)
    checkRules :: forall (m :: * -> *) store.
(Monad m, LaunchDarklyStoreRead store m) =>
store -> Either Text Bool -> SegmentRule -> m (Either Text Bool)
checkRules store
_ (Left Text
e) SegmentRule
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left Text
e
    checkRules store
_ (Right Bool
True) SegmentRule
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right Bool
True
    checkRules store
store Either Text Bool
_ SegmentRule
rule = forall (m :: * -> *) store.
(Monad m, LaunchDarklyStoreRead store m) =>
store
-> SegmentRule
-> Context
-> Text
-> Text
-> HashSet Text
-> m (Either Text Bool)
segmentRuleMatchesContext store
store SegmentRule
rule Context
context Text
key Text
salt (forall a. (Eq a, Hashable a) => a -> HashSet a -> HashSet a
HS.insert Text
key HashSet Text
seenSegments)

contextKeyInSegmentTarget :: SegmentTarget -> Context -> Bool
contextKeyInSegmentTarget :: SegmentTarget -> Context -> Bool
contextKeyInSegmentTarget (SegmentTarget {HashSet Text
$sel:values:SegmentTarget :: SegmentTarget -> HashSet Text
values :: HashSet Text
values, Text
$sel:contextKind:SegmentTarget :: SegmentTarget -> Text
contextKind :: Text
contextKind}) = HashSet Text -> Text -> Context -> Bool
contextKeyInTargetList HashSet Text
values Text
contextKind

contextKeyInTargetList :: (HashSet Text) -> Text -> Context -> Bool
contextKeyInTargetList :: HashSet Text -> Text -> Context -> Bool
contextKeyInTargetList HashSet Text
targets Text
kind Context
context = case Text -> Context -> Maybe Context
getIndividualContext Text
kind Context
context of
    Just Context
ctx -> forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem (Context -> Text
getKey Context
ctx) HashSet Text
targets
    Maybe Context
Nothing -> Bool
False