{-# 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.CreateDeploymentGroup
-- 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 group to which application revisions are deployed.
module Amazonka.CodeDeploy.CreateDeploymentGroup
  ( -- * Creating a Request
    CreateDeploymentGroup (..),
    newCreateDeploymentGroup,

    -- * Request Lenses
    createDeploymentGroup_alarmConfiguration,
    createDeploymentGroup_autoRollbackConfiguration,
    createDeploymentGroup_autoScalingGroups,
    createDeploymentGroup_blueGreenDeploymentConfiguration,
    createDeploymentGroup_deploymentConfigName,
    createDeploymentGroup_deploymentStyle,
    createDeploymentGroup_ec2TagFilters,
    createDeploymentGroup_ec2TagSet,
    createDeploymentGroup_ecsServices,
    createDeploymentGroup_loadBalancerInfo,
    createDeploymentGroup_onPremisesInstanceTagFilters,
    createDeploymentGroup_onPremisesTagSet,
    createDeploymentGroup_outdatedInstancesStrategy,
    createDeploymentGroup_tags,
    createDeploymentGroup_triggerConfigurations,
    createDeploymentGroup_applicationName,
    createDeploymentGroup_deploymentGroupName,
    createDeploymentGroup_serviceRoleArn,

    -- * Destructuring the Response
    CreateDeploymentGroupResponse (..),
    newCreateDeploymentGroupResponse,

    -- * Response Lenses
    createDeploymentGroupResponse_deploymentGroupId,
    createDeploymentGroupResponse_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 @CreateDeploymentGroup@ operation.
--
-- /See:/ 'newCreateDeploymentGroup' smart constructor.
data CreateDeploymentGroup = CreateDeploymentGroup'
  { -- | Information to add about Amazon CloudWatch alarms when the deployment
    -- group is created.
    CreateDeploymentGroup -> Maybe AlarmConfiguration
alarmConfiguration :: Prelude.Maybe AlarmConfiguration,
    -- | Configuration information for an automatic rollback that is added when a
    -- deployment group is created.
    CreateDeploymentGroup -> Maybe AutoRollbackConfiguration
autoRollbackConfiguration :: Prelude.Maybe AutoRollbackConfiguration,
    -- | A list of associated Amazon EC2 Auto Scaling groups.
    CreateDeploymentGroup -> Maybe [Text]
autoScalingGroups :: Prelude.Maybe [Prelude.Text],
    -- | Information about blue\/green deployment options for a deployment group.
    CreateDeploymentGroup -> Maybe BlueGreenDeploymentConfiguration
blueGreenDeploymentConfiguration :: Prelude.Maybe BlueGreenDeploymentConfiguration,
    -- | If specified, the deployment configuration name can be either one of the
    -- predefined configurations provided with CodeDeploy or a custom
    -- deployment configuration that you create by calling the create
    -- deployment configuration operation.
    --
    -- @CodeDeployDefault.OneAtATime@ is the default deployment configuration.
    -- It is used if a configuration isn\'t specified for the deployment or
    -- deployment group.
    --
    -- For more information about the predefined deployment configurations in
    -- CodeDeploy, see
    -- <https://docs.aws.amazon.com/codedeploy/latest/userguide/deployment-configurations.html Working with Deployment Configurations in CodeDeploy>
    -- in the /CodeDeploy User Guide/.
    CreateDeploymentGroup -> Maybe Text
deploymentConfigName :: Prelude.Maybe Prelude.Text,
    -- | Information about the type of deployment, in-place or blue\/green, that
    -- you want to run and whether to route deployment traffic behind a load
    -- balancer.
    CreateDeploymentGroup -> Maybe DeploymentStyle
deploymentStyle :: Prelude.Maybe DeploymentStyle,
    -- | The Amazon EC2 tags on which to filter. The deployment group includes
    -- Amazon EC2 instances with any of the specified tags. Cannot be used in
    -- the same call as ec2TagSet.
    CreateDeploymentGroup -> Maybe [EC2TagFilter]
ec2TagFilters :: Prelude.Maybe [EC2TagFilter],
    -- | Information about groups of tags applied to Amazon EC2 instances. The
    -- deployment group includes only Amazon EC2 instances identified by all
    -- the tag groups. Cannot be used in the same call as @ec2TagFilters@.
    CreateDeploymentGroup -> Maybe EC2TagSet
ec2TagSet :: Prelude.Maybe EC2TagSet,
    -- | The target Amazon ECS services in the deployment group. This applies
    -- only to deployment groups that use the Amazon ECS compute platform. A
    -- target Amazon ECS service is specified as an Amazon ECS cluster and
    -- service name pair using the format @\<clustername>:\<servicename>@.
    CreateDeploymentGroup -> Maybe [ECSService]
ecsServices :: Prelude.Maybe [ECSService],
    -- | Information about the load balancer used in a deployment.
    CreateDeploymentGroup -> Maybe LoadBalancerInfo
loadBalancerInfo :: Prelude.Maybe LoadBalancerInfo,
    -- | The on-premises instance tags on which to filter. The deployment group
    -- includes on-premises instances with any of the specified tags. Cannot be
    -- used in the same call as @OnPremisesTagSet@.
    CreateDeploymentGroup -> Maybe [TagFilter]
onPremisesInstanceTagFilters :: Prelude.Maybe [TagFilter],
    -- | Information about groups of tags applied to on-premises instances. The
    -- deployment group includes only on-premises instances identified by all
    -- of the tag groups. Cannot be used in the same call as
    -- @onPremisesInstanceTagFilters@.
    CreateDeploymentGroup -> Maybe OnPremisesTagSet
onPremisesTagSet :: Prelude.Maybe OnPremisesTagSet,
    -- | Indicates what happens when new Amazon EC2 instances are launched
    -- mid-deployment and do not receive the deployed application revision.
    --
    -- If this option is set to @UPDATE@ or is unspecified, CodeDeploy
    -- initiates one or more \'auto-update outdated instances\' deployments to
    -- apply the deployed application revision to the new Amazon EC2 instances.
    --
    -- If this option is set to @IGNORE@, CodeDeploy does not initiate a
    -- deployment to update the new Amazon EC2 instances. This may result in
    -- instances having different revisions.
    CreateDeploymentGroup -> Maybe OutdatedInstancesStrategy
outdatedInstancesStrategy :: Prelude.Maybe OutdatedInstancesStrategy,
    -- | The metadata that you apply to CodeDeploy deployment groups to help you
    -- organize and categorize them. Each tag consists of a key and an optional
    -- value, both of which you define.
    CreateDeploymentGroup -> Maybe [Tag]
tags :: Prelude.Maybe [Tag],
    -- | Information about triggers to create when the deployment group is
    -- created. For examples, see
    -- <https://docs.aws.amazon.com/codedeploy/latest/userguide/how-to-notify-sns.html Create a Trigger for an CodeDeploy Event>
    -- in the /CodeDeploy User Guide/.
    CreateDeploymentGroup -> Maybe [TriggerConfig]
triggerConfigurations :: Prelude.Maybe [TriggerConfig],
    -- | The name of an CodeDeploy application associated with the IAM user or
    -- Amazon Web Services account.
    CreateDeploymentGroup -> Text
applicationName :: Prelude.Text,
    -- | The name of a new deployment group for the specified application.
    CreateDeploymentGroup -> Text
deploymentGroupName :: Prelude.Text,
    -- | A service role Amazon Resource Name (ARN) that allows CodeDeploy to act
    -- on the user\'s behalf when interacting with Amazon Web Services
    -- services.
    CreateDeploymentGroup -> Text
serviceRoleArn :: Prelude.Text
  }
  deriving (CreateDeploymentGroup -> CreateDeploymentGroup -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateDeploymentGroup -> CreateDeploymentGroup -> Bool
$c/= :: CreateDeploymentGroup -> CreateDeploymentGroup -> Bool
== :: CreateDeploymentGroup -> CreateDeploymentGroup -> Bool
$c== :: CreateDeploymentGroup -> CreateDeploymentGroup -> Bool
Prelude.Eq, ReadPrec [CreateDeploymentGroup]
ReadPrec CreateDeploymentGroup
Int -> ReadS CreateDeploymentGroup
ReadS [CreateDeploymentGroup]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateDeploymentGroup]
$creadListPrec :: ReadPrec [CreateDeploymentGroup]
readPrec :: ReadPrec CreateDeploymentGroup
$creadPrec :: ReadPrec CreateDeploymentGroup
readList :: ReadS [CreateDeploymentGroup]
$creadList :: ReadS [CreateDeploymentGroup]
readsPrec :: Int -> ReadS CreateDeploymentGroup
$creadsPrec :: Int -> ReadS CreateDeploymentGroup
Prelude.Read, Int -> CreateDeploymentGroup -> ShowS
[CreateDeploymentGroup] -> ShowS
CreateDeploymentGroup -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateDeploymentGroup] -> ShowS
$cshowList :: [CreateDeploymentGroup] -> ShowS
show :: CreateDeploymentGroup -> String
$cshow :: CreateDeploymentGroup -> String
showsPrec :: Int -> CreateDeploymentGroup -> ShowS
$cshowsPrec :: Int -> CreateDeploymentGroup -> ShowS
Prelude.Show, forall x. Rep CreateDeploymentGroup x -> CreateDeploymentGroup
forall x. CreateDeploymentGroup -> Rep CreateDeploymentGroup x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateDeploymentGroup x -> CreateDeploymentGroup
$cfrom :: forall x. CreateDeploymentGroup -> Rep CreateDeploymentGroup x
Prelude.Generic)

-- |
-- Create a value of 'CreateDeploymentGroup' 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:
--
-- 'alarmConfiguration', 'createDeploymentGroup_alarmConfiguration' - Information to add about Amazon CloudWatch alarms when the deployment
-- group is created.
--
-- 'autoRollbackConfiguration', 'createDeploymentGroup_autoRollbackConfiguration' - Configuration information for an automatic rollback that is added when a
-- deployment group is created.
--
-- 'autoScalingGroups', 'createDeploymentGroup_autoScalingGroups' - A list of associated Amazon EC2 Auto Scaling groups.
--
-- 'blueGreenDeploymentConfiguration', 'createDeploymentGroup_blueGreenDeploymentConfiguration' - Information about blue\/green deployment options for a deployment group.
--
-- 'deploymentConfigName', 'createDeploymentGroup_deploymentConfigName' - If specified, the deployment configuration name can be either one of the
-- predefined configurations provided with CodeDeploy or a custom
-- deployment configuration that you create by calling the create
-- deployment configuration operation.
--
-- @CodeDeployDefault.OneAtATime@ is the default deployment configuration.
-- It is used if a configuration isn\'t specified for the deployment or
-- deployment group.
--
-- For more information about the predefined deployment configurations in
-- CodeDeploy, see
-- <https://docs.aws.amazon.com/codedeploy/latest/userguide/deployment-configurations.html Working with Deployment Configurations in CodeDeploy>
-- in the /CodeDeploy User Guide/.
--
-- 'deploymentStyle', 'createDeploymentGroup_deploymentStyle' - Information about the type of deployment, in-place or blue\/green, that
-- you want to run and whether to route deployment traffic behind a load
-- balancer.
--
-- 'ec2TagFilters', 'createDeploymentGroup_ec2TagFilters' - The Amazon EC2 tags on which to filter. The deployment group includes
-- Amazon EC2 instances with any of the specified tags. Cannot be used in
-- the same call as ec2TagSet.
--
-- 'ec2TagSet', 'createDeploymentGroup_ec2TagSet' - Information about groups of tags applied to Amazon EC2 instances. The
-- deployment group includes only Amazon EC2 instances identified by all
-- the tag groups. Cannot be used in the same call as @ec2TagFilters@.
--
-- 'ecsServices', 'createDeploymentGroup_ecsServices' - The target Amazon ECS services in the deployment group. This applies
-- only to deployment groups that use the Amazon ECS compute platform. A
-- target Amazon ECS service is specified as an Amazon ECS cluster and
-- service name pair using the format @\<clustername>:\<servicename>@.
--
-- 'loadBalancerInfo', 'createDeploymentGroup_loadBalancerInfo' - Information about the load balancer used in a deployment.
--
-- 'onPremisesInstanceTagFilters', 'createDeploymentGroup_onPremisesInstanceTagFilters' - The on-premises instance tags on which to filter. The deployment group
-- includes on-premises instances with any of the specified tags. Cannot be
-- used in the same call as @OnPremisesTagSet@.
--
-- 'onPremisesTagSet', 'createDeploymentGroup_onPremisesTagSet' - Information about groups of tags applied to on-premises instances. The
-- deployment group includes only on-premises instances identified by all
-- of the tag groups. Cannot be used in the same call as
-- @onPremisesInstanceTagFilters@.
--
-- 'outdatedInstancesStrategy', 'createDeploymentGroup_outdatedInstancesStrategy' - Indicates what happens when new Amazon EC2 instances are launched
-- mid-deployment and do not receive the deployed application revision.
--
-- If this option is set to @UPDATE@ or is unspecified, CodeDeploy
-- initiates one or more \'auto-update outdated instances\' deployments to
-- apply the deployed application revision to the new Amazon EC2 instances.
--
-- If this option is set to @IGNORE@, CodeDeploy does not initiate a
-- deployment to update the new Amazon EC2 instances. This may result in
-- instances having different revisions.
--
-- 'tags', 'createDeploymentGroup_tags' - The metadata that you apply to CodeDeploy deployment groups to help you
-- organize and categorize them. Each tag consists of a key and an optional
-- value, both of which you define.
--
-- 'triggerConfigurations', 'createDeploymentGroup_triggerConfigurations' - Information about triggers to create when the deployment group is
-- created. For examples, see
-- <https://docs.aws.amazon.com/codedeploy/latest/userguide/how-to-notify-sns.html Create a Trigger for an CodeDeploy Event>
-- in the /CodeDeploy User Guide/.
--
-- 'applicationName', 'createDeploymentGroup_applicationName' - The name of an CodeDeploy application associated with the IAM user or
-- Amazon Web Services account.
--
-- 'deploymentGroupName', 'createDeploymentGroup_deploymentGroupName' - The name of a new deployment group for the specified application.
--
-- 'serviceRoleArn', 'createDeploymentGroup_serviceRoleArn' - A service role Amazon Resource Name (ARN) that allows CodeDeploy to act
-- on the user\'s behalf when interacting with Amazon Web Services
-- services.
newCreateDeploymentGroup ::
  -- | 'applicationName'
  Prelude.Text ->
  -- | 'deploymentGroupName'
  Prelude.Text ->
  -- | 'serviceRoleArn'
  Prelude.Text ->
  CreateDeploymentGroup
newCreateDeploymentGroup :: Text -> Text -> Text -> CreateDeploymentGroup
newCreateDeploymentGroup
  Text
pApplicationName_
  Text
pDeploymentGroupName_
  Text
pServiceRoleArn_ =
    CreateDeploymentGroup'
      { $sel:alarmConfiguration:CreateDeploymentGroup' :: Maybe AlarmConfiguration
alarmConfiguration =
          forall a. Maybe a
Prelude.Nothing,
        $sel:autoRollbackConfiguration:CreateDeploymentGroup' :: Maybe AutoRollbackConfiguration
autoRollbackConfiguration = forall a. Maybe a
Prelude.Nothing,
        $sel:autoScalingGroups:CreateDeploymentGroup' :: Maybe [Text]
autoScalingGroups = forall a. Maybe a
Prelude.Nothing,
        $sel:blueGreenDeploymentConfiguration:CreateDeploymentGroup' :: Maybe BlueGreenDeploymentConfiguration
blueGreenDeploymentConfiguration = forall a. Maybe a
Prelude.Nothing,
        $sel:deploymentConfigName:CreateDeploymentGroup' :: Maybe Text
deploymentConfigName = forall a. Maybe a
Prelude.Nothing,
        $sel:deploymentStyle:CreateDeploymentGroup' :: Maybe DeploymentStyle
deploymentStyle = forall a. Maybe a
Prelude.Nothing,
        $sel:ec2TagFilters:CreateDeploymentGroup' :: Maybe [EC2TagFilter]
ec2TagFilters = forall a. Maybe a
Prelude.Nothing,
        $sel:ec2TagSet:CreateDeploymentGroup' :: Maybe EC2TagSet
ec2TagSet = forall a. Maybe a
Prelude.Nothing,
        $sel:ecsServices:CreateDeploymentGroup' :: Maybe [ECSService]
ecsServices = forall a. Maybe a
Prelude.Nothing,
        $sel:loadBalancerInfo:CreateDeploymentGroup' :: Maybe LoadBalancerInfo
loadBalancerInfo = forall a. Maybe a
Prelude.Nothing,
        $sel:onPremisesInstanceTagFilters:CreateDeploymentGroup' :: Maybe [TagFilter]
onPremisesInstanceTagFilters = forall a. Maybe a
Prelude.Nothing,
        $sel:onPremisesTagSet:CreateDeploymentGroup' :: Maybe OnPremisesTagSet
onPremisesTagSet = forall a. Maybe a
Prelude.Nothing,
        $sel:outdatedInstancesStrategy:CreateDeploymentGroup' :: Maybe OutdatedInstancesStrategy
outdatedInstancesStrategy = forall a. Maybe a
Prelude.Nothing,
        $sel:tags:CreateDeploymentGroup' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing,
        $sel:triggerConfigurations:CreateDeploymentGroup' :: Maybe [TriggerConfig]
triggerConfigurations = forall a. Maybe a
Prelude.Nothing,
        $sel:applicationName:CreateDeploymentGroup' :: Text
applicationName = Text
pApplicationName_,
        $sel:deploymentGroupName:CreateDeploymentGroup' :: Text
deploymentGroupName = Text
pDeploymentGroupName_,
        $sel:serviceRoleArn:CreateDeploymentGroup' :: Text
serviceRoleArn = Text
pServiceRoleArn_
      }

-- | Information to add about Amazon CloudWatch alarms when the deployment
-- group is created.
createDeploymentGroup_alarmConfiguration :: Lens.Lens' CreateDeploymentGroup (Prelude.Maybe AlarmConfiguration)
createDeploymentGroup_alarmConfiguration :: Lens' CreateDeploymentGroup (Maybe AlarmConfiguration)
createDeploymentGroup_alarmConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDeploymentGroup' {Maybe AlarmConfiguration
alarmConfiguration :: Maybe AlarmConfiguration
$sel:alarmConfiguration:CreateDeploymentGroup' :: CreateDeploymentGroup -> Maybe AlarmConfiguration
alarmConfiguration} -> Maybe AlarmConfiguration
alarmConfiguration) (\s :: CreateDeploymentGroup
s@CreateDeploymentGroup' {} Maybe AlarmConfiguration
a -> CreateDeploymentGroup
s {$sel:alarmConfiguration:CreateDeploymentGroup' :: Maybe AlarmConfiguration
alarmConfiguration = Maybe AlarmConfiguration
a} :: CreateDeploymentGroup)

-- | Configuration information for an automatic rollback that is added when a
-- deployment group is created.
createDeploymentGroup_autoRollbackConfiguration :: Lens.Lens' CreateDeploymentGroup (Prelude.Maybe AutoRollbackConfiguration)
createDeploymentGroup_autoRollbackConfiguration :: Lens' CreateDeploymentGroup (Maybe AutoRollbackConfiguration)
createDeploymentGroup_autoRollbackConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDeploymentGroup' {Maybe AutoRollbackConfiguration
autoRollbackConfiguration :: Maybe AutoRollbackConfiguration
$sel:autoRollbackConfiguration:CreateDeploymentGroup' :: CreateDeploymentGroup -> Maybe AutoRollbackConfiguration
autoRollbackConfiguration} -> Maybe AutoRollbackConfiguration
autoRollbackConfiguration) (\s :: CreateDeploymentGroup
s@CreateDeploymentGroup' {} Maybe AutoRollbackConfiguration
a -> CreateDeploymentGroup
s {$sel:autoRollbackConfiguration:CreateDeploymentGroup' :: Maybe AutoRollbackConfiguration
autoRollbackConfiguration = Maybe AutoRollbackConfiguration
a} :: CreateDeploymentGroup)

-- | A list of associated Amazon EC2 Auto Scaling groups.
createDeploymentGroup_autoScalingGroups :: Lens.Lens' CreateDeploymentGroup (Prelude.Maybe [Prelude.Text])
createDeploymentGroup_autoScalingGroups :: Lens' CreateDeploymentGroup (Maybe [Text])
createDeploymentGroup_autoScalingGroups = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDeploymentGroup' {Maybe [Text]
autoScalingGroups :: Maybe [Text]
$sel:autoScalingGroups:CreateDeploymentGroup' :: CreateDeploymentGroup -> Maybe [Text]
autoScalingGroups} -> Maybe [Text]
autoScalingGroups) (\s :: CreateDeploymentGroup
s@CreateDeploymentGroup' {} Maybe [Text]
a -> CreateDeploymentGroup
s {$sel:autoScalingGroups:CreateDeploymentGroup' :: Maybe [Text]
autoScalingGroups = Maybe [Text]
a} :: CreateDeploymentGroup) 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

-- | Information about blue\/green deployment options for a deployment group.
createDeploymentGroup_blueGreenDeploymentConfiguration :: Lens.Lens' CreateDeploymentGroup (Prelude.Maybe BlueGreenDeploymentConfiguration)
createDeploymentGroup_blueGreenDeploymentConfiguration :: Lens'
  CreateDeploymentGroup (Maybe BlueGreenDeploymentConfiguration)
createDeploymentGroup_blueGreenDeploymentConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDeploymentGroup' {Maybe BlueGreenDeploymentConfiguration
blueGreenDeploymentConfiguration :: Maybe BlueGreenDeploymentConfiguration
$sel:blueGreenDeploymentConfiguration:CreateDeploymentGroup' :: CreateDeploymentGroup -> Maybe BlueGreenDeploymentConfiguration
blueGreenDeploymentConfiguration} -> Maybe BlueGreenDeploymentConfiguration
blueGreenDeploymentConfiguration) (\s :: CreateDeploymentGroup
s@CreateDeploymentGroup' {} Maybe BlueGreenDeploymentConfiguration
a -> CreateDeploymentGroup
s {$sel:blueGreenDeploymentConfiguration:CreateDeploymentGroup' :: Maybe BlueGreenDeploymentConfiguration
blueGreenDeploymentConfiguration = Maybe BlueGreenDeploymentConfiguration
a} :: CreateDeploymentGroup)

-- | If specified, the deployment configuration name can be either one of the
-- predefined configurations provided with CodeDeploy or a custom
-- deployment configuration that you create by calling the create
-- deployment configuration operation.
--
-- @CodeDeployDefault.OneAtATime@ is the default deployment configuration.
-- It is used if a configuration isn\'t specified for the deployment or
-- deployment group.
--
-- For more information about the predefined deployment configurations in
-- CodeDeploy, see
-- <https://docs.aws.amazon.com/codedeploy/latest/userguide/deployment-configurations.html Working with Deployment Configurations in CodeDeploy>
-- in the /CodeDeploy User Guide/.
createDeploymentGroup_deploymentConfigName :: Lens.Lens' CreateDeploymentGroup (Prelude.Maybe Prelude.Text)
createDeploymentGroup_deploymentConfigName :: Lens' CreateDeploymentGroup (Maybe Text)
createDeploymentGroup_deploymentConfigName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDeploymentGroup' {Maybe Text
deploymentConfigName :: Maybe Text
$sel:deploymentConfigName:CreateDeploymentGroup' :: CreateDeploymentGroup -> Maybe Text
deploymentConfigName} -> Maybe Text
deploymentConfigName) (\s :: CreateDeploymentGroup
s@CreateDeploymentGroup' {} Maybe Text
a -> CreateDeploymentGroup
s {$sel:deploymentConfigName:CreateDeploymentGroup' :: Maybe Text
deploymentConfigName = Maybe Text
a} :: CreateDeploymentGroup)

-- | Information about the type of deployment, in-place or blue\/green, that
-- you want to run and whether to route deployment traffic behind a load
-- balancer.
createDeploymentGroup_deploymentStyle :: Lens.Lens' CreateDeploymentGroup (Prelude.Maybe DeploymentStyle)
createDeploymentGroup_deploymentStyle :: Lens' CreateDeploymentGroup (Maybe DeploymentStyle)
createDeploymentGroup_deploymentStyle = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDeploymentGroup' {Maybe DeploymentStyle
deploymentStyle :: Maybe DeploymentStyle
$sel:deploymentStyle:CreateDeploymentGroup' :: CreateDeploymentGroup -> Maybe DeploymentStyle
deploymentStyle} -> Maybe DeploymentStyle
deploymentStyle) (\s :: CreateDeploymentGroup
s@CreateDeploymentGroup' {} Maybe DeploymentStyle
a -> CreateDeploymentGroup
s {$sel:deploymentStyle:CreateDeploymentGroup' :: Maybe DeploymentStyle
deploymentStyle = Maybe DeploymentStyle
a} :: CreateDeploymentGroup)

-- | The Amazon EC2 tags on which to filter. The deployment group includes
-- Amazon EC2 instances with any of the specified tags. Cannot be used in
-- the same call as ec2TagSet.
createDeploymentGroup_ec2TagFilters :: Lens.Lens' CreateDeploymentGroup (Prelude.Maybe [EC2TagFilter])
createDeploymentGroup_ec2TagFilters :: Lens' CreateDeploymentGroup (Maybe [EC2TagFilter])
createDeploymentGroup_ec2TagFilters = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDeploymentGroup' {Maybe [EC2TagFilter]
ec2TagFilters :: Maybe [EC2TagFilter]
$sel:ec2TagFilters:CreateDeploymentGroup' :: CreateDeploymentGroup -> Maybe [EC2TagFilter]
ec2TagFilters} -> Maybe [EC2TagFilter]
ec2TagFilters) (\s :: CreateDeploymentGroup
s@CreateDeploymentGroup' {} Maybe [EC2TagFilter]
a -> CreateDeploymentGroup
s {$sel:ec2TagFilters:CreateDeploymentGroup' :: Maybe [EC2TagFilter]
ec2TagFilters = Maybe [EC2TagFilter]
a} :: CreateDeploymentGroup) 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

-- | Information about groups of tags applied to Amazon EC2 instances. The
-- deployment group includes only Amazon EC2 instances identified by all
-- the tag groups. Cannot be used in the same call as @ec2TagFilters@.
createDeploymentGroup_ec2TagSet :: Lens.Lens' CreateDeploymentGroup (Prelude.Maybe EC2TagSet)
createDeploymentGroup_ec2TagSet :: Lens' CreateDeploymentGroup (Maybe EC2TagSet)
createDeploymentGroup_ec2TagSet = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDeploymentGroup' {Maybe EC2TagSet
ec2TagSet :: Maybe EC2TagSet
$sel:ec2TagSet:CreateDeploymentGroup' :: CreateDeploymentGroup -> Maybe EC2TagSet
ec2TagSet} -> Maybe EC2TagSet
ec2TagSet) (\s :: CreateDeploymentGroup
s@CreateDeploymentGroup' {} Maybe EC2TagSet
a -> CreateDeploymentGroup
s {$sel:ec2TagSet:CreateDeploymentGroup' :: Maybe EC2TagSet
ec2TagSet = Maybe EC2TagSet
a} :: CreateDeploymentGroup)

-- | The target Amazon ECS services in the deployment group. This applies
-- only to deployment groups that use the Amazon ECS compute platform. A
-- target Amazon ECS service is specified as an Amazon ECS cluster and
-- service name pair using the format @\<clustername>:\<servicename>@.
createDeploymentGroup_ecsServices :: Lens.Lens' CreateDeploymentGroup (Prelude.Maybe [ECSService])
createDeploymentGroup_ecsServices :: Lens' CreateDeploymentGroup (Maybe [ECSService])
createDeploymentGroup_ecsServices = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDeploymentGroup' {Maybe [ECSService]
ecsServices :: Maybe [ECSService]
$sel:ecsServices:CreateDeploymentGroup' :: CreateDeploymentGroup -> Maybe [ECSService]
ecsServices} -> Maybe [ECSService]
ecsServices) (\s :: CreateDeploymentGroup
s@CreateDeploymentGroup' {} Maybe [ECSService]
a -> CreateDeploymentGroup
s {$sel:ecsServices:CreateDeploymentGroup' :: Maybe [ECSService]
ecsServices = Maybe [ECSService]
a} :: CreateDeploymentGroup) 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

-- | Information about the load balancer used in a deployment.
createDeploymentGroup_loadBalancerInfo :: Lens.Lens' CreateDeploymentGroup (Prelude.Maybe LoadBalancerInfo)
createDeploymentGroup_loadBalancerInfo :: Lens' CreateDeploymentGroup (Maybe LoadBalancerInfo)
createDeploymentGroup_loadBalancerInfo = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDeploymentGroup' {Maybe LoadBalancerInfo
loadBalancerInfo :: Maybe LoadBalancerInfo
$sel:loadBalancerInfo:CreateDeploymentGroup' :: CreateDeploymentGroup -> Maybe LoadBalancerInfo
loadBalancerInfo} -> Maybe LoadBalancerInfo
loadBalancerInfo) (\s :: CreateDeploymentGroup
s@CreateDeploymentGroup' {} Maybe LoadBalancerInfo
a -> CreateDeploymentGroup
s {$sel:loadBalancerInfo:CreateDeploymentGroup' :: Maybe LoadBalancerInfo
loadBalancerInfo = Maybe LoadBalancerInfo
a} :: CreateDeploymentGroup)

-- | The on-premises instance tags on which to filter. The deployment group
-- includes on-premises instances with any of the specified tags. Cannot be
-- used in the same call as @OnPremisesTagSet@.
createDeploymentGroup_onPremisesInstanceTagFilters :: Lens.Lens' CreateDeploymentGroup (Prelude.Maybe [TagFilter])
createDeploymentGroup_onPremisesInstanceTagFilters :: Lens' CreateDeploymentGroup (Maybe [TagFilter])
createDeploymentGroup_onPremisesInstanceTagFilters = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDeploymentGroup' {Maybe [TagFilter]
onPremisesInstanceTagFilters :: Maybe [TagFilter]
$sel:onPremisesInstanceTagFilters:CreateDeploymentGroup' :: CreateDeploymentGroup -> Maybe [TagFilter]
onPremisesInstanceTagFilters} -> Maybe [TagFilter]
onPremisesInstanceTagFilters) (\s :: CreateDeploymentGroup
s@CreateDeploymentGroup' {} Maybe [TagFilter]
a -> CreateDeploymentGroup
s {$sel:onPremisesInstanceTagFilters:CreateDeploymentGroup' :: Maybe [TagFilter]
onPremisesInstanceTagFilters = Maybe [TagFilter]
a} :: CreateDeploymentGroup) 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

-- | Information about groups of tags applied to on-premises instances. The
-- deployment group includes only on-premises instances identified by all
-- of the tag groups. Cannot be used in the same call as
-- @onPremisesInstanceTagFilters@.
createDeploymentGroup_onPremisesTagSet :: Lens.Lens' CreateDeploymentGroup (Prelude.Maybe OnPremisesTagSet)
createDeploymentGroup_onPremisesTagSet :: Lens' CreateDeploymentGroup (Maybe OnPremisesTagSet)
createDeploymentGroup_onPremisesTagSet = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDeploymentGroup' {Maybe OnPremisesTagSet
onPremisesTagSet :: Maybe OnPremisesTagSet
$sel:onPremisesTagSet:CreateDeploymentGroup' :: CreateDeploymentGroup -> Maybe OnPremisesTagSet
onPremisesTagSet} -> Maybe OnPremisesTagSet
onPremisesTagSet) (\s :: CreateDeploymentGroup
s@CreateDeploymentGroup' {} Maybe OnPremisesTagSet
a -> CreateDeploymentGroup
s {$sel:onPremisesTagSet:CreateDeploymentGroup' :: Maybe OnPremisesTagSet
onPremisesTagSet = Maybe OnPremisesTagSet
a} :: CreateDeploymentGroup)

-- | Indicates what happens when new Amazon EC2 instances are launched
-- mid-deployment and do not receive the deployed application revision.
--
-- If this option is set to @UPDATE@ or is unspecified, CodeDeploy
-- initiates one or more \'auto-update outdated instances\' deployments to
-- apply the deployed application revision to the new Amazon EC2 instances.
--
-- If this option is set to @IGNORE@, CodeDeploy does not initiate a
-- deployment to update the new Amazon EC2 instances. This may result in
-- instances having different revisions.
createDeploymentGroup_outdatedInstancesStrategy :: Lens.Lens' CreateDeploymentGroup (Prelude.Maybe OutdatedInstancesStrategy)
createDeploymentGroup_outdatedInstancesStrategy :: Lens' CreateDeploymentGroup (Maybe OutdatedInstancesStrategy)
createDeploymentGroup_outdatedInstancesStrategy = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDeploymentGroup' {Maybe OutdatedInstancesStrategy
outdatedInstancesStrategy :: Maybe OutdatedInstancesStrategy
$sel:outdatedInstancesStrategy:CreateDeploymentGroup' :: CreateDeploymentGroup -> Maybe OutdatedInstancesStrategy
outdatedInstancesStrategy} -> Maybe OutdatedInstancesStrategy
outdatedInstancesStrategy) (\s :: CreateDeploymentGroup
s@CreateDeploymentGroup' {} Maybe OutdatedInstancesStrategy
a -> CreateDeploymentGroup
s {$sel:outdatedInstancesStrategy:CreateDeploymentGroup' :: Maybe OutdatedInstancesStrategy
outdatedInstancesStrategy = Maybe OutdatedInstancesStrategy
a} :: CreateDeploymentGroup)

-- | The metadata that you apply to CodeDeploy deployment groups to help you
-- organize and categorize them. Each tag consists of a key and an optional
-- value, both of which you define.
createDeploymentGroup_tags :: Lens.Lens' CreateDeploymentGroup (Prelude.Maybe [Tag])
createDeploymentGroup_tags :: Lens' CreateDeploymentGroup (Maybe [Tag])
createDeploymentGroup_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDeploymentGroup' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:CreateDeploymentGroup' :: CreateDeploymentGroup -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: CreateDeploymentGroup
s@CreateDeploymentGroup' {} Maybe [Tag]
a -> CreateDeploymentGroup
s {$sel:tags:CreateDeploymentGroup' :: Maybe [Tag]
tags = Maybe [Tag]
a} :: CreateDeploymentGroup) 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

-- | Information about triggers to create when the deployment group is
-- created. For examples, see
-- <https://docs.aws.amazon.com/codedeploy/latest/userguide/how-to-notify-sns.html Create a Trigger for an CodeDeploy Event>
-- in the /CodeDeploy User Guide/.
createDeploymentGroup_triggerConfigurations :: Lens.Lens' CreateDeploymentGroup (Prelude.Maybe [TriggerConfig])
createDeploymentGroup_triggerConfigurations :: Lens' CreateDeploymentGroup (Maybe [TriggerConfig])
createDeploymentGroup_triggerConfigurations = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDeploymentGroup' {Maybe [TriggerConfig]
triggerConfigurations :: Maybe [TriggerConfig]
$sel:triggerConfigurations:CreateDeploymentGroup' :: CreateDeploymentGroup -> Maybe [TriggerConfig]
triggerConfigurations} -> Maybe [TriggerConfig]
triggerConfigurations) (\s :: CreateDeploymentGroup
s@CreateDeploymentGroup' {} Maybe [TriggerConfig]
a -> CreateDeploymentGroup
s {$sel:triggerConfigurations:CreateDeploymentGroup' :: Maybe [TriggerConfig]
triggerConfigurations = Maybe [TriggerConfig]
a} :: CreateDeploymentGroup) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | The name of an CodeDeploy application associated with the IAM user or
-- Amazon Web Services account.
createDeploymentGroup_applicationName :: Lens.Lens' CreateDeploymentGroup Prelude.Text
createDeploymentGroup_applicationName :: Lens' CreateDeploymentGroup Text
createDeploymentGroup_applicationName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDeploymentGroup' {Text
applicationName :: Text
$sel:applicationName:CreateDeploymentGroup' :: CreateDeploymentGroup -> Text
applicationName} -> Text
applicationName) (\s :: CreateDeploymentGroup
s@CreateDeploymentGroup' {} Text
a -> CreateDeploymentGroup
s {$sel:applicationName:CreateDeploymentGroup' :: Text
applicationName = Text
a} :: CreateDeploymentGroup)

-- | The name of a new deployment group for the specified application.
createDeploymentGroup_deploymentGroupName :: Lens.Lens' CreateDeploymentGroup Prelude.Text
createDeploymentGroup_deploymentGroupName :: Lens' CreateDeploymentGroup Text
createDeploymentGroup_deploymentGroupName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDeploymentGroup' {Text
deploymentGroupName :: Text
$sel:deploymentGroupName:CreateDeploymentGroup' :: CreateDeploymentGroup -> Text
deploymentGroupName} -> Text
deploymentGroupName) (\s :: CreateDeploymentGroup
s@CreateDeploymentGroup' {} Text
a -> CreateDeploymentGroup
s {$sel:deploymentGroupName:CreateDeploymentGroup' :: Text
deploymentGroupName = Text
a} :: CreateDeploymentGroup)

-- | A service role Amazon Resource Name (ARN) that allows CodeDeploy to act
-- on the user\'s behalf when interacting with Amazon Web Services
-- services.
createDeploymentGroup_serviceRoleArn :: Lens.Lens' CreateDeploymentGroup Prelude.Text
createDeploymentGroup_serviceRoleArn :: Lens' CreateDeploymentGroup Text
createDeploymentGroup_serviceRoleArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDeploymentGroup' {Text
serviceRoleArn :: Text
$sel:serviceRoleArn:CreateDeploymentGroup' :: CreateDeploymentGroup -> Text
serviceRoleArn} -> Text
serviceRoleArn) (\s :: CreateDeploymentGroup
s@CreateDeploymentGroup' {} Text
a -> CreateDeploymentGroup
s {$sel:serviceRoleArn:CreateDeploymentGroup' :: Text
serviceRoleArn = Text
a} :: CreateDeploymentGroup)

instance Core.AWSRequest CreateDeploymentGroup where
  type
    AWSResponse CreateDeploymentGroup =
      CreateDeploymentGroupResponse
  request :: (Service -> Service)
-> CreateDeploymentGroup -> Request CreateDeploymentGroup
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 CreateDeploymentGroup
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CreateDeploymentGroup)))
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 -> CreateDeploymentGroupResponse
CreateDeploymentGroupResponse'
            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
"deploymentGroupId")
            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 CreateDeploymentGroup where
  hashWithSalt :: Int -> CreateDeploymentGroup -> Int
hashWithSalt Int
_salt CreateDeploymentGroup' {Maybe [Text]
Maybe [EC2TagFilter]
Maybe [ECSService]
Maybe [Tag]
Maybe [TagFilter]
Maybe [TriggerConfig]
Maybe Text
Maybe AlarmConfiguration
Maybe AutoRollbackConfiguration
Maybe DeploymentStyle
Maybe EC2TagSet
Maybe BlueGreenDeploymentConfiguration
Maybe OutdatedInstancesStrategy
Maybe OnPremisesTagSet
Maybe LoadBalancerInfo
Text
serviceRoleArn :: Text
deploymentGroupName :: Text
applicationName :: Text
triggerConfigurations :: Maybe [TriggerConfig]
tags :: Maybe [Tag]
outdatedInstancesStrategy :: Maybe OutdatedInstancesStrategy
onPremisesTagSet :: Maybe OnPremisesTagSet
onPremisesInstanceTagFilters :: Maybe [TagFilter]
loadBalancerInfo :: Maybe LoadBalancerInfo
ecsServices :: Maybe [ECSService]
ec2TagSet :: Maybe EC2TagSet
ec2TagFilters :: Maybe [EC2TagFilter]
deploymentStyle :: Maybe DeploymentStyle
deploymentConfigName :: Maybe Text
blueGreenDeploymentConfiguration :: Maybe BlueGreenDeploymentConfiguration
autoScalingGroups :: Maybe [Text]
autoRollbackConfiguration :: Maybe AutoRollbackConfiguration
alarmConfiguration :: Maybe AlarmConfiguration
$sel:serviceRoleArn:CreateDeploymentGroup' :: CreateDeploymentGroup -> Text
$sel:deploymentGroupName:CreateDeploymentGroup' :: CreateDeploymentGroup -> Text
$sel:applicationName:CreateDeploymentGroup' :: CreateDeploymentGroup -> Text
$sel:triggerConfigurations:CreateDeploymentGroup' :: CreateDeploymentGroup -> Maybe [TriggerConfig]
$sel:tags:CreateDeploymentGroup' :: CreateDeploymentGroup -> Maybe [Tag]
$sel:outdatedInstancesStrategy:CreateDeploymentGroup' :: CreateDeploymentGroup -> Maybe OutdatedInstancesStrategy
$sel:onPremisesTagSet:CreateDeploymentGroup' :: CreateDeploymentGroup -> Maybe OnPremisesTagSet
$sel:onPremisesInstanceTagFilters:CreateDeploymentGroup' :: CreateDeploymentGroup -> Maybe [TagFilter]
$sel:loadBalancerInfo:CreateDeploymentGroup' :: CreateDeploymentGroup -> Maybe LoadBalancerInfo
$sel:ecsServices:CreateDeploymentGroup' :: CreateDeploymentGroup -> Maybe [ECSService]
$sel:ec2TagSet:CreateDeploymentGroup' :: CreateDeploymentGroup -> Maybe EC2TagSet
$sel:ec2TagFilters:CreateDeploymentGroup' :: CreateDeploymentGroup -> Maybe [EC2TagFilter]
$sel:deploymentStyle:CreateDeploymentGroup' :: CreateDeploymentGroup -> Maybe DeploymentStyle
$sel:deploymentConfigName:CreateDeploymentGroup' :: CreateDeploymentGroup -> Maybe Text
$sel:blueGreenDeploymentConfiguration:CreateDeploymentGroup' :: CreateDeploymentGroup -> Maybe BlueGreenDeploymentConfiguration
$sel:autoScalingGroups:CreateDeploymentGroup' :: CreateDeploymentGroup -> Maybe [Text]
$sel:autoRollbackConfiguration:CreateDeploymentGroup' :: CreateDeploymentGroup -> Maybe AutoRollbackConfiguration
$sel:alarmConfiguration:CreateDeploymentGroup' :: CreateDeploymentGroup -> Maybe AlarmConfiguration
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe AlarmConfiguration
alarmConfiguration
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe AutoRollbackConfiguration
autoRollbackConfiguration
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
autoScalingGroups
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe BlueGreenDeploymentConfiguration
blueGreenDeploymentConfiguration
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
deploymentConfigName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe DeploymentStyle
deploymentStyle
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [EC2TagFilter]
ec2TagFilters
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe EC2TagSet
ec2TagSet
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [ECSService]
ecsServices
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe LoadBalancerInfo
loadBalancerInfo
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [TagFilter]
onPremisesInstanceTagFilters
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe OnPremisesTagSet
onPremisesTagSet
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe OutdatedInstancesStrategy
outdatedInstancesStrategy
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Tag]
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [TriggerConfig]
triggerConfigurations
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
applicationName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
deploymentGroupName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
serviceRoleArn

instance Prelude.NFData CreateDeploymentGroup where
  rnf :: CreateDeploymentGroup -> ()
rnf CreateDeploymentGroup' {Maybe [Text]
Maybe [EC2TagFilter]
Maybe [ECSService]
Maybe [Tag]
Maybe [TagFilter]
Maybe [TriggerConfig]
Maybe Text
Maybe AlarmConfiguration
Maybe AutoRollbackConfiguration
Maybe DeploymentStyle
Maybe EC2TagSet
Maybe BlueGreenDeploymentConfiguration
Maybe OutdatedInstancesStrategy
Maybe OnPremisesTagSet
Maybe LoadBalancerInfo
Text
serviceRoleArn :: Text
deploymentGroupName :: Text
applicationName :: Text
triggerConfigurations :: Maybe [TriggerConfig]
tags :: Maybe [Tag]
outdatedInstancesStrategy :: Maybe OutdatedInstancesStrategy
onPremisesTagSet :: Maybe OnPremisesTagSet
onPremisesInstanceTagFilters :: Maybe [TagFilter]
loadBalancerInfo :: Maybe LoadBalancerInfo
ecsServices :: Maybe [ECSService]
ec2TagSet :: Maybe EC2TagSet
ec2TagFilters :: Maybe [EC2TagFilter]
deploymentStyle :: Maybe DeploymentStyle
deploymentConfigName :: Maybe Text
blueGreenDeploymentConfiguration :: Maybe BlueGreenDeploymentConfiguration
autoScalingGroups :: Maybe [Text]
autoRollbackConfiguration :: Maybe AutoRollbackConfiguration
alarmConfiguration :: Maybe AlarmConfiguration
$sel:serviceRoleArn:CreateDeploymentGroup' :: CreateDeploymentGroup -> Text
$sel:deploymentGroupName:CreateDeploymentGroup' :: CreateDeploymentGroup -> Text
$sel:applicationName:CreateDeploymentGroup' :: CreateDeploymentGroup -> Text
$sel:triggerConfigurations:CreateDeploymentGroup' :: CreateDeploymentGroup -> Maybe [TriggerConfig]
$sel:tags:CreateDeploymentGroup' :: CreateDeploymentGroup -> Maybe [Tag]
$sel:outdatedInstancesStrategy:CreateDeploymentGroup' :: CreateDeploymentGroup -> Maybe OutdatedInstancesStrategy
$sel:onPremisesTagSet:CreateDeploymentGroup' :: CreateDeploymentGroup -> Maybe OnPremisesTagSet
$sel:onPremisesInstanceTagFilters:CreateDeploymentGroup' :: CreateDeploymentGroup -> Maybe [TagFilter]
$sel:loadBalancerInfo:CreateDeploymentGroup' :: CreateDeploymentGroup -> Maybe LoadBalancerInfo
$sel:ecsServices:CreateDeploymentGroup' :: CreateDeploymentGroup -> Maybe [ECSService]
$sel:ec2TagSet:CreateDeploymentGroup' :: CreateDeploymentGroup -> Maybe EC2TagSet
$sel:ec2TagFilters:CreateDeploymentGroup' :: CreateDeploymentGroup -> Maybe [EC2TagFilter]
$sel:deploymentStyle:CreateDeploymentGroup' :: CreateDeploymentGroup -> Maybe DeploymentStyle
$sel:deploymentConfigName:CreateDeploymentGroup' :: CreateDeploymentGroup -> Maybe Text
$sel:blueGreenDeploymentConfiguration:CreateDeploymentGroup' :: CreateDeploymentGroup -> Maybe BlueGreenDeploymentConfiguration
$sel:autoScalingGroups:CreateDeploymentGroup' :: CreateDeploymentGroup -> Maybe [Text]
$sel:autoRollbackConfiguration:CreateDeploymentGroup' :: CreateDeploymentGroup -> Maybe AutoRollbackConfiguration
$sel:alarmConfiguration:CreateDeploymentGroup' :: CreateDeploymentGroup -> Maybe AlarmConfiguration
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe AlarmConfiguration
alarmConfiguration
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe AutoRollbackConfiguration
autoRollbackConfiguration
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
autoScalingGroups
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe BlueGreenDeploymentConfiguration
blueGreenDeploymentConfiguration
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
deploymentConfigName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe DeploymentStyle
deploymentStyle
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [EC2TagFilter]
ec2TagFilters
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe EC2TagSet
ec2TagSet
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [ECSService]
ecsServices
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe LoadBalancerInfo
loadBalancerInfo
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [TagFilter]
onPremisesInstanceTagFilters
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe OnPremisesTagSet
onPremisesTagSet
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe OutdatedInstancesStrategy
outdatedInstancesStrategy
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Tag]
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [TriggerConfig]
triggerConfigurations
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
applicationName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
deploymentGroupName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
serviceRoleArn

instance Data.ToHeaders CreateDeploymentGroup where
  toHeaders :: CreateDeploymentGroup -> 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.CreateDeploymentGroup" ::
                          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 CreateDeploymentGroup where
  toJSON :: CreateDeploymentGroup -> Value
toJSON CreateDeploymentGroup' {Maybe [Text]
Maybe [EC2TagFilter]
Maybe [ECSService]
Maybe [Tag]
Maybe [TagFilter]
Maybe [TriggerConfig]
Maybe Text
Maybe AlarmConfiguration
Maybe AutoRollbackConfiguration
Maybe DeploymentStyle
Maybe EC2TagSet
Maybe BlueGreenDeploymentConfiguration
Maybe OutdatedInstancesStrategy
Maybe OnPremisesTagSet
Maybe LoadBalancerInfo
Text
serviceRoleArn :: Text
deploymentGroupName :: Text
applicationName :: Text
triggerConfigurations :: Maybe [TriggerConfig]
tags :: Maybe [Tag]
outdatedInstancesStrategy :: Maybe OutdatedInstancesStrategy
onPremisesTagSet :: Maybe OnPremisesTagSet
onPremisesInstanceTagFilters :: Maybe [TagFilter]
loadBalancerInfo :: Maybe LoadBalancerInfo
ecsServices :: Maybe [ECSService]
ec2TagSet :: Maybe EC2TagSet
ec2TagFilters :: Maybe [EC2TagFilter]
deploymentStyle :: Maybe DeploymentStyle
deploymentConfigName :: Maybe Text
blueGreenDeploymentConfiguration :: Maybe BlueGreenDeploymentConfiguration
autoScalingGroups :: Maybe [Text]
autoRollbackConfiguration :: Maybe AutoRollbackConfiguration
alarmConfiguration :: Maybe AlarmConfiguration
$sel:serviceRoleArn:CreateDeploymentGroup' :: CreateDeploymentGroup -> Text
$sel:deploymentGroupName:CreateDeploymentGroup' :: CreateDeploymentGroup -> Text
$sel:applicationName:CreateDeploymentGroup' :: CreateDeploymentGroup -> Text
$sel:triggerConfigurations:CreateDeploymentGroup' :: CreateDeploymentGroup -> Maybe [TriggerConfig]
$sel:tags:CreateDeploymentGroup' :: CreateDeploymentGroup -> Maybe [Tag]
$sel:outdatedInstancesStrategy:CreateDeploymentGroup' :: CreateDeploymentGroup -> Maybe OutdatedInstancesStrategy
$sel:onPremisesTagSet:CreateDeploymentGroup' :: CreateDeploymentGroup -> Maybe OnPremisesTagSet
$sel:onPremisesInstanceTagFilters:CreateDeploymentGroup' :: CreateDeploymentGroup -> Maybe [TagFilter]
$sel:loadBalancerInfo:CreateDeploymentGroup' :: CreateDeploymentGroup -> Maybe LoadBalancerInfo
$sel:ecsServices:CreateDeploymentGroup' :: CreateDeploymentGroup -> Maybe [ECSService]
$sel:ec2TagSet:CreateDeploymentGroup' :: CreateDeploymentGroup -> Maybe EC2TagSet
$sel:ec2TagFilters:CreateDeploymentGroup' :: CreateDeploymentGroup -> Maybe [EC2TagFilter]
$sel:deploymentStyle:CreateDeploymentGroup' :: CreateDeploymentGroup -> Maybe DeploymentStyle
$sel:deploymentConfigName:CreateDeploymentGroup' :: CreateDeploymentGroup -> Maybe Text
$sel:blueGreenDeploymentConfiguration:CreateDeploymentGroup' :: CreateDeploymentGroup -> Maybe BlueGreenDeploymentConfiguration
$sel:autoScalingGroups:CreateDeploymentGroup' :: CreateDeploymentGroup -> Maybe [Text]
$sel:autoRollbackConfiguration:CreateDeploymentGroup' :: CreateDeploymentGroup -> Maybe AutoRollbackConfiguration
$sel:alarmConfiguration:CreateDeploymentGroup' :: CreateDeploymentGroup -> Maybe AlarmConfiguration
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"alarmConfiguration" 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 AlarmConfiguration
alarmConfiguration,
            (Key
"autoRollbackConfiguration" 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 AutoRollbackConfiguration
autoRollbackConfiguration,
            (Key
"autoScalingGroups" 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]
autoScalingGroups,
            (Key
"blueGreenDeploymentConfiguration" 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 BlueGreenDeploymentConfiguration
blueGreenDeploymentConfiguration,
            (Key
"deploymentConfigName" 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
deploymentConfigName,
            (Key
"deploymentStyle" 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 DeploymentStyle
deploymentStyle,
            (Key
"ec2TagFilters" 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 [EC2TagFilter]
ec2TagFilters,
            (Key
"ec2TagSet" 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 EC2TagSet
ec2TagSet,
            (Key
"ecsServices" 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 [ECSService]
ecsServices,
            (Key
"loadBalancerInfo" 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 LoadBalancerInfo
loadBalancerInfo,
            (Key
"onPremisesInstanceTagFilters" 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 [TagFilter]
onPremisesInstanceTagFilters,
            (Key
"onPremisesTagSet" 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 OnPremisesTagSet
onPremisesTagSet,
            (Key
"outdatedInstancesStrategy" 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 OutdatedInstancesStrategy
outdatedInstancesStrategy,
            (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 [Tag]
tags,
            (Key
"triggerConfigurations" 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 [TriggerConfig]
triggerConfigurations,
            forall a. a -> Maybe a
Prelude.Just
              (Key
"applicationName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
applicationName),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"deploymentGroupName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
deploymentGroupName),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"serviceRoleArn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
serviceRoleArn)
          ]
      )

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

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

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

-- |
-- Create a value of 'CreateDeploymentGroupResponse' 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:
--
-- 'deploymentGroupId', 'createDeploymentGroupResponse_deploymentGroupId' - A unique deployment group ID.
--
-- 'httpStatus', 'createDeploymentGroupResponse_httpStatus' - The response's http status code.
newCreateDeploymentGroupResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateDeploymentGroupResponse
newCreateDeploymentGroupResponse :: Int -> CreateDeploymentGroupResponse
newCreateDeploymentGroupResponse Int
pHttpStatus_ =
  CreateDeploymentGroupResponse'
    { $sel:deploymentGroupId:CreateDeploymentGroupResponse' :: Maybe Text
deploymentGroupId =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateDeploymentGroupResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | A unique deployment group ID.
createDeploymentGroupResponse_deploymentGroupId :: Lens.Lens' CreateDeploymentGroupResponse (Prelude.Maybe Prelude.Text)
createDeploymentGroupResponse_deploymentGroupId :: Lens' CreateDeploymentGroupResponse (Maybe Text)
createDeploymentGroupResponse_deploymentGroupId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDeploymentGroupResponse' {Maybe Text
deploymentGroupId :: Maybe Text
$sel:deploymentGroupId:CreateDeploymentGroupResponse' :: CreateDeploymentGroupResponse -> Maybe Text
deploymentGroupId} -> Maybe Text
deploymentGroupId) (\s :: CreateDeploymentGroupResponse
s@CreateDeploymentGroupResponse' {} Maybe Text
a -> CreateDeploymentGroupResponse
s {$sel:deploymentGroupId:CreateDeploymentGroupResponse' :: Maybe Text
deploymentGroupId = Maybe Text
a} :: CreateDeploymentGroupResponse)

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

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