module LaunchDarkly.Server.Evaluate where

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

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

setFallback :: EvaluationDetail Value -> Value -> EvaluationDetail Value
setFallback :: EvaluationDetail Value -> Value -> EvaluationDetail Value
setFallback EvaluationDetail Value
detail Value
fallback = case EvaluationDetail Value -> Maybe Integer
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 :: EvaluationDetail Value -> a -> EvaluationDetail a
setValue EvaluationDetail Value
x a
v = EvaluationDetail Value
x { $sel:value:EvaluationDetail :: a
value = a
v }

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

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

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

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

status :: Prerequisite -> EvaluationDetail a -> Flag -> Bool
status :: Prerequisite -> EvaluationDetail a -> Flag -> Bool
status Prerequisite
prereq EvaluationDetail a
result 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)

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

sequenceUntil :: Monad m => (a -> Bool) -> [m a] -> m [a]
sequenceUntil :: (a -> Bool) -> [m a] -> m [a]
sequenceUntil a -> Bool
_ []     = [a] -> m [a]
forall (m :: * -> *) a. Monad m => a -> m a
return []
sequenceUntil a -> Bool
p (m a
m:[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 -> 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
>>= \[a]
as -> [a] -> m [a]
forall (m :: * -> *) a. Monad m => a -> m a
return (a
aa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
as)

checkPrerequisites :: (Monad m, LaunchDarklyStoreRead store m) => Flag -> UserI -> store
    -> m (Maybe EvaluationReason, [EvalEvent])
checkPrerequisites :: Flag -> UserI -> store -> m (Maybe EvaluationReason, [EvalEvent])
checkPrerequisites Flag
flag UserI
user 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 EvaluationReason, [EvalEvent])
-> m (Maybe EvaluationReason, [EvalEvent])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe EvaluationReason
forall a. Maybe a
Nothing, []) else do
    [(Maybe EvaluationReason, [EvalEvent])]
evals <- ((Maybe EvaluationReason, [EvalEvent]) -> Bool)
-> [m (Maybe EvaluationReason, [EvalEvent])]
-> m [(Maybe EvaluationReason, [EvalEvent])]
forall (m :: * -> *) a. Monad m => (a -> Bool) -> [m a] -> m [a]
sequenceUntil (Maybe EvaluationReason -> Bool
forall a. Maybe a -> Bool
isJust (Maybe EvaluationReason -> Bool)
-> ((Maybe EvaluationReason, [EvalEvent])
    -> Maybe EvaluationReason)
-> (Maybe EvaluationReason, [EvalEvent])
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe EvaluationReason, [EvalEvent]) -> Maybe EvaluationReason
forall a b. (a, b) -> a
fst) ([m (Maybe EvaluationReason, [EvalEvent])]
 -> m [(Maybe EvaluationReason, [EvalEvent])])
-> [m (Maybe EvaluationReason, [EvalEvent])]
-> m [(Maybe EvaluationReason, [EvalEvent])]
forall a b. (a -> b) -> a -> b
$ (Prerequisite -> m (Maybe EvaluationReason, [EvalEvent]))
-> [Prerequisite] -> [m (Maybe EvaluationReason, [EvalEvent])]
forall a b. (a -> b) -> [a] -> [b]
map (store
-> UserI
-> Flag
-> Prerequisite
-> m (Maybe EvaluationReason, [EvalEvent])
forall (m :: * -> *) store.
(Monad m, LaunchDarklyStoreRead store m) =>
store
-> UserI
-> Flag
-> Prerequisite
-> m (Maybe EvaluationReason, [EvalEvent])
checkPrerequisite store
store UserI
user Flag
flag) [Prerequisite]
p
    (Maybe EvaluationReason, [EvalEvent])
-> m (Maybe EvaluationReason, [EvalEvent])
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Maybe EvaluationReason] -> Maybe EvaluationReason
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum ([Maybe EvaluationReason] -> Maybe EvaluationReason)
-> [Maybe EvaluationReason] -> Maybe EvaluationReason
forall a b. (a -> b) -> a -> b
$ ((Maybe EvaluationReason, [EvalEvent]) -> Maybe EvaluationReason)
-> [(Maybe EvaluationReason, [EvalEvent])]
-> [Maybe EvaluationReason]
forall a b. (a -> b) -> [a] -> [b]
map (Maybe EvaluationReason, [EvalEvent]) -> Maybe EvaluationReason
forall a b. (a, b) -> a
fst [(Maybe EvaluationReason, [EvalEvent])]
evals, ((Maybe EvaluationReason, [EvalEvent]) -> [EvalEvent])
-> [(Maybe EvaluationReason, [EvalEvent])] -> [EvalEvent]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Maybe EvaluationReason, [EvalEvent]) -> [EvalEvent]
forall a b. (a, b) -> b
snd [(Maybe EvaluationReason, [EvalEvent])]
evals)

evaluateInternal :: (Monad m, LaunchDarklyStoreRead store m) => Flag -> UserI -> store -> m (EvaluationDetail Value)
evaluateInternal :: Flag -> UserI -> store -> m (EvaluationDetail Value)
evaluateInternal Flag
flag UserI
user store
store = m (EvaluationDetail Value)
result where
    checkTarget :: Target -> Maybe (EvaluationDetail Value)
checkTarget Target
target = if Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem (UserI -> Text
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"key" UserI
user) (Target -> [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
    checkRule :: (Natural, Rule) -> m (Maybe (EvaluationDetail Value))
checkRule (Natural
ruleIndex, Rule
rule) = m Bool
-> m (Maybe (EvaluationDetail Value))
-> m (Maybe (EvaluationDetail Value))
-> m (Maybe (EvaluationDetail Value))
forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
ifM (Rule -> UserI -> store -> m Bool
forall (m :: * -> *) store.
(Monad m, LaunchDarklyStoreRead store m) =>
Rule -> UserI -> store -> m Bool
ruleMatchesUser Rule
rule UserI
user store
store)
        (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 a b. (a -> b) -> a -> b
$ 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
-> UserI
-> EvaluationReason
-> EvaluationDetail Value
getValueForVariationOrRollout Flag
flag (Rule -> VariationOrRollout
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"variationOrRollout" Rule
rule) UserI
user
            EvaluationReasonRuleMatch :: 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 })
        (Maybe (EvaluationDetail Value)
-> m (Maybe (EvaluationDetail Value))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (EvaluationDetail Value)
forall a. Maybe a
Nothing)
    fallthrough :: EvaluationDetail Value
fallthrough = Flag
-> VariationOrRollout
-> UserI
-> EvaluationReason
-> EvaluationDetail Value
getValueForVariationOrRollout Flag
flag (Flag -> VariationOrRollout
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"fallthrough" Flag
flag) UserI
user (Bool -> EvaluationReason
EvaluationReasonFallthrough Bool
False)
    result :: m (EvaluationDetail Value)
result = let
        ruleMatch :: [m (Maybe (EvaluationDetail Value))]
ruleMatch   = (Natural, Rule) -> m (Maybe (EvaluationDetail Value))
checkRule ((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 [Natural
0..] (Flag -> [Rule]
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"rules" Flag
flag)
        targetMatch :: [m (Maybe (EvaluationDetail Value))]
targetMatch = Maybe (EvaluationDetail Value)
-> m (Maybe (EvaluationDetail Value))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (EvaluationDetail Value)
 -> m (Maybe (EvaluationDetail Value)))
-> (Target -> Maybe (EvaluationDetail Value))
-> Target
-> m (Maybe (EvaluationDetail Value))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Target -> Maybe (EvaluationDetail Value)
checkTarget (Target -> m (Maybe (EvaluationDetail Value)))
-> [Target] -> [m (Maybe (EvaluationDetail Value))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Flag -> [Target]
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"targets" 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))]
ruleMatch [m (Maybe (EvaluationDetail Value))]
-> [m (Maybe (EvaluationDetail Value))]
-> [m (Maybe (EvaluationDetail Value))]
forall a. [a] -> [a] -> [a]
++ [m (Maybe (EvaluationDetail Value))]
targetMatch)

errorDefault :: EvalErrorKind -> Value -> EvaluationDetail Value
errorDefault :: EvalErrorKind -> Value -> EvaluationDetail Value
errorDefault EvalErrorKind
kind Value
v = EvaluationDetail :: 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 EvalErrorKind
kind = EvalErrorKind -> Value -> EvaluationDetail Value
errorDefault EvalErrorKind
kind Value
Null

getValueForVariationOrRollout :: Flag -> VariationOrRollout -> UserI -> EvaluationReason -> EvaluationDetail Value
getValueForVariationOrRollout :: Flag
-> VariationOrRollout
-> UserI
-> EvaluationReason
-> EvaluationDetail Value
getValueForVariationOrRollout Flag
flag VariationOrRollout
vr UserI
user EvaluationReason
reason =
    case VariationOrRollout
-> UserI -> Text -> Text -> (Maybe Integer, Bool)
variationIndexForUser VariationOrRollout
vr UserI
user (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
        (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) 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 Bool
inExperiment EvaluationReason
reason = case EvaluationReason
reason of
    EvaluationReasonFallthrough Bool
_         -> Bool -> EvaluationReason
EvaluationReasonFallthrough Bool
inExperiment
    EvaluationReasonRuleMatch Natural
index Text
idx Bool
_ -> Natural -> Text -> Bool -> EvaluationReason
EvaluationReasonRuleMatch Natural
index Text
idx Bool
inExperiment
    EvaluationReason
x                                     -> EvaluationReason
x

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

variationIndexForUser :: VariationOrRollout -> UserI -> Text -> Text -> (Maybe Integer, Bool)
variationIndexForUser :: VariationOrRollout
-> UserI -> Text -> Text -> (Maybe Integer, Bool)
variationIndexForUser VariationOrRollout
vor UserI
user Text
key Text
salt
    | (Just Integer
variation) <- 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) <- VariationOrRollout -> Maybe Rollout
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"rollout" VariationOrRollout
vor = let
        isExperiment :: Bool
isExperiment = (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
        variations :: [WeightedVariation]
variations = Rollout -> [WeightedVariation]
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"variations" Rollout
rollout
        bucket :: Float
bucket = UserI -> Text -> Text -> Text -> Maybe Int -> Float
bucketUser UserI
user Text
key (Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"key" (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ Rollout -> Maybe Text
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"bucketBy" Rollout
rollout) Text
salt (Rollout -> Maybe Int
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"seed" Rollout
rollout)
        c :: Either (Maybe Integer, Bool) Float
-> WeightedVariation -> Either (Maybe Integer, Bool) Float
c Either (Maybe Integer, Bool) Float
acc WeightedVariation
i = Either (Maybe Integer, Bool) Float
acc 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
>>= \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
/ Float
100000.0) in
            if Float
bucket Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
< Float
t then (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) else Float -> Either (Maybe Integer, Bool) Float
forall a b. b -> Either a b
Right Float
t
        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 (Float
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 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
    | Word8
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
<= Word8
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
- Word8
48
    | Word8
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
<= Word8
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
- Word8
55
    | Word8
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
<= Word8
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
- Word8
87
    | Bool
otherwise           -> Maybe Word8
forall a. Maybe a
Nothing

hexStringToNumber :: ByteString -> Maybe Natural
hexStringToNumber :: ByteString -> Maybe Natural
hexStringToNumber 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 Natural
0) ByteString
bytes where
    step :: Maybe Natural -> Word8 -> Maybe Natural
step Maybe Natural
acc 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
>>= \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
* Natural
16)

bucketUser :: UserI -> Text -> Text -> Text -> Maybe Int -> Float
bucketUser :: UserI -> Text -> Text -> Text -> Maybe Int -> Float
bucketUser UserI
user Text
key Text
attribute Text
salt Maybe Int
seed = Float -> Maybe Float -> Float
forall a. a -> Maybe a -> a
fromMaybe Float
0 (Maybe Float -> Float) -> Maybe Float -> Float
forall a b. (a -> b) -> a -> b
$ do
    let secondarySuffix :: Text
secondarySuffix = Text -> (Text -> Text) -> Maybe Text -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" (Text -> Text -> Text
T.append Text
".") (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ UserI -> Maybe Text
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"secondary" UserI
user
    ByteString
i <- UserI -> Text -> Maybe Value
valueOf UserI
user Text
attribute Maybe Value -> (Value -> Maybe Text) -> Maybe Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> Maybe Text
bucketableStringValue Maybe Text -> (Text -> Maybe ByteString) -> Maybe ByteString
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Text
x -> ByteString -> Maybe ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
B.take Int
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
$
        case Maybe Int
seed of
            Maybe Int
Nothing    -> [Text] -> Text
T.concat [Text
key, Text
".", Text
salt, Text
".", Text
x, Text
secondarySuffix]
            Just Int
seed' -> [Text] -> Text
T.concat [String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show Int
seed', Text
".", Text
x, Text
secondarySuffix]
    Float -> Maybe Float
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Float -> Maybe Float) -> Float -> Maybe Float
forall a b. (a -> b) -> a -> b
$ ((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
i) :: Float) Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ (Float
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 Text
x) = Text -> Maybe Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
x
bucketableStringValue (Number 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 Value
_          = Maybe Text
forall a. Maybe a
Nothing

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

maybeNegate :: Clause -> Bool -> Bool
maybeNegate :: Clause -> Bool -> Bool
maybeNegate Clause
clause 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

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

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

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

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

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

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