{-# 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.UpdateDeploymentGroup
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Changes information about a deployment group.
module Amazonka.CodeDeploy.UpdateDeploymentGroup
  ( -- * Creating a Request
    UpdateDeploymentGroup (..),
    newUpdateDeploymentGroup,

    -- * Request Lenses
    updateDeploymentGroup_alarmConfiguration,
    updateDeploymentGroup_autoRollbackConfiguration,
    updateDeploymentGroup_autoScalingGroups,
    updateDeploymentGroup_blueGreenDeploymentConfiguration,
    updateDeploymentGroup_deploymentConfigName,
    updateDeploymentGroup_deploymentStyle,
    updateDeploymentGroup_ec2TagFilters,
    updateDeploymentGroup_ec2TagSet,
    updateDeploymentGroup_ecsServices,
    updateDeploymentGroup_loadBalancerInfo,
    updateDeploymentGroup_newDeploymentGroupName,
    updateDeploymentGroup_onPremisesInstanceTagFilters,
    updateDeploymentGroup_onPremisesTagSet,
    updateDeploymentGroup_outdatedInstancesStrategy,
    updateDeploymentGroup_serviceRoleArn,
    updateDeploymentGroup_triggerConfigurations,
    updateDeploymentGroup_applicationName,
    updateDeploymentGroup_currentDeploymentGroupName,

    -- * Destructuring the Response
    UpdateDeploymentGroupResponse (..),
    newUpdateDeploymentGroupResponse,

    -- * Response Lenses
    updateDeploymentGroupResponse_hooksNotCleanedUp,
    updateDeploymentGroupResponse_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 an @UpdateDeploymentGroup@ operation.
--
-- /See:/ 'newUpdateDeploymentGroup' smart constructor.
data UpdateDeploymentGroup = UpdateDeploymentGroup'
  { -- | Information to add or change about Amazon CloudWatch alarms when the
    -- deployment group is updated.
    UpdateDeploymentGroup -> Maybe AlarmConfiguration
alarmConfiguration :: Prelude.Maybe AlarmConfiguration,
    -- | Information for an automatic rollback configuration that is added or
    -- changed when a deployment group is updated.
    UpdateDeploymentGroup -> Maybe AutoRollbackConfiguration
autoRollbackConfiguration :: Prelude.Maybe AutoRollbackConfiguration,
    -- | The replacement list of Auto Scaling groups to be included in the
    -- deployment group, if you want to change them.
    --
    -- -   To keep the Auto Scaling groups, enter their names or do not specify
    --     this parameter.
    --
    -- -   To remove Auto Scaling groups, specify a non-null empty list of Auto
    --     Scaling group names to detach all CodeDeploy-managed Auto Scaling
    --     lifecycle hooks. For examples, see
    --     <https://docs.aws.amazon.com/https:/docs.aws.amazon.com/codedeploy/latest/userguide/troubleshooting-auto-scaling.html#troubleshooting-auto-scaling-heartbeat Amazon EC2 instances in an Amazon EC2 Auto Scaling group fail to launch and receive the error \"Heartbeat Timeout\">
    --     in the /CodeDeploy User Guide/.
    UpdateDeploymentGroup -> Maybe [Text]
autoScalingGroups :: Prelude.Maybe [Prelude.Text],
    -- | Information about blue\/green deployment options for a deployment group.
    UpdateDeploymentGroup -> Maybe BlueGreenDeploymentConfiguration
blueGreenDeploymentConfiguration :: Prelude.Maybe BlueGreenDeploymentConfiguration,
    -- | The replacement deployment configuration name to use, if you want to
    -- change it.
    UpdateDeploymentGroup -> Maybe Text
deploymentConfigName :: Prelude.Maybe Prelude.Text,
    -- | Information about the type of deployment, either in-place or
    -- blue\/green, you want to run and whether to route deployment traffic
    -- behind a load balancer.
    UpdateDeploymentGroup -> Maybe DeploymentStyle
deploymentStyle :: Prelude.Maybe DeploymentStyle,
    -- | The replacement set of Amazon EC2 tags on which to filter, if you want
    -- to change them. To keep the existing tags, enter their names. To remove
    -- tags, do not enter any tag names.
    UpdateDeploymentGroup -> Maybe [EC2TagFilter]
ec2TagFilters :: Prelude.Maybe [EC2TagFilter],
    -- | Information about groups of tags applied to on-premises instances. The
    -- deployment group includes only Amazon EC2 instances identified by all
    -- the tag groups.
    UpdateDeploymentGroup -> 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>@.
    UpdateDeploymentGroup -> Maybe [ECSService]
ecsServices :: Prelude.Maybe [ECSService],
    -- | Information about the load balancer used in a deployment.
    UpdateDeploymentGroup -> Maybe LoadBalancerInfo
loadBalancerInfo :: Prelude.Maybe LoadBalancerInfo,
    -- | The new name of the deployment group, if you want to change it.
    UpdateDeploymentGroup -> Maybe Text
newDeploymentGroupName' :: Prelude.Maybe Prelude.Text,
    -- | The replacement set of on-premises instance tags on which to filter, if
    -- you want to change them. To keep the existing tags, enter their names.
    -- To remove tags, do not enter any tag names.
    UpdateDeploymentGroup -> Maybe [TagFilter]
onPremisesInstanceTagFilters :: Prelude.Maybe [TagFilter],
    -- | Information about an on-premises instance tag set. The deployment group
    -- includes only on-premises instances identified by all the tag groups.
    UpdateDeploymentGroup -> 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.
    UpdateDeploymentGroup -> Maybe OutdatedInstancesStrategy
outdatedInstancesStrategy :: Prelude.Maybe OutdatedInstancesStrategy,
    -- | A replacement ARN for the service role, if you want to change it.
    UpdateDeploymentGroup -> Maybe Text
serviceRoleArn :: Prelude.Maybe Prelude.Text,
    -- | Information about triggers to change when the deployment group is
    -- updated. For examples, see
    -- <https://docs.aws.amazon.com/codedeploy/latest/userguide/how-to-notify-edit.html Edit a Trigger in a CodeDeploy Deployment Group>
    -- in the /CodeDeploy User Guide/.
    UpdateDeploymentGroup -> Maybe [TriggerConfig]
triggerConfigurations :: Prelude.Maybe [TriggerConfig],
    -- | The application name that corresponds to the deployment group to update.
    UpdateDeploymentGroup -> Text
applicationName :: Prelude.Text,
    -- | The current name of the deployment group.
    UpdateDeploymentGroup -> Text
currentDeploymentGroupName :: Prelude.Text
  }
  deriving (UpdateDeploymentGroup -> UpdateDeploymentGroup -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateDeploymentGroup -> UpdateDeploymentGroup -> Bool
$c/= :: UpdateDeploymentGroup -> UpdateDeploymentGroup -> Bool
== :: UpdateDeploymentGroup -> UpdateDeploymentGroup -> Bool
$c== :: UpdateDeploymentGroup -> UpdateDeploymentGroup -> Bool
Prelude.Eq, ReadPrec [UpdateDeploymentGroup]
ReadPrec UpdateDeploymentGroup
Int -> ReadS UpdateDeploymentGroup
ReadS [UpdateDeploymentGroup]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateDeploymentGroup]
$creadListPrec :: ReadPrec [UpdateDeploymentGroup]
readPrec :: ReadPrec UpdateDeploymentGroup
$creadPrec :: ReadPrec UpdateDeploymentGroup
readList :: ReadS [UpdateDeploymentGroup]
$creadList :: ReadS [UpdateDeploymentGroup]
readsPrec :: Int -> ReadS UpdateDeploymentGroup
$creadsPrec :: Int -> ReadS UpdateDeploymentGroup
Prelude.Read, Int -> UpdateDeploymentGroup -> ShowS
[UpdateDeploymentGroup] -> ShowS
UpdateDeploymentGroup -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateDeploymentGroup] -> ShowS
$cshowList :: [UpdateDeploymentGroup] -> ShowS
show :: UpdateDeploymentGroup -> String
$cshow :: UpdateDeploymentGroup -> String
showsPrec :: Int -> UpdateDeploymentGroup -> ShowS
$cshowsPrec :: Int -> UpdateDeploymentGroup -> ShowS
Prelude.Show, forall x. Rep UpdateDeploymentGroup x -> UpdateDeploymentGroup
forall x. UpdateDeploymentGroup -> Rep UpdateDeploymentGroup x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateDeploymentGroup x -> UpdateDeploymentGroup
$cfrom :: forall x. UpdateDeploymentGroup -> Rep UpdateDeploymentGroup x
Prelude.Generic)

-- |
-- Create a value of 'UpdateDeploymentGroup' 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', 'updateDeploymentGroup_alarmConfiguration' - Information to add or change about Amazon CloudWatch alarms when the
-- deployment group is updated.
--
-- 'autoRollbackConfiguration', 'updateDeploymentGroup_autoRollbackConfiguration' - Information for an automatic rollback configuration that is added or
-- changed when a deployment group is updated.
--
-- 'autoScalingGroups', 'updateDeploymentGroup_autoScalingGroups' - The replacement list of Auto Scaling groups to be included in the
-- deployment group, if you want to change them.
--
-- -   To keep the Auto Scaling groups, enter their names or do not specify
--     this parameter.
--
-- -   To remove Auto Scaling groups, specify a non-null empty list of Auto
--     Scaling group names to detach all CodeDeploy-managed Auto Scaling
--     lifecycle hooks. For examples, see
--     <https://docs.aws.amazon.com/https:/docs.aws.amazon.com/codedeploy/latest/userguide/troubleshooting-auto-scaling.html#troubleshooting-auto-scaling-heartbeat Amazon EC2 instances in an Amazon EC2 Auto Scaling group fail to launch and receive the error \"Heartbeat Timeout\">
--     in the /CodeDeploy User Guide/.
--
-- 'blueGreenDeploymentConfiguration', 'updateDeploymentGroup_blueGreenDeploymentConfiguration' - Information about blue\/green deployment options for a deployment group.
--
-- 'deploymentConfigName', 'updateDeploymentGroup_deploymentConfigName' - The replacement deployment configuration name to use, if you want to
-- change it.
--
-- 'deploymentStyle', 'updateDeploymentGroup_deploymentStyle' - Information about the type of deployment, either in-place or
-- blue\/green, you want to run and whether to route deployment traffic
-- behind a load balancer.
--
-- 'ec2TagFilters', 'updateDeploymentGroup_ec2TagFilters' - The replacement set of Amazon EC2 tags on which to filter, if you want
-- to change them. To keep the existing tags, enter their names. To remove
-- tags, do not enter any tag names.
--
-- 'ec2TagSet', 'updateDeploymentGroup_ec2TagSet' - Information about groups of tags applied to on-premises instances. The
-- deployment group includes only Amazon EC2 instances identified by all
-- the tag groups.
--
-- 'ecsServices', 'updateDeploymentGroup_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', 'updateDeploymentGroup_loadBalancerInfo' - Information about the load balancer used in a deployment.
--
-- 'newDeploymentGroupName'', 'updateDeploymentGroup_newDeploymentGroupName' - The new name of the deployment group, if you want to change it.
--
-- 'onPremisesInstanceTagFilters', 'updateDeploymentGroup_onPremisesInstanceTagFilters' - The replacement set of on-premises instance tags on which to filter, if
-- you want to change them. To keep the existing tags, enter their names.
-- To remove tags, do not enter any tag names.
--
-- 'onPremisesTagSet', 'updateDeploymentGroup_onPremisesTagSet' - Information about an on-premises instance tag set. The deployment group
-- includes only on-premises instances identified by all the tag groups.
--
-- 'outdatedInstancesStrategy', 'updateDeploymentGroup_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.
--
-- 'serviceRoleArn', 'updateDeploymentGroup_serviceRoleArn' - A replacement ARN for the service role, if you want to change it.
--
-- 'triggerConfigurations', 'updateDeploymentGroup_triggerConfigurations' - Information about triggers to change when the deployment group is
-- updated. For examples, see
-- <https://docs.aws.amazon.com/codedeploy/latest/userguide/how-to-notify-edit.html Edit a Trigger in a CodeDeploy Deployment Group>
-- in the /CodeDeploy User Guide/.
--
-- 'applicationName', 'updateDeploymentGroup_applicationName' - The application name that corresponds to the deployment group to update.
--
-- 'currentDeploymentGroupName', 'updateDeploymentGroup_currentDeploymentGroupName' - The current name of the deployment group.
newUpdateDeploymentGroup ::
  -- | 'applicationName'
  Prelude.Text ->
  -- | 'currentDeploymentGroupName'
  Prelude.Text ->
  UpdateDeploymentGroup
newUpdateDeploymentGroup :: Text -> Text -> UpdateDeploymentGroup
newUpdateDeploymentGroup
  Text
pApplicationName_
  Text
pCurrentDeploymentGroupName_ =
    UpdateDeploymentGroup'
      { $sel:alarmConfiguration:UpdateDeploymentGroup' :: Maybe AlarmConfiguration
alarmConfiguration =
          forall a. Maybe a
Prelude.Nothing,
        $sel:autoRollbackConfiguration:UpdateDeploymentGroup' :: Maybe AutoRollbackConfiguration
autoRollbackConfiguration = forall a. Maybe a
Prelude.Nothing,
        $sel:autoScalingGroups:UpdateDeploymentGroup' :: Maybe [Text]
autoScalingGroups = forall a. Maybe a
Prelude.Nothing,
        $sel:blueGreenDeploymentConfiguration:UpdateDeploymentGroup' :: Maybe BlueGreenDeploymentConfiguration
blueGreenDeploymentConfiguration = forall a. Maybe a
Prelude.Nothing,
        $sel:deploymentConfigName:UpdateDeploymentGroup' :: Maybe Text
deploymentConfigName = forall a. Maybe a
Prelude.Nothing,
        $sel:deploymentStyle:UpdateDeploymentGroup' :: Maybe DeploymentStyle
deploymentStyle = forall a. Maybe a
Prelude.Nothing,
        $sel:ec2TagFilters:UpdateDeploymentGroup' :: Maybe [EC2TagFilter]
ec2TagFilters = forall a. Maybe a
Prelude.Nothing,
        $sel:ec2TagSet:UpdateDeploymentGroup' :: Maybe EC2TagSet
ec2TagSet = forall a. Maybe a
Prelude.Nothing,
        $sel:ecsServices:UpdateDeploymentGroup' :: Maybe [ECSService]
ecsServices = forall a. Maybe a
Prelude.Nothing,
        $sel:loadBalancerInfo:UpdateDeploymentGroup' :: Maybe LoadBalancerInfo
loadBalancerInfo = forall a. Maybe a
Prelude.Nothing,
        $sel:newDeploymentGroupName':UpdateDeploymentGroup' :: Maybe Text
newDeploymentGroupName' = forall a. Maybe a
Prelude.Nothing,
        $sel:onPremisesInstanceTagFilters:UpdateDeploymentGroup' :: Maybe [TagFilter]
onPremisesInstanceTagFilters = forall a. Maybe a
Prelude.Nothing,
        $sel:onPremisesTagSet:UpdateDeploymentGroup' :: Maybe OnPremisesTagSet
onPremisesTagSet = forall a. Maybe a
Prelude.Nothing,
        $sel:outdatedInstancesStrategy:UpdateDeploymentGroup' :: Maybe OutdatedInstancesStrategy
outdatedInstancesStrategy = forall a. Maybe a
Prelude.Nothing,
        $sel:serviceRoleArn:UpdateDeploymentGroup' :: Maybe Text
serviceRoleArn = forall a. Maybe a
Prelude.Nothing,
        $sel:triggerConfigurations:UpdateDeploymentGroup' :: Maybe [TriggerConfig]
triggerConfigurations = forall a. Maybe a
Prelude.Nothing,
        $sel:applicationName:UpdateDeploymentGroup' :: Text
applicationName = Text
pApplicationName_,
        $sel:currentDeploymentGroupName:UpdateDeploymentGroup' :: Text
currentDeploymentGroupName =
          Text
pCurrentDeploymentGroupName_
      }

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

-- | Information for an automatic rollback configuration that is added or
-- changed when a deployment group is updated.
updateDeploymentGroup_autoRollbackConfiguration :: Lens.Lens' UpdateDeploymentGroup (Prelude.Maybe AutoRollbackConfiguration)
updateDeploymentGroup_autoRollbackConfiguration :: Lens' UpdateDeploymentGroup (Maybe AutoRollbackConfiguration)
updateDeploymentGroup_autoRollbackConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateDeploymentGroup' {Maybe AutoRollbackConfiguration
autoRollbackConfiguration :: Maybe AutoRollbackConfiguration
$sel:autoRollbackConfiguration:UpdateDeploymentGroup' :: UpdateDeploymentGroup -> Maybe AutoRollbackConfiguration
autoRollbackConfiguration} -> Maybe AutoRollbackConfiguration
autoRollbackConfiguration) (\s :: UpdateDeploymentGroup
s@UpdateDeploymentGroup' {} Maybe AutoRollbackConfiguration
a -> UpdateDeploymentGroup
s {$sel:autoRollbackConfiguration:UpdateDeploymentGroup' :: Maybe AutoRollbackConfiguration
autoRollbackConfiguration = Maybe AutoRollbackConfiguration
a} :: UpdateDeploymentGroup)

-- | The replacement list of Auto Scaling groups to be included in the
-- deployment group, if you want to change them.
--
-- -   To keep the Auto Scaling groups, enter their names or do not specify
--     this parameter.
--
-- -   To remove Auto Scaling groups, specify a non-null empty list of Auto
--     Scaling group names to detach all CodeDeploy-managed Auto Scaling
--     lifecycle hooks. For examples, see
--     <https://docs.aws.amazon.com/https:/docs.aws.amazon.com/codedeploy/latest/userguide/troubleshooting-auto-scaling.html#troubleshooting-auto-scaling-heartbeat Amazon EC2 instances in an Amazon EC2 Auto Scaling group fail to launch and receive the error \"Heartbeat Timeout\">
--     in the /CodeDeploy User Guide/.
updateDeploymentGroup_autoScalingGroups :: Lens.Lens' UpdateDeploymentGroup (Prelude.Maybe [Prelude.Text])
updateDeploymentGroup_autoScalingGroups :: Lens' UpdateDeploymentGroup (Maybe [Text])
updateDeploymentGroup_autoScalingGroups = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateDeploymentGroup' {Maybe [Text]
autoScalingGroups :: Maybe [Text]
$sel:autoScalingGroups:UpdateDeploymentGroup' :: UpdateDeploymentGroup -> Maybe [Text]
autoScalingGroups} -> Maybe [Text]
autoScalingGroups) (\s :: UpdateDeploymentGroup
s@UpdateDeploymentGroup' {} Maybe [Text]
a -> UpdateDeploymentGroup
s {$sel:autoScalingGroups:UpdateDeploymentGroup' :: Maybe [Text]
autoScalingGroups = Maybe [Text]
a} :: UpdateDeploymentGroup) 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.
updateDeploymentGroup_blueGreenDeploymentConfiguration :: Lens.Lens' UpdateDeploymentGroup (Prelude.Maybe BlueGreenDeploymentConfiguration)
updateDeploymentGroup_blueGreenDeploymentConfiguration :: Lens'
  UpdateDeploymentGroup (Maybe BlueGreenDeploymentConfiguration)
updateDeploymentGroup_blueGreenDeploymentConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateDeploymentGroup' {Maybe BlueGreenDeploymentConfiguration
blueGreenDeploymentConfiguration :: Maybe BlueGreenDeploymentConfiguration
$sel:blueGreenDeploymentConfiguration:UpdateDeploymentGroup' :: UpdateDeploymentGroup -> Maybe BlueGreenDeploymentConfiguration
blueGreenDeploymentConfiguration} -> Maybe BlueGreenDeploymentConfiguration
blueGreenDeploymentConfiguration) (\s :: UpdateDeploymentGroup
s@UpdateDeploymentGroup' {} Maybe BlueGreenDeploymentConfiguration
a -> UpdateDeploymentGroup
s {$sel:blueGreenDeploymentConfiguration:UpdateDeploymentGroup' :: Maybe BlueGreenDeploymentConfiguration
blueGreenDeploymentConfiguration = Maybe BlueGreenDeploymentConfiguration
a} :: UpdateDeploymentGroup)

-- | The replacement deployment configuration name to use, if you want to
-- change it.
updateDeploymentGroup_deploymentConfigName :: Lens.Lens' UpdateDeploymentGroup (Prelude.Maybe Prelude.Text)
updateDeploymentGroup_deploymentConfigName :: Lens' UpdateDeploymentGroup (Maybe Text)
updateDeploymentGroup_deploymentConfigName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateDeploymentGroup' {Maybe Text
deploymentConfigName :: Maybe Text
$sel:deploymentConfigName:UpdateDeploymentGroup' :: UpdateDeploymentGroup -> Maybe Text
deploymentConfigName} -> Maybe Text
deploymentConfigName) (\s :: UpdateDeploymentGroup
s@UpdateDeploymentGroup' {} Maybe Text
a -> UpdateDeploymentGroup
s {$sel:deploymentConfigName:UpdateDeploymentGroup' :: Maybe Text
deploymentConfigName = Maybe Text
a} :: UpdateDeploymentGroup)

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

-- | The replacement set of Amazon EC2 tags on which to filter, if you want
-- to change them. To keep the existing tags, enter their names. To remove
-- tags, do not enter any tag names.
updateDeploymentGroup_ec2TagFilters :: Lens.Lens' UpdateDeploymentGroup (Prelude.Maybe [EC2TagFilter])
updateDeploymentGroup_ec2TagFilters :: Lens' UpdateDeploymentGroup (Maybe [EC2TagFilter])
updateDeploymentGroup_ec2TagFilters = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateDeploymentGroup' {Maybe [EC2TagFilter]
ec2TagFilters :: Maybe [EC2TagFilter]
$sel:ec2TagFilters:UpdateDeploymentGroup' :: UpdateDeploymentGroup -> Maybe [EC2TagFilter]
ec2TagFilters} -> Maybe [EC2TagFilter]
ec2TagFilters) (\s :: UpdateDeploymentGroup
s@UpdateDeploymentGroup' {} Maybe [EC2TagFilter]
a -> UpdateDeploymentGroup
s {$sel:ec2TagFilters:UpdateDeploymentGroup' :: Maybe [EC2TagFilter]
ec2TagFilters = Maybe [EC2TagFilter]
a} :: UpdateDeploymentGroup) 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 Amazon EC2 instances identified by all
-- the tag groups.
updateDeploymentGroup_ec2TagSet :: Lens.Lens' UpdateDeploymentGroup (Prelude.Maybe EC2TagSet)
updateDeploymentGroup_ec2TagSet :: Lens' UpdateDeploymentGroup (Maybe EC2TagSet)
updateDeploymentGroup_ec2TagSet = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateDeploymentGroup' {Maybe EC2TagSet
ec2TagSet :: Maybe EC2TagSet
$sel:ec2TagSet:UpdateDeploymentGroup' :: UpdateDeploymentGroup -> Maybe EC2TagSet
ec2TagSet} -> Maybe EC2TagSet
ec2TagSet) (\s :: UpdateDeploymentGroup
s@UpdateDeploymentGroup' {} Maybe EC2TagSet
a -> UpdateDeploymentGroup
s {$sel:ec2TagSet:UpdateDeploymentGroup' :: Maybe EC2TagSet
ec2TagSet = Maybe EC2TagSet
a} :: UpdateDeploymentGroup)

-- | 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>@.
updateDeploymentGroup_ecsServices :: Lens.Lens' UpdateDeploymentGroup (Prelude.Maybe [ECSService])
updateDeploymentGroup_ecsServices :: Lens' UpdateDeploymentGroup (Maybe [ECSService])
updateDeploymentGroup_ecsServices = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateDeploymentGroup' {Maybe [ECSService]
ecsServices :: Maybe [ECSService]
$sel:ecsServices:UpdateDeploymentGroup' :: UpdateDeploymentGroup -> Maybe [ECSService]
ecsServices} -> Maybe [ECSService]
ecsServices) (\s :: UpdateDeploymentGroup
s@UpdateDeploymentGroup' {} Maybe [ECSService]
a -> UpdateDeploymentGroup
s {$sel:ecsServices:UpdateDeploymentGroup' :: Maybe [ECSService]
ecsServices = Maybe [ECSService]
a} :: UpdateDeploymentGroup) 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.
updateDeploymentGroup_loadBalancerInfo :: Lens.Lens' UpdateDeploymentGroup (Prelude.Maybe LoadBalancerInfo)
updateDeploymentGroup_loadBalancerInfo :: Lens' UpdateDeploymentGroup (Maybe LoadBalancerInfo)
updateDeploymentGroup_loadBalancerInfo = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateDeploymentGroup' {Maybe LoadBalancerInfo
loadBalancerInfo :: Maybe LoadBalancerInfo
$sel:loadBalancerInfo:UpdateDeploymentGroup' :: UpdateDeploymentGroup -> Maybe LoadBalancerInfo
loadBalancerInfo} -> Maybe LoadBalancerInfo
loadBalancerInfo) (\s :: UpdateDeploymentGroup
s@UpdateDeploymentGroup' {} Maybe LoadBalancerInfo
a -> UpdateDeploymentGroup
s {$sel:loadBalancerInfo:UpdateDeploymentGroup' :: Maybe LoadBalancerInfo
loadBalancerInfo = Maybe LoadBalancerInfo
a} :: UpdateDeploymentGroup)

-- | The new name of the deployment group, if you want to change it.
updateDeploymentGroup_newDeploymentGroupName :: Lens.Lens' UpdateDeploymentGroup (Prelude.Maybe Prelude.Text)
updateDeploymentGroup_newDeploymentGroupName :: Lens' UpdateDeploymentGroup (Maybe Text)
updateDeploymentGroup_newDeploymentGroupName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateDeploymentGroup' {Maybe Text
newDeploymentGroupName' :: Maybe Text
$sel:newDeploymentGroupName':UpdateDeploymentGroup' :: UpdateDeploymentGroup -> Maybe Text
newDeploymentGroupName'} -> Maybe Text
newDeploymentGroupName') (\s :: UpdateDeploymentGroup
s@UpdateDeploymentGroup' {} Maybe Text
a -> UpdateDeploymentGroup
s {$sel:newDeploymentGroupName':UpdateDeploymentGroup' :: Maybe Text
newDeploymentGroupName' = Maybe Text
a} :: UpdateDeploymentGroup)

-- | The replacement set of on-premises instance tags on which to filter, if
-- you want to change them. To keep the existing tags, enter their names.
-- To remove tags, do not enter any tag names.
updateDeploymentGroup_onPremisesInstanceTagFilters :: Lens.Lens' UpdateDeploymentGroup (Prelude.Maybe [TagFilter])
updateDeploymentGroup_onPremisesInstanceTagFilters :: Lens' UpdateDeploymentGroup (Maybe [TagFilter])
updateDeploymentGroup_onPremisesInstanceTagFilters = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateDeploymentGroup' {Maybe [TagFilter]
onPremisesInstanceTagFilters :: Maybe [TagFilter]
$sel:onPremisesInstanceTagFilters:UpdateDeploymentGroup' :: UpdateDeploymentGroup -> Maybe [TagFilter]
onPremisesInstanceTagFilters} -> Maybe [TagFilter]
onPremisesInstanceTagFilters) (\s :: UpdateDeploymentGroup
s@UpdateDeploymentGroup' {} Maybe [TagFilter]
a -> UpdateDeploymentGroup
s {$sel:onPremisesInstanceTagFilters:UpdateDeploymentGroup' :: Maybe [TagFilter]
onPremisesInstanceTagFilters = Maybe [TagFilter]
a} :: UpdateDeploymentGroup) 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 an on-premises instance tag set. The deployment group
-- includes only on-premises instances identified by all the tag groups.
updateDeploymentGroup_onPremisesTagSet :: Lens.Lens' UpdateDeploymentGroup (Prelude.Maybe OnPremisesTagSet)
updateDeploymentGroup_onPremisesTagSet :: Lens' UpdateDeploymentGroup (Maybe OnPremisesTagSet)
updateDeploymentGroup_onPremisesTagSet = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateDeploymentGroup' {Maybe OnPremisesTagSet
onPremisesTagSet :: Maybe OnPremisesTagSet
$sel:onPremisesTagSet:UpdateDeploymentGroup' :: UpdateDeploymentGroup -> Maybe OnPremisesTagSet
onPremisesTagSet} -> Maybe OnPremisesTagSet
onPremisesTagSet) (\s :: UpdateDeploymentGroup
s@UpdateDeploymentGroup' {} Maybe OnPremisesTagSet
a -> UpdateDeploymentGroup
s {$sel:onPremisesTagSet:UpdateDeploymentGroup' :: Maybe OnPremisesTagSet
onPremisesTagSet = Maybe OnPremisesTagSet
a} :: UpdateDeploymentGroup)

-- | 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.
updateDeploymentGroup_outdatedInstancesStrategy :: Lens.Lens' UpdateDeploymentGroup (Prelude.Maybe OutdatedInstancesStrategy)
updateDeploymentGroup_outdatedInstancesStrategy :: Lens' UpdateDeploymentGroup (Maybe OutdatedInstancesStrategy)
updateDeploymentGroup_outdatedInstancesStrategy = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateDeploymentGroup' {Maybe OutdatedInstancesStrategy
outdatedInstancesStrategy :: Maybe OutdatedInstancesStrategy
$sel:outdatedInstancesStrategy:UpdateDeploymentGroup' :: UpdateDeploymentGroup -> Maybe OutdatedInstancesStrategy
outdatedInstancesStrategy} -> Maybe OutdatedInstancesStrategy
outdatedInstancesStrategy) (\s :: UpdateDeploymentGroup
s@UpdateDeploymentGroup' {} Maybe OutdatedInstancesStrategy
a -> UpdateDeploymentGroup
s {$sel:outdatedInstancesStrategy:UpdateDeploymentGroup' :: Maybe OutdatedInstancesStrategy
outdatedInstancesStrategy = Maybe OutdatedInstancesStrategy
a} :: UpdateDeploymentGroup)

-- | A replacement ARN for the service role, if you want to change it.
updateDeploymentGroup_serviceRoleArn :: Lens.Lens' UpdateDeploymentGroup (Prelude.Maybe Prelude.Text)
updateDeploymentGroup_serviceRoleArn :: Lens' UpdateDeploymentGroup (Maybe Text)
updateDeploymentGroup_serviceRoleArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateDeploymentGroup' {Maybe Text
serviceRoleArn :: Maybe Text
$sel:serviceRoleArn:UpdateDeploymentGroup' :: UpdateDeploymentGroup -> Maybe Text
serviceRoleArn} -> Maybe Text
serviceRoleArn) (\s :: UpdateDeploymentGroup
s@UpdateDeploymentGroup' {} Maybe Text
a -> UpdateDeploymentGroup
s {$sel:serviceRoleArn:UpdateDeploymentGroup' :: Maybe Text
serviceRoleArn = Maybe Text
a} :: UpdateDeploymentGroup)

-- | Information about triggers to change when the deployment group is
-- updated. For examples, see
-- <https://docs.aws.amazon.com/codedeploy/latest/userguide/how-to-notify-edit.html Edit a Trigger in a CodeDeploy Deployment Group>
-- in the /CodeDeploy User Guide/.
updateDeploymentGroup_triggerConfigurations :: Lens.Lens' UpdateDeploymentGroup (Prelude.Maybe [TriggerConfig])
updateDeploymentGroup_triggerConfigurations :: Lens' UpdateDeploymentGroup (Maybe [TriggerConfig])
updateDeploymentGroup_triggerConfigurations = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateDeploymentGroup' {Maybe [TriggerConfig]
triggerConfigurations :: Maybe [TriggerConfig]
$sel:triggerConfigurations:UpdateDeploymentGroup' :: UpdateDeploymentGroup -> Maybe [TriggerConfig]
triggerConfigurations} -> Maybe [TriggerConfig]
triggerConfigurations) (\s :: UpdateDeploymentGroup
s@UpdateDeploymentGroup' {} Maybe [TriggerConfig]
a -> UpdateDeploymentGroup
s {$sel:triggerConfigurations:UpdateDeploymentGroup' :: Maybe [TriggerConfig]
triggerConfigurations = Maybe [TriggerConfig]
a} :: UpdateDeploymentGroup) 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 application name that corresponds to the deployment group to update.
updateDeploymentGroup_applicationName :: Lens.Lens' UpdateDeploymentGroup Prelude.Text
updateDeploymentGroup_applicationName :: Lens' UpdateDeploymentGroup Text
updateDeploymentGroup_applicationName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateDeploymentGroup' {Text
applicationName :: Text
$sel:applicationName:UpdateDeploymentGroup' :: UpdateDeploymentGroup -> Text
applicationName} -> Text
applicationName) (\s :: UpdateDeploymentGroup
s@UpdateDeploymentGroup' {} Text
a -> UpdateDeploymentGroup
s {$sel:applicationName:UpdateDeploymentGroup' :: Text
applicationName = Text
a} :: UpdateDeploymentGroup)

-- | The current name of the deployment group.
updateDeploymentGroup_currentDeploymentGroupName :: Lens.Lens' UpdateDeploymentGroup Prelude.Text
updateDeploymentGroup_currentDeploymentGroupName :: Lens' UpdateDeploymentGroup Text
updateDeploymentGroup_currentDeploymentGroupName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateDeploymentGroup' {Text
currentDeploymentGroupName :: Text
$sel:currentDeploymentGroupName:UpdateDeploymentGroup' :: UpdateDeploymentGroup -> Text
currentDeploymentGroupName} -> Text
currentDeploymentGroupName) (\s :: UpdateDeploymentGroup
s@UpdateDeploymentGroup' {} Text
a -> UpdateDeploymentGroup
s {$sel:currentDeploymentGroupName:UpdateDeploymentGroup' :: Text
currentDeploymentGroupName = Text
a} :: UpdateDeploymentGroup)

instance Core.AWSRequest UpdateDeploymentGroup where
  type
    AWSResponse UpdateDeploymentGroup =
      UpdateDeploymentGroupResponse
  request :: (Service -> Service)
-> UpdateDeploymentGroup -> Request UpdateDeploymentGroup
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 UpdateDeploymentGroup
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse UpdateDeploymentGroup)))
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 [AutoScalingGroup] -> Int -> UpdateDeploymentGroupResponse
UpdateDeploymentGroupResponse'
            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
"hooksNotCleanedUp"
                            forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty
                        )
            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 UpdateDeploymentGroup where
  hashWithSalt :: Int -> UpdateDeploymentGroup -> Int
hashWithSalt Int
_salt UpdateDeploymentGroup' {Maybe [Text]
Maybe [EC2TagFilter]
Maybe [ECSService]
Maybe [TagFilter]
Maybe [TriggerConfig]
Maybe Text
Maybe AlarmConfiguration
Maybe AutoRollbackConfiguration
Maybe DeploymentStyle
Maybe EC2TagSet
Maybe BlueGreenDeploymentConfiguration
Maybe OutdatedInstancesStrategy
Maybe OnPremisesTagSet
Maybe LoadBalancerInfo
Text
currentDeploymentGroupName :: Text
applicationName :: Text
triggerConfigurations :: Maybe [TriggerConfig]
serviceRoleArn :: Maybe Text
outdatedInstancesStrategy :: Maybe OutdatedInstancesStrategy
onPremisesTagSet :: Maybe OnPremisesTagSet
onPremisesInstanceTagFilters :: Maybe [TagFilter]
newDeploymentGroupName' :: Maybe Text
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:currentDeploymentGroupName:UpdateDeploymentGroup' :: UpdateDeploymentGroup -> Text
$sel:applicationName:UpdateDeploymentGroup' :: UpdateDeploymentGroup -> Text
$sel:triggerConfigurations:UpdateDeploymentGroup' :: UpdateDeploymentGroup -> Maybe [TriggerConfig]
$sel:serviceRoleArn:UpdateDeploymentGroup' :: UpdateDeploymentGroup -> Maybe Text
$sel:outdatedInstancesStrategy:UpdateDeploymentGroup' :: UpdateDeploymentGroup -> Maybe OutdatedInstancesStrategy
$sel:onPremisesTagSet:UpdateDeploymentGroup' :: UpdateDeploymentGroup -> Maybe OnPremisesTagSet
$sel:onPremisesInstanceTagFilters:UpdateDeploymentGroup' :: UpdateDeploymentGroup -> Maybe [TagFilter]
$sel:newDeploymentGroupName':UpdateDeploymentGroup' :: UpdateDeploymentGroup -> Maybe Text
$sel:loadBalancerInfo:UpdateDeploymentGroup' :: UpdateDeploymentGroup -> Maybe LoadBalancerInfo
$sel:ecsServices:UpdateDeploymentGroup' :: UpdateDeploymentGroup -> Maybe [ECSService]
$sel:ec2TagSet:UpdateDeploymentGroup' :: UpdateDeploymentGroup -> Maybe EC2TagSet
$sel:ec2TagFilters:UpdateDeploymentGroup' :: UpdateDeploymentGroup -> Maybe [EC2TagFilter]
$sel:deploymentStyle:UpdateDeploymentGroup' :: UpdateDeploymentGroup -> Maybe DeploymentStyle
$sel:deploymentConfigName:UpdateDeploymentGroup' :: UpdateDeploymentGroup -> Maybe Text
$sel:blueGreenDeploymentConfiguration:UpdateDeploymentGroup' :: UpdateDeploymentGroup -> Maybe BlueGreenDeploymentConfiguration
$sel:autoScalingGroups:UpdateDeploymentGroup' :: UpdateDeploymentGroup -> Maybe [Text]
$sel:autoRollbackConfiguration:UpdateDeploymentGroup' :: UpdateDeploymentGroup -> Maybe AutoRollbackConfiguration
$sel:alarmConfiguration:UpdateDeploymentGroup' :: UpdateDeploymentGroup -> 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 Text
newDeploymentGroupName'
      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 Text
serviceRoleArn
      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
currentDeploymentGroupName

instance Prelude.NFData UpdateDeploymentGroup where
  rnf :: UpdateDeploymentGroup -> ()
rnf UpdateDeploymentGroup' {Maybe [Text]
Maybe [EC2TagFilter]
Maybe [ECSService]
Maybe [TagFilter]
Maybe [TriggerConfig]
Maybe Text
Maybe AlarmConfiguration
Maybe AutoRollbackConfiguration
Maybe DeploymentStyle
Maybe EC2TagSet
Maybe BlueGreenDeploymentConfiguration
Maybe OutdatedInstancesStrategy
Maybe OnPremisesTagSet
Maybe LoadBalancerInfo
Text
currentDeploymentGroupName :: Text
applicationName :: Text
triggerConfigurations :: Maybe [TriggerConfig]
serviceRoleArn :: Maybe Text
outdatedInstancesStrategy :: Maybe OutdatedInstancesStrategy
onPremisesTagSet :: Maybe OnPremisesTagSet
onPremisesInstanceTagFilters :: Maybe [TagFilter]
newDeploymentGroupName' :: Maybe Text
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:currentDeploymentGroupName:UpdateDeploymentGroup' :: UpdateDeploymentGroup -> Text
$sel:applicationName:UpdateDeploymentGroup' :: UpdateDeploymentGroup -> Text
$sel:triggerConfigurations:UpdateDeploymentGroup' :: UpdateDeploymentGroup -> Maybe [TriggerConfig]
$sel:serviceRoleArn:UpdateDeploymentGroup' :: UpdateDeploymentGroup -> Maybe Text
$sel:outdatedInstancesStrategy:UpdateDeploymentGroup' :: UpdateDeploymentGroup -> Maybe OutdatedInstancesStrategy
$sel:onPremisesTagSet:UpdateDeploymentGroup' :: UpdateDeploymentGroup -> Maybe OnPremisesTagSet
$sel:onPremisesInstanceTagFilters:UpdateDeploymentGroup' :: UpdateDeploymentGroup -> Maybe [TagFilter]
$sel:newDeploymentGroupName':UpdateDeploymentGroup' :: UpdateDeploymentGroup -> Maybe Text
$sel:loadBalancerInfo:UpdateDeploymentGroup' :: UpdateDeploymentGroup -> Maybe LoadBalancerInfo
$sel:ecsServices:UpdateDeploymentGroup' :: UpdateDeploymentGroup -> Maybe [ECSService]
$sel:ec2TagSet:UpdateDeploymentGroup' :: UpdateDeploymentGroup -> Maybe EC2TagSet
$sel:ec2TagFilters:UpdateDeploymentGroup' :: UpdateDeploymentGroup -> Maybe [EC2TagFilter]
$sel:deploymentStyle:UpdateDeploymentGroup' :: UpdateDeploymentGroup -> Maybe DeploymentStyle
$sel:deploymentConfigName:UpdateDeploymentGroup' :: UpdateDeploymentGroup -> Maybe Text
$sel:blueGreenDeploymentConfiguration:UpdateDeploymentGroup' :: UpdateDeploymentGroup -> Maybe BlueGreenDeploymentConfiguration
$sel:autoScalingGroups:UpdateDeploymentGroup' :: UpdateDeploymentGroup -> Maybe [Text]
$sel:autoRollbackConfiguration:UpdateDeploymentGroup' :: UpdateDeploymentGroup -> Maybe AutoRollbackConfiguration
$sel:alarmConfiguration:UpdateDeploymentGroup' :: UpdateDeploymentGroup -> 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 Text
newDeploymentGroupName'
      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 Text
serviceRoleArn
      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
currentDeploymentGroupName

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

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

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

-- | Represents the output of an @UpdateDeploymentGroup@ operation.
--
-- /See:/ 'newUpdateDeploymentGroupResponse' smart constructor.
data UpdateDeploymentGroupResponse = UpdateDeploymentGroupResponse'
  { -- | If the output contains no data, and the corresponding deployment group
    -- contained at least one Auto Scaling group, CodeDeploy successfully
    -- removed all corresponding Auto Scaling lifecycle event hooks from the
    -- Amazon Web Services account. If the output contains data, CodeDeploy
    -- could not remove some Auto Scaling lifecycle event hooks from the Amazon
    -- Web Services account.
    UpdateDeploymentGroupResponse -> Maybe [AutoScalingGroup]
hooksNotCleanedUp :: Prelude.Maybe [AutoScalingGroup],
    -- | The response's http status code.
    UpdateDeploymentGroupResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (UpdateDeploymentGroupResponse
-> UpdateDeploymentGroupResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateDeploymentGroupResponse
-> UpdateDeploymentGroupResponse -> Bool
$c/= :: UpdateDeploymentGroupResponse
-> UpdateDeploymentGroupResponse -> Bool
== :: UpdateDeploymentGroupResponse
-> UpdateDeploymentGroupResponse -> Bool
$c== :: UpdateDeploymentGroupResponse
-> UpdateDeploymentGroupResponse -> Bool
Prelude.Eq, ReadPrec [UpdateDeploymentGroupResponse]
ReadPrec UpdateDeploymentGroupResponse
Int -> ReadS UpdateDeploymentGroupResponse
ReadS [UpdateDeploymentGroupResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateDeploymentGroupResponse]
$creadListPrec :: ReadPrec [UpdateDeploymentGroupResponse]
readPrec :: ReadPrec UpdateDeploymentGroupResponse
$creadPrec :: ReadPrec UpdateDeploymentGroupResponse
readList :: ReadS [UpdateDeploymentGroupResponse]
$creadList :: ReadS [UpdateDeploymentGroupResponse]
readsPrec :: Int -> ReadS UpdateDeploymentGroupResponse
$creadsPrec :: Int -> ReadS UpdateDeploymentGroupResponse
Prelude.Read, Int -> UpdateDeploymentGroupResponse -> ShowS
[UpdateDeploymentGroupResponse] -> ShowS
UpdateDeploymentGroupResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateDeploymentGroupResponse] -> ShowS
$cshowList :: [UpdateDeploymentGroupResponse] -> ShowS
show :: UpdateDeploymentGroupResponse -> String
$cshow :: UpdateDeploymentGroupResponse -> String
showsPrec :: Int -> UpdateDeploymentGroupResponse -> ShowS
$cshowsPrec :: Int -> UpdateDeploymentGroupResponse -> ShowS
Prelude.Show, forall x.
Rep UpdateDeploymentGroupResponse x
-> UpdateDeploymentGroupResponse
forall x.
UpdateDeploymentGroupResponse
-> Rep UpdateDeploymentGroupResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep UpdateDeploymentGroupResponse x
-> UpdateDeploymentGroupResponse
$cfrom :: forall x.
UpdateDeploymentGroupResponse
-> Rep UpdateDeploymentGroupResponse x
Prelude.Generic)

-- |
-- Create a value of 'UpdateDeploymentGroupResponse' 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:
--
-- 'hooksNotCleanedUp', 'updateDeploymentGroupResponse_hooksNotCleanedUp' - If the output contains no data, and the corresponding deployment group
-- contained at least one Auto Scaling group, CodeDeploy successfully
-- removed all corresponding Auto Scaling lifecycle event hooks from the
-- Amazon Web Services account. If the output contains data, CodeDeploy
-- could not remove some Auto Scaling lifecycle event hooks from the Amazon
-- Web Services account.
--
-- 'httpStatus', 'updateDeploymentGroupResponse_httpStatus' - The response's http status code.
newUpdateDeploymentGroupResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UpdateDeploymentGroupResponse
newUpdateDeploymentGroupResponse :: Int -> UpdateDeploymentGroupResponse
newUpdateDeploymentGroupResponse Int
pHttpStatus_ =
  UpdateDeploymentGroupResponse'
    { $sel:hooksNotCleanedUp:UpdateDeploymentGroupResponse' :: Maybe [AutoScalingGroup]
hooksNotCleanedUp =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:UpdateDeploymentGroupResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | If the output contains no data, and the corresponding deployment group
-- contained at least one Auto Scaling group, CodeDeploy successfully
-- removed all corresponding Auto Scaling lifecycle event hooks from the
-- Amazon Web Services account. If the output contains data, CodeDeploy
-- could not remove some Auto Scaling lifecycle event hooks from the Amazon
-- Web Services account.
updateDeploymentGroupResponse_hooksNotCleanedUp :: Lens.Lens' UpdateDeploymentGroupResponse (Prelude.Maybe [AutoScalingGroup])
updateDeploymentGroupResponse_hooksNotCleanedUp :: Lens' UpdateDeploymentGroupResponse (Maybe [AutoScalingGroup])
updateDeploymentGroupResponse_hooksNotCleanedUp = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateDeploymentGroupResponse' {Maybe [AutoScalingGroup]
hooksNotCleanedUp :: Maybe [AutoScalingGroup]
$sel:hooksNotCleanedUp:UpdateDeploymentGroupResponse' :: UpdateDeploymentGroupResponse -> Maybe [AutoScalingGroup]
hooksNotCleanedUp} -> Maybe [AutoScalingGroup]
hooksNotCleanedUp) (\s :: UpdateDeploymentGroupResponse
s@UpdateDeploymentGroupResponse' {} Maybe [AutoScalingGroup]
a -> UpdateDeploymentGroupResponse
s {$sel:hooksNotCleanedUp:UpdateDeploymentGroupResponse' :: Maybe [AutoScalingGroup]
hooksNotCleanedUp = Maybe [AutoScalingGroup]
a} :: UpdateDeploymentGroupResponse) 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 response's http status code.
updateDeploymentGroupResponse_httpStatus :: Lens.Lens' UpdateDeploymentGroupResponse Prelude.Int
updateDeploymentGroupResponse_httpStatus :: Lens' UpdateDeploymentGroupResponse Int
updateDeploymentGroupResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateDeploymentGroupResponse' {Int
httpStatus :: Int
$sel:httpStatus:UpdateDeploymentGroupResponse' :: UpdateDeploymentGroupResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: UpdateDeploymentGroupResponse
s@UpdateDeploymentGroupResponse' {} Int
a -> UpdateDeploymentGroupResponse
s {$sel:httpStatus:UpdateDeploymentGroupResponse' :: Int
httpStatus = Int
a} :: UpdateDeploymentGroupResponse)

instance Prelude.NFData UpdateDeploymentGroupResponse where
  rnf :: UpdateDeploymentGroupResponse -> ()
rnf UpdateDeploymentGroupResponse' {Int
Maybe [AutoScalingGroup]
httpStatus :: Int
hooksNotCleanedUp :: Maybe [AutoScalingGroup]
$sel:httpStatus:UpdateDeploymentGroupResponse' :: UpdateDeploymentGroupResponse -> Int
$sel:hooksNotCleanedUp:UpdateDeploymentGroupResponse' :: UpdateDeploymentGroupResponse -> Maybe [AutoScalingGroup]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [AutoScalingGroup]
hooksNotCleanedUp
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus