{-# 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.CodeDeploy.CreateDeploymentConfig
-- 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 configuration.
module Amazonka.CodeDeploy.CreateDeploymentConfig
  ( -- * Creating a Request
    CreateDeploymentConfig (..),
    newCreateDeploymentConfig,

    -- * Request Lenses
    createDeploymentConfig_computePlatform,
    createDeploymentConfig_minimumHealthyHosts,
    createDeploymentConfig_trafficRoutingConfig,
    createDeploymentConfig_deploymentConfigName,

    -- * Destructuring the Response
    CreateDeploymentConfigResponse (..),
    newCreateDeploymentConfigResponse,

    -- * Response Lenses
    createDeploymentConfigResponse_deploymentConfigId,
    createDeploymentConfigResponse_httpStatus,
  )
where

import Amazonka.CodeDeploy.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

-- | Represents the input of a @CreateDeploymentConfig@ operation.
--
-- /See:/ 'newCreateDeploymentConfig' smart constructor.
data CreateDeploymentConfig = CreateDeploymentConfig'
  { -- | The destination platform type for the deployment (@Lambda@, @Server@, or
    -- @ECS@).
    CreateDeploymentConfig -> Maybe ComputePlatform
computePlatform :: Prelude.Maybe ComputePlatform,
    -- | The minimum number of healthy instances that should be available at any
    -- time during the deployment. There are two parameters expected in the
    -- input: type and value.
    --
    -- The type parameter takes either of the following values:
    --
    -- -   HOST_COUNT: The value parameter represents the minimum number of
    --     healthy instances as an absolute value.
    --
    -- -   FLEET_PERCENT: The value parameter represents the minimum number of
    --     healthy instances as a percentage of the total number of instances
    --     in the deployment. If you specify FLEET_PERCENT, at the start of the
    --     deployment, CodeDeploy converts the percentage to the equivalent
    --     number of instances and rounds up fractional instances.
    --
    -- The value parameter takes an integer.
    --
    -- For example, to set a minimum of 95% healthy instance, specify a type of
    -- FLEET_PERCENT and a value of 95.
    CreateDeploymentConfig -> Maybe MinimumHealthyHosts
minimumHealthyHosts :: Prelude.Maybe MinimumHealthyHosts,
    -- | The configuration that specifies how the deployment traffic is routed.
    CreateDeploymentConfig -> Maybe TrafficRoutingConfig
trafficRoutingConfig :: Prelude.Maybe TrafficRoutingConfig,
    -- | The name of the deployment configuration to create.
    CreateDeploymentConfig -> Text
deploymentConfigName :: Prelude.Text
  }
  deriving (CreateDeploymentConfig -> CreateDeploymentConfig -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateDeploymentConfig -> CreateDeploymentConfig -> Bool
$c/= :: CreateDeploymentConfig -> CreateDeploymentConfig -> Bool
== :: CreateDeploymentConfig -> CreateDeploymentConfig -> Bool
$c== :: CreateDeploymentConfig -> CreateDeploymentConfig -> Bool
Prelude.Eq, ReadPrec [CreateDeploymentConfig]
ReadPrec CreateDeploymentConfig
Int -> ReadS CreateDeploymentConfig
ReadS [CreateDeploymentConfig]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateDeploymentConfig]
$creadListPrec :: ReadPrec [CreateDeploymentConfig]
readPrec :: ReadPrec CreateDeploymentConfig
$creadPrec :: ReadPrec CreateDeploymentConfig
readList :: ReadS [CreateDeploymentConfig]
$creadList :: ReadS [CreateDeploymentConfig]
readsPrec :: Int -> ReadS CreateDeploymentConfig
$creadsPrec :: Int -> ReadS CreateDeploymentConfig
Prelude.Read, Int -> CreateDeploymentConfig -> ShowS
[CreateDeploymentConfig] -> ShowS
CreateDeploymentConfig -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateDeploymentConfig] -> ShowS
$cshowList :: [CreateDeploymentConfig] -> ShowS
show :: CreateDeploymentConfig -> String
$cshow :: CreateDeploymentConfig -> String
showsPrec :: Int -> CreateDeploymentConfig -> ShowS
$cshowsPrec :: Int -> CreateDeploymentConfig -> ShowS
Prelude.Show, forall x. Rep CreateDeploymentConfig x -> CreateDeploymentConfig
forall x. CreateDeploymentConfig -> Rep CreateDeploymentConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateDeploymentConfig x -> CreateDeploymentConfig
$cfrom :: forall x. CreateDeploymentConfig -> Rep CreateDeploymentConfig x
Prelude.Generic)

-- |
-- Create a value of 'CreateDeploymentConfig' 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:
--
-- 'computePlatform', 'createDeploymentConfig_computePlatform' - The destination platform type for the deployment (@Lambda@, @Server@, or
-- @ECS@).
--
-- 'minimumHealthyHosts', 'createDeploymentConfig_minimumHealthyHosts' - The minimum number of healthy instances that should be available at any
-- time during the deployment. There are two parameters expected in the
-- input: type and value.
--
-- The type parameter takes either of the following values:
--
-- -   HOST_COUNT: The value parameter represents the minimum number of
--     healthy instances as an absolute value.
--
-- -   FLEET_PERCENT: The value parameter represents the minimum number of
--     healthy instances as a percentage of the total number of instances
--     in the deployment. If you specify FLEET_PERCENT, at the start of the
--     deployment, CodeDeploy converts the percentage to the equivalent
--     number of instances and rounds up fractional instances.
--
-- The value parameter takes an integer.
--
-- For example, to set a minimum of 95% healthy instance, specify a type of
-- FLEET_PERCENT and a value of 95.
--
-- 'trafficRoutingConfig', 'createDeploymentConfig_trafficRoutingConfig' - The configuration that specifies how the deployment traffic is routed.
--
-- 'deploymentConfigName', 'createDeploymentConfig_deploymentConfigName' - The name of the deployment configuration to create.
newCreateDeploymentConfig ::
  -- | 'deploymentConfigName'
  Prelude.Text ->
  CreateDeploymentConfig
newCreateDeploymentConfig :: Text -> CreateDeploymentConfig
newCreateDeploymentConfig Text
pDeploymentConfigName_ =
  CreateDeploymentConfig'
    { $sel:computePlatform:CreateDeploymentConfig' :: Maybe ComputePlatform
computePlatform =
        forall a. Maybe a
Prelude.Nothing,
      $sel:minimumHealthyHosts:CreateDeploymentConfig' :: Maybe MinimumHealthyHosts
minimumHealthyHosts = forall a. Maybe a
Prelude.Nothing,
      $sel:trafficRoutingConfig:CreateDeploymentConfig' :: Maybe TrafficRoutingConfig
trafficRoutingConfig = forall a. Maybe a
Prelude.Nothing,
      $sel:deploymentConfigName:CreateDeploymentConfig' :: Text
deploymentConfigName = Text
pDeploymentConfigName_
    }

-- | The destination platform type for the deployment (@Lambda@, @Server@, or
-- @ECS@).
createDeploymentConfig_computePlatform :: Lens.Lens' CreateDeploymentConfig (Prelude.Maybe ComputePlatform)
createDeploymentConfig_computePlatform :: Lens' CreateDeploymentConfig (Maybe ComputePlatform)
createDeploymentConfig_computePlatform = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDeploymentConfig' {Maybe ComputePlatform
computePlatform :: Maybe ComputePlatform
$sel:computePlatform:CreateDeploymentConfig' :: CreateDeploymentConfig -> Maybe ComputePlatform
computePlatform} -> Maybe ComputePlatform
computePlatform) (\s :: CreateDeploymentConfig
s@CreateDeploymentConfig' {} Maybe ComputePlatform
a -> CreateDeploymentConfig
s {$sel:computePlatform:CreateDeploymentConfig' :: Maybe ComputePlatform
computePlatform = Maybe ComputePlatform
a} :: CreateDeploymentConfig)

-- | The minimum number of healthy instances that should be available at any
-- time during the deployment. There are two parameters expected in the
-- input: type and value.
--
-- The type parameter takes either of the following values:
--
-- -   HOST_COUNT: The value parameter represents the minimum number of
--     healthy instances as an absolute value.
--
-- -   FLEET_PERCENT: The value parameter represents the minimum number of
--     healthy instances as a percentage of the total number of instances
--     in the deployment. If you specify FLEET_PERCENT, at the start of the
--     deployment, CodeDeploy converts the percentage to the equivalent
--     number of instances and rounds up fractional instances.
--
-- The value parameter takes an integer.
--
-- For example, to set a minimum of 95% healthy instance, specify a type of
-- FLEET_PERCENT and a value of 95.
createDeploymentConfig_minimumHealthyHosts :: Lens.Lens' CreateDeploymentConfig (Prelude.Maybe MinimumHealthyHosts)
createDeploymentConfig_minimumHealthyHosts :: Lens' CreateDeploymentConfig (Maybe MinimumHealthyHosts)
createDeploymentConfig_minimumHealthyHosts = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDeploymentConfig' {Maybe MinimumHealthyHosts
minimumHealthyHosts :: Maybe MinimumHealthyHosts
$sel:minimumHealthyHosts:CreateDeploymentConfig' :: CreateDeploymentConfig -> Maybe MinimumHealthyHosts
minimumHealthyHosts} -> Maybe MinimumHealthyHosts
minimumHealthyHosts) (\s :: CreateDeploymentConfig
s@CreateDeploymentConfig' {} Maybe MinimumHealthyHosts
a -> CreateDeploymentConfig
s {$sel:minimumHealthyHosts:CreateDeploymentConfig' :: Maybe MinimumHealthyHosts
minimumHealthyHosts = Maybe MinimumHealthyHosts
a} :: CreateDeploymentConfig)

-- | The configuration that specifies how the deployment traffic is routed.
createDeploymentConfig_trafficRoutingConfig :: Lens.Lens' CreateDeploymentConfig (Prelude.Maybe TrafficRoutingConfig)
createDeploymentConfig_trafficRoutingConfig :: Lens' CreateDeploymentConfig (Maybe TrafficRoutingConfig)
createDeploymentConfig_trafficRoutingConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDeploymentConfig' {Maybe TrafficRoutingConfig
trafficRoutingConfig :: Maybe TrafficRoutingConfig
$sel:trafficRoutingConfig:CreateDeploymentConfig' :: CreateDeploymentConfig -> Maybe TrafficRoutingConfig
trafficRoutingConfig} -> Maybe TrafficRoutingConfig
trafficRoutingConfig) (\s :: CreateDeploymentConfig
s@CreateDeploymentConfig' {} Maybe TrafficRoutingConfig
a -> CreateDeploymentConfig
s {$sel:trafficRoutingConfig:CreateDeploymentConfig' :: Maybe TrafficRoutingConfig
trafficRoutingConfig = Maybe TrafficRoutingConfig
a} :: CreateDeploymentConfig)

-- | The name of the deployment configuration to create.
createDeploymentConfig_deploymentConfigName :: Lens.Lens' CreateDeploymentConfig Prelude.Text
createDeploymentConfig_deploymentConfigName :: Lens' CreateDeploymentConfig Text
createDeploymentConfig_deploymentConfigName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDeploymentConfig' {Text
deploymentConfigName :: Text
$sel:deploymentConfigName:CreateDeploymentConfig' :: CreateDeploymentConfig -> Text
deploymentConfigName} -> Text
deploymentConfigName) (\s :: CreateDeploymentConfig
s@CreateDeploymentConfig' {} Text
a -> CreateDeploymentConfig
s {$sel:deploymentConfigName:CreateDeploymentConfig' :: Text
deploymentConfigName = Text
a} :: CreateDeploymentConfig)

instance Core.AWSRequest CreateDeploymentConfig where
  type
    AWSResponse CreateDeploymentConfig =
      CreateDeploymentConfigResponse
  request :: (Service -> Service)
-> CreateDeploymentConfig -> Request CreateDeploymentConfig
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 CreateDeploymentConfig
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CreateDeploymentConfig)))
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 Text -> Int -> CreateDeploymentConfigResponse
CreateDeploymentConfigResponse'
            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
"deploymentConfigId")
            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 CreateDeploymentConfig where
  hashWithSalt :: Int -> CreateDeploymentConfig -> Int
hashWithSalt Int
_salt CreateDeploymentConfig' {Maybe ComputePlatform
Maybe MinimumHealthyHosts
Maybe TrafficRoutingConfig
Text
deploymentConfigName :: Text
trafficRoutingConfig :: Maybe TrafficRoutingConfig
minimumHealthyHosts :: Maybe MinimumHealthyHosts
computePlatform :: Maybe ComputePlatform
$sel:deploymentConfigName:CreateDeploymentConfig' :: CreateDeploymentConfig -> Text
$sel:trafficRoutingConfig:CreateDeploymentConfig' :: CreateDeploymentConfig -> Maybe TrafficRoutingConfig
$sel:minimumHealthyHosts:CreateDeploymentConfig' :: CreateDeploymentConfig -> Maybe MinimumHealthyHosts
$sel:computePlatform:CreateDeploymentConfig' :: CreateDeploymentConfig -> Maybe ComputePlatform
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ComputePlatform
computePlatform
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe MinimumHealthyHosts
minimumHealthyHosts
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe TrafficRoutingConfig
trafficRoutingConfig
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
deploymentConfigName

instance Prelude.NFData CreateDeploymentConfig where
  rnf :: CreateDeploymentConfig -> ()
rnf CreateDeploymentConfig' {Maybe ComputePlatform
Maybe MinimumHealthyHosts
Maybe TrafficRoutingConfig
Text
deploymentConfigName :: Text
trafficRoutingConfig :: Maybe TrafficRoutingConfig
minimumHealthyHosts :: Maybe MinimumHealthyHosts
computePlatform :: Maybe ComputePlatform
$sel:deploymentConfigName:CreateDeploymentConfig' :: CreateDeploymentConfig -> Text
$sel:trafficRoutingConfig:CreateDeploymentConfig' :: CreateDeploymentConfig -> Maybe TrafficRoutingConfig
$sel:minimumHealthyHosts:CreateDeploymentConfig' :: CreateDeploymentConfig -> Maybe MinimumHealthyHosts
$sel:computePlatform:CreateDeploymentConfig' :: CreateDeploymentConfig -> Maybe ComputePlatform
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe ComputePlatform
computePlatform
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe MinimumHealthyHosts
minimumHealthyHosts
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe TrafficRoutingConfig
trafficRoutingConfig
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
deploymentConfigName

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

instance Data.ToJSON CreateDeploymentConfig where
  toJSON :: CreateDeploymentConfig -> Value
toJSON CreateDeploymentConfig' {Maybe ComputePlatform
Maybe MinimumHealthyHosts
Maybe TrafficRoutingConfig
Text
deploymentConfigName :: Text
trafficRoutingConfig :: Maybe TrafficRoutingConfig
minimumHealthyHosts :: Maybe MinimumHealthyHosts
computePlatform :: Maybe ComputePlatform
$sel:deploymentConfigName:CreateDeploymentConfig' :: CreateDeploymentConfig -> Text
$sel:trafficRoutingConfig:CreateDeploymentConfig' :: CreateDeploymentConfig -> Maybe TrafficRoutingConfig
$sel:minimumHealthyHosts:CreateDeploymentConfig' :: CreateDeploymentConfig -> Maybe MinimumHealthyHosts
$sel:computePlatform:CreateDeploymentConfig' :: CreateDeploymentConfig -> Maybe ComputePlatform
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"computePlatform" 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 ComputePlatform
computePlatform,
            (Key
"minimumHealthyHosts" 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 MinimumHealthyHosts
minimumHealthyHosts,
            (Key
"trafficRoutingConfig" 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 TrafficRoutingConfig
trafficRoutingConfig,
            forall a. a -> Maybe a
Prelude.Just
              ( Key
"deploymentConfigName"
                  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
deploymentConfigName
              )
          ]
      )

instance Data.ToPath CreateDeploymentConfig where
  toPath :: CreateDeploymentConfig -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

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

-- | Represents the output of a @CreateDeploymentConfig@ operation.
--
-- /See:/ 'newCreateDeploymentConfigResponse' smart constructor.
data CreateDeploymentConfigResponse = CreateDeploymentConfigResponse'
  { -- | A unique deployment configuration ID.
    CreateDeploymentConfigResponse -> Maybe Text
deploymentConfigId :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    CreateDeploymentConfigResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CreateDeploymentConfigResponse
-> CreateDeploymentConfigResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateDeploymentConfigResponse
-> CreateDeploymentConfigResponse -> Bool
$c/= :: CreateDeploymentConfigResponse
-> CreateDeploymentConfigResponse -> Bool
== :: CreateDeploymentConfigResponse
-> CreateDeploymentConfigResponse -> Bool
$c== :: CreateDeploymentConfigResponse
-> CreateDeploymentConfigResponse -> Bool
Prelude.Eq, ReadPrec [CreateDeploymentConfigResponse]
ReadPrec CreateDeploymentConfigResponse
Int -> ReadS CreateDeploymentConfigResponse
ReadS [CreateDeploymentConfigResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateDeploymentConfigResponse]
$creadListPrec :: ReadPrec [CreateDeploymentConfigResponse]
readPrec :: ReadPrec CreateDeploymentConfigResponse
$creadPrec :: ReadPrec CreateDeploymentConfigResponse
readList :: ReadS [CreateDeploymentConfigResponse]
$creadList :: ReadS [CreateDeploymentConfigResponse]
readsPrec :: Int -> ReadS CreateDeploymentConfigResponse
$creadsPrec :: Int -> ReadS CreateDeploymentConfigResponse
Prelude.Read, Int -> CreateDeploymentConfigResponse -> ShowS
[CreateDeploymentConfigResponse] -> ShowS
CreateDeploymentConfigResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateDeploymentConfigResponse] -> ShowS
$cshowList :: [CreateDeploymentConfigResponse] -> ShowS
show :: CreateDeploymentConfigResponse -> String
$cshow :: CreateDeploymentConfigResponse -> String
showsPrec :: Int -> CreateDeploymentConfigResponse -> ShowS
$cshowsPrec :: Int -> CreateDeploymentConfigResponse -> ShowS
Prelude.Show, forall x.
Rep CreateDeploymentConfigResponse x
-> CreateDeploymentConfigResponse
forall x.
CreateDeploymentConfigResponse
-> Rep CreateDeploymentConfigResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateDeploymentConfigResponse x
-> CreateDeploymentConfigResponse
$cfrom :: forall x.
CreateDeploymentConfigResponse
-> Rep CreateDeploymentConfigResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateDeploymentConfigResponse' 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:
--
-- 'deploymentConfigId', 'createDeploymentConfigResponse_deploymentConfigId' - A unique deployment configuration ID.
--
-- 'httpStatus', 'createDeploymentConfigResponse_httpStatus' - The response's http status code.
newCreateDeploymentConfigResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateDeploymentConfigResponse
newCreateDeploymentConfigResponse :: Int -> CreateDeploymentConfigResponse
newCreateDeploymentConfigResponse Int
pHttpStatus_ =
  CreateDeploymentConfigResponse'
    { $sel:deploymentConfigId:CreateDeploymentConfigResponse' :: Maybe Text
deploymentConfigId =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateDeploymentConfigResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | A unique deployment configuration ID.
createDeploymentConfigResponse_deploymentConfigId :: Lens.Lens' CreateDeploymentConfigResponse (Prelude.Maybe Prelude.Text)
createDeploymentConfigResponse_deploymentConfigId :: Lens' CreateDeploymentConfigResponse (Maybe Text)
createDeploymentConfigResponse_deploymentConfigId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDeploymentConfigResponse' {Maybe Text
deploymentConfigId :: Maybe Text
$sel:deploymentConfigId:CreateDeploymentConfigResponse' :: CreateDeploymentConfigResponse -> Maybe Text
deploymentConfigId} -> Maybe Text
deploymentConfigId) (\s :: CreateDeploymentConfigResponse
s@CreateDeploymentConfigResponse' {} Maybe Text
a -> CreateDeploymentConfigResponse
s {$sel:deploymentConfigId:CreateDeploymentConfigResponse' :: Maybe Text
deploymentConfigId = Maybe Text
a} :: CreateDeploymentConfigResponse)

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

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