{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -fno-warn-unused-binds #-}
{-# 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.UpdateFeature
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Updates an existing feature.
--
-- You can\'t use this operation to update the tags of an existing feature.
-- Instead, use
-- <https://docs.aws.amazon.com/cloudwatchevidently/latest/APIReference/API_TagResource.html TagResource>.
module Amazonka.Evidently.UpdateFeature
  ( -- * Creating a Request
    UpdateFeature (..),
    newUpdateFeature,

    -- * Request Lenses
    updateFeature_addOrUpdateVariations,
    updateFeature_defaultVariation,
    updateFeature_description,
    updateFeature_entityOverrides,
    updateFeature_evaluationStrategy,
    updateFeature_removeVariations,
    updateFeature_feature,
    updateFeature_project,

    -- * Destructuring the Response
    UpdateFeatureResponse (..),
    newUpdateFeatureResponse,

    -- * Response Lenses
    updateFeatureResponse_httpStatus,
    updateFeatureResponse_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
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newUpdateFeature' smart constructor.
data UpdateFeature = UpdateFeature'
  { -- | To update variation configurations for this feature, or add new ones,
    -- specify this structure. In this array, include any variations that you
    -- want to add or update. If the array includes a variation name that
    -- already exists for this feature, it is updated. If it includes a new
    -- variation name, it is added as a new variation.
    UpdateFeature -> Maybe (NonEmpty VariationConfig)
addOrUpdateVariations :: Prelude.Maybe (Prelude.NonEmpty VariationConfig),
    -- | The name of the variation to use as the default variation. The default
    -- variation is served to users who are not allocated to any ongoing
    -- launches or experiments of this feature.
    UpdateFeature -> Maybe Text
defaultVariation :: Prelude.Maybe Prelude.Text,
    -- | An optional description of the feature.
    UpdateFeature -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | Specified users that should always be served a specific variation of a
    -- feature. Each user is specified by a key-value pair . For each key,
    -- specify a user by entering their user ID, account ID, or some other
    -- identifier. For the value, specify the name of the variation that they
    -- are to be served.
    UpdateFeature -> Maybe (HashMap Text Text)
entityOverrides :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | Specify @ALL_RULES@ to activate the traffic allocation specified by any
    -- ongoing launches or experiments. Specify @DEFAULT_VARIATION@ to serve
    -- the default variation to all users instead.
    UpdateFeature -> Maybe FeatureEvaluationStrategy
evaluationStrategy :: Prelude.Maybe FeatureEvaluationStrategy,
    -- | Removes a variation from the feature. If the variation you specify
    -- doesn\'t exist, then this makes no change and does not report an error.
    --
    -- This operation fails if you try to remove a variation that is part of an
    -- ongoing launch or experiment.
    UpdateFeature -> Maybe [Text]
removeVariations :: Prelude.Maybe [Prelude.Text],
    -- | The name of the feature to be updated.
    UpdateFeature -> Text
feature :: Prelude.Text,
    -- | The name or ARN of the project that contains the feature to be updated.
    UpdateFeature -> Text
project :: Prelude.Text
  }
  deriving (UpdateFeature -> UpdateFeature -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateFeature -> UpdateFeature -> Bool
$c/= :: UpdateFeature -> UpdateFeature -> Bool
== :: UpdateFeature -> UpdateFeature -> Bool
$c== :: UpdateFeature -> UpdateFeature -> Bool
Prelude.Eq, ReadPrec [UpdateFeature]
ReadPrec UpdateFeature
Int -> ReadS UpdateFeature
ReadS [UpdateFeature]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateFeature]
$creadListPrec :: ReadPrec [UpdateFeature]
readPrec :: ReadPrec UpdateFeature
$creadPrec :: ReadPrec UpdateFeature
readList :: ReadS [UpdateFeature]
$creadList :: ReadS [UpdateFeature]
readsPrec :: Int -> ReadS UpdateFeature
$creadsPrec :: Int -> ReadS UpdateFeature
Prelude.Read, Int -> UpdateFeature -> ShowS
[UpdateFeature] -> ShowS
UpdateFeature -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateFeature] -> ShowS
$cshowList :: [UpdateFeature] -> ShowS
show :: UpdateFeature -> String
$cshow :: UpdateFeature -> String
showsPrec :: Int -> UpdateFeature -> ShowS
$cshowsPrec :: Int -> UpdateFeature -> ShowS
Prelude.Show, forall x. Rep UpdateFeature x -> UpdateFeature
forall x. UpdateFeature -> Rep UpdateFeature x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateFeature x -> UpdateFeature
$cfrom :: forall x. UpdateFeature -> Rep UpdateFeature x
Prelude.Generic)

-- |
-- Create a value of 'UpdateFeature' 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:
--
-- 'addOrUpdateVariations', 'updateFeature_addOrUpdateVariations' - To update variation configurations for this feature, or add new ones,
-- specify this structure. In this array, include any variations that you
-- want to add or update. If the array includes a variation name that
-- already exists for this feature, it is updated. If it includes a new
-- variation name, it is added as a new variation.
--
-- 'defaultVariation', 'updateFeature_defaultVariation' - The name of the variation to use as the default variation. The default
-- variation is served to users who are not allocated to any ongoing
-- launches or experiments of this feature.
--
-- 'description', 'updateFeature_description' - An optional description of the feature.
--
-- 'entityOverrides', 'updateFeature_entityOverrides' - Specified users that should always be served a specific variation of a
-- feature. Each user is specified by a key-value pair . For each key,
-- specify a user by entering their user ID, account ID, or some other
-- identifier. For the value, specify the name of the variation that they
-- are to be served.
--
-- 'evaluationStrategy', 'updateFeature_evaluationStrategy' - Specify @ALL_RULES@ to activate the traffic allocation specified by any
-- ongoing launches or experiments. Specify @DEFAULT_VARIATION@ to serve
-- the default variation to all users instead.
--
-- 'removeVariations', 'updateFeature_removeVariations' - Removes a variation from the feature. If the variation you specify
-- doesn\'t exist, then this makes no change and does not report an error.
--
-- This operation fails if you try to remove a variation that is part of an
-- ongoing launch or experiment.
--
-- 'feature', 'updateFeature_feature' - The name of the feature to be updated.
--
-- 'project', 'updateFeature_project' - The name or ARN of the project that contains the feature to be updated.
newUpdateFeature ::
  -- | 'feature'
  Prelude.Text ->
  -- | 'project'
  Prelude.Text ->
  UpdateFeature
newUpdateFeature :: Text -> Text -> UpdateFeature
newUpdateFeature Text
pFeature_ Text
pProject_ =
  UpdateFeature'
    { $sel:addOrUpdateVariations:UpdateFeature' :: Maybe (NonEmpty VariationConfig)
addOrUpdateVariations =
        forall a. Maybe a
Prelude.Nothing,
      $sel:defaultVariation:UpdateFeature' :: Maybe Text
defaultVariation = forall a. Maybe a
Prelude.Nothing,
      $sel:description:UpdateFeature' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:entityOverrides:UpdateFeature' :: Maybe (HashMap Text Text)
entityOverrides = forall a. Maybe a
Prelude.Nothing,
      $sel:evaluationStrategy:UpdateFeature' :: Maybe FeatureEvaluationStrategy
evaluationStrategy = forall a. Maybe a
Prelude.Nothing,
      $sel:removeVariations:UpdateFeature' :: Maybe [Text]
removeVariations = forall a. Maybe a
Prelude.Nothing,
      $sel:feature:UpdateFeature' :: Text
feature = Text
pFeature_,
      $sel:project:UpdateFeature' :: Text
project = Text
pProject_
    }

-- | To update variation configurations for this feature, or add new ones,
-- specify this structure. In this array, include any variations that you
-- want to add or update. If the array includes a variation name that
-- already exists for this feature, it is updated. If it includes a new
-- variation name, it is added as a new variation.
updateFeature_addOrUpdateVariations :: Lens.Lens' UpdateFeature (Prelude.Maybe (Prelude.NonEmpty VariationConfig))
updateFeature_addOrUpdateVariations :: Lens' UpdateFeature (Maybe (NonEmpty VariationConfig))
updateFeature_addOrUpdateVariations = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateFeature' {Maybe (NonEmpty VariationConfig)
addOrUpdateVariations :: Maybe (NonEmpty VariationConfig)
$sel:addOrUpdateVariations:UpdateFeature' :: UpdateFeature -> Maybe (NonEmpty VariationConfig)
addOrUpdateVariations} -> Maybe (NonEmpty VariationConfig)
addOrUpdateVariations) (\s :: UpdateFeature
s@UpdateFeature' {} Maybe (NonEmpty VariationConfig)
a -> UpdateFeature
s {$sel:addOrUpdateVariations:UpdateFeature' :: Maybe (NonEmpty VariationConfig)
addOrUpdateVariations = Maybe (NonEmpty VariationConfig)
a} :: UpdateFeature) 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 of the variation to use as the default variation. The default
-- variation is served to users who are not allocated to any ongoing
-- launches or experiments of this feature.
updateFeature_defaultVariation :: Lens.Lens' UpdateFeature (Prelude.Maybe Prelude.Text)
updateFeature_defaultVariation :: Lens' UpdateFeature (Maybe Text)
updateFeature_defaultVariation = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateFeature' {Maybe Text
defaultVariation :: Maybe Text
$sel:defaultVariation:UpdateFeature' :: UpdateFeature -> Maybe Text
defaultVariation} -> Maybe Text
defaultVariation) (\s :: UpdateFeature
s@UpdateFeature' {} Maybe Text
a -> UpdateFeature
s {$sel:defaultVariation:UpdateFeature' :: Maybe Text
defaultVariation = Maybe Text
a} :: UpdateFeature)

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

-- | Specified users that should always be served a specific variation of a
-- feature. Each user is specified by a key-value pair . For each key,
-- specify a user by entering their user ID, account ID, or some other
-- identifier. For the value, specify the name of the variation that they
-- are to be served.
updateFeature_entityOverrides :: Lens.Lens' UpdateFeature (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
updateFeature_entityOverrides :: Lens' UpdateFeature (Maybe (HashMap Text Text))
updateFeature_entityOverrides = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateFeature' {Maybe (HashMap Text Text)
entityOverrides :: Maybe (HashMap Text Text)
$sel:entityOverrides:UpdateFeature' :: UpdateFeature -> Maybe (HashMap Text Text)
entityOverrides} -> Maybe (HashMap Text Text)
entityOverrides) (\s :: UpdateFeature
s@UpdateFeature' {} Maybe (HashMap Text Text)
a -> UpdateFeature
s {$sel:entityOverrides:UpdateFeature' :: Maybe (HashMap Text Text)
entityOverrides = Maybe (HashMap Text Text)
a} :: UpdateFeature) 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

-- | Specify @ALL_RULES@ to activate the traffic allocation specified by any
-- ongoing launches or experiments. Specify @DEFAULT_VARIATION@ to serve
-- the default variation to all users instead.
updateFeature_evaluationStrategy :: Lens.Lens' UpdateFeature (Prelude.Maybe FeatureEvaluationStrategy)
updateFeature_evaluationStrategy :: Lens' UpdateFeature (Maybe FeatureEvaluationStrategy)
updateFeature_evaluationStrategy = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateFeature' {Maybe FeatureEvaluationStrategy
evaluationStrategy :: Maybe FeatureEvaluationStrategy
$sel:evaluationStrategy:UpdateFeature' :: UpdateFeature -> Maybe FeatureEvaluationStrategy
evaluationStrategy} -> Maybe FeatureEvaluationStrategy
evaluationStrategy) (\s :: UpdateFeature
s@UpdateFeature' {} Maybe FeatureEvaluationStrategy
a -> UpdateFeature
s {$sel:evaluationStrategy:UpdateFeature' :: Maybe FeatureEvaluationStrategy
evaluationStrategy = Maybe FeatureEvaluationStrategy
a} :: UpdateFeature)

-- | Removes a variation from the feature. If the variation you specify
-- doesn\'t exist, then this makes no change and does not report an error.
--
-- This operation fails if you try to remove a variation that is part of an
-- ongoing launch or experiment.
updateFeature_removeVariations :: Lens.Lens' UpdateFeature (Prelude.Maybe [Prelude.Text])
updateFeature_removeVariations :: Lens' UpdateFeature (Maybe [Text])
updateFeature_removeVariations = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateFeature' {Maybe [Text]
removeVariations :: Maybe [Text]
$sel:removeVariations:UpdateFeature' :: UpdateFeature -> Maybe [Text]
removeVariations} -> Maybe [Text]
removeVariations) (\s :: UpdateFeature
s@UpdateFeature' {} Maybe [Text]
a -> UpdateFeature
s {$sel:removeVariations:UpdateFeature' :: Maybe [Text]
removeVariations = Maybe [Text]
a} :: UpdateFeature) 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 of the feature to be updated.
updateFeature_feature :: Lens.Lens' UpdateFeature Prelude.Text
updateFeature_feature :: Lens' UpdateFeature Text
updateFeature_feature = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateFeature' {Text
feature :: Text
$sel:feature:UpdateFeature' :: UpdateFeature -> Text
feature} -> Text
feature) (\s :: UpdateFeature
s@UpdateFeature' {} Text
a -> UpdateFeature
s {$sel:feature:UpdateFeature' :: Text
feature = Text
a} :: UpdateFeature)

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

instance Core.AWSRequest UpdateFeature where
  type
    AWSResponse UpdateFeature =
      UpdateFeatureResponse
  request :: (Service -> Service) -> UpdateFeature -> Request UpdateFeature
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.patchJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy UpdateFeature
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse UpdateFeature)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> Object -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveJSON
      ( \Int
s ResponseHeaders
h Object
x ->
          Int -> Feature -> UpdateFeatureResponse
UpdateFeatureResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"feature")
      )

instance Prelude.Hashable UpdateFeature where
  hashWithSalt :: Int -> UpdateFeature -> Int
hashWithSalt Int
_salt UpdateFeature' {Maybe [Text]
Maybe (NonEmpty VariationConfig)
Maybe Text
Maybe (HashMap Text Text)
Maybe FeatureEvaluationStrategy
Text
project :: Text
feature :: Text
removeVariations :: Maybe [Text]
evaluationStrategy :: Maybe FeatureEvaluationStrategy
entityOverrides :: Maybe (HashMap Text Text)
description :: Maybe Text
defaultVariation :: Maybe Text
addOrUpdateVariations :: Maybe (NonEmpty VariationConfig)
$sel:project:UpdateFeature' :: UpdateFeature -> Text
$sel:feature:UpdateFeature' :: UpdateFeature -> Text
$sel:removeVariations:UpdateFeature' :: UpdateFeature -> Maybe [Text]
$sel:evaluationStrategy:UpdateFeature' :: UpdateFeature -> Maybe FeatureEvaluationStrategy
$sel:entityOverrides:UpdateFeature' :: UpdateFeature -> Maybe (HashMap Text Text)
$sel:description:UpdateFeature' :: UpdateFeature -> Maybe Text
$sel:defaultVariation:UpdateFeature' :: UpdateFeature -> Maybe Text
$sel:addOrUpdateVariations:UpdateFeature' :: UpdateFeature -> Maybe (NonEmpty VariationConfig)
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (NonEmpty VariationConfig)
addOrUpdateVariations
      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 FeatureEvaluationStrategy
evaluationStrategy
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
removeVariations
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
feature
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
project

instance Prelude.NFData UpdateFeature where
  rnf :: UpdateFeature -> ()
rnf UpdateFeature' {Maybe [Text]
Maybe (NonEmpty VariationConfig)
Maybe Text
Maybe (HashMap Text Text)
Maybe FeatureEvaluationStrategy
Text
project :: Text
feature :: Text
removeVariations :: Maybe [Text]
evaluationStrategy :: Maybe FeatureEvaluationStrategy
entityOverrides :: Maybe (HashMap Text Text)
description :: Maybe Text
defaultVariation :: Maybe Text
addOrUpdateVariations :: Maybe (NonEmpty VariationConfig)
$sel:project:UpdateFeature' :: UpdateFeature -> Text
$sel:feature:UpdateFeature' :: UpdateFeature -> Text
$sel:removeVariations:UpdateFeature' :: UpdateFeature -> Maybe [Text]
$sel:evaluationStrategy:UpdateFeature' :: UpdateFeature -> Maybe FeatureEvaluationStrategy
$sel:entityOverrides:UpdateFeature' :: UpdateFeature -> Maybe (HashMap Text Text)
$sel:description:UpdateFeature' :: UpdateFeature -> Maybe Text
$sel:defaultVariation:UpdateFeature' :: UpdateFeature -> Maybe Text
$sel:addOrUpdateVariations:UpdateFeature' :: UpdateFeature -> Maybe (NonEmpty VariationConfig)
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe (NonEmpty VariationConfig)
addOrUpdateVariations
      seq :: forall a b. a -> b -> b
`Prelude.seq` 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 FeatureEvaluationStrategy
evaluationStrategy
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
removeVariations
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
feature
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
project

instance Data.ToHeaders UpdateFeature where
  toHeaders :: UpdateFeature -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON UpdateFeature where
  toJSON :: UpdateFeature -> Value
toJSON UpdateFeature' {Maybe [Text]
Maybe (NonEmpty VariationConfig)
Maybe Text
Maybe (HashMap Text Text)
Maybe FeatureEvaluationStrategy
Text
project :: Text
feature :: Text
removeVariations :: Maybe [Text]
evaluationStrategy :: Maybe FeatureEvaluationStrategy
entityOverrides :: Maybe (HashMap Text Text)
description :: Maybe Text
defaultVariation :: Maybe Text
addOrUpdateVariations :: Maybe (NonEmpty VariationConfig)
$sel:project:UpdateFeature' :: UpdateFeature -> Text
$sel:feature:UpdateFeature' :: UpdateFeature -> Text
$sel:removeVariations:UpdateFeature' :: UpdateFeature -> Maybe [Text]
$sel:evaluationStrategy:UpdateFeature' :: UpdateFeature -> Maybe FeatureEvaluationStrategy
$sel:entityOverrides:UpdateFeature' :: UpdateFeature -> Maybe (HashMap Text Text)
$sel:description:UpdateFeature' :: UpdateFeature -> Maybe Text
$sel:defaultVariation:UpdateFeature' :: UpdateFeature -> Maybe Text
$sel:addOrUpdateVariations:UpdateFeature' :: UpdateFeature -> Maybe (NonEmpty VariationConfig)
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"addOrUpdateVariations" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe (NonEmpty VariationConfig)
addOrUpdateVariations,
            (Key
"defaultVariation" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
defaultVariation,
            (Key
"description" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
description,
            (Key
"entityOverrides" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe (HashMap Text Text)
entityOverrides,
            (Key
"evaluationStrategy" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe FeatureEvaluationStrategy
evaluationStrategy,
            (Key
"removeVariations" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [Text]
removeVariations
          ]
      )

instance Data.ToPath UpdateFeature where
  toPath :: UpdateFeature -> ByteString
toPath UpdateFeature' {Maybe [Text]
Maybe (NonEmpty VariationConfig)
Maybe Text
Maybe (HashMap Text Text)
Maybe FeatureEvaluationStrategy
Text
project :: Text
feature :: Text
removeVariations :: Maybe [Text]
evaluationStrategy :: Maybe FeatureEvaluationStrategy
entityOverrides :: Maybe (HashMap Text Text)
description :: Maybe Text
defaultVariation :: Maybe Text
addOrUpdateVariations :: Maybe (NonEmpty VariationConfig)
$sel:project:UpdateFeature' :: UpdateFeature -> Text
$sel:feature:UpdateFeature' :: UpdateFeature -> Text
$sel:removeVariations:UpdateFeature' :: UpdateFeature -> Maybe [Text]
$sel:evaluationStrategy:UpdateFeature' :: UpdateFeature -> Maybe FeatureEvaluationStrategy
$sel:entityOverrides:UpdateFeature' :: UpdateFeature -> Maybe (HashMap Text Text)
$sel:description:UpdateFeature' :: UpdateFeature -> Maybe Text
$sel:defaultVariation:UpdateFeature' :: UpdateFeature -> Maybe Text
$sel:addOrUpdateVariations:UpdateFeature' :: UpdateFeature -> Maybe (NonEmpty VariationConfig)
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/projects/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
project,
        ByteString
"/features/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
feature
      ]

instance Data.ToQuery UpdateFeature where
  toQuery :: UpdateFeature -> QueryString
toQuery = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

-- | /See:/ 'newUpdateFeatureResponse' smart constructor.
data UpdateFeatureResponse = UpdateFeatureResponse'
  { -- | The response's http status code.
    UpdateFeatureResponse -> Int
httpStatus :: Prelude.Int,
    -- | A structure that contains information about the updated feature.
    UpdateFeatureResponse -> Feature
feature :: Feature
  }
  deriving (UpdateFeatureResponse -> UpdateFeatureResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateFeatureResponse -> UpdateFeatureResponse -> Bool
$c/= :: UpdateFeatureResponse -> UpdateFeatureResponse -> Bool
== :: UpdateFeatureResponse -> UpdateFeatureResponse -> Bool
$c== :: UpdateFeatureResponse -> UpdateFeatureResponse -> Bool
Prelude.Eq, ReadPrec [UpdateFeatureResponse]
ReadPrec UpdateFeatureResponse
Int -> ReadS UpdateFeatureResponse
ReadS [UpdateFeatureResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateFeatureResponse]
$creadListPrec :: ReadPrec [UpdateFeatureResponse]
readPrec :: ReadPrec UpdateFeatureResponse
$creadPrec :: ReadPrec UpdateFeatureResponse
readList :: ReadS [UpdateFeatureResponse]
$creadList :: ReadS [UpdateFeatureResponse]
readsPrec :: Int -> ReadS UpdateFeatureResponse
$creadsPrec :: Int -> ReadS UpdateFeatureResponse
Prelude.Read, Int -> UpdateFeatureResponse -> ShowS
[UpdateFeatureResponse] -> ShowS
UpdateFeatureResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateFeatureResponse] -> ShowS
$cshowList :: [UpdateFeatureResponse] -> ShowS
show :: UpdateFeatureResponse -> String
$cshow :: UpdateFeatureResponse -> String
showsPrec :: Int -> UpdateFeatureResponse -> ShowS
$cshowsPrec :: Int -> UpdateFeatureResponse -> ShowS
Prelude.Show, forall x. Rep UpdateFeatureResponse x -> UpdateFeatureResponse
forall x. UpdateFeatureResponse -> Rep UpdateFeatureResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateFeatureResponse x -> UpdateFeatureResponse
$cfrom :: forall x. UpdateFeatureResponse -> Rep UpdateFeatureResponse x
Prelude.Generic)

-- |
-- Create a value of 'UpdateFeatureResponse' 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:
--
-- 'httpStatus', 'updateFeatureResponse_httpStatus' - The response's http status code.
--
-- 'feature', 'updateFeatureResponse_feature' - A structure that contains information about the updated feature.
newUpdateFeatureResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'feature'
  Feature ->
  UpdateFeatureResponse
newUpdateFeatureResponse :: Int -> Feature -> UpdateFeatureResponse
newUpdateFeatureResponse Int
pHttpStatus_ Feature
pFeature_ =
  UpdateFeatureResponse'
    { $sel:httpStatus:UpdateFeatureResponse' :: Int
httpStatus = Int
pHttpStatus_,
      $sel:feature:UpdateFeatureResponse' :: Feature
feature = Feature
pFeature_
    }

-- | The response's http status code.
updateFeatureResponse_httpStatus :: Lens.Lens' UpdateFeatureResponse Prelude.Int
updateFeatureResponse_httpStatus :: Lens' UpdateFeatureResponse Int
updateFeatureResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateFeatureResponse' {Int
httpStatus :: Int
$sel:httpStatus:UpdateFeatureResponse' :: UpdateFeatureResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: UpdateFeatureResponse
s@UpdateFeatureResponse' {} Int
a -> UpdateFeatureResponse
s {$sel:httpStatus:UpdateFeatureResponse' :: Int
httpStatus = Int
a} :: UpdateFeatureResponse)

-- | A structure that contains information about the updated feature.
updateFeatureResponse_feature :: Lens.Lens' UpdateFeatureResponse Feature
updateFeatureResponse_feature :: Lens' UpdateFeatureResponse Feature
updateFeatureResponse_feature = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateFeatureResponse' {Feature
feature :: Feature
$sel:feature:UpdateFeatureResponse' :: UpdateFeatureResponse -> Feature
feature} -> Feature
feature) (\s :: UpdateFeatureResponse
s@UpdateFeatureResponse' {} Feature
a -> UpdateFeatureResponse
s {$sel:feature:UpdateFeatureResponse' :: Feature
feature = Feature
a} :: UpdateFeatureResponse)

instance Prelude.NFData UpdateFeatureResponse where
  rnf :: UpdateFeatureResponse -> ()
rnf UpdateFeatureResponse' {Int
Feature
feature :: Feature
httpStatus :: Int
$sel:feature:UpdateFeatureResponse' :: UpdateFeatureResponse -> Feature
$sel:httpStatus:UpdateFeatureResponse' :: UpdateFeatureResponse -> Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Feature
feature