{-# 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.Glue.CreateSession
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Creates a new session.
module Amazonka.Glue.CreateSession
  ( -- * Creating a Request
    CreateSession (..),
    newCreateSession,

    -- * Request Lenses
    createSession_connections,
    createSession_defaultArguments,
    createSession_description,
    createSession_glueVersion,
    createSession_idleTimeout,
    createSession_maxCapacity,
    createSession_numberOfWorkers,
    createSession_requestOrigin,
    createSession_securityConfiguration,
    createSession_tags,
    createSession_timeout,
    createSession_workerType,
    createSession_id,
    createSession_role,
    createSession_command,

    -- * Destructuring the Response
    CreateSessionResponse (..),
    newCreateSessionResponse,

    -- * Response Lenses
    createSessionResponse_session,
    createSessionResponse_httpStatus,
  )
where

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

-- | Request to create a new session.
--
-- /See:/ 'newCreateSession' smart constructor.
data CreateSession = CreateSession'
  { -- | The number of connections to use for the session.
    CreateSession -> Maybe ConnectionsList
connections :: Prelude.Maybe ConnectionsList,
    -- | A map array of key-value pairs. Max is 75 pairs.
    CreateSession -> Maybe (HashMap Text Text)
defaultArguments :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | The description of the session.
    CreateSession -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | The Glue version determines the versions of Apache Spark and Python that
    -- Glue supports. The GlueVersion must be greater than 2.0.
    CreateSession -> Maybe Text
glueVersion :: Prelude.Maybe Prelude.Text,
    -- | The number of seconds when idle before request times out.
    CreateSession -> Maybe Natural
idleTimeout :: Prelude.Maybe Prelude.Natural,
    -- | The number of Glue data processing units (DPUs) that can be allocated
    -- when the job runs. A DPU is a relative measure of processing power that
    -- consists of 4 vCPUs of compute capacity and 16 GB memory.
    CreateSession -> Maybe Double
maxCapacity :: Prelude.Maybe Prelude.Double,
    -- | The number of workers of a defined @WorkerType@ to use for the session.
    CreateSession -> Maybe Int
numberOfWorkers :: Prelude.Maybe Prelude.Int,
    -- | The origin of the request.
    CreateSession -> Maybe Text
requestOrigin :: Prelude.Maybe Prelude.Text,
    -- | The name of the SecurityConfiguration structure to be used with the
    -- session
    CreateSession -> Maybe Text
securityConfiguration :: Prelude.Maybe Prelude.Text,
    -- | The map of key value pairs (tags) belonging to the session.
    CreateSession -> Maybe (HashMap Text Text)
tags :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | The number of seconds before request times out.
    CreateSession -> Maybe Natural
timeout :: Prelude.Maybe Prelude.Natural,
    -- | The type of predefined worker that is allocated to use for the session.
    -- Accepts a value of Standard, G.1X, G.2X, or G.025X.
    --
    -- -   For the @Standard@ worker type, each worker provides 4 vCPU, 16 GB
    --     of memory and a 50GB disk, and 2 executors per worker.
    --
    -- -   For the @G.1X@ worker type, each worker maps to 1 DPU (4 vCPU, 16 GB
    --     of memory, 64 GB disk), and provides 1 executor per worker. We
    --     recommend this worker type for memory-intensive jobs.
    --
    -- -   For the @G.2X@ worker type, each worker maps to 2 DPU (8 vCPU, 32 GB
    --     of memory, 128 GB disk), and provides 1 executor per worker. We
    --     recommend this worker type for memory-intensive jobs.
    --
    -- -   For the @G.025X@ worker type, each worker maps to 0.25 DPU (2 vCPU,
    --     4 GB of memory, 64 GB disk), and provides 1 executor per worker. We
    --     recommend this worker type for low volume streaming jobs. This
    --     worker type is only available for Glue version 3.0 streaming jobs.
    CreateSession -> Maybe WorkerType
workerType :: Prelude.Maybe WorkerType,
    -- | The ID of the session request.
    CreateSession -> Text
id :: Prelude.Text,
    -- | The IAM Role ARN
    CreateSession -> Text
role' :: Prelude.Text,
    -- | The @SessionCommand@ that runs the job.
    CreateSession -> SessionCommand
command :: SessionCommand
  }
  deriving (CreateSession -> CreateSession -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateSession -> CreateSession -> Bool
$c/= :: CreateSession -> CreateSession -> Bool
== :: CreateSession -> CreateSession -> Bool
$c== :: CreateSession -> CreateSession -> Bool
Prelude.Eq, ReadPrec [CreateSession]
ReadPrec CreateSession
Int -> ReadS CreateSession
ReadS [CreateSession]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateSession]
$creadListPrec :: ReadPrec [CreateSession]
readPrec :: ReadPrec CreateSession
$creadPrec :: ReadPrec CreateSession
readList :: ReadS [CreateSession]
$creadList :: ReadS [CreateSession]
readsPrec :: Int -> ReadS CreateSession
$creadsPrec :: Int -> ReadS CreateSession
Prelude.Read, Int -> CreateSession -> ShowS
[CreateSession] -> ShowS
CreateSession -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateSession] -> ShowS
$cshowList :: [CreateSession] -> ShowS
show :: CreateSession -> String
$cshow :: CreateSession -> String
showsPrec :: Int -> CreateSession -> ShowS
$cshowsPrec :: Int -> CreateSession -> ShowS
Prelude.Show, forall x. Rep CreateSession x -> CreateSession
forall x. CreateSession -> Rep CreateSession x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateSession x -> CreateSession
$cfrom :: forall x. CreateSession -> Rep CreateSession x
Prelude.Generic)

-- |
-- Create a value of 'CreateSession' 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:
--
-- 'connections', 'createSession_connections' - The number of connections to use for the session.
--
-- 'defaultArguments', 'createSession_defaultArguments' - A map array of key-value pairs. Max is 75 pairs.
--
-- 'description', 'createSession_description' - The description of the session.
--
-- 'glueVersion', 'createSession_glueVersion' - The Glue version determines the versions of Apache Spark and Python that
-- Glue supports. The GlueVersion must be greater than 2.0.
--
-- 'idleTimeout', 'createSession_idleTimeout' - The number of seconds when idle before request times out.
--
-- 'maxCapacity', 'createSession_maxCapacity' - The number of Glue data processing units (DPUs) that can be allocated
-- when the job runs. A DPU is a relative measure of processing power that
-- consists of 4 vCPUs of compute capacity and 16 GB memory.
--
-- 'numberOfWorkers', 'createSession_numberOfWorkers' - The number of workers of a defined @WorkerType@ to use for the session.
--
-- 'requestOrigin', 'createSession_requestOrigin' - The origin of the request.
--
-- 'securityConfiguration', 'createSession_securityConfiguration' - The name of the SecurityConfiguration structure to be used with the
-- session
--
-- 'tags', 'createSession_tags' - The map of key value pairs (tags) belonging to the session.
--
-- 'timeout', 'createSession_timeout' - The number of seconds before request times out.
--
-- 'workerType', 'createSession_workerType' - The type of predefined worker that is allocated to use for the session.
-- Accepts a value of Standard, G.1X, G.2X, or G.025X.
--
-- -   For the @Standard@ worker type, each worker provides 4 vCPU, 16 GB
--     of memory and a 50GB disk, and 2 executors per worker.
--
-- -   For the @G.1X@ worker type, each worker maps to 1 DPU (4 vCPU, 16 GB
--     of memory, 64 GB disk), and provides 1 executor per worker. We
--     recommend this worker type for memory-intensive jobs.
--
-- -   For the @G.2X@ worker type, each worker maps to 2 DPU (8 vCPU, 32 GB
--     of memory, 128 GB disk), and provides 1 executor per worker. We
--     recommend this worker type for memory-intensive jobs.
--
-- -   For the @G.025X@ worker type, each worker maps to 0.25 DPU (2 vCPU,
--     4 GB of memory, 64 GB disk), and provides 1 executor per worker. We
--     recommend this worker type for low volume streaming jobs. This
--     worker type is only available for Glue version 3.0 streaming jobs.
--
-- 'id', 'createSession_id' - The ID of the session request.
--
-- 'role'', 'createSession_role' - The IAM Role ARN
--
-- 'command', 'createSession_command' - The @SessionCommand@ that runs the job.
newCreateSession ::
  -- | 'id'
  Prelude.Text ->
  -- | 'role''
  Prelude.Text ->
  -- | 'command'
  SessionCommand ->
  CreateSession
newCreateSession :: Text -> Text -> SessionCommand -> CreateSession
newCreateSession Text
pId_ Text
pRole_ SessionCommand
pCommand_ =
  CreateSession'
    { $sel:connections:CreateSession' :: Maybe ConnectionsList
connections = forall a. Maybe a
Prelude.Nothing,
      $sel:defaultArguments:CreateSession' :: Maybe (HashMap Text Text)
defaultArguments = forall a. Maybe a
Prelude.Nothing,
      $sel:description:CreateSession' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:glueVersion:CreateSession' :: Maybe Text
glueVersion = forall a. Maybe a
Prelude.Nothing,
      $sel:idleTimeout:CreateSession' :: Maybe Natural
idleTimeout = forall a. Maybe a
Prelude.Nothing,
      $sel:maxCapacity:CreateSession' :: Maybe Double
maxCapacity = forall a. Maybe a
Prelude.Nothing,
      $sel:numberOfWorkers:CreateSession' :: Maybe Int
numberOfWorkers = forall a. Maybe a
Prelude.Nothing,
      $sel:requestOrigin:CreateSession' :: Maybe Text
requestOrigin = forall a. Maybe a
Prelude.Nothing,
      $sel:securityConfiguration:CreateSession' :: Maybe Text
securityConfiguration = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:CreateSession' :: Maybe (HashMap Text Text)
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:timeout:CreateSession' :: Maybe Natural
timeout = forall a. Maybe a
Prelude.Nothing,
      $sel:workerType:CreateSession' :: Maybe WorkerType
workerType = forall a. Maybe a
Prelude.Nothing,
      $sel:id:CreateSession' :: Text
id = Text
pId_,
      $sel:role':CreateSession' :: Text
role' = Text
pRole_,
      $sel:command:CreateSession' :: SessionCommand
command = SessionCommand
pCommand_
    }

-- | The number of connections to use for the session.
createSession_connections :: Lens.Lens' CreateSession (Prelude.Maybe ConnectionsList)
createSession_connections :: Lens' CreateSession (Maybe ConnectionsList)
createSession_connections = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateSession' {Maybe ConnectionsList
connections :: Maybe ConnectionsList
$sel:connections:CreateSession' :: CreateSession -> Maybe ConnectionsList
connections} -> Maybe ConnectionsList
connections) (\s :: CreateSession
s@CreateSession' {} Maybe ConnectionsList
a -> CreateSession
s {$sel:connections:CreateSession' :: Maybe ConnectionsList
connections = Maybe ConnectionsList
a} :: CreateSession)

-- | A map array of key-value pairs. Max is 75 pairs.
createSession_defaultArguments :: Lens.Lens' CreateSession (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
createSession_defaultArguments :: Lens' CreateSession (Maybe (HashMap Text Text))
createSession_defaultArguments = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateSession' {Maybe (HashMap Text Text)
defaultArguments :: Maybe (HashMap Text Text)
$sel:defaultArguments:CreateSession' :: CreateSession -> Maybe (HashMap Text Text)
defaultArguments} -> Maybe (HashMap Text Text)
defaultArguments) (\s :: CreateSession
s@CreateSession' {} Maybe (HashMap Text Text)
a -> CreateSession
s {$sel:defaultArguments:CreateSession' :: Maybe (HashMap Text Text)
defaultArguments = Maybe (HashMap Text Text)
a} :: CreateSession) 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

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

-- | The Glue version determines the versions of Apache Spark and Python that
-- Glue supports. The GlueVersion must be greater than 2.0.
createSession_glueVersion :: Lens.Lens' CreateSession (Prelude.Maybe Prelude.Text)
createSession_glueVersion :: Lens' CreateSession (Maybe Text)
createSession_glueVersion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateSession' {Maybe Text
glueVersion :: Maybe Text
$sel:glueVersion:CreateSession' :: CreateSession -> Maybe Text
glueVersion} -> Maybe Text
glueVersion) (\s :: CreateSession
s@CreateSession' {} Maybe Text
a -> CreateSession
s {$sel:glueVersion:CreateSession' :: Maybe Text
glueVersion = Maybe Text
a} :: CreateSession)

-- | The number of seconds when idle before request times out.
createSession_idleTimeout :: Lens.Lens' CreateSession (Prelude.Maybe Prelude.Natural)
createSession_idleTimeout :: Lens' CreateSession (Maybe Natural)
createSession_idleTimeout = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateSession' {Maybe Natural
idleTimeout :: Maybe Natural
$sel:idleTimeout:CreateSession' :: CreateSession -> Maybe Natural
idleTimeout} -> Maybe Natural
idleTimeout) (\s :: CreateSession
s@CreateSession' {} Maybe Natural
a -> CreateSession
s {$sel:idleTimeout:CreateSession' :: Maybe Natural
idleTimeout = Maybe Natural
a} :: CreateSession)

-- | The number of Glue data processing units (DPUs) that can be allocated
-- when the job runs. A DPU is a relative measure of processing power that
-- consists of 4 vCPUs of compute capacity and 16 GB memory.
createSession_maxCapacity :: Lens.Lens' CreateSession (Prelude.Maybe Prelude.Double)
createSession_maxCapacity :: Lens' CreateSession (Maybe Double)
createSession_maxCapacity = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateSession' {Maybe Double
maxCapacity :: Maybe Double
$sel:maxCapacity:CreateSession' :: CreateSession -> Maybe Double
maxCapacity} -> Maybe Double
maxCapacity) (\s :: CreateSession
s@CreateSession' {} Maybe Double
a -> CreateSession
s {$sel:maxCapacity:CreateSession' :: Maybe Double
maxCapacity = Maybe Double
a} :: CreateSession)

-- | The number of workers of a defined @WorkerType@ to use for the session.
createSession_numberOfWorkers :: Lens.Lens' CreateSession (Prelude.Maybe Prelude.Int)
createSession_numberOfWorkers :: Lens' CreateSession (Maybe Int)
createSession_numberOfWorkers = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateSession' {Maybe Int
numberOfWorkers :: Maybe Int
$sel:numberOfWorkers:CreateSession' :: CreateSession -> Maybe Int
numberOfWorkers} -> Maybe Int
numberOfWorkers) (\s :: CreateSession
s@CreateSession' {} Maybe Int
a -> CreateSession
s {$sel:numberOfWorkers:CreateSession' :: Maybe Int
numberOfWorkers = Maybe Int
a} :: CreateSession)

-- | The origin of the request.
createSession_requestOrigin :: Lens.Lens' CreateSession (Prelude.Maybe Prelude.Text)
createSession_requestOrigin :: Lens' CreateSession (Maybe Text)
createSession_requestOrigin = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateSession' {Maybe Text
requestOrigin :: Maybe Text
$sel:requestOrigin:CreateSession' :: CreateSession -> Maybe Text
requestOrigin} -> Maybe Text
requestOrigin) (\s :: CreateSession
s@CreateSession' {} Maybe Text
a -> CreateSession
s {$sel:requestOrigin:CreateSession' :: Maybe Text
requestOrigin = Maybe Text
a} :: CreateSession)

-- | The name of the SecurityConfiguration structure to be used with the
-- session
createSession_securityConfiguration :: Lens.Lens' CreateSession (Prelude.Maybe Prelude.Text)
createSession_securityConfiguration :: Lens' CreateSession (Maybe Text)
createSession_securityConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateSession' {Maybe Text
securityConfiguration :: Maybe Text
$sel:securityConfiguration:CreateSession' :: CreateSession -> Maybe Text
securityConfiguration} -> Maybe Text
securityConfiguration) (\s :: CreateSession
s@CreateSession' {} Maybe Text
a -> CreateSession
s {$sel:securityConfiguration:CreateSession' :: Maybe Text
securityConfiguration = Maybe Text
a} :: CreateSession)

-- | The map of key value pairs (tags) belonging to the session.
createSession_tags :: Lens.Lens' CreateSession (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
createSession_tags :: Lens' CreateSession (Maybe (HashMap Text Text))
createSession_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateSession' {Maybe (HashMap Text Text)
tags :: Maybe (HashMap Text Text)
$sel:tags:CreateSession' :: CreateSession -> Maybe (HashMap Text Text)
tags} -> Maybe (HashMap Text Text)
tags) (\s :: CreateSession
s@CreateSession' {} Maybe (HashMap Text Text)
a -> CreateSession
s {$sel:tags:CreateSession' :: Maybe (HashMap Text Text)
tags = Maybe (HashMap Text Text)
a} :: CreateSession) 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

-- | The number of seconds before request times out.
createSession_timeout :: Lens.Lens' CreateSession (Prelude.Maybe Prelude.Natural)
createSession_timeout :: Lens' CreateSession (Maybe Natural)
createSession_timeout = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateSession' {Maybe Natural
timeout :: Maybe Natural
$sel:timeout:CreateSession' :: CreateSession -> Maybe Natural
timeout} -> Maybe Natural
timeout) (\s :: CreateSession
s@CreateSession' {} Maybe Natural
a -> CreateSession
s {$sel:timeout:CreateSession' :: Maybe Natural
timeout = Maybe Natural
a} :: CreateSession)

-- | The type of predefined worker that is allocated to use for the session.
-- Accepts a value of Standard, G.1X, G.2X, or G.025X.
--
-- -   For the @Standard@ worker type, each worker provides 4 vCPU, 16 GB
--     of memory and a 50GB disk, and 2 executors per worker.
--
-- -   For the @G.1X@ worker type, each worker maps to 1 DPU (4 vCPU, 16 GB
--     of memory, 64 GB disk), and provides 1 executor per worker. We
--     recommend this worker type for memory-intensive jobs.
--
-- -   For the @G.2X@ worker type, each worker maps to 2 DPU (8 vCPU, 32 GB
--     of memory, 128 GB disk), and provides 1 executor per worker. We
--     recommend this worker type for memory-intensive jobs.
--
-- -   For the @G.025X@ worker type, each worker maps to 0.25 DPU (2 vCPU,
--     4 GB of memory, 64 GB disk), and provides 1 executor per worker. We
--     recommend this worker type for low volume streaming jobs. This
--     worker type is only available for Glue version 3.0 streaming jobs.
createSession_workerType :: Lens.Lens' CreateSession (Prelude.Maybe WorkerType)
createSession_workerType :: Lens' CreateSession (Maybe WorkerType)
createSession_workerType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateSession' {Maybe WorkerType
workerType :: Maybe WorkerType
$sel:workerType:CreateSession' :: CreateSession -> Maybe WorkerType
workerType} -> Maybe WorkerType
workerType) (\s :: CreateSession
s@CreateSession' {} Maybe WorkerType
a -> CreateSession
s {$sel:workerType:CreateSession' :: Maybe WorkerType
workerType = Maybe WorkerType
a} :: CreateSession)

-- | The ID of the session request.
createSession_id :: Lens.Lens' CreateSession Prelude.Text
createSession_id :: Lens' CreateSession Text
createSession_id = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateSession' {Text
id :: Text
$sel:id:CreateSession' :: CreateSession -> Text
id} -> Text
id) (\s :: CreateSession
s@CreateSession' {} Text
a -> CreateSession
s {$sel:id:CreateSession' :: Text
id = Text
a} :: CreateSession)

-- | The IAM Role ARN
createSession_role :: Lens.Lens' CreateSession Prelude.Text
createSession_role :: Lens' CreateSession Text
createSession_role = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateSession' {Text
role' :: Text
$sel:role':CreateSession' :: CreateSession -> Text
role'} -> Text
role') (\s :: CreateSession
s@CreateSession' {} Text
a -> CreateSession
s {$sel:role':CreateSession' :: Text
role' = Text
a} :: CreateSession)

-- | The @SessionCommand@ that runs the job.
createSession_command :: Lens.Lens' CreateSession SessionCommand
createSession_command :: Lens' CreateSession SessionCommand
createSession_command = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateSession' {SessionCommand
command :: SessionCommand
$sel:command:CreateSession' :: CreateSession -> SessionCommand
command} -> SessionCommand
command) (\s :: CreateSession
s@CreateSession' {} SessionCommand
a -> CreateSession
s {$sel:command:CreateSession' :: SessionCommand
command = SessionCommand
a} :: CreateSession)

instance Core.AWSRequest CreateSession where
  type
    AWSResponse CreateSession =
      CreateSessionResponse
  request :: (Service -> Service) -> CreateSession -> Request CreateSession
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 CreateSession
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CreateSession)))
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 Session -> Int -> CreateSessionResponse
CreateSessionResponse'
            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 CreateSession where
  hashWithSalt :: Int -> CreateSession -> Int
hashWithSalt Int
_salt CreateSession' {Maybe Double
Maybe Int
Maybe Natural
Maybe Text
Maybe (HashMap Text Text)
Maybe ConnectionsList
Maybe WorkerType
Text
SessionCommand
command :: SessionCommand
role' :: Text
id :: Text
workerType :: Maybe WorkerType
timeout :: Maybe Natural
tags :: Maybe (HashMap Text Text)
securityConfiguration :: Maybe Text
requestOrigin :: Maybe Text
numberOfWorkers :: Maybe Int
maxCapacity :: Maybe Double
idleTimeout :: Maybe Natural
glueVersion :: Maybe Text
description :: Maybe Text
defaultArguments :: Maybe (HashMap Text Text)
connections :: Maybe ConnectionsList
$sel:command:CreateSession' :: CreateSession -> SessionCommand
$sel:role':CreateSession' :: CreateSession -> Text
$sel:id:CreateSession' :: CreateSession -> Text
$sel:workerType:CreateSession' :: CreateSession -> Maybe WorkerType
$sel:timeout:CreateSession' :: CreateSession -> Maybe Natural
$sel:tags:CreateSession' :: CreateSession -> Maybe (HashMap Text Text)
$sel:securityConfiguration:CreateSession' :: CreateSession -> Maybe Text
$sel:requestOrigin:CreateSession' :: CreateSession -> Maybe Text
$sel:numberOfWorkers:CreateSession' :: CreateSession -> Maybe Int
$sel:maxCapacity:CreateSession' :: CreateSession -> Maybe Double
$sel:idleTimeout:CreateSession' :: CreateSession -> Maybe Natural
$sel:glueVersion:CreateSession' :: CreateSession -> Maybe Text
$sel:description:CreateSession' :: CreateSession -> Maybe Text
$sel:defaultArguments:CreateSession' :: CreateSession -> Maybe (HashMap Text Text)
$sel:connections:CreateSession' :: CreateSession -> Maybe ConnectionsList
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ConnectionsList
connections
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Text)
defaultArguments
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
glueVersion
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
idleTimeout
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Double
maxCapacity
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
numberOfWorkers
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
requestOrigin
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
securityConfiguration
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Text)
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
timeout
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe WorkerType
workerType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
id
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
role'
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` SessionCommand
command

instance Prelude.NFData CreateSession where
  rnf :: CreateSession -> ()
rnf CreateSession' {Maybe Double
Maybe Int
Maybe Natural
Maybe Text
Maybe (HashMap Text Text)
Maybe ConnectionsList
Maybe WorkerType
Text
SessionCommand
command :: SessionCommand
role' :: Text
id :: Text
workerType :: Maybe WorkerType
timeout :: Maybe Natural
tags :: Maybe (HashMap Text Text)
securityConfiguration :: Maybe Text
requestOrigin :: Maybe Text
numberOfWorkers :: Maybe Int
maxCapacity :: Maybe Double
idleTimeout :: Maybe Natural
glueVersion :: Maybe Text
description :: Maybe Text
defaultArguments :: Maybe (HashMap Text Text)
connections :: Maybe ConnectionsList
$sel:command:CreateSession' :: CreateSession -> SessionCommand
$sel:role':CreateSession' :: CreateSession -> Text
$sel:id:CreateSession' :: CreateSession -> Text
$sel:workerType:CreateSession' :: CreateSession -> Maybe WorkerType
$sel:timeout:CreateSession' :: CreateSession -> Maybe Natural
$sel:tags:CreateSession' :: CreateSession -> Maybe (HashMap Text Text)
$sel:securityConfiguration:CreateSession' :: CreateSession -> Maybe Text
$sel:requestOrigin:CreateSession' :: CreateSession -> Maybe Text
$sel:numberOfWorkers:CreateSession' :: CreateSession -> Maybe Int
$sel:maxCapacity:CreateSession' :: CreateSession -> Maybe Double
$sel:idleTimeout:CreateSession' :: CreateSession -> Maybe Natural
$sel:glueVersion:CreateSession' :: CreateSession -> Maybe Text
$sel:description:CreateSession' :: CreateSession -> Maybe Text
$sel:defaultArguments:CreateSession' :: CreateSession -> Maybe (HashMap Text Text)
$sel:connections:CreateSession' :: CreateSession -> Maybe ConnectionsList
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe ConnectionsList
connections
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text Text)
defaultArguments
      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
glueVersion
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
idleTimeout
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Double
maxCapacity
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
numberOfWorkers
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
requestOrigin
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
securityConfiguration
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text Text)
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
timeout
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe WorkerType
workerType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
id
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
role'
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf SessionCommand
command

instance Data.ToHeaders CreateSession where
  toHeaders :: CreateSession -> 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
"AWSGlue.CreateSession" :: 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 CreateSession where
  toJSON :: CreateSession -> Value
toJSON CreateSession' {Maybe Double
Maybe Int
Maybe Natural
Maybe Text
Maybe (HashMap Text Text)
Maybe ConnectionsList
Maybe WorkerType
Text
SessionCommand
command :: SessionCommand
role' :: Text
id :: Text
workerType :: Maybe WorkerType
timeout :: Maybe Natural
tags :: Maybe (HashMap Text Text)
securityConfiguration :: Maybe Text
requestOrigin :: Maybe Text
numberOfWorkers :: Maybe Int
maxCapacity :: Maybe Double
idleTimeout :: Maybe Natural
glueVersion :: Maybe Text
description :: Maybe Text
defaultArguments :: Maybe (HashMap Text Text)
connections :: Maybe ConnectionsList
$sel:command:CreateSession' :: CreateSession -> SessionCommand
$sel:role':CreateSession' :: CreateSession -> Text
$sel:id:CreateSession' :: CreateSession -> Text
$sel:workerType:CreateSession' :: CreateSession -> Maybe WorkerType
$sel:timeout:CreateSession' :: CreateSession -> Maybe Natural
$sel:tags:CreateSession' :: CreateSession -> Maybe (HashMap Text Text)
$sel:securityConfiguration:CreateSession' :: CreateSession -> Maybe Text
$sel:requestOrigin:CreateSession' :: CreateSession -> Maybe Text
$sel:numberOfWorkers:CreateSession' :: CreateSession -> Maybe Int
$sel:maxCapacity:CreateSession' :: CreateSession -> Maybe Double
$sel:idleTimeout:CreateSession' :: CreateSession -> Maybe Natural
$sel:glueVersion:CreateSession' :: CreateSession -> Maybe Text
$sel:description:CreateSession' :: CreateSession -> Maybe Text
$sel:defaultArguments:CreateSession' :: CreateSession -> Maybe (HashMap Text Text)
$sel:connections:CreateSession' :: CreateSession -> Maybe ConnectionsList
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"Connections" 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 ConnectionsList
connections,
            (Key
"DefaultArguments" 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 (HashMap Text Text)
defaultArguments,
            (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
"GlueVersion" 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
glueVersion,
            (Key
"IdleTimeout" 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
idleTimeout,
            (Key
"MaxCapacity" 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 Double
maxCapacity,
            (Key
"NumberOfWorkers" 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 Int
numberOfWorkers,
            (Key
"RequestOrigin" 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
requestOrigin,
            (Key
"SecurityConfiguration" 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
securityConfiguration,
            (Key
"Tags" 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 (HashMap Text Text)
tags,
            (Key
"Timeout" 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
timeout,
            (Key
"WorkerType" 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 WorkerType
workerType,
            forall a. a -> Maybe a
Prelude.Just (Key
"Id" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
id),
            forall a. a -> Maybe a
Prelude.Just (Key
"Role" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
role'),
            forall a. a -> Maybe a
Prelude.Just (Key
"Command" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= SessionCommand
command)
          ]
      )

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

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

-- | /See:/ 'newCreateSessionResponse' smart constructor.
data CreateSessionResponse = CreateSessionResponse'
  { -- | Returns the session object in the response.
    CreateSessionResponse -> Maybe Session
session :: Prelude.Maybe Session,
    -- | The response's http status code.
    CreateSessionResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CreateSessionResponse -> CreateSessionResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateSessionResponse -> CreateSessionResponse -> Bool
$c/= :: CreateSessionResponse -> CreateSessionResponse -> Bool
== :: CreateSessionResponse -> CreateSessionResponse -> Bool
$c== :: CreateSessionResponse -> CreateSessionResponse -> Bool
Prelude.Eq, ReadPrec [CreateSessionResponse]
ReadPrec CreateSessionResponse
Int -> ReadS CreateSessionResponse
ReadS [CreateSessionResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateSessionResponse]
$creadListPrec :: ReadPrec [CreateSessionResponse]
readPrec :: ReadPrec CreateSessionResponse
$creadPrec :: ReadPrec CreateSessionResponse
readList :: ReadS [CreateSessionResponse]
$creadList :: ReadS [CreateSessionResponse]
readsPrec :: Int -> ReadS CreateSessionResponse
$creadsPrec :: Int -> ReadS CreateSessionResponse
Prelude.Read, Int -> CreateSessionResponse -> ShowS
[CreateSessionResponse] -> ShowS
CreateSessionResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateSessionResponse] -> ShowS
$cshowList :: [CreateSessionResponse] -> ShowS
show :: CreateSessionResponse -> String
$cshow :: CreateSessionResponse -> String
showsPrec :: Int -> CreateSessionResponse -> ShowS
$cshowsPrec :: Int -> CreateSessionResponse -> ShowS
Prelude.Show, forall x. Rep CreateSessionResponse x -> CreateSessionResponse
forall x. CreateSessionResponse -> Rep CreateSessionResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateSessionResponse x -> CreateSessionResponse
$cfrom :: forall x. CreateSessionResponse -> Rep CreateSessionResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateSessionResponse' 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', 'createSessionResponse_session' - Returns the session object in the response.
--
-- 'httpStatus', 'createSessionResponse_httpStatus' - The response's http status code.
newCreateSessionResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateSessionResponse
newCreateSessionResponse :: Int -> CreateSessionResponse
newCreateSessionResponse Int
pHttpStatus_ =
  CreateSessionResponse'
    { $sel:session:CreateSessionResponse' :: Maybe Session
session = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateSessionResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Returns the session object in the response.
createSessionResponse_session :: Lens.Lens' CreateSessionResponse (Prelude.Maybe Session)
createSessionResponse_session :: Lens' CreateSessionResponse (Maybe Session)
createSessionResponse_session = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateSessionResponse' {Maybe Session
session :: Maybe Session
$sel:session:CreateSessionResponse' :: CreateSessionResponse -> Maybe Session
session} -> Maybe Session
session) (\s :: CreateSessionResponse
s@CreateSessionResponse' {} Maybe Session
a -> CreateSessionResponse
s {$sel:session:CreateSessionResponse' :: Maybe Session
session = Maybe Session
a} :: CreateSessionResponse)

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

instance Prelude.NFData CreateSessionResponse where
  rnf :: CreateSessionResponse -> ()
rnf CreateSessionResponse' {Int
Maybe Session
httpStatus :: Int
session :: Maybe Session
$sel:httpStatus:CreateSessionResponse' :: CreateSessionResponse -> Int
$sel:session:CreateSessionResponse' :: CreateSessionResponse -> Maybe Session
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Session
session
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus