{-# 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.CloudWatch.PutMetricAlarm
-- 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 an alarm and associates it with the specified metric,
-- metric math expression, anomaly detection model, or Metrics Insights
-- query. For more information about using a Metrics Insights query for an
-- alarm, see
-- <https://docs.aws.amazon.com/AmazonCloudWatch/latest/monitoring/Create_Metrics_Insights_Alarm.html Create alarms on Metrics Insights queries>.
--
-- Alarms based on anomaly detection models cannot have Auto Scaling
-- actions.
--
-- When this operation creates an alarm, the alarm state is immediately set
-- to @INSUFFICIENT_DATA@. The alarm is then evaluated and its state is set
-- appropriately. Any actions associated with the new state are then
-- executed.
--
-- When you update an existing alarm, its state is left unchanged, but the
-- update completely overwrites the previous configuration of the alarm.
--
-- If you are an IAM user, you must have Amazon EC2 permissions for some
-- alarm operations:
--
-- -   The @iam:CreateServiceLinkedRole@ for all alarms with EC2 actions
--
-- -   The @iam:CreateServiceLinkedRole@ to create an alarm with Systems
--     Manager OpsItem actions.
--
-- The first time you create an alarm in the Amazon Web Services Management
-- Console, the CLI, or by using the PutMetricAlarm API, CloudWatch creates
-- the necessary service-linked role for you. The service-linked roles are
-- called @AWSServiceRoleForCloudWatchEvents@ and
-- @AWSServiceRoleForCloudWatchAlarms_ActionSSM@. For more information, see
-- <https://docs.aws.amazon.com/IAM/latest/UserGuide/id_roles_terms-and-concepts.html#iam-term-service-linked-role Amazon Web Services service-linked role>.
--
-- __Cross-account alarms__
--
-- You can set an alarm on metrics in the current account, or in another
-- account. To create a cross-account alarm that watches a metric in a
-- different account, you must have completed the following pre-requisites:
--
-- -   The account where the metrics are located (the /sharing account/)
--     must already have a sharing role named
--     __CloudWatch-CrossAccountSharingRole__. If it does not already have
--     this role, you must create it using the instructions in __Set up a
--     sharing account__ in
--     <https://docs.aws.amazon.com/AmazonCloudWatch/latest/monitoring/Cross-Account-Cross-Region.html#enable-cross-account-cross-Region Cross-account cross-Region CloudWatch console>.
--     The policy for that role must grant access to the ID of the account
--     where you are creating the alarm.
--
-- -   The account where you are creating the alarm (the /monitoring
--     account/) must already have a service-linked role named
--     __AWSServiceRoleForCloudWatchCrossAccount__ to allow CloudWatch to
--     assume the sharing role in the sharing account. If it does not, you
--     must create it following the directions in __Set up a monitoring
--     account__ in
--     <https://docs.aws.amazon.com/AmazonCloudWatch/latest/monitoring/Cross-Account-Cross-Region.html#enable-cross-account-cross-Region Cross-account cross-Region CloudWatch console>.
module Amazonka.CloudWatch.PutMetricAlarm
  ( -- * Creating a Request
    PutMetricAlarm (..),
    newPutMetricAlarm,

    -- * Request Lenses
    putMetricAlarm_actionsEnabled,
    putMetricAlarm_alarmActions,
    putMetricAlarm_alarmDescription,
    putMetricAlarm_datapointsToAlarm,
    putMetricAlarm_dimensions,
    putMetricAlarm_evaluateLowSampleCountPercentile,
    putMetricAlarm_extendedStatistic,
    putMetricAlarm_insufficientDataActions,
    putMetricAlarm_metricName,
    putMetricAlarm_metrics,
    putMetricAlarm_namespace,
    putMetricAlarm_oKActions,
    putMetricAlarm_period,
    putMetricAlarm_statistic,
    putMetricAlarm_tags,
    putMetricAlarm_threshold,
    putMetricAlarm_thresholdMetricId,
    putMetricAlarm_treatMissingData,
    putMetricAlarm_unit,
    putMetricAlarm_alarmName,
    putMetricAlarm_evaluationPeriods,
    putMetricAlarm_comparisonOperator,

    -- * Destructuring the Response
    PutMetricAlarmResponse (..),
    newPutMetricAlarmResponse,
  )
where

import Amazonka.CloudWatch.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:/ 'newPutMetricAlarm' smart constructor.
data PutMetricAlarm = PutMetricAlarm'
  { -- | Indicates whether actions should be executed during any changes to the
    -- alarm state. The default is @TRUE@.
    PutMetricAlarm -> Maybe Bool
actionsEnabled :: Prelude.Maybe Prelude.Bool,
    -- | The actions to execute when this alarm transitions to the @ALARM@ state
    -- from any other state. Each action is specified as an Amazon Resource
    -- Name (ARN).
    --
    -- Valid Values: @arn:aws:automate:@/@region@/@:ec2:stop@ |
    -- @arn:aws:automate:@/@region@/@:ec2:terminate@ |
    -- @arn:aws:automate:@/@region@/@:ec2:recover@ |
    -- @arn:aws:automate:@/@region@/@:ec2:reboot@ |
    -- @arn:aws:sns:@/@region@/@:@/@account-id@/@:@/@sns-topic-name@/@ @ |
    -- @arn:aws:autoscaling:@/@region@/@:@/@account-id@/@:scalingPolicy:@/@policy-id@/@:autoScalingGroupName\/@/@group-friendly-name@/@:policyName\/@/@policy-friendly-name@/@ @
    -- | @arn:aws:ssm:@/@region@/@:@/@account-id@/@:opsitem:@/@severity@/@ @ |
    -- @arn:aws:ssm-incidents::@/@account-id@/@:response-plan:@/@response-plan-name@/@ @
    --
    -- Valid Values (for use with IAM roles):
    -- @arn:aws:swf:@/@region@/@:@/@account-id@/@:action\/actions\/AWS_EC2.InstanceId.Stop\/1.0@
    -- |
    -- @arn:aws:swf:@/@region@/@:@/@account-id@/@:action\/actions\/AWS_EC2.InstanceId.Terminate\/1.0@
    -- |
    -- @arn:aws:swf:@/@region@/@:@/@account-id@/@:action\/actions\/AWS_EC2.InstanceId.Reboot\/1.0@
    -- |
    -- @arn:aws:swf:@/@region@/@:@/@account-id@/@:action\/actions\/AWS_EC2.InstanceId.Recover\/1.0@
    PutMetricAlarm -> Maybe [Text]
alarmActions :: Prelude.Maybe [Prelude.Text],
    -- | The description for the alarm.
    PutMetricAlarm -> Maybe Text
alarmDescription :: Prelude.Maybe Prelude.Text,
    -- | The number of data points that must be breaching to trigger the alarm.
    -- This is used only if you are setting an \"M out of N\" alarm. In that
    -- case, this value is the M. For more information, see
    -- <https://docs.aws.amazon.com/AmazonCloudWatch/latest/monitoring/AlarmThatSendsEmail.html#alarm-evaluation Evaluating an Alarm>
    -- in the /Amazon CloudWatch User Guide/.
    PutMetricAlarm -> Maybe Natural
datapointsToAlarm :: Prelude.Maybe Prelude.Natural,
    -- | The dimensions for the metric specified in @MetricName@.
    PutMetricAlarm -> Maybe [Dimension]
dimensions :: Prelude.Maybe [Dimension],
    -- | Used only for alarms based on percentiles. If you specify @ignore@, the
    -- alarm state does not change during periods with too few data points to
    -- be statistically significant. If you specify @evaluate@ or omit this
    -- parameter, the alarm is always evaluated and possibly changes state no
    -- matter how many data points are available. For more information, see
    -- <https://docs.aws.amazon.com/AmazonCloudWatch/latest/monitoring/AlarmThatSendsEmail.html#percentiles-with-low-samples Percentile-Based CloudWatch Alarms and Low Data Samples>.
    --
    -- Valid Values: @evaluate | ignore@
    PutMetricAlarm -> Maybe Text
evaluateLowSampleCountPercentile :: Prelude.Maybe Prelude.Text,
    -- | The percentile statistic for the metric specified in @MetricName@.
    -- Specify a value between p0.0 and p100. When you call @PutMetricAlarm@
    -- and specify a @MetricName@, you must specify either @Statistic@ or
    -- @ExtendedStatistic,@ but not both.
    PutMetricAlarm -> Maybe Text
extendedStatistic :: Prelude.Maybe Prelude.Text,
    -- | The actions to execute when this alarm transitions to the
    -- @INSUFFICIENT_DATA@ state from any other state. Each action is specified
    -- as an Amazon Resource Name (ARN).
    --
    -- Valid Values: @arn:aws:automate:@/@region@/@:ec2:stop@ |
    -- @arn:aws:automate:@/@region@/@:ec2:terminate@ |
    -- @arn:aws:automate:@/@region@/@:ec2:recover@ |
    -- @arn:aws:automate:@/@region@/@:ec2:reboot@ |
    -- @arn:aws:sns:@/@region@/@:@/@account-id@/@:@/@sns-topic-name@/@ @ |
    -- @arn:aws:autoscaling:@/@region@/@:@/@account-id@/@:scalingPolicy:@/@policy-id@/@:autoScalingGroupName\/@/@group-friendly-name@/@:policyName\/@/@policy-friendly-name@/@ @
    --
    -- Valid Values (for use with IAM roles):
    -- @>arn:aws:swf:@/@region@/@:@/@account-id@/@:action\/actions\/AWS_EC2.InstanceId.Stop\/1.0@
    -- |
    -- @arn:aws:swf:@/@region@/@:@/@account-id@/@:action\/actions\/AWS_EC2.InstanceId.Terminate\/1.0@
    -- |
    -- @arn:aws:swf:@/@region@/@:@/@account-id@/@:action\/actions\/AWS_EC2.InstanceId.Reboot\/1.0@
    PutMetricAlarm -> Maybe [Text]
insufficientDataActions :: Prelude.Maybe [Prelude.Text],
    -- | The name for the metric associated with the alarm. For each
    -- @PutMetricAlarm@ operation, you must specify either @MetricName@ or a
    -- @Metrics@ array.
    --
    -- If you are creating an alarm based on a math expression, you cannot
    -- specify this parameter, or any of the @Dimensions@, @Period@,
    -- @Namespace@, @Statistic@, or @ExtendedStatistic@ parameters. Instead,
    -- you specify all this information in the @Metrics@ array.
    PutMetricAlarm -> Maybe Text
metricName :: Prelude.Maybe Prelude.Text,
    -- | An array of @MetricDataQuery@ structures that enable you to create an
    -- alarm based on the result of a metric math expression. For each
    -- @PutMetricAlarm@ operation, you must specify either @MetricName@ or a
    -- @Metrics@ array.
    --
    -- Each item in the @Metrics@ array either retrieves a metric or performs a
    -- math expression.
    --
    -- One item in the @Metrics@ array is the expression that the alarm
    -- watches. You designate this expression by setting @ReturnData@ to true
    -- for this object in the array. For more information, see
    -- <https://docs.aws.amazon.com/AmazonCloudWatch/latest/APIReference/API_MetricDataQuery.html MetricDataQuery>.
    --
    -- If you use the @Metrics@ parameter, you cannot include the @MetricName@,
    -- @Dimensions@, @Period@, @Namespace@, @Statistic@, or @ExtendedStatistic@
    -- parameters of @PutMetricAlarm@ in the same operation. Instead, you
    -- retrieve the metrics you are using in your math expression as part of
    -- the @Metrics@ array.
    PutMetricAlarm -> Maybe [MetricDataQuery]
metrics :: Prelude.Maybe [MetricDataQuery],
    -- | The namespace for the metric associated specified in @MetricName@.
    PutMetricAlarm -> Maybe Text
namespace :: Prelude.Maybe Prelude.Text,
    -- | The actions to execute when this alarm transitions to an @OK@ state from
    -- any other state. Each action is specified as an Amazon Resource Name
    -- (ARN).
    --
    -- Valid Values: @arn:aws:automate:@/@region@/@:ec2:stop@ |
    -- @arn:aws:automate:@/@region@/@:ec2:terminate@ |
    -- @arn:aws:automate:@/@region@/@:ec2:recover@ |
    -- @arn:aws:automate:@/@region@/@:ec2:reboot@ |
    -- @arn:aws:sns:@/@region@/@:@/@account-id@/@:@/@sns-topic-name@/@ @ |
    -- @arn:aws:autoscaling:@/@region@/@:@/@account-id@/@:scalingPolicy:@/@policy-id@/@:autoScalingGroupName\/@/@group-friendly-name@/@:policyName\/@/@policy-friendly-name@/@ @
    --
    -- Valid Values (for use with IAM roles):
    -- @arn:aws:swf:@/@region@/@:@/@account-id@/@:action\/actions\/AWS_EC2.InstanceId.Stop\/1.0@
    -- |
    -- @arn:aws:swf:@/@region@/@:@/@account-id@/@:action\/actions\/AWS_EC2.InstanceId.Terminate\/1.0@
    -- |
    -- @arn:aws:swf:@/@region@/@:@/@account-id@/@:action\/actions\/AWS_EC2.InstanceId.Reboot\/1.0@
    -- |
    -- @arn:aws:swf:@/@region@/@:@/@account-id@/@:action\/actions\/AWS_EC2.InstanceId.Recover\/1.0@
    PutMetricAlarm -> Maybe [Text]
oKActions :: Prelude.Maybe [Prelude.Text],
    -- | The length, in seconds, used each time the metric specified in
    -- @MetricName@ is evaluated. Valid values are 10, 30, and any multiple of
    -- 60.
    --
    -- @Period@ is required for alarms based on static thresholds. If you are
    -- creating an alarm based on a metric math expression, you specify the
    -- period for each metric within the objects in the @Metrics@ array.
    --
    -- Be sure to specify 10 or 30 only for metrics that are stored by a
    -- @PutMetricData@ call with a @StorageResolution@ of 1. If you specify a
    -- period of 10 or 30 for a metric that does not have sub-minute
    -- resolution, the alarm still attempts to gather data at the period rate
    -- that you specify. In this case, it does not receive data for the
    -- attempts that do not correspond to a one-minute data resolution, and the
    -- alarm might often lapse into INSUFFICENT_DATA status. Specifying 10 or
    -- 30 also sets this alarm as a high-resolution alarm, which has a higher
    -- charge than other alarms. For more information about pricing, see
    -- <https://aws.amazon.com/cloudwatch/pricing/ Amazon CloudWatch Pricing>.
    --
    -- An alarm\'s total current evaluation period can be no longer than one
    -- day, so @Period@ multiplied by @EvaluationPeriods@ cannot be more than
    -- 86,400 seconds.
    PutMetricAlarm -> Maybe Natural
period :: Prelude.Maybe Prelude.Natural,
    -- | The statistic for the metric specified in @MetricName@, other than
    -- percentile. For percentile statistics, use @ExtendedStatistic@. When you
    -- call @PutMetricAlarm@ and specify a @MetricName@, you must specify
    -- either @Statistic@ or @ExtendedStatistic,@ but not both.
    PutMetricAlarm -> Maybe Statistic
statistic :: Prelude.Maybe Statistic,
    -- | A list of key-value pairs to associate with the alarm. You can associate
    -- as many as 50 tags with an alarm.
    --
    -- Tags can help you organize and categorize your resources. You can also
    -- use them to scope user permissions by granting a user permission to
    -- access or change only resources with certain tag values.
    --
    -- If you are using this operation to update an existing alarm, any tags
    -- you specify in this parameter are ignored. To change the tags of an
    -- existing alarm, use
    -- <https://docs.aws.amazon.com/AmazonCloudWatch/latest/APIReference/API_TagResource.html TagResource>
    -- or
    -- <https://docs.aws.amazon.com/AmazonCloudWatch/latest/APIReference/API_UntagResource.html UntagResource>.
    PutMetricAlarm -> Maybe [Tag]
tags :: Prelude.Maybe [Tag],
    -- | The value against which the specified statistic is compared.
    --
    -- This parameter is required for alarms based on static thresholds, but
    -- should not be used for alarms based on anomaly detection models.
    PutMetricAlarm -> Maybe Double
threshold :: Prelude.Maybe Prelude.Double,
    -- | If this is an alarm based on an anomaly detection model, make this value
    -- match the ID of the @ANOMALY_DETECTION_BAND@ function.
    --
    -- For an example of how to use this parameter, see the __Anomaly Detection
    -- Model Alarm__ example on this page.
    --
    -- If your alarm uses this parameter, it cannot have Auto Scaling actions.
    PutMetricAlarm -> Maybe Text
thresholdMetricId :: Prelude.Maybe Prelude.Text,
    -- | Sets how this alarm is to handle missing data points. If
    -- @TreatMissingData@ is omitted, the default behavior of @missing@ is
    -- used. For more information, see
    -- <https://docs.aws.amazon.com/AmazonCloudWatch/latest/monitoring/AlarmThatSendsEmail.html#alarms-and-missing-data Configuring How CloudWatch Alarms Treats Missing Data>.
    --
    -- Valid Values: @breaching | notBreaching | ignore | missing@
    --
    -- Alarms that evaluate metrics in the @AWS\/DynamoDB@ namespace always
    -- @ignore@ missing data even if you choose a different option for
    -- @TreatMissingData@. When an @AWS\/DynamoDB@ metric has missing data,
    -- alarms that evaluate that metric remain in their current state.
    PutMetricAlarm -> Maybe Text
treatMissingData :: Prelude.Maybe Prelude.Text,
    -- | The unit of measure for the statistic. For example, the units for the
    -- Amazon EC2 NetworkIn metric are Bytes because NetworkIn tracks the
    -- number of bytes that an instance receives on all network interfaces. You
    -- can also specify a unit when you create a custom metric. Units help
    -- provide conceptual meaning to your data. Metric data points that specify
    -- a unit of measure, such as Percent, are aggregated separately.
    --
    -- If you don\'t specify @Unit@, CloudWatch retrieves all unit types that
    -- have been published for the metric and attempts to evaluate the alarm.
    -- Usually, metrics are published with only one unit, so the alarm works as
    -- intended.
    --
    -- However, if the metric is published with multiple types of units and you
    -- don\'t specify a unit, the alarm\'s behavior is not defined and it
    -- behaves unpredictably.
    --
    -- We recommend omitting @Unit@ so that you don\'t inadvertently specify an
    -- incorrect unit that is not published for this metric. Doing so causes
    -- the alarm to be stuck in the @INSUFFICIENT DATA@ state.
    PutMetricAlarm -> Maybe StandardUnit
unit :: Prelude.Maybe StandardUnit,
    -- | The name for the alarm. This name must be unique within the Region.
    PutMetricAlarm -> Text
alarmName :: Prelude.Text,
    -- | The number of periods over which data is compared to the specified
    -- threshold. If you are setting an alarm that requires that a number of
    -- consecutive data points be breaching to trigger the alarm, this value
    -- specifies that number. If you are setting an \"M out of N\" alarm, this
    -- value is the N.
    --
    -- An alarm\'s total current evaluation period can be no longer than one
    -- day, so this number multiplied by @Period@ cannot be more than 86,400
    -- seconds.
    PutMetricAlarm -> Natural
evaluationPeriods :: Prelude.Natural,
    -- | The arithmetic operation to use when comparing the specified statistic
    -- and threshold. The specified statistic value is used as the first
    -- operand.
    --
    -- The values @LessThanLowerOrGreaterThanUpperThreshold@,
    -- @LessThanLowerThreshold@, and @GreaterThanUpperThreshold@ are used only
    -- for alarms based on anomaly detection models.
    PutMetricAlarm -> ComparisonOperator
comparisonOperator :: ComparisonOperator
  }
  deriving (PutMetricAlarm -> PutMetricAlarm -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PutMetricAlarm -> PutMetricAlarm -> Bool
$c/= :: PutMetricAlarm -> PutMetricAlarm -> Bool
== :: PutMetricAlarm -> PutMetricAlarm -> Bool
$c== :: PutMetricAlarm -> PutMetricAlarm -> Bool
Prelude.Eq, ReadPrec [PutMetricAlarm]
ReadPrec PutMetricAlarm
Int -> ReadS PutMetricAlarm
ReadS [PutMetricAlarm]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PutMetricAlarm]
$creadListPrec :: ReadPrec [PutMetricAlarm]
readPrec :: ReadPrec PutMetricAlarm
$creadPrec :: ReadPrec PutMetricAlarm
readList :: ReadS [PutMetricAlarm]
$creadList :: ReadS [PutMetricAlarm]
readsPrec :: Int -> ReadS PutMetricAlarm
$creadsPrec :: Int -> ReadS PutMetricAlarm
Prelude.Read, Int -> PutMetricAlarm -> ShowS
[PutMetricAlarm] -> ShowS
PutMetricAlarm -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PutMetricAlarm] -> ShowS
$cshowList :: [PutMetricAlarm] -> ShowS
show :: PutMetricAlarm -> String
$cshow :: PutMetricAlarm -> String
showsPrec :: Int -> PutMetricAlarm -> ShowS
$cshowsPrec :: Int -> PutMetricAlarm -> ShowS
Prelude.Show, forall x. Rep PutMetricAlarm x -> PutMetricAlarm
forall x. PutMetricAlarm -> Rep PutMetricAlarm x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PutMetricAlarm x -> PutMetricAlarm
$cfrom :: forall x. PutMetricAlarm -> Rep PutMetricAlarm x
Prelude.Generic)

-- |
-- Create a value of 'PutMetricAlarm' 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:
--
-- 'actionsEnabled', 'putMetricAlarm_actionsEnabled' - Indicates whether actions should be executed during any changes to the
-- alarm state. The default is @TRUE@.
--
-- 'alarmActions', 'putMetricAlarm_alarmActions' - The actions to execute when this alarm transitions to the @ALARM@ state
-- from any other state. Each action is specified as an Amazon Resource
-- Name (ARN).
--
-- Valid Values: @arn:aws:automate:@/@region@/@:ec2:stop@ |
-- @arn:aws:automate:@/@region@/@:ec2:terminate@ |
-- @arn:aws:automate:@/@region@/@:ec2:recover@ |
-- @arn:aws:automate:@/@region@/@:ec2:reboot@ |
-- @arn:aws:sns:@/@region@/@:@/@account-id@/@:@/@sns-topic-name@/@ @ |
-- @arn:aws:autoscaling:@/@region@/@:@/@account-id@/@:scalingPolicy:@/@policy-id@/@:autoScalingGroupName\/@/@group-friendly-name@/@:policyName\/@/@policy-friendly-name@/@ @
-- | @arn:aws:ssm:@/@region@/@:@/@account-id@/@:opsitem:@/@severity@/@ @ |
-- @arn:aws:ssm-incidents::@/@account-id@/@:response-plan:@/@response-plan-name@/@ @
--
-- Valid Values (for use with IAM roles):
-- @arn:aws:swf:@/@region@/@:@/@account-id@/@:action\/actions\/AWS_EC2.InstanceId.Stop\/1.0@
-- |
-- @arn:aws:swf:@/@region@/@:@/@account-id@/@:action\/actions\/AWS_EC2.InstanceId.Terminate\/1.0@
-- |
-- @arn:aws:swf:@/@region@/@:@/@account-id@/@:action\/actions\/AWS_EC2.InstanceId.Reboot\/1.0@
-- |
-- @arn:aws:swf:@/@region@/@:@/@account-id@/@:action\/actions\/AWS_EC2.InstanceId.Recover\/1.0@
--
-- 'alarmDescription', 'putMetricAlarm_alarmDescription' - The description for the alarm.
--
-- 'datapointsToAlarm', 'putMetricAlarm_datapointsToAlarm' - The number of data points that must be breaching to trigger the alarm.
-- This is used only if you are setting an \"M out of N\" alarm. In that
-- case, this value is the M. For more information, see
-- <https://docs.aws.amazon.com/AmazonCloudWatch/latest/monitoring/AlarmThatSendsEmail.html#alarm-evaluation Evaluating an Alarm>
-- in the /Amazon CloudWatch User Guide/.
--
-- 'dimensions', 'putMetricAlarm_dimensions' - The dimensions for the metric specified in @MetricName@.
--
-- 'evaluateLowSampleCountPercentile', 'putMetricAlarm_evaluateLowSampleCountPercentile' - Used only for alarms based on percentiles. If you specify @ignore@, the
-- alarm state does not change during periods with too few data points to
-- be statistically significant. If you specify @evaluate@ or omit this
-- parameter, the alarm is always evaluated and possibly changes state no
-- matter how many data points are available. For more information, see
-- <https://docs.aws.amazon.com/AmazonCloudWatch/latest/monitoring/AlarmThatSendsEmail.html#percentiles-with-low-samples Percentile-Based CloudWatch Alarms and Low Data Samples>.
--
-- Valid Values: @evaluate | ignore@
--
-- 'extendedStatistic', 'putMetricAlarm_extendedStatistic' - The percentile statistic for the metric specified in @MetricName@.
-- Specify a value between p0.0 and p100. When you call @PutMetricAlarm@
-- and specify a @MetricName@, you must specify either @Statistic@ or
-- @ExtendedStatistic,@ but not both.
--
-- 'insufficientDataActions', 'putMetricAlarm_insufficientDataActions' - The actions to execute when this alarm transitions to the
-- @INSUFFICIENT_DATA@ state from any other state. Each action is specified
-- as an Amazon Resource Name (ARN).
--
-- Valid Values: @arn:aws:automate:@/@region@/@:ec2:stop@ |
-- @arn:aws:automate:@/@region@/@:ec2:terminate@ |
-- @arn:aws:automate:@/@region@/@:ec2:recover@ |
-- @arn:aws:automate:@/@region@/@:ec2:reboot@ |
-- @arn:aws:sns:@/@region@/@:@/@account-id@/@:@/@sns-topic-name@/@ @ |
-- @arn:aws:autoscaling:@/@region@/@:@/@account-id@/@:scalingPolicy:@/@policy-id@/@:autoScalingGroupName\/@/@group-friendly-name@/@:policyName\/@/@policy-friendly-name@/@ @
--
-- Valid Values (for use with IAM roles):
-- @>arn:aws:swf:@/@region@/@:@/@account-id@/@:action\/actions\/AWS_EC2.InstanceId.Stop\/1.0@
-- |
-- @arn:aws:swf:@/@region@/@:@/@account-id@/@:action\/actions\/AWS_EC2.InstanceId.Terminate\/1.0@
-- |
-- @arn:aws:swf:@/@region@/@:@/@account-id@/@:action\/actions\/AWS_EC2.InstanceId.Reboot\/1.0@
--
-- 'metricName', 'putMetricAlarm_metricName' - The name for the metric associated with the alarm. For each
-- @PutMetricAlarm@ operation, you must specify either @MetricName@ or a
-- @Metrics@ array.
--
-- If you are creating an alarm based on a math expression, you cannot
-- specify this parameter, or any of the @Dimensions@, @Period@,
-- @Namespace@, @Statistic@, or @ExtendedStatistic@ parameters. Instead,
-- you specify all this information in the @Metrics@ array.
--
-- 'metrics', 'putMetricAlarm_metrics' - An array of @MetricDataQuery@ structures that enable you to create an
-- alarm based on the result of a metric math expression. For each
-- @PutMetricAlarm@ operation, you must specify either @MetricName@ or a
-- @Metrics@ array.
--
-- Each item in the @Metrics@ array either retrieves a metric or performs a
-- math expression.
--
-- One item in the @Metrics@ array is the expression that the alarm
-- watches. You designate this expression by setting @ReturnData@ to true
-- for this object in the array. For more information, see
-- <https://docs.aws.amazon.com/AmazonCloudWatch/latest/APIReference/API_MetricDataQuery.html MetricDataQuery>.
--
-- If you use the @Metrics@ parameter, you cannot include the @MetricName@,
-- @Dimensions@, @Period@, @Namespace@, @Statistic@, or @ExtendedStatistic@
-- parameters of @PutMetricAlarm@ in the same operation. Instead, you
-- retrieve the metrics you are using in your math expression as part of
-- the @Metrics@ array.
--
-- 'namespace', 'putMetricAlarm_namespace' - The namespace for the metric associated specified in @MetricName@.
--
-- 'oKActions', 'putMetricAlarm_oKActions' - The actions to execute when this alarm transitions to an @OK@ state from
-- any other state. Each action is specified as an Amazon Resource Name
-- (ARN).
--
-- Valid Values: @arn:aws:automate:@/@region@/@:ec2:stop@ |
-- @arn:aws:automate:@/@region@/@:ec2:terminate@ |
-- @arn:aws:automate:@/@region@/@:ec2:recover@ |
-- @arn:aws:automate:@/@region@/@:ec2:reboot@ |
-- @arn:aws:sns:@/@region@/@:@/@account-id@/@:@/@sns-topic-name@/@ @ |
-- @arn:aws:autoscaling:@/@region@/@:@/@account-id@/@:scalingPolicy:@/@policy-id@/@:autoScalingGroupName\/@/@group-friendly-name@/@:policyName\/@/@policy-friendly-name@/@ @
--
-- Valid Values (for use with IAM roles):
-- @arn:aws:swf:@/@region@/@:@/@account-id@/@:action\/actions\/AWS_EC2.InstanceId.Stop\/1.0@
-- |
-- @arn:aws:swf:@/@region@/@:@/@account-id@/@:action\/actions\/AWS_EC2.InstanceId.Terminate\/1.0@
-- |
-- @arn:aws:swf:@/@region@/@:@/@account-id@/@:action\/actions\/AWS_EC2.InstanceId.Reboot\/1.0@
-- |
-- @arn:aws:swf:@/@region@/@:@/@account-id@/@:action\/actions\/AWS_EC2.InstanceId.Recover\/1.0@
--
-- 'period', 'putMetricAlarm_period' - The length, in seconds, used each time the metric specified in
-- @MetricName@ is evaluated. Valid values are 10, 30, and any multiple of
-- 60.
--
-- @Period@ is required for alarms based on static thresholds. If you are
-- creating an alarm based on a metric math expression, you specify the
-- period for each metric within the objects in the @Metrics@ array.
--
-- Be sure to specify 10 or 30 only for metrics that are stored by a
-- @PutMetricData@ call with a @StorageResolution@ of 1. If you specify a
-- period of 10 or 30 for a metric that does not have sub-minute
-- resolution, the alarm still attempts to gather data at the period rate
-- that you specify. In this case, it does not receive data for the
-- attempts that do not correspond to a one-minute data resolution, and the
-- alarm might often lapse into INSUFFICENT_DATA status. Specifying 10 or
-- 30 also sets this alarm as a high-resolution alarm, which has a higher
-- charge than other alarms. For more information about pricing, see
-- <https://aws.amazon.com/cloudwatch/pricing/ Amazon CloudWatch Pricing>.
--
-- An alarm\'s total current evaluation period can be no longer than one
-- day, so @Period@ multiplied by @EvaluationPeriods@ cannot be more than
-- 86,400 seconds.
--
-- 'statistic', 'putMetricAlarm_statistic' - The statistic for the metric specified in @MetricName@, other than
-- percentile. For percentile statistics, use @ExtendedStatistic@. When you
-- call @PutMetricAlarm@ and specify a @MetricName@, you must specify
-- either @Statistic@ or @ExtendedStatistic,@ but not both.
--
-- 'tags', 'putMetricAlarm_tags' - A list of key-value pairs to associate with the alarm. You can associate
-- as many as 50 tags with an alarm.
--
-- Tags can help you organize and categorize your resources. You can also
-- use them to scope user permissions by granting a user permission to
-- access or change only resources with certain tag values.
--
-- If you are using this operation to update an existing alarm, any tags
-- you specify in this parameter are ignored. To change the tags of an
-- existing alarm, use
-- <https://docs.aws.amazon.com/AmazonCloudWatch/latest/APIReference/API_TagResource.html TagResource>
-- or
-- <https://docs.aws.amazon.com/AmazonCloudWatch/latest/APIReference/API_UntagResource.html UntagResource>.
--
-- 'threshold', 'putMetricAlarm_threshold' - The value against which the specified statistic is compared.
--
-- This parameter is required for alarms based on static thresholds, but
-- should not be used for alarms based on anomaly detection models.
--
-- 'thresholdMetricId', 'putMetricAlarm_thresholdMetricId' - If this is an alarm based on an anomaly detection model, make this value
-- match the ID of the @ANOMALY_DETECTION_BAND@ function.
--
-- For an example of how to use this parameter, see the __Anomaly Detection
-- Model Alarm__ example on this page.
--
-- If your alarm uses this parameter, it cannot have Auto Scaling actions.
--
-- 'treatMissingData', 'putMetricAlarm_treatMissingData' - Sets how this alarm is to handle missing data points. If
-- @TreatMissingData@ is omitted, the default behavior of @missing@ is
-- used. For more information, see
-- <https://docs.aws.amazon.com/AmazonCloudWatch/latest/monitoring/AlarmThatSendsEmail.html#alarms-and-missing-data Configuring How CloudWatch Alarms Treats Missing Data>.
--
-- Valid Values: @breaching | notBreaching | ignore | missing@
--
-- Alarms that evaluate metrics in the @AWS\/DynamoDB@ namespace always
-- @ignore@ missing data even if you choose a different option for
-- @TreatMissingData@. When an @AWS\/DynamoDB@ metric has missing data,
-- alarms that evaluate that metric remain in their current state.
--
-- 'unit', 'putMetricAlarm_unit' - The unit of measure for the statistic. For example, the units for the
-- Amazon EC2 NetworkIn metric are Bytes because NetworkIn tracks the
-- number of bytes that an instance receives on all network interfaces. You
-- can also specify a unit when you create a custom metric. Units help
-- provide conceptual meaning to your data. Metric data points that specify
-- a unit of measure, such as Percent, are aggregated separately.
--
-- If you don\'t specify @Unit@, CloudWatch retrieves all unit types that
-- have been published for the metric and attempts to evaluate the alarm.
-- Usually, metrics are published with only one unit, so the alarm works as
-- intended.
--
-- However, if the metric is published with multiple types of units and you
-- don\'t specify a unit, the alarm\'s behavior is not defined and it
-- behaves unpredictably.
--
-- We recommend omitting @Unit@ so that you don\'t inadvertently specify an
-- incorrect unit that is not published for this metric. Doing so causes
-- the alarm to be stuck in the @INSUFFICIENT DATA@ state.
--
-- 'alarmName', 'putMetricAlarm_alarmName' - The name for the alarm. This name must be unique within the Region.
--
-- 'evaluationPeriods', 'putMetricAlarm_evaluationPeriods' - The number of periods over which data is compared to the specified
-- threshold. If you are setting an alarm that requires that a number of
-- consecutive data points be breaching to trigger the alarm, this value
-- specifies that number. If you are setting an \"M out of N\" alarm, this
-- value is the N.
--
-- An alarm\'s total current evaluation period can be no longer than one
-- day, so this number multiplied by @Period@ cannot be more than 86,400
-- seconds.
--
-- 'comparisonOperator', 'putMetricAlarm_comparisonOperator' - The arithmetic operation to use when comparing the specified statistic
-- and threshold. The specified statistic value is used as the first
-- operand.
--
-- The values @LessThanLowerOrGreaterThanUpperThreshold@,
-- @LessThanLowerThreshold@, and @GreaterThanUpperThreshold@ are used only
-- for alarms based on anomaly detection models.
newPutMetricAlarm ::
  -- | 'alarmName'
  Prelude.Text ->
  -- | 'evaluationPeriods'
  Prelude.Natural ->
  -- | 'comparisonOperator'
  ComparisonOperator ->
  PutMetricAlarm
newPutMetricAlarm :: Text -> Natural -> ComparisonOperator -> PutMetricAlarm
newPutMetricAlarm
  Text
pAlarmName_
  Natural
pEvaluationPeriods_
  ComparisonOperator
pComparisonOperator_ =
    PutMetricAlarm'
      { $sel:actionsEnabled:PutMetricAlarm' :: Maybe Bool
actionsEnabled = forall a. Maybe a
Prelude.Nothing,
        $sel:alarmActions:PutMetricAlarm' :: Maybe [Text]
alarmActions = forall a. Maybe a
Prelude.Nothing,
        $sel:alarmDescription:PutMetricAlarm' :: Maybe Text
alarmDescription = forall a. Maybe a
Prelude.Nothing,
        $sel:datapointsToAlarm:PutMetricAlarm' :: Maybe Natural
datapointsToAlarm = forall a. Maybe a
Prelude.Nothing,
        $sel:dimensions:PutMetricAlarm' :: Maybe [Dimension]
dimensions = forall a. Maybe a
Prelude.Nothing,
        $sel:evaluateLowSampleCountPercentile:PutMetricAlarm' :: Maybe Text
evaluateLowSampleCountPercentile = forall a. Maybe a
Prelude.Nothing,
        $sel:extendedStatistic:PutMetricAlarm' :: Maybe Text
extendedStatistic = forall a. Maybe a
Prelude.Nothing,
        $sel:insufficientDataActions:PutMetricAlarm' :: Maybe [Text]
insufficientDataActions = forall a. Maybe a
Prelude.Nothing,
        $sel:metricName:PutMetricAlarm' :: Maybe Text
metricName = forall a. Maybe a
Prelude.Nothing,
        $sel:metrics:PutMetricAlarm' :: Maybe [MetricDataQuery]
metrics = forall a. Maybe a
Prelude.Nothing,
        $sel:namespace:PutMetricAlarm' :: Maybe Text
namespace = forall a. Maybe a
Prelude.Nothing,
        $sel:oKActions:PutMetricAlarm' :: Maybe [Text]
oKActions = forall a. Maybe a
Prelude.Nothing,
        $sel:period:PutMetricAlarm' :: Maybe Natural
period = forall a. Maybe a
Prelude.Nothing,
        $sel:statistic:PutMetricAlarm' :: Maybe Statistic
statistic = forall a. Maybe a
Prelude.Nothing,
        $sel:tags:PutMetricAlarm' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing,
        $sel:threshold:PutMetricAlarm' :: Maybe Double
threshold = forall a. Maybe a
Prelude.Nothing,
        $sel:thresholdMetricId:PutMetricAlarm' :: Maybe Text
thresholdMetricId = forall a. Maybe a
Prelude.Nothing,
        $sel:treatMissingData:PutMetricAlarm' :: Maybe Text
treatMissingData = forall a. Maybe a
Prelude.Nothing,
        $sel:unit:PutMetricAlarm' :: Maybe StandardUnit
unit = forall a. Maybe a
Prelude.Nothing,
        $sel:alarmName:PutMetricAlarm' :: Text
alarmName = Text
pAlarmName_,
        $sel:evaluationPeriods:PutMetricAlarm' :: Natural
evaluationPeriods = Natural
pEvaluationPeriods_,
        $sel:comparisonOperator:PutMetricAlarm' :: ComparisonOperator
comparisonOperator = ComparisonOperator
pComparisonOperator_
      }

-- | Indicates whether actions should be executed during any changes to the
-- alarm state. The default is @TRUE@.
putMetricAlarm_actionsEnabled :: Lens.Lens' PutMetricAlarm (Prelude.Maybe Prelude.Bool)
putMetricAlarm_actionsEnabled :: Lens' PutMetricAlarm (Maybe Bool)
putMetricAlarm_actionsEnabled = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutMetricAlarm' {Maybe Bool
actionsEnabled :: Maybe Bool
$sel:actionsEnabled:PutMetricAlarm' :: PutMetricAlarm -> Maybe Bool
actionsEnabled} -> Maybe Bool
actionsEnabled) (\s :: PutMetricAlarm
s@PutMetricAlarm' {} Maybe Bool
a -> PutMetricAlarm
s {$sel:actionsEnabled:PutMetricAlarm' :: Maybe Bool
actionsEnabled = Maybe Bool
a} :: PutMetricAlarm)

-- | The actions to execute when this alarm transitions to the @ALARM@ state
-- from any other state. Each action is specified as an Amazon Resource
-- Name (ARN).
--
-- Valid Values: @arn:aws:automate:@/@region@/@:ec2:stop@ |
-- @arn:aws:automate:@/@region@/@:ec2:terminate@ |
-- @arn:aws:automate:@/@region@/@:ec2:recover@ |
-- @arn:aws:automate:@/@region@/@:ec2:reboot@ |
-- @arn:aws:sns:@/@region@/@:@/@account-id@/@:@/@sns-topic-name@/@ @ |
-- @arn:aws:autoscaling:@/@region@/@:@/@account-id@/@:scalingPolicy:@/@policy-id@/@:autoScalingGroupName\/@/@group-friendly-name@/@:policyName\/@/@policy-friendly-name@/@ @
-- | @arn:aws:ssm:@/@region@/@:@/@account-id@/@:opsitem:@/@severity@/@ @ |
-- @arn:aws:ssm-incidents::@/@account-id@/@:response-plan:@/@response-plan-name@/@ @
--
-- Valid Values (for use with IAM roles):
-- @arn:aws:swf:@/@region@/@:@/@account-id@/@:action\/actions\/AWS_EC2.InstanceId.Stop\/1.0@
-- |
-- @arn:aws:swf:@/@region@/@:@/@account-id@/@:action\/actions\/AWS_EC2.InstanceId.Terminate\/1.0@
-- |
-- @arn:aws:swf:@/@region@/@:@/@account-id@/@:action\/actions\/AWS_EC2.InstanceId.Reboot\/1.0@
-- |
-- @arn:aws:swf:@/@region@/@:@/@account-id@/@:action\/actions\/AWS_EC2.InstanceId.Recover\/1.0@
putMetricAlarm_alarmActions :: Lens.Lens' PutMetricAlarm (Prelude.Maybe [Prelude.Text])
putMetricAlarm_alarmActions :: Lens' PutMetricAlarm (Maybe [Text])
putMetricAlarm_alarmActions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutMetricAlarm' {Maybe [Text]
alarmActions :: Maybe [Text]
$sel:alarmActions:PutMetricAlarm' :: PutMetricAlarm -> Maybe [Text]
alarmActions} -> Maybe [Text]
alarmActions) (\s :: PutMetricAlarm
s@PutMetricAlarm' {} Maybe [Text]
a -> PutMetricAlarm
s {$sel:alarmActions:PutMetricAlarm' :: Maybe [Text]
alarmActions = Maybe [Text]
a} :: PutMetricAlarm) 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 description for the alarm.
putMetricAlarm_alarmDescription :: Lens.Lens' PutMetricAlarm (Prelude.Maybe Prelude.Text)
putMetricAlarm_alarmDescription :: Lens' PutMetricAlarm (Maybe Text)
putMetricAlarm_alarmDescription = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutMetricAlarm' {Maybe Text
alarmDescription :: Maybe Text
$sel:alarmDescription:PutMetricAlarm' :: PutMetricAlarm -> Maybe Text
alarmDescription} -> Maybe Text
alarmDescription) (\s :: PutMetricAlarm
s@PutMetricAlarm' {} Maybe Text
a -> PutMetricAlarm
s {$sel:alarmDescription:PutMetricAlarm' :: Maybe Text
alarmDescription = Maybe Text
a} :: PutMetricAlarm)

-- | The number of data points that must be breaching to trigger the alarm.
-- This is used only if you are setting an \"M out of N\" alarm. In that
-- case, this value is the M. For more information, see
-- <https://docs.aws.amazon.com/AmazonCloudWatch/latest/monitoring/AlarmThatSendsEmail.html#alarm-evaluation Evaluating an Alarm>
-- in the /Amazon CloudWatch User Guide/.
putMetricAlarm_datapointsToAlarm :: Lens.Lens' PutMetricAlarm (Prelude.Maybe Prelude.Natural)
putMetricAlarm_datapointsToAlarm :: Lens' PutMetricAlarm (Maybe Natural)
putMetricAlarm_datapointsToAlarm = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutMetricAlarm' {Maybe Natural
datapointsToAlarm :: Maybe Natural
$sel:datapointsToAlarm:PutMetricAlarm' :: PutMetricAlarm -> Maybe Natural
datapointsToAlarm} -> Maybe Natural
datapointsToAlarm) (\s :: PutMetricAlarm
s@PutMetricAlarm' {} Maybe Natural
a -> PutMetricAlarm
s {$sel:datapointsToAlarm:PutMetricAlarm' :: Maybe Natural
datapointsToAlarm = Maybe Natural
a} :: PutMetricAlarm)

-- | The dimensions for the metric specified in @MetricName@.
putMetricAlarm_dimensions :: Lens.Lens' PutMetricAlarm (Prelude.Maybe [Dimension])
putMetricAlarm_dimensions :: Lens' PutMetricAlarm (Maybe [Dimension])
putMetricAlarm_dimensions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutMetricAlarm' {Maybe [Dimension]
dimensions :: Maybe [Dimension]
$sel:dimensions:PutMetricAlarm' :: PutMetricAlarm -> Maybe [Dimension]
dimensions} -> Maybe [Dimension]
dimensions) (\s :: PutMetricAlarm
s@PutMetricAlarm' {} Maybe [Dimension]
a -> PutMetricAlarm
s {$sel:dimensions:PutMetricAlarm' :: Maybe [Dimension]
dimensions = Maybe [Dimension]
a} :: PutMetricAlarm) 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

-- | Used only for alarms based on percentiles. If you specify @ignore@, the
-- alarm state does not change during periods with too few data points to
-- be statistically significant. If you specify @evaluate@ or omit this
-- parameter, the alarm is always evaluated and possibly changes state no
-- matter how many data points are available. For more information, see
-- <https://docs.aws.amazon.com/AmazonCloudWatch/latest/monitoring/AlarmThatSendsEmail.html#percentiles-with-low-samples Percentile-Based CloudWatch Alarms and Low Data Samples>.
--
-- Valid Values: @evaluate | ignore@
putMetricAlarm_evaluateLowSampleCountPercentile :: Lens.Lens' PutMetricAlarm (Prelude.Maybe Prelude.Text)
putMetricAlarm_evaluateLowSampleCountPercentile :: Lens' PutMetricAlarm (Maybe Text)
putMetricAlarm_evaluateLowSampleCountPercentile = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutMetricAlarm' {Maybe Text
evaluateLowSampleCountPercentile :: Maybe Text
$sel:evaluateLowSampleCountPercentile:PutMetricAlarm' :: PutMetricAlarm -> Maybe Text
evaluateLowSampleCountPercentile} -> Maybe Text
evaluateLowSampleCountPercentile) (\s :: PutMetricAlarm
s@PutMetricAlarm' {} Maybe Text
a -> PutMetricAlarm
s {$sel:evaluateLowSampleCountPercentile:PutMetricAlarm' :: Maybe Text
evaluateLowSampleCountPercentile = Maybe Text
a} :: PutMetricAlarm)

-- | The percentile statistic for the metric specified in @MetricName@.
-- Specify a value between p0.0 and p100. When you call @PutMetricAlarm@
-- and specify a @MetricName@, you must specify either @Statistic@ or
-- @ExtendedStatistic,@ but not both.
putMetricAlarm_extendedStatistic :: Lens.Lens' PutMetricAlarm (Prelude.Maybe Prelude.Text)
putMetricAlarm_extendedStatistic :: Lens' PutMetricAlarm (Maybe Text)
putMetricAlarm_extendedStatistic = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutMetricAlarm' {Maybe Text
extendedStatistic :: Maybe Text
$sel:extendedStatistic:PutMetricAlarm' :: PutMetricAlarm -> Maybe Text
extendedStatistic} -> Maybe Text
extendedStatistic) (\s :: PutMetricAlarm
s@PutMetricAlarm' {} Maybe Text
a -> PutMetricAlarm
s {$sel:extendedStatistic:PutMetricAlarm' :: Maybe Text
extendedStatistic = Maybe Text
a} :: PutMetricAlarm)

-- | The actions to execute when this alarm transitions to the
-- @INSUFFICIENT_DATA@ state from any other state. Each action is specified
-- as an Amazon Resource Name (ARN).
--
-- Valid Values: @arn:aws:automate:@/@region@/@:ec2:stop@ |
-- @arn:aws:automate:@/@region@/@:ec2:terminate@ |
-- @arn:aws:automate:@/@region@/@:ec2:recover@ |
-- @arn:aws:automate:@/@region@/@:ec2:reboot@ |
-- @arn:aws:sns:@/@region@/@:@/@account-id@/@:@/@sns-topic-name@/@ @ |
-- @arn:aws:autoscaling:@/@region@/@:@/@account-id@/@:scalingPolicy:@/@policy-id@/@:autoScalingGroupName\/@/@group-friendly-name@/@:policyName\/@/@policy-friendly-name@/@ @
--
-- Valid Values (for use with IAM roles):
-- @>arn:aws:swf:@/@region@/@:@/@account-id@/@:action\/actions\/AWS_EC2.InstanceId.Stop\/1.0@
-- |
-- @arn:aws:swf:@/@region@/@:@/@account-id@/@:action\/actions\/AWS_EC2.InstanceId.Terminate\/1.0@
-- |
-- @arn:aws:swf:@/@region@/@:@/@account-id@/@:action\/actions\/AWS_EC2.InstanceId.Reboot\/1.0@
putMetricAlarm_insufficientDataActions :: Lens.Lens' PutMetricAlarm (Prelude.Maybe [Prelude.Text])
putMetricAlarm_insufficientDataActions :: Lens' PutMetricAlarm (Maybe [Text])
putMetricAlarm_insufficientDataActions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutMetricAlarm' {Maybe [Text]
insufficientDataActions :: Maybe [Text]
$sel:insufficientDataActions:PutMetricAlarm' :: PutMetricAlarm -> Maybe [Text]
insufficientDataActions} -> Maybe [Text]
insufficientDataActions) (\s :: PutMetricAlarm
s@PutMetricAlarm' {} Maybe [Text]
a -> PutMetricAlarm
s {$sel:insufficientDataActions:PutMetricAlarm' :: Maybe [Text]
insufficientDataActions = Maybe [Text]
a} :: PutMetricAlarm) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | The name for the metric associated with the alarm. For each
-- @PutMetricAlarm@ operation, you must specify either @MetricName@ or a
-- @Metrics@ array.
--
-- If you are creating an alarm based on a math expression, you cannot
-- specify this parameter, or any of the @Dimensions@, @Period@,
-- @Namespace@, @Statistic@, or @ExtendedStatistic@ parameters. Instead,
-- you specify all this information in the @Metrics@ array.
putMetricAlarm_metricName :: Lens.Lens' PutMetricAlarm (Prelude.Maybe Prelude.Text)
putMetricAlarm_metricName :: Lens' PutMetricAlarm (Maybe Text)
putMetricAlarm_metricName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutMetricAlarm' {Maybe Text
metricName :: Maybe Text
$sel:metricName:PutMetricAlarm' :: PutMetricAlarm -> Maybe Text
metricName} -> Maybe Text
metricName) (\s :: PutMetricAlarm
s@PutMetricAlarm' {} Maybe Text
a -> PutMetricAlarm
s {$sel:metricName:PutMetricAlarm' :: Maybe Text
metricName = Maybe Text
a} :: PutMetricAlarm)

-- | An array of @MetricDataQuery@ structures that enable you to create an
-- alarm based on the result of a metric math expression. For each
-- @PutMetricAlarm@ operation, you must specify either @MetricName@ or a
-- @Metrics@ array.
--
-- Each item in the @Metrics@ array either retrieves a metric or performs a
-- math expression.
--
-- One item in the @Metrics@ array is the expression that the alarm
-- watches. You designate this expression by setting @ReturnData@ to true
-- for this object in the array. For more information, see
-- <https://docs.aws.amazon.com/AmazonCloudWatch/latest/APIReference/API_MetricDataQuery.html MetricDataQuery>.
--
-- If you use the @Metrics@ parameter, you cannot include the @MetricName@,
-- @Dimensions@, @Period@, @Namespace@, @Statistic@, or @ExtendedStatistic@
-- parameters of @PutMetricAlarm@ in the same operation. Instead, you
-- retrieve the metrics you are using in your math expression as part of
-- the @Metrics@ array.
putMetricAlarm_metrics :: Lens.Lens' PutMetricAlarm (Prelude.Maybe [MetricDataQuery])
putMetricAlarm_metrics :: Lens' PutMetricAlarm (Maybe [MetricDataQuery])
putMetricAlarm_metrics = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutMetricAlarm' {Maybe [MetricDataQuery]
metrics :: Maybe [MetricDataQuery]
$sel:metrics:PutMetricAlarm' :: PutMetricAlarm -> Maybe [MetricDataQuery]
metrics} -> Maybe [MetricDataQuery]
metrics) (\s :: PutMetricAlarm
s@PutMetricAlarm' {} Maybe [MetricDataQuery]
a -> PutMetricAlarm
s {$sel:metrics:PutMetricAlarm' :: Maybe [MetricDataQuery]
metrics = Maybe [MetricDataQuery]
a} :: PutMetricAlarm) 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 namespace for the metric associated specified in @MetricName@.
putMetricAlarm_namespace :: Lens.Lens' PutMetricAlarm (Prelude.Maybe Prelude.Text)
putMetricAlarm_namespace :: Lens' PutMetricAlarm (Maybe Text)
putMetricAlarm_namespace = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutMetricAlarm' {Maybe Text
namespace :: Maybe Text
$sel:namespace:PutMetricAlarm' :: PutMetricAlarm -> Maybe Text
namespace} -> Maybe Text
namespace) (\s :: PutMetricAlarm
s@PutMetricAlarm' {} Maybe Text
a -> PutMetricAlarm
s {$sel:namespace:PutMetricAlarm' :: Maybe Text
namespace = Maybe Text
a} :: PutMetricAlarm)

-- | The actions to execute when this alarm transitions to an @OK@ state from
-- any other state. Each action is specified as an Amazon Resource Name
-- (ARN).
--
-- Valid Values: @arn:aws:automate:@/@region@/@:ec2:stop@ |
-- @arn:aws:automate:@/@region@/@:ec2:terminate@ |
-- @arn:aws:automate:@/@region@/@:ec2:recover@ |
-- @arn:aws:automate:@/@region@/@:ec2:reboot@ |
-- @arn:aws:sns:@/@region@/@:@/@account-id@/@:@/@sns-topic-name@/@ @ |
-- @arn:aws:autoscaling:@/@region@/@:@/@account-id@/@:scalingPolicy:@/@policy-id@/@:autoScalingGroupName\/@/@group-friendly-name@/@:policyName\/@/@policy-friendly-name@/@ @
--
-- Valid Values (for use with IAM roles):
-- @arn:aws:swf:@/@region@/@:@/@account-id@/@:action\/actions\/AWS_EC2.InstanceId.Stop\/1.0@
-- |
-- @arn:aws:swf:@/@region@/@:@/@account-id@/@:action\/actions\/AWS_EC2.InstanceId.Terminate\/1.0@
-- |
-- @arn:aws:swf:@/@region@/@:@/@account-id@/@:action\/actions\/AWS_EC2.InstanceId.Reboot\/1.0@
-- |
-- @arn:aws:swf:@/@region@/@:@/@account-id@/@:action\/actions\/AWS_EC2.InstanceId.Recover\/1.0@
putMetricAlarm_oKActions :: Lens.Lens' PutMetricAlarm (Prelude.Maybe [Prelude.Text])
putMetricAlarm_oKActions :: Lens' PutMetricAlarm (Maybe [Text])
putMetricAlarm_oKActions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutMetricAlarm' {Maybe [Text]
oKActions :: Maybe [Text]
$sel:oKActions:PutMetricAlarm' :: PutMetricAlarm -> Maybe [Text]
oKActions} -> Maybe [Text]
oKActions) (\s :: PutMetricAlarm
s@PutMetricAlarm' {} Maybe [Text]
a -> PutMetricAlarm
s {$sel:oKActions:PutMetricAlarm' :: Maybe [Text]
oKActions = Maybe [Text]
a} :: PutMetricAlarm) 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 length, in seconds, used each time the metric specified in
-- @MetricName@ is evaluated. Valid values are 10, 30, and any multiple of
-- 60.
--
-- @Period@ is required for alarms based on static thresholds. If you are
-- creating an alarm based on a metric math expression, you specify the
-- period for each metric within the objects in the @Metrics@ array.
--
-- Be sure to specify 10 or 30 only for metrics that are stored by a
-- @PutMetricData@ call with a @StorageResolution@ of 1. If you specify a
-- period of 10 or 30 for a metric that does not have sub-minute
-- resolution, the alarm still attempts to gather data at the period rate
-- that you specify. In this case, it does not receive data for the
-- attempts that do not correspond to a one-minute data resolution, and the
-- alarm might often lapse into INSUFFICENT_DATA status. Specifying 10 or
-- 30 also sets this alarm as a high-resolution alarm, which has a higher
-- charge than other alarms. For more information about pricing, see
-- <https://aws.amazon.com/cloudwatch/pricing/ Amazon CloudWatch Pricing>.
--
-- An alarm\'s total current evaluation period can be no longer than one
-- day, so @Period@ multiplied by @EvaluationPeriods@ cannot be more than
-- 86,400 seconds.
putMetricAlarm_period :: Lens.Lens' PutMetricAlarm (Prelude.Maybe Prelude.Natural)
putMetricAlarm_period :: Lens' PutMetricAlarm (Maybe Natural)
putMetricAlarm_period = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutMetricAlarm' {Maybe Natural
period :: Maybe Natural
$sel:period:PutMetricAlarm' :: PutMetricAlarm -> Maybe Natural
period} -> Maybe Natural
period) (\s :: PutMetricAlarm
s@PutMetricAlarm' {} Maybe Natural
a -> PutMetricAlarm
s {$sel:period:PutMetricAlarm' :: Maybe Natural
period = Maybe Natural
a} :: PutMetricAlarm)

-- | The statistic for the metric specified in @MetricName@, other than
-- percentile. For percentile statistics, use @ExtendedStatistic@. When you
-- call @PutMetricAlarm@ and specify a @MetricName@, you must specify
-- either @Statistic@ or @ExtendedStatistic,@ but not both.
putMetricAlarm_statistic :: Lens.Lens' PutMetricAlarm (Prelude.Maybe Statistic)
putMetricAlarm_statistic :: Lens' PutMetricAlarm (Maybe Statistic)
putMetricAlarm_statistic = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutMetricAlarm' {Maybe Statistic
statistic :: Maybe Statistic
$sel:statistic:PutMetricAlarm' :: PutMetricAlarm -> Maybe Statistic
statistic} -> Maybe Statistic
statistic) (\s :: PutMetricAlarm
s@PutMetricAlarm' {} Maybe Statistic
a -> PutMetricAlarm
s {$sel:statistic:PutMetricAlarm' :: Maybe Statistic
statistic = Maybe Statistic
a} :: PutMetricAlarm)

-- | A list of key-value pairs to associate with the alarm. You can associate
-- as many as 50 tags with an alarm.
--
-- Tags can help you organize and categorize your resources. You can also
-- use them to scope user permissions by granting a user permission to
-- access or change only resources with certain tag values.
--
-- If you are using this operation to update an existing alarm, any tags
-- you specify in this parameter are ignored. To change the tags of an
-- existing alarm, use
-- <https://docs.aws.amazon.com/AmazonCloudWatch/latest/APIReference/API_TagResource.html TagResource>
-- or
-- <https://docs.aws.amazon.com/AmazonCloudWatch/latest/APIReference/API_UntagResource.html UntagResource>.
putMetricAlarm_tags :: Lens.Lens' PutMetricAlarm (Prelude.Maybe [Tag])
putMetricAlarm_tags :: Lens' PutMetricAlarm (Maybe [Tag])
putMetricAlarm_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutMetricAlarm' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:PutMetricAlarm' :: PutMetricAlarm -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: PutMetricAlarm
s@PutMetricAlarm' {} Maybe [Tag]
a -> PutMetricAlarm
s {$sel:tags:PutMetricAlarm' :: Maybe [Tag]
tags = Maybe [Tag]
a} :: PutMetricAlarm) 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 value against which the specified statistic is compared.
--
-- This parameter is required for alarms based on static thresholds, but
-- should not be used for alarms based on anomaly detection models.
putMetricAlarm_threshold :: Lens.Lens' PutMetricAlarm (Prelude.Maybe Prelude.Double)
putMetricAlarm_threshold :: Lens' PutMetricAlarm (Maybe Double)
putMetricAlarm_threshold = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutMetricAlarm' {Maybe Double
threshold :: Maybe Double
$sel:threshold:PutMetricAlarm' :: PutMetricAlarm -> Maybe Double
threshold} -> Maybe Double
threshold) (\s :: PutMetricAlarm
s@PutMetricAlarm' {} Maybe Double
a -> PutMetricAlarm
s {$sel:threshold:PutMetricAlarm' :: Maybe Double
threshold = Maybe Double
a} :: PutMetricAlarm)

-- | If this is an alarm based on an anomaly detection model, make this value
-- match the ID of the @ANOMALY_DETECTION_BAND@ function.
--
-- For an example of how to use this parameter, see the __Anomaly Detection
-- Model Alarm__ example on this page.
--
-- If your alarm uses this parameter, it cannot have Auto Scaling actions.
putMetricAlarm_thresholdMetricId :: Lens.Lens' PutMetricAlarm (Prelude.Maybe Prelude.Text)
putMetricAlarm_thresholdMetricId :: Lens' PutMetricAlarm (Maybe Text)
putMetricAlarm_thresholdMetricId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutMetricAlarm' {Maybe Text
thresholdMetricId :: Maybe Text
$sel:thresholdMetricId:PutMetricAlarm' :: PutMetricAlarm -> Maybe Text
thresholdMetricId} -> Maybe Text
thresholdMetricId) (\s :: PutMetricAlarm
s@PutMetricAlarm' {} Maybe Text
a -> PutMetricAlarm
s {$sel:thresholdMetricId:PutMetricAlarm' :: Maybe Text
thresholdMetricId = Maybe Text
a} :: PutMetricAlarm)

-- | Sets how this alarm is to handle missing data points. If
-- @TreatMissingData@ is omitted, the default behavior of @missing@ is
-- used. For more information, see
-- <https://docs.aws.amazon.com/AmazonCloudWatch/latest/monitoring/AlarmThatSendsEmail.html#alarms-and-missing-data Configuring How CloudWatch Alarms Treats Missing Data>.
--
-- Valid Values: @breaching | notBreaching | ignore | missing@
--
-- Alarms that evaluate metrics in the @AWS\/DynamoDB@ namespace always
-- @ignore@ missing data even if you choose a different option for
-- @TreatMissingData@. When an @AWS\/DynamoDB@ metric has missing data,
-- alarms that evaluate that metric remain in their current state.
putMetricAlarm_treatMissingData :: Lens.Lens' PutMetricAlarm (Prelude.Maybe Prelude.Text)
putMetricAlarm_treatMissingData :: Lens' PutMetricAlarm (Maybe Text)
putMetricAlarm_treatMissingData = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutMetricAlarm' {Maybe Text
treatMissingData :: Maybe Text
$sel:treatMissingData:PutMetricAlarm' :: PutMetricAlarm -> Maybe Text
treatMissingData} -> Maybe Text
treatMissingData) (\s :: PutMetricAlarm
s@PutMetricAlarm' {} Maybe Text
a -> PutMetricAlarm
s {$sel:treatMissingData:PutMetricAlarm' :: Maybe Text
treatMissingData = Maybe Text
a} :: PutMetricAlarm)

-- | The unit of measure for the statistic. For example, the units for the
-- Amazon EC2 NetworkIn metric are Bytes because NetworkIn tracks the
-- number of bytes that an instance receives on all network interfaces. You
-- can also specify a unit when you create a custom metric. Units help
-- provide conceptual meaning to your data. Metric data points that specify
-- a unit of measure, such as Percent, are aggregated separately.
--
-- If you don\'t specify @Unit@, CloudWatch retrieves all unit types that
-- have been published for the metric and attempts to evaluate the alarm.
-- Usually, metrics are published with only one unit, so the alarm works as
-- intended.
--
-- However, if the metric is published with multiple types of units and you
-- don\'t specify a unit, the alarm\'s behavior is not defined and it
-- behaves unpredictably.
--
-- We recommend omitting @Unit@ so that you don\'t inadvertently specify an
-- incorrect unit that is not published for this metric. Doing so causes
-- the alarm to be stuck in the @INSUFFICIENT DATA@ state.
putMetricAlarm_unit :: Lens.Lens' PutMetricAlarm (Prelude.Maybe StandardUnit)
putMetricAlarm_unit :: Lens' PutMetricAlarm (Maybe StandardUnit)
putMetricAlarm_unit = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutMetricAlarm' {Maybe StandardUnit
unit :: Maybe StandardUnit
$sel:unit:PutMetricAlarm' :: PutMetricAlarm -> Maybe StandardUnit
unit} -> Maybe StandardUnit
unit) (\s :: PutMetricAlarm
s@PutMetricAlarm' {} Maybe StandardUnit
a -> PutMetricAlarm
s {$sel:unit:PutMetricAlarm' :: Maybe StandardUnit
unit = Maybe StandardUnit
a} :: PutMetricAlarm)

-- | The name for the alarm. This name must be unique within the Region.
putMetricAlarm_alarmName :: Lens.Lens' PutMetricAlarm Prelude.Text
putMetricAlarm_alarmName :: Lens' PutMetricAlarm Text
putMetricAlarm_alarmName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutMetricAlarm' {Text
alarmName :: Text
$sel:alarmName:PutMetricAlarm' :: PutMetricAlarm -> Text
alarmName} -> Text
alarmName) (\s :: PutMetricAlarm
s@PutMetricAlarm' {} Text
a -> PutMetricAlarm
s {$sel:alarmName:PutMetricAlarm' :: Text
alarmName = Text
a} :: PutMetricAlarm)

-- | The number of periods over which data is compared to the specified
-- threshold. If you are setting an alarm that requires that a number of
-- consecutive data points be breaching to trigger the alarm, this value
-- specifies that number. If you are setting an \"M out of N\" alarm, this
-- value is the N.
--
-- An alarm\'s total current evaluation period can be no longer than one
-- day, so this number multiplied by @Period@ cannot be more than 86,400
-- seconds.
putMetricAlarm_evaluationPeriods :: Lens.Lens' PutMetricAlarm Prelude.Natural
putMetricAlarm_evaluationPeriods :: Lens' PutMetricAlarm Natural
putMetricAlarm_evaluationPeriods = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutMetricAlarm' {Natural
evaluationPeriods :: Natural
$sel:evaluationPeriods:PutMetricAlarm' :: PutMetricAlarm -> Natural
evaluationPeriods} -> Natural
evaluationPeriods) (\s :: PutMetricAlarm
s@PutMetricAlarm' {} Natural
a -> PutMetricAlarm
s {$sel:evaluationPeriods:PutMetricAlarm' :: Natural
evaluationPeriods = Natural
a} :: PutMetricAlarm)

-- | The arithmetic operation to use when comparing the specified statistic
-- and threshold. The specified statistic value is used as the first
-- operand.
--
-- The values @LessThanLowerOrGreaterThanUpperThreshold@,
-- @LessThanLowerThreshold@, and @GreaterThanUpperThreshold@ are used only
-- for alarms based on anomaly detection models.
putMetricAlarm_comparisonOperator :: Lens.Lens' PutMetricAlarm ComparisonOperator
putMetricAlarm_comparisonOperator :: Lens' PutMetricAlarm ComparisonOperator
putMetricAlarm_comparisonOperator = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutMetricAlarm' {ComparisonOperator
comparisonOperator :: ComparisonOperator
$sel:comparisonOperator:PutMetricAlarm' :: PutMetricAlarm -> ComparisonOperator
comparisonOperator} -> ComparisonOperator
comparisonOperator) (\s :: PutMetricAlarm
s@PutMetricAlarm' {} ComparisonOperator
a -> PutMetricAlarm
s {$sel:comparisonOperator:PutMetricAlarm' :: ComparisonOperator
comparisonOperator = ComparisonOperator
a} :: PutMetricAlarm)

instance Core.AWSRequest PutMetricAlarm where
  type
    AWSResponse PutMetricAlarm =
      PutMetricAlarmResponse
  request :: (Service -> Service) -> PutMetricAlarm -> Request PutMetricAlarm
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 PutMetricAlarm
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse PutMetricAlarm)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
AWSResponse a
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveNull PutMetricAlarmResponse
PutMetricAlarmResponse'

instance Prelude.Hashable PutMetricAlarm where
  hashWithSalt :: Int -> PutMetricAlarm -> Int
hashWithSalt Int
_salt PutMetricAlarm' {Natural
Maybe Bool
Maybe Double
Maybe Natural
Maybe [Text]
Maybe [Dimension]
Maybe [MetricDataQuery]
Maybe [Tag]
Maybe Text
Maybe StandardUnit
Maybe Statistic
Text
ComparisonOperator
comparisonOperator :: ComparisonOperator
evaluationPeriods :: Natural
alarmName :: Text
unit :: Maybe StandardUnit
treatMissingData :: Maybe Text
thresholdMetricId :: Maybe Text
threshold :: Maybe Double
tags :: Maybe [Tag]
statistic :: Maybe Statistic
period :: Maybe Natural
oKActions :: Maybe [Text]
namespace :: Maybe Text
metrics :: Maybe [MetricDataQuery]
metricName :: Maybe Text
insufficientDataActions :: Maybe [Text]
extendedStatistic :: Maybe Text
evaluateLowSampleCountPercentile :: Maybe Text
dimensions :: Maybe [Dimension]
datapointsToAlarm :: Maybe Natural
alarmDescription :: Maybe Text
alarmActions :: Maybe [Text]
actionsEnabled :: Maybe Bool
$sel:comparisonOperator:PutMetricAlarm' :: PutMetricAlarm -> ComparisonOperator
$sel:evaluationPeriods:PutMetricAlarm' :: PutMetricAlarm -> Natural
$sel:alarmName:PutMetricAlarm' :: PutMetricAlarm -> Text
$sel:unit:PutMetricAlarm' :: PutMetricAlarm -> Maybe StandardUnit
$sel:treatMissingData:PutMetricAlarm' :: PutMetricAlarm -> Maybe Text
$sel:thresholdMetricId:PutMetricAlarm' :: PutMetricAlarm -> Maybe Text
$sel:threshold:PutMetricAlarm' :: PutMetricAlarm -> Maybe Double
$sel:tags:PutMetricAlarm' :: PutMetricAlarm -> Maybe [Tag]
$sel:statistic:PutMetricAlarm' :: PutMetricAlarm -> Maybe Statistic
$sel:period:PutMetricAlarm' :: PutMetricAlarm -> Maybe Natural
$sel:oKActions:PutMetricAlarm' :: PutMetricAlarm -> Maybe [Text]
$sel:namespace:PutMetricAlarm' :: PutMetricAlarm -> Maybe Text
$sel:metrics:PutMetricAlarm' :: PutMetricAlarm -> Maybe [MetricDataQuery]
$sel:metricName:PutMetricAlarm' :: PutMetricAlarm -> Maybe Text
$sel:insufficientDataActions:PutMetricAlarm' :: PutMetricAlarm -> Maybe [Text]
$sel:extendedStatistic:PutMetricAlarm' :: PutMetricAlarm -> Maybe Text
$sel:evaluateLowSampleCountPercentile:PutMetricAlarm' :: PutMetricAlarm -> Maybe Text
$sel:dimensions:PutMetricAlarm' :: PutMetricAlarm -> Maybe [Dimension]
$sel:datapointsToAlarm:PutMetricAlarm' :: PutMetricAlarm -> Maybe Natural
$sel:alarmDescription:PutMetricAlarm' :: PutMetricAlarm -> Maybe Text
$sel:alarmActions:PutMetricAlarm' :: PutMetricAlarm -> Maybe [Text]
$sel:actionsEnabled:PutMetricAlarm' :: PutMetricAlarm -> Maybe Bool
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
actionsEnabled
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
alarmActions
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
alarmDescription
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
datapointsToAlarm
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Dimension]
dimensions
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
evaluateLowSampleCountPercentile
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
extendedStatistic
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
insufficientDataActions
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
metricName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [MetricDataQuery]
metrics
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
namespace
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
oKActions
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
period
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Statistic
statistic
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Tag]
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Double
threshold
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
thresholdMetricId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
treatMissingData
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe StandardUnit
unit
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
alarmName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Natural
evaluationPeriods
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` ComparisonOperator
comparisonOperator

instance Prelude.NFData PutMetricAlarm where
  rnf :: PutMetricAlarm -> ()
rnf PutMetricAlarm' {Natural
Maybe Bool
Maybe Double
Maybe Natural
Maybe [Text]
Maybe [Dimension]
Maybe [MetricDataQuery]
Maybe [Tag]
Maybe Text
Maybe StandardUnit
Maybe Statistic
Text
ComparisonOperator
comparisonOperator :: ComparisonOperator
evaluationPeriods :: Natural
alarmName :: Text
unit :: Maybe StandardUnit
treatMissingData :: Maybe Text
thresholdMetricId :: Maybe Text
threshold :: Maybe Double
tags :: Maybe [Tag]
statistic :: Maybe Statistic
period :: Maybe Natural
oKActions :: Maybe [Text]
namespace :: Maybe Text
metrics :: Maybe [MetricDataQuery]
metricName :: Maybe Text
insufficientDataActions :: Maybe [Text]
extendedStatistic :: Maybe Text
evaluateLowSampleCountPercentile :: Maybe Text
dimensions :: Maybe [Dimension]
datapointsToAlarm :: Maybe Natural
alarmDescription :: Maybe Text
alarmActions :: Maybe [Text]
actionsEnabled :: Maybe Bool
$sel:comparisonOperator:PutMetricAlarm' :: PutMetricAlarm -> ComparisonOperator
$sel:evaluationPeriods:PutMetricAlarm' :: PutMetricAlarm -> Natural
$sel:alarmName:PutMetricAlarm' :: PutMetricAlarm -> Text
$sel:unit:PutMetricAlarm' :: PutMetricAlarm -> Maybe StandardUnit
$sel:treatMissingData:PutMetricAlarm' :: PutMetricAlarm -> Maybe Text
$sel:thresholdMetricId:PutMetricAlarm' :: PutMetricAlarm -> Maybe Text
$sel:threshold:PutMetricAlarm' :: PutMetricAlarm -> Maybe Double
$sel:tags:PutMetricAlarm' :: PutMetricAlarm -> Maybe [Tag]
$sel:statistic:PutMetricAlarm' :: PutMetricAlarm -> Maybe Statistic
$sel:period:PutMetricAlarm' :: PutMetricAlarm -> Maybe Natural
$sel:oKActions:PutMetricAlarm' :: PutMetricAlarm -> Maybe [Text]
$sel:namespace:PutMetricAlarm' :: PutMetricAlarm -> Maybe Text
$sel:metrics:PutMetricAlarm' :: PutMetricAlarm -> Maybe [MetricDataQuery]
$sel:metricName:PutMetricAlarm' :: PutMetricAlarm -> Maybe Text
$sel:insufficientDataActions:PutMetricAlarm' :: PutMetricAlarm -> Maybe [Text]
$sel:extendedStatistic:PutMetricAlarm' :: PutMetricAlarm -> Maybe Text
$sel:evaluateLowSampleCountPercentile:PutMetricAlarm' :: PutMetricAlarm -> Maybe Text
$sel:dimensions:PutMetricAlarm' :: PutMetricAlarm -> Maybe [Dimension]
$sel:datapointsToAlarm:PutMetricAlarm' :: PutMetricAlarm -> Maybe Natural
$sel:alarmDescription:PutMetricAlarm' :: PutMetricAlarm -> Maybe Text
$sel:alarmActions:PutMetricAlarm' :: PutMetricAlarm -> Maybe [Text]
$sel:actionsEnabled:PutMetricAlarm' :: PutMetricAlarm -> Maybe Bool
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
actionsEnabled
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
alarmActions
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
alarmDescription
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
datapointsToAlarm
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Dimension]
dimensions
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
evaluateLowSampleCountPercentile
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
extendedStatistic
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
insufficientDataActions
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
metricName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [MetricDataQuery]
metrics
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
namespace
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
oKActions
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
period
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Statistic
statistic
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Tag]
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Double
threshold
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
thresholdMetricId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
treatMissingData
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe StandardUnit
unit
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
alarmName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        Natural
evaluationPeriods
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        ComparisonOperator
comparisonOperator

instance Data.ToHeaders PutMetricAlarm where
  toHeaders :: PutMetricAlarm -> [Header]
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

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

instance Data.ToQuery PutMetricAlarm where
  toQuery :: PutMetricAlarm -> QueryString
toQuery PutMetricAlarm' {Natural
Maybe Bool
Maybe Double
Maybe Natural
Maybe [Text]
Maybe [Dimension]
Maybe [MetricDataQuery]
Maybe [Tag]
Maybe Text
Maybe StandardUnit
Maybe Statistic
Text
ComparisonOperator
comparisonOperator :: ComparisonOperator
evaluationPeriods :: Natural
alarmName :: Text
unit :: Maybe StandardUnit
treatMissingData :: Maybe Text
thresholdMetricId :: Maybe Text
threshold :: Maybe Double
tags :: Maybe [Tag]
statistic :: Maybe Statistic
period :: Maybe Natural
oKActions :: Maybe [Text]
namespace :: Maybe Text
metrics :: Maybe [MetricDataQuery]
metricName :: Maybe Text
insufficientDataActions :: Maybe [Text]
extendedStatistic :: Maybe Text
evaluateLowSampleCountPercentile :: Maybe Text
dimensions :: Maybe [Dimension]
datapointsToAlarm :: Maybe Natural
alarmDescription :: Maybe Text
alarmActions :: Maybe [Text]
actionsEnabled :: Maybe Bool
$sel:comparisonOperator:PutMetricAlarm' :: PutMetricAlarm -> ComparisonOperator
$sel:evaluationPeriods:PutMetricAlarm' :: PutMetricAlarm -> Natural
$sel:alarmName:PutMetricAlarm' :: PutMetricAlarm -> Text
$sel:unit:PutMetricAlarm' :: PutMetricAlarm -> Maybe StandardUnit
$sel:treatMissingData:PutMetricAlarm' :: PutMetricAlarm -> Maybe Text
$sel:thresholdMetricId:PutMetricAlarm' :: PutMetricAlarm -> Maybe Text
$sel:threshold:PutMetricAlarm' :: PutMetricAlarm -> Maybe Double
$sel:tags:PutMetricAlarm' :: PutMetricAlarm -> Maybe [Tag]
$sel:statistic:PutMetricAlarm' :: PutMetricAlarm -> Maybe Statistic
$sel:period:PutMetricAlarm' :: PutMetricAlarm -> Maybe Natural
$sel:oKActions:PutMetricAlarm' :: PutMetricAlarm -> Maybe [Text]
$sel:namespace:PutMetricAlarm' :: PutMetricAlarm -> Maybe Text
$sel:metrics:PutMetricAlarm' :: PutMetricAlarm -> Maybe [MetricDataQuery]
$sel:metricName:PutMetricAlarm' :: PutMetricAlarm -> Maybe Text
$sel:insufficientDataActions:PutMetricAlarm' :: PutMetricAlarm -> Maybe [Text]
$sel:extendedStatistic:PutMetricAlarm' :: PutMetricAlarm -> Maybe Text
$sel:evaluateLowSampleCountPercentile:PutMetricAlarm' :: PutMetricAlarm -> Maybe Text
$sel:dimensions:PutMetricAlarm' :: PutMetricAlarm -> Maybe [Dimension]
$sel:datapointsToAlarm:PutMetricAlarm' :: PutMetricAlarm -> Maybe Natural
$sel:alarmDescription:PutMetricAlarm' :: PutMetricAlarm -> Maybe Text
$sel:alarmActions:PutMetricAlarm' :: PutMetricAlarm -> Maybe [Text]
$sel:actionsEnabled:PutMetricAlarm' :: PutMetricAlarm -> Maybe Bool
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"PutMetricAlarm" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2010-08-01" :: Prelude.ByteString),
        ByteString
"ActionsEnabled" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
actionsEnabled,
        ByteString
"AlarmActions"
          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 [Text]
alarmActions),
        ByteString
"AlarmDescription" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
alarmDescription,
        ByteString
"DatapointsToAlarm" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Natural
datapointsToAlarm,
        ByteString
"Dimensions"
          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 [Dimension]
dimensions),
        ByteString
"EvaluateLowSampleCountPercentile"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
evaluateLowSampleCountPercentile,
        ByteString
"ExtendedStatistic" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
extendedStatistic,
        ByteString
"InsufficientDataActions"
          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 [Text]
insufficientDataActions
            ),
        ByteString
"MetricName" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
metricName,
        ByteString
"Metrics"
          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 [MetricDataQuery]
metrics),
        ByteString
"Namespace" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
namespace,
        ByteString
"OKActions"
          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 [Text]
oKActions),
        ByteString
"Period" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Natural
period,
        ByteString
"Statistic" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Statistic
statistic,
        ByteString
"Tags"
          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 [Tag]
tags),
        ByteString
"Threshold" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Double
threshold,
        ByteString
"ThresholdMetricId" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
thresholdMetricId,
        ByteString
"TreatMissingData" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
treatMissingData,
        ByteString
"Unit" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe StandardUnit
unit,
        ByteString
"AlarmName" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
alarmName,
        ByteString
"EvaluationPeriods" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Natural
evaluationPeriods,
        ByteString
"ComparisonOperator" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: ComparisonOperator
comparisonOperator
      ]

-- | /See:/ 'newPutMetricAlarmResponse' smart constructor.
data PutMetricAlarmResponse = PutMetricAlarmResponse'
  {
  }
  deriving (PutMetricAlarmResponse -> PutMetricAlarmResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PutMetricAlarmResponse -> PutMetricAlarmResponse -> Bool
$c/= :: PutMetricAlarmResponse -> PutMetricAlarmResponse -> Bool
== :: PutMetricAlarmResponse -> PutMetricAlarmResponse -> Bool
$c== :: PutMetricAlarmResponse -> PutMetricAlarmResponse -> Bool
Prelude.Eq, ReadPrec [PutMetricAlarmResponse]
ReadPrec PutMetricAlarmResponse
Int -> ReadS PutMetricAlarmResponse
ReadS [PutMetricAlarmResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PutMetricAlarmResponse]
$creadListPrec :: ReadPrec [PutMetricAlarmResponse]
readPrec :: ReadPrec PutMetricAlarmResponse
$creadPrec :: ReadPrec PutMetricAlarmResponse
readList :: ReadS [PutMetricAlarmResponse]
$creadList :: ReadS [PutMetricAlarmResponse]
readsPrec :: Int -> ReadS PutMetricAlarmResponse
$creadsPrec :: Int -> ReadS PutMetricAlarmResponse
Prelude.Read, Int -> PutMetricAlarmResponse -> ShowS
[PutMetricAlarmResponse] -> ShowS
PutMetricAlarmResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PutMetricAlarmResponse] -> ShowS
$cshowList :: [PutMetricAlarmResponse] -> ShowS
show :: PutMetricAlarmResponse -> String
$cshow :: PutMetricAlarmResponse -> String
showsPrec :: Int -> PutMetricAlarmResponse -> ShowS
$cshowsPrec :: Int -> PutMetricAlarmResponse -> ShowS
Prelude.Show, forall x. Rep PutMetricAlarmResponse x -> PutMetricAlarmResponse
forall x. PutMetricAlarmResponse -> Rep PutMetricAlarmResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PutMetricAlarmResponse x -> PutMetricAlarmResponse
$cfrom :: forall x. PutMetricAlarmResponse -> Rep PutMetricAlarmResponse x
Prelude.Generic)

-- |
-- Create a value of 'PutMetricAlarmResponse' 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.
newPutMetricAlarmResponse ::
  PutMetricAlarmResponse
newPutMetricAlarmResponse :: PutMetricAlarmResponse
newPutMetricAlarmResponse = PutMetricAlarmResponse
PutMetricAlarmResponse'

instance Prelude.NFData PutMetricAlarmResponse where
  rnf :: PutMetricAlarmResponse -> ()
rnf PutMetricAlarmResponse
_ = ()