{-# 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.DeleteKeyword
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Deletes an existing keyword from an origination phone number or pool.
--
-- A keyword is a word that you can search for on a particular phone number
-- or pool. It is also a specific word or phrase that an end user can send
-- to your number to elicit a response, such as an informational message or
-- a special offer. When your number receives a message that begins with a
-- keyword, Amazon Pinpoint responds with a customizable message.
--
-- Keywords \"HELP\" and \"STOP\" can\'t be deleted or modified.
module Amazonka.PinpointSmsVoiceV2.DeleteKeyword
  ( -- * Creating a Request
    DeleteKeyword (..),
    newDeleteKeyword,

    -- * Request Lenses
    deleteKeyword_originationIdentity,
    deleteKeyword_keyword,

    -- * Destructuring the Response
    DeleteKeywordResponse (..),
    newDeleteKeywordResponse,

    -- * Response Lenses
    deleteKeywordResponse_keyword,
    deleteKeywordResponse_keywordAction,
    deleteKeywordResponse_keywordMessage,
    deleteKeywordResponse_originationIdentity,
    deleteKeywordResponse_originationIdentityArn,
    deleteKeywordResponse_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:/ 'newDeleteKeyword' smart constructor.
data DeleteKeyword = DeleteKeyword'
  { -- | The origination identity to use such as a PhoneNumberId, PhoneNumberArn,
    -- PoolId or PoolArn. You can use DescribePhoneNumbers to find the values
    -- for PhoneNumberId and PhoneNumberArn and DescribePools to find the
    -- values of PoolId and PoolArn.
    DeleteKeyword -> Text
originationIdentity :: Prelude.Text,
    -- | The keyword to delete.
    DeleteKeyword -> Text
keyword :: Prelude.Text
  }
  deriving (DeleteKeyword -> DeleteKeyword -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeleteKeyword -> DeleteKeyword -> Bool
$c/= :: DeleteKeyword -> DeleteKeyword -> Bool
== :: DeleteKeyword -> DeleteKeyword -> Bool
$c== :: DeleteKeyword -> DeleteKeyword -> Bool
Prelude.Eq, ReadPrec [DeleteKeyword]
ReadPrec DeleteKeyword
Int -> ReadS DeleteKeyword
ReadS [DeleteKeyword]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeleteKeyword]
$creadListPrec :: ReadPrec [DeleteKeyword]
readPrec :: ReadPrec DeleteKeyword
$creadPrec :: ReadPrec DeleteKeyword
readList :: ReadS [DeleteKeyword]
$creadList :: ReadS [DeleteKeyword]
readsPrec :: Int -> ReadS DeleteKeyword
$creadsPrec :: Int -> ReadS DeleteKeyword
Prelude.Read, Int -> DeleteKeyword -> ShowS
[DeleteKeyword] -> ShowS
DeleteKeyword -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeleteKeyword] -> ShowS
$cshowList :: [DeleteKeyword] -> ShowS
show :: DeleteKeyword -> String
$cshow :: DeleteKeyword -> String
showsPrec :: Int -> DeleteKeyword -> ShowS
$cshowsPrec :: Int -> DeleteKeyword -> ShowS
Prelude.Show, forall x. Rep DeleteKeyword x -> DeleteKeyword
forall x. DeleteKeyword -> Rep DeleteKeyword x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DeleteKeyword x -> DeleteKeyword
$cfrom :: forall x. DeleteKeyword -> Rep DeleteKeyword x
Prelude.Generic)

-- |
-- Create a value of 'DeleteKeyword' 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:
--
-- 'originationIdentity', 'deleteKeyword_originationIdentity' - The origination identity to use such as a PhoneNumberId, PhoneNumberArn,
-- PoolId or PoolArn. You can use DescribePhoneNumbers to find the values
-- for PhoneNumberId and PhoneNumberArn and DescribePools to find the
-- values of PoolId and PoolArn.
--
-- 'keyword', 'deleteKeyword_keyword' - The keyword to delete.
newDeleteKeyword ::
  -- | 'originationIdentity'
  Prelude.Text ->
  -- | 'keyword'
  Prelude.Text ->
  DeleteKeyword
newDeleteKeyword :: Text -> Text -> DeleteKeyword
newDeleteKeyword Text
pOriginationIdentity_ Text
pKeyword_ =
  DeleteKeyword'
    { $sel:originationIdentity:DeleteKeyword' :: Text
originationIdentity =
        Text
pOriginationIdentity_,
      $sel:keyword:DeleteKeyword' :: Text
keyword = Text
pKeyword_
    }

-- | The origination identity to use such as a PhoneNumberId, PhoneNumberArn,
-- PoolId or PoolArn. You can use DescribePhoneNumbers to find the values
-- for PhoneNumberId and PhoneNumberArn and DescribePools to find the
-- values of PoolId and PoolArn.
deleteKeyword_originationIdentity :: Lens.Lens' DeleteKeyword Prelude.Text
deleteKeyword_originationIdentity :: Lens' DeleteKeyword Text
deleteKeyword_originationIdentity = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteKeyword' {Text
originationIdentity :: Text
$sel:originationIdentity:DeleteKeyword' :: DeleteKeyword -> Text
originationIdentity} -> Text
originationIdentity) (\s :: DeleteKeyword
s@DeleteKeyword' {} Text
a -> DeleteKeyword
s {$sel:originationIdentity:DeleteKeyword' :: Text
originationIdentity = Text
a} :: DeleteKeyword)

-- | The keyword to delete.
deleteKeyword_keyword :: Lens.Lens' DeleteKeyword Prelude.Text
deleteKeyword_keyword :: Lens' DeleteKeyword Text
deleteKeyword_keyword = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteKeyword' {Text
keyword :: Text
$sel:keyword:DeleteKeyword' :: DeleteKeyword -> Text
keyword} -> Text
keyword) (\s :: DeleteKeyword
s@DeleteKeyword' {} Text
a -> DeleteKeyword
s {$sel:keyword:DeleteKeyword' :: Text
keyword = Text
a} :: DeleteKeyword)

instance Core.AWSRequest DeleteKeyword where
  type
    AWSResponse DeleteKeyword =
      DeleteKeywordResponse
  request :: (Service -> Service) -> DeleteKeyword -> Request DeleteKeyword
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 DeleteKeyword
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse DeleteKeyword)))
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 KeywordAction
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Int
-> DeleteKeywordResponse
DeleteKeywordResponse'
            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
"Keyword")
            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
"KeywordAction")
            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
"KeywordMessage")
            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
"OriginationIdentity")
            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
"OriginationIdentityArn")
            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 DeleteKeyword where
  hashWithSalt :: Int -> DeleteKeyword -> Int
hashWithSalt Int
_salt DeleteKeyword' {Text
keyword :: Text
originationIdentity :: Text
$sel:keyword:DeleteKeyword' :: DeleteKeyword -> Text
$sel:originationIdentity:DeleteKeyword' :: DeleteKeyword -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
originationIdentity
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
keyword

instance Prelude.NFData DeleteKeyword where
  rnf :: DeleteKeyword -> ()
rnf DeleteKeyword' {Text
keyword :: Text
originationIdentity :: Text
$sel:keyword:DeleteKeyword' :: DeleteKeyword -> Text
$sel:originationIdentity:DeleteKeyword' :: DeleteKeyword -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
originationIdentity
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
keyword

instance Data.ToHeaders DeleteKeyword where
  toHeaders :: DeleteKeyword -> 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.DeleteKeyword" ::
                          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 DeleteKeyword where
  toJSON :: DeleteKeyword -> Value
toJSON DeleteKeyword' {Text
keyword :: Text
originationIdentity :: Text
$sel:keyword:DeleteKeyword' :: DeleteKeyword -> Text
$sel:originationIdentity:DeleteKeyword' :: DeleteKeyword -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just
              (Key
"OriginationIdentity" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
originationIdentity),
            forall a. a -> Maybe a
Prelude.Just (Key
"Keyword" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
keyword)
          ]
      )

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

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

-- | /See:/ 'newDeleteKeywordResponse' smart constructor.
data DeleteKeywordResponse = DeleteKeywordResponse'
  { -- | The keyword that was deleted.
    DeleteKeywordResponse -> Maybe Text
keyword :: Prelude.Maybe Prelude.Text,
    -- | The action that was associated with the deleted keyword.
    DeleteKeywordResponse -> Maybe KeywordAction
keywordAction :: Prelude.Maybe KeywordAction,
    -- | The message that was associated with the deleted keyword.
    DeleteKeywordResponse -> Maybe Text
keywordMessage :: Prelude.Maybe Prelude.Text,
    -- | The PhoneNumberId or PoolId that the keyword was associated with.
    DeleteKeywordResponse -> Maybe Text
originationIdentity :: Prelude.Maybe Prelude.Text,
    -- | The PhoneNumberArn or PoolArn that the keyword was associated with.
    DeleteKeywordResponse -> Maybe Text
originationIdentityArn :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    DeleteKeywordResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (DeleteKeywordResponse -> DeleteKeywordResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeleteKeywordResponse -> DeleteKeywordResponse -> Bool
$c/= :: DeleteKeywordResponse -> DeleteKeywordResponse -> Bool
== :: DeleteKeywordResponse -> DeleteKeywordResponse -> Bool
$c== :: DeleteKeywordResponse -> DeleteKeywordResponse -> Bool
Prelude.Eq, ReadPrec [DeleteKeywordResponse]
ReadPrec DeleteKeywordResponse
Int -> ReadS DeleteKeywordResponse
ReadS [DeleteKeywordResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeleteKeywordResponse]
$creadListPrec :: ReadPrec [DeleteKeywordResponse]
readPrec :: ReadPrec DeleteKeywordResponse
$creadPrec :: ReadPrec DeleteKeywordResponse
readList :: ReadS [DeleteKeywordResponse]
$creadList :: ReadS [DeleteKeywordResponse]
readsPrec :: Int -> ReadS DeleteKeywordResponse
$creadsPrec :: Int -> ReadS DeleteKeywordResponse
Prelude.Read, Int -> DeleteKeywordResponse -> ShowS
[DeleteKeywordResponse] -> ShowS
DeleteKeywordResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeleteKeywordResponse] -> ShowS
$cshowList :: [DeleteKeywordResponse] -> ShowS
show :: DeleteKeywordResponse -> String
$cshow :: DeleteKeywordResponse -> String
showsPrec :: Int -> DeleteKeywordResponse -> ShowS
$cshowsPrec :: Int -> DeleteKeywordResponse -> ShowS
Prelude.Show, forall x. Rep DeleteKeywordResponse x -> DeleteKeywordResponse
forall x. DeleteKeywordResponse -> Rep DeleteKeywordResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DeleteKeywordResponse x -> DeleteKeywordResponse
$cfrom :: forall x. DeleteKeywordResponse -> Rep DeleteKeywordResponse x
Prelude.Generic)

-- |
-- Create a value of 'DeleteKeywordResponse' 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:
--
-- 'keyword', 'deleteKeywordResponse_keyword' - The keyword that was deleted.
--
-- 'keywordAction', 'deleteKeywordResponse_keywordAction' - The action that was associated with the deleted keyword.
--
-- 'keywordMessage', 'deleteKeywordResponse_keywordMessage' - The message that was associated with the deleted keyword.
--
-- 'originationIdentity', 'deleteKeywordResponse_originationIdentity' - The PhoneNumberId or PoolId that the keyword was associated with.
--
-- 'originationIdentityArn', 'deleteKeywordResponse_originationIdentityArn' - The PhoneNumberArn or PoolArn that the keyword was associated with.
--
-- 'httpStatus', 'deleteKeywordResponse_httpStatus' - The response's http status code.
newDeleteKeywordResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DeleteKeywordResponse
newDeleteKeywordResponse :: Int -> DeleteKeywordResponse
newDeleteKeywordResponse Int
pHttpStatus_ =
  DeleteKeywordResponse'
    { $sel:keyword:DeleteKeywordResponse' :: Maybe Text
keyword = forall a. Maybe a
Prelude.Nothing,
      $sel:keywordAction:DeleteKeywordResponse' :: Maybe KeywordAction
keywordAction = forall a. Maybe a
Prelude.Nothing,
      $sel:keywordMessage:DeleteKeywordResponse' :: Maybe Text
keywordMessage = forall a. Maybe a
Prelude.Nothing,
      $sel:originationIdentity:DeleteKeywordResponse' :: Maybe Text
originationIdentity = forall a. Maybe a
Prelude.Nothing,
      $sel:originationIdentityArn:DeleteKeywordResponse' :: Maybe Text
originationIdentityArn = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:DeleteKeywordResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The keyword that was deleted.
deleteKeywordResponse_keyword :: Lens.Lens' DeleteKeywordResponse (Prelude.Maybe Prelude.Text)
deleteKeywordResponse_keyword :: Lens' DeleteKeywordResponse (Maybe Text)
deleteKeywordResponse_keyword = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteKeywordResponse' {Maybe Text
keyword :: Maybe Text
$sel:keyword:DeleteKeywordResponse' :: DeleteKeywordResponse -> Maybe Text
keyword} -> Maybe Text
keyword) (\s :: DeleteKeywordResponse
s@DeleteKeywordResponse' {} Maybe Text
a -> DeleteKeywordResponse
s {$sel:keyword:DeleteKeywordResponse' :: Maybe Text
keyword = Maybe Text
a} :: DeleteKeywordResponse)

-- | The action that was associated with the deleted keyword.
deleteKeywordResponse_keywordAction :: Lens.Lens' DeleteKeywordResponse (Prelude.Maybe KeywordAction)
deleteKeywordResponse_keywordAction :: Lens' DeleteKeywordResponse (Maybe KeywordAction)
deleteKeywordResponse_keywordAction = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteKeywordResponse' {Maybe KeywordAction
keywordAction :: Maybe KeywordAction
$sel:keywordAction:DeleteKeywordResponse' :: DeleteKeywordResponse -> Maybe KeywordAction
keywordAction} -> Maybe KeywordAction
keywordAction) (\s :: DeleteKeywordResponse
s@DeleteKeywordResponse' {} Maybe KeywordAction
a -> DeleteKeywordResponse
s {$sel:keywordAction:DeleteKeywordResponse' :: Maybe KeywordAction
keywordAction = Maybe KeywordAction
a} :: DeleteKeywordResponse)

-- | The message that was associated with the deleted keyword.
deleteKeywordResponse_keywordMessage :: Lens.Lens' DeleteKeywordResponse (Prelude.Maybe Prelude.Text)
deleteKeywordResponse_keywordMessage :: Lens' DeleteKeywordResponse (Maybe Text)
deleteKeywordResponse_keywordMessage = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteKeywordResponse' {Maybe Text
keywordMessage :: Maybe Text
$sel:keywordMessage:DeleteKeywordResponse' :: DeleteKeywordResponse -> Maybe Text
keywordMessage} -> Maybe Text
keywordMessage) (\s :: DeleteKeywordResponse
s@DeleteKeywordResponse' {} Maybe Text
a -> DeleteKeywordResponse
s {$sel:keywordMessage:DeleteKeywordResponse' :: Maybe Text
keywordMessage = Maybe Text
a} :: DeleteKeywordResponse)

-- | The PhoneNumberId or PoolId that the keyword was associated with.
deleteKeywordResponse_originationIdentity :: Lens.Lens' DeleteKeywordResponse (Prelude.Maybe Prelude.Text)
deleteKeywordResponse_originationIdentity :: Lens' DeleteKeywordResponse (Maybe Text)
deleteKeywordResponse_originationIdentity = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteKeywordResponse' {Maybe Text
originationIdentity :: Maybe Text
$sel:originationIdentity:DeleteKeywordResponse' :: DeleteKeywordResponse -> Maybe Text
originationIdentity} -> Maybe Text
originationIdentity) (\s :: DeleteKeywordResponse
s@DeleteKeywordResponse' {} Maybe Text
a -> DeleteKeywordResponse
s {$sel:originationIdentity:DeleteKeywordResponse' :: Maybe Text
originationIdentity = Maybe Text
a} :: DeleteKeywordResponse)

-- | The PhoneNumberArn or PoolArn that the keyword was associated with.
deleteKeywordResponse_originationIdentityArn :: Lens.Lens' DeleteKeywordResponse (Prelude.Maybe Prelude.Text)
deleteKeywordResponse_originationIdentityArn :: Lens' DeleteKeywordResponse (Maybe Text)
deleteKeywordResponse_originationIdentityArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteKeywordResponse' {Maybe Text
originationIdentityArn :: Maybe Text
$sel:originationIdentityArn:DeleteKeywordResponse' :: DeleteKeywordResponse -> Maybe Text
originationIdentityArn} -> Maybe Text
originationIdentityArn) (\s :: DeleteKeywordResponse
s@DeleteKeywordResponse' {} Maybe Text
a -> DeleteKeywordResponse
s {$sel:originationIdentityArn:DeleteKeywordResponse' :: Maybe Text
originationIdentityArn = Maybe Text
a} :: DeleteKeywordResponse)

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

instance Prelude.NFData DeleteKeywordResponse where
  rnf :: DeleteKeywordResponse -> ()
rnf DeleteKeywordResponse' {Int
Maybe Text
Maybe KeywordAction
httpStatus :: Int
originationIdentityArn :: Maybe Text
originationIdentity :: Maybe Text
keywordMessage :: Maybe Text
keywordAction :: Maybe KeywordAction
keyword :: Maybe Text
$sel:httpStatus:DeleteKeywordResponse' :: DeleteKeywordResponse -> Int
$sel:originationIdentityArn:DeleteKeywordResponse' :: DeleteKeywordResponse -> Maybe Text
$sel:originationIdentity:DeleteKeywordResponse' :: DeleteKeywordResponse -> Maybe Text
$sel:keywordMessage:DeleteKeywordResponse' :: DeleteKeywordResponse -> Maybe Text
$sel:keywordAction:DeleteKeywordResponse' :: DeleteKeywordResponse -> Maybe KeywordAction
$sel:keyword:DeleteKeywordResponse' :: DeleteKeywordResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
keyword
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe KeywordAction
keywordAction
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
keywordMessage
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
originationIdentity
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
originationIdentityArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus