{-# 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.IoTEventsData.Types.AlarmState
-- 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.IoTEventsData.Types.AlarmState where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.IoTEventsData.Types.AlarmStateName
import Amazonka.IoTEventsData.Types.CustomerAction
import Amazonka.IoTEventsData.Types.RuleEvaluation
import Amazonka.IoTEventsData.Types.SystemEvent
import qualified Amazonka.Prelude as Prelude

-- | Contains information about the current state of the alarm.
--
-- /See:/ 'newAlarmState' smart constructor.
data AlarmState = AlarmState'
  { -- | Contains information about the action that you can take to respond to
    -- the alarm.
    AlarmState -> Maybe CustomerAction
customerAction :: Prelude.Maybe CustomerAction,
    -- | Information needed to evaluate data.
    AlarmState -> Maybe RuleEvaluation
ruleEvaluation :: Prelude.Maybe RuleEvaluation,
    -- | The name of the alarm state. The state name can be one of the following
    -- values:
    --
    -- -   @DISABLED@ - When the alarm is in the @DISABLED@ state, it isn\'t
    --     ready to evaluate data. To enable the alarm, you must change the
    --     alarm to the @NORMAL@ state.
    --
    -- -   @NORMAL@ - When the alarm is in the @NORMAL@ state, it\'s ready to
    --     evaluate data.
    --
    -- -   @ACTIVE@ - If the alarm is in the @ACTIVE@ state, the alarm is
    --     invoked.
    --
    -- -   @ACKNOWLEDGED@ - When the alarm is in the @ACKNOWLEDGED@ state, the
    --     alarm was invoked and you acknowledged the alarm.
    --
    -- -   @SNOOZE_DISABLED@ - When the alarm is in the @SNOOZE_DISABLED@
    --     state, the alarm is disabled for a specified period of time. After
    --     the snooze time, the alarm automatically changes to the @NORMAL@
    --     state.
    --
    -- -   @LATCHED@ - When the alarm is in the @LATCHED@ state, the alarm was
    --     invoked. However, the data that the alarm is currently evaluating is
    --     within the specified range. To change the alarm to the @NORMAL@
    --     state, you must acknowledge the alarm.
    AlarmState -> Maybe AlarmStateName
stateName :: Prelude.Maybe AlarmStateName,
    -- | Contains information about alarm state changes.
    AlarmState -> Maybe SystemEvent
systemEvent :: Prelude.Maybe SystemEvent
  }
  deriving (AlarmState -> AlarmState -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AlarmState -> AlarmState -> Bool
$c/= :: AlarmState -> AlarmState -> Bool
== :: AlarmState -> AlarmState -> Bool
$c== :: AlarmState -> AlarmState -> Bool
Prelude.Eq, ReadPrec [AlarmState]
ReadPrec AlarmState
Int -> ReadS AlarmState
ReadS [AlarmState]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AlarmState]
$creadListPrec :: ReadPrec [AlarmState]
readPrec :: ReadPrec AlarmState
$creadPrec :: ReadPrec AlarmState
readList :: ReadS [AlarmState]
$creadList :: ReadS [AlarmState]
readsPrec :: Int -> ReadS AlarmState
$creadsPrec :: Int -> ReadS AlarmState
Prelude.Read, Int -> AlarmState -> ShowS
[AlarmState] -> ShowS
AlarmState -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AlarmState] -> ShowS
$cshowList :: [AlarmState] -> ShowS
show :: AlarmState -> String
$cshow :: AlarmState -> String
showsPrec :: Int -> AlarmState -> ShowS
$cshowsPrec :: Int -> AlarmState -> ShowS
Prelude.Show, forall x. Rep AlarmState x -> AlarmState
forall x. AlarmState -> Rep AlarmState x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AlarmState x -> AlarmState
$cfrom :: forall x. AlarmState -> Rep AlarmState x
Prelude.Generic)

-- |
-- Create a value of 'AlarmState' 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:
--
-- 'customerAction', 'alarmState_customerAction' - Contains information about the action that you can take to respond to
-- the alarm.
--
-- 'ruleEvaluation', 'alarmState_ruleEvaluation' - Information needed to evaluate data.
--
-- 'stateName', 'alarmState_stateName' - The name of the alarm state. The state name can be one of the following
-- values:
--
-- -   @DISABLED@ - When the alarm is in the @DISABLED@ state, it isn\'t
--     ready to evaluate data. To enable the alarm, you must change the
--     alarm to the @NORMAL@ state.
--
-- -   @NORMAL@ - When the alarm is in the @NORMAL@ state, it\'s ready to
--     evaluate data.
--
-- -   @ACTIVE@ - If the alarm is in the @ACTIVE@ state, the alarm is
--     invoked.
--
-- -   @ACKNOWLEDGED@ - When the alarm is in the @ACKNOWLEDGED@ state, the
--     alarm was invoked and you acknowledged the alarm.
--
-- -   @SNOOZE_DISABLED@ - When the alarm is in the @SNOOZE_DISABLED@
--     state, the alarm is disabled for a specified period of time. After
--     the snooze time, the alarm automatically changes to the @NORMAL@
--     state.
--
-- -   @LATCHED@ - When the alarm is in the @LATCHED@ state, the alarm was
--     invoked. However, the data that the alarm is currently evaluating is
--     within the specified range. To change the alarm to the @NORMAL@
--     state, you must acknowledge the alarm.
--
-- 'systemEvent', 'alarmState_systemEvent' - Contains information about alarm state changes.
newAlarmState ::
  AlarmState
newAlarmState :: AlarmState
newAlarmState =
  AlarmState'
    { $sel:customerAction:AlarmState' :: Maybe CustomerAction
customerAction = forall a. Maybe a
Prelude.Nothing,
      $sel:ruleEvaluation:AlarmState' :: Maybe RuleEvaluation
ruleEvaluation = forall a. Maybe a
Prelude.Nothing,
      $sel:stateName:AlarmState' :: Maybe AlarmStateName
stateName = forall a. Maybe a
Prelude.Nothing,
      $sel:systemEvent:AlarmState' :: Maybe SystemEvent
systemEvent = forall a. Maybe a
Prelude.Nothing
    }

-- | Contains information about the action that you can take to respond to
-- the alarm.
alarmState_customerAction :: Lens.Lens' AlarmState (Prelude.Maybe CustomerAction)
alarmState_customerAction :: Lens' AlarmState (Maybe CustomerAction)
alarmState_customerAction = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AlarmState' {Maybe CustomerAction
customerAction :: Maybe CustomerAction
$sel:customerAction:AlarmState' :: AlarmState -> Maybe CustomerAction
customerAction} -> Maybe CustomerAction
customerAction) (\s :: AlarmState
s@AlarmState' {} Maybe CustomerAction
a -> AlarmState
s {$sel:customerAction:AlarmState' :: Maybe CustomerAction
customerAction = Maybe CustomerAction
a} :: AlarmState)

-- | Information needed to evaluate data.
alarmState_ruleEvaluation :: Lens.Lens' AlarmState (Prelude.Maybe RuleEvaluation)
alarmState_ruleEvaluation :: Lens' AlarmState (Maybe RuleEvaluation)
alarmState_ruleEvaluation = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AlarmState' {Maybe RuleEvaluation
ruleEvaluation :: Maybe RuleEvaluation
$sel:ruleEvaluation:AlarmState' :: AlarmState -> Maybe RuleEvaluation
ruleEvaluation} -> Maybe RuleEvaluation
ruleEvaluation) (\s :: AlarmState
s@AlarmState' {} Maybe RuleEvaluation
a -> AlarmState
s {$sel:ruleEvaluation:AlarmState' :: Maybe RuleEvaluation
ruleEvaluation = Maybe RuleEvaluation
a} :: AlarmState)

-- | The name of the alarm state. The state name can be one of the following
-- values:
--
-- -   @DISABLED@ - When the alarm is in the @DISABLED@ state, it isn\'t
--     ready to evaluate data. To enable the alarm, you must change the
--     alarm to the @NORMAL@ state.
--
-- -   @NORMAL@ - When the alarm is in the @NORMAL@ state, it\'s ready to
--     evaluate data.
--
-- -   @ACTIVE@ - If the alarm is in the @ACTIVE@ state, the alarm is
--     invoked.
--
-- -   @ACKNOWLEDGED@ - When the alarm is in the @ACKNOWLEDGED@ state, the
--     alarm was invoked and you acknowledged the alarm.
--
-- -   @SNOOZE_DISABLED@ - When the alarm is in the @SNOOZE_DISABLED@
--     state, the alarm is disabled for a specified period of time. After
--     the snooze time, the alarm automatically changes to the @NORMAL@
--     state.
--
-- -   @LATCHED@ - When the alarm is in the @LATCHED@ state, the alarm was
--     invoked. However, the data that the alarm is currently evaluating is
--     within the specified range. To change the alarm to the @NORMAL@
--     state, you must acknowledge the alarm.
alarmState_stateName :: Lens.Lens' AlarmState (Prelude.Maybe AlarmStateName)
alarmState_stateName :: Lens' AlarmState (Maybe AlarmStateName)
alarmState_stateName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AlarmState' {Maybe AlarmStateName
stateName :: Maybe AlarmStateName
$sel:stateName:AlarmState' :: AlarmState -> Maybe AlarmStateName
stateName} -> Maybe AlarmStateName
stateName) (\s :: AlarmState
s@AlarmState' {} Maybe AlarmStateName
a -> AlarmState
s {$sel:stateName:AlarmState' :: Maybe AlarmStateName
stateName = Maybe AlarmStateName
a} :: AlarmState)

-- | Contains information about alarm state changes.
alarmState_systemEvent :: Lens.Lens' AlarmState (Prelude.Maybe SystemEvent)
alarmState_systemEvent :: Lens' AlarmState (Maybe SystemEvent)
alarmState_systemEvent = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AlarmState' {Maybe SystemEvent
systemEvent :: Maybe SystemEvent
$sel:systemEvent:AlarmState' :: AlarmState -> Maybe SystemEvent
systemEvent} -> Maybe SystemEvent
systemEvent) (\s :: AlarmState
s@AlarmState' {} Maybe SystemEvent
a -> AlarmState
s {$sel:systemEvent:AlarmState' :: Maybe SystemEvent
systemEvent = Maybe SystemEvent
a} :: AlarmState)

instance Data.FromJSON AlarmState where
  parseJSON :: Value -> Parser AlarmState
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"AlarmState"
      ( \Object
x ->
          Maybe CustomerAction
-> Maybe RuleEvaluation
-> Maybe AlarmStateName
-> Maybe SystemEvent
-> AlarmState
AlarmState'
            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
"customerAction")
            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
"ruleEvaluation")
            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
"stateName")
            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
"systemEvent")
      )

instance Prelude.Hashable AlarmState where
  hashWithSalt :: Int -> AlarmState -> Int
hashWithSalt Int
_salt AlarmState' {Maybe AlarmStateName
Maybe RuleEvaluation
Maybe CustomerAction
Maybe SystemEvent
systemEvent :: Maybe SystemEvent
stateName :: Maybe AlarmStateName
ruleEvaluation :: Maybe RuleEvaluation
customerAction :: Maybe CustomerAction
$sel:systemEvent:AlarmState' :: AlarmState -> Maybe SystemEvent
$sel:stateName:AlarmState' :: AlarmState -> Maybe AlarmStateName
$sel:ruleEvaluation:AlarmState' :: AlarmState -> Maybe RuleEvaluation
$sel:customerAction:AlarmState' :: AlarmState -> Maybe CustomerAction
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe CustomerAction
customerAction
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe RuleEvaluation
ruleEvaluation
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe AlarmStateName
stateName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe SystemEvent
systemEvent

instance Prelude.NFData AlarmState where
  rnf :: AlarmState -> ()
rnf AlarmState' {Maybe AlarmStateName
Maybe RuleEvaluation
Maybe CustomerAction
Maybe SystemEvent
systemEvent :: Maybe SystemEvent
stateName :: Maybe AlarmStateName
ruleEvaluation :: Maybe RuleEvaluation
customerAction :: Maybe CustomerAction
$sel:systemEvent:AlarmState' :: AlarmState -> Maybe SystemEvent
$sel:stateName:AlarmState' :: AlarmState -> Maybe AlarmStateName
$sel:ruleEvaluation:AlarmState' :: AlarmState -> Maybe RuleEvaluation
$sel:customerAction:AlarmState' :: AlarmState -> Maybe CustomerAction
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe CustomerAction
customerAction
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe RuleEvaluation
ruleEvaluation
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe AlarmStateName
stateName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe SystemEvent
systemEvent