{-# 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.LexRuntime.PostText
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Sends user input to Amazon Lex. Client applications can use this API to
-- send requests to Amazon Lex at runtime. Amazon Lex then interprets the
-- user input using the machine learning model it built for the bot.
--
-- In response, Amazon Lex returns the next @message@ to convey to the user
-- an optional @responseCard@ to display. Consider the following example
-- messages:
--
-- -   For a user input \"I would like a pizza\", Amazon Lex might return a
--     response with a message eliciting slot data (for example,
--     PizzaSize): \"What size pizza would you like?\"
--
-- -   After the user provides all of the pizza order information, Amazon
--     Lex might return a response with a message to obtain user
--     confirmation \"Proceed with the pizza order?\".
--
-- -   After the user replies to a confirmation prompt with a \"yes\",
--     Amazon Lex might return a conclusion statement: \"Thank you, your
--     cheese pizza has been ordered.\".
--
-- Not all Amazon Lex messages require a user response. For example, a
-- conclusion statement does not require a response. Some messages require
-- only a \"yes\" or \"no\" user response. In addition to the @message@,
-- Amazon Lex provides additional context about the message in the response
-- that you might use to enhance client behavior, for example, to display
-- the appropriate client user interface. These are the @slotToElicit@,
-- @dialogState@, @intentName@, and @slots@ fields in the response.
-- Consider the following examples:
--
-- -   If the message is to elicit slot data, Amazon Lex returns the
--     following context information:
--
--     -   @dialogState@ set to ElicitSlot
--
--     -   @intentName@ set to the intent name in the current context
--
--     -   @slotToElicit@ set to the slot name for which the @message@ is
--         eliciting information
--
--     -   @slots@ set to a map of slots, configured for the intent, with
--         currently known values
--
-- -   If the message is a confirmation prompt, the @dialogState@ is set to
--     ConfirmIntent and @SlotToElicit@ is set to null.
--
-- -   If the message is a clarification prompt (configured for the intent)
--     that indicates that user intent is not understood, the @dialogState@
--     is set to ElicitIntent and @slotToElicit@ is set to null.
--
-- In addition, Amazon Lex also returns your application-specific
-- @sessionAttributes@. For more information, see
-- <https://docs.aws.amazon.com/lex/latest/dg/context-mgmt.html Managing Conversation Context>.
module Amazonka.LexRuntime.PostText
  ( -- * Creating a Request
    PostText (..),
    newPostText,

    -- * Request Lenses
    postText_activeContexts,
    postText_requestAttributes,
    postText_sessionAttributes,
    postText_botName,
    postText_botAlias,
    postText_userId,
    postText_inputText,

    -- * Destructuring the Response
    PostTextResponse (..),
    newPostTextResponse,

    -- * Response Lenses
    postTextResponse_activeContexts,
    postTextResponse_alternativeIntents,
    postTextResponse_botVersion,
    postTextResponse_dialogState,
    postTextResponse_intentName,
    postTextResponse_message,
    postTextResponse_messageFormat,
    postTextResponse_nluIntentConfidence,
    postTextResponse_responseCard,
    postTextResponse_sentimentResponse,
    postTextResponse_sessionAttributes,
    postTextResponse_sessionId,
    postTextResponse_slotToElicit,
    postTextResponse_slots,
    postTextResponse_httpStatus,
  )
where

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

-- | /See:/ 'newPostText' smart constructor.
data PostText = PostText'
  { -- | A list of contexts active for the request. A context can be activated
    -- when a previous intent is fulfilled, or by including the context in the
    -- request,
    --
    -- If you don\'t specify a list of contexts, Amazon Lex will use the
    -- current list of contexts for the session. If you specify an empty list,
    -- all contexts for the session are cleared.
    PostText -> Maybe (Sensitive [ActiveContext])
activeContexts :: Prelude.Maybe (Data.Sensitive [ActiveContext]),
    -- | Request-specific information passed between Amazon Lex and a client
    -- application.
    --
    -- The namespace @x-amz-lex:@ is reserved for special attributes. Don\'t
    -- create any request attributes with the prefix @x-amz-lex:@.
    --
    -- For more information, see
    -- <https://docs.aws.amazon.com/lex/latest/dg/context-mgmt.html#context-mgmt-request-attribs Setting Request Attributes>.
    PostText -> Maybe (Sensitive (HashMap Text Text))
requestAttributes :: Prelude.Maybe (Data.Sensitive (Prelude.HashMap Prelude.Text Prelude.Text)),
    -- | Application-specific information passed between Amazon Lex and a client
    -- application.
    --
    -- For more information, see
    -- <https://docs.aws.amazon.com/lex/latest/dg/context-mgmt.html#context-mgmt-session-attribs Setting Session Attributes>.
    PostText -> Maybe (Sensitive (HashMap Text Text))
sessionAttributes :: Prelude.Maybe (Data.Sensitive (Prelude.HashMap Prelude.Text Prelude.Text)),
    -- | The name of the Amazon Lex bot.
    PostText -> Text
botName :: Prelude.Text,
    -- | The alias of the Amazon Lex bot.
    PostText -> Text
botAlias :: Prelude.Text,
    -- | The ID of the client application user. Amazon Lex uses this to identify
    -- a user\'s conversation with your bot. At runtime, each request must
    -- contain the @userID@ field.
    --
    -- To decide the user ID to use for your application, consider the
    -- following factors.
    --
    -- -   The @userID@ field must not contain any personally identifiable
    --     information of the user, for example, name, personal identification
    --     numbers, or other end user personal information.
    --
    -- -   If you want a user to start a conversation on one device and
    --     continue on another device, use a user-specific identifier.
    --
    -- -   If you want the same user to be able to have two independent
    --     conversations on two different devices, choose a device-specific
    --     identifier.
    --
    -- -   A user can\'t have two independent conversations with two different
    --     versions of the same bot. For example, a user can\'t have a
    --     conversation with the PROD and BETA versions of the same bot. If you
    --     anticipate that a user will need to have conversation with two
    --     different versions, for example, while testing, include the bot
    --     alias in the user ID to separate the two conversations.
    PostText -> Text
userId :: Prelude.Text,
    -- | The text that the user entered (Amazon Lex interprets this text).
    PostText -> Sensitive Text
inputText :: Data.Sensitive Prelude.Text
  }
  deriving (PostText -> PostText -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostText -> PostText -> Bool
$c/= :: PostText -> PostText -> Bool
== :: PostText -> PostText -> Bool
$c== :: PostText -> PostText -> Bool
Prelude.Eq, Int -> PostText -> ShowS
[PostText] -> ShowS
PostText -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PostText] -> ShowS
$cshowList :: [PostText] -> ShowS
show :: PostText -> String
$cshow :: PostText -> String
showsPrec :: Int -> PostText -> ShowS
$cshowsPrec :: Int -> PostText -> ShowS
Prelude.Show, forall x. Rep PostText x -> PostText
forall x. PostText -> Rep PostText x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PostText x -> PostText
$cfrom :: forall x. PostText -> Rep PostText x
Prelude.Generic)

-- |
-- Create a value of 'PostText' 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:
--
-- 'activeContexts', 'postText_activeContexts' - A list of contexts active for the request. A context can be activated
-- when a previous intent is fulfilled, or by including the context in the
-- request,
--
-- If you don\'t specify a list of contexts, Amazon Lex will use the
-- current list of contexts for the session. If you specify an empty list,
-- all contexts for the session are cleared.
--
-- 'requestAttributes', 'postText_requestAttributes' - Request-specific information passed between Amazon Lex and a client
-- application.
--
-- The namespace @x-amz-lex:@ is reserved for special attributes. Don\'t
-- create any request attributes with the prefix @x-amz-lex:@.
--
-- For more information, see
-- <https://docs.aws.amazon.com/lex/latest/dg/context-mgmt.html#context-mgmt-request-attribs Setting Request Attributes>.
--
-- 'sessionAttributes', 'postText_sessionAttributes' - Application-specific information passed between Amazon Lex and a client
-- application.
--
-- For more information, see
-- <https://docs.aws.amazon.com/lex/latest/dg/context-mgmt.html#context-mgmt-session-attribs Setting Session Attributes>.
--
-- 'botName', 'postText_botName' - The name of the Amazon Lex bot.
--
-- 'botAlias', 'postText_botAlias' - The alias of the Amazon Lex bot.
--
-- 'userId', 'postText_userId' - The ID of the client application user. Amazon Lex uses this to identify
-- a user\'s conversation with your bot. At runtime, each request must
-- contain the @userID@ field.
--
-- To decide the user ID to use for your application, consider the
-- following factors.
--
-- -   The @userID@ field must not contain any personally identifiable
--     information of the user, for example, name, personal identification
--     numbers, or other end user personal information.
--
-- -   If you want a user to start a conversation on one device and
--     continue on another device, use a user-specific identifier.
--
-- -   If you want the same user to be able to have two independent
--     conversations on two different devices, choose a device-specific
--     identifier.
--
-- -   A user can\'t have two independent conversations with two different
--     versions of the same bot. For example, a user can\'t have a
--     conversation with the PROD and BETA versions of the same bot. If you
--     anticipate that a user will need to have conversation with two
--     different versions, for example, while testing, include the bot
--     alias in the user ID to separate the two conversations.
--
-- 'inputText', 'postText_inputText' - The text that the user entered (Amazon Lex interprets this text).
newPostText ::
  -- | 'botName'
  Prelude.Text ->
  -- | 'botAlias'
  Prelude.Text ->
  -- | 'userId'
  Prelude.Text ->
  -- | 'inputText'
  Prelude.Text ->
  PostText
newPostText :: Text -> Text -> Text -> Text -> PostText
newPostText Text
pBotName_ Text
pBotAlias_ Text
pUserId_ Text
pInputText_ =
  PostText'
    { $sel:activeContexts:PostText' :: Maybe (Sensitive [ActiveContext])
activeContexts = forall a. Maybe a
Prelude.Nothing,
      $sel:requestAttributes:PostText' :: Maybe (Sensitive (HashMap Text Text))
requestAttributes = forall a. Maybe a
Prelude.Nothing,
      $sel:sessionAttributes:PostText' :: Maybe (Sensitive (HashMap Text Text))
sessionAttributes = forall a. Maybe a
Prelude.Nothing,
      $sel:botName:PostText' :: Text
botName = Text
pBotName_,
      $sel:botAlias:PostText' :: Text
botAlias = Text
pBotAlias_,
      $sel:userId:PostText' :: Text
userId = Text
pUserId_,
      $sel:inputText:PostText' :: Sensitive Text
inputText = forall a. Iso' (Sensitive a) a
Data._Sensitive forall t b. AReview t b -> b -> t
Lens.# Text
pInputText_
    }

-- | A list of contexts active for the request. A context can be activated
-- when a previous intent is fulfilled, or by including the context in the
-- request,
--
-- If you don\'t specify a list of contexts, Amazon Lex will use the
-- current list of contexts for the session. If you specify an empty list,
-- all contexts for the session are cleared.
postText_activeContexts :: Lens.Lens' PostText (Prelude.Maybe [ActiveContext])
postText_activeContexts :: Lens' PostText (Maybe [ActiveContext])
postText_activeContexts = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PostText' {Maybe (Sensitive [ActiveContext])
activeContexts :: Maybe (Sensitive [ActiveContext])
$sel:activeContexts:PostText' :: PostText -> Maybe (Sensitive [ActiveContext])
activeContexts} -> Maybe (Sensitive [ActiveContext])
activeContexts) (\s :: PostText
s@PostText' {} Maybe (Sensitive [ActiveContext])
a -> PostText
s {$sel:activeContexts:PostText' :: Maybe (Sensitive [ActiveContext])
activeContexts = Maybe (Sensitive [ActiveContext])
a} :: PostText) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping (forall a. Iso' (Sensitive a) a
Data._Sensitive forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced)

-- | Request-specific information passed between Amazon Lex and a client
-- application.
--
-- The namespace @x-amz-lex:@ is reserved for special attributes. Don\'t
-- create any request attributes with the prefix @x-amz-lex:@.
--
-- For more information, see
-- <https://docs.aws.amazon.com/lex/latest/dg/context-mgmt.html#context-mgmt-request-attribs Setting Request Attributes>.
postText_requestAttributes :: Lens.Lens' PostText (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
postText_requestAttributes :: Lens' PostText (Maybe (HashMap Text Text))
postText_requestAttributes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PostText' {Maybe (Sensitive (HashMap Text Text))
requestAttributes :: Maybe (Sensitive (HashMap Text Text))
$sel:requestAttributes:PostText' :: PostText -> Maybe (Sensitive (HashMap Text Text))
requestAttributes} -> Maybe (Sensitive (HashMap Text Text))
requestAttributes) (\s :: PostText
s@PostText' {} Maybe (Sensitive (HashMap Text Text))
a -> PostText
s {$sel:requestAttributes:PostText' :: Maybe (Sensitive (HashMap Text Text))
requestAttributes = Maybe (Sensitive (HashMap Text Text))
a} :: PostText) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping (forall a. Iso' (Sensitive a) a
Data._Sensitive forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced)

-- | Application-specific information passed between Amazon Lex and a client
-- application.
--
-- For more information, see
-- <https://docs.aws.amazon.com/lex/latest/dg/context-mgmt.html#context-mgmt-session-attribs Setting Session Attributes>.
postText_sessionAttributes :: Lens.Lens' PostText (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
postText_sessionAttributes :: Lens' PostText (Maybe (HashMap Text Text))
postText_sessionAttributes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PostText' {Maybe (Sensitive (HashMap Text Text))
sessionAttributes :: Maybe (Sensitive (HashMap Text Text))
$sel:sessionAttributes:PostText' :: PostText -> Maybe (Sensitive (HashMap Text Text))
sessionAttributes} -> Maybe (Sensitive (HashMap Text Text))
sessionAttributes) (\s :: PostText
s@PostText' {} Maybe (Sensitive (HashMap Text Text))
a -> PostText
s {$sel:sessionAttributes:PostText' :: Maybe (Sensitive (HashMap Text Text))
sessionAttributes = Maybe (Sensitive (HashMap Text Text))
a} :: PostText) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping (forall a. Iso' (Sensitive a) a
Data._Sensitive forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced)

-- | The name of the Amazon Lex bot.
postText_botName :: Lens.Lens' PostText Prelude.Text
postText_botName :: Lens' PostText Text
postText_botName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PostText' {Text
botName :: Text
$sel:botName:PostText' :: PostText -> Text
botName} -> Text
botName) (\s :: PostText
s@PostText' {} Text
a -> PostText
s {$sel:botName:PostText' :: Text
botName = Text
a} :: PostText)

-- | The alias of the Amazon Lex bot.
postText_botAlias :: Lens.Lens' PostText Prelude.Text
postText_botAlias :: Lens' PostText Text
postText_botAlias = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PostText' {Text
botAlias :: Text
$sel:botAlias:PostText' :: PostText -> Text
botAlias} -> Text
botAlias) (\s :: PostText
s@PostText' {} Text
a -> PostText
s {$sel:botAlias:PostText' :: Text
botAlias = Text
a} :: PostText)

-- | The ID of the client application user. Amazon Lex uses this to identify
-- a user\'s conversation with your bot. At runtime, each request must
-- contain the @userID@ field.
--
-- To decide the user ID to use for your application, consider the
-- following factors.
--
-- -   The @userID@ field must not contain any personally identifiable
--     information of the user, for example, name, personal identification
--     numbers, or other end user personal information.
--
-- -   If you want a user to start a conversation on one device and
--     continue on another device, use a user-specific identifier.
--
-- -   If you want the same user to be able to have two independent
--     conversations on two different devices, choose a device-specific
--     identifier.
--
-- -   A user can\'t have two independent conversations with two different
--     versions of the same bot. For example, a user can\'t have a
--     conversation with the PROD and BETA versions of the same bot. If you
--     anticipate that a user will need to have conversation with two
--     different versions, for example, while testing, include the bot
--     alias in the user ID to separate the two conversations.
postText_userId :: Lens.Lens' PostText Prelude.Text
postText_userId :: Lens' PostText Text
postText_userId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PostText' {Text
userId :: Text
$sel:userId:PostText' :: PostText -> Text
userId} -> Text
userId) (\s :: PostText
s@PostText' {} Text
a -> PostText
s {$sel:userId:PostText' :: Text
userId = Text
a} :: PostText)

-- | The text that the user entered (Amazon Lex interprets this text).
postText_inputText :: Lens.Lens' PostText Prelude.Text
postText_inputText :: Lens' PostText Text
postText_inputText = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PostText' {Sensitive Text
inputText :: Sensitive Text
$sel:inputText:PostText' :: PostText -> Sensitive Text
inputText} -> Sensitive Text
inputText) (\s :: PostText
s@PostText' {} Sensitive Text
a -> PostText
s {$sel:inputText:PostText' :: Sensitive Text
inputText = Sensitive Text
a} :: PostText) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a. Iso' (Sensitive a) a
Data._Sensitive

instance Core.AWSRequest PostText where
  type AWSResponse PostText = PostTextResponse
  request :: (Service -> Service) -> PostText -> Request PostText
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 PostText
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse PostText)))
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 (Sensitive [ActiveContext])
-> Maybe [PredictedIntent]
-> Maybe Text
-> Maybe DialogState
-> Maybe Text
-> Maybe (Sensitive Text)
-> Maybe MessageFormatType
-> Maybe IntentConfidence
-> Maybe ResponseCard
-> Maybe SentimentResponse
-> Maybe (Sensitive (HashMap Text Text))
-> Maybe Text
-> Maybe Text
-> Maybe (Sensitive (HashMap Text Text))
-> Int
-> PostTextResponse
PostTextResponse'
            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
"activeContexts" forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty)
            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
"alternativeIntents"
                            forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty
                        )
            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
"botVersion")
            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
"dialogState")
            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
"intentName")
            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
"message")
            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
"messageFormat")
            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
"nluIntentConfidence")
            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
"responseCard")
            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
"sentimentResponse")
            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
"sessionAttributes"
                            forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty
                        )
            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
"sessionId")
            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
"slotToElicit")
            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
"slots" forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty)
            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 PostText where
  hashWithSalt :: Int -> PostText -> Int
hashWithSalt Int
_salt PostText' {Maybe (Sensitive [ActiveContext])
Maybe (Sensitive (HashMap Text Text))
Text
Sensitive Text
inputText :: Sensitive Text
userId :: Text
botAlias :: Text
botName :: Text
sessionAttributes :: Maybe (Sensitive (HashMap Text Text))
requestAttributes :: Maybe (Sensitive (HashMap Text Text))
activeContexts :: Maybe (Sensitive [ActiveContext])
$sel:inputText:PostText' :: PostText -> Sensitive Text
$sel:userId:PostText' :: PostText -> Text
$sel:botAlias:PostText' :: PostText -> Text
$sel:botName:PostText' :: PostText -> Text
$sel:sessionAttributes:PostText' :: PostText -> Maybe (Sensitive (HashMap Text Text))
$sel:requestAttributes:PostText' :: PostText -> Maybe (Sensitive (HashMap Text Text))
$sel:activeContexts:PostText' :: PostText -> Maybe (Sensitive [ActiveContext])
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (Sensitive [ActiveContext])
activeContexts
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (Sensitive (HashMap Text Text))
requestAttributes
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (Sensitive (HashMap Text Text))
sessionAttributes
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
botName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
botAlias
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
userId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Sensitive Text
inputText

instance Prelude.NFData PostText where
  rnf :: PostText -> ()
rnf PostText' {Maybe (Sensitive [ActiveContext])
Maybe (Sensitive (HashMap Text Text))
Text
Sensitive Text
inputText :: Sensitive Text
userId :: Text
botAlias :: Text
botName :: Text
sessionAttributes :: Maybe (Sensitive (HashMap Text Text))
requestAttributes :: Maybe (Sensitive (HashMap Text Text))
activeContexts :: Maybe (Sensitive [ActiveContext])
$sel:inputText:PostText' :: PostText -> Sensitive Text
$sel:userId:PostText' :: PostText -> Text
$sel:botAlias:PostText' :: PostText -> Text
$sel:botName:PostText' :: PostText -> Text
$sel:sessionAttributes:PostText' :: PostText -> Maybe (Sensitive (HashMap Text Text))
$sel:requestAttributes:PostText' :: PostText -> Maybe (Sensitive (HashMap Text Text))
$sel:activeContexts:PostText' :: PostText -> Maybe (Sensitive [ActiveContext])
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe (Sensitive [ActiveContext])
activeContexts
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (Sensitive (HashMap Text Text))
requestAttributes
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (Sensitive (HashMap Text Text))
sessionAttributes
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
botName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
botAlias
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
userId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Sensitive Text
inputText

instance Data.ToHeaders PostText where
  toHeaders :: PostText -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON PostText where
  toJSON :: PostText -> Value
toJSON PostText' {Maybe (Sensitive [ActiveContext])
Maybe (Sensitive (HashMap Text Text))
Text
Sensitive Text
inputText :: Sensitive Text
userId :: Text
botAlias :: Text
botName :: Text
sessionAttributes :: Maybe (Sensitive (HashMap Text Text))
requestAttributes :: Maybe (Sensitive (HashMap Text Text))
activeContexts :: Maybe (Sensitive [ActiveContext])
$sel:inputText:PostText' :: PostText -> Sensitive Text
$sel:userId:PostText' :: PostText -> Text
$sel:botAlias:PostText' :: PostText -> Text
$sel:botName:PostText' :: PostText -> Text
$sel:sessionAttributes:PostText' :: PostText -> Maybe (Sensitive (HashMap Text Text))
$sel:requestAttributes:PostText' :: PostText -> Maybe (Sensitive (HashMap Text Text))
$sel:activeContexts:PostText' :: PostText -> Maybe (Sensitive [ActiveContext])
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"activeContexts" 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 (Sensitive [ActiveContext])
activeContexts,
            (Key
"requestAttributes" 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 (Sensitive (HashMap Text Text))
requestAttributes,
            (Key
"sessionAttributes" 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 (Sensitive (HashMap Text Text))
sessionAttributes,
            forall a. a -> Maybe a
Prelude.Just (Key
"inputText" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Sensitive Text
inputText)
          ]
      )

instance Data.ToPath PostText where
  toPath :: PostText -> ByteString
toPath PostText' {Maybe (Sensitive [ActiveContext])
Maybe (Sensitive (HashMap Text Text))
Text
Sensitive Text
inputText :: Sensitive Text
userId :: Text
botAlias :: Text
botName :: Text
sessionAttributes :: Maybe (Sensitive (HashMap Text Text))
requestAttributes :: Maybe (Sensitive (HashMap Text Text))
activeContexts :: Maybe (Sensitive [ActiveContext])
$sel:inputText:PostText' :: PostText -> Sensitive Text
$sel:userId:PostText' :: PostText -> Text
$sel:botAlias:PostText' :: PostText -> Text
$sel:botName:PostText' :: PostText -> Text
$sel:sessionAttributes:PostText' :: PostText -> Maybe (Sensitive (HashMap Text Text))
$sel:requestAttributes:PostText' :: PostText -> Maybe (Sensitive (HashMap Text Text))
$sel:activeContexts:PostText' :: PostText -> Maybe (Sensitive [ActiveContext])
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/bot/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
botName,
        ByteString
"/alias/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
botAlias,
        ByteString
"/user/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
userId,
        ByteString
"/text"
      ]

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

-- | /See:/ 'newPostTextResponse' smart constructor.
data PostTextResponse = PostTextResponse'
  { -- | A list of active contexts for the session. A context can be set when an
    -- intent is fulfilled or by calling the @PostContent@, @PostText@, or
    -- @PutSession@ operation.
    --
    -- You can use a context to control the intents that can follow up an
    -- intent, or to modify the operation of your application.
    PostTextResponse -> Maybe (Sensitive [ActiveContext])
activeContexts :: Prelude.Maybe (Data.Sensitive [ActiveContext]),
    -- | One to four alternative intents that may be applicable to the user\'s
    -- intent.
    --
    -- Each alternative includes a score that indicates how confident Amazon
    -- Lex is that the intent matches the user\'s intent. The intents are
    -- sorted by the confidence score.
    PostTextResponse -> Maybe [PredictedIntent]
alternativeIntents :: Prelude.Maybe [PredictedIntent],
    -- | The version of the bot that responded to the conversation. You can use
    -- this information to help determine if one version of a bot is performing
    -- better than another version.
    PostTextResponse -> Maybe Text
botVersion :: Prelude.Maybe Prelude.Text,
    -- | Identifies the current state of the user interaction. Amazon Lex returns
    -- one of the following values as @dialogState@. The client can optionally
    -- use this information to customize the user interface.
    --
    -- -   @ElicitIntent@ - Amazon Lex wants to elicit user intent.
    --
    --     For example, a user might utter an intent (\"I want to order a
    --     pizza\"). If Amazon Lex cannot infer the user intent from this
    --     utterance, it will return this dialogState.
    --
    -- -   @ConfirmIntent@ - Amazon Lex is expecting a \"yes\" or \"no\"
    --     response.
    --
    --     For example, Amazon Lex wants user confirmation before fulfilling an
    --     intent.
    --
    --     Instead of a simple \"yes\" or \"no,\" a user might respond with
    --     additional information. For example, \"yes, but make it thick crust
    --     pizza\" or \"no, I want to order a drink\". Amazon Lex can process
    --     such additional information (in these examples, update the crust
    --     type slot value, or change intent from OrderPizza to OrderDrink).
    --
    -- -   @ElicitSlot@ - Amazon Lex is expecting a slot value for the current
    --     intent.
    --
    --     For example, suppose that in the response Amazon Lex sends this
    --     message: \"What size pizza would you like?\". A user might reply
    --     with the slot value (e.g., \"medium\"). The user might also provide
    --     additional information in the response (e.g., \"medium thick crust
    --     pizza\"). Amazon Lex can process such additional information
    --     appropriately.
    --
    -- -   @Fulfilled@ - Conveys that the Lambda function configured for the
    --     intent has successfully fulfilled the intent.
    --
    -- -   @ReadyForFulfillment@ - Conveys that the client has to fulfill the
    --     intent.
    --
    -- -   @Failed@ - Conveys that the conversation with the user failed.
    --
    --     This can happen for various reasons including that the user did not
    --     provide an appropriate response to prompts from the service (you can
    --     configure how many times Amazon Lex can prompt a user for specific
    --     information), or the Lambda function failed to fulfill the intent.
    PostTextResponse -> Maybe DialogState
dialogState :: Prelude.Maybe DialogState,
    -- | The current user intent that Amazon Lex is aware of.
    PostTextResponse -> Maybe Text
intentName :: Prelude.Maybe Prelude.Text,
    -- | The message to convey to the user. The message can come from the bot\'s
    -- configuration or from a Lambda function.
    --
    -- If the intent is not configured with a Lambda function, or if the Lambda
    -- function returned @Delegate@ as the @dialogAction.type@ its response,
    -- Amazon Lex decides on the next course of action and selects an
    -- appropriate message from the bot\'s configuration based on the current
    -- interaction context. For example, if Amazon Lex isn\'t able to
    -- understand user input, it uses a clarification prompt message.
    --
    -- When you create an intent you can assign messages to groups. When
    -- messages are assigned to groups Amazon Lex returns one message from each
    -- group in the response. The message field is an escaped JSON string
    -- containing the messages. For more information about the structure of the
    -- JSON string returned, see msg-prompts-formats.
    --
    -- If the Lambda function returns a message, Amazon Lex passes it to the
    -- client in its response.
    PostTextResponse -> Maybe (Sensitive Text)
message :: Prelude.Maybe (Data.Sensitive Prelude.Text),
    -- | The format of the response message. One of the following values:
    --
    -- -   @PlainText@ - The message contains plain UTF-8 text.
    --
    -- -   @CustomPayload@ - The message is a custom format defined by the
    --     Lambda function.
    --
    -- -   @SSML@ - The message contains text formatted for voice output.
    --
    -- -   @Composite@ - The message contains an escaped JSON object containing
    --     one or more messages from the groups that messages were assigned to
    --     when the intent was created.
    PostTextResponse -> Maybe MessageFormatType
messageFormat :: Prelude.Maybe MessageFormatType,
    -- | Provides a score that indicates how confident Amazon Lex is that the
    -- returned intent is the one that matches the user\'s intent. The score is
    -- between 0.0 and 1.0. For more information, see
    -- <https://docs.aws.amazon.com/lex/latest/dg/confidence-scores.html Confidence Scores>.
    --
    -- The score is a relative score, not an absolute score. The score may
    -- change based on improvements to Amazon Lex.
    PostTextResponse -> Maybe IntentConfidence
nluIntentConfidence :: Prelude.Maybe IntentConfidence,
    -- | Represents the options that the user has to respond to the current
    -- prompt. Response Card can come from the bot configuration (in the Amazon
    -- Lex console, choose the settings button next to a slot) or from a code
    -- hook (Lambda function).
    PostTextResponse -> Maybe ResponseCard
responseCard :: Prelude.Maybe ResponseCard,
    -- | The sentiment expressed in and utterance.
    --
    -- When the bot is configured to send utterances to Amazon Comprehend for
    -- sentiment analysis, this field contains the result of the analysis.
    PostTextResponse -> Maybe SentimentResponse
sentimentResponse :: Prelude.Maybe SentimentResponse,
    -- | A map of key-value pairs representing the session-specific context
    -- information.
    PostTextResponse -> Maybe (Sensitive (HashMap Text Text))
sessionAttributes :: Prelude.Maybe (Data.Sensitive (Prelude.HashMap Prelude.Text Prelude.Text)),
    -- | A unique identifier for the session.
    PostTextResponse -> Maybe Text
sessionId :: Prelude.Maybe Prelude.Text,
    -- | If the @dialogState@ value is @ElicitSlot@, returns the name of the slot
    -- for which Amazon Lex is eliciting a value.
    PostTextResponse -> Maybe Text
slotToElicit :: Prelude.Maybe Prelude.Text,
    -- | The intent slots that Amazon Lex detected from the user input in the
    -- conversation.
    --
    -- Amazon Lex creates a resolution list containing likely values for a
    -- slot. The value that it returns is determined by the
    -- @valueSelectionStrategy@ selected when the slot type was created or
    -- updated. If @valueSelectionStrategy@ is set to @ORIGINAL_VALUE@, the
    -- value provided by the user is returned, if the user value is similar to
    -- the slot values. If @valueSelectionStrategy@ is set to @TOP_RESOLUTION@
    -- Amazon Lex returns the first value in the resolution list or, if there
    -- is no resolution list, null. If you don\'t specify a
    -- @valueSelectionStrategy@, the default is @ORIGINAL_VALUE@.
    PostTextResponse -> Maybe (Sensitive (HashMap Text Text))
slots :: Prelude.Maybe (Data.Sensitive (Prelude.HashMap Prelude.Text Prelude.Text)),
    -- | The response's http status code.
    PostTextResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (PostTextResponse -> PostTextResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostTextResponse -> PostTextResponse -> Bool
$c/= :: PostTextResponse -> PostTextResponse -> Bool
== :: PostTextResponse -> PostTextResponse -> Bool
$c== :: PostTextResponse -> PostTextResponse -> Bool
Prelude.Eq, Int -> PostTextResponse -> ShowS
[PostTextResponse] -> ShowS
PostTextResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PostTextResponse] -> ShowS
$cshowList :: [PostTextResponse] -> ShowS
show :: PostTextResponse -> String
$cshow :: PostTextResponse -> String
showsPrec :: Int -> PostTextResponse -> ShowS
$cshowsPrec :: Int -> PostTextResponse -> ShowS
Prelude.Show, forall x. Rep PostTextResponse x -> PostTextResponse
forall x. PostTextResponse -> Rep PostTextResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PostTextResponse x -> PostTextResponse
$cfrom :: forall x. PostTextResponse -> Rep PostTextResponse x
Prelude.Generic)

-- |
-- Create a value of 'PostTextResponse' 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:
--
-- 'activeContexts', 'postTextResponse_activeContexts' - A list of active contexts for the session. A context can be set when an
-- intent is fulfilled or by calling the @PostContent@, @PostText@, or
-- @PutSession@ operation.
--
-- You can use a context to control the intents that can follow up an
-- intent, or to modify the operation of your application.
--
-- 'alternativeIntents', 'postTextResponse_alternativeIntents' - One to four alternative intents that may be applicable to the user\'s
-- intent.
--
-- Each alternative includes a score that indicates how confident Amazon
-- Lex is that the intent matches the user\'s intent. The intents are
-- sorted by the confidence score.
--
-- 'botVersion', 'postTextResponse_botVersion' - The version of the bot that responded to the conversation. You can use
-- this information to help determine if one version of a bot is performing
-- better than another version.
--
-- 'dialogState', 'postTextResponse_dialogState' - Identifies the current state of the user interaction. Amazon Lex returns
-- one of the following values as @dialogState@. The client can optionally
-- use this information to customize the user interface.
--
-- -   @ElicitIntent@ - Amazon Lex wants to elicit user intent.
--
--     For example, a user might utter an intent (\"I want to order a
--     pizza\"). If Amazon Lex cannot infer the user intent from this
--     utterance, it will return this dialogState.
--
-- -   @ConfirmIntent@ - Amazon Lex is expecting a \"yes\" or \"no\"
--     response.
--
--     For example, Amazon Lex wants user confirmation before fulfilling an
--     intent.
--
--     Instead of a simple \"yes\" or \"no,\" a user might respond with
--     additional information. For example, \"yes, but make it thick crust
--     pizza\" or \"no, I want to order a drink\". Amazon Lex can process
--     such additional information (in these examples, update the crust
--     type slot value, or change intent from OrderPizza to OrderDrink).
--
-- -   @ElicitSlot@ - Amazon Lex is expecting a slot value for the current
--     intent.
--
--     For example, suppose that in the response Amazon Lex sends this
--     message: \"What size pizza would you like?\". A user might reply
--     with the slot value (e.g., \"medium\"). The user might also provide
--     additional information in the response (e.g., \"medium thick crust
--     pizza\"). Amazon Lex can process such additional information
--     appropriately.
--
-- -   @Fulfilled@ - Conveys that the Lambda function configured for the
--     intent has successfully fulfilled the intent.
--
-- -   @ReadyForFulfillment@ - Conveys that the client has to fulfill the
--     intent.
--
-- -   @Failed@ - Conveys that the conversation with the user failed.
--
--     This can happen for various reasons including that the user did not
--     provide an appropriate response to prompts from the service (you can
--     configure how many times Amazon Lex can prompt a user for specific
--     information), or the Lambda function failed to fulfill the intent.
--
-- 'intentName', 'postTextResponse_intentName' - The current user intent that Amazon Lex is aware of.
--
-- 'message', 'postTextResponse_message' - The message to convey to the user. The message can come from the bot\'s
-- configuration or from a Lambda function.
--
-- If the intent is not configured with a Lambda function, or if the Lambda
-- function returned @Delegate@ as the @dialogAction.type@ its response,
-- Amazon Lex decides on the next course of action and selects an
-- appropriate message from the bot\'s configuration based on the current
-- interaction context. For example, if Amazon Lex isn\'t able to
-- understand user input, it uses a clarification prompt message.
--
-- When you create an intent you can assign messages to groups. When
-- messages are assigned to groups Amazon Lex returns one message from each
-- group in the response. The message field is an escaped JSON string
-- containing the messages. For more information about the structure of the
-- JSON string returned, see msg-prompts-formats.
--
-- If the Lambda function returns a message, Amazon Lex passes it to the
-- client in its response.
--
-- 'messageFormat', 'postTextResponse_messageFormat' - The format of the response message. One of the following values:
--
-- -   @PlainText@ - The message contains plain UTF-8 text.
--
-- -   @CustomPayload@ - The message is a custom format defined by the
--     Lambda function.
--
-- -   @SSML@ - The message contains text formatted for voice output.
--
-- -   @Composite@ - The message contains an escaped JSON object containing
--     one or more messages from the groups that messages were assigned to
--     when the intent was created.
--
-- 'nluIntentConfidence', 'postTextResponse_nluIntentConfidence' - Provides a score that indicates how confident Amazon Lex is that the
-- returned intent is the one that matches the user\'s intent. The score is
-- between 0.0 and 1.0. For more information, see
-- <https://docs.aws.amazon.com/lex/latest/dg/confidence-scores.html Confidence Scores>.
--
-- The score is a relative score, not an absolute score. The score may
-- change based on improvements to Amazon Lex.
--
-- 'responseCard', 'postTextResponse_responseCard' - Represents the options that the user has to respond to the current
-- prompt. Response Card can come from the bot configuration (in the Amazon
-- Lex console, choose the settings button next to a slot) or from a code
-- hook (Lambda function).
--
-- 'sentimentResponse', 'postTextResponse_sentimentResponse' - The sentiment expressed in and utterance.
--
-- When the bot is configured to send utterances to Amazon Comprehend for
-- sentiment analysis, this field contains the result of the analysis.
--
-- 'sessionAttributes', 'postTextResponse_sessionAttributes' - A map of key-value pairs representing the session-specific context
-- information.
--
-- 'sessionId', 'postTextResponse_sessionId' - A unique identifier for the session.
--
-- 'slotToElicit', 'postTextResponse_slotToElicit' - If the @dialogState@ value is @ElicitSlot@, returns the name of the slot
-- for which Amazon Lex is eliciting a value.
--
-- 'slots', 'postTextResponse_slots' - The intent slots that Amazon Lex detected from the user input in the
-- conversation.
--
-- Amazon Lex creates a resolution list containing likely values for a
-- slot. The value that it returns is determined by the
-- @valueSelectionStrategy@ selected when the slot type was created or
-- updated. If @valueSelectionStrategy@ is set to @ORIGINAL_VALUE@, the
-- value provided by the user is returned, if the user value is similar to
-- the slot values. If @valueSelectionStrategy@ is set to @TOP_RESOLUTION@
-- Amazon Lex returns the first value in the resolution list or, if there
-- is no resolution list, null. If you don\'t specify a
-- @valueSelectionStrategy@, the default is @ORIGINAL_VALUE@.
--
-- 'httpStatus', 'postTextResponse_httpStatus' - The response's http status code.
newPostTextResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  PostTextResponse
newPostTextResponse :: Int -> PostTextResponse
newPostTextResponse Int
pHttpStatus_ =
  PostTextResponse'
    { $sel:activeContexts:PostTextResponse' :: Maybe (Sensitive [ActiveContext])
activeContexts = forall a. Maybe a
Prelude.Nothing,
      $sel:alternativeIntents:PostTextResponse' :: Maybe [PredictedIntent]
alternativeIntents = forall a. Maybe a
Prelude.Nothing,
      $sel:botVersion:PostTextResponse' :: Maybe Text
botVersion = forall a. Maybe a
Prelude.Nothing,
      $sel:dialogState:PostTextResponse' :: Maybe DialogState
dialogState = forall a. Maybe a
Prelude.Nothing,
      $sel:intentName:PostTextResponse' :: Maybe Text
intentName = forall a. Maybe a
Prelude.Nothing,
      $sel:message:PostTextResponse' :: Maybe (Sensitive Text)
message = forall a. Maybe a
Prelude.Nothing,
      $sel:messageFormat:PostTextResponse' :: Maybe MessageFormatType
messageFormat = forall a. Maybe a
Prelude.Nothing,
      $sel:nluIntentConfidence:PostTextResponse' :: Maybe IntentConfidence
nluIntentConfidence = forall a. Maybe a
Prelude.Nothing,
      $sel:responseCard:PostTextResponse' :: Maybe ResponseCard
responseCard = forall a. Maybe a
Prelude.Nothing,
      $sel:sentimentResponse:PostTextResponse' :: Maybe SentimentResponse
sentimentResponse = forall a. Maybe a
Prelude.Nothing,
      $sel:sessionAttributes:PostTextResponse' :: Maybe (Sensitive (HashMap Text Text))
sessionAttributes = forall a. Maybe a
Prelude.Nothing,
      $sel:sessionId:PostTextResponse' :: Maybe Text
sessionId = forall a. Maybe a
Prelude.Nothing,
      $sel:slotToElicit:PostTextResponse' :: Maybe Text
slotToElicit = forall a. Maybe a
Prelude.Nothing,
      $sel:slots:PostTextResponse' :: Maybe (Sensitive (HashMap Text Text))
slots = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:PostTextResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | A list of active contexts for the session. A context can be set when an
-- intent is fulfilled or by calling the @PostContent@, @PostText@, or
-- @PutSession@ operation.
--
-- You can use a context to control the intents that can follow up an
-- intent, or to modify the operation of your application.
postTextResponse_activeContexts :: Lens.Lens' PostTextResponse (Prelude.Maybe [ActiveContext])
postTextResponse_activeContexts :: Lens' PostTextResponse (Maybe [ActiveContext])
postTextResponse_activeContexts = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PostTextResponse' {Maybe (Sensitive [ActiveContext])
activeContexts :: Maybe (Sensitive [ActiveContext])
$sel:activeContexts:PostTextResponse' :: PostTextResponse -> Maybe (Sensitive [ActiveContext])
activeContexts} -> Maybe (Sensitive [ActiveContext])
activeContexts) (\s :: PostTextResponse
s@PostTextResponse' {} Maybe (Sensitive [ActiveContext])
a -> PostTextResponse
s {$sel:activeContexts:PostTextResponse' :: Maybe (Sensitive [ActiveContext])
activeContexts = Maybe (Sensitive [ActiveContext])
a} :: PostTextResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping (forall a. Iso' (Sensitive a) a
Data._Sensitive forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced)

-- | One to four alternative intents that may be applicable to the user\'s
-- intent.
--
-- Each alternative includes a score that indicates how confident Amazon
-- Lex is that the intent matches the user\'s intent. The intents are
-- sorted by the confidence score.
postTextResponse_alternativeIntents :: Lens.Lens' PostTextResponse (Prelude.Maybe [PredictedIntent])
postTextResponse_alternativeIntents :: Lens' PostTextResponse (Maybe [PredictedIntent])
postTextResponse_alternativeIntents = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PostTextResponse' {Maybe [PredictedIntent]
alternativeIntents :: Maybe [PredictedIntent]
$sel:alternativeIntents:PostTextResponse' :: PostTextResponse -> Maybe [PredictedIntent]
alternativeIntents} -> Maybe [PredictedIntent]
alternativeIntents) (\s :: PostTextResponse
s@PostTextResponse' {} Maybe [PredictedIntent]
a -> PostTextResponse
s {$sel:alternativeIntents:PostTextResponse' :: Maybe [PredictedIntent]
alternativeIntents = Maybe [PredictedIntent]
a} :: PostTextResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | The version of the bot that responded to the conversation. You can use
-- this information to help determine if one version of a bot is performing
-- better than another version.
postTextResponse_botVersion :: Lens.Lens' PostTextResponse (Prelude.Maybe Prelude.Text)
postTextResponse_botVersion :: Lens' PostTextResponse (Maybe Text)
postTextResponse_botVersion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PostTextResponse' {Maybe Text
botVersion :: Maybe Text
$sel:botVersion:PostTextResponse' :: PostTextResponse -> Maybe Text
botVersion} -> Maybe Text
botVersion) (\s :: PostTextResponse
s@PostTextResponse' {} Maybe Text
a -> PostTextResponse
s {$sel:botVersion:PostTextResponse' :: Maybe Text
botVersion = Maybe Text
a} :: PostTextResponse)

-- | Identifies the current state of the user interaction. Amazon Lex returns
-- one of the following values as @dialogState@. The client can optionally
-- use this information to customize the user interface.
--
-- -   @ElicitIntent@ - Amazon Lex wants to elicit user intent.
--
--     For example, a user might utter an intent (\"I want to order a
--     pizza\"). If Amazon Lex cannot infer the user intent from this
--     utterance, it will return this dialogState.
--
-- -   @ConfirmIntent@ - Amazon Lex is expecting a \"yes\" or \"no\"
--     response.
--
--     For example, Amazon Lex wants user confirmation before fulfilling an
--     intent.
--
--     Instead of a simple \"yes\" or \"no,\" a user might respond with
--     additional information. For example, \"yes, but make it thick crust
--     pizza\" or \"no, I want to order a drink\". Amazon Lex can process
--     such additional information (in these examples, update the crust
--     type slot value, or change intent from OrderPizza to OrderDrink).
--
-- -   @ElicitSlot@ - Amazon Lex is expecting a slot value for the current
--     intent.
--
--     For example, suppose that in the response Amazon Lex sends this
--     message: \"What size pizza would you like?\". A user might reply
--     with the slot value (e.g., \"medium\"). The user might also provide
--     additional information in the response (e.g., \"medium thick crust
--     pizza\"). Amazon Lex can process such additional information
--     appropriately.
--
-- -   @Fulfilled@ - Conveys that the Lambda function configured for the
--     intent has successfully fulfilled the intent.
--
-- -   @ReadyForFulfillment@ - Conveys that the client has to fulfill the
--     intent.
--
-- -   @Failed@ - Conveys that the conversation with the user failed.
--
--     This can happen for various reasons including that the user did not
--     provide an appropriate response to prompts from the service (you can
--     configure how many times Amazon Lex can prompt a user for specific
--     information), or the Lambda function failed to fulfill the intent.
postTextResponse_dialogState :: Lens.Lens' PostTextResponse (Prelude.Maybe DialogState)
postTextResponse_dialogState :: Lens' PostTextResponse (Maybe DialogState)
postTextResponse_dialogState = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PostTextResponse' {Maybe DialogState
dialogState :: Maybe DialogState
$sel:dialogState:PostTextResponse' :: PostTextResponse -> Maybe DialogState
dialogState} -> Maybe DialogState
dialogState) (\s :: PostTextResponse
s@PostTextResponse' {} Maybe DialogState
a -> PostTextResponse
s {$sel:dialogState:PostTextResponse' :: Maybe DialogState
dialogState = Maybe DialogState
a} :: PostTextResponse)

-- | The current user intent that Amazon Lex is aware of.
postTextResponse_intentName :: Lens.Lens' PostTextResponse (Prelude.Maybe Prelude.Text)
postTextResponse_intentName :: Lens' PostTextResponse (Maybe Text)
postTextResponse_intentName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PostTextResponse' {Maybe Text
intentName :: Maybe Text
$sel:intentName:PostTextResponse' :: PostTextResponse -> Maybe Text
intentName} -> Maybe Text
intentName) (\s :: PostTextResponse
s@PostTextResponse' {} Maybe Text
a -> PostTextResponse
s {$sel:intentName:PostTextResponse' :: Maybe Text
intentName = Maybe Text
a} :: PostTextResponse)

-- | The message to convey to the user. The message can come from the bot\'s
-- configuration or from a Lambda function.
--
-- If the intent is not configured with a Lambda function, or if the Lambda
-- function returned @Delegate@ as the @dialogAction.type@ its response,
-- Amazon Lex decides on the next course of action and selects an
-- appropriate message from the bot\'s configuration based on the current
-- interaction context. For example, if Amazon Lex isn\'t able to
-- understand user input, it uses a clarification prompt message.
--
-- When you create an intent you can assign messages to groups. When
-- messages are assigned to groups Amazon Lex returns one message from each
-- group in the response. The message field is an escaped JSON string
-- containing the messages. For more information about the structure of the
-- JSON string returned, see msg-prompts-formats.
--
-- If the Lambda function returns a message, Amazon Lex passes it to the
-- client in its response.
postTextResponse_message :: Lens.Lens' PostTextResponse (Prelude.Maybe Prelude.Text)
postTextResponse_message :: Lens' PostTextResponse (Maybe Text)
postTextResponse_message = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PostTextResponse' {Maybe (Sensitive Text)
message :: Maybe (Sensitive Text)
$sel:message:PostTextResponse' :: PostTextResponse -> Maybe (Sensitive Text)
message} -> Maybe (Sensitive Text)
message) (\s :: PostTextResponse
s@PostTextResponse' {} Maybe (Sensitive Text)
a -> PostTextResponse
s {$sel:message:PostTextResponse' :: Maybe (Sensitive Text)
message = Maybe (Sensitive Text)
a} :: PostTextResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall a. Iso' (Sensitive a) a
Data._Sensitive

-- | The format of the response message. One of the following values:
--
-- -   @PlainText@ - The message contains plain UTF-8 text.
--
-- -   @CustomPayload@ - The message is a custom format defined by the
--     Lambda function.
--
-- -   @SSML@ - The message contains text formatted for voice output.
--
-- -   @Composite@ - The message contains an escaped JSON object containing
--     one or more messages from the groups that messages were assigned to
--     when the intent was created.
postTextResponse_messageFormat :: Lens.Lens' PostTextResponse (Prelude.Maybe MessageFormatType)
postTextResponse_messageFormat :: Lens' PostTextResponse (Maybe MessageFormatType)
postTextResponse_messageFormat = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PostTextResponse' {Maybe MessageFormatType
messageFormat :: Maybe MessageFormatType
$sel:messageFormat:PostTextResponse' :: PostTextResponse -> Maybe MessageFormatType
messageFormat} -> Maybe MessageFormatType
messageFormat) (\s :: PostTextResponse
s@PostTextResponse' {} Maybe MessageFormatType
a -> PostTextResponse
s {$sel:messageFormat:PostTextResponse' :: Maybe MessageFormatType
messageFormat = Maybe MessageFormatType
a} :: PostTextResponse)

-- | Provides a score that indicates how confident Amazon Lex is that the
-- returned intent is the one that matches the user\'s intent. The score is
-- between 0.0 and 1.0. For more information, see
-- <https://docs.aws.amazon.com/lex/latest/dg/confidence-scores.html Confidence Scores>.
--
-- The score is a relative score, not an absolute score. The score may
-- change based on improvements to Amazon Lex.
postTextResponse_nluIntentConfidence :: Lens.Lens' PostTextResponse (Prelude.Maybe IntentConfidence)
postTextResponse_nluIntentConfidence :: Lens' PostTextResponse (Maybe IntentConfidence)
postTextResponse_nluIntentConfidence = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PostTextResponse' {Maybe IntentConfidence
nluIntentConfidence :: Maybe IntentConfidence
$sel:nluIntentConfidence:PostTextResponse' :: PostTextResponse -> Maybe IntentConfidence
nluIntentConfidence} -> Maybe IntentConfidence
nluIntentConfidence) (\s :: PostTextResponse
s@PostTextResponse' {} Maybe IntentConfidence
a -> PostTextResponse
s {$sel:nluIntentConfidence:PostTextResponse' :: Maybe IntentConfidence
nluIntentConfidence = Maybe IntentConfidence
a} :: PostTextResponse)

-- | Represents the options that the user has to respond to the current
-- prompt. Response Card can come from the bot configuration (in the Amazon
-- Lex console, choose the settings button next to a slot) or from a code
-- hook (Lambda function).
postTextResponse_responseCard :: Lens.Lens' PostTextResponse (Prelude.Maybe ResponseCard)
postTextResponse_responseCard :: Lens' PostTextResponse (Maybe ResponseCard)
postTextResponse_responseCard = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PostTextResponse' {Maybe ResponseCard
responseCard :: Maybe ResponseCard
$sel:responseCard:PostTextResponse' :: PostTextResponse -> Maybe ResponseCard
responseCard} -> Maybe ResponseCard
responseCard) (\s :: PostTextResponse
s@PostTextResponse' {} Maybe ResponseCard
a -> PostTextResponse
s {$sel:responseCard:PostTextResponse' :: Maybe ResponseCard
responseCard = Maybe ResponseCard
a} :: PostTextResponse)

-- | The sentiment expressed in and utterance.
--
-- When the bot is configured to send utterances to Amazon Comprehend for
-- sentiment analysis, this field contains the result of the analysis.
postTextResponse_sentimentResponse :: Lens.Lens' PostTextResponse (Prelude.Maybe SentimentResponse)
postTextResponse_sentimentResponse :: Lens' PostTextResponse (Maybe SentimentResponse)
postTextResponse_sentimentResponse = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PostTextResponse' {Maybe SentimentResponse
sentimentResponse :: Maybe SentimentResponse
$sel:sentimentResponse:PostTextResponse' :: PostTextResponse -> Maybe SentimentResponse
sentimentResponse} -> Maybe SentimentResponse
sentimentResponse) (\s :: PostTextResponse
s@PostTextResponse' {} Maybe SentimentResponse
a -> PostTextResponse
s {$sel:sentimentResponse:PostTextResponse' :: Maybe SentimentResponse
sentimentResponse = Maybe SentimentResponse
a} :: PostTextResponse)

-- | A map of key-value pairs representing the session-specific context
-- information.
postTextResponse_sessionAttributes :: Lens.Lens' PostTextResponse (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
postTextResponse_sessionAttributes :: Lens' PostTextResponse (Maybe (HashMap Text Text))
postTextResponse_sessionAttributes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PostTextResponse' {Maybe (Sensitive (HashMap Text Text))
sessionAttributes :: Maybe (Sensitive (HashMap Text Text))
$sel:sessionAttributes:PostTextResponse' :: PostTextResponse -> Maybe (Sensitive (HashMap Text Text))
sessionAttributes} -> Maybe (Sensitive (HashMap Text Text))
sessionAttributes) (\s :: PostTextResponse
s@PostTextResponse' {} Maybe (Sensitive (HashMap Text Text))
a -> PostTextResponse
s {$sel:sessionAttributes:PostTextResponse' :: Maybe (Sensitive (HashMap Text Text))
sessionAttributes = Maybe (Sensitive (HashMap Text Text))
a} :: PostTextResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping (forall a. Iso' (Sensitive a) a
Data._Sensitive forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced)

-- | A unique identifier for the session.
postTextResponse_sessionId :: Lens.Lens' PostTextResponse (Prelude.Maybe Prelude.Text)
postTextResponse_sessionId :: Lens' PostTextResponse (Maybe Text)
postTextResponse_sessionId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PostTextResponse' {Maybe Text
sessionId :: Maybe Text
$sel:sessionId:PostTextResponse' :: PostTextResponse -> Maybe Text
sessionId} -> Maybe Text
sessionId) (\s :: PostTextResponse
s@PostTextResponse' {} Maybe Text
a -> PostTextResponse
s {$sel:sessionId:PostTextResponse' :: Maybe Text
sessionId = Maybe Text
a} :: PostTextResponse)

-- | If the @dialogState@ value is @ElicitSlot@, returns the name of the slot
-- for which Amazon Lex is eliciting a value.
postTextResponse_slotToElicit :: Lens.Lens' PostTextResponse (Prelude.Maybe Prelude.Text)
postTextResponse_slotToElicit :: Lens' PostTextResponse (Maybe Text)
postTextResponse_slotToElicit = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PostTextResponse' {Maybe Text
slotToElicit :: Maybe Text
$sel:slotToElicit:PostTextResponse' :: PostTextResponse -> Maybe Text
slotToElicit} -> Maybe Text
slotToElicit) (\s :: PostTextResponse
s@PostTextResponse' {} Maybe Text
a -> PostTextResponse
s {$sel:slotToElicit:PostTextResponse' :: Maybe Text
slotToElicit = Maybe Text
a} :: PostTextResponse)

-- | The intent slots that Amazon Lex detected from the user input in the
-- conversation.
--
-- Amazon Lex creates a resolution list containing likely values for a
-- slot. The value that it returns is determined by the
-- @valueSelectionStrategy@ selected when the slot type was created or
-- updated. If @valueSelectionStrategy@ is set to @ORIGINAL_VALUE@, the
-- value provided by the user is returned, if the user value is similar to
-- the slot values. If @valueSelectionStrategy@ is set to @TOP_RESOLUTION@
-- Amazon Lex returns the first value in the resolution list or, if there
-- is no resolution list, null. If you don\'t specify a
-- @valueSelectionStrategy@, the default is @ORIGINAL_VALUE@.
postTextResponse_slots :: Lens.Lens' PostTextResponse (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
postTextResponse_slots :: Lens' PostTextResponse (Maybe (HashMap Text Text))
postTextResponse_slots = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PostTextResponse' {Maybe (Sensitive (HashMap Text Text))
slots :: Maybe (Sensitive (HashMap Text Text))
$sel:slots:PostTextResponse' :: PostTextResponse -> Maybe (Sensitive (HashMap Text Text))
slots} -> Maybe (Sensitive (HashMap Text Text))
slots) (\s :: PostTextResponse
s@PostTextResponse' {} Maybe (Sensitive (HashMap Text Text))
a -> PostTextResponse
s {$sel:slots:PostTextResponse' :: Maybe (Sensitive (HashMap Text Text))
slots = Maybe (Sensitive (HashMap Text Text))
a} :: PostTextResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping (forall a. Iso' (Sensitive a) a
Data._Sensitive forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced)

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

instance Prelude.NFData PostTextResponse where
  rnf :: PostTextResponse -> ()
rnf PostTextResponse' {Int
Maybe [PredictedIntent]
Maybe Text
Maybe (Sensitive [ActiveContext])
Maybe (Sensitive Text)
Maybe (Sensitive (HashMap Text Text))
Maybe DialogState
Maybe IntentConfidence
Maybe MessageFormatType
Maybe ResponseCard
Maybe SentimentResponse
httpStatus :: Int
slots :: Maybe (Sensitive (HashMap Text Text))
slotToElicit :: Maybe Text
sessionId :: Maybe Text
sessionAttributes :: Maybe (Sensitive (HashMap Text Text))
sentimentResponse :: Maybe SentimentResponse
responseCard :: Maybe ResponseCard
nluIntentConfidence :: Maybe IntentConfidence
messageFormat :: Maybe MessageFormatType
message :: Maybe (Sensitive Text)
intentName :: Maybe Text
dialogState :: Maybe DialogState
botVersion :: Maybe Text
alternativeIntents :: Maybe [PredictedIntent]
activeContexts :: Maybe (Sensitive [ActiveContext])
$sel:httpStatus:PostTextResponse' :: PostTextResponse -> Int
$sel:slots:PostTextResponse' :: PostTextResponse -> Maybe (Sensitive (HashMap Text Text))
$sel:slotToElicit:PostTextResponse' :: PostTextResponse -> Maybe Text
$sel:sessionId:PostTextResponse' :: PostTextResponse -> Maybe Text
$sel:sessionAttributes:PostTextResponse' :: PostTextResponse -> Maybe (Sensitive (HashMap Text Text))
$sel:sentimentResponse:PostTextResponse' :: PostTextResponse -> Maybe SentimentResponse
$sel:responseCard:PostTextResponse' :: PostTextResponse -> Maybe ResponseCard
$sel:nluIntentConfidence:PostTextResponse' :: PostTextResponse -> Maybe IntentConfidence
$sel:messageFormat:PostTextResponse' :: PostTextResponse -> Maybe MessageFormatType
$sel:message:PostTextResponse' :: PostTextResponse -> Maybe (Sensitive Text)
$sel:intentName:PostTextResponse' :: PostTextResponse -> Maybe Text
$sel:dialogState:PostTextResponse' :: PostTextResponse -> Maybe DialogState
$sel:botVersion:PostTextResponse' :: PostTextResponse -> Maybe Text
$sel:alternativeIntents:PostTextResponse' :: PostTextResponse -> Maybe [PredictedIntent]
$sel:activeContexts:PostTextResponse' :: PostTextResponse -> Maybe (Sensitive [ActiveContext])
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe (Sensitive [ActiveContext])
activeContexts
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [PredictedIntent]
alternativeIntents
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
botVersion
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe DialogState
dialogState
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
intentName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (Sensitive Text)
message
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe MessageFormatType
messageFormat
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe IntentConfidence
nluIntentConfidence
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ResponseCard
responseCard
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe SentimentResponse
sentimentResponse
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (Sensitive (HashMap Text Text))
sessionAttributes
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
sessionId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
slotToElicit
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (Sensitive (HashMap Text Text))
slots
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus