{-# 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.IoT.DescribeEventConfigurations
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Describes event configurations.
--
-- Requires permission to access the
-- <https://docs.aws.amazon.com/service-authorization/latest/reference/list_awsiot.html#awsiot-actions-as-permissions DescribeEventConfigurations>
-- action.
module Amazonka.IoT.DescribeEventConfigurations
  ( -- * Creating a Request
    DescribeEventConfigurations (..),
    newDescribeEventConfigurations,

    -- * Destructuring the Response
    DescribeEventConfigurationsResponse (..),
    newDescribeEventConfigurationsResponse,

    -- * Response Lenses
    describeEventConfigurationsResponse_creationDate,
    describeEventConfigurationsResponse_eventConfigurations,
    describeEventConfigurationsResponse_lastModifiedDate,
    describeEventConfigurationsResponse_httpStatus,
  )
where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.IoT.Types
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newDescribeEventConfigurations' smart constructor.
data DescribeEventConfigurations = DescribeEventConfigurations'
  {
  }
  deriving (DescribeEventConfigurations -> DescribeEventConfigurations -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeEventConfigurations -> DescribeEventConfigurations -> Bool
$c/= :: DescribeEventConfigurations -> DescribeEventConfigurations -> Bool
== :: DescribeEventConfigurations -> DescribeEventConfigurations -> Bool
$c== :: DescribeEventConfigurations -> DescribeEventConfigurations -> Bool
Prelude.Eq, ReadPrec [DescribeEventConfigurations]
ReadPrec DescribeEventConfigurations
Int -> ReadS DescribeEventConfigurations
ReadS [DescribeEventConfigurations]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeEventConfigurations]
$creadListPrec :: ReadPrec [DescribeEventConfigurations]
readPrec :: ReadPrec DescribeEventConfigurations
$creadPrec :: ReadPrec DescribeEventConfigurations
readList :: ReadS [DescribeEventConfigurations]
$creadList :: ReadS [DescribeEventConfigurations]
readsPrec :: Int -> ReadS DescribeEventConfigurations
$creadsPrec :: Int -> ReadS DescribeEventConfigurations
Prelude.Read, Int -> DescribeEventConfigurations -> ShowS
[DescribeEventConfigurations] -> ShowS
DescribeEventConfigurations -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeEventConfigurations] -> ShowS
$cshowList :: [DescribeEventConfigurations] -> ShowS
show :: DescribeEventConfigurations -> String
$cshow :: DescribeEventConfigurations -> String
showsPrec :: Int -> DescribeEventConfigurations -> ShowS
$cshowsPrec :: Int -> DescribeEventConfigurations -> ShowS
Prelude.Show, forall x.
Rep DescribeEventConfigurations x -> DescribeEventConfigurations
forall x.
DescribeEventConfigurations -> Rep DescribeEventConfigurations x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DescribeEventConfigurations x -> DescribeEventConfigurations
$cfrom :: forall x.
DescribeEventConfigurations -> Rep DescribeEventConfigurations x
Prelude.Generic)

-- |
-- Create a value of 'DescribeEventConfigurations' 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.
newDescribeEventConfigurations ::
  DescribeEventConfigurations
newDescribeEventConfigurations :: DescribeEventConfigurations
newDescribeEventConfigurations =
  DescribeEventConfigurations
DescribeEventConfigurations'

instance Core.AWSRequest DescribeEventConfigurations where
  type
    AWSResponse DescribeEventConfigurations =
      DescribeEventConfigurationsResponse
  request :: (Service -> Service)
-> DescribeEventConfigurations
-> Request DescribeEventConfigurations
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.get (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy DescribeEventConfigurations
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse DescribeEventConfigurations)))
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 POSIX
-> Maybe (HashMap EventType Configuration)
-> Maybe POSIX
-> Int
-> DescribeEventConfigurationsResponse
DescribeEventConfigurationsResponse'
            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
"creationDate")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ( Object
x
                            forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"eventConfigurations"
                            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.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"lastModifiedDate")
            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 DescribeEventConfigurations where
  hashWithSalt :: Int -> DescribeEventConfigurations -> Int
hashWithSalt Int
_salt DescribeEventConfigurations
_ =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` ()

instance Prelude.NFData DescribeEventConfigurations where
  rnf :: DescribeEventConfigurations -> ()
rnf DescribeEventConfigurations
_ = ()

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

instance Data.ToPath DescribeEventConfigurations where
  toPath :: DescribeEventConfigurations -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/event-configurations"

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

-- | /See:/ 'newDescribeEventConfigurationsResponse' smart constructor.
data DescribeEventConfigurationsResponse = DescribeEventConfigurationsResponse'
  { -- | The creation date of the event configuration.
    DescribeEventConfigurationsResponse -> Maybe POSIX
creationDate :: Prelude.Maybe Data.POSIX,
    -- | The event configurations.
    DescribeEventConfigurationsResponse
-> Maybe (HashMap EventType Configuration)
eventConfigurations :: Prelude.Maybe (Prelude.HashMap EventType Configuration),
    -- | The date the event configurations were last modified.
    DescribeEventConfigurationsResponse -> Maybe POSIX
lastModifiedDate :: Prelude.Maybe Data.POSIX,
    -- | The response's http status code.
    DescribeEventConfigurationsResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (DescribeEventConfigurationsResponse
-> DescribeEventConfigurationsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeEventConfigurationsResponse
-> DescribeEventConfigurationsResponse -> Bool
$c/= :: DescribeEventConfigurationsResponse
-> DescribeEventConfigurationsResponse -> Bool
== :: DescribeEventConfigurationsResponse
-> DescribeEventConfigurationsResponse -> Bool
$c== :: DescribeEventConfigurationsResponse
-> DescribeEventConfigurationsResponse -> Bool
Prelude.Eq, ReadPrec [DescribeEventConfigurationsResponse]
ReadPrec DescribeEventConfigurationsResponse
Int -> ReadS DescribeEventConfigurationsResponse
ReadS [DescribeEventConfigurationsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeEventConfigurationsResponse]
$creadListPrec :: ReadPrec [DescribeEventConfigurationsResponse]
readPrec :: ReadPrec DescribeEventConfigurationsResponse
$creadPrec :: ReadPrec DescribeEventConfigurationsResponse
readList :: ReadS [DescribeEventConfigurationsResponse]
$creadList :: ReadS [DescribeEventConfigurationsResponse]
readsPrec :: Int -> ReadS DescribeEventConfigurationsResponse
$creadsPrec :: Int -> ReadS DescribeEventConfigurationsResponse
Prelude.Read, Int -> DescribeEventConfigurationsResponse -> ShowS
[DescribeEventConfigurationsResponse] -> ShowS
DescribeEventConfigurationsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeEventConfigurationsResponse] -> ShowS
$cshowList :: [DescribeEventConfigurationsResponse] -> ShowS
show :: DescribeEventConfigurationsResponse -> String
$cshow :: DescribeEventConfigurationsResponse -> String
showsPrec :: Int -> DescribeEventConfigurationsResponse -> ShowS
$cshowsPrec :: Int -> DescribeEventConfigurationsResponse -> ShowS
Prelude.Show, forall x.
Rep DescribeEventConfigurationsResponse x
-> DescribeEventConfigurationsResponse
forall x.
DescribeEventConfigurationsResponse
-> Rep DescribeEventConfigurationsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DescribeEventConfigurationsResponse x
-> DescribeEventConfigurationsResponse
$cfrom :: forall x.
DescribeEventConfigurationsResponse
-> Rep DescribeEventConfigurationsResponse x
Prelude.Generic)

-- |
-- Create a value of 'DescribeEventConfigurationsResponse' 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:
--
-- 'creationDate', 'describeEventConfigurationsResponse_creationDate' - The creation date of the event configuration.
--
-- 'eventConfigurations', 'describeEventConfigurationsResponse_eventConfigurations' - The event configurations.
--
-- 'lastModifiedDate', 'describeEventConfigurationsResponse_lastModifiedDate' - The date the event configurations were last modified.
--
-- 'httpStatus', 'describeEventConfigurationsResponse_httpStatus' - The response's http status code.
newDescribeEventConfigurationsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DescribeEventConfigurationsResponse
newDescribeEventConfigurationsResponse :: Int -> DescribeEventConfigurationsResponse
newDescribeEventConfigurationsResponse Int
pHttpStatus_ =
  DescribeEventConfigurationsResponse'
    { $sel:creationDate:DescribeEventConfigurationsResponse' :: Maybe POSIX
creationDate =
        forall a. Maybe a
Prelude.Nothing,
      $sel:eventConfigurations:DescribeEventConfigurationsResponse' :: Maybe (HashMap EventType Configuration)
eventConfigurations = forall a. Maybe a
Prelude.Nothing,
      $sel:lastModifiedDate:DescribeEventConfigurationsResponse' :: Maybe POSIX
lastModifiedDate = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:DescribeEventConfigurationsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The creation date of the event configuration.
describeEventConfigurationsResponse_creationDate :: Lens.Lens' DescribeEventConfigurationsResponse (Prelude.Maybe Prelude.UTCTime)
describeEventConfigurationsResponse_creationDate :: Lens' DescribeEventConfigurationsResponse (Maybe UTCTime)
describeEventConfigurationsResponse_creationDate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeEventConfigurationsResponse' {Maybe POSIX
creationDate :: Maybe POSIX
$sel:creationDate:DescribeEventConfigurationsResponse' :: DescribeEventConfigurationsResponse -> Maybe POSIX
creationDate} -> Maybe POSIX
creationDate) (\s :: DescribeEventConfigurationsResponse
s@DescribeEventConfigurationsResponse' {} Maybe POSIX
a -> DescribeEventConfigurationsResponse
s {$sel:creationDate:DescribeEventConfigurationsResponse' :: Maybe POSIX
creationDate = Maybe POSIX
a} :: DescribeEventConfigurationsResponse) 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 (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The event configurations.
describeEventConfigurationsResponse_eventConfigurations :: Lens.Lens' DescribeEventConfigurationsResponse (Prelude.Maybe (Prelude.HashMap EventType Configuration))
describeEventConfigurationsResponse_eventConfigurations :: Lens'
  DescribeEventConfigurationsResponse
  (Maybe (HashMap EventType Configuration))
describeEventConfigurationsResponse_eventConfigurations = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeEventConfigurationsResponse' {Maybe (HashMap EventType Configuration)
eventConfigurations :: Maybe (HashMap EventType Configuration)
$sel:eventConfigurations:DescribeEventConfigurationsResponse' :: DescribeEventConfigurationsResponse
-> Maybe (HashMap EventType Configuration)
eventConfigurations} -> Maybe (HashMap EventType Configuration)
eventConfigurations) (\s :: DescribeEventConfigurationsResponse
s@DescribeEventConfigurationsResponse' {} Maybe (HashMap EventType Configuration)
a -> DescribeEventConfigurationsResponse
s {$sel:eventConfigurations:DescribeEventConfigurationsResponse' :: Maybe (HashMap EventType Configuration)
eventConfigurations = Maybe (HashMap EventType Configuration)
a} :: DescribeEventConfigurationsResponse) 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 date the event configurations were last modified.
describeEventConfigurationsResponse_lastModifiedDate :: Lens.Lens' DescribeEventConfigurationsResponse (Prelude.Maybe Prelude.UTCTime)
describeEventConfigurationsResponse_lastModifiedDate :: Lens' DescribeEventConfigurationsResponse (Maybe UTCTime)
describeEventConfigurationsResponse_lastModifiedDate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeEventConfigurationsResponse' {Maybe POSIX
lastModifiedDate :: Maybe POSIX
$sel:lastModifiedDate:DescribeEventConfigurationsResponse' :: DescribeEventConfigurationsResponse -> Maybe POSIX
lastModifiedDate} -> Maybe POSIX
lastModifiedDate) (\s :: DescribeEventConfigurationsResponse
s@DescribeEventConfigurationsResponse' {} Maybe POSIX
a -> DescribeEventConfigurationsResponse
s {$sel:lastModifiedDate:DescribeEventConfigurationsResponse' :: Maybe POSIX
lastModifiedDate = Maybe POSIX
a} :: DescribeEventConfigurationsResponse) 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 (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The response's http status code.
describeEventConfigurationsResponse_httpStatus :: Lens.Lens' DescribeEventConfigurationsResponse Prelude.Int
describeEventConfigurationsResponse_httpStatus :: Lens' DescribeEventConfigurationsResponse Int
describeEventConfigurationsResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeEventConfigurationsResponse' {Int
httpStatus :: Int
$sel:httpStatus:DescribeEventConfigurationsResponse' :: DescribeEventConfigurationsResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: DescribeEventConfigurationsResponse
s@DescribeEventConfigurationsResponse' {} Int
a -> DescribeEventConfigurationsResponse
s {$sel:httpStatus:DescribeEventConfigurationsResponse' :: Int
httpStatus = Int
a} :: DescribeEventConfigurationsResponse)

instance
  Prelude.NFData
    DescribeEventConfigurationsResponse
  where
  rnf :: DescribeEventConfigurationsResponse -> ()
rnf DescribeEventConfigurationsResponse' {Int
Maybe (HashMap EventType Configuration)
Maybe POSIX
httpStatus :: Int
lastModifiedDate :: Maybe POSIX
eventConfigurations :: Maybe (HashMap EventType Configuration)
creationDate :: Maybe POSIX
$sel:httpStatus:DescribeEventConfigurationsResponse' :: DescribeEventConfigurationsResponse -> Int
$sel:lastModifiedDate:DescribeEventConfigurationsResponse' :: DescribeEventConfigurationsResponse -> Maybe POSIX
$sel:eventConfigurations:DescribeEventConfigurationsResponse' :: DescribeEventConfigurationsResponse
-> Maybe (HashMap EventType Configuration)
$sel:creationDate:DescribeEventConfigurationsResponse' :: DescribeEventConfigurationsResponse -> Maybe POSIX
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
creationDate
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap EventType Configuration)
eventConfigurations
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
lastModifiedDate
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus