{- |
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 :: [FeatureToggleName]
supportedStrategies = [FeatureToggleName
"default", FeatureToggleName
"userWithId", FeatureToggleName
"gradualRolloutUserId", FeatureToggleName
"gradualRolloutSessionId", FeatureToggleName
"gradualRolloutRandom", FeatureToggleName
"remoteAddress", FeatureToggleName
"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] = 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.id, segment.constraints)) <$> segments

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

generateRandomText :: MonadIO m => m Text
generateRandomText :: forall (m :: * -> *). MonadIO m => m FeatureToggleName
generateRandomText = Int -> FeatureToggleName
forall a. TextShow a => a -> FeatureToggleName
showt (Int -> FeatureToggleName) -> m Int -> m FeatureToggleName
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 -> (FeatureToggleName, Feature)
fromJsonFeature Map Int [Constraint]
segmentMap Feature
jsonFeature =
    ( jsonFeature.name,
      Feature :: IsEnabled -> GetVariant -> Feature
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 (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> m Bool) -> Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ jsonFeature.enabled && (null jsonFeature.strategies || 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 jsonFeature.enabled
                then VariantResponse -> m VariantResponse
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 [] jsonFeature.variants
                    case [Variant] -> Context -> Maybe Variant
enabledByOverride [Variant]
variants Context
ctx of
                        Just Variant
variant ->
                            -- Has overrides
                            VariantResponse -> m VariantResponse
forall (f :: * -> *) a. Applicative f => a -> f a
pure (VariantResponse -> m VariantResponse)
-> VariantResponse -> m VariantResponse
forall a b. (a -> b) -> a -> b
$
                                VariantResponse :: FeatureToggleName -> Maybe Payload -> Bool -> VariantResponse
VariantResponse
                                    { $sel:name:VariantResponse :: FeatureToggleName
name = variant.name,
                                      $sel:payload:VariantResponse :: Maybe Payload
payload = variant.payload,
                                      $sel:enabled:VariantResponse :: Bool
enabled = Bool
True
                                    }
                        Maybe Variant
Nothing -> do
                            -- Does not have overrides
                            let maybeStickiness :: Maybe FeatureToggleName
maybeStickiness = (FeatureToggleName -> Bool)
-> [FeatureToggleName] -> Maybe FeatureToggleName
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (FeatureToggleName
"default" FeatureToggleName -> FeatureToggleName -> Bool
forall a. Eq a => a -> a -> Bool
/=) ([FeatureToggleName] -> Maybe FeatureToggleName)
-> ([Maybe FeatureToggleName] -> [FeatureToggleName])
-> [Maybe FeatureToggleName]
-> Maybe FeatureToggleName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe FeatureToggleName] -> [FeatureToggleName]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe FeatureToggleName] -> Maybe FeatureToggleName)
-> [Maybe FeatureToggleName] -> Maybe FeatureToggleName
forall a b. (a -> b) -> a -> b
$ (.stickiness) <$> variants
                            case Maybe FeatureToggleName
maybeStickiness of
                                Just FeatureToggleName
stickiness -> do
                                    -- Has non-default stickiness
                                    let identifier :: Maybe FeatureToggleName
identifier = FeatureToggleName -> Context -> Maybe FeatureToggleName
lookupContextValue FeatureToggleName
stickiness Context
ctx
                                    [Variant]
-> Maybe FeatureToggleName
-> FeatureToggleName
-> m VariantResponse
forall (m :: * -> *).
MonadIO m =>
[Variant]
-> Maybe FeatureToggleName
-> FeatureToggleName
-> m VariantResponse
selectVariant [Variant]
variants Maybe FeatureToggleName
identifier jsonFeature.name
                                Maybe FeatureToggleName
Nothing -> do
                                    -- Default stickiness
                                    let identifier :: Maybe FeatureToggleName
identifier = ctx.userId <|> ctx.sessionId <|> ctx.remoteAddress
                                    [Variant]
-> Maybe FeatureToggleName
-> FeatureToggleName
-> m VariantResponse
forall (m :: * -> *).
MonadIO m =>
[Variant]
-> Maybe FeatureToggleName
-> FeatureToggleName
-> m VariantResponse
selectVariant [Variant]
variants Maybe FeatureToggleName
identifier 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)
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 (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FeatureToggleName
-> Map Int [Constraint] -> Strategy -> Context -> m Bool
forall (m :: * -> *).
MonadIO m =>
FeatureToggleName
-> Map Int [Constraint] -> Strategy -> Context -> m Bool
fromJsonStrategy jsonFeature.name segmentMap) 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.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 ->
                                FeatureToggleName -> Context -> Maybe FeatureToggleName
lookupContextValue override.contextName ctx `elem` (Just <$> override.values)
                            )
                            [Override]
overrides
                )
                [Variant]
variants

        selectVariant :: MonadIO m => [Variant] -> Maybe Text -> Text -> m VariantResponse
        selectVariant :: forall (m :: * -> *).
MonadIO m =>
[Variant]
-> Maybe FeatureToggleName
-> FeatureToggleName
-> m VariantResponse
selectVariant [Variant]
variants Maybe FeatureToggleName
maybeIdentifier FeatureToggleName
featureName = do
            FeatureToggleName
randomValue <- m FeatureToggleName
forall (m :: * -> *). MonadIO m => m FeatureToggleName
generateRandomText
            let identifier :: FeatureToggleName
identifier = FeatureToggleName -> Maybe FeatureToggleName -> FeatureToggleName
forall a. a -> Maybe a -> a
fromMaybe FeatureToggleName
randomValue Maybe FeatureToggleName
maybeIdentifier
                weights :: [Int]
weights = (.weight) <$> variants
                hashed :: Int
hashed = FeatureToggleName -> FeatureToggleName -> Word32 -> Int
getNormalizedNumberN FeatureToggleName
identifier FeatureToggleName
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 (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Int]
weights)
                accumulated :: [Int]
accumulated = [Int] -> [Int]
forall a. [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 (f :: * -> *) a. Applicative f => a -> f a
pure VariantResponse
emptyVariantResponse
                    Just Variant
variant ->
                        VariantResponse -> m VariantResponse
forall (f :: * -> *) a. Applicative f => a -> f a
pure (VariantResponse -> m VariantResponse)
-> VariantResponse -> m VariantResponse
forall a b. (a -> b) -> a -> b
$
                            VariantResponse :: FeatureToggleName -> Maybe Payload -> Bool -> VariantResponse
VariantResponse
                                { $sel:name:VariantResponse :: FeatureToggleName
name = variant.name,
                                  $sel:payload:VariantResponse :: Maybe Payload
payload = 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 =>
FeatureToggleName
-> Map Int [Constraint] -> Strategy -> Context -> m Bool
fromJsonStrategy FeatureToggleName
featureToggleName Map Int [Constraint]
segmentMap Strategy
jsonStrategy =
    \Context
ctx -> (Bool -> Bool -> Bool) -> m Bool -> m Bool -> m Bool
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Bool -> Bool -> Bool
(&&) (Context -> m Bool
forall (m :: * -> *). MonadIO m => Context -> m Bool
strategyFunction Context
ctx) (Context -> m Bool
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 jsonStrategy.name of
                FeatureToggleName
"default" -> Bool -> m Bool
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
                FeatureToggleName
"userWithId" ->
                    Bool -> m Bool
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 FeatureToggleName FeatureToggleName -> Bool
strategy Map FeatureToggleName FeatureToggleName
params =
                                let userIds :: [FeatureToggleName]
userIds = [FeatureToggleName]
-> (FeatureToggleName -> [FeatureToggleName])
-> Maybe FeatureToggleName
-> [FeatureToggleName]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (FeatureToggleName -> FeatureToggleName -> [FeatureToggleName]
Text.splitOn FeatureToggleName
", ") (FeatureToggleName
-> Map FeatureToggleName FeatureToggleName
-> Maybe FeatureToggleName
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup FeatureToggleName
"userIds" Map FeatureToggleName FeatureToggleName
params)
                                 in ctx.userId `elem` (Just <$> userIds)
                         in (Map FeatureToggleName FeatureToggleName -> Bool)
-> Maybe (Map FeatureToggleName FeatureToggleName) -> Bool
forall a. (a -> Bool) -> Maybe a -> Bool
evaluateStrategy Map FeatureToggleName FeatureToggleName -> Bool
strategy jsonStrategy.parameters
                FeatureToggleName
"gradualRolloutUserId" ->
                    Bool -> m Bool
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 ctx.userId of
                            Maybe FeatureToggleName
Nothing -> Bool
False
                            Just FeatureToggleName
userId ->
                                (Map FeatureToggleName FeatureToggleName -> Bool)
-> Maybe (Map FeatureToggleName FeatureToggleName) -> Bool
forall a. (a -> Bool) -> Maybe a -> Bool
evaluateStrategy Map FeatureToggleName FeatureToggleName -> Bool
strategy jsonStrategy.parameters
                                where
                                    strategy :: Map FeatureToggleName FeatureToggleName -> Bool
strategy Map FeatureToggleName FeatureToggleName
params =
                                        let percentage :: Int
percentage = FeatureToggleName -> Map FeatureToggleName FeatureToggleName -> Int
getInt FeatureToggleName
"percentage" Map FeatureToggleName FeatureToggleName
params
                                            groupId :: FeatureToggleName
groupId = FeatureToggleName -> Maybe FeatureToggleName -> FeatureToggleName
forall a. a -> Maybe a -> a
fromMaybe FeatureToggleName
featureToggleName (Maybe FeatureToggleName -> FeatureToggleName)
-> Maybe FeatureToggleName -> FeatureToggleName
forall a b. (a -> b) -> a -> b
$ FeatureToggleName
-> Map FeatureToggleName FeatureToggleName
-> Maybe FeatureToggleName
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup FeatureToggleName
"groupId" Map FeatureToggleName FeatureToggleName
params
                                            normValue :: Int
normValue = FeatureToggleName -> FeatureToggleName -> Int
getNormalizedNumber FeatureToggleName
userId FeatureToggleName
groupId
                                         in Int
normValue Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
percentage
                FeatureToggleName
"gradualRolloutSessionId" ->
                    Bool -> m Bool
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 ctx.sessionId of
                            Maybe FeatureToggleName
Nothing -> Bool
False
                            Just FeatureToggleName
sessionId ->
                                (Map FeatureToggleName FeatureToggleName -> Bool)
-> Maybe (Map FeatureToggleName FeatureToggleName) -> Bool
forall a. (a -> Bool) -> Maybe a -> Bool
evaluateStrategy Map FeatureToggleName FeatureToggleName -> Bool
strategy jsonStrategy.parameters
                                where
                                    strategy :: Map FeatureToggleName FeatureToggleName -> Bool
strategy Map FeatureToggleName FeatureToggleName
params =
                                        let percentage :: Int
percentage = FeatureToggleName -> Map FeatureToggleName FeatureToggleName -> Int
getInt FeatureToggleName
"percentage" Map FeatureToggleName FeatureToggleName
params
                                            groupId :: FeatureToggleName
groupId = FeatureToggleName -> Maybe FeatureToggleName -> FeatureToggleName
forall a. a -> Maybe a -> a
fromMaybe FeatureToggleName
featureToggleName (Maybe FeatureToggleName -> FeatureToggleName)
-> Maybe FeatureToggleName -> FeatureToggleName
forall a b. (a -> b) -> a -> b
$ FeatureToggleName
-> Map FeatureToggleName FeatureToggleName
-> Maybe FeatureToggleName
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup FeatureToggleName
"groupId" Map FeatureToggleName FeatureToggleName
params
                                            normValue :: Int
normValue = FeatureToggleName -> FeatureToggleName -> Int
getNormalizedNumber FeatureToggleName
sessionId FeatureToggleName
groupId
                                         in Int
normValue Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
percentage
                FeatureToggleName
"gradualRolloutRandom" -> \Context
_ctx -> do
                    case jsonStrategy.parameters of
                        Maybe (Map FeatureToggleName FeatureToggleName)
Nothing -> Bool -> m Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
                        Just Map FeatureToggleName FeatureToggleName
params -> do
                            let percentage :: Int
percentage = FeatureToggleName -> Map FeatureToggleName FeatureToggleName -> Int
getInt FeatureToggleName
"percentage" Map FeatureToggleName FeatureToggleName
params
                            Int
num <- forall a (m :: * -> *). (Random a, MonadIO m) => (a, a) -> m a
randomRIO @Int (Int
1, Int
100)
                            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
$ Int
percentage Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
num
                FeatureToggleName
"remoteAddress" ->
                    Bool -> m Bool
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 FeatureToggleName FeatureToggleName -> Bool
strategy Map FeatureToggleName FeatureToggleName
params =
                                let remoteAddresses :: [FeatureToggleName]
remoteAddresses = [FeatureToggleName]
-> (FeatureToggleName -> [FeatureToggleName])
-> Maybe FeatureToggleName
-> [FeatureToggleName]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (FeatureToggleName -> FeatureToggleName -> [FeatureToggleName]
Text.splitOn FeatureToggleName
", ") (FeatureToggleName
-> Map FeatureToggleName FeatureToggleName
-> Maybe FeatureToggleName
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup FeatureToggleName
"IPs" Map FeatureToggleName FeatureToggleName
params)
                                 in ctx.remoteAddress `elem` (Just <$> remoteAddresses)
                         in (Map FeatureToggleName FeatureToggleName -> Bool)
-> Maybe (Map FeatureToggleName FeatureToggleName) -> Bool
forall a. (a -> Bool) -> Maybe a -> Bool
evaluateStrategy Map FeatureToggleName FeatureToggleName -> Bool
strategy jsonStrategy.parameters
                FeatureToggleName
"flexibleRollout" -> \Context
ctx -> do
                    FeatureToggleName
randomValue <- m FeatureToggleName
forall (m :: * -> *). MonadIO m => m FeatureToggleName
generateRandomText
                    let strategy :: Map FeatureToggleName FeatureToggleName -> Bool
strategy Map FeatureToggleName FeatureToggleName
params =
                            let rollout :: Int
rollout = FeatureToggleName -> Map FeatureToggleName FeatureToggleName -> Int
getInt FeatureToggleName
"rollout" Map FeatureToggleName FeatureToggleName
params
                                stickiness :: FeatureToggleName
stickiness = FeatureToggleName -> Maybe FeatureToggleName -> FeatureToggleName
forall a. a -> Maybe a -> a
fromMaybe FeatureToggleName
"default" (Maybe FeatureToggleName -> FeatureToggleName)
-> Maybe FeatureToggleName -> FeatureToggleName
forall a b. (a -> b) -> a -> b
$ FeatureToggleName
-> Map FeatureToggleName FeatureToggleName
-> Maybe FeatureToggleName
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup FeatureToggleName
"stickiness" Map FeatureToggleName FeatureToggleName
params
                                groupId :: FeatureToggleName
groupId = FeatureToggleName -> Maybe FeatureToggleName -> FeatureToggleName
forall a. a -> Maybe a -> a
fromMaybe FeatureToggleName
featureToggleName (Maybe FeatureToggleName -> FeatureToggleName)
-> Maybe FeatureToggleName -> FeatureToggleName
forall a b. (a -> b) -> a -> b
$ FeatureToggleName
-> Map FeatureToggleName FeatureToggleName
-> Maybe FeatureToggleName
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup FeatureToggleName
"groupId" Map FeatureToggleName FeatureToggleName
params
                             in case FeatureToggleName
stickiness of
                                    FeatureToggleName
"default" ->
                                        Int
normalizedNumber Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
rollout
                                        where
                                            identifier :: FeatureToggleName
identifier = FeatureToggleName -> Maybe FeatureToggleName -> FeatureToggleName
forall a. a -> Maybe a -> a
fromMaybe FeatureToggleName
randomValue (ctx.userId <|> ctx.sessionId <|> ctx.remoteAddress)
                                            normalizedNumber :: Int
normalizedNumber = FeatureToggleName -> FeatureToggleName -> Int
getNormalizedNumber FeatureToggleName
identifier FeatureToggleName
groupId
                                    FeatureToggleName
"userId" ->
                                        case ctx.userId of
                                            Maybe FeatureToggleName
Nothing -> Bool
False
                                            Just FeatureToggleName
userId -> FeatureToggleName -> FeatureToggleName -> Int
getNormalizedNumber FeatureToggleName
userId FeatureToggleName
groupId Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
rollout
                                    FeatureToggleName
"sessionId" ->
                                        case ctx.sessionId of
                                            Maybe FeatureToggleName
Nothing -> Bool
False
                                            Just FeatureToggleName
sessionId -> FeatureToggleName -> FeatureToggleName -> Int
getNormalizedNumber FeatureToggleName
sessionId FeatureToggleName
groupId Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
rollout
                                    FeatureToggleName
customField ->
                                        case FeatureToggleName -> Context -> Maybe FeatureToggleName
lookupContextValue FeatureToggleName
customField Context
ctx of
                                            Maybe FeatureToggleName
Nothing -> Bool
False
                                            Just FeatureToggleName
customValue ->
                                                FeatureToggleName -> FeatureToggleName -> Int
getNormalizedNumber FeatureToggleName
customValue FeatureToggleName
groupId Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
rollout
                     in 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
$ (Map FeatureToggleName FeatureToggleName -> Bool)
-> Maybe (Map FeatureToggleName FeatureToggleName) -> Bool
forall a. (a -> Bool) -> Maybe a -> Bool
evaluateStrategy Map FeatureToggleName FeatureToggleName -> Bool
strategy jsonStrategy.parameters
                -- Unknown strategy
                FeatureToggleName
_ -> Bool -> m Bool
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

        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)
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 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 [] 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 (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 (t :: * -> *) a. Foldable t => t a -> Bool
null [Context -> Bool]
allPredicates
            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
$ 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 :: [FeatureToggleName]
constraintValues =
            if Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False constraint.caseInsensitive
                then FeatureToggleName -> FeatureToggleName
Text.toLower (FeatureToggleName -> FeatureToggleName)
-> [FeatureToggleName] -> [FeatureToggleName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [FeatureToggleName]
-> Maybe [FeatureToggleName] -> [FeatureToggleName]
forall a. a -> Maybe a -> a
fromMaybe [] constraint.values
                else [FeatureToggleName]
-> Maybe [FeatureToggleName] -> [FeatureToggleName]
forall a. a -> Maybe a -> a
fromMaybe [] constraint.values

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

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

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

lookupContextValue :: Text -> JsonTypes.Context -> Maybe Text
lookupContextValue :: FeatureToggleName -> Context -> Maybe FeatureToggleName
lookupContextValue FeatureToggleName
key Context
ctx =
    case FeatureToggleName
key of
        FeatureToggleName
"appName" -> ctx.appName
        FeatureToggleName
"currentTime" -> ctx.currentTime
        FeatureToggleName
"environment" -> ctx.environment
        FeatureToggleName
"remoteAddress" -> ctx.remoteAddress
        FeatureToggleName
"sessionId" -> ctx.sessionId
        FeatureToggleName
"userId" -> ctx.userId
        FeatureToggleName
propertiesKey -> do
            Map FeatureToggleName (Maybe FeatureToggleName)
m <- ctx.properties
            Maybe FeatureToggleName
value <- FeatureToggleName
-> Map FeatureToggleName (Maybe FeatureToggleName)
-> Maybe (Maybe FeatureToggleName)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup FeatureToggleName
propertiesKey Map FeatureToggleName (Maybe FeatureToggleName)
m
            Maybe FeatureToggleName
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 (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 FeatureToggleName -> [FeatureToggleName] -> Bool
startsWithAnyOf Maybe FeatureToggleName
mCurrentValue [FeatureToggleName]
values = do
    case Maybe FeatureToggleName
mCurrentValue of
        Maybe FeatureToggleName
Nothing -> Bool
False
        Just FeatureToggleName
currentValue -> (FeatureToggleName -> Bool) -> [FeatureToggleName] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (FeatureToggleName -> FeatureToggleName -> Bool
`Text.isPrefixOf` FeatureToggleName
currentValue) [FeatureToggleName]
values

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

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

getNormalizedNumberN :: Text -> Text -> Word32 -> Int
getNormalizedNumberN :: FeatureToggleName -> FeatureToggleName -> Word32 -> Int
getNormalizedNumberN FeatureToggleName
identifier FeatureToggleName
groupId Word32
n = do
    let s :: FeatureToggleName
s = FeatureToggleName
groupId FeatureToggleName -> FeatureToggleName -> FeatureToggleName
forall a. Semigroup a => a -> a -> a
<> FeatureToggleName
":" FeatureToggleName -> FeatureToggleName -> FeatureToggleName
forall a. Semigroup a => a -> a -> a
<> FeatureToggleName
identifier
    let Word32
hash :: Word32 = Word32 -> ByteString -> Word32
murmur3 (Word32
0 :: Word32) (ByteString -> Word32) -> ByteString -> Word32
forall a b. (a -> b) -> a -> b
$ FeatureToggleName -> ByteString
encodeUtf8 FeatureToggleName
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 :: FeatureToggleName -> FeatureToggleName -> Int
getNormalizedNumber FeatureToggleName
identifier FeatureToggleName
groupId = FeatureToggleName -> FeatureToggleName -> Word32 -> Int
getNormalizedNumberN FeatureToggleName
identifier FeatureToggleName
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 -> FeatureToggleName -> Context -> m Bool
featureIsEnabled Features
state FeatureToggleName
toggleName Context
ctx = do
    let Maybe Feature
mToggle :: Maybe Feature = FeatureToggleName -> Features -> Maybe Feature
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup FeatureToggleName
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 (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False

getInt :: Text -> Parameters -> Int
getInt :: FeatureToggleName -> Map FeatureToggleName FeatureToggleName -> Int
getInt FeatureToggleName
key Map FeatureToggleName FeatureToggleName
params = String -> Int
forall a. Read a => String -> a
read (String -> Int)
-> (FeatureToggleName -> String) -> FeatureToggleName -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FeatureToggleName -> String
Text.unpack (FeatureToggleName -> Int) -> FeatureToggleName -> Int
forall a b. (a -> b) -> a -> b
$ FeatureToggleName -> Maybe FeatureToggleName -> FeatureToggleName
forall a. a -> Maybe a -> a
fromMaybe FeatureToggleName
"0" (FeatureToggleName
-> Map FeatureToggleName FeatureToggleName
-> Maybe FeatureToggleName
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup FeatureToggleName
key Map FeatureToggleName FeatureToggleName
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 -> FeatureToggleName -> Context -> m VariantResponse
featureGetVariant Features
state FeatureToggleName
toggleName Context
ctx = do
    let Maybe Feature
mToggle :: Maybe Feature = FeatureToggleName -> Features -> Maybe Feature
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup FeatureToggleName
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 (f :: * -> *) a. Applicative f => a -> f a
pure VariantResponse
emptyVariantResponse