{-# 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, mapMaybe)
import Data.Scientific (Scientific, floatingOrInteger)
import Data.Text (Text)
import qualified Data.Text as T
import Data.Text.Encoding (encodeUtf8)
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)
import LaunchDarkly.Server.Util (fst3, snd3, trd)

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

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

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

evaluateTyped :: Client -> Text -> Context -> a -> (a -> Value) -> Bool -> (Value -> Maybe a) -> IO (EvaluationDetail a)
evaluateTyped :: Client
-> Text
-> Context
-> a
-> (a -> Value)
-> Bool
-> (Value -> Maybe a)
-> IO (EvaluationDetail a)
evaluateTyped client :: Client
client key :: Text
key context :: Context
context fallback :: a
fallback wrap :: a -> Value
wrap includeReason :: Bool
includeReason convert :: Value -> Maybe a
convert =
    Client -> IO Status
getStatusI Client
client IO Status
-> (Status -> IO (EvaluationDetail a)) -> IO (EvaluationDetail a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \status :: Status
status ->
        if Status
status Status -> Status -> Bool
forall a. Eq a => a -> a -> Bool
/= Status
Initialized
            then EvaluationDetail a -> IO (EvaluationDetail a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (EvaluationDetail a -> IO (EvaluationDetail a))
-> EvaluationDetail a -> IO (EvaluationDetail a)
forall a b. (a -> b) -> a -> b
$ a -> Maybe Integer -> EvaluationReason -> EvaluationDetail a
forall value.
value
-> Maybe Integer -> EvaluationReason -> EvaluationDetail value
EvaluationDetail a
fallback Maybe Integer
forall a. Maybe a
Nothing (EvaluationReason -> EvaluationDetail a)
-> EvaluationReason -> EvaluationDetail a
forall a b. (a -> b) -> a -> b
$ EvalErrorKind -> EvaluationReason
EvaluationReasonError EvalErrorKind
EvalErrorClientNotReady
            else
                Client
-> Text
-> Context
-> Value
-> Bool
-> IO (EvaluationDetail Value, Maybe [Text])
evaluateInternalClient Client
client Text
key Context
context (a -> Value
wrap a
fallback) Bool
includeReason IO (EvaluationDetail Value, Maybe [Text])
-> ((EvaluationDetail Value, Maybe [Text])
    -> IO (EvaluationDetail a))
-> IO (EvaluationDetail a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(detail :: EvaluationDetail Value
detail, _) ->
                    EvaluationDetail a -> IO (EvaluationDetail a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (EvaluationDetail a -> IO (EvaluationDetail a))
-> EvaluationDetail a -> IO (EvaluationDetail a)
forall a b. (a -> b) -> a -> b
$
                        EvaluationDetail a
-> (a -> EvaluationDetail a) -> Maybe a -> EvaluationDetail a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
                            (a -> Maybe Integer -> EvaluationReason -> EvaluationDetail a
forall value.
value
-> Maybe Integer -> EvaluationReason -> EvaluationDetail value
EvaluationDetail a
fallback Maybe Integer
forall a. Maybe a
Nothing (EvaluationReason -> EvaluationDetail a)
-> EvaluationReason -> EvaluationDetail a
forall a b. (a -> b) -> a -> b
$ if EvaluationReason -> Bool
isError (EvaluationDetail Value -> EvaluationReason
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"reason" EvaluationDetail Value
detail) then (EvaluationDetail Value -> EvaluationReason
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"reason" EvaluationDetail Value
detail) else EvalErrorKind -> EvaluationReason
EvaluationReasonError EvalErrorKind
EvalErrorWrongType)
                            (EvaluationDetail Value -> a -> EvaluationDetail a
forall a. EvaluationDetail Value -> a -> EvaluationDetail a
setValue EvaluationDetail Value
detail)
                            (Value -> Maybe a
convert (Value -> Maybe a) -> Value -> Maybe a
forall a b. (a -> b) -> a -> b
$ EvaluationDetail Value -> Value
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, Maybe [Text])
evaluateInternalClient :: Client
-> Text
-> Context
-> Value
-> Bool
-> IO (EvaluationDetail Value, Maybe [Text])
evaluateInternalClient _ _ (Invalid _) fallback :: Value
fallback _ = (EvaluationDetail Value, Maybe [Text])
-> IO (EvaluationDetail Value, Maybe [Text])
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((EvaluationDetail Value, Maybe [Text])
 -> IO (EvaluationDetail Value, Maybe [Text]))
-> (EvaluationDetail Value, Maybe [Text])
-> IO (EvaluationDetail Value, Maybe [Text])
forall a b. (a -> b) -> a -> b
$ (EvalErrorKind -> Value -> EvaluationDetail Value
errorDefault EvalErrorKind
EvalErrorInvalidContext Value
fallback, Maybe [Text]
forall a. Maybe a
Nothing)
evaluateInternalClient client :: Client
client key :: Text
key context :: Context
context fallback :: Value
fallback includeReason :: Bool
includeReason = do
    (detail :: EvaluationDetail Value
detail, unknown :: Bool
unknown, events :: [EvalEvent]
events, prereqs :: Maybe [Text]
prereqs) <-
        StoreHandle IO -> Text -> StoreResultM IO (Maybe Flag)
forall store (m :: * -> *).
LaunchDarklyStoreRead store m =>
store -> Text -> StoreResultM m (Maybe Flag)
getFlagC (Client -> StoreHandle IO
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"store" Client
client) Text
key StoreResultM IO (Maybe Flag)
-> (Either Text (Maybe Flag)
    -> IO (EvaluationDetail Value, Bool, [EvalEvent], Maybe [Text]))
-> IO (EvaluationDetail Value, Bool, [EvalEvent], Maybe [Text])
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            Left err :: Text
err -> do
                let event :: EvalEvent
event = Text -> Value -> EvaluationReason -> Context -> EvalEvent
newUnknownFlagEvent Text
key Value
fallback (EvalErrorKind -> EvaluationReason
EvaluationReasonError (EvalErrorKind -> EvaluationReason)
-> EvalErrorKind -> EvaluationReason
forall a b. (a -> b) -> a -> b
$ Text -> EvalErrorKind
EvalErrorExternalStore Text
err) Context
context
                (EvaluationDetail Value, Bool, [EvalEvent], Maybe [Text])
-> IO (EvaluationDetail Value, Bool, [EvalEvent], Maybe [Text])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (EvalErrorKind -> EvaluationDetail Value
errorDetail (EvalErrorKind -> EvaluationDetail Value)
-> EvalErrorKind -> EvaluationDetail Value
forall a b. (a -> b) -> a -> b
$ Text -> EvalErrorKind
EvalErrorExternalStore Text
err, Bool
True, EvalEvent -> [EvalEvent]
forall (f :: * -> *) a. Applicative f => a -> f a
pure EvalEvent
event, Maybe [Text]
forall a. Maybe a
Nothing)
            Right Nothing -> do
                let event :: EvalEvent
event = Text -> Value -> EvaluationReason -> Context -> EvalEvent
newUnknownFlagEvent Text
key Value
fallback (EvalErrorKind -> EvaluationReason
EvaluationReasonError EvalErrorKind
EvalErrorFlagNotFound) Context
context
                (EvaluationDetail Value, Bool, [EvalEvent], Maybe [Text])
-> IO (EvaluationDetail Value, Bool, [EvalEvent], Maybe [Text])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (EvalErrorKind -> Value -> EvaluationDetail Value
errorDefault EvalErrorKind
EvalErrorFlagNotFound Value
fallback, Bool
True, EvalEvent -> [EvalEvent]
forall (f :: * -> *) a. Applicative f => a -> f a
pure EvalEvent
event, Maybe [Text]
forall a. Maybe a
Nothing)
            Right (Just flag :: Flag
flag) -> do
                (detail :: EvaluationDetail Value
detail, events :: [EvalEvent]
events, prereqs :: Maybe [Text]
prereqs) <- Flag
-> Context
-> HashSet Text
-> StoreHandle IO
-> IO (EvaluationDetail Value, [EvalEvent], Maybe [Text])
forall (m :: * -> *) store.
(Monad m, LaunchDarklyStoreRead store m) =>
Flag
-> Context
-> HashSet Text
-> store
-> m (EvaluationDetail Value, [EvalEvent], Maybe [Text])
evaluateDetail Flag
flag Context
context HashSet Text
forall a. HashSet a
HS.empty (StoreHandle IO
 -> IO (EvaluationDetail Value, [EvalEvent], Maybe [Text]))
-> StoreHandle IO
-> IO (EvaluationDetail Value, [EvalEvent], Maybe [Text])
forall a b. (a -> b) -> a -> b
$ Client -> StoreHandle IO
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
                (EvaluationDetail Value, Bool, [EvalEvent], Maybe [Text])
-> IO (EvaluationDetail Value, Bool, [EvalEvent], Maybe [Text])
forall (f :: * -> *) a. Applicative f => a -> f a
pure
                    ( EvaluationDetail Value
detail'
                    , Bool
False
                    , (EvalEvent -> [EvalEvent] -> [EvalEvent])
-> [EvalEvent] -> EvalEvent -> [EvalEvent]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (:) [EvalEvent]
events (EvalEvent -> [EvalEvent]) -> EvalEvent -> [EvalEvent]
forall a b. (a -> b) -> a -> b
$
                        Flag
-> Maybe Integer
-> Value
-> Maybe Value
-> EvaluationReason
-> Maybe Text
-> Context
-> EvalEvent
newSuccessfulEvalEvent
                            Flag
flag
                            (EvaluationDetail Value -> Maybe Integer
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"variationIndex" EvaluationDetail Value
detail')
                            (EvaluationDetail Value -> Value
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"value" EvaluationDetail Value
detail')
                            (Value -> Maybe Value
forall a. a -> Maybe a
Just Value
fallback)
                            (EvaluationDetail Value -> EvaluationReason
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"reason" EvaluationDetail Value
detail')
                            Maybe Text
forall a. Maybe a
Nothing
                            Context
context
                    , Maybe [Text]
prereqs
                    )
    Config
-> EventState -> Context -> Bool -> [EvalEvent] -> Bool -> IO ()
processEvalEvents (Client -> Config
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"config" Client
client) (Client -> EventState
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"events" Client
client) Context
context Bool
includeReason [EvalEvent]
events Bool
unknown
    (EvaluationDetail Value, Maybe [Text])
-> IO (EvaluationDetail Value, Maybe [Text])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (EvaluationDetail Value
detail, Maybe [Text]
prereqs)

getOffValue :: Flag -> EvaluationReason -> EvaluationDetail Value
getOffValue :: Flag -> EvaluationReason -> EvaluationDetail Value
getOffValue flag :: Flag
flag reason :: EvaluationReason
reason = case Flag -> Maybe Integer
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"offVariation" Flag
flag of
    Just offVariation :: Integer
offVariation -> Flag -> Integer -> EvaluationReason -> EvaluationDetail Value
getVariation Flag
flag Integer
offVariation EvaluationReason
reason
    Nothing -> $WEvaluationDetail :: forall value.
value
-> Maybe Integer -> EvaluationReason -> EvaluationDetail value
EvaluationDetail {$sel:value:EvaluationDetail :: Value
value = Value
Null, $sel:variationIndex:EvaluationDetail :: Maybe Integer
variationIndex = Maybe Integer
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
flag index :: Integer
index reason :: EvaluationReason
reason
    | Int
idx Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 0 = $WEvaluationDetail :: forall value.
value
-> Maybe Integer -> EvaluationReason -> EvaluationDetail value
EvaluationDetail {$sel:value:EvaluationDetail :: Value
value = Value
Null, $sel:variationIndex:EvaluationDetail :: Maybe Integer
variationIndex = Maybe Integer
forall (m :: * -> *) a. MonadPlus m => m a
mzero, $sel:reason:EvaluationDetail :: EvaluationReason
reason = EvalErrorKind -> EvaluationReason
EvaluationReasonError EvalErrorKind
EvalErrorKindMalformedFlag}
    | Int
idx Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= [Value] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Value]
variations = $WEvaluationDetail :: forall value.
value
-> Maybe Integer -> EvaluationReason -> EvaluationDetail value
EvaluationDetail {$sel:value:EvaluationDetail :: Value
value = Value
Null, $sel:variationIndex:EvaluationDetail :: Maybe Integer
variationIndex = Maybe Integer
forall (m :: * -> *) a. MonadPlus m => m a
mzero, $sel:reason:EvaluationDetail :: EvaluationReason
reason = EvalErrorKind -> EvaluationReason
EvaluationReasonError EvalErrorKind
EvalErrorKindMalformedFlag}
    | Bool
otherwise = $WEvaluationDetail :: forall value.
value
-> Maybe Integer -> EvaluationReason -> EvaluationDetail value
EvaluationDetail {$sel:value:EvaluationDetail :: Value
value = [Value] -> Integer -> Value
forall i a. Integral i => [a] -> i -> a
genericIndex [Value]
variations Integer
index, $sel:variationIndex:EvaluationDetail :: Maybe Integer
variationIndex = Integer -> Maybe Integer
forall (f :: * -> *) a. Applicative f => a -> f a
pure Integer
index, $sel:reason:EvaluationDetail :: EvaluationReason
reason = EvaluationReason
reason}
  where
    idx :: Int
idx = Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
index
    variations :: [Value]
variations = Flag -> [Value]
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], Maybe [Text])
evaluateDetail :: Flag
-> Context
-> HashSet Text
-> store
-> m (EvaluationDetail Value, [EvalEvent], Maybe [Text])
evaluateDetail flag :: Flag
flag@(forall a s. HasField' "on" s a => s -> a
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"on" -> Bool
False) _ _ _ = (EvaluationDetail Value, [EvalEvent], Maybe [Text])
-> m (EvaluationDetail Value, [EvalEvent], Maybe [Text])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Flag -> EvaluationReason -> EvaluationDetail Value
getOffValue Flag
flag EvaluationReason
EvaluationReasonOff, [], Maybe [Text]
forall a. Maybe a
Nothing)
evaluateDetail flag :: Flag
flag context :: Context
context seenFlags :: HashSet Text
seenFlags store :: store
store
    | Text -> HashSet Text -> Bool
forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
HS.member (Flag -> Text
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"key" Flag
flag) HashSet Text
seenFlags = (EvaluationDetail Value, [EvalEvent], Maybe [Text])
-> m (EvaluationDetail Value, [EvalEvent], Maybe [Text])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Flag -> EvaluationReason -> EvaluationDetail Value
getOffValue Flag
flag (EvaluationReason -> EvaluationDetail Value)
-> EvaluationReason -> EvaluationDetail Value
forall a b. (a -> b) -> a -> b
$ EvalErrorKind -> EvaluationReason
EvaluationReasonError EvalErrorKind
EvalErrorKindMalformedFlag, [], Maybe [Text]
forall a. Maybe a
Nothing)
    | Bool
otherwise =
        Flag
-> Context
-> HashSet Text
-> store
-> m (Maybe (EvaluationDetail Value), [EvalEvent], Maybe [Text])
forall (m :: * -> *) store.
(Monad m, LaunchDarklyStoreRead store m) =>
Flag
-> Context
-> HashSet Text
-> store
-> m (Maybe (EvaluationDetail Value), [EvalEvent], Maybe [Text])
checkPrerequisites Flag
flag Context
context (Text -> HashSet Text -> HashSet Text
forall a. (Eq a, Hashable a) => a -> HashSet a -> HashSet a
HS.insert (Flag -> Text
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"key" Flag
flag) HashSet Text
seenFlags) store
store m (Maybe (EvaluationDetail Value), [EvalEvent], Maybe [Text])
-> ((Maybe (EvaluationDetail Value), [EvalEvent], Maybe [Text])
    -> m (EvaluationDetail Value, [EvalEvent], Maybe [Text]))
-> m (EvaluationDetail Value, [EvalEvent], Maybe [Text])
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            (Nothing, events :: [EvalEvent]
events, prereqs :: Maybe [Text]
prereqs) -> Flag -> Context -> store -> m (EvaluationDetail Value)
forall (m :: * -> *) store.
(Monad m, LaunchDarklyStoreRead store m) =>
Flag -> Context -> store -> m (EvaluationDetail Value)
evaluateInternal Flag
flag Context
context store
store m (EvaluationDetail Value)
-> (EvaluationDetail Value
    -> m (EvaluationDetail Value, [EvalEvent], Maybe [Text]))
-> m (EvaluationDetail Value, [EvalEvent], Maybe [Text])
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\x :: EvaluationDetail Value
x -> (EvaluationDetail Value, [EvalEvent], Maybe [Text])
-> m (EvaluationDetail Value, [EvalEvent], Maybe [Text])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (EvaluationDetail Value
x, [EvalEvent]
events, Maybe [Text]
prereqs))
            (Just detail :: EvaluationDetail Value
detail, events :: [EvalEvent]
events, prereqs :: Maybe [Text]
prereqs) -> (EvaluationDetail Value, [EvalEvent], Maybe [Text])
-> m (EvaluationDetail Value, [EvalEvent], Maybe [Text])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (EvaluationDetail Value
detail, [EvalEvent]
events, Maybe [Text]
prereqs)

status :: Prerequisite -> EvaluationDetail a -> Flag -> Bool
status :: Prerequisite -> EvaluationDetail a -> Flag -> Bool
status prereq :: Prerequisite
prereq result :: EvaluationDetail a
result prereqFlag :: Flag
prereqFlag =
    Flag -> Bool
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"on" Flag
prereqFlag
        Bool -> Bool -> Bool
&& (EvaluationDetail a -> Maybe Integer
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"variationIndex" EvaluationDetail a
result)
            Maybe Integer -> Maybe Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer -> Maybe Integer
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Prerequisite -> Integer
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 :: (a -> Bool) -> [m a] -> m [a]
sequenceUntil _ [] = [a] -> m [a]
forall (m :: * -> *) a. Monad m => a -> m a
return []
sequenceUntil p :: a -> Bool
p (m :: m a
m : ms :: [m a]
ms) =
    m a
m m a -> (a -> m [a]) -> m [a]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a :: a
a ->
        if a -> Bool
p a
a
            then [a] -> m [a]
forall (m :: * -> *) a. Monad m => a -> m a
return [a
a]
            else (a -> Bool) -> [m a] -> m [a]
forall (m :: * -> *) a. Monad m => (a -> Bool) -> [m a] -> m [a]
sequenceUntil a -> Bool
p [m a]
ms m [a] -> ([a] -> m [a]) -> m [a]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \as :: [a]
as -> [a] -> m [a]
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a a -> [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], Maybe [Text])
checkPrerequisites :: Flag
-> Context
-> HashSet Text
-> store
-> m (Maybe (EvaluationDetail Value), [EvalEvent], Maybe [Text])
checkPrerequisites flag :: Flag
flag context :: Context
context seenFlags :: HashSet Text
seenFlags store :: store
store =
    let p :: [Prerequisite]
p = Flag -> [Prerequisite]
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"prerequisites" Flag
flag
     in if [Prerequisite] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Prerequisite]
p
            then (Maybe (EvaluationDetail Value), [EvalEvent], Maybe [Text])
-> m (Maybe (EvaluationDetail Value), [EvalEvent], Maybe [Text])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (EvaluationDetail Value)
forall a. Maybe a
Nothing, [], Maybe [Text]
forall a. Maybe a
Nothing)
            else do
                [(Maybe (EvaluationDetail Value), [EvalEvent], Maybe Text)]
evals <- ((Maybe (EvaluationDetail Value), [EvalEvent], Maybe Text) -> Bool)
-> [m (Maybe (EvaluationDetail Value), [EvalEvent], Maybe Text)]
-> m [(Maybe (EvaluationDetail Value), [EvalEvent], Maybe Text)]
forall (m :: * -> *) a. Monad m => (a -> Bool) -> [m a] -> m [a]
sequenceUntil (Maybe (EvaluationDetail Value) -> Bool
forall a. Maybe a -> Bool
isJust (Maybe (EvaluationDetail Value) -> Bool)
-> ((Maybe (EvaluationDetail Value), [EvalEvent], Maybe Text)
    -> Maybe (EvaluationDetail Value))
-> (Maybe (EvaluationDetail Value), [EvalEvent], Maybe Text)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe (EvaluationDetail Value), [EvalEvent], Maybe Text)
-> Maybe (EvaluationDetail Value)
forall a b c. (a, b, c) -> a
fst3) ([m (Maybe (EvaluationDetail Value), [EvalEvent], Maybe Text)]
 -> m [(Maybe (EvaluationDetail Value), [EvalEvent], Maybe Text)])
-> [m (Maybe (EvaluationDetail Value), [EvalEvent], Maybe Text)]
-> m [(Maybe (EvaluationDetail Value), [EvalEvent], Maybe Text)]
forall a b. (a -> b) -> a -> b
$ (Prerequisite
 -> m (Maybe (EvaluationDetail Value), [EvalEvent], Maybe Text))
-> [Prerequisite]
-> [m (Maybe (EvaluationDetail Value), [EvalEvent], Maybe Text)]
forall a b. (a -> b) -> [a] -> [b]
map (store
-> Context
-> Flag
-> HashSet Text
-> Prerequisite
-> m (Maybe (EvaluationDetail Value), [EvalEvent], Maybe Text)
forall (m :: * -> *) store.
(Monad m, LaunchDarklyStoreRead store m) =>
store
-> Context
-> Flag
-> HashSet Text
-> Prerequisite
-> m (Maybe (EvaluationDetail Value), [EvalEvent], Maybe Text)
checkPrerequisite store
store Context
context Flag
flag HashSet Text
seenFlags) [Prerequisite]
p
                Maybe [Text]
prereqs <- Maybe [Text] -> m (Maybe [Text])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe [Text] -> m (Maybe [Text]))
-> Maybe [Text] -> m (Maybe [Text])
forall a b. (a -> b) -> a -> b
$ ((Maybe (EvaluationDetail Value), [EvalEvent], Maybe Text)
 -> Maybe [Text] -> Maybe [Text])
-> Maybe [Text]
-> [(Maybe (EvaluationDetail Value), [EvalEvent], Maybe Text)]
-> Maybe [Text]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Maybe Text -> Maybe [Text] -> Maybe [Text]
forall a. Maybe a -> Maybe [a] -> Maybe [a]
collectPrereqs (Maybe Text -> Maybe [Text] -> Maybe [Text])
-> ((Maybe (EvaluationDetail Value), [EvalEvent], Maybe Text)
    -> Maybe Text)
-> (Maybe (EvaluationDetail Value), [EvalEvent], Maybe Text)
-> Maybe [Text]
-> Maybe [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe (EvaluationDetail Value), [EvalEvent], Maybe Text)
-> Maybe Text
forall a b c. (a, b, c) -> c
trd) Maybe [Text]
forall a. Maybe a
Nothing [(Maybe (EvaluationDetail Value), [EvalEvent], Maybe Text)]
evals
                (Maybe (EvaluationDetail Value), [EvalEvent], Maybe [Text])
-> m (Maybe (EvaluationDetail Value), [EvalEvent], Maybe [Text])
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Maybe (EvaluationDetail Value)] -> Maybe (EvaluationDetail Value)
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum ([Maybe (EvaluationDetail Value)]
 -> Maybe (EvaluationDetail Value))
-> [Maybe (EvaluationDetail Value)]
-> Maybe (EvaluationDetail Value)
forall a b. (a -> b) -> a -> b
$ ((Maybe (EvaluationDetail Value), [EvalEvent], Maybe Text)
 -> Maybe (EvaluationDetail Value))
-> [(Maybe (EvaluationDetail Value), [EvalEvent], Maybe Text)]
-> [Maybe (EvaluationDetail Value)]
forall a b. (a -> b) -> [a] -> [b]
map (Maybe (EvaluationDetail Value), [EvalEvent], Maybe Text)
-> Maybe (EvaluationDetail Value)
forall a b c. (a, b, c) -> a
fst3 [(Maybe (EvaluationDetail Value), [EvalEvent], Maybe Text)]
evals, ((Maybe (EvaluationDetail Value), [EvalEvent], Maybe Text)
 -> [EvalEvent])
-> [(Maybe (EvaluationDetail Value), [EvalEvent], Maybe Text)]
-> [EvalEvent]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Maybe (EvaluationDetail Value), [EvalEvent], Maybe Text)
-> [EvalEvent]
forall a b c. (a, b, c) -> b
snd3 [(Maybe (EvaluationDetail Value), [EvalEvent], Maybe Text)]
evals, Maybe [Text]
prereqs)
  where
    collectPrereqs :: Maybe a -> Maybe [a] -> Maybe [a]
    collectPrereqs :: Maybe a -> Maybe [a] -> Maybe [a]
collectPrereqs Nothing Nothing = Maybe [a]
forall a. Maybe a
Nothing
    collectPrereqs Nothing (Just x :: [a]
x) = [a] -> Maybe [a]
forall a. a -> Maybe a
Just [a]
x
    collectPrereqs (Just x :: a
x) Nothing = [a] -> Maybe [a]
forall a. a -> Maybe a
Just [a
x]
    collectPrereqs (Just x :: a
x) (Just xs :: [a]
xs) = [a] -> Maybe [a]
forall a. a -> Maybe a
Just (a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
xs)

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

evaluateInternal :: (Monad m, LaunchDarklyStoreRead store m) => Flag -> Context -> store -> m (EvaluationDetail Value)
evaluateInternal :: Flag -> Context -> store -> m (EvaluationDetail Value)
evaluateInternal flag :: Flag
flag context :: Context
context store :: store
store = m (EvaluationDetail Value)
result
  where
    fallthrough :: EvaluationDetail Value
fallthrough = Flag
-> VariationOrRollout
-> Context
-> EvaluationReason
-> EvaluationDetail Value
getValueForVariationOrRollout Flag
flag (Flag -> VariationOrRollout
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 = Maybe (EvaluationDetail Value)
-> m (Maybe (EvaluationDetail Value))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (EvaluationDetail Value)
 -> m (Maybe (EvaluationDetail Value)))
-> [Maybe (EvaluationDetail Value)]
-> [m (Maybe (EvaluationDetail Value))]
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 = (Flag
-> Context
-> store
-> (Natural, Rule)
-> m (Maybe (EvaluationDetail Value))
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, Rule) -> m (Maybe (EvaluationDetail Value)))
-> [(Natural, Rule)] -> [m (Maybe (EvaluationDetail Value))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Natural] -> [Rule] -> [(Natural, Rule)]
forall a b. [a] -> [b] -> [(a, b)]
zip [0 ..] (Flag -> [Rule]
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"rules" Flag
flag)
         in
            EvaluationDetail Value
-> Maybe (EvaluationDetail Value) -> EvaluationDetail Value
forall a. a -> Maybe a -> a
fromMaybe EvaluationDetail Value
fallthrough (Maybe (EvaluationDetail Value) -> EvaluationDetail Value)
-> m (Maybe (EvaluationDetail Value)) -> m (EvaluationDetail Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (m (Maybe (EvaluationDetail Value))
 -> m (Maybe (EvaluationDetail Value)))
-> [m (Maybe (EvaluationDetail Value))]
-> m (Maybe (EvaluationDetail Value))
forall (m :: * -> *) a b.
Monad m =>
(a -> m (Maybe b)) -> [a] -> m (Maybe b)
firstJustM m (Maybe (EvaluationDetail Value))
-> m (Maybe (EvaluationDetail Value))
forall a. a -> a
Prelude.id ([m (Maybe (EvaluationDetail Value))]
targetEvaluationResults [m (Maybe (EvaluationDetail Value))]
-> [m (Maybe (EvaluationDetail Value))]
-> [m (Maybe (EvaluationDetail Value))]
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 :: Flag
-> Context
-> store
-> (Natural, Rule)
-> m (Maybe (EvaluationDetail Value))
checkRule flag :: Flag
flag context :: Context
context store :: store
store (ruleIndex :: Natural
ruleIndex, rule :: Rule
rule) =
    Rule -> Context -> store -> m (Either Text Bool)
forall (m :: * -> *) store.
(Monad m, LaunchDarklyStoreRead store m) =>
Rule -> Context -> store -> m (Either Text Bool)
ruleMatchesContext Rule
rule Context
context store
store
        m (Either Text Bool)
-> (Either Text Bool -> m (Maybe (EvaluationDetail Value)))
-> m (Maybe (EvaluationDetail Value))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Maybe (EvaluationDetail Value)
-> m (Maybe (EvaluationDetail Value))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (EvaluationDetail Value)
 -> m (Maybe (EvaluationDetail Value)))
-> (Either Text Bool -> Maybe (EvaluationDetail Value))
-> Either Text Bool
-> m (Maybe (EvaluationDetail Value))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
            Left _ -> EvaluationDetail Value -> Maybe (EvaluationDetail Value)
forall a. a -> Maybe a
Just (EvaluationDetail Value -> Maybe (EvaluationDetail Value))
-> EvaluationDetail Value -> Maybe (EvaluationDetail Value)
forall a b. (a -> b) -> a -> b
$ EvalErrorKind -> EvaluationDetail Value
errorDetail EvalErrorKind
EvalErrorKindMalformedFlag
            Right True -> EvaluationDetail Value -> Maybe (EvaluationDetail Value)
forall a. a -> Maybe a
Just (EvaluationDetail Value -> Maybe (EvaluationDetail Value))
-> EvaluationDetail Value -> Maybe (EvaluationDetail Value)
forall a b. (a -> b) -> a -> b
$ Flag
-> VariationOrRollout
-> Context
-> EvaluationReason
-> EvaluationDetail Value
getValueForVariationOrRollout Flag
flag (Rule -> VariationOrRollout
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"variationOrRollout" Rule
rule) Context
context $WEvaluationReasonRuleMatch :: Natural -> Text -> Bool -> EvaluationReason
EvaluationReasonRuleMatch {$sel:ruleIndex:EvaluationReasonOff :: Natural
ruleIndex = Natural
ruleIndex, $sel:ruleId:EvaluationReasonOff :: Text
ruleId = Rule -> Text
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"id" Rule
rule, $sel:inExperiment:EvaluationReasonOff :: Bool
inExperiment = Bool
False}
            Right False -> Maybe (EvaluationDetail Value)
forall a. Maybe a
Nothing

checkTargets :: Context -> Flag -> [Maybe (EvaluationDetail Value)]
checkTargets :: Context -> Flag -> [Maybe (EvaluationDetail Value)]
checkTargets context :: Context
context flag :: Flag
flag =
    let userTargets :: [Target]
userTargets = Flag -> [Target]
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"targets" Flag
flag
        contextTargets :: [Target]
contextTargets = Flag -> [Target]
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 "user" Flag
flag (Target -> Maybe (EvaluationDetail Value))
-> [Target] -> [Maybe (EvaluationDetail Value)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Target]
userTargets
            _ -> 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
context flag :: Flag
flag userTargets :: [Target]
userTargets contextTargets :: [Target]
contextTargets =
    Context
-> Flag -> [Target] -> Target -> Maybe (EvaluationDetail Value)
checkContextTarget Context
context Flag
flag [Target]
userTargets (Target -> Maybe (EvaluationDetail Value))
-> [Target] -> [Maybe (EvaluationDetail Value)]
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
context flag :: Flag
flag userTargets :: [Target]
userTargets contextTarget :: Target
contextTarget =
    let contextKind :: Text
contextKind = Target -> Text
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"contextKind" Target
contextTarget
        values :: HashSet Text
values = Target -> HashSet Text
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"values" Target
contextTarget
     in if Text
contextKind Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== "user" Bool -> Bool -> Bool
&& HashSet Text -> 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
                (Maybe (EvaluationDetail Value) -> Maybe (EvaluationDetail Value))
-> [Maybe (EvaluationDetail Value)]
-> Maybe (EvaluationDetail Value)
forall a b. (a -> Maybe b) -> [a] -> Maybe b
firstJust Maybe (EvaluationDetail Value) -> Maybe (EvaluationDetail Value)
forall a. a -> a
Prelude.id ([Maybe (EvaluationDetail Value)]
 -> Maybe (EvaluationDetail Value))
-> [Maybe (EvaluationDetail Value)]
-> Maybe (EvaluationDetail Value)
forall a b. (a -> b) -> a -> b
$ (Context -> Text -> Flag -> Target -> Maybe (EvaluationDetail Value)
checkTarget Context
context "user" Flag
flag) (Target -> Maybe (EvaluationDetail Value))
-> [Target] -> [Maybe (EvaluationDetail Value)]
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
context contextKind :: Text
contextKind flag :: Flag
flag target :: Target
target =
    case Text -> Context -> Maybe Context
getIndividualContext Text
contextKind Context
context of
        Nothing -> Maybe (EvaluationDetail Value)
forall a. Maybe a
Nothing
        Just ctx :: Context
ctx ->
            if Text -> HashSet Text -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem (Context -> Text
getKey Context
ctx) (Target -> HashSet Text
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"values" Target
target)
                then EvaluationDetail Value -> Maybe (EvaluationDetail Value)
forall a. a -> Maybe a
Just (EvaluationDetail Value -> Maybe (EvaluationDetail Value))
-> EvaluationDetail Value -> Maybe (EvaluationDetail Value)
forall a b. (a -> b) -> a -> b
$ Flag -> Integer -> EvaluationReason -> EvaluationDetail Value
getVariation Flag
flag (Target -> Integer
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"variation" Target
target) EvaluationReason
EvaluationReasonTargetMatch
                else Maybe (EvaluationDetail Value)
forall a. Maybe a
Nothing

errorDefault :: EvalErrorKind -> Value -> EvaluationDetail Value
errorDefault :: EvalErrorKind -> Value -> EvaluationDetail Value
errorDefault kind :: EvalErrorKind
kind v :: Value
v = $WEvaluationDetail :: forall value.
value
-> Maybe Integer -> EvaluationReason -> EvaluationDetail value
EvaluationDetail {$sel:value:EvaluationDetail :: Value
value = Value
v, $sel:variationIndex:EvaluationDetail :: Maybe Integer
variationIndex = Maybe Integer
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 kind :: 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
flag vr :: VariationOrRollout
vr context :: Context
context reason :: EvaluationReason
reason =
    case VariationOrRollout
-> Context -> Text -> Text -> (Maybe Integer, Bool)
variationIndexForContext VariationOrRollout
vr Context
context (Flag -> Text
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"key" Flag
flag) (Flag -> Text
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"salt" Flag
flag) of
        (Nothing, _) -> EvalErrorKind -> EvaluationDetail Value
errorDetail EvalErrorKind
EvalErrorKindMalformedFlag
        (Just x :: Integer
x, inExperiment :: Bool
inExperiment) -> (Flag -> Integer -> EvaluationReason -> EvaluationDetail Value
getVariation Flag
flag Integer
x EvaluationReason
reason) EvaluationDetail Value
-> (EvaluationDetail Value -> EvaluationDetail Value)
-> EvaluationDetail Value
forall a b. a -> (a -> b) -> b
& forall s t a b. HasField "reason" s t a b => Lens s t a b
forall (field :: Symbol) s t a b.
HasField field s t a b =>
Lens s t a b
field @"reason" ((EvaluationReason -> Identity EvaluationReason)
 -> EvaluationDetail Value -> Identity (EvaluationDetail Value))
-> (EvaluationReason -> EvaluationReason)
-> EvaluationDetail Value
-> EvaluationDetail Value
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 inExperiment :: Bool
inExperiment reason :: EvaluationReason
reason = case EvaluationReason
reason of
    EvaluationReasonFallthrough _ -> Bool -> EvaluationReason
EvaluationReasonFallthrough Bool
inExperiment
    EvaluationReasonRuleMatch index :: Natural
index idx :: Text
idx _ -> Natural -> Text -> Bool -> EvaluationReason
EvaluationReasonRuleMatch Natural
index Text
idx Bool
inExperiment
    x :: EvaluationReason
x -> EvaluationReason
x

ruleMatchesContext :: Monad m => LaunchDarklyStoreRead store m => Rule -> Context -> store -> m (Either Text Bool)
ruleMatchesContext :: Rule -> Context -> store -> m (Either Text Bool)
ruleMatchesContext rule :: Rule
rule context :: Context
context store :: store
store = (Either Text Bool -> Clause -> m (Either Text Bool))
-> Either Text Bool -> [Clause] -> m (Either Text Bool)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldlM (store
-> Context -> Either Text Bool -> Clause -> m (Either Text Bool)
forall (m :: * -> *) store.
(Monad m, LaunchDarklyStoreRead store m) =>
store
-> Context -> Either Text Bool -> Clause -> m (Either Text Bool)
checkRule store
store Context
context) (Bool -> Either Text Bool
forall a b. b -> Either a b
Right Bool
True) [Clause]
clauses
  where
    clauses :: [Clause]
clauses = Rule -> [Clause]
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 :: store
-> Context -> Either Text Bool -> Clause -> m (Either Text Bool)
checkRule _ _ (Left e :: Text
e) _ = Either Text Bool -> m (Either Text Bool)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text Bool -> m (Either Text Bool))
-> Either Text Bool -> m (Either Text Bool)
forall a b. (a -> b) -> a -> b
$ Text -> Either Text Bool
forall a b. a -> Either a b
Left Text
e
    checkRule _ _ (Right False) _ = Either Text Bool -> m (Either Text Bool)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text Bool -> m (Either Text Bool))
-> Either Text Bool -> m (Either Text Bool)
forall a b. (a -> b) -> a -> b
$ Bool -> Either Text Bool
forall a b. b -> Either a b
Right Bool
False
    checkRule store :: store
store context :: Context
context _ clause :: Clause
clause = store -> Clause -> Context -> HashSet Text -> m (Either Text Bool)
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
forall a. HashSet a
HS.empty

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

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

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

hexStringToNumber :: ByteString -> Maybe Natural
hexStringToNumber :: ByteString -> Maybe Natural
hexStringToNumber bytes :: ByteString
bytes = (Maybe Natural -> Word8 -> Maybe Natural)
-> Maybe Natural -> ByteString -> Maybe Natural
forall a. (a -> Word8 -> a) -> a -> ByteString -> a
B.foldl' Maybe Natural -> Word8 -> Maybe Natural
step (Natural -> Maybe Natural
forall a. a -> Maybe a
Just 0) ByteString
bytes
  where
    step :: Maybe Natural -> Word8 -> Maybe Natural
step acc :: Maybe Natural
acc x :: Word8
x = Maybe Natural
acc Maybe Natural -> (Natural -> Maybe Natural) -> Maybe Natural
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \acc' :: Natural
acc' -> Word8 -> Maybe Natural
hexCharToNumber Word8
x Maybe Natural -> (Natural -> Maybe Natural) -> Maybe Natural
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Natural -> Maybe Natural
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Natural -> Maybe Natural)
-> (Natural -> Natural) -> Natural -> Maybe Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
(+) (Natural
acc' Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
* 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
context kind :: Maybe Text
kind key :: Text
key attribute :: Text
attribute salt :: Text
salt seed :: Maybe Int
seed =
    let bucketBy :: Reference
bucketBy = case Maybe Text
kind of
            Nothing -> Text -> Reference
makeLiteral Text
attribute
            Just _ -> Text -> Reference
makeReference Text
attribute
     in case Text -> Context -> Maybe Context
getIndividualContext (Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe "user" Maybe Text
kind) Context
context of
            Nothing -> Maybe Float
forall a. Maybe a
Nothing
            Just ctx :: Context
ctx ->
                let bucketableString :: Maybe Text
bucketableString = Value -> Maybe Text
bucketableStringValue (Value -> Maybe Text) -> Value -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Reference -> Context -> Value
getValueForReference Reference
bucketBy Context
ctx
                 in Float -> Maybe Float
forall a. a -> Maybe a
Just (Float -> Maybe Float) -> Float -> Maybe Float
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 Nothing _ _ _ = 0
calculateBucketValue (Just text :: Text
text) key :: Text
key salt :: Text
salt seed :: Maybe Int
seed =
    let seed' :: Text
seed' = case Maybe Int
seed of
            Nothing -> [Text] -> Text
T.concat [Text
key, ".", Text
salt, ".", Text
text]
            Just seed' :: Int
seed' -> [Text] -> Text
T.concat [String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show Int
seed', ".", Text
text]
        byteString :: ByteString
byteString = Int -> ByteString -> ByteString
B.take 15 (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
B16.encode (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
hash (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
encodeUtf8 (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ Text
seed'
     in ((Natural -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Natural -> Float) -> Natural -> Float
forall a b. (a -> b) -> a -> b
$ Maybe Natural -> Natural
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Natural -> Natural) -> Maybe Natural -> Natural
forall a b. (a -> b) -> a -> b
$ ByteString -> Maybe Natural
hexStringToNumber ByteString
byteString) :: Float) Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ 0xFFFFFFFFFFFFFFF

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

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

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

maybeNegate :: Clause -> Bool -> Bool
maybeNegate :: Clause -> Bool -> Bool
maybeNegate clause :: Clause
clause value :: Bool
value = if Clause -> Bool
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
clause contextValue :: Value
contextValue = (Value -> Bool) -> [Value] -> Bool
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 (Op -> Value -> Value -> Bool) -> Op -> Value -> Value -> Bool
forall a b. (a -> b) -> a -> b
$ Clause -> Op
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"op" Clause
clause
    v :: [Value]
v = Clause -> [Value]
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
clause context :: Context
context = (Text -> Bool -> Bool) -> Bool -> [Text] -> Bool
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 kind :: Text
kind result :: Bool
result
        | Bool
result Bool -> Bool -> Bool
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
clause context :: Context
context
    | Reference -> Bool
isValid (Clause -> Reference
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"attribute" Clause
clause) Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool
False = Text -> Either Text Bool
forall a b. a -> Either a b
Left (Text -> Either Text Bool) -> Text -> Either Text Bool
forall a b. (a -> b) -> a -> b
$ Reference -> Text
getError (Reference -> Text) -> Reference -> Text
forall a b. (a -> b) -> a -> b
$ Clause -> Reference
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"attribute" Clause
clause
    | ["kind"] [Text] -> [Text] -> Bool
forall a. Eq a => a -> a -> Bool
== Reference -> [Text]
getComponents (Clause -> Reference
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"attribute" Clause
clause) = Bool -> Either Text Bool
forall a b. b -> Either a b
Right (Bool -> Either Text Bool) -> Bool -> Either Text Bool
forall a b. (a -> b) -> a -> b
$ Clause -> Bool -> Bool
maybeNegate Clause
clause (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Clause -> Context -> Bool
clauseMatchesByKind Clause
clause Context
context
    | Bool
otherwise = case Text -> Context -> Maybe Context
getIndividualContext (Clause -> Text
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"contextKind" Clause
clause) Context
context of
        Nothing -> Bool -> Either Text Bool
forall a b. b -> Either a b
Right Bool
False
        Just ctx :: Context
ctx -> case Reference -> Context -> Value
getValueForReference (Clause -> Reference
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"attribute" Clause
clause) Context
ctx of
            Null -> Bool -> Either Text Bool
forall a b. b -> Either a b
Right Bool
False
            Array a :: Array
a -> Bool -> Either Text Bool
forall a b. b -> Either a b
Right (Bool -> Either Text Bool) -> Bool -> Either Text Bool
forall a b. (a -> b) -> a -> b
$ Clause -> Bool -> Bool
maybeNegate Clause
clause (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ (Value -> Bool) -> Array -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Clause -> Value -> Bool
matchAnyClauseValue Clause
clause) Array
a
            x :: Value
x -> Bool -> Either Text Bool
forall a b. b -> Either a b
Right (Bool -> Either Text Bool) -> Bool -> Either Text Bool
forall a b. (a -> b) -> a -> b
$ Clause -> Bool -> Bool
maybeNegate Clause
clause (Bool -> Bool) -> Bool -> Bool
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 :: store -> Clause -> Context -> HashSet Text -> m (Either Text Bool)
clauseMatchesContext store :: store
store clause :: Clause
clause context :: Context
context seenSegments :: HashSet Text
seenSegments
    | Clause -> Op
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"op" Clause
clause Op -> Op -> Bool
forall a. Eq a => a -> a -> Bool
== Op
OpSegmentMatch =
        let values :: [Text]
values = [Text
x | String x :: Text
x <- Clause -> [Value]
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"values" Clause
clause]
         in (Either Text Bool -> Text -> m (Either Text Bool))
-> Either Text Bool -> [Text] -> m (Either Text Bool)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldlM (store
-> Context
-> HashSet Text
-> Either Text Bool
-> Text
-> m (Either Text Bool)
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) (Bool -> Either Text Bool
forall a b. b -> Either a b
Right Bool
False) [Text]
values m (Either Text Bool)
-> (Either Text Bool -> m (Either Text Bool))
-> m (Either Text Bool)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either Text Bool -> m (Either Text Bool)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text Bool -> m (Either Text Bool))
-> (Either Text Bool -> Either Text Bool)
-> Either Text Bool
-> m (Either Text Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Bool) -> Either Text Bool -> Either Text Bool
forall b c a. (b -> c) -> Either a b -> Either a c
mapRight (Clause -> Bool -> Bool
maybeNegate Clause
clause)
    | Bool
otherwise = Either Text Bool -> m (Either Text Bool)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text Bool -> m (Either Text Bool))
-> Either Text Bool -> m (Either Text Bool)
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 :: store
-> Context
-> HashSet Text
-> Either Text Bool
-> Text
-> m (Either Text Bool)
checkSegment _ _ _ (Left e :: Text
e) _ = Either Text Bool -> m (Either Text Bool)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text Bool -> m (Either Text Bool))
-> Either Text Bool -> m (Either Text Bool)
forall a b. (a -> b) -> a -> b
$ Text -> Either Text Bool
forall a b. a -> Either a b
Left Text
e
checkSegment _ _ _ (Right True) _ = Either Text Bool -> m (Either Text Bool)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text Bool -> m (Either Text Bool))
-> Either Text Bool -> m (Either Text Bool)
forall a b. (a -> b) -> a -> b
$ Bool -> Either Text Bool
forall a b. b -> Either a b
Right Bool
True
checkSegment store :: store
store context :: Context
context seenSegments :: HashSet Text
seenSegments _ value :: Text
value =
    store -> Text -> StoreResultM m (Maybe Segment)
forall store (m :: * -> *).
LaunchDarklyStoreRead store m =>
store -> Text -> StoreResultM m (Maybe Segment)
getSegmentC store
store Text
value StoreResultM m (Maybe Segment)
-> (Either Text (Maybe Segment) -> m (Either Text Bool))
-> m (Either Text Bool)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Right (Just segment :: Segment
segment) -> store -> Segment -> Context -> HashSet Text -> m (Either Text Bool)
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 Bool -> m (Either Text Bool)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text Bool -> m (Either Text Bool))
-> Either Text Bool -> m (Either Text Bool)
forall a b. (a -> b) -> a -> b
$ Bool -> Either Text Bool
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 :: store
-> SegmentRule
-> Context
-> Text
-> Text
-> HashSet Text
-> m (Either Text Bool)
segmentRuleMatchesContext store :: store
store rule :: SegmentRule
rule context :: Context
context key :: Text
key salt :: Text
salt seenSegments :: HashSet Text
seenSegments =
    (Either Text Bool -> Clause -> m (Either Text Bool))
-> Either Text Bool -> [Clause] -> m (Either Text Bool)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldlM (store -> Either Text Bool -> Clause -> m (Either Text Bool)
forall (m :: * -> *) store.
(Monad m, LaunchDarklyStoreRead store m) =>
store -> Either Text Bool -> Clause -> m (Either Text Bool)
checkClause store
store) (Bool -> Either Text Bool
forall a b. b -> Either a b
Right Bool
True) (SegmentRule -> [Clause]
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"clauses" SegmentRule
rule) m (Either Text Bool)
-> (Either Text Bool -> m (Either Text Bool))
-> m (Either Text Bool)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \result :: Either Text Bool
result ->
        Either Text Bool -> m (Either Text Bool)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text Bool -> m (Either Text Bool))
-> Either Text Bool -> m (Either Text Bool)
forall a b. (a -> b) -> a -> b
$ case Either Text Bool
result of
            Left _ -> Either Text Bool
result
            Right False -> Either Text Bool
result
            _ ->
                Bool -> Either Text Bool
forall a b. b -> Either a b
Right (Bool -> Either Text Bool) -> Bool -> Either Text Bool
forall a b. (a -> b) -> a -> b
$
                    ( ((Float -> Bool) -> Maybe Float -> Bool)
-> Maybe Float -> (Float -> Bool) -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Bool -> (Float -> Bool) -> Maybe Float -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True) (SegmentRule -> Maybe Float
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"weight" SegmentRule
rule) ((Float -> Bool) -> Bool) -> (Float -> Bool) -> Bool
forall a b. (a -> b) -> a -> b
$ \weight :: Float
weight ->
                        let bucket :: Maybe Float
bucket = Context
-> Maybe Text -> Text -> Text -> Text -> Maybe Int -> Maybe Float
bucketContext Context
context (SegmentRule -> Maybe Text
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"rolloutContextKind" SegmentRule
rule) Text
key (Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe "key" (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ SegmentRule -> Maybe Text
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"bucketBy" SegmentRule
rule) Text
salt Maybe Int
forall a. Maybe a
Nothing
                         in case Maybe Float
bucket of
                                Just v :: Float
v | Float
v Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
>= (Float
weight Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ 100000.0) -> Bool
False
                                _ -> Bool
True
                    )
  where
    checkClause :: (Monad m, LaunchDarklyStoreRead store m) => store -> Either Text Bool -> Clause -> m (Either Text Bool)
    checkClause :: store -> Either Text Bool -> Clause -> m (Either Text Bool)
checkClause _ (Left e :: Text
e) _ = Either Text Bool -> m (Either Text Bool)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text Bool -> m (Either Text Bool))
-> Either Text Bool -> m (Either Text Bool)
forall a b. (a -> b) -> a -> b
$ Text -> Either Text Bool
forall a b. a -> Either a b
Left Text
e
    checkClause _ (Right False) _ = Either Text Bool -> m (Either Text Bool)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text Bool -> m (Either Text Bool))
-> Either Text Bool -> m (Either Text Bool)
forall a b. (a -> b) -> a -> b
$ Bool -> Either Text Bool
forall a b. b -> Either a b
Right Bool
False
    checkClause store :: store
store _ clause :: Clause
clause = store -> Clause -> Context -> HashSet Text -> m (Either Text Bool)
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 :: store -> Segment -> Context -> HashSet Text -> m (Either Text Bool)
segmentContainsContext store :: 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
context seenSegments :: HashSet Text
seenSegments
    | Text -> HashSet Text -> Bool
forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
HS.member Text
key HashSet Text
seenSegments = Either Text Bool -> m (Either Text Bool)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text Bool -> m (Either Text Bool))
-> Either Text Bool -> m (Either Text Bool)
forall a b. (a -> b) -> a -> b
$ Text -> Either Text Bool
forall a b. a -> Either a b
Left "segment rule caused a circular reference; this is probably a temporary condition"
    | HashSet Text -> Text -> Context -> Bool
contextKeyInTargetList HashSet Text
included "user" Context
context = Either Text Bool -> m (Either Text Bool)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text Bool -> m (Either Text Bool))
-> Either Text Bool -> m (Either Text Bool)
forall a b. (a -> b) -> a -> b
$ Bool -> Either Text Bool
forall a b. b -> Either a b
Right Bool
True
    | ((SegmentTarget -> Bool) -> [SegmentTarget] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((SegmentTarget -> Context -> Bool)
-> Context -> SegmentTarget -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip SegmentTarget -> Context -> Bool
contextKeyInSegmentTarget Context
context) [SegmentTarget]
includedContexts) = Either Text Bool -> m (Either Text Bool)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text Bool -> m (Either Text Bool))
-> Either Text Bool -> m (Either Text Bool)
forall a b. (a -> b) -> a -> b
$ Bool -> Either Text Bool
forall a b. b -> Either a b
Right Bool
True
    | HashSet Text -> Text -> Context -> Bool
contextKeyInTargetList HashSet Text
excluded "user" Context
context = Either Text Bool -> m (Either Text Bool)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text Bool -> m (Either Text Bool))
-> Either Text Bool -> m (Either Text Bool)
forall a b. (a -> b) -> a -> b
$ Bool -> Either Text Bool
forall a b. b -> Either a b
Right Bool
False
    | ((SegmentTarget -> Bool) -> [SegmentTarget] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((SegmentTarget -> Context -> Bool)
-> Context -> SegmentTarget -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip SegmentTarget -> Context -> Bool
contextKeyInSegmentTarget Context
context) [SegmentTarget]
excludedContexts) = Either Text Bool -> m (Either Text Bool)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text Bool -> m (Either Text Bool))
-> Either Text Bool -> m (Either Text Bool)
forall a b. (a -> b) -> a -> b
$ Bool -> Either Text Bool
forall a b. b -> Either a b
Right Bool
False
    | Bool
otherwise = (Either Text Bool -> SegmentRule -> m (Either Text Bool))
-> Either Text Bool -> [SegmentRule] -> m (Either Text Bool)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldlM (store -> Either Text Bool -> SegmentRule -> m (Either Text Bool)
forall (m :: * -> *) store.
(Monad m, LaunchDarklyStoreRead store m) =>
store -> Either Text Bool -> SegmentRule -> m (Either Text Bool)
checkRules store
store) (Bool -> Either Text Bool
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 :: store -> Either Text Bool -> SegmentRule -> m (Either Text Bool)
checkRules _ (Left e :: Text
e) _ = Either Text Bool -> m (Either Text Bool)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text Bool -> m (Either Text Bool))
-> Either Text Bool -> m (Either Text Bool)
forall a b. (a -> b) -> a -> b
$ Text -> Either Text Bool
forall a b. a -> Either a b
Left Text
e
    checkRules _ (Right True) _ = Either Text Bool -> m (Either Text Bool)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text Bool -> m (Either Text Bool))
-> Either Text Bool -> m (Either Text Bool)
forall a b. (a -> b) -> a -> b
$ Bool -> Either Text Bool
forall a b. b -> Either a b
Right Bool
True
    checkRules store :: store
store _ rule :: SegmentRule
rule = store
-> SegmentRule
-> Context
-> Text
-> Text
-> HashSet Text
-> m (Either Text Bool)
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 (Text -> HashSet Text -> HashSet Text
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 targets :: HashSet Text
targets kind :: Text
kind context :: Context
context = case Text -> Context -> Maybe Context
getIndividualContext Text
kind Context
context of
    Just ctx :: Context
ctx -> Text -> HashSet Text -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem (Context -> Text
getKey Context
ctx) HashSet Text
targets
    Nothing -> Bool
False