{-# 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.BatchDeleteDetector
-- 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 one or more detectors that were created. When a detector is
-- deleted, its state will be cleared and the detector will be removed from
-- the list of detectors. The deleted detector will no longer appear if
-- referenced in the
-- <https://docs.aws.amazon.com/iotevents/latest/apireference/API_iotevents-data_ListDetectors.html ListDetectors>
-- API call.
module Amazonka.IoTEventsData.BatchDeleteDetector
  ( -- * Creating a Request
    BatchDeleteDetector (..),
    newBatchDeleteDetector,

    -- * Request Lenses
    batchDeleteDetector_detectors,

    -- * Destructuring the Response
    BatchDeleteDetectorResponse (..),
    newBatchDeleteDetectorResponse,

    -- * Response Lenses
    batchDeleteDetectorResponse_batchDeleteDetectorErrorEntries,
    batchDeleteDetectorResponse_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:/ 'newBatchDeleteDetector' smart constructor.
data BatchDeleteDetector = BatchDeleteDetector'
  { -- | The list of one or more detectors to be deleted.
    BatchDeleteDetector -> NonEmpty DeleteDetectorRequest
detectors :: Prelude.NonEmpty DeleteDetectorRequest
  }
  deriving (BatchDeleteDetector -> BatchDeleteDetector -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BatchDeleteDetector -> BatchDeleteDetector -> Bool
$c/= :: BatchDeleteDetector -> BatchDeleteDetector -> Bool
== :: BatchDeleteDetector -> BatchDeleteDetector -> Bool
$c== :: BatchDeleteDetector -> BatchDeleteDetector -> Bool
Prelude.Eq, ReadPrec [BatchDeleteDetector]
ReadPrec BatchDeleteDetector
Int -> ReadS BatchDeleteDetector
ReadS [BatchDeleteDetector]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [BatchDeleteDetector]
$creadListPrec :: ReadPrec [BatchDeleteDetector]
readPrec :: ReadPrec BatchDeleteDetector
$creadPrec :: ReadPrec BatchDeleteDetector
readList :: ReadS [BatchDeleteDetector]
$creadList :: ReadS [BatchDeleteDetector]
readsPrec :: Int -> ReadS BatchDeleteDetector
$creadsPrec :: Int -> ReadS BatchDeleteDetector
Prelude.Read, Int -> BatchDeleteDetector -> ShowS
[BatchDeleteDetector] -> ShowS
BatchDeleteDetector -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BatchDeleteDetector] -> ShowS
$cshowList :: [BatchDeleteDetector] -> ShowS
show :: BatchDeleteDetector -> String
$cshow :: BatchDeleteDetector -> String
showsPrec :: Int -> BatchDeleteDetector -> ShowS
$cshowsPrec :: Int -> BatchDeleteDetector -> ShowS
Prelude.Show, forall x. Rep BatchDeleteDetector x -> BatchDeleteDetector
forall x. BatchDeleteDetector -> Rep BatchDeleteDetector x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BatchDeleteDetector x -> BatchDeleteDetector
$cfrom :: forall x. BatchDeleteDetector -> Rep BatchDeleteDetector x
Prelude.Generic)

-- |
-- Create a value of 'BatchDeleteDetector' 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:
--
-- 'detectors', 'batchDeleteDetector_detectors' - The list of one or more detectors to be deleted.
newBatchDeleteDetector ::
  -- | 'detectors'
  Prelude.NonEmpty DeleteDetectorRequest ->
  BatchDeleteDetector
newBatchDeleteDetector :: NonEmpty DeleteDetectorRequest -> BatchDeleteDetector
newBatchDeleteDetector NonEmpty DeleteDetectorRequest
pDetectors_ =
  BatchDeleteDetector'
    { $sel:detectors:BatchDeleteDetector' :: NonEmpty DeleteDetectorRequest
detectors =
        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 DeleteDetectorRequest
pDetectors_
    }

-- | The list of one or more detectors to be deleted.
batchDeleteDetector_detectors :: Lens.Lens' BatchDeleteDetector (Prelude.NonEmpty DeleteDetectorRequest)
batchDeleteDetector_detectors :: Lens' BatchDeleteDetector (NonEmpty DeleteDetectorRequest)
batchDeleteDetector_detectors = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchDeleteDetector' {NonEmpty DeleteDetectorRequest
detectors :: NonEmpty DeleteDetectorRequest
$sel:detectors:BatchDeleteDetector' :: BatchDeleteDetector -> NonEmpty DeleteDetectorRequest
detectors} -> NonEmpty DeleteDetectorRequest
detectors) (\s :: BatchDeleteDetector
s@BatchDeleteDetector' {} NonEmpty DeleteDetectorRequest
a -> BatchDeleteDetector
s {$sel:detectors:BatchDeleteDetector' :: NonEmpty DeleteDetectorRequest
detectors = NonEmpty DeleteDetectorRequest
a} :: BatchDeleteDetector) 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 BatchDeleteDetector where
  type
    AWSResponse BatchDeleteDetector =
      BatchDeleteDetectorResponse
  request :: (Service -> Service)
-> BatchDeleteDetector -> Request BatchDeleteDetector
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 BatchDeleteDetector
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse BatchDeleteDetector)))
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 [BatchDeleteDetectorErrorEntry]
-> Int -> BatchDeleteDetectorResponse
BatchDeleteDetectorResponse'
            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
"batchDeleteDetectorErrorEntries"
                            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 BatchDeleteDetector where
  hashWithSalt :: Int -> BatchDeleteDetector -> Int
hashWithSalt Int
_salt BatchDeleteDetector' {NonEmpty DeleteDetectorRequest
detectors :: NonEmpty DeleteDetectorRequest
$sel:detectors:BatchDeleteDetector' :: BatchDeleteDetector -> NonEmpty DeleteDetectorRequest
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` NonEmpty DeleteDetectorRequest
detectors

instance Prelude.NFData BatchDeleteDetector where
  rnf :: BatchDeleteDetector -> ()
rnf BatchDeleteDetector' {NonEmpty DeleteDetectorRequest
detectors :: NonEmpty DeleteDetectorRequest
$sel:detectors:BatchDeleteDetector' :: BatchDeleteDetector -> NonEmpty DeleteDetectorRequest
..} = forall a. NFData a => a -> ()
Prelude.rnf NonEmpty DeleteDetectorRequest
detectors

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

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

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

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

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

-- |
-- Create a value of 'BatchDeleteDetectorResponse' 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:
--
-- 'batchDeleteDetectorErrorEntries', 'batchDeleteDetectorResponse_batchDeleteDetectorErrorEntries' - A list of errors associated with the request, or an empty array (@[]@)
-- if there are no errors. Each error entry contains a @messageId@ that
-- helps you identify the entry that failed.
--
-- 'httpStatus', 'batchDeleteDetectorResponse_httpStatus' - The response's http status code.
newBatchDeleteDetectorResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  BatchDeleteDetectorResponse
newBatchDeleteDetectorResponse :: Int -> BatchDeleteDetectorResponse
newBatchDeleteDetectorResponse Int
pHttpStatus_ =
  BatchDeleteDetectorResponse'
    { $sel:batchDeleteDetectorErrorEntries:BatchDeleteDetectorResponse' :: Maybe [BatchDeleteDetectorErrorEntry]
batchDeleteDetectorErrorEntries =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:BatchDeleteDetectorResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | A list of errors associated with the request, or an empty array (@[]@)
-- if there are no errors. Each error entry contains a @messageId@ that
-- helps you identify the entry that failed.
batchDeleteDetectorResponse_batchDeleteDetectorErrorEntries :: Lens.Lens' BatchDeleteDetectorResponse (Prelude.Maybe [BatchDeleteDetectorErrorEntry])
batchDeleteDetectorResponse_batchDeleteDetectorErrorEntries :: Lens'
  BatchDeleteDetectorResponse (Maybe [BatchDeleteDetectorErrorEntry])
batchDeleteDetectorResponse_batchDeleteDetectorErrorEntries = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchDeleteDetectorResponse' {Maybe [BatchDeleteDetectorErrorEntry]
batchDeleteDetectorErrorEntries :: Maybe [BatchDeleteDetectorErrorEntry]
$sel:batchDeleteDetectorErrorEntries:BatchDeleteDetectorResponse' :: BatchDeleteDetectorResponse
-> Maybe [BatchDeleteDetectorErrorEntry]
batchDeleteDetectorErrorEntries} -> Maybe [BatchDeleteDetectorErrorEntry]
batchDeleteDetectorErrorEntries) (\s :: BatchDeleteDetectorResponse
s@BatchDeleteDetectorResponse' {} Maybe [BatchDeleteDetectorErrorEntry]
a -> BatchDeleteDetectorResponse
s {$sel:batchDeleteDetectorErrorEntries:BatchDeleteDetectorResponse' :: Maybe [BatchDeleteDetectorErrorEntry]
batchDeleteDetectorErrorEntries = Maybe [BatchDeleteDetectorErrorEntry]
a} :: BatchDeleteDetectorResponse) 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.
batchDeleteDetectorResponse_httpStatus :: Lens.Lens' BatchDeleteDetectorResponse Prelude.Int
batchDeleteDetectorResponse_httpStatus :: Lens' BatchDeleteDetectorResponse Int
batchDeleteDetectorResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchDeleteDetectorResponse' {Int
httpStatus :: Int
$sel:httpStatus:BatchDeleteDetectorResponse' :: BatchDeleteDetectorResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: BatchDeleteDetectorResponse
s@BatchDeleteDetectorResponse' {} Int
a -> BatchDeleteDetectorResponse
s {$sel:httpStatus:BatchDeleteDetectorResponse' :: Int
httpStatus = Int
a} :: BatchDeleteDetectorResponse)

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