{-# 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.StartSession
-- 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 session for running calculations within a workgroup. The
-- session is ready when it reaches an @IDLE@ state.
module Amazonka.Athena.StartSession
  ( -- * Creating a Request
    StartSession (..),
    newStartSession,

    -- * Request Lenses
    startSession_clientRequestToken,
    startSession_description,
    startSession_notebookVersion,
    startSession_sessionIdleTimeoutInMinutes,
    startSession_workGroup,
    startSession_engineConfiguration,

    -- * Destructuring the Response
    StartSessionResponse (..),
    newStartSessionResponse,

    -- * Response Lenses
    startSessionResponse_sessionId,
    startSessionResponse_state,
    startSessionResponse_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:/ 'newStartSession' smart constructor.
data StartSession = StartSession'
  { -- | A unique case-sensitive string used to ensure the request to create the
    -- session is idempotent (executes only once). If another
    -- @StartSessionRequest@ is received, the same response is returned and
    -- another session is not created. If a parameter has changed, an error is
    -- returned.
    --
    -- This token is listed as not required because Amazon Web Services SDKs
    -- (for example the Amazon Web Services SDK for Java) auto-generate the
    -- token for users. If you are not using the Amazon Web Services SDK or the
    -- Amazon Web Services CLI, you must provide this token or the action will
    -- fail.
    StartSession -> Maybe Text
clientRequestToken :: Prelude.Maybe Prelude.Text,
    -- | The session description.
    StartSession -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | The notebook version. This value is required only when requesting that a
    -- notebook server be started for the session. The only valid notebook
    -- version is @Jupyter1.0@.
    StartSession -> Maybe Text
notebookVersion :: Prelude.Maybe Prelude.Text,
    -- | The idle timeout in minutes for the session.
    StartSession -> Maybe Natural
sessionIdleTimeoutInMinutes :: Prelude.Maybe Prelude.Natural,
    -- | The workgroup to which the session belongs.
    StartSession -> Text
workGroup :: Prelude.Text,
    -- | Contains engine data processing unit (DPU) configuration settings and
    -- parameter mappings.
    StartSession -> EngineConfiguration
engineConfiguration :: EngineConfiguration
  }
  deriving (StartSession -> StartSession -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StartSession -> StartSession -> Bool
$c/= :: StartSession -> StartSession -> Bool
== :: StartSession -> StartSession -> Bool
$c== :: StartSession -> StartSession -> Bool
Prelude.Eq, ReadPrec [StartSession]
ReadPrec StartSession
Int -> ReadS StartSession
ReadS [StartSession]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StartSession]
$creadListPrec :: ReadPrec [StartSession]
readPrec :: ReadPrec StartSession
$creadPrec :: ReadPrec StartSession
readList :: ReadS [StartSession]
$creadList :: ReadS [StartSession]
readsPrec :: Int -> ReadS StartSession
$creadsPrec :: Int -> ReadS StartSession
Prelude.Read, Int -> StartSession -> ShowS
[StartSession] -> ShowS
StartSession -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StartSession] -> ShowS
$cshowList :: [StartSession] -> ShowS
show :: StartSession -> String
$cshow :: StartSession -> String
showsPrec :: Int -> StartSession -> ShowS
$cshowsPrec :: Int -> StartSession -> ShowS
Prelude.Show, forall x. Rep StartSession x -> StartSession
forall x. StartSession -> Rep StartSession x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StartSession x -> StartSession
$cfrom :: forall x. StartSession -> Rep StartSession x
Prelude.Generic)

-- |
-- Create a value of 'StartSession' 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:
--
-- 'clientRequestToken', 'startSession_clientRequestToken' - A unique case-sensitive string used to ensure the request to create the
-- session is idempotent (executes only once). If another
-- @StartSessionRequest@ is received, the same response is returned and
-- another session is not created. If a parameter has changed, an error is
-- returned.
--
-- This token is listed as not required because Amazon Web Services SDKs
-- (for example the Amazon Web Services SDK for Java) auto-generate the
-- token for users. If you are not using the Amazon Web Services SDK or the
-- Amazon Web Services CLI, you must provide this token or the action will
-- fail.
--
-- 'description', 'startSession_description' - The session description.
--
-- 'notebookVersion', 'startSession_notebookVersion' - The notebook version. This value is required only when requesting that a
-- notebook server be started for the session. The only valid notebook
-- version is @Jupyter1.0@.
--
-- 'sessionIdleTimeoutInMinutes', 'startSession_sessionIdleTimeoutInMinutes' - The idle timeout in minutes for the session.
--
-- 'workGroup', 'startSession_workGroup' - The workgroup to which the session belongs.
--
-- 'engineConfiguration', 'startSession_engineConfiguration' - Contains engine data processing unit (DPU) configuration settings and
-- parameter mappings.
newStartSession ::
  -- | 'workGroup'
  Prelude.Text ->
  -- | 'engineConfiguration'
  EngineConfiguration ->
  StartSession
newStartSession :: Text -> EngineConfiguration -> StartSession
newStartSession Text
pWorkGroup_ EngineConfiguration
pEngineConfiguration_ =
  StartSession'
    { $sel:clientRequestToken:StartSession' :: Maybe Text
clientRequestToken = forall a. Maybe a
Prelude.Nothing,
      $sel:description:StartSession' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:notebookVersion:StartSession' :: Maybe Text
notebookVersion = forall a. Maybe a
Prelude.Nothing,
      $sel:sessionIdleTimeoutInMinutes:StartSession' :: Maybe Natural
sessionIdleTimeoutInMinutes = forall a. Maybe a
Prelude.Nothing,
      $sel:workGroup:StartSession' :: Text
workGroup = Text
pWorkGroup_,
      $sel:engineConfiguration:StartSession' :: EngineConfiguration
engineConfiguration = EngineConfiguration
pEngineConfiguration_
    }

-- | A unique case-sensitive string used to ensure the request to create the
-- session is idempotent (executes only once). If another
-- @StartSessionRequest@ is received, the same response is returned and
-- another session is not created. If a parameter has changed, an error is
-- returned.
--
-- This token is listed as not required because Amazon Web Services SDKs
-- (for example the Amazon Web Services SDK for Java) auto-generate the
-- token for users. If you are not using the Amazon Web Services SDK or the
-- Amazon Web Services CLI, you must provide this token or the action will
-- fail.
startSession_clientRequestToken :: Lens.Lens' StartSession (Prelude.Maybe Prelude.Text)
startSession_clientRequestToken :: Lens' StartSession (Maybe Text)
startSession_clientRequestToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartSession' {Maybe Text
clientRequestToken :: Maybe Text
$sel:clientRequestToken:StartSession' :: StartSession -> Maybe Text
clientRequestToken} -> Maybe Text
clientRequestToken) (\s :: StartSession
s@StartSession' {} Maybe Text
a -> StartSession
s {$sel:clientRequestToken:StartSession' :: Maybe Text
clientRequestToken = Maybe Text
a} :: StartSession)

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

-- | The notebook version. This value is required only when requesting that a
-- notebook server be started for the session. The only valid notebook
-- version is @Jupyter1.0@.
startSession_notebookVersion :: Lens.Lens' StartSession (Prelude.Maybe Prelude.Text)
startSession_notebookVersion :: Lens' StartSession (Maybe Text)
startSession_notebookVersion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartSession' {Maybe Text
notebookVersion :: Maybe Text
$sel:notebookVersion:StartSession' :: StartSession -> Maybe Text
notebookVersion} -> Maybe Text
notebookVersion) (\s :: StartSession
s@StartSession' {} Maybe Text
a -> StartSession
s {$sel:notebookVersion:StartSession' :: Maybe Text
notebookVersion = Maybe Text
a} :: StartSession)

-- | The idle timeout in minutes for the session.
startSession_sessionIdleTimeoutInMinutes :: Lens.Lens' StartSession (Prelude.Maybe Prelude.Natural)
startSession_sessionIdleTimeoutInMinutes :: Lens' StartSession (Maybe Natural)
startSession_sessionIdleTimeoutInMinutes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartSession' {Maybe Natural
sessionIdleTimeoutInMinutes :: Maybe Natural
$sel:sessionIdleTimeoutInMinutes:StartSession' :: StartSession -> Maybe Natural
sessionIdleTimeoutInMinutes} -> Maybe Natural
sessionIdleTimeoutInMinutes) (\s :: StartSession
s@StartSession' {} Maybe Natural
a -> StartSession
s {$sel:sessionIdleTimeoutInMinutes:StartSession' :: Maybe Natural
sessionIdleTimeoutInMinutes = Maybe Natural
a} :: StartSession)

-- | The workgroup to which the session belongs.
startSession_workGroup :: Lens.Lens' StartSession Prelude.Text
startSession_workGroup :: Lens' StartSession Text
startSession_workGroup = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartSession' {Text
workGroup :: Text
$sel:workGroup:StartSession' :: StartSession -> Text
workGroup} -> Text
workGroup) (\s :: StartSession
s@StartSession' {} Text
a -> StartSession
s {$sel:workGroup:StartSession' :: Text
workGroup = Text
a} :: StartSession)

-- | Contains engine data processing unit (DPU) configuration settings and
-- parameter mappings.
startSession_engineConfiguration :: Lens.Lens' StartSession EngineConfiguration
startSession_engineConfiguration :: Lens' StartSession EngineConfiguration
startSession_engineConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartSession' {EngineConfiguration
engineConfiguration :: EngineConfiguration
$sel:engineConfiguration:StartSession' :: StartSession -> EngineConfiguration
engineConfiguration} -> EngineConfiguration
engineConfiguration) (\s :: StartSession
s@StartSession' {} EngineConfiguration
a -> StartSession
s {$sel:engineConfiguration:StartSession' :: EngineConfiguration
engineConfiguration = EngineConfiguration
a} :: StartSession)

instance Core.AWSRequest StartSession where
  type AWSResponse StartSession = StartSessionResponse
  request :: (Service -> Service) -> StartSession -> Request StartSession
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 StartSession
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse StartSession)))
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 SessionState -> Int -> StartSessionResponse
StartSessionResponse'
            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
"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
"State")
            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 StartSession where
  hashWithSalt :: Int -> StartSession -> Int
hashWithSalt Int
_salt StartSession' {Maybe Natural
Maybe Text
Text
EngineConfiguration
engineConfiguration :: EngineConfiguration
workGroup :: Text
sessionIdleTimeoutInMinutes :: Maybe Natural
notebookVersion :: Maybe Text
description :: Maybe Text
clientRequestToken :: Maybe Text
$sel:engineConfiguration:StartSession' :: StartSession -> EngineConfiguration
$sel:workGroup:StartSession' :: StartSession -> Text
$sel:sessionIdleTimeoutInMinutes:StartSession' :: StartSession -> Maybe Natural
$sel:notebookVersion:StartSession' :: StartSession -> Maybe Text
$sel:description:StartSession' :: StartSession -> Maybe Text
$sel:clientRequestToken:StartSession' :: StartSession -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
clientRequestToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
notebookVersion
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
sessionIdleTimeoutInMinutes
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
workGroup
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` EngineConfiguration
engineConfiguration

instance Prelude.NFData StartSession where
  rnf :: StartSession -> ()
rnf StartSession' {Maybe Natural
Maybe Text
Text
EngineConfiguration
engineConfiguration :: EngineConfiguration
workGroup :: Text
sessionIdleTimeoutInMinutes :: Maybe Natural
notebookVersion :: Maybe Text
description :: Maybe Text
clientRequestToken :: Maybe Text
$sel:engineConfiguration:StartSession' :: StartSession -> EngineConfiguration
$sel:workGroup:StartSession' :: StartSession -> Text
$sel:sessionIdleTimeoutInMinutes:StartSession' :: StartSession -> Maybe Natural
$sel:notebookVersion:StartSession' :: StartSession -> Maybe Text
$sel:description:StartSession' :: StartSession -> Maybe Text
$sel:clientRequestToken:StartSession' :: StartSession -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
clientRequestToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` 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 Text
notebookVersion
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
sessionIdleTimeoutInMinutes
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
workGroup
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf EngineConfiguration
engineConfiguration

instance Data.ToHeaders StartSession where
  toHeaders :: StartSession -> 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.StartSession" :: 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 StartSession where
  toJSON :: StartSession -> Value
toJSON StartSession' {Maybe Natural
Maybe Text
Text
EngineConfiguration
engineConfiguration :: EngineConfiguration
workGroup :: Text
sessionIdleTimeoutInMinutes :: Maybe Natural
notebookVersion :: Maybe Text
description :: Maybe Text
clientRequestToken :: Maybe Text
$sel:engineConfiguration:StartSession' :: StartSession -> EngineConfiguration
$sel:workGroup:StartSession' :: StartSession -> Text
$sel:sessionIdleTimeoutInMinutes:StartSession' :: StartSession -> Maybe Natural
$sel:notebookVersion:StartSession' :: StartSession -> Maybe Text
$sel:description:StartSession' :: StartSession -> Maybe Text
$sel:clientRequestToken:StartSession' :: StartSession -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"ClientRequestToken" 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 Text
clientRequestToken,
            (Key
"Description" 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 Text
description,
            (Key
"NotebookVersion" 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 Text
notebookVersion,
            (Key
"SessionIdleTimeoutInMinutes" 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 Natural
sessionIdleTimeoutInMinutes,
            forall a. a -> Maybe a
Prelude.Just (Key
"WorkGroup" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
workGroup),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"EngineConfiguration" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= EngineConfiguration
engineConfiguration)
          ]
      )

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

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

-- | /See:/ 'newStartSessionResponse' smart constructor.
data StartSessionResponse = StartSessionResponse'
  { -- | The session ID.
    StartSessionResponse -> Maybe Text
sessionId :: Prelude.Maybe Prelude.Text,
    -- | The state of the session. A description of each state follows.
    --
    -- @CREATING@ - The session is being started, including acquiring
    -- resources.
    --
    -- @CREATED@ - The session has been started.
    --
    -- @IDLE@ - The session is able to accept a calculation.
    --
    -- @BUSY@ - The session is processing another task and is unable to accept
    -- a calculation.
    --
    -- @TERMINATING@ - The session is in the process of shutting down.
    --
    -- @TERMINATED@ - The session and its resources are no longer running.
    --
    -- @DEGRADED@ - The session has no healthy coordinators.
    --
    -- @FAILED@ - Due to a failure, the session and its resources are no longer
    -- running.
    StartSessionResponse -> Maybe SessionState
state :: Prelude.Maybe SessionState,
    -- | The response's http status code.
    StartSessionResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (StartSessionResponse -> StartSessionResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StartSessionResponse -> StartSessionResponse -> Bool
$c/= :: StartSessionResponse -> StartSessionResponse -> Bool
== :: StartSessionResponse -> StartSessionResponse -> Bool
$c== :: StartSessionResponse -> StartSessionResponse -> Bool
Prelude.Eq, ReadPrec [StartSessionResponse]
ReadPrec StartSessionResponse
Int -> ReadS StartSessionResponse
ReadS [StartSessionResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StartSessionResponse]
$creadListPrec :: ReadPrec [StartSessionResponse]
readPrec :: ReadPrec StartSessionResponse
$creadPrec :: ReadPrec StartSessionResponse
readList :: ReadS [StartSessionResponse]
$creadList :: ReadS [StartSessionResponse]
readsPrec :: Int -> ReadS StartSessionResponse
$creadsPrec :: Int -> ReadS StartSessionResponse
Prelude.Read, Int -> StartSessionResponse -> ShowS
[StartSessionResponse] -> ShowS
StartSessionResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StartSessionResponse] -> ShowS
$cshowList :: [StartSessionResponse] -> ShowS
show :: StartSessionResponse -> String
$cshow :: StartSessionResponse -> String
showsPrec :: Int -> StartSessionResponse -> ShowS
$cshowsPrec :: Int -> StartSessionResponse -> ShowS
Prelude.Show, forall x. Rep StartSessionResponse x -> StartSessionResponse
forall x. StartSessionResponse -> Rep StartSessionResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StartSessionResponse x -> StartSessionResponse
$cfrom :: forall x. StartSessionResponse -> Rep StartSessionResponse x
Prelude.Generic)

-- |
-- Create a value of 'StartSessionResponse' 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', 'startSessionResponse_sessionId' - The session ID.
--
-- 'state', 'startSessionResponse_state' - The state of the session. A description of each state follows.
--
-- @CREATING@ - The session is being started, including acquiring
-- resources.
--
-- @CREATED@ - The session has been started.
--
-- @IDLE@ - The session is able to accept a calculation.
--
-- @BUSY@ - The session is processing another task and is unable to accept
-- a calculation.
--
-- @TERMINATING@ - The session is in the process of shutting down.
--
-- @TERMINATED@ - The session and its resources are no longer running.
--
-- @DEGRADED@ - The session has no healthy coordinators.
--
-- @FAILED@ - Due to a failure, the session and its resources are no longer
-- running.
--
-- 'httpStatus', 'startSessionResponse_httpStatus' - The response's http status code.
newStartSessionResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  StartSessionResponse
newStartSessionResponse :: Int -> StartSessionResponse
newStartSessionResponse Int
pHttpStatus_ =
  StartSessionResponse'
    { $sel:sessionId:StartSessionResponse' :: Maybe Text
sessionId = forall a. Maybe a
Prelude.Nothing,
      $sel:state:StartSessionResponse' :: Maybe SessionState
state = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:StartSessionResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The session ID.
startSessionResponse_sessionId :: Lens.Lens' StartSessionResponse (Prelude.Maybe Prelude.Text)
startSessionResponse_sessionId :: Lens' StartSessionResponse (Maybe Text)
startSessionResponse_sessionId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartSessionResponse' {Maybe Text
sessionId :: Maybe Text
$sel:sessionId:StartSessionResponse' :: StartSessionResponse -> Maybe Text
sessionId} -> Maybe Text
sessionId) (\s :: StartSessionResponse
s@StartSessionResponse' {} Maybe Text
a -> StartSessionResponse
s {$sel:sessionId:StartSessionResponse' :: Maybe Text
sessionId = Maybe Text
a} :: StartSessionResponse)

-- | The state of the session. A description of each state follows.
--
-- @CREATING@ - The session is being started, including acquiring
-- resources.
--
-- @CREATED@ - The session has been started.
--
-- @IDLE@ - The session is able to accept a calculation.
--
-- @BUSY@ - The session is processing another task and is unable to accept
-- a calculation.
--
-- @TERMINATING@ - The session is in the process of shutting down.
--
-- @TERMINATED@ - The session and its resources are no longer running.
--
-- @DEGRADED@ - The session has no healthy coordinators.
--
-- @FAILED@ - Due to a failure, the session and its resources are no longer
-- running.
startSessionResponse_state :: Lens.Lens' StartSessionResponse (Prelude.Maybe SessionState)
startSessionResponse_state :: Lens' StartSessionResponse (Maybe SessionState)
startSessionResponse_state = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartSessionResponse' {Maybe SessionState
state :: Maybe SessionState
$sel:state:StartSessionResponse' :: StartSessionResponse -> Maybe SessionState
state} -> Maybe SessionState
state) (\s :: StartSessionResponse
s@StartSessionResponse' {} Maybe SessionState
a -> StartSessionResponse
s {$sel:state:StartSessionResponse' :: Maybe SessionState
state = Maybe SessionState
a} :: StartSessionResponse)

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

instance Prelude.NFData StartSessionResponse where
  rnf :: StartSessionResponse -> ()
rnf StartSessionResponse' {Int
Maybe Text
Maybe SessionState
httpStatus :: Int
state :: Maybe SessionState
sessionId :: Maybe Text
$sel:httpStatus:StartSessionResponse' :: StartSessionResponse -> Int
$sel:state:StartSessionResponse' :: StartSessionResponse -> Maybe SessionState
$sel:sessionId:StartSessionResponse' :: StartSessionResponse -> Maybe Text
..} =
    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 SessionState
state
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus