{-# 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.IoTEventsData.BatchDisableAlarm
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Disables one or more alarms. The alarms change to the @DISABLED@ state
-- after you disable them.
module Amazonka.IoTEventsData.BatchDisableAlarm
  ( -- * Creating a Request
    BatchDisableAlarm (..),
    newBatchDisableAlarm,

    -- * Request Lenses
    batchDisableAlarm_disableActionRequests,

    -- * Destructuring the Response
    BatchDisableAlarmResponse (..),
    newBatchDisableAlarmResponse,

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

-- | /See:/ 'newBatchDisableAlarm' smart constructor.
data BatchDisableAlarm = BatchDisableAlarm'
  { -- | The list of disable action requests. You can specify up to 10 requests
    -- per operation.
    BatchDisableAlarm -> NonEmpty DisableAlarmActionRequest
disableActionRequests :: Prelude.NonEmpty DisableAlarmActionRequest
  }
  deriving (BatchDisableAlarm -> BatchDisableAlarm -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BatchDisableAlarm -> BatchDisableAlarm -> Bool
$c/= :: BatchDisableAlarm -> BatchDisableAlarm -> Bool
== :: BatchDisableAlarm -> BatchDisableAlarm -> Bool
$c== :: BatchDisableAlarm -> BatchDisableAlarm -> Bool
Prelude.Eq, ReadPrec [BatchDisableAlarm]
ReadPrec BatchDisableAlarm
Int -> ReadS BatchDisableAlarm
ReadS [BatchDisableAlarm]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [BatchDisableAlarm]
$creadListPrec :: ReadPrec [BatchDisableAlarm]
readPrec :: ReadPrec BatchDisableAlarm
$creadPrec :: ReadPrec BatchDisableAlarm
readList :: ReadS [BatchDisableAlarm]
$creadList :: ReadS [BatchDisableAlarm]
readsPrec :: Int -> ReadS BatchDisableAlarm
$creadsPrec :: Int -> ReadS BatchDisableAlarm
Prelude.Read, Int -> BatchDisableAlarm -> ShowS
[BatchDisableAlarm] -> ShowS
BatchDisableAlarm -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BatchDisableAlarm] -> ShowS
$cshowList :: [BatchDisableAlarm] -> ShowS
show :: BatchDisableAlarm -> String
$cshow :: BatchDisableAlarm -> String
showsPrec :: Int -> BatchDisableAlarm -> ShowS
$cshowsPrec :: Int -> BatchDisableAlarm -> ShowS
Prelude.Show, forall x. Rep BatchDisableAlarm x -> BatchDisableAlarm
forall x. BatchDisableAlarm -> Rep BatchDisableAlarm x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BatchDisableAlarm x -> BatchDisableAlarm
$cfrom :: forall x. BatchDisableAlarm -> Rep BatchDisableAlarm x
Prelude.Generic)

-- |
-- Create a value of 'BatchDisableAlarm' 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:
--
-- 'disableActionRequests', 'batchDisableAlarm_disableActionRequests' - The list of disable action requests. You can specify up to 10 requests
-- per operation.
newBatchDisableAlarm ::
  -- | 'disableActionRequests'
  Prelude.NonEmpty DisableAlarmActionRequest ->
  BatchDisableAlarm
newBatchDisableAlarm :: NonEmpty DisableAlarmActionRequest -> BatchDisableAlarm
newBatchDisableAlarm NonEmpty DisableAlarmActionRequest
pDisableActionRequests_ =
  BatchDisableAlarm'
    { $sel:disableActionRequests:BatchDisableAlarm' :: NonEmpty DisableAlarmActionRequest
disableActionRequests =
        forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced forall t b. AReview t b -> b -> t
Lens.# NonEmpty DisableAlarmActionRequest
pDisableActionRequests_
    }

-- | The list of disable action requests. You can specify up to 10 requests
-- per operation.
batchDisableAlarm_disableActionRequests :: Lens.Lens' BatchDisableAlarm (Prelude.NonEmpty DisableAlarmActionRequest)
batchDisableAlarm_disableActionRequests :: Lens' BatchDisableAlarm (NonEmpty DisableAlarmActionRequest)
batchDisableAlarm_disableActionRequests = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchDisableAlarm' {NonEmpty DisableAlarmActionRequest
disableActionRequests :: NonEmpty DisableAlarmActionRequest
$sel:disableActionRequests:BatchDisableAlarm' :: BatchDisableAlarm -> NonEmpty DisableAlarmActionRequest
disableActionRequests} -> NonEmpty DisableAlarmActionRequest
disableActionRequests) (\s :: BatchDisableAlarm
s@BatchDisableAlarm' {} NonEmpty DisableAlarmActionRequest
a -> BatchDisableAlarm
s {$sel:disableActionRequests:BatchDisableAlarm' :: NonEmpty DisableAlarmActionRequest
disableActionRequests = NonEmpty DisableAlarmActionRequest
a} :: BatchDisableAlarm) 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 BatchDisableAlarm where
  type
    AWSResponse BatchDisableAlarm =
      BatchDisableAlarmResponse
  request :: (Service -> Service)
-> BatchDisableAlarm -> Request BatchDisableAlarm
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 BatchDisableAlarm
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse BatchDisableAlarm)))
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 [BatchAlarmActionErrorEntry]
-> Int -> BatchDisableAlarmResponse
BatchDisableAlarmResponse'
            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
"errorEntries" 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 BatchDisableAlarm where
  hashWithSalt :: Int -> BatchDisableAlarm -> Int
hashWithSalt Int
_salt BatchDisableAlarm' {NonEmpty DisableAlarmActionRequest
disableActionRequests :: NonEmpty DisableAlarmActionRequest
$sel:disableActionRequests:BatchDisableAlarm' :: BatchDisableAlarm -> NonEmpty DisableAlarmActionRequest
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` NonEmpty DisableAlarmActionRequest
disableActionRequests

instance Prelude.NFData BatchDisableAlarm where
  rnf :: BatchDisableAlarm -> ()
rnf BatchDisableAlarm' {NonEmpty DisableAlarmActionRequest
disableActionRequests :: NonEmpty DisableAlarmActionRequest
$sel:disableActionRequests:BatchDisableAlarm' :: BatchDisableAlarm -> NonEmpty DisableAlarmActionRequest
..} =
    forall a. NFData a => a -> ()
Prelude.rnf NonEmpty DisableAlarmActionRequest
disableActionRequests

instance Data.ToHeaders BatchDisableAlarm where
  toHeaders :: BatchDisableAlarm -> ResponseHeaders
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

instance Data.ToJSON BatchDisableAlarm where
  toJSON :: BatchDisableAlarm -> Value
toJSON BatchDisableAlarm' {NonEmpty DisableAlarmActionRequest
disableActionRequests :: NonEmpty DisableAlarmActionRequest
$sel:disableActionRequests:BatchDisableAlarm' :: BatchDisableAlarm -> NonEmpty DisableAlarmActionRequest
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just
              ( Key
"disableActionRequests"
                  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= NonEmpty DisableAlarmActionRequest
disableActionRequests
              )
          ]
      )

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

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

-- | /See:/ 'newBatchDisableAlarmResponse' smart constructor.
data BatchDisableAlarmResponse = BatchDisableAlarmResponse'
  { -- | A list of errors associated with the request, or @null@ if there are no
    -- errors. Each error entry contains an entry ID that helps you identify
    -- the entry that failed.
    BatchDisableAlarmResponse -> Maybe [BatchAlarmActionErrorEntry]
errorEntries :: Prelude.Maybe [BatchAlarmActionErrorEntry],
    -- | The response's http status code.
    BatchDisableAlarmResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (BatchDisableAlarmResponse -> BatchDisableAlarmResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BatchDisableAlarmResponse -> BatchDisableAlarmResponse -> Bool
$c/= :: BatchDisableAlarmResponse -> BatchDisableAlarmResponse -> Bool
== :: BatchDisableAlarmResponse -> BatchDisableAlarmResponse -> Bool
$c== :: BatchDisableAlarmResponse -> BatchDisableAlarmResponse -> Bool
Prelude.Eq, ReadPrec [BatchDisableAlarmResponse]
ReadPrec BatchDisableAlarmResponse
Int -> ReadS BatchDisableAlarmResponse
ReadS [BatchDisableAlarmResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [BatchDisableAlarmResponse]
$creadListPrec :: ReadPrec [BatchDisableAlarmResponse]
readPrec :: ReadPrec BatchDisableAlarmResponse
$creadPrec :: ReadPrec BatchDisableAlarmResponse
readList :: ReadS [BatchDisableAlarmResponse]
$creadList :: ReadS [BatchDisableAlarmResponse]
readsPrec :: Int -> ReadS BatchDisableAlarmResponse
$creadsPrec :: Int -> ReadS BatchDisableAlarmResponse
Prelude.Read, Int -> BatchDisableAlarmResponse -> ShowS
[BatchDisableAlarmResponse] -> ShowS
BatchDisableAlarmResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BatchDisableAlarmResponse] -> ShowS
$cshowList :: [BatchDisableAlarmResponse] -> ShowS
show :: BatchDisableAlarmResponse -> String
$cshow :: BatchDisableAlarmResponse -> String
showsPrec :: Int -> BatchDisableAlarmResponse -> ShowS
$cshowsPrec :: Int -> BatchDisableAlarmResponse -> ShowS
Prelude.Show, forall x.
Rep BatchDisableAlarmResponse x -> BatchDisableAlarmResponse
forall x.
BatchDisableAlarmResponse -> Rep BatchDisableAlarmResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep BatchDisableAlarmResponse x -> BatchDisableAlarmResponse
$cfrom :: forall x.
BatchDisableAlarmResponse -> Rep BatchDisableAlarmResponse x
Prelude.Generic)

-- |
-- Create a value of 'BatchDisableAlarmResponse' 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:
--
-- 'errorEntries', 'batchDisableAlarmResponse_errorEntries' - A list of errors associated with the request, or @null@ if there are no
-- errors. Each error entry contains an entry ID that helps you identify
-- the entry that failed.
--
-- 'httpStatus', 'batchDisableAlarmResponse_httpStatus' - The response's http status code.
newBatchDisableAlarmResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  BatchDisableAlarmResponse
newBatchDisableAlarmResponse :: Int -> BatchDisableAlarmResponse
newBatchDisableAlarmResponse Int
pHttpStatus_ =
  BatchDisableAlarmResponse'
    { $sel:errorEntries:BatchDisableAlarmResponse' :: Maybe [BatchAlarmActionErrorEntry]
errorEntries =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:BatchDisableAlarmResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | A list of errors associated with the request, or @null@ if there are no
-- errors. Each error entry contains an entry ID that helps you identify
-- the entry that failed.
batchDisableAlarmResponse_errorEntries :: Lens.Lens' BatchDisableAlarmResponse (Prelude.Maybe [BatchAlarmActionErrorEntry])
batchDisableAlarmResponse_errorEntries :: Lens'
  BatchDisableAlarmResponse (Maybe [BatchAlarmActionErrorEntry])
batchDisableAlarmResponse_errorEntries = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchDisableAlarmResponse' {Maybe [BatchAlarmActionErrorEntry]
errorEntries :: Maybe [BatchAlarmActionErrorEntry]
$sel:errorEntries:BatchDisableAlarmResponse' :: BatchDisableAlarmResponse -> Maybe [BatchAlarmActionErrorEntry]
errorEntries} -> Maybe [BatchAlarmActionErrorEntry]
errorEntries) (\s :: BatchDisableAlarmResponse
s@BatchDisableAlarmResponse' {} Maybe [BatchAlarmActionErrorEntry]
a -> BatchDisableAlarmResponse
s {$sel:errorEntries:BatchDisableAlarmResponse' :: Maybe [BatchAlarmActionErrorEntry]
errorEntries = Maybe [BatchAlarmActionErrorEntry]
a} :: BatchDisableAlarmResponse) 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.
batchDisableAlarmResponse_httpStatus :: Lens.Lens' BatchDisableAlarmResponse Prelude.Int
batchDisableAlarmResponse_httpStatus :: Lens' BatchDisableAlarmResponse Int
batchDisableAlarmResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchDisableAlarmResponse' {Int
httpStatus :: Int
$sel:httpStatus:BatchDisableAlarmResponse' :: BatchDisableAlarmResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: BatchDisableAlarmResponse
s@BatchDisableAlarmResponse' {} Int
a -> BatchDisableAlarmResponse
s {$sel:httpStatus:BatchDisableAlarmResponse' :: Int
httpStatus = Int
a} :: BatchDisableAlarmResponse)

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