{-# 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.AutoScaling.PutScalingPolicy
-- 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 or updates a scaling policy for an Auto Scaling group. Scaling
-- policies are used to scale an Auto Scaling group based on configurable
-- metrics. If no policies are defined, the dynamic scaling and predictive
-- scaling features are not used.
--
-- For more information about using dynamic scaling, see
-- <https://docs.aws.amazon.com/autoscaling/ec2/userguide/as-scaling-target-tracking.html Target tracking scaling policies>
-- and
-- <https://docs.aws.amazon.com/autoscaling/ec2/userguide/as-scaling-simple-step.html Step and simple scaling policies>
-- in the /Amazon EC2 Auto Scaling User Guide/.
--
-- For more information about using predictive scaling, see
-- <https://docs.aws.amazon.com/autoscaling/ec2/userguide/ec2-auto-scaling-predictive-scaling.html Predictive scaling for Amazon EC2 Auto Scaling>
-- in the /Amazon EC2 Auto Scaling User Guide/.
--
-- You can view the scaling policies for an Auto Scaling group using the
-- DescribePolicies API call. If you are no longer using a scaling policy,
-- you can delete it by calling the DeletePolicy API.
module Amazonka.AutoScaling.PutScalingPolicy
  ( -- * Creating a Request
    PutScalingPolicy (..),
    newPutScalingPolicy,

    -- * Request Lenses
    putScalingPolicy_adjustmentType,
    putScalingPolicy_cooldown,
    putScalingPolicy_enabled,
    putScalingPolicy_estimatedInstanceWarmup,
    putScalingPolicy_metricAggregationType,
    putScalingPolicy_minAdjustmentMagnitude,
    putScalingPolicy_minAdjustmentStep,
    putScalingPolicy_policyType,
    putScalingPolicy_predictiveScalingConfiguration,
    putScalingPolicy_scalingAdjustment,
    putScalingPolicy_stepAdjustments,
    putScalingPolicy_targetTrackingConfiguration,
    putScalingPolicy_autoScalingGroupName,
    putScalingPolicy_policyName,

    -- * Destructuring the Response
    PutScalingPolicyResponse (..),
    newPutScalingPolicyResponse,

    -- * Response Lenses
    putScalingPolicyResponse_alarms,
    putScalingPolicyResponse_policyARN,
    putScalingPolicyResponse_httpStatus,
  )
where

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

-- | /See:/ 'newPutScalingPolicy' smart constructor.
data PutScalingPolicy = PutScalingPolicy'
  { -- | Specifies how the scaling adjustment is interpreted (for example, an
    -- absolute number or a percentage). The valid values are
    -- @ChangeInCapacity@, @ExactCapacity@, and @PercentChangeInCapacity@.
    --
    -- Required if the policy type is @StepScaling@ or @SimpleScaling@. For
    -- more information, see
    -- <https://docs.aws.amazon.com/autoscaling/ec2/userguide/as-scaling-simple-step.html#as-scaling-adjustment Scaling adjustment types>
    -- in the /Amazon EC2 Auto Scaling User Guide/.
    PutScalingPolicy -> Maybe Text
adjustmentType :: Prelude.Maybe Prelude.Text,
    -- | A cooldown period, in seconds, that applies to a specific simple scaling
    -- policy. When a cooldown period is specified here, it overrides the
    -- default cooldown.
    --
    -- Valid only if the policy type is @SimpleScaling@. For more information,
    -- see
    -- <https://docs.aws.amazon.com/autoscaling/ec2/userguide/Cooldown.html Scaling cooldowns for Amazon EC2 Auto Scaling>
    -- in the /Amazon EC2 Auto Scaling User Guide/.
    --
    -- Default: None
    PutScalingPolicy -> Maybe Int
cooldown :: Prelude.Maybe Prelude.Int,
    -- | Indicates whether the scaling policy is enabled or disabled. The default
    -- is enabled. For more information, see
    -- <https://docs.aws.amazon.com/autoscaling/ec2/userguide/as-enable-disable-scaling-policy.html Disabling a scaling policy for an Auto Scaling group>
    -- in the /Amazon EC2 Auto Scaling User Guide/.
    PutScalingPolicy -> Maybe Bool
enabled :: Prelude.Maybe Prelude.Bool,
    -- | /Not needed if the default instance warmup is defined for the group./
    --
    -- The estimated time, in seconds, until a newly launched instance can
    -- contribute to the CloudWatch metrics. This warm-up period applies to
    -- instances launched due to a specific target tracking or step scaling
    -- policy. When a warm-up period is specified here, it overrides the
    -- default instance warmup.
    --
    -- Valid only if the policy type is @TargetTrackingScaling@ or
    -- @StepScaling@.
    --
    -- The default is to use the value for the default instance warmup defined
    -- for the group. If default instance warmup is null, then
    -- @EstimatedInstanceWarmup@ falls back to the value of default cooldown.
    PutScalingPolicy -> Maybe Int
estimatedInstanceWarmup :: Prelude.Maybe Prelude.Int,
    -- | The aggregation type for the CloudWatch metrics. The valid values are
    -- @Minimum@, @Maximum@, and @Average@. If the aggregation type is null,
    -- the value is treated as @Average@.
    --
    -- Valid only if the policy type is @StepScaling@.
    PutScalingPolicy -> Maybe Text
metricAggregationType :: Prelude.Maybe Prelude.Text,
    -- | The minimum value to scale by when the adjustment type is
    -- @PercentChangeInCapacity@. For example, suppose that you create a step
    -- scaling policy to scale out an Auto Scaling group by 25 percent and you
    -- specify a @MinAdjustmentMagnitude@ of 2. If the group has 4 instances
    -- and the scaling policy is performed, 25 percent of 4 is 1. However,
    -- because you specified a @MinAdjustmentMagnitude@ of 2, Amazon EC2 Auto
    -- Scaling scales out the group by 2 instances.
    --
    -- Valid only if the policy type is @StepScaling@ or @SimpleScaling@. For
    -- more information, see
    -- <https://docs.aws.amazon.com/autoscaling/ec2/userguide/as-scaling-simple-step.html#as-scaling-adjustment Scaling adjustment types>
    -- in the /Amazon EC2 Auto Scaling User Guide/.
    --
    -- Some Auto Scaling groups use instance weights. In this case, set the
    -- @MinAdjustmentMagnitude@ to a value that is at least as large as your
    -- largest instance weight.
    PutScalingPolicy -> Maybe Int
minAdjustmentMagnitude :: Prelude.Maybe Prelude.Int,
    -- | Available for backward compatibility. Use @MinAdjustmentMagnitude@
    -- instead.
    PutScalingPolicy -> Maybe Int
minAdjustmentStep :: Prelude.Maybe Prelude.Int,
    -- | One of the following policy types:
    --
    -- -   @TargetTrackingScaling@
    --
    -- -   @StepScaling@
    --
    -- -   @SimpleScaling@ (default)
    --
    -- -   @PredictiveScaling@
    PutScalingPolicy -> Maybe Text
policyType :: Prelude.Maybe Prelude.Text,
    -- | A predictive scaling policy. Provides support for predefined and custom
    -- metrics.
    --
    -- Predefined metrics include CPU utilization, network in\/out, and the
    -- Application Load Balancer request count.
    --
    -- For more information, see
    -- <https://docs.aws.amazon.com/autoscaling/ec2/APIReference/API_PredictiveScalingConfiguration.html PredictiveScalingConfiguration>
    -- in the /Amazon EC2 Auto Scaling API Reference/.
    --
    -- Required if the policy type is @PredictiveScaling@.
    PutScalingPolicy -> Maybe PredictiveScalingConfiguration
predictiveScalingConfiguration :: Prelude.Maybe PredictiveScalingConfiguration,
    -- | The amount by which to scale, based on the specified adjustment type. A
    -- positive value adds to the current capacity while a negative number
    -- removes from the current capacity. For exact capacity, you must specify
    -- a positive value.
    --
    -- Required if the policy type is @SimpleScaling@. (Not used with any other
    -- policy type.)
    PutScalingPolicy -> Maybe Int
scalingAdjustment :: Prelude.Maybe Prelude.Int,
    -- | A set of adjustments that enable you to scale based on the size of the
    -- alarm breach.
    --
    -- Required if the policy type is @StepScaling@. (Not used with any other
    -- policy type.)
    PutScalingPolicy -> Maybe [StepAdjustment]
stepAdjustments :: Prelude.Maybe [StepAdjustment],
    -- | A target tracking scaling policy. Provides support for predefined or
    -- custom metrics.
    --
    -- The following predefined metrics are available:
    --
    -- -   @ASGAverageCPUUtilization@
    --
    -- -   @ASGAverageNetworkIn@
    --
    -- -   @ASGAverageNetworkOut@
    --
    -- -   @ALBRequestCountPerTarget@
    --
    -- If you specify @ALBRequestCountPerTarget@ for the metric, you must
    -- specify the @ResourceLabel@ property with the
    -- @PredefinedMetricSpecification@.
    --
    -- For more information, see
    -- <https://docs.aws.amazon.com/autoscaling/ec2/APIReference/API_TargetTrackingConfiguration.html TargetTrackingConfiguration>
    -- in the /Amazon EC2 Auto Scaling API Reference/.
    --
    -- Required if the policy type is @TargetTrackingScaling@.
    PutScalingPolicy -> Maybe TargetTrackingConfiguration
targetTrackingConfiguration :: Prelude.Maybe TargetTrackingConfiguration,
    -- | The name of the Auto Scaling group.
    PutScalingPolicy -> Text
autoScalingGroupName :: Prelude.Text,
    -- | The name of the policy.
    PutScalingPolicy -> Text
policyName :: Prelude.Text
  }
  deriving (PutScalingPolicy -> PutScalingPolicy -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PutScalingPolicy -> PutScalingPolicy -> Bool
$c/= :: PutScalingPolicy -> PutScalingPolicy -> Bool
== :: PutScalingPolicy -> PutScalingPolicy -> Bool
$c== :: PutScalingPolicy -> PutScalingPolicy -> Bool
Prelude.Eq, ReadPrec [PutScalingPolicy]
ReadPrec PutScalingPolicy
Int -> ReadS PutScalingPolicy
ReadS [PutScalingPolicy]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PutScalingPolicy]
$creadListPrec :: ReadPrec [PutScalingPolicy]
readPrec :: ReadPrec PutScalingPolicy
$creadPrec :: ReadPrec PutScalingPolicy
readList :: ReadS [PutScalingPolicy]
$creadList :: ReadS [PutScalingPolicy]
readsPrec :: Int -> ReadS PutScalingPolicy
$creadsPrec :: Int -> ReadS PutScalingPolicy
Prelude.Read, Int -> PutScalingPolicy -> ShowS
[PutScalingPolicy] -> ShowS
PutScalingPolicy -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PutScalingPolicy] -> ShowS
$cshowList :: [PutScalingPolicy] -> ShowS
show :: PutScalingPolicy -> String
$cshow :: PutScalingPolicy -> String
showsPrec :: Int -> PutScalingPolicy -> ShowS
$cshowsPrec :: Int -> PutScalingPolicy -> ShowS
Prelude.Show, forall x. Rep PutScalingPolicy x -> PutScalingPolicy
forall x. PutScalingPolicy -> Rep PutScalingPolicy x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PutScalingPolicy x -> PutScalingPolicy
$cfrom :: forall x. PutScalingPolicy -> Rep PutScalingPolicy x
Prelude.Generic)

-- |
-- Create a value of 'PutScalingPolicy' 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:
--
-- 'adjustmentType', 'putScalingPolicy_adjustmentType' - Specifies how the scaling adjustment is interpreted (for example, an
-- absolute number or a percentage). The valid values are
-- @ChangeInCapacity@, @ExactCapacity@, and @PercentChangeInCapacity@.
--
-- Required if the policy type is @StepScaling@ or @SimpleScaling@. For
-- more information, see
-- <https://docs.aws.amazon.com/autoscaling/ec2/userguide/as-scaling-simple-step.html#as-scaling-adjustment Scaling adjustment types>
-- in the /Amazon EC2 Auto Scaling User Guide/.
--
-- 'cooldown', 'putScalingPolicy_cooldown' - A cooldown period, in seconds, that applies to a specific simple scaling
-- policy. When a cooldown period is specified here, it overrides the
-- default cooldown.
--
-- Valid only if the policy type is @SimpleScaling@. For more information,
-- see
-- <https://docs.aws.amazon.com/autoscaling/ec2/userguide/Cooldown.html Scaling cooldowns for Amazon EC2 Auto Scaling>
-- in the /Amazon EC2 Auto Scaling User Guide/.
--
-- Default: None
--
-- 'enabled', 'putScalingPolicy_enabled' - Indicates whether the scaling policy is enabled or disabled. The default
-- is enabled. For more information, see
-- <https://docs.aws.amazon.com/autoscaling/ec2/userguide/as-enable-disable-scaling-policy.html Disabling a scaling policy for an Auto Scaling group>
-- in the /Amazon EC2 Auto Scaling User Guide/.
--
-- 'estimatedInstanceWarmup', 'putScalingPolicy_estimatedInstanceWarmup' - /Not needed if the default instance warmup is defined for the group./
--
-- The estimated time, in seconds, until a newly launched instance can
-- contribute to the CloudWatch metrics. This warm-up period applies to
-- instances launched due to a specific target tracking or step scaling
-- policy. When a warm-up period is specified here, it overrides the
-- default instance warmup.
--
-- Valid only if the policy type is @TargetTrackingScaling@ or
-- @StepScaling@.
--
-- The default is to use the value for the default instance warmup defined
-- for the group. If default instance warmup is null, then
-- @EstimatedInstanceWarmup@ falls back to the value of default cooldown.
--
-- 'metricAggregationType', 'putScalingPolicy_metricAggregationType' - The aggregation type for the CloudWatch metrics. The valid values are
-- @Minimum@, @Maximum@, and @Average@. If the aggregation type is null,
-- the value is treated as @Average@.
--
-- Valid only if the policy type is @StepScaling@.
--
-- 'minAdjustmentMagnitude', 'putScalingPolicy_minAdjustmentMagnitude' - The minimum value to scale by when the adjustment type is
-- @PercentChangeInCapacity@. For example, suppose that you create a step
-- scaling policy to scale out an Auto Scaling group by 25 percent and you
-- specify a @MinAdjustmentMagnitude@ of 2. If the group has 4 instances
-- and the scaling policy is performed, 25 percent of 4 is 1. However,
-- because you specified a @MinAdjustmentMagnitude@ of 2, Amazon EC2 Auto
-- Scaling scales out the group by 2 instances.
--
-- Valid only if the policy type is @StepScaling@ or @SimpleScaling@. For
-- more information, see
-- <https://docs.aws.amazon.com/autoscaling/ec2/userguide/as-scaling-simple-step.html#as-scaling-adjustment Scaling adjustment types>
-- in the /Amazon EC2 Auto Scaling User Guide/.
--
-- Some Auto Scaling groups use instance weights. In this case, set the
-- @MinAdjustmentMagnitude@ to a value that is at least as large as your
-- largest instance weight.
--
-- 'minAdjustmentStep', 'putScalingPolicy_minAdjustmentStep' - Available for backward compatibility. Use @MinAdjustmentMagnitude@
-- instead.
--
-- 'policyType', 'putScalingPolicy_policyType' - One of the following policy types:
--
-- -   @TargetTrackingScaling@
--
-- -   @StepScaling@
--
-- -   @SimpleScaling@ (default)
--
-- -   @PredictiveScaling@
--
-- 'predictiveScalingConfiguration', 'putScalingPolicy_predictiveScalingConfiguration' - A predictive scaling policy. Provides support for predefined and custom
-- metrics.
--
-- Predefined metrics include CPU utilization, network in\/out, and the
-- Application Load Balancer request count.
--
-- For more information, see
-- <https://docs.aws.amazon.com/autoscaling/ec2/APIReference/API_PredictiveScalingConfiguration.html PredictiveScalingConfiguration>
-- in the /Amazon EC2 Auto Scaling API Reference/.
--
-- Required if the policy type is @PredictiveScaling@.
--
-- 'scalingAdjustment', 'putScalingPolicy_scalingAdjustment' - The amount by which to scale, based on the specified adjustment type. A
-- positive value adds to the current capacity while a negative number
-- removes from the current capacity. For exact capacity, you must specify
-- a positive value.
--
-- Required if the policy type is @SimpleScaling@. (Not used with any other
-- policy type.)
--
-- 'stepAdjustments', 'putScalingPolicy_stepAdjustments' - A set of adjustments that enable you to scale based on the size of the
-- alarm breach.
--
-- Required if the policy type is @StepScaling@. (Not used with any other
-- policy type.)
--
-- 'targetTrackingConfiguration', 'putScalingPolicy_targetTrackingConfiguration' - A target tracking scaling policy. Provides support for predefined or
-- custom metrics.
--
-- The following predefined metrics are available:
--
-- -   @ASGAverageCPUUtilization@
--
-- -   @ASGAverageNetworkIn@
--
-- -   @ASGAverageNetworkOut@
--
-- -   @ALBRequestCountPerTarget@
--
-- If you specify @ALBRequestCountPerTarget@ for the metric, you must
-- specify the @ResourceLabel@ property with the
-- @PredefinedMetricSpecification@.
--
-- For more information, see
-- <https://docs.aws.amazon.com/autoscaling/ec2/APIReference/API_TargetTrackingConfiguration.html TargetTrackingConfiguration>
-- in the /Amazon EC2 Auto Scaling API Reference/.
--
-- Required if the policy type is @TargetTrackingScaling@.
--
-- 'autoScalingGroupName', 'putScalingPolicy_autoScalingGroupName' - The name of the Auto Scaling group.
--
-- 'policyName', 'putScalingPolicy_policyName' - The name of the policy.
newPutScalingPolicy ::
  -- | 'autoScalingGroupName'
  Prelude.Text ->
  -- | 'policyName'
  Prelude.Text ->
  PutScalingPolicy
newPutScalingPolicy :: Text -> Text -> PutScalingPolicy
newPutScalingPolicy
  Text
pAutoScalingGroupName_
  Text
pPolicyName_ =
    PutScalingPolicy'
      { $sel:adjustmentType:PutScalingPolicy' :: Maybe Text
adjustmentType = forall a. Maybe a
Prelude.Nothing,
        $sel:cooldown:PutScalingPolicy' :: Maybe Int
cooldown = forall a. Maybe a
Prelude.Nothing,
        $sel:enabled:PutScalingPolicy' :: Maybe Bool
enabled = forall a. Maybe a
Prelude.Nothing,
        $sel:estimatedInstanceWarmup:PutScalingPolicy' :: Maybe Int
estimatedInstanceWarmup = forall a. Maybe a
Prelude.Nothing,
        $sel:metricAggregationType:PutScalingPolicy' :: Maybe Text
metricAggregationType = forall a. Maybe a
Prelude.Nothing,
        $sel:minAdjustmentMagnitude:PutScalingPolicy' :: Maybe Int
minAdjustmentMagnitude = forall a. Maybe a
Prelude.Nothing,
        $sel:minAdjustmentStep:PutScalingPolicy' :: Maybe Int
minAdjustmentStep = forall a. Maybe a
Prelude.Nothing,
        $sel:policyType:PutScalingPolicy' :: Maybe Text
policyType = forall a. Maybe a
Prelude.Nothing,
        $sel:predictiveScalingConfiguration:PutScalingPolicy' :: Maybe PredictiveScalingConfiguration
predictiveScalingConfiguration = forall a. Maybe a
Prelude.Nothing,
        $sel:scalingAdjustment:PutScalingPolicy' :: Maybe Int
scalingAdjustment = forall a. Maybe a
Prelude.Nothing,
        $sel:stepAdjustments:PutScalingPolicy' :: Maybe [StepAdjustment]
stepAdjustments = forall a. Maybe a
Prelude.Nothing,
        $sel:targetTrackingConfiguration:PutScalingPolicy' :: Maybe TargetTrackingConfiguration
targetTrackingConfiguration = forall a. Maybe a
Prelude.Nothing,
        $sel:autoScalingGroupName:PutScalingPolicy' :: Text
autoScalingGroupName = Text
pAutoScalingGroupName_,
        $sel:policyName:PutScalingPolicy' :: Text
policyName = Text
pPolicyName_
      }

-- | Specifies how the scaling adjustment is interpreted (for example, an
-- absolute number or a percentage). The valid values are
-- @ChangeInCapacity@, @ExactCapacity@, and @PercentChangeInCapacity@.
--
-- Required if the policy type is @StepScaling@ or @SimpleScaling@. For
-- more information, see
-- <https://docs.aws.amazon.com/autoscaling/ec2/userguide/as-scaling-simple-step.html#as-scaling-adjustment Scaling adjustment types>
-- in the /Amazon EC2 Auto Scaling User Guide/.
putScalingPolicy_adjustmentType :: Lens.Lens' PutScalingPolicy (Prelude.Maybe Prelude.Text)
putScalingPolicy_adjustmentType :: Lens' PutScalingPolicy (Maybe Text)
putScalingPolicy_adjustmentType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutScalingPolicy' {Maybe Text
adjustmentType :: Maybe Text
$sel:adjustmentType:PutScalingPolicy' :: PutScalingPolicy -> Maybe Text
adjustmentType} -> Maybe Text
adjustmentType) (\s :: PutScalingPolicy
s@PutScalingPolicy' {} Maybe Text
a -> PutScalingPolicy
s {$sel:adjustmentType:PutScalingPolicy' :: Maybe Text
adjustmentType = Maybe Text
a} :: PutScalingPolicy)

-- | A cooldown period, in seconds, that applies to a specific simple scaling
-- policy. When a cooldown period is specified here, it overrides the
-- default cooldown.
--
-- Valid only if the policy type is @SimpleScaling@. For more information,
-- see
-- <https://docs.aws.amazon.com/autoscaling/ec2/userguide/Cooldown.html Scaling cooldowns for Amazon EC2 Auto Scaling>
-- in the /Amazon EC2 Auto Scaling User Guide/.
--
-- Default: None
putScalingPolicy_cooldown :: Lens.Lens' PutScalingPolicy (Prelude.Maybe Prelude.Int)
putScalingPolicy_cooldown :: Lens' PutScalingPolicy (Maybe Int)
putScalingPolicy_cooldown = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutScalingPolicy' {Maybe Int
cooldown :: Maybe Int
$sel:cooldown:PutScalingPolicy' :: PutScalingPolicy -> Maybe Int
cooldown} -> Maybe Int
cooldown) (\s :: PutScalingPolicy
s@PutScalingPolicy' {} Maybe Int
a -> PutScalingPolicy
s {$sel:cooldown:PutScalingPolicy' :: Maybe Int
cooldown = Maybe Int
a} :: PutScalingPolicy)

-- | Indicates whether the scaling policy is enabled or disabled. The default
-- is enabled. For more information, see
-- <https://docs.aws.amazon.com/autoscaling/ec2/userguide/as-enable-disable-scaling-policy.html Disabling a scaling policy for an Auto Scaling group>
-- in the /Amazon EC2 Auto Scaling User Guide/.
putScalingPolicy_enabled :: Lens.Lens' PutScalingPolicy (Prelude.Maybe Prelude.Bool)
putScalingPolicy_enabled :: Lens' PutScalingPolicy (Maybe Bool)
putScalingPolicy_enabled = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutScalingPolicy' {Maybe Bool
enabled :: Maybe Bool
$sel:enabled:PutScalingPolicy' :: PutScalingPolicy -> Maybe Bool
enabled} -> Maybe Bool
enabled) (\s :: PutScalingPolicy
s@PutScalingPolicy' {} Maybe Bool
a -> PutScalingPolicy
s {$sel:enabled:PutScalingPolicy' :: Maybe Bool
enabled = Maybe Bool
a} :: PutScalingPolicy)

-- | /Not needed if the default instance warmup is defined for the group./
--
-- The estimated time, in seconds, until a newly launched instance can
-- contribute to the CloudWatch metrics. This warm-up period applies to
-- instances launched due to a specific target tracking or step scaling
-- policy. When a warm-up period is specified here, it overrides the
-- default instance warmup.
--
-- Valid only if the policy type is @TargetTrackingScaling@ or
-- @StepScaling@.
--
-- The default is to use the value for the default instance warmup defined
-- for the group. If default instance warmup is null, then
-- @EstimatedInstanceWarmup@ falls back to the value of default cooldown.
putScalingPolicy_estimatedInstanceWarmup :: Lens.Lens' PutScalingPolicy (Prelude.Maybe Prelude.Int)
putScalingPolicy_estimatedInstanceWarmup :: Lens' PutScalingPolicy (Maybe Int)
putScalingPolicy_estimatedInstanceWarmup = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutScalingPolicy' {Maybe Int
estimatedInstanceWarmup :: Maybe Int
$sel:estimatedInstanceWarmup:PutScalingPolicy' :: PutScalingPolicy -> Maybe Int
estimatedInstanceWarmup} -> Maybe Int
estimatedInstanceWarmup) (\s :: PutScalingPolicy
s@PutScalingPolicy' {} Maybe Int
a -> PutScalingPolicy
s {$sel:estimatedInstanceWarmup:PutScalingPolicy' :: Maybe Int
estimatedInstanceWarmup = Maybe Int
a} :: PutScalingPolicy)

-- | The aggregation type for the CloudWatch metrics. The valid values are
-- @Minimum@, @Maximum@, and @Average@. If the aggregation type is null,
-- the value is treated as @Average@.
--
-- Valid only if the policy type is @StepScaling@.
putScalingPolicy_metricAggregationType :: Lens.Lens' PutScalingPolicy (Prelude.Maybe Prelude.Text)
putScalingPolicy_metricAggregationType :: Lens' PutScalingPolicy (Maybe Text)
putScalingPolicy_metricAggregationType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutScalingPolicy' {Maybe Text
metricAggregationType :: Maybe Text
$sel:metricAggregationType:PutScalingPolicy' :: PutScalingPolicy -> Maybe Text
metricAggregationType} -> Maybe Text
metricAggregationType) (\s :: PutScalingPolicy
s@PutScalingPolicy' {} Maybe Text
a -> PutScalingPolicy
s {$sel:metricAggregationType:PutScalingPolicy' :: Maybe Text
metricAggregationType = Maybe Text
a} :: PutScalingPolicy)

-- | The minimum value to scale by when the adjustment type is
-- @PercentChangeInCapacity@. For example, suppose that you create a step
-- scaling policy to scale out an Auto Scaling group by 25 percent and you
-- specify a @MinAdjustmentMagnitude@ of 2. If the group has 4 instances
-- and the scaling policy is performed, 25 percent of 4 is 1. However,
-- because you specified a @MinAdjustmentMagnitude@ of 2, Amazon EC2 Auto
-- Scaling scales out the group by 2 instances.
--
-- Valid only if the policy type is @StepScaling@ or @SimpleScaling@. For
-- more information, see
-- <https://docs.aws.amazon.com/autoscaling/ec2/userguide/as-scaling-simple-step.html#as-scaling-adjustment Scaling adjustment types>
-- in the /Amazon EC2 Auto Scaling User Guide/.
--
-- Some Auto Scaling groups use instance weights. In this case, set the
-- @MinAdjustmentMagnitude@ to a value that is at least as large as your
-- largest instance weight.
putScalingPolicy_minAdjustmentMagnitude :: Lens.Lens' PutScalingPolicy (Prelude.Maybe Prelude.Int)
putScalingPolicy_minAdjustmentMagnitude :: Lens' PutScalingPolicy (Maybe Int)
putScalingPolicy_minAdjustmentMagnitude = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutScalingPolicy' {Maybe Int
minAdjustmentMagnitude :: Maybe Int
$sel:minAdjustmentMagnitude:PutScalingPolicy' :: PutScalingPolicy -> Maybe Int
minAdjustmentMagnitude} -> Maybe Int
minAdjustmentMagnitude) (\s :: PutScalingPolicy
s@PutScalingPolicy' {} Maybe Int
a -> PutScalingPolicy
s {$sel:minAdjustmentMagnitude:PutScalingPolicy' :: Maybe Int
minAdjustmentMagnitude = Maybe Int
a} :: PutScalingPolicy)

-- | Available for backward compatibility. Use @MinAdjustmentMagnitude@
-- instead.
putScalingPolicy_minAdjustmentStep :: Lens.Lens' PutScalingPolicy (Prelude.Maybe Prelude.Int)
putScalingPolicy_minAdjustmentStep :: Lens' PutScalingPolicy (Maybe Int)
putScalingPolicy_minAdjustmentStep = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutScalingPolicy' {Maybe Int
minAdjustmentStep :: Maybe Int
$sel:minAdjustmentStep:PutScalingPolicy' :: PutScalingPolicy -> Maybe Int
minAdjustmentStep} -> Maybe Int
minAdjustmentStep) (\s :: PutScalingPolicy
s@PutScalingPolicy' {} Maybe Int
a -> PutScalingPolicy
s {$sel:minAdjustmentStep:PutScalingPolicy' :: Maybe Int
minAdjustmentStep = Maybe Int
a} :: PutScalingPolicy)

-- | One of the following policy types:
--
-- -   @TargetTrackingScaling@
--
-- -   @StepScaling@
--
-- -   @SimpleScaling@ (default)
--
-- -   @PredictiveScaling@
putScalingPolicy_policyType :: Lens.Lens' PutScalingPolicy (Prelude.Maybe Prelude.Text)
putScalingPolicy_policyType :: Lens' PutScalingPolicy (Maybe Text)
putScalingPolicy_policyType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutScalingPolicy' {Maybe Text
policyType :: Maybe Text
$sel:policyType:PutScalingPolicy' :: PutScalingPolicy -> Maybe Text
policyType} -> Maybe Text
policyType) (\s :: PutScalingPolicy
s@PutScalingPolicy' {} Maybe Text
a -> PutScalingPolicy
s {$sel:policyType:PutScalingPolicy' :: Maybe Text
policyType = Maybe Text
a} :: PutScalingPolicy)

-- | A predictive scaling policy. Provides support for predefined and custom
-- metrics.
--
-- Predefined metrics include CPU utilization, network in\/out, and the
-- Application Load Balancer request count.
--
-- For more information, see
-- <https://docs.aws.amazon.com/autoscaling/ec2/APIReference/API_PredictiveScalingConfiguration.html PredictiveScalingConfiguration>
-- in the /Amazon EC2 Auto Scaling API Reference/.
--
-- Required if the policy type is @PredictiveScaling@.
putScalingPolicy_predictiveScalingConfiguration :: Lens.Lens' PutScalingPolicy (Prelude.Maybe PredictiveScalingConfiguration)
putScalingPolicy_predictiveScalingConfiguration :: Lens' PutScalingPolicy (Maybe PredictiveScalingConfiguration)
putScalingPolicy_predictiveScalingConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutScalingPolicy' {Maybe PredictiveScalingConfiguration
predictiveScalingConfiguration :: Maybe PredictiveScalingConfiguration
$sel:predictiveScalingConfiguration:PutScalingPolicy' :: PutScalingPolicy -> Maybe PredictiveScalingConfiguration
predictiveScalingConfiguration} -> Maybe PredictiveScalingConfiguration
predictiveScalingConfiguration) (\s :: PutScalingPolicy
s@PutScalingPolicy' {} Maybe PredictiveScalingConfiguration
a -> PutScalingPolicy
s {$sel:predictiveScalingConfiguration:PutScalingPolicy' :: Maybe PredictiveScalingConfiguration
predictiveScalingConfiguration = Maybe PredictiveScalingConfiguration
a} :: PutScalingPolicy)

-- | The amount by which to scale, based on the specified adjustment type. A
-- positive value adds to the current capacity while a negative number
-- removes from the current capacity. For exact capacity, you must specify
-- a positive value.
--
-- Required if the policy type is @SimpleScaling@. (Not used with any other
-- policy type.)
putScalingPolicy_scalingAdjustment :: Lens.Lens' PutScalingPolicy (Prelude.Maybe Prelude.Int)
putScalingPolicy_scalingAdjustment :: Lens' PutScalingPolicy (Maybe Int)
putScalingPolicy_scalingAdjustment = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutScalingPolicy' {Maybe Int
scalingAdjustment :: Maybe Int
$sel:scalingAdjustment:PutScalingPolicy' :: PutScalingPolicy -> Maybe Int
scalingAdjustment} -> Maybe Int
scalingAdjustment) (\s :: PutScalingPolicy
s@PutScalingPolicy' {} Maybe Int
a -> PutScalingPolicy
s {$sel:scalingAdjustment:PutScalingPolicy' :: Maybe Int
scalingAdjustment = Maybe Int
a} :: PutScalingPolicy)

-- | A set of adjustments that enable you to scale based on the size of the
-- alarm breach.
--
-- Required if the policy type is @StepScaling@. (Not used with any other
-- policy type.)
putScalingPolicy_stepAdjustments :: Lens.Lens' PutScalingPolicy (Prelude.Maybe [StepAdjustment])
putScalingPolicy_stepAdjustments :: Lens' PutScalingPolicy (Maybe [StepAdjustment])
putScalingPolicy_stepAdjustments = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutScalingPolicy' {Maybe [StepAdjustment]
stepAdjustments :: Maybe [StepAdjustment]
$sel:stepAdjustments:PutScalingPolicy' :: PutScalingPolicy -> Maybe [StepAdjustment]
stepAdjustments} -> Maybe [StepAdjustment]
stepAdjustments) (\s :: PutScalingPolicy
s@PutScalingPolicy' {} Maybe [StepAdjustment]
a -> PutScalingPolicy
s {$sel:stepAdjustments:PutScalingPolicy' :: Maybe [StepAdjustment]
stepAdjustments = Maybe [StepAdjustment]
a} :: PutScalingPolicy) 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

-- | A target tracking scaling policy. Provides support for predefined or
-- custom metrics.
--
-- The following predefined metrics are available:
--
-- -   @ASGAverageCPUUtilization@
--
-- -   @ASGAverageNetworkIn@
--
-- -   @ASGAverageNetworkOut@
--
-- -   @ALBRequestCountPerTarget@
--
-- If you specify @ALBRequestCountPerTarget@ for the metric, you must
-- specify the @ResourceLabel@ property with the
-- @PredefinedMetricSpecification@.
--
-- For more information, see
-- <https://docs.aws.amazon.com/autoscaling/ec2/APIReference/API_TargetTrackingConfiguration.html TargetTrackingConfiguration>
-- in the /Amazon EC2 Auto Scaling API Reference/.
--
-- Required if the policy type is @TargetTrackingScaling@.
putScalingPolicy_targetTrackingConfiguration :: Lens.Lens' PutScalingPolicy (Prelude.Maybe TargetTrackingConfiguration)
putScalingPolicy_targetTrackingConfiguration :: Lens' PutScalingPolicy (Maybe TargetTrackingConfiguration)
putScalingPolicy_targetTrackingConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutScalingPolicy' {Maybe TargetTrackingConfiguration
targetTrackingConfiguration :: Maybe TargetTrackingConfiguration
$sel:targetTrackingConfiguration:PutScalingPolicy' :: PutScalingPolicy -> Maybe TargetTrackingConfiguration
targetTrackingConfiguration} -> Maybe TargetTrackingConfiguration
targetTrackingConfiguration) (\s :: PutScalingPolicy
s@PutScalingPolicy' {} Maybe TargetTrackingConfiguration
a -> PutScalingPolicy
s {$sel:targetTrackingConfiguration:PutScalingPolicy' :: Maybe TargetTrackingConfiguration
targetTrackingConfiguration = Maybe TargetTrackingConfiguration
a} :: PutScalingPolicy)

-- | The name of the Auto Scaling group.
putScalingPolicy_autoScalingGroupName :: Lens.Lens' PutScalingPolicy Prelude.Text
putScalingPolicy_autoScalingGroupName :: Lens' PutScalingPolicy Text
putScalingPolicy_autoScalingGroupName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutScalingPolicy' {Text
autoScalingGroupName :: Text
$sel:autoScalingGroupName:PutScalingPolicy' :: PutScalingPolicy -> Text
autoScalingGroupName} -> Text
autoScalingGroupName) (\s :: PutScalingPolicy
s@PutScalingPolicy' {} Text
a -> PutScalingPolicy
s {$sel:autoScalingGroupName:PutScalingPolicy' :: Text
autoScalingGroupName = Text
a} :: PutScalingPolicy)

-- | The name of the policy.
putScalingPolicy_policyName :: Lens.Lens' PutScalingPolicy Prelude.Text
putScalingPolicy_policyName :: Lens' PutScalingPolicy Text
putScalingPolicy_policyName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutScalingPolicy' {Text
policyName :: Text
$sel:policyName:PutScalingPolicy' :: PutScalingPolicy -> Text
policyName} -> Text
policyName) (\s :: PutScalingPolicy
s@PutScalingPolicy' {} Text
a -> PutScalingPolicy
s {$sel:policyName:PutScalingPolicy' :: Text
policyName = Text
a} :: PutScalingPolicy)

instance Core.AWSRequest PutScalingPolicy where
  type
    AWSResponse PutScalingPolicy =
      PutScalingPolicyResponse
  request :: (Service -> Service)
-> PutScalingPolicy -> Request PutScalingPolicy
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.postQuery (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy PutScalingPolicy
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse PutScalingPolicy)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
Text
-> (Int
    -> ResponseHeaders -> [Node] -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveXMLWrapper
      Text
"PutScalingPolicyResult"
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Maybe [Alarm] -> Maybe Text -> Int -> PutScalingPolicyResponse
PutScalingPolicyResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> ( [Node]
x
                            forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"Alarms"
                            forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty
                            forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
Prelude.>>= forall (f :: * -> *) a b.
Applicative f =>
([a] -> f b) -> [a] -> f (Maybe b)
Core.may (forall a. FromXML a => Text -> [Node] -> Either String [a]
Data.parseXMLList Text
"member")
                        )
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"PolicyARN")
            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 PutScalingPolicy where
  hashWithSalt :: Int -> PutScalingPolicy -> Int
hashWithSalt Int
_salt PutScalingPolicy' {Maybe Bool
Maybe Int
Maybe [StepAdjustment]
Maybe Text
Maybe PredictiveScalingConfiguration
Maybe TargetTrackingConfiguration
Text
policyName :: Text
autoScalingGroupName :: Text
targetTrackingConfiguration :: Maybe TargetTrackingConfiguration
stepAdjustments :: Maybe [StepAdjustment]
scalingAdjustment :: Maybe Int
predictiveScalingConfiguration :: Maybe PredictiveScalingConfiguration
policyType :: Maybe Text
minAdjustmentStep :: Maybe Int
minAdjustmentMagnitude :: Maybe Int
metricAggregationType :: Maybe Text
estimatedInstanceWarmup :: Maybe Int
enabled :: Maybe Bool
cooldown :: Maybe Int
adjustmentType :: Maybe Text
$sel:policyName:PutScalingPolicy' :: PutScalingPolicy -> Text
$sel:autoScalingGroupName:PutScalingPolicy' :: PutScalingPolicy -> Text
$sel:targetTrackingConfiguration:PutScalingPolicy' :: PutScalingPolicy -> Maybe TargetTrackingConfiguration
$sel:stepAdjustments:PutScalingPolicy' :: PutScalingPolicy -> Maybe [StepAdjustment]
$sel:scalingAdjustment:PutScalingPolicy' :: PutScalingPolicy -> Maybe Int
$sel:predictiveScalingConfiguration:PutScalingPolicy' :: PutScalingPolicy -> Maybe PredictiveScalingConfiguration
$sel:policyType:PutScalingPolicy' :: PutScalingPolicy -> Maybe Text
$sel:minAdjustmentStep:PutScalingPolicy' :: PutScalingPolicy -> Maybe Int
$sel:minAdjustmentMagnitude:PutScalingPolicy' :: PutScalingPolicy -> Maybe Int
$sel:metricAggregationType:PutScalingPolicy' :: PutScalingPolicy -> Maybe Text
$sel:estimatedInstanceWarmup:PutScalingPolicy' :: PutScalingPolicy -> Maybe Int
$sel:enabled:PutScalingPolicy' :: PutScalingPolicy -> Maybe Bool
$sel:cooldown:PutScalingPolicy' :: PutScalingPolicy -> Maybe Int
$sel:adjustmentType:PutScalingPolicy' :: PutScalingPolicy -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
adjustmentType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
cooldown
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
enabled
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
estimatedInstanceWarmup
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
metricAggregationType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
minAdjustmentMagnitude
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
minAdjustmentStep
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
policyType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe PredictiveScalingConfiguration
predictiveScalingConfiguration
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
scalingAdjustment
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [StepAdjustment]
stepAdjustments
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe TargetTrackingConfiguration
targetTrackingConfiguration
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
autoScalingGroupName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
policyName

instance Prelude.NFData PutScalingPolicy where
  rnf :: PutScalingPolicy -> ()
rnf PutScalingPolicy' {Maybe Bool
Maybe Int
Maybe [StepAdjustment]
Maybe Text
Maybe PredictiveScalingConfiguration
Maybe TargetTrackingConfiguration
Text
policyName :: Text
autoScalingGroupName :: Text
targetTrackingConfiguration :: Maybe TargetTrackingConfiguration
stepAdjustments :: Maybe [StepAdjustment]
scalingAdjustment :: Maybe Int
predictiveScalingConfiguration :: Maybe PredictiveScalingConfiguration
policyType :: Maybe Text
minAdjustmentStep :: Maybe Int
minAdjustmentMagnitude :: Maybe Int
metricAggregationType :: Maybe Text
estimatedInstanceWarmup :: Maybe Int
enabled :: Maybe Bool
cooldown :: Maybe Int
adjustmentType :: Maybe Text
$sel:policyName:PutScalingPolicy' :: PutScalingPolicy -> Text
$sel:autoScalingGroupName:PutScalingPolicy' :: PutScalingPolicy -> Text
$sel:targetTrackingConfiguration:PutScalingPolicy' :: PutScalingPolicy -> Maybe TargetTrackingConfiguration
$sel:stepAdjustments:PutScalingPolicy' :: PutScalingPolicy -> Maybe [StepAdjustment]
$sel:scalingAdjustment:PutScalingPolicy' :: PutScalingPolicy -> Maybe Int
$sel:predictiveScalingConfiguration:PutScalingPolicy' :: PutScalingPolicy -> Maybe PredictiveScalingConfiguration
$sel:policyType:PutScalingPolicy' :: PutScalingPolicy -> Maybe Text
$sel:minAdjustmentStep:PutScalingPolicy' :: PutScalingPolicy -> Maybe Int
$sel:minAdjustmentMagnitude:PutScalingPolicy' :: PutScalingPolicy -> Maybe Int
$sel:metricAggregationType:PutScalingPolicy' :: PutScalingPolicy -> Maybe Text
$sel:estimatedInstanceWarmup:PutScalingPolicy' :: PutScalingPolicy -> Maybe Int
$sel:enabled:PutScalingPolicy' :: PutScalingPolicy -> Maybe Bool
$sel:cooldown:PutScalingPolicy' :: PutScalingPolicy -> Maybe Int
$sel:adjustmentType:PutScalingPolicy' :: PutScalingPolicy -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
adjustmentType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
cooldown
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
enabled
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
estimatedInstanceWarmup
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
metricAggregationType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
minAdjustmentMagnitude
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
minAdjustmentStep
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
policyType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe PredictiveScalingConfiguration
predictiveScalingConfiguration
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
scalingAdjustment
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [StepAdjustment]
stepAdjustments
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe TargetTrackingConfiguration
targetTrackingConfiguration
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
autoScalingGroupName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
policyName

instance Data.ToHeaders PutScalingPolicy where
  toHeaders :: PutScalingPolicy -> ResponseHeaders
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

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

instance Data.ToQuery PutScalingPolicy where
  toQuery :: PutScalingPolicy -> QueryString
toQuery PutScalingPolicy' {Maybe Bool
Maybe Int
Maybe [StepAdjustment]
Maybe Text
Maybe PredictiveScalingConfiguration
Maybe TargetTrackingConfiguration
Text
policyName :: Text
autoScalingGroupName :: Text
targetTrackingConfiguration :: Maybe TargetTrackingConfiguration
stepAdjustments :: Maybe [StepAdjustment]
scalingAdjustment :: Maybe Int
predictiveScalingConfiguration :: Maybe PredictiveScalingConfiguration
policyType :: Maybe Text
minAdjustmentStep :: Maybe Int
minAdjustmentMagnitude :: Maybe Int
metricAggregationType :: Maybe Text
estimatedInstanceWarmup :: Maybe Int
enabled :: Maybe Bool
cooldown :: Maybe Int
adjustmentType :: Maybe Text
$sel:policyName:PutScalingPolicy' :: PutScalingPolicy -> Text
$sel:autoScalingGroupName:PutScalingPolicy' :: PutScalingPolicy -> Text
$sel:targetTrackingConfiguration:PutScalingPolicy' :: PutScalingPolicy -> Maybe TargetTrackingConfiguration
$sel:stepAdjustments:PutScalingPolicy' :: PutScalingPolicy -> Maybe [StepAdjustment]
$sel:scalingAdjustment:PutScalingPolicy' :: PutScalingPolicy -> Maybe Int
$sel:predictiveScalingConfiguration:PutScalingPolicy' :: PutScalingPolicy -> Maybe PredictiveScalingConfiguration
$sel:policyType:PutScalingPolicy' :: PutScalingPolicy -> Maybe Text
$sel:minAdjustmentStep:PutScalingPolicy' :: PutScalingPolicy -> Maybe Int
$sel:minAdjustmentMagnitude:PutScalingPolicy' :: PutScalingPolicy -> Maybe Int
$sel:metricAggregationType:PutScalingPolicy' :: PutScalingPolicy -> Maybe Text
$sel:estimatedInstanceWarmup:PutScalingPolicy' :: PutScalingPolicy -> Maybe Int
$sel:enabled:PutScalingPolicy' :: PutScalingPolicy -> Maybe Bool
$sel:cooldown:PutScalingPolicy' :: PutScalingPolicy -> Maybe Int
$sel:adjustmentType:PutScalingPolicy' :: PutScalingPolicy -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"PutScalingPolicy" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2011-01-01" :: Prelude.ByteString),
        ByteString
"AdjustmentType" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
adjustmentType,
        ByteString
"Cooldown" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Int
cooldown,
        ByteString
"Enabled" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
enabled,
        ByteString
"EstimatedInstanceWarmup"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Int
estimatedInstanceWarmup,
        ByteString
"MetricAggregationType"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
metricAggregationType,
        ByteString
"MinAdjustmentMagnitude"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Int
minAdjustmentMagnitude,
        ByteString
"MinAdjustmentStep" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Int
minAdjustmentStep,
        ByteString
"PolicyType" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
policyType,
        ByteString
"PredictiveScalingConfiguration"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe PredictiveScalingConfiguration
predictiveScalingConfiguration,
        ByteString
"ScalingAdjustment" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Int
scalingAdjustment,
        ByteString
"StepAdjustments"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: forall a. ToQuery a => a -> QueryString
Data.toQuery
            ( forall a.
(IsList a, ToQuery (Item a)) =>
ByteString -> a -> QueryString
Data.toQueryList ByteString
"member"
                forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [StepAdjustment]
stepAdjustments
            ),
        ByteString
"TargetTrackingConfiguration"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe TargetTrackingConfiguration
targetTrackingConfiguration,
        ByteString
"AutoScalingGroupName" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
autoScalingGroupName,
        ByteString
"PolicyName" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
policyName
      ]

-- | Contains the output of PutScalingPolicy.
--
-- /See:/ 'newPutScalingPolicyResponse' smart constructor.
data PutScalingPolicyResponse = PutScalingPolicyResponse'
  { -- | The CloudWatch alarms created for the target tracking scaling policy.
    PutScalingPolicyResponse -> Maybe [Alarm]
alarms :: Prelude.Maybe [Alarm],
    -- | The Amazon Resource Name (ARN) of the policy.
    PutScalingPolicyResponse -> Maybe Text
policyARN :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    PutScalingPolicyResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (PutScalingPolicyResponse -> PutScalingPolicyResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PutScalingPolicyResponse -> PutScalingPolicyResponse -> Bool
$c/= :: PutScalingPolicyResponse -> PutScalingPolicyResponse -> Bool
== :: PutScalingPolicyResponse -> PutScalingPolicyResponse -> Bool
$c== :: PutScalingPolicyResponse -> PutScalingPolicyResponse -> Bool
Prelude.Eq, ReadPrec [PutScalingPolicyResponse]
ReadPrec PutScalingPolicyResponse
Int -> ReadS PutScalingPolicyResponse
ReadS [PutScalingPolicyResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PutScalingPolicyResponse]
$creadListPrec :: ReadPrec [PutScalingPolicyResponse]
readPrec :: ReadPrec PutScalingPolicyResponse
$creadPrec :: ReadPrec PutScalingPolicyResponse
readList :: ReadS [PutScalingPolicyResponse]
$creadList :: ReadS [PutScalingPolicyResponse]
readsPrec :: Int -> ReadS PutScalingPolicyResponse
$creadsPrec :: Int -> ReadS PutScalingPolicyResponse
Prelude.Read, Int -> PutScalingPolicyResponse -> ShowS
[PutScalingPolicyResponse] -> ShowS
PutScalingPolicyResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PutScalingPolicyResponse] -> ShowS
$cshowList :: [PutScalingPolicyResponse] -> ShowS
show :: PutScalingPolicyResponse -> String
$cshow :: PutScalingPolicyResponse -> String
showsPrec :: Int -> PutScalingPolicyResponse -> ShowS
$cshowsPrec :: Int -> PutScalingPolicyResponse -> ShowS
Prelude.Show, forall x.
Rep PutScalingPolicyResponse x -> PutScalingPolicyResponse
forall x.
PutScalingPolicyResponse -> Rep PutScalingPolicyResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep PutScalingPolicyResponse x -> PutScalingPolicyResponse
$cfrom :: forall x.
PutScalingPolicyResponse -> Rep PutScalingPolicyResponse x
Prelude.Generic)

-- |
-- Create a value of 'PutScalingPolicyResponse' 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:
--
-- 'alarms', 'putScalingPolicyResponse_alarms' - The CloudWatch alarms created for the target tracking scaling policy.
--
-- 'policyARN', 'putScalingPolicyResponse_policyARN' - The Amazon Resource Name (ARN) of the policy.
--
-- 'httpStatus', 'putScalingPolicyResponse_httpStatus' - The response's http status code.
newPutScalingPolicyResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  PutScalingPolicyResponse
newPutScalingPolicyResponse :: Int -> PutScalingPolicyResponse
newPutScalingPolicyResponse Int
pHttpStatus_ =
  PutScalingPolicyResponse'
    { $sel:alarms:PutScalingPolicyResponse' :: Maybe [Alarm]
alarms = forall a. Maybe a
Prelude.Nothing,
      $sel:policyARN:PutScalingPolicyResponse' :: Maybe Text
policyARN = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:PutScalingPolicyResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The CloudWatch alarms created for the target tracking scaling policy.
putScalingPolicyResponse_alarms :: Lens.Lens' PutScalingPolicyResponse (Prelude.Maybe [Alarm])
putScalingPolicyResponse_alarms :: Lens' PutScalingPolicyResponse (Maybe [Alarm])
putScalingPolicyResponse_alarms = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutScalingPolicyResponse' {Maybe [Alarm]
alarms :: Maybe [Alarm]
$sel:alarms:PutScalingPolicyResponse' :: PutScalingPolicyResponse -> Maybe [Alarm]
alarms} -> Maybe [Alarm]
alarms) (\s :: PutScalingPolicyResponse
s@PutScalingPolicyResponse' {} Maybe [Alarm]
a -> PutScalingPolicyResponse
s {$sel:alarms:PutScalingPolicyResponse' :: Maybe [Alarm]
alarms = Maybe [Alarm]
a} :: PutScalingPolicyResponse) 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 Amazon Resource Name (ARN) of the policy.
putScalingPolicyResponse_policyARN :: Lens.Lens' PutScalingPolicyResponse (Prelude.Maybe Prelude.Text)
putScalingPolicyResponse_policyARN :: Lens' PutScalingPolicyResponse (Maybe Text)
putScalingPolicyResponse_policyARN = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutScalingPolicyResponse' {Maybe Text
policyARN :: Maybe Text
$sel:policyARN:PutScalingPolicyResponse' :: PutScalingPolicyResponse -> Maybe Text
policyARN} -> Maybe Text
policyARN) (\s :: PutScalingPolicyResponse
s@PutScalingPolicyResponse' {} Maybe Text
a -> PutScalingPolicyResponse
s {$sel:policyARN:PutScalingPolicyResponse' :: Maybe Text
policyARN = Maybe Text
a} :: PutScalingPolicyResponse)

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

instance Prelude.NFData PutScalingPolicyResponse where
  rnf :: PutScalingPolicyResponse -> ()
rnf PutScalingPolicyResponse' {Int
Maybe [Alarm]
Maybe Text
httpStatus :: Int
policyARN :: Maybe Text
alarms :: Maybe [Alarm]
$sel:httpStatus:PutScalingPolicyResponse' :: PutScalingPolicyResponse -> Int
$sel:policyARN:PutScalingPolicyResponse' :: PutScalingPolicyResponse -> Maybe Text
$sel:alarms:PutScalingPolicyResponse' :: PutScalingPolicyResponse -> Maybe [Alarm]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [Alarm]
alarms
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
policyARN
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus