{-# 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.GetSubscriptionAttributes
-- 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 subscription.
module Amazonka.SNS.GetSubscriptionAttributes
  ( -- * Creating a Request
    GetSubscriptionAttributes (..),
    newGetSubscriptionAttributes,

    -- * Request Lenses
    getSubscriptionAttributes_subscriptionArn,

    -- * Destructuring the Response
    GetSubscriptionAttributesResponse (..),
    newGetSubscriptionAttributesResponse,

    -- * Response Lenses
    getSubscriptionAttributesResponse_attributes,
    getSubscriptionAttributesResponse_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 GetSubscriptionAttributes.
--
-- /See:/ 'newGetSubscriptionAttributes' smart constructor.
data GetSubscriptionAttributes = GetSubscriptionAttributes'
  { -- | The ARN of the subscription whose properties you want to get.
    GetSubscriptionAttributes -> Text
subscriptionArn :: Prelude.Text
  }
  deriving (GetSubscriptionAttributes -> GetSubscriptionAttributes -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetSubscriptionAttributes -> GetSubscriptionAttributes -> Bool
$c/= :: GetSubscriptionAttributes -> GetSubscriptionAttributes -> Bool
== :: GetSubscriptionAttributes -> GetSubscriptionAttributes -> Bool
$c== :: GetSubscriptionAttributes -> GetSubscriptionAttributes -> Bool
Prelude.Eq, ReadPrec [GetSubscriptionAttributes]
ReadPrec GetSubscriptionAttributes
Int -> ReadS GetSubscriptionAttributes
ReadS [GetSubscriptionAttributes]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetSubscriptionAttributes]
$creadListPrec :: ReadPrec [GetSubscriptionAttributes]
readPrec :: ReadPrec GetSubscriptionAttributes
$creadPrec :: ReadPrec GetSubscriptionAttributes
readList :: ReadS [GetSubscriptionAttributes]
$creadList :: ReadS [GetSubscriptionAttributes]
readsPrec :: Int -> ReadS GetSubscriptionAttributes
$creadsPrec :: Int -> ReadS GetSubscriptionAttributes
Prelude.Read, Int -> GetSubscriptionAttributes -> ShowS
[GetSubscriptionAttributes] -> ShowS
GetSubscriptionAttributes -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetSubscriptionAttributes] -> ShowS
$cshowList :: [GetSubscriptionAttributes] -> ShowS
show :: GetSubscriptionAttributes -> String
$cshow :: GetSubscriptionAttributes -> String
showsPrec :: Int -> GetSubscriptionAttributes -> ShowS
$cshowsPrec :: Int -> GetSubscriptionAttributes -> ShowS
Prelude.Show, forall x.
Rep GetSubscriptionAttributes x -> GetSubscriptionAttributes
forall x.
GetSubscriptionAttributes -> Rep GetSubscriptionAttributes x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetSubscriptionAttributes x -> GetSubscriptionAttributes
$cfrom :: forall x.
GetSubscriptionAttributes -> Rep GetSubscriptionAttributes x
Prelude.Generic)

-- |
-- Create a value of 'GetSubscriptionAttributes' 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:
--
-- 'subscriptionArn', 'getSubscriptionAttributes_subscriptionArn' - The ARN of the subscription whose properties you want to get.
newGetSubscriptionAttributes ::
  -- | 'subscriptionArn'
  Prelude.Text ->
  GetSubscriptionAttributes
newGetSubscriptionAttributes :: Text -> GetSubscriptionAttributes
newGetSubscriptionAttributes Text
pSubscriptionArn_ =
  GetSubscriptionAttributes'
    { $sel:subscriptionArn:GetSubscriptionAttributes' :: Text
subscriptionArn =
        Text
pSubscriptionArn_
    }

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

instance Core.AWSRequest GetSubscriptionAttributes where
  type
    AWSResponse GetSubscriptionAttributes =
      GetSubscriptionAttributesResponse
  request :: (Service -> Service)
-> GetSubscriptionAttributes -> Request GetSubscriptionAttributes
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 GetSubscriptionAttributes
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse GetSubscriptionAttributes)))
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
"GetSubscriptionAttributesResult"
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Maybe (HashMap Text Text)
-> Int -> GetSubscriptionAttributesResponse
GetSubscriptionAttributesResponse'
            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 GetSubscriptionAttributes where
  hashWithSalt :: Int -> GetSubscriptionAttributes -> Int
hashWithSalt Int
_salt GetSubscriptionAttributes' {Text
subscriptionArn :: Text
$sel:subscriptionArn:GetSubscriptionAttributes' :: GetSubscriptionAttributes -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
subscriptionArn

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

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

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

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

-- | Response for GetSubscriptionAttributes action.
--
-- /See:/ 'newGetSubscriptionAttributesResponse' smart constructor.
data GetSubscriptionAttributesResponse = GetSubscriptionAttributesResponse'
  { -- | A map of the subscription\'s attributes. Attributes in this map include
    -- the following:
    --
    -- -   @ConfirmationWasAuthenticated@ – @true@ if the subscription
    --     confirmation request was authenticated.
    --
    -- -   @DeliveryPolicy@ – The JSON serialization of the subscription\'s
    --     delivery policy.
    --
    -- -   @EffectiveDeliveryPolicy@ – The JSON serialization of the effective
    --     delivery policy that takes into account the topic delivery policy
    --     and account system defaults.
    --
    -- -   @FilterPolicy@ – The filter policy JSON that is assigned to the
    --     subscription. For more information, see
    --     <https://docs.aws.amazon.com/sns/latest/dg/sns-message-filtering.html Amazon SNS Message Filtering>
    --     in the /Amazon SNS Developer Guide/.
    --
    -- -   @FilterPolicyScope@ – This attribute lets you choose the filtering
    --     scope by using one of the following string value types:
    --
    --     -   @MessageAttributes@ (default) – The filter is applied on the
    --         message attributes.
    --
    --     -   @MessageBody@ – The filter is applied on the message body.
    --
    -- -   @Owner@ – The Amazon Web Services account ID of the subscription\'s
    --     owner.
    --
    -- -   @PendingConfirmation@ – @true@ if the subscription hasn\'t been
    --     confirmed. To confirm a pending subscription, call the
    --     @ConfirmSubscription@ action with a confirmation token.
    --
    -- -   @RawMessageDelivery@ – @true@ if raw message delivery is enabled for
    --     the subscription. Raw messages are free of JSON formatting and can
    --     be sent to HTTP\/S and Amazon SQS endpoints.
    --
    -- -   @RedrivePolicy@ – When specified, sends undeliverable messages to
    --     the specified Amazon SQS dead-letter queue. Messages that can\'t be
    --     delivered due to client errors (for example, when the subscribed
    --     endpoint is unreachable) or server errors (for example, when the
    --     service that powers the subscribed endpoint becomes unavailable) are
    --     held in the dead-letter queue for further analysis or reprocessing.
    --
    -- -   @SubscriptionArn@ – The subscription\'s ARN.
    --
    -- -   @TopicArn@ – The topic ARN that the subscription is associated with.
    --
    -- The following attribute applies only to Amazon Kinesis Data Firehose
    -- delivery stream subscriptions:
    --
    -- -   @SubscriptionRoleArn@ – The ARN of the IAM role that has the
    --     following:
    --
    --     -   Permission to write to the Kinesis Data Firehose delivery stream
    --
    --     -   Amazon SNS listed as a trusted entity
    --
    --     Specifying a valid ARN for this attribute is required for Kinesis
    --     Data Firehose delivery stream subscriptions. For more information,
    --     see
    --     <https://docs.aws.amazon.com/sns/latest/dg/sns-firehose-as-subscriber.html Fanout to Kinesis Data Firehose delivery streams>
    --     in the /Amazon SNS Developer Guide/.
    GetSubscriptionAttributesResponse -> Maybe (HashMap Text Text)
attributes :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | The response's http status code.
    GetSubscriptionAttributesResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetSubscriptionAttributesResponse
-> GetSubscriptionAttributesResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetSubscriptionAttributesResponse
-> GetSubscriptionAttributesResponse -> Bool
$c/= :: GetSubscriptionAttributesResponse
-> GetSubscriptionAttributesResponse -> Bool
== :: GetSubscriptionAttributesResponse
-> GetSubscriptionAttributesResponse -> Bool
$c== :: GetSubscriptionAttributesResponse
-> GetSubscriptionAttributesResponse -> Bool
Prelude.Eq, ReadPrec [GetSubscriptionAttributesResponse]
ReadPrec GetSubscriptionAttributesResponse
Int -> ReadS GetSubscriptionAttributesResponse
ReadS [GetSubscriptionAttributesResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetSubscriptionAttributesResponse]
$creadListPrec :: ReadPrec [GetSubscriptionAttributesResponse]
readPrec :: ReadPrec GetSubscriptionAttributesResponse
$creadPrec :: ReadPrec GetSubscriptionAttributesResponse
readList :: ReadS [GetSubscriptionAttributesResponse]
$creadList :: ReadS [GetSubscriptionAttributesResponse]
readsPrec :: Int -> ReadS GetSubscriptionAttributesResponse
$creadsPrec :: Int -> ReadS GetSubscriptionAttributesResponse
Prelude.Read, Int -> GetSubscriptionAttributesResponse -> ShowS
[GetSubscriptionAttributesResponse] -> ShowS
GetSubscriptionAttributesResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetSubscriptionAttributesResponse] -> ShowS
$cshowList :: [GetSubscriptionAttributesResponse] -> ShowS
show :: GetSubscriptionAttributesResponse -> String
$cshow :: GetSubscriptionAttributesResponse -> String
showsPrec :: Int -> GetSubscriptionAttributesResponse -> ShowS
$cshowsPrec :: Int -> GetSubscriptionAttributesResponse -> ShowS
Prelude.Show, forall x.
Rep GetSubscriptionAttributesResponse x
-> GetSubscriptionAttributesResponse
forall x.
GetSubscriptionAttributesResponse
-> Rep GetSubscriptionAttributesResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetSubscriptionAttributesResponse x
-> GetSubscriptionAttributesResponse
$cfrom :: forall x.
GetSubscriptionAttributesResponse
-> Rep GetSubscriptionAttributesResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetSubscriptionAttributesResponse' 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', 'getSubscriptionAttributesResponse_attributes' - A map of the subscription\'s attributes. Attributes in this map include
-- the following:
--
-- -   @ConfirmationWasAuthenticated@ – @true@ if the subscription
--     confirmation request was authenticated.
--
-- -   @DeliveryPolicy@ – The JSON serialization of the subscription\'s
--     delivery policy.
--
-- -   @EffectiveDeliveryPolicy@ – The JSON serialization of the effective
--     delivery policy that takes into account the topic delivery policy
--     and account system defaults.
--
-- -   @FilterPolicy@ – The filter policy JSON that is assigned to the
--     subscription. For more information, see
--     <https://docs.aws.amazon.com/sns/latest/dg/sns-message-filtering.html Amazon SNS Message Filtering>
--     in the /Amazon SNS Developer Guide/.
--
-- -   @FilterPolicyScope@ – This attribute lets you choose the filtering
--     scope by using one of the following string value types:
--
--     -   @MessageAttributes@ (default) – The filter is applied on the
--         message attributes.
--
--     -   @MessageBody@ – The filter is applied on the message body.
--
-- -   @Owner@ – The Amazon Web Services account ID of the subscription\'s
--     owner.
--
-- -   @PendingConfirmation@ – @true@ if the subscription hasn\'t been
--     confirmed. To confirm a pending subscription, call the
--     @ConfirmSubscription@ action with a confirmation token.
--
-- -   @RawMessageDelivery@ – @true@ if raw message delivery is enabled for
--     the subscription. Raw messages are free of JSON formatting and can
--     be sent to HTTP\/S and Amazon SQS endpoints.
--
-- -   @RedrivePolicy@ – When specified, sends undeliverable messages to
--     the specified Amazon SQS dead-letter queue. Messages that can\'t be
--     delivered due to client errors (for example, when the subscribed
--     endpoint is unreachable) or server errors (for example, when the
--     service that powers the subscribed endpoint becomes unavailable) are
--     held in the dead-letter queue for further analysis or reprocessing.
--
-- -   @SubscriptionArn@ – The subscription\'s ARN.
--
-- -   @TopicArn@ – The topic ARN that the subscription is associated with.
--
-- The following attribute applies only to Amazon Kinesis Data Firehose
-- delivery stream subscriptions:
--
-- -   @SubscriptionRoleArn@ – The ARN of the IAM role that has the
--     following:
--
--     -   Permission to write to the Kinesis Data Firehose delivery stream
--
--     -   Amazon SNS listed as a trusted entity
--
--     Specifying a valid ARN for this attribute is required for Kinesis
--     Data Firehose delivery stream subscriptions. For more information,
--     see
--     <https://docs.aws.amazon.com/sns/latest/dg/sns-firehose-as-subscriber.html Fanout to Kinesis Data Firehose delivery streams>
--     in the /Amazon SNS Developer Guide/.
--
-- 'httpStatus', 'getSubscriptionAttributesResponse_httpStatus' - The response's http status code.
newGetSubscriptionAttributesResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetSubscriptionAttributesResponse
newGetSubscriptionAttributesResponse :: Int -> GetSubscriptionAttributesResponse
newGetSubscriptionAttributesResponse Int
pHttpStatus_ =
  GetSubscriptionAttributesResponse'
    { $sel:attributes:GetSubscriptionAttributesResponse' :: Maybe (HashMap Text Text)
attributes =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetSubscriptionAttributesResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | A map of the subscription\'s attributes. Attributes in this map include
-- the following:
--
-- -   @ConfirmationWasAuthenticated@ – @true@ if the subscription
--     confirmation request was authenticated.
--
-- -   @DeliveryPolicy@ – The JSON serialization of the subscription\'s
--     delivery policy.
--
-- -   @EffectiveDeliveryPolicy@ – The JSON serialization of the effective
--     delivery policy that takes into account the topic delivery policy
--     and account system defaults.
--
-- -   @FilterPolicy@ – The filter policy JSON that is assigned to the
--     subscription. For more information, see
--     <https://docs.aws.amazon.com/sns/latest/dg/sns-message-filtering.html Amazon SNS Message Filtering>
--     in the /Amazon SNS Developer Guide/.
--
-- -   @FilterPolicyScope@ – This attribute lets you choose the filtering
--     scope by using one of the following string value types:
--
--     -   @MessageAttributes@ (default) – The filter is applied on the
--         message attributes.
--
--     -   @MessageBody@ – The filter is applied on the message body.
--
-- -   @Owner@ – The Amazon Web Services account ID of the subscription\'s
--     owner.
--
-- -   @PendingConfirmation@ – @true@ if the subscription hasn\'t been
--     confirmed. To confirm a pending subscription, call the
--     @ConfirmSubscription@ action with a confirmation token.
--
-- -   @RawMessageDelivery@ – @true@ if raw message delivery is enabled for
--     the subscription. Raw messages are free of JSON formatting and can
--     be sent to HTTP\/S and Amazon SQS endpoints.
--
-- -   @RedrivePolicy@ – When specified, sends undeliverable messages to
--     the specified Amazon SQS dead-letter queue. Messages that can\'t be
--     delivered due to client errors (for example, when the subscribed
--     endpoint is unreachable) or server errors (for example, when the
--     service that powers the subscribed endpoint becomes unavailable) are
--     held in the dead-letter queue for further analysis or reprocessing.
--
-- -   @SubscriptionArn@ – The subscription\'s ARN.
--
-- -   @TopicArn@ – The topic ARN that the subscription is associated with.
--
-- The following attribute applies only to Amazon Kinesis Data Firehose
-- delivery stream subscriptions:
--
-- -   @SubscriptionRoleArn@ – The ARN of the IAM role that has the
--     following:
--
--     -   Permission to write to the Kinesis Data Firehose delivery stream
--
--     -   Amazon SNS listed as a trusted entity
--
--     Specifying a valid ARN for this attribute is required for Kinesis
--     Data Firehose delivery stream subscriptions. For more information,
--     see
--     <https://docs.aws.amazon.com/sns/latest/dg/sns-firehose-as-subscriber.html Fanout to Kinesis Data Firehose delivery streams>
--     in the /Amazon SNS Developer Guide/.
getSubscriptionAttributesResponse_attributes :: Lens.Lens' GetSubscriptionAttributesResponse (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
getSubscriptionAttributesResponse_attributes :: Lens' GetSubscriptionAttributesResponse (Maybe (HashMap Text Text))
getSubscriptionAttributesResponse_attributes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetSubscriptionAttributesResponse' {Maybe (HashMap Text Text)
attributes :: Maybe (HashMap Text Text)
$sel:attributes:GetSubscriptionAttributesResponse' :: GetSubscriptionAttributesResponse -> Maybe (HashMap Text Text)
attributes} -> Maybe (HashMap Text Text)
attributes) (\s :: GetSubscriptionAttributesResponse
s@GetSubscriptionAttributesResponse' {} Maybe (HashMap Text Text)
a -> GetSubscriptionAttributesResponse
s {$sel:attributes:GetSubscriptionAttributesResponse' :: Maybe (HashMap Text Text)
attributes = Maybe (HashMap Text Text)
a} :: GetSubscriptionAttributesResponse) 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.
getSubscriptionAttributesResponse_httpStatus :: Lens.Lens' GetSubscriptionAttributesResponse Prelude.Int
getSubscriptionAttributesResponse_httpStatus :: Lens' GetSubscriptionAttributesResponse Int
getSubscriptionAttributesResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetSubscriptionAttributesResponse' {Int
httpStatus :: Int
$sel:httpStatus:GetSubscriptionAttributesResponse' :: GetSubscriptionAttributesResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: GetSubscriptionAttributesResponse
s@GetSubscriptionAttributesResponse' {} Int
a -> GetSubscriptionAttributesResponse
s {$sel:httpStatus:GetSubscriptionAttributesResponse' :: Int
httpStatus = Int
a} :: GetSubscriptionAttributesResponse)

instance
  Prelude.NFData
    GetSubscriptionAttributesResponse
  where
  rnf :: GetSubscriptionAttributesResponse -> ()
rnf GetSubscriptionAttributesResponse' {Int
Maybe (HashMap Text Text)
httpStatus :: Int
attributes :: Maybe (HashMap Text Text)
$sel:httpStatus:GetSubscriptionAttributesResponse' :: GetSubscriptionAttributesResponse -> Int
$sel:attributes:GetSubscriptionAttributesResponse' :: GetSubscriptionAttributesResponse -> 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