{-# 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.SNS.GetTopicAttributes
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Returns all of the properties of a topic. Topic properties returned
-- might differ based on the authorization of the user.
module Amazonka.SNS.GetTopicAttributes
  ( -- * Creating a Request
    GetTopicAttributes (..),
    newGetTopicAttributes,

    -- * Request Lenses
    getTopicAttributes_topicArn,

    -- * Destructuring the Response
    GetTopicAttributesResponse (..),
    newGetTopicAttributesResponse,

    -- * Response Lenses
    getTopicAttributesResponse_attributes,
    getTopicAttributesResponse_httpStatus,
  )
where

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

-- | Input for GetTopicAttributes action.
--
-- /See:/ 'newGetTopicAttributes' smart constructor.
data GetTopicAttributes = GetTopicAttributes'
  { -- | The ARN of the topic whose properties you want to get.
    GetTopicAttributes -> Text
topicArn :: Prelude.Text
  }
  deriving (GetTopicAttributes -> GetTopicAttributes -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetTopicAttributes -> GetTopicAttributes -> Bool
$c/= :: GetTopicAttributes -> GetTopicAttributes -> Bool
== :: GetTopicAttributes -> GetTopicAttributes -> Bool
$c== :: GetTopicAttributes -> GetTopicAttributes -> Bool
Prelude.Eq, ReadPrec [GetTopicAttributes]
ReadPrec GetTopicAttributes
Int -> ReadS GetTopicAttributes
ReadS [GetTopicAttributes]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetTopicAttributes]
$creadListPrec :: ReadPrec [GetTopicAttributes]
readPrec :: ReadPrec GetTopicAttributes
$creadPrec :: ReadPrec GetTopicAttributes
readList :: ReadS [GetTopicAttributes]
$creadList :: ReadS [GetTopicAttributes]
readsPrec :: Int -> ReadS GetTopicAttributes
$creadsPrec :: Int -> ReadS GetTopicAttributes
Prelude.Read, Int -> GetTopicAttributes -> ShowS
[GetTopicAttributes] -> ShowS
GetTopicAttributes -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetTopicAttributes] -> ShowS
$cshowList :: [GetTopicAttributes] -> ShowS
show :: GetTopicAttributes -> String
$cshow :: GetTopicAttributes -> String
showsPrec :: Int -> GetTopicAttributes -> ShowS
$cshowsPrec :: Int -> GetTopicAttributes -> ShowS
Prelude.Show, forall x. Rep GetTopicAttributes x -> GetTopicAttributes
forall x. GetTopicAttributes -> Rep GetTopicAttributes x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetTopicAttributes x -> GetTopicAttributes
$cfrom :: forall x. GetTopicAttributes -> Rep GetTopicAttributes x
Prelude.Generic)

-- |
-- Create a value of 'GetTopicAttributes' 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:
--
-- 'topicArn', 'getTopicAttributes_topicArn' - The ARN of the topic whose properties you want to get.
newGetTopicAttributes ::
  -- | 'topicArn'
  Prelude.Text ->
  GetTopicAttributes
newGetTopicAttributes :: Text -> GetTopicAttributes
newGetTopicAttributes Text
pTopicArn_ =
  GetTopicAttributes' {$sel:topicArn:GetTopicAttributes' :: Text
topicArn = Text
pTopicArn_}

-- | The ARN of the topic whose properties you want to get.
getTopicAttributes_topicArn :: Lens.Lens' GetTopicAttributes Prelude.Text
getTopicAttributes_topicArn :: Lens' GetTopicAttributes Text
getTopicAttributes_topicArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetTopicAttributes' {Text
topicArn :: Text
$sel:topicArn:GetTopicAttributes' :: GetTopicAttributes -> Text
topicArn} -> Text
topicArn) (\s :: GetTopicAttributes
s@GetTopicAttributes' {} Text
a -> GetTopicAttributes
s {$sel:topicArn:GetTopicAttributes' :: Text
topicArn = Text
a} :: GetTopicAttributes)

instance Core.AWSRequest GetTopicAttributes where
  type
    AWSResponse GetTopicAttributes =
      GetTopicAttributesResponse
  request :: (Service -> Service)
-> GetTopicAttributes -> Request GetTopicAttributes
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.postQuery (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy GetTopicAttributes
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse GetTopicAttributes)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
Text
-> (Int
    -> ResponseHeaders -> [Node] -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveXMLWrapper
      Text
"GetTopicAttributesResult"
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Maybe (HashMap Text Text) -> Int -> GetTopicAttributesResponse
GetTopicAttributesResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> ( [Node]
x
                            forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"Attributes"
                            forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty
                            forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
Prelude.>>= forall (f :: * -> *) a b.
Applicative f =>
([a] -> f b) -> [a] -> f (Maybe b)
Core.may (forall k v.
(Eq k, Hashable k, FromText k, FromXML v) =>
Text -> Text -> Text -> [Node] -> Either String (HashMap k v)
Data.parseXMLMap Text
"entry" Text
"key" Text
"value")
                        )
            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 GetTopicAttributes where
  hashWithSalt :: Int -> GetTopicAttributes -> Int
hashWithSalt Int
_salt GetTopicAttributes' {Text
topicArn :: Text
$sel:topicArn:GetTopicAttributes' :: GetTopicAttributes -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
topicArn

instance Prelude.NFData GetTopicAttributes where
  rnf :: GetTopicAttributes -> ()
rnf GetTopicAttributes' {Text
topicArn :: Text
$sel:topicArn:GetTopicAttributes' :: GetTopicAttributes -> Text
..} = forall a. NFData a => a -> ()
Prelude.rnf Text
topicArn

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

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

instance Data.ToQuery GetTopicAttributes where
  toQuery :: GetTopicAttributes -> QueryString
toQuery GetTopicAttributes' {Text
topicArn :: Text
$sel:topicArn:GetTopicAttributes' :: GetTopicAttributes -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"GetTopicAttributes" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2010-03-31" :: Prelude.ByteString),
        ByteString
"TopicArn" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
topicArn
      ]

-- | Response for GetTopicAttributes action.
--
-- /See:/ 'newGetTopicAttributesResponse' smart constructor.
data GetTopicAttributesResponse = GetTopicAttributesResponse'
  { -- | A map of the topic\'s attributes. Attributes in this map include the
    -- following:
    --
    -- -   @DeliveryPolicy@ – The JSON serialization of the topic\'s delivery
    --     policy.
    --
    -- -   @DisplayName@ – The human-readable name used in the @From@ field for
    --     notifications to @email@ and @email-json@ endpoints.
    --
    -- -   @EffectiveDeliveryPolicy@ – The JSON serialization of the effective
    --     delivery policy, taking system defaults into account.
    --
    -- -   @Owner@ – The Amazon Web Services account ID of the topic\'s owner.
    --
    -- -   @Policy@ – The JSON serialization of the topic\'s access control
    --     policy.
    --
    -- -   @SignatureVersion@ – The version of the Amazon SNS signature used
    --     for the topic.
    --
    --     -   By default, @SignatureVersion@ is set to __1__. The signature is
    --         a Base64-encoded __SHA1withRSA__ signature.
    --
    --     -   When you set @SignatureVersion@ to __2__. Amazon SNS uses a
    --         Base64-encoded __SHA256withRSA__ signature.
    --
    --         If the API response does not include the @SignatureVersion@
    --         attribute, it means that the @SignatureVersion@ for the topic
    --         has value __1__.
    --
    -- -   @SubscriptionsConfirmed@ – The number of confirmed subscriptions for
    --     the topic.
    --
    -- -   @SubscriptionsDeleted@ – The number of deleted subscriptions for the
    --     topic.
    --
    -- -   @SubscriptionsPending@ – The number of subscriptions pending
    --     confirmation for the topic.
    --
    -- -   @TopicArn@ – The topic\'s ARN.
    --
    -- -   @TracingConfig@ – Tracing mode of an Amazon SNS topic. By default
    --     @TracingConfig@ is set to @PassThrough@, and the topic passes
    --     through the tracing header it receives from an Amazon SNS publisher
    --     to its subscriptions. If set to Active, Amazon SNS will vend X-Ray
    --     segment data to topic owner account if the sampled flag in the
    --     tracing header is true. This is only supported on standard topics.
    --
    -- The following attribute applies only to
    -- <https://docs.aws.amazon.com/sns/latest/dg/sns-server-side-encryption.html server-side-encryption>:
    --
    -- -   @KmsMasterKeyId@ - The ID of an Amazon Web Services managed customer
    --     master key (CMK) for Amazon SNS or a custom CMK. For more
    --     information, see
    --     <https://docs.aws.amazon.com/sns/latest/dg/sns-server-side-encryption.html#sse-key-terms Key Terms>.
    --     For more examples, see
    --     <https://docs.aws.amazon.com/kms/latest/APIReference/API_DescribeKey.html#API_DescribeKey_RequestParameters KeyId>
    --     in the /Key Management Service API Reference/.
    --
    -- The following attributes apply only to
    -- <https://docs.aws.amazon.com/sns/latest/dg/sns-fifo-topics.html FIFO topics>:
    --
    -- -   @FifoTopic@ – When this is set to @true@, a FIFO topic is created.
    --
    -- -   @ContentBasedDeduplication@ – Enables content-based deduplication
    --     for FIFO topics.
    --
    --     -   By default, @ContentBasedDeduplication@ is set to @false@. If
    --         you create a FIFO topic and this attribute is @false@, you must
    --         specify a value for the @MessageDeduplicationId@ parameter for
    --         the
    --         <https://docs.aws.amazon.com/sns/latest/api/API_Publish.html Publish>
    --         action.
    --
    --     -   When you set @ContentBasedDeduplication@ to @true@, Amazon SNS
    --         uses a SHA-256 hash to generate the @MessageDeduplicationId@
    --         using the body of the message (but not the attributes of the
    --         message).
    --
    --         (Optional) To override the generated value, you can specify a
    --         value for the @MessageDeduplicationId@ parameter for the
    --         @Publish@ action.
    GetTopicAttributesResponse -> Maybe (HashMap Text Text)
attributes :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | The response's http status code.
    GetTopicAttributesResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetTopicAttributesResponse -> GetTopicAttributesResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetTopicAttributesResponse -> GetTopicAttributesResponse -> Bool
$c/= :: GetTopicAttributesResponse -> GetTopicAttributesResponse -> Bool
== :: GetTopicAttributesResponse -> GetTopicAttributesResponse -> Bool
$c== :: GetTopicAttributesResponse -> GetTopicAttributesResponse -> Bool
Prelude.Eq, ReadPrec [GetTopicAttributesResponse]
ReadPrec GetTopicAttributesResponse
Int -> ReadS GetTopicAttributesResponse
ReadS [GetTopicAttributesResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetTopicAttributesResponse]
$creadListPrec :: ReadPrec [GetTopicAttributesResponse]
readPrec :: ReadPrec GetTopicAttributesResponse
$creadPrec :: ReadPrec GetTopicAttributesResponse
readList :: ReadS [GetTopicAttributesResponse]
$creadList :: ReadS [GetTopicAttributesResponse]
readsPrec :: Int -> ReadS GetTopicAttributesResponse
$creadsPrec :: Int -> ReadS GetTopicAttributesResponse
Prelude.Read, Int -> GetTopicAttributesResponse -> ShowS
[GetTopicAttributesResponse] -> ShowS
GetTopicAttributesResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetTopicAttributesResponse] -> ShowS
$cshowList :: [GetTopicAttributesResponse] -> ShowS
show :: GetTopicAttributesResponse -> String
$cshow :: GetTopicAttributesResponse -> String
showsPrec :: Int -> GetTopicAttributesResponse -> ShowS
$cshowsPrec :: Int -> GetTopicAttributesResponse -> ShowS
Prelude.Show, forall x.
Rep GetTopicAttributesResponse x -> GetTopicAttributesResponse
forall x.
GetTopicAttributesResponse -> Rep GetTopicAttributesResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetTopicAttributesResponse x -> GetTopicAttributesResponse
$cfrom :: forall x.
GetTopicAttributesResponse -> Rep GetTopicAttributesResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetTopicAttributesResponse' 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:
--
-- 'attributes', 'getTopicAttributesResponse_attributes' - A map of the topic\'s attributes. Attributes in this map include the
-- following:
--
-- -   @DeliveryPolicy@ – The JSON serialization of the topic\'s delivery
--     policy.
--
-- -   @DisplayName@ – The human-readable name used in the @From@ field for
--     notifications to @email@ and @email-json@ endpoints.
--
-- -   @EffectiveDeliveryPolicy@ – The JSON serialization of the effective
--     delivery policy, taking system defaults into account.
--
-- -   @Owner@ – The Amazon Web Services account ID of the topic\'s owner.
--
-- -   @Policy@ – The JSON serialization of the topic\'s access control
--     policy.
--
-- -   @SignatureVersion@ – The version of the Amazon SNS signature used
--     for the topic.
--
--     -   By default, @SignatureVersion@ is set to __1__. The signature is
--         a Base64-encoded __SHA1withRSA__ signature.
--
--     -   When you set @SignatureVersion@ to __2__. Amazon SNS uses a
--         Base64-encoded __SHA256withRSA__ signature.
--
--         If the API response does not include the @SignatureVersion@
--         attribute, it means that the @SignatureVersion@ for the topic
--         has value __1__.
--
-- -   @SubscriptionsConfirmed@ – The number of confirmed subscriptions for
--     the topic.
--
-- -   @SubscriptionsDeleted@ – The number of deleted subscriptions for the
--     topic.
--
-- -   @SubscriptionsPending@ – The number of subscriptions pending
--     confirmation for the topic.
--
-- -   @TopicArn@ – The topic\'s ARN.
--
-- -   @TracingConfig@ – Tracing mode of an Amazon SNS topic. By default
--     @TracingConfig@ is set to @PassThrough@, and the topic passes
--     through the tracing header it receives from an Amazon SNS publisher
--     to its subscriptions. If set to Active, Amazon SNS will vend X-Ray
--     segment data to topic owner account if the sampled flag in the
--     tracing header is true. This is only supported on standard topics.
--
-- The following attribute applies only to
-- <https://docs.aws.amazon.com/sns/latest/dg/sns-server-side-encryption.html server-side-encryption>:
--
-- -   @KmsMasterKeyId@ - The ID of an Amazon Web Services managed customer
--     master key (CMK) for Amazon SNS or a custom CMK. For more
--     information, see
--     <https://docs.aws.amazon.com/sns/latest/dg/sns-server-side-encryption.html#sse-key-terms Key Terms>.
--     For more examples, see
--     <https://docs.aws.amazon.com/kms/latest/APIReference/API_DescribeKey.html#API_DescribeKey_RequestParameters KeyId>
--     in the /Key Management Service API Reference/.
--
-- The following attributes apply only to
-- <https://docs.aws.amazon.com/sns/latest/dg/sns-fifo-topics.html FIFO topics>:
--
-- -   @FifoTopic@ – When this is set to @true@, a FIFO topic is created.
--
-- -   @ContentBasedDeduplication@ – Enables content-based deduplication
--     for FIFO topics.
--
--     -   By default, @ContentBasedDeduplication@ is set to @false@. If
--         you create a FIFO topic and this attribute is @false@, you must
--         specify a value for the @MessageDeduplicationId@ parameter for
--         the
--         <https://docs.aws.amazon.com/sns/latest/api/API_Publish.html Publish>
--         action.
--
--     -   When you set @ContentBasedDeduplication@ to @true@, Amazon SNS
--         uses a SHA-256 hash to generate the @MessageDeduplicationId@
--         using the body of the message (but not the attributes of the
--         message).
--
--         (Optional) To override the generated value, you can specify a
--         value for the @MessageDeduplicationId@ parameter for the
--         @Publish@ action.
--
-- 'httpStatus', 'getTopicAttributesResponse_httpStatus' - The response's http status code.
newGetTopicAttributesResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetTopicAttributesResponse
newGetTopicAttributesResponse :: Int -> GetTopicAttributesResponse
newGetTopicAttributesResponse Int
pHttpStatus_ =
  GetTopicAttributesResponse'
    { $sel:attributes:GetTopicAttributesResponse' :: Maybe (HashMap Text Text)
attributes =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetTopicAttributesResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | A map of the topic\'s attributes. Attributes in this map include the
-- following:
--
-- -   @DeliveryPolicy@ – The JSON serialization of the topic\'s delivery
--     policy.
--
-- -   @DisplayName@ – The human-readable name used in the @From@ field for
--     notifications to @email@ and @email-json@ endpoints.
--
-- -   @EffectiveDeliveryPolicy@ – The JSON serialization of the effective
--     delivery policy, taking system defaults into account.
--
-- -   @Owner@ – The Amazon Web Services account ID of the topic\'s owner.
--
-- -   @Policy@ – The JSON serialization of the topic\'s access control
--     policy.
--
-- -   @SignatureVersion@ – The version of the Amazon SNS signature used
--     for the topic.
--
--     -   By default, @SignatureVersion@ is set to __1__. The signature is
--         a Base64-encoded __SHA1withRSA__ signature.
--
--     -   When you set @SignatureVersion@ to __2__. Amazon SNS uses a
--         Base64-encoded __SHA256withRSA__ signature.
--
--         If the API response does not include the @SignatureVersion@
--         attribute, it means that the @SignatureVersion@ for the topic
--         has value __1__.
--
-- -   @SubscriptionsConfirmed@ – The number of confirmed subscriptions for
--     the topic.
--
-- -   @SubscriptionsDeleted@ – The number of deleted subscriptions for the
--     topic.
--
-- -   @SubscriptionsPending@ – The number of subscriptions pending
--     confirmation for the topic.
--
-- -   @TopicArn@ – The topic\'s ARN.
--
-- -   @TracingConfig@ – Tracing mode of an Amazon SNS topic. By default
--     @TracingConfig@ is set to @PassThrough@, and the topic passes
--     through the tracing header it receives from an Amazon SNS publisher
--     to its subscriptions. If set to Active, Amazon SNS will vend X-Ray
--     segment data to topic owner account if the sampled flag in the
--     tracing header is true. This is only supported on standard topics.
--
-- The following attribute applies only to
-- <https://docs.aws.amazon.com/sns/latest/dg/sns-server-side-encryption.html server-side-encryption>:
--
-- -   @KmsMasterKeyId@ - The ID of an Amazon Web Services managed customer
--     master key (CMK) for Amazon SNS or a custom CMK. For more
--     information, see
--     <https://docs.aws.amazon.com/sns/latest/dg/sns-server-side-encryption.html#sse-key-terms Key Terms>.
--     For more examples, see
--     <https://docs.aws.amazon.com/kms/latest/APIReference/API_DescribeKey.html#API_DescribeKey_RequestParameters KeyId>
--     in the /Key Management Service API Reference/.
--
-- The following attributes apply only to
-- <https://docs.aws.amazon.com/sns/latest/dg/sns-fifo-topics.html FIFO topics>:
--
-- -   @FifoTopic@ – When this is set to @true@, a FIFO topic is created.
--
-- -   @ContentBasedDeduplication@ – Enables content-based deduplication
--     for FIFO topics.
--
--     -   By default, @ContentBasedDeduplication@ is set to @false@. If
--         you create a FIFO topic and this attribute is @false@, you must
--         specify a value for the @MessageDeduplicationId@ parameter for
--         the
--         <https://docs.aws.amazon.com/sns/latest/api/API_Publish.html Publish>
--         action.
--
--     -   When you set @ContentBasedDeduplication@ to @true@, Amazon SNS
--         uses a SHA-256 hash to generate the @MessageDeduplicationId@
--         using the body of the message (but not the attributes of the
--         message).
--
--         (Optional) To override the generated value, you can specify a
--         value for the @MessageDeduplicationId@ parameter for the
--         @Publish@ action.
getTopicAttributesResponse_attributes :: Lens.Lens' GetTopicAttributesResponse (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
getTopicAttributesResponse_attributes :: Lens' GetTopicAttributesResponse (Maybe (HashMap Text Text))
getTopicAttributesResponse_attributes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetTopicAttributesResponse' {Maybe (HashMap Text Text)
attributes :: Maybe (HashMap Text Text)
$sel:attributes:GetTopicAttributesResponse' :: GetTopicAttributesResponse -> Maybe (HashMap Text Text)
attributes} -> Maybe (HashMap Text Text)
attributes) (\s :: GetTopicAttributesResponse
s@GetTopicAttributesResponse' {} Maybe (HashMap Text Text)
a -> GetTopicAttributesResponse
s {$sel:attributes:GetTopicAttributesResponse' :: Maybe (HashMap Text Text)
attributes = Maybe (HashMap Text Text)
a} :: GetTopicAttributesResponse) 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.
getTopicAttributesResponse_httpStatus :: Lens.Lens' GetTopicAttributesResponse Prelude.Int
getTopicAttributesResponse_httpStatus :: Lens' GetTopicAttributesResponse Int
getTopicAttributesResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetTopicAttributesResponse' {Int
httpStatus :: Int
$sel:httpStatus:GetTopicAttributesResponse' :: GetTopicAttributesResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: GetTopicAttributesResponse
s@GetTopicAttributesResponse' {} Int
a -> GetTopicAttributesResponse
s {$sel:httpStatus:GetTopicAttributesResponse' :: Int
httpStatus = Int
a} :: GetTopicAttributesResponse)

instance Prelude.NFData GetTopicAttributesResponse where
  rnf :: GetTopicAttributesResponse -> ()
rnf GetTopicAttributesResponse' {Int
Maybe (HashMap Text Text)
httpStatus :: Int
attributes :: Maybe (HashMap Text Text)
$sel:httpStatus:GetTopicAttributesResponse' :: GetTopicAttributesResponse -> Int
$sel:attributes:GetTopicAttributesResponse' :: GetTopicAttributesResponse -> Maybe (HashMap Text Text)
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text Text)
attributes
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus