{-# 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.DirectoryService.DescribeEventTopics
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Obtains information about which Amazon SNS topics receive status
-- messages from the specified directory.
--
-- If no input parameters are provided, such as DirectoryId or TopicName,
-- this request describes all of the associations in the account.
module Amazonka.DirectoryService.DescribeEventTopics
  ( -- * Creating a Request
    DescribeEventTopics (..),
    newDescribeEventTopics,

    -- * Request Lenses
    describeEventTopics_directoryId,
    describeEventTopics_topicNames,

    -- * Destructuring the Response
    DescribeEventTopicsResponse (..),
    newDescribeEventTopicsResponse,

    -- * Response Lenses
    describeEventTopicsResponse_eventTopics,
    describeEventTopicsResponse_httpStatus,
  )
where

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

-- | Describes event topics.
--
-- /See:/ 'newDescribeEventTopics' smart constructor.
data DescribeEventTopics = DescribeEventTopics'
  { -- | The Directory ID for which to get the list of associated Amazon SNS
    -- topics. If this member is null, associations for all Directory IDs are
    -- returned.
    DescribeEventTopics -> Maybe Text
directoryId :: Prelude.Maybe Prelude.Text,
    -- | A list of Amazon SNS topic names for which to obtain the information. If
    -- this member is null, all associations for the specified Directory ID are
    -- returned.
    --
    -- An empty list results in an @InvalidParameterException@ being thrown.
    DescribeEventTopics -> Maybe [Text]
topicNames :: Prelude.Maybe [Prelude.Text]
  }
  deriving (DescribeEventTopics -> DescribeEventTopics -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeEventTopics -> DescribeEventTopics -> Bool
$c/= :: DescribeEventTopics -> DescribeEventTopics -> Bool
== :: DescribeEventTopics -> DescribeEventTopics -> Bool
$c== :: DescribeEventTopics -> DescribeEventTopics -> Bool
Prelude.Eq, ReadPrec [DescribeEventTopics]
ReadPrec DescribeEventTopics
Int -> ReadS DescribeEventTopics
ReadS [DescribeEventTopics]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeEventTopics]
$creadListPrec :: ReadPrec [DescribeEventTopics]
readPrec :: ReadPrec DescribeEventTopics
$creadPrec :: ReadPrec DescribeEventTopics
readList :: ReadS [DescribeEventTopics]
$creadList :: ReadS [DescribeEventTopics]
readsPrec :: Int -> ReadS DescribeEventTopics
$creadsPrec :: Int -> ReadS DescribeEventTopics
Prelude.Read, Int -> DescribeEventTopics -> ShowS
[DescribeEventTopics] -> ShowS
DescribeEventTopics -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeEventTopics] -> ShowS
$cshowList :: [DescribeEventTopics] -> ShowS
show :: DescribeEventTopics -> String
$cshow :: DescribeEventTopics -> String
showsPrec :: Int -> DescribeEventTopics -> ShowS
$cshowsPrec :: Int -> DescribeEventTopics -> ShowS
Prelude.Show, forall x. Rep DescribeEventTopics x -> DescribeEventTopics
forall x. DescribeEventTopics -> Rep DescribeEventTopics x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DescribeEventTopics x -> DescribeEventTopics
$cfrom :: forall x. DescribeEventTopics -> Rep DescribeEventTopics x
Prelude.Generic)

-- |
-- Create a value of 'DescribeEventTopics' 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:
--
-- 'directoryId', 'describeEventTopics_directoryId' - The Directory ID for which to get the list of associated Amazon SNS
-- topics. If this member is null, associations for all Directory IDs are
-- returned.
--
-- 'topicNames', 'describeEventTopics_topicNames' - A list of Amazon SNS topic names for which to obtain the information. If
-- this member is null, all associations for the specified Directory ID are
-- returned.
--
-- An empty list results in an @InvalidParameterException@ being thrown.
newDescribeEventTopics ::
  DescribeEventTopics
newDescribeEventTopics :: DescribeEventTopics
newDescribeEventTopics =
  DescribeEventTopics'
    { $sel:directoryId:DescribeEventTopics' :: Maybe Text
directoryId = forall a. Maybe a
Prelude.Nothing,
      $sel:topicNames:DescribeEventTopics' :: Maybe [Text]
topicNames = forall a. Maybe a
Prelude.Nothing
    }

-- | The Directory ID for which to get the list of associated Amazon SNS
-- topics. If this member is null, associations for all Directory IDs are
-- returned.
describeEventTopics_directoryId :: Lens.Lens' DescribeEventTopics (Prelude.Maybe Prelude.Text)
describeEventTopics_directoryId :: Lens' DescribeEventTopics (Maybe Text)
describeEventTopics_directoryId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeEventTopics' {Maybe Text
directoryId :: Maybe Text
$sel:directoryId:DescribeEventTopics' :: DescribeEventTopics -> Maybe Text
directoryId} -> Maybe Text
directoryId) (\s :: DescribeEventTopics
s@DescribeEventTopics' {} Maybe Text
a -> DescribeEventTopics
s {$sel:directoryId:DescribeEventTopics' :: Maybe Text
directoryId = Maybe Text
a} :: DescribeEventTopics)

-- | A list of Amazon SNS topic names for which to obtain the information. If
-- this member is null, all associations for the specified Directory ID are
-- returned.
--
-- An empty list results in an @InvalidParameterException@ being thrown.
describeEventTopics_topicNames :: Lens.Lens' DescribeEventTopics (Prelude.Maybe [Prelude.Text])
describeEventTopics_topicNames :: Lens' DescribeEventTopics (Maybe [Text])
describeEventTopics_topicNames = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeEventTopics' {Maybe [Text]
topicNames :: Maybe [Text]
$sel:topicNames:DescribeEventTopics' :: DescribeEventTopics -> Maybe [Text]
topicNames} -> Maybe [Text]
topicNames) (\s :: DescribeEventTopics
s@DescribeEventTopics' {} Maybe [Text]
a -> DescribeEventTopics
s {$sel:topicNames:DescribeEventTopics' :: Maybe [Text]
topicNames = Maybe [Text]
a} :: DescribeEventTopics) 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

instance Core.AWSRequest DescribeEventTopics where
  type
    AWSResponse DescribeEventTopics =
      DescribeEventTopicsResponse
  request :: (Service -> Service)
-> DescribeEventTopics -> Request DescribeEventTopics
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 DescribeEventTopics
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse DescribeEventTopics)))
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 [EventTopic] -> Int -> DescribeEventTopicsResponse
DescribeEventTopicsResponse'
            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
"EventTopics" 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 DescribeEventTopics where
  hashWithSalt :: Int -> DescribeEventTopics -> Int
hashWithSalt Int
_salt DescribeEventTopics' {Maybe [Text]
Maybe Text
topicNames :: Maybe [Text]
directoryId :: Maybe Text
$sel:topicNames:DescribeEventTopics' :: DescribeEventTopics -> Maybe [Text]
$sel:directoryId:DescribeEventTopics' :: DescribeEventTopics -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
directoryId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
topicNames

instance Prelude.NFData DescribeEventTopics where
  rnf :: DescribeEventTopics -> ()
rnf DescribeEventTopics' {Maybe [Text]
Maybe Text
topicNames :: Maybe [Text]
directoryId :: Maybe Text
$sel:topicNames:DescribeEventTopics' :: DescribeEventTopics -> Maybe [Text]
$sel:directoryId:DescribeEventTopics' :: DescribeEventTopics -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
directoryId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
topicNames

instance Data.ToHeaders DescribeEventTopics where
  toHeaders :: DescribeEventTopics -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"X-Amz-Target"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"DirectoryService_20150416.DescribeEventTopics" ::
                          Prelude.ByteString
                      ),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON DescribeEventTopics where
  toJSON :: DescribeEventTopics -> Value
toJSON DescribeEventTopics' {Maybe [Text]
Maybe Text
topicNames :: Maybe [Text]
directoryId :: Maybe Text
$sel:topicNames:DescribeEventTopics' :: DescribeEventTopics -> Maybe [Text]
$sel:directoryId:DescribeEventTopics' :: DescribeEventTopics -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"DirectoryId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
directoryId,
            (Key
"TopicNames" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [Text]
topicNames
          ]
      )

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

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

-- | The result of a DescribeEventTopic request.
--
-- /See:/ 'newDescribeEventTopicsResponse' smart constructor.
data DescribeEventTopicsResponse = DescribeEventTopicsResponse'
  { -- | A list of Amazon SNS topic names that receive status messages from the
    -- specified Directory ID.
    DescribeEventTopicsResponse -> Maybe [EventTopic]
eventTopics :: Prelude.Maybe [EventTopic],
    -- | The response's http status code.
    DescribeEventTopicsResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (DescribeEventTopicsResponse -> DescribeEventTopicsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeEventTopicsResponse -> DescribeEventTopicsResponse -> Bool
$c/= :: DescribeEventTopicsResponse -> DescribeEventTopicsResponse -> Bool
== :: DescribeEventTopicsResponse -> DescribeEventTopicsResponse -> Bool
$c== :: DescribeEventTopicsResponse -> DescribeEventTopicsResponse -> Bool
Prelude.Eq, ReadPrec [DescribeEventTopicsResponse]
ReadPrec DescribeEventTopicsResponse
Int -> ReadS DescribeEventTopicsResponse
ReadS [DescribeEventTopicsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeEventTopicsResponse]
$creadListPrec :: ReadPrec [DescribeEventTopicsResponse]
readPrec :: ReadPrec DescribeEventTopicsResponse
$creadPrec :: ReadPrec DescribeEventTopicsResponse
readList :: ReadS [DescribeEventTopicsResponse]
$creadList :: ReadS [DescribeEventTopicsResponse]
readsPrec :: Int -> ReadS DescribeEventTopicsResponse
$creadsPrec :: Int -> ReadS DescribeEventTopicsResponse
Prelude.Read, Int -> DescribeEventTopicsResponse -> ShowS
[DescribeEventTopicsResponse] -> ShowS
DescribeEventTopicsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeEventTopicsResponse] -> ShowS
$cshowList :: [DescribeEventTopicsResponse] -> ShowS
show :: DescribeEventTopicsResponse -> String
$cshow :: DescribeEventTopicsResponse -> String
showsPrec :: Int -> DescribeEventTopicsResponse -> ShowS
$cshowsPrec :: Int -> DescribeEventTopicsResponse -> ShowS
Prelude.Show, forall x.
Rep DescribeEventTopicsResponse x -> DescribeEventTopicsResponse
forall x.
DescribeEventTopicsResponse -> Rep DescribeEventTopicsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DescribeEventTopicsResponse x -> DescribeEventTopicsResponse
$cfrom :: forall x.
DescribeEventTopicsResponse -> Rep DescribeEventTopicsResponse x
Prelude.Generic)

-- |
-- Create a value of 'DescribeEventTopicsResponse' 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:
--
-- 'eventTopics', 'describeEventTopicsResponse_eventTopics' - A list of Amazon SNS topic names that receive status messages from the
-- specified Directory ID.
--
-- 'httpStatus', 'describeEventTopicsResponse_httpStatus' - The response's http status code.
newDescribeEventTopicsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DescribeEventTopicsResponse
newDescribeEventTopicsResponse :: Int -> DescribeEventTopicsResponse
newDescribeEventTopicsResponse Int
pHttpStatus_ =
  DescribeEventTopicsResponse'
    { $sel:eventTopics:DescribeEventTopicsResponse' :: Maybe [EventTopic]
eventTopics =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:DescribeEventTopicsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | A list of Amazon SNS topic names that receive status messages from the
-- specified Directory ID.
describeEventTopicsResponse_eventTopics :: Lens.Lens' DescribeEventTopicsResponse (Prelude.Maybe [EventTopic])
describeEventTopicsResponse_eventTopics :: Lens' DescribeEventTopicsResponse (Maybe [EventTopic])
describeEventTopicsResponse_eventTopics = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeEventTopicsResponse' {Maybe [EventTopic]
eventTopics :: Maybe [EventTopic]
$sel:eventTopics:DescribeEventTopicsResponse' :: DescribeEventTopicsResponse -> Maybe [EventTopic]
eventTopics} -> Maybe [EventTopic]
eventTopics) (\s :: DescribeEventTopicsResponse
s@DescribeEventTopicsResponse' {} Maybe [EventTopic]
a -> DescribeEventTopicsResponse
s {$sel:eventTopics:DescribeEventTopicsResponse' :: Maybe [EventTopic]
eventTopics = Maybe [EventTopic]
a} :: DescribeEventTopicsResponse) 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.
describeEventTopicsResponse_httpStatus :: Lens.Lens' DescribeEventTopicsResponse Prelude.Int
describeEventTopicsResponse_httpStatus :: Lens' DescribeEventTopicsResponse Int
describeEventTopicsResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeEventTopicsResponse' {Int
httpStatus :: Int
$sel:httpStatus:DescribeEventTopicsResponse' :: DescribeEventTopicsResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: DescribeEventTopicsResponse
s@DescribeEventTopicsResponse' {} Int
a -> DescribeEventTopicsResponse
s {$sel:httpStatus:DescribeEventTopicsResponse' :: Int
httpStatus = Int
a} :: DescribeEventTopicsResponse)

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