{-# 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.BatchUpdateDetector
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Updates the state, variable values, and timer settings of one or more
-- detectors (instances) of a specified detector model.
module Amazonka.IoTEventsData.BatchUpdateDetector
  ( -- * Creating a Request
    BatchUpdateDetector (..),
    newBatchUpdateDetector,

    -- * Request Lenses
    batchUpdateDetector_detectors,

    -- * Destructuring the Response
    BatchUpdateDetectorResponse (..),
    newBatchUpdateDetectorResponse,

    -- * Response Lenses
    batchUpdateDetectorResponse_batchUpdateDetectorErrorEntries,
    batchUpdateDetectorResponse_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:/ 'newBatchUpdateDetector' smart constructor.
data BatchUpdateDetector = BatchUpdateDetector'
  { -- | The list of detectors (instances) to update, along with the values to
    -- update.
    BatchUpdateDetector -> NonEmpty UpdateDetectorRequest
detectors :: Prelude.NonEmpty UpdateDetectorRequest
  }
  deriving (BatchUpdateDetector -> BatchUpdateDetector -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BatchUpdateDetector -> BatchUpdateDetector -> Bool
$c/= :: BatchUpdateDetector -> BatchUpdateDetector -> Bool
== :: BatchUpdateDetector -> BatchUpdateDetector -> Bool
$c== :: BatchUpdateDetector -> BatchUpdateDetector -> Bool
Prelude.Eq, ReadPrec [BatchUpdateDetector]
ReadPrec BatchUpdateDetector
Int -> ReadS BatchUpdateDetector
ReadS [BatchUpdateDetector]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [BatchUpdateDetector]
$creadListPrec :: ReadPrec [BatchUpdateDetector]
readPrec :: ReadPrec BatchUpdateDetector
$creadPrec :: ReadPrec BatchUpdateDetector
readList :: ReadS [BatchUpdateDetector]
$creadList :: ReadS [BatchUpdateDetector]
readsPrec :: Int -> ReadS BatchUpdateDetector
$creadsPrec :: Int -> ReadS BatchUpdateDetector
Prelude.Read, Int -> BatchUpdateDetector -> ShowS
[BatchUpdateDetector] -> ShowS
BatchUpdateDetector -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BatchUpdateDetector] -> ShowS
$cshowList :: [BatchUpdateDetector] -> ShowS
show :: BatchUpdateDetector -> String
$cshow :: BatchUpdateDetector -> String
showsPrec :: Int -> BatchUpdateDetector -> ShowS
$cshowsPrec :: Int -> BatchUpdateDetector -> ShowS
Prelude.Show, forall x. Rep BatchUpdateDetector x -> BatchUpdateDetector
forall x. BatchUpdateDetector -> Rep BatchUpdateDetector x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BatchUpdateDetector x -> BatchUpdateDetector
$cfrom :: forall x. BatchUpdateDetector -> Rep BatchUpdateDetector x
Prelude.Generic)

-- |
-- Create a value of 'BatchUpdateDetector' 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', 'batchUpdateDetector_detectors' - The list of detectors (instances) to update, along with the values to
-- update.
newBatchUpdateDetector ::
  -- | 'detectors'
  Prelude.NonEmpty UpdateDetectorRequest ->
  BatchUpdateDetector
newBatchUpdateDetector :: NonEmpty UpdateDetectorRequest -> BatchUpdateDetector
newBatchUpdateDetector NonEmpty UpdateDetectorRequest
pDetectors_ =
  BatchUpdateDetector'
    { $sel:detectors:BatchUpdateDetector' :: NonEmpty UpdateDetectorRequest
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 UpdateDetectorRequest
pDetectors_
    }

-- | The list of detectors (instances) to update, along with the values to
-- update.
batchUpdateDetector_detectors :: Lens.Lens' BatchUpdateDetector (Prelude.NonEmpty UpdateDetectorRequest)
batchUpdateDetector_detectors :: Lens' BatchUpdateDetector (NonEmpty UpdateDetectorRequest)
batchUpdateDetector_detectors = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchUpdateDetector' {NonEmpty UpdateDetectorRequest
detectors :: NonEmpty UpdateDetectorRequest
$sel:detectors:BatchUpdateDetector' :: BatchUpdateDetector -> NonEmpty UpdateDetectorRequest
detectors} -> NonEmpty UpdateDetectorRequest
detectors) (\s :: BatchUpdateDetector
s@BatchUpdateDetector' {} NonEmpty UpdateDetectorRequest
a -> BatchUpdateDetector
s {$sel:detectors:BatchUpdateDetector' :: NonEmpty UpdateDetectorRequest
detectors = NonEmpty UpdateDetectorRequest
a} :: BatchUpdateDetector) 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 BatchUpdateDetector where
  type
    AWSResponse BatchUpdateDetector =
      BatchUpdateDetectorResponse
  request :: (Service -> Service)
-> BatchUpdateDetector -> Request BatchUpdateDetector
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 BatchUpdateDetector
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse BatchUpdateDetector)))
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 [BatchUpdateDetectorErrorEntry]
-> Int -> BatchUpdateDetectorResponse
BatchUpdateDetectorResponse'
            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
"batchUpdateDetectorErrorEntries"
                            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 BatchUpdateDetector where
  hashWithSalt :: Int -> BatchUpdateDetector -> Int
hashWithSalt Int
_salt BatchUpdateDetector' {NonEmpty UpdateDetectorRequest
detectors :: NonEmpty UpdateDetectorRequest
$sel:detectors:BatchUpdateDetector' :: BatchUpdateDetector -> NonEmpty UpdateDetectorRequest
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` NonEmpty UpdateDetectorRequest
detectors

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

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

instance Data.ToJSON BatchUpdateDetector where
  toJSON :: BatchUpdateDetector -> Value
toJSON BatchUpdateDetector' {NonEmpty UpdateDetectorRequest
detectors :: NonEmpty UpdateDetectorRequest
$sel:detectors:BatchUpdateDetector' :: BatchUpdateDetector -> NonEmpty UpdateDetectorRequest
..} =
    [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 UpdateDetectorRequest
detectors)]
      )

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

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

-- | /See:/ 'newBatchUpdateDetectorResponse' smart constructor.
data BatchUpdateDetectorResponse = BatchUpdateDetectorResponse'
  { -- | A list of those detector updates that resulted in errors. (If an error
    -- is listed here, the specific update did not occur.)
    BatchUpdateDetectorResponse
-> Maybe [BatchUpdateDetectorErrorEntry]
batchUpdateDetectorErrorEntries :: Prelude.Maybe [BatchUpdateDetectorErrorEntry],
    -- | The response's http status code.
    BatchUpdateDetectorResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (BatchUpdateDetectorResponse -> BatchUpdateDetectorResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BatchUpdateDetectorResponse -> BatchUpdateDetectorResponse -> Bool
$c/= :: BatchUpdateDetectorResponse -> BatchUpdateDetectorResponse -> Bool
== :: BatchUpdateDetectorResponse -> BatchUpdateDetectorResponse -> Bool
$c== :: BatchUpdateDetectorResponse -> BatchUpdateDetectorResponse -> Bool
Prelude.Eq, ReadPrec [BatchUpdateDetectorResponse]
ReadPrec BatchUpdateDetectorResponse
Int -> ReadS BatchUpdateDetectorResponse
ReadS [BatchUpdateDetectorResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [BatchUpdateDetectorResponse]
$creadListPrec :: ReadPrec [BatchUpdateDetectorResponse]
readPrec :: ReadPrec BatchUpdateDetectorResponse
$creadPrec :: ReadPrec BatchUpdateDetectorResponse
readList :: ReadS [BatchUpdateDetectorResponse]
$creadList :: ReadS [BatchUpdateDetectorResponse]
readsPrec :: Int -> ReadS BatchUpdateDetectorResponse
$creadsPrec :: Int -> ReadS BatchUpdateDetectorResponse
Prelude.Read, Int -> BatchUpdateDetectorResponse -> ShowS
[BatchUpdateDetectorResponse] -> ShowS
BatchUpdateDetectorResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BatchUpdateDetectorResponse] -> ShowS
$cshowList :: [BatchUpdateDetectorResponse] -> ShowS
show :: BatchUpdateDetectorResponse -> String
$cshow :: BatchUpdateDetectorResponse -> String
showsPrec :: Int -> BatchUpdateDetectorResponse -> ShowS
$cshowsPrec :: Int -> BatchUpdateDetectorResponse -> ShowS
Prelude.Show, forall x.
Rep BatchUpdateDetectorResponse x -> BatchUpdateDetectorResponse
forall x.
BatchUpdateDetectorResponse -> Rep BatchUpdateDetectorResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep BatchUpdateDetectorResponse x -> BatchUpdateDetectorResponse
$cfrom :: forall x.
BatchUpdateDetectorResponse -> Rep BatchUpdateDetectorResponse x
Prelude.Generic)

-- |
-- Create a value of 'BatchUpdateDetectorResponse' 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:
--
-- 'batchUpdateDetectorErrorEntries', 'batchUpdateDetectorResponse_batchUpdateDetectorErrorEntries' - A list of those detector updates that resulted in errors. (If an error
-- is listed here, the specific update did not occur.)
--
-- 'httpStatus', 'batchUpdateDetectorResponse_httpStatus' - The response's http status code.
newBatchUpdateDetectorResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  BatchUpdateDetectorResponse
newBatchUpdateDetectorResponse :: Int -> BatchUpdateDetectorResponse
newBatchUpdateDetectorResponse Int
pHttpStatus_ =
  BatchUpdateDetectorResponse'
    { $sel:batchUpdateDetectorErrorEntries:BatchUpdateDetectorResponse' :: Maybe [BatchUpdateDetectorErrorEntry]
batchUpdateDetectorErrorEntries =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:BatchUpdateDetectorResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | A list of those detector updates that resulted in errors. (If an error
-- is listed here, the specific update did not occur.)
batchUpdateDetectorResponse_batchUpdateDetectorErrorEntries :: Lens.Lens' BatchUpdateDetectorResponse (Prelude.Maybe [BatchUpdateDetectorErrorEntry])
batchUpdateDetectorResponse_batchUpdateDetectorErrorEntries :: Lens'
  BatchUpdateDetectorResponse (Maybe [BatchUpdateDetectorErrorEntry])
batchUpdateDetectorResponse_batchUpdateDetectorErrorEntries = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchUpdateDetectorResponse' {Maybe [BatchUpdateDetectorErrorEntry]
batchUpdateDetectorErrorEntries :: Maybe [BatchUpdateDetectorErrorEntry]
$sel:batchUpdateDetectorErrorEntries:BatchUpdateDetectorResponse' :: BatchUpdateDetectorResponse
-> Maybe [BatchUpdateDetectorErrorEntry]
batchUpdateDetectorErrorEntries} -> Maybe [BatchUpdateDetectorErrorEntry]
batchUpdateDetectorErrorEntries) (\s :: BatchUpdateDetectorResponse
s@BatchUpdateDetectorResponse' {} Maybe [BatchUpdateDetectorErrorEntry]
a -> BatchUpdateDetectorResponse
s {$sel:batchUpdateDetectorErrorEntries:BatchUpdateDetectorResponse' :: Maybe [BatchUpdateDetectorErrorEntry]
batchUpdateDetectorErrorEntries = Maybe [BatchUpdateDetectorErrorEntry]
a} :: BatchUpdateDetectorResponse) 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.
batchUpdateDetectorResponse_httpStatus :: Lens.Lens' BatchUpdateDetectorResponse Prelude.Int
batchUpdateDetectorResponse_httpStatus :: Lens' BatchUpdateDetectorResponse Int
batchUpdateDetectorResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchUpdateDetectorResponse' {Int
httpStatus :: Int
$sel:httpStatus:BatchUpdateDetectorResponse' :: BatchUpdateDetectorResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: BatchUpdateDetectorResponse
s@BatchUpdateDetectorResponse' {} Int
a -> BatchUpdateDetectorResponse
s {$sel:httpStatus:BatchUpdateDetectorResponse' :: Int
httpStatus = Int
a} :: BatchUpdateDetectorResponse)

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