{-# 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.PostContent
-- 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 (text or speech) to Amazon Lex. Clients use this API to
-- send text and audio requests to Amazon Lex at runtime. Amazon Lex
-- interprets the user input using the machine learning model that it built
-- for the bot.
--
-- The @PostContent@ operation supports audio input at 8kHz and 16kHz. You
-- can use 8kHz audio to achieve higher speech recognition accuracy in
-- telephone audio applications.
--
-- In response, Amazon Lex returns the next message to convey to the user.
-- 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 get user confirmation:
--     \"Order the pizza?\".
--
-- -   After the user replies \"Yes\" to the confirmation prompt, Amazon
--     Lex might return a conclusion statement: \"Thank you, your cheese
--     pizza has been ordered.\".
--
-- Not all Amazon Lex messages require a response from the user. For
-- example, conclusion statements do not require a response. Some messages
-- require only a yes or no response. In addition to the @message@, Amazon
-- Lex provides additional context about the message in the response that
-- you can use to enhance client behavior, such as displaying the
-- appropriate client user interface. Consider the following examples:
--
-- -   If the message is to elicit slot data, Amazon Lex returns the
--     following context information:
--
--     -   @x-amz-lex-dialog-state@ header set to @ElicitSlot@
--
--     -   @x-amz-lex-intent-name@ header set to the intent name in the
--         current context
--
--     -   @x-amz-lex-slot-to-elicit@ header set to the slot name for which
--         the @message@ is eliciting information
--
--     -   @x-amz-lex-slots@ header set to a map of slots configured for
--         the intent with their current values
--
-- -   If the message is a confirmation prompt, the
--     @x-amz-lex-dialog-state@ header is set to @Confirmation@ and the
--     @x-amz-lex-slot-to-elicit@ header is omitted.
--
-- -   If the message is a clarification prompt configured for the intent,
--     indicating that the user intent is not understood, the
--     @x-amz-dialog-state@ header is set to @ElicitIntent@ and the
--     @x-amz-slot-to-elicit@ header is omitted.
--
-- 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.PostContent
  ( -- * Creating a Request
    PostContent (..),
    newPostContent,

    -- * Request Lenses
    postContent_accept,
    postContent_activeContexts,
    postContent_requestAttributes,
    postContent_sessionAttributes,
    postContent_botName,
    postContent_botAlias,
    postContent_userId,
    postContent_contentType,
    postContent_inputStream,

    -- * Destructuring the Response
    PostContentResponse (..),
    newPostContentResponse,

    -- * Response Lenses
    postContentResponse_activeContexts,
    postContentResponse_alternativeIntents,
    postContentResponse_botVersion,
    postContentResponse_contentType,
    postContentResponse_dialogState,
    postContentResponse_encodedInputTranscript,
    postContentResponse_encodedMessage,
    postContentResponse_inputTranscript,
    postContentResponse_intentName,
    postContentResponse_message,
    postContentResponse_messageFormat,
    postContentResponse_nluIntentConfidence,
    postContentResponse_sentimentResponse,
    postContentResponse_sessionAttributes,
    postContentResponse_sessionId,
    postContentResponse_slotToElicit,
    postContentResponse_slots,
    postContentResponse_httpStatus,
    postContentResponse_audioStream,
  )
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:/ 'newPostContent' smart constructor.
data PostContent = PostContent'
  { -- | You pass this value as the @Accept@ HTTP header.
    --
    -- The message Amazon Lex returns in the response can be either text or
    -- speech based on the @Accept@ HTTP header value in the request.
    --
    -- -   If the value is @text\/plain; charset=utf-8@, Amazon Lex returns
    --     text in the response.
    --
    -- -   If the value begins with @audio\/@, Amazon Lex returns speech in the
    --     response. Amazon Lex uses Amazon Polly to generate the speech (using
    --     the configuration you specified in the @Accept@ header). For
    --     example, if you specify @audio\/mpeg@ as the value, Amazon Lex
    --     returns speech in the MPEG format.
    --
    -- -   If the value is @audio\/pcm@, the speech returned is @audio\/pcm@ in
    --     16-bit, little endian format.
    --
    -- -   The following are the accepted values:
    --
    --     -   audio\/mpeg
    --
    --     -   audio\/ogg
    --
    --     -   audio\/pcm
    --
    --     -   text\/plain; charset=utf-8
    --
    --     -   audio\/* (defaults to mpeg)
    PostContent -> Maybe Text
accept :: Prelude.Maybe Prelude.Text,
    -- | 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.
    PostContent -> Maybe (Sensitive Text)
activeContexts :: Prelude.Maybe (Data.Sensitive Prelude.Text),
    -- | You pass this value as the @x-amz-lex-request-attributes@ HTTP header.
    --
    -- Request-specific information passed between Amazon Lex and a client
    -- application. The value must be a JSON serialized and base64 encoded map
    -- with string keys and values. The total size of the @requestAttributes@
    -- and @sessionAttributes@ headers is limited to 12 KB.
    --
    -- 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>.
    PostContent -> Maybe (Sensitive Text)
requestAttributes :: Prelude.Maybe (Data.Sensitive Prelude.Text),
    -- | You pass this value as the @x-amz-lex-session-attributes@ HTTP header.
    --
    -- Application-specific information passed between Amazon Lex and a client
    -- application. The value must be a JSON serialized and base64 encoded map
    -- with string keys and values. The total size of the @sessionAttributes@
    -- and @requestAttributes@ headers is limited to 12 KB.
    --
    -- For more information, see
    -- <https://docs.aws.amazon.com/lex/latest/dg/context-mgmt.html#context-mgmt-session-attribs Setting Session Attributes>.
    PostContent -> Maybe (Sensitive Text)
sessionAttributes :: Prelude.Maybe (Data.Sensitive Prelude.Text),
    -- | Name of the Amazon Lex bot.
    PostContent -> Text
botName :: Prelude.Text,
    -- | Alias of the Amazon Lex bot.
    PostContent -> 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.
    PostContent -> Text
userId :: Prelude.Text,
    -- | You pass this value as the @Content-Type@ HTTP header.
    --
    -- Indicates the audio format or text. The header value must start with one
    -- of the following prefixes:
    --
    -- -   PCM format, audio data must be in little-endian byte order.
    --
    --     -   audio\/l16; rate=16000; channels=1
    --
    --     -   audio\/x-l16; sample-rate=16000; channel-count=1
    --
    --     -   audio\/lpcm; sample-rate=8000; sample-size-bits=16;
    --         channel-count=1; is-big-endian=false
    --
    -- -   Opus format
    --
    --     -   audio\/x-cbr-opus-with-preamble; preamble-size=0;
    --         bit-rate=256000; frame-size-milliseconds=4
    --
    -- -   Text format
    --
    --     -   text\/plain; charset=utf-8
    PostContent -> Text
contentType :: Prelude.Text,
    -- | User input in PCM or Opus audio format or text format as described in
    -- the @Content-Type@ HTTP header.
    --
    -- You can stream audio data to Amazon Lex or you can create a local buffer
    -- that captures all of the audio data before sending. In general, you get
    -- better performance if you stream audio data rather than buffering the
    -- data locally.
    PostContent -> HashedBody
inputStream :: Data.HashedBody
  }
  deriving (Int -> PostContent -> ShowS
[PostContent] -> ShowS
PostContent -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PostContent] -> ShowS
$cshowList :: [PostContent] -> ShowS
show :: PostContent -> String
$cshow :: PostContent -> String
showsPrec :: Int -> PostContent -> ShowS
$cshowsPrec :: Int -> PostContent -> ShowS
Prelude.Show, forall x. Rep PostContent x -> PostContent
forall x. PostContent -> Rep PostContent x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PostContent x -> PostContent
$cfrom :: forall x. PostContent -> Rep PostContent x
Prelude.Generic)

-- |
-- Create a value of 'PostContent' 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:
--
-- 'accept', 'postContent_accept' - You pass this value as the @Accept@ HTTP header.
--
-- The message Amazon Lex returns in the response can be either text or
-- speech based on the @Accept@ HTTP header value in the request.
--
-- -   If the value is @text\/plain; charset=utf-8@, Amazon Lex returns
--     text in the response.
--
-- -   If the value begins with @audio\/@, Amazon Lex returns speech in the
--     response. Amazon Lex uses Amazon Polly to generate the speech (using
--     the configuration you specified in the @Accept@ header). For
--     example, if you specify @audio\/mpeg@ as the value, Amazon Lex
--     returns speech in the MPEG format.
--
-- -   If the value is @audio\/pcm@, the speech returned is @audio\/pcm@ in
--     16-bit, little endian format.
--
-- -   The following are the accepted values:
--
--     -   audio\/mpeg
--
--     -   audio\/ogg
--
--     -   audio\/pcm
--
--     -   text\/plain; charset=utf-8
--
--     -   audio\/* (defaults to mpeg)
--
-- 'activeContexts', 'postContent_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', 'postContent_requestAttributes' - You pass this value as the @x-amz-lex-request-attributes@ HTTP header.
--
-- Request-specific information passed between Amazon Lex and a client
-- application. The value must be a JSON serialized and base64 encoded map
-- with string keys and values. The total size of the @requestAttributes@
-- and @sessionAttributes@ headers is limited to 12 KB.
--
-- 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', 'postContent_sessionAttributes' - You pass this value as the @x-amz-lex-session-attributes@ HTTP header.
--
-- Application-specific information passed between Amazon Lex and a client
-- application. The value must be a JSON serialized and base64 encoded map
-- with string keys and values. The total size of the @sessionAttributes@
-- and @requestAttributes@ headers is limited to 12 KB.
--
-- For more information, see
-- <https://docs.aws.amazon.com/lex/latest/dg/context-mgmt.html#context-mgmt-session-attribs Setting Session Attributes>.
--
-- 'botName', 'postContent_botName' - Name of the Amazon Lex bot.
--
-- 'botAlias', 'postContent_botAlias' - Alias of the Amazon Lex bot.
--
-- 'userId', 'postContent_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.
--
-- 'contentType', 'postContent_contentType' - You pass this value as the @Content-Type@ HTTP header.
--
-- Indicates the audio format or text. The header value must start with one
-- of the following prefixes:
--
-- -   PCM format, audio data must be in little-endian byte order.
--
--     -   audio\/l16; rate=16000; channels=1
--
--     -   audio\/x-l16; sample-rate=16000; channel-count=1
--
--     -   audio\/lpcm; sample-rate=8000; sample-size-bits=16;
--         channel-count=1; is-big-endian=false
--
-- -   Opus format
--
--     -   audio\/x-cbr-opus-with-preamble; preamble-size=0;
--         bit-rate=256000; frame-size-milliseconds=4
--
-- -   Text format
--
--     -   text\/plain; charset=utf-8
--
-- 'inputStream', 'postContent_inputStream' - User input in PCM or Opus audio format or text format as described in
-- the @Content-Type@ HTTP header.
--
-- You can stream audio data to Amazon Lex or you can create a local buffer
-- that captures all of the audio data before sending. In general, you get
-- better performance if you stream audio data rather than buffering the
-- data locally.
newPostContent ::
  -- | 'botName'
  Prelude.Text ->
  -- | 'botAlias'
  Prelude.Text ->
  -- | 'userId'
  Prelude.Text ->
  -- | 'contentType'
  Prelude.Text ->
  -- | 'inputStream'
  Data.HashedBody ->
  PostContent
newPostContent :: Text -> Text -> Text -> Text -> HashedBody -> PostContent
newPostContent
  Text
pBotName_
  Text
pBotAlias_
  Text
pUserId_
  Text
pContentType_
  HashedBody
pInputStream_ =
    PostContent'
      { $sel:accept:PostContent' :: Maybe Text
accept = forall a. Maybe a
Prelude.Nothing,
        $sel:activeContexts:PostContent' :: Maybe (Sensitive Text)
activeContexts = forall a. Maybe a
Prelude.Nothing,
        $sel:requestAttributes:PostContent' :: Maybe (Sensitive Text)
requestAttributes = forall a. Maybe a
Prelude.Nothing,
        $sel:sessionAttributes:PostContent' :: Maybe (Sensitive Text)
sessionAttributes = forall a. Maybe a
Prelude.Nothing,
        $sel:botName:PostContent' :: Text
botName = Text
pBotName_,
        $sel:botAlias:PostContent' :: Text
botAlias = Text
pBotAlias_,
        $sel:userId:PostContent' :: Text
userId = Text
pUserId_,
        $sel:contentType:PostContent' :: Text
contentType = Text
pContentType_,
        $sel:inputStream:PostContent' :: HashedBody
inputStream = HashedBody
pInputStream_
      }

-- | You pass this value as the @Accept@ HTTP header.
--
-- The message Amazon Lex returns in the response can be either text or
-- speech based on the @Accept@ HTTP header value in the request.
--
-- -   If the value is @text\/plain; charset=utf-8@, Amazon Lex returns
--     text in the response.
--
-- -   If the value begins with @audio\/@, Amazon Lex returns speech in the
--     response. Amazon Lex uses Amazon Polly to generate the speech (using
--     the configuration you specified in the @Accept@ header). For
--     example, if you specify @audio\/mpeg@ as the value, Amazon Lex
--     returns speech in the MPEG format.
--
-- -   If the value is @audio\/pcm@, the speech returned is @audio\/pcm@ in
--     16-bit, little endian format.
--
-- -   The following are the accepted values:
--
--     -   audio\/mpeg
--
--     -   audio\/ogg
--
--     -   audio\/pcm
--
--     -   text\/plain; charset=utf-8
--
--     -   audio\/* (defaults to mpeg)
postContent_accept :: Lens.Lens' PostContent (Prelude.Maybe Prelude.Text)
postContent_accept :: Lens' PostContent (Maybe Text)
postContent_accept = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PostContent' {Maybe Text
accept :: Maybe Text
$sel:accept:PostContent' :: PostContent -> Maybe Text
accept} -> Maybe Text
accept) (\s :: PostContent
s@PostContent' {} Maybe Text
a -> PostContent
s {$sel:accept:PostContent' :: Maybe Text
accept = Maybe Text
a} :: PostContent)

-- | 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.
postContent_activeContexts :: Lens.Lens' PostContent (Prelude.Maybe Prelude.Text)
postContent_activeContexts :: Lens' PostContent (Maybe Text)
postContent_activeContexts = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PostContent' {Maybe (Sensitive Text)
activeContexts :: Maybe (Sensitive Text)
$sel:activeContexts:PostContent' :: PostContent -> Maybe (Sensitive Text)
activeContexts} -> Maybe (Sensitive Text)
activeContexts) (\s :: PostContent
s@PostContent' {} Maybe (Sensitive Text)
a -> PostContent
s {$sel:activeContexts:PostContent' :: Maybe (Sensitive Text)
activeContexts = Maybe (Sensitive Text)
a} :: PostContent) 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

-- | You pass this value as the @x-amz-lex-request-attributes@ HTTP header.
--
-- Request-specific information passed between Amazon Lex and a client
-- application. The value must be a JSON serialized and base64 encoded map
-- with string keys and values. The total size of the @requestAttributes@
-- and @sessionAttributes@ headers is limited to 12 KB.
--
-- 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>.
postContent_requestAttributes :: Lens.Lens' PostContent (Prelude.Maybe Prelude.Text)
postContent_requestAttributes :: Lens' PostContent (Maybe Text)
postContent_requestAttributes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PostContent' {Maybe (Sensitive Text)
requestAttributes :: Maybe (Sensitive Text)
$sel:requestAttributes:PostContent' :: PostContent -> Maybe (Sensitive Text)
requestAttributes} -> Maybe (Sensitive Text)
requestAttributes) (\s :: PostContent
s@PostContent' {} Maybe (Sensitive Text)
a -> PostContent
s {$sel:requestAttributes:PostContent' :: Maybe (Sensitive Text)
requestAttributes = Maybe (Sensitive Text)
a} :: PostContent) 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

-- | You pass this value as the @x-amz-lex-session-attributes@ HTTP header.
--
-- Application-specific information passed between Amazon Lex and a client
-- application. The value must be a JSON serialized and base64 encoded map
-- with string keys and values. The total size of the @sessionAttributes@
-- and @requestAttributes@ headers is limited to 12 KB.
--
-- For more information, see
-- <https://docs.aws.amazon.com/lex/latest/dg/context-mgmt.html#context-mgmt-session-attribs Setting Session Attributes>.
postContent_sessionAttributes :: Lens.Lens' PostContent (Prelude.Maybe Prelude.Text)
postContent_sessionAttributes :: Lens' PostContent (Maybe Text)
postContent_sessionAttributes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PostContent' {Maybe (Sensitive Text)
sessionAttributes :: Maybe (Sensitive Text)
$sel:sessionAttributes:PostContent' :: PostContent -> Maybe (Sensitive Text)
sessionAttributes} -> Maybe (Sensitive Text)
sessionAttributes) (\s :: PostContent
s@PostContent' {} Maybe (Sensitive Text)
a -> PostContent
s {$sel:sessionAttributes:PostContent' :: Maybe (Sensitive Text)
sessionAttributes = Maybe (Sensitive Text)
a} :: PostContent) 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

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

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

-- | 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.
postContent_userId :: Lens.Lens' PostContent Prelude.Text
postContent_userId :: Lens' PostContent Text
postContent_userId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PostContent' {Text
userId :: Text
$sel:userId:PostContent' :: PostContent -> Text
userId} -> Text
userId) (\s :: PostContent
s@PostContent' {} Text
a -> PostContent
s {$sel:userId:PostContent' :: Text
userId = Text
a} :: PostContent)

-- | You pass this value as the @Content-Type@ HTTP header.
--
-- Indicates the audio format or text. The header value must start with one
-- of the following prefixes:
--
-- -   PCM format, audio data must be in little-endian byte order.
--
--     -   audio\/l16; rate=16000; channels=1
--
--     -   audio\/x-l16; sample-rate=16000; channel-count=1
--
--     -   audio\/lpcm; sample-rate=8000; sample-size-bits=16;
--         channel-count=1; is-big-endian=false
--
-- -   Opus format
--
--     -   audio\/x-cbr-opus-with-preamble; preamble-size=0;
--         bit-rate=256000; frame-size-milliseconds=4
--
-- -   Text format
--
--     -   text\/plain; charset=utf-8
postContent_contentType :: Lens.Lens' PostContent Prelude.Text
postContent_contentType :: Lens' PostContent Text
postContent_contentType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PostContent' {Text
contentType :: Text
$sel:contentType:PostContent' :: PostContent -> Text
contentType} -> Text
contentType) (\s :: PostContent
s@PostContent' {} Text
a -> PostContent
s {$sel:contentType:PostContent' :: Text
contentType = Text
a} :: PostContent)

-- | User input in PCM or Opus audio format or text format as described in
-- the @Content-Type@ HTTP header.
--
-- You can stream audio data to Amazon Lex or you can create a local buffer
-- that captures all of the audio data before sending. In general, you get
-- better performance if you stream audio data rather than buffering the
-- data locally.
postContent_inputStream :: Lens.Lens' PostContent Data.HashedBody
postContent_inputStream :: Lens' PostContent HashedBody
postContent_inputStream = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PostContent' {HashedBody
inputStream :: HashedBody
$sel:inputStream:PostContent' :: PostContent -> HashedBody
inputStream} -> HashedBody
inputStream) (\s :: PostContent
s@PostContent' {} HashedBody
a -> PostContent
s {$sel:inputStream:PostContent' :: HashedBody
inputStream = HashedBody
a} :: PostContent)

instance Core.AWSRequest PostContent where
  type AWSResponse PostContent = PostContentResponse
  request :: (Service -> Service) -> PostContent -> Request PostContent
request Service -> Service
overrides =
    forall a. (ToRequest a, ToBody a) => Service -> a -> Request a
Request.postBody (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy PostContent
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse PostContent)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int
 -> ResponseHeaders
 -> ResponseBody
 -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveBody
      ( \Int
s ResponseHeaders
h ResponseBody
x ->
          Maybe (Sensitive Text)
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe DialogState
-> Maybe (Sensitive Text)
-> Maybe (Sensitive Text)
-> Maybe Text
-> Maybe Text
-> Maybe (Sensitive Text)
-> Maybe MessageFormatType
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Int
-> ResponseBody
-> PostContentResponse
PostContentResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (ResponseHeaders
h forall a.
FromText a =>
ResponseHeaders -> HeaderName -> Either String (Maybe a)
Data..#? HeaderName
"x-amz-lex-active-contexts")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (ResponseHeaders
h forall a.
FromText a =>
ResponseHeaders -> HeaderName -> Either String (Maybe a)
Data..#? HeaderName
"x-amz-lex-alternative-intents")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (ResponseHeaders
h forall a.
FromText a =>
ResponseHeaders -> HeaderName -> Either String (Maybe a)
Data..#? HeaderName
"x-amz-lex-bot-version")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (ResponseHeaders
h forall a.
FromText a =>
ResponseHeaders -> HeaderName -> Either String (Maybe a)
Data..#? HeaderName
"Content-Type")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (ResponseHeaders
h forall a.
FromText a =>
ResponseHeaders -> HeaderName -> Either String (Maybe a)
Data..#? HeaderName
"x-amz-lex-dialog-state")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (ResponseHeaders
h forall a.
FromText a =>
ResponseHeaders -> HeaderName -> Either String (Maybe a)
Data..#? HeaderName
"x-amz-lex-encoded-input-transcript")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (ResponseHeaders
h forall a.
FromText a =>
ResponseHeaders -> HeaderName -> Either String (Maybe a)
Data..#? HeaderName
"x-amz-lex-encoded-message")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (ResponseHeaders
h forall a.
FromText a =>
ResponseHeaders -> HeaderName -> Either String (Maybe a)
Data..#? HeaderName
"x-amz-lex-input-transcript")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (ResponseHeaders
h forall a.
FromText a =>
ResponseHeaders -> HeaderName -> Either String (Maybe a)
Data..#? HeaderName
"x-amz-lex-intent-name")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (ResponseHeaders
h forall a.
FromText a =>
ResponseHeaders -> HeaderName -> Either String (Maybe a)
Data..#? HeaderName
"x-amz-lex-message")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (ResponseHeaders
h forall a.
FromText a =>
ResponseHeaders -> HeaderName -> Either String (Maybe a)
Data..#? HeaderName
"x-amz-lex-message-format")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (ResponseHeaders
h forall a.
FromText a =>
ResponseHeaders -> HeaderName -> Either String (Maybe a)
Data..#? HeaderName
"x-amz-lex-nlu-intent-confidence")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (ResponseHeaders
h forall a.
FromText a =>
ResponseHeaders -> HeaderName -> Either String (Maybe a)
Data..#? HeaderName
"x-amz-lex-sentiment")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (ResponseHeaders
h forall a.
FromText a =>
ResponseHeaders -> HeaderName -> Either String (Maybe a)
Data..#? HeaderName
"x-amz-lex-session-attributes")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (ResponseHeaders
h forall a.
FromText a =>
ResponseHeaders -> HeaderName -> Either String (Maybe a)
Data..#? HeaderName
"x-amz-lex-session-id")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (ResponseHeaders
h forall a.
FromText a =>
ResponseHeaders -> HeaderName -> Either String (Maybe a)
Data..#? HeaderName
"x-amz-lex-slot-to-elicit")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (ResponseHeaders
h forall a.
FromText a =>
ResponseHeaders -> HeaderName -> Either String (Maybe a)
Data..#? HeaderName
"x-amz-lex-slots")
            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))
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure ResponseBody
x)
      )

instance Data.ToBody PostContent where
  toBody :: PostContent -> RequestBody
toBody PostContent' {Maybe Text
Maybe (Sensitive Text)
Text
HashedBody
inputStream :: HashedBody
contentType :: Text
userId :: Text
botAlias :: Text
botName :: Text
sessionAttributes :: Maybe (Sensitive Text)
requestAttributes :: Maybe (Sensitive Text)
activeContexts :: Maybe (Sensitive Text)
accept :: Maybe Text
$sel:inputStream:PostContent' :: PostContent -> HashedBody
$sel:contentType:PostContent' :: PostContent -> Text
$sel:userId:PostContent' :: PostContent -> Text
$sel:botAlias:PostContent' :: PostContent -> Text
$sel:botName:PostContent' :: PostContent -> Text
$sel:sessionAttributes:PostContent' :: PostContent -> Maybe (Sensitive Text)
$sel:requestAttributes:PostContent' :: PostContent -> Maybe (Sensitive Text)
$sel:activeContexts:PostContent' :: PostContent -> Maybe (Sensitive Text)
$sel:accept:PostContent' :: PostContent -> Maybe Text
..} = forall a. ToBody a => a -> RequestBody
Data.toBody HashedBody
inputStream

instance Data.ToHeaders PostContent where
  toHeaders :: PostContent -> ResponseHeaders
toHeaders PostContent' {Maybe Text
Maybe (Sensitive Text)
Text
HashedBody
inputStream :: HashedBody
contentType :: Text
userId :: Text
botAlias :: Text
botName :: Text
sessionAttributes :: Maybe (Sensitive Text)
requestAttributes :: Maybe (Sensitive Text)
activeContexts :: Maybe (Sensitive Text)
accept :: Maybe Text
$sel:inputStream:PostContent' :: PostContent -> HashedBody
$sel:contentType:PostContent' :: PostContent -> Text
$sel:userId:PostContent' :: PostContent -> Text
$sel:botAlias:PostContent' :: PostContent -> Text
$sel:botName:PostContent' :: PostContent -> Text
$sel:sessionAttributes:PostContent' :: PostContent -> Maybe (Sensitive Text)
$sel:requestAttributes:PostContent' :: PostContent -> Maybe (Sensitive Text)
$sel:activeContexts:PostContent' :: PostContent -> Maybe (Sensitive Text)
$sel:accept:PostContent' :: PostContent -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ HeaderName
"Accept" forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# Maybe Text
accept,
        HeaderName
"x-amz-lex-active-contexts" forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# Maybe (Sensitive Text)
activeContexts,
        HeaderName
"x-amz-lex-request-attributes"
          forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# Maybe (Sensitive Text)
requestAttributes,
        HeaderName
"x-amz-lex-session-attributes"
          forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# Maybe (Sensitive Text)
sessionAttributes,
        HeaderName
"Content-Type" forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# Text
contentType
      ]

instance Data.ToPath PostContent where
  toPath :: PostContent -> ByteString
toPath PostContent' {Maybe Text
Maybe (Sensitive Text)
Text
HashedBody
inputStream :: HashedBody
contentType :: Text
userId :: Text
botAlias :: Text
botName :: Text
sessionAttributes :: Maybe (Sensitive Text)
requestAttributes :: Maybe (Sensitive Text)
activeContexts :: Maybe (Sensitive Text)
accept :: Maybe Text
$sel:inputStream:PostContent' :: PostContent -> HashedBody
$sel:contentType:PostContent' :: PostContent -> Text
$sel:userId:PostContent' :: PostContent -> Text
$sel:botAlias:PostContent' :: PostContent -> Text
$sel:botName:PostContent' :: PostContent -> Text
$sel:sessionAttributes:PostContent' :: PostContent -> Maybe (Sensitive Text)
$sel:requestAttributes:PostContent' :: PostContent -> Maybe (Sensitive Text)
$sel:activeContexts:PostContent' :: PostContent -> Maybe (Sensitive Text)
$sel:accept:PostContent' :: PostContent -> Maybe Text
..} =
    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
"/content"
      ]

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

-- | /See:/ 'newPostContentResponse' smart constructor.
data PostContentResponse = PostContentResponse'
  { -- | 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.
    PostContentResponse -> Maybe (Sensitive Text)
activeContexts :: Prelude.Maybe (Data.Sensitive Prelude.Text),
    -- | 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.
    PostContentResponse -> Maybe Text
alternativeIntents :: Prelude.Maybe Prelude.Text,
    -- | 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.
    PostContentResponse -> Maybe Text
botVersion :: Prelude.Maybe Prelude.Text,
    -- | Content type as specified in the @Accept@ HTTP header in the request.
    PostContentResponse -> Maybe Text
contentType :: 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 the user\'s intent.
    --     Consider the following examples:
    --
    --     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 dialog state.
    --
    -- -   @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\" response, a user might
    --     respond with additional information. For example, \"yes, but make it
    --     a 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 or change the intent from OrderPizza to
    --     OrderDrink).
    --
    -- -   @ElicitSlot@ - Amazon Lex is expecting the value of a slot 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 has successfully
    --     fulfilled the intent.
    --
    -- -   @ReadyForFulfillment@ - Conveys that the client has to fulfill the
    --     request.
    --
    -- -   @Failed@ - Conveys that the conversation with the user failed.
    --
    --     This can happen for various reasons, including that the user does
    --     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 if the Lambda function fails to fulfill
    --     the intent.
    PostContentResponse -> Maybe DialogState
dialogState :: Prelude.Maybe DialogState,
    -- | The text used to process the request.
    --
    -- If the input was an audio stream, the @encodedInputTranscript@ field
    -- contains the text extracted from the audio stream. This is the text that
    -- is actually processed to recognize intents and slot values. You can use
    -- this information to determine if Amazon Lex is correctly processing the
    -- audio that you send.
    --
    -- The @encodedInputTranscript@ field is base-64 encoded. You must decode
    -- the field before you can use the value.
    PostContentResponse -> Maybe (Sensitive Text)
encodedInputTranscript :: Prelude.Maybe (Data.Sensitive 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@ in 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.
    --
    -- The @encodedMessage@ field is base-64 encoded. You must decode the field
    -- before you can use the value.
    PostContentResponse -> Maybe (Sensitive Text)
encodedMessage :: Prelude.Maybe (Data.Sensitive Prelude.Text),
    -- | The text used to process the request.
    --
    -- You can use this field only in the de-DE, en-AU, en-GB, en-US, es-419,
    -- es-ES, es-US, fr-CA, fr-FR, and it-IT locales. In all other locales, the
    -- @inputTranscript@ field is null. You should use the
    -- @encodedInputTranscript@ field instead.
    --
    -- If the input was an audio stream, the @inputTranscript@ field contains
    -- the text extracted from the audio stream. This is the text that is
    -- actually processed to recognize intents and slot values. You can use
    -- this information to determine if Amazon Lex is correctly processing the
    -- audio that you send.
    PostContentResponse -> Maybe Text
inputTranscript :: Prelude.Maybe Prelude.Text,
    -- | Current user intent that Amazon Lex is aware of.
    PostContentResponse -> Maybe Text
intentName :: Prelude.Maybe Prelude.Text,
    -- | You can only use this field in the de-DE, en-AU, en-GB, en-US, es-419,
    -- es-ES, es-US, fr-CA, fr-FR, and it-IT locales. In all other locales, the
    -- @message@ field is null. You should use the @encodedMessage@ field
    -- instead.
    --
    -- 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@ in 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.
    PostContentResponse -> 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 for the client.
    --
    -- -   @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.
    PostContentResponse -> 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.
    --
    -- The score is a relative score, not an absolute score. The score may
    -- change based on improvements to Amazon Lex.
    PostContentResponse -> Maybe Text
nluIntentConfidence :: Prelude.Maybe Prelude.Text,
    -- | The sentiment expressed in an utterance.
    --
    -- When the bot is configured to send utterances to Amazon Comprehend for
    -- sentiment analysis, this field contains the result of the analysis.
    PostContentResponse -> Maybe Text
sentimentResponse :: Prelude.Maybe Prelude.Text,
    -- | Map of key\/value pairs representing the session-specific context
    -- information.
    PostContentResponse -> Maybe Text
sessionAttributes :: Prelude.Maybe Prelude.Text,
    -- | The unique identifier for the session.
    PostContentResponse -> 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.
    PostContentResponse -> Maybe Text
slotToElicit :: Prelude.Maybe Prelude.Text,
    -- | Map of zero or more intent slots (name\/value pairs) Amazon Lex detected
    -- from the user input during the conversation. The field is base-64
    -- encoded.
    --
    -- 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@.
    PostContentResponse -> Maybe Text
slots :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    PostContentResponse -> Int
httpStatus :: Prelude.Int,
    -- | The prompt (or statement) to convey to the user. This is based on the
    -- bot configuration and context. For example, if Amazon Lex did not
    -- understand the user intent, it sends the @clarificationPrompt@
    -- configured for the bot. If the intent requires confirmation before
    -- taking the fulfillment action, it sends the @confirmationPrompt@.
    -- Another example: Suppose that the Lambda function successfully fulfilled
    -- the intent, and sent a message to convey to the user. Then Amazon Lex
    -- sends that message in the response.
    PostContentResponse -> ResponseBody
audioStream :: Data.ResponseBody
  }
  deriving (Int -> PostContentResponse -> ShowS
[PostContentResponse] -> ShowS
PostContentResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PostContentResponse] -> ShowS
$cshowList :: [PostContentResponse] -> ShowS
show :: PostContentResponse -> String
$cshow :: PostContentResponse -> String
showsPrec :: Int -> PostContentResponse -> ShowS
$cshowsPrec :: Int -> PostContentResponse -> ShowS
Prelude.Show, forall x. Rep PostContentResponse x -> PostContentResponse
forall x. PostContentResponse -> Rep PostContentResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PostContentResponse x -> PostContentResponse
$cfrom :: forall x. PostContentResponse -> Rep PostContentResponse x
Prelude.Generic)

-- |
-- Create a value of 'PostContentResponse' 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', 'postContentResponse_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', 'postContentResponse_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', 'postContentResponse_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.
--
-- 'contentType', 'postContentResponse_contentType' - Content type as specified in the @Accept@ HTTP header in the request.
--
-- 'dialogState', 'postContentResponse_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 the user\'s intent.
--     Consider the following examples:
--
--     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 dialog state.
--
-- -   @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\" response, a user might
--     respond with additional information. For example, \"yes, but make it
--     a 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 or change the intent from OrderPizza to
--     OrderDrink).
--
-- -   @ElicitSlot@ - Amazon Lex is expecting the value of a slot 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 has successfully
--     fulfilled the intent.
--
-- -   @ReadyForFulfillment@ - Conveys that the client has to fulfill the
--     request.
--
-- -   @Failed@ - Conveys that the conversation with the user failed.
--
--     This can happen for various reasons, including that the user does
--     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 if the Lambda function fails to fulfill
--     the intent.
--
-- 'encodedInputTranscript', 'postContentResponse_encodedInputTranscript' - The text used to process the request.
--
-- If the input was an audio stream, the @encodedInputTranscript@ field
-- contains the text extracted from the audio stream. This is the text that
-- is actually processed to recognize intents and slot values. You can use
-- this information to determine if Amazon Lex is correctly processing the
-- audio that you send.
--
-- The @encodedInputTranscript@ field is base-64 encoded. You must decode
-- the field before you can use the value.
--
-- 'encodedMessage', 'postContentResponse_encodedMessage' - 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@ in 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.
--
-- The @encodedMessage@ field is base-64 encoded. You must decode the field
-- before you can use the value.
--
-- 'inputTranscript', 'postContentResponse_inputTranscript' - The text used to process the request.
--
-- You can use this field only in the de-DE, en-AU, en-GB, en-US, es-419,
-- es-ES, es-US, fr-CA, fr-FR, and it-IT locales. In all other locales, the
-- @inputTranscript@ field is null. You should use the
-- @encodedInputTranscript@ field instead.
--
-- If the input was an audio stream, the @inputTranscript@ field contains
-- the text extracted from the audio stream. This is the text that is
-- actually processed to recognize intents and slot values. You can use
-- this information to determine if Amazon Lex is correctly processing the
-- audio that you send.
--
-- 'intentName', 'postContentResponse_intentName' - Current user intent that Amazon Lex is aware of.
--
-- 'message', 'postContentResponse_message' - You can only use this field in the de-DE, en-AU, en-GB, en-US, es-419,
-- es-ES, es-US, fr-CA, fr-FR, and it-IT locales. In all other locales, the
-- @message@ field is null. You should use the @encodedMessage@ field
-- instead.
--
-- 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@ in 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', 'postContentResponse_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 for the client.
--
-- -   @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', 'postContentResponse_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.
--
-- The score is a relative score, not an absolute score. The score may
-- change based on improvements to Amazon Lex.
--
-- 'sentimentResponse', 'postContentResponse_sentimentResponse' - The sentiment expressed in an utterance.
--
-- When the bot is configured to send utterances to Amazon Comprehend for
-- sentiment analysis, this field contains the result of the analysis.
--
-- 'sessionAttributes', 'postContentResponse_sessionAttributes' - Map of key\/value pairs representing the session-specific context
-- information.
--
-- 'sessionId', 'postContentResponse_sessionId' - The unique identifier for the session.
--
-- 'slotToElicit', 'postContentResponse_slotToElicit' - If the @dialogState@ value is @ElicitSlot@, returns the name of the slot
-- for which Amazon Lex is eliciting a value.
--
-- 'slots', 'postContentResponse_slots' - Map of zero or more intent slots (name\/value pairs) Amazon Lex detected
-- from the user input during the conversation. The field is base-64
-- encoded.
--
-- 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', 'postContentResponse_httpStatus' - The response's http status code.
--
-- 'audioStream', 'postContentResponse_audioStream' - The prompt (or statement) to convey to the user. This is based on the
-- bot configuration and context. For example, if Amazon Lex did not
-- understand the user intent, it sends the @clarificationPrompt@
-- configured for the bot. If the intent requires confirmation before
-- taking the fulfillment action, it sends the @confirmationPrompt@.
-- Another example: Suppose that the Lambda function successfully fulfilled
-- the intent, and sent a message to convey to the user. Then Amazon Lex
-- sends that message in the response.
newPostContentResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'audioStream'
  Data.ResponseBody ->
  PostContentResponse
newPostContentResponse :: Int -> ResponseBody -> PostContentResponse
newPostContentResponse Int
pHttpStatus_ ResponseBody
pAudioStream_ =
  PostContentResponse'
    { $sel:activeContexts:PostContentResponse' :: Maybe (Sensitive Text)
activeContexts =
        forall a. Maybe a
Prelude.Nothing,
      $sel:alternativeIntents:PostContentResponse' :: Maybe Text
alternativeIntents = forall a. Maybe a
Prelude.Nothing,
      $sel:botVersion:PostContentResponse' :: Maybe Text
botVersion = forall a. Maybe a
Prelude.Nothing,
      $sel:contentType:PostContentResponse' :: Maybe Text
contentType = forall a. Maybe a
Prelude.Nothing,
      $sel:dialogState:PostContentResponse' :: Maybe DialogState
dialogState = forall a. Maybe a
Prelude.Nothing,
      $sel:encodedInputTranscript:PostContentResponse' :: Maybe (Sensitive Text)
encodedInputTranscript = forall a. Maybe a
Prelude.Nothing,
      $sel:encodedMessage:PostContentResponse' :: Maybe (Sensitive Text)
encodedMessage = forall a. Maybe a
Prelude.Nothing,
      $sel:inputTranscript:PostContentResponse' :: Maybe Text
inputTranscript = forall a. Maybe a
Prelude.Nothing,
      $sel:intentName:PostContentResponse' :: Maybe Text
intentName = forall a. Maybe a
Prelude.Nothing,
      $sel:message:PostContentResponse' :: Maybe (Sensitive Text)
message = forall a. Maybe a
Prelude.Nothing,
      $sel:messageFormat:PostContentResponse' :: Maybe MessageFormatType
messageFormat = forall a. Maybe a
Prelude.Nothing,
      $sel:nluIntentConfidence:PostContentResponse' :: Maybe Text
nluIntentConfidence = forall a. Maybe a
Prelude.Nothing,
      $sel:sentimentResponse:PostContentResponse' :: Maybe Text
sentimentResponse = forall a. Maybe a
Prelude.Nothing,
      $sel:sessionAttributes:PostContentResponse' :: Maybe Text
sessionAttributes = forall a. Maybe a
Prelude.Nothing,
      $sel:sessionId:PostContentResponse' :: Maybe Text
sessionId = forall a. Maybe a
Prelude.Nothing,
      $sel:slotToElicit:PostContentResponse' :: Maybe Text
slotToElicit = forall a. Maybe a
Prelude.Nothing,
      $sel:slots:PostContentResponse' :: Maybe Text
slots = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:PostContentResponse' :: Int
httpStatus = Int
pHttpStatus_,
      $sel:audioStream:PostContentResponse' :: ResponseBody
audioStream = ResponseBody
pAudioStream_
    }

-- | 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.
postContentResponse_activeContexts :: Lens.Lens' PostContentResponse (Prelude.Maybe Prelude.Text)
postContentResponse_activeContexts :: Lens' PostContentResponse (Maybe Text)
postContentResponse_activeContexts = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PostContentResponse' {Maybe (Sensitive Text)
activeContexts :: Maybe (Sensitive Text)
$sel:activeContexts:PostContentResponse' :: PostContentResponse -> Maybe (Sensitive Text)
activeContexts} -> Maybe (Sensitive Text)
activeContexts) (\s :: PostContentResponse
s@PostContentResponse' {} Maybe (Sensitive Text)
a -> PostContentResponse
s {$sel:activeContexts:PostContentResponse' :: Maybe (Sensitive Text)
activeContexts = Maybe (Sensitive Text)
a} :: PostContentResponse) 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

-- | 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.
postContentResponse_alternativeIntents :: Lens.Lens' PostContentResponse (Prelude.Maybe Prelude.Text)
postContentResponse_alternativeIntents :: Lens' PostContentResponse (Maybe Text)
postContentResponse_alternativeIntents = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PostContentResponse' {Maybe Text
alternativeIntents :: Maybe Text
$sel:alternativeIntents:PostContentResponse' :: PostContentResponse -> Maybe Text
alternativeIntents} -> Maybe Text
alternativeIntents) (\s :: PostContentResponse
s@PostContentResponse' {} Maybe Text
a -> PostContentResponse
s {$sel:alternativeIntents:PostContentResponse' :: Maybe Text
alternativeIntents = Maybe Text
a} :: PostContentResponse)

-- | 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.
postContentResponse_botVersion :: Lens.Lens' PostContentResponse (Prelude.Maybe Prelude.Text)
postContentResponse_botVersion :: Lens' PostContentResponse (Maybe Text)
postContentResponse_botVersion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PostContentResponse' {Maybe Text
botVersion :: Maybe Text
$sel:botVersion:PostContentResponse' :: PostContentResponse -> Maybe Text
botVersion} -> Maybe Text
botVersion) (\s :: PostContentResponse
s@PostContentResponse' {} Maybe Text
a -> PostContentResponse
s {$sel:botVersion:PostContentResponse' :: Maybe Text
botVersion = Maybe Text
a} :: PostContentResponse)

-- | Content type as specified in the @Accept@ HTTP header in the request.
postContentResponse_contentType :: Lens.Lens' PostContentResponse (Prelude.Maybe Prelude.Text)
postContentResponse_contentType :: Lens' PostContentResponse (Maybe Text)
postContentResponse_contentType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PostContentResponse' {Maybe Text
contentType :: Maybe Text
$sel:contentType:PostContentResponse' :: PostContentResponse -> Maybe Text
contentType} -> Maybe Text
contentType) (\s :: PostContentResponse
s@PostContentResponse' {} Maybe Text
a -> PostContentResponse
s {$sel:contentType:PostContentResponse' :: Maybe Text
contentType = Maybe Text
a} :: PostContentResponse)

-- | 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 the user\'s intent.
--     Consider the following examples:
--
--     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 dialog state.
--
-- -   @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\" response, a user might
--     respond with additional information. For example, \"yes, but make it
--     a 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 or change the intent from OrderPizza to
--     OrderDrink).
--
-- -   @ElicitSlot@ - Amazon Lex is expecting the value of a slot 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 has successfully
--     fulfilled the intent.
--
-- -   @ReadyForFulfillment@ - Conveys that the client has to fulfill the
--     request.
--
-- -   @Failed@ - Conveys that the conversation with the user failed.
--
--     This can happen for various reasons, including that the user does
--     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 if the Lambda function fails to fulfill
--     the intent.
postContentResponse_dialogState :: Lens.Lens' PostContentResponse (Prelude.Maybe DialogState)
postContentResponse_dialogState :: Lens' PostContentResponse (Maybe DialogState)
postContentResponse_dialogState = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PostContentResponse' {Maybe DialogState
dialogState :: Maybe DialogState
$sel:dialogState:PostContentResponse' :: PostContentResponse -> Maybe DialogState
dialogState} -> Maybe DialogState
dialogState) (\s :: PostContentResponse
s@PostContentResponse' {} Maybe DialogState
a -> PostContentResponse
s {$sel:dialogState:PostContentResponse' :: Maybe DialogState
dialogState = Maybe DialogState
a} :: PostContentResponse)

-- | The text used to process the request.
--
-- If the input was an audio stream, the @encodedInputTranscript@ field
-- contains the text extracted from the audio stream. This is the text that
-- is actually processed to recognize intents and slot values. You can use
-- this information to determine if Amazon Lex is correctly processing the
-- audio that you send.
--
-- The @encodedInputTranscript@ field is base-64 encoded. You must decode
-- the field before you can use the value.
postContentResponse_encodedInputTranscript :: Lens.Lens' PostContentResponse (Prelude.Maybe Prelude.Text)
postContentResponse_encodedInputTranscript :: Lens' PostContentResponse (Maybe Text)
postContentResponse_encodedInputTranscript = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PostContentResponse' {Maybe (Sensitive Text)
encodedInputTranscript :: Maybe (Sensitive Text)
$sel:encodedInputTranscript:PostContentResponse' :: PostContentResponse -> Maybe (Sensitive Text)
encodedInputTranscript} -> Maybe (Sensitive Text)
encodedInputTranscript) (\s :: PostContentResponse
s@PostContentResponse' {} Maybe (Sensitive Text)
a -> PostContentResponse
s {$sel:encodedInputTranscript:PostContentResponse' :: Maybe (Sensitive Text)
encodedInputTranscript = Maybe (Sensitive Text)
a} :: PostContentResponse) 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 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@ in 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.
--
-- The @encodedMessage@ field is base-64 encoded. You must decode the field
-- before you can use the value.
postContentResponse_encodedMessage :: Lens.Lens' PostContentResponse (Prelude.Maybe Prelude.Text)
postContentResponse_encodedMessage :: Lens' PostContentResponse (Maybe Text)
postContentResponse_encodedMessage = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PostContentResponse' {Maybe (Sensitive Text)
encodedMessage :: Maybe (Sensitive Text)
$sel:encodedMessage:PostContentResponse' :: PostContentResponse -> Maybe (Sensitive Text)
encodedMessage} -> Maybe (Sensitive Text)
encodedMessage) (\s :: PostContentResponse
s@PostContentResponse' {} Maybe (Sensitive Text)
a -> PostContentResponse
s {$sel:encodedMessage:PostContentResponse' :: Maybe (Sensitive Text)
encodedMessage = Maybe (Sensitive Text)
a} :: PostContentResponse) 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 text used to process the request.
--
-- You can use this field only in the de-DE, en-AU, en-GB, en-US, es-419,
-- es-ES, es-US, fr-CA, fr-FR, and it-IT locales. In all other locales, the
-- @inputTranscript@ field is null. You should use the
-- @encodedInputTranscript@ field instead.
--
-- If the input was an audio stream, the @inputTranscript@ field contains
-- the text extracted from the audio stream. This is the text that is
-- actually processed to recognize intents and slot values. You can use
-- this information to determine if Amazon Lex is correctly processing the
-- audio that you send.
postContentResponse_inputTranscript :: Lens.Lens' PostContentResponse (Prelude.Maybe Prelude.Text)
postContentResponse_inputTranscript :: Lens' PostContentResponse (Maybe Text)
postContentResponse_inputTranscript = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PostContentResponse' {Maybe Text
inputTranscript :: Maybe Text
$sel:inputTranscript:PostContentResponse' :: PostContentResponse -> Maybe Text
inputTranscript} -> Maybe Text
inputTranscript) (\s :: PostContentResponse
s@PostContentResponse' {} Maybe Text
a -> PostContentResponse
s {$sel:inputTranscript:PostContentResponse' :: Maybe Text
inputTranscript = Maybe Text
a} :: PostContentResponse)

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

-- | You can only use this field in the de-DE, en-AU, en-GB, en-US, es-419,
-- es-ES, es-US, fr-CA, fr-FR, and it-IT locales. In all other locales, the
-- @message@ field is null. You should use the @encodedMessage@ field
-- instead.
--
-- 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@ in 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.
postContentResponse_message :: Lens.Lens' PostContentResponse (Prelude.Maybe Prelude.Text)
postContentResponse_message :: Lens' PostContentResponse (Maybe Text)
postContentResponse_message = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PostContentResponse' {Maybe (Sensitive Text)
message :: Maybe (Sensitive Text)
$sel:message:PostContentResponse' :: PostContentResponse -> Maybe (Sensitive Text)
message} -> Maybe (Sensitive Text)
message) (\s :: PostContentResponse
s@PostContentResponse' {} Maybe (Sensitive Text)
a -> PostContentResponse
s {$sel:message:PostContentResponse' :: Maybe (Sensitive Text)
message = Maybe (Sensitive Text)
a} :: PostContentResponse) 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 for the client.
--
-- -   @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.
postContentResponse_messageFormat :: Lens.Lens' PostContentResponse (Prelude.Maybe MessageFormatType)
postContentResponse_messageFormat :: Lens' PostContentResponse (Maybe MessageFormatType)
postContentResponse_messageFormat = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PostContentResponse' {Maybe MessageFormatType
messageFormat :: Maybe MessageFormatType
$sel:messageFormat:PostContentResponse' :: PostContentResponse -> Maybe MessageFormatType
messageFormat} -> Maybe MessageFormatType
messageFormat) (\s :: PostContentResponse
s@PostContentResponse' {} Maybe MessageFormatType
a -> PostContentResponse
s {$sel:messageFormat:PostContentResponse' :: Maybe MessageFormatType
messageFormat = Maybe MessageFormatType
a} :: PostContentResponse)

-- | 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.
--
-- The score is a relative score, not an absolute score. The score may
-- change based on improvements to Amazon Lex.
postContentResponse_nluIntentConfidence :: Lens.Lens' PostContentResponse (Prelude.Maybe Prelude.Text)
postContentResponse_nluIntentConfidence :: Lens' PostContentResponse (Maybe Text)
postContentResponse_nluIntentConfidence = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PostContentResponse' {Maybe Text
nluIntentConfidence :: Maybe Text
$sel:nluIntentConfidence:PostContentResponse' :: PostContentResponse -> Maybe Text
nluIntentConfidence} -> Maybe Text
nluIntentConfidence) (\s :: PostContentResponse
s@PostContentResponse' {} Maybe Text
a -> PostContentResponse
s {$sel:nluIntentConfidence:PostContentResponse' :: Maybe Text
nluIntentConfidence = Maybe Text
a} :: PostContentResponse)

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

-- | Map of key\/value pairs representing the session-specific context
-- information.
postContentResponse_sessionAttributes :: Lens.Lens' PostContentResponse (Prelude.Maybe Prelude.Text)
postContentResponse_sessionAttributes :: Lens' PostContentResponse (Maybe Text)
postContentResponse_sessionAttributes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PostContentResponse' {Maybe Text
sessionAttributes :: Maybe Text
$sel:sessionAttributes:PostContentResponse' :: PostContentResponse -> Maybe Text
sessionAttributes} -> Maybe Text
sessionAttributes) (\s :: PostContentResponse
s@PostContentResponse' {} Maybe Text
a -> PostContentResponse
s {$sel:sessionAttributes:PostContentResponse' :: Maybe Text
sessionAttributes = Maybe Text
a} :: PostContentResponse)

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

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

-- | Map of zero or more intent slots (name\/value pairs) Amazon Lex detected
-- from the user input during the conversation. The field is base-64
-- encoded.
--
-- 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@.
postContentResponse_slots :: Lens.Lens' PostContentResponse (Prelude.Maybe Prelude.Text)
postContentResponse_slots :: Lens' PostContentResponse (Maybe Text)
postContentResponse_slots = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PostContentResponse' {Maybe Text
slots :: Maybe Text
$sel:slots:PostContentResponse' :: PostContentResponse -> Maybe Text
slots} -> Maybe Text
slots) (\s :: PostContentResponse
s@PostContentResponse' {} Maybe Text
a -> PostContentResponse
s {$sel:slots:PostContentResponse' :: Maybe Text
slots = Maybe Text
a} :: PostContentResponse)

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

-- | The prompt (or statement) to convey to the user. This is based on the
-- bot configuration and context. For example, if Amazon Lex did not
-- understand the user intent, it sends the @clarificationPrompt@
-- configured for the bot. If the intent requires confirmation before
-- taking the fulfillment action, it sends the @confirmationPrompt@.
-- Another example: Suppose that the Lambda function successfully fulfilled
-- the intent, and sent a message to convey to the user. Then Amazon Lex
-- sends that message in the response.
postContentResponse_audioStream :: Lens.Lens' PostContentResponse Data.ResponseBody
postContentResponse_audioStream :: Lens' PostContentResponse ResponseBody
postContentResponse_audioStream = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PostContentResponse' {ResponseBody
audioStream :: ResponseBody
$sel:audioStream:PostContentResponse' :: PostContentResponse -> ResponseBody
audioStream} -> ResponseBody
audioStream) (\s :: PostContentResponse
s@PostContentResponse' {} ResponseBody
a -> PostContentResponse
s {$sel:audioStream:PostContentResponse' :: ResponseBody
audioStream = ResponseBody
a} :: PostContentResponse)