{-# 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.StartJobRun
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Starts a job run using a job definition.
module Amazonka.Glue.StartJobRun
  ( -- * Creating a Request
    StartJobRun (..),
    newStartJobRun,

    -- * Request Lenses
    startJobRun_allocatedCapacity,
    startJobRun_arguments,
    startJobRun_executionClass,
    startJobRun_jobRunId,
    startJobRun_maxCapacity,
    startJobRun_notificationProperty,
    startJobRun_numberOfWorkers,
    startJobRun_securityConfiguration,
    startJobRun_timeout,
    startJobRun_workerType,
    startJobRun_jobName,

    -- * Destructuring the Response
    StartJobRunResponse (..),
    newStartJobRunResponse,

    -- * Response Lenses
    startJobRunResponse_jobRunId,
    startJobRunResponse_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

-- | /See:/ 'newStartJobRun' smart constructor.
data StartJobRun = StartJobRun'
  { -- | This field is deprecated. Use @MaxCapacity@ instead.
    --
    -- The number of Glue data processing units (DPUs) to allocate to this
    -- JobRun. You can allocate a minimum of 2 DPUs; the default is 10. A DPU
    -- is a relative measure of processing power that consists of 4 vCPUs of
    -- compute capacity and 16 GB of memory. For more information, see the
    -- <https://aws.amazon.com/glue/pricing/ Glue pricing page>.
    StartJobRun -> Maybe Int
allocatedCapacity :: Prelude.Maybe Prelude.Int,
    -- | The job arguments specifically for this run. For this job run, they
    -- replace the default arguments set in the job definition itself.
    --
    -- You can specify arguments here that your own job-execution script
    -- consumes, as well as arguments that Glue itself consumes.
    --
    -- Job arguments may be logged. Do not pass plaintext secrets as arguments.
    -- Retrieve secrets from a Glue Connection, Secrets Manager or other secret
    -- management mechanism if you intend to keep them within the Job.
    --
    -- For information about how to specify and consume your own Job arguments,
    -- see the
    -- <https://docs.aws.amazon.com/glue/latest/dg/aws-glue-programming-python-calling.html Calling Glue APIs in Python>
    -- topic in the developer guide.
    --
    -- For information about the key-value pairs that Glue consumes to set up
    -- your job, see the
    -- <https://docs.aws.amazon.com/glue/latest/dg/aws-glue-programming-etl-glue-arguments.html Special Parameters Used by Glue>
    -- topic in the developer guide.
    StartJobRun -> Maybe (HashMap Text Text)
arguments :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | Indicates whether the job is run with a standard or flexible execution
    -- class. The standard execution-class is ideal for time-sensitive
    -- workloads that require fast job startup and dedicated resources.
    --
    -- The flexible execution class is appropriate for time-insensitive jobs
    -- whose start and completion times may vary.
    --
    -- Only jobs with Glue version 3.0 and above and command type @glueetl@
    -- will be allowed to set @ExecutionClass@ to @FLEX@. The flexible
    -- execution class is available for Spark jobs.
    StartJobRun -> Maybe ExecutionClass
executionClass :: Prelude.Maybe ExecutionClass,
    -- | The ID of a previous @JobRun@ to retry.
    StartJobRun -> Maybe Text
jobRunId :: Prelude.Maybe Prelude.Text,
    -- | The number of Glue data processing units (DPUs) that can be allocated
    -- when this job runs. A DPU is a relative measure of processing power that
    -- consists of 4 vCPUs of compute capacity and 16 GB of memory. For more
    -- information, see the
    -- <https://aws.amazon.com/glue/pricing/ Glue pricing page>.
    --
    -- Do not set @Max Capacity@ if using @WorkerType@ and @NumberOfWorkers@.
    --
    -- The value that can be allocated for @MaxCapacity@ depends on whether you
    -- are running a Python shell job, or an Apache Spark ETL job:
    --
    -- -   When you specify a Python shell job
    --     (@JobCommand.Name@=\"pythonshell\"), you can allocate either 0.0625
    --     or 1 DPU. The default is 0.0625 DPU.
    --
    -- -   When you specify an Apache Spark ETL job
    --     (@JobCommand.Name@=\"glueetl\"), you can allocate a minimum of 2
    --     DPUs. The default is 10 DPUs. This job type cannot have a fractional
    --     DPU allocation.
    StartJobRun -> Maybe Double
maxCapacity :: Prelude.Maybe Prelude.Double,
    -- | Specifies configuration properties of a job run notification.
    StartJobRun -> Maybe NotificationProperty
notificationProperty :: Prelude.Maybe NotificationProperty,
    -- | The number of workers of a defined @workerType@ that are allocated when
    -- a job runs.
    StartJobRun -> Maybe Int
numberOfWorkers :: Prelude.Maybe Prelude.Int,
    -- | The name of the @SecurityConfiguration@ structure to be used with this
    -- job run.
    StartJobRun -> Maybe Text
securityConfiguration :: Prelude.Maybe Prelude.Text,
    -- | The @JobRun@ timeout in minutes. This is the maximum time that a job run
    -- can consume resources before it is terminated and enters @TIMEOUT@
    -- status. This value overrides the timeout value set in the parent job.
    --
    -- Streaming jobs do not have a timeout. The default for non-streaming jobs
    -- is 2,880 minutes (48 hours).
    StartJobRun -> Maybe Natural
timeout :: Prelude.Maybe Prelude.Natural,
    -- | The type of predefined worker that is allocated when a job runs. 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 provides 4 vCPU, 16 GB of
    --     memory and a 64GB disk, and 1 executor per worker.
    --
    -- -   For the @G.2X@ worker type, each worker provides 8 vCPU, 32 GB of
    --     memory and a 128GB disk, and 1 executor per worker.
    --
    -- -   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.
    StartJobRun -> Maybe WorkerType
workerType :: Prelude.Maybe WorkerType,
    -- | The name of the job definition to use.
    StartJobRun -> Text
jobName :: Prelude.Text
  }
  deriving (StartJobRun -> StartJobRun -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StartJobRun -> StartJobRun -> Bool
$c/= :: StartJobRun -> StartJobRun -> Bool
== :: StartJobRun -> StartJobRun -> Bool
$c== :: StartJobRun -> StartJobRun -> Bool
Prelude.Eq, ReadPrec [StartJobRun]
ReadPrec StartJobRun
Int -> ReadS StartJobRun
ReadS [StartJobRun]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StartJobRun]
$creadListPrec :: ReadPrec [StartJobRun]
readPrec :: ReadPrec StartJobRun
$creadPrec :: ReadPrec StartJobRun
readList :: ReadS [StartJobRun]
$creadList :: ReadS [StartJobRun]
readsPrec :: Int -> ReadS StartJobRun
$creadsPrec :: Int -> ReadS StartJobRun
Prelude.Read, Int -> StartJobRun -> ShowS
[StartJobRun] -> ShowS
StartJobRun -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StartJobRun] -> ShowS
$cshowList :: [StartJobRun] -> ShowS
show :: StartJobRun -> String
$cshow :: StartJobRun -> String
showsPrec :: Int -> StartJobRun -> ShowS
$cshowsPrec :: Int -> StartJobRun -> ShowS
Prelude.Show, forall x. Rep StartJobRun x -> StartJobRun
forall x. StartJobRun -> Rep StartJobRun x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StartJobRun x -> StartJobRun
$cfrom :: forall x. StartJobRun -> Rep StartJobRun x
Prelude.Generic)

-- |
-- Create a value of 'StartJobRun' 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:
--
-- 'allocatedCapacity', 'startJobRun_allocatedCapacity' - This field is deprecated. Use @MaxCapacity@ instead.
--
-- The number of Glue data processing units (DPUs) to allocate to this
-- JobRun. You can allocate a minimum of 2 DPUs; the default is 10. A DPU
-- is a relative measure of processing power that consists of 4 vCPUs of
-- compute capacity and 16 GB of memory. For more information, see the
-- <https://aws.amazon.com/glue/pricing/ Glue pricing page>.
--
-- 'arguments', 'startJobRun_arguments' - The job arguments specifically for this run. For this job run, they
-- replace the default arguments set in the job definition itself.
--
-- You can specify arguments here that your own job-execution script
-- consumes, as well as arguments that Glue itself consumes.
--
-- Job arguments may be logged. Do not pass plaintext secrets as arguments.
-- Retrieve secrets from a Glue Connection, Secrets Manager or other secret
-- management mechanism if you intend to keep them within the Job.
--
-- For information about how to specify and consume your own Job arguments,
-- see the
-- <https://docs.aws.amazon.com/glue/latest/dg/aws-glue-programming-python-calling.html Calling Glue APIs in Python>
-- topic in the developer guide.
--
-- For information about the key-value pairs that Glue consumes to set up
-- your job, see the
-- <https://docs.aws.amazon.com/glue/latest/dg/aws-glue-programming-etl-glue-arguments.html Special Parameters Used by Glue>
-- topic in the developer guide.
--
-- 'executionClass', 'startJobRun_executionClass' - Indicates whether the job is run with a standard or flexible execution
-- class. The standard execution-class is ideal for time-sensitive
-- workloads that require fast job startup and dedicated resources.
--
-- The flexible execution class is appropriate for time-insensitive jobs
-- whose start and completion times may vary.
--
-- Only jobs with Glue version 3.0 and above and command type @glueetl@
-- will be allowed to set @ExecutionClass@ to @FLEX@. The flexible
-- execution class is available for Spark jobs.
--
-- 'jobRunId', 'startJobRun_jobRunId' - The ID of a previous @JobRun@ to retry.
--
-- 'maxCapacity', 'startJobRun_maxCapacity' - The number of Glue data processing units (DPUs) that can be allocated
-- when this job runs. A DPU is a relative measure of processing power that
-- consists of 4 vCPUs of compute capacity and 16 GB of memory. For more
-- information, see the
-- <https://aws.amazon.com/glue/pricing/ Glue pricing page>.
--
-- Do not set @Max Capacity@ if using @WorkerType@ and @NumberOfWorkers@.
--
-- The value that can be allocated for @MaxCapacity@ depends on whether you
-- are running a Python shell job, or an Apache Spark ETL job:
--
-- -   When you specify a Python shell job
--     (@JobCommand.Name@=\"pythonshell\"), you can allocate either 0.0625
--     or 1 DPU. The default is 0.0625 DPU.
--
-- -   When you specify an Apache Spark ETL job
--     (@JobCommand.Name@=\"glueetl\"), you can allocate a minimum of 2
--     DPUs. The default is 10 DPUs. This job type cannot have a fractional
--     DPU allocation.
--
-- 'notificationProperty', 'startJobRun_notificationProperty' - Specifies configuration properties of a job run notification.
--
-- 'numberOfWorkers', 'startJobRun_numberOfWorkers' - The number of workers of a defined @workerType@ that are allocated when
-- a job runs.
--
-- 'securityConfiguration', 'startJobRun_securityConfiguration' - The name of the @SecurityConfiguration@ structure to be used with this
-- job run.
--
-- 'timeout', 'startJobRun_timeout' - The @JobRun@ timeout in minutes. This is the maximum time that a job run
-- can consume resources before it is terminated and enters @TIMEOUT@
-- status. This value overrides the timeout value set in the parent job.
--
-- Streaming jobs do not have a timeout. The default for non-streaming jobs
-- is 2,880 minutes (48 hours).
--
-- 'workerType', 'startJobRun_workerType' - The type of predefined worker that is allocated when a job runs. 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 provides 4 vCPU, 16 GB of
--     memory and a 64GB disk, and 1 executor per worker.
--
-- -   For the @G.2X@ worker type, each worker provides 8 vCPU, 32 GB of
--     memory and a 128GB disk, and 1 executor per worker.
--
-- -   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.
--
-- 'jobName', 'startJobRun_jobName' - The name of the job definition to use.
newStartJobRun ::
  -- | 'jobName'
  Prelude.Text ->
  StartJobRun
newStartJobRun :: Text -> StartJobRun
newStartJobRun Text
pJobName_ =
  StartJobRun'
    { $sel:allocatedCapacity:StartJobRun' :: Maybe Int
allocatedCapacity = forall a. Maybe a
Prelude.Nothing,
      $sel:arguments:StartJobRun' :: Maybe (HashMap Text Text)
arguments = forall a. Maybe a
Prelude.Nothing,
      $sel:executionClass:StartJobRun' :: Maybe ExecutionClass
executionClass = forall a. Maybe a
Prelude.Nothing,
      $sel:jobRunId:StartJobRun' :: Maybe Text
jobRunId = forall a. Maybe a
Prelude.Nothing,
      $sel:maxCapacity:StartJobRun' :: Maybe Double
maxCapacity = forall a. Maybe a
Prelude.Nothing,
      $sel:notificationProperty:StartJobRun' :: Maybe NotificationProperty
notificationProperty = forall a. Maybe a
Prelude.Nothing,
      $sel:numberOfWorkers:StartJobRun' :: Maybe Int
numberOfWorkers = forall a. Maybe a
Prelude.Nothing,
      $sel:securityConfiguration:StartJobRun' :: Maybe Text
securityConfiguration = forall a. Maybe a
Prelude.Nothing,
      $sel:timeout:StartJobRun' :: Maybe Natural
timeout = forall a. Maybe a
Prelude.Nothing,
      $sel:workerType:StartJobRun' :: Maybe WorkerType
workerType = forall a. Maybe a
Prelude.Nothing,
      $sel:jobName:StartJobRun' :: Text
jobName = Text
pJobName_
    }

-- | This field is deprecated. Use @MaxCapacity@ instead.
--
-- The number of Glue data processing units (DPUs) to allocate to this
-- JobRun. You can allocate a minimum of 2 DPUs; the default is 10. A DPU
-- is a relative measure of processing power that consists of 4 vCPUs of
-- compute capacity and 16 GB of memory. For more information, see the
-- <https://aws.amazon.com/glue/pricing/ Glue pricing page>.
startJobRun_allocatedCapacity :: Lens.Lens' StartJobRun (Prelude.Maybe Prelude.Int)
startJobRun_allocatedCapacity :: Lens' StartJobRun (Maybe Int)
startJobRun_allocatedCapacity = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartJobRun' {Maybe Int
allocatedCapacity :: Maybe Int
$sel:allocatedCapacity:StartJobRun' :: StartJobRun -> Maybe Int
allocatedCapacity} -> Maybe Int
allocatedCapacity) (\s :: StartJobRun
s@StartJobRun' {} Maybe Int
a -> StartJobRun
s {$sel:allocatedCapacity:StartJobRun' :: Maybe Int
allocatedCapacity = Maybe Int
a} :: StartJobRun)

-- | The job arguments specifically for this run. For this job run, they
-- replace the default arguments set in the job definition itself.
--
-- You can specify arguments here that your own job-execution script
-- consumes, as well as arguments that Glue itself consumes.
--
-- Job arguments may be logged. Do not pass plaintext secrets as arguments.
-- Retrieve secrets from a Glue Connection, Secrets Manager or other secret
-- management mechanism if you intend to keep them within the Job.
--
-- For information about how to specify and consume your own Job arguments,
-- see the
-- <https://docs.aws.amazon.com/glue/latest/dg/aws-glue-programming-python-calling.html Calling Glue APIs in Python>
-- topic in the developer guide.
--
-- For information about the key-value pairs that Glue consumes to set up
-- your job, see the
-- <https://docs.aws.amazon.com/glue/latest/dg/aws-glue-programming-etl-glue-arguments.html Special Parameters Used by Glue>
-- topic in the developer guide.
startJobRun_arguments :: Lens.Lens' StartJobRun (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
startJobRun_arguments :: Lens' StartJobRun (Maybe (HashMap Text Text))
startJobRun_arguments = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartJobRun' {Maybe (HashMap Text Text)
arguments :: Maybe (HashMap Text Text)
$sel:arguments:StartJobRun' :: StartJobRun -> Maybe (HashMap Text Text)
arguments} -> Maybe (HashMap Text Text)
arguments) (\s :: StartJobRun
s@StartJobRun' {} Maybe (HashMap Text Text)
a -> StartJobRun
s {$sel:arguments:StartJobRun' :: Maybe (HashMap Text Text)
arguments = Maybe (HashMap Text Text)
a} :: StartJobRun) 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

-- | Indicates whether the job is run with a standard or flexible execution
-- class. The standard execution-class is ideal for time-sensitive
-- workloads that require fast job startup and dedicated resources.
--
-- The flexible execution class is appropriate for time-insensitive jobs
-- whose start and completion times may vary.
--
-- Only jobs with Glue version 3.0 and above and command type @glueetl@
-- will be allowed to set @ExecutionClass@ to @FLEX@. The flexible
-- execution class is available for Spark jobs.
startJobRun_executionClass :: Lens.Lens' StartJobRun (Prelude.Maybe ExecutionClass)
startJobRun_executionClass :: Lens' StartJobRun (Maybe ExecutionClass)
startJobRun_executionClass = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartJobRun' {Maybe ExecutionClass
executionClass :: Maybe ExecutionClass
$sel:executionClass:StartJobRun' :: StartJobRun -> Maybe ExecutionClass
executionClass} -> Maybe ExecutionClass
executionClass) (\s :: StartJobRun
s@StartJobRun' {} Maybe ExecutionClass
a -> StartJobRun
s {$sel:executionClass:StartJobRun' :: Maybe ExecutionClass
executionClass = Maybe ExecutionClass
a} :: StartJobRun)

-- | The ID of a previous @JobRun@ to retry.
startJobRun_jobRunId :: Lens.Lens' StartJobRun (Prelude.Maybe Prelude.Text)
startJobRun_jobRunId :: Lens' StartJobRun (Maybe Text)
startJobRun_jobRunId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartJobRun' {Maybe Text
jobRunId :: Maybe Text
$sel:jobRunId:StartJobRun' :: StartJobRun -> Maybe Text
jobRunId} -> Maybe Text
jobRunId) (\s :: StartJobRun
s@StartJobRun' {} Maybe Text
a -> StartJobRun
s {$sel:jobRunId:StartJobRun' :: Maybe Text
jobRunId = Maybe Text
a} :: StartJobRun)

-- | The number of Glue data processing units (DPUs) that can be allocated
-- when this job runs. A DPU is a relative measure of processing power that
-- consists of 4 vCPUs of compute capacity and 16 GB of memory. For more
-- information, see the
-- <https://aws.amazon.com/glue/pricing/ Glue pricing page>.
--
-- Do not set @Max Capacity@ if using @WorkerType@ and @NumberOfWorkers@.
--
-- The value that can be allocated for @MaxCapacity@ depends on whether you
-- are running a Python shell job, or an Apache Spark ETL job:
--
-- -   When you specify a Python shell job
--     (@JobCommand.Name@=\"pythonshell\"), you can allocate either 0.0625
--     or 1 DPU. The default is 0.0625 DPU.
--
-- -   When you specify an Apache Spark ETL job
--     (@JobCommand.Name@=\"glueetl\"), you can allocate a minimum of 2
--     DPUs. The default is 10 DPUs. This job type cannot have a fractional
--     DPU allocation.
startJobRun_maxCapacity :: Lens.Lens' StartJobRun (Prelude.Maybe Prelude.Double)
startJobRun_maxCapacity :: Lens' StartJobRun (Maybe Double)
startJobRun_maxCapacity = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartJobRun' {Maybe Double
maxCapacity :: Maybe Double
$sel:maxCapacity:StartJobRun' :: StartJobRun -> Maybe Double
maxCapacity} -> Maybe Double
maxCapacity) (\s :: StartJobRun
s@StartJobRun' {} Maybe Double
a -> StartJobRun
s {$sel:maxCapacity:StartJobRun' :: Maybe Double
maxCapacity = Maybe Double
a} :: StartJobRun)

-- | Specifies configuration properties of a job run notification.
startJobRun_notificationProperty :: Lens.Lens' StartJobRun (Prelude.Maybe NotificationProperty)
startJobRun_notificationProperty :: Lens' StartJobRun (Maybe NotificationProperty)
startJobRun_notificationProperty = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartJobRun' {Maybe NotificationProperty
notificationProperty :: Maybe NotificationProperty
$sel:notificationProperty:StartJobRun' :: StartJobRun -> Maybe NotificationProperty
notificationProperty} -> Maybe NotificationProperty
notificationProperty) (\s :: StartJobRun
s@StartJobRun' {} Maybe NotificationProperty
a -> StartJobRun
s {$sel:notificationProperty:StartJobRun' :: Maybe NotificationProperty
notificationProperty = Maybe NotificationProperty
a} :: StartJobRun)

-- | The number of workers of a defined @workerType@ that are allocated when
-- a job runs.
startJobRun_numberOfWorkers :: Lens.Lens' StartJobRun (Prelude.Maybe Prelude.Int)
startJobRun_numberOfWorkers :: Lens' StartJobRun (Maybe Int)
startJobRun_numberOfWorkers = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartJobRun' {Maybe Int
numberOfWorkers :: Maybe Int
$sel:numberOfWorkers:StartJobRun' :: StartJobRun -> Maybe Int
numberOfWorkers} -> Maybe Int
numberOfWorkers) (\s :: StartJobRun
s@StartJobRun' {} Maybe Int
a -> StartJobRun
s {$sel:numberOfWorkers:StartJobRun' :: Maybe Int
numberOfWorkers = Maybe Int
a} :: StartJobRun)

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

-- | The @JobRun@ timeout in minutes. This is the maximum time that a job run
-- can consume resources before it is terminated and enters @TIMEOUT@
-- status. This value overrides the timeout value set in the parent job.
--
-- Streaming jobs do not have a timeout. The default for non-streaming jobs
-- is 2,880 minutes (48 hours).
startJobRun_timeout :: Lens.Lens' StartJobRun (Prelude.Maybe Prelude.Natural)
startJobRun_timeout :: Lens' StartJobRun (Maybe Natural)
startJobRun_timeout = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartJobRun' {Maybe Natural
timeout :: Maybe Natural
$sel:timeout:StartJobRun' :: StartJobRun -> Maybe Natural
timeout} -> Maybe Natural
timeout) (\s :: StartJobRun
s@StartJobRun' {} Maybe Natural
a -> StartJobRun
s {$sel:timeout:StartJobRun' :: Maybe Natural
timeout = Maybe Natural
a} :: StartJobRun)

-- | The type of predefined worker that is allocated when a job runs. 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 provides 4 vCPU, 16 GB of
--     memory and a 64GB disk, and 1 executor per worker.
--
-- -   For the @G.2X@ worker type, each worker provides 8 vCPU, 32 GB of
--     memory and a 128GB disk, and 1 executor per worker.
--
-- -   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.
startJobRun_workerType :: Lens.Lens' StartJobRun (Prelude.Maybe WorkerType)
startJobRun_workerType :: Lens' StartJobRun (Maybe WorkerType)
startJobRun_workerType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartJobRun' {Maybe WorkerType
workerType :: Maybe WorkerType
$sel:workerType:StartJobRun' :: StartJobRun -> Maybe WorkerType
workerType} -> Maybe WorkerType
workerType) (\s :: StartJobRun
s@StartJobRun' {} Maybe WorkerType
a -> StartJobRun
s {$sel:workerType:StartJobRun' :: Maybe WorkerType
workerType = Maybe WorkerType
a} :: StartJobRun)

-- | The name of the job definition to use.
startJobRun_jobName :: Lens.Lens' StartJobRun Prelude.Text
startJobRun_jobName :: Lens' StartJobRun Text
startJobRun_jobName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartJobRun' {Text
jobName :: Text
$sel:jobName:StartJobRun' :: StartJobRun -> Text
jobName} -> Text
jobName) (\s :: StartJobRun
s@StartJobRun' {} Text
a -> StartJobRun
s {$sel:jobName:StartJobRun' :: Text
jobName = Text
a} :: StartJobRun)

instance Core.AWSRequest StartJobRun where
  type AWSResponse StartJobRun = StartJobRunResponse
  request :: (Service -> Service) -> StartJobRun -> Request StartJobRun
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 StartJobRun
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse StartJobRun)))
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 -> Int -> StartJobRunResponse
StartJobRunResponse'
            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
"JobRunId")
            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 StartJobRun where
  hashWithSalt :: Int -> StartJobRun -> Int
hashWithSalt Int
_salt StartJobRun' {Maybe Double
Maybe Int
Maybe Natural
Maybe Text
Maybe (HashMap Text Text)
Maybe ExecutionClass
Maybe NotificationProperty
Maybe WorkerType
Text
jobName :: Text
workerType :: Maybe WorkerType
timeout :: Maybe Natural
securityConfiguration :: Maybe Text
numberOfWorkers :: Maybe Int
notificationProperty :: Maybe NotificationProperty
maxCapacity :: Maybe Double
jobRunId :: Maybe Text
executionClass :: Maybe ExecutionClass
arguments :: Maybe (HashMap Text Text)
allocatedCapacity :: Maybe Int
$sel:jobName:StartJobRun' :: StartJobRun -> Text
$sel:workerType:StartJobRun' :: StartJobRun -> Maybe WorkerType
$sel:timeout:StartJobRun' :: StartJobRun -> Maybe Natural
$sel:securityConfiguration:StartJobRun' :: StartJobRun -> Maybe Text
$sel:numberOfWorkers:StartJobRun' :: StartJobRun -> Maybe Int
$sel:notificationProperty:StartJobRun' :: StartJobRun -> Maybe NotificationProperty
$sel:maxCapacity:StartJobRun' :: StartJobRun -> Maybe Double
$sel:jobRunId:StartJobRun' :: StartJobRun -> Maybe Text
$sel:executionClass:StartJobRun' :: StartJobRun -> Maybe ExecutionClass
$sel:arguments:StartJobRun' :: StartJobRun -> Maybe (HashMap Text Text)
$sel:allocatedCapacity:StartJobRun' :: StartJobRun -> Maybe Int
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
allocatedCapacity
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Text)
arguments
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ExecutionClass
executionClass
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
jobRunId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Double
maxCapacity
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe NotificationProperty
notificationProperty
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
numberOfWorkers
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
securityConfiguration
      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
jobName

instance Prelude.NFData StartJobRun where
  rnf :: StartJobRun -> ()
rnf StartJobRun' {Maybe Double
Maybe Int
Maybe Natural
Maybe Text
Maybe (HashMap Text Text)
Maybe ExecutionClass
Maybe NotificationProperty
Maybe WorkerType
Text
jobName :: Text
workerType :: Maybe WorkerType
timeout :: Maybe Natural
securityConfiguration :: Maybe Text
numberOfWorkers :: Maybe Int
notificationProperty :: Maybe NotificationProperty
maxCapacity :: Maybe Double
jobRunId :: Maybe Text
executionClass :: Maybe ExecutionClass
arguments :: Maybe (HashMap Text Text)
allocatedCapacity :: Maybe Int
$sel:jobName:StartJobRun' :: StartJobRun -> Text
$sel:workerType:StartJobRun' :: StartJobRun -> Maybe WorkerType
$sel:timeout:StartJobRun' :: StartJobRun -> Maybe Natural
$sel:securityConfiguration:StartJobRun' :: StartJobRun -> Maybe Text
$sel:numberOfWorkers:StartJobRun' :: StartJobRun -> Maybe Int
$sel:notificationProperty:StartJobRun' :: StartJobRun -> Maybe NotificationProperty
$sel:maxCapacity:StartJobRun' :: StartJobRun -> Maybe Double
$sel:jobRunId:StartJobRun' :: StartJobRun -> Maybe Text
$sel:executionClass:StartJobRun' :: StartJobRun -> Maybe ExecutionClass
$sel:arguments:StartJobRun' :: StartJobRun -> Maybe (HashMap Text Text)
$sel:allocatedCapacity:StartJobRun' :: StartJobRun -> Maybe Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
allocatedCapacity
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text Text)
arguments
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ExecutionClass
executionClass
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
jobRunId
      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 NotificationProperty
notificationProperty
      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
securityConfiguration
      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
jobName

instance Data.ToHeaders StartJobRun where
  toHeaders :: StartJobRun -> 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.StartJobRun" :: 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 StartJobRun where
  toJSON :: StartJobRun -> Value
toJSON StartJobRun' {Maybe Double
Maybe Int
Maybe Natural
Maybe Text
Maybe (HashMap Text Text)
Maybe ExecutionClass
Maybe NotificationProperty
Maybe WorkerType
Text
jobName :: Text
workerType :: Maybe WorkerType
timeout :: Maybe Natural
securityConfiguration :: Maybe Text
numberOfWorkers :: Maybe Int
notificationProperty :: Maybe NotificationProperty
maxCapacity :: Maybe Double
jobRunId :: Maybe Text
executionClass :: Maybe ExecutionClass
arguments :: Maybe (HashMap Text Text)
allocatedCapacity :: Maybe Int
$sel:jobName:StartJobRun' :: StartJobRun -> Text
$sel:workerType:StartJobRun' :: StartJobRun -> Maybe WorkerType
$sel:timeout:StartJobRun' :: StartJobRun -> Maybe Natural
$sel:securityConfiguration:StartJobRun' :: StartJobRun -> Maybe Text
$sel:numberOfWorkers:StartJobRun' :: StartJobRun -> Maybe Int
$sel:notificationProperty:StartJobRun' :: StartJobRun -> Maybe NotificationProperty
$sel:maxCapacity:StartJobRun' :: StartJobRun -> Maybe Double
$sel:jobRunId:StartJobRun' :: StartJobRun -> Maybe Text
$sel:executionClass:StartJobRun' :: StartJobRun -> Maybe ExecutionClass
$sel:arguments:StartJobRun' :: StartJobRun -> Maybe (HashMap Text Text)
$sel:allocatedCapacity:StartJobRun' :: StartJobRun -> Maybe Int
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"AllocatedCapacity" 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
allocatedCapacity,
            (Key
"Arguments" 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)
arguments,
            (Key
"ExecutionClass" 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 ExecutionClass
executionClass,
            (Key
"JobRunId" 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
jobRunId,
            (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
"NotificationProperty" 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 NotificationProperty
notificationProperty,
            (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
"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
"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
"JobName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
jobName)
          ]
      )

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

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

-- | /See:/ 'newStartJobRunResponse' smart constructor.
data StartJobRunResponse = StartJobRunResponse'
  { -- | The ID assigned to this job run.
    StartJobRunResponse -> Maybe Text
jobRunId :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    StartJobRunResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (StartJobRunResponse -> StartJobRunResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StartJobRunResponse -> StartJobRunResponse -> Bool
$c/= :: StartJobRunResponse -> StartJobRunResponse -> Bool
== :: StartJobRunResponse -> StartJobRunResponse -> Bool
$c== :: StartJobRunResponse -> StartJobRunResponse -> Bool
Prelude.Eq, ReadPrec [StartJobRunResponse]
ReadPrec StartJobRunResponse
Int -> ReadS StartJobRunResponse
ReadS [StartJobRunResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StartJobRunResponse]
$creadListPrec :: ReadPrec [StartJobRunResponse]
readPrec :: ReadPrec StartJobRunResponse
$creadPrec :: ReadPrec StartJobRunResponse
readList :: ReadS [StartJobRunResponse]
$creadList :: ReadS [StartJobRunResponse]
readsPrec :: Int -> ReadS StartJobRunResponse
$creadsPrec :: Int -> ReadS StartJobRunResponse
Prelude.Read, Int -> StartJobRunResponse -> ShowS
[StartJobRunResponse] -> ShowS
StartJobRunResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StartJobRunResponse] -> ShowS
$cshowList :: [StartJobRunResponse] -> ShowS
show :: StartJobRunResponse -> String
$cshow :: StartJobRunResponse -> String
showsPrec :: Int -> StartJobRunResponse -> ShowS
$cshowsPrec :: Int -> StartJobRunResponse -> ShowS
Prelude.Show, forall x. Rep StartJobRunResponse x -> StartJobRunResponse
forall x. StartJobRunResponse -> Rep StartJobRunResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StartJobRunResponse x -> StartJobRunResponse
$cfrom :: forall x. StartJobRunResponse -> Rep StartJobRunResponse x
Prelude.Generic)

-- |
-- Create a value of 'StartJobRunResponse' 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:
--
-- 'jobRunId', 'startJobRunResponse_jobRunId' - The ID assigned to this job run.
--
-- 'httpStatus', 'startJobRunResponse_httpStatus' - The response's http status code.
newStartJobRunResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  StartJobRunResponse
newStartJobRunResponse :: Int -> StartJobRunResponse
newStartJobRunResponse Int
pHttpStatus_ =
  StartJobRunResponse'
    { $sel:jobRunId:StartJobRunResponse' :: Maybe Text
jobRunId = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:StartJobRunResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The ID assigned to this job run.
startJobRunResponse_jobRunId :: Lens.Lens' StartJobRunResponse (Prelude.Maybe Prelude.Text)
startJobRunResponse_jobRunId :: Lens' StartJobRunResponse (Maybe Text)
startJobRunResponse_jobRunId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartJobRunResponse' {Maybe Text
jobRunId :: Maybe Text
$sel:jobRunId:StartJobRunResponse' :: StartJobRunResponse -> Maybe Text
jobRunId} -> Maybe Text
jobRunId) (\s :: StartJobRunResponse
s@StartJobRunResponse' {} Maybe Text
a -> StartJobRunResponse
s {$sel:jobRunId:StartJobRunResponse' :: Maybe Text
jobRunId = Maybe Text
a} :: StartJobRunResponse)

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

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