{-# 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.PutSession
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Creates a new session or modifies an existing session with an Amazon Lex
-- bot. Use this operation to enable your application to set the state of
-- the bot.
--
-- For more information, see
-- <https://docs.aws.amazon.com/lex/latest/dg/how-session-api.html Managing Sessions>.
module Amazonka.LexRuntime.PutSession
  ( -- * Creating a Request
    PutSession (..),
    newPutSession,

    -- * Request Lenses
    putSession_accept,
    putSession_activeContexts,
    putSession_dialogAction,
    putSession_recentIntentSummaryView,
    putSession_sessionAttributes,
    putSession_botName,
    putSession_botAlias,
    putSession_userId,

    -- * Destructuring the Response
    PutSessionResponse (..),
    newPutSessionResponse,

    -- * Response Lenses
    putSessionResponse_activeContexts,
    putSessionResponse_contentType,
    putSessionResponse_dialogState,
    putSessionResponse_encodedMessage,
    putSessionResponse_intentName,
    putSessionResponse_message,
    putSessionResponse_messageFormat,
    putSessionResponse_sessionAttributes,
    putSessionResponse_sessionId,
    putSessionResponse_slotToElicit,
    putSessionResponse_slots,
    putSessionResponse_httpStatus,
    putSessionResponse_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:/ 'newPutSession' smart constructor.
data PutSession = PutSession'
  { -- | The message that Amazon Lex returns in the response can be either text
    -- or speech based depending on the value of this field.
    --
    -- -   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 in the
    --     configuration that you specify. 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 is returned as @audio\/pcm@
    --     in 16-bit, little endian format.
    --
    -- -   The following are the accepted values:
    --
    --     -   @audio\/mpeg@
    --
    --     -   @audio\/ogg@
    --
    --     -   @audio\/pcm@
    --
    --     -   @audio\/*@ (defaults to mpeg)
    --
    --     -   @text\/plain; charset=utf-8@
    PutSession -> 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.
    PutSession -> Maybe (Sensitive [ActiveContext])
activeContexts :: Prelude.Maybe (Data.Sensitive [ActiveContext]),
    -- | Sets the next action that the bot should take to fulfill the
    -- conversation.
    PutSession -> Maybe DialogAction
dialogAction :: Prelude.Maybe DialogAction,
    -- | A summary of the recent intents for the bot. You can use the intent
    -- summary view to set a checkpoint label on an intent and modify
    -- attributes of intents. You can also use it to remove or add intent
    -- summary objects to the list.
    --
    -- An intent that you modify or add to the list must make sense for the
    -- bot. For example, the intent name must be valid for the bot. You must
    -- provide valid values for:
    --
    -- -   @intentName@
    --
    -- -   slot names
    --
    -- -   @slotToElict@
    --
    -- If you send the @recentIntentSummaryView@ parameter in a @PutSession@
    -- request, the contents of the new summary view replaces the old summary
    -- view. For example, if a @GetSession@ request returns three intents in
    -- the summary view and you call @PutSession@ with one intent in the
    -- summary view, the next call to @GetSession@ will only return one intent.
    PutSession -> Maybe [IntentSummary]
recentIntentSummaryView :: Prelude.Maybe [IntentSummary],
    -- | Map of key\/value pairs representing the session-specific context
    -- information. It contains application information passed between Amazon
    -- Lex and a client application.
    PutSession -> Maybe (Sensitive (HashMap Text Text))
sessionAttributes :: Prelude.Maybe (Data.Sensitive (Prelude.HashMap Prelude.Text Prelude.Text)),
    -- | The name of the bot that contains the session data.
    PutSession -> Text
botName :: Prelude.Text,
    -- | The alias in use for the bot that contains the session data.
    PutSession -> Text
botAlias :: Prelude.Text,
    -- | The ID of the client application user. Amazon Lex uses this to identify
    -- a user\'s conversation with your bot.
    PutSession -> Text
userId :: Prelude.Text
  }
  deriving (PutSession -> PutSession -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PutSession -> PutSession -> Bool
$c/= :: PutSession -> PutSession -> Bool
== :: PutSession -> PutSession -> Bool
$c== :: PutSession -> PutSession -> Bool
Prelude.Eq, Int -> PutSession -> ShowS
[PutSession] -> ShowS
PutSession -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PutSession] -> ShowS
$cshowList :: [PutSession] -> ShowS
show :: PutSession -> String
$cshow :: PutSession -> String
showsPrec :: Int -> PutSession -> ShowS
$cshowsPrec :: Int -> PutSession -> ShowS
Prelude.Show, forall x. Rep PutSession x -> PutSession
forall x. PutSession -> Rep PutSession x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PutSession x -> PutSession
$cfrom :: forall x. PutSession -> Rep PutSession x
Prelude.Generic)

-- |
-- Create a value of 'PutSession' 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', 'putSession_accept' - The message that Amazon Lex returns in the response can be either text
-- or speech based depending on the value of this field.
--
-- -   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 in the
--     configuration that you specify. 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 is returned as @audio\/pcm@
--     in 16-bit, little endian format.
--
-- -   The following are the accepted values:
--
--     -   @audio\/mpeg@
--
--     -   @audio\/ogg@
--
--     -   @audio\/pcm@
--
--     -   @audio\/*@ (defaults to mpeg)
--
--     -   @text\/plain; charset=utf-8@
--
-- 'activeContexts', 'putSession_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.
--
-- 'dialogAction', 'putSession_dialogAction' - Sets the next action that the bot should take to fulfill the
-- conversation.
--
-- 'recentIntentSummaryView', 'putSession_recentIntentSummaryView' - A summary of the recent intents for the bot. You can use the intent
-- summary view to set a checkpoint label on an intent and modify
-- attributes of intents. You can also use it to remove or add intent
-- summary objects to the list.
--
-- An intent that you modify or add to the list must make sense for the
-- bot. For example, the intent name must be valid for the bot. You must
-- provide valid values for:
--
-- -   @intentName@
--
-- -   slot names
--
-- -   @slotToElict@
--
-- If you send the @recentIntentSummaryView@ parameter in a @PutSession@
-- request, the contents of the new summary view replaces the old summary
-- view. For example, if a @GetSession@ request returns three intents in
-- the summary view and you call @PutSession@ with one intent in the
-- summary view, the next call to @GetSession@ will only return one intent.
--
-- 'sessionAttributes', 'putSession_sessionAttributes' - Map of key\/value pairs representing the session-specific context
-- information. It contains application information passed between Amazon
-- Lex and a client application.
--
-- 'botName', 'putSession_botName' - The name of the bot that contains the session data.
--
-- 'botAlias', 'putSession_botAlias' - The alias in use for the bot that contains the session data.
--
-- 'userId', 'putSession_userId' - The ID of the client application user. Amazon Lex uses this to identify
-- a user\'s conversation with your bot.
newPutSession ::
  -- | 'botName'
  Prelude.Text ->
  -- | 'botAlias'
  Prelude.Text ->
  -- | 'userId'
  Prelude.Text ->
  PutSession
newPutSession :: Text -> Text -> Text -> PutSession
newPutSession Text
pBotName_ Text
pBotAlias_ Text
pUserId_ =
  PutSession'
    { $sel:accept:PutSession' :: Maybe Text
accept = forall a. Maybe a
Prelude.Nothing,
      $sel:activeContexts:PutSession' :: Maybe (Sensitive [ActiveContext])
activeContexts = forall a. Maybe a
Prelude.Nothing,
      $sel:dialogAction:PutSession' :: Maybe DialogAction
dialogAction = forall a. Maybe a
Prelude.Nothing,
      $sel:recentIntentSummaryView:PutSession' :: Maybe [IntentSummary]
recentIntentSummaryView = forall a. Maybe a
Prelude.Nothing,
      $sel:sessionAttributes:PutSession' :: Maybe (Sensitive (HashMap Text Text))
sessionAttributes = forall a. Maybe a
Prelude.Nothing,
      $sel:botName:PutSession' :: Text
botName = Text
pBotName_,
      $sel:botAlias:PutSession' :: Text
botAlias = Text
pBotAlias_,
      $sel:userId:PutSession' :: Text
userId = Text
pUserId_
    }

-- | The message that Amazon Lex returns in the response can be either text
-- or speech based depending on the value of this field.
--
-- -   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 in the
--     configuration that you specify. 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 is returned as @audio\/pcm@
--     in 16-bit, little endian format.
--
-- -   The following are the accepted values:
--
--     -   @audio\/mpeg@
--
--     -   @audio\/ogg@
--
--     -   @audio\/pcm@
--
--     -   @audio\/*@ (defaults to mpeg)
--
--     -   @text\/plain; charset=utf-8@
putSession_accept :: Lens.Lens' PutSession (Prelude.Maybe Prelude.Text)
putSession_accept :: Lens' PutSession (Maybe Text)
putSession_accept = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutSession' {Maybe Text
accept :: Maybe Text
$sel:accept:PutSession' :: PutSession -> Maybe Text
accept} -> Maybe Text
accept) (\s :: PutSession
s@PutSession' {} Maybe Text
a -> PutSession
s {$sel:accept:PutSession' :: Maybe Text
accept = Maybe Text
a} :: PutSession)

-- | 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.
putSession_activeContexts :: Lens.Lens' PutSession (Prelude.Maybe [ActiveContext])
putSession_activeContexts :: Lens' PutSession (Maybe [ActiveContext])
putSession_activeContexts = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutSession' {Maybe (Sensitive [ActiveContext])
activeContexts :: Maybe (Sensitive [ActiveContext])
$sel:activeContexts:PutSession' :: PutSession -> Maybe (Sensitive [ActiveContext])
activeContexts} -> Maybe (Sensitive [ActiveContext])
activeContexts) (\s :: PutSession
s@PutSession' {} Maybe (Sensitive [ActiveContext])
a -> PutSession
s {$sel:activeContexts:PutSession' :: Maybe (Sensitive [ActiveContext])
activeContexts = Maybe (Sensitive [ActiveContext])
a} :: PutSession) 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)

-- | Sets the next action that the bot should take to fulfill the
-- conversation.
putSession_dialogAction :: Lens.Lens' PutSession (Prelude.Maybe DialogAction)
putSession_dialogAction :: Lens' PutSession (Maybe DialogAction)
putSession_dialogAction = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutSession' {Maybe DialogAction
dialogAction :: Maybe DialogAction
$sel:dialogAction:PutSession' :: PutSession -> Maybe DialogAction
dialogAction} -> Maybe DialogAction
dialogAction) (\s :: PutSession
s@PutSession' {} Maybe DialogAction
a -> PutSession
s {$sel:dialogAction:PutSession' :: Maybe DialogAction
dialogAction = Maybe DialogAction
a} :: PutSession)

-- | A summary of the recent intents for the bot. You can use the intent
-- summary view to set a checkpoint label on an intent and modify
-- attributes of intents. You can also use it to remove or add intent
-- summary objects to the list.
--
-- An intent that you modify or add to the list must make sense for the
-- bot. For example, the intent name must be valid for the bot. You must
-- provide valid values for:
--
-- -   @intentName@
--
-- -   slot names
--
-- -   @slotToElict@
--
-- If you send the @recentIntentSummaryView@ parameter in a @PutSession@
-- request, the contents of the new summary view replaces the old summary
-- view. For example, if a @GetSession@ request returns three intents in
-- the summary view and you call @PutSession@ with one intent in the
-- summary view, the next call to @GetSession@ will only return one intent.
putSession_recentIntentSummaryView :: Lens.Lens' PutSession (Prelude.Maybe [IntentSummary])
putSession_recentIntentSummaryView :: Lens' PutSession (Maybe [IntentSummary])
putSession_recentIntentSummaryView = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutSession' {Maybe [IntentSummary]
recentIntentSummaryView :: Maybe [IntentSummary]
$sel:recentIntentSummaryView:PutSession' :: PutSession -> Maybe [IntentSummary]
recentIntentSummaryView} -> Maybe [IntentSummary]
recentIntentSummaryView) (\s :: PutSession
s@PutSession' {} Maybe [IntentSummary]
a -> PutSession
s {$sel:recentIntentSummaryView:PutSession' :: Maybe [IntentSummary]
recentIntentSummaryView = Maybe [IntentSummary]
a} :: PutSession) 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

-- | Map of key\/value pairs representing the session-specific context
-- information. It contains application information passed between Amazon
-- Lex and a client application.
putSession_sessionAttributes :: Lens.Lens' PutSession (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
putSession_sessionAttributes :: Lens' PutSession (Maybe (HashMap Text Text))
putSession_sessionAttributes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutSession' {Maybe (Sensitive (HashMap Text Text))
sessionAttributes :: Maybe (Sensitive (HashMap Text Text))
$sel:sessionAttributes:PutSession' :: PutSession -> Maybe (Sensitive (HashMap Text Text))
sessionAttributes} -> Maybe (Sensitive (HashMap Text Text))
sessionAttributes) (\s :: PutSession
s@PutSession' {} Maybe (Sensitive (HashMap Text Text))
a -> PutSession
s {$sel:sessionAttributes:PutSession' :: Maybe (Sensitive (HashMap Text Text))
sessionAttributes = Maybe (Sensitive (HashMap Text Text))
a} :: PutSession) 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 bot that contains the session data.
putSession_botName :: Lens.Lens' PutSession Prelude.Text
putSession_botName :: Lens' PutSession Text
putSession_botName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutSession' {Text
botName :: Text
$sel:botName:PutSession' :: PutSession -> Text
botName} -> Text
botName) (\s :: PutSession
s@PutSession' {} Text
a -> PutSession
s {$sel:botName:PutSession' :: Text
botName = Text
a} :: PutSession)

-- | The alias in use for the bot that contains the session data.
putSession_botAlias :: Lens.Lens' PutSession Prelude.Text
putSession_botAlias :: Lens' PutSession Text
putSession_botAlias = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutSession' {Text
botAlias :: Text
$sel:botAlias:PutSession' :: PutSession -> Text
botAlias} -> Text
botAlias) (\s :: PutSession
s@PutSession' {} Text
a -> PutSession
s {$sel:botAlias:PutSession' :: Text
botAlias = Text
a} :: PutSession)

-- | The ID of the client application user. Amazon Lex uses this to identify
-- a user\'s conversation with your bot.
putSession_userId :: Lens.Lens' PutSession Prelude.Text
putSession_userId :: Lens' PutSession Text
putSession_userId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutSession' {Text
userId :: Text
$sel:userId:PutSession' :: PutSession -> Text
userId} -> Text
userId) (\s :: PutSession
s@PutSession' {} Text
a -> PutSession
s {$sel:userId:PutSession' :: Text
userId = Text
a} :: PutSession)

instance Core.AWSRequest PutSession where
  type AWSResponse PutSession = PutSessionResponse
  request :: (Service -> Service) -> PutSession -> Request PutSession
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 PutSession
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse PutSession)))
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 DialogState
-> Maybe (Sensitive Text)
-> Maybe Text
-> Maybe (Sensitive Text)
-> Maybe MessageFormatType
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Int
-> ResponseBody
-> PutSessionResponse
PutSessionResponse'
            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
"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-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-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-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 Prelude.Hashable PutSession where
  hashWithSalt :: Int -> PutSession -> Int
hashWithSalt Int
_salt PutSession' {Maybe [IntentSummary]
Maybe Text
Maybe (Sensitive [ActiveContext])
Maybe (Sensitive (HashMap Text Text))
Maybe DialogAction
Text
userId :: Text
botAlias :: Text
botName :: Text
sessionAttributes :: Maybe (Sensitive (HashMap Text Text))
recentIntentSummaryView :: Maybe [IntentSummary]
dialogAction :: Maybe DialogAction
activeContexts :: Maybe (Sensitive [ActiveContext])
accept :: Maybe Text
$sel:userId:PutSession' :: PutSession -> Text
$sel:botAlias:PutSession' :: PutSession -> Text
$sel:botName:PutSession' :: PutSession -> Text
$sel:sessionAttributes:PutSession' :: PutSession -> Maybe (Sensitive (HashMap Text Text))
$sel:recentIntentSummaryView:PutSession' :: PutSession -> Maybe [IntentSummary]
$sel:dialogAction:PutSession' :: PutSession -> Maybe DialogAction
$sel:activeContexts:PutSession' :: PutSession -> Maybe (Sensitive [ActiveContext])
$sel:accept:PutSession' :: PutSession -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
accept
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (Sensitive [ActiveContext])
activeContexts
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe DialogAction
dialogAction
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [IntentSummary]
recentIntentSummaryView
      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

instance Prelude.NFData PutSession where
  rnf :: PutSession -> ()
rnf PutSession' {Maybe [IntentSummary]
Maybe Text
Maybe (Sensitive [ActiveContext])
Maybe (Sensitive (HashMap Text Text))
Maybe DialogAction
Text
userId :: Text
botAlias :: Text
botName :: Text
sessionAttributes :: Maybe (Sensitive (HashMap Text Text))
recentIntentSummaryView :: Maybe [IntentSummary]
dialogAction :: Maybe DialogAction
activeContexts :: Maybe (Sensitive [ActiveContext])
accept :: Maybe Text
$sel:userId:PutSession' :: PutSession -> Text
$sel:botAlias:PutSession' :: PutSession -> Text
$sel:botName:PutSession' :: PutSession -> Text
$sel:sessionAttributes:PutSession' :: PutSession -> Maybe (Sensitive (HashMap Text Text))
$sel:recentIntentSummaryView:PutSession' :: PutSession -> Maybe [IntentSummary]
$sel:dialogAction:PutSession' :: PutSession -> Maybe DialogAction
$sel:activeContexts:PutSession' :: PutSession -> Maybe (Sensitive [ActiveContext])
$sel:accept:PutSession' :: PutSession -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
accept
      seq :: forall a b. a -> b -> b
`Prelude.seq` 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 DialogAction
dialogAction
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [IntentSummary]
recentIntentSummaryView
      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

instance Data.ToHeaders PutSession where
  toHeaders :: PutSession -> ResponseHeaders
toHeaders PutSession' {Maybe [IntentSummary]
Maybe Text
Maybe (Sensitive [ActiveContext])
Maybe (Sensitive (HashMap Text Text))
Maybe DialogAction
Text
userId :: Text
botAlias :: Text
botName :: Text
sessionAttributes :: Maybe (Sensitive (HashMap Text Text))
recentIntentSummaryView :: Maybe [IntentSummary]
dialogAction :: Maybe DialogAction
activeContexts :: Maybe (Sensitive [ActiveContext])
accept :: Maybe Text
$sel:userId:PutSession' :: PutSession -> Text
$sel:botAlias:PutSession' :: PutSession -> Text
$sel:botName:PutSession' :: PutSession -> Text
$sel:sessionAttributes:PutSession' :: PutSession -> Maybe (Sensitive (HashMap Text Text))
$sel:recentIntentSummaryView:PutSession' :: PutSession -> Maybe [IntentSummary]
$sel:dialogAction:PutSession' :: PutSession -> Maybe DialogAction
$sel:activeContexts:PutSession' :: PutSession -> Maybe (Sensitive [ActiveContext])
$sel:accept:PutSession' :: PutSession -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ HeaderName
"Accept" forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# Maybe Text
accept,
        HeaderName
"Content-Type"
          forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# (ByteString
"application/x-amz-json-1.1" :: Prelude.ByteString)
      ]

instance Data.ToJSON PutSession where
  toJSON :: PutSession -> Value
toJSON PutSession' {Maybe [IntentSummary]
Maybe Text
Maybe (Sensitive [ActiveContext])
Maybe (Sensitive (HashMap Text Text))
Maybe DialogAction
Text
userId :: Text
botAlias :: Text
botName :: Text
sessionAttributes :: Maybe (Sensitive (HashMap Text Text))
recentIntentSummaryView :: Maybe [IntentSummary]
dialogAction :: Maybe DialogAction
activeContexts :: Maybe (Sensitive [ActiveContext])
accept :: Maybe Text
$sel:userId:PutSession' :: PutSession -> Text
$sel:botAlias:PutSession' :: PutSession -> Text
$sel:botName:PutSession' :: PutSession -> Text
$sel:sessionAttributes:PutSession' :: PutSession -> Maybe (Sensitive (HashMap Text Text))
$sel:recentIntentSummaryView:PutSession' :: PutSession -> Maybe [IntentSummary]
$sel:dialogAction:PutSession' :: PutSession -> Maybe DialogAction
$sel:activeContexts:PutSession' :: PutSession -> Maybe (Sensitive [ActiveContext])
$sel:accept:PutSession' :: PutSession -> Maybe Text
..} =
    [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
"dialogAction" 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 DialogAction
dialogAction,
            (Key
"recentIntentSummaryView" 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 [IntentSummary]
recentIntentSummaryView,
            (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
          ]
      )

instance Data.ToPath PutSession where
  toPath :: PutSession -> ByteString
toPath PutSession' {Maybe [IntentSummary]
Maybe Text
Maybe (Sensitive [ActiveContext])
Maybe (Sensitive (HashMap Text Text))
Maybe DialogAction
Text
userId :: Text
botAlias :: Text
botName :: Text
sessionAttributes :: Maybe (Sensitive (HashMap Text Text))
recentIntentSummaryView :: Maybe [IntentSummary]
dialogAction :: Maybe DialogAction
activeContexts :: Maybe (Sensitive [ActiveContext])
accept :: Maybe Text
$sel:userId:PutSession' :: PutSession -> Text
$sel:botAlias:PutSession' :: PutSession -> Text
$sel:botName:PutSession' :: PutSession -> Text
$sel:sessionAttributes:PutSession' :: PutSession -> Maybe (Sensitive (HashMap Text Text))
$sel:recentIntentSummaryView:PutSession' :: PutSession -> Maybe [IntentSummary]
$sel:dialogAction:PutSession' :: PutSession -> Maybe DialogAction
$sel:activeContexts:PutSession' :: PutSession -> Maybe (Sensitive [ActiveContext])
$sel:accept:PutSession' :: PutSession -> 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
"/session"
      ]

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

-- | /See:/ 'newPutSessionResponse' smart constructor.
data PutSessionResponse = PutSessionResponse'
  { -- | A list of active contexts for the session.
    PutSessionResponse -> Maybe (Sensitive Text)
activeContexts :: Prelude.Maybe (Data.Sensitive Prelude.Text),
    -- | Content type as specified in the @Accept@ HTTP header in the request.
    PutSessionResponse -> Maybe Text
contentType :: Prelude.Maybe Prelude.Text,
    -- | -   @ConfirmIntent@ - Amazon Lex is expecting a \"yes\" or \"no\"
    --     response to confirm the intent before fulfilling an intent.
    --
    -- -   @ElicitIntent@ - Amazon Lex wants to elicit the user\'s intent.
    --
    -- -   @ElicitSlot@ - Amazon Lex is expecting the value of a slot for the
    --     current intent.
    --
    -- -   @Failed@ - Conveys that the conversation with the user has failed.
    --     This can happen for various reasons, including the user does not
    --     provide an appropriate response to prompts from the service, or if
    --     the Lambda function fails to fulfill the intent.
    --
    -- -   @Fulfilled@ - Conveys that the Lambda function has sucessfully
    --     fulfilled the intent.
    --
    -- -   @ReadyForFulfillment@ - Conveys that the client has to fulfill the
    --     intent.
    PutSessionResponse -> Maybe DialogState
dialogState :: Prelude.Maybe DialogState,
    -- | The next message that should be presented to the user.
    --
    -- The @encodedMessage@ field is base-64 encoded. You must decode the field
    -- before you can use the value.
    PutSessionResponse -> Maybe (Sensitive Text)
encodedMessage :: Prelude.Maybe (Data.Sensitive Prelude.Text),
    -- | The name of the current intent.
    PutSessionResponse -> Maybe Text
intentName :: Prelude.Maybe Prelude.Text,
    -- | The next message that should be presented to the user.
    --
    -- 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.
    PutSessionResponse -> 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.
    PutSessionResponse -> Maybe MessageFormatType
messageFormat :: Prelude.Maybe MessageFormatType,
    -- | Map of key\/value pairs representing session-specific context
    -- information.
    PutSessionResponse -> Maybe Text
sessionAttributes :: Prelude.Maybe Prelude.Text,
    -- | A unique identifier for the session.
    PutSessionResponse -> Maybe Text
sessionId :: Prelude.Maybe Prelude.Text,
    -- | If the @dialogState@ is @ElicitSlot@, returns the name of the slot for
    -- which Amazon Lex is eliciting a value.
    PutSessionResponse -> Maybe Text
slotToElicit :: Prelude.Maybe Prelude.Text,
    -- | Map of zero or more intent slots Amazon Lex detected from the user input
    -- during 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@.
    PutSessionResponse -> Maybe Text
slots :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    PutSessionResponse -> Int
httpStatus :: Prelude.Int,
    -- | The audio version of the message to convey to the user.
    PutSessionResponse -> ResponseBody
audioStream :: Data.ResponseBody
  }
  deriving (Int -> PutSessionResponse -> ShowS
[PutSessionResponse] -> ShowS
PutSessionResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PutSessionResponse] -> ShowS
$cshowList :: [PutSessionResponse] -> ShowS
show :: PutSessionResponse -> String
$cshow :: PutSessionResponse -> String
showsPrec :: Int -> PutSessionResponse -> ShowS
$cshowsPrec :: Int -> PutSessionResponse -> ShowS
Prelude.Show, forall x. Rep PutSessionResponse x -> PutSessionResponse
forall x. PutSessionResponse -> Rep PutSessionResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PutSessionResponse x -> PutSessionResponse
$cfrom :: forall x. PutSessionResponse -> Rep PutSessionResponse x
Prelude.Generic)

-- |
-- Create a value of 'PutSessionResponse' 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', 'putSessionResponse_activeContexts' - A list of active contexts for the session.
--
-- 'contentType', 'putSessionResponse_contentType' - Content type as specified in the @Accept@ HTTP header in the request.
--
-- 'dialogState', 'putSessionResponse_dialogState' - -   @ConfirmIntent@ - Amazon Lex is expecting a \"yes\" or \"no\"
--     response to confirm the intent before fulfilling an intent.
--
-- -   @ElicitIntent@ - Amazon Lex wants to elicit the user\'s intent.
--
-- -   @ElicitSlot@ - Amazon Lex is expecting the value of a slot for the
--     current intent.
--
-- -   @Failed@ - Conveys that the conversation with the user has failed.
--     This can happen for various reasons, including the user does not
--     provide an appropriate response to prompts from the service, or if
--     the Lambda function fails to fulfill the intent.
--
-- -   @Fulfilled@ - Conveys that the Lambda function has sucessfully
--     fulfilled the intent.
--
-- -   @ReadyForFulfillment@ - Conveys that the client has to fulfill the
--     intent.
--
-- 'encodedMessage', 'putSessionResponse_encodedMessage' - The next message that should be presented to the user.
--
-- The @encodedMessage@ field is base-64 encoded. You must decode the field
-- before you can use the value.
--
-- 'intentName', 'putSessionResponse_intentName' - The name of the current intent.
--
-- 'message', 'putSessionResponse_message' - The next message that should be presented to the user.
--
-- 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.
--
-- 'messageFormat', 'putSessionResponse_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.
--
-- 'sessionAttributes', 'putSessionResponse_sessionAttributes' - Map of key\/value pairs representing session-specific context
-- information.
--
-- 'sessionId', 'putSessionResponse_sessionId' - A unique identifier for the session.
--
-- 'slotToElicit', 'putSessionResponse_slotToElicit' - If the @dialogState@ is @ElicitSlot@, returns the name of the slot for
-- which Amazon Lex is eliciting a value.
--
-- 'slots', 'putSessionResponse_slots' - Map of zero or more intent slots Amazon Lex detected from the user input
-- during 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', 'putSessionResponse_httpStatus' - The response's http status code.
--
-- 'audioStream', 'putSessionResponse_audioStream' - The audio version of the message to convey to the user.
newPutSessionResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'audioStream'
  Data.ResponseBody ->
  PutSessionResponse
newPutSessionResponse :: Int -> ResponseBody -> PutSessionResponse
newPutSessionResponse Int
pHttpStatus_ ResponseBody
pAudioStream_ =
  PutSessionResponse'
    { $sel:activeContexts:PutSessionResponse' :: Maybe (Sensitive Text)
activeContexts =
        forall a. Maybe a
Prelude.Nothing,
      $sel:contentType:PutSessionResponse' :: Maybe Text
contentType = forall a. Maybe a
Prelude.Nothing,
      $sel:dialogState:PutSessionResponse' :: Maybe DialogState
dialogState = forall a. Maybe a
Prelude.Nothing,
      $sel:encodedMessage:PutSessionResponse' :: Maybe (Sensitive Text)
encodedMessage = forall a. Maybe a
Prelude.Nothing,
      $sel:intentName:PutSessionResponse' :: Maybe Text
intentName = forall a. Maybe a
Prelude.Nothing,
      $sel:message:PutSessionResponse' :: Maybe (Sensitive Text)
message = forall a. Maybe a
Prelude.Nothing,
      $sel:messageFormat:PutSessionResponse' :: Maybe MessageFormatType
messageFormat = forall a. Maybe a
Prelude.Nothing,
      $sel:sessionAttributes:PutSessionResponse' :: Maybe Text
sessionAttributes = forall a. Maybe a
Prelude.Nothing,
      $sel:sessionId:PutSessionResponse' :: Maybe Text
sessionId = forall a. Maybe a
Prelude.Nothing,
      $sel:slotToElicit:PutSessionResponse' :: Maybe Text
slotToElicit = forall a. Maybe a
Prelude.Nothing,
      $sel:slots:PutSessionResponse' :: Maybe Text
slots = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:PutSessionResponse' :: Int
httpStatus = Int
pHttpStatus_,
      $sel:audioStream:PutSessionResponse' :: ResponseBody
audioStream = ResponseBody
pAudioStream_
    }

-- | A list of active contexts for the session.
putSessionResponse_activeContexts :: Lens.Lens' PutSessionResponse (Prelude.Maybe Prelude.Text)
putSessionResponse_activeContexts :: Lens' PutSessionResponse (Maybe Text)
putSessionResponse_activeContexts = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutSessionResponse' {Maybe (Sensitive Text)
activeContexts :: Maybe (Sensitive Text)
$sel:activeContexts:PutSessionResponse' :: PutSessionResponse -> Maybe (Sensitive Text)
activeContexts} -> Maybe (Sensitive Text)
activeContexts) (\s :: PutSessionResponse
s@PutSessionResponse' {} Maybe (Sensitive Text)
a -> PutSessionResponse
s {$sel:activeContexts:PutSessionResponse' :: Maybe (Sensitive Text)
activeContexts = Maybe (Sensitive Text)
a} :: PutSessionResponse) 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

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

-- | -   @ConfirmIntent@ - Amazon Lex is expecting a \"yes\" or \"no\"
--     response to confirm the intent before fulfilling an intent.
--
-- -   @ElicitIntent@ - Amazon Lex wants to elicit the user\'s intent.
--
-- -   @ElicitSlot@ - Amazon Lex is expecting the value of a slot for the
--     current intent.
--
-- -   @Failed@ - Conveys that the conversation with the user has failed.
--     This can happen for various reasons, including the user does not
--     provide an appropriate response to prompts from the service, or if
--     the Lambda function fails to fulfill the intent.
--
-- -   @Fulfilled@ - Conveys that the Lambda function has sucessfully
--     fulfilled the intent.
--
-- -   @ReadyForFulfillment@ - Conveys that the client has to fulfill the
--     intent.
putSessionResponse_dialogState :: Lens.Lens' PutSessionResponse (Prelude.Maybe DialogState)
putSessionResponse_dialogState :: Lens' PutSessionResponse (Maybe DialogState)
putSessionResponse_dialogState = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutSessionResponse' {Maybe DialogState
dialogState :: Maybe DialogState
$sel:dialogState:PutSessionResponse' :: PutSessionResponse -> Maybe DialogState
dialogState} -> Maybe DialogState
dialogState) (\s :: PutSessionResponse
s@PutSessionResponse' {} Maybe DialogState
a -> PutSessionResponse
s {$sel:dialogState:PutSessionResponse' :: Maybe DialogState
dialogState = Maybe DialogState
a} :: PutSessionResponse)

-- | The next message that should be presented to the user.
--
-- The @encodedMessage@ field is base-64 encoded. You must decode the field
-- before you can use the value.
putSessionResponse_encodedMessage :: Lens.Lens' PutSessionResponse (Prelude.Maybe Prelude.Text)
putSessionResponse_encodedMessage :: Lens' PutSessionResponse (Maybe Text)
putSessionResponse_encodedMessage = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutSessionResponse' {Maybe (Sensitive Text)
encodedMessage :: Maybe (Sensitive Text)
$sel:encodedMessage:PutSessionResponse' :: PutSessionResponse -> Maybe (Sensitive Text)
encodedMessage} -> Maybe (Sensitive Text)
encodedMessage) (\s :: PutSessionResponse
s@PutSessionResponse' {} Maybe (Sensitive Text)
a -> PutSessionResponse
s {$sel:encodedMessage:PutSessionResponse' :: Maybe (Sensitive Text)
encodedMessage = Maybe (Sensitive Text)
a} :: PutSessionResponse) 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 name of the current intent.
putSessionResponse_intentName :: Lens.Lens' PutSessionResponse (Prelude.Maybe Prelude.Text)
putSessionResponse_intentName :: Lens' PutSessionResponse (Maybe Text)
putSessionResponse_intentName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutSessionResponse' {Maybe Text
intentName :: Maybe Text
$sel:intentName:PutSessionResponse' :: PutSessionResponse -> Maybe Text
intentName} -> Maybe Text
intentName) (\s :: PutSessionResponse
s@PutSessionResponse' {} Maybe Text
a -> PutSessionResponse
s {$sel:intentName:PutSessionResponse' :: Maybe Text
intentName = Maybe Text
a} :: PutSessionResponse)

-- | The next message that should be presented to the user.
--
-- 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.
putSessionResponse_message :: Lens.Lens' PutSessionResponse (Prelude.Maybe Prelude.Text)
putSessionResponse_message :: Lens' PutSessionResponse (Maybe Text)
putSessionResponse_message = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutSessionResponse' {Maybe (Sensitive Text)
message :: Maybe (Sensitive Text)
$sel:message:PutSessionResponse' :: PutSessionResponse -> Maybe (Sensitive Text)
message} -> Maybe (Sensitive Text)
message) (\s :: PutSessionResponse
s@PutSessionResponse' {} Maybe (Sensitive Text)
a -> PutSessionResponse
s {$sel:message:PutSessionResponse' :: Maybe (Sensitive Text)
message = Maybe (Sensitive Text)
a} :: PutSessionResponse) 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.
putSessionResponse_messageFormat :: Lens.Lens' PutSessionResponse (Prelude.Maybe MessageFormatType)
putSessionResponse_messageFormat :: Lens' PutSessionResponse (Maybe MessageFormatType)
putSessionResponse_messageFormat = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutSessionResponse' {Maybe MessageFormatType
messageFormat :: Maybe MessageFormatType
$sel:messageFormat:PutSessionResponse' :: PutSessionResponse -> Maybe MessageFormatType
messageFormat} -> Maybe MessageFormatType
messageFormat) (\s :: PutSessionResponse
s@PutSessionResponse' {} Maybe MessageFormatType
a -> PutSessionResponse
s {$sel:messageFormat:PutSessionResponse' :: Maybe MessageFormatType
messageFormat = Maybe MessageFormatType
a} :: PutSessionResponse)

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

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

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

-- | Map of zero or more intent slots Amazon Lex detected from the user input
-- during 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@.
putSessionResponse_slots :: Lens.Lens' PutSessionResponse (Prelude.Maybe Prelude.Text)
putSessionResponse_slots :: Lens' PutSessionResponse (Maybe Text)
putSessionResponse_slots = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutSessionResponse' {Maybe Text
slots :: Maybe Text
$sel:slots:PutSessionResponse' :: PutSessionResponse -> Maybe Text
slots} -> Maybe Text
slots) (\s :: PutSessionResponse
s@PutSessionResponse' {} Maybe Text
a -> PutSessionResponse
s {$sel:slots:PutSessionResponse' :: Maybe Text
slots = Maybe Text
a} :: PutSessionResponse)

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

-- | The audio version of the message to convey to the user.
putSessionResponse_audioStream :: Lens.Lens' PutSessionResponse Data.ResponseBody
putSessionResponse_audioStream :: Lens' PutSessionResponse ResponseBody
putSessionResponse_audioStream = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutSessionResponse' {ResponseBody
audioStream :: ResponseBody
$sel:audioStream:PutSessionResponse' :: PutSessionResponse -> ResponseBody
audioStream} -> ResponseBody
audioStream) (\s :: PutSessionResponse
s@PutSessionResponse' {} ResponseBody
a -> PutSessionResponse
s {$sel:audioStream:PutSessionResponse' :: ResponseBody
audioStream = ResponseBody
a} :: PutSessionResponse)