{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
{-# OPTIONS_GHC -fno-warn-unused-matches #-}

-- Derived from AWS service descriptions, licensed under Apache 2.0.

-- |
-- Module      : Amazonka.Lightsail.Types.Alarm
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
module Amazonka.Lightsail.Types.Alarm where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.Lightsail.Types.AlarmState
import Amazonka.Lightsail.Types.ComparisonOperator
import Amazonka.Lightsail.Types.ContactProtocol
import Amazonka.Lightsail.Types.MetricName
import Amazonka.Lightsail.Types.MetricStatistic
import Amazonka.Lightsail.Types.MetricUnit
import Amazonka.Lightsail.Types.MonitoredResourceInfo
import Amazonka.Lightsail.Types.ResourceLocation
import Amazonka.Lightsail.Types.ResourceType
import Amazonka.Lightsail.Types.TreatMissingData
import qualified Amazonka.Prelude as Prelude

-- | Describes an alarm.
--
-- An alarm is a way to monitor your Lightsail resource metrics. For more
-- information, see
-- <https://lightsail.aws.amazon.com/ls/docs/en_us/articles/amazon-lightsail-alarms Alarms in Amazon Lightsail>.
--
-- /See:/ 'newAlarm' smart constructor.
data Alarm = Alarm'
  { -- | The Amazon Resource Name (ARN) of the alarm.
    Alarm -> Maybe Text
arn :: Prelude.Maybe Prelude.Text,
    -- | The arithmetic operation used when comparing the specified statistic and
    -- threshold.
    Alarm -> Maybe ComparisonOperator
comparisonOperator :: Prelude.Maybe ComparisonOperator,
    -- | The contact protocols for the alarm, such as @Email@, @SMS@ (text
    -- messaging), or both.
    Alarm -> Maybe [ContactProtocol]
contactProtocols :: Prelude.Maybe [ContactProtocol],
    -- | The timestamp when the alarm was created.
    Alarm -> Maybe POSIX
createdAt :: Prelude.Maybe Data.POSIX,
    -- | The number of data points that must not within the specified threshold
    -- to trigger the alarm.
    Alarm -> Maybe Int
datapointsToAlarm :: Prelude.Maybe Prelude.Int,
    -- | The number of periods over which data is compared to the specified
    -- threshold.
    Alarm -> Maybe Int
evaluationPeriods :: Prelude.Maybe Prelude.Int,
    -- | An object that lists information about the location of the alarm.
    Alarm -> Maybe ResourceLocation
location :: Prelude.Maybe ResourceLocation,
    -- | The name of the metric associated with the alarm.
    Alarm -> Maybe MetricName
metricName :: Prelude.Maybe MetricName,
    -- | An object that lists information about the resource monitored by the
    -- alarm.
    Alarm -> Maybe MonitoredResourceInfo
monitoredResourceInfo :: Prelude.Maybe MonitoredResourceInfo,
    -- | The name of the alarm.
    Alarm -> Maybe Text
name :: Prelude.Maybe Prelude.Text,
    -- | Indicates whether the alarm is enabled.
    Alarm -> Maybe Bool
notificationEnabled :: Prelude.Maybe Prelude.Bool,
    -- | The alarm states that trigger a notification.
    Alarm -> Maybe [AlarmState]
notificationTriggers :: Prelude.Maybe [AlarmState],
    -- | The period, in seconds, over which the statistic is applied.
    Alarm -> Maybe Natural
period :: Prelude.Maybe Prelude.Natural,
    -- | The Lightsail resource type (e.g., @Alarm@).
    Alarm -> Maybe ResourceType
resourceType :: Prelude.Maybe ResourceType,
    -- | The current state of the alarm.
    --
    -- An alarm has the following possible states:
    --
    -- -   @ALARM@ - The metric is outside of the defined threshold.
    --
    -- -   @INSUFFICIENT_DATA@ - The alarm has just started, the metric is not
    --     available, or not enough data is available for the metric to
    --     determine the alarm state.
    --
    -- -   @OK@ - The metric is within the defined threshold.
    Alarm -> Maybe AlarmState
state :: Prelude.Maybe AlarmState,
    -- | The statistic for the metric associated with the alarm.
    --
    -- The following statistics are available:
    --
    -- -   @Minimum@ - The lowest value observed during the specified period.
    --     Use this value to determine low volumes of activity for your
    --     application.
    --
    -- -   @Maximum@ - The highest value observed during the specified period.
    --     Use this value to determine high volumes of activity for your
    --     application.
    --
    -- -   @Sum@ - All values submitted for the matching metric added together.
    --     You can use this statistic to determine the total volume of a
    --     metric.
    --
    -- -   @Average@ - The value of Sum \/ SampleCount during the specified
    --     period. By comparing this statistic with the Minimum and Maximum
    --     values, you can determine the full scope of a metric and how close
    --     the average use is to the Minimum and Maximum values. This
    --     comparison helps you to know when to increase or decrease your
    --     resources.
    --
    -- -   @SampleCount@ - The count, or number, of data points used for the
    --     statistical calculation.
    Alarm -> Maybe MetricStatistic
statistic :: Prelude.Maybe MetricStatistic,
    -- | The support code. Include this code in your email to support when you
    -- have questions about your Lightsail alarm. This code enables our support
    -- team to look up your Lightsail information more easily.
    Alarm -> Maybe Text
supportCode :: Prelude.Maybe Prelude.Text,
    -- | The value against which the specified statistic is compared.
    Alarm -> Maybe Double
threshold :: Prelude.Maybe Prelude.Double,
    -- | Specifies how the alarm handles missing data points.
    --
    -- An alarm can treat missing data in the following ways:
    --
    -- -   @breaching@ - Assume the missing data is not within the threshold.
    --     Missing data counts towards the number of times the metric is not
    --     within the threshold.
    --
    -- -   @notBreaching@ - Assume the missing data is within the threshold.
    --     Missing data does not count towards the number of times the metric
    --     is not within the threshold.
    --
    -- -   @ignore@ - Ignore the missing data. Maintains the current alarm
    --     state.
    --
    -- -   @missing@ - Missing data is treated as missing.
    Alarm -> Maybe TreatMissingData
treatMissingData :: Prelude.Maybe TreatMissingData,
    -- | The unit of the metric associated with the alarm.
    Alarm -> Maybe MetricUnit
unit :: Prelude.Maybe MetricUnit
  }
  deriving (Alarm -> Alarm -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Alarm -> Alarm -> Bool
$c/= :: Alarm -> Alarm -> Bool
== :: Alarm -> Alarm -> Bool
$c== :: Alarm -> Alarm -> Bool
Prelude.Eq, ReadPrec [Alarm]
ReadPrec Alarm
Int -> ReadS Alarm
ReadS [Alarm]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Alarm]
$creadListPrec :: ReadPrec [Alarm]
readPrec :: ReadPrec Alarm
$creadPrec :: ReadPrec Alarm
readList :: ReadS [Alarm]
$creadList :: ReadS [Alarm]
readsPrec :: Int -> ReadS Alarm
$creadsPrec :: Int -> ReadS Alarm
Prelude.Read, Int -> Alarm -> ShowS
[Alarm] -> ShowS
Alarm -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Alarm] -> ShowS
$cshowList :: [Alarm] -> ShowS
show :: Alarm -> String
$cshow :: Alarm -> String
showsPrec :: Int -> Alarm -> ShowS
$cshowsPrec :: Int -> Alarm -> ShowS
Prelude.Show, forall x. Rep Alarm x -> Alarm
forall x. Alarm -> Rep Alarm x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Alarm x -> Alarm
$cfrom :: forall x. Alarm -> Rep Alarm x
Prelude.Generic)

-- |
-- Create a value of 'Alarm' 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:
--
-- 'arn', 'alarm_arn' - The Amazon Resource Name (ARN) of the alarm.
--
-- 'comparisonOperator', 'alarm_comparisonOperator' - The arithmetic operation used when comparing the specified statistic and
-- threshold.
--
-- 'contactProtocols', 'alarm_contactProtocols' - The contact protocols for the alarm, such as @Email@, @SMS@ (text
-- messaging), or both.
--
-- 'createdAt', 'alarm_createdAt' - The timestamp when the alarm was created.
--
-- 'datapointsToAlarm', 'alarm_datapointsToAlarm' - The number of data points that must not within the specified threshold
-- to trigger the alarm.
--
-- 'evaluationPeriods', 'alarm_evaluationPeriods' - The number of periods over which data is compared to the specified
-- threshold.
--
-- 'location', 'alarm_location' - An object that lists information about the location of the alarm.
--
-- 'metricName', 'alarm_metricName' - The name of the metric associated with the alarm.
--
-- 'monitoredResourceInfo', 'alarm_monitoredResourceInfo' - An object that lists information about the resource monitored by the
-- alarm.
--
-- 'name', 'alarm_name' - The name of the alarm.
--
-- 'notificationEnabled', 'alarm_notificationEnabled' - Indicates whether the alarm is enabled.
--
-- 'notificationTriggers', 'alarm_notificationTriggers' - The alarm states that trigger a notification.
--
-- 'period', 'alarm_period' - The period, in seconds, over which the statistic is applied.
--
-- 'resourceType', 'alarm_resourceType' - The Lightsail resource type (e.g., @Alarm@).
--
-- 'state', 'alarm_state' - The current state of the alarm.
--
-- An alarm has the following possible states:
--
-- -   @ALARM@ - The metric is outside of the defined threshold.
--
-- -   @INSUFFICIENT_DATA@ - The alarm has just started, the metric is not
--     available, or not enough data is available for the metric to
--     determine the alarm state.
--
-- -   @OK@ - The metric is within the defined threshold.
--
-- 'statistic', 'alarm_statistic' - The statistic for the metric associated with the alarm.
--
-- The following statistics are available:
--
-- -   @Minimum@ - The lowest value observed during the specified period.
--     Use this value to determine low volumes of activity for your
--     application.
--
-- -   @Maximum@ - The highest value observed during the specified period.
--     Use this value to determine high volumes of activity for your
--     application.
--
-- -   @Sum@ - All values submitted for the matching metric added together.
--     You can use this statistic to determine the total volume of a
--     metric.
--
-- -   @Average@ - The value of Sum \/ SampleCount during the specified
--     period. By comparing this statistic with the Minimum and Maximum
--     values, you can determine the full scope of a metric and how close
--     the average use is to the Minimum and Maximum values. This
--     comparison helps you to know when to increase or decrease your
--     resources.
--
-- -   @SampleCount@ - The count, or number, of data points used for the
--     statistical calculation.
--
-- 'supportCode', 'alarm_supportCode' - The support code. Include this code in your email to support when you
-- have questions about your Lightsail alarm. This code enables our support
-- team to look up your Lightsail information more easily.
--
-- 'threshold', 'alarm_threshold' - The value against which the specified statistic is compared.
--
-- 'treatMissingData', 'alarm_treatMissingData' - Specifies how the alarm handles missing data points.
--
-- An alarm can treat missing data in the following ways:
--
-- -   @breaching@ - Assume the missing data is not within the threshold.
--     Missing data counts towards the number of times the metric is not
--     within the threshold.
--
-- -   @notBreaching@ - Assume the missing data is within the threshold.
--     Missing data does not count towards the number of times the metric
--     is not within the threshold.
--
-- -   @ignore@ - Ignore the missing data. Maintains the current alarm
--     state.
--
-- -   @missing@ - Missing data is treated as missing.
--
-- 'unit', 'alarm_unit' - The unit of the metric associated with the alarm.
newAlarm ::
  Alarm
newAlarm :: Alarm
newAlarm =
  Alarm'
    { $sel:arn:Alarm' :: Maybe Text
arn = forall a. Maybe a
Prelude.Nothing,
      $sel:comparisonOperator:Alarm' :: Maybe ComparisonOperator
comparisonOperator = forall a. Maybe a
Prelude.Nothing,
      $sel:contactProtocols:Alarm' :: Maybe [ContactProtocol]
contactProtocols = forall a. Maybe a
Prelude.Nothing,
      $sel:createdAt:Alarm' :: Maybe POSIX
createdAt = forall a. Maybe a
Prelude.Nothing,
      $sel:datapointsToAlarm:Alarm' :: Maybe Int
datapointsToAlarm = forall a. Maybe a
Prelude.Nothing,
      $sel:evaluationPeriods:Alarm' :: Maybe Int
evaluationPeriods = forall a. Maybe a
Prelude.Nothing,
      $sel:location:Alarm' :: Maybe ResourceLocation
location = forall a. Maybe a
Prelude.Nothing,
      $sel:metricName:Alarm' :: Maybe MetricName
metricName = forall a. Maybe a
Prelude.Nothing,
      $sel:monitoredResourceInfo:Alarm' :: Maybe MonitoredResourceInfo
monitoredResourceInfo = forall a. Maybe a
Prelude.Nothing,
      $sel:name:Alarm' :: Maybe Text
name = forall a. Maybe a
Prelude.Nothing,
      $sel:notificationEnabled:Alarm' :: Maybe Bool
notificationEnabled = forall a. Maybe a
Prelude.Nothing,
      $sel:notificationTriggers:Alarm' :: Maybe [AlarmState]
notificationTriggers = forall a. Maybe a
Prelude.Nothing,
      $sel:period:Alarm' :: Maybe Natural
period = forall a. Maybe a
Prelude.Nothing,
      $sel:resourceType:Alarm' :: Maybe ResourceType
resourceType = forall a. Maybe a
Prelude.Nothing,
      $sel:state:Alarm' :: Maybe AlarmState
state = forall a. Maybe a
Prelude.Nothing,
      $sel:statistic:Alarm' :: Maybe MetricStatistic
statistic = forall a. Maybe a
Prelude.Nothing,
      $sel:supportCode:Alarm' :: Maybe Text
supportCode = forall a. Maybe a
Prelude.Nothing,
      $sel:threshold:Alarm' :: Maybe Double
threshold = forall a. Maybe a
Prelude.Nothing,
      $sel:treatMissingData:Alarm' :: Maybe TreatMissingData
treatMissingData = forall a. Maybe a
Prelude.Nothing,
      $sel:unit:Alarm' :: Maybe MetricUnit
unit = forall a. Maybe a
Prelude.Nothing
    }

-- | The Amazon Resource Name (ARN) of the alarm.
alarm_arn :: Lens.Lens' Alarm (Prelude.Maybe Prelude.Text)
alarm_arn :: Lens' Alarm (Maybe Text)
alarm_arn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Alarm' {Maybe Text
arn :: Maybe Text
$sel:arn:Alarm' :: Alarm -> Maybe Text
arn} -> Maybe Text
arn) (\s :: Alarm
s@Alarm' {} Maybe Text
a -> Alarm
s {$sel:arn:Alarm' :: Maybe Text
arn = Maybe Text
a} :: Alarm)

-- | The arithmetic operation used when comparing the specified statistic and
-- threshold.
alarm_comparisonOperator :: Lens.Lens' Alarm (Prelude.Maybe ComparisonOperator)
alarm_comparisonOperator :: Lens' Alarm (Maybe ComparisonOperator)
alarm_comparisonOperator = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Alarm' {Maybe ComparisonOperator
comparisonOperator :: Maybe ComparisonOperator
$sel:comparisonOperator:Alarm' :: Alarm -> Maybe ComparisonOperator
comparisonOperator} -> Maybe ComparisonOperator
comparisonOperator) (\s :: Alarm
s@Alarm' {} Maybe ComparisonOperator
a -> Alarm
s {$sel:comparisonOperator:Alarm' :: Maybe ComparisonOperator
comparisonOperator = Maybe ComparisonOperator
a} :: Alarm)

-- | The contact protocols for the alarm, such as @Email@, @SMS@ (text
-- messaging), or both.
alarm_contactProtocols :: Lens.Lens' Alarm (Prelude.Maybe [ContactProtocol])
alarm_contactProtocols :: Lens' Alarm (Maybe [ContactProtocol])
alarm_contactProtocols = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Alarm' {Maybe [ContactProtocol]
contactProtocols :: Maybe [ContactProtocol]
$sel:contactProtocols:Alarm' :: Alarm -> Maybe [ContactProtocol]
contactProtocols} -> Maybe [ContactProtocol]
contactProtocols) (\s :: Alarm
s@Alarm' {} Maybe [ContactProtocol]
a -> Alarm
s {$sel:contactProtocols:Alarm' :: Maybe [ContactProtocol]
contactProtocols = Maybe [ContactProtocol]
a} :: Alarm) 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 timestamp when the alarm was created.
alarm_createdAt :: Lens.Lens' Alarm (Prelude.Maybe Prelude.UTCTime)
alarm_createdAt :: Lens' Alarm (Maybe UTCTime)
alarm_createdAt = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Alarm' {Maybe POSIX
createdAt :: Maybe POSIX
$sel:createdAt:Alarm' :: Alarm -> Maybe POSIX
createdAt} -> Maybe POSIX
createdAt) (\s :: Alarm
s@Alarm' {} Maybe POSIX
a -> Alarm
s {$sel:createdAt:Alarm' :: Maybe POSIX
createdAt = Maybe POSIX
a} :: Alarm) 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 (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The number of data points that must not within the specified threshold
-- to trigger the alarm.
alarm_datapointsToAlarm :: Lens.Lens' Alarm (Prelude.Maybe Prelude.Int)
alarm_datapointsToAlarm :: Lens' Alarm (Maybe Int)
alarm_datapointsToAlarm = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Alarm' {Maybe Int
datapointsToAlarm :: Maybe Int
$sel:datapointsToAlarm:Alarm' :: Alarm -> Maybe Int
datapointsToAlarm} -> Maybe Int
datapointsToAlarm) (\s :: Alarm
s@Alarm' {} Maybe Int
a -> Alarm
s {$sel:datapointsToAlarm:Alarm' :: Maybe Int
datapointsToAlarm = Maybe Int
a} :: Alarm)

-- | The number of periods over which data is compared to the specified
-- threshold.
alarm_evaluationPeriods :: Lens.Lens' Alarm (Prelude.Maybe Prelude.Int)
alarm_evaluationPeriods :: Lens' Alarm (Maybe Int)
alarm_evaluationPeriods = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Alarm' {Maybe Int
evaluationPeriods :: Maybe Int
$sel:evaluationPeriods:Alarm' :: Alarm -> Maybe Int
evaluationPeriods} -> Maybe Int
evaluationPeriods) (\s :: Alarm
s@Alarm' {} Maybe Int
a -> Alarm
s {$sel:evaluationPeriods:Alarm' :: Maybe Int
evaluationPeriods = Maybe Int
a} :: Alarm)

-- | An object that lists information about the location of the alarm.
alarm_location :: Lens.Lens' Alarm (Prelude.Maybe ResourceLocation)
alarm_location :: Lens' Alarm (Maybe ResourceLocation)
alarm_location = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Alarm' {Maybe ResourceLocation
location :: Maybe ResourceLocation
$sel:location:Alarm' :: Alarm -> Maybe ResourceLocation
location} -> Maybe ResourceLocation
location) (\s :: Alarm
s@Alarm' {} Maybe ResourceLocation
a -> Alarm
s {$sel:location:Alarm' :: Maybe ResourceLocation
location = Maybe ResourceLocation
a} :: Alarm)

-- | The name of the metric associated with the alarm.
alarm_metricName :: Lens.Lens' Alarm (Prelude.Maybe MetricName)
alarm_metricName :: Lens' Alarm (Maybe MetricName)
alarm_metricName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Alarm' {Maybe MetricName
metricName :: Maybe MetricName
$sel:metricName:Alarm' :: Alarm -> Maybe MetricName
metricName} -> Maybe MetricName
metricName) (\s :: Alarm
s@Alarm' {} Maybe MetricName
a -> Alarm
s {$sel:metricName:Alarm' :: Maybe MetricName
metricName = Maybe MetricName
a} :: Alarm)

-- | An object that lists information about the resource monitored by the
-- alarm.
alarm_monitoredResourceInfo :: Lens.Lens' Alarm (Prelude.Maybe MonitoredResourceInfo)
alarm_monitoredResourceInfo :: Lens' Alarm (Maybe MonitoredResourceInfo)
alarm_monitoredResourceInfo = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Alarm' {Maybe MonitoredResourceInfo
monitoredResourceInfo :: Maybe MonitoredResourceInfo
$sel:monitoredResourceInfo:Alarm' :: Alarm -> Maybe MonitoredResourceInfo
monitoredResourceInfo} -> Maybe MonitoredResourceInfo
monitoredResourceInfo) (\s :: Alarm
s@Alarm' {} Maybe MonitoredResourceInfo
a -> Alarm
s {$sel:monitoredResourceInfo:Alarm' :: Maybe MonitoredResourceInfo
monitoredResourceInfo = Maybe MonitoredResourceInfo
a} :: Alarm)

-- | The name of the alarm.
alarm_name :: Lens.Lens' Alarm (Prelude.Maybe Prelude.Text)
alarm_name :: Lens' Alarm (Maybe Text)
alarm_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Alarm' {Maybe Text
name :: Maybe Text
$sel:name:Alarm' :: Alarm -> Maybe Text
name} -> Maybe Text
name) (\s :: Alarm
s@Alarm' {} Maybe Text
a -> Alarm
s {$sel:name:Alarm' :: Maybe Text
name = Maybe Text
a} :: Alarm)

-- | Indicates whether the alarm is enabled.
alarm_notificationEnabled :: Lens.Lens' Alarm (Prelude.Maybe Prelude.Bool)
alarm_notificationEnabled :: Lens' Alarm (Maybe Bool)
alarm_notificationEnabled = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Alarm' {Maybe Bool
notificationEnabled :: Maybe Bool
$sel:notificationEnabled:Alarm' :: Alarm -> Maybe Bool
notificationEnabled} -> Maybe Bool
notificationEnabled) (\s :: Alarm
s@Alarm' {} Maybe Bool
a -> Alarm
s {$sel:notificationEnabled:Alarm' :: Maybe Bool
notificationEnabled = Maybe Bool
a} :: Alarm)

-- | The alarm states that trigger a notification.
alarm_notificationTriggers :: Lens.Lens' Alarm (Prelude.Maybe [AlarmState])
alarm_notificationTriggers :: Lens' Alarm (Maybe [AlarmState])
alarm_notificationTriggers = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Alarm' {Maybe [AlarmState]
notificationTriggers :: Maybe [AlarmState]
$sel:notificationTriggers:Alarm' :: Alarm -> Maybe [AlarmState]
notificationTriggers} -> Maybe [AlarmState]
notificationTriggers) (\s :: Alarm
s@Alarm' {} Maybe [AlarmState]
a -> Alarm
s {$sel:notificationTriggers:Alarm' :: Maybe [AlarmState]
notificationTriggers = Maybe [AlarmState]
a} :: Alarm) 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 period, in seconds, over which the statistic is applied.
alarm_period :: Lens.Lens' Alarm (Prelude.Maybe Prelude.Natural)
alarm_period :: Lens' Alarm (Maybe Natural)
alarm_period = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Alarm' {Maybe Natural
period :: Maybe Natural
$sel:period:Alarm' :: Alarm -> Maybe Natural
period} -> Maybe Natural
period) (\s :: Alarm
s@Alarm' {} Maybe Natural
a -> Alarm
s {$sel:period:Alarm' :: Maybe Natural
period = Maybe Natural
a} :: Alarm)

-- | The Lightsail resource type (e.g., @Alarm@).
alarm_resourceType :: Lens.Lens' Alarm (Prelude.Maybe ResourceType)
alarm_resourceType :: Lens' Alarm (Maybe ResourceType)
alarm_resourceType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Alarm' {Maybe ResourceType
resourceType :: Maybe ResourceType
$sel:resourceType:Alarm' :: Alarm -> Maybe ResourceType
resourceType} -> Maybe ResourceType
resourceType) (\s :: Alarm
s@Alarm' {} Maybe ResourceType
a -> Alarm
s {$sel:resourceType:Alarm' :: Maybe ResourceType
resourceType = Maybe ResourceType
a} :: Alarm)

-- | The current state of the alarm.
--
-- An alarm has the following possible states:
--
-- -   @ALARM@ - The metric is outside of the defined threshold.
--
-- -   @INSUFFICIENT_DATA@ - The alarm has just started, the metric is not
--     available, or not enough data is available for the metric to
--     determine the alarm state.
--
-- -   @OK@ - The metric is within the defined threshold.
alarm_state :: Lens.Lens' Alarm (Prelude.Maybe AlarmState)
alarm_state :: Lens' Alarm (Maybe AlarmState)
alarm_state = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Alarm' {Maybe AlarmState
state :: Maybe AlarmState
$sel:state:Alarm' :: Alarm -> Maybe AlarmState
state} -> Maybe AlarmState
state) (\s :: Alarm
s@Alarm' {} Maybe AlarmState
a -> Alarm
s {$sel:state:Alarm' :: Maybe AlarmState
state = Maybe AlarmState
a} :: Alarm)

-- | The statistic for the metric associated with the alarm.
--
-- The following statistics are available:
--
-- -   @Minimum@ - The lowest value observed during the specified period.
--     Use this value to determine low volumes of activity for your
--     application.
--
-- -   @Maximum@ - The highest value observed during the specified period.
--     Use this value to determine high volumes of activity for your
--     application.
--
-- -   @Sum@ - All values submitted for the matching metric added together.
--     You can use this statistic to determine the total volume of a
--     metric.
--
-- -   @Average@ - The value of Sum \/ SampleCount during the specified
--     period. By comparing this statistic with the Minimum and Maximum
--     values, you can determine the full scope of a metric and how close
--     the average use is to the Minimum and Maximum values. This
--     comparison helps you to know when to increase or decrease your
--     resources.
--
-- -   @SampleCount@ - The count, or number, of data points used for the
--     statistical calculation.
alarm_statistic :: Lens.Lens' Alarm (Prelude.Maybe MetricStatistic)
alarm_statistic :: Lens' Alarm (Maybe MetricStatistic)
alarm_statistic = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Alarm' {Maybe MetricStatistic
statistic :: Maybe MetricStatistic
$sel:statistic:Alarm' :: Alarm -> Maybe MetricStatistic
statistic} -> Maybe MetricStatistic
statistic) (\s :: Alarm
s@Alarm' {} Maybe MetricStatistic
a -> Alarm
s {$sel:statistic:Alarm' :: Maybe MetricStatistic
statistic = Maybe MetricStatistic
a} :: Alarm)

-- | The support code. Include this code in your email to support when you
-- have questions about your Lightsail alarm. This code enables our support
-- team to look up your Lightsail information more easily.
alarm_supportCode :: Lens.Lens' Alarm (Prelude.Maybe Prelude.Text)
alarm_supportCode :: Lens' Alarm (Maybe Text)
alarm_supportCode = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Alarm' {Maybe Text
supportCode :: Maybe Text
$sel:supportCode:Alarm' :: Alarm -> Maybe Text
supportCode} -> Maybe Text
supportCode) (\s :: Alarm
s@Alarm' {} Maybe Text
a -> Alarm
s {$sel:supportCode:Alarm' :: Maybe Text
supportCode = Maybe Text
a} :: Alarm)

-- | The value against which the specified statistic is compared.
alarm_threshold :: Lens.Lens' Alarm (Prelude.Maybe Prelude.Double)
alarm_threshold :: Lens' Alarm (Maybe Double)
alarm_threshold = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Alarm' {Maybe Double
threshold :: Maybe Double
$sel:threshold:Alarm' :: Alarm -> Maybe Double
threshold} -> Maybe Double
threshold) (\s :: Alarm
s@Alarm' {} Maybe Double
a -> Alarm
s {$sel:threshold:Alarm' :: Maybe Double
threshold = Maybe Double
a} :: Alarm)

-- | Specifies how the alarm handles missing data points.
--
-- An alarm can treat missing data in the following ways:
--
-- -   @breaching@ - Assume the missing data is not within the threshold.
--     Missing data counts towards the number of times the metric is not
--     within the threshold.
--
-- -   @notBreaching@ - Assume the missing data is within the threshold.
--     Missing data does not count towards the number of times the metric
--     is not within the threshold.
--
-- -   @ignore@ - Ignore the missing data. Maintains the current alarm
--     state.
--
-- -   @missing@ - Missing data is treated as missing.
alarm_treatMissingData :: Lens.Lens' Alarm (Prelude.Maybe TreatMissingData)
alarm_treatMissingData :: Lens' Alarm (Maybe TreatMissingData)
alarm_treatMissingData = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Alarm' {Maybe TreatMissingData
treatMissingData :: Maybe TreatMissingData
$sel:treatMissingData:Alarm' :: Alarm -> Maybe TreatMissingData
treatMissingData} -> Maybe TreatMissingData
treatMissingData) (\s :: Alarm
s@Alarm' {} Maybe TreatMissingData
a -> Alarm
s {$sel:treatMissingData:Alarm' :: Maybe TreatMissingData
treatMissingData = Maybe TreatMissingData
a} :: Alarm)

-- | The unit of the metric associated with the alarm.
alarm_unit :: Lens.Lens' Alarm (Prelude.Maybe MetricUnit)
alarm_unit :: Lens' Alarm (Maybe MetricUnit)
alarm_unit = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Alarm' {Maybe MetricUnit
unit :: Maybe MetricUnit
$sel:unit:Alarm' :: Alarm -> Maybe MetricUnit
unit} -> Maybe MetricUnit
unit) (\s :: Alarm
s@Alarm' {} Maybe MetricUnit
a -> Alarm
s {$sel:unit:Alarm' :: Maybe MetricUnit
unit = Maybe MetricUnit
a} :: Alarm)

instance Data.FromJSON Alarm where
  parseJSON :: Value -> Parser Alarm
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"Alarm"
      ( \Object
x ->
          Maybe Text
-> Maybe ComparisonOperator
-> Maybe [ContactProtocol]
-> Maybe POSIX
-> Maybe Int
-> Maybe Int
-> Maybe ResourceLocation
-> Maybe MetricName
-> Maybe MonitoredResourceInfo
-> Maybe Text
-> Maybe Bool
-> Maybe [AlarmState]
-> Maybe Natural
-> Maybe ResourceType
-> Maybe AlarmState
-> Maybe MetricStatistic
-> Maybe Text
-> Maybe Double
-> Maybe TreatMissingData
-> Maybe MetricUnit
-> Alarm
Alarm'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"arn")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"comparisonOperator")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ( Object
x
                            forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"contactProtocols"
                            forall a. Parser (Maybe a) -> a -> Parser a
Data..!= forall a. Monoid a => a
Prelude.mempty
                        )
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"createdAt")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"datapointsToAlarm")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"evaluationPeriods")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"location")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"metricName")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"monitoredResourceInfo")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"name")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"notificationEnabled")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ( Object
x
                            forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"notificationTriggers"
                            forall a. Parser (Maybe a) -> a -> Parser a
Data..!= forall a. Monoid a => a
Prelude.mempty
                        )
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"period")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"resourceType")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"state")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"statistic")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"supportCode")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"threshold")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"treatMissingData")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"unit")
      )

instance Prelude.Hashable Alarm where
  hashWithSalt :: Int -> Alarm -> Int
hashWithSalt Int
_salt Alarm' {Maybe Bool
Maybe Double
Maybe Int
Maybe Natural
Maybe [AlarmState]
Maybe [ContactProtocol]
Maybe Text
Maybe POSIX
Maybe AlarmState
Maybe ComparisonOperator
Maybe MetricName
Maybe MetricStatistic
Maybe MetricUnit
Maybe ResourceLocation
Maybe ResourceType
Maybe MonitoredResourceInfo
Maybe TreatMissingData
unit :: Maybe MetricUnit
treatMissingData :: Maybe TreatMissingData
threshold :: Maybe Double
supportCode :: Maybe Text
statistic :: Maybe MetricStatistic
state :: Maybe AlarmState
resourceType :: Maybe ResourceType
period :: Maybe Natural
notificationTriggers :: Maybe [AlarmState]
notificationEnabled :: Maybe Bool
name :: Maybe Text
monitoredResourceInfo :: Maybe MonitoredResourceInfo
metricName :: Maybe MetricName
location :: Maybe ResourceLocation
evaluationPeriods :: Maybe Int
datapointsToAlarm :: Maybe Int
createdAt :: Maybe POSIX
contactProtocols :: Maybe [ContactProtocol]
comparisonOperator :: Maybe ComparisonOperator
arn :: Maybe Text
$sel:unit:Alarm' :: Alarm -> Maybe MetricUnit
$sel:treatMissingData:Alarm' :: Alarm -> Maybe TreatMissingData
$sel:threshold:Alarm' :: Alarm -> Maybe Double
$sel:supportCode:Alarm' :: Alarm -> Maybe Text
$sel:statistic:Alarm' :: Alarm -> Maybe MetricStatistic
$sel:state:Alarm' :: Alarm -> Maybe AlarmState
$sel:resourceType:Alarm' :: Alarm -> Maybe ResourceType
$sel:period:Alarm' :: Alarm -> Maybe Natural
$sel:notificationTriggers:Alarm' :: Alarm -> Maybe [AlarmState]
$sel:notificationEnabled:Alarm' :: Alarm -> Maybe Bool
$sel:name:Alarm' :: Alarm -> Maybe Text
$sel:monitoredResourceInfo:Alarm' :: Alarm -> Maybe MonitoredResourceInfo
$sel:metricName:Alarm' :: Alarm -> Maybe MetricName
$sel:location:Alarm' :: Alarm -> Maybe ResourceLocation
$sel:evaluationPeriods:Alarm' :: Alarm -> Maybe Int
$sel:datapointsToAlarm:Alarm' :: Alarm -> Maybe Int
$sel:createdAt:Alarm' :: Alarm -> Maybe POSIX
$sel:contactProtocols:Alarm' :: Alarm -> Maybe [ContactProtocol]
$sel:comparisonOperator:Alarm' :: Alarm -> Maybe ComparisonOperator
$sel:arn:Alarm' :: Alarm -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
arn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ComparisonOperator
comparisonOperator
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [ContactProtocol]
contactProtocols
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe POSIX
createdAt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
datapointsToAlarm
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
evaluationPeriods
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ResourceLocation
location
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe MetricName
metricName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe MonitoredResourceInfo
monitoredResourceInfo
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
name
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
notificationEnabled
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [AlarmState]
notificationTriggers
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
period
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ResourceType
resourceType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe AlarmState
state
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe MetricStatistic
statistic
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
supportCode
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Double
threshold
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe TreatMissingData
treatMissingData
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe MetricUnit
unit

instance Prelude.NFData Alarm where
  rnf :: Alarm -> ()
rnf Alarm' {Maybe Bool
Maybe Double
Maybe Int
Maybe Natural
Maybe [AlarmState]
Maybe [ContactProtocol]
Maybe Text
Maybe POSIX
Maybe AlarmState
Maybe ComparisonOperator
Maybe MetricName
Maybe MetricStatistic
Maybe MetricUnit
Maybe ResourceLocation
Maybe ResourceType
Maybe MonitoredResourceInfo
Maybe TreatMissingData
unit :: Maybe MetricUnit
treatMissingData :: Maybe TreatMissingData
threshold :: Maybe Double
supportCode :: Maybe Text
statistic :: Maybe MetricStatistic
state :: Maybe AlarmState
resourceType :: Maybe ResourceType
period :: Maybe Natural
notificationTriggers :: Maybe [AlarmState]
notificationEnabled :: Maybe Bool
name :: Maybe Text
monitoredResourceInfo :: Maybe MonitoredResourceInfo
metricName :: Maybe MetricName
location :: Maybe ResourceLocation
evaluationPeriods :: Maybe Int
datapointsToAlarm :: Maybe Int
createdAt :: Maybe POSIX
contactProtocols :: Maybe [ContactProtocol]
comparisonOperator :: Maybe ComparisonOperator
arn :: Maybe Text
$sel:unit:Alarm' :: Alarm -> Maybe MetricUnit
$sel:treatMissingData:Alarm' :: Alarm -> Maybe TreatMissingData
$sel:threshold:Alarm' :: Alarm -> Maybe Double
$sel:supportCode:Alarm' :: Alarm -> Maybe Text
$sel:statistic:Alarm' :: Alarm -> Maybe MetricStatistic
$sel:state:Alarm' :: Alarm -> Maybe AlarmState
$sel:resourceType:Alarm' :: Alarm -> Maybe ResourceType
$sel:period:Alarm' :: Alarm -> Maybe Natural
$sel:notificationTriggers:Alarm' :: Alarm -> Maybe [AlarmState]
$sel:notificationEnabled:Alarm' :: Alarm -> Maybe Bool
$sel:name:Alarm' :: Alarm -> Maybe Text
$sel:monitoredResourceInfo:Alarm' :: Alarm -> Maybe MonitoredResourceInfo
$sel:metricName:Alarm' :: Alarm -> Maybe MetricName
$sel:location:Alarm' :: Alarm -> Maybe ResourceLocation
$sel:evaluationPeriods:Alarm' :: Alarm -> Maybe Int
$sel:datapointsToAlarm:Alarm' :: Alarm -> Maybe Int
$sel:createdAt:Alarm' :: Alarm -> Maybe POSIX
$sel:contactProtocols:Alarm' :: Alarm -> Maybe [ContactProtocol]
$sel:comparisonOperator:Alarm' :: Alarm -> Maybe ComparisonOperator
$sel:arn:Alarm' :: Alarm -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
arn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ComparisonOperator
comparisonOperator
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [ContactProtocol]
contactProtocols
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
createdAt
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
datapointsToAlarm
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
evaluationPeriods
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ResourceLocation
location
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe MetricName
metricName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe MonitoredResourceInfo
monitoredResourceInfo
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
name
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
notificationEnabled
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [AlarmState]
notificationTriggers
      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 ResourceType
resourceType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe AlarmState
state
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe MetricStatistic
statistic
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
supportCode
      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 TreatMissingData
treatMissingData
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe MetricUnit
unit