{- |
Module      : Unleash.Internal.DomainTypes
Copyright   : Copyright © FINN.no AS, Inc. All rights reserved.
License     : MIT
Stability   : experimental

Domain types and evaluation functions.
-}
module Unleash.Internal.DomainTypes (
    featureGetVariant,
    featureIsEnabled,
    fromJsonFeatures,
    supportedStrategies,
    Feature (..),
    Features,
    FeatureToggleName,
    GetVariant (..),
    IsEnabled (..),
) where
import Control.Applicative (liftA2, (<|>))
import Control.Monad.IO.Class (MonadIO)
import Data.Hash.Murmur (murmur3)
import Data.List (find)
import Data.Map.Strict (Map, fromList)
import qualified Data.Map.Strict as Map
import Data.Maybe (catMaybes, fromMaybe)
import Data.Text (Text)
import qualified Data.Text as Text
import Data.Text.Encoding (encodeUtf8)
import Data.Word (Word32)
import System.Random (randomRIO)
import TextShow (showt)
import Unleash.Internal.JsonTypes (Variant, VariantResponse (..), emptyVariantResponse)
import qualified Unleash.Internal.JsonTypes as JsonTypes
import Unleash.Internal.Predicates (datePredicate, numPredicate, semVerPredicate)

-- | A list of currently supported strategies for this library.
supportedStrategies :: [Text]
supportedStrategies :: [Text]
supportedStrategies = [Text
"default", Text
"userWithId", Text
"gradualRolloutUserId", Text
"gradualRolloutSessionId", Text
"gradualRolloutRandom", Text
"remoteAddress", Text
"flexibleRollout"]

-- | Alias used for feature toggle names (as they are represented on Unleash servers).
type FeatureToggleName = Text

-- | Map of feature toggles keyed on toggle names. Typically the full set of features fetched from a server.
type Features = Map FeatureToggleName Feature

-- | Map of feature toggles keyed on strategy parameters.
type Parameters = Map Text FeatureToggleName

-- | Feature toggle state getter.
newtype IsEnabled = IsEnabled (forall m. MonadIO m => JsonTypes.Context -> m Bool)

-- | Feature toggle variant getter.
newtype GetVariant = GetVariant (forall m. MonadIO m => JsonTypes.Context -> m VariantResponse)

-- | Feature toggle.
data Feature = Feature
    { -- | Feature toggle state getter.
      Feature -> IsEnabled
isEnabled :: IsEnabled,
      -- | Feature toggle variant getter.
      Feature -> GetVariant
getVariant :: GetVariant
    }

segmentMap :: Maybe [JsonTypes.Segment] -> Map Int [JsonTypes.Constraint]
segmentMap :: Maybe [Segment] -> Map Int [Constraint]
segmentMap Maybe [Segment]
maybeSegments =
    let [Segment]
segments :: [JsonTypes.Segment] = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat Maybe [Segment]
maybeSegments
     in forall k a. Ord k => [(k, a)] -> Map k a
fromList forall a b. (a -> b) -> a -> b
$ (\Segment
segment -> (Segment
segment.id, Segment
segment.constraints)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Segment]
segments

-- | Feature toggle set domain transfer object to domain type converter.
fromJsonFeatures :: JsonTypes.Features -> Features
fromJsonFeatures :: Features -> Features
fromJsonFeatures Features
jsonFeatures = forall k a. Ord k => [(k, a)] -> Map k a
fromList forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Map Int [Constraint] -> Feature -> (Text, Feature)
fromJsonFeature (Maybe [Segment] -> Map Int [Constraint]
segmentMap Features
jsonFeatures.segments)) Features
jsonFeatures.features

generateRandomText :: MonadIO m => m Text
generateRandomText :: forall (m :: * -> *). MonadIO m => m Text
generateRandomText = forall a. TextShow a => a -> Text
showt forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a (m :: * -> *). (Random a, MonadIO m) => (a, a) -> m a
randomRIO @Int (Int
0, Int
99999)

fromJsonFeature :: Map Int [JsonTypes.Constraint] -> JsonTypes.Feature -> (FeatureToggleName, Feature)
fromJsonFeature :: Map Int [Constraint] -> Feature -> (Text, Feature)
fromJsonFeature Map Int [Constraint]
segmentMap Feature
jsonFeature =
    ( Feature
jsonFeature.name,
      Feature
        { $sel:isEnabled:Feature :: IsEnabled
isEnabled = (forall (m :: * -> *). MonadIO m => Context -> m Bool) -> IsEnabled
IsEnabled forall a b. (a -> b) -> a -> b
$ \Context
ctx -> do
            Bool
isAnyStrategyEnabled <- forall (m :: * -> *). MonadIO m => Context -> m Bool
anyStrategyEnabled Context
ctx
            forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Feature
jsonFeature.enabled Bool -> Bool -> Bool
&& (forall (t :: * -> *) a. Foldable t => t a -> Bool
null Feature
jsonFeature.strategies Bool -> Bool -> Bool
|| Bool
isAnyStrategyEnabled),
          $sel:getVariant:Feature :: GetVariant
getVariant = (forall (m :: * -> *). MonadIO m => Context -> m VariantResponse)
-> GetVariant
GetVariant forall a b. (a -> b) -> a -> b
$ \Context
ctx ->
            if Bool -> Bool
not Feature
jsonFeature.enabled
                then forall (f :: * -> *) a. Applicative f => a -> f a
pure VariantResponse
emptyVariantResponse
                else do
                    let [Variant]
variants :: [Variant] = forall a. a -> Maybe a -> a
fromMaybe [] Feature
jsonFeature.variants
                    case [Variant] -> Context -> Maybe Variant
enabledByOverride [Variant]
variants Context
ctx of
                        Just Variant
variant ->
                            -- Has overrides
                            forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
                                VariantResponse
                                    { $sel:name:VariantResponse :: Text
name = Variant
variant.name,
                                      $sel:payload:VariantResponse :: Maybe Payload
payload = Variant
variant.payload,
                                      $sel:enabled:VariantResponse :: Bool
enabled = Bool
True
                                    }
                        Maybe Variant
Nothing -> do
                            -- Does not have overrides
                            let maybeStickiness :: Maybe Text
maybeStickiness = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (Text
"default" forall a. Eq a => a -> a -> Bool
/=) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [Maybe a] -> [a]
catMaybes forall a b. (a -> b) -> a -> b
$ (.stickiness) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Variant]
variants
                            case Maybe Text
maybeStickiness of
                                Just Text
stickiness -> do
                                    -- Has non-default stickiness
                                    let identifier :: Maybe Text
identifier = Text -> Context -> Maybe Text
lookupContextValue Text
stickiness Context
ctx
                                    forall (m :: * -> *).
MonadIO m =>
[Variant] -> Maybe Text -> Text -> m VariantResponse
selectVariant [Variant]
variants Maybe Text
identifier Feature
jsonFeature.name
                                Maybe Text
Nothing -> do
                                    -- Default stickiness
                                    let identifier :: Maybe Text
identifier = Context
ctx.userId forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Context
ctx.sessionId forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Context
ctx.remoteAddress
                                    forall (m :: * -> *).
MonadIO m =>
[Variant] -> Maybe Text -> Text -> m VariantResponse
selectVariant [Variant]
variants Maybe Text
identifier Feature
jsonFeature.name
        }
    )
    where
        anyStrategyEnabled :: MonadIO m => JsonTypes.Context -> m Bool
        anyStrategyEnabled :: forall (m :: * -> *). MonadIO m => Context -> m Bool
anyStrategyEnabled Context
ctx = forall (t :: * -> *). Foldable t => t Bool -> Bool
or forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (\Context -> m Bool
f -> Context -> m Bool
f Context
ctx) forall (m :: * -> *). MonadIO m => [Context -> m Bool]
strategyPredicates

        strategyPredicates :: MonadIO m => [JsonTypes.Context -> m Bool]
        strategyPredicates :: forall (m :: * -> *). MonadIO m => [Context -> m Bool]
strategyPredicates =
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (m :: * -> *).
MonadIO m =>
Text -> Map Int [Constraint] -> Strategy -> Context -> m Bool
fromJsonStrategy Feature
jsonFeature.name Map Int [Constraint]
segmentMap) Feature
jsonFeature.strategies

        enabledByOverride :: [Variant] -> JsonTypes.Context -> Maybe Variant
        enabledByOverride :: [Variant] -> Context -> Maybe Variant
enabledByOverride [Variant]
variants Context
ctx =
            forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find
                ( \Variant
variant -> case Variant
variant.overrides of
                    Maybe [Override]
Nothing -> Bool
False
                    Just [Override]
overrides ->
                        forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any
                            ( \Override
override ->
                                Text -> Context -> Maybe Text
lookupContextValue Override
override.contextName Context
ctx forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Override
override.values)
                            )
                            [Override]
overrides
                )
                [Variant]
variants

        selectVariant :: MonadIO m => [Variant] -> Maybe Text -> Text -> m VariantResponse
        selectVariant :: forall (m :: * -> *).
MonadIO m =>
[Variant] -> Maybe Text -> Text -> m VariantResponse
selectVariant [Variant]
variants Maybe Text
maybeIdentifier Text
featureName = do
            Text
randomValue <- forall (m :: * -> *). MonadIO m => m Text
generateRandomText
            let identifier :: Text
identifier = forall a. a -> Maybe a -> a
fromMaybe Text
randomValue Maybe Text
maybeIdentifier
                weights :: [Int]
weights = (.weight) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Variant]
variants
                hashed :: Int
hashed = Text -> Text -> Word32 -> Int
getNormalizedNumberN Text
identifier Text
featureName (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Int]
weights)
                accumulated :: [Int]
accumulated = forall a. [a] -> [a]
tail forall a b. (a -> b) -> a -> b
$ forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl forall a. Num a => a -> a -> a
(+) Int
0 [Int]
weights
                zipped :: [(Int, Variant)]
zipped = forall a b. [a] -> [b] -> [(a, b)]
zip [Int]
accumulated [Variant]
variants
                maybeVariant :: Maybe Variant
maybeVariant = forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\(Int
acc, Variant
_) -> Int
acc forall a. Ord a => a -> a -> Bool
>= Int
hashed) [(Int, Variant)]
zipped
             in case Maybe Variant
maybeVariant of
                    Maybe Variant
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure VariantResponse
emptyVariantResponse
                    Just Variant
variant ->
                        forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
                            VariantResponse
                                { $sel:name:VariantResponse :: Text
name = Variant
variant.name,
                                  $sel:payload:VariantResponse :: Maybe Payload
payload = Variant
variant.payload,
                                  $sel:enabled:VariantResponse :: Bool
enabled = Bool
True
                                }

fromJsonStrategy :: MonadIO m => FeatureToggleName -> Map Int [JsonTypes.Constraint] -> JsonTypes.Strategy -> (JsonTypes.Context -> m Bool)
fromJsonStrategy :: forall (m :: * -> *).
MonadIO m =>
Text -> Map Int [Constraint] -> Strategy -> Context -> m Bool
fromJsonStrategy Text
featureToggleName Map Int [Constraint]
segmentMap Strategy
jsonStrategy =
    \Context
ctx -> forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Bool -> Bool -> Bool
(&&) (forall (m :: * -> *). MonadIO m => Context -> m Bool
strategyFunction Context
ctx) (forall (m :: * -> *). MonadIO m => Context -> m Bool
constraintsPredicate Context
ctx)
    where
        strategyFunction :: MonadIO m => JsonTypes.Context -> m Bool
        strategyFunction :: forall (m :: * -> *). MonadIO m => Context -> m Bool
strategyFunction =
            case Strategy
jsonStrategy.name of
                Text
"default" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. \Context
_ctx -> Bool
True
                Text
"userWithId" ->
                    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. \Context
ctx ->
                        let strategy :: Map k Text -> Bool
strategy Map k Text
params =
                                let userIds :: [Text]
userIds = forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (Text -> Text -> [Text]
Text.splitOn Text
", ") (forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup k
"userIds" Map k Text
params)
                                 in Context
ctx.userId forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
userIds)
                         in forall a. (a -> Bool) -> Maybe a -> Bool
evaluateStrategy forall {k}. (Ord k, IsString k) => Map k Text -> Bool
strategy Strategy
jsonStrategy.parameters
                Text
"gradualRolloutUserId" ->
                    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. \Context
ctx ->
                        case Context
ctx.userId of
                            Maybe Text
Nothing -> Bool
False
                            Just Text
userId ->
                                forall a. (a -> Bool) -> Maybe a -> Bool
evaluateStrategy Map Text Text -> Bool
strategy Strategy
jsonStrategy.parameters
                                where
                                    strategy :: Map Text Text -> Bool
strategy Map Text Text
params =
                                        let percentage :: Int
percentage = Text -> Map Text Text -> Int
getInt Text
"percentage" Map Text Text
params
                                            groupId :: Text
groupId = forall a. a -> Maybe a -> a
fromMaybe Text
featureToggleName forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
"groupId" Map Text Text
params
                                            normValue :: Int
normValue = Text -> Text -> Int
getNormalizedNumber Text
userId Text
groupId
                                         in Int
normValue forall a. Ord a => a -> a -> Bool
<= Int
percentage
                Text
"gradualRolloutSessionId" ->
                    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. \Context
ctx ->
                        case Context
ctx.sessionId of
                            Maybe Text
Nothing -> Bool
False
                            Just Text
sessionId ->
                                forall a. (a -> Bool) -> Maybe a -> Bool
evaluateStrategy Map Text Text -> Bool
strategy Strategy
jsonStrategy.parameters
                                where
                                    strategy :: Map Text Text -> Bool
strategy Map Text Text
params =
                                        let percentage :: Int
percentage = Text -> Map Text Text -> Int
getInt Text
"percentage" Map Text Text
params
                                            groupId :: Text
groupId = forall a. a -> Maybe a -> a
fromMaybe Text
featureToggleName forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
"groupId" Map Text Text
params
                                            normValue :: Int
normValue = Text -> Text -> Int
getNormalizedNumber Text
sessionId Text
groupId
                                         in Int
normValue forall a. Ord a => a -> a -> Bool
<= Int
percentage
                Text
"gradualRolloutRandom" -> \Context
_ctx -> do
                    case Strategy
jsonStrategy.parameters of
                        Maybe (Map Text Text)
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
                        Just Map Text Text
params -> do
                            let percentage :: Int
percentage = Text -> Map Text Text -> Int
getInt Text
"percentage" Map Text Text
params
                            Int
num <- forall a (m :: * -> *). (Random a, MonadIO m) => (a, a) -> m a
randomRIO @Int (Int
1, Int
100)
                            forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Int
percentage forall a. Ord a => a -> a -> Bool
>= Int
num
                Text
"remoteAddress" ->
                    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. \Context
ctx ->
                        let strategy :: Map k Text -> Bool
strategy Map k Text
params =
                                let remoteAddresses :: [Text]
remoteAddresses = forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (Text -> Text -> [Text]
Text.splitOn Text
", ") (forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup k
"IPs" Map k Text
params)
                                 in Context
ctx.remoteAddress forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
remoteAddresses)
                         in forall a. (a -> Bool) -> Maybe a -> Bool
evaluateStrategy forall {k}. (Ord k, IsString k) => Map k Text -> Bool
strategy Strategy
jsonStrategy.parameters
                Text
"flexibleRollout" -> \Context
ctx -> do
                    Text
randomValue <- forall (m :: * -> *). MonadIO m => m Text
generateRandomText
                    let strategy :: Map Text Text -> Bool
strategy Map Text Text
params =
                            let rollout :: Int
rollout = Text -> Map Text Text -> Int
getInt Text
"rollout" Map Text Text
params
                                stickiness :: Text
stickiness = forall a. a -> Maybe a -> a
fromMaybe Text
"default" forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
"stickiness" Map Text Text
params
                                groupId :: Text
groupId = forall a. a -> Maybe a -> a
fromMaybe Text
featureToggleName forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
"groupId" Map Text Text
params
                             in case Text
stickiness of
                                    Text
"default" ->
                                        Int
normalizedNumber forall a. Ord a => a -> a -> Bool
<= Int
rollout
                                        where
                                            identifier :: Text
identifier = forall a. a -> Maybe a -> a
fromMaybe Text
randomValue (Context
ctx.userId forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Context
ctx.sessionId forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Context
ctx.remoteAddress)
                                            normalizedNumber :: Int
normalizedNumber = Text -> Text -> Int
getNormalizedNumber Text
identifier Text
groupId
                                    Text
"userId" ->
                                        case Context
ctx.userId of
                                            Maybe Text
Nothing -> Bool
False
                                            Just Text
userId -> Text -> Text -> Int
getNormalizedNumber Text
userId Text
groupId forall a. Ord a => a -> a -> Bool
<= Int
rollout
                                    Text
"sessionId" ->
                                        case Context
ctx.sessionId of
                                            Maybe Text
Nothing -> Bool
False
                                            Just Text
sessionId -> Text -> Text -> Int
getNormalizedNumber Text
sessionId Text
groupId forall a. Ord a => a -> a -> Bool
<= Int
rollout
                                    Text
customField ->
                                        case Text -> Context -> Maybe Text
lookupContextValue Text
customField Context
ctx of
                                            Maybe Text
Nothing -> Bool
False
                                            Just Text
customValue ->
                                                Text -> Text -> Int
getNormalizedNumber Text
customValue Text
groupId forall a. Ord a => a -> a -> Bool
<= Int
rollout
                     in forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> Maybe a -> Bool
evaluateStrategy Map Text Text -> Bool
strategy Strategy
jsonStrategy.parameters
                -- Unknown strategy
                Text
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. \Context
_ctx -> Bool
False

        segmentsToConstraints :: [Int] -> Map Int [JsonTypes.Constraint] -> [Maybe JsonTypes.Constraint]
        segmentsToConstraints :: [Int] -> Map Int [Constraint] -> [Maybe Constraint]
segmentsToConstraints [Int]
segmentReferences Map Int [Constraint]
segmentMap =
            forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((forall a b c. (a -> b -> c) -> b -> a -> c
flip forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup) Map Int [Constraint]
segmentMap forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Int]
segmentReferences)

        constraintsPredicate :: MonadIO m => JsonTypes.Context -> m Bool
        constraintsPredicate :: forall (m :: * -> *). MonadIO m => Context -> m Bool
constraintsPredicate Context
ctx = do
            let segmentReferences :: [Int]
segmentReferences = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat Strategy
jsonStrategy.segments
                maybeSegmentConstraints :: [Maybe Constraint]
maybeSegmentConstraints = [Int] -> Map Int [Constraint] -> [Maybe Constraint]
segmentsToConstraints [Int]
segmentReferences Map Int [Constraint]
segmentMap
                segmentConstraints :: [Constraint]
segmentConstraints = forall a. [Maybe a] -> [a]
catMaybes [Maybe Constraint]
maybeSegmentConstraints
                strategyConstraints :: [Constraint]
strategyConstraints = forall a. a -> Maybe a -> a
fromMaybe [] Strategy
jsonStrategy.constraints
                allConstraints :: [Constraint]
allConstraints = [Constraint]
segmentConstraints forall a. Semigroup a => a -> a -> a
<> [Constraint]
strategyConstraints
                allPredicates :: [Context -> Bool]
allPredicates = Constraint -> Context -> Bool
fromJsonConstraint forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Constraint]
allConstraints
                allSegmentConstraintsAreReferredTo :: Bool
allSegmentConstraintsAreReferredTo = Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall a. Maybe a
Nothing forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Maybe Constraint]
maybeSegmentConstraints
                allPredicatesAreSatisfied :: Bool
allPredicatesAreSatisfied = Bool
allSegmentConstraintsAreReferredTo Bool -> Bool -> Bool
&& forall (t :: * -> *). Foldable t => t Bool -> Bool
and ((Context -> Bool) -> Bool
evaluatePredicate forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Context -> Bool]
allPredicates)
                thereAreNoPredicates :: Bool
thereAreNoPredicates = forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Context -> Bool]
allPredicates
            forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Bool
thereAreNoPredicates Bool -> Bool -> Bool
|| Bool
allPredicatesAreSatisfied
            where
                evaluatePredicate :: (JsonTypes.Context -> Bool) -> Bool
                evaluatePredicate :: (Context -> Bool) -> Bool
evaluatePredicate Context -> Bool
f = Context -> Bool
f Context
ctx

fromJsonConstraint :: JsonTypes.Constraint -> (JsonTypes.Context -> Bool)
fromJsonConstraint :: Constraint -> Context -> Bool
fromJsonConstraint Constraint
constraint = \Context
ctx -> do
    let constraintValues :: [Text]
constraintValues =
            if forall a. a -> Maybe a -> a
fromMaybe Bool
False Constraint
constraint.caseInsensitive
                then Text -> Text
Text.toLower forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. a -> Maybe a -> a
fromMaybe [] Constraint
constraint.values
                else forall a. a -> Maybe a -> a
fromMaybe [] Constraint
constraint.values

    let mCurrentValue :: Maybe Text
mCurrentValue = do
            let Maybe Text
tmpValue :: Maybe Text = Text -> Context -> Maybe Text
lookupContextValue Constraint
constraint.contextName Context
ctx
            if forall a. a -> Maybe a -> a
fromMaybe Bool
False Constraint
constraint.caseInsensitive
                then (Text -> Text
Text.toLower forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
tmpValue)
                else Maybe Text
tmpValue

    let result :: Bool
result =
            case Constraint
constraint.operator of
                Text
"IN" -> Maybe Text
mCurrentValue forall a. Eq a => Maybe a -> [a] -> Bool
`isIn` [Text]
constraintValues
                Text
"NOT_IN" -> Maybe Text
mCurrentValue forall a. Eq a => Maybe a -> [a] -> Bool
`isNotIn` [Text]
constraintValues
                Text
"STR_STARTS_WITH" -> Maybe Text
mCurrentValue Maybe Text -> [Text] -> Bool
`startsWithAnyOf` [Text]
constraintValues
                Text
"STR_ENDS_WITH" -> Maybe Text
mCurrentValue Maybe Text -> [Text] -> Bool
`endsWithAnyOf` [Text]
constraintValues
                Text
"STR_CONTAINS" -> Maybe Text
mCurrentValue Maybe Text -> [Text] -> Bool
`containsAnyOf` [Text]
constraintValues
                Text
"NUM_EQ" -> (Double -> Double -> Bool) -> Maybe Text -> Maybe Text -> Bool
numPredicate forall a. Eq a => a -> a -> Bool
(==) Maybe Text
mCurrentValue Constraint
constraint.value
                Text
"NUM_GT" -> (Double -> Double -> Bool) -> Maybe Text -> Maybe Text -> Bool
numPredicate forall a. Ord a => a -> a -> Bool
(>) Maybe Text
mCurrentValue Constraint
constraint.value
                Text
"NUM_GTE" -> (Double -> Double -> Bool) -> Maybe Text -> Maybe Text -> Bool
numPredicate forall a. Ord a => a -> a -> Bool
(>=) Maybe Text
mCurrentValue Constraint
constraint.value
                Text
"NUM_LTE" -> (Double -> Double -> Bool) -> Maybe Text -> Maybe Text -> Bool
numPredicate forall a. Ord a => a -> a -> Bool
(<=) Maybe Text
mCurrentValue Constraint
constraint.value
                Text
"NUM_LT" -> (Double -> Double -> Bool) -> Maybe Text -> Maybe Text -> Bool
numPredicate forall a. Ord a => a -> a -> Bool
(<) Maybe Text
mCurrentValue Constraint
constraint.value
                Text
"DATE_AFTER" -> (UTCTime -> UTCTime -> Bool) -> Maybe Text -> Maybe Text -> Bool
datePredicate forall a. Ord a => a -> a -> Bool
(>) Maybe Text
mCurrentValue Constraint
constraint.value
                Text
"DATE_BEFORE" -> (UTCTime -> UTCTime -> Bool) -> Maybe Text -> Maybe Text -> Bool
datePredicate forall a. Ord a => a -> a -> Bool
(<) Maybe Text
mCurrentValue Constraint
constraint.value
                Text
"SEMVER_EQ" -> (SemVer -> SemVer -> Bool) -> Maybe Text -> Maybe Text -> Bool
semVerPredicate forall a. Eq a => a -> a -> Bool
(==) Maybe Text
mCurrentValue Constraint
constraint.value
                Text
"SEMVER_GT" -> (SemVer -> SemVer -> Bool) -> Maybe Text -> Maybe Text -> Bool
semVerPredicate forall a. Ord a => a -> a -> Bool
(>) Maybe Text
mCurrentValue Constraint
constraint.value
                Text
"SEMVER_LT" -> (SemVer -> SemVer -> Bool) -> Maybe Text -> Maybe Text -> Bool
semVerPredicate forall a. Ord a => a -> a -> Bool
(<) Maybe Text
mCurrentValue Constraint
constraint.value
                Text
_ -> Bool
False

    if forall a. a -> Maybe a -> a
fromMaybe Bool
False Constraint
constraint.inverted
        then Bool -> Bool
not Bool
result
        else Bool
result

lookupContextValue :: Text -> JsonTypes.Context -> Maybe Text
lookupContextValue :: Text -> Context -> Maybe Text
lookupContextValue Text
key Context
ctx =
    case Text
key of
        Text
"appName" -> Context
ctx.appName
        Text
"currentTime" -> Context
ctx.currentTime
        Text
"environment" -> Context
ctx.environment
        Text
"remoteAddress" -> Context
ctx.remoteAddress
        Text
"sessionId" -> Context
ctx.sessionId
        Text
"userId" -> Context
ctx.userId
        Text
propertiesKey -> do
            Map Text (Maybe Text)
m <- Context
ctx.properties
            Maybe Text
value <- forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
propertiesKey Map Text (Maybe Text)
m
            Maybe Text
value

isIn :: Eq a => Maybe a -> [a] -> Bool
isIn :: forall a. Eq a => Maybe a -> [a] -> Bool
isIn Maybe a
mCurrentValue [a]
values =
    case Maybe a
mCurrentValue of
        Maybe a
Nothing -> Bool
False
        Just a
currentValue -> a
currentValue forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [a]
values

isNotIn :: Eq a => Maybe a -> [a] -> Bool
isNotIn :: forall a. Eq a => Maybe a -> [a] -> Bool
isNotIn Maybe a
mCurrentValue [a]
values = Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall a. Eq a => Maybe a -> [a] -> Bool
isIn Maybe a
mCurrentValue [a]
values

startsWithAnyOf :: Maybe Text -> [Text] -> Bool
startsWithAnyOf :: Maybe Text -> [Text] -> Bool
startsWithAnyOf Maybe Text
mCurrentValue [Text]
values = do
    case Maybe Text
mCurrentValue of
        Maybe Text
Nothing -> Bool
False
        Just Text
currentValue -> forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Text -> Text -> Bool
`Text.isPrefixOf` Text
currentValue) [Text]
values

endsWithAnyOf :: Maybe Text -> [Text] -> Bool
endsWithAnyOf :: Maybe Text -> [Text] -> Bool
endsWithAnyOf Maybe Text
mCurrentValue [Text]
values = do
    case Maybe Text
mCurrentValue of
        Maybe Text
Nothing -> Bool
False
        Just Text
currentValue -> forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Text -> Text -> Bool
`Text.isSuffixOf` Text
currentValue) [Text]
values

containsAnyOf :: Maybe Text -> [Text] -> Bool
containsAnyOf :: Maybe Text -> [Text] -> Bool
containsAnyOf Maybe Text
mCurrentValue [Text]
values = do
    case Maybe Text
mCurrentValue of
        Maybe Text
Nothing -> Bool
False
        Just Text
currentValue -> forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Text -> Text -> Bool
`Text.isInfixOf` Text
currentValue) [Text]
values

getNormalizedNumberN :: Text -> Text -> Word32 -> Int
getNormalizedNumberN :: Text -> Text -> Word32 -> Int
getNormalizedNumberN Text
identifier Text
groupId Word32
n = do
    let s :: Text
s = Text
groupId forall a. Semigroup a => a -> a -> a
<> Text
":" forall a. Semigroup a => a -> a -> a
<> Text
identifier
    let Word32
hash :: Word32 = Word32 -> ByteString -> Word32
murmur3 (Word32
0 :: Word32) forall a b. (a -> b) -> a -> b
$ Text -> ByteString
encodeUtf8 Text
s

    forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ (forall a. Integral a => a -> a -> a
mod Word32
hash Word32
n) forall a. Num a => a -> a -> a
+ Word32
1

getNormalizedNumber :: Text -> Text -> Int
getNormalizedNumber :: Text -> Text -> Int
getNormalizedNumber Text
identifier Text
groupId = Text -> Text -> Word32 -> Int
getNormalizedNumberN Text
identifier Text
groupId Word32
100

-- | Check whether or not a feature toggle is enabled.
featureIsEnabled ::
    MonadIO m =>
    -- | Full set of features fetched from a server.
    Features ->
    -- | Feature toggle name (as it is represented on the server).
    FeatureToggleName ->
    -- | User context.
    JsonTypes.Context ->
    -- | Feature toggle state.
    m Bool
featureIsEnabled :: forall (m :: * -> *).
MonadIO m =>
Features -> Text -> Context -> m Bool
featureIsEnabled Features
state Text
toggleName Context
ctx = do
    let Maybe Feature
mToggle :: Maybe Feature = forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
toggleName Features
state
    case Maybe Feature
mToggle of
        Just Feature {$sel:isEnabled:Feature :: Feature -> IsEnabled
isEnabled = IsEnabled forall (m :: * -> *). MonadIO m => Context -> m Bool
isEnabled} -> forall (m :: * -> *). MonadIO m => Context -> m Bool
isEnabled Context
ctx
        Maybe Feature
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False

getInt :: Text -> Parameters -> Int
getInt :: Text -> Map Text Text -> Int
getInt Text
key Map Text Text
params = forall a. Read a => String -> a
read forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
Text.unpack forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe Text
"0" (forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
key Map Text Text
params)

evaluateStrategy :: (a -> Bool) -> Maybe a -> Bool
evaluateStrategy :: forall a. (a -> Bool) -> Maybe a -> Bool
evaluateStrategy a -> Bool
f Maybe a
p = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False a -> Bool
f Maybe a
p

-- | Get a variant for a given feature toggle.
featureGetVariant ::
    MonadIO m =>
    -- | Full set of features fetched from a server.
    Features ->
    -- | Feature toggle name (as it is represented on the server).
    FeatureToggleName ->
    -- | User context.
    JsonTypes.Context ->
    -- | Variant.
    m VariantResponse
featureGetVariant :: forall (m :: * -> *).
MonadIO m =>
Features -> Text -> Context -> m VariantResponse
featureGetVariant Features
state Text
toggleName Context
ctx = do
    let Maybe Feature
mToggle :: Maybe Feature = forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
toggleName Features
state
    case Maybe Feature
mToggle of
        Just Feature {$sel:getVariant:Feature :: Feature -> GetVariant
getVariant = GetVariant forall (m :: * -> *). MonadIO m => Context -> m VariantResponse
getVariant} -> forall (m :: * -> *). MonadIO m => Context -> m VariantResponse
getVariant Context
ctx
        Maybe Feature
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure VariantResponse
emptyVariantResponse