{-# 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.PutKeyword
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Creates or updates a keyword configuration on 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.
--
-- If you specify a keyword that isn\'t valid, an Error is returned.
module Amazonka.PinpointSmsVoiceV2.PutKeyword
  ( -- * Creating a Request
    PutKeyword (..),
    newPutKeyword,

    -- * Request Lenses
    putKeyword_keywordAction,
    putKeyword_originationIdentity,
    putKeyword_keyword,
    putKeyword_keywordMessage,

    -- * Destructuring the Response
    PutKeywordResponse (..),
    newPutKeywordResponse,

    -- * Response Lenses
    putKeywordResponse_keyword,
    putKeywordResponse_keywordAction,
    putKeywordResponse_keywordMessage,
    putKeywordResponse_originationIdentity,
    putKeywordResponse_originationIdentityArn,
    putKeywordResponse_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:/ 'newPutKeyword' smart constructor.
data PutKeyword = PutKeyword'
  { -- | The action to perform for the new keyword when it is received.
    PutKeyword -> Maybe KeywordAction
keywordAction :: Prelude.Maybe KeywordAction,
    -- | The origination identity to use such as a PhoneNumberId, PhoneNumberArn,
    -- SenderId or SenderIdArn. You can use DescribePhoneNumbers get the values
    -- for PhoneNumberId and PhoneNumberArn while DescribeSenderIds can be used
    -- to get the values for SenderId and SenderIdArn.
    PutKeyword -> Text
originationIdentity :: Prelude.Text,
    -- | The new keyword to add.
    PutKeyword -> Text
keyword :: Prelude.Text,
    -- | The message associated with the keyword.
    --
    -- -   AUTOMATIC_RESPONSE: A message is sent to the recipient.
    --
    -- -   OPT_OUT: Keeps the recipient from receiving future messages.
    --
    -- -   OPT_IN: The recipient wants to receive future messages.
    PutKeyword -> Text
keywordMessage :: Prelude.Text
  }
  deriving (PutKeyword -> PutKeyword -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PutKeyword -> PutKeyword -> Bool
$c/= :: PutKeyword -> PutKeyword -> Bool
== :: PutKeyword -> PutKeyword -> Bool
$c== :: PutKeyword -> PutKeyword -> Bool
Prelude.Eq, ReadPrec [PutKeyword]
ReadPrec PutKeyword
Int -> ReadS PutKeyword
ReadS [PutKeyword]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PutKeyword]
$creadListPrec :: ReadPrec [PutKeyword]
readPrec :: ReadPrec PutKeyword
$creadPrec :: ReadPrec PutKeyword
readList :: ReadS [PutKeyword]
$creadList :: ReadS [PutKeyword]
readsPrec :: Int -> ReadS PutKeyword
$creadsPrec :: Int -> ReadS PutKeyword
Prelude.Read, Int -> PutKeyword -> ShowS
[PutKeyword] -> ShowS
PutKeyword -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PutKeyword] -> ShowS
$cshowList :: [PutKeyword] -> ShowS
show :: PutKeyword -> String
$cshow :: PutKeyword -> String
showsPrec :: Int -> PutKeyword -> ShowS
$cshowsPrec :: Int -> PutKeyword -> ShowS
Prelude.Show, forall x. Rep PutKeyword x -> PutKeyword
forall x. PutKeyword -> Rep PutKeyword x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PutKeyword x -> PutKeyword
$cfrom :: forall x. PutKeyword -> Rep PutKeyword x
Prelude.Generic)

-- |
-- Create a value of 'PutKeyword' 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:
--
-- 'keywordAction', 'putKeyword_keywordAction' - The action to perform for the new keyword when it is received.
--
-- 'originationIdentity', 'putKeyword_originationIdentity' - The origination identity to use such as a PhoneNumberId, PhoneNumberArn,
-- SenderId or SenderIdArn. You can use DescribePhoneNumbers get the values
-- for PhoneNumberId and PhoneNumberArn while DescribeSenderIds can be used
-- to get the values for SenderId and SenderIdArn.
--
-- 'keyword', 'putKeyword_keyword' - The new keyword to add.
--
-- 'keywordMessage', 'putKeyword_keywordMessage' - The message associated with the keyword.
--
-- -   AUTOMATIC_RESPONSE: A message is sent to the recipient.
--
-- -   OPT_OUT: Keeps the recipient from receiving future messages.
--
-- -   OPT_IN: The recipient wants to receive future messages.
newPutKeyword ::
  -- | 'originationIdentity'
  Prelude.Text ->
  -- | 'keyword'
  Prelude.Text ->
  -- | 'keywordMessage'
  Prelude.Text ->
  PutKeyword
newPutKeyword :: Text -> Text -> Text -> PutKeyword
newPutKeyword
  Text
pOriginationIdentity_
  Text
pKeyword_
  Text
pKeywordMessage_ =
    PutKeyword'
      { $sel:keywordAction:PutKeyword' :: Maybe KeywordAction
keywordAction = forall a. Maybe a
Prelude.Nothing,
        $sel:originationIdentity:PutKeyword' :: Text
originationIdentity = Text
pOriginationIdentity_,
        $sel:keyword:PutKeyword' :: Text
keyword = Text
pKeyword_,
        $sel:keywordMessage:PutKeyword' :: Text
keywordMessage = Text
pKeywordMessage_
      }

-- | The action to perform for the new keyword when it is received.
putKeyword_keywordAction :: Lens.Lens' PutKeyword (Prelude.Maybe KeywordAction)
putKeyword_keywordAction :: Lens' PutKeyword (Maybe KeywordAction)
putKeyword_keywordAction = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutKeyword' {Maybe KeywordAction
keywordAction :: Maybe KeywordAction
$sel:keywordAction:PutKeyword' :: PutKeyword -> Maybe KeywordAction
keywordAction} -> Maybe KeywordAction
keywordAction) (\s :: PutKeyword
s@PutKeyword' {} Maybe KeywordAction
a -> PutKeyword
s {$sel:keywordAction:PutKeyword' :: Maybe KeywordAction
keywordAction = Maybe KeywordAction
a} :: PutKeyword)

-- | The origination identity to use such as a PhoneNumberId, PhoneNumberArn,
-- SenderId or SenderIdArn. You can use DescribePhoneNumbers get the values
-- for PhoneNumberId and PhoneNumberArn while DescribeSenderIds can be used
-- to get the values for SenderId and SenderIdArn.
putKeyword_originationIdentity :: Lens.Lens' PutKeyword Prelude.Text
putKeyword_originationIdentity :: Lens' PutKeyword Text
putKeyword_originationIdentity = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutKeyword' {Text
originationIdentity :: Text
$sel:originationIdentity:PutKeyword' :: PutKeyword -> Text
originationIdentity} -> Text
originationIdentity) (\s :: PutKeyword
s@PutKeyword' {} Text
a -> PutKeyword
s {$sel:originationIdentity:PutKeyword' :: Text
originationIdentity = Text
a} :: PutKeyword)

-- | The new keyword to add.
putKeyword_keyword :: Lens.Lens' PutKeyword Prelude.Text
putKeyword_keyword :: Lens' PutKeyword Text
putKeyword_keyword = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutKeyword' {Text
keyword :: Text
$sel:keyword:PutKeyword' :: PutKeyword -> Text
keyword} -> Text
keyword) (\s :: PutKeyword
s@PutKeyword' {} Text
a -> PutKeyword
s {$sel:keyword:PutKeyword' :: Text
keyword = Text
a} :: PutKeyword)

-- | The message associated with the keyword.
--
-- -   AUTOMATIC_RESPONSE: A message is sent to the recipient.
--
-- -   OPT_OUT: Keeps the recipient from receiving future messages.
--
-- -   OPT_IN: The recipient wants to receive future messages.
putKeyword_keywordMessage :: Lens.Lens' PutKeyword Prelude.Text
putKeyword_keywordMessage :: Lens' PutKeyword Text
putKeyword_keywordMessage = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutKeyword' {Text
keywordMessage :: Text
$sel:keywordMessage:PutKeyword' :: PutKeyword -> Text
keywordMessage} -> Text
keywordMessage) (\s :: PutKeyword
s@PutKeyword' {} Text
a -> PutKeyword
s {$sel:keywordMessage:PutKeyword' :: Text
keywordMessage = Text
a} :: PutKeyword)

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

instance Prelude.NFData PutKeyword where
  rnf :: PutKeyword -> ()
rnf PutKeyword' {Maybe KeywordAction
Text
keywordMessage :: Text
keyword :: Text
originationIdentity :: Text
keywordAction :: Maybe KeywordAction
$sel:keywordMessage:PutKeyword' :: PutKeyword -> Text
$sel:keyword:PutKeyword' :: PutKeyword -> Text
$sel:originationIdentity:PutKeyword' :: PutKeyword -> Text
$sel:keywordAction:PutKeyword' :: PutKeyword -> Maybe KeywordAction
..} =
    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 Text
originationIdentity
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
keyword
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
keywordMessage

instance Data.ToHeaders PutKeyword where
  toHeaders :: PutKeyword -> 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.PutKeyword" ::
                          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 PutKeyword where
  toJSON :: PutKeyword -> Value
toJSON PutKeyword' {Maybe KeywordAction
Text
keywordMessage :: Text
keyword :: Text
originationIdentity :: Text
keywordAction :: Maybe KeywordAction
$sel:keywordMessage:PutKeyword' :: PutKeyword -> Text
$sel:keyword:PutKeyword' :: PutKeyword -> Text
$sel:originationIdentity:PutKeyword' :: PutKeyword -> Text
$sel:keywordAction:PutKeyword' :: PutKeyword -> Maybe KeywordAction
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"KeywordAction" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe KeywordAction
keywordAction,
            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),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"KeywordMessage" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
keywordMessage)
          ]
      )

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

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

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

-- |
-- Create a value of 'PutKeywordResponse' 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', 'putKeywordResponse_keyword' - The keyword that was added.
--
-- 'keywordAction', 'putKeywordResponse_keywordAction' - The action to perform when the keyword is used.
--
-- 'keywordMessage', 'putKeywordResponse_keywordMessage' - The message associated with the keyword.
--
-- 'originationIdentity', 'putKeywordResponse_originationIdentity' - The PhoneNumberId or PoolId that the keyword was associated with.
--
-- 'originationIdentityArn', 'putKeywordResponse_originationIdentityArn' - The PhoneNumberArn or PoolArn that the keyword was associated with.
--
-- 'httpStatus', 'putKeywordResponse_httpStatus' - The response's http status code.
newPutKeywordResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  PutKeywordResponse
newPutKeywordResponse :: Int -> PutKeywordResponse
newPutKeywordResponse Int
pHttpStatus_ =
  PutKeywordResponse'
    { $sel:keyword:PutKeywordResponse' :: Maybe Text
keyword = forall a. Maybe a
Prelude.Nothing,
      $sel:keywordAction:PutKeywordResponse' :: Maybe KeywordAction
keywordAction = forall a. Maybe a
Prelude.Nothing,
      $sel:keywordMessage:PutKeywordResponse' :: Maybe Text
keywordMessage = forall a. Maybe a
Prelude.Nothing,
      $sel:originationIdentity:PutKeywordResponse' :: Maybe Text
originationIdentity = forall a. Maybe a
Prelude.Nothing,
      $sel:originationIdentityArn:PutKeywordResponse' :: Maybe Text
originationIdentityArn = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:PutKeywordResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

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

-- | The action to perform when the keyword is used.
putKeywordResponse_keywordAction :: Lens.Lens' PutKeywordResponse (Prelude.Maybe KeywordAction)
putKeywordResponse_keywordAction :: Lens' PutKeywordResponse (Maybe KeywordAction)
putKeywordResponse_keywordAction = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutKeywordResponse' {Maybe KeywordAction
keywordAction :: Maybe KeywordAction
$sel:keywordAction:PutKeywordResponse' :: PutKeywordResponse -> Maybe KeywordAction
keywordAction} -> Maybe KeywordAction
keywordAction) (\s :: PutKeywordResponse
s@PutKeywordResponse' {} Maybe KeywordAction
a -> PutKeywordResponse
s {$sel:keywordAction:PutKeywordResponse' :: Maybe KeywordAction
keywordAction = Maybe KeywordAction
a} :: PutKeywordResponse)

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

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

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

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

instance Prelude.NFData PutKeywordResponse where
  rnf :: PutKeywordResponse -> ()
rnf PutKeywordResponse' {Int
Maybe Text
Maybe KeywordAction
httpStatus :: Int
originationIdentityArn :: Maybe Text
originationIdentity :: Maybe Text
keywordMessage :: Maybe Text
keywordAction :: Maybe KeywordAction
keyword :: Maybe Text
$sel:httpStatus:PutKeywordResponse' :: PutKeywordResponse -> Int
$sel:originationIdentityArn:PutKeywordResponse' :: PutKeywordResponse -> Maybe Text
$sel:originationIdentity:PutKeywordResponse' :: PutKeywordResponse -> Maybe Text
$sel:keywordMessage:PutKeywordResponse' :: PutKeywordResponse -> Maybe Text
$sel:keywordAction:PutKeywordResponse' :: PutKeywordResponse -> Maybe KeywordAction
$sel:keyword:PutKeywordResponse' :: PutKeywordResponse -> 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