{-# 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.StartSimulationJobBatch
-- 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 new simulation job batch. The batch is defined using one or
-- more @SimulationJobRequest@ objects.
module Amazonka.RobOMaker.StartSimulationJobBatch
  ( -- * Creating a Request
    StartSimulationJobBatch (..),
    newStartSimulationJobBatch,

    -- * Request Lenses
    startSimulationJobBatch_batchPolicy,
    startSimulationJobBatch_clientRequestToken,
    startSimulationJobBatch_tags,
    startSimulationJobBatch_createSimulationJobRequests,

    -- * Destructuring the Response
    StartSimulationJobBatchResponse (..),
    newStartSimulationJobBatchResponse,

    -- * Response Lenses
    startSimulationJobBatchResponse_arn,
    startSimulationJobBatchResponse_batchPolicy,
    startSimulationJobBatchResponse_clientRequestToken,
    startSimulationJobBatchResponse_createdAt,
    startSimulationJobBatchResponse_createdRequests,
    startSimulationJobBatchResponse_failedRequests,
    startSimulationJobBatchResponse_failureCode,
    startSimulationJobBatchResponse_failureReason,
    startSimulationJobBatchResponse_pendingRequests,
    startSimulationJobBatchResponse_status,
    startSimulationJobBatchResponse_tags,
    startSimulationJobBatchResponse_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:/ 'newStartSimulationJobBatch' smart constructor.
data StartSimulationJobBatch = StartSimulationJobBatch'
  { -- | The batch policy.
    StartSimulationJobBatch -> Maybe BatchPolicy
batchPolicy :: Prelude.Maybe BatchPolicy,
    -- | Unique, case-sensitive identifier that you provide to ensure the
    -- idempotency of the request.
    StartSimulationJobBatch -> Maybe Text
clientRequestToken :: Prelude.Maybe Prelude.Text,
    -- | A map that contains tag keys and tag values that are attached to the
    -- deployment job batch.
    StartSimulationJobBatch -> Maybe (HashMap Text Text)
tags :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | A list of simulation job requests to create in the batch.
    StartSimulationJobBatch -> NonEmpty SimulationJobRequest
createSimulationJobRequests :: Prelude.NonEmpty SimulationJobRequest
  }
  deriving (StartSimulationJobBatch -> StartSimulationJobBatch -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StartSimulationJobBatch -> StartSimulationJobBatch -> Bool
$c/= :: StartSimulationJobBatch -> StartSimulationJobBatch -> Bool
== :: StartSimulationJobBatch -> StartSimulationJobBatch -> Bool
$c== :: StartSimulationJobBatch -> StartSimulationJobBatch -> Bool
Prelude.Eq, ReadPrec [StartSimulationJobBatch]
ReadPrec StartSimulationJobBatch
Int -> ReadS StartSimulationJobBatch
ReadS [StartSimulationJobBatch]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StartSimulationJobBatch]
$creadListPrec :: ReadPrec [StartSimulationJobBatch]
readPrec :: ReadPrec StartSimulationJobBatch
$creadPrec :: ReadPrec StartSimulationJobBatch
readList :: ReadS [StartSimulationJobBatch]
$creadList :: ReadS [StartSimulationJobBatch]
readsPrec :: Int -> ReadS StartSimulationJobBatch
$creadsPrec :: Int -> ReadS StartSimulationJobBatch
Prelude.Read, Int -> StartSimulationJobBatch -> ShowS
[StartSimulationJobBatch] -> ShowS
StartSimulationJobBatch -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StartSimulationJobBatch] -> ShowS
$cshowList :: [StartSimulationJobBatch] -> ShowS
show :: StartSimulationJobBatch -> String
$cshow :: StartSimulationJobBatch -> String
showsPrec :: Int -> StartSimulationJobBatch -> ShowS
$cshowsPrec :: Int -> StartSimulationJobBatch -> ShowS
Prelude.Show, forall x. Rep StartSimulationJobBatch x -> StartSimulationJobBatch
forall x. StartSimulationJobBatch -> Rep StartSimulationJobBatch x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StartSimulationJobBatch x -> StartSimulationJobBatch
$cfrom :: forall x. StartSimulationJobBatch -> Rep StartSimulationJobBatch x
Prelude.Generic)

-- |
-- Create a value of 'StartSimulationJobBatch' 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:
--
-- 'batchPolicy', 'startSimulationJobBatch_batchPolicy' - The batch policy.
--
-- 'clientRequestToken', 'startSimulationJobBatch_clientRequestToken' - Unique, case-sensitive identifier that you provide to ensure the
-- idempotency of the request.
--
-- 'tags', 'startSimulationJobBatch_tags' - A map that contains tag keys and tag values that are attached to the
-- deployment job batch.
--
-- 'createSimulationJobRequests', 'startSimulationJobBatch_createSimulationJobRequests' - A list of simulation job requests to create in the batch.
newStartSimulationJobBatch ::
  -- | 'createSimulationJobRequests'
  Prelude.NonEmpty SimulationJobRequest ->
  StartSimulationJobBatch
newStartSimulationJobBatch :: NonEmpty SimulationJobRequest -> StartSimulationJobBatch
newStartSimulationJobBatch
  NonEmpty SimulationJobRequest
pCreateSimulationJobRequests_ =
    StartSimulationJobBatch'
      { $sel:batchPolicy:StartSimulationJobBatch' :: Maybe BatchPolicy
batchPolicy =
          forall a. Maybe a
Prelude.Nothing,
        $sel:clientRequestToken:StartSimulationJobBatch' :: Maybe Text
clientRequestToken = forall a. Maybe a
Prelude.Nothing,
        $sel:tags:StartSimulationJobBatch' :: Maybe (HashMap Text Text)
tags = forall a. Maybe a
Prelude.Nothing,
        $sel:createSimulationJobRequests:StartSimulationJobBatch' :: NonEmpty SimulationJobRequest
createSimulationJobRequests =
          forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced
            forall t b. AReview t b -> b -> t
Lens.# NonEmpty SimulationJobRequest
pCreateSimulationJobRequests_
      }

-- | The batch policy.
startSimulationJobBatch_batchPolicy :: Lens.Lens' StartSimulationJobBatch (Prelude.Maybe BatchPolicy)
startSimulationJobBatch_batchPolicy :: Lens' StartSimulationJobBatch (Maybe BatchPolicy)
startSimulationJobBatch_batchPolicy = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartSimulationJobBatch' {Maybe BatchPolicy
batchPolicy :: Maybe BatchPolicy
$sel:batchPolicy:StartSimulationJobBatch' :: StartSimulationJobBatch -> Maybe BatchPolicy
batchPolicy} -> Maybe BatchPolicy
batchPolicy) (\s :: StartSimulationJobBatch
s@StartSimulationJobBatch' {} Maybe BatchPolicy
a -> StartSimulationJobBatch
s {$sel:batchPolicy:StartSimulationJobBatch' :: Maybe BatchPolicy
batchPolicy = Maybe BatchPolicy
a} :: StartSimulationJobBatch)

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

-- | A map that contains tag keys and tag values that are attached to the
-- deployment job batch.
startSimulationJobBatch_tags :: Lens.Lens' StartSimulationJobBatch (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
startSimulationJobBatch_tags :: Lens' StartSimulationJobBatch (Maybe (HashMap Text Text))
startSimulationJobBatch_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartSimulationJobBatch' {Maybe (HashMap Text Text)
tags :: Maybe (HashMap Text Text)
$sel:tags:StartSimulationJobBatch' :: StartSimulationJobBatch -> Maybe (HashMap Text Text)
tags} -> Maybe (HashMap Text Text)
tags) (\s :: StartSimulationJobBatch
s@StartSimulationJobBatch' {} Maybe (HashMap Text Text)
a -> StartSimulationJobBatch
s {$sel:tags:StartSimulationJobBatch' :: Maybe (HashMap Text Text)
tags = Maybe (HashMap Text Text)
a} :: StartSimulationJobBatch) 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 list of simulation job requests to create in the batch.
startSimulationJobBatch_createSimulationJobRequests :: Lens.Lens' StartSimulationJobBatch (Prelude.NonEmpty SimulationJobRequest)
startSimulationJobBatch_createSimulationJobRequests :: Lens' StartSimulationJobBatch (NonEmpty SimulationJobRequest)
startSimulationJobBatch_createSimulationJobRequests = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartSimulationJobBatch' {NonEmpty SimulationJobRequest
createSimulationJobRequests :: NonEmpty SimulationJobRequest
$sel:createSimulationJobRequests:StartSimulationJobBatch' :: StartSimulationJobBatch -> NonEmpty SimulationJobRequest
createSimulationJobRequests} -> NonEmpty SimulationJobRequest
createSimulationJobRequests) (\s :: StartSimulationJobBatch
s@StartSimulationJobBatch' {} NonEmpty SimulationJobRequest
a -> StartSimulationJobBatch
s {$sel:createSimulationJobRequests:StartSimulationJobBatch' :: NonEmpty SimulationJobRequest
createSimulationJobRequests = NonEmpty SimulationJobRequest
a} :: StartSimulationJobBatch) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

instance Core.AWSRequest StartSimulationJobBatch where
  type
    AWSResponse StartSimulationJobBatch =
      StartSimulationJobBatchResponse
  request :: (Service -> Service)
-> StartSimulationJobBatch -> Request StartSimulationJobBatch
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 StartSimulationJobBatch
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse StartSimulationJobBatch)))
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 BatchPolicy
-> Maybe Text
-> Maybe POSIX
-> Maybe [SimulationJobSummary]
-> Maybe [FailedCreateSimulationJobRequest]
-> Maybe SimulationJobBatchErrorCode
-> Maybe Text
-> Maybe (NonEmpty SimulationJobRequest)
-> Maybe SimulationJobBatchStatus
-> Maybe (HashMap Text Text)
-> Int
-> StartSimulationJobBatchResponse
StartSimulationJobBatchResponse'
            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
"batchPolicy")
            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
"createdAt")
            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
"createdRequests"
                            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
"failedRequests" 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
"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
"failureReason")
            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
"pendingRequests")
            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.<*> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
      )

instance Prelude.Hashable StartSimulationJobBatch where
  hashWithSalt :: Int -> StartSimulationJobBatch -> Int
hashWithSalt Int
_salt StartSimulationJobBatch' {Maybe Text
Maybe (HashMap Text Text)
Maybe BatchPolicy
NonEmpty SimulationJobRequest
createSimulationJobRequests :: NonEmpty SimulationJobRequest
tags :: Maybe (HashMap Text Text)
clientRequestToken :: Maybe Text
batchPolicy :: Maybe BatchPolicy
$sel:createSimulationJobRequests:StartSimulationJobBatch' :: StartSimulationJobBatch -> NonEmpty SimulationJobRequest
$sel:tags:StartSimulationJobBatch' :: StartSimulationJobBatch -> Maybe (HashMap Text Text)
$sel:clientRequestToken:StartSimulationJobBatch' :: StartSimulationJobBatch -> Maybe Text
$sel:batchPolicy:StartSimulationJobBatch' :: StartSimulationJobBatch -> Maybe BatchPolicy
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe BatchPolicy
batchPolicy
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
clientRequestToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Text)
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` NonEmpty SimulationJobRequest
createSimulationJobRequests

instance Prelude.NFData StartSimulationJobBatch where
  rnf :: StartSimulationJobBatch -> ()
rnf StartSimulationJobBatch' {Maybe Text
Maybe (HashMap Text Text)
Maybe BatchPolicy
NonEmpty SimulationJobRequest
createSimulationJobRequests :: NonEmpty SimulationJobRequest
tags :: Maybe (HashMap Text Text)
clientRequestToken :: Maybe Text
batchPolicy :: Maybe BatchPolicy
$sel:createSimulationJobRequests:StartSimulationJobBatch' :: StartSimulationJobBatch -> NonEmpty SimulationJobRequest
$sel:tags:StartSimulationJobBatch' :: StartSimulationJobBatch -> Maybe (HashMap Text Text)
$sel:clientRequestToken:StartSimulationJobBatch' :: StartSimulationJobBatch -> Maybe Text
$sel:batchPolicy:StartSimulationJobBatch' :: StartSimulationJobBatch -> Maybe BatchPolicy
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe BatchPolicy
batchPolicy
      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 (HashMap Text Text)
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf NonEmpty SimulationJobRequest
createSimulationJobRequests

instance Data.ToHeaders StartSimulationJobBatch where
  toHeaders :: StartSimulationJobBatch -> 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 StartSimulationJobBatch where
  toJSON :: StartSimulationJobBatch -> Value
toJSON StartSimulationJobBatch' {Maybe Text
Maybe (HashMap Text Text)
Maybe BatchPolicy
NonEmpty SimulationJobRequest
createSimulationJobRequests :: NonEmpty SimulationJobRequest
tags :: Maybe (HashMap Text Text)
clientRequestToken :: Maybe Text
batchPolicy :: Maybe BatchPolicy
$sel:createSimulationJobRequests:StartSimulationJobBatch' :: StartSimulationJobBatch -> NonEmpty SimulationJobRequest
$sel:tags:StartSimulationJobBatch' :: StartSimulationJobBatch -> Maybe (HashMap Text Text)
$sel:clientRequestToken:StartSimulationJobBatch' :: StartSimulationJobBatch -> Maybe Text
$sel:batchPolicy:StartSimulationJobBatch' :: StartSimulationJobBatch -> Maybe BatchPolicy
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"batchPolicy" 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 BatchPolicy
batchPolicy,
            (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
"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
"createSimulationJobRequests"
                  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= NonEmpty SimulationJobRequest
createSimulationJobRequests
              )
          ]
      )

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

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

-- | /See:/ 'newStartSimulationJobBatchResponse' smart constructor.
data StartSimulationJobBatchResponse = StartSimulationJobBatchResponse'
  { -- | The Amazon Resource Name (arn) of the batch.
    StartSimulationJobBatchResponse -> Maybe Text
arn :: Prelude.Maybe Prelude.Text,
    -- | The batch policy.
    StartSimulationJobBatchResponse -> Maybe BatchPolicy
batchPolicy :: Prelude.Maybe BatchPolicy,
    -- | Unique, case-sensitive identifier that you provide to ensure the
    -- idempotency of the request.
    StartSimulationJobBatchResponse -> Maybe Text
clientRequestToken :: Prelude.Maybe Prelude.Text,
    -- | The time, in milliseconds since the epoch, when the simulation job batch
    -- was created.
    StartSimulationJobBatchResponse -> Maybe POSIX
createdAt :: Prelude.Maybe Data.POSIX,
    -- | A list of created simulation job request summaries.
    StartSimulationJobBatchResponse -> Maybe [SimulationJobSummary]
createdRequests :: Prelude.Maybe [SimulationJobSummary],
    -- | A list of failed simulation job requests. The request failed to be
    -- created into a simulation job. Failed requests do not have a simulation
    -- job ID.
    StartSimulationJobBatchResponse
-> Maybe [FailedCreateSimulationJobRequest]
failedRequests :: Prelude.Maybe [FailedCreateSimulationJobRequest],
    -- | The failure code if the simulation job batch failed.
    StartSimulationJobBatchResponse
-> Maybe SimulationJobBatchErrorCode
failureCode :: Prelude.Maybe SimulationJobBatchErrorCode,
    -- | The reason the simulation job batch failed.
    StartSimulationJobBatchResponse -> Maybe Text
failureReason :: Prelude.Maybe Prelude.Text,
    -- | A list of pending simulation job requests. These requests have not yet
    -- been created into simulation jobs.
    StartSimulationJobBatchResponse
-> Maybe (NonEmpty SimulationJobRequest)
pendingRequests :: Prelude.Maybe (Prelude.NonEmpty SimulationJobRequest),
    -- | The status of the simulation job batch.
    --
    -- [Pending]
    --     The simulation job batch request is pending.
    --
    -- [InProgress]
    --     The simulation job batch is in progress.
    --
    -- [Failed]
    --     The simulation job batch failed. One or more simulation job requests
    --     could not be completed due to an internal failure (like
    --     @InternalServiceError@). See @failureCode@ and @failureReason@ for
    --     more information.
    --
    -- [Completed]
    --     The simulation batch job completed. A batch is complete when (1)
    --     there are no pending simulation job requests in the batch and none
    --     of the failed simulation job requests are due to
    --     @InternalServiceError@ and (2) when all created simulation jobs have
    --     reached a terminal state (for example, @Completed@ or @Failed@).
    --
    -- [Canceled]
    --     The simulation batch job was cancelled.
    --
    -- [Canceling]
    --     The simulation batch job is being cancelled.
    --
    -- [Completing]
    --     The simulation batch job is completing.
    --
    -- [TimingOut]
    --     The simulation job batch is timing out.
    --
    --     If a batch timing out, and there are pending requests that were
    --     failing due to an internal failure (like @InternalServiceError@),
    --     the batch status will be @Failed@. If there are no such failing
    --     request, the batch status will be @TimedOut@.
    --
    -- [TimedOut]
    --     The simulation batch job timed out.
    StartSimulationJobBatchResponse -> Maybe SimulationJobBatchStatus
status :: Prelude.Maybe SimulationJobBatchStatus,
    -- | A map that contains tag keys and tag values that are attached to the
    -- deployment job batch.
    StartSimulationJobBatchResponse -> Maybe (HashMap Text Text)
tags :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | The response's http status code.
    StartSimulationJobBatchResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (StartSimulationJobBatchResponse
-> StartSimulationJobBatchResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StartSimulationJobBatchResponse
-> StartSimulationJobBatchResponse -> Bool
$c/= :: StartSimulationJobBatchResponse
-> StartSimulationJobBatchResponse -> Bool
== :: StartSimulationJobBatchResponse
-> StartSimulationJobBatchResponse -> Bool
$c== :: StartSimulationJobBatchResponse
-> StartSimulationJobBatchResponse -> Bool
Prelude.Eq, ReadPrec [StartSimulationJobBatchResponse]
ReadPrec StartSimulationJobBatchResponse
Int -> ReadS StartSimulationJobBatchResponse
ReadS [StartSimulationJobBatchResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StartSimulationJobBatchResponse]
$creadListPrec :: ReadPrec [StartSimulationJobBatchResponse]
readPrec :: ReadPrec StartSimulationJobBatchResponse
$creadPrec :: ReadPrec StartSimulationJobBatchResponse
readList :: ReadS [StartSimulationJobBatchResponse]
$creadList :: ReadS [StartSimulationJobBatchResponse]
readsPrec :: Int -> ReadS StartSimulationJobBatchResponse
$creadsPrec :: Int -> ReadS StartSimulationJobBatchResponse
Prelude.Read, Int -> StartSimulationJobBatchResponse -> ShowS
[StartSimulationJobBatchResponse] -> ShowS
StartSimulationJobBatchResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StartSimulationJobBatchResponse] -> ShowS
$cshowList :: [StartSimulationJobBatchResponse] -> ShowS
show :: StartSimulationJobBatchResponse -> String
$cshow :: StartSimulationJobBatchResponse -> String
showsPrec :: Int -> StartSimulationJobBatchResponse -> ShowS
$cshowsPrec :: Int -> StartSimulationJobBatchResponse -> ShowS
Prelude.Show, forall x.
Rep StartSimulationJobBatchResponse x
-> StartSimulationJobBatchResponse
forall x.
StartSimulationJobBatchResponse
-> Rep StartSimulationJobBatchResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep StartSimulationJobBatchResponse x
-> StartSimulationJobBatchResponse
$cfrom :: forall x.
StartSimulationJobBatchResponse
-> Rep StartSimulationJobBatchResponse x
Prelude.Generic)

-- |
-- Create a value of 'StartSimulationJobBatchResponse' 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', 'startSimulationJobBatchResponse_arn' - The Amazon Resource Name (arn) of the batch.
--
-- 'batchPolicy', 'startSimulationJobBatchResponse_batchPolicy' - The batch policy.
--
-- 'clientRequestToken', 'startSimulationJobBatchResponse_clientRequestToken' - Unique, case-sensitive identifier that you provide to ensure the
-- idempotency of the request.
--
-- 'createdAt', 'startSimulationJobBatchResponse_createdAt' - The time, in milliseconds since the epoch, when the simulation job batch
-- was created.
--
-- 'createdRequests', 'startSimulationJobBatchResponse_createdRequests' - A list of created simulation job request summaries.
--
-- 'failedRequests', 'startSimulationJobBatchResponse_failedRequests' - A list of failed simulation job requests. The request failed to be
-- created into a simulation job. Failed requests do not have a simulation
-- job ID.
--
-- 'failureCode', 'startSimulationJobBatchResponse_failureCode' - The failure code if the simulation job batch failed.
--
-- 'failureReason', 'startSimulationJobBatchResponse_failureReason' - The reason the simulation job batch failed.
--
-- 'pendingRequests', 'startSimulationJobBatchResponse_pendingRequests' - A list of pending simulation job requests. These requests have not yet
-- been created into simulation jobs.
--
-- 'status', 'startSimulationJobBatchResponse_status' - The status of the simulation job batch.
--
-- [Pending]
--     The simulation job batch request is pending.
--
-- [InProgress]
--     The simulation job batch is in progress.
--
-- [Failed]
--     The simulation job batch failed. One or more simulation job requests
--     could not be completed due to an internal failure (like
--     @InternalServiceError@). See @failureCode@ and @failureReason@ for
--     more information.
--
-- [Completed]
--     The simulation batch job completed. A batch is complete when (1)
--     there are no pending simulation job requests in the batch and none
--     of the failed simulation job requests are due to
--     @InternalServiceError@ and (2) when all created simulation jobs have
--     reached a terminal state (for example, @Completed@ or @Failed@).
--
-- [Canceled]
--     The simulation batch job was cancelled.
--
-- [Canceling]
--     The simulation batch job is being cancelled.
--
-- [Completing]
--     The simulation batch job is completing.
--
-- [TimingOut]
--     The simulation job batch is timing out.
--
--     If a batch timing out, and there are pending requests that were
--     failing due to an internal failure (like @InternalServiceError@),
--     the batch status will be @Failed@. If there are no such failing
--     request, the batch status will be @TimedOut@.
--
-- [TimedOut]
--     The simulation batch job timed out.
--
-- 'tags', 'startSimulationJobBatchResponse_tags' - A map that contains tag keys and tag values that are attached to the
-- deployment job batch.
--
-- 'httpStatus', 'startSimulationJobBatchResponse_httpStatus' - The response's http status code.
newStartSimulationJobBatchResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  StartSimulationJobBatchResponse
newStartSimulationJobBatchResponse :: Int -> StartSimulationJobBatchResponse
newStartSimulationJobBatchResponse Int
pHttpStatus_ =
  StartSimulationJobBatchResponse'
    { $sel:arn:StartSimulationJobBatchResponse' :: Maybe Text
arn =
        forall a. Maybe a
Prelude.Nothing,
      $sel:batchPolicy:StartSimulationJobBatchResponse' :: Maybe BatchPolicy
batchPolicy = forall a. Maybe a
Prelude.Nothing,
      $sel:clientRequestToken:StartSimulationJobBatchResponse' :: Maybe Text
clientRequestToken = forall a. Maybe a
Prelude.Nothing,
      $sel:createdAt:StartSimulationJobBatchResponse' :: Maybe POSIX
createdAt = forall a. Maybe a
Prelude.Nothing,
      $sel:createdRequests:StartSimulationJobBatchResponse' :: Maybe [SimulationJobSummary]
createdRequests = forall a. Maybe a
Prelude.Nothing,
      $sel:failedRequests:StartSimulationJobBatchResponse' :: Maybe [FailedCreateSimulationJobRequest]
failedRequests = forall a. Maybe a
Prelude.Nothing,
      $sel:failureCode:StartSimulationJobBatchResponse' :: Maybe SimulationJobBatchErrorCode
failureCode = forall a. Maybe a
Prelude.Nothing,
      $sel:failureReason:StartSimulationJobBatchResponse' :: Maybe Text
failureReason = forall a. Maybe a
Prelude.Nothing,
      $sel:pendingRequests:StartSimulationJobBatchResponse' :: Maybe (NonEmpty SimulationJobRequest)
pendingRequests = forall a. Maybe a
Prelude.Nothing,
      $sel:status:StartSimulationJobBatchResponse' :: Maybe SimulationJobBatchStatus
status = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:StartSimulationJobBatchResponse' :: Maybe (HashMap Text Text)
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:StartSimulationJobBatchResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

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

-- | The batch policy.
startSimulationJobBatchResponse_batchPolicy :: Lens.Lens' StartSimulationJobBatchResponse (Prelude.Maybe BatchPolicy)
startSimulationJobBatchResponse_batchPolicy :: Lens' StartSimulationJobBatchResponse (Maybe BatchPolicy)
startSimulationJobBatchResponse_batchPolicy = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartSimulationJobBatchResponse' {Maybe BatchPolicy
batchPolicy :: Maybe BatchPolicy
$sel:batchPolicy:StartSimulationJobBatchResponse' :: StartSimulationJobBatchResponse -> Maybe BatchPolicy
batchPolicy} -> Maybe BatchPolicy
batchPolicy) (\s :: StartSimulationJobBatchResponse
s@StartSimulationJobBatchResponse' {} Maybe BatchPolicy
a -> StartSimulationJobBatchResponse
s {$sel:batchPolicy:StartSimulationJobBatchResponse' :: Maybe BatchPolicy
batchPolicy = Maybe BatchPolicy
a} :: StartSimulationJobBatchResponse)

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

-- | The time, in milliseconds since the epoch, when the simulation job batch
-- was created.
startSimulationJobBatchResponse_createdAt :: Lens.Lens' StartSimulationJobBatchResponse (Prelude.Maybe Prelude.UTCTime)
startSimulationJobBatchResponse_createdAt :: Lens' StartSimulationJobBatchResponse (Maybe UTCTime)
startSimulationJobBatchResponse_createdAt = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartSimulationJobBatchResponse' {Maybe POSIX
createdAt :: Maybe POSIX
$sel:createdAt:StartSimulationJobBatchResponse' :: StartSimulationJobBatchResponse -> Maybe POSIX
createdAt} -> Maybe POSIX
createdAt) (\s :: StartSimulationJobBatchResponse
s@StartSimulationJobBatchResponse' {} Maybe POSIX
a -> StartSimulationJobBatchResponse
s {$sel:createdAt:StartSimulationJobBatchResponse' :: Maybe POSIX
createdAt = Maybe POSIX
a} :: StartSimulationJobBatchResponse) 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

-- | A list of created simulation job request summaries.
startSimulationJobBatchResponse_createdRequests :: Lens.Lens' StartSimulationJobBatchResponse (Prelude.Maybe [SimulationJobSummary])
startSimulationJobBatchResponse_createdRequests :: Lens'
  StartSimulationJobBatchResponse (Maybe [SimulationJobSummary])
startSimulationJobBatchResponse_createdRequests = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartSimulationJobBatchResponse' {Maybe [SimulationJobSummary]
createdRequests :: Maybe [SimulationJobSummary]
$sel:createdRequests:StartSimulationJobBatchResponse' :: StartSimulationJobBatchResponse -> Maybe [SimulationJobSummary]
createdRequests} -> Maybe [SimulationJobSummary]
createdRequests) (\s :: StartSimulationJobBatchResponse
s@StartSimulationJobBatchResponse' {} Maybe [SimulationJobSummary]
a -> StartSimulationJobBatchResponse
s {$sel:createdRequests:StartSimulationJobBatchResponse' :: Maybe [SimulationJobSummary]
createdRequests = Maybe [SimulationJobSummary]
a} :: StartSimulationJobBatchResponse) 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 list of failed simulation job requests. The request failed to be
-- created into a simulation job. Failed requests do not have a simulation
-- job ID.
startSimulationJobBatchResponse_failedRequests :: Lens.Lens' StartSimulationJobBatchResponse (Prelude.Maybe [FailedCreateSimulationJobRequest])
startSimulationJobBatchResponse_failedRequests :: Lens'
  StartSimulationJobBatchResponse
  (Maybe [FailedCreateSimulationJobRequest])
startSimulationJobBatchResponse_failedRequests = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartSimulationJobBatchResponse' {Maybe [FailedCreateSimulationJobRequest]
failedRequests :: Maybe [FailedCreateSimulationJobRequest]
$sel:failedRequests:StartSimulationJobBatchResponse' :: StartSimulationJobBatchResponse
-> Maybe [FailedCreateSimulationJobRequest]
failedRequests} -> Maybe [FailedCreateSimulationJobRequest]
failedRequests) (\s :: StartSimulationJobBatchResponse
s@StartSimulationJobBatchResponse' {} Maybe [FailedCreateSimulationJobRequest]
a -> StartSimulationJobBatchResponse
s {$sel:failedRequests:StartSimulationJobBatchResponse' :: Maybe [FailedCreateSimulationJobRequest]
failedRequests = Maybe [FailedCreateSimulationJobRequest]
a} :: StartSimulationJobBatchResponse) 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 code if the simulation job batch failed.
startSimulationJobBatchResponse_failureCode :: Lens.Lens' StartSimulationJobBatchResponse (Prelude.Maybe SimulationJobBatchErrorCode)
startSimulationJobBatchResponse_failureCode :: Lens'
  StartSimulationJobBatchResponse (Maybe SimulationJobBatchErrorCode)
startSimulationJobBatchResponse_failureCode = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartSimulationJobBatchResponse' {Maybe SimulationJobBatchErrorCode
failureCode :: Maybe SimulationJobBatchErrorCode
$sel:failureCode:StartSimulationJobBatchResponse' :: StartSimulationJobBatchResponse
-> Maybe SimulationJobBatchErrorCode
failureCode} -> Maybe SimulationJobBatchErrorCode
failureCode) (\s :: StartSimulationJobBatchResponse
s@StartSimulationJobBatchResponse' {} Maybe SimulationJobBatchErrorCode
a -> StartSimulationJobBatchResponse
s {$sel:failureCode:StartSimulationJobBatchResponse' :: Maybe SimulationJobBatchErrorCode
failureCode = Maybe SimulationJobBatchErrorCode
a} :: StartSimulationJobBatchResponse)

-- | The reason the simulation job batch failed.
startSimulationJobBatchResponse_failureReason :: Lens.Lens' StartSimulationJobBatchResponse (Prelude.Maybe Prelude.Text)
startSimulationJobBatchResponse_failureReason :: Lens' StartSimulationJobBatchResponse (Maybe Text)
startSimulationJobBatchResponse_failureReason = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartSimulationJobBatchResponse' {Maybe Text
failureReason :: Maybe Text
$sel:failureReason:StartSimulationJobBatchResponse' :: StartSimulationJobBatchResponse -> Maybe Text
failureReason} -> Maybe Text
failureReason) (\s :: StartSimulationJobBatchResponse
s@StartSimulationJobBatchResponse' {} Maybe Text
a -> StartSimulationJobBatchResponse
s {$sel:failureReason:StartSimulationJobBatchResponse' :: Maybe Text
failureReason = Maybe Text
a} :: StartSimulationJobBatchResponse)

-- | A list of pending simulation job requests. These requests have not yet
-- been created into simulation jobs.
startSimulationJobBatchResponse_pendingRequests :: Lens.Lens' StartSimulationJobBatchResponse (Prelude.Maybe (Prelude.NonEmpty SimulationJobRequest))
startSimulationJobBatchResponse_pendingRequests :: Lens'
  StartSimulationJobBatchResponse
  (Maybe (NonEmpty SimulationJobRequest))
startSimulationJobBatchResponse_pendingRequests = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartSimulationJobBatchResponse' {Maybe (NonEmpty SimulationJobRequest)
pendingRequests :: Maybe (NonEmpty SimulationJobRequest)
$sel:pendingRequests:StartSimulationJobBatchResponse' :: StartSimulationJobBatchResponse
-> Maybe (NonEmpty SimulationJobRequest)
pendingRequests} -> Maybe (NonEmpty SimulationJobRequest)
pendingRequests) (\s :: StartSimulationJobBatchResponse
s@StartSimulationJobBatchResponse' {} Maybe (NonEmpty SimulationJobRequest)
a -> StartSimulationJobBatchResponse
s {$sel:pendingRequests:StartSimulationJobBatchResponse' :: Maybe (NonEmpty SimulationJobRequest)
pendingRequests = Maybe (NonEmpty SimulationJobRequest)
a} :: StartSimulationJobBatchResponse) 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 status of the simulation job batch.
--
-- [Pending]
--     The simulation job batch request is pending.
--
-- [InProgress]
--     The simulation job batch is in progress.
--
-- [Failed]
--     The simulation job batch failed. One or more simulation job requests
--     could not be completed due to an internal failure (like
--     @InternalServiceError@). See @failureCode@ and @failureReason@ for
--     more information.
--
-- [Completed]
--     The simulation batch job completed. A batch is complete when (1)
--     there are no pending simulation job requests in the batch and none
--     of the failed simulation job requests are due to
--     @InternalServiceError@ and (2) when all created simulation jobs have
--     reached a terminal state (for example, @Completed@ or @Failed@).
--
-- [Canceled]
--     The simulation batch job was cancelled.
--
-- [Canceling]
--     The simulation batch job is being cancelled.
--
-- [Completing]
--     The simulation batch job is completing.
--
-- [TimingOut]
--     The simulation job batch is timing out.
--
--     If a batch timing out, and there are pending requests that were
--     failing due to an internal failure (like @InternalServiceError@),
--     the batch status will be @Failed@. If there are no such failing
--     request, the batch status will be @TimedOut@.
--
-- [TimedOut]
--     The simulation batch job timed out.
startSimulationJobBatchResponse_status :: Lens.Lens' StartSimulationJobBatchResponse (Prelude.Maybe SimulationJobBatchStatus)
startSimulationJobBatchResponse_status :: Lens'
  StartSimulationJobBatchResponse (Maybe SimulationJobBatchStatus)
startSimulationJobBatchResponse_status = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartSimulationJobBatchResponse' {Maybe SimulationJobBatchStatus
status :: Maybe SimulationJobBatchStatus
$sel:status:StartSimulationJobBatchResponse' :: StartSimulationJobBatchResponse -> Maybe SimulationJobBatchStatus
status} -> Maybe SimulationJobBatchStatus
status) (\s :: StartSimulationJobBatchResponse
s@StartSimulationJobBatchResponse' {} Maybe SimulationJobBatchStatus
a -> StartSimulationJobBatchResponse
s {$sel:status:StartSimulationJobBatchResponse' :: Maybe SimulationJobBatchStatus
status = Maybe SimulationJobBatchStatus
a} :: StartSimulationJobBatchResponse)

-- | A map that contains tag keys and tag values that are attached to the
-- deployment job batch.
startSimulationJobBatchResponse_tags :: Lens.Lens' StartSimulationJobBatchResponse (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
startSimulationJobBatchResponse_tags :: Lens' StartSimulationJobBatchResponse (Maybe (HashMap Text Text))
startSimulationJobBatchResponse_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartSimulationJobBatchResponse' {Maybe (HashMap Text Text)
tags :: Maybe (HashMap Text Text)
$sel:tags:StartSimulationJobBatchResponse' :: StartSimulationJobBatchResponse -> Maybe (HashMap Text Text)
tags} -> Maybe (HashMap Text Text)
tags) (\s :: StartSimulationJobBatchResponse
s@StartSimulationJobBatchResponse' {} Maybe (HashMap Text Text)
a -> StartSimulationJobBatchResponse
s {$sel:tags:StartSimulationJobBatchResponse' :: Maybe (HashMap Text Text)
tags = Maybe (HashMap Text Text)
a} :: StartSimulationJobBatchResponse) 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 response's http status code.
startSimulationJobBatchResponse_httpStatus :: Lens.Lens' StartSimulationJobBatchResponse Prelude.Int
startSimulationJobBatchResponse_httpStatus :: Lens' StartSimulationJobBatchResponse Int
startSimulationJobBatchResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartSimulationJobBatchResponse' {Int
httpStatus :: Int
$sel:httpStatus:StartSimulationJobBatchResponse' :: StartSimulationJobBatchResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: StartSimulationJobBatchResponse
s@StartSimulationJobBatchResponse' {} Int
a -> StartSimulationJobBatchResponse
s {$sel:httpStatus:StartSimulationJobBatchResponse' :: Int
httpStatus = Int
a} :: StartSimulationJobBatchResponse)

instance
  Prelude.NFData
    StartSimulationJobBatchResponse
  where
  rnf :: StartSimulationJobBatchResponse -> ()
rnf StartSimulationJobBatchResponse' {Int
Maybe [SimulationJobSummary]
Maybe [FailedCreateSimulationJobRequest]
Maybe (NonEmpty SimulationJobRequest)
Maybe Text
Maybe (HashMap Text Text)
Maybe POSIX
Maybe BatchPolicy
Maybe SimulationJobBatchErrorCode
Maybe SimulationJobBatchStatus
httpStatus :: Int
tags :: Maybe (HashMap Text Text)
status :: Maybe SimulationJobBatchStatus
pendingRequests :: Maybe (NonEmpty SimulationJobRequest)
failureReason :: Maybe Text
failureCode :: Maybe SimulationJobBatchErrorCode
failedRequests :: Maybe [FailedCreateSimulationJobRequest]
createdRequests :: Maybe [SimulationJobSummary]
createdAt :: Maybe POSIX
clientRequestToken :: Maybe Text
batchPolicy :: Maybe BatchPolicy
arn :: Maybe Text
$sel:httpStatus:StartSimulationJobBatchResponse' :: StartSimulationJobBatchResponse -> Int
$sel:tags:StartSimulationJobBatchResponse' :: StartSimulationJobBatchResponse -> Maybe (HashMap Text Text)
$sel:status:StartSimulationJobBatchResponse' :: StartSimulationJobBatchResponse -> Maybe SimulationJobBatchStatus
$sel:pendingRequests:StartSimulationJobBatchResponse' :: StartSimulationJobBatchResponse
-> Maybe (NonEmpty SimulationJobRequest)
$sel:failureReason:StartSimulationJobBatchResponse' :: StartSimulationJobBatchResponse -> Maybe Text
$sel:failureCode:StartSimulationJobBatchResponse' :: StartSimulationJobBatchResponse
-> Maybe SimulationJobBatchErrorCode
$sel:failedRequests:StartSimulationJobBatchResponse' :: StartSimulationJobBatchResponse
-> Maybe [FailedCreateSimulationJobRequest]
$sel:createdRequests:StartSimulationJobBatchResponse' :: StartSimulationJobBatchResponse -> Maybe [SimulationJobSummary]
$sel:createdAt:StartSimulationJobBatchResponse' :: StartSimulationJobBatchResponse -> Maybe POSIX
$sel:clientRequestToken:StartSimulationJobBatchResponse' :: StartSimulationJobBatchResponse -> Maybe Text
$sel:batchPolicy:StartSimulationJobBatchResponse' :: StartSimulationJobBatchResponse -> Maybe BatchPolicy
$sel:arn:StartSimulationJobBatchResponse' :: StartSimulationJobBatchResponse -> 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 BatchPolicy
batchPolicy
      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 POSIX
createdAt
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [SimulationJobSummary]
createdRequests
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [FailedCreateSimulationJobRequest]
failedRequests
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe SimulationJobBatchErrorCode
failureCode
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
failureReason
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (NonEmpty SimulationJobRequest)
pendingRequests
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe SimulationJobBatchStatus
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 Int
httpStatus