{-# 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.SimSpaceWeaver.StartSimulation
-- 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 simulation with the given name and schema.
module Amazonka.SimSpaceWeaver.StartSimulation
  ( -- * Creating a Request
    StartSimulation (..),
    newStartSimulation,

    -- * Request Lenses
    startSimulation_clientToken,
    startSimulation_description,
    startSimulation_maximumDuration,
    startSimulation_tags,
    startSimulation_name,
    startSimulation_roleArn,
    startSimulation_schemaS3Location,

    -- * Destructuring the Response
    StartSimulationResponse (..),
    newStartSimulationResponse,

    -- * Response Lenses
    startSimulationResponse_arn,
    startSimulationResponse_creationTime,
    startSimulationResponse_executionId,
    startSimulationResponse_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.SimSpaceWeaver.Types

-- | /See:/ 'newStartSimulation' smart constructor.
data StartSimulation = StartSimulation'
  { -- | A value that you provide to ensure that repeated calls to this API
    -- operation using the same parameters complete only once. A @ClientToken@
    -- is also known as an /idempotency token/. A @ClientToken@ expires after
    -- 24 hours.
    StartSimulation -> Maybe (Sensitive Text)
clientToken :: Prelude.Maybe (Data.Sensitive Prelude.Text),
    -- | The description of the simulation.
    StartSimulation -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | The maximum running time of the simulation, specified as a number of
    -- months (m or M), hours (h or H), or days (d or D). The simulation stops
    -- when it reaches this limit.
    StartSimulation -> Maybe Text
maximumDuration :: Prelude.Maybe Prelude.Text,
    -- | A list of tags for the simulation. For more information about tags, see
    -- <https://docs.aws.amazon.com/general/latest/gr/aws_tagging.html Tagging Amazon Web Services resources>
    -- in the /Amazon Web Services General Reference/.
    StartSimulation -> Maybe (HashMap Text Text)
tags :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | The name of the simulation.
    StartSimulation -> Text
name :: Prelude.Text,
    -- | The Amazon Resource Name (ARN) of the Identity and Access Management
    -- (IAM) role that the simulation assumes to perform actions. For more
    -- information about ARNs, see
    -- <https://docs.aws.amazon.com/general/latest/gr/aws-arns-and-namespaces.html Amazon Resource Names (ARNs)>
    -- in the /Amazon Web Services General Reference/. For more information
    -- about IAM roles, see
    -- <https://docs.aws.amazon.com/IAM/latest/UserGuide/id_roles.html IAM roles>
    -- in the /Identity and Access Management User Guide/.
    StartSimulation -> Text
roleArn :: Prelude.Text,
    -- | The location of the simulation schema in Amazon Simple Storage Service
    -- (Amazon S3). For more information about Amazon S3, see the
    -- <https://docs.aws.amazon.com/AmazonS3/latest/userguide/Welcome.html Amazon Simple Storage Service User Guide>
    -- .
    StartSimulation -> S3Location
schemaS3Location :: S3Location
  }
  deriving (StartSimulation -> StartSimulation -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StartSimulation -> StartSimulation -> Bool
$c/= :: StartSimulation -> StartSimulation -> Bool
== :: StartSimulation -> StartSimulation -> Bool
$c== :: StartSimulation -> StartSimulation -> Bool
Prelude.Eq, Int -> StartSimulation -> ShowS
[StartSimulation] -> ShowS
StartSimulation -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StartSimulation] -> ShowS
$cshowList :: [StartSimulation] -> ShowS
show :: StartSimulation -> String
$cshow :: StartSimulation -> String
showsPrec :: Int -> StartSimulation -> ShowS
$cshowsPrec :: Int -> StartSimulation -> ShowS
Prelude.Show, forall x. Rep StartSimulation x -> StartSimulation
forall x. StartSimulation -> Rep StartSimulation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StartSimulation x -> StartSimulation
$cfrom :: forall x. StartSimulation -> Rep StartSimulation x
Prelude.Generic)

-- |
-- Create a value of 'StartSimulation' 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:
--
-- 'clientToken', 'startSimulation_clientToken' - A value that you provide to ensure that repeated calls to this API
-- operation using the same parameters complete only once. A @ClientToken@
-- is also known as an /idempotency token/. A @ClientToken@ expires after
-- 24 hours.
--
-- 'description', 'startSimulation_description' - The description of the simulation.
--
-- 'maximumDuration', 'startSimulation_maximumDuration' - The maximum running time of the simulation, specified as a number of
-- months (m or M), hours (h or H), or days (d or D). The simulation stops
-- when it reaches this limit.
--
-- 'tags', 'startSimulation_tags' - A list of tags for the simulation. For more information about tags, see
-- <https://docs.aws.amazon.com/general/latest/gr/aws_tagging.html Tagging Amazon Web Services resources>
-- in the /Amazon Web Services General Reference/.
--
-- 'name', 'startSimulation_name' - The name of the simulation.
--
-- 'roleArn', 'startSimulation_roleArn' - The Amazon Resource Name (ARN) of the Identity and Access Management
-- (IAM) role that the simulation assumes to perform actions. For more
-- information about ARNs, see
-- <https://docs.aws.amazon.com/general/latest/gr/aws-arns-and-namespaces.html Amazon Resource Names (ARNs)>
-- in the /Amazon Web Services General Reference/. For more information
-- about IAM roles, see
-- <https://docs.aws.amazon.com/IAM/latest/UserGuide/id_roles.html IAM roles>
-- in the /Identity and Access Management User Guide/.
--
-- 'schemaS3Location', 'startSimulation_schemaS3Location' - The location of the simulation schema in Amazon Simple Storage Service
-- (Amazon S3). For more information about Amazon S3, see the
-- <https://docs.aws.amazon.com/AmazonS3/latest/userguide/Welcome.html Amazon Simple Storage Service User Guide>
-- .
newStartSimulation ::
  -- | 'name'
  Prelude.Text ->
  -- | 'roleArn'
  Prelude.Text ->
  -- | 'schemaS3Location'
  S3Location ->
  StartSimulation
newStartSimulation :: Text -> Text -> S3Location -> StartSimulation
newStartSimulation
  Text
pName_
  Text
pRoleArn_
  S3Location
pSchemaS3Location_ =
    StartSimulation'
      { $sel:clientToken:StartSimulation' :: Maybe (Sensitive Text)
clientToken = forall a. Maybe a
Prelude.Nothing,
        $sel:description:StartSimulation' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
        $sel:maximumDuration:StartSimulation' :: Maybe Text
maximumDuration = forall a. Maybe a
Prelude.Nothing,
        $sel:tags:StartSimulation' :: Maybe (HashMap Text Text)
tags = forall a. Maybe a
Prelude.Nothing,
        $sel:name:StartSimulation' :: Text
name = Text
pName_,
        $sel:roleArn:StartSimulation' :: Text
roleArn = Text
pRoleArn_,
        $sel:schemaS3Location:StartSimulation' :: S3Location
schemaS3Location = S3Location
pSchemaS3Location_
      }

-- | A value that you provide to ensure that repeated calls to this API
-- operation using the same parameters complete only once. A @ClientToken@
-- is also known as an /idempotency token/. A @ClientToken@ expires after
-- 24 hours.
startSimulation_clientToken :: Lens.Lens' StartSimulation (Prelude.Maybe Prelude.Text)
startSimulation_clientToken :: Lens' StartSimulation (Maybe Text)
startSimulation_clientToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartSimulation' {Maybe (Sensitive Text)
clientToken :: Maybe (Sensitive Text)
$sel:clientToken:StartSimulation' :: StartSimulation -> Maybe (Sensitive Text)
clientToken} -> Maybe (Sensitive Text)
clientToken) (\s :: StartSimulation
s@StartSimulation' {} Maybe (Sensitive Text)
a -> StartSimulation
s {$sel:clientToken:StartSimulation' :: Maybe (Sensitive Text)
clientToken = Maybe (Sensitive Text)
a} :: StartSimulation) 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. Iso' (Sensitive a) a
Data._Sensitive

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

-- | The maximum running time of the simulation, specified as a number of
-- months (m or M), hours (h or H), or days (d or D). The simulation stops
-- when it reaches this limit.
startSimulation_maximumDuration :: Lens.Lens' StartSimulation (Prelude.Maybe Prelude.Text)
startSimulation_maximumDuration :: Lens' StartSimulation (Maybe Text)
startSimulation_maximumDuration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartSimulation' {Maybe Text
maximumDuration :: Maybe Text
$sel:maximumDuration:StartSimulation' :: StartSimulation -> Maybe Text
maximumDuration} -> Maybe Text
maximumDuration) (\s :: StartSimulation
s@StartSimulation' {} Maybe Text
a -> StartSimulation
s {$sel:maximumDuration:StartSimulation' :: Maybe Text
maximumDuration = Maybe Text
a} :: StartSimulation)

-- | A list of tags for the simulation. For more information about tags, see
-- <https://docs.aws.amazon.com/general/latest/gr/aws_tagging.html Tagging Amazon Web Services resources>
-- in the /Amazon Web Services General Reference/.
startSimulation_tags :: Lens.Lens' StartSimulation (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
startSimulation_tags :: Lens' StartSimulation (Maybe (HashMap Text Text))
startSimulation_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartSimulation' {Maybe (HashMap Text Text)
tags :: Maybe (HashMap Text Text)
$sel:tags:StartSimulation' :: StartSimulation -> Maybe (HashMap Text Text)
tags} -> Maybe (HashMap Text Text)
tags) (\s :: StartSimulation
s@StartSimulation' {} Maybe (HashMap Text Text)
a -> StartSimulation
s {$sel:tags:StartSimulation' :: Maybe (HashMap Text Text)
tags = Maybe (HashMap Text Text)
a} :: StartSimulation) 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 name of the simulation.
startSimulation_name :: Lens.Lens' StartSimulation Prelude.Text
startSimulation_name :: Lens' StartSimulation Text
startSimulation_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartSimulation' {Text
name :: Text
$sel:name:StartSimulation' :: StartSimulation -> Text
name} -> Text
name) (\s :: StartSimulation
s@StartSimulation' {} Text
a -> StartSimulation
s {$sel:name:StartSimulation' :: Text
name = Text
a} :: StartSimulation)

-- | The Amazon Resource Name (ARN) of the Identity and Access Management
-- (IAM) role that the simulation assumes to perform actions. For more
-- information about ARNs, see
-- <https://docs.aws.amazon.com/general/latest/gr/aws-arns-and-namespaces.html Amazon Resource Names (ARNs)>
-- in the /Amazon Web Services General Reference/. For more information
-- about IAM roles, see
-- <https://docs.aws.amazon.com/IAM/latest/UserGuide/id_roles.html IAM roles>
-- in the /Identity and Access Management User Guide/.
startSimulation_roleArn :: Lens.Lens' StartSimulation Prelude.Text
startSimulation_roleArn :: Lens' StartSimulation Text
startSimulation_roleArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartSimulation' {Text
roleArn :: Text
$sel:roleArn:StartSimulation' :: StartSimulation -> Text
roleArn} -> Text
roleArn) (\s :: StartSimulation
s@StartSimulation' {} Text
a -> StartSimulation
s {$sel:roleArn:StartSimulation' :: Text
roleArn = Text
a} :: StartSimulation)

-- | The location of the simulation schema in Amazon Simple Storage Service
-- (Amazon S3). For more information about Amazon S3, see the
-- <https://docs.aws.amazon.com/AmazonS3/latest/userguide/Welcome.html Amazon Simple Storage Service User Guide>
-- .
startSimulation_schemaS3Location :: Lens.Lens' StartSimulation S3Location
startSimulation_schemaS3Location :: Lens' StartSimulation S3Location
startSimulation_schemaS3Location = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartSimulation' {S3Location
schemaS3Location :: S3Location
$sel:schemaS3Location:StartSimulation' :: StartSimulation -> S3Location
schemaS3Location} -> S3Location
schemaS3Location) (\s :: StartSimulation
s@StartSimulation' {} S3Location
a -> StartSimulation
s {$sel:schemaS3Location:StartSimulation' :: S3Location
schemaS3Location = S3Location
a} :: StartSimulation)

instance Core.AWSRequest StartSimulation where
  type
    AWSResponse StartSimulation =
      StartSimulationResponse
  request :: (Service -> Service) -> StartSimulation -> Request StartSimulation
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 StartSimulation
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse StartSimulation)))
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 POSIX -> Maybe Text -> Int -> StartSimulationResponse
StartSimulationResponse'
            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
"CreationTime")
            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
"ExecutionId")
            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 StartSimulation where
  hashWithSalt :: Int -> StartSimulation -> Int
hashWithSalt Int
_salt StartSimulation' {Maybe Text
Maybe (HashMap Text Text)
Maybe (Sensitive Text)
Text
S3Location
schemaS3Location :: S3Location
roleArn :: Text
name :: Text
tags :: Maybe (HashMap Text Text)
maximumDuration :: Maybe Text
description :: Maybe Text
clientToken :: Maybe (Sensitive Text)
$sel:schemaS3Location:StartSimulation' :: StartSimulation -> S3Location
$sel:roleArn:StartSimulation' :: StartSimulation -> Text
$sel:name:StartSimulation' :: StartSimulation -> Text
$sel:tags:StartSimulation' :: StartSimulation -> Maybe (HashMap Text Text)
$sel:maximumDuration:StartSimulation' :: StartSimulation -> Maybe Text
$sel:description:StartSimulation' :: StartSimulation -> Maybe Text
$sel:clientToken:StartSimulation' :: StartSimulation -> Maybe (Sensitive Text)
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (Sensitive Text)
clientToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
maximumDuration
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Text)
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
name
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
roleArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` S3Location
schemaS3Location

instance Prelude.NFData StartSimulation where
  rnf :: StartSimulation -> ()
rnf StartSimulation' {Maybe Text
Maybe (HashMap Text Text)
Maybe (Sensitive Text)
Text
S3Location
schemaS3Location :: S3Location
roleArn :: Text
name :: Text
tags :: Maybe (HashMap Text Text)
maximumDuration :: Maybe Text
description :: Maybe Text
clientToken :: Maybe (Sensitive Text)
$sel:schemaS3Location:StartSimulation' :: StartSimulation -> S3Location
$sel:roleArn:StartSimulation' :: StartSimulation -> Text
$sel:name:StartSimulation' :: StartSimulation -> Text
$sel:tags:StartSimulation' :: StartSimulation -> Maybe (HashMap Text Text)
$sel:maximumDuration:StartSimulation' :: StartSimulation -> Maybe Text
$sel:description:StartSimulation' :: StartSimulation -> Maybe Text
$sel:clientToken:StartSimulation' :: StartSimulation -> Maybe (Sensitive Text)
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe (Sensitive Text)
clientToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
description
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
maximumDuration
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text Text)
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
name
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
roleArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf S3Location
schemaS3Location

instance Data.ToHeaders StartSimulation where
  toHeaders :: StartSimulation -> 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 StartSimulation where
  toJSON :: StartSimulation -> Value
toJSON StartSimulation' {Maybe Text
Maybe (HashMap Text Text)
Maybe (Sensitive Text)
Text
S3Location
schemaS3Location :: S3Location
roleArn :: Text
name :: Text
tags :: Maybe (HashMap Text Text)
maximumDuration :: Maybe Text
description :: Maybe Text
clientToken :: Maybe (Sensitive Text)
$sel:schemaS3Location:StartSimulation' :: StartSimulation -> S3Location
$sel:roleArn:StartSimulation' :: StartSimulation -> Text
$sel:name:StartSimulation' :: StartSimulation -> Text
$sel:tags:StartSimulation' :: StartSimulation -> Maybe (HashMap Text Text)
$sel:maximumDuration:StartSimulation' :: StartSimulation -> Maybe Text
$sel:description:StartSimulation' :: StartSimulation -> Maybe Text
$sel:clientToken:StartSimulation' :: StartSimulation -> Maybe (Sensitive Text)
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"ClientToken" 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 (Sensitive Text)
clientToken,
            (Key
"Description" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
description,
            (Key
"MaximumDuration" 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
maximumDuration,
            (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
"Name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
name),
            forall a. a -> Maybe a
Prelude.Just (Key
"RoleArn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
roleArn),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"SchemaS3Location" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= S3Location
schemaS3Location)
          ]
      )

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

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

-- | /See:/ 'newStartSimulationResponse' smart constructor.
data StartSimulationResponse = StartSimulationResponse'
  { -- | The Amazon Resource Name (ARN) of the simulation. For more information
    -- about ARNs, see
    -- <https://docs.aws.amazon.com/general/latest/gr/aws-arns-and-namespaces.html Amazon Resource Names (ARNs)>
    -- in the /Amazon Web Services General Reference/.
    StartSimulationResponse -> Maybe Text
arn :: Prelude.Maybe Prelude.Text,
    -- | The time when the simulation was created, expressed as the number of
    -- seconds and milliseconds in UTC since the Unix epoch (0:0:0.000, January
    -- 1, 1970).
    StartSimulationResponse -> Maybe POSIX
creationTime :: Prelude.Maybe Data.POSIX,
    -- | A universally unique identifier (UUID) for this simulation.
    StartSimulationResponse -> Maybe Text
executionId :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    StartSimulationResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (StartSimulationResponse -> StartSimulationResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StartSimulationResponse -> StartSimulationResponse -> Bool
$c/= :: StartSimulationResponse -> StartSimulationResponse -> Bool
== :: StartSimulationResponse -> StartSimulationResponse -> Bool
$c== :: StartSimulationResponse -> StartSimulationResponse -> Bool
Prelude.Eq, ReadPrec [StartSimulationResponse]
ReadPrec StartSimulationResponse
Int -> ReadS StartSimulationResponse
ReadS [StartSimulationResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StartSimulationResponse]
$creadListPrec :: ReadPrec [StartSimulationResponse]
readPrec :: ReadPrec StartSimulationResponse
$creadPrec :: ReadPrec StartSimulationResponse
readList :: ReadS [StartSimulationResponse]
$creadList :: ReadS [StartSimulationResponse]
readsPrec :: Int -> ReadS StartSimulationResponse
$creadsPrec :: Int -> ReadS StartSimulationResponse
Prelude.Read, Int -> StartSimulationResponse -> ShowS
[StartSimulationResponse] -> ShowS
StartSimulationResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StartSimulationResponse] -> ShowS
$cshowList :: [StartSimulationResponse] -> ShowS
show :: StartSimulationResponse -> String
$cshow :: StartSimulationResponse -> String
showsPrec :: Int -> StartSimulationResponse -> ShowS
$cshowsPrec :: Int -> StartSimulationResponse -> ShowS
Prelude.Show, forall x. Rep StartSimulationResponse x -> StartSimulationResponse
forall x. StartSimulationResponse -> Rep StartSimulationResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StartSimulationResponse x -> StartSimulationResponse
$cfrom :: forall x. StartSimulationResponse -> Rep StartSimulationResponse x
Prelude.Generic)

-- |
-- Create a value of 'StartSimulationResponse' 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', 'startSimulationResponse_arn' - The Amazon Resource Name (ARN) of the simulation. For more information
-- about ARNs, see
-- <https://docs.aws.amazon.com/general/latest/gr/aws-arns-and-namespaces.html Amazon Resource Names (ARNs)>
-- in the /Amazon Web Services General Reference/.
--
-- 'creationTime', 'startSimulationResponse_creationTime' - The time when the simulation was created, expressed as the number of
-- seconds and milliseconds in UTC since the Unix epoch (0:0:0.000, January
-- 1, 1970).
--
-- 'executionId', 'startSimulationResponse_executionId' - A universally unique identifier (UUID) for this simulation.
--
-- 'httpStatus', 'startSimulationResponse_httpStatus' - The response's http status code.
newStartSimulationResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  StartSimulationResponse
newStartSimulationResponse :: Int -> StartSimulationResponse
newStartSimulationResponse Int
pHttpStatus_ =
  StartSimulationResponse'
    { $sel:arn:StartSimulationResponse' :: Maybe Text
arn = forall a. Maybe a
Prelude.Nothing,
      $sel:creationTime:StartSimulationResponse' :: Maybe POSIX
creationTime = forall a. Maybe a
Prelude.Nothing,
      $sel:executionId:StartSimulationResponse' :: Maybe Text
executionId = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:StartSimulationResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The Amazon Resource Name (ARN) of the simulation. For more information
-- about ARNs, see
-- <https://docs.aws.amazon.com/general/latest/gr/aws-arns-and-namespaces.html Amazon Resource Names (ARNs)>
-- in the /Amazon Web Services General Reference/.
startSimulationResponse_arn :: Lens.Lens' StartSimulationResponse (Prelude.Maybe Prelude.Text)
startSimulationResponse_arn :: Lens' StartSimulationResponse (Maybe Text)
startSimulationResponse_arn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartSimulationResponse' {Maybe Text
arn :: Maybe Text
$sel:arn:StartSimulationResponse' :: StartSimulationResponse -> Maybe Text
arn} -> Maybe Text
arn) (\s :: StartSimulationResponse
s@StartSimulationResponse' {} Maybe Text
a -> StartSimulationResponse
s {$sel:arn:StartSimulationResponse' :: Maybe Text
arn = Maybe Text
a} :: StartSimulationResponse)

-- | The time when the simulation was created, expressed as the number of
-- seconds and milliseconds in UTC since the Unix epoch (0:0:0.000, January
-- 1, 1970).
startSimulationResponse_creationTime :: Lens.Lens' StartSimulationResponse (Prelude.Maybe Prelude.UTCTime)
startSimulationResponse_creationTime :: Lens' StartSimulationResponse (Maybe UTCTime)
startSimulationResponse_creationTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartSimulationResponse' {Maybe POSIX
creationTime :: Maybe POSIX
$sel:creationTime:StartSimulationResponse' :: StartSimulationResponse -> Maybe POSIX
creationTime} -> Maybe POSIX
creationTime) (\s :: StartSimulationResponse
s@StartSimulationResponse' {} Maybe POSIX
a -> StartSimulationResponse
s {$sel:creationTime:StartSimulationResponse' :: Maybe POSIX
creationTime = Maybe POSIX
a} :: StartSimulationResponse) 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 universally unique identifier (UUID) for this simulation.
startSimulationResponse_executionId :: Lens.Lens' StartSimulationResponse (Prelude.Maybe Prelude.Text)
startSimulationResponse_executionId :: Lens' StartSimulationResponse (Maybe Text)
startSimulationResponse_executionId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartSimulationResponse' {Maybe Text
executionId :: Maybe Text
$sel:executionId:StartSimulationResponse' :: StartSimulationResponse -> Maybe Text
executionId} -> Maybe Text
executionId) (\s :: StartSimulationResponse
s@StartSimulationResponse' {} Maybe Text
a -> StartSimulationResponse
s {$sel:executionId:StartSimulationResponse' :: Maybe Text
executionId = Maybe Text
a} :: StartSimulationResponse)

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

instance Prelude.NFData StartSimulationResponse where
  rnf :: StartSimulationResponse -> ()
rnf StartSimulationResponse' {Int
Maybe Text
Maybe POSIX
httpStatus :: Int
executionId :: Maybe Text
creationTime :: Maybe POSIX
arn :: Maybe Text
$sel:httpStatus:StartSimulationResponse' :: StartSimulationResponse -> Int
$sel:executionId:StartSimulationResponse' :: StartSimulationResponse -> Maybe Text
$sel:creationTime:StartSimulationResponse' :: StartSimulationResponse -> Maybe POSIX
$sel:arn:StartSimulationResponse' :: StartSimulationResponse -> 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 POSIX
creationTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
executionId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus