{-# 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.SetIdentityMailFromDomain
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Enables or disables the custom MAIL FROM domain setup for a verified
-- identity (an email address or a domain).
--
-- To send emails using the specified MAIL FROM domain, you must add an MX
-- record to your MAIL FROM domain\'s DNS settings. If you want your emails
-- to pass Sender Policy Framework (SPF) checks, you must also add or
-- update an SPF record. For more information, see the
-- <https://docs.aws.amazon.com/ses/latest/DeveloperGuide/mail-from-set.html Amazon SES Developer Guide>.
--
-- You can execute this operation no more than once per second.
module Amazonka.SES.SetIdentityMailFromDomain
  ( -- * Creating a Request
    SetIdentityMailFromDomain (..),
    newSetIdentityMailFromDomain,

    -- * Request Lenses
    setIdentityMailFromDomain_behaviorOnMXFailure,
    setIdentityMailFromDomain_mailFromDomain,
    setIdentityMailFromDomain_identity,

    -- * Destructuring the Response
    SetIdentityMailFromDomainResponse (..),
    newSetIdentityMailFromDomainResponse,

    -- * Response Lenses
    setIdentityMailFromDomainResponse_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 enable or disable the Amazon SES custom MAIL
-- FROM domain setup for a verified identity. For information about using a
-- custom MAIL FROM domain, see the
-- <https://docs.aws.amazon.com/ses/latest/DeveloperGuide/mail-from.html Amazon SES Developer Guide>.
--
-- /See:/ 'newSetIdentityMailFromDomain' smart constructor.
data SetIdentityMailFromDomain = SetIdentityMailFromDomain'
  { -- | The action that you want Amazon SES to take if it cannot successfully
    -- read the required MX record when you send an email. If you choose
    -- @UseDefaultValue@, Amazon SES will use amazonses.com (or a subdomain of
    -- that) as the MAIL FROM domain. If you choose @RejectMessage@, Amazon SES
    -- will return a @MailFromDomainNotVerified@ error and not send the email.
    --
    -- The action specified in @BehaviorOnMXFailure@ is taken when the custom
    -- MAIL FROM domain setup is in the @Pending@, @Failed@, and
    -- @TemporaryFailure@ states.
    SetIdentityMailFromDomain -> Maybe BehaviorOnMXFailure
behaviorOnMXFailure :: Prelude.Maybe BehaviorOnMXFailure,
    -- | The custom MAIL FROM domain that you want the verified identity to use.
    -- The MAIL FROM domain must 1) be a subdomain of the verified identity, 2)
    -- not be used in a \"From\" address if the MAIL FROM domain is the
    -- destination of email feedback forwarding (for more information, see the
    -- <https://docs.aws.amazon.com/ses/latest/DeveloperGuide/mail-from.html Amazon SES Developer Guide>),
    -- and 3) not be used to receive emails. A value of @null@ disables the
    -- custom MAIL FROM setting for the identity.
    SetIdentityMailFromDomain -> Maybe Text
mailFromDomain :: Prelude.Maybe Prelude.Text,
    -- | The verified identity for which you want to enable or disable the
    -- specified custom MAIL FROM domain.
    SetIdentityMailFromDomain -> Text
identity :: Prelude.Text
  }
  deriving (SetIdentityMailFromDomain -> SetIdentityMailFromDomain -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SetIdentityMailFromDomain -> SetIdentityMailFromDomain -> Bool
$c/= :: SetIdentityMailFromDomain -> SetIdentityMailFromDomain -> Bool
== :: SetIdentityMailFromDomain -> SetIdentityMailFromDomain -> Bool
$c== :: SetIdentityMailFromDomain -> SetIdentityMailFromDomain -> Bool
Prelude.Eq, ReadPrec [SetIdentityMailFromDomain]
ReadPrec SetIdentityMailFromDomain
Int -> ReadS SetIdentityMailFromDomain
ReadS [SetIdentityMailFromDomain]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SetIdentityMailFromDomain]
$creadListPrec :: ReadPrec [SetIdentityMailFromDomain]
readPrec :: ReadPrec SetIdentityMailFromDomain
$creadPrec :: ReadPrec SetIdentityMailFromDomain
readList :: ReadS [SetIdentityMailFromDomain]
$creadList :: ReadS [SetIdentityMailFromDomain]
readsPrec :: Int -> ReadS SetIdentityMailFromDomain
$creadsPrec :: Int -> ReadS SetIdentityMailFromDomain
Prelude.Read, Int -> SetIdentityMailFromDomain -> ShowS
[SetIdentityMailFromDomain] -> ShowS
SetIdentityMailFromDomain -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SetIdentityMailFromDomain] -> ShowS
$cshowList :: [SetIdentityMailFromDomain] -> ShowS
show :: SetIdentityMailFromDomain -> String
$cshow :: SetIdentityMailFromDomain -> String
showsPrec :: Int -> SetIdentityMailFromDomain -> ShowS
$cshowsPrec :: Int -> SetIdentityMailFromDomain -> ShowS
Prelude.Show, forall x.
Rep SetIdentityMailFromDomain x -> SetIdentityMailFromDomain
forall x.
SetIdentityMailFromDomain -> Rep SetIdentityMailFromDomain x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep SetIdentityMailFromDomain x -> SetIdentityMailFromDomain
$cfrom :: forall x.
SetIdentityMailFromDomain -> Rep SetIdentityMailFromDomain x
Prelude.Generic)

-- |
-- Create a value of 'SetIdentityMailFromDomain' 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:
--
-- 'behaviorOnMXFailure', 'setIdentityMailFromDomain_behaviorOnMXFailure' - The action that you want Amazon SES to take if it cannot successfully
-- read the required MX record when you send an email. If you choose
-- @UseDefaultValue@, Amazon SES will use amazonses.com (or a subdomain of
-- that) as the MAIL FROM domain. If you choose @RejectMessage@, Amazon SES
-- will return a @MailFromDomainNotVerified@ error and not send the email.
--
-- The action specified in @BehaviorOnMXFailure@ is taken when the custom
-- MAIL FROM domain setup is in the @Pending@, @Failed@, and
-- @TemporaryFailure@ states.
--
-- 'mailFromDomain', 'setIdentityMailFromDomain_mailFromDomain' - The custom MAIL FROM domain that you want the verified identity to use.
-- The MAIL FROM domain must 1) be a subdomain of the verified identity, 2)
-- not be used in a \"From\" address if the MAIL FROM domain is the
-- destination of email feedback forwarding (for more information, see the
-- <https://docs.aws.amazon.com/ses/latest/DeveloperGuide/mail-from.html Amazon SES Developer Guide>),
-- and 3) not be used to receive emails. A value of @null@ disables the
-- custom MAIL FROM setting for the identity.
--
-- 'identity', 'setIdentityMailFromDomain_identity' - The verified identity for which you want to enable or disable the
-- specified custom MAIL FROM domain.
newSetIdentityMailFromDomain ::
  -- | 'identity'
  Prelude.Text ->
  SetIdentityMailFromDomain
newSetIdentityMailFromDomain :: Text -> SetIdentityMailFromDomain
newSetIdentityMailFromDomain Text
pIdentity_ =
  SetIdentityMailFromDomain'
    { $sel:behaviorOnMXFailure:SetIdentityMailFromDomain' :: Maybe BehaviorOnMXFailure
behaviorOnMXFailure =
        forall a. Maybe a
Prelude.Nothing,
      $sel:mailFromDomain:SetIdentityMailFromDomain' :: Maybe Text
mailFromDomain = forall a. Maybe a
Prelude.Nothing,
      $sel:identity:SetIdentityMailFromDomain' :: Text
identity = Text
pIdentity_
    }

-- | The action that you want Amazon SES to take if it cannot successfully
-- read the required MX record when you send an email. If you choose
-- @UseDefaultValue@, Amazon SES will use amazonses.com (or a subdomain of
-- that) as the MAIL FROM domain. If you choose @RejectMessage@, Amazon SES
-- will return a @MailFromDomainNotVerified@ error and not send the email.
--
-- The action specified in @BehaviorOnMXFailure@ is taken when the custom
-- MAIL FROM domain setup is in the @Pending@, @Failed@, and
-- @TemporaryFailure@ states.
setIdentityMailFromDomain_behaviorOnMXFailure :: Lens.Lens' SetIdentityMailFromDomain (Prelude.Maybe BehaviorOnMXFailure)
setIdentityMailFromDomain_behaviorOnMXFailure :: Lens' SetIdentityMailFromDomain (Maybe BehaviorOnMXFailure)
setIdentityMailFromDomain_behaviorOnMXFailure = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SetIdentityMailFromDomain' {Maybe BehaviorOnMXFailure
behaviorOnMXFailure :: Maybe BehaviorOnMXFailure
$sel:behaviorOnMXFailure:SetIdentityMailFromDomain' :: SetIdentityMailFromDomain -> Maybe BehaviorOnMXFailure
behaviorOnMXFailure} -> Maybe BehaviorOnMXFailure
behaviorOnMXFailure) (\s :: SetIdentityMailFromDomain
s@SetIdentityMailFromDomain' {} Maybe BehaviorOnMXFailure
a -> SetIdentityMailFromDomain
s {$sel:behaviorOnMXFailure:SetIdentityMailFromDomain' :: Maybe BehaviorOnMXFailure
behaviorOnMXFailure = Maybe BehaviorOnMXFailure
a} :: SetIdentityMailFromDomain)

-- | The custom MAIL FROM domain that you want the verified identity to use.
-- The MAIL FROM domain must 1) be a subdomain of the verified identity, 2)
-- not be used in a \"From\" address if the MAIL FROM domain is the
-- destination of email feedback forwarding (for more information, see the
-- <https://docs.aws.amazon.com/ses/latest/DeveloperGuide/mail-from.html Amazon SES Developer Guide>),
-- and 3) not be used to receive emails. A value of @null@ disables the
-- custom MAIL FROM setting for the identity.
setIdentityMailFromDomain_mailFromDomain :: Lens.Lens' SetIdentityMailFromDomain (Prelude.Maybe Prelude.Text)
setIdentityMailFromDomain_mailFromDomain :: Lens' SetIdentityMailFromDomain (Maybe Text)
setIdentityMailFromDomain_mailFromDomain = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SetIdentityMailFromDomain' {Maybe Text
mailFromDomain :: Maybe Text
$sel:mailFromDomain:SetIdentityMailFromDomain' :: SetIdentityMailFromDomain -> Maybe Text
mailFromDomain} -> Maybe Text
mailFromDomain) (\s :: SetIdentityMailFromDomain
s@SetIdentityMailFromDomain' {} Maybe Text
a -> SetIdentityMailFromDomain
s {$sel:mailFromDomain:SetIdentityMailFromDomain' :: Maybe Text
mailFromDomain = Maybe Text
a} :: SetIdentityMailFromDomain)

-- | The verified identity for which you want to enable or disable the
-- specified custom MAIL FROM domain.
setIdentityMailFromDomain_identity :: Lens.Lens' SetIdentityMailFromDomain Prelude.Text
setIdentityMailFromDomain_identity :: Lens' SetIdentityMailFromDomain Text
setIdentityMailFromDomain_identity = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SetIdentityMailFromDomain' {Text
identity :: Text
$sel:identity:SetIdentityMailFromDomain' :: SetIdentityMailFromDomain -> Text
identity} -> Text
identity) (\s :: SetIdentityMailFromDomain
s@SetIdentityMailFromDomain' {} Text
a -> SetIdentityMailFromDomain
s {$sel:identity:SetIdentityMailFromDomain' :: Text
identity = Text
a} :: SetIdentityMailFromDomain)

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

instance Prelude.NFData SetIdentityMailFromDomain where
  rnf :: SetIdentityMailFromDomain -> ()
rnf SetIdentityMailFromDomain' {Maybe Text
Maybe BehaviorOnMXFailure
Text
identity :: Text
mailFromDomain :: Maybe Text
behaviorOnMXFailure :: Maybe BehaviorOnMXFailure
$sel:identity:SetIdentityMailFromDomain' :: SetIdentityMailFromDomain -> Text
$sel:mailFromDomain:SetIdentityMailFromDomain' :: SetIdentityMailFromDomain -> Maybe Text
$sel:behaviorOnMXFailure:SetIdentityMailFromDomain' :: SetIdentityMailFromDomain -> Maybe BehaviorOnMXFailure
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe BehaviorOnMXFailure
behaviorOnMXFailure
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
mailFromDomain
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
identity

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

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

instance Data.ToQuery SetIdentityMailFromDomain where
  toQuery :: SetIdentityMailFromDomain -> QueryString
toQuery SetIdentityMailFromDomain' {Maybe Text
Maybe BehaviorOnMXFailure
Text
identity :: Text
mailFromDomain :: Maybe Text
behaviorOnMXFailure :: Maybe BehaviorOnMXFailure
$sel:identity:SetIdentityMailFromDomain' :: SetIdentityMailFromDomain -> Text
$sel:mailFromDomain:SetIdentityMailFromDomain' :: SetIdentityMailFromDomain -> Maybe Text
$sel:behaviorOnMXFailure:SetIdentityMailFromDomain' :: SetIdentityMailFromDomain -> Maybe BehaviorOnMXFailure
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"SetIdentityMailFromDomain" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2010-12-01" :: Prelude.ByteString),
        ByteString
"BehaviorOnMXFailure" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe BehaviorOnMXFailure
behaviorOnMXFailure,
        ByteString
"MailFromDomain" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
mailFromDomain,
        ByteString
"Identity" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
identity
      ]

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

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

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

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