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

    -- * Request Lenses
    batchSnoozeAlarm_snoozeActionRequests,

    -- * Destructuring the Response
    BatchSnoozeAlarmResponse (..),
    newBatchSnoozeAlarmResponse,

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

-- |
-- Create a value of 'BatchSnoozeAlarm' 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:
--
-- 'snoozeActionRequests', 'batchSnoozeAlarm_snoozeActionRequests' - The list of snooze action requests. You can specify up to 10 requests
-- per operation.
newBatchSnoozeAlarm ::
  -- | 'snoozeActionRequests'
  Prelude.NonEmpty SnoozeAlarmActionRequest ->
  BatchSnoozeAlarm
newBatchSnoozeAlarm :: NonEmpty SnoozeAlarmActionRequest -> BatchSnoozeAlarm
newBatchSnoozeAlarm NonEmpty SnoozeAlarmActionRequest
pSnoozeActionRequests_ =
  BatchSnoozeAlarm'
    { $sel:snoozeActionRequests:BatchSnoozeAlarm' :: NonEmpty SnoozeAlarmActionRequest
snoozeActionRequests =
        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 SnoozeAlarmActionRequest
pSnoozeActionRequests_
    }

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

instance Prelude.NFData BatchSnoozeAlarm where
  rnf :: BatchSnoozeAlarm -> ()
rnf BatchSnoozeAlarm' {NonEmpty SnoozeAlarmActionRequest
snoozeActionRequests :: NonEmpty SnoozeAlarmActionRequest
$sel:snoozeActionRequests:BatchSnoozeAlarm' :: BatchSnoozeAlarm -> NonEmpty SnoozeAlarmActionRequest
..} =
    forall a. NFData a => a -> ()
Prelude.rnf NonEmpty SnoozeAlarmActionRequest
snoozeActionRequests

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

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

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

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

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

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

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