{-# 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.GetSession
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Returns session information for a specified bot, alias, and user ID.
module Amazonka.LexRuntime.GetSession
  ( -- * Creating a Request
    GetSession (..),
    newGetSession,

    -- * Request Lenses
    getSession_checkpointLabelFilter,
    getSession_botName,
    getSession_botAlias,
    getSession_userId,

    -- * Destructuring the Response
    GetSessionResponse (..),
    newGetSessionResponse,

    -- * Response Lenses
    getSessionResponse_activeContexts,
    getSessionResponse_dialogAction,
    getSessionResponse_recentIntentSummaryView,
    getSessionResponse_sessionAttributes,
    getSessionResponse_sessionId,
    getSessionResponse_httpStatus,
  )
where

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

-- | /See:/ 'newGetSession' smart constructor.
data GetSession = GetSession'
  { -- | A string used to filter the intents returned in the
    -- @recentIntentSummaryView@ structure.
    --
    -- When you specify a filter, only intents with their @checkpointLabel@
    -- field set to that string are returned.
    GetSession -> Maybe Text
checkpointLabelFilter :: Prelude.Maybe Prelude.Text,
    -- | The name of the bot that contains the session data.
    GetSession -> Text
botName :: Prelude.Text,
    -- | The alias in use for the bot that contains the session data.
    GetSession -> Text
botAlias :: Prelude.Text,
    -- | The ID of the client application user. Amazon Lex uses this to identify
    -- a user\'s conversation with your bot.
    GetSession -> Text
userId :: Prelude.Text
  }
  deriving (GetSession -> GetSession -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetSession -> GetSession -> Bool
$c/= :: GetSession -> GetSession -> Bool
== :: GetSession -> GetSession -> Bool
$c== :: GetSession -> GetSession -> Bool
Prelude.Eq, ReadPrec [GetSession]
ReadPrec GetSession
Int -> ReadS GetSession
ReadS [GetSession]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetSession]
$creadListPrec :: ReadPrec [GetSession]
readPrec :: ReadPrec GetSession
$creadPrec :: ReadPrec GetSession
readList :: ReadS [GetSession]
$creadList :: ReadS [GetSession]
readsPrec :: Int -> ReadS GetSession
$creadsPrec :: Int -> ReadS GetSession
Prelude.Read, Int -> GetSession -> ShowS
[GetSession] -> ShowS
GetSession -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetSession] -> ShowS
$cshowList :: [GetSession] -> ShowS
show :: GetSession -> String
$cshow :: GetSession -> String
showsPrec :: Int -> GetSession -> ShowS
$cshowsPrec :: Int -> GetSession -> ShowS
Prelude.Show, forall x. Rep GetSession x -> GetSession
forall x. GetSession -> Rep GetSession x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetSession x -> GetSession
$cfrom :: forall x. GetSession -> Rep GetSession x
Prelude.Generic)

-- |
-- Create a value of 'GetSession' 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:
--
-- 'checkpointLabelFilter', 'getSession_checkpointLabelFilter' - A string used to filter the intents returned in the
-- @recentIntentSummaryView@ structure.
--
-- When you specify a filter, only intents with their @checkpointLabel@
-- field set to that string are returned.
--
-- 'botName', 'getSession_botName' - The name of the bot that contains the session data.
--
-- 'botAlias', 'getSession_botAlias' - The alias in use for the bot that contains the session data.
--
-- 'userId', 'getSession_userId' - The ID of the client application user. Amazon Lex uses this to identify
-- a user\'s conversation with your bot.
newGetSession ::
  -- | 'botName'
  Prelude.Text ->
  -- | 'botAlias'
  Prelude.Text ->
  -- | 'userId'
  Prelude.Text ->
  GetSession
newGetSession :: Text -> Text -> Text -> GetSession
newGetSession Text
pBotName_ Text
pBotAlias_ Text
pUserId_ =
  GetSession'
    { $sel:checkpointLabelFilter:GetSession' :: Maybe Text
checkpointLabelFilter =
        forall a. Maybe a
Prelude.Nothing,
      $sel:botName:GetSession' :: Text
botName = Text
pBotName_,
      $sel:botAlias:GetSession' :: Text
botAlias = Text
pBotAlias_,
      $sel:userId:GetSession' :: Text
userId = Text
pUserId_
    }

-- | A string used to filter the intents returned in the
-- @recentIntentSummaryView@ structure.
--
-- When you specify a filter, only intents with their @checkpointLabel@
-- field set to that string are returned.
getSession_checkpointLabelFilter :: Lens.Lens' GetSession (Prelude.Maybe Prelude.Text)
getSession_checkpointLabelFilter :: Lens' GetSession (Maybe Text)
getSession_checkpointLabelFilter = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetSession' {Maybe Text
checkpointLabelFilter :: Maybe Text
$sel:checkpointLabelFilter:GetSession' :: GetSession -> Maybe Text
checkpointLabelFilter} -> Maybe Text
checkpointLabelFilter) (\s :: GetSession
s@GetSession' {} Maybe Text
a -> GetSession
s {$sel:checkpointLabelFilter:GetSession' :: Maybe Text
checkpointLabelFilter = Maybe Text
a} :: GetSession)

-- | The name of the bot that contains the session data.
getSession_botName :: Lens.Lens' GetSession Prelude.Text
getSession_botName :: Lens' GetSession Text
getSession_botName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetSession' {Text
botName :: Text
$sel:botName:GetSession' :: GetSession -> Text
botName} -> Text
botName) (\s :: GetSession
s@GetSession' {} Text
a -> GetSession
s {$sel:botName:GetSession' :: Text
botName = Text
a} :: GetSession)

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

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

instance Core.AWSRequest GetSession where
  type AWSResponse GetSession = GetSessionResponse
  request :: (Service -> Service) -> GetSession -> Request GetSession
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.get (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy GetSession
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse GetSession)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> Object -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveJSON
      ( \Int
s ResponseHeaders
h Object
x ->
          Maybe (Sensitive [ActiveContext])
-> Maybe DialogAction
-> Maybe [IntentSummary]
-> Maybe (Sensitive (HashMap Text Text))
-> Maybe Text
-> Int
-> GetSessionResponse
GetSessionResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"activeContexts" forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty)
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"dialogAction")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ( Object
x
                            forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"recentIntentSummaryView"
                            forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty
                        )
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ( Object
x
                            forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"sessionAttributes"
                            forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty
                        )
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"sessionId")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
      )

instance Prelude.Hashable GetSession where
  hashWithSalt :: Int -> GetSession -> Int
hashWithSalt Int
_salt GetSession' {Maybe Text
Text
userId :: Text
botAlias :: Text
botName :: Text
checkpointLabelFilter :: Maybe Text
$sel:userId:GetSession' :: GetSession -> Text
$sel:botAlias:GetSession' :: GetSession -> Text
$sel:botName:GetSession' :: GetSession -> Text
$sel:checkpointLabelFilter:GetSession' :: GetSession -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
checkpointLabelFilter
      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 GetSession where
  rnf :: GetSession -> ()
rnf GetSession' {Maybe Text
Text
userId :: Text
botAlias :: Text
botName :: Text
checkpointLabelFilter :: Maybe Text
$sel:userId:GetSession' :: GetSession -> Text
$sel:botAlias:GetSession' :: GetSession -> Text
$sel:botName:GetSession' :: GetSession -> Text
$sel:checkpointLabelFilter:GetSession' :: GetSession -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
checkpointLabelFilter
      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 GetSession where
  toHeaders :: GetSession -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToPath GetSession where
  toPath :: GetSession -> ByteString
toPath GetSession' {Maybe Text
Text
userId :: Text
botAlias :: Text
botName :: Text
checkpointLabelFilter :: Maybe Text
$sel:userId:GetSession' :: GetSession -> Text
$sel:botAlias:GetSession' :: GetSession -> Text
$sel:botName:GetSession' :: GetSession -> Text
$sel:checkpointLabelFilter:GetSession' :: GetSession -> 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 GetSession where
  toQuery :: GetSession -> QueryString
toQuery GetSession' {Maybe Text
Text
userId :: Text
botAlias :: Text
botName :: Text
checkpointLabelFilter :: Maybe Text
$sel:userId:GetSession' :: GetSession -> Text
$sel:botAlias:GetSession' :: GetSession -> Text
$sel:botName:GetSession' :: GetSession -> Text
$sel:checkpointLabelFilter:GetSession' :: GetSession -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"checkpointLabelFilter"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
checkpointLabelFilter
      ]

-- | /See:/ 'newGetSessionResponse' smart constructor.
data GetSessionResponse = GetSessionResponse'
  { -- | 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.
    GetSessionResponse -> Maybe (Sensitive [ActiveContext])
activeContexts :: Prelude.Maybe (Data.Sensitive [ActiveContext]),
    -- | Describes the current state of the bot.
    GetSessionResponse -> Maybe DialogAction
dialogAction :: Prelude.Maybe DialogAction,
    -- | An array of information about the intents used in the session. The array
    -- can contain a maximum of three summaries. If more than three intents are
    -- used in the session, the @recentIntentSummaryView@ operation contains
    -- information about the last three intents used.
    --
    -- If you set the @checkpointLabelFilter@ parameter in the request, the
    -- array contains only the intents with the specified label.
    GetSessionResponse -> 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.
    GetSessionResponse -> Maybe (Sensitive (HashMap Text Text))
sessionAttributes :: Prelude.Maybe (Data.Sensitive (Prelude.HashMap Prelude.Text Prelude.Text)),
    -- | A unique identifier for the session.
    GetSessionResponse -> Maybe Text
sessionId :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    GetSessionResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetSessionResponse -> GetSessionResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetSessionResponse -> GetSessionResponse -> Bool
$c/= :: GetSessionResponse -> GetSessionResponse -> Bool
== :: GetSessionResponse -> GetSessionResponse -> Bool
$c== :: GetSessionResponse -> GetSessionResponse -> Bool
Prelude.Eq, Int -> GetSessionResponse -> ShowS
[GetSessionResponse] -> ShowS
GetSessionResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetSessionResponse] -> ShowS
$cshowList :: [GetSessionResponse] -> ShowS
show :: GetSessionResponse -> String
$cshow :: GetSessionResponse -> String
showsPrec :: Int -> GetSessionResponse -> ShowS
$cshowsPrec :: Int -> GetSessionResponse -> ShowS
Prelude.Show, forall x. Rep GetSessionResponse x -> GetSessionResponse
forall x. GetSessionResponse -> Rep GetSessionResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetSessionResponse x -> GetSessionResponse
$cfrom :: forall x. GetSessionResponse -> Rep GetSessionResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetSessionResponse' 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', 'getSessionResponse_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.
--
-- 'dialogAction', 'getSessionResponse_dialogAction' - Describes the current state of the bot.
--
-- 'recentIntentSummaryView', 'getSessionResponse_recentIntentSummaryView' - An array of information about the intents used in the session. The array
-- can contain a maximum of three summaries. If more than three intents are
-- used in the session, the @recentIntentSummaryView@ operation contains
-- information about the last three intents used.
--
-- If you set the @checkpointLabelFilter@ parameter in the request, the
-- array contains only the intents with the specified label.
--
-- 'sessionAttributes', 'getSessionResponse_sessionAttributes' - Map of key\/value pairs representing the session-specific context
-- information. It contains application information passed between Amazon
-- Lex and a client application.
--
-- 'sessionId', 'getSessionResponse_sessionId' - A unique identifier for the session.
--
-- 'httpStatus', 'getSessionResponse_httpStatus' - The response's http status code.
newGetSessionResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetSessionResponse
newGetSessionResponse :: Int -> GetSessionResponse
newGetSessionResponse Int
pHttpStatus_ =
  GetSessionResponse'
    { $sel:activeContexts:GetSessionResponse' :: Maybe (Sensitive [ActiveContext])
activeContexts =
        forall a. Maybe a
Prelude.Nothing,
      $sel:dialogAction:GetSessionResponse' :: Maybe DialogAction
dialogAction = forall a. Maybe a
Prelude.Nothing,
      $sel:recentIntentSummaryView:GetSessionResponse' :: Maybe [IntentSummary]
recentIntentSummaryView = forall a. Maybe a
Prelude.Nothing,
      $sel:sessionAttributes:GetSessionResponse' :: Maybe (Sensitive (HashMap Text Text))
sessionAttributes = forall a. Maybe a
Prelude.Nothing,
      $sel:sessionId:GetSessionResponse' :: Maybe Text
sessionId = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetSessionResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | A list of active contexts for the session. A context can be set when an
-- intent is fulfilled or by calling the @PostContent@, @PostText@, or
-- @PutSession@ operation.
--
-- You can use a context to control the intents that can follow up an
-- intent, or to modify the operation of your application.
getSessionResponse_activeContexts :: Lens.Lens' GetSessionResponse (Prelude.Maybe [ActiveContext])
getSessionResponse_activeContexts :: Lens' GetSessionResponse (Maybe [ActiveContext])
getSessionResponse_activeContexts = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetSessionResponse' {Maybe (Sensitive [ActiveContext])
activeContexts :: Maybe (Sensitive [ActiveContext])
$sel:activeContexts:GetSessionResponse' :: GetSessionResponse -> Maybe (Sensitive [ActiveContext])
activeContexts} -> Maybe (Sensitive [ActiveContext])
activeContexts) (\s :: GetSessionResponse
s@GetSessionResponse' {} Maybe (Sensitive [ActiveContext])
a -> GetSessionResponse
s {$sel:activeContexts:GetSessionResponse' :: Maybe (Sensitive [ActiveContext])
activeContexts = Maybe (Sensitive [ActiveContext])
a} :: GetSessionResponse) 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)

-- | Describes the current state of the bot.
getSessionResponse_dialogAction :: Lens.Lens' GetSessionResponse (Prelude.Maybe DialogAction)
getSessionResponse_dialogAction :: Lens' GetSessionResponse (Maybe DialogAction)
getSessionResponse_dialogAction = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetSessionResponse' {Maybe DialogAction
dialogAction :: Maybe DialogAction
$sel:dialogAction:GetSessionResponse' :: GetSessionResponse -> Maybe DialogAction
dialogAction} -> Maybe DialogAction
dialogAction) (\s :: GetSessionResponse
s@GetSessionResponse' {} Maybe DialogAction
a -> GetSessionResponse
s {$sel:dialogAction:GetSessionResponse' :: Maybe DialogAction
dialogAction = Maybe DialogAction
a} :: GetSessionResponse)

-- | An array of information about the intents used in the session. The array
-- can contain a maximum of three summaries. If more than three intents are
-- used in the session, the @recentIntentSummaryView@ operation contains
-- information about the last three intents used.
--
-- If you set the @checkpointLabelFilter@ parameter in the request, the
-- array contains only the intents with the specified label.
getSessionResponse_recentIntentSummaryView :: Lens.Lens' GetSessionResponse (Prelude.Maybe [IntentSummary])
getSessionResponse_recentIntentSummaryView :: Lens' GetSessionResponse (Maybe [IntentSummary])
getSessionResponse_recentIntentSummaryView = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetSessionResponse' {Maybe [IntentSummary]
recentIntentSummaryView :: Maybe [IntentSummary]
$sel:recentIntentSummaryView:GetSessionResponse' :: GetSessionResponse -> Maybe [IntentSummary]
recentIntentSummaryView} -> Maybe [IntentSummary]
recentIntentSummaryView) (\s :: GetSessionResponse
s@GetSessionResponse' {} Maybe [IntentSummary]
a -> GetSessionResponse
s {$sel:recentIntentSummaryView:GetSessionResponse' :: Maybe [IntentSummary]
recentIntentSummaryView = Maybe [IntentSummary]
a} :: GetSessionResponse) 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.
getSessionResponse_sessionAttributes :: Lens.Lens' GetSessionResponse (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
getSessionResponse_sessionAttributes :: Lens' GetSessionResponse (Maybe (HashMap Text Text))
getSessionResponse_sessionAttributes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetSessionResponse' {Maybe (Sensitive (HashMap Text Text))
sessionAttributes :: Maybe (Sensitive (HashMap Text Text))
$sel:sessionAttributes:GetSessionResponse' :: GetSessionResponse -> Maybe (Sensitive (HashMap Text Text))
sessionAttributes} -> Maybe (Sensitive (HashMap Text Text))
sessionAttributes) (\s :: GetSessionResponse
s@GetSessionResponse' {} Maybe (Sensitive (HashMap Text Text))
a -> GetSessionResponse
s {$sel:sessionAttributes:GetSessionResponse' :: Maybe (Sensitive (HashMap Text Text))
sessionAttributes = Maybe (Sensitive (HashMap Text Text))
a} :: GetSessionResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping (forall a. Iso' (Sensitive a) a
Data._Sensitive forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced)

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

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

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