{-# 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.SetAlarmState
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Temporarily sets the state of an alarm for testing purposes. When the
-- updated state differs from the previous value, the action configured for
-- the appropriate state is invoked. For example, if your alarm is
-- configured to send an Amazon SNS message when an alarm is triggered,
-- temporarily changing the alarm state to @ALARM@ sends an SNS message.
--
-- Metric alarms returns to their actual state quickly, often within
-- seconds. Because the metric alarm state change happens quickly, it is
-- typically only visible in the alarm\'s __History__ tab in the Amazon
-- CloudWatch console or through
-- <https://docs.aws.amazon.com/AmazonCloudWatch/latest/APIReference/API_DescribeAlarmHistory.html DescribeAlarmHistory>.
--
-- If you use @SetAlarmState@ on a composite alarm, the composite alarm is
-- not guaranteed to return to its actual state. It returns to its actual
-- state only once any of its children alarms change state. It is also
-- reevaluated if you update its configuration.
--
-- If an alarm triggers EC2 Auto Scaling policies or application Auto
-- Scaling policies, you must include information in the @StateReasonData@
-- parameter to enable the policy to take the correct action.
module Amazonka.CloudWatch.SetAlarmState
  ( -- * Creating a Request
    SetAlarmState (..),
    newSetAlarmState,

    -- * Request Lenses
    setAlarmState_stateReasonData,
    setAlarmState_alarmName,
    setAlarmState_stateValue,
    setAlarmState_stateReason,

    -- * Destructuring the Response
    SetAlarmStateResponse (..),
    newSetAlarmStateResponse,
  )
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:/ 'newSetAlarmState' smart constructor.
data SetAlarmState = SetAlarmState'
  { -- | The reason that this alarm is set to this specific state, in JSON
    -- format.
    --
    -- For SNS or EC2 alarm actions, this is just informational. But for EC2
    -- Auto Scaling or application Auto Scaling alarm actions, the Auto Scaling
    -- policy uses the information in this field to take the correct action.
    SetAlarmState -> Maybe Text
stateReasonData :: Prelude.Maybe Prelude.Text,
    -- | The name of the alarm.
    SetAlarmState -> Text
alarmName :: Prelude.Text,
    -- | The value of the state.
    SetAlarmState -> StateValue
stateValue :: StateValue,
    -- | The reason that this alarm is set to this specific state, in text
    -- format.
    SetAlarmState -> Text
stateReason :: Prelude.Text
  }
  deriving (SetAlarmState -> SetAlarmState -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SetAlarmState -> SetAlarmState -> Bool
$c/= :: SetAlarmState -> SetAlarmState -> Bool
== :: SetAlarmState -> SetAlarmState -> Bool
$c== :: SetAlarmState -> SetAlarmState -> Bool
Prelude.Eq, ReadPrec [SetAlarmState]
ReadPrec SetAlarmState
Int -> ReadS SetAlarmState
ReadS [SetAlarmState]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SetAlarmState]
$creadListPrec :: ReadPrec [SetAlarmState]
readPrec :: ReadPrec SetAlarmState
$creadPrec :: ReadPrec SetAlarmState
readList :: ReadS [SetAlarmState]
$creadList :: ReadS [SetAlarmState]
readsPrec :: Int -> ReadS SetAlarmState
$creadsPrec :: Int -> ReadS SetAlarmState
Prelude.Read, Int -> SetAlarmState -> ShowS
[SetAlarmState] -> ShowS
SetAlarmState -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SetAlarmState] -> ShowS
$cshowList :: [SetAlarmState] -> ShowS
show :: SetAlarmState -> String
$cshow :: SetAlarmState -> String
showsPrec :: Int -> SetAlarmState -> ShowS
$cshowsPrec :: Int -> SetAlarmState -> ShowS
Prelude.Show, forall x. Rep SetAlarmState x -> SetAlarmState
forall x. SetAlarmState -> Rep SetAlarmState x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SetAlarmState x -> SetAlarmState
$cfrom :: forall x. SetAlarmState -> Rep SetAlarmState x
Prelude.Generic)

-- |
-- Create a value of 'SetAlarmState' 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:
--
-- 'stateReasonData', 'setAlarmState_stateReasonData' - The reason that this alarm is set to this specific state, in JSON
-- format.
--
-- For SNS or EC2 alarm actions, this is just informational. But for EC2
-- Auto Scaling or application Auto Scaling alarm actions, the Auto Scaling
-- policy uses the information in this field to take the correct action.
--
-- 'alarmName', 'setAlarmState_alarmName' - The name of the alarm.
--
-- 'stateValue', 'setAlarmState_stateValue' - The value of the state.
--
-- 'stateReason', 'setAlarmState_stateReason' - The reason that this alarm is set to this specific state, in text
-- format.
newSetAlarmState ::
  -- | 'alarmName'
  Prelude.Text ->
  -- | 'stateValue'
  StateValue ->
  -- | 'stateReason'
  Prelude.Text ->
  SetAlarmState
newSetAlarmState :: Text -> StateValue -> Text -> SetAlarmState
newSetAlarmState
  Text
pAlarmName_
  StateValue
pStateValue_
  Text
pStateReason_ =
    SetAlarmState'
      { $sel:stateReasonData:SetAlarmState' :: Maybe Text
stateReasonData = forall a. Maybe a
Prelude.Nothing,
        $sel:alarmName:SetAlarmState' :: Text
alarmName = Text
pAlarmName_,
        $sel:stateValue:SetAlarmState' :: StateValue
stateValue = StateValue
pStateValue_,
        $sel:stateReason:SetAlarmState' :: Text
stateReason = Text
pStateReason_
      }

-- | The reason that this alarm is set to this specific state, in JSON
-- format.
--
-- For SNS or EC2 alarm actions, this is just informational. But for EC2
-- Auto Scaling or application Auto Scaling alarm actions, the Auto Scaling
-- policy uses the information in this field to take the correct action.
setAlarmState_stateReasonData :: Lens.Lens' SetAlarmState (Prelude.Maybe Prelude.Text)
setAlarmState_stateReasonData :: Lens' SetAlarmState (Maybe Text)
setAlarmState_stateReasonData = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SetAlarmState' {Maybe Text
stateReasonData :: Maybe Text
$sel:stateReasonData:SetAlarmState' :: SetAlarmState -> Maybe Text
stateReasonData} -> Maybe Text
stateReasonData) (\s :: SetAlarmState
s@SetAlarmState' {} Maybe Text
a -> SetAlarmState
s {$sel:stateReasonData:SetAlarmState' :: Maybe Text
stateReasonData = Maybe Text
a} :: SetAlarmState)

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

-- | The value of the state.
setAlarmState_stateValue :: Lens.Lens' SetAlarmState StateValue
setAlarmState_stateValue :: Lens' SetAlarmState StateValue
setAlarmState_stateValue = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SetAlarmState' {StateValue
stateValue :: StateValue
$sel:stateValue:SetAlarmState' :: SetAlarmState -> StateValue
stateValue} -> StateValue
stateValue) (\s :: SetAlarmState
s@SetAlarmState' {} StateValue
a -> SetAlarmState
s {$sel:stateValue:SetAlarmState' :: StateValue
stateValue = StateValue
a} :: SetAlarmState)

-- | The reason that this alarm is set to this specific state, in text
-- format.
setAlarmState_stateReason :: Lens.Lens' SetAlarmState Prelude.Text
setAlarmState_stateReason :: Lens' SetAlarmState Text
setAlarmState_stateReason = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SetAlarmState' {Text
stateReason :: Text
$sel:stateReason:SetAlarmState' :: SetAlarmState -> Text
stateReason} -> Text
stateReason) (\s :: SetAlarmState
s@SetAlarmState' {} Text
a -> SetAlarmState
s {$sel:stateReason:SetAlarmState' :: Text
stateReason = Text
a} :: SetAlarmState)

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

instance Prelude.Hashable SetAlarmState where
  hashWithSalt :: Int -> SetAlarmState -> Int
hashWithSalt Int
_salt SetAlarmState' {Maybe Text
Text
StateValue
stateReason :: Text
stateValue :: StateValue
alarmName :: Text
stateReasonData :: Maybe Text
$sel:stateReason:SetAlarmState' :: SetAlarmState -> Text
$sel:stateValue:SetAlarmState' :: SetAlarmState -> StateValue
$sel:alarmName:SetAlarmState' :: SetAlarmState -> Text
$sel:stateReasonData:SetAlarmState' :: SetAlarmState -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
stateReasonData
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
alarmName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` StateValue
stateValue
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
stateReason

instance Prelude.NFData SetAlarmState where
  rnf :: SetAlarmState -> ()
rnf SetAlarmState' {Maybe Text
Text
StateValue
stateReason :: Text
stateValue :: StateValue
alarmName :: Text
stateReasonData :: Maybe Text
$sel:stateReason:SetAlarmState' :: SetAlarmState -> Text
$sel:stateValue:SetAlarmState' :: SetAlarmState -> StateValue
$sel:alarmName:SetAlarmState' :: SetAlarmState -> Text
$sel:stateReasonData:SetAlarmState' :: SetAlarmState -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
stateReasonData
      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 StateValue
stateValue
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
stateReason

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

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

instance Data.ToQuery SetAlarmState where
  toQuery :: SetAlarmState -> QueryString
toQuery SetAlarmState' {Maybe Text
Text
StateValue
stateReason :: Text
stateValue :: StateValue
alarmName :: Text
stateReasonData :: Maybe Text
$sel:stateReason:SetAlarmState' :: SetAlarmState -> Text
$sel:stateValue:SetAlarmState' :: SetAlarmState -> StateValue
$sel:alarmName:SetAlarmState' :: SetAlarmState -> Text
$sel:stateReasonData:SetAlarmState' :: SetAlarmState -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"SetAlarmState" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2010-08-01" :: Prelude.ByteString),
        ByteString
"StateReasonData" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
stateReasonData,
        ByteString
"AlarmName" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
alarmName,
        ByteString
"StateValue" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: StateValue
stateValue,
        ByteString
"StateReason" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
stateReason
      ]

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

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

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