{- |
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 (
    defaultStrategyEvaluator,
    defaultSupportedStrategies,
    featureGetVariant,
    featureIsEnabled,
    fromJsonFeatures,
    Feature (..),
    Features,
    FeatureToggleName,
    GetVariant (..),
    IsEnabled (..),
    StrategyEvaluator,
) 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.
defaultSupportedStrategies :: JsonTypes.SupportedStrategies
defaultSupportedStrategies :: [Text]
defaultSupportedStrategies = [Text
"default", Text
"userWithId", Text
"gradualRolloutUserId", Text
"gradualRolloutSessionId", Text
"gradualRolloutRandom", Text
"remoteAddress", Text
"flexibleRollout"]

-- | Functions that implement strategies.
type StrategyEvaluator = forall m. (MonadIO m) => JsonTypes.Strategy -> FeatureToggleName -> JsonTypes.Context -> m Bool

-- | 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] = Maybe [Segment] -> [Segment]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat Maybe [Segment]
maybeSegments
     in [(Int, [Constraint])] -> Map Int [Constraint]
forall k a. Ord k => [(k, a)] -> Map k a
fromList ([(Int, [Constraint])] -> Map Int [Constraint])
-> [(Int, [Constraint])] -> Map Int [Constraint]
forall a b. (a -> b) -> a -> b
$ (\Segment
segment -> (Segment
segment.id, Segment
segment.constraints)) (Segment -> (Int, [Constraint]))
-> [Segment] -> [(Int, [Constraint])]
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 :: StrategyEvaluator -> JsonTypes.Features -> Features
fromJsonFeatures :: StrategyEvaluator -> Features -> Features
fromJsonFeatures StrategyEvaluator
strategyEvaluator Features
jsonFeatures = [(Text, Feature)] -> Features
forall k a. Ord k => [(k, a)] -> Map k a
fromList ([(Text, Feature)] -> Features) -> [(Text, Feature)] -> Features
forall a b. (a -> b) -> a -> b
$ (Feature -> (Text, Feature)) -> [Feature] -> [(Text, Feature)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (StrategyEvaluator
-> Map Int [Constraint] -> Feature -> (Text, Feature)
fromJsonFeature Strategy -> Text -> Context -> m Bool
StrategyEvaluator
strategyEvaluator (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 = Int -> Text
forall a. TextShow a => a -> Text
showt (Int -> Text) -> m Int -> m Text
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 :: StrategyEvaluator -> Map Int [JsonTypes.Constraint] -> JsonTypes.Feature -> (FeatureToggleName, Feature)
fromJsonFeature :: StrategyEvaluator
-> Map Int [Constraint] -> Feature -> (Text, Feature)
fromJsonFeature StrategyEvaluator
strategyEvaluator 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 (m :: * -> *). MonadIO m => Context -> m Bool)
 -> IsEnabled)
-> (forall (m :: * -> *). MonadIO m => Context -> m Bool)
-> IsEnabled
forall a b. (a -> b) -> a -> b
$ \Context
ctx -> do
            Bool
isAnyStrategyEnabled <- Context -> m Bool
forall (m :: * -> *). MonadIO m => Context -> m Bool
anyStrategyEnabled Context
ctx
            Bool -> m Bool
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> m Bool) -> Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ Feature
jsonFeature.enabled Bool -> Bool -> Bool
&& ([Strategy] -> Bool
forall a. [a] -> 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 (m :: * -> *). MonadIO m => Context -> m VariantResponse)
 -> GetVariant)
-> (forall (m :: * -> *).
    MonadIO m =>
    Context -> m VariantResponse)
-> GetVariant
forall a b. (a -> b) -> a -> b
$ \Context
ctx ->
            if Bool -> Bool
not Feature
jsonFeature.enabled
                then VariantResponse -> m VariantResponse
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure VariantResponse
emptyVariantResponse
                else do
                    let [Variant]
variants :: [Variant] = [Variant] -> Maybe [Variant] -> [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
                            VariantResponse -> m VariantResponse
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (VariantResponse -> m VariantResponse)
-> VariantResponse -> m VariantResponse
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 = (Text -> Bool) -> [Text] -> Maybe Text
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (Text
"default" Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/=) ([Text] -> Maybe Text)
-> ([Maybe Text] -> [Text]) -> [Maybe Text] -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe Text] -> [Text]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe Text] -> Maybe Text) -> [Maybe Text] -> Maybe Text
forall a b. (a -> b) -> a -> b
$ (.stickiness) (Variant -> Maybe Text) -> [Variant] -> [Maybe Text]
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
                                    [Variant] -> Maybe Text -> Text -> m VariantResponse
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 Maybe Text -> Maybe Text -> Maybe Text
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Context
ctx.sessionId Maybe Text -> Maybe Text -> Maybe Text
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Context
ctx.remoteAddress
                                    [Variant] -> Maybe Text -> Text -> m VariantResponse
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 = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or ([Bool] -> Bool) -> m [Bool] -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Context -> m Bool) -> m Bool) -> [Context -> m Bool] -> m [Bool]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (\Context -> m Bool
f -> Context -> m Bool
f Context
ctx) [Context -> m Bool]
forall (m :: * -> *). MonadIO m => [Context -> m Bool]
strategyPredicates

        strategyPredicates :: (MonadIO m) => [JsonTypes.Context -> m Bool]
        strategyPredicates :: forall (m :: * -> *). MonadIO m => [Context -> m Bool]
strategyPredicates =
            (Strategy -> Context -> m Bool)
-> [Strategy] -> [Context -> m Bool]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (StrategyEvaluator
-> Text -> Map Int [Constraint] -> Strategy -> Context -> m Bool
forall (m :: * -> *).
MonadIO m =>
StrategyEvaluator
-> Text -> Map Int [Constraint] -> Strategy -> Context -> m Bool
fromJsonStrategy Strategy -> Text -> Context -> m Bool
StrategyEvaluator
strategyEvaluator 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 =
            (Variant -> Bool) -> [Variant] -> Maybe Variant
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 ->
                        (Override -> Bool) -> [Override] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any
                            ( \Override
override ->
                                Text -> Context -> Maybe Text
lookupContextValue Override
override.contextName Context
ctx Maybe Text -> [Maybe Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> [Text] -> [Maybe Text]
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 <- m Text
forall (m :: * -> *). MonadIO m => m Text
generateRandomText
            let identifier :: Text
identifier = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
randomValue Maybe Text
maybeIdentifier
                weights :: [Int]
weights = (.weight) (Variant -> Int) -> [Variant] -> [Int]
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 (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word32) -> Int -> Word32
forall a b. (a -> b) -> a -> b
$ [Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Int]
weights)
                accumulated :: [Int]
accumulated = [Int] -> [Int]
forall a. HasCallStack => [a] -> [a]
tail ([Int] -> [Int]) -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
$ (Int -> Int -> Int) -> Int -> [Int] -> [Int]
forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) Int
0 [Int]
weights
                zipped :: [(Int, Variant)]
zipped = [Int] -> [Variant] -> [(Int, Variant)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int]
accumulated [Variant]
variants
                maybeVariant :: Maybe Variant
maybeVariant = (Int, Variant) -> Variant
forall a b. (a, b) -> b
snd ((Int, Variant) -> Variant)
-> Maybe (Int, Variant) -> Maybe Variant
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Int, Variant) -> Bool)
-> [(Int, Variant)] -> Maybe (Int, Variant)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\(Int
acc, Variant
_) -> Int
acc Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
hashed) [(Int, Variant)]
zipped
             in case Maybe Variant
maybeVariant of
                    Maybe Variant
Nothing -> VariantResponse -> m VariantResponse
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure VariantResponse
emptyVariantResponse
                    Just Variant
variant ->
                        VariantResponse -> m VariantResponse
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (VariantResponse -> m VariantResponse)
-> VariantResponse -> m VariantResponse
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) => StrategyEvaluator -> FeatureToggleName -> Map Int [JsonTypes.Constraint] -> JsonTypes.Strategy -> (JsonTypes.Context -> m Bool)
fromJsonStrategy :: forall (m :: * -> *).
MonadIO m =>
StrategyEvaluator
-> Text -> Map Int [Constraint] -> Strategy -> Context -> m Bool
fromJsonStrategy StrategyEvaluator
strategyEvaluator Text
featureToggleName Map Int [Constraint]
segmentMap Strategy
jsonStrategy =
    \Context
ctx -> (Bool -> Bool -> Bool) -> m Bool -> m Bool -> m Bool
forall a b c. (a -> b -> c) -> m a -> m b -> m c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Bool -> Bool -> Bool
(&&) (Strategy -> Text -> Context -> m Bool
StrategyEvaluator
strategyEvaluator Strategy
jsonStrategy Text
featureToggleName Context
ctx) (Context -> m Bool
forall (m :: * -> *). MonadIO m => Context -> m Bool
constraintsPredicate Context
ctx)
    where
        segmentsToConstraints :: [Int] -> Map Int [JsonTypes.Constraint] -> [Maybe JsonTypes.Constraint]
        segmentsToConstraints :: [Int] -> Map Int [Constraint] -> [Maybe Constraint]
segmentsToConstraints [Int]
segmentReferences Map Int [Constraint]
segmentMap =
            [[Maybe Constraint]] -> [Maybe Constraint]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Maybe Constraint]] -> [Maybe Constraint])
-> [[Maybe Constraint]] -> [Maybe Constraint]
forall a b. (a -> b) -> a -> b
$ Maybe [Constraint] -> [Maybe Constraint]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => Maybe (m a) -> m (Maybe a)
sequence (Maybe [Constraint] -> [Maybe Constraint])
-> [Maybe [Constraint]] -> [[Maybe Constraint]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (((Int -> Map Int [Constraint] -> Maybe [Constraint])
-> Map Int [Constraint] -> Int -> Maybe [Constraint]
forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> Map Int [Constraint] -> Maybe [Constraint]
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup) Map Int [Constraint]
segmentMap (Int -> Maybe [Constraint]) -> [Int] -> [Maybe [Constraint]]
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 = Maybe [Int] -> [Int]
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 = [Maybe Constraint] -> [Constraint]
forall a. [Maybe a] -> [a]
catMaybes [Maybe Constraint]
maybeSegmentConstraints
                strategyConstraints :: [Constraint]
strategyConstraints = [Constraint] -> Maybe [Constraint] -> [Constraint]
forall a. a -> Maybe a -> a
fromMaybe [] Strategy
jsonStrategy.constraints
                allConstraints :: [Constraint]
allConstraints = [Constraint]
segmentConstraints [Constraint] -> [Constraint] -> [Constraint]
forall a. Semigroup a => a -> a -> a
<> [Constraint]
strategyConstraints
                allPredicates :: [Context -> Bool]
allPredicates = Constraint -> Context -> Bool
fromJsonConstraint (Constraint -> Context -> Bool)
-> [Constraint] -> [Context -> Bool]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Constraint]
allConstraints
                allSegmentConstraintsAreReferredTo :: Bool
allSegmentConstraintsAreReferredTo = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Maybe Constraint
forall a. Maybe a
Nothing Maybe Constraint -> [Maybe Constraint] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Maybe Constraint]
maybeSegmentConstraints
                allPredicatesAreSatisfied :: Bool
allPredicatesAreSatisfied = Bool
allSegmentConstraintsAreReferredTo Bool -> Bool -> Bool
&& [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and ((Context -> Bool) -> Bool
evaluatePredicate ((Context -> Bool) -> Bool) -> [Context -> Bool] -> [Bool]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Context -> Bool]
allPredicates)
                thereAreNoPredicates :: Bool
thereAreNoPredicates = [Context -> Bool] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Context -> Bool]
allPredicates
            Bool -> m Bool
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> m Bool) -> Bool -> m Bool
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

-- | Implementation of default strategies.
defaultStrategyEvaluator :: StrategyEvaluator
defaultStrategyEvaluator :: StrategyEvaluator
defaultStrategyEvaluator Strategy
jsonStrategy Text
featureToggleName =
    case Strategy
jsonStrategy.name of
        Text
"default" -> Bool -> m Bool
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> m Bool) -> (Context -> Bool) -> Context -> m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \Context
_ctx -> Bool
True
        Text
"userWithId" ->
            Bool -> m Bool
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> m Bool) -> (Context -> Bool) -> Context -> m Bool
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 = [Text] -> (Text -> [Text]) -> Maybe Text -> [Text]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] Text -> [Text]
splitParams (k -> Map k Text -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup k
"userIds" Map k Text
params)
                         in Context
ctx.userId Maybe Text -> [Maybe Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> [Text] -> [Maybe Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
userIds)
                 in (Map Text Text -> Bool) -> Maybe (Map Text Text) -> Bool
forall a. (a -> Bool) -> Maybe a -> Bool
evaluateStrategy Map Text Text -> Bool
forall {k}. (Ord k, IsString k) => Map k Text -> Bool
strategy Strategy
jsonStrategy.parameters
        Text
"gradualRolloutUserId" ->
            Bool -> m Bool
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> m Bool) -> (Context -> Bool) -> Context -> m Bool
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 ->
                        (Map Text Text -> Bool) -> Maybe (Map Text Text) -> Bool
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 = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
featureToggleName (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Map Text Text -> Maybe Text
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
percentage
        Text
"gradualRolloutSessionId" ->
            Bool -> m Bool
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> m Bool) -> (Context -> Bool) -> Context -> m Bool
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 ->
                        (Map Text Text -> Bool) -> Maybe (Map Text Text) -> Bool
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 = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
featureToggleName (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Map Text Text -> Maybe Text
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
percentage
        Text
"gradualRolloutRandom" -> \Context
_ctx -> do
            case Strategy
jsonStrategy.parameters of
                Maybe (Map Text Text)
Nothing -> Bool -> m Bool
forall a. a -> m a
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)
                    Bool -> m Bool
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> m Bool) -> Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ Int
percentage Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
num
        Text
"remoteAddress" ->
            Bool -> m Bool
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> m Bool) -> (Context -> Bool) -> Context -> m Bool
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 = [Text] -> (Text -> [Text]) -> Maybe Text -> [Text]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] Text -> [Text]
splitParams (k -> Map k Text -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup k
"IPs" Map k Text
params)
                         in Context
ctx.remoteAddress Maybe Text -> [Maybe Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> [Text] -> [Maybe Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
remoteAddresses)
                 in (Map Text Text -> Bool) -> Maybe (Map Text Text) -> Bool
forall a. (a -> Bool) -> Maybe a -> Bool
evaluateStrategy Map Text Text -> Bool
forall {k}. (Ord k, IsString k) => Map k Text -> Bool
strategy Strategy
jsonStrategy.parameters
        Text
"flexibleRollout" -> \Context
ctx -> do
            Text
randomValue <- m Text
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 = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"default" (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Map Text Text -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
"stickiness" Map Text Text
params
                        groupId :: Text
groupId = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
featureToggleName (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Map Text Text -> Maybe Text
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
rollout
                                where
                                    identifier :: Text
identifier = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
randomValue (Context
ctx.userId Maybe Text -> Maybe Text -> Maybe Text
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Context
ctx.sessionId Maybe Text -> Maybe Text -> Maybe Text
forall a. Maybe a -> Maybe a -> Maybe a
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 Int -> Int -> Bool
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 Int -> Int -> Bool
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
rollout
             in Bool -> m Bool
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> m Bool) -> Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ (Map Text Text -> Bool) -> Maybe (Map Text Text) -> Bool
forall a. (a -> Bool) -> Maybe a -> Bool
evaluateStrategy Map Text Text -> Bool
strategy Strategy
jsonStrategy.parameters
        -- Unknown strategy
        Text
_ -> Bool -> m Bool
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> m Bool) -> (Context -> Bool) -> Context -> m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \Context
_ctx -> Bool
False
    where
        splitParams :: Text -> [Text]
        splitParams :: Text -> [Text]
splitParams = (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Text
Text.strip ([Text] -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => Text -> Text -> [Text]
Text -> Text -> [Text]
Text.splitOn Text
","

fromJsonConstraint :: JsonTypes.Constraint -> (JsonTypes.Context -> Bool)
fromJsonConstraint :: Constraint -> Context -> Bool
fromJsonConstraint Constraint
constraint = \Context
ctx -> do
    let constraintValues :: [Text]
constraintValues =
            if Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False Constraint
constraint.caseInsensitive
                then Text -> Text
Text.toLower (Text -> Text) -> [Text] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text] -> Maybe [Text] -> [Text]
forall a. a -> Maybe a -> a
fromMaybe [] Constraint
constraint.values
                else [Text] -> Maybe [Text] -> [Text]
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 Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False Constraint
constraint.caseInsensitive
                then (Text -> Text
Text.toLower (Text -> Text) -> Maybe Text -> Maybe Text
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 Maybe Text -> [Text] -> Bool
forall a. Eq a => Maybe a -> [a] -> Bool
`isIn` [Text]
constraintValues
                Text
"NOT_IN" -> Maybe Text
mCurrentValue Maybe Text -> [Text] -> Bool
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 Double -> Double -> Bool
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 Double -> Double -> Bool
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 Double -> Double -> Bool
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 Double -> Double -> Bool
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 Double -> Double -> Bool
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 UTCTime -> UTCTime -> Bool
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 UTCTime -> UTCTime -> Bool
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 SemVer -> SemVer -> Bool
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 SemVer -> SemVer -> Bool
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 SemVer -> SemVer -> Bool
forall a. Ord a => a -> a -> Bool
(<) Maybe Text
mCurrentValue Constraint
constraint.value
                Text
_ -> Bool
False

    if Bool -> Maybe Bool -> Bool
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 <- Text -> Map Text (Maybe Text) -> Maybe (Maybe Text)
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 a -> [a] -> Bool
forall a. Eq a => a -> [a] -> Bool
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 (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Maybe a -> [a] -> Bool
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 -> (Text -> Bool) -> [Text] -> Bool
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 -> (Text -> Bool) -> [Text] -> Bool
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 -> (Text -> Bool) -> [Text] -> Bool
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 Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
identifier
    let Word32
hash :: Word32 = Word32 -> ByteString -> Word32
murmur3 (Word32
0 :: Word32) (ByteString -> Word32) -> ByteString -> Word32
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
encodeUtf8 Text
s

    Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int) -> Word32 -> Int
forall a b. (a -> b) -> a -> b
$ (Word32 -> Word32 -> Word32
forall a. Integral a => a -> a -> a
mod Word32
hash Word32
n) Word32 -> Word32 -> Word32
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 = Text -> Features -> 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} -> Context -> m Bool
forall (m :: * -> *). MonadIO m => Context -> m Bool
isEnabled Context
ctx
        Maybe Feature
Nothing -> Bool -> m Bool
forall a. a -> m a
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 = String -> Int
forall a. Read a => String -> a
read (String -> Int) -> (Text -> String) -> Text -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
Text.unpack (Text -> Int) -> Text -> Int
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"0" (Text -> Map Text Text -> Maybe Text
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 = Bool -> (a -> Bool) -> Maybe a -> Bool
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 = Text -> Features -> 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} -> Context -> m VariantResponse
forall (m :: * -> *). MonadIO m => Context -> m VariantResponse
getVariant Context
ctx
        Maybe Feature
Nothing -> VariantResponse -> m VariantResponse
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure VariantResponse
emptyVariantResponse