{-# 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.APIGateway.CreateStage
-- 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 a new Stage resource that references a pre-existing Deployment
-- for the API.
module Amazonka.APIGateway.CreateStage
  ( -- * Creating a Request
    CreateStage (..),
    newCreateStage,

    -- * Request Lenses
    createStage_cacheClusterEnabled,
    createStage_cacheClusterSize,
    createStage_canarySettings,
    createStage_description,
    createStage_documentationVersion,
    createStage_tags,
    createStage_tracingEnabled,
    createStage_variables,
    createStage_restApiId,
    createStage_stageName,
    createStage_deploymentId,

    -- * Destructuring the Response
    Stage (..),
    newStage,

    -- * Response Lenses
    stage_accessLogSettings,
    stage_cacheClusterEnabled,
    stage_cacheClusterSize,
    stage_cacheClusterStatus,
    stage_canarySettings,
    stage_clientCertificateId,
    stage_createdDate,
    stage_deploymentId,
    stage_description,
    stage_documentationVersion,
    stage_lastUpdatedDate,
    stage_methodSettings,
    stage_stageName,
    stage_tags,
    stage_tracingEnabled,
    stage_variables,
    stage_webAclArn,
  )
where

import Amazonka.APIGateway.Types
import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | Requests API Gateway to create a Stage resource.
--
-- /See:/ 'newCreateStage' smart constructor.
data CreateStage = CreateStage'
  { -- | Whether cache clustering is enabled for the stage.
    CreateStage -> Maybe Bool
cacheClusterEnabled :: Prelude.Maybe Prelude.Bool,
    -- | The stage\'s cache capacity in GB. For more information about choosing a
    -- cache size, see
    -- <https://docs.aws.amazon.com/apigateway/latest/developerguide/api-gateway-caching.html Enabling API caching to enhance responsiveness>.
    CreateStage -> Maybe CacheClusterSize
cacheClusterSize :: Prelude.Maybe CacheClusterSize,
    -- | The canary deployment settings of this stage.
    CreateStage -> Maybe CanarySettings
canarySettings :: Prelude.Maybe CanarySettings,
    -- | The description of the Stage resource.
    CreateStage -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | The version of the associated API documentation.
    CreateStage -> Maybe Text
documentationVersion :: Prelude.Maybe Prelude.Text,
    -- | The key-value map of strings. The valid character set is
    -- [a-zA-Z+-=._:\/]. The tag key can be up to 128 characters and must not
    -- start with @aws:@. The tag value can be up to 256 characters.
    CreateStage -> Maybe (HashMap Text Text)
tags :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | Specifies whether active tracing with X-ray is enabled for the Stage.
    CreateStage -> Maybe Bool
tracingEnabled :: Prelude.Maybe Prelude.Bool,
    -- | A map that defines the stage variables for the new Stage resource.
    -- Variable names can have alphanumeric and underscore characters, and the
    -- values must match @[A-Za-z0-9-._~:\/?#&=,]+@.
    CreateStage -> Maybe (HashMap Text Text)
variables :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | The string identifier of the associated RestApi.
    CreateStage -> Text
restApiId :: Prelude.Text,
    -- | The name for the Stage resource. Stage names can only contain
    -- alphanumeric characters, hyphens, and underscores. Maximum length is 128
    -- characters.
    CreateStage -> Text
stageName :: Prelude.Text,
    -- | The identifier of the Deployment resource for the Stage resource.
    CreateStage -> Text
deploymentId :: Prelude.Text
  }
  deriving (CreateStage -> CreateStage -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateStage -> CreateStage -> Bool
$c/= :: CreateStage -> CreateStage -> Bool
== :: CreateStage -> CreateStage -> Bool
$c== :: CreateStage -> CreateStage -> Bool
Prelude.Eq, ReadPrec [CreateStage]
ReadPrec CreateStage
Int -> ReadS CreateStage
ReadS [CreateStage]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateStage]
$creadListPrec :: ReadPrec [CreateStage]
readPrec :: ReadPrec CreateStage
$creadPrec :: ReadPrec CreateStage
readList :: ReadS [CreateStage]
$creadList :: ReadS [CreateStage]
readsPrec :: Int -> ReadS CreateStage
$creadsPrec :: Int -> ReadS CreateStage
Prelude.Read, Int -> CreateStage -> ShowS
[CreateStage] -> ShowS
CreateStage -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateStage] -> ShowS
$cshowList :: [CreateStage] -> ShowS
show :: CreateStage -> String
$cshow :: CreateStage -> String
showsPrec :: Int -> CreateStage -> ShowS
$cshowsPrec :: Int -> CreateStage -> ShowS
Prelude.Show, forall x. Rep CreateStage x -> CreateStage
forall x. CreateStage -> Rep CreateStage x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateStage x -> CreateStage
$cfrom :: forall x. CreateStage -> Rep CreateStage x
Prelude.Generic)

-- |
-- Create a value of 'CreateStage' 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:
--
-- 'cacheClusterEnabled', 'createStage_cacheClusterEnabled' - Whether cache clustering is enabled for the stage.
--
-- 'cacheClusterSize', 'createStage_cacheClusterSize' - The stage\'s cache capacity in GB. For more information about choosing a
-- cache size, see
-- <https://docs.aws.amazon.com/apigateway/latest/developerguide/api-gateway-caching.html Enabling API caching to enhance responsiveness>.
--
-- 'canarySettings', 'createStage_canarySettings' - The canary deployment settings of this stage.
--
-- 'description', 'createStage_description' - The description of the Stage resource.
--
-- 'documentationVersion', 'createStage_documentationVersion' - The version of the associated API documentation.
--
-- 'tags', 'createStage_tags' - The key-value map of strings. The valid character set is
-- [a-zA-Z+-=._:\/]. The tag key can be up to 128 characters and must not
-- start with @aws:@. The tag value can be up to 256 characters.
--
-- 'tracingEnabled', 'createStage_tracingEnabled' - Specifies whether active tracing with X-ray is enabled for the Stage.
--
-- 'variables', 'createStage_variables' - A map that defines the stage variables for the new Stage resource.
-- Variable names can have alphanumeric and underscore characters, and the
-- values must match @[A-Za-z0-9-._~:\/?#&=,]+@.
--
-- 'restApiId', 'createStage_restApiId' - The string identifier of the associated RestApi.
--
-- 'stageName', 'createStage_stageName' - The name for the Stage resource. Stage names can only contain
-- alphanumeric characters, hyphens, and underscores. Maximum length is 128
-- characters.
--
-- 'deploymentId', 'createStage_deploymentId' - The identifier of the Deployment resource for the Stage resource.
newCreateStage ::
  -- | 'restApiId'
  Prelude.Text ->
  -- | 'stageName'
  Prelude.Text ->
  -- | 'deploymentId'
  Prelude.Text ->
  CreateStage
newCreateStage :: Text -> Text -> Text -> CreateStage
newCreateStage Text
pRestApiId_ Text
pStageName_ Text
pDeploymentId_ =
  CreateStage'
    { $sel:cacheClusterEnabled:CreateStage' :: Maybe Bool
cacheClusterEnabled = forall a. Maybe a
Prelude.Nothing,
      $sel:cacheClusterSize:CreateStage' :: Maybe CacheClusterSize
cacheClusterSize = forall a. Maybe a
Prelude.Nothing,
      $sel:canarySettings:CreateStage' :: Maybe CanarySettings
canarySettings = forall a. Maybe a
Prelude.Nothing,
      $sel:description:CreateStage' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:documentationVersion:CreateStage' :: Maybe Text
documentationVersion = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:CreateStage' :: Maybe (HashMap Text Text)
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:tracingEnabled:CreateStage' :: Maybe Bool
tracingEnabled = forall a. Maybe a
Prelude.Nothing,
      $sel:variables:CreateStage' :: Maybe (HashMap Text Text)
variables = forall a. Maybe a
Prelude.Nothing,
      $sel:restApiId:CreateStage' :: Text
restApiId = Text
pRestApiId_,
      $sel:stageName:CreateStage' :: Text
stageName = Text
pStageName_,
      $sel:deploymentId:CreateStage' :: Text
deploymentId = Text
pDeploymentId_
    }

-- | Whether cache clustering is enabled for the stage.
createStage_cacheClusterEnabled :: Lens.Lens' CreateStage (Prelude.Maybe Prelude.Bool)
createStage_cacheClusterEnabled :: Lens' CreateStage (Maybe Bool)
createStage_cacheClusterEnabled = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateStage' {Maybe Bool
cacheClusterEnabled :: Maybe Bool
$sel:cacheClusterEnabled:CreateStage' :: CreateStage -> Maybe Bool
cacheClusterEnabled} -> Maybe Bool
cacheClusterEnabled) (\s :: CreateStage
s@CreateStage' {} Maybe Bool
a -> CreateStage
s {$sel:cacheClusterEnabled:CreateStage' :: Maybe Bool
cacheClusterEnabled = Maybe Bool
a} :: CreateStage)

-- | The stage\'s cache capacity in GB. For more information about choosing a
-- cache size, see
-- <https://docs.aws.amazon.com/apigateway/latest/developerguide/api-gateway-caching.html Enabling API caching to enhance responsiveness>.
createStage_cacheClusterSize :: Lens.Lens' CreateStage (Prelude.Maybe CacheClusterSize)
createStage_cacheClusterSize :: Lens' CreateStage (Maybe CacheClusterSize)
createStage_cacheClusterSize = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateStage' {Maybe CacheClusterSize
cacheClusterSize :: Maybe CacheClusterSize
$sel:cacheClusterSize:CreateStage' :: CreateStage -> Maybe CacheClusterSize
cacheClusterSize} -> Maybe CacheClusterSize
cacheClusterSize) (\s :: CreateStage
s@CreateStage' {} Maybe CacheClusterSize
a -> CreateStage
s {$sel:cacheClusterSize:CreateStage' :: Maybe CacheClusterSize
cacheClusterSize = Maybe CacheClusterSize
a} :: CreateStage)

-- | The canary deployment settings of this stage.
createStage_canarySettings :: Lens.Lens' CreateStage (Prelude.Maybe CanarySettings)
createStage_canarySettings :: Lens' CreateStage (Maybe CanarySettings)
createStage_canarySettings = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateStage' {Maybe CanarySettings
canarySettings :: Maybe CanarySettings
$sel:canarySettings:CreateStage' :: CreateStage -> Maybe CanarySettings
canarySettings} -> Maybe CanarySettings
canarySettings) (\s :: CreateStage
s@CreateStage' {} Maybe CanarySettings
a -> CreateStage
s {$sel:canarySettings:CreateStage' :: Maybe CanarySettings
canarySettings = Maybe CanarySettings
a} :: CreateStage)

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

-- | The version of the associated API documentation.
createStage_documentationVersion :: Lens.Lens' CreateStage (Prelude.Maybe Prelude.Text)
createStage_documentationVersion :: Lens' CreateStage (Maybe Text)
createStage_documentationVersion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateStage' {Maybe Text
documentationVersion :: Maybe Text
$sel:documentationVersion:CreateStage' :: CreateStage -> Maybe Text
documentationVersion} -> Maybe Text
documentationVersion) (\s :: CreateStage
s@CreateStage' {} Maybe Text
a -> CreateStage
s {$sel:documentationVersion:CreateStage' :: Maybe Text
documentationVersion = Maybe Text
a} :: CreateStage)

-- | The key-value map of strings. The valid character set is
-- [a-zA-Z+-=._:\/]. The tag key can be up to 128 characters and must not
-- start with @aws:@. The tag value can be up to 256 characters.
createStage_tags :: Lens.Lens' CreateStage (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
createStage_tags :: Lens' CreateStage (Maybe (HashMap Text Text))
createStage_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateStage' {Maybe (HashMap Text Text)
tags :: Maybe (HashMap Text Text)
$sel:tags:CreateStage' :: CreateStage -> Maybe (HashMap Text Text)
tags} -> Maybe (HashMap Text Text)
tags) (\s :: CreateStage
s@CreateStage' {} Maybe (HashMap Text Text)
a -> CreateStage
s {$sel:tags:CreateStage' :: Maybe (HashMap Text Text)
tags = Maybe (HashMap Text Text)
a} :: CreateStage) 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

-- | Specifies whether active tracing with X-ray is enabled for the Stage.
createStage_tracingEnabled :: Lens.Lens' CreateStage (Prelude.Maybe Prelude.Bool)
createStage_tracingEnabled :: Lens' CreateStage (Maybe Bool)
createStage_tracingEnabled = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateStage' {Maybe Bool
tracingEnabled :: Maybe Bool
$sel:tracingEnabled:CreateStage' :: CreateStage -> Maybe Bool
tracingEnabled} -> Maybe Bool
tracingEnabled) (\s :: CreateStage
s@CreateStage' {} Maybe Bool
a -> CreateStage
s {$sel:tracingEnabled:CreateStage' :: Maybe Bool
tracingEnabled = Maybe Bool
a} :: CreateStage)

-- | A map that defines the stage variables for the new Stage resource.
-- Variable names can have alphanumeric and underscore characters, and the
-- values must match @[A-Za-z0-9-._~:\/?#&=,]+@.
createStage_variables :: Lens.Lens' CreateStage (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
createStage_variables :: Lens' CreateStage (Maybe (HashMap Text Text))
createStage_variables = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateStage' {Maybe (HashMap Text Text)
variables :: Maybe (HashMap Text Text)
$sel:variables:CreateStage' :: CreateStage -> Maybe (HashMap Text Text)
variables} -> Maybe (HashMap Text Text)
variables) (\s :: CreateStage
s@CreateStage' {} Maybe (HashMap Text Text)
a -> CreateStage
s {$sel:variables:CreateStage' :: Maybe (HashMap Text Text)
variables = Maybe (HashMap Text Text)
a} :: CreateStage) 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 string identifier of the associated RestApi.
createStage_restApiId :: Lens.Lens' CreateStage Prelude.Text
createStage_restApiId :: Lens' CreateStage Text
createStage_restApiId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateStage' {Text
restApiId :: Text
$sel:restApiId:CreateStage' :: CreateStage -> Text
restApiId} -> Text
restApiId) (\s :: CreateStage
s@CreateStage' {} Text
a -> CreateStage
s {$sel:restApiId:CreateStage' :: Text
restApiId = Text
a} :: CreateStage)

-- | The name for the Stage resource. Stage names can only contain
-- alphanumeric characters, hyphens, and underscores. Maximum length is 128
-- characters.
createStage_stageName :: Lens.Lens' CreateStage Prelude.Text
createStage_stageName :: Lens' CreateStage Text
createStage_stageName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateStage' {Text
stageName :: Text
$sel:stageName:CreateStage' :: CreateStage -> Text
stageName} -> Text
stageName) (\s :: CreateStage
s@CreateStage' {} Text
a -> CreateStage
s {$sel:stageName:CreateStage' :: Text
stageName = Text
a} :: CreateStage)

-- | The identifier of the Deployment resource for the Stage resource.
createStage_deploymentId :: Lens.Lens' CreateStage Prelude.Text
createStage_deploymentId :: Lens' CreateStage Text
createStage_deploymentId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateStage' {Text
deploymentId :: Text
$sel:deploymentId:CreateStage' :: CreateStage -> Text
deploymentId} -> Text
deploymentId) (\s :: CreateStage
s@CreateStage' {} Text
a -> CreateStage
s {$sel:deploymentId:CreateStage' :: Text
deploymentId = Text
a} :: CreateStage)

instance Core.AWSRequest CreateStage where
  type AWSResponse CreateStage = Stage
  request :: (Service -> Service) -> CreateStage -> Request CreateStage
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 CreateStage
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CreateStage)))
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 -> forall a. FromJSON a => Object -> Either String a
Data.eitherParseJSON Object
x)

instance Prelude.Hashable CreateStage where
  hashWithSalt :: Int -> CreateStage -> Int
hashWithSalt Int
_salt CreateStage' {Maybe Bool
Maybe Text
Maybe (HashMap Text Text)
Maybe CacheClusterSize
Maybe CanarySettings
Text
deploymentId :: Text
stageName :: Text
restApiId :: Text
variables :: Maybe (HashMap Text Text)
tracingEnabled :: Maybe Bool
tags :: Maybe (HashMap Text Text)
documentationVersion :: Maybe Text
description :: Maybe Text
canarySettings :: Maybe CanarySettings
cacheClusterSize :: Maybe CacheClusterSize
cacheClusterEnabled :: Maybe Bool
$sel:deploymentId:CreateStage' :: CreateStage -> Text
$sel:stageName:CreateStage' :: CreateStage -> Text
$sel:restApiId:CreateStage' :: CreateStage -> Text
$sel:variables:CreateStage' :: CreateStage -> Maybe (HashMap Text Text)
$sel:tracingEnabled:CreateStage' :: CreateStage -> Maybe Bool
$sel:tags:CreateStage' :: CreateStage -> Maybe (HashMap Text Text)
$sel:documentationVersion:CreateStage' :: CreateStage -> Maybe Text
$sel:description:CreateStage' :: CreateStage -> Maybe Text
$sel:canarySettings:CreateStage' :: CreateStage -> Maybe CanarySettings
$sel:cacheClusterSize:CreateStage' :: CreateStage -> Maybe CacheClusterSize
$sel:cacheClusterEnabled:CreateStage' :: CreateStage -> Maybe Bool
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
cacheClusterEnabled
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe CacheClusterSize
cacheClusterSize
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe CanarySettings
canarySettings
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
documentationVersion
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Text)
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
tracingEnabled
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Text)
variables
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
restApiId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
stageName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
deploymentId

instance Prelude.NFData CreateStage where
  rnf :: CreateStage -> ()
rnf CreateStage' {Maybe Bool
Maybe Text
Maybe (HashMap Text Text)
Maybe CacheClusterSize
Maybe CanarySettings
Text
deploymentId :: Text
stageName :: Text
restApiId :: Text
variables :: Maybe (HashMap Text Text)
tracingEnabled :: Maybe Bool
tags :: Maybe (HashMap Text Text)
documentationVersion :: Maybe Text
description :: Maybe Text
canarySettings :: Maybe CanarySettings
cacheClusterSize :: Maybe CacheClusterSize
cacheClusterEnabled :: Maybe Bool
$sel:deploymentId:CreateStage' :: CreateStage -> Text
$sel:stageName:CreateStage' :: CreateStage -> Text
$sel:restApiId:CreateStage' :: CreateStage -> Text
$sel:variables:CreateStage' :: CreateStage -> Maybe (HashMap Text Text)
$sel:tracingEnabled:CreateStage' :: CreateStage -> Maybe Bool
$sel:tags:CreateStage' :: CreateStage -> Maybe (HashMap Text Text)
$sel:documentationVersion:CreateStage' :: CreateStage -> Maybe Text
$sel:description:CreateStage' :: CreateStage -> Maybe Text
$sel:canarySettings:CreateStage' :: CreateStage -> Maybe CanarySettings
$sel:cacheClusterSize:CreateStage' :: CreateStage -> Maybe CacheClusterSize
$sel:cacheClusterEnabled:CreateStage' :: CreateStage -> Maybe Bool
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
cacheClusterEnabled
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe CacheClusterSize
cacheClusterSize
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe CanarySettings
canarySettings
      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 Text
documentationVersion
      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 Maybe Bool
tracingEnabled
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text Text)
variables
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
restApiId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
stageName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
deploymentId

instance Data.ToHeaders CreateStage where
  toHeaders :: CreateStage -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"Accept"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# (ByteString
"application/json" :: Prelude.ByteString)
          ]
      )

instance Data.ToJSON CreateStage where
  toJSON :: CreateStage -> Value
toJSON CreateStage' {Maybe Bool
Maybe Text
Maybe (HashMap Text Text)
Maybe CacheClusterSize
Maybe CanarySettings
Text
deploymentId :: Text
stageName :: Text
restApiId :: Text
variables :: Maybe (HashMap Text Text)
tracingEnabled :: Maybe Bool
tags :: Maybe (HashMap Text Text)
documentationVersion :: Maybe Text
description :: Maybe Text
canarySettings :: Maybe CanarySettings
cacheClusterSize :: Maybe CacheClusterSize
cacheClusterEnabled :: Maybe Bool
$sel:deploymentId:CreateStage' :: CreateStage -> Text
$sel:stageName:CreateStage' :: CreateStage -> Text
$sel:restApiId:CreateStage' :: CreateStage -> Text
$sel:variables:CreateStage' :: CreateStage -> Maybe (HashMap Text Text)
$sel:tracingEnabled:CreateStage' :: CreateStage -> Maybe Bool
$sel:tags:CreateStage' :: CreateStage -> Maybe (HashMap Text Text)
$sel:documentationVersion:CreateStage' :: CreateStage -> Maybe Text
$sel:description:CreateStage' :: CreateStage -> Maybe Text
$sel:canarySettings:CreateStage' :: CreateStage -> Maybe CanarySettings
$sel:cacheClusterSize:CreateStage' :: CreateStage -> Maybe CacheClusterSize
$sel:cacheClusterEnabled:CreateStage' :: CreateStage -> Maybe Bool
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"cacheClusterEnabled" 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 Bool
cacheClusterEnabled,
            (Key
"cacheClusterSize" 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 CacheClusterSize
cacheClusterSize,
            (Key
"canarySettings" 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 CanarySettings
canarySettings,
            (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
"documentationVersion" 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
documentationVersion,
            (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,
            (Key
"tracingEnabled" 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 Bool
tracingEnabled,
            (Key
"variables" 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)
variables,
            forall a. a -> Maybe a
Prelude.Just (Key
"stageName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
stageName),
            forall a. a -> Maybe a
Prelude.Just (Key
"deploymentId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
deploymentId)
          ]
      )

instance Data.ToPath CreateStage where
  toPath :: CreateStage -> ByteString
toPath CreateStage' {Maybe Bool
Maybe Text
Maybe (HashMap Text Text)
Maybe CacheClusterSize
Maybe CanarySettings
Text
deploymentId :: Text
stageName :: Text
restApiId :: Text
variables :: Maybe (HashMap Text Text)
tracingEnabled :: Maybe Bool
tags :: Maybe (HashMap Text Text)
documentationVersion :: Maybe Text
description :: Maybe Text
canarySettings :: Maybe CanarySettings
cacheClusterSize :: Maybe CacheClusterSize
cacheClusterEnabled :: Maybe Bool
$sel:deploymentId:CreateStage' :: CreateStage -> Text
$sel:stageName:CreateStage' :: CreateStage -> Text
$sel:restApiId:CreateStage' :: CreateStage -> Text
$sel:variables:CreateStage' :: CreateStage -> Maybe (HashMap Text Text)
$sel:tracingEnabled:CreateStage' :: CreateStage -> Maybe Bool
$sel:tags:CreateStage' :: CreateStage -> Maybe (HashMap Text Text)
$sel:documentationVersion:CreateStage' :: CreateStage -> Maybe Text
$sel:description:CreateStage' :: CreateStage -> Maybe Text
$sel:canarySettings:CreateStage' :: CreateStage -> Maybe CanarySettings
$sel:cacheClusterSize:CreateStage' :: CreateStage -> Maybe CacheClusterSize
$sel:cacheClusterEnabled:CreateStage' :: CreateStage -> Maybe Bool
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ByteString
"/restapis/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
restApiId, ByteString
"/stages"]

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