{-# 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.SES.SendBounce
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Generates and sends a bounce message to the sender of an email you
-- received through Amazon SES. You can only use this API on an email up to
-- 24 hours after you receive it.
--
-- You cannot use this API to send generic bounces for mail that was not
-- received by Amazon SES.
--
-- For information about receiving email through Amazon SES, see the
-- <https://docs.aws.amazon.com/ses/latest/DeveloperGuide/receiving-email.html Amazon SES Developer Guide>.
--
-- You can execute this operation no more than once per second.
module Amazonka.SES.SendBounce
  ( -- * Creating a Request
    SendBounce (..),
    newSendBounce,

    -- * Request Lenses
    sendBounce_bounceSenderArn,
    sendBounce_explanation,
    sendBounce_messageDsn,
    sendBounce_originalMessageId,
    sendBounce_bounceSender,
    sendBounce_bouncedRecipientInfoList,

    -- * Destructuring the Response
    SendBounceResponse (..),
    newSendBounceResponse,

    -- * Response Lenses
    sendBounceResponse_messageId,
    sendBounceResponse_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.SES.Types

-- | Represents a request to send a bounce message to the sender of an email
-- you received through Amazon SES.
--
-- /See:/ 'newSendBounce' smart constructor.
data SendBounce = SendBounce'
  { -- | This parameter is used only for sending authorization. It is the ARN of
    -- the identity that is associated with the sending authorization policy
    -- that permits you to use the address in the \"From\" header of the
    -- bounce. For more information about sending authorization, see the
    -- <https://docs.aws.amazon.com/ses/latest/DeveloperGuide/sending-authorization.html Amazon SES Developer Guide>.
    SendBounce -> Maybe Text
bounceSenderArn :: Prelude.Maybe Prelude.Text,
    -- | Human-readable text for the bounce message to explain the failure. If
    -- not specified, the text will be auto-generated based on the bounced
    -- recipient information.
    SendBounce -> Maybe Text
explanation :: Prelude.Maybe Prelude.Text,
    -- | Message-related DSN fields. If not specified, Amazon SES will choose the
    -- values.
    SendBounce -> Maybe MessageDsn
messageDsn :: Prelude.Maybe MessageDsn,
    -- | The message ID of the message to be bounced.
    SendBounce -> Text
originalMessageId :: Prelude.Text,
    -- | The address to use in the \"From\" header of the bounce message. This
    -- must be an identity that you have verified with Amazon SES.
    SendBounce -> Text
bounceSender :: Prelude.Text,
    -- | A list of recipients of the bounced message, including the information
    -- required to create the Delivery Status Notifications (DSNs) for the
    -- recipients. You must specify at least one @BouncedRecipientInfo@ in the
    -- list.
    SendBounce -> [BouncedRecipientInfo]
bouncedRecipientInfoList :: [BouncedRecipientInfo]
  }
  deriving (SendBounce -> SendBounce -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SendBounce -> SendBounce -> Bool
$c/= :: SendBounce -> SendBounce -> Bool
== :: SendBounce -> SendBounce -> Bool
$c== :: SendBounce -> SendBounce -> Bool
Prelude.Eq, ReadPrec [SendBounce]
ReadPrec SendBounce
Int -> ReadS SendBounce
ReadS [SendBounce]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SendBounce]
$creadListPrec :: ReadPrec [SendBounce]
readPrec :: ReadPrec SendBounce
$creadPrec :: ReadPrec SendBounce
readList :: ReadS [SendBounce]
$creadList :: ReadS [SendBounce]
readsPrec :: Int -> ReadS SendBounce
$creadsPrec :: Int -> ReadS SendBounce
Prelude.Read, Int -> SendBounce -> ShowS
[SendBounce] -> ShowS
SendBounce -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SendBounce] -> ShowS
$cshowList :: [SendBounce] -> ShowS
show :: SendBounce -> String
$cshow :: SendBounce -> String
showsPrec :: Int -> SendBounce -> ShowS
$cshowsPrec :: Int -> SendBounce -> ShowS
Prelude.Show, forall x. Rep SendBounce x -> SendBounce
forall x. SendBounce -> Rep SendBounce x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SendBounce x -> SendBounce
$cfrom :: forall x. SendBounce -> Rep SendBounce x
Prelude.Generic)

-- |
-- Create a value of 'SendBounce' 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:
--
-- 'bounceSenderArn', 'sendBounce_bounceSenderArn' - This parameter is used only for sending authorization. It is the ARN of
-- the identity that is associated with the sending authorization policy
-- that permits you to use the address in the \"From\" header of the
-- bounce. For more information about sending authorization, see the
-- <https://docs.aws.amazon.com/ses/latest/DeveloperGuide/sending-authorization.html Amazon SES Developer Guide>.
--
-- 'explanation', 'sendBounce_explanation' - Human-readable text for the bounce message to explain the failure. If
-- not specified, the text will be auto-generated based on the bounced
-- recipient information.
--
-- 'messageDsn', 'sendBounce_messageDsn' - Message-related DSN fields. If not specified, Amazon SES will choose the
-- values.
--
-- 'originalMessageId', 'sendBounce_originalMessageId' - The message ID of the message to be bounced.
--
-- 'bounceSender', 'sendBounce_bounceSender' - The address to use in the \"From\" header of the bounce message. This
-- must be an identity that you have verified with Amazon SES.
--
-- 'bouncedRecipientInfoList', 'sendBounce_bouncedRecipientInfoList' - A list of recipients of the bounced message, including the information
-- required to create the Delivery Status Notifications (DSNs) for the
-- recipients. You must specify at least one @BouncedRecipientInfo@ in the
-- list.
newSendBounce ::
  -- | 'originalMessageId'
  Prelude.Text ->
  -- | 'bounceSender'
  Prelude.Text ->
  SendBounce
newSendBounce :: Text -> Text -> SendBounce
newSendBounce Text
pOriginalMessageId_ Text
pBounceSender_ =
  SendBounce'
    { $sel:bounceSenderArn:SendBounce' :: Maybe Text
bounceSenderArn = forall a. Maybe a
Prelude.Nothing,
      $sel:explanation:SendBounce' :: Maybe Text
explanation = forall a. Maybe a
Prelude.Nothing,
      $sel:messageDsn:SendBounce' :: Maybe MessageDsn
messageDsn = forall a. Maybe a
Prelude.Nothing,
      $sel:originalMessageId:SendBounce' :: Text
originalMessageId = Text
pOriginalMessageId_,
      $sel:bounceSender:SendBounce' :: Text
bounceSender = Text
pBounceSender_,
      $sel:bouncedRecipientInfoList:SendBounce' :: [BouncedRecipientInfo]
bouncedRecipientInfoList = forall a. Monoid a => a
Prelude.mempty
    }

-- | This parameter is used only for sending authorization. It is the ARN of
-- the identity that is associated with the sending authorization policy
-- that permits you to use the address in the \"From\" header of the
-- bounce. For more information about sending authorization, see the
-- <https://docs.aws.amazon.com/ses/latest/DeveloperGuide/sending-authorization.html Amazon SES Developer Guide>.
sendBounce_bounceSenderArn :: Lens.Lens' SendBounce (Prelude.Maybe Prelude.Text)
sendBounce_bounceSenderArn :: Lens' SendBounce (Maybe Text)
sendBounce_bounceSenderArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SendBounce' {Maybe Text
bounceSenderArn :: Maybe Text
$sel:bounceSenderArn:SendBounce' :: SendBounce -> Maybe Text
bounceSenderArn} -> Maybe Text
bounceSenderArn) (\s :: SendBounce
s@SendBounce' {} Maybe Text
a -> SendBounce
s {$sel:bounceSenderArn:SendBounce' :: Maybe Text
bounceSenderArn = Maybe Text
a} :: SendBounce)

-- | Human-readable text for the bounce message to explain the failure. If
-- not specified, the text will be auto-generated based on the bounced
-- recipient information.
sendBounce_explanation :: Lens.Lens' SendBounce (Prelude.Maybe Prelude.Text)
sendBounce_explanation :: Lens' SendBounce (Maybe Text)
sendBounce_explanation = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SendBounce' {Maybe Text
explanation :: Maybe Text
$sel:explanation:SendBounce' :: SendBounce -> Maybe Text
explanation} -> Maybe Text
explanation) (\s :: SendBounce
s@SendBounce' {} Maybe Text
a -> SendBounce
s {$sel:explanation:SendBounce' :: Maybe Text
explanation = Maybe Text
a} :: SendBounce)

-- | Message-related DSN fields. If not specified, Amazon SES will choose the
-- values.
sendBounce_messageDsn :: Lens.Lens' SendBounce (Prelude.Maybe MessageDsn)
sendBounce_messageDsn :: Lens' SendBounce (Maybe MessageDsn)
sendBounce_messageDsn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SendBounce' {Maybe MessageDsn
messageDsn :: Maybe MessageDsn
$sel:messageDsn:SendBounce' :: SendBounce -> Maybe MessageDsn
messageDsn} -> Maybe MessageDsn
messageDsn) (\s :: SendBounce
s@SendBounce' {} Maybe MessageDsn
a -> SendBounce
s {$sel:messageDsn:SendBounce' :: Maybe MessageDsn
messageDsn = Maybe MessageDsn
a} :: SendBounce)

-- | The message ID of the message to be bounced.
sendBounce_originalMessageId :: Lens.Lens' SendBounce Prelude.Text
sendBounce_originalMessageId :: Lens' SendBounce Text
sendBounce_originalMessageId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SendBounce' {Text
originalMessageId :: Text
$sel:originalMessageId:SendBounce' :: SendBounce -> Text
originalMessageId} -> Text
originalMessageId) (\s :: SendBounce
s@SendBounce' {} Text
a -> SendBounce
s {$sel:originalMessageId:SendBounce' :: Text
originalMessageId = Text
a} :: SendBounce)

-- | The address to use in the \"From\" header of the bounce message. This
-- must be an identity that you have verified with Amazon SES.
sendBounce_bounceSender :: Lens.Lens' SendBounce Prelude.Text
sendBounce_bounceSender :: Lens' SendBounce Text
sendBounce_bounceSender = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SendBounce' {Text
bounceSender :: Text
$sel:bounceSender:SendBounce' :: SendBounce -> Text
bounceSender} -> Text
bounceSender) (\s :: SendBounce
s@SendBounce' {} Text
a -> SendBounce
s {$sel:bounceSender:SendBounce' :: Text
bounceSender = Text
a} :: SendBounce)

-- | A list of recipients of the bounced message, including the information
-- required to create the Delivery Status Notifications (DSNs) for the
-- recipients. You must specify at least one @BouncedRecipientInfo@ in the
-- list.
sendBounce_bouncedRecipientInfoList :: Lens.Lens' SendBounce [BouncedRecipientInfo]
sendBounce_bouncedRecipientInfoList :: Lens' SendBounce [BouncedRecipientInfo]
sendBounce_bouncedRecipientInfoList = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SendBounce' {[BouncedRecipientInfo]
bouncedRecipientInfoList :: [BouncedRecipientInfo]
$sel:bouncedRecipientInfoList:SendBounce' :: SendBounce -> [BouncedRecipientInfo]
bouncedRecipientInfoList} -> [BouncedRecipientInfo]
bouncedRecipientInfoList) (\s :: SendBounce
s@SendBounce' {} [BouncedRecipientInfo]
a -> SendBounce
s {$sel:bouncedRecipientInfoList:SendBounce' :: [BouncedRecipientInfo]
bouncedRecipientInfoList = [BouncedRecipientInfo]
a} :: SendBounce) 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 SendBounce where
  type AWSResponse SendBounce = SendBounceResponse
  request :: (Service -> Service) -> SendBounce -> Request SendBounce
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 SendBounce
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse SendBounce)))
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
"SendBounceResult"
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Maybe Text -> Int -> SendBounceResponse
SendBounceResponse'
            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
"MessageId")
            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 SendBounce where
  hashWithSalt :: Int -> SendBounce -> Int
hashWithSalt Int
_salt SendBounce' {[BouncedRecipientInfo]
Maybe Text
Maybe MessageDsn
Text
bouncedRecipientInfoList :: [BouncedRecipientInfo]
bounceSender :: Text
originalMessageId :: Text
messageDsn :: Maybe MessageDsn
explanation :: Maybe Text
bounceSenderArn :: Maybe Text
$sel:bouncedRecipientInfoList:SendBounce' :: SendBounce -> [BouncedRecipientInfo]
$sel:bounceSender:SendBounce' :: SendBounce -> Text
$sel:originalMessageId:SendBounce' :: SendBounce -> Text
$sel:messageDsn:SendBounce' :: SendBounce -> Maybe MessageDsn
$sel:explanation:SendBounce' :: SendBounce -> Maybe Text
$sel:bounceSenderArn:SendBounce' :: SendBounce -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
bounceSenderArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
explanation
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe MessageDsn
messageDsn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
originalMessageId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
bounceSender
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` [BouncedRecipientInfo]
bouncedRecipientInfoList

instance Prelude.NFData SendBounce where
  rnf :: SendBounce -> ()
rnf SendBounce' {[BouncedRecipientInfo]
Maybe Text
Maybe MessageDsn
Text
bouncedRecipientInfoList :: [BouncedRecipientInfo]
bounceSender :: Text
originalMessageId :: Text
messageDsn :: Maybe MessageDsn
explanation :: Maybe Text
bounceSenderArn :: Maybe Text
$sel:bouncedRecipientInfoList:SendBounce' :: SendBounce -> [BouncedRecipientInfo]
$sel:bounceSender:SendBounce' :: SendBounce -> Text
$sel:originalMessageId:SendBounce' :: SendBounce -> Text
$sel:messageDsn:SendBounce' :: SendBounce -> Maybe MessageDsn
$sel:explanation:SendBounce' :: SendBounce -> Maybe Text
$sel:bounceSenderArn:SendBounce' :: SendBounce -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
bounceSenderArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
explanation
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe MessageDsn
messageDsn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
originalMessageId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
bounceSender
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf [BouncedRecipientInfo]
bouncedRecipientInfoList

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

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

instance Data.ToQuery SendBounce where
  toQuery :: SendBounce -> QueryString
toQuery SendBounce' {[BouncedRecipientInfo]
Maybe Text
Maybe MessageDsn
Text
bouncedRecipientInfoList :: [BouncedRecipientInfo]
bounceSender :: Text
originalMessageId :: Text
messageDsn :: Maybe MessageDsn
explanation :: Maybe Text
bounceSenderArn :: Maybe Text
$sel:bouncedRecipientInfoList:SendBounce' :: SendBounce -> [BouncedRecipientInfo]
$sel:bounceSender:SendBounce' :: SendBounce -> Text
$sel:originalMessageId:SendBounce' :: SendBounce -> Text
$sel:messageDsn:SendBounce' :: SendBounce -> Maybe MessageDsn
$sel:explanation:SendBounce' :: SendBounce -> Maybe Text
$sel:bounceSenderArn:SendBounce' :: SendBounce -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"SendBounce" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2010-12-01" :: Prelude.ByteString),
        ByteString
"BounceSenderArn" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
bounceSenderArn,
        ByteString
"Explanation" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
explanation,
        ByteString
"MessageDsn" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe MessageDsn
messageDsn,
        ByteString
"OriginalMessageId" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
originalMessageId,
        ByteString
"BounceSender" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
bounceSender,
        ByteString
"BouncedRecipientInfoList"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: forall a.
(IsList a, ToQuery (Item a)) =>
ByteString -> a -> QueryString
Data.toQueryList ByteString
"member" [BouncedRecipientInfo]
bouncedRecipientInfoList
      ]

-- | Represents a unique message ID.
--
-- /See:/ 'newSendBounceResponse' smart constructor.
data SendBounceResponse = SendBounceResponse'
  { -- | The message ID of the bounce message.
    SendBounceResponse -> Maybe Text
messageId :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    SendBounceResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (SendBounceResponse -> SendBounceResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SendBounceResponse -> SendBounceResponse -> Bool
$c/= :: SendBounceResponse -> SendBounceResponse -> Bool
== :: SendBounceResponse -> SendBounceResponse -> Bool
$c== :: SendBounceResponse -> SendBounceResponse -> Bool
Prelude.Eq, ReadPrec [SendBounceResponse]
ReadPrec SendBounceResponse
Int -> ReadS SendBounceResponse
ReadS [SendBounceResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SendBounceResponse]
$creadListPrec :: ReadPrec [SendBounceResponse]
readPrec :: ReadPrec SendBounceResponse
$creadPrec :: ReadPrec SendBounceResponse
readList :: ReadS [SendBounceResponse]
$creadList :: ReadS [SendBounceResponse]
readsPrec :: Int -> ReadS SendBounceResponse
$creadsPrec :: Int -> ReadS SendBounceResponse
Prelude.Read, Int -> SendBounceResponse -> ShowS
[SendBounceResponse] -> ShowS
SendBounceResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SendBounceResponse] -> ShowS
$cshowList :: [SendBounceResponse] -> ShowS
show :: SendBounceResponse -> String
$cshow :: SendBounceResponse -> String
showsPrec :: Int -> SendBounceResponse -> ShowS
$cshowsPrec :: Int -> SendBounceResponse -> ShowS
Prelude.Show, forall x. Rep SendBounceResponse x -> SendBounceResponse
forall x. SendBounceResponse -> Rep SendBounceResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SendBounceResponse x -> SendBounceResponse
$cfrom :: forall x. SendBounceResponse -> Rep SendBounceResponse x
Prelude.Generic)

-- |
-- Create a value of 'SendBounceResponse' 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:
--
-- 'messageId', 'sendBounceResponse_messageId' - The message ID of the bounce message.
--
-- 'httpStatus', 'sendBounceResponse_httpStatus' - The response's http status code.
newSendBounceResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  SendBounceResponse
newSendBounceResponse :: Int -> SendBounceResponse
newSendBounceResponse Int
pHttpStatus_ =
  SendBounceResponse'
    { $sel:messageId:SendBounceResponse' :: Maybe Text
messageId = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:SendBounceResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The message ID of the bounce message.
sendBounceResponse_messageId :: Lens.Lens' SendBounceResponse (Prelude.Maybe Prelude.Text)
sendBounceResponse_messageId :: Lens' SendBounceResponse (Maybe Text)
sendBounceResponse_messageId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SendBounceResponse' {Maybe Text
messageId :: Maybe Text
$sel:messageId:SendBounceResponse' :: SendBounceResponse -> Maybe Text
messageId} -> Maybe Text
messageId) (\s :: SendBounceResponse
s@SendBounceResponse' {} Maybe Text
a -> SendBounceResponse
s {$sel:messageId:SendBounceResponse' :: Maybe Text
messageId = Maybe Text
a} :: SendBounceResponse)

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

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