{-# 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.SetSMSAttributes
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Use this request to set the default settings for sending SMS messages
-- and receiving daily SMS usage reports.
--
-- You can override some of these settings for a single message when you
-- use the @Publish@ action with the @MessageAttributes.entry.N@ parameter.
-- For more information, see
-- <https://docs.aws.amazon.com/sns/latest/dg/sms_publish-to-phone.html Publishing to a mobile phone>
-- in the /Amazon SNS Developer Guide/.
--
-- To use this operation, you must grant the Amazon SNS service principal
-- (@sns.amazonaws.com@) permission to perform the @s3:ListBucket@ action.
module Amazonka.SNS.SetSMSAttributes
  ( -- * Creating a Request
    SetSMSAttributes (..),
    newSetSMSAttributes,

    -- * Request Lenses
    setSMSAttributes_attributes,

    -- * Destructuring the Response
    SetSMSAttributesResponse (..),
    newSetSMSAttributesResponse,

    -- * Response Lenses
    setSMSAttributesResponse_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

-- | The input for the SetSMSAttributes action.
--
-- /See:/ 'newSetSMSAttributes' smart constructor.
data SetSMSAttributes = SetSMSAttributes'
  { -- | The default settings for sending SMS messages from your Amazon Web
    -- Services account. You can set values for the following attribute names:
    --
    -- @MonthlySpendLimit@ – The maximum amount in USD that you are willing to
    -- spend each month to send SMS messages. When Amazon SNS determines that
    -- sending an SMS message would incur a cost that exceeds this limit, it
    -- stops sending SMS messages within minutes.
    --
    -- Amazon SNS stops sending SMS messages within minutes of the limit being
    -- crossed. During that interval, if you continue to send SMS messages, you
    -- will incur costs that exceed your limit.
    --
    -- By default, the spend limit is set to the maximum allowed by Amazon SNS.
    -- If you want to raise the limit, submit an
    -- <https://console.aws.amazon.com/support/home#/case/create?issueType=service-limit-increase&limitType=service-code-sns SNS Limit Increase case>.
    -- For __New limit value__, enter your desired monthly spend limit. In the
    -- __Use Case Description__ field, explain that you are requesting an SMS
    -- monthly spend limit increase.
    --
    -- @DeliveryStatusIAMRole@ – The ARN of the IAM role that allows Amazon SNS
    -- to write logs about SMS deliveries in CloudWatch Logs. For each SMS
    -- message that you send, Amazon SNS writes a log that includes the message
    -- price, the success or failure status, the reason for failure (if the
    -- message failed), the message dwell time, and other information.
    --
    -- @DeliveryStatusSuccessSamplingRate@ – The percentage of successful SMS
    -- deliveries for which Amazon SNS will write logs in CloudWatch Logs. The
    -- value can be an integer from 0 - 100. For example, to write logs only
    -- for failed deliveries, set this value to @0@. To write logs for 10% of
    -- your successful deliveries, set it to @10@.
    --
    -- @DefaultSenderID@ – A string, such as your business brand, that is
    -- displayed as the sender on the receiving device. Support for sender IDs
    -- varies by country. The sender ID can be 1 - 11 alphanumeric characters,
    -- and it must contain at least one letter.
    --
    -- @DefaultSMSType@ – The type of SMS message that you will send by
    -- default. You can assign the following values:
    --
    -- -   @Promotional@ – (Default) Noncritical messages, such as marketing
    --     messages. Amazon SNS optimizes the message delivery to incur the
    --     lowest cost.
    --
    -- -   @Transactional@ – Critical messages that support customer
    --     transactions, such as one-time passcodes for multi-factor
    --     authentication. Amazon SNS optimizes the message delivery to achieve
    --     the highest reliability.
    --
    -- @UsageReportS3Bucket@ – The name of the Amazon S3 bucket to receive
    -- daily SMS usage reports from Amazon SNS. Each day, Amazon SNS will
    -- deliver a usage report as a CSV file to the bucket. The report includes
    -- the following information for each SMS message that was successfully
    -- delivered by your Amazon Web Services account:
    --
    -- -   Time that the message was published (in UTC)
    --
    -- -   Message ID
    --
    -- -   Destination phone number
    --
    -- -   Message type
    --
    -- -   Delivery status
    --
    -- -   Message price (in USD)
    --
    -- -   Part number (a message is split into multiple parts if it is too
    --     long for a single message)
    --
    -- -   Total number of parts
    --
    -- To receive the report, the bucket must have a policy that allows the
    -- Amazon SNS service principal to perform the @s3:PutObject@ and
    -- @s3:GetBucketLocation@ actions.
    --
    -- For an example bucket policy and usage report, see
    -- <https://docs.aws.amazon.com/sns/latest/dg/sms_stats.html Monitoring SMS Activity>
    -- in the /Amazon SNS Developer Guide/.
    SetSMSAttributes -> HashMap Text Text
attributes :: Prelude.HashMap Prelude.Text Prelude.Text
  }
  deriving (SetSMSAttributes -> SetSMSAttributes -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SetSMSAttributes -> SetSMSAttributes -> Bool
$c/= :: SetSMSAttributes -> SetSMSAttributes -> Bool
== :: SetSMSAttributes -> SetSMSAttributes -> Bool
$c== :: SetSMSAttributes -> SetSMSAttributes -> Bool
Prelude.Eq, ReadPrec [SetSMSAttributes]
ReadPrec SetSMSAttributes
Int -> ReadS SetSMSAttributes
ReadS [SetSMSAttributes]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SetSMSAttributes]
$creadListPrec :: ReadPrec [SetSMSAttributes]
readPrec :: ReadPrec SetSMSAttributes
$creadPrec :: ReadPrec SetSMSAttributes
readList :: ReadS [SetSMSAttributes]
$creadList :: ReadS [SetSMSAttributes]
readsPrec :: Int -> ReadS SetSMSAttributes
$creadsPrec :: Int -> ReadS SetSMSAttributes
Prelude.Read, Int -> SetSMSAttributes -> ShowS
[SetSMSAttributes] -> ShowS
SetSMSAttributes -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SetSMSAttributes] -> ShowS
$cshowList :: [SetSMSAttributes] -> ShowS
show :: SetSMSAttributes -> String
$cshow :: SetSMSAttributes -> String
showsPrec :: Int -> SetSMSAttributes -> ShowS
$cshowsPrec :: Int -> SetSMSAttributes -> ShowS
Prelude.Show, forall x. Rep SetSMSAttributes x -> SetSMSAttributes
forall x. SetSMSAttributes -> Rep SetSMSAttributes x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SetSMSAttributes x -> SetSMSAttributes
$cfrom :: forall x. SetSMSAttributes -> Rep SetSMSAttributes x
Prelude.Generic)

-- |
-- Create a value of 'SetSMSAttributes' 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', 'setSMSAttributes_attributes' - The default settings for sending SMS messages from your Amazon Web
-- Services account. You can set values for the following attribute names:
--
-- @MonthlySpendLimit@ – The maximum amount in USD that you are willing to
-- spend each month to send SMS messages. When Amazon SNS determines that
-- sending an SMS message would incur a cost that exceeds this limit, it
-- stops sending SMS messages within minutes.
--
-- Amazon SNS stops sending SMS messages within minutes of the limit being
-- crossed. During that interval, if you continue to send SMS messages, you
-- will incur costs that exceed your limit.
--
-- By default, the spend limit is set to the maximum allowed by Amazon SNS.
-- If you want to raise the limit, submit an
-- <https://console.aws.amazon.com/support/home#/case/create?issueType=service-limit-increase&limitType=service-code-sns SNS Limit Increase case>.
-- For __New limit value__, enter your desired monthly spend limit. In the
-- __Use Case Description__ field, explain that you are requesting an SMS
-- monthly spend limit increase.
--
-- @DeliveryStatusIAMRole@ – The ARN of the IAM role that allows Amazon SNS
-- to write logs about SMS deliveries in CloudWatch Logs. For each SMS
-- message that you send, Amazon SNS writes a log that includes the message
-- price, the success or failure status, the reason for failure (if the
-- message failed), the message dwell time, and other information.
--
-- @DeliveryStatusSuccessSamplingRate@ – The percentage of successful SMS
-- deliveries for which Amazon SNS will write logs in CloudWatch Logs. The
-- value can be an integer from 0 - 100. For example, to write logs only
-- for failed deliveries, set this value to @0@. To write logs for 10% of
-- your successful deliveries, set it to @10@.
--
-- @DefaultSenderID@ – A string, such as your business brand, that is
-- displayed as the sender on the receiving device. Support for sender IDs
-- varies by country. The sender ID can be 1 - 11 alphanumeric characters,
-- and it must contain at least one letter.
--
-- @DefaultSMSType@ – The type of SMS message that you will send by
-- default. You can assign the following values:
--
-- -   @Promotional@ – (Default) Noncritical messages, such as marketing
--     messages. Amazon SNS optimizes the message delivery to incur the
--     lowest cost.
--
-- -   @Transactional@ – Critical messages that support customer
--     transactions, such as one-time passcodes for multi-factor
--     authentication. Amazon SNS optimizes the message delivery to achieve
--     the highest reliability.
--
-- @UsageReportS3Bucket@ – The name of the Amazon S3 bucket to receive
-- daily SMS usage reports from Amazon SNS. Each day, Amazon SNS will
-- deliver a usage report as a CSV file to the bucket. The report includes
-- the following information for each SMS message that was successfully
-- delivered by your Amazon Web Services account:
--
-- -   Time that the message was published (in UTC)
--
-- -   Message ID
--
-- -   Destination phone number
--
-- -   Message type
--
-- -   Delivery status
--
-- -   Message price (in USD)
--
-- -   Part number (a message is split into multiple parts if it is too
--     long for a single message)
--
-- -   Total number of parts
--
-- To receive the report, the bucket must have a policy that allows the
-- Amazon SNS service principal to perform the @s3:PutObject@ and
-- @s3:GetBucketLocation@ actions.
--
-- For an example bucket policy and usage report, see
-- <https://docs.aws.amazon.com/sns/latest/dg/sms_stats.html Monitoring SMS Activity>
-- in the /Amazon SNS Developer Guide/.
newSetSMSAttributes ::
  SetSMSAttributes
newSetSMSAttributes :: SetSMSAttributes
newSetSMSAttributes =
  SetSMSAttributes' {$sel:attributes:SetSMSAttributes' :: HashMap Text Text
attributes = forall a. Monoid a => a
Prelude.mempty}

-- | The default settings for sending SMS messages from your Amazon Web
-- Services account. You can set values for the following attribute names:
--
-- @MonthlySpendLimit@ – The maximum amount in USD that you are willing to
-- spend each month to send SMS messages. When Amazon SNS determines that
-- sending an SMS message would incur a cost that exceeds this limit, it
-- stops sending SMS messages within minutes.
--
-- Amazon SNS stops sending SMS messages within minutes of the limit being
-- crossed. During that interval, if you continue to send SMS messages, you
-- will incur costs that exceed your limit.
--
-- By default, the spend limit is set to the maximum allowed by Amazon SNS.
-- If you want to raise the limit, submit an
-- <https://console.aws.amazon.com/support/home#/case/create?issueType=service-limit-increase&limitType=service-code-sns SNS Limit Increase case>.
-- For __New limit value__, enter your desired monthly spend limit. In the
-- __Use Case Description__ field, explain that you are requesting an SMS
-- monthly spend limit increase.
--
-- @DeliveryStatusIAMRole@ – The ARN of the IAM role that allows Amazon SNS
-- to write logs about SMS deliveries in CloudWatch Logs. For each SMS
-- message that you send, Amazon SNS writes a log that includes the message
-- price, the success or failure status, the reason for failure (if the
-- message failed), the message dwell time, and other information.
--
-- @DeliveryStatusSuccessSamplingRate@ – The percentage of successful SMS
-- deliveries for which Amazon SNS will write logs in CloudWatch Logs. The
-- value can be an integer from 0 - 100. For example, to write logs only
-- for failed deliveries, set this value to @0@. To write logs for 10% of
-- your successful deliveries, set it to @10@.
--
-- @DefaultSenderID@ – A string, such as your business brand, that is
-- displayed as the sender on the receiving device. Support for sender IDs
-- varies by country. The sender ID can be 1 - 11 alphanumeric characters,
-- and it must contain at least one letter.
--
-- @DefaultSMSType@ – The type of SMS message that you will send by
-- default. You can assign the following values:
--
-- -   @Promotional@ – (Default) Noncritical messages, such as marketing
--     messages. Amazon SNS optimizes the message delivery to incur the
--     lowest cost.
--
-- -   @Transactional@ – Critical messages that support customer
--     transactions, such as one-time passcodes for multi-factor
--     authentication. Amazon SNS optimizes the message delivery to achieve
--     the highest reliability.
--
-- @UsageReportS3Bucket@ – The name of the Amazon S3 bucket to receive
-- daily SMS usage reports from Amazon SNS. Each day, Amazon SNS will
-- deliver a usage report as a CSV file to the bucket. The report includes
-- the following information for each SMS message that was successfully
-- delivered by your Amazon Web Services account:
--
-- -   Time that the message was published (in UTC)
--
-- -   Message ID
--
-- -   Destination phone number
--
-- -   Message type
--
-- -   Delivery status
--
-- -   Message price (in USD)
--
-- -   Part number (a message is split into multiple parts if it is too
--     long for a single message)
--
-- -   Total number of parts
--
-- To receive the report, the bucket must have a policy that allows the
-- Amazon SNS service principal to perform the @s3:PutObject@ and
-- @s3:GetBucketLocation@ actions.
--
-- For an example bucket policy and usage report, see
-- <https://docs.aws.amazon.com/sns/latest/dg/sms_stats.html Monitoring SMS Activity>
-- in the /Amazon SNS Developer Guide/.
setSMSAttributes_attributes :: Lens.Lens' SetSMSAttributes (Prelude.HashMap Prelude.Text Prelude.Text)
setSMSAttributes_attributes :: Lens' SetSMSAttributes (HashMap Text Text)
setSMSAttributes_attributes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SetSMSAttributes' {HashMap Text Text
attributes :: HashMap Text Text
$sel:attributes:SetSMSAttributes' :: SetSMSAttributes -> HashMap Text Text
attributes} -> HashMap Text Text
attributes) (\s :: SetSMSAttributes
s@SetSMSAttributes' {} HashMap Text Text
a -> SetSMSAttributes
s {$sel:attributes:SetSMSAttributes' :: HashMap Text Text
attributes = HashMap Text Text
a} :: SetSMSAttributes) 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 SetSMSAttributes where
  type
    AWSResponse SetSMSAttributes =
      SetSMSAttributesResponse
  request :: (Service -> Service)
-> SetSMSAttributes -> Request SetSMSAttributes
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 SetSMSAttributes
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse SetSMSAttributes)))
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
"SetSMSAttributesResult"
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Int -> SetSMSAttributesResponse
SetSMSAttributesResponse'
            forall (f :: * -> *) a b. Functor 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 SetSMSAttributes where
  hashWithSalt :: Int -> SetSMSAttributes -> Int
hashWithSalt Int
_salt SetSMSAttributes' {HashMap Text Text
attributes :: HashMap Text Text
$sel:attributes:SetSMSAttributes' :: SetSMSAttributes -> HashMap Text Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` HashMap Text Text
attributes

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

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

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

instance Data.ToQuery SetSMSAttributes where
  toQuery :: SetSMSAttributes -> QueryString
toQuery SetSMSAttributes' {HashMap Text Text
attributes :: HashMap Text Text
$sel:attributes:SetSMSAttributes' :: SetSMSAttributes -> HashMap Text Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"SetSMSAttributes" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2010-03-31" :: Prelude.ByteString),
        ByteString
"attributes"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: forall k v.
(ToQuery k, ToQuery v) =>
ByteString
-> ByteString -> ByteString -> HashMap k v -> QueryString
Data.toQueryMap ByteString
"entry" ByteString
"key" ByteString
"value" HashMap Text Text
attributes
      ]

-- | The response for the SetSMSAttributes action.
--
-- /See:/ 'newSetSMSAttributesResponse' smart constructor.
data SetSMSAttributesResponse = SetSMSAttributesResponse'
  { -- | The response's http status code.
    SetSMSAttributesResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (SetSMSAttributesResponse -> SetSMSAttributesResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SetSMSAttributesResponse -> SetSMSAttributesResponse -> Bool
$c/= :: SetSMSAttributesResponse -> SetSMSAttributesResponse -> Bool
== :: SetSMSAttributesResponse -> SetSMSAttributesResponse -> Bool
$c== :: SetSMSAttributesResponse -> SetSMSAttributesResponse -> Bool
Prelude.Eq, ReadPrec [SetSMSAttributesResponse]
ReadPrec SetSMSAttributesResponse
Int -> ReadS SetSMSAttributesResponse
ReadS [SetSMSAttributesResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SetSMSAttributesResponse]
$creadListPrec :: ReadPrec [SetSMSAttributesResponse]
readPrec :: ReadPrec SetSMSAttributesResponse
$creadPrec :: ReadPrec SetSMSAttributesResponse
readList :: ReadS [SetSMSAttributesResponse]
$creadList :: ReadS [SetSMSAttributesResponse]
readsPrec :: Int -> ReadS SetSMSAttributesResponse
$creadsPrec :: Int -> ReadS SetSMSAttributesResponse
Prelude.Read, Int -> SetSMSAttributesResponse -> ShowS
[SetSMSAttributesResponse] -> ShowS
SetSMSAttributesResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SetSMSAttributesResponse] -> ShowS
$cshowList :: [SetSMSAttributesResponse] -> ShowS
show :: SetSMSAttributesResponse -> String
$cshow :: SetSMSAttributesResponse -> String
showsPrec :: Int -> SetSMSAttributesResponse -> ShowS
$cshowsPrec :: Int -> SetSMSAttributesResponse -> ShowS
Prelude.Show, forall x.
Rep SetSMSAttributesResponse x -> SetSMSAttributesResponse
forall x.
SetSMSAttributesResponse -> Rep SetSMSAttributesResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep SetSMSAttributesResponse x -> SetSMSAttributesResponse
$cfrom :: forall x.
SetSMSAttributesResponse -> Rep SetSMSAttributesResponse x
Prelude.Generic)

-- |
-- Create a value of 'SetSMSAttributesResponse' 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:
--
-- 'httpStatus', 'setSMSAttributesResponse_httpStatus' - The response's http status code.
newSetSMSAttributesResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  SetSMSAttributesResponse
newSetSMSAttributesResponse :: Int -> SetSMSAttributesResponse
newSetSMSAttributesResponse Int
pHttpStatus_ =
  SetSMSAttributesResponse'
    { $sel:httpStatus:SetSMSAttributesResponse' :: Int
httpStatus =
        Int
pHttpStatus_
    }

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

instance Prelude.NFData SetSMSAttributesResponse where
  rnf :: SetSMSAttributesResponse -> ()
rnf SetSMSAttributesResponse' {Int
httpStatus :: Int
$sel:httpStatus:SetSMSAttributesResponse' :: SetSMSAttributesResponse -> Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus