{-# 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.PinpointSmsVoiceV2.SetDefaultSenderId
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Sets default sender ID on a configuration set.
--
-- When sending a text message to a destination country that supports
-- sender IDs, the default sender ID on the configuration set specified
-- will be used if no dedicated origination phone numbers or registered
-- sender IDs are available in your account.
module Amazonka.PinpointSmsVoiceV2.SetDefaultSenderId
  ( -- * Creating a Request
    SetDefaultSenderId (..),
    newSetDefaultSenderId,

    -- * Request Lenses
    setDefaultSenderId_configurationSetName,
    setDefaultSenderId_senderId,

    -- * Destructuring the Response
    SetDefaultSenderIdResponse (..),
    newSetDefaultSenderIdResponse,

    -- * Response Lenses
    setDefaultSenderIdResponse_configurationSetArn,
    setDefaultSenderIdResponse_configurationSetName,
    setDefaultSenderIdResponse_senderId,
    setDefaultSenderIdResponse_httpStatus,
  )
where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.PinpointSmsVoiceV2.Types
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newSetDefaultSenderId' smart constructor.
data SetDefaultSenderId = SetDefaultSenderId'
  { -- | The configuration set to updated with a new default SenderId. This field
    -- can be the ConsigurationSetName or ConfigurationSetArn.
    SetDefaultSenderId -> Text
configurationSetName :: Prelude.Text,
    -- | The current sender ID for the configuration set. When sending a text
    -- message to a destination country which supports SenderIds, the default
    -- sender ID on the configuration set specified on SendTextMessage will be
    -- used if no dedicated origination phone numbers or registered SenderIds
    -- are available in your account, instead of a generic sender ID, such as
    -- \'NOTICE\'.
    SetDefaultSenderId -> Text
senderId :: Prelude.Text
  }
  deriving (SetDefaultSenderId -> SetDefaultSenderId -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SetDefaultSenderId -> SetDefaultSenderId -> Bool
$c/= :: SetDefaultSenderId -> SetDefaultSenderId -> Bool
== :: SetDefaultSenderId -> SetDefaultSenderId -> Bool
$c== :: SetDefaultSenderId -> SetDefaultSenderId -> Bool
Prelude.Eq, ReadPrec [SetDefaultSenderId]
ReadPrec SetDefaultSenderId
Int -> ReadS SetDefaultSenderId
ReadS [SetDefaultSenderId]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SetDefaultSenderId]
$creadListPrec :: ReadPrec [SetDefaultSenderId]
readPrec :: ReadPrec SetDefaultSenderId
$creadPrec :: ReadPrec SetDefaultSenderId
readList :: ReadS [SetDefaultSenderId]
$creadList :: ReadS [SetDefaultSenderId]
readsPrec :: Int -> ReadS SetDefaultSenderId
$creadsPrec :: Int -> ReadS SetDefaultSenderId
Prelude.Read, Int -> SetDefaultSenderId -> ShowS
[SetDefaultSenderId] -> ShowS
SetDefaultSenderId -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SetDefaultSenderId] -> ShowS
$cshowList :: [SetDefaultSenderId] -> ShowS
show :: SetDefaultSenderId -> String
$cshow :: SetDefaultSenderId -> String
showsPrec :: Int -> SetDefaultSenderId -> ShowS
$cshowsPrec :: Int -> SetDefaultSenderId -> ShowS
Prelude.Show, forall x. Rep SetDefaultSenderId x -> SetDefaultSenderId
forall x. SetDefaultSenderId -> Rep SetDefaultSenderId x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SetDefaultSenderId x -> SetDefaultSenderId
$cfrom :: forall x. SetDefaultSenderId -> Rep SetDefaultSenderId x
Prelude.Generic)

-- |
-- Create a value of 'SetDefaultSenderId' 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:
--
-- 'configurationSetName', 'setDefaultSenderId_configurationSetName' - The configuration set to updated with a new default SenderId. This field
-- can be the ConsigurationSetName or ConfigurationSetArn.
--
-- 'senderId', 'setDefaultSenderId_senderId' - The current sender ID for the configuration set. When sending a text
-- message to a destination country which supports SenderIds, the default
-- sender ID on the configuration set specified on SendTextMessage will be
-- used if no dedicated origination phone numbers or registered SenderIds
-- are available in your account, instead of a generic sender ID, such as
-- \'NOTICE\'.
newSetDefaultSenderId ::
  -- | 'configurationSetName'
  Prelude.Text ->
  -- | 'senderId'
  Prelude.Text ->
  SetDefaultSenderId
newSetDefaultSenderId :: Text -> Text -> SetDefaultSenderId
newSetDefaultSenderId
  Text
pConfigurationSetName_
  Text
pSenderId_ =
    SetDefaultSenderId'
      { $sel:configurationSetName:SetDefaultSenderId' :: Text
configurationSetName =
          Text
pConfigurationSetName_,
        $sel:senderId:SetDefaultSenderId' :: Text
senderId = Text
pSenderId_
      }

-- | The configuration set to updated with a new default SenderId. This field
-- can be the ConsigurationSetName or ConfigurationSetArn.
setDefaultSenderId_configurationSetName :: Lens.Lens' SetDefaultSenderId Prelude.Text
setDefaultSenderId_configurationSetName :: Lens' SetDefaultSenderId Text
setDefaultSenderId_configurationSetName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SetDefaultSenderId' {Text
configurationSetName :: Text
$sel:configurationSetName:SetDefaultSenderId' :: SetDefaultSenderId -> Text
configurationSetName} -> Text
configurationSetName) (\s :: SetDefaultSenderId
s@SetDefaultSenderId' {} Text
a -> SetDefaultSenderId
s {$sel:configurationSetName:SetDefaultSenderId' :: Text
configurationSetName = Text
a} :: SetDefaultSenderId)

-- | The current sender ID for the configuration set. When sending a text
-- message to a destination country which supports SenderIds, the default
-- sender ID on the configuration set specified on SendTextMessage will be
-- used if no dedicated origination phone numbers or registered SenderIds
-- are available in your account, instead of a generic sender ID, such as
-- \'NOTICE\'.
setDefaultSenderId_senderId :: Lens.Lens' SetDefaultSenderId Prelude.Text
setDefaultSenderId_senderId :: Lens' SetDefaultSenderId Text
setDefaultSenderId_senderId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SetDefaultSenderId' {Text
senderId :: Text
$sel:senderId:SetDefaultSenderId' :: SetDefaultSenderId -> Text
senderId} -> Text
senderId) (\s :: SetDefaultSenderId
s@SetDefaultSenderId' {} Text
a -> SetDefaultSenderId
s {$sel:senderId:SetDefaultSenderId' :: Text
senderId = Text
a} :: SetDefaultSenderId)

instance Core.AWSRequest SetDefaultSenderId where
  type
    AWSResponse SetDefaultSenderId =
      SetDefaultSenderIdResponse
  request :: (Service -> Service)
-> SetDefaultSenderId -> Request SetDefaultSenderId
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.postJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy SetDefaultSenderId
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse SetDefaultSenderId)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> Object -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveJSON
      ( \Int
s ResponseHeaders
h Object
x ->
          Maybe Text
-> Maybe Text -> Maybe Text -> Int -> SetDefaultSenderIdResponse
SetDefaultSenderIdResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"ConfigurationSetArn")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"ConfigurationSetName")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"SenderId")
            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 SetDefaultSenderId where
  hashWithSalt :: Int -> SetDefaultSenderId -> Int
hashWithSalt Int
_salt SetDefaultSenderId' {Text
senderId :: Text
configurationSetName :: Text
$sel:senderId:SetDefaultSenderId' :: SetDefaultSenderId -> Text
$sel:configurationSetName:SetDefaultSenderId' :: SetDefaultSenderId -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
configurationSetName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
senderId

instance Prelude.NFData SetDefaultSenderId where
  rnf :: SetDefaultSenderId -> ()
rnf SetDefaultSenderId' {Text
senderId :: Text
configurationSetName :: Text
$sel:senderId:SetDefaultSenderId' :: SetDefaultSenderId -> Text
$sel:configurationSetName:SetDefaultSenderId' :: SetDefaultSenderId -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
configurationSetName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
senderId

instance Data.ToHeaders SetDefaultSenderId where
  toHeaders :: SetDefaultSenderId -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"X-Amz-Target"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"PinpointSMSVoiceV2.SetDefaultSenderId" ::
                          Prelude.ByteString
                      ),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.0" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON SetDefaultSenderId where
  toJSON :: SetDefaultSenderId -> Value
toJSON SetDefaultSenderId' {Text
senderId :: Text
configurationSetName :: Text
$sel:senderId:SetDefaultSenderId' :: SetDefaultSenderId -> Text
$sel:configurationSetName:SetDefaultSenderId' :: SetDefaultSenderId -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just
              ( Key
"ConfigurationSetName"
                  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
configurationSetName
              ),
            forall a. a -> Maybe a
Prelude.Just (Key
"SenderId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
senderId)
          ]
      )

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

instance Data.ToQuery SetDefaultSenderId where
  toQuery :: SetDefaultSenderId -> QueryString
toQuery = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

-- | /See:/ 'newSetDefaultSenderIdResponse' smart constructor.
data SetDefaultSenderIdResponse = SetDefaultSenderIdResponse'
  { -- | The Amazon Resource Name (ARN) of the updated configuration set.
    SetDefaultSenderIdResponse -> Maybe Text
configurationSetArn :: Prelude.Maybe Prelude.Text,
    -- | The name of the configuration set that was updated.
    SetDefaultSenderIdResponse -> Maybe Text
configurationSetName :: Prelude.Maybe Prelude.Text,
    -- | The default sender ID to set for the ConfigurationSet.
    SetDefaultSenderIdResponse -> Maybe Text
senderId :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    SetDefaultSenderIdResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (SetDefaultSenderIdResponse -> SetDefaultSenderIdResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SetDefaultSenderIdResponse -> SetDefaultSenderIdResponse -> Bool
$c/= :: SetDefaultSenderIdResponse -> SetDefaultSenderIdResponse -> Bool
== :: SetDefaultSenderIdResponse -> SetDefaultSenderIdResponse -> Bool
$c== :: SetDefaultSenderIdResponse -> SetDefaultSenderIdResponse -> Bool
Prelude.Eq, ReadPrec [SetDefaultSenderIdResponse]
ReadPrec SetDefaultSenderIdResponse
Int -> ReadS SetDefaultSenderIdResponse
ReadS [SetDefaultSenderIdResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SetDefaultSenderIdResponse]
$creadListPrec :: ReadPrec [SetDefaultSenderIdResponse]
readPrec :: ReadPrec SetDefaultSenderIdResponse
$creadPrec :: ReadPrec SetDefaultSenderIdResponse
readList :: ReadS [SetDefaultSenderIdResponse]
$creadList :: ReadS [SetDefaultSenderIdResponse]
readsPrec :: Int -> ReadS SetDefaultSenderIdResponse
$creadsPrec :: Int -> ReadS SetDefaultSenderIdResponse
Prelude.Read, Int -> SetDefaultSenderIdResponse -> ShowS
[SetDefaultSenderIdResponse] -> ShowS
SetDefaultSenderIdResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SetDefaultSenderIdResponse] -> ShowS
$cshowList :: [SetDefaultSenderIdResponse] -> ShowS
show :: SetDefaultSenderIdResponse -> String
$cshow :: SetDefaultSenderIdResponse -> String
showsPrec :: Int -> SetDefaultSenderIdResponse -> ShowS
$cshowsPrec :: Int -> SetDefaultSenderIdResponse -> ShowS
Prelude.Show, forall x.
Rep SetDefaultSenderIdResponse x -> SetDefaultSenderIdResponse
forall x.
SetDefaultSenderIdResponse -> Rep SetDefaultSenderIdResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep SetDefaultSenderIdResponse x -> SetDefaultSenderIdResponse
$cfrom :: forall x.
SetDefaultSenderIdResponse -> Rep SetDefaultSenderIdResponse x
Prelude.Generic)

-- |
-- Create a value of 'SetDefaultSenderIdResponse' 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:
--
-- 'configurationSetArn', 'setDefaultSenderIdResponse_configurationSetArn' - The Amazon Resource Name (ARN) of the updated configuration set.
--
-- 'configurationSetName', 'setDefaultSenderIdResponse_configurationSetName' - The name of the configuration set that was updated.
--
-- 'senderId', 'setDefaultSenderIdResponse_senderId' - The default sender ID to set for the ConfigurationSet.
--
-- 'httpStatus', 'setDefaultSenderIdResponse_httpStatus' - The response's http status code.
newSetDefaultSenderIdResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  SetDefaultSenderIdResponse
newSetDefaultSenderIdResponse :: Int -> SetDefaultSenderIdResponse
newSetDefaultSenderIdResponse Int
pHttpStatus_ =
  SetDefaultSenderIdResponse'
    { $sel:configurationSetArn:SetDefaultSenderIdResponse' :: Maybe Text
configurationSetArn =
        forall a. Maybe a
Prelude.Nothing,
      $sel:configurationSetName:SetDefaultSenderIdResponse' :: Maybe Text
configurationSetName = forall a. Maybe a
Prelude.Nothing,
      $sel:senderId:SetDefaultSenderIdResponse' :: Maybe Text
senderId = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:SetDefaultSenderIdResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The Amazon Resource Name (ARN) of the updated configuration set.
setDefaultSenderIdResponse_configurationSetArn :: Lens.Lens' SetDefaultSenderIdResponse (Prelude.Maybe Prelude.Text)
setDefaultSenderIdResponse_configurationSetArn :: Lens' SetDefaultSenderIdResponse (Maybe Text)
setDefaultSenderIdResponse_configurationSetArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SetDefaultSenderIdResponse' {Maybe Text
configurationSetArn :: Maybe Text
$sel:configurationSetArn:SetDefaultSenderIdResponse' :: SetDefaultSenderIdResponse -> Maybe Text
configurationSetArn} -> Maybe Text
configurationSetArn) (\s :: SetDefaultSenderIdResponse
s@SetDefaultSenderIdResponse' {} Maybe Text
a -> SetDefaultSenderIdResponse
s {$sel:configurationSetArn:SetDefaultSenderIdResponse' :: Maybe Text
configurationSetArn = Maybe Text
a} :: SetDefaultSenderIdResponse)

-- | The name of the configuration set that was updated.
setDefaultSenderIdResponse_configurationSetName :: Lens.Lens' SetDefaultSenderIdResponse (Prelude.Maybe Prelude.Text)
setDefaultSenderIdResponse_configurationSetName :: Lens' SetDefaultSenderIdResponse (Maybe Text)
setDefaultSenderIdResponse_configurationSetName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SetDefaultSenderIdResponse' {Maybe Text
configurationSetName :: Maybe Text
$sel:configurationSetName:SetDefaultSenderIdResponse' :: SetDefaultSenderIdResponse -> Maybe Text
configurationSetName} -> Maybe Text
configurationSetName) (\s :: SetDefaultSenderIdResponse
s@SetDefaultSenderIdResponse' {} Maybe Text
a -> SetDefaultSenderIdResponse
s {$sel:configurationSetName:SetDefaultSenderIdResponse' :: Maybe Text
configurationSetName = Maybe Text
a} :: SetDefaultSenderIdResponse)

-- | The default sender ID to set for the ConfigurationSet.
setDefaultSenderIdResponse_senderId :: Lens.Lens' SetDefaultSenderIdResponse (Prelude.Maybe Prelude.Text)
setDefaultSenderIdResponse_senderId :: Lens' SetDefaultSenderIdResponse (Maybe Text)
setDefaultSenderIdResponse_senderId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SetDefaultSenderIdResponse' {Maybe Text
senderId :: Maybe Text
$sel:senderId:SetDefaultSenderIdResponse' :: SetDefaultSenderIdResponse -> Maybe Text
senderId} -> Maybe Text
senderId) (\s :: SetDefaultSenderIdResponse
s@SetDefaultSenderIdResponse' {} Maybe Text
a -> SetDefaultSenderIdResponse
s {$sel:senderId:SetDefaultSenderIdResponse' :: Maybe Text
senderId = Maybe Text
a} :: SetDefaultSenderIdResponse)

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

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