{-# 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.Wisdom.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)
--
-- Retrieves information for a specified session.
module Amazonka.Wisdom.GetSession
  ( -- * Creating a Request
    GetSession (..),
    newGetSession,

    -- * Request Lenses
    getSession_assistantId,
    getSession_sessionId,

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

    -- * Response Lenses
    getSessionResponse_session,
    getSessionResponse_httpStatus,
  )
where

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

-- | /See:/ 'newGetSession' smart constructor.
data GetSession = GetSession'
  { -- | The identifier of the Wisdom assistant. Can be either the ID or the ARN.
    -- URLs cannot contain the ARN.
    GetSession -> Text
assistantId :: Prelude.Text,
    -- | The identifier of the session. Can be either the ID or the ARN. URLs
    -- cannot contain the ARN.
    GetSession -> Text
sessionId :: 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:
--
-- 'assistantId', 'getSession_assistantId' - The identifier of the Wisdom assistant. Can be either the ID or the ARN.
-- URLs cannot contain the ARN.
--
-- 'sessionId', 'getSession_sessionId' - The identifier of the session. Can be either the ID or the ARN. URLs
-- cannot contain the ARN.
newGetSession ::
  -- | 'assistantId'
  Prelude.Text ->
  -- | 'sessionId'
  Prelude.Text ->
  GetSession
newGetSession :: Text -> Text -> GetSession
newGetSession Text
pAssistantId_ Text
pSessionId_ =
  GetSession'
    { $sel:assistantId:GetSession' :: Text
assistantId = Text
pAssistantId_,
      $sel:sessionId:GetSession' :: Text
sessionId = Text
pSessionId_
    }

-- | The identifier of the Wisdom assistant. Can be either the ID or the ARN.
-- URLs cannot contain the ARN.
getSession_assistantId :: Lens.Lens' GetSession Prelude.Text
getSession_assistantId :: Lens' GetSession Text
getSession_assistantId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetSession' {Text
assistantId :: Text
$sel:assistantId:GetSession' :: GetSession -> Text
assistantId} -> Text
assistantId) (\s :: GetSession
s@GetSession' {} Text
a -> GetSession
s {$sel:assistantId:GetSession' :: Text
assistantId = Text
a} :: GetSession)

-- | The identifier of the session. Can be either the ID or the ARN. URLs
-- cannot contain the ARN.
getSession_sessionId :: Lens.Lens' GetSession Prelude.Text
getSession_sessionId :: Lens' GetSession Text
getSession_sessionId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetSession' {Text
sessionId :: Text
$sel:sessionId:GetSession' :: GetSession -> Text
sessionId} -> Text
sessionId) (\s :: GetSession
s@GetSession' {} Text
a -> GetSession
s {$sel:sessionId:GetSession' :: Text
sessionId = 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 SessionData -> 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
"session")
            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' {Text
sessionId :: Text
assistantId :: Text
$sel:sessionId:GetSession' :: GetSession -> Text
$sel:assistantId:GetSession' :: GetSession -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
assistantId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
sessionId

instance Prelude.NFData GetSession where
  rnf :: GetSession -> ()
rnf GetSession' {Text
sessionId :: Text
assistantId :: Text
$sel:sessionId:GetSession' :: GetSession -> Text
$sel:assistantId:GetSession' :: GetSession -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
assistantId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
sessionId

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' {Text
sessionId :: Text
assistantId :: Text
$sel:sessionId:GetSession' :: GetSession -> Text
$sel:assistantId:GetSession' :: GetSession -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/assistants/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
assistantId,
        ByteString
"/sessions/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
sessionId
      ]

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

-- | /See:/ 'newGetSessionResponse' smart constructor.
data GetSessionResponse = GetSessionResponse'
  { -- | The session.
    GetSessionResponse -> Maybe SessionData
session :: Prelude.Maybe SessionData,
    -- | 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, ReadPrec [GetSessionResponse]
ReadPrec GetSessionResponse
Int -> ReadS GetSessionResponse
ReadS [GetSessionResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetSessionResponse]
$creadListPrec :: ReadPrec [GetSessionResponse]
readPrec :: ReadPrec GetSessionResponse
$creadPrec :: ReadPrec GetSessionResponse
readList :: ReadS [GetSessionResponse]
$creadList :: ReadS [GetSessionResponse]
readsPrec :: Int -> ReadS GetSessionResponse
$creadsPrec :: Int -> ReadS GetSessionResponse
Prelude.Read, 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:
--
-- 'session', 'getSessionResponse_session' - The session.
--
-- 'httpStatus', 'getSessionResponse_httpStatus' - The response's http status code.
newGetSessionResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetSessionResponse
newGetSessionResponse :: Int -> GetSessionResponse
newGetSessionResponse Int
pHttpStatus_ =
  GetSessionResponse'
    { $sel:session:GetSessionResponse' :: Maybe SessionData
session = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetSessionResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The session.
getSessionResponse_session :: Lens.Lens' GetSessionResponse (Prelude.Maybe SessionData)
getSessionResponse_session :: Lens' GetSessionResponse (Maybe SessionData)
getSessionResponse_session = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetSessionResponse' {Maybe SessionData
session :: Maybe SessionData
$sel:session:GetSessionResponse' :: GetSessionResponse -> Maybe SessionData
session} -> Maybe SessionData
session) (\s :: GetSessionResponse
s@GetSessionResponse' {} Maybe SessionData
a -> GetSessionResponse
s {$sel:session:GetSessionResponse' :: Maybe SessionData
session = Maybe SessionData
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 SessionData
httpStatus :: Int
session :: Maybe SessionData
$sel:httpStatus:GetSessionResponse' :: GetSessionResponse -> Int
$sel:session:GetSessionResponse' :: GetSessionResponse -> Maybe SessionData
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe SessionData
session
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus