{-# 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.SetIdentityFeedbackForwardingEnabled
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Given an identity (an email address or a domain), enables or disables
-- whether Amazon SES forwards bounce and complaint notifications as email.
-- Feedback forwarding can only be disabled when Amazon Simple Notification
-- Service (Amazon SNS) topics are specified for both bounces and
-- complaints.
--
-- Feedback forwarding does not apply to delivery notifications. Delivery
-- notifications are only available through Amazon SNS.
--
-- You can execute this operation no more than once per second.
--
-- For more information about using notifications with Amazon SES, see the
-- <https://docs.aws.amazon.com/ses/latest/DeveloperGuide/notifications.html Amazon SES Developer Guide>.
module Amazonka.SES.SetIdentityFeedbackForwardingEnabled
  ( -- * Creating a Request
    SetIdentityFeedbackForwardingEnabled (..),
    newSetIdentityFeedbackForwardingEnabled,

    -- * Request Lenses
    setIdentityFeedbackForwardingEnabled_identity,
    setIdentityFeedbackForwardingEnabled_forwardingEnabled,

    -- * Destructuring the Response
    SetIdentityFeedbackForwardingEnabledResponse (..),
    newSetIdentityFeedbackForwardingEnabledResponse,

    -- * Response Lenses
    setIdentityFeedbackForwardingEnabledResponse_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 whether Amazon SES forwards
-- you bounce and complaint notifications through email. For information
-- about email feedback forwarding, see the
-- <https://docs.aws.amazon.com/ses/latest/DeveloperGuide/notifications-via-email.html Amazon SES Developer Guide>.
--
-- /See:/ 'newSetIdentityFeedbackForwardingEnabled' smart constructor.
data SetIdentityFeedbackForwardingEnabled = SetIdentityFeedbackForwardingEnabled'
  { -- | The identity for which to set bounce and complaint notification
    -- forwarding. Examples: @user\@example.com@, @example.com@.
    SetIdentityFeedbackForwardingEnabled -> Text
identity :: Prelude.Text,
    -- | Sets whether Amazon SES will forward bounce and complaint notifications
    -- as email. @true@ specifies that Amazon SES will forward bounce and
    -- complaint notifications as email, in addition to any Amazon SNS topic
    -- publishing otherwise specified. @false@ specifies that Amazon SES will
    -- publish bounce and complaint notifications only through Amazon SNS. This
    -- value can only be set to @false@ when Amazon SNS topics are set for both
    -- @Bounce@ and @Complaint@ notification types.
    SetIdentityFeedbackForwardingEnabled -> Bool
forwardingEnabled :: Prelude.Bool
  }
  deriving (SetIdentityFeedbackForwardingEnabled
-> SetIdentityFeedbackForwardingEnabled -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SetIdentityFeedbackForwardingEnabled
-> SetIdentityFeedbackForwardingEnabled -> Bool
$c/= :: SetIdentityFeedbackForwardingEnabled
-> SetIdentityFeedbackForwardingEnabled -> Bool
== :: SetIdentityFeedbackForwardingEnabled
-> SetIdentityFeedbackForwardingEnabled -> Bool
$c== :: SetIdentityFeedbackForwardingEnabled
-> SetIdentityFeedbackForwardingEnabled -> Bool
Prelude.Eq, ReadPrec [SetIdentityFeedbackForwardingEnabled]
ReadPrec SetIdentityFeedbackForwardingEnabled
Int -> ReadS SetIdentityFeedbackForwardingEnabled
ReadS [SetIdentityFeedbackForwardingEnabled]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SetIdentityFeedbackForwardingEnabled]
$creadListPrec :: ReadPrec [SetIdentityFeedbackForwardingEnabled]
readPrec :: ReadPrec SetIdentityFeedbackForwardingEnabled
$creadPrec :: ReadPrec SetIdentityFeedbackForwardingEnabled
readList :: ReadS [SetIdentityFeedbackForwardingEnabled]
$creadList :: ReadS [SetIdentityFeedbackForwardingEnabled]
readsPrec :: Int -> ReadS SetIdentityFeedbackForwardingEnabled
$creadsPrec :: Int -> ReadS SetIdentityFeedbackForwardingEnabled
Prelude.Read, Int -> SetIdentityFeedbackForwardingEnabled -> ShowS
[SetIdentityFeedbackForwardingEnabled] -> ShowS
SetIdentityFeedbackForwardingEnabled -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SetIdentityFeedbackForwardingEnabled] -> ShowS
$cshowList :: [SetIdentityFeedbackForwardingEnabled] -> ShowS
show :: SetIdentityFeedbackForwardingEnabled -> String
$cshow :: SetIdentityFeedbackForwardingEnabled -> String
showsPrec :: Int -> SetIdentityFeedbackForwardingEnabled -> ShowS
$cshowsPrec :: Int -> SetIdentityFeedbackForwardingEnabled -> ShowS
Prelude.Show, forall x.
Rep SetIdentityFeedbackForwardingEnabled x
-> SetIdentityFeedbackForwardingEnabled
forall x.
SetIdentityFeedbackForwardingEnabled
-> Rep SetIdentityFeedbackForwardingEnabled x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep SetIdentityFeedbackForwardingEnabled x
-> SetIdentityFeedbackForwardingEnabled
$cfrom :: forall x.
SetIdentityFeedbackForwardingEnabled
-> Rep SetIdentityFeedbackForwardingEnabled x
Prelude.Generic)

-- |
-- Create a value of 'SetIdentityFeedbackForwardingEnabled' 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:
--
-- 'identity', 'setIdentityFeedbackForwardingEnabled_identity' - The identity for which to set bounce and complaint notification
-- forwarding. Examples: @user\@example.com@, @example.com@.
--
-- 'forwardingEnabled', 'setIdentityFeedbackForwardingEnabled_forwardingEnabled' - Sets whether Amazon SES will forward bounce and complaint notifications
-- as email. @true@ specifies that Amazon SES will forward bounce and
-- complaint notifications as email, in addition to any Amazon SNS topic
-- publishing otherwise specified. @false@ specifies that Amazon SES will
-- publish bounce and complaint notifications only through Amazon SNS. This
-- value can only be set to @false@ when Amazon SNS topics are set for both
-- @Bounce@ and @Complaint@ notification types.
newSetIdentityFeedbackForwardingEnabled ::
  -- | 'identity'
  Prelude.Text ->
  -- | 'forwardingEnabled'
  Prelude.Bool ->
  SetIdentityFeedbackForwardingEnabled
newSetIdentityFeedbackForwardingEnabled :: Text -> Bool -> SetIdentityFeedbackForwardingEnabled
newSetIdentityFeedbackForwardingEnabled
  Text
pIdentity_
  Bool
pForwardingEnabled_ =
    SetIdentityFeedbackForwardingEnabled'
      { $sel:identity:SetIdentityFeedbackForwardingEnabled' :: Text
identity =
          Text
pIdentity_,
        $sel:forwardingEnabled:SetIdentityFeedbackForwardingEnabled' :: Bool
forwardingEnabled =
          Bool
pForwardingEnabled_
      }

-- | The identity for which to set bounce and complaint notification
-- forwarding. Examples: @user\@example.com@, @example.com@.
setIdentityFeedbackForwardingEnabled_identity :: Lens.Lens' SetIdentityFeedbackForwardingEnabled Prelude.Text
setIdentityFeedbackForwardingEnabled_identity :: Lens' SetIdentityFeedbackForwardingEnabled Text
setIdentityFeedbackForwardingEnabled_identity = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SetIdentityFeedbackForwardingEnabled' {Text
identity :: Text
$sel:identity:SetIdentityFeedbackForwardingEnabled' :: SetIdentityFeedbackForwardingEnabled -> Text
identity} -> Text
identity) (\s :: SetIdentityFeedbackForwardingEnabled
s@SetIdentityFeedbackForwardingEnabled' {} Text
a -> SetIdentityFeedbackForwardingEnabled
s {$sel:identity:SetIdentityFeedbackForwardingEnabled' :: Text
identity = Text
a} :: SetIdentityFeedbackForwardingEnabled)

-- | Sets whether Amazon SES will forward bounce and complaint notifications
-- as email. @true@ specifies that Amazon SES will forward bounce and
-- complaint notifications as email, in addition to any Amazon SNS topic
-- publishing otherwise specified. @false@ specifies that Amazon SES will
-- publish bounce and complaint notifications only through Amazon SNS. This
-- value can only be set to @false@ when Amazon SNS topics are set for both
-- @Bounce@ and @Complaint@ notification types.
setIdentityFeedbackForwardingEnabled_forwardingEnabled :: Lens.Lens' SetIdentityFeedbackForwardingEnabled Prelude.Bool
setIdentityFeedbackForwardingEnabled_forwardingEnabled :: Lens' SetIdentityFeedbackForwardingEnabled Bool
setIdentityFeedbackForwardingEnabled_forwardingEnabled = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SetIdentityFeedbackForwardingEnabled' {Bool
forwardingEnabled :: Bool
$sel:forwardingEnabled:SetIdentityFeedbackForwardingEnabled' :: SetIdentityFeedbackForwardingEnabled -> Bool
forwardingEnabled} -> Bool
forwardingEnabled) (\s :: SetIdentityFeedbackForwardingEnabled
s@SetIdentityFeedbackForwardingEnabled' {} Bool
a -> SetIdentityFeedbackForwardingEnabled
s {$sel:forwardingEnabled:SetIdentityFeedbackForwardingEnabled' :: Bool
forwardingEnabled = Bool
a} :: SetIdentityFeedbackForwardingEnabled)

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

instance
  Prelude.NFData
    SetIdentityFeedbackForwardingEnabled
  where
  rnf :: SetIdentityFeedbackForwardingEnabled -> ()
rnf SetIdentityFeedbackForwardingEnabled' {Bool
Text
forwardingEnabled :: Bool
identity :: Text
$sel:forwardingEnabled:SetIdentityFeedbackForwardingEnabled' :: SetIdentityFeedbackForwardingEnabled -> Bool
$sel:identity:SetIdentityFeedbackForwardingEnabled' :: SetIdentityFeedbackForwardingEnabled -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
identity
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Bool
forwardingEnabled

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

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

instance
  Data.ToQuery
    SetIdentityFeedbackForwardingEnabled
  where
  toQuery :: SetIdentityFeedbackForwardingEnabled -> QueryString
toQuery SetIdentityFeedbackForwardingEnabled' {Bool
Text
forwardingEnabled :: Bool
identity :: Text
$sel:forwardingEnabled:SetIdentityFeedbackForwardingEnabled' :: SetIdentityFeedbackForwardingEnabled -> Bool
$sel:identity:SetIdentityFeedbackForwardingEnabled' :: SetIdentityFeedbackForwardingEnabled -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: ( ByteString
"SetIdentityFeedbackForwardingEnabled" ::
                      Prelude.ByteString
                  ),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2010-12-01" :: Prelude.ByteString),
        ByteString
"Identity" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
identity,
        ByteString
"ForwardingEnabled" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Bool
forwardingEnabled
      ]

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

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

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

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