{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
{-# OPTIONS_GHC -fno-warn-unused-matches #-}

-- Derived from AWS service descriptions, licensed under Apache 2.0.

-- |
-- Module      : Amazonka.Evidently.Types.Feature
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
module Amazonka.Evidently.Types.Feature where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.Evidently.Types.EvaluationRule
import Amazonka.Evidently.Types.FeatureEvaluationStrategy
import Amazonka.Evidently.Types.FeatureStatus
import Amazonka.Evidently.Types.Variation
import Amazonka.Evidently.Types.VariationValueType
import qualified Amazonka.Prelude as Prelude

-- | This structure contains information about one Evidently feature in your
-- account.
--
-- /See:/ 'newFeature' smart constructor.
data Feature = Feature'
  { -- | The name of the variation that is used as the default variation. The
    -- default variation is served to users who are not allocated to any
    -- ongoing launches or experiments of this feature.
    --
    -- This variation must also be listed in the @variations@ structure.
    --
    -- If you omit @defaultVariation@, the first variation listed in the
    -- @variations@ structure is used as the default variation.
    Feature -> Maybe Text
defaultVariation :: Prelude.Maybe Prelude.Text,
    -- | The description of the feature.
    Feature -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | A set of key-value pairs that specify users who should always be served
    -- a specific variation of a feature. Each key specifies a user using their
    -- user ID, account ID, or some other identifier. The value specifies the
    -- name of the variation that the user is to be served.
    --
    -- For the override to be successful, the value of the key must match the
    -- @entityId@ used in the
    -- <https://docs.aws.amazon.com/cloudwatchevidently/latest/APIReference/API_EvaluateFeature.html EvaluateFeature>
    -- operation.
    Feature -> Maybe (HashMap Text Text)
entityOverrides :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | An array of structures that define the evaluation rules for the feature.
    Feature -> Maybe [EvaluationRule]
evaluationRules :: Prelude.Maybe [EvaluationRule],
    -- | The name or ARN of the project that contains the feature.
    Feature -> Maybe Text
project :: Prelude.Maybe Prelude.Text,
    -- | The list of tag keys and values associated with this feature.
    Feature -> Maybe (HashMap Text Text)
tags :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | The ARN of the feature.
    Feature -> Text
arn :: Prelude.Text,
    -- | The date and time that the feature is created.
    Feature -> POSIX
createdTime :: Data.POSIX,
    -- | If this value is @ALL_RULES@, the traffic allocation specified by any
    -- ongoing launches or experiments is being used. If this is
    -- @DEFAULT_VARIATION@, the default variation is being served to all users.
    Feature -> FeatureEvaluationStrategy
evaluationStrategy :: FeatureEvaluationStrategy,
    -- | The date and time that the feature was most recently updated.
    Feature -> POSIX
lastUpdatedTime :: Data.POSIX,
    -- | The name of the feature.
    Feature -> Text
name :: Prelude.Text,
    -- | The current state of the feature.
    Feature -> FeatureStatus
status :: FeatureStatus,
    -- | Defines the type of value used to define the different feature
    -- variations. For more information, see
    -- <https://docs.aws.amazon.com/AmazonCloudWatch/latest/monitoring/CloudWatch-Evidently-variationtypes.html Variation types>
    Feature -> VariationValueType
valueType :: VariationValueType,
    -- | An array of structures that contain the configuration of the feature\'s
    -- different variations.
    Feature -> [Variation]
variations :: [Variation]
  }
  deriving (Feature -> Feature -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Feature -> Feature -> Bool
$c/= :: Feature -> Feature -> Bool
== :: Feature -> Feature -> Bool
$c== :: Feature -> Feature -> Bool
Prelude.Eq, ReadPrec [Feature]
ReadPrec Feature
Int -> ReadS Feature
ReadS [Feature]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Feature]
$creadListPrec :: ReadPrec [Feature]
readPrec :: ReadPrec Feature
$creadPrec :: ReadPrec Feature
readList :: ReadS [Feature]
$creadList :: ReadS [Feature]
readsPrec :: Int -> ReadS Feature
$creadsPrec :: Int -> ReadS Feature
Prelude.Read, Int -> Feature -> ShowS
[Feature] -> ShowS
Feature -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Feature] -> ShowS
$cshowList :: [Feature] -> ShowS
show :: Feature -> String
$cshow :: Feature -> String
showsPrec :: Int -> Feature -> ShowS
$cshowsPrec :: Int -> Feature -> ShowS
Prelude.Show, forall x. Rep Feature x -> Feature
forall x. Feature -> Rep Feature x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Feature x -> Feature
$cfrom :: forall x. Feature -> Rep Feature x
Prelude.Generic)

-- |
-- Create a value of 'Feature' with all optional fields omitted.
--
-- Use <https://hackage.haskell.org/package/generic-lens generic-lens> or <https://hackage.haskell.org/package/optics optics> to modify other optional fields.
--
-- The following record fields are available, with the corresponding lenses provided
-- for backwards compatibility:
--
-- 'defaultVariation', 'feature_defaultVariation' - The name of the variation that is used as the default variation. The
-- default variation is served to users who are not allocated to any
-- ongoing launches or experiments of this feature.
--
-- This variation must also be listed in the @variations@ structure.
--
-- If you omit @defaultVariation@, the first variation listed in the
-- @variations@ structure is used as the default variation.
--
-- 'description', 'feature_description' - The description of the feature.
--
-- 'entityOverrides', 'feature_entityOverrides' - A set of key-value pairs that specify users who should always be served
-- a specific variation of a feature. Each key specifies a user using their
-- user ID, account ID, or some other identifier. The value specifies the
-- name of the variation that the user is to be served.
--
-- For the override to be successful, the value of the key must match the
-- @entityId@ used in the
-- <https://docs.aws.amazon.com/cloudwatchevidently/latest/APIReference/API_EvaluateFeature.html EvaluateFeature>
-- operation.
--
-- 'evaluationRules', 'feature_evaluationRules' - An array of structures that define the evaluation rules for the feature.
--
-- 'project', 'feature_project' - The name or ARN of the project that contains the feature.
--
-- 'tags', 'feature_tags' - The list of tag keys and values associated with this feature.
--
-- 'arn', 'feature_arn' - The ARN of the feature.
--
-- 'createdTime', 'feature_createdTime' - The date and time that the feature is created.
--
-- 'evaluationStrategy', 'feature_evaluationStrategy' - If this value is @ALL_RULES@, the traffic allocation specified by any
-- ongoing launches or experiments is being used. If this is
-- @DEFAULT_VARIATION@, the default variation is being served to all users.
--
-- 'lastUpdatedTime', 'feature_lastUpdatedTime' - The date and time that the feature was most recently updated.
--
-- 'name', 'feature_name' - The name of the feature.
--
-- 'status', 'feature_status' - The current state of the feature.
--
-- 'valueType', 'feature_valueType' - Defines the type of value used to define the different feature
-- variations. For more information, see
-- <https://docs.aws.amazon.com/AmazonCloudWatch/latest/monitoring/CloudWatch-Evidently-variationtypes.html Variation types>
--
-- 'variations', 'feature_variations' - An array of structures that contain the configuration of the feature\'s
-- different variations.
newFeature ::
  -- | 'arn'
  Prelude.Text ->
  -- | 'createdTime'
  Prelude.UTCTime ->
  -- | 'evaluationStrategy'
  FeatureEvaluationStrategy ->
  -- | 'lastUpdatedTime'
  Prelude.UTCTime ->
  -- | 'name'
  Prelude.Text ->
  -- | 'status'
  FeatureStatus ->
  -- | 'valueType'
  VariationValueType ->
  Feature
newFeature :: Text
-> UTCTime
-> FeatureEvaluationStrategy
-> UTCTime
-> Text
-> FeatureStatus
-> VariationValueType
-> Feature
newFeature
  Text
pArn_
  UTCTime
pCreatedTime_
  FeatureEvaluationStrategy
pEvaluationStrategy_
  UTCTime
pLastUpdatedTime_
  Text
pName_
  FeatureStatus
pStatus_
  VariationValueType
pValueType_ =
    Feature'
      { $sel:defaultVariation:Feature' :: Maybe Text
defaultVariation = forall a. Maybe a
Prelude.Nothing,
        $sel:description:Feature' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
        $sel:entityOverrides:Feature' :: Maybe (HashMap Text Text)
entityOverrides = forall a. Maybe a
Prelude.Nothing,
        $sel:evaluationRules:Feature' :: Maybe [EvaluationRule]
evaluationRules = forall a. Maybe a
Prelude.Nothing,
        $sel:project:Feature' :: Maybe Text
project = forall a. Maybe a
Prelude.Nothing,
        $sel:tags:Feature' :: Maybe (HashMap Text Text)
tags = forall a. Maybe a
Prelude.Nothing,
        $sel:arn:Feature' :: Text
arn = Text
pArn_,
        $sel:createdTime:Feature' :: POSIX
createdTime = forall (a :: Format). Iso' (Time a) UTCTime
Data._Time forall t b. AReview t b -> b -> t
Lens.# UTCTime
pCreatedTime_,
        $sel:evaluationStrategy:Feature' :: FeatureEvaluationStrategy
evaluationStrategy = FeatureEvaluationStrategy
pEvaluationStrategy_,
        $sel:lastUpdatedTime:Feature' :: POSIX
lastUpdatedTime =
          forall (a :: Format). Iso' (Time a) UTCTime
Data._Time forall t b. AReview t b -> b -> t
Lens.# UTCTime
pLastUpdatedTime_,
        $sel:name:Feature' :: Text
name = Text
pName_,
        $sel:status:Feature' :: FeatureStatus
status = FeatureStatus
pStatus_,
        $sel:valueType:Feature' :: VariationValueType
valueType = VariationValueType
pValueType_,
        $sel:variations:Feature' :: [Variation]
variations = forall a. Monoid a => a
Prelude.mempty
      }

-- | The name of the variation that is used as the default variation. The
-- default variation is served to users who are not allocated to any
-- ongoing launches or experiments of this feature.
--
-- This variation must also be listed in the @variations@ structure.
--
-- If you omit @defaultVariation@, the first variation listed in the
-- @variations@ structure is used as the default variation.
feature_defaultVariation :: Lens.Lens' Feature (Prelude.Maybe Prelude.Text)
feature_defaultVariation :: Lens' Feature (Maybe Text)
feature_defaultVariation = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Feature' {Maybe Text
defaultVariation :: Maybe Text
$sel:defaultVariation:Feature' :: Feature -> Maybe Text
defaultVariation} -> Maybe Text
defaultVariation) (\s :: Feature
s@Feature' {} Maybe Text
a -> Feature
s {$sel:defaultVariation:Feature' :: Maybe Text
defaultVariation = Maybe Text
a} :: Feature)

-- | The description of the feature.
feature_description :: Lens.Lens' Feature (Prelude.Maybe Prelude.Text)
feature_description :: Lens' Feature (Maybe Text)
feature_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Feature' {Maybe Text
description :: Maybe Text
$sel:description:Feature' :: Feature -> Maybe Text
description} -> Maybe Text
description) (\s :: Feature
s@Feature' {} Maybe Text
a -> Feature
s {$sel:description:Feature' :: Maybe Text
description = Maybe Text
a} :: Feature)

-- | A set of key-value pairs that specify users who should always be served
-- a specific variation of a feature. Each key specifies a user using their
-- user ID, account ID, or some other identifier. The value specifies the
-- name of the variation that the user is to be served.
--
-- For the override to be successful, the value of the key must match the
-- @entityId@ used in the
-- <https://docs.aws.amazon.com/cloudwatchevidently/latest/APIReference/API_EvaluateFeature.html EvaluateFeature>
-- operation.
feature_entityOverrides :: Lens.Lens' Feature (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
feature_entityOverrides :: Lens' Feature (Maybe (HashMap Text Text))
feature_entityOverrides = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Feature' {Maybe (HashMap Text Text)
entityOverrides :: Maybe (HashMap Text Text)
$sel:entityOverrides:Feature' :: Feature -> Maybe (HashMap Text Text)
entityOverrides} -> Maybe (HashMap Text Text)
entityOverrides) (\s :: Feature
s@Feature' {} Maybe (HashMap Text Text)
a -> Feature
s {$sel:entityOverrides:Feature' :: Maybe (HashMap Text Text)
entityOverrides = Maybe (HashMap Text Text)
a} :: Feature) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | An array of structures that define the evaluation rules for the feature.
feature_evaluationRules :: Lens.Lens' Feature (Prelude.Maybe [EvaluationRule])
feature_evaluationRules :: Lens' Feature (Maybe [EvaluationRule])
feature_evaluationRules = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Feature' {Maybe [EvaluationRule]
evaluationRules :: Maybe [EvaluationRule]
$sel:evaluationRules:Feature' :: Feature -> Maybe [EvaluationRule]
evaluationRules} -> Maybe [EvaluationRule]
evaluationRules) (\s :: Feature
s@Feature' {} Maybe [EvaluationRule]
a -> Feature
s {$sel:evaluationRules:Feature' :: Maybe [EvaluationRule]
evaluationRules = Maybe [EvaluationRule]
a} :: Feature) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | The name or ARN of the project that contains the feature.
feature_project :: Lens.Lens' Feature (Prelude.Maybe Prelude.Text)
feature_project :: Lens' Feature (Maybe Text)
feature_project = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Feature' {Maybe Text
project :: Maybe Text
$sel:project:Feature' :: Feature -> Maybe Text
project} -> Maybe Text
project) (\s :: Feature
s@Feature' {} Maybe Text
a -> Feature
s {$sel:project:Feature' :: Maybe Text
project = Maybe Text
a} :: Feature)

-- | The list of tag keys and values associated with this feature.
feature_tags :: Lens.Lens' Feature (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
feature_tags :: Lens' Feature (Maybe (HashMap Text Text))
feature_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Feature' {Maybe (HashMap Text Text)
tags :: Maybe (HashMap Text Text)
$sel:tags:Feature' :: Feature -> Maybe (HashMap Text Text)
tags} -> Maybe (HashMap Text Text)
tags) (\s :: Feature
s@Feature' {} Maybe (HashMap Text Text)
a -> Feature
s {$sel:tags:Feature' :: Maybe (HashMap Text Text)
tags = Maybe (HashMap Text Text)
a} :: Feature) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | The ARN of the feature.
feature_arn :: Lens.Lens' Feature Prelude.Text
feature_arn :: Lens' Feature Text
feature_arn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Feature' {Text
arn :: Text
$sel:arn:Feature' :: Feature -> Text
arn} -> Text
arn) (\s :: Feature
s@Feature' {} Text
a -> Feature
s {$sel:arn:Feature' :: Text
arn = Text
a} :: Feature)

-- | The date and time that the feature is created.
feature_createdTime :: Lens.Lens' Feature Prelude.UTCTime
feature_createdTime :: Lens' Feature UTCTime
feature_createdTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Feature' {POSIX
createdTime :: POSIX
$sel:createdTime:Feature' :: Feature -> POSIX
createdTime} -> POSIX
createdTime) (\s :: Feature
s@Feature' {} POSIX
a -> Feature
s {$sel:createdTime:Feature' :: POSIX
createdTime = POSIX
a} :: Feature) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | If this value is @ALL_RULES@, the traffic allocation specified by any
-- ongoing launches or experiments is being used. If this is
-- @DEFAULT_VARIATION@, the default variation is being served to all users.
feature_evaluationStrategy :: Lens.Lens' Feature FeatureEvaluationStrategy
feature_evaluationStrategy :: Lens' Feature FeatureEvaluationStrategy
feature_evaluationStrategy = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Feature' {FeatureEvaluationStrategy
evaluationStrategy :: FeatureEvaluationStrategy
$sel:evaluationStrategy:Feature' :: Feature -> FeatureEvaluationStrategy
evaluationStrategy} -> FeatureEvaluationStrategy
evaluationStrategy) (\s :: Feature
s@Feature' {} FeatureEvaluationStrategy
a -> Feature
s {$sel:evaluationStrategy:Feature' :: FeatureEvaluationStrategy
evaluationStrategy = FeatureEvaluationStrategy
a} :: Feature)

-- | The date and time that the feature was most recently updated.
feature_lastUpdatedTime :: Lens.Lens' Feature Prelude.UTCTime
feature_lastUpdatedTime :: Lens' Feature UTCTime
feature_lastUpdatedTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Feature' {POSIX
lastUpdatedTime :: POSIX
$sel:lastUpdatedTime:Feature' :: Feature -> POSIX
lastUpdatedTime} -> POSIX
lastUpdatedTime) (\s :: Feature
s@Feature' {} POSIX
a -> Feature
s {$sel:lastUpdatedTime:Feature' :: POSIX
lastUpdatedTime = POSIX
a} :: Feature) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The name of the feature.
feature_name :: Lens.Lens' Feature Prelude.Text
feature_name :: Lens' Feature Text
feature_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Feature' {Text
name :: Text
$sel:name:Feature' :: Feature -> Text
name} -> Text
name) (\s :: Feature
s@Feature' {} Text
a -> Feature
s {$sel:name:Feature' :: Text
name = Text
a} :: Feature)

-- | The current state of the feature.
feature_status :: Lens.Lens' Feature FeatureStatus
feature_status :: Lens' Feature FeatureStatus
feature_status = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Feature' {FeatureStatus
status :: FeatureStatus
$sel:status:Feature' :: Feature -> FeatureStatus
status} -> FeatureStatus
status) (\s :: Feature
s@Feature' {} FeatureStatus
a -> Feature
s {$sel:status:Feature' :: FeatureStatus
status = FeatureStatus
a} :: Feature)

-- | Defines the type of value used to define the different feature
-- variations. For more information, see
-- <https://docs.aws.amazon.com/AmazonCloudWatch/latest/monitoring/CloudWatch-Evidently-variationtypes.html Variation types>
feature_valueType :: Lens.Lens' Feature VariationValueType
feature_valueType :: Lens' Feature VariationValueType
feature_valueType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Feature' {VariationValueType
valueType :: VariationValueType
$sel:valueType:Feature' :: Feature -> VariationValueType
valueType} -> VariationValueType
valueType) (\s :: Feature
s@Feature' {} VariationValueType
a -> Feature
s {$sel:valueType:Feature' :: VariationValueType
valueType = VariationValueType
a} :: Feature)

-- | An array of structures that contain the configuration of the feature\'s
-- different variations.
feature_variations :: Lens.Lens' Feature [Variation]
feature_variations :: Lens' Feature [Variation]
feature_variations = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Feature' {[Variation]
variations :: [Variation]
$sel:variations:Feature' :: Feature -> [Variation]
variations} -> [Variation]
variations) (\s :: Feature
s@Feature' {} [Variation]
a -> Feature
s {$sel:variations:Feature' :: [Variation]
variations = [Variation]
a} :: Feature) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

instance Data.FromJSON Feature where
  parseJSON :: Value -> Parser Feature
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"Feature"
      ( \Object
x ->
          Maybe Text
-> Maybe Text
-> Maybe (HashMap Text Text)
-> Maybe [EvaluationRule]
-> Maybe Text
-> Maybe (HashMap Text Text)
-> Text
-> POSIX
-> FeatureEvaluationStrategy
-> POSIX
-> Text
-> FeatureStatus
-> VariationValueType
-> [Variation]
-> Feature
Feature'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"defaultVariation")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"description")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ( Object
x
                            forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"entityOverrides"
                            forall a. Parser (Maybe a) -> a -> Parser a
Data..!= forall a. Monoid a => a
Prelude.mempty
                        )
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ( Object
x
                            forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"evaluationRules"
                            forall a. Parser (Maybe a) -> a -> Parser a
Data..!= forall a. Monoid a => a
Prelude.mempty
                        )
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"project")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"tags" forall a. Parser (Maybe a) -> a -> Parser a
Data..!= forall a. Monoid a => a
Prelude.mempty)
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser a
Data..: Key
"arn")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser a
Data..: Key
"createdTime")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser a
Data..: Key
"evaluationStrategy")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser a
Data..: Key
"lastUpdatedTime")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser a
Data..: Key
"name")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser a
Data..: Key
"status")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser a
Data..: Key
"valueType")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"variations" forall a. Parser (Maybe a) -> a -> Parser a
Data..!= forall a. Monoid a => a
Prelude.mempty)
      )

instance Prelude.Hashable Feature where
  hashWithSalt :: Int -> Feature -> Int
hashWithSalt Int
_salt Feature' {[Variation]
Maybe [EvaluationRule]
Maybe Text
Maybe (HashMap Text Text)
Text
POSIX
FeatureEvaluationStrategy
FeatureStatus
VariationValueType
variations :: [Variation]
valueType :: VariationValueType
status :: FeatureStatus
name :: Text
lastUpdatedTime :: POSIX
evaluationStrategy :: FeatureEvaluationStrategy
createdTime :: POSIX
arn :: Text
tags :: Maybe (HashMap Text Text)
project :: Maybe Text
evaluationRules :: Maybe [EvaluationRule]
entityOverrides :: Maybe (HashMap Text Text)
description :: Maybe Text
defaultVariation :: Maybe Text
$sel:variations:Feature' :: Feature -> [Variation]
$sel:valueType:Feature' :: Feature -> VariationValueType
$sel:status:Feature' :: Feature -> FeatureStatus
$sel:name:Feature' :: Feature -> Text
$sel:lastUpdatedTime:Feature' :: Feature -> POSIX
$sel:evaluationStrategy:Feature' :: Feature -> FeatureEvaluationStrategy
$sel:createdTime:Feature' :: Feature -> POSIX
$sel:arn:Feature' :: Feature -> Text
$sel:tags:Feature' :: Feature -> Maybe (HashMap Text Text)
$sel:project:Feature' :: Feature -> Maybe Text
$sel:evaluationRules:Feature' :: Feature -> Maybe [EvaluationRule]
$sel:entityOverrides:Feature' :: Feature -> Maybe (HashMap Text Text)
$sel:description:Feature' :: Feature -> Maybe Text
$sel:defaultVariation:Feature' :: Feature -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
defaultVariation
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Text)
entityOverrides
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [EvaluationRule]
evaluationRules
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
project
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Text)
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
arn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` POSIX
createdTime
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` FeatureEvaluationStrategy
evaluationStrategy
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` POSIX
lastUpdatedTime
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
name
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` FeatureStatus
status
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` VariationValueType
valueType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` [Variation]
variations

instance Prelude.NFData Feature where
  rnf :: Feature -> ()
rnf Feature' {[Variation]
Maybe [EvaluationRule]
Maybe Text
Maybe (HashMap Text Text)
Text
POSIX
FeatureEvaluationStrategy
FeatureStatus
VariationValueType
variations :: [Variation]
valueType :: VariationValueType
status :: FeatureStatus
name :: Text
lastUpdatedTime :: POSIX
evaluationStrategy :: FeatureEvaluationStrategy
createdTime :: POSIX
arn :: Text
tags :: Maybe (HashMap Text Text)
project :: Maybe Text
evaluationRules :: Maybe [EvaluationRule]
entityOverrides :: Maybe (HashMap Text Text)
description :: Maybe Text
defaultVariation :: Maybe Text
$sel:variations:Feature' :: Feature -> [Variation]
$sel:valueType:Feature' :: Feature -> VariationValueType
$sel:status:Feature' :: Feature -> FeatureStatus
$sel:name:Feature' :: Feature -> Text
$sel:lastUpdatedTime:Feature' :: Feature -> POSIX
$sel:evaluationStrategy:Feature' :: Feature -> FeatureEvaluationStrategy
$sel:createdTime:Feature' :: Feature -> POSIX
$sel:arn:Feature' :: Feature -> Text
$sel:tags:Feature' :: Feature -> Maybe (HashMap Text Text)
$sel:project:Feature' :: Feature -> Maybe Text
$sel:evaluationRules:Feature' :: Feature -> Maybe [EvaluationRule]
$sel:entityOverrides:Feature' :: Feature -> Maybe (HashMap Text Text)
$sel:description:Feature' :: Feature -> Maybe Text
$sel:defaultVariation:Feature' :: Feature -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
defaultVariation
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
description
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text Text)
entityOverrides
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [EvaluationRule]
evaluationRules
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
project
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text Text)
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
arn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf POSIX
createdTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf FeatureEvaluationStrategy
evaluationStrategy
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf POSIX
lastUpdatedTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
name
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf FeatureStatus
status
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf VariationValueType
valueType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf [Variation]
variations