{-# 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.RobOMaker.CreateSimulationJob
-- 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 simulation job.
--
-- After 90 days, simulation jobs expire and will be deleted. They will no
-- longer be accessible.
module Amazonka.RobOMaker.CreateSimulationJob
  ( -- * Creating a Request
    CreateSimulationJob (..),
    newCreateSimulationJob,

    -- * Request Lenses
    createSimulationJob_clientRequestToken,
    createSimulationJob_compute,
    createSimulationJob_dataSources,
    createSimulationJob_failureBehavior,
    createSimulationJob_loggingConfig,
    createSimulationJob_outputLocation,
    createSimulationJob_robotApplications,
    createSimulationJob_simulationApplications,
    createSimulationJob_tags,
    createSimulationJob_vpcConfig,
    createSimulationJob_maxJobDurationInSeconds,
    createSimulationJob_iamRole,

    -- * Destructuring the Response
    CreateSimulationJobResponse (..),
    newCreateSimulationJobResponse,

    -- * Response Lenses
    createSimulationJobResponse_arn,
    createSimulationJobResponse_clientRequestToken,
    createSimulationJobResponse_compute,
    createSimulationJobResponse_dataSources,
    createSimulationJobResponse_failureBehavior,
    createSimulationJobResponse_failureCode,
    createSimulationJobResponse_iamRole,
    createSimulationJobResponse_lastStartedAt,
    createSimulationJobResponse_lastUpdatedAt,
    createSimulationJobResponse_loggingConfig,
    createSimulationJobResponse_maxJobDurationInSeconds,
    createSimulationJobResponse_outputLocation,
    createSimulationJobResponse_robotApplications,
    createSimulationJobResponse_simulationApplications,
    createSimulationJobResponse_simulationTimeMillis,
    createSimulationJobResponse_status,
    createSimulationJobResponse_tags,
    createSimulationJobResponse_vpcConfig,
    createSimulationJobResponse_httpStatus,
  )
where

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

-- | /See:/ 'newCreateSimulationJob' smart constructor.
data CreateSimulationJob = CreateSimulationJob'
  { -- | Unique, case-sensitive identifier that you provide to ensure the
    -- idempotency of the request.
    CreateSimulationJob -> Maybe Text
clientRequestToken :: Prelude.Maybe Prelude.Text,
    -- | Compute information for the simulation job.
    CreateSimulationJob -> Maybe Compute
compute :: Prelude.Maybe Compute,
    -- | Specify data sources to mount read-only files from S3 into your
    -- simulation. These files are available under
    -- @\/opt\/robomaker\/datasources\/data_source_name@.
    --
    -- There is a limit of 100 files and a combined size of 25GB for all
    -- @DataSourceConfig@ objects.
    CreateSimulationJob -> Maybe (NonEmpty DataSourceConfig)
dataSources :: Prelude.Maybe (Prelude.NonEmpty DataSourceConfig),
    -- | The failure behavior the simulation job.
    --
    -- [Continue]
    --     Leaves the instance running for its maximum timeout duration after a
    --     @4XX@ error code.
    --
    -- [Fail]
    --     Stop the simulation job and terminate the instance.
    CreateSimulationJob -> Maybe FailureBehavior
failureBehavior :: Prelude.Maybe FailureBehavior,
    -- | The logging configuration.
    CreateSimulationJob -> Maybe LoggingConfig
loggingConfig :: Prelude.Maybe LoggingConfig,
    -- | Location for output files generated by the simulation job.
    CreateSimulationJob -> Maybe OutputLocation
outputLocation :: Prelude.Maybe OutputLocation,
    -- | The robot application to use in the simulation job.
    CreateSimulationJob -> Maybe (NonEmpty RobotApplicationConfig)
robotApplications :: Prelude.Maybe (Prelude.NonEmpty RobotApplicationConfig),
    -- | The simulation application to use in the simulation job.
    CreateSimulationJob -> Maybe (NonEmpty SimulationApplicationConfig)
simulationApplications :: Prelude.Maybe (Prelude.NonEmpty SimulationApplicationConfig),
    -- | A map that contains tag keys and tag values that are attached to the
    -- simulation job.
    CreateSimulationJob -> Maybe (HashMap Text Text)
tags :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | If your simulation job accesses resources in a VPC, you provide this
    -- parameter identifying the list of security group IDs and subnet IDs.
    -- These must belong to the same VPC. You must provide at least one
    -- security group and one subnet ID.
    CreateSimulationJob -> Maybe VPCConfig
vpcConfig :: Prelude.Maybe VPCConfig,
    -- | The maximum simulation job duration in seconds (up to 14 days or
    -- 1,209,600 seconds. When @maxJobDurationInSeconds@ is reached, the
    -- simulation job will status will transition to @Completed@.
    CreateSimulationJob -> Integer
maxJobDurationInSeconds :: Prelude.Integer,
    -- | The IAM role name that allows the simulation instance to call the AWS
    -- APIs that are specified in its associated policies on your behalf. This
    -- is how credentials are passed in to your simulation job.
    CreateSimulationJob -> Text
iamRole :: Prelude.Text
  }
  deriving (CreateSimulationJob -> CreateSimulationJob -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateSimulationJob -> CreateSimulationJob -> Bool
$c/= :: CreateSimulationJob -> CreateSimulationJob -> Bool
== :: CreateSimulationJob -> CreateSimulationJob -> Bool
$c== :: CreateSimulationJob -> CreateSimulationJob -> Bool
Prelude.Eq, ReadPrec [CreateSimulationJob]
ReadPrec CreateSimulationJob
Int -> ReadS CreateSimulationJob
ReadS [CreateSimulationJob]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateSimulationJob]
$creadListPrec :: ReadPrec [CreateSimulationJob]
readPrec :: ReadPrec CreateSimulationJob
$creadPrec :: ReadPrec CreateSimulationJob
readList :: ReadS [CreateSimulationJob]
$creadList :: ReadS [CreateSimulationJob]
readsPrec :: Int -> ReadS CreateSimulationJob
$creadsPrec :: Int -> ReadS CreateSimulationJob
Prelude.Read, Int -> CreateSimulationJob -> ShowS
[CreateSimulationJob] -> ShowS
CreateSimulationJob -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateSimulationJob] -> ShowS
$cshowList :: [CreateSimulationJob] -> ShowS
show :: CreateSimulationJob -> String
$cshow :: CreateSimulationJob -> String
showsPrec :: Int -> CreateSimulationJob -> ShowS
$cshowsPrec :: Int -> CreateSimulationJob -> ShowS
Prelude.Show, forall x. Rep CreateSimulationJob x -> CreateSimulationJob
forall x. CreateSimulationJob -> Rep CreateSimulationJob x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateSimulationJob x -> CreateSimulationJob
$cfrom :: forall x. CreateSimulationJob -> Rep CreateSimulationJob x
Prelude.Generic)

-- |
-- Create a value of 'CreateSimulationJob' with all optional fields omitted.
--
-- Use <https://hackage.haskell.org/package/generic-lens generic-lens> or <https://hackage.haskell.org/package/optics optics> to modify other optional fields.
--
-- The following record fields are available, with the corresponding lenses provided
-- for backwards compatibility:
--
-- 'clientRequestToken', 'createSimulationJob_clientRequestToken' - Unique, case-sensitive identifier that you provide to ensure the
-- idempotency of the request.
--
-- 'compute', 'createSimulationJob_compute' - Compute information for the simulation job.
--
-- 'dataSources', 'createSimulationJob_dataSources' - Specify data sources to mount read-only files from S3 into your
-- simulation. These files are available under
-- @\/opt\/robomaker\/datasources\/data_source_name@.
--
-- There is a limit of 100 files and a combined size of 25GB for all
-- @DataSourceConfig@ objects.
--
-- 'failureBehavior', 'createSimulationJob_failureBehavior' - The failure behavior the simulation job.
--
-- [Continue]
--     Leaves the instance running for its maximum timeout duration after a
--     @4XX@ error code.
--
-- [Fail]
--     Stop the simulation job and terminate the instance.
--
-- 'loggingConfig', 'createSimulationJob_loggingConfig' - The logging configuration.
--
-- 'outputLocation', 'createSimulationJob_outputLocation' - Location for output files generated by the simulation job.
--
-- 'robotApplications', 'createSimulationJob_robotApplications' - The robot application to use in the simulation job.
--
-- 'simulationApplications', 'createSimulationJob_simulationApplications' - The simulation application to use in the simulation job.
--
-- 'tags', 'createSimulationJob_tags' - A map that contains tag keys and tag values that are attached to the
-- simulation job.
--
-- 'vpcConfig', 'createSimulationJob_vpcConfig' - If your simulation job accesses resources in a VPC, you provide this
-- parameter identifying the list of security group IDs and subnet IDs.
-- These must belong to the same VPC. You must provide at least one
-- security group and one subnet ID.
--
-- 'maxJobDurationInSeconds', 'createSimulationJob_maxJobDurationInSeconds' - The maximum simulation job duration in seconds (up to 14 days or
-- 1,209,600 seconds. When @maxJobDurationInSeconds@ is reached, the
-- simulation job will status will transition to @Completed@.
--
-- 'iamRole', 'createSimulationJob_iamRole' - The IAM role name that allows the simulation instance to call the AWS
-- APIs that are specified in its associated policies on your behalf. This
-- is how credentials are passed in to your simulation job.
newCreateSimulationJob ::
  -- | 'maxJobDurationInSeconds'
  Prelude.Integer ->
  -- | 'iamRole'
  Prelude.Text ->
  CreateSimulationJob
newCreateSimulationJob :: Integer -> Text -> CreateSimulationJob
newCreateSimulationJob
  Integer
pMaxJobDurationInSeconds_
  Text
pIamRole_ =
    CreateSimulationJob'
      { $sel:clientRequestToken:CreateSimulationJob' :: Maybe Text
clientRequestToken =
          forall a. Maybe a
Prelude.Nothing,
        $sel:compute:CreateSimulationJob' :: Maybe Compute
compute = forall a. Maybe a
Prelude.Nothing,
        $sel:dataSources:CreateSimulationJob' :: Maybe (NonEmpty DataSourceConfig)
dataSources = forall a. Maybe a
Prelude.Nothing,
        $sel:failureBehavior:CreateSimulationJob' :: Maybe FailureBehavior
failureBehavior = forall a. Maybe a
Prelude.Nothing,
        $sel:loggingConfig:CreateSimulationJob' :: Maybe LoggingConfig
loggingConfig = forall a. Maybe a
Prelude.Nothing,
        $sel:outputLocation:CreateSimulationJob' :: Maybe OutputLocation
outputLocation = forall a. Maybe a
Prelude.Nothing,
        $sel:robotApplications:CreateSimulationJob' :: Maybe (NonEmpty RobotApplicationConfig)
robotApplications = forall a. Maybe a
Prelude.Nothing,
        $sel:simulationApplications:CreateSimulationJob' :: Maybe (NonEmpty SimulationApplicationConfig)
simulationApplications = forall a. Maybe a
Prelude.Nothing,
        $sel:tags:CreateSimulationJob' :: Maybe (HashMap Text Text)
tags = forall a. Maybe a
Prelude.Nothing,
        $sel:vpcConfig:CreateSimulationJob' :: Maybe VPCConfig
vpcConfig = forall a. Maybe a
Prelude.Nothing,
        $sel:maxJobDurationInSeconds:CreateSimulationJob' :: Integer
maxJobDurationInSeconds = Integer
pMaxJobDurationInSeconds_,
        $sel:iamRole:CreateSimulationJob' :: Text
iamRole = Text
pIamRole_
      }

-- | Unique, case-sensitive identifier that you provide to ensure the
-- idempotency of the request.
createSimulationJob_clientRequestToken :: Lens.Lens' CreateSimulationJob (Prelude.Maybe Prelude.Text)
createSimulationJob_clientRequestToken :: Lens' CreateSimulationJob (Maybe Text)
createSimulationJob_clientRequestToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateSimulationJob' {Maybe Text
clientRequestToken :: Maybe Text
$sel:clientRequestToken:CreateSimulationJob' :: CreateSimulationJob -> Maybe Text
clientRequestToken} -> Maybe Text
clientRequestToken) (\s :: CreateSimulationJob
s@CreateSimulationJob' {} Maybe Text
a -> CreateSimulationJob
s {$sel:clientRequestToken:CreateSimulationJob' :: Maybe Text
clientRequestToken = Maybe Text
a} :: CreateSimulationJob)

-- | Compute information for the simulation job.
createSimulationJob_compute :: Lens.Lens' CreateSimulationJob (Prelude.Maybe Compute)
createSimulationJob_compute :: Lens' CreateSimulationJob (Maybe Compute)
createSimulationJob_compute = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateSimulationJob' {Maybe Compute
compute :: Maybe Compute
$sel:compute:CreateSimulationJob' :: CreateSimulationJob -> Maybe Compute
compute} -> Maybe Compute
compute) (\s :: CreateSimulationJob
s@CreateSimulationJob' {} Maybe Compute
a -> CreateSimulationJob
s {$sel:compute:CreateSimulationJob' :: Maybe Compute
compute = Maybe Compute
a} :: CreateSimulationJob)

-- | Specify data sources to mount read-only files from S3 into your
-- simulation. These files are available under
-- @\/opt\/robomaker\/datasources\/data_source_name@.
--
-- There is a limit of 100 files and a combined size of 25GB for all
-- @DataSourceConfig@ objects.
createSimulationJob_dataSources :: Lens.Lens' CreateSimulationJob (Prelude.Maybe (Prelude.NonEmpty DataSourceConfig))
createSimulationJob_dataSources :: Lens' CreateSimulationJob (Maybe (NonEmpty DataSourceConfig))
createSimulationJob_dataSources = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateSimulationJob' {Maybe (NonEmpty DataSourceConfig)
dataSources :: Maybe (NonEmpty DataSourceConfig)
$sel:dataSources:CreateSimulationJob' :: CreateSimulationJob -> Maybe (NonEmpty DataSourceConfig)
dataSources} -> Maybe (NonEmpty DataSourceConfig)
dataSources) (\s :: CreateSimulationJob
s@CreateSimulationJob' {} Maybe (NonEmpty DataSourceConfig)
a -> CreateSimulationJob
s {$sel:dataSources:CreateSimulationJob' :: Maybe (NonEmpty DataSourceConfig)
dataSources = Maybe (NonEmpty DataSourceConfig)
a} :: CreateSimulationJob) 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 failure behavior the simulation job.
--
-- [Continue]
--     Leaves the instance running for its maximum timeout duration after a
--     @4XX@ error code.
--
-- [Fail]
--     Stop the simulation job and terminate the instance.
createSimulationJob_failureBehavior :: Lens.Lens' CreateSimulationJob (Prelude.Maybe FailureBehavior)
createSimulationJob_failureBehavior :: Lens' CreateSimulationJob (Maybe FailureBehavior)
createSimulationJob_failureBehavior = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateSimulationJob' {Maybe FailureBehavior
failureBehavior :: Maybe FailureBehavior
$sel:failureBehavior:CreateSimulationJob' :: CreateSimulationJob -> Maybe FailureBehavior
failureBehavior} -> Maybe FailureBehavior
failureBehavior) (\s :: CreateSimulationJob
s@CreateSimulationJob' {} Maybe FailureBehavior
a -> CreateSimulationJob
s {$sel:failureBehavior:CreateSimulationJob' :: Maybe FailureBehavior
failureBehavior = Maybe FailureBehavior
a} :: CreateSimulationJob)

-- | The logging configuration.
createSimulationJob_loggingConfig :: Lens.Lens' CreateSimulationJob (Prelude.Maybe LoggingConfig)
createSimulationJob_loggingConfig :: Lens' CreateSimulationJob (Maybe LoggingConfig)
createSimulationJob_loggingConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateSimulationJob' {Maybe LoggingConfig
loggingConfig :: Maybe LoggingConfig
$sel:loggingConfig:CreateSimulationJob' :: CreateSimulationJob -> Maybe LoggingConfig
loggingConfig} -> Maybe LoggingConfig
loggingConfig) (\s :: CreateSimulationJob
s@CreateSimulationJob' {} Maybe LoggingConfig
a -> CreateSimulationJob
s {$sel:loggingConfig:CreateSimulationJob' :: Maybe LoggingConfig
loggingConfig = Maybe LoggingConfig
a} :: CreateSimulationJob)

-- | Location for output files generated by the simulation job.
createSimulationJob_outputLocation :: Lens.Lens' CreateSimulationJob (Prelude.Maybe OutputLocation)
createSimulationJob_outputLocation :: Lens' CreateSimulationJob (Maybe OutputLocation)
createSimulationJob_outputLocation = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateSimulationJob' {Maybe OutputLocation
outputLocation :: Maybe OutputLocation
$sel:outputLocation:CreateSimulationJob' :: CreateSimulationJob -> Maybe OutputLocation
outputLocation} -> Maybe OutputLocation
outputLocation) (\s :: CreateSimulationJob
s@CreateSimulationJob' {} Maybe OutputLocation
a -> CreateSimulationJob
s {$sel:outputLocation:CreateSimulationJob' :: Maybe OutputLocation
outputLocation = Maybe OutputLocation
a} :: CreateSimulationJob)

-- | The robot application to use in the simulation job.
createSimulationJob_robotApplications :: Lens.Lens' CreateSimulationJob (Prelude.Maybe (Prelude.NonEmpty RobotApplicationConfig))
createSimulationJob_robotApplications :: Lens' CreateSimulationJob (Maybe (NonEmpty RobotApplicationConfig))
createSimulationJob_robotApplications = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateSimulationJob' {Maybe (NonEmpty RobotApplicationConfig)
robotApplications :: Maybe (NonEmpty RobotApplicationConfig)
$sel:robotApplications:CreateSimulationJob' :: CreateSimulationJob -> Maybe (NonEmpty RobotApplicationConfig)
robotApplications} -> Maybe (NonEmpty RobotApplicationConfig)
robotApplications) (\s :: CreateSimulationJob
s@CreateSimulationJob' {} Maybe (NonEmpty RobotApplicationConfig)
a -> CreateSimulationJob
s {$sel:robotApplications:CreateSimulationJob' :: Maybe (NonEmpty RobotApplicationConfig)
robotApplications = Maybe (NonEmpty RobotApplicationConfig)
a} :: CreateSimulationJob) 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 simulation application to use in the simulation job.
createSimulationJob_simulationApplications :: Lens.Lens' CreateSimulationJob (Prelude.Maybe (Prelude.NonEmpty SimulationApplicationConfig))
createSimulationJob_simulationApplications :: Lens'
  CreateSimulationJob (Maybe (NonEmpty SimulationApplicationConfig))
createSimulationJob_simulationApplications = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateSimulationJob' {Maybe (NonEmpty SimulationApplicationConfig)
simulationApplications :: Maybe (NonEmpty SimulationApplicationConfig)
$sel:simulationApplications:CreateSimulationJob' :: CreateSimulationJob -> Maybe (NonEmpty SimulationApplicationConfig)
simulationApplications} -> Maybe (NonEmpty SimulationApplicationConfig)
simulationApplications) (\s :: CreateSimulationJob
s@CreateSimulationJob' {} Maybe (NonEmpty SimulationApplicationConfig)
a -> CreateSimulationJob
s {$sel:simulationApplications:CreateSimulationJob' :: Maybe (NonEmpty SimulationApplicationConfig)
simulationApplications = Maybe (NonEmpty SimulationApplicationConfig)
a} :: CreateSimulationJob) 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

-- | A map that contains tag keys and tag values that are attached to the
-- simulation job.
createSimulationJob_tags :: Lens.Lens' CreateSimulationJob (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
createSimulationJob_tags :: Lens' CreateSimulationJob (Maybe (HashMap Text Text))
createSimulationJob_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateSimulationJob' {Maybe (HashMap Text Text)
tags :: Maybe (HashMap Text Text)
$sel:tags:CreateSimulationJob' :: CreateSimulationJob -> Maybe (HashMap Text Text)
tags} -> Maybe (HashMap Text Text)
tags) (\s :: CreateSimulationJob
s@CreateSimulationJob' {} Maybe (HashMap Text Text)
a -> CreateSimulationJob
s {$sel:tags:CreateSimulationJob' :: Maybe (HashMap Text Text)
tags = Maybe (HashMap Text Text)
a} :: CreateSimulationJob) 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

-- | If your simulation job accesses resources in a VPC, you provide this
-- parameter identifying the list of security group IDs and subnet IDs.
-- These must belong to the same VPC. You must provide at least one
-- security group and one subnet ID.
createSimulationJob_vpcConfig :: Lens.Lens' CreateSimulationJob (Prelude.Maybe VPCConfig)
createSimulationJob_vpcConfig :: Lens' CreateSimulationJob (Maybe VPCConfig)
createSimulationJob_vpcConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateSimulationJob' {Maybe VPCConfig
vpcConfig :: Maybe VPCConfig
$sel:vpcConfig:CreateSimulationJob' :: CreateSimulationJob -> Maybe VPCConfig
vpcConfig} -> Maybe VPCConfig
vpcConfig) (\s :: CreateSimulationJob
s@CreateSimulationJob' {} Maybe VPCConfig
a -> CreateSimulationJob
s {$sel:vpcConfig:CreateSimulationJob' :: Maybe VPCConfig
vpcConfig = Maybe VPCConfig
a} :: CreateSimulationJob)

-- | The maximum simulation job duration in seconds (up to 14 days or
-- 1,209,600 seconds. When @maxJobDurationInSeconds@ is reached, the
-- simulation job will status will transition to @Completed@.
createSimulationJob_maxJobDurationInSeconds :: Lens.Lens' CreateSimulationJob Prelude.Integer
createSimulationJob_maxJobDurationInSeconds :: Lens' CreateSimulationJob Integer
createSimulationJob_maxJobDurationInSeconds = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateSimulationJob' {Integer
maxJobDurationInSeconds :: Integer
$sel:maxJobDurationInSeconds:CreateSimulationJob' :: CreateSimulationJob -> Integer
maxJobDurationInSeconds} -> Integer
maxJobDurationInSeconds) (\s :: CreateSimulationJob
s@CreateSimulationJob' {} Integer
a -> CreateSimulationJob
s {$sel:maxJobDurationInSeconds:CreateSimulationJob' :: Integer
maxJobDurationInSeconds = Integer
a} :: CreateSimulationJob)

-- | The IAM role name that allows the simulation instance to call the AWS
-- APIs that are specified in its associated policies on your behalf. This
-- is how credentials are passed in to your simulation job.
createSimulationJob_iamRole :: Lens.Lens' CreateSimulationJob Prelude.Text
createSimulationJob_iamRole :: Lens' CreateSimulationJob Text
createSimulationJob_iamRole = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateSimulationJob' {Text
iamRole :: Text
$sel:iamRole:CreateSimulationJob' :: CreateSimulationJob -> Text
iamRole} -> Text
iamRole) (\s :: CreateSimulationJob
s@CreateSimulationJob' {} Text
a -> CreateSimulationJob
s {$sel:iamRole:CreateSimulationJob' :: Text
iamRole = Text
a} :: CreateSimulationJob)

instance Core.AWSRequest CreateSimulationJob where
  type
    AWSResponse CreateSimulationJob =
      CreateSimulationJobResponse
  request :: (Service -> Service)
-> CreateSimulationJob -> Request CreateSimulationJob
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 CreateSimulationJob
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CreateSimulationJob)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> Object -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveJSON
      ( \Int
s ResponseHeaders
h Object
x ->
          Maybe Text
-> Maybe Text
-> Maybe ComputeResponse
-> Maybe [DataSource]
-> Maybe FailureBehavior
-> Maybe SimulationJobErrorCode
-> Maybe Text
-> Maybe POSIX
-> Maybe POSIX
-> Maybe LoggingConfig
-> Maybe Integer
-> Maybe OutputLocation
-> Maybe (NonEmpty RobotApplicationConfig)
-> Maybe (NonEmpty SimulationApplicationConfig)
-> Maybe Integer
-> Maybe SimulationJobStatus
-> Maybe (HashMap Text Text)
-> Maybe VPCConfigResponse
-> Int
-> CreateSimulationJobResponse
CreateSimulationJobResponse'
            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
"arn")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"clientRequestToken")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"compute")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"dataSources" forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty)
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"failureBehavior")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"failureCode")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"iamRole")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"lastStartedAt")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"lastUpdatedAt")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"loggingConfig")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"maxJobDurationInSeconds")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"outputLocation")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"robotApplications")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"simulationApplications")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"simulationTimeMillis")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"status")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"tags" forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty)
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"vpcConfig")
            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 CreateSimulationJob where
  hashWithSalt :: Int -> CreateSimulationJob -> Int
hashWithSalt Int
_salt CreateSimulationJob' {Integer
Maybe (NonEmpty DataSourceConfig)
Maybe (NonEmpty RobotApplicationConfig)
Maybe (NonEmpty SimulationApplicationConfig)
Maybe Text
Maybe (HashMap Text Text)
Maybe Compute
Maybe FailureBehavior
Maybe LoggingConfig
Maybe OutputLocation
Maybe VPCConfig
Text
iamRole :: Text
maxJobDurationInSeconds :: Integer
vpcConfig :: Maybe VPCConfig
tags :: Maybe (HashMap Text Text)
simulationApplications :: Maybe (NonEmpty SimulationApplicationConfig)
robotApplications :: Maybe (NonEmpty RobotApplicationConfig)
outputLocation :: Maybe OutputLocation
loggingConfig :: Maybe LoggingConfig
failureBehavior :: Maybe FailureBehavior
dataSources :: Maybe (NonEmpty DataSourceConfig)
compute :: Maybe Compute
clientRequestToken :: Maybe Text
$sel:iamRole:CreateSimulationJob' :: CreateSimulationJob -> Text
$sel:maxJobDurationInSeconds:CreateSimulationJob' :: CreateSimulationJob -> Integer
$sel:vpcConfig:CreateSimulationJob' :: CreateSimulationJob -> Maybe VPCConfig
$sel:tags:CreateSimulationJob' :: CreateSimulationJob -> Maybe (HashMap Text Text)
$sel:simulationApplications:CreateSimulationJob' :: CreateSimulationJob -> Maybe (NonEmpty SimulationApplicationConfig)
$sel:robotApplications:CreateSimulationJob' :: CreateSimulationJob -> Maybe (NonEmpty RobotApplicationConfig)
$sel:outputLocation:CreateSimulationJob' :: CreateSimulationJob -> Maybe OutputLocation
$sel:loggingConfig:CreateSimulationJob' :: CreateSimulationJob -> Maybe LoggingConfig
$sel:failureBehavior:CreateSimulationJob' :: CreateSimulationJob -> Maybe FailureBehavior
$sel:dataSources:CreateSimulationJob' :: CreateSimulationJob -> Maybe (NonEmpty DataSourceConfig)
$sel:compute:CreateSimulationJob' :: CreateSimulationJob -> Maybe Compute
$sel:clientRequestToken:CreateSimulationJob' :: CreateSimulationJob -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
clientRequestToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Compute
compute
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (NonEmpty DataSourceConfig)
dataSources
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe FailureBehavior
failureBehavior
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe LoggingConfig
loggingConfig
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe OutputLocation
outputLocation
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (NonEmpty RobotApplicationConfig)
robotApplications
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (NonEmpty SimulationApplicationConfig)
simulationApplications
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Text)
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe VPCConfig
vpcConfig
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Integer
maxJobDurationInSeconds
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
iamRole

instance Prelude.NFData CreateSimulationJob where
  rnf :: CreateSimulationJob -> ()
rnf CreateSimulationJob' {Integer
Maybe (NonEmpty DataSourceConfig)
Maybe (NonEmpty RobotApplicationConfig)
Maybe (NonEmpty SimulationApplicationConfig)
Maybe Text
Maybe (HashMap Text Text)
Maybe Compute
Maybe FailureBehavior
Maybe LoggingConfig
Maybe OutputLocation
Maybe VPCConfig
Text
iamRole :: Text
maxJobDurationInSeconds :: Integer
vpcConfig :: Maybe VPCConfig
tags :: Maybe (HashMap Text Text)
simulationApplications :: Maybe (NonEmpty SimulationApplicationConfig)
robotApplications :: Maybe (NonEmpty RobotApplicationConfig)
outputLocation :: Maybe OutputLocation
loggingConfig :: Maybe LoggingConfig
failureBehavior :: Maybe FailureBehavior
dataSources :: Maybe (NonEmpty DataSourceConfig)
compute :: Maybe Compute
clientRequestToken :: Maybe Text
$sel:iamRole:CreateSimulationJob' :: CreateSimulationJob -> Text
$sel:maxJobDurationInSeconds:CreateSimulationJob' :: CreateSimulationJob -> Integer
$sel:vpcConfig:CreateSimulationJob' :: CreateSimulationJob -> Maybe VPCConfig
$sel:tags:CreateSimulationJob' :: CreateSimulationJob -> Maybe (HashMap Text Text)
$sel:simulationApplications:CreateSimulationJob' :: CreateSimulationJob -> Maybe (NonEmpty SimulationApplicationConfig)
$sel:robotApplications:CreateSimulationJob' :: CreateSimulationJob -> Maybe (NonEmpty RobotApplicationConfig)
$sel:outputLocation:CreateSimulationJob' :: CreateSimulationJob -> Maybe OutputLocation
$sel:loggingConfig:CreateSimulationJob' :: CreateSimulationJob -> Maybe LoggingConfig
$sel:failureBehavior:CreateSimulationJob' :: CreateSimulationJob -> Maybe FailureBehavior
$sel:dataSources:CreateSimulationJob' :: CreateSimulationJob -> Maybe (NonEmpty DataSourceConfig)
$sel:compute:CreateSimulationJob' :: CreateSimulationJob -> Maybe Compute
$sel:clientRequestToken:CreateSimulationJob' :: CreateSimulationJob -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
clientRequestToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Compute
compute
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (NonEmpty DataSourceConfig)
dataSources
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe FailureBehavior
failureBehavior
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe LoggingConfig
loggingConfig
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe OutputLocation
outputLocation
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (NonEmpty RobotApplicationConfig)
robotApplications
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (NonEmpty SimulationApplicationConfig)
simulationApplications
      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 VPCConfig
vpcConfig
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Integer
maxJobDurationInSeconds
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
iamRole

instance Data.ToHeaders CreateSimulationJob where
  toHeaders :: CreateSimulationJob -> 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 CreateSimulationJob where
  toJSON :: CreateSimulationJob -> Value
toJSON CreateSimulationJob' {Integer
Maybe (NonEmpty DataSourceConfig)
Maybe (NonEmpty RobotApplicationConfig)
Maybe (NonEmpty SimulationApplicationConfig)
Maybe Text
Maybe (HashMap Text Text)
Maybe Compute
Maybe FailureBehavior
Maybe LoggingConfig
Maybe OutputLocation
Maybe VPCConfig
Text
iamRole :: Text
maxJobDurationInSeconds :: Integer
vpcConfig :: Maybe VPCConfig
tags :: Maybe (HashMap Text Text)
simulationApplications :: Maybe (NonEmpty SimulationApplicationConfig)
robotApplications :: Maybe (NonEmpty RobotApplicationConfig)
outputLocation :: Maybe OutputLocation
loggingConfig :: Maybe LoggingConfig
failureBehavior :: Maybe FailureBehavior
dataSources :: Maybe (NonEmpty DataSourceConfig)
compute :: Maybe Compute
clientRequestToken :: Maybe Text
$sel:iamRole:CreateSimulationJob' :: CreateSimulationJob -> Text
$sel:maxJobDurationInSeconds:CreateSimulationJob' :: CreateSimulationJob -> Integer
$sel:vpcConfig:CreateSimulationJob' :: CreateSimulationJob -> Maybe VPCConfig
$sel:tags:CreateSimulationJob' :: CreateSimulationJob -> Maybe (HashMap Text Text)
$sel:simulationApplications:CreateSimulationJob' :: CreateSimulationJob -> Maybe (NonEmpty SimulationApplicationConfig)
$sel:robotApplications:CreateSimulationJob' :: CreateSimulationJob -> Maybe (NonEmpty RobotApplicationConfig)
$sel:outputLocation:CreateSimulationJob' :: CreateSimulationJob -> Maybe OutputLocation
$sel:loggingConfig:CreateSimulationJob' :: CreateSimulationJob -> Maybe LoggingConfig
$sel:failureBehavior:CreateSimulationJob' :: CreateSimulationJob -> Maybe FailureBehavior
$sel:dataSources:CreateSimulationJob' :: CreateSimulationJob -> Maybe (NonEmpty DataSourceConfig)
$sel:compute:CreateSimulationJob' :: CreateSimulationJob -> Maybe Compute
$sel:clientRequestToken:CreateSimulationJob' :: CreateSimulationJob -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"clientRequestToken" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
clientRequestToken,
            (Key
"compute" 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 Compute
compute,
            (Key
"dataSources" 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 (NonEmpty DataSourceConfig)
dataSources,
            (Key
"failureBehavior" 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 FailureBehavior
failureBehavior,
            (Key
"loggingConfig" 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 LoggingConfig
loggingConfig,
            (Key
"outputLocation" 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 OutputLocation
outputLocation,
            (Key
"robotApplications" 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 (NonEmpty RobotApplicationConfig)
robotApplications,
            (Key
"simulationApplications" 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 (NonEmpty SimulationApplicationConfig)
simulationApplications,
            (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
"vpcConfig" 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 VPCConfig
vpcConfig,
            forall a. a -> Maybe a
Prelude.Just
              ( Key
"maxJobDurationInSeconds"
                  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Integer
maxJobDurationInSeconds
              ),
            forall a. a -> Maybe a
Prelude.Just (Key
"iamRole" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
iamRole)
          ]
      )

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

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

-- | /See:/ 'newCreateSimulationJobResponse' smart constructor.
data CreateSimulationJobResponse = CreateSimulationJobResponse'
  { -- | The Amazon Resource Name (ARN) of the simulation job.
    CreateSimulationJobResponse -> Maybe Text
arn :: Prelude.Maybe Prelude.Text,
    -- | Unique, case-sensitive identifier that you provide to ensure the
    -- idempotency of the request.
    CreateSimulationJobResponse -> Maybe Text
clientRequestToken :: Prelude.Maybe Prelude.Text,
    -- | Compute information for the simulation job.
    CreateSimulationJobResponse -> Maybe ComputeResponse
compute :: Prelude.Maybe ComputeResponse,
    -- | The data sources for the simulation job.
    CreateSimulationJobResponse -> Maybe [DataSource]
dataSources :: Prelude.Maybe [DataSource],
    -- | the failure behavior for the simulation job.
    CreateSimulationJobResponse -> Maybe FailureBehavior
failureBehavior :: Prelude.Maybe FailureBehavior,
    -- | The failure code of the simulation job if it failed:
    --
    -- [InternalServiceError]
    --     Internal service error.
    --
    -- [RobotApplicationCrash]
    --     Robot application exited abnormally.
    --
    -- [SimulationApplicationCrash]
    --     Simulation application exited abnormally.
    --
    -- [BadPermissionsRobotApplication]
    --     Robot application bundle could not be downloaded.
    --
    -- [BadPermissionsSimulationApplication]
    --     Simulation application bundle could not be downloaded.
    --
    -- [BadPermissionsS3Output]
    --     Unable to publish outputs to customer-provided S3 bucket.
    --
    -- [BadPermissionsCloudwatchLogs]
    --     Unable to publish logs to customer-provided CloudWatch Logs
    --     resource.
    --
    -- [SubnetIpLimitExceeded]
    --     Subnet IP limit exceeded.
    --
    -- [ENILimitExceeded]
    --     ENI limit exceeded.
    --
    -- [BadPermissionsUserCredentials]
    --     Unable to use the Role provided.
    --
    -- [InvalidBundleRobotApplication]
    --     Robot bundle cannot be extracted (invalid format, bundling error, or
    --     other issue).
    --
    -- [InvalidBundleSimulationApplication]
    --     Simulation bundle cannot be extracted (invalid format, bundling
    --     error, or other issue).
    --
    -- [RobotApplicationVersionMismatchedEtag]
    --     Etag for RobotApplication does not match value during version
    --     creation.
    --
    -- [SimulationApplicationVersionMismatchedEtag]
    --     Etag for SimulationApplication does not match value during version
    --     creation.
    CreateSimulationJobResponse -> Maybe SimulationJobErrorCode
failureCode :: Prelude.Maybe SimulationJobErrorCode,
    -- | The IAM role that allows the simulation job to call the AWS APIs that
    -- are specified in its associated policies on your behalf.
    CreateSimulationJobResponse -> Maybe Text
iamRole :: Prelude.Maybe Prelude.Text,
    -- | The time, in milliseconds since the epoch, when the simulation job was
    -- last started.
    CreateSimulationJobResponse -> Maybe POSIX
lastStartedAt :: Prelude.Maybe Data.POSIX,
    -- | The time, in milliseconds since the epoch, when the simulation job was
    -- last updated.
    CreateSimulationJobResponse -> Maybe POSIX
lastUpdatedAt :: Prelude.Maybe Data.POSIX,
    -- | The logging configuration.
    CreateSimulationJobResponse -> Maybe LoggingConfig
loggingConfig :: Prelude.Maybe LoggingConfig,
    -- | The maximum simulation job duration in seconds.
    CreateSimulationJobResponse -> Maybe Integer
maxJobDurationInSeconds :: Prelude.Maybe Prelude.Integer,
    -- | Simulation job output files location.
    CreateSimulationJobResponse -> Maybe OutputLocation
outputLocation :: Prelude.Maybe OutputLocation,
    -- | The robot application used by the simulation job.
    CreateSimulationJobResponse
-> Maybe (NonEmpty RobotApplicationConfig)
robotApplications :: Prelude.Maybe (Prelude.NonEmpty RobotApplicationConfig),
    -- | The simulation application used by the simulation job.
    CreateSimulationJobResponse
-> Maybe (NonEmpty SimulationApplicationConfig)
simulationApplications :: Prelude.Maybe (Prelude.NonEmpty SimulationApplicationConfig),
    -- | The simulation job execution duration in milliseconds.
    CreateSimulationJobResponse -> Maybe Integer
simulationTimeMillis :: Prelude.Maybe Prelude.Integer,
    -- | The status of the simulation job.
    CreateSimulationJobResponse -> Maybe SimulationJobStatus
status :: Prelude.Maybe SimulationJobStatus,
    -- | The list of all tags added to the simulation job.
    CreateSimulationJobResponse -> Maybe (HashMap Text Text)
tags :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | Information about the vpc configuration.
    CreateSimulationJobResponse -> Maybe VPCConfigResponse
vpcConfig :: Prelude.Maybe VPCConfigResponse,
    -- | The response's http status code.
    CreateSimulationJobResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CreateSimulationJobResponse -> CreateSimulationJobResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateSimulationJobResponse -> CreateSimulationJobResponse -> Bool
$c/= :: CreateSimulationJobResponse -> CreateSimulationJobResponse -> Bool
== :: CreateSimulationJobResponse -> CreateSimulationJobResponse -> Bool
$c== :: CreateSimulationJobResponse -> CreateSimulationJobResponse -> Bool
Prelude.Eq, ReadPrec [CreateSimulationJobResponse]
ReadPrec CreateSimulationJobResponse
Int -> ReadS CreateSimulationJobResponse
ReadS [CreateSimulationJobResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateSimulationJobResponse]
$creadListPrec :: ReadPrec [CreateSimulationJobResponse]
readPrec :: ReadPrec CreateSimulationJobResponse
$creadPrec :: ReadPrec CreateSimulationJobResponse
readList :: ReadS [CreateSimulationJobResponse]
$creadList :: ReadS [CreateSimulationJobResponse]
readsPrec :: Int -> ReadS CreateSimulationJobResponse
$creadsPrec :: Int -> ReadS CreateSimulationJobResponse
Prelude.Read, Int -> CreateSimulationJobResponse -> ShowS
[CreateSimulationJobResponse] -> ShowS
CreateSimulationJobResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateSimulationJobResponse] -> ShowS
$cshowList :: [CreateSimulationJobResponse] -> ShowS
show :: CreateSimulationJobResponse -> String
$cshow :: CreateSimulationJobResponse -> String
showsPrec :: Int -> CreateSimulationJobResponse -> ShowS
$cshowsPrec :: Int -> CreateSimulationJobResponse -> ShowS
Prelude.Show, forall x.
Rep CreateSimulationJobResponse x -> CreateSimulationJobResponse
forall x.
CreateSimulationJobResponse -> Rep CreateSimulationJobResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateSimulationJobResponse x -> CreateSimulationJobResponse
$cfrom :: forall x.
CreateSimulationJobResponse -> Rep CreateSimulationJobResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateSimulationJobResponse' 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:
--
-- 'arn', 'createSimulationJobResponse_arn' - The Amazon Resource Name (ARN) of the simulation job.
--
-- 'clientRequestToken', 'createSimulationJobResponse_clientRequestToken' - Unique, case-sensitive identifier that you provide to ensure the
-- idempotency of the request.
--
-- 'compute', 'createSimulationJobResponse_compute' - Compute information for the simulation job.
--
-- 'dataSources', 'createSimulationJobResponse_dataSources' - The data sources for the simulation job.
--
-- 'failureBehavior', 'createSimulationJobResponse_failureBehavior' - the failure behavior for the simulation job.
--
-- 'failureCode', 'createSimulationJobResponse_failureCode' - The failure code of the simulation job if it failed:
--
-- [InternalServiceError]
--     Internal service error.
--
-- [RobotApplicationCrash]
--     Robot application exited abnormally.
--
-- [SimulationApplicationCrash]
--     Simulation application exited abnormally.
--
-- [BadPermissionsRobotApplication]
--     Robot application bundle could not be downloaded.
--
-- [BadPermissionsSimulationApplication]
--     Simulation application bundle could not be downloaded.
--
-- [BadPermissionsS3Output]
--     Unable to publish outputs to customer-provided S3 bucket.
--
-- [BadPermissionsCloudwatchLogs]
--     Unable to publish logs to customer-provided CloudWatch Logs
--     resource.
--
-- [SubnetIpLimitExceeded]
--     Subnet IP limit exceeded.
--
-- [ENILimitExceeded]
--     ENI limit exceeded.
--
-- [BadPermissionsUserCredentials]
--     Unable to use the Role provided.
--
-- [InvalidBundleRobotApplication]
--     Robot bundle cannot be extracted (invalid format, bundling error, or
--     other issue).
--
-- [InvalidBundleSimulationApplication]
--     Simulation bundle cannot be extracted (invalid format, bundling
--     error, or other issue).
--
-- [RobotApplicationVersionMismatchedEtag]
--     Etag for RobotApplication does not match value during version
--     creation.
--
-- [SimulationApplicationVersionMismatchedEtag]
--     Etag for SimulationApplication does not match value during version
--     creation.
--
-- 'iamRole', 'createSimulationJobResponse_iamRole' - The IAM role that allows the simulation job to call the AWS APIs that
-- are specified in its associated policies on your behalf.
--
-- 'lastStartedAt', 'createSimulationJobResponse_lastStartedAt' - The time, in milliseconds since the epoch, when the simulation job was
-- last started.
--
-- 'lastUpdatedAt', 'createSimulationJobResponse_lastUpdatedAt' - The time, in milliseconds since the epoch, when the simulation job was
-- last updated.
--
-- 'loggingConfig', 'createSimulationJobResponse_loggingConfig' - The logging configuration.
--
-- 'maxJobDurationInSeconds', 'createSimulationJobResponse_maxJobDurationInSeconds' - The maximum simulation job duration in seconds.
--
-- 'outputLocation', 'createSimulationJobResponse_outputLocation' - Simulation job output files location.
--
-- 'robotApplications', 'createSimulationJobResponse_robotApplications' - The robot application used by the simulation job.
--
-- 'simulationApplications', 'createSimulationJobResponse_simulationApplications' - The simulation application used by the simulation job.
--
-- 'simulationTimeMillis', 'createSimulationJobResponse_simulationTimeMillis' - The simulation job execution duration in milliseconds.
--
-- 'status', 'createSimulationJobResponse_status' - The status of the simulation job.
--
-- 'tags', 'createSimulationJobResponse_tags' - The list of all tags added to the simulation job.
--
-- 'vpcConfig', 'createSimulationJobResponse_vpcConfig' - Information about the vpc configuration.
--
-- 'httpStatus', 'createSimulationJobResponse_httpStatus' - The response's http status code.
newCreateSimulationJobResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateSimulationJobResponse
newCreateSimulationJobResponse :: Int -> CreateSimulationJobResponse
newCreateSimulationJobResponse Int
pHttpStatus_ =
  CreateSimulationJobResponse'
    { $sel:arn:CreateSimulationJobResponse' :: Maybe Text
arn = forall a. Maybe a
Prelude.Nothing,
      $sel:clientRequestToken:CreateSimulationJobResponse' :: Maybe Text
clientRequestToken = forall a. Maybe a
Prelude.Nothing,
      $sel:compute:CreateSimulationJobResponse' :: Maybe ComputeResponse
compute = forall a. Maybe a
Prelude.Nothing,
      $sel:dataSources:CreateSimulationJobResponse' :: Maybe [DataSource]
dataSources = forall a. Maybe a
Prelude.Nothing,
      $sel:failureBehavior:CreateSimulationJobResponse' :: Maybe FailureBehavior
failureBehavior = forall a. Maybe a
Prelude.Nothing,
      $sel:failureCode:CreateSimulationJobResponse' :: Maybe SimulationJobErrorCode
failureCode = forall a. Maybe a
Prelude.Nothing,
      $sel:iamRole:CreateSimulationJobResponse' :: Maybe Text
iamRole = forall a. Maybe a
Prelude.Nothing,
      $sel:lastStartedAt:CreateSimulationJobResponse' :: Maybe POSIX
lastStartedAt = forall a. Maybe a
Prelude.Nothing,
      $sel:lastUpdatedAt:CreateSimulationJobResponse' :: Maybe POSIX
lastUpdatedAt = forall a. Maybe a
Prelude.Nothing,
      $sel:loggingConfig:CreateSimulationJobResponse' :: Maybe LoggingConfig
loggingConfig = forall a. Maybe a
Prelude.Nothing,
      $sel:maxJobDurationInSeconds:CreateSimulationJobResponse' :: Maybe Integer
maxJobDurationInSeconds = forall a. Maybe a
Prelude.Nothing,
      $sel:outputLocation:CreateSimulationJobResponse' :: Maybe OutputLocation
outputLocation = forall a. Maybe a
Prelude.Nothing,
      $sel:robotApplications:CreateSimulationJobResponse' :: Maybe (NonEmpty RobotApplicationConfig)
robotApplications = forall a. Maybe a
Prelude.Nothing,
      $sel:simulationApplications:CreateSimulationJobResponse' :: Maybe (NonEmpty SimulationApplicationConfig)
simulationApplications = forall a. Maybe a
Prelude.Nothing,
      $sel:simulationTimeMillis:CreateSimulationJobResponse' :: Maybe Integer
simulationTimeMillis = forall a. Maybe a
Prelude.Nothing,
      $sel:status:CreateSimulationJobResponse' :: Maybe SimulationJobStatus
status = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:CreateSimulationJobResponse' :: Maybe (HashMap Text Text)
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:vpcConfig:CreateSimulationJobResponse' :: Maybe VPCConfigResponse
vpcConfig = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateSimulationJobResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The Amazon Resource Name (ARN) of the simulation job.
createSimulationJobResponse_arn :: Lens.Lens' CreateSimulationJobResponse (Prelude.Maybe Prelude.Text)
createSimulationJobResponse_arn :: Lens' CreateSimulationJobResponse (Maybe Text)
createSimulationJobResponse_arn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateSimulationJobResponse' {Maybe Text
arn :: Maybe Text
$sel:arn:CreateSimulationJobResponse' :: CreateSimulationJobResponse -> Maybe Text
arn} -> Maybe Text
arn) (\s :: CreateSimulationJobResponse
s@CreateSimulationJobResponse' {} Maybe Text
a -> CreateSimulationJobResponse
s {$sel:arn:CreateSimulationJobResponse' :: Maybe Text
arn = Maybe Text
a} :: CreateSimulationJobResponse)

-- | Unique, case-sensitive identifier that you provide to ensure the
-- idempotency of the request.
createSimulationJobResponse_clientRequestToken :: Lens.Lens' CreateSimulationJobResponse (Prelude.Maybe Prelude.Text)
createSimulationJobResponse_clientRequestToken :: Lens' CreateSimulationJobResponse (Maybe Text)
createSimulationJobResponse_clientRequestToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateSimulationJobResponse' {Maybe Text
clientRequestToken :: Maybe Text
$sel:clientRequestToken:CreateSimulationJobResponse' :: CreateSimulationJobResponse -> Maybe Text
clientRequestToken} -> Maybe Text
clientRequestToken) (\s :: CreateSimulationJobResponse
s@CreateSimulationJobResponse' {} Maybe Text
a -> CreateSimulationJobResponse
s {$sel:clientRequestToken:CreateSimulationJobResponse' :: Maybe Text
clientRequestToken = Maybe Text
a} :: CreateSimulationJobResponse)

-- | Compute information for the simulation job.
createSimulationJobResponse_compute :: Lens.Lens' CreateSimulationJobResponse (Prelude.Maybe ComputeResponse)
createSimulationJobResponse_compute :: Lens' CreateSimulationJobResponse (Maybe ComputeResponse)
createSimulationJobResponse_compute = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateSimulationJobResponse' {Maybe ComputeResponse
compute :: Maybe ComputeResponse
$sel:compute:CreateSimulationJobResponse' :: CreateSimulationJobResponse -> Maybe ComputeResponse
compute} -> Maybe ComputeResponse
compute) (\s :: CreateSimulationJobResponse
s@CreateSimulationJobResponse' {} Maybe ComputeResponse
a -> CreateSimulationJobResponse
s {$sel:compute:CreateSimulationJobResponse' :: Maybe ComputeResponse
compute = Maybe ComputeResponse
a} :: CreateSimulationJobResponse)

-- | The data sources for the simulation job.
createSimulationJobResponse_dataSources :: Lens.Lens' CreateSimulationJobResponse (Prelude.Maybe [DataSource])
createSimulationJobResponse_dataSources :: Lens' CreateSimulationJobResponse (Maybe [DataSource])
createSimulationJobResponse_dataSources = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateSimulationJobResponse' {Maybe [DataSource]
dataSources :: Maybe [DataSource]
$sel:dataSources:CreateSimulationJobResponse' :: CreateSimulationJobResponse -> Maybe [DataSource]
dataSources} -> Maybe [DataSource]
dataSources) (\s :: CreateSimulationJobResponse
s@CreateSimulationJobResponse' {} Maybe [DataSource]
a -> CreateSimulationJobResponse
s {$sel:dataSources:CreateSimulationJobResponse' :: Maybe [DataSource]
dataSources = Maybe [DataSource]
a} :: CreateSimulationJobResponse) 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 failure behavior for the simulation job.
createSimulationJobResponse_failureBehavior :: Lens.Lens' CreateSimulationJobResponse (Prelude.Maybe FailureBehavior)
createSimulationJobResponse_failureBehavior :: Lens' CreateSimulationJobResponse (Maybe FailureBehavior)
createSimulationJobResponse_failureBehavior = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateSimulationJobResponse' {Maybe FailureBehavior
failureBehavior :: Maybe FailureBehavior
$sel:failureBehavior:CreateSimulationJobResponse' :: CreateSimulationJobResponse -> Maybe FailureBehavior
failureBehavior} -> Maybe FailureBehavior
failureBehavior) (\s :: CreateSimulationJobResponse
s@CreateSimulationJobResponse' {} Maybe FailureBehavior
a -> CreateSimulationJobResponse
s {$sel:failureBehavior:CreateSimulationJobResponse' :: Maybe FailureBehavior
failureBehavior = Maybe FailureBehavior
a} :: CreateSimulationJobResponse)

-- | The failure code of the simulation job if it failed:
--
-- [InternalServiceError]
--     Internal service error.
--
-- [RobotApplicationCrash]
--     Robot application exited abnormally.
--
-- [SimulationApplicationCrash]
--     Simulation application exited abnormally.
--
-- [BadPermissionsRobotApplication]
--     Robot application bundle could not be downloaded.
--
-- [BadPermissionsSimulationApplication]
--     Simulation application bundle could not be downloaded.
--
-- [BadPermissionsS3Output]
--     Unable to publish outputs to customer-provided S3 bucket.
--
-- [BadPermissionsCloudwatchLogs]
--     Unable to publish logs to customer-provided CloudWatch Logs
--     resource.
--
-- [SubnetIpLimitExceeded]
--     Subnet IP limit exceeded.
--
-- [ENILimitExceeded]
--     ENI limit exceeded.
--
-- [BadPermissionsUserCredentials]
--     Unable to use the Role provided.
--
-- [InvalidBundleRobotApplication]
--     Robot bundle cannot be extracted (invalid format, bundling error, or
--     other issue).
--
-- [InvalidBundleSimulationApplication]
--     Simulation bundle cannot be extracted (invalid format, bundling
--     error, or other issue).
--
-- [RobotApplicationVersionMismatchedEtag]
--     Etag for RobotApplication does not match value during version
--     creation.
--
-- [SimulationApplicationVersionMismatchedEtag]
--     Etag for SimulationApplication does not match value during version
--     creation.
createSimulationJobResponse_failureCode :: Lens.Lens' CreateSimulationJobResponse (Prelude.Maybe SimulationJobErrorCode)
createSimulationJobResponse_failureCode :: Lens' CreateSimulationJobResponse (Maybe SimulationJobErrorCode)
createSimulationJobResponse_failureCode = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateSimulationJobResponse' {Maybe SimulationJobErrorCode
failureCode :: Maybe SimulationJobErrorCode
$sel:failureCode:CreateSimulationJobResponse' :: CreateSimulationJobResponse -> Maybe SimulationJobErrorCode
failureCode} -> Maybe SimulationJobErrorCode
failureCode) (\s :: CreateSimulationJobResponse
s@CreateSimulationJobResponse' {} Maybe SimulationJobErrorCode
a -> CreateSimulationJobResponse
s {$sel:failureCode:CreateSimulationJobResponse' :: Maybe SimulationJobErrorCode
failureCode = Maybe SimulationJobErrorCode
a} :: CreateSimulationJobResponse)

-- | The IAM role that allows the simulation job to call the AWS APIs that
-- are specified in its associated policies on your behalf.
createSimulationJobResponse_iamRole :: Lens.Lens' CreateSimulationJobResponse (Prelude.Maybe Prelude.Text)
createSimulationJobResponse_iamRole :: Lens' CreateSimulationJobResponse (Maybe Text)
createSimulationJobResponse_iamRole = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateSimulationJobResponse' {Maybe Text
iamRole :: Maybe Text
$sel:iamRole:CreateSimulationJobResponse' :: CreateSimulationJobResponse -> Maybe Text
iamRole} -> Maybe Text
iamRole) (\s :: CreateSimulationJobResponse
s@CreateSimulationJobResponse' {} Maybe Text
a -> CreateSimulationJobResponse
s {$sel:iamRole:CreateSimulationJobResponse' :: Maybe Text
iamRole = Maybe Text
a} :: CreateSimulationJobResponse)

-- | The time, in milliseconds since the epoch, when the simulation job was
-- last started.
createSimulationJobResponse_lastStartedAt :: Lens.Lens' CreateSimulationJobResponse (Prelude.Maybe Prelude.UTCTime)
createSimulationJobResponse_lastStartedAt :: Lens' CreateSimulationJobResponse (Maybe UTCTime)
createSimulationJobResponse_lastStartedAt = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateSimulationJobResponse' {Maybe POSIX
lastStartedAt :: Maybe POSIX
$sel:lastStartedAt:CreateSimulationJobResponse' :: CreateSimulationJobResponse -> Maybe POSIX
lastStartedAt} -> Maybe POSIX
lastStartedAt) (\s :: CreateSimulationJobResponse
s@CreateSimulationJobResponse' {} Maybe POSIX
a -> CreateSimulationJobResponse
s {$sel:lastStartedAt:CreateSimulationJobResponse' :: Maybe POSIX
lastStartedAt = Maybe POSIX
a} :: CreateSimulationJobResponse) 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 (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The time, in milliseconds since the epoch, when the simulation job was
-- last updated.
createSimulationJobResponse_lastUpdatedAt :: Lens.Lens' CreateSimulationJobResponse (Prelude.Maybe Prelude.UTCTime)
createSimulationJobResponse_lastUpdatedAt :: Lens' CreateSimulationJobResponse (Maybe UTCTime)
createSimulationJobResponse_lastUpdatedAt = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateSimulationJobResponse' {Maybe POSIX
lastUpdatedAt :: Maybe POSIX
$sel:lastUpdatedAt:CreateSimulationJobResponse' :: CreateSimulationJobResponse -> Maybe POSIX
lastUpdatedAt} -> Maybe POSIX
lastUpdatedAt) (\s :: CreateSimulationJobResponse
s@CreateSimulationJobResponse' {} Maybe POSIX
a -> CreateSimulationJobResponse
s {$sel:lastUpdatedAt:CreateSimulationJobResponse' :: Maybe POSIX
lastUpdatedAt = Maybe POSIX
a} :: CreateSimulationJobResponse) 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 (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The logging configuration.
createSimulationJobResponse_loggingConfig :: Lens.Lens' CreateSimulationJobResponse (Prelude.Maybe LoggingConfig)
createSimulationJobResponse_loggingConfig :: Lens' CreateSimulationJobResponse (Maybe LoggingConfig)
createSimulationJobResponse_loggingConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateSimulationJobResponse' {Maybe LoggingConfig
loggingConfig :: Maybe LoggingConfig
$sel:loggingConfig:CreateSimulationJobResponse' :: CreateSimulationJobResponse -> Maybe LoggingConfig
loggingConfig} -> Maybe LoggingConfig
loggingConfig) (\s :: CreateSimulationJobResponse
s@CreateSimulationJobResponse' {} Maybe LoggingConfig
a -> CreateSimulationJobResponse
s {$sel:loggingConfig:CreateSimulationJobResponse' :: Maybe LoggingConfig
loggingConfig = Maybe LoggingConfig
a} :: CreateSimulationJobResponse)

-- | The maximum simulation job duration in seconds.
createSimulationJobResponse_maxJobDurationInSeconds :: Lens.Lens' CreateSimulationJobResponse (Prelude.Maybe Prelude.Integer)
createSimulationJobResponse_maxJobDurationInSeconds :: Lens' CreateSimulationJobResponse (Maybe Integer)
createSimulationJobResponse_maxJobDurationInSeconds = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateSimulationJobResponse' {Maybe Integer
maxJobDurationInSeconds :: Maybe Integer
$sel:maxJobDurationInSeconds:CreateSimulationJobResponse' :: CreateSimulationJobResponse -> Maybe Integer
maxJobDurationInSeconds} -> Maybe Integer
maxJobDurationInSeconds) (\s :: CreateSimulationJobResponse
s@CreateSimulationJobResponse' {} Maybe Integer
a -> CreateSimulationJobResponse
s {$sel:maxJobDurationInSeconds:CreateSimulationJobResponse' :: Maybe Integer
maxJobDurationInSeconds = Maybe Integer
a} :: CreateSimulationJobResponse)

-- | Simulation job output files location.
createSimulationJobResponse_outputLocation :: Lens.Lens' CreateSimulationJobResponse (Prelude.Maybe OutputLocation)
createSimulationJobResponse_outputLocation :: Lens' CreateSimulationJobResponse (Maybe OutputLocation)
createSimulationJobResponse_outputLocation = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateSimulationJobResponse' {Maybe OutputLocation
outputLocation :: Maybe OutputLocation
$sel:outputLocation:CreateSimulationJobResponse' :: CreateSimulationJobResponse -> Maybe OutputLocation
outputLocation} -> Maybe OutputLocation
outputLocation) (\s :: CreateSimulationJobResponse
s@CreateSimulationJobResponse' {} Maybe OutputLocation
a -> CreateSimulationJobResponse
s {$sel:outputLocation:CreateSimulationJobResponse' :: Maybe OutputLocation
outputLocation = Maybe OutputLocation
a} :: CreateSimulationJobResponse)

-- | The robot application used by the simulation job.
createSimulationJobResponse_robotApplications :: Lens.Lens' CreateSimulationJobResponse (Prelude.Maybe (Prelude.NonEmpty RobotApplicationConfig))
createSimulationJobResponse_robotApplications :: Lens'
  CreateSimulationJobResponse
  (Maybe (NonEmpty RobotApplicationConfig))
createSimulationJobResponse_robotApplications = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateSimulationJobResponse' {Maybe (NonEmpty RobotApplicationConfig)
robotApplications :: Maybe (NonEmpty RobotApplicationConfig)
$sel:robotApplications:CreateSimulationJobResponse' :: CreateSimulationJobResponse
-> Maybe (NonEmpty RobotApplicationConfig)
robotApplications} -> Maybe (NonEmpty RobotApplicationConfig)
robotApplications) (\s :: CreateSimulationJobResponse
s@CreateSimulationJobResponse' {} Maybe (NonEmpty RobotApplicationConfig)
a -> CreateSimulationJobResponse
s {$sel:robotApplications:CreateSimulationJobResponse' :: Maybe (NonEmpty RobotApplicationConfig)
robotApplications = Maybe (NonEmpty RobotApplicationConfig)
a} :: CreateSimulationJobResponse) 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 simulation application used by the simulation job.
createSimulationJobResponse_simulationApplications :: Lens.Lens' CreateSimulationJobResponse (Prelude.Maybe (Prelude.NonEmpty SimulationApplicationConfig))
createSimulationJobResponse_simulationApplications :: Lens'
  CreateSimulationJobResponse
  (Maybe (NonEmpty SimulationApplicationConfig))
createSimulationJobResponse_simulationApplications = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateSimulationJobResponse' {Maybe (NonEmpty SimulationApplicationConfig)
simulationApplications :: Maybe (NonEmpty SimulationApplicationConfig)
$sel:simulationApplications:CreateSimulationJobResponse' :: CreateSimulationJobResponse
-> Maybe (NonEmpty SimulationApplicationConfig)
simulationApplications} -> Maybe (NonEmpty SimulationApplicationConfig)
simulationApplications) (\s :: CreateSimulationJobResponse
s@CreateSimulationJobResponse' {} Maybe (NonEmpty SimulationApplicationConfig)
a -> CreateSimulationJobResponse
s {$sel:simulationApplications:CreateSimulationJobResponse' :: Maybe (NonEmpty SimulationApplicationConfig)
simulationApplications = Maybe (NonEmpty SimulationApplicationConfig)
a} :: CreateSimulationJobResponse) 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 simulation job execution duration in milliseconds.
createSimulationJobResponse_simulationTimeMillis :: Lens.Lens' CreateSimulationJobResponse (Prelude.Maybe Prelude.Integer)
createSimulationJobResponse_simulationTimeMillis :: Lens' CreateSimulationJobResponse (Maybe Integer)
createSimulationJobResponse_simulationTimeMillis = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateSimulationJobResponse' {Maybe Integer
simulationTimeMillis :: Maybe Integer
$sel:simulationTimeMillis:CreateSimulationJobResponse' :: CreateSimulationJobResponse -> Maybe Integer
simulationTimeMillis} -> Maybe Integer
simulationTimeMillis) (\s :: CreateSimulationJobResponse
s@CreateSimulationJobResponse' {} Maybe Integer
a -> CreateSimulationJobResponse
s {$sel:simulationTimeMillis:CreateSimulationJobResponse' :: Maybe Integer
simulationTimeMillis = Maybe Integer
a} :: CreateSimulationJobResponse)

-- | The status of the simulation job.
createSimulationJobResponse_status :: Lens.Lens' CreateSimulationJobResponse (Prelude.Maybe SimulationJobStatus)
createSimulationJobResponse_status :: Lens' CreateSimulationJobResponse (Maybe SimulationJobStatus)
createSimulationJobResponse_status = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateSimulationJobResponse' {Maybe SimulationJobStatus
status :: Maybe SimulationJobStatus
$sel:status:CreateSimulationJobResponse' :: CreateSimulationJobResponse -> Maybe SimulationJobStatus
status} -> Maybe SimulationJobStatus
status) (\s :: CreateSimulationJobResponse
s@CreateSimulationJobResponse' {} Maybe SimulationJobStatus
a -> CreateSimulationJobResponse
s {$sel:status:CreateSimulationJobResponse' :: Maybe SimulationJobStatus
status = Maybe SimulationJobStatus
a} :: CreateSimulationJobResponse)

-- | The list of all tags added to the simulation job.
createSimulationJobResponse_tags :: Lens.Lens' CreateSimulationJobResponse (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
createSimulationJobResponse_tags :: Lens' CreateSimulationJobResponse (Maybe (HashMap Text Text))
createSimulationJobResponse_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateSimulationJobResponse' {Maybe (HashMap Text Text)
tags :: Maybe (HashMap Text Text)
$sel:tags:CreateSimulationJobResponse' :: CreateSimulationJobResponse -> Maybe (HashMap Text Text)
tags} -> Maybe (HashMap Text Text)
tags) (\s :: CreateSimulationJobResponse
s@CreateSimulationJobResponse' {} Maybe (HashMap Text Text)
a -> CreateSimulationJobResponse
s {$sel:tags:CreateSimulationJobResponse' :: Maybe (HashMap Text Text)
tags = Maybe (HashMap Text Text)
a} :: CreateSimulationJobResponse) 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

-- | Information about the vpc configuration.
createSimulationJobResponse_vpcConfig :: Lens.Lens' CreateSimulationJobResponse (Prelude.Maybe VPCConfigResponse)
createSimulationJobResponse_vpcConfig :: Lens' CreateSimulationJobResponse (Maybe VPCConfigResponse)
createSimulationJobResponse_vpcConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateSimulationJobResponse' {Maybe VPCConfigResponse
vpcConfig :: Maybe VPCConfigResponse
$sel:vpcConfig:CreateSimulationJobResponse' :: CreateSimulationJobResponse -> Maybe VPCConfigResponse
vpcConfig} -> Maybe VPCConfigResponse
vpcConfig) (\s :: CreateSimulationJobResponse
s@CreateSimulationJobResponse' {} Maybe VPCConfigResponse
a -> CreateSimulationJobResponse
s {$sel:vpcConfig:CreateSimulationJobResponse' :: Maybe VPCConfigResponse
vpcConfig = Maybe VPCConfigResponse
a} :: CreateSimulationJobResponse)

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

instance Prelude.NFData CreateSimulationJobResponse where
  rnf :: CreateSimulationJobResponse -> ()
rnf CreateSimulationJobResponse' {Int
Maybe Integer
Maybe [DataSource]
Maybe (NonEmpty RobotApplicationConfig)
Maybe (NonEmpty SimulationApplicationConfig)
Maybe Text
Maybe (HashMap Text Text)
Maybe POSIX
Maybe ComputeResponse
Maybe FailureBehavior
Maybe LoggingConfig
Maybe OutputLocation
Maybe SimulationJobErrorCode
Maybe SimulationJobStatus
Maybe VPCConfigResponse
httpStatus :: Int
vpcConfig :: Maybe VPCConfigResponse
tags :: Maybe (HashMap Text Text)
status :: Maybe SimulationJobStatus
simulationTimeMillis :: Maybe Integer
simulationApplications :: Maybe (NonEmpty SimulationApplicationConfig)
robotApplications :: Maybe (NonEmpty RobotApplicationConfig)
outputLocation :: Maybe OutputLocation
maxJobDurationInSeconds :: Maybe Integer
loggingConfig :: Maybe LoggingConfig
lastUpdatedAt :: Maybe POSIX
lastStartedAt :: Maybe POSIX
iamRole :: Maybe Text
failureCode :: Maybe SimulationJobErrorCode
failureBehavior :: Maybe FailureBehavior
dataSources :: Maybe [DataSource]
compute :: Maybe ComputeResponse
clientRequestToken :: Maybe Text
arn :: Maybe Text
$sel:httpStatus:CreateSimulationJobResponse' :: CreateSimulationJobResponse -> Int
$sel:vpcConfig:CreateSimulationJobResponse' :: CreateSimulationJobResponse -> Maybe VPCConfigResponse
$sel:tags:CreateSimulationJobResponse' :: CreateSimulationJobResponse -> Maybe (HashMap Text Text)
$sel:status:CreateSimulationJobResponse' :: CreateSimulationJobResponse -> Maybe SimulationJobStatus
$sel:simulationTimeMillis:CreateSimulationJobResponse' :: CreateSimulationJobResponse -> Maybe Integer
$sel:simulationApplications:CreateSimulationJobResponse' :: CreateSimulationJobResponse
-> Maybe (NonEmpty SimulationApplicationConfig)
$sel:robotApplications:CreateSimulationJobResponse' :: CreateSimulationJobResponse
-> Maybe (NonEmpty RobotApplicationConfig)
$sel:outputLocation:CreateSimulationJobResponse' :: CreateSimulationJobResponse -> Maybe OutputLocation
$sel:maxJobDurationInSeconds:CreateSimulationJobResponse' :: CreateSimulationJobResponse -> Maybe Integer
$sel:loggingConfig:CreateSimulationJobResponse' :: CreateSimulationJobResponse -> Maybe LoggingConfig
$sel:lastUpdatedAt:CreateSimulationJobResponse' :: CreateSimulationJobResponse -> Maybe POSIX
$sel:lastStartedAt:CreateSimulationJobResponse' :: CreateSimulationJobResponse -> Maybe POSIX
$sel:iamRole:CreateSimulationJobResponse' :: CreateSimulationJobResponse -> Maybe Text
$sel:failureCode:CreateSimulationJobResponse' :: CreateSimulationJobResponse -> Maybe SimulationJobErrorCode
$sel:failureBehavior:CreateSimulationJobResponse' :: CreateSimulationJobResponse -> Maybe FailureBehavior
$sel:dataSources:CreateSimulationJobResponse' :: CreateSimulationJobResponse -> Maybe [DataSource]
$sel:compute:CreateSimulationJobResponse' :: CreateSimulationJobResponse -> Maybe ComputeResponse
$sel:clientRequestToken:CreateSimulationJobResponse' :: CreateSimulationJobResponse -> Maybe Text
$sel:arn:CreateSimulationJobResponse' :: CreateSimulationJobResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
arn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
clientRequestToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ComputeResponse
compute
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [DataSource]
dataSources
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe FailureBehavior
failureBehavior
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe SimulationJobErrorCode
failureCode
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
iamRole
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
lastStartedAt
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
lastUpdatedAt
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe LoggingConfig
loggingConfig
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Integer
maxJobDurationInSeconds
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe OutputLocation
outputLocation
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (NonEmpty RobotApplicationConfig)
robotApplications
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (NonEmpty SimulationApplicationConfig)
simulationApplications
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Integer
simulationTimeMillis
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe SimulationJobStatus
status
      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 VPCConfigResponse
vpcConfig
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus