{-# 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.DeleteAlarms
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Deletes the specified alarms. You can delete up to 100 alarms in one
-- operation. However, this total can include no more than one composite
-- alarm. For example, you could delete 99 metric alarms and one composite
-- alarms with one operation, but you can\'t delete two composite alarms
-- with one operation.
--
-- In the event of an error, no alarms are deleted.
--
-- It is possible to create a loop or cycle of composite alarms, where
-- composite alarm A depends on composite alarm B, and composite alarm B
-- also depends on composite alarm A. In this scenario, you can\'t delete
-- any composite alarm that is part of the cycle because there is always
-- still a composite alarm that depends on that alarm that you want to
-- delete.
--
-- To get out of such a situation, you must break the cycle by changing the
-- rule of one of the composite alarms in the cycle to remove a dependency
-- that creates the cycle. The simplest change to make to break a cycle is
-- to change the @AlarmRule@ of one of the alarms to @false@.
--
-- Additionally, the evaluation of composite alarms stops if CloudWatch
-- detects a cycle in the evaluation path.
module Amazonka.CloudWatch.DeleteAlarms
  ( -- * Creating a Request
    DeleteAlarms (..),
    newDeleteAlarms,

    -- * Request Lenses
    deleteAlarms_alarmNames,

    -- * Destructuring the Response
    DeleteAlarmsResponse (..),
    newDeleteAlarmsResponse,
  )
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:/ 'newDeleteAlarms' smart constructor.
data DeleteAlarms = DeleteAlarms'
  { -- | The alarms to be deleted.
    DeleteAlarms -> [Text]
alarmNames :: [Prelude.Text]
  }
  deriving (DeleteAlarms -> DeleteAlarms -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeleteAlarms -> DeleteAlarms -> Bool
$c/= :: DeleteAlarms -> DeleteAlarms -> Bool
== :: DeleteAlarms -> DeleteAlarms -> Bool
$c== :: DeleteAlarms -> DeleteAlarms -> Bool
Prelude.Eq, ReadPrec [DeleteAlarms]
ReadPrec DeleteAlarms
Int -> ReadS DeleteAlarms
ReadS [DeleteAlarms]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeleteAlarms]
$creadListPrec :: ReadPrec [DeleteAlarms]
readPrec :: ReadPrec DeleteAlarms
$creadPrec :: ReadPrec DeleteAlarms
readList :: ReadS [DeleteAlarms]
$creadList :: ReadS [DeleteAlarms]
readsPrec :: Int -> ReadS DeleteAlarms
$creadsPrec :: Int -> ReadS DeleteAlarms
Prelude.Read, Int -> DeleteAlarms -> ShowS
[DeleteAlarms] -> ShowS
DeleteAlarms -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeleteAlarms] -> ShowS
$cshowList :: [DeleteAlarms] -> ShowS
show :: DeleteAlarms -> String
$cshow :: DeleteAlarms -> String
showsPrec :: Int -> DeleteAlarms -> ShowS
$cshowsPrec :: Int -> DeleteAlarms -> ShowS
Prelude.Show, forall x. Rep DeleteAlarms x -> DeleteAlarms
forall x. DeleteAlarms -> Rep DeleteAlarms x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DeleteAlarms x -> DeleteAlarms
$cfrom :: forall x. DeleteAlarms -> Rep DeleteAlarms x
Prelude.Generic)

-- |
-- Create a value of 'DeleteAlarms' 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:
--
-- 'alarmNames', 'deleteAlarms_alarmNames' - The alarms to be deleted.
newDeleteAlarms ::
  DeleteAlarms
newDeleteAlarms :: DeleteAlarms
newDeleteAlarms =
  DeleteAlarms' {$sel:alarmNames:DeleteAlarms' :: [Text]
alarmNames = forall a. Monoid a => a
Prelude.mempty}

-- | The alarms to be deleted.
deleteAlarms_alarmNames :: Lens.Lens' DeleteAlarms [Prelude.Text]
deleteAlarms_alarmNames :: Lens' DeleteAlarms [Text]
deleteAlarms_alarmNames = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteAlarms' {[Text]
alarmNames :: [Text]
$sel:alarmNames:DeleteAlarms' :: DeleteAlarms -> [Text]
alarmNames} -> [Text]
alarmNames) (\s :: DeleteAlarms
s@DeleteAlarms' {} [Text]
a -> DeleteAlarms
s {$sel:alarmNames:DeleteAlarms' :: [Text]
alarmNames = [Text]
a} :: DeleteAlarms) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

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

instance Prelude.Hashable DeleteAlarms where
  hashWithSalt :: Int -> DeleteAlarms -> Int
hashWithSalt Int
_salt DeleteAlarms' {[Text]
alarmNames :: [Text]
$sel:alarmNames:DeleteAlarms' :: DeleteAlarms -> [Text]
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` [Text]
alarmNames

instance Prelude.NFData DeleteAlarms where
  rnf :: DeleteAlarms -> ()
rnf DeleteAlarms' {[Text]
alarmNames :: [Text]
$sel:alarmNames:DeleteAlarms' :: DeleteAlarms -> [Text]
..} = forall a. NFData a => a -> ()
Prelude.rnf [Text]
alarmNames

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

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

instance Data.ToQuery DeleteAlarms where
  toQuery :: DeleteAlarms -> QueryString
toQuery DeleteAlarms' {[Text]
alarmNames :: [Text]
$sel:alarmNames:DeleteAlarms' :: DeleteAlarms -> [Text]
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"DeleteAlarms" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2010-08-01" :: Prelude.ByteString),
        ByteString
"AlarmNames"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: forall a.
(IsList a, ToQuery (Item a)) =>
ByteString -> a -> QueryString
Data.toQueryList ByteString
"member" [Text]
alarmNames
      ]

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

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

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