{-# 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.EMRServerless.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.
module Amazonka.EMRServerless.StartJobRun
  ( -- * Creating a Request
    StartJobRun (..),
    newStartJobRun,

    -- * Request Lenses
    startJobRun_configurationOverrides,
    startJobRun_executionTimeoutMinutes,
    startJobRun_jobDriver,
    startJobRun_name,
    startJobRun_tags,
    startJobRun_applicationId,
    startJobRun_clientToken,
    startJobRun_executionRoleArn,

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

    -- * Response Lenses
    startJobRunResponse_httpStatus,
    startJobRunResponse_applicationId,
    startJobRunResponse_jobRunId,
    startJobRunResponse_arn,
  )
where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.EMRServerless.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'
  { -- | The configuration overrides for the job run.
    StartJobRun -> Maybe ConfigurationOverrides
configurationOverrides :: Prelude.Maybe ConfigurationOverrides,
    -- | The maximum duration for the job run to run. If the job run runs beyond
    -- this duration, it will be automatically cancelled.
    StartJobRun -> Maybe Natural
executionTimeoutMinutes :: Prelude.Maybe Prelude.Natural,
    -- | The job driver for the job run.
    StartJobRun -> Maybe JobDriver
jobDriver :: Prelude.Maybe JobDriver,
    -- | The optional job run name. This doesn\'t have to be unique.
    StartJobRun -> Maybe Text
name :: Prelude.Maybe Prelude.Text,
    -- | The tags assigned to the job run.
    StartJobRun -> Maybe (HashMap Text Text)
tags :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | The ID of the application on which to run the job.
    StartJobRun -> Text
applicationId :: Prelude.Text,
    -- | The client idempotency token of the job run to start. Its value must be
    -- unique for each request.
    StartJobRun -> Text
clientToken :: Prelude.Text,
    -- | The execution role ARN for the job run.
    StartJobRun -> Text
executionRoleArn :: 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, 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:
--
-- 'configurationOverrides', 'startJobRun_configurationOverrides' - The configuration overrides for the job run.
--
-- 'executionTimeoutMinutes', 'startJobRun_executionTimeoutMinutes' - The maximum duration for the job run to run. If the job run runs beyond
-- this duration, it will be automatically cancelled.
--
-- 'jobDriver', 'startJobRun_jobDriver' - The job driver for the job run.
--
-- 'name', 'startJobRun_name' - The optional job run name. This doesn\'t have to be unique.
--
-- 'tags', 'startJobRun_tags' - The tags assigned to the job run.
--
-- 'applicationId', 'startJobRun_applicationId' - The ID of the application on which to run the job.
--
-- 'clientToken', 'startJobRun_clientToken' - The client idempotency token of the job run to start. Its value must be
-- unique for each request.
--
-- 'executionRoleArn', 'startJobRun_executionRoleArn' - The execution role ARN for the job run.
newStartJobRun ::
  -- | 'applicationId'
  Prelude.Text ->
  -- | 'clientToken'
  Prelude.Text ->
  -- | 'executionRoleArn'
  Prelude.Text ->
  StartJobRun
newStartJobRun :: Text -> Text -> Text -> StartJobRun
newStartJobRun
  Text
pApplicationId_
  Text
pClientToken_
  Text
pExecutionRoleArn_ =
    StartJobRun'
      { $sel:configurationOverrides:StartJobRun' :: Maybe ConfigurationOverrides
configurationOverrides =
          forall a. Maybe a
Prelude.Nothing,
        $sel:executionTimeoutMinutes:StartJobRun' :: Maybe Natural
executionTimeoutMinutes = forall a. Maybe a
Prelude.Nothing,
        $sel:jobDriver:StartJobRun' :: Maybe JobDriver
jobDriver = forall a. Maybe a
Prelude.Nothing,
        $sel:name:StartJobRun' :: Maybe Text
name = forall a. Maybe a
Prelude.Nothing,
        $sel:tags:StartJobRun' :: Maybe (HashMap Text Text)
tags = forall a. Maybe a
Prelude.Nothing,
        $sel:applicationId:StartJobRun' :: Text
applicationId = Text
pApplicationId_,
        $sel:clientToken:StartJobRun' :: Text
clientToken = Text
pClientToken_,
        $sel:executionRoleArn:StartJobRun' :: Text
executionRoleArn = Text
pExecutionRoleArn_
      }

-- | The configuration overrides for the job run.
startJobRun_configurationOverrides :: Lens.Lens' StartJobRun (Prelude.Maybe ConfigurationOverrides)
startJobRun_configurationOverrides :: Lens' StartJobRun (Maybe ConfigurationOverrides)
startJobRun_configurationOverrides = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartJobRun' {Maybe ConfigurationOverrides
configurationOverrides :: Maybe ConfigurationOverrides
$sel:configurationOverrides:StartJobRun' :: StartJobRun -> Maybe ConfigurationOverrides
configurationOverrides} -> Maybe ConfigurationOverrides
configurationOverrides) (\s :: StartJobRun
s@StartJobRun' {} Maybe ConfigurationOverrides
a -> StartJobRun
s {$sel:configurationOverrides:StartJobRun' :: Maybe ConfigurationOverrides
configurationOverrides = Maybe ConfigurationOverrides
a} :: StartJobRun)

-- | The maximum duration for the job run to run. If the job run runs beyond
-- this duration, it will be automatically cancelled.
startJobRun_executionTimeoutMinutes :: Lens.Lens' StartJobRun (Prelude.Maybe Prelude.Natural)
startJobRun_executionTimeoutMinutes :: Lens' StartJobRun (Maybe Natural)
startJobRun_executionTimeoutMinutes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartJobRun' {Maybe Natural
executionTimeoutMinutes :: Maybe Natural
$sel:executionTimeoutMinutes:StartJobRun' :: StartJobRun -> Maybe Natural
executionTimeoutMinutes} -> Maybe Natural
executionTimeoutMinutes) (\s :: StartJobRun
s@StartJobRun' {} Maybe Natural
a -> StartJobRun
s {$sel:executionTimeoutMinutes:StartJobRun' :: Maybe Natural
executionTimeoutMinutes = Maybe Natural
a} :: StartJobRun)

-- | The job driver for the job run.
startJobRun_jobDriver :: Lens.Lens' StartJobRun (Prelude.Maybe JobDriver)
startJobRun_jobDriver :: Lens' StartJobRun (Maybe JobDriver)
startJobRun_jobDriver = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartJobRun' {Maybe JobDriver
jobDriver :: Maybe JobDriver
$sel:jobDriver:StartJobRun' :: StartJobRun -> Maybe JobDriver
jobDriver} -> Maybe JobDriver
jobDriver) (\s :: StartJobRun
s@StartJobRun' {} Maybe JobDriver
a -> StartJobRun
s {$sel:jobDriver:StartJobRun' :: Maybe JobDriver
jobDriver = Maybe JobDriver
a} :: StartJobRun)

-- | The optional job run name. This doesn\'t have to be unique.
startJobRun_name :: Lens.Lens' StartJobRun (Prelude.Maybe Prelude.Text)
startJobRun_name :: Lens' StartJobRun (Maybe Text)
startJobRun_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartJobRun' {Maybe Text
name :: Maybe Text
$sel:name:StartJobRun' :: StartJobRun -> Maybe Text
name} -> Maybe Text
name) (\s :: StartJobRun
s@StartJobRun' {} Maybe Text
a -> StartJobRun
s {$sel:name:StartJobRun' :: Maybe Text
name = Maybe Text
a} :: StartJobRun)

-- | The tags assigned to the job run.
startJobRun_tags :: Lens.Lens' StartJobRun (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
startJobRun_tags :: Lens' StartJobRun (Maybe (HashMap Text Text))
startJobRun_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartJobRun' {Maybe (HashMap Text Text)
tags :: Maybe (HashMap Text Text)
$sel:tags:StartJobRun' :: StartJobRun -> Maybe (HashMap Text Text)
tags} -> Maybe (HashMap Text Text)
tags) (\s :: StartJobRun
s@StartJobRun' {} Maybe (HashMap Text Text)
a -> StartJobRun
s {$sel:tags:StartJobRun' :: Maybe (HashMap Text Text)
tags = 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

-- | The ID of the application on which to run the job.
startJobRun_applicationId :: Lens.Lens' StartJobRun Prelude.Text
startJobRun_applicationId :: Lens' StartJobRun Text
startJobRun_applicationId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartJobRun' {Text
applicationId :: Text
$sel:applicationId:StartJobRun' :: StartJobRun -> Text
applicationId} -> Text
applicationId) (\s :: StartJobRun
s@StartJobRun' {} Text
a -> StartJobRun
s {$sel:applicationId:StartJobRun' :: Text
applicationId = Text
a} :: StartJobRun)

-- | The client idempotency token of the job run to start. Its value must be
-- unique for each request.
startJobRun_clientToken :: Lens.Lens' StartJobRun Prelude.Text
startJobRun_clientToken :: Lens' StartJobRun Text
startJobRun_clientToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartJobRun' {Text
clientToken :: Text
$sel:clientToken:StartJobRun' :: StartJobRun -> Text
clientToken} -> Text
clientToken) (\s :: StartJobRun
s@StartJobRun' {} Text
a -> StartJobRun
s {$sel:clientToken:StartJobRun' :: Text
clientToken = Text
a} :: StartJobRun)

-- | The execution role ARN for the job run.
startJobRun_executionRoleArn :: Lens.Lens' StartJobRun Prelude.Text
startJobRun_executionRoleArn :: Lens' StartJobRun Text
startJobRun_executionRoleArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartJobRun' {Text
executionRoleArn :: Text
$sel:executionRoleArn:StartJobRun' :: StartJobRun -> Text
executionRoleArn} -> Text
executionRoleArn) (\s :: StartJobRun
s@StartJobRun' {} Text
a -> StartJobRun
s {$sel:executionRoleArn:StartJobRun' :: Text
executionRoleArn = 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 ->
          Int -> Text -> Text -> Text -> StartJobRunResponse
StartJobRunResponse'
            forall (f :: * -> *) a b. Functor 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))
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"applicationId")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"jobRunId")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"arn")
      )

instance Prelude.Hashable StartJobRun where
  hashWithSalt :: Int -> StartJobRun -> Int
hashWithSalt Int
_salt StartJobRun' {Maybe Natural
Maybe Text
Maybe (HashMap Text Text)
Maybe ConfigurationOverrides
Maybe JobDriver
Text
executionRoleArn :: Text
clientToken :: Text
applicationId :: Text
tags :: Maybe (HashMap Text Text)
name :: Maybe Text
jobDriver :: Maybe JobDriver
executionTimeoutMinutes :: Maybe Natural
configurationOverrides :: Maybe ConfigurationOverrides
$sel:executionRoleArn:StartJobRun' :: StartJobRun -> Text
$sel:clientToken:StartJobRun' :: StartJobRun -> Text
$sel:applicationId:StartJobRun' :: StartJobRun -> Text
$sel:tags:StartJobRun' :: StartJobRun -> Maybe (HashMap Text Text)
$sel:name:StartJobRun' :: StartJobRun -> Maybe Text
$sel:jobDriver:StartJobRun' :: StartJobRun -> Maybe JobDriver
$sel:executionTimeoutMinutes:StartJobRun' :: StartJobRun -> Maybe Natural
$sel:configurationOverrides:StartJobRun' :: StartJobRun -> Maybe ConfigurationOverrides
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ConfigurationOverrides
configurationOverrides
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
executionTimeoutMinutes
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe JobDriver
jobDriver
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
name
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Text)
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
applicationId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
clientToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
executionRoleArn

instance Prelude.NFData StartJobRun where
  rnf :: StartJobRun -> ()
rnf StartJobRun' {Maybe Natural
Maybe Text
Maybe (HashMap Text Text)
Maybe ConfigurationOverrides
Maybe JobDriver
Text
executionRoleArn :: Text
clientToken :: Text
applicationId :: Text
tags :: Maybe (HashMap Text Text)
name :: Maybe Text
jobDriver :: Maybe JobDriver
executionTimeoutMinutes :: Maybe Natural
configurationOverrides :: Maybe ConfigurationOverrides
$sel:executionRoleArn:StartJobRun' :: StartJobRun -> Text
$sel:clientToken:StartJobRun' :: StartJobRun -> Text
$sel:applicationId:StartJobRun' :: StartJobRun -> Text
$sel:tags:StartJobRun' :: StartJobRun -> Maybe (HashMap Text Text)
$sel:name:StartJobRun' :: StartJobRun -> Maybe Text
$sel:jobDriver:StartJobRun' :: StartJobRun -> Maybe JobDriver
$sel:executionTimeoutMinutes:StartJobRun' :: StartJobRun -> Maybe Natural
$sel:configurationOverrides:StartJobRun' :: StartJobRun -> Maybe ConfigurationOverrides
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe ConfigurationOverrides
configurationOverrides
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
executionTimeoutMinutes
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe JobDriver
jobDriver
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
name
      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 Text
applicationId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
clientToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
executionRoleArn

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
"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 Natural
Maybe Text
Maybe (HashMap Text Text)
Maybe ConfigurationOverrides
Maybe JobDriver
Text
executionRoleArn :: Text
clientToken :: Text
applicationId :: Text
tags :: Maybe (HashMap Text Text)
name :: Maybe Text
jobDriver :: Maybe JobDriver
executionTimeoutMinutes :: Maybe Natural
configurationOverrides :: Maybe ConfigurationOverrides
$sel:executionRoleArn:StartJobRun' :: StartJobRun -> Text
$sel:clientToken:StartJobRun' :: StartJobRun -> Text
$sel:applicationId:StartJobRun' :: StartJobRun -> Text
$sel:tags:StartJobRun' :: StartJobRun -> Maybe (HashMap Text Text)
$sel:name:StartJobRun' :: StartJobRun -> Maybe Text
$sel:jobDriver:StartJobRun' :: StartJobRun -> Maybe JobDriver
$sel:executionTimeoutMinutes:StartJobRun' :: StartJobRun -> Maybe Natural
$sel:configurationOverrides:StartJobRun' :: StartJobRun -> Maybe ConfigurationOverrides
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"configurationOverrides" 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 ConfigurationOverrides
configurationOverrides,
            (Key
"executionTimeoutMinutes" 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
executionTimeoutMinutes,
            (Key
"jobDriver" 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 JobDriver
jobDriver,
            (Key
"name" 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
name,
            (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,
            forall a. a -> Maybe a
Prelude.Just (Key
"clientToken" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
clientToken),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"executionRoleArn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
executionRoleArn)
          ]
      )

instance Data.ToPath StartJobRun where
  toPath :: StartJobRun -> ByteString
toPath StartJobRun' {Maybe Natural
Maybe Text
Maybe (HashMap Text Text)
Maybe ConfigurationOverrides
Maybe JobDriver
Text
executionRoleArn :: Text
clientToken :: Text
applicationId :: Text
tags :: Maybe (HashMap Text Text)
name :: Maybe Text
jobDriver :: Maybe JobDriver
executionTimeoutMinutes :: Maybe Natural
configurationOverrides :: Maybe ConfigurationOverrides
$sel:executionRoleArn:StartJobRun' :: StartJobRun -> Text
$sel:clientToken:StartJobRun' :: StartJobRun -> Text
$sel:applicationId:StartJobRun' :: StartJobRun -> Text
$sel:tags:StartJobRun' :: StartJobRun -> Maybe (HashMap Text Text)
$sel:name:StartJobRun' :: StartJobRun -> Maybe Text
$sel:jobDriver:StartJobRun' :: StartJobRun -> Maybe JobDriver
$sel:executionTimeoutMinutes:StartJobRun' :: StartJobRun -> Maybe Natural
$sel:configurationOverrides:StartJobRun' :: StartJobRun -> Maybe ConfigurationOverrides
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/applications/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
applicationId,
        ByteString
"/jobruns"
      ]

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 response's http status code.
    StartJobRunResponse -> Int
httpStatus :: Prelude.Int,
    -- | This output displays the application ID on which the job run was
    -- submitted.
    StartJobRunResponse -> Text
applicationId :: Prelude.Text,
    -- | The output contains the ID of the started job run.
    StartJobRunResponse -> Text
jobRunId :: Prelude.Text,
    -- | The output lists the execution role ARN of the job run.
    StartJobRunResponse -> Text
arn :: Prelude.Text
  }
  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:
--
-- 'httpStatus', 'startJobRunResponse_httpStatus' - The response's http status code.
--
-- 'applicationId', 'startJobRunResponse_applicationId' - This output displays the application ID on which the job run was
-- submitted.
--
-- 'jobRunId', 'startJobRunResponse_jobRunId' - The output contains the ID of the started job run.
--
-- 'arn', 'startJobRunResponse_arn' - The output lists the execution role ARN of the job run.
newStartJobRunResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'applicationId'
  Prelude.Text ->
  -- | 'jobRunId'
  Prelude.Text ->
  -- | 'arn'
  Prelude.Text ->
  StartJobRunResponse
newStartJobRunResponse :: Int -> Text -> Text -> Text -> StartJobRunResponse
newStartJobRunResponse
  Int
pHttpStatus_
  Text
pApplicationId_
  Text
pJobRunId_
  Text
pArn_ =
    StartJobRunResponse'
      { $sel:httpStatus:StartJobRunResponse' :: Int
httpStatus = Int
pHttpStatus_,
        $sel:applicationId:StartJobRunResponse' :: Text
applicationId = Text
pApplicationId_,
        $sel:jobRunId:StartJobRunResponse' :: Text
jobRunId = Text
pJobRunId_,
        $sel:arn:StartJobRunResponse' :: Text
arn = Text
pArn_
      }

-- | 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)

-- | This output displays the application ID on which the job run was
-- submitted.
startJobRunResponse_applicationId :: Lens.Lens' StartJobRunResponse Prelude.Text
startJobRunResponse_applicationId :: Lens' StartJobRunResponse Text
startJobRunResponse_applicationId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartJobRunResponse' {Text
applicationId :: Text
$sel:applicationId:StartJobRunResponse' :: StartJobRunResponse -> Text
applicationId} -> Text
applicationId) (\s :: StartJobRunResponse
s@StartJobRunResponse' {} Text
a -> StartJobRunResponse
s {$sel:applicationId:StartJobRunResponse' :: Text
applicationId = Text
a} :: StartJobRunResponse)

-- | The output contains the ID of the started job run.
startJobRunResponse_jobRunId :: Lens.Lens' StartJobRunResponse Prelude.Text
startJobRunResponse_jobRunId :: Lens' StartJobRunResponse Text
startJobRunResponse_jobRunId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartJobRunResponse' {Text
jobRunId :: Text
$sel:jobRunId:StartJobRunResponse' :: StartJobRunResponse -> Text
jobRunId} -> Text
jobRunId) (\s :: StartJobRunResponse
s@StartJobRunResponse' {} Text
a -> StartJobRunResponse
s {$sel:jobRunId:StartJobRunResponse' :: Text
jobRunId = Text
a} :: StartJobRunResponse)

-- | The output lists the execution role ARN of the job run.
startJobRunResponse_arn :: Lens.Lens' StartJobRunResponse Prelude.Text
startJobRunResponse_arn :: Lens' StartJobRunResponse Text
startJobRunResponse_arn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartJobRunResponse' {Text
arn :: Text
$sel:arn:StartJobRunResponse' :: StartJobRunResponse -> Text
arn} -> Text
arn) (\s :: StartJobRunResponse
s@StartJobRunResponse' {} Text
a -> StartJobRunResponse
s {$sel:arn:StartJobRunResponse' :: Text
arn = Text
a} :: StartJobRunResponse)

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