{-# 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.Lightsail.TestAlarm
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Tests an alarm by displaying a banner on the Amazon Lightsail console.
-- If a notification trigger is configured for the specified alarm, the
-- test also sends a notification to the notification protocol (@Email@
-- and\/or @SMS@) configured for the alarm.
--
-- An alarm is used to monitor a single metric for one of your resources.
-- When a metric condition is met, the alarm can notify you by email, SMS
-- text message, and a banner displayed on the Amazon Lightsail console.
-- For more information, see
-- <https://lightsail.aws.amazon.com/ls/docs/en_us/articles/amazon-lightsail-alarms Alarms in Amazon Lightsail>.
module Amazonka.Lightsail.TestAlarm
  ( -- * Creating a Request
    TestAlarm (..),
    newTestAlarm,

    -- * Request Lenses
    testAlarm_alarmName,
    testAlarm_state,

    -- * Destructuring the Response
    TestAlarmResponse (..),
    newTestAlarmResponse,

    -- * Response Lenses
    testAlarmResponse_operations,
    testAlarmResponse_httpStatus,
  )
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
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newTestAlarm' smart constructor.
data TestAlarm = TestAlarm'
  { -- | The name of the alarm to test.
    TestAlarm -> Text
alarmName :: Prelude.Text,
    -- | The alarm state to test.
    --
    -- An alarm has the following possible states that can be tested:
    --
    -- -   @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.
    TestAlarm -> AlarmState
state :: AlarmState
  }
  deriving (TestAlarm -> TestAlarm -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TestAlarm -> TestAlarm -> Bool
$c/= :: TestAlarm -> TestAlarm -> Bool
== :: TestAlarm -> TestAlarm -> Bool
$c== :: TestAlarm -> TestAlarm -> Bool
Prelude.Eq, ReadPrec [TestAlarm]
ReadPrec TestAlarm
Int -> ReadS TestAlarm
ReadS [TestAlarm]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [TestAlarm]
$creadListPrec :: ReadPrec [TestAlarm]
readPrec :: ReadPrec TestAlarm
$creadPrec :: ReadPrec TestAlarm
readList :: ReadS [TestAlarm]
$creadList :: ReadS [TestAlarm]
readsPrec :: Int -> ReadS TestAlarm
$creadsPrec :: Int -> ReadS TestAlarm
Prelude.Read, Int -> TestAlarm -> ShowS
[TestAlarm] -> ShowS
TestAlarm -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TestAlarm] -> ShowS
$cshowList :: [TestAlarm] -> ShowS
show :: TestAlarm -> String
$cshow :: TestAlarm -> String
showsPrec :: Int -> TestAlarm -> ShowS
$cshowsPrec :: Int -> TestAlarm -> ShowS
Prelude.Show, forall x. Rep TestAlarm x -> TestAlarm
forall x. TestAlarm -> Rep TestAlarm x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TestAlarm x -> TestAlarm
$cfrom :: forall x. TestAlarm -> Rep TestAlarm x
Prelude.Generic)

-- |
-- Create a value of 'TestAlarm' 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:
--
-- 'alarmName', 'testAlarm_alarmName' - The name of the alarm to test.
--
-- 'state', 'testAlarm_state' - The alarm state to test.
--
-- An alarm has the following possible states that can be tested:
--
-- -   @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.
newTestAlarm ::
  -- | 'alarmName'
  Prelude.Text ->
  -- | 'state'
  AlarmState ->
  TestAlarm
newTestAlarm :: Text -> AlarmState -> TestAlarm
newTestAlarm Text
pAlarmName_ AlarmState
pState_ =
  TestAlarm'
    { $sel:alarmName:TestAlarm' :: Text
alarmName = Text
pAlarmName_,
      $sel:state:TestAlarm' :: AlarmState
state = AlarmState
pState_
    }

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

-- | The alarm state to test.
--
-- An alarm has the following possible states that can be tested:
--
-- -   @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.
testAlarm_state :: Lens.Lens' TestAlarm AlarmState
testAlarm_state :: Lens' TestAlarm AlarmState
testAlarm_state = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TestAlarm' {AlarmState
state :: AlarmState
$sel:state:TestAlarm' :: TestAlarm -> AlarmState
state} -> AlarmState
state) (\s :: TestAlarm
s@TestAlarm' {} AlarmState
a -> TestAlarm
s {$sel:state:TestAlarm' :: AlarmState
state = AlarmState
a} :: TestAlarm)

instance Core.AWSRequest TestAlarm where
  type AWSResponse TestAlarm = TestAlarmResponse
  request :: (Service -> Service) -> TestAlarm -> Request TestAlarm
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.postJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy TestAlarm
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse TestAlarm)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> Object -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveJSON
      ( \Int
s ResponseHeaders
h Object
x ->
          Maybe [Operation] -> Int -> TestAlarmResponse
TestAlarmResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"operations" forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty)
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
      )

instance Prelude.Hashable TestAlarm where
  hashWithSalt :: Int -> TestAlarm -> Int
hashWithSalt Int
_salt TestAlarm' {Text
AlarmState
state :: AlarmState
alarmName :: Text
$sel:state:TestAlarm' :: TestAlarm -> AlarmState
$sel:alarmName:TestAlarm' :: TestAlarm -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
alarmName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` AlarmState
state

instance Prelude.NFData TestAlarm where
  rnf :: TestAlarm -> ()
rnf TestAlarm' {Text
AlarmState
state :: AlarmState
alarmName :: Text
$sel:state:TestAlarm' :: TestAlarm -> AlarmState
$sel:alarmName:TestAlarm' :: TestAlarm -> Text
..} =
    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 AlarmState
state

instance Data.ToHeaders TestAlarm where
  toHeaders :: TestAlarm -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"X-Amz-Target"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"Lightsail_20161128.TestAlarm" ::
                          Prelude.ByteString
                      ),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON TestAlarm where
  toJSON :: TestAlarm -> Value
toJSON TestAlarm' {Text
AlarmState
state :: AlarmState
alarmName :: Text
$sel:state:TestAlarm' :: TestAlarm -> AlarmState
$sel:alarmName:TestAlarm' :: TestAlarm -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just (Key
"alarmName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
alarmName),
            forall a. a -> Maybe a
Prelude.Just (Key
"state" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= AlarmState
state)
          ]
      )

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

instance Data.ToQuery TestAlarm where
  toQuery :: TestAlarm -> QueryString
toQuery = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

-- | /See:/ 'newTestAlarmResponse' smart constructor.
data TestAlarmResponse = TestAlarmResponse'
  { -- | An array of objects that describe the result of the action, such as the
    -- status of the request, the timestamp of the request, and the resources
    -- affected by the request.
    TestAlarmResponse -> Maybe [Operation]
operations :: Prelude.Maybe [Operation],
    -- | The response's http status code.
    TestAlarmResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (TestAlarmResponse -> TestAlarmResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TestAlarmResponse -> TestAlarmResponse -> Bool
$c/= :: TestAlarmResponse -> TestAlarmResponse -> Bool
== :: TestAlarmResponse -> TestAlarmResponse -> Bool
$c== :: TestAlarmResponse -> TestAlarmResponse -> Bool
Prelude.Eq, ReadPrec [TestAlarmResponse]
ReadPrec TestAlarmResponse
Int -> ReadS TestAlarmResponse
ReadS [TestAlarmResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [TestAlarmResponse]
$creadListPrec :: ReadPrec [TestAlarmResponse]
readPrec :: ReadPrec TestAlarmResponse
$creadPrec :: ReadPrec TestAlarmResponse
readList :: ReadS [TestAlarmResponse]
$creadList :: ReadS [TestAlarmResponse]
readsPrec :: Int -> ReadS TestAlarmResponse
$creadsPrec :: Int -> ReadS TestAlarmResponse
Prelude.Read, Int -> TestAlarmResponse -> ShowS
[TestAlarmResponse] -> ShowS
TestAlarmResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TestAlarmResponse] -> ShowS
$cshowList :: [TestAlarmResponse] -> ShowS
show :: TestAlarmResponse -> String
$cshow :: TestAlarmResponse -> String
showsPrec :: Int -> TestAlarmResponse -> ShowS
$cshowsPrec :: Int -> TestAlarmResponse -> ShowS
Prelude.Show, forall x. Rep TestAlarmResponse x -> TestAlarmResponse
forall x. TestAlarmResponse -> Rep TestAlarmResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TestAlarmResponse x -> TestAlarmResponse
$cfrom :: forall x. TestAlarmResponse -> Rep TestAlarmResponse x
Prelude.Generic)

-- |
-- Create a value of 'TestAlarmResponse' 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:
--
-- 'operations', 'testAlarmResponse_operations' - An array of objects that describe the result of the action, such as the
-- status of the request, the timestamp of the request, and the resources
-- affected by the request.
--
-- 'httpStatus', 'testAlarmResponse_httpStatus' - The response's http status code.
newTestAlarmResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  TestAlarmResponse
newTestAlarmResponse :: Int -> TestAlarmResponse
newTestAlarmResponse Int
pHttpStatus_ =
  TestAlarmResponse'
    { $sel:operations:TestAlarmResponse' :: Maybe [Operation]
operations = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:TestAlarmResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | An array of objects that describe the result of the action, such as the
-- status of the request, the timestamp of the request, and the resources
-- affected by the request.
testAlarmResponse_operations :: Lens.Lens' TestAlarmResponse (Prelude.Maybe [Operation])
testAlarmResponse_operations :: Lens' TestAlarmResponse (Maybe [Operation])
testAlarmResponse_operations = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TestAlarmResponse' {Maybe [Operation]
operations :: Maybe [Operation]
$sel:operations:TestAlarmResponse' :: TestAlarmResponse -> Maybe [Operation]
operations} -> Maybe [Operation]
operations) (\s :: TestAlarmResponse
s@TestAlarmResponse' {} Maybe [Operation]
a -> TestAlarmResponse
s {$sel:operations:TestAlarmResponse' :: Maybe [Operation]
operations = Maybe [Operation]
a} :: TestAlarmResponse) 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 response's http status code.
testAlarmResponse_httpStatus :: Lens.Lens' TestAlarmResponse Prelude.Int
testAlarmResponse_httpStatus :: Lens' TestAlarmResponse Int
testAlarmResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TestAlarmResponse' {Int
httpStatus :: Int
$sel:httpStatus:TestAlarmResponse' :: TestAlarmResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: TestAlarmResponse
s@TestAlarmResponse' {} Int
a -> TestAlarmResponse
s {$sel:httpStatus:TestAlarmResponse' :: Int
httpStatus = Int
a} :: TestAlarmResponse)

instance Prelude.NFData TestAlarmResponse where
  rnf :: TestAlarmResponse -> ()
rnf TestAlarmResponse' {Int
Maybe [Operation]
httpStatus :: Int
operations :: Maybe [Operation]
$sel:httpStatus:TestAlarmResponse' :: TestAlarmResponse -> Int
$sel:operations:TestAlarmResponse' :: TestAlarmResponse -> Maybe [Operation]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [Operation]
operations
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus