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

    -- * Request Lenses
    batchEnableAlarm_enableActionRequests,

    -- * Destructuring the Response
    BatchEnableAlarmResponse (..),
    newBatchEnableAlarmResponse,

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

-- |
-- Create a value of 'BatchEnableAlarm' 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:
--
-- 'enableActionRequests', 'batchEnableAlarm_enableActionRequests' - The list of enable action requests. You can specify up to 10 requests
-- per operation.
newBatchEnableAlarm ::
  -- | 'enableActionRequests'
  Prelude.NonEmpty EnableAlarmActionRequest ->
  BatchEnableAlarm
newBatchEnableAlarm :: NonEmpty EnableAlarmActionRequest -> BatchEnableAlarm
newBatchEnableAlarm NonEmpty EnableAlarmActionRequest
pEnableActionRequests_ =
  BatchEnableAlarm'
    { $sel:enableActionRequests:BatchEnableAlarm' :: NonEmpty EnableAlarmActionRequest
enableActionRequests =
        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 EnableAlarmActionRequest
pEnableActionRequests_
    }

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

instance Prelude.NFData BatchEnableAlarm where
  rnf :: BatchEnableAlarm -> ()
rnf BatchEnableAlarm' {NonEmpty EnableAlarmActionRequest
enableActionRequests :: NonEmpty EnableAlarmActionRequest
$sel:enableActionRequests:BatchEnableAlarm' :: BatchEnableAlarm -> NonEmpty EnableAlarmActionRequest
..} =
    forall a. NFData a => a -> ()
Prelude.rnf NonEmpty EnableAlarmActionRequest
enableActionRequests

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

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

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

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

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

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

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