{-# 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.Athena.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)
--
-- Gets the full details of a previously created session, including the
-- session status and configuration.
module Amazonka.Athena.GetSession
  ( -- * Creating a Request
    GetSession (..),
    newGetSession,

    -- * Request Lenses
    getSession_sessionId,

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

    -- * Response Lenses
    getSessionResponse_description,
    getSessionResponse_engineConfiguration,
    getSessionResponse_engineVersion,
    getSessionResponse_notebookVersion,
    getSessionResponse_sessionConfiguration,
    getSessionResponse_sessionId,
    getSessionResponse_statistics,
    getSessionResponse_status,
    getSessionResponse_workGroup,
    getSessionResponse_httpStatus,
  )
where

import Amazonka.Athena.Types
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

-- | /See:/ 'newGetSession' smart constructor.
data GetSession = GetSession'
  { -- | The session ID.
    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:
--
-- 'sessionId', 'getSession_sessionId' - The session ID.
newGetSession ::
  -- | 'sessionId'
  Prelude.Text ->
  GetSession
newGetSession :: Text -> GetSession
newGetSession Text
pSessionId_ =
  GetSession' {$sel:sessionId:GetSession' :: Text
sessionId = Text
pSessionId_}

-- | The session ID.
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, ToJSON a) => Service -> a -> Request a
Request.postJSON (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 Text
-> Maybe EngineConfiguration
-> Maybe Text
-> Maybe Text
-> Maybe SessionConfiguration
-> Maybe Text
-> Maybe SessionStatistics
-> Maybe SessionStatus
-> 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
"Description")
            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
"EngineConfiguration")
            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
"EngineVersion")
            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
"NotebookVersion")
            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
"SessionConfiguration")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"SessionId")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"Statistics")
            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
"Status")
            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
"WorkGroup")
            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
$sel:sessionId:GetSession' :: GetSession -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
sessionId

instance Prelude.NFData GetSession where
  rnf :: GetSession -> ()
rnf GetSession' {Text
sessionId :: Text
$sel:sessionId:GetSession' :: GetSession -> Text
..} = 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
"X-Amz-Target"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# (ByteString
"AmazonAthena.GetSession" :: Prelude.ByteString),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON GetSession where
  toJSON :: GetSession -> Value
toJSON GetSession' {Text
sessionId :: Text
$sel:sessionId:GetSession' :: GetSession -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [forall a. a -> Maybe a
Prelude.Just (Key
"SessionId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
sessionId)]
      )

instance Data.ToPath GetSession where
  toPath :: GetSession -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

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 description.
    GetSessionResponse -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | Contains engine configuration information like DPU usage.
    GetSessionResponse -> Maybe EngineConfiguration
engineConfiguration :: Prelude.Maybe EngineConfiguration,
    -- | The engine version used by the session (for example,
    -- @PySpark engine version 3@). You can get a list of engine versions by
    -- calling ListEngineVersions.
    GetSessionResponse -> Maybe Text
engineVersion :: Prelude.Maybe Prelude.Text,
    -- | The notebook version.
    GetSessionResponse -> Maybe Text
notebookVersion :: Prelude.Maybe Prelude.Text,
    -- | Contains the workgroup configuration information used by the session.
    GetSessionResponse -> Maybe SessionConfiguration
sessionConfiguration :: Prelude.Maybe SessionConfiguration,
    -- | The session ID.
    GetSessionResponse -> Maybe Text
sessionId :: Prelude.Maybe Prelude.Text,
    -- | Contains the DPU execution time.
    GetSessionResponse -> Maybe SessionStatistics
statistics :: Prelude.Maybe SessionStatistics,
    -- | Contains information about the status of the session.
    GetSessionResponse -> Maybe SessionStatus
status :: Prelude.Maybe SessionStatus,
    -- | The workgroup to which the session belongs.
    GetSessionResponse -> Maybe Text
workGroup :: 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, 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:
--
-- 'description', 'getSessionResponse_description' - The session description.
--
-- 'engineConfiguration', 'getSessionResponse_engineConfiguration' - Contains engine configuration information like DPU usage.
--
-- 'engineVersion', 'getSessionResponse_engineVersion' - The engine version used by the session (for example,
-- @PySpark engine version 3@). You can get a list of engine versions by
-- calling ListEngineVersions.
--
-- 'notebookVersion', 'getSessionResponse_notebookVersion' - The notebook version.
--
-- 'sessionConfiguration', 'getSessionResponse_sessionConfiguration' - Contains the workgroup configuration information used by the session.
--
-- 'sessionId', 'getSessionResponse_sessionId' - The session ID.
--
-- 'statistics', 'getSessionResponse_statistics' - Contains the DPU execution time.
--
-- 'status', 'getSessionResponse_status' - Contains information about the status of the session.
--
-- 'workGroup', 'getSessionResponse_workGroup' - The workgroup to which the session belongs.
--
-- 'httpStatus', 'getSessionResponse_httpStatus' - The response's http status code.
newGetSessionResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetSessionResponse
newGetSessionResponse :: Int -> GetSessionResponse
newGetSessionResponse Int
pHttpStatus_ =
  GetSessionResponse'
    { $sel:description:GetSessionResponse' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:engineConfiguration:GetSessionResponse' :: Maybe EngineConfiguration
engineConfiguration = forall a. Maybe a
Prelude.Nothing,
      $sel:engineVersion:GetSessionResponse' :: Maybe Text
engineVersion = forall a. Maybe a
Prelude.Nothing,
      $sel:notebookVersion:GetSessionResponse' :: Maybe Text
notebookVersion = forall a. Maybe a
Prelude.Nothing,
      $sel:sessionConfiguration:GetSessionResponse' :: Maybe SessionConfiguration
sessionConfiguration = forall a. Maybe a
Prelude.Nothing,
      $sel:sessionId:GetSessionResponse' :: Maybe Text
sessionId = forall a. Maybe a
Prelude.Nothing,
      $sel:statistics:GetSessionResponse' :: Maybe SessionStatistics
statistics = forall a. Maybe a
Prelude.Nothing,
      $sel:status:GetSessionResponse' :: Maybe SessionStatus
status = forall a. Maybe a
Prelude.Nothing,
      $sel:workGroup:GetSessionResponse' :: Maybe Text
workGroup = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetSessionResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The session description.
getSessionResponse_description :: Lens.Lens' GetSessionResponse (Prelude.Maybe Prelude.Text)
getSessionResponse_description :: Lens' GetSessionResponse (Maybe Text)
getSessionResponse_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetSessionResponse' {Maybe Text
description :: Maybe Text
$sel:description:GetSessionResponse' :: GetSessionResponse -> Maybe Text
description} -> Maybe Text
description) (\s :: GetSessionResponse
s@GetSessionResponse' {} Maybe Text
a -> GetSessionResponse
s {$sel:description:GetSessionResponse' :: Maybe Text
description = Maybe Text
a} :: GetSessionResponse)

-- | Contains engine configuration information like DPU usage.
getSessionResponse_engineConfiguration :: Lens.Lens' GetSessionResponse (Prelude.Maybe EngineConfiguration)
getSessionResponse_engineConfiguration :: Lens' GetSessionResponse (Maybe EngineConfiguration)
getSessionResponse_engineConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetSessionResponse' {Maybe EngineConfiguration
engineConfiguration :: Maybe EngineConfiguration
$sel:engineConfiguration:GetSessionResponse' :: GetSessionResponse -> Maybe EngineConfiguration
engineConfiguration} -> Maybe EngineConfiguration
engineConfiguration) (\s :: GetSessionResponse
s@GetSessionResponse' {} Maybe EngineConfiguration
a -> GetSessionResponse
s {$sel:engineConfiguration:GetSessionResponse' :: Maybe EngineConfiguration
engineConfiguration = Maybe EngineConfiguration
a} :: GetSessionResponse)

-- | The engine version used by the session (for example,
-- @PySpark engine version 3@). You can get a list of engine versions by
-- calling ListEngineVersions.
getSessionResponse_engineVersion :: Lens.Lens' GetSessionResponse (Prelude.Maybe Prelude.Text)
getSessionResponse_engineVersion :: Lens' GetSessionResponse (Maybe Text)
getSessionResponse_engineVersion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetSessionResponse' {Maybe Text
engineVersion :: Maybe Text
$sel:engineVersion:GetSessionResponse' :: GetSessionResponse -> Maybe Text
engineVersion} -> Maybe Text
engineVersion) (\s :: GetSessionResponse
s@GetSessionResponse' {} Maybe Text
a -> GetSessionResponse
s {$sel:engineVersion:GetSessionResponse' :: Maybe Text
engineVersion = Maybe Text
a} :: GetSessionResponse)

-- | The notebook version.
getSessionResponse_notebookVersion :: Lens.Lens' GetSessionResponse (Prelude.Maybe Prelude.Text)
getSessionResponse_notebookVersion :: Lens' GetSessionResponse (Maybe Text)
getSessionResponse_notebookVersion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetSessionResponse' {Maybe Text
notebookVersion :: Maybe Text
$sel:notebookVersion:GetSessionResponse' :: GetSessionResponse -> Maybe Text
notebookVersion} -> Maybe Text
notebookVersion) (\s :: GetSessionResponse
s@GetSessionResponse' {} Maybe Text
a -> GetSessionResponse
s {$sel:notebookVersion:GetSessionResponse' :: Maybe Text
notebookVersion = Maybe Text
a} :: GetSessionResponse)

-- | Contains the workgroup configuration information used by the session.
getSessionResponse_sessionConfiguration :: Lens.Lens' GetSessionResponse (Prelude.Maybe SessionConfiguration)
getSessionResponse_sessionConfiguration :: Lens' GetSessionResponse (Maybe SessionConfiguration)
getSessionResponse_sessionConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetSessionResponse' {Maybe SessionConfiguration
sessionConfiguration :: Maybe SessionConfiguration
$sel:sessionConfiguration:GetSessionResponse' :: GetSessionResponse -> Maybe SessionConfiguration
sessionConfiguration} -> Maybe SessionConfiguration
sessionConfiguration) (\s :: GetSessionResponse
s@GetSessionResponse' {} Maybe SessionConfiguration
a -> GetSessionResponse
s {$sel:sessionConfiguration:GetSessionResponse' :: Maybe SessionConfiguration
sessionConfiguration = Maybe SessionConfiguration
a} :: GetSessionResponse)

-- | The session ID.
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)

-- | Contains the DPU execution time.
getSessionResponse_statistics :: Lens.Lens' GetSessionResponse (Prelude.Maybe SessionStatistics)
getSessionResponse_statistics :: Lens' GetSessionResponse (Maybe SessionStatistics)
getSessionResponse_statistics = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetSessionResponse' {Maybe SessionStatistics
statistics :: Maybe SessionStatistics
$sel:statistics:GetSessionResponse' :: GetSessionResponse -> Maybe SessionStatistics
statistics} -> Maybe SessionStatistics
statistics) (\s :: GetSessionResponse
s@GetSessionResponse' {} Maybe SessionStatistics
a -> GetSessionResponse
s {$sel:statistics:GetSessionResponse' :: Maybe SessionStatistics
statistics = Maybe SessionStatistics
a} :: GetSessionResponse)

-- | Contains information about the status of the session.
getSessionResponse_status :: Lens.Lens' GetSessionResponse (Prelude.Maybe SessionStatus)
getSessionResponse_status :: Lens' GetSessionResponse (Maybe SessionStatus)
getSessionResponse_status = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetSessionResponse' {Maybe SessionStatus
status :: Maybe SessionStatus
$sel:status:GetSessionResponse' :: GetSessionResponse -> Maybe SessionStatus
status} -> Maybe SessionStatus
status) (\s :: GetSessionResponse
s@GetSessionResponse' {} Maybe SessionStatus
a -> GetSessionResponse
s {$sel:status:GetSessionResponse' :: Maybe SessionStatus
status = Maybe SessionStatus
a} :: GetSessionResponse)

-- | The workgroup to which the session belongs.
getSessionResponse_workGroup :: Lens.Lens' GetSessionResponse (Prelude.Maybe Prelude.Text)
getSessionResponse_workGroup :: Lens' GetSessionResponse (Maybe Text)
getSessionResponse_workGroup = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetSessionResponse' {Maybe Text
workGroup :: Maybe Text
$sel:workGroup:GetSessionResponse' :: GetSessionResponse -> Maybe Text
workGroup} -> Maybe Text
workGroup) (\s :: GetSessionResponse
s@GetSessionResponse' {} Maybe Text
a -> GetSessionResponse
s {$sel:workGroup:GetSessionResponse' :: Maybe Text
workGroup = 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 Text
Maybe EngineConfiguration
Maybe SessionConfiguration
Maybe SessionStatistics
Maybe SessionStatus
httpStatus :: Int
workGroup :: Maybe Text
status :: Maybe SessionStatus
statistics :: Maybe SessionStatistics
sessionId :: Maybe Text
sessionConfiguration :: Maybe SessionConfiguration
notebookVersion :: Maybe Text
engineVersion :: Maybe Text
engineConfiguration :: Maybe EngineConfiguration
description :: Maybe Text
$sel:httpStatus:GetSessionResponse' :: GetSessionResponse -> Int
$sel:workGroup:GetSessionResponse' :: GetSessionResponse -> Maybe Text
$sel:status:GetSessionResponse' :: GetSessionResponse -> Maybe SessionStatus
$sel:statistics:GetSessionResponse' :: GetSessionResponse -> Maybe SessionStatistics
$sel:sessionId:GetSessionResponse' :: GetSessionResponse -> Maybe Text
$sel:sessionConfiguration:GetSessionResponse' :: GetSessionResponse -> Maybe SessionConfiguration
$sel:notebookVersion:GetSessionResponse' :: GetSessionResponse -> Maybe Text
$sel:engineVersion:GetSessionResponse' :: GetSessionResponse -> Maybe Text
$sel:engineConfiguration:GetSessionResponse' :: GetSessionResponse -> Maybe EngineConfiguration
$sel:description:GetSessionResponse' :: GetSessionResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
description
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe EngineConfiguration
engineConfiguration
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
engineVersion
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
notebookVersion
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe SessionConfiguration
sessionConfiguration
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
sessionId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe SessionStatistics
statistics
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe SessionStatus
status
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
workGroup
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus