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

    -- * Request Lenses
    batchResetAlarm_resetActionRequests,

    -- * Destructuring the Response
    BatchResetAlarmResponse (..),
    newBatchResetAlarmResponse,

    -- * Response Lenses
    batchResetAlarmResponse_errorEntries,
    batchResetAlarmResponse_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:/ 'newBatchResetAlarm' smart constructor.
data BatchResetAlarm = BatchResetAlarm'
  { -- | The list of reset action requests. You can specify up to 10 requests per
    -- operation.
    BatchResetAlarm -> NonEmpty ResetAlarmActionRequest
resetActionRequests :: Prelude.NonEmpty ResetAlarmActionRequest
  }
  deriving (BatchResetAlarm -> BatchResetAlarm -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BatchResetAlarm -> BatchResetAlarm -> Bool
$c/= :: BatchResetAlarm -> BatchResetAlarm -> Bool
== :: BatchResetAlarm -> BatchResetAlarm -> Bool
$c== :: BatchResetAlarm -> BatchResetAlarm -> Bool
Prelude.Eq, ReadPrec [BatchResetAlarm]
ReadPrec BatchResetAlarm
Int -> ReadS BatchResetAlarm
ReadS [BatchResetAlarm]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [BatchResetAlarm]
$creadListPrec :: ReadPrec [BatchResetAlarm]
readPrec :: ReadPrec BatchResetAlarm
$creadPrec :: ReadPrec BatchResetAlarm
readList :: ReadS [BatchResetAlarm]
$creadList :: ReadS [BatchResetAlarm]
readsPrec :: Int -> ReadS BatchResetAlarm
$creadsPrec :: Int -> ReadS BatchResetAlarm
Prelude.Read, Int -> BatchResetAlarm -> ShowS
[BatchResetAlarm] -> ShowS
BatchResetAlarm -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BatchResetAlarm] -> ShowS
$cshowList :: [BatchResetAlarm] -> ShowS
show :: BatchResetAlarm -> String
$cshow :: BatchResetAlarm -> String
showsPrec :: Int -> BatchResetAlarm -> ShowS
$cshowsPrec :: Int -> BatchResetAlarm -> ShowS
Prelude.Show, forall x. Rep BatchResetAlarm x -> BatchResetAlarm
forall x. BatchResetAlarm -> Rep BatchResetAlarm x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BatchResetAlarm x -> BatchResetAlarm
$cfrom :: forall x. BatchResetAlarm -> Rep BatchResetAlarm x
Prelude.Generic)

-- |
-- Create a value of 'BatchResetAlarm' 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:
--
-- 'resetActionRequests', 'batchResetAlarm_resetActionRequests' - The list of reset action requests. You can specify up to 10 requests per
-- operation.
newBatchResetAlarm ::
  -- | 'resetActionRequests'
  Prelude.NonEmpty ResetAlarmActionRequest ->
  BatchResetAlarm
newBatchResetAlarm :: NonEmpty ResetAlarmActionRequest -> BatchResetAlarm
newBatchResetAlarm NonEmpty ResetAlarmActionRequest
pResetActionRequests_ =
  BatchResetAlarm'
    { $sel:resetActionRequests:BatchResetAlarm' :: NonEmpty ResetAlarmActionRequest
resetActionRequests =
        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 ResetAlarmActionRequest
pResetActionRequests_
    }

-- | The list of reset action requests. You can specify up to 10 requests per
-- operation.
batchResetAlarm_resetActionRequests :: Lens.Lens' BatchResetAlarm (Prelude.NonEmpty ResetAlarmActionRequest)
batchResetAlarm_resetActionRequests :: Lens' BatchResetAlarm (NonEmpty ResetAlarmActionRequest)
batchResetAlarm_resetActionRequests = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchResetAlarm' {NonEmpty ResetAlarmActionRequest
resetActionRequests :: NonEmpty ResetAlarmActionRequest
$sel:resetActionRequests:BatchResetAlarm' :: BatchResetAlarm -> NonEmpty ResetAlarmActionRequest
resetActionRequests} -> NonEmpty ResetAlarmActionRequest
resetActionRequests) (\s :: BatchResetAlarm
s@BatchResetAlarm' {} NonEmpty ResetAlarmActionRequest
a -> BatchResetAlarm
s {$sel:resetActionRequests:BatchResetAlarm' :: NonEmpty ResetAlarmActionRequest
resetActionRequests = NonEmpty ResetAlarmActionRequest
a} :: BatchResetAlarm) 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 BatchResetAlarm where
  type
    AWSResponse BatchResetAlarm =
      BatchResetAlarmResponse
  request :: (Service -> Service) -> BatchResetAlarm -> Request BatchResetAlarm
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 BatchResetAlarm
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse BatchResetAlarm)))
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 -> BatchResetAlarmResponse
BatchResetAlarmResponse'
            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 BatchResetAlarm where
  hashWithSalt :: Int -> BatchResetAlarm -> Int
hashWithSalt Int
_salt BatchResetAlarm' {NonEmpty ResetAlarmActionRequest
resetActionRequests :: NonEmpty ResetAlarmActionRequest
$sel:resetActionRequests:BatchResetAlarm' :: BatchResetAlarm -> NonEmpty ResetAlarmActionRequest
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` NonEmpty ResetAlarmActionRequest
resetActionRequests

instance Prelude.NFData BatchResetAlarm where
  rnf :: BatchResetAlarm -> ()
rnf BatchResetAlarm' {NonEmpty ResetAlarmActionRequest
resetActionRequests :: NonEmpty ResetAlarmActionRequest
$sel:resetActionRequests:BatchResetAlarm' :: BatchResetAlarm -> NonEmpty ResetAlarmActionRequest
..} =
    forall a. NFData a => a -> ()
Prelude.rnf NonEmpty ResetAlarmActionRequest
resetActionRequests

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

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

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

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

-- | /See:/ 'newBatchResetAlarmResponse' smart constructor.
data BatchResetAlarmResponse = BatchResetAlarmResponse'
  { -- | 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.
    BatchResetAlarmResponse -> Maybe [BatchAlarmActionErrorEntry]
errorEntries :: Prelude.Maybe [BatchAlarmActionErrorEntry],
    -- | The response's http status code.
    BatchResetAlarmResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (BatchResetAlarmResponse -> BatchResetAlarmResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BatchResetAlarmResponse -> BatchResetAlarmResponse -> Bool
$c/= :: BatchResetAlarmResponse -> BatchResetAlarmResponse -> Bool
== :: BatchResetAlarmResponse -> BatchResetAlarmResponse -> Bool
$c== :: BatchResetAlarmResponse -> BatchResetAlarmResponse -> Bool
Prelude.Eq, ReadPrec [BatchResetAlarmResponse]
ReadPrec BatchResetAlarmResponse
Int -> ReadS BatchResetAlarmResponse
ReadS [BatchResetAlarmResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [BatchResetAlarmResponse]
$creadListPrec :: ReadPrec [BatchResetAlarmResponse]
readPrec :: ReadPrec BatchResetAlarmResponse
$creadPrec :: ReadPrec BatchResetAlarmResponse
readList :: ReadS [BatchResetAlarmResponse]
$creadList :: ReadS [BatchResetAlarmResponse]
readsPrec :: Int -> ReadS BatchResetAlarmResponse
$creadsPrec :: Int -> ReadS BatchResetAlarmResponse
Prelude.Read, Int -> BatchResetAlarmResponse -> ShowS
[BatchResetAlarmResponse] -> ShowS
BatchResetAlarmResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BatchResetAlarmResponse] -> ShowS
$cshowList :: [BatchResetAlarmResponse] -> ShowS
show :: BatchResetAlarmResponse -> String
$cshow :: BatchResetAlarmResponse -> String
showsPrec :: Int -> BatchResetAlarmResponse -> ShowS
$cshowsPrec :: Int -> BatchResetAlarmResponse -> ShowS
Prelude.Show, forall x. Rep BatchResetAlarmResponse x -> BatchResetAlarmResponse
forall x. BatchResetAlarmResponse -> Rep BatchResetAlarmResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BatchResetAlarmResponse x -> BatchResetAlarmResponse
$cfrom :: forall x. BatchResetAlarmResponse -> Rep BatchResetAlarmResponse x
Prelude.Generic)

-- |
-- Create a value of 'BatchResetAlarmResponse' 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', 'batchResetAlarmResponse_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', 'batchResetAlarmResponse_httpStatus' - The response's http status code.
newBatchResetAlarmResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  BatchResetAlarmResponse
newBatchResetAlarmResponse :: Int -> BatchResetAlarmResponse
newBatchResetAlarmResponse Int
pHttpStatus_ =
  BatchResetAlarmResponse'
    { $sel:errorEntries:BatchResetAlarmResponse' :: Maybe [BatchAlarmActionErrorEntry]
errorEntries =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:BatchResetAlarmResponse' :: 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.
batchResetAlarmResponse_errorEntries :: Lens.Lens' BatchResetAlarmResponse (Prelude.Maybe [BatchAlarmActionErrorEntry])
batchResetAlarmResponse_errorEntries :: Lens' BatchResetAlarmResponse (Maybe [BatchAlarmActionErrorEntry])
batchResetAlarmResponse_errorEntries = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchResetAlarmResponse' {Maybe [BatchAlarmActionErrorEntry]
errorEntries :: Maybe [BatchAlarmActionErrorEntry]
$sel:errorEntries:BatchResetAlarmResponse' :: BatchResetAlarmResponse -> Maybe [BatchAlarmActionErrorEntry]
errorEntries} -> Maybe [BatchAlarmActionErrorEntry]
errorEntries) (\s :: BatchResetAlarmResponse
s@BatchResetAlarmResponse' {} Maybe [BatchAlarmActionErrorEntry]
a -> BatchResetAlarmResponse
s {$sel:errorEntries:BatchResetAlarmResponse' :: Maybe [BatchAlarmActionErrorEntry]
errorEntries = Maybe [BatchAlarmActionErrorEntry]
a} :: BatchResetAlarmResponse) 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.
batchResetAlarmResponse_httpStatus :: Lens.Lens' BatchResetAlarmResponse Prelude.Int
batchResetAlarmResponse_httpStatus :: Lens' BatchResetAlarmResponse Int
batchResetAlarmResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchResetAlarmResponse' {Int
httpStatus :: Int
$sel:httpStatus:BatchResetAlarmResponse' :: BatchResetAlarmResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: BatchResetAlarmResponse
s@BatchResetAlarmResponse' {} Int
a -> BatchResetAlarmResponse
s {$sel:httpStatus:BatchResetAlarmResponse' :: Int
httpStatus = Int
a} :: BatchResetAlarmResponse)

instance Prelude.NFData BatchResetAlarmResponse where
  rnf :: BatchResetAlarmResponse -> ()
rnf BatchResetAlarmResponse' {Int
Maybe [BatchAlarmActionErrorEntry]
httpStatus :: Int
errorEntries :: Maybe [BatchAlarmActionErrorEntry]
$sel:httpStatus:BatchResetAlarmResponse' :: BatchResetAlarmResponse -> Int
$sel:errorEntries:BatchResetAlarmResponse' :: BatchResetAlarmResponse -> 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