unleash-client-haskell-core 0.10.0 → 0.11.0

raw patch · 6 files changed

+159/−108 lines, 6 filesdep ~basePVP ok

version bump matches the API change (PVP)

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• CHANGELOG.md +12/−0
• src/Unleash.hs +27/−4
• src/Unleash/Internal/DomainTypes.hs +108/−98
• src/Unleash/Internal/JsonTypes.hs +7/−1
• test/UnleashSpecificationSpec.hs +2/−2
• unleash-client-haskell-core.cabal +3/−3

@@ -1,3 +1,15 @@+## <small>0.11.0 (2024-06-24)</small>++* Handle strategy parameter lists without spaces between values ([88aeb01](https://github.com/finn-no/unleash-client-haskell-core/commit/88aeb01))+* Pass strategy function ([ffeb9c4](https://github.com/finn-no/unleash-client-haskell-core/commit/ffeb9c4))+* Refactor Cabal file ([292ce80](https://github.com/finn-no/unleash-client-haskell-core/commit/292ce80))+* Reformat ([8ce5184](https://github.com/finn-no/unleash-client-haskell-core/commit/8ce5184))+* Reformat flake.nix ([218de71](https://github.com/finn-no/unleash-client-haskell-core/commit/218de71))+* Reformat Nix ([d8555ba](https://github.com/finn-no/unleash-client-haskell-core/commit/d8555ba))+* Update nixpkgs ([a15f64a](https://github.com/finn-no/unleash-client-haskell-core/commit/a15f64a))+++ ## <small>0.10.0 (2023-10-16)</small>  * Add homepage ([bc2e162](https://github.com/finn-no/unleash-client-haskell-core/commit/bc2e162))

@@ -7,16 +7,39 @@ Functions and types for checking feature toggles and variants. -} module Unleash (-    Features,     Context (..),+    defaultStrategyEvaluator,+    defaultSupportedStrategies,     emptyContext,     emptyVariantResponse,-    featureIsEnabled,     featureGetVariant,+    featureIsEnabled,+    Features,+    FeatureToggleName,     MetricsPayload (..),     RegisterPayload (..),+    Strategy (..),+    StrategyEvaluator,+    SupportedStrategies,     VariantResponse (..), ) where -import Unleash.Internal.DomainTypes (Features, featureGetVariant, featureIsEnabled)-import Unleash.Internal.JsonTypes (Context (..), MetricsPayload (..), RegisterPayload (..), VariantResponse (..), emptyContext, emptyVariantResponse)+import Unleash.Internal.DomainTypes (+    FeatureToggleName,+    Features,+    StrategyEvaluator,+    defaultStrategyEvaluator,+    defaultSupportedStrategies,+    featureGetVariant,+    featureIsEnabled,+ )+import Unleash.Internal.JsonTypes (+    Context (..),+    MetricsPayload (..),+    RegisterPayload (..),+    Strategy (..),+    SupportedStrategies,+    VariantResponse (..),+    emptyContext,+    emptyVariantResponse,+ )

@@ -7,16 +7,19 @@ Domain types and evaluation functions. -} module Unleash.Internal.DomainTypes (+    defaultStrategyEvaluator,+    defaultSupportedStrategies,     featureGetVariant,     featureIsEnabled,     fromJsonFeatures,-    supportedStrategies,     Feature (..),     Features,     FeatureToggleName,     GetVariant (..),     IsEnabled (..),+    StrategyEvaluator, ) where+ import Control.Applicative (liftA2, (<|>)) import Control.Monad.IO.Class (MonadIO) import Data.Hash.Murmur (murmur3)@@ -35,9 +38,12 @@ import Unleash.Internal.Predicates (datePredicate, numPredicate, semVerPredicate)  -- | A list of currently supported strategies for this library.-supportedStrategies :: [Text]-supportedStrategies = ["default", "userWithId", "gradualRolloutUserId", "gradualRolloutSessionId", "gradualRolloutRandom", "remoteAddress", "flexibleRollout"]+defaultSupportedStrategies :: JsonTypes.SupportedStrategies+defaultSupportedStrategies = ["default", "userWithId", "gradualRolloutUserId", "gradualRolloutSessionId", "gradualRolloutRandom", "remoteAddress", "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 @@ -48,10 +54,10 @@ type Parameters = Map Text FeatureToggleName  -- | Feature toggle state getter.-newtype IsEnabled = IsEnabled (forall m. MonadIO m => JsonTypes.Context -> m Bool)+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)+newtype GetVariant = GetVariant (forall m. (MonadIO m) => JsonTypes.Context -> m VariantResponse)  -- | Feature toggle. data Feature = Feature@@ -67,14 +73,14 @@      in fromList $ (\segment -> (segment.id, segment.constraints)) <$> segments  -- | Feature toggle set domain transfer object to domain type converter.-fromJsonFeatures :: JsonTypes.Features -> Features-fromJsonFeatures jsonFeatures = fromList $ fmap (fromJsonFeature (segmentMap jsonFeatures.segments)) jsonFeatures.features+fromJsonFeatures :: StrategyEvaluator -> JsonTypes.Features -> Features+fromJsonFeatures strategyEvaluator jsonFeatures = fromList $ fmap (fromJsonFeature strategyEvaluator (segmentMap jsonFeatures.segments)) jsonFeatures.features -generateRandomText :: MonadIO m => m Text+generateRandomText :: (MonadIO m) => m Text generateRandomText = showt <$> randomRIO @Int (0, 99999) -fromJsonFeature :: Map Int [JsonTypes.Constraint] -> JsonTypes.Feature -> (FeatureToggleName, Feature)-fromJsonFeature segmentMap jsonFeature =+fromJsonFeature :: StrategyEvaluator -> Map Int [JsonTypes.Constraint] -> JsonTypes.Feature -> (FeatureToggleName, Feature)+fromJsonFeature strategyEvaluator segmentMap jsonFeature =     ( jsonFeature.name,       Feature         { isEnabled = IsEnabled $ \ctx -> do@@ -109,12 +115,12 @@         }     )     where-        anyStrategyEnabled :: MonadIO m => JsonTypes.Context -> m Bool+        anyStrategyEnabled :: (MonadIO m) => JsonTypes.Context -> m Bool         anyStrategyEnabled ctx = or <$> traverse (\f -> f ctx) strategyPredicates -        strategyPredicates :: MonadIO m => [JsonTypes.Context -> m Bool]+        strategyPredicates :: (MonadIO m) => [JsonTypes.Context -> m Bool]         strategyPredicates =-            fmap (fromJsonStrategy jsonFeature.name segmentMap) jsonFeature.strategies+            fmap (fromJsonStrategy strategyEvaluator jsonFeature.name segmentMap) jsonFeature.strategies          enabledByOverride :: [Variant] -> JsonTypes.Context -> Maybe Variant         enabledByOverride variants ctx =@@ -130,7 +136,7 @@                 )                 variants -        selectVariant :: MonadIO m => [Variant] -> Maybe Text -> Text -> m VariantResponse+        selectVariant :: (MonadIO m) => [Variant] -> Maybe Text -> Text -> m VariantResponse         selectVariant variants maybeIdentifier featureName = do             randomValue <- generateRandomText             let identifier = fromMaybe randomValue maybeIdentifier@@ -149,91 +155,15 @@                                   enabled = True                                 } -fromJsonStrategy :: MonadIO m => FeatureToggleName -> Map Int [JsonTypes.Constraint] -> JsonTypes.Strategy -> (JsonTypes.Context -> m Bool)-fromJsonStrategy featureToggleName segmentMap jsonStrategy =-    \ctx -> liftA2 (&&) (strategyFunction ctx) (constraintsPredicate ctx)+fromJsonStrategy :: (MonadIO m) => StrategyEvaluator -> FeatureToggleName -> Map Int [JsonTypes.Constraint] -> JsonTypes.Strategy -> (JsonTypes.Context -> m Bool)+fromJsonStrategy strategyEvaluator featureToggleName segmentMap jsonStrategy =+    \ctx -> liftA2 (&&) (strategyEvaluator jsonStrategy featureToggleName ctx) (constraintsPredicate ctx)     where-        strategyFunction :: MonadIO m => JsonTypes.Context -> m Bool-        strategyFunction =-            case jsonStrategy.name of-                "default" -> pure . \_ctx -> True-                "userWithId" ->-                    pure . \ctx ->-                        let strategy params =-                                let userIds = maybe [] (Text.splitOn ", ") (Map.lookup "userIds" params)-                                 in ctx.userId `elem` (Just <$> userIds)-                         in evaluateStrategy strategy jsonStrategy.parameters-                "gradualRolloutUserId" ->-                    pure . \ctx ->-                        case ctx.userId of-                            Nothing -> False-                            Just userId ->-                                evaluateStrategy strategy jsonStrategy.parameters-                                where-                                    strategy params =-                                        let percentage = getInt "percentage" params-                                            groupId = fromMaybe featureToggleName $ Map.lookup "groupId" params-                                            normValue = getNormalizedNumber userId groupId-                                         in normValue <= percentage-                "gradualRolloutSessionId" ->-                    pure . \ctx ->-                        case ctx.sessionId of-                            Nothing -> False-                            Just sessionId ->-                                evaluateStrategy strategy jsonStrategy.parameters-                                where-                                    strategy params =-                                        let percentage = getInt "percentage" params-                                            groupId = fromMaybe featureToggleName $ Map.lookup "groupId" params-                                            normValue = getNormalizedNumber sessionId groupId-                                         in normValue <= percentage-                "gradualRolloutRandom" -> \_ctx -> do-                    case jsonStrategy.parameters of-                        Nothing -> pure False-                        Just params -> do-                            let percentage = getInt "percentage" params-                            num <- randomRIO @Int (1, 100)-                            pure $ percentage >= num-                "remoteAddress" ->-                    pure . \ctx ->-                        let strategy params =-                                let remoteAddresses = maybe [] (Text.splitOn ", ") (Map.lookup "IPs" params)-                                 in ctx.remoteAddress `elem` (Just <$> remoteAddresses)-                         in evaluateStrategy strategy jsonStrategy.parameters-                "flexibleRollout" -> \ctx -> do-                    randomValue <- generateRandomText-                    let strategy params =-                            let rollout = getInt "rollout" params-                                stickiness = fromMaybe "default" $ Map.lookup "stickiness" params-                                groupId = fromMaybe featureToggleName $ Map.lookup "groupId" params-                             in case stickiness of-                                    "default" ->-                                        normalizedNumber <= rollout-                                        where-                                            identifier = fromMaybe randomValue (ctx.userId <|> ctx.sessionId <|> ctx.remoteAddress)-                                            normalizedNumber = getNormalizedNumber identifier groupId-                                    "userId" ->-                                        case ctx.userId of-                                            Nothing -> False-                                            Just userId -> getNormalizedNumber userId groupId <= rollout-                                    "sessionId" ->-                                        case ctx.sessionId of-                                            Nothing -> False-                                            Just sessionId -> getNormalizedNumber sessionId groupId <= rollout-                                    customField ->-                                        case lookupContextValue customField ctx of-                                            Nothing -> False-                                            Just customValue ->-                                                getNormalizedNumber customValue groupId <= rollout-                     in pure $ evaluateStrategy strategy jsonStrategy.parameters-                -- Unknown strategy-                _ -> pure . \_ctx -> False-         segmentsToConstraints :: [Int] -> Map Int [JsonTypes.Constraint] -> [Maybe JsonTypes.Constraint]         segmentsToConstraints segmentReferences segmentMap =             concat $ sequence <$> ((flip Map.lookup) segmentMap <$> segmentReferences) -        constraintsPredicate :: MonadIO m => JsonTypes.Context -> m Bool+        constraintsPredicate :: (MonadIO m) => JsonTypes.Context -> m Bool         constraintsPredicate ctx = do             let segmentReferences = concat jsonStrategy.segments                 maybeSegmentConstraints = segmentsToConstraints segmentReferences segmentMap@@ -249,6 +179,86 @@                 evaluatePredicate :: (JsonTypes.Context -> Bool) -> Bool                 evaluatePredicate f = f ctx +-- | Implementation of default strategies.+defaultStrategyEvaluator :: StrategyEvaluator+defaultStrategyEvaluator jsonStrategy featureToggleName =+    case jsonStrategy.name of+        "default" -> pure . \_ctx -> True+        "userWithId" ->+            pure . \ctx ->+                let strategy params =+                        let userIds = maybe [] splitParams (Map.lookup "userIds" params)+                         in ctx.userId `elem` (Just <$> userIds)+                 in evaluateStrategy strategy jsonStrategy.parameters+        "gradualRolloutUserId" ->+            pure . \ctx ->+                case ctx.userId of+                    Nothing -> False+                    Just userId ->+                        evaluateStrategy strategy jsonStrategy.parameters+                        where+                            strategy params =+                                let percentage = getInt "percentage" params+                                    groupId = fromMaybe featureToggleName $ Map.lookup "groupId" params+                                    normValue = getNormalizedNumber userId groupId+                                 in normValue <= percentage+        "gradualRolloutSessionId" ->+            pure . \ctx ->+                case ctx.sessionId of+                    Nothing -> False+                    Just sessionId ->+                        evaluateStrategy strategy jsonStrategy.parameters+                        where+                            strategy params =+                                let percentage = getInt "percentage" params+                                    groupId = fromMaybe featureToggleName $ Map.lookup "groupId" params+                                    normValue = getNormalizedNumber sessionId groupId+                                 in normValue <= percentage+        "gradualRolloutRandom" -> \_ctx -> do+            case jsonStrategy.parameters of+                Nothing -> pure False+                Just params -> do+                    let percentage = getInt "percentage" params+                    num <- randomRIO @Int (1, 100)+                    pure $ percentage >= num+        "remoteAddress" ->+            pure . \ctx ->+                let strategy params =+                        let remoteAddresses = maybe [] splitParams (Map.lookup "IPs" params)+                         in ctx.remoteAddress `elem` (Just <$> remoteAddresses)+                 in evaluateStrategy strategy jsonStrategy.parameters+        "flexibleRollout" -> \ctx -> do+            randomValue <- generateRandomText+            let strategy params =+                    let rollout = getInt "rollout" params+                        stickiness = fromMaybe "default" $ Map.lookup "stickiness" params+                        groupId = fromMaybe featureToggleName $ Map.lookup "groupId" params+                     in case stickiness of+                            "default" ->+                                normalizedNumber <= rollout+                                where+                                    identifier = fromMaybe randomValue (ctx.userId <|> ctx.sessionId <|> ctx.remoteAddress)+                                    normalizedNumber = getNormalizedNumber identifier groupId+                            "userId" ->+                                case ctx.userId of+                                    Nothing -> False+                                    Just userId -> getNormalizedNumber userId groupId <= rollout+                            "sessionId" ->+                                case ctx.sessionId of+                                    Nothing -> False+                                    Just sessionId -> getNormalizedNumber sessionId groupId <= rollout+                            customField ->+                                case lookupContextValue customField ctx of+                                    Nothing -> False+                                    Just customValue ->+                                        getNormalizedNumber customValue groupId <= rollout+             in pure $ evaluateStrategy strategy jsonStrategy.parameters+        -- Unknown strategy+        _ -> pure . \_ctx -> False+    where+        splitParams :: Text -> [Text]+        splitParams = fmap Text.strip . Text.splitOn ","+ fromJsonConstraint :: JsonTypes.Constraint -> (JsonTypes.Context -> Bool) fromJsonConstraint constraint = \ctx -> do     let constraintValues =@@ -299,13 +309,13 @@             value <- Map.lookup propertiesKey m             value -isIn :: Eq a => Maybe a -> [a] -> Bool+isIn :: (Eq a) => Maybe a -> [a] -> Bool isIn mCurrentValue values =     case mCurrentValue of         Nothing -> False         Just currentValue -> currentValue `elem` values -isNotIn :: Eq a => Maybe a -> [a] -> Bool+isNotIn :: (Eq a) => Maybe a -> [a] -> Bool isNotIn mCurrentValue values = not $ isIn mCurrentValue values  startsWithAnyOf :: Maybe Text -> [Text] -> Bool@@ -338,7 +348,7 @@  -- | Check whether or not a feature toggle is enabled. featureIsEnabled ::-    MonadIO m =>+    (MonadIO m) =>     -- | Full set of features fetched from a server.     Features ->     -- | Feature toggle name (as it is represented on the server).@@ -361,7 +371,7 @@  -- | Get a variant for a given feature toggle. featureGetVariant ::-    MonadIO m =>+    (MonadIO m) =>     -- | Full set of features fetched from a server.     Features ->     -- | Feature toggle name (as it is represented on the server).

@@ -28,6 +28,7 @@     YesAndNoes (..),     FullRegisterPayload (..),     RegisterPayload (..),+    SupportedStrategies, ) where  import Data.Aeson (FromJSON, Options (..), ToJSON (toJSON), defaultOptions, genericParseJSON, genericToJSON)@@ -231,7 +232,7 @@       -- | Unleash client SDK version.       sdkVersion :: Text,       -- | Supported strategies.-      strategies :: [Text],+      strategies :: SupportedStrategies,       -- | When the application was started.       started :: UTCTime,       -- | Expected metrics sending interval.@@ -246,6 +247,8 @@       appName :: Text,       -- | Instance identifier (typically hostname).       instanceId :: Text,+      -- | Supported strategies.+      strategies :: SupportedStrategies,       -- | Client application startup timestamp.       started :: UTCTime,       -- | Intended metrics sending interval.@@ -253,3 +256,6 @@     }     deriving stock (Eq, Show, Generic)     deriving anyclass (ToJSON)++-- | Alias for a list of supported strategies.+type SupportedStrategies = [Text]

@@ -8,7 +8,7 @@ import Data.Foldable (traverse_) import Data.Maybe (fromMaybe) import Test.Hspec-import Unleash.Internal.DomainTypes (featureGetVariant, featureIsEnabled, fromJsonFeatures)+import Unleash.Internal.DomainTypes (defaultStrategyEvaluator, featureGetVariant, featureIsEnabled, fromJsonFeatures) import qualified UnleashSpecificationJsonTypes as JsonTypes  spec :: Spec@@ -24,7 +24,7 @@ runSpecification filePath = do     Right specification <- eitherDecodeFileStrict @JsonTypes.Specification filePath -    let state = fromJsonFeatures specification.state+    let state = fromJsonFeatures defaultStrategyEvaluator specification.state      let isEnabled' :: JsonTypes.Test -> Expectation         isEnabled' sut = do

@@ -1,7 +1,7 @@ cabal-version: 3.0  name: unleash-client-haskell-core-version: 0.10.0+version: 0.11.0 synopsis: Unleash feature toggle client core description:     This is a library for evaluating [Unleash](https://www.getunleash.io/) feature toggles.@@ -16,8 +16,6 @@ extra-source-files: README.md  common all-    build-depends:-        base >=4.7 && <5,     default-extensions:         BlockArguments         DeriveFoldable@@ -49,6 +47,7 @@     hs-source-dirs: src     build-depends:         aeson >= 2.0.3 && < 2.2,+        base >= 4.7 && < 5,         containers >= 0.6.4 && < 0.7,         random >= 1.2.1 && < 1.3,         text >= 1.2.5 && < 2.1,@@ -73,5 +72,6 @@         aeson-pretty >= 0.8.9 && < 0.9,         hspec >= 2.8.5 && < 2.11,         aeson,+        base,         text,         unleash-client-haskell-core,