{-# 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.CreateDeployment
-- 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 Deployment resource, which makes a specified RestApi callable
-- over the internet.
module Amazonka.APIGateway.CreateDeployment
  ( -- * Creating a Request
    CreateDeployment (..),
    newCreateDeployment,

    -- * Request Lenses
    createDeployment_cacheClusterEnabled,
    createDeployment_cacheClusterSize,
    createDeployment_canarySettings,
    createDeployment_description,
    createDeployment_stageDescription,
    createDeployment_stageName,
    createDeployment_tracingEnabled,
    createDeployment_variables,
    createDeployment_restApiId,

    -- * Destructuring the Response
    Deployment (..),
    newDeployment,

    -- * Response Lenses
    deployment_apiSummary,
    deployment_createdDate,
    deployment_description,
    deployment_id,
  )
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 Deployment resource.
--
-- /See:/ 'newCreateDeployment' smart constructor.
data CreateDeployment = CreateDeployment'
  { -- | Enables a cache cluster for the Stage resource specified in the input.
    CreateDeployment -> 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>.
    CreateDeployment -> Maybe CacheClusterSize
cacheClusterSize :: Prelude.Maybe CacheClusterSize,
    -- | The input configuration for the canary deployment when the deployment is
    -- a canary release deployment.
    CreateDeployment -> Maybe DeploymentCanarySettings
canarySettings :: Prelude.Maybe DeploymentCanarySettings,
    -- | The description for the Deployment resource to create.
    CreateDeployment -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | The description of the Stage resource for the Deployment resource to
    -- create.
    CreateDeployment -> Maybe Text
stageDescription :: Prelude.Maybe Prelude.Text,
    -- | The name of the Stage resource for the Deployment resource to create.
    CreateDeployment -> Maybe Text
stageName :: Prelude.Maybe Prelude.Text,
    -- | Specifies whether active tracing with X-ray is enabled for the Stage.
    CreateDeployment -> Maybe Bool
tracingEnabled :: Prelude.Maybe Prelude.Bool,
    -- | A map that defines the stage variables for the Stage resource that is
    -- associated with the new deployment. Variable names can have alphanumeric
    -- and underscore characters, and the values must match
    -- @[A-Za-z0-9-._~:\/?#&=,]+@.
    CreateDeployment -> Maybe (HashMap Text Text)
variables :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | The string identifier of the associated RestApi.
    CreateDeployment -> Text
restApiId :: Prelude.Text
  }
  deriving (CreateDeployment -> CreateDeployment -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateDeployment -> CreateDeployment -> Bool
$c/= :: CreateDeployment -> CreateDeployment -> Bool
== :: CreateDeployment -> CreateDeployment -> Bool
$c== :: CreateDeployment -> CreateDeployment -> Bool
Prelude.Eq, ReadPrec [CreateDeployment]
ReadPrec CreateDeployment
Int -> ReadS CreateDeployment
ReadS [CreateDeployment]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateDeployment]
$creadListPrec :: ReadPrec [CreateDeployment]
readPrec :: ReadPrec CreateDeployment
$creadPrec :: ReadPrec CreateDeployment
readList :: ReadS [CreateDeployment]
$creadList :: ReadS [CreateDeployment]
readsPrec :: Int -> ReadS CreateDeployment
$creadsPrec :: Int -> ReadS CreateDeployment
Prelude.Read, Int -> CreateDeployment -> ShowS
[CreateDeployment] -> ShowS
CreateDeployment -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateDeployment] -> ShowS
$cshowList :: [CreateDeployment] -> ShowS
show :: CreateDeployment -> String
$cshow :: CreateDeployment -> String
showsPrec :: Int -> CreateDeployment -> ShowS
$cshowsPrec :: Int -> CreateDeployment -> ShowS
Prelude.Show, forall x. Rep CreateDeployment x -> CreateDeployment
forall x. CreateDeployment -> Rep CreateDeployment x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateDeployment x -> CreateDeployment
$cfrom :: forall x. CreateDeployment -> Rep CreateDeployment x
Prelude.Generic)

-- |
-- Create a value of 'CreateDeployment' 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', 'createDeployment_cacheClusterEnabled' - Enables a cache cluster for the Stage resource specified in the input.
--
-- 'cacheClusterSize', 'createDeployment_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', 'createDeployment_canarySettings' - The input configuration for the canary deployment when the deployment is
-- a canary release deployment.
--
-- 'description', 'createDeployment_description' - The description for the Deployment resource to create.
--
-- 'stageDescription', 'createDeployment_stageDescription' - The description of the Stage resource for the Deployment resource to
-- create.
--
-- 'stageName', 'createDeployment_stageName' - The name of the Stage resource for the Deployment resource to create.
--
-- 'tracingEnabled', 'createDeployment_tracingEnabled' - Specifies whether active tracing with X-ray is enabled for the Stage.
--
-- 'variables', 'createDeployment_variables' - A map that defines the stage variables for the Stage resource that is
-- associated with the new deployment. Variable names can have alphanumeric
-- and underscore characters, and the values must match
-- @[A-Za-z0-9-._~:\/?#&=,]+@.
--
-- 'restApiId', 'createDeployment_restApiId' - The string identifier of the associated RestApi.
newCreateDeployment ::
  -- | 'restApiId'
  Prelude.Text ->
  CreateDeployment
newCreateDeployment :: Text -> CreateDeployment
newCreateDeployment Text
pRestApiId_ =
  CreateDeployment'
    { $sel:cacheClusterEnabled:CreateDeployment' :: Maybe Bool
cacheClusterEnabled =
        forall a. Maybe a
Prelude.Nothing,
      $sel:cacheClusterSize:CreateDeployment' :: Maybe CacheClusterSize
cacheClusterSize = forall a. Maybe a
Prelude.Nothing,
      $sel:canarySettings:CreateDeployment' :: Maybe DeploymentCanarySettings
canarySettings = forall a. Maybe a
Prelude.Nothing,
      $sel:description:CreateDeployment' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:stageDescription:CreateDeployment' :: Maybe Text
stageDescription = forall a. Maybe a
Prelude.Nothing,
      $sel:stageName:CreateDeployment' :: Maybe Text
stageName = forall a. Maybe a
Prelude.Nothing,
      $sel:tracingEnabled:CreateDeployment' :: Maybe Bool
tracingEnabled = forall a. Maybe a
Prelude.Nothing,
      $sel:variables:CreateDeployment' :: Maybe (HashMap Text Text)
variables = forall a. Maybe a
Prelude.Nothing,
      $sel:restApiId:CreateDeployment' :: Text
restApiId = Text
pRestApiId_
    }

-- | Enables a cache cluster for the Stage resource specified in the input.
createDeployment_cacheClusterEnabled :: Lens.Lens' CreateDeployment (Prelude.Maybe Prelude.Bool)
createDeployment_cacheClusterEnabled :: Lens' CreateDeployment (Maybe Bool)
createDeployment_cacheClusterEnabled = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDeployment' {Maybe Bool
cacheClusterEnabled :: Maybe Bool
$sel:cacheClusterEnabled:CreateDeployment' :: CreateDeployment -> Maybe Bool
cacheClusterEnabled} -> Maybe Bool
cacheClusterEnabled) (\s :: CreateDeployment
s@CreateDeployment' {} Maybe Bool
a -> CreateDeployment
s {$sel:cacheClusterEnabled:CreateDeployment' :: Maybe Bool
cacheClusterEnabled = Maybe Bool
a} :: CreateDeployment)

-- | 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>.
createDeployment_cacheClusterSize :: Lens.Lens' CreateDeployment (Prelude.Maybe CacheClusterSize)
createDeployment_cacheClusterSize :: Lens' CreateDeployment (Maybe CacheClusterSize)
createDeployment_cacheClusterSize = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDeployment' {Maybe CacheClusterSize
cacheClusterSize :: Maybe CacheClusterSize
$sel:cacheClusterSize:CreateDeployment' :: CreateDeployment -> Maybe CacheClusterSize
cacheClusterSize} -> Maybe CacheClusterSize
cacheClusterSize) (\s :: CreateDeployment
s@CreateDeployment' {} Maybe CacheClusterSize
a -> CreateDeployment
s {$sel:cacheClusterSize:CreateDeployment' :: Maybe CacheClusterSize
cacheClusterSize = Maybe CacheClusterSize
a} :: CreateDeployment)

-- | The input configuration for the canary deployment when the deployment is
-- a canary release deployment.
createDeployment_canarySettings :: Lens.Lens' CreateDeployment (Prelude.Maybe DeploymentCanarySettings)
createDeployment_canarySettings :: Lens' CreateDeployment (Maybe DeploymentCanarySettings)
createDeployment_canarySettings = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDeployment' {Maybe DeploymentCanarySettings
canarySettings :: Maybe DeploymentCanarySettings
$sel:canarySettings:CreateDeployment' :: CreateDeployment -> Maybe DeploymentCanarySettings
canarySettings} -> Maybe DeploymentCanarySettings
canarySettings) (\s :: CreateDeployment
s@CreateDeployment' {} Maybe DeploymentCanarySettings
a -> CreateDeployment
s {$sel:canarySettings:CreateDeployment' :: Maybe DeploymentCanarySettings
canarySettings = Maybe DeploymentCanarySettings
a} :: CreateDeployment)

-- | The description for the Deployment resource to create.
createDeployment_description :: Lens.Lens' CreateDeployment (Prelude.Maybe Prelude.Text)
createDeployment_description :: Lens' CreateDeployment (Maybe Text)
createDeployment_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDeployment' {Maybe Text
description :: Maybe Text
$sel:description:CreateDeployment' :: CreateDeployment -> Maybe Text
description} -> Maybe Text
description) (\s :: CreateDeployment
s@CreateDeployment' {} Maybe Text
a -> CreateDeployment
s {$sel:description:CreateDeployment' :: Maybe Text
description = Maybe Text
a} :: CreateDeployment)

-- | The description of the Stage resource for the Deployment resource to
-- create.
createDeployment_stageDescription :: Lens.Lens' CreateDeployment (Prelude.Maybe Prelude.Text)
createDeployment_stageDescription :: Lens' CreateDeployment (Maybe Text)
createDeployment_stageDescription = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDeployment' {Maybe Text
stageDescription :: Maybe Text
$sel:stageDescription:CreateDeployment' :: CreateDeployment -> Maybe Text
stageDescription} -> Maybe Text
stageDescription) (\s :: CreateDeployment
s@CreateDeployment' {} Maybe Text
a -> CreateDeployment
s {$sel:stageDescription:CreateDeployment' :: Maybe Text
stageDescription = Maybe Text
a} :: CreateDeployment)

-- | The name of the Stage resource for the Deployment resource to create.
createDeployment_stageName :: Lens.Lens' CreateDeployment (Prelude.Maybe Prelude.Text)
createDeployment_stageName :: Lens' CreateDeployment (Maybe Text)
createDeployment_stageName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDeployment' {Maybe Text
stageName :: Maybe Text
$sel:stageName:CreateDeployment' :: CreateDeployment -> Maybe Text
stageName} -> Maybe Text
stageName) (\s :: CreateDeployment
s@CreateDeployment' {} Maybe Text
a -> CreateDeployment
s {$sel:stageName:CreateDeployment' :: Maybe Text
stageName = Maybe Text
a} :: CreateDeployment)

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

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

instance Core.AWSRequest CreateDeployment where
  type AWSResponse CreateDeployment = Deployment
  request :: (Service -> Service)
-> CreateDeployment -> Request CreateDeployment
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 CreateDeployment
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CreateDeployment)))
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 CreateDeployment where
  hashWithSalt :: Int -> CreateDeployment -> Int
hashWithSalt Int
_salt CreateDeployment' {Maybe Bool
Maybe Text
Maybe (HashMap Text Text)
Maybe CacheClusterSize
Maybe DeploymentCanarySettings
Text
restApiId :: Text
variables :: Maybe (HashMap Text Text)
tracingEnabled :: Maybe Bool
stageName :: Maybe Text
stageDescription :: Maybe Text
description :: Maybe Text
canarySettings :: Maybe DeploymentCanarySettings
cacheClusterSize :: Maybe CacheClusterSize
cacheClusterEnabled :: Maybe Bool
$sel:restApiId:CreateDeployment' :: CreateDeployment -> Text
$sel:variables:CreateDeployment' :: CreateDeployment -> Maybe (HashMap Text Text)
$sel:tracingEnabled:CreateDeployment' :: CreateDeployment -> Maybe Bool
$sel:stageName:CreateDeployment' :: CreateDeployment -> Maybe Text
$sel:stageDescription:CreateDeployment' :: CreateDeployment -> Maybe Text
$sel:description:CreateDeployment' :: CreateDeployment -> Maybe Text
$sel:canarySettings:CreateDeployment' :: CreateDeployment -> Maybe DeploymentCanarySettings
$sel:cacheClusterSize:CreateDeployment' :: CreateDeployment -> Maybe CacheClusterSize
$sel:cacheClusterEnabled:CreateDeployment' :: CreateDeployment -> 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 DeploymentCanarySettings
canarySettings
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
stageDescription
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
stageName
      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

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

instance Data.ToHeaders CreateDeployment where
  toHeaders :: CreateDeployment -> 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 CreateDeployment where
  toJSON :: CreateDeployment -> Value
toJSON CreateDeployment' {Maybe Bool
Maybe Text
Maybe (HashMap Text Text)
Maybe CacheClusterSize
Maybe DeploymentCanarySettings
Text
restApiId :: Text
variables :: Maybe (HashMap Text Text)
tracingEnabled :: Maybe Bool
stageName :: Maybe Text
stageDescription :: Maybe Text
description :: Maybe Text
canarySettings :: Maybe DeploymentCanarySettings
cacheClusterSize :: Maybe CacheClusterSize
cacheClusterEnabled :: Maybe Bool
$sel:restApiId:CreateDeployment' :: CreateDeployment -> Text
$sel:variables:CreateDeployment' :: CreateDeployment -> Maybe (HashMap Text Text)
$sel:tracingEnabled:CreateDeployment' :: CreateDeployment -> Maybe Bool
$sel:stageName:CreateDeployment' :: CreateDeployment -> Maybe Text
$sel:stageDescription:CreateDeployment' :: CreateDeployment -> Maybe Text
$sel:description:CreateDeployment' :: CreateDeployment -> Maybe Text
$sel:canarySettings:CreateDeployment' :: CreateDeployment -> Maybe DeploymentCanarySettings
$sel:cacheClusterSize:CreateDeployment' :: CreateDeployment -> Maybe CacheClusterSize
$sel:cacheClusterEnabled:CreateDeployment' :: CreateDeployment -> 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 DeploymentCanarySettings
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
"stageDescription" 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
stageDescription,
            (Key
"stageName" 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
stageName,
            (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
          ]
      )

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

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