module LaunchDarkly.Server.Evaluate where

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.Aeson.Types                    (Value(..))
import           Data.Maybe                          (maybe, fromJust, isJust, fromMaybe)
import           Data.Text                           (Text)
import           Data.Generics.Product               (getField)
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, naturalToInt)
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)
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 Natural
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"variationIndex" EvaluationDetail Value
detail of
    Maybe Natural
Nothing -> EvaluationDetail Value
detail { $sel:value:EvaluationDetail :: Value
value = Value
fallback }; Maybe Natural
_ -> 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 Natural -> EvaluationReason -> EvaluationDetail a
forall value.
value
-> Maybe Natural -> EvaluationReason -> EvaluationDetail value
EvaluationDetail a
fallback Maybe Natural
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 Natural -> EvaluationReason -> EvaluationDetail a
forall value.
value
-> Maybe Natural -> EvaluationReason -> EvaluationDetail value
EvaluationDetail a
fallback Maybe Natural
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 -> EvaluationDetail Value
errorDetail EvalErrorKind
EvalErrorFlagNotFound, 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 Natural
-> Value
-> Maybe Value
-> EvaluationReason
-> Maybe Text
-> EvalEvent
newSuccessfulEvalEvent Flag
flag (EvaluationDetail Value -> Maybe Natural
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 Natural
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"offVariation" Flag
flag of
    Just Natural
offVariation -> Flag -> Natural -> EvaluationReason -> EvaluationDetail Value
getVariation Flag
flag Natural
offVariation EvaluationReason
reason
    Maybe Natural
Nothing           -> EvaluationDetail :: forall value.
value
-> Maybe Natural -> EvaluationReason -> EvaluationDetail value
EvaluationDetail { $sel:value:EvaluationDetail :: Value
value = Value
Null, $sel:variationIndex:EvaluationDetail :: Maybe Natural
variationIndex = Maybe Natural
forall (m :: * -> *) a. MonadPlus m => m a
mzero, $sel:reason:EvaluationDetail :: EvaluationReason
reason = EvaluationReason
reason }

getVariation :: Flag -> Natural -> EvaluationReason -> EvaluationDetail Value
getVariation :: Flag -> Natural -> EvaluationReason -> EvaluationDetail Value
getVariation Flag
flag Natural
index EvaluationReason
reason = let variations :: [Value]
variations = Flag -> [Value]
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"variations" Flag
flag in
    if Natural -> Int
naturalToInt Natural
index Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= [Value] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Value]
variations
        then EvaluationDetail :: forall value.
value
-> Maybe Natural -> EvaluationReason -> EvaluationDetail value
EvaluationDetail { $sel:value:EvaluationDetail :: Value
value = Value
Null, $sel:variationIndex:EvaluationDetail :: Maybe Natural
variationIndex = Maybe Natural
forall (m :: * -> *) a. MonadPlus m => m a
mzero, $sel:reason:EvaluationDetail :: EvaluationReason
reason = EvalErrorKind -> EvaluationReason
EvaluationReasonError EvalErrorKind
EvalErrorKindMalformedFlag }
        else EvaluationDetail :: forall value.
value
-> Maybe Natural -> EvaluationReason -> EvaluationDetail value
EvaluationDetail { $sel:value:EvaluationDetail :: Value
value = [Value] -> Natural -> Value
forall i a. Integral i => [a] -> i -> a
genericIndex [Value]
variations Natural
index, $sel:variationIndex:EvaluationDetail :: Maybe Natural
variationIndex = Natural -> Maybe Natural
forall (f :: * -> *) a. Applicative f => a -> f a
pure Natural
index, $sel:reason:EvaluationDetail :: EvaluationReason
reason = EvaluationReason
reason }

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 Natural
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"variationIndex" EvaluationDetail a
result) Maybe Natural -> Maybe Natural -> Bool
forall a. Eq a => a -> a -> Bool
==
    Natural -> Maybe Natural
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Prerequisite -> Natural
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 Natural
-> Value
-> Maybe Value
-> EvaluationReason
-> Maybe Text
-> EvalEvent
newSuccessfulEvalEvent Flag
prereqFlag (EvaluationDetail Value -> Maybe Natural
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 -> Natural -> EvaluationReason -> EvaluationDetail Value
getVariation Flag
flag (Target -> Natural
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 -> 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 })
        (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 EvaluationReason
EvaluationReasonFallthrough
    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)

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

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 Natural
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 Natural
Nothing -> EvalErrorKind -> EvaluationDetail Value
errorDetail EvalErrorKind
EvalErrorKindMalformedFlag
        Just Natural
x  -> Flag -> Natural -> EvaluationReason -> EvaluationDetail Value
getVariation Flag
flag Natural
x EvaluationReason
reason

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 Natural
variationIndexForUser :: VariationOrRollout -> UserI -> Text -> Text -> Maybe Natural
variationIndexForUser VariationOrRollout
vor UserI
user Text
key Text
salt
    | (Just Natural
variation) <- VariationOrRollout -> Maybe Natural
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"variation" VariationOrRollout
vor = Natural -> Maybe Natural
forall (f :: * -> *) a. Applicative f => a -> f a
pure Natural
variation
    | (Just Rollout
rollout) <- VariationOrRollout -> Maybe Rollout
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"rollout" VariationOrRollout
vor = let
        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 -> 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
        c :: Either Natural Float -> WeightedVariation -> Either Natural Float
c Either Natural Float
acc WeightedVariation
i = Either Natural Float
acc Either Natural Float
-> (Float -> Either Natural Float) -> Either Natural 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 Natural -> Either Natural Float
forall a b. a -> Either a b
Left (WeightedVariation -> Natural
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"variation" WeightedVariation
i) else Float -> Either Natural 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 Natural
forall a. Maybe a
Nothing else Natural -> Maybe Natural
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Natural -> Maybe Natural) -> Natural -> Maybe Natural
forall a b. (a -> b) -> a -> b
$ Natural -> Either Natural Float -> Natural
forall a b. a -> Either a b -> a
fromLeft (forall a s. HasField' "variation" s a => s -> a
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"variation" (WeightedVariation -> Natural) -> WeightedVariation -> Natural
forall a b. (a -> b) -> a -> b
$ [WeightedVariation] -> WeightedVariation
forall a. [a] -> a
last [WeightedVariation]
variations) (Either Natural Float -> Natural)
-> Either Natural Float -> Natural
forall a b. (a -> b) -> a -> b
$
            (Either Natural Float -> WeightedVariation -> Either Natural Float)
-> Either Natural Float
-> [WeightedVariation]
-> Either Natural Float
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Either Natural Float -> WeightedVariation -> Either Natural Float
c (Float -> Either Natural Float
forall a b. b -> Either a b
Right (Float
0.0 :: Float)) [WeightedVariation]
variations
    | Bool
otherwise = Maybe Natural
forall a. Maybe a
Nothing

-- 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 -> Float
bucketUser :: UserI -> Text -> Text -> Text -> Float
bucketUser UserI
user Text
key Text
attribute Text
salt = 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
    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
$
        [Text] -> Text
T.concat [Text
key, Text
".", Text
salt, Text
".", Text
x, 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]
    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 (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 -> 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 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