{-# 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.CreateFeature
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Creates an Evidently /feature/ that you want to launch or test. You can
-- define up to five variations of a feature, and use these variations in
-- your launches and experiments. A feature must be created in a project.
-- For information about creating a project, see
-- <https://docs.aws.amazon.com/cloudwatchevidently/latest/APIReference/API_CreateProject.html CreateProject>.
--
-- Don\'t use this operation to update an existing feature. Instead, use
-- <https://docs.aws.amazon.com/cloudwatchevidently/latest/APIReference/API_UpdateFeature.html UpdateFeature>.
module Amazonka.Evidently.CreateFeature
  ( -- * Creating a Request
    CreateFeature (..),
    newCreateFeature,

    -- * Request Lenses
    createFeature_defaultVariation,
    createFeature_description,
    createFeature_entityOverrides,
    createFeature_evaluationStrategy,
    createFeature_tags,
    createFeature_name,
    createFeature_project,
    createFeature_variations,

    -- * Destructuring the Response
    CreateFeatureResponse (..),
    newCreateFeatureResponse,

    -- * Response Lenses
    createFeatureResponse_feature,
    createFeatureResponse_httpStatus,
  )
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:/ 'newCreateFeature' smart constructor.
data CreateFeature = CreateFeature'
  { -- | 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.
    --
    -- 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.
    CreateFeature -> Maybe Text
defaultVariation :: Prelude.Maybe Prelude.Text,
    -- | An optional description of the feature.
    CreateFeature -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | Specify 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.
    CreateFeature -> 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.
    CreateFeature -> Maybe FeatureEvaluationStrategy
evaluationStrategy :: Prelude.Maybe FeatureEvaluationStrategy,
    -- | Assigns one or more tags (key-value pairs) to the feature.
    --
    -- Tags can help you organize and categorize your resources. You can also
    -- use them to scope user permissions by granting a user permission to
    -- access or change only resources with certain tag values.
    --
    -- Tags don\'t have any semantic meaning to Amazon Web Services and are
    -- interpreted strictly as strings of characters.
    --
    -- >  <p>You can associate as many as 50 tags with a feature.</p> <p>For more information, see <a href="https://docs.aws.amazon.com/general/latest/gr/aws_tagging.html">Tagging Amazon Web Services resources</a>.</p>
    CreateFeature -> Maybe (HashMap Text Text)
tags :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | The name for the new feature.
    CreateFeature -> Text
name :: Prelude.Text,
    -- | The name or ARN of the project that is to contain the new feature.
    CreateFeature -> Text
project :: Prelude.Text,
    -- | An array of structures that contain the configuration of the feature\'s
    -- different variations.
    CreateFeature -> NonEmpty VariationConfig
variations :: Prelude.NonEmpty VariationConfig
  }
  deriving (CreateFeature -> CreateFeature -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateFeature -> CreateFeature -> Bool
$c/= :: CreateFeature -> CreateFeature -> Bool
== :: CreateFeature -> CreateFeature -> Bool
$c== :: CreateFeature -> CreateFeature -> Bool
Prelude.Eq, ReadPrec [CreateFeature]
ReadPrec CreateFeature
Int -> ReadS CreateFeature
ReadS [CreateFeature]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateFeature]
$creadListPrec :: ReadPrec [CreateFeature]
readPrec :: ReadPrec CreateFeature
$creadPrec :: ReadPrec CreateFeature
readList :: ReadS [CreateFeature]
$creadList :: ReadS [CreateFeature]
readsPrec :: Int -> ReadS CreateFeature
$creadsPrec :: Int -> ReadS CreateFeature
Prelude.Read, Int -> CreateFeature -> ShowS
[CreateFeature] -> ShowS
CreateFeature -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateFeature] -> ShowS
$cshowList :: [CreateFeature] -> ShowS
show :: CreateFeature -> String
$cshow :: CreateFeature -> String
showsPrec :: Int -> CreateFeature -> ShowS
$cshowsPrec :: Int -> CreateFeature -> ShowS
Prelude.Show, forall x. Rep CreateFeature x -> CreateFeature
forall x. CreateFeature -> Rep CreateFeature x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateFeature x -> CreateFeature
$cfrom :: forall x. CreateFeature -> Rep CreateFeature x
Prelude.Generic)

-- |
-- Create a value of 'CreateFeature' 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', 'createFeature_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.
--
-- 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', 'createFeature_description' - An optional description of the feature.
--
-- 'entityOverrides', 'createFeature_entityOverrides' - Specify 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', 'createFeature_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.
--
-- 'tags', 'createFeature_tags' - Assigns one or more tags (key-value pairs) to the feature.
--
-- Tags can help you organize and categorize your resources. You can also
-- use them to scope user permissions by granting a user permission to
-- access or change only resources with certain tag values.
--
-- Tags don\'t have any semantic meaning to Amazon Web Services and are
-- interpreted strictly as strings of characters.
--
-- >  <p>You can associate as many as 50 tags with a feature.</p> <p>For more information, see <a href="https://docs.aws.amazon.com/general/latest/gr/aws_tagging.html">Tagging Amazon Web Services resources</a>.</p>
--
-- 'name', 'createFeature_name' - The name for the new feature.
--
-- 'project', 'createFeature_project' - The name or ARN of the project that is to contain the new feature.
--
-- 'variations', 'createFeature_variations' - An array of structures that contain the configuration of the feature\'s
-- different variations.
newCreateFeature ::
  -- | 'name'
  Prelude.Text ->
  -- | 'project'
  Prelude.Text ->
  -- | 'variations'
  Prelude.NonEmpty VariationConfig ->
  CreateFeature
newCreateFeature :: Text -> Text -> NonEmpty VariationConfig -> CreateFeature
newCreateFeature Text
pName_ Text
pProject_ NonEmpty VariationConfig
pVariations_ =
  CreateFeature'
    { $sel:defaultVariation:CreateFeature' :: Maybe Text
defaultVariation = forall a. Maybe a
Prelude.Nothing,
      $sel:description:CreateFeature' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:entityOverrides:CreateFeature' :: Maybe (HashMap Text Text)
entityOverrides = forall a. Maybe a
Prelude.Nothing,
      $sel:evaluationStrategy:CreateFeature' :: Maybe FeatureEvaluationStrategy
evaluationStrategy = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:CreateFeature' :: Maybe (HashMap Text Text)
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:name:CreateFeature' :: Text
name = Text
pName_,
      $sel:project:CreateFeature' :: Text
project = Text
pProject_,
      $sel:variations:CreateFeature' :: NonEmpty VariationConfig
variations = forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced forall t b. AReview t b -> b -> t
Lens.# NonEmpty VariationConfig
pVariations_
    }

-- | 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.
--
-- 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.
createFeature_defaultVariation :: Lens.Lens' CreateFeature (Prelude.Maybe Prelude.Text)
createFeature_defaultVariation :: Lens' CreateFeature (Maybe Text)
createFeature_defaultVariation = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateFeature' {Maybe Text
defaultVariation :: Maybe Text
$sel:defaultVariation:CreateFeature' :: CreateFeature -> Maybe Text
defaultVariation} -> Maybe Text
defaultVariation) (\s :: CreateFeature
s@CreateFeature' {} Maybe Text
a -> CreateFeature
s {$sel:defaultVariation:CreateFeature' :: Maybe Text
defaultVariation = Maybe Text
a} :: CreateFeature)

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

-- | Specify 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.
createFeature_entityOverrides :: Lens.Lens' CreateFeature (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
createFeature_entityOverrides :: Lens' CreateFeature (Maybe (HashMap Text Text))
createFeature_entityOverrides = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateFeature' {Maybe (HashMap Text Text)
entityOverrides :: Maybe (HashMap Text Text)
$sel:entityOverrides:CreateFeature' :: CreateFeature -> Maybe (HashMap Text Text)
entityOverrides} -> Maybe (HashMap Text Text)
entityOverrides) (\s :: CreateFeature
s@CreateFeature' {} Maybe (HashMap Text Text)
a -> CreateFeature
s {$sel:entityOverrides:CreateFeature' :: Maybe (HashMap Text Text)
entityOverrides = Maybe (HashMap Text Text)
a} :: CreateFeature) 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.
createFeature_evaluationStrategy :: Lens.Lens' CreateFeature (Prelude.Maybe FeatureEvaluationStrategy)
createFeature_evaluationStrategy :: Lens' CreateFeature (Maybe FeatureEvaluationStrategy)
createFeature_evaluationStrategy = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateFeature' {Maybe FeatureEvaluationStrategy
evaluationStrategy :: Maybe FeatureEvaluationStrategy
$sel:evaluationStrategy:CreateFeature' :: CreateFeature -> Maybe FeatureEvaluationStrategy
evaluationStrategy} -> Maybe FeatureEvaluationStrategy
evaluationStrategy) (\s :: CreateFeature
s@CreateFeature' {} Maybe FeatureEvaluationStrategy
a -> CreateFeature
s {$sel:evaluationStrategy:CreateFeature' :: Maybe FeatureEvaluationStrategy
evaluationStrategy = Maybe FeatureEvaluationStrategy
a} :: CreateFeature)

-- | Assigns one or more tags (key-value pairs) to the feature.
--
-- Tags can help you organize and categorize your resources. You can also
-- use them to scope user permissions by granting a user permission to
-- access or change only resources with certain tag values.
--
-- Tags don\'t have any semantic meaning to Amazon Web Services and are
-- interpreted strictly as strings of characters.
--
-- >  <p>You can associate as many as 50 tags with a feature.</p> <p>For more information, see <a href="https://docs.aws.amazon.com/general/latest/gr/aws_tagging.html">Tagging Amazon Web Services resources</a>.</p>
createFeature_tags :: Lens.Lens' CreateFeature (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
createFeature_tags :: Lens' CreateFeature (Maybe (HashMap Text Text))
createFeature_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateFeature' {Maybe (HashMap Text Text)
tags :: Maybe (HashMap Text Text)
$sel:tags:CreateFeature' :: CreateFeature -> Maybe (HashMap Text Text)
tags} -> Maybe (HashMap Text Text)
tags) (\s :: CreateFeature
s@CreateFeature' {} Maybe (HashMap Text Text)
a -> CreateFeature
s {$sel:tags:CreateFeature' :: Maybe (HashMap Text Text)
tags = Maybe (HashMap Text Text)
a} :: CreateFeature) 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 for the new feature.
createFeature_name :: Lens.Lens' CreateFeature Prelude.Text
createFeature_name :: Lens' CreateFeature Text
createFeature_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateFeature' {Text
name :: Text
$sel:name:CreateFeature' :: CreateFeature -> Text
name} -> Text
name) (\s :: CreateFeature
s@CreateFeature' {} Text
a -> CreateFeature
s {$sel:name:CreateFeature' :: Text
name = Text
a} :: CreateFeature)

-- | The name or ARN of the project that is to contain the new feature.
createFeature_project :: Lens.Lens' CreateFeature Prelude.Text
createFeature_project :: Lens' CreateFeature Text
createFeature_project = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateFeature' {Text
project :: Text
$sel:project:CreateFeature' :: CreateFeature -> Text
project} -> Text
project) (\s :: CreateFeature
s@CreateFeature' {} Text
a -> CreateFeature
s {$sel:project:CreateFeature' :: Text
project = Text
a} :: CreateFeature)

-- | An array of structures that contain the configuration of the feature\'s
-- different variations.
createFeature_variations :: Lens.Lens' CreateFeature (Prelude.NonEmpty VariationConfig)
createFeature_variations :: Lens' CreateFeature (NonEmpty VariationConfig)
createFeature_variations = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateFeature' {NonEmpty VariationConfig
variations :: NonEmpty VariationConfig
$sel:variations:CreateFeature' :: CreateFeature -> NonEmpty VariationConfig
variations} -> NonEmpty VariationConfig
variations) (\s :: CreateFeature
s@CreateFeature' {} NonEmpty VariationConfig
a -> CreateFeature
s {$sel:variations:CreateFeature' :: NonEmpty VariationConfig
variations = NonEmpty VariationConfig
a} :: CreateFeature) 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 Core.AWSRequest CreateFeature where
  type
    AWSResponse CreateFeature =
      CreateFeatureResponse
  request :: (Service -> Service) -> CreateFeature -> Request CreateFeature
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.postJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy CreateFeature
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CreateFeature)))
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 ->
          Maybe Feature -> Int -> CreateFeatureResponse
CreateFeatureResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"feature")
            forall (f :: * -> *) a b. Applicative f => 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))
      )

instance Prelude.Hashable CreateFeature where
  hashWithSalt :: Int -> CreateFeature -> Int
hashWithSalt Int
_salt CreateFeature' {Maybe Text
Maybe (HashMap Text Text)
Maybe FeatureEvaluationStrategy
NonEmpty VariationConfig
Text
variations :: NonEmpty VariationConfig
project :: Text
name :: Text
tags :: Maybe (HashMap Text Text)
evaluationStrategy :: Maybe FeatureEvaluationStrategy
entityOverrides :: Maybe (HashMap Text Text)
description :: Maybe Text
defaultVariation :: Maybe Text
$sel:variations:CreateFeature' :: CreateFeature -> NonEmpty VariationConfig
$sel:project:CreateFeature' :: CreateFeature -> Text
$sel:name:CreateFeature' :: CreateFeature -> Text
$sel:tags:CreateFeature' :: CreateFeature -> Maybe (HashMap Text Text)
$sel:evaluationStrategy:CreateFeature' :: CreateFeature -> Maybe FeatureEvaluationStrategy
$sel:entityOverrides:CreateFeature' :: CreateFeature -> Maybe (HashMap Text Text)
$sel:description:CreateFeature' :: CreateFeature -> Maybe Text
$sel:defaultVariation:CreateFeature' :: CreateFeature -> 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 FeatureEvaluationStrategy
evaluationStrategy
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Text)
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
name
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
project
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` NonEmpty VariationConfig
variations

instance Prelude.NFData CreateFeature where
  rnf :: CreateFeature -> ()
rnf CreateFeature' {Maybe Text
Maybe (HashMap Text Text)
Maybe FeatureEvaluationStrategy
NonEmpty VariationConfig
Text
variations :: NonEmpty VariationConfig
project :: Text
name :: Text
tags :: Maybe (HashMap Text Text)
evaluationStrategy :: Maybe FeatureEvaluationStrategy
entityOverrides :: Maybe (HashMap Text Text)
description :: Maybe Text
defaultVariation :: Maybe Text
$sel:variations:CreateFeature' :: CreateFeature -> NonEmpty VariationConfig
$sel:project:CreateFeature' :: CreateFeature -> Text
$sel:name:CreateFeature' :: CreateFeature -> Text
$sel:tags:CreateFeature' :: CreateFeature -> Maybe (HashMap Text Text)
$sel:evaluationStrategy:CreateFeature' :: CreateFeature -> Maybe FeatureEvaluationStrategy
$sel:entityOverrides:CreateFeature' :: CreateFeature -> Maybe (HashMap Text Text)
$sel:description:CreateFeature' :: CreateFeature -> Maybe Text
$sel:defaultVariation:CreateFeature' :: CreateFeature -> 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 FeatureEvaluationStrategy
evaluationStrategy
      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
name
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
project
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf NonEmpty VariationConfig
variations

instance Data.ToHeaders CreateFeature where
  toHeaders :: CreateFeature -> 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 CreateFeature where
  toJSON :: CreateFeature -> Value
toJSON CreateFeature' {Maybe Text
Maybe (HashMap Text Text)
Maybe FeatureEvaluationStrategy
NonEmpty VariationConfig
Text
variations :: NonEmpty VariationConfig
project :: Text
name :: Text
tags :: Maybe (HashMap Text Text)
evaluationStrategy :: Maybe FeatureEvaluationStrategy
entityOverrides :: Maybe (HashMap Text Text)
description :: Maybe Text
defaultVariation :: Maybe Text
$sel:variations:CreateFeature' :: CreateFeature -> NonEmpty VariationConfig
$sel:project:CreateFeature' :: CreateFeature -> Text
$sel:name:CreateFeature' :: CreateFeature -> Text
$sel:tags:CreateFeature' :: CreateFeature -> Maybe (HashMap Text Text)
$sel:evaluationStrategy:CreateFeature' :: CreateFeature -> Maybe FeatureEvaluationStrategy
$sel:entityOverrides:CreateFeature' :: CreateFeature -> Maybe (HashMap Text Text)
$sel:description:CreateFeature' :: CreateFeature -> Maybe Text
$sel:defaultVariation:CreateFeature' :: CreateFeature -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (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
"tags" 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)
tags,
            forall a. a -> Maybe a
Prelude.Just (Key
"name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
name),
            forall a. a -> Maybe a
Prelude.Just (Key
"variations" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= NonEmpty VariationConfig
variations)
          ]
      )

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

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

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

-- |
-- Create a value of 'CreateFeatureResponse' 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:
--
-- 'feature', 'createFeatureResponse_feature' - A structure that contains information about the new feature.
--
-- 'httpStatus', 'createFeatureResponse_httpStatus' - The response's http status code.
newCreateFeatureResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateFeatureResponse
newCreateFeatureResponse :: Int -> CreateFeatureResponse
newCreateFeatureResponse Int
pHttpStatus_ =
  CreateFeatureResponse'
    { $sel:feature:CreateFeatureResponse' :: Maybe Feature
feature = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateFeatureResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | A structure that contains information about the new feature.
createFeatureResponse_feature :: Lens.Lens' CreateFeatureResponse (Prelude.Maybe Feature)
createFeatureResponse_feature :: Lens' CreateFeatureResponse (Maybe Feature)
createFeatureResponse_feature = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateFeatureResponse' {Maybe Feature
feature :: Maybe Feature
$sel:feature:CreateFeatureResponse' :: CreateFeatureResponse -> Maybe Feature
feature} -> Maybe Feature
feature) (\s :: CreateFeatureResponse
s@CreateFeatureResponse' {} Maybe Feature
a -> CreateFeatureResponse
s {$sel:feature:CreateFeatureResponse' :: Maybe Feature
feature = Maybe Feature
a} :: CreateFeatureResponse)

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

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