{-# 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.CreateWorldTemplate
-- 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 world template.
module Amazonka.RobOMaker.CreateWorldTemplate
  ( -- * Creating a Request
    CreateWorldTemplate (..),
    newCreateWorldTemplate,

    -- * Request Lenses
    createWorldTemplate_clientRequestToken,
    createWorldTemplate_name,
    createWorldTemplate_tags,
    createWorldTemplate_templateBody,
    createWorldTemplate_templateLocation,

    -- * Destructuring the Response
    CreateWorldTemplateResponse (..),
    newCreateWorldTemplateResponse,

    -- * Response Lenses
    createWorldTemplateResponse_arn,
    createWorldTemplateResponse_clientRequestToken,
    createWorldTemplateResponse_createdAt,
    createWorldTemplateResponse_name,
    createWorldTemplateResponse_tags,
    createWorldTemplateResponse_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:/ 'newCreateWorldTemplate' smart constructor.
data CreateWorldTemplate = CreateWorldTemplate'
  { -- | Unique, case-sensitive identifier that you provide to ensure the
    -- idempotency of the request.
    CreateWorldTemplate -> Maybe Text
clientRequestToken :: Prelude.Maybe Prelude.Text,
    -- | The name of the world template.
    CreateWorldTemplate -> Maybe Text
name :: Prelude.Maybe Prelude.Text,
    -- | A map that contains tag keys and tag values that are attached to the
    -- world template.
    CreateWorldTemplate -> Maybe (HashMap Text Text)
tags :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | The world template body.
    CreateWorldTemplate -> Maybe Text
templateBody :: Prelude.Maybe Prelude.Text,
    -- | The location of the world template.
    CreateWorldTemplate -> Maybe TemplateLocation
templateLocation :: Prelude.Maybe TemplateLocation
  }
  deriving (CreateWorldTemplate -> CreateWorldTemplate -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateWorldTemplate -> CreateWorldTemplate -> Bool
$c/= :: CreateWorldTemplate -> CreateWorldTemplate -> Bool
== :: CreateWorldTemplate -> CreateWorldTemplate -> Bool
$c== :: CreateWorldTemplate -> CreateWorldTemplate -> Bool
Prelude.Eq, ReadPrec [CreateWorldTemplate]
ReadPrec CreateWorldTemplate
Int -> ReadS CreateWorldTemplate
ReadS [CreateWorldTemplate]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateWorldTemplate]
$creadListPrec :: ReadPrec [CreateWorldTemplate]
readPrec :: ReadPrec CreateWorldTemplate
$creadPrec :: ReadPrec CreateWorldTemplate
readList :: ReadS [CreateWorldTemplate]
$creadList :: ReadS [CreateWorldTemplate]
readsPrec :: Int -> ReadS CreateWorldTemplate
$creadsPrec :: Int -> ReadS CreateWorldTemplate
Prelude.Read, Int -> CreateWorldTemplate -> ShowS
[CreateWorldTemplate] -> ShowS
CreateWorldTemplate -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateWorldTemplate] -> ShowS
$cshowList :: [CreateWorldTemplate] -> ShowS
show :: CreateWorldTemplate -> String
$cshow :: CreateWorldTemplate -> String
showsPrec :: Int -> CreateWorldTemplate -> ShowS
$cshowsPrec :: Int -> CreateWorldTemplate -> ShowS
Prelude.Show, forall x. Rep CreateWorldTemplate x -> CreateWorldTemplate
forall x. CreateWorldTemplate -> Rep CreateWorldTemplate x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateWorldTemplate x -> CreateWorldTemplate
$cfrom :: forall x. CreateWorldTemplate -> Rep CreateWorldTemplate x
Prelude.Generic)

-- |
-- Create a value of 'CreateWorldTemplate' 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', 'createWorldTemplate_clientRequestToken' - Unique, case-sensitive identifier that you provide to ensure the
-- idempotency of the request.
--
-- 'name', 'createWorldTemplate_name' - The name of the world template.
--
-- 'tags', 'createWorldTemplate_tags' - A map that contains tag keys and tag values that are attached to the
-- world template.
--
-- 'templateBody', 'createWorldTemplate_templateBody' - The world template body.
--
-- 'templateLocation', 'createWorldTemplate_templateLocation' - The location of the world template.
newCreateWorldTemplate ::
  CreateWorldTemplate
newCreateWorldTemplate :: CreateWorldTemplate
newCreateWorldTemplate =
  CreateWorldTemplate'
    { $sel:clientRequestToken:CreateWorldTemplate' :: Maybe Text
clientRequestToken =
        forall a. Maybe a
Prelude.Nothing,
      $sel:name:CreateWorldTemplate' :: Maybe Text
name = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:CreateWorldTemplate' :: Maybe (HashMap Text Text)
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:templateBody:CreateWorldTemplate' :: Maybe Text
templateBody = forall a. Maybe a
Prelude.Nothing,
      $sel:templateLocation:CreateWorldTemplate' :: Maybe TemplateLocation
templateLocation = forall a. Maybe a
Prelude.Nothing
    }

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

-- | The name of the world template.
createWorldTemplate_name :: Lens.Lens' CreateWorldTemplate (Prelude.Maybe Prelude.Text)
createWorldTemplate_name :: Lens' CreateWorldTemplate (Maybe Text)
createWorldTemplate_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateWorldTemplate' {Maybe Text
name :: Maybe Text
$sel:name:CreateWorldTemplate' :: CreateWorldTemplate -> Maybe Text
name} -> Maybe Text
name) (\s :: CreateWorldTemplate
s@CreateWorldTemplate' {} Maybe Text
a -> CreateWorldTemplate
s {$sel:name:CreateWorldTemplate' :: Maybe Text
name = Maybe Text
a} :: CreateWorldTemplate)

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

-- | The location of the world template.
createWorldTemplate_templateLocation :: Lens.Lens' CreateWorldTemplate (Prelude.Maybe TemplateLocation)
createWorldTemplate_templateLocation :: Lens' CreateWorldTemplate (Maybe TemplateLocation)
createWorldTemplate_templateLocation = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateWorldTemplate' {Maybe TemplateLocation
templateLocation :: Maybe TemplateLocation
$sel:templateLocation:CreateWorldTemplate' :: CreateWorldTemplate -> Maybe TemplateLocation
templateLocation} -> Maybe TemplateLocation
templateLocation) (\s :: CreateWorldTemplate
s@CreateWorldTemplate' {} Maybe TemplateLocation
a -> CreateWorldTemplate
s {$sel:templateLocation:CreateWorldTemplate' :: Maybe TemplateLocation
templateLocation = Maybe TemplateLocation
a} :: CreateWorldTemplate)

instance Core.AWSRequest CreateWorldTemplate where
  type
    AWSResponse CreateWorldTemplate =
      CreateWorldTemplateResponse
  request :: (Service -> Service)
-> CreateWorldTemplate -> Request CreateWorldTemplate
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 CreateWorldTemplate
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CreateWorldTemplate)))
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 POSIX
-> Maybe Text
-> Maybe (HashMap Text Text)
-> Int
-> CreateWorldTemplateResponse
CreateWorldTemplateResponse'
            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
"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
"name")
            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 CreateWorldTemplate where
  hashWithSalt :: Int -> CreateWorldTemplate -> Int
hashWithSalt Int
_salt CreateWorldTemplate' {Maybe Text
Maybe (HashMap Text Text)
Maybe TemplateLocation
templateLocation :: Maybe TemplateLocation
templateBody :: Maybe Text
tags :: Maybe (HashMap Text Text)
name :: Maybe Text
clientRequestToken :: Maybe Text
$sel:templateLocation:CreateWorldTemplate' :: CreateWorldTemplate -> Maybe TemplateLocation
$sel:templateBody:CreateWorldTemplate' :: CreateWorldTemplate -> Maybe Text
$sel:tags:CreateWorldTemplate' :: CreateWorldTemplate -> Maybe (HashMap Text Text)
$sel:name:CreateWorldTemplate' :: CreateWorldTemplate -> Maybe Text
$sel:clientRequestToken:CreateWorldTemplate' :: CreateWorldTemplate -> 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 Text
name
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Text)
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
templateBody
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe TemplateLocation
templateLocation

instance Prelude.NFData CreateWorldTemplate where
  rnf :: CreateWorldTemplate -> ()
rnf CreateWorldTemplate' {Maybe Text
Maybe (HashMap Text Text)
Maybe TemplateLocation
templateLocation :: Maybe TemplateLocation
templateBody :: Maybe Text
tags :: Maybe (HashMap Text Text)
name :: Maybe Text
clientRequestToken :: Maybe Text
$sel:templateLocation:CreateWorldTemplate' :: CreateWorldTemplate -> Maybe TemplateLocation
$sel:templateBody:CreateWorldTemplate' :: CreateWorldTemplate -> Maybe Text
$sel:tags:CreateWorldTemplate' :: CreateWorldTemplate -> Maybe (HashMap Text Text)
$sel:name:CreateWorldTemplate' :: CreateWorldTemplate -> Maybe Text
$sel:clientRequestToken:CreateWorldTemplate' :: CreateWorldTemplate -> 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 Text
name
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text Text)
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
templateBody
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe TemplateLocation
templateLocation

instance Data.ToHeaders CreateWorldTemplate where
  toHeaders :: CreateWorldTemplate -> 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 CreateWorldTemplate where
  toJSON :: CreateWorldTemplate -> Value
toJSON CreateWorldTemplate' {Maybe Text
Maybe (HashMap Text Text)
Maybe TemplateLocation
templateLocation :: Maybe TemplateLocation
templateBody :: Maybe Text
tags :: Maybe (HashMap Text Text)
name :: Maybe Text
clientRequestToken :: Maybe Text
$sel:templateLocation:CreateWorldTemplate' :: CreateWorldTemplate -> Maybe TemplateLocation
$sel:templateBody:CreateWorldTemplate' :: CreateWorldTemplate -> Maybe Text
$sel:tags:CreateWorldTemplate' :: CreateWorldTemplate -> Maybe (HashMap Text Text)
$sel:name:CreateWorldTemplate' :: CreateWorldTemplate -> Maybe Text
$sel:clientRequestToken:CreateWorldTemplate' :: CreateWorldTemplate -> 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
"name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
name,
            (Key
"tags" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe (HashMap Text Text)
tags,
            (Key
"templateBody" 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
templateBody,
            (Key
"templateLocation" 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 TemplateLocation
templateLocation
          ]
      )

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

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

-- | /See:/ 'newCreateWorldTemplateResponse' smart constructor.
data CreateWorldTemplateResponse = CreateWorldTemplateResponse'
  { -- | The Amazon Resource Name (ARN) of the world template.
    CreateWorldTemplateResponse -> Maybe Text
arn :: Prelude.Maybe Prelude.Text,
    -- | Unique, case-sensitive identifier that you provide to ensure the
    -- idempotency of the request.
    CreateWorldTemplateResponse -> Maybe Text
clientRequestToken :: Prelude.Maybe Prelude.Text,
    -- | The time, in milliseconds since the epoch, when the world template was
    -- created.
    CreateWorldTemplateResponse -> Maybe POSIX
createdAt :: Prelude.Maybe Data.POSIX,
    -- | The name of the world template.
    CreateWorldTemplateResponse -> Maybe Text
name :: Prelude.Maybe Prelude.Text,
    -- | A map that contains tag keys and tag values that are attached to the
    -- world template.
    CreateWorldTemplateResponse -> Maybe (HashMap Text Text)
tags :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | The response's http status code.
    CreateWorldTemplateResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CreateWorldTemplateResponse -> CreateWorldTemplateResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateWorldTemplateResponse -> CreateWorldTemplateResponse -> Bool
$c/= :: CreateWorldTemplateResponse -> CreateWorldTemplateResponse -> Bool
== :: CreateWorldTemplateResponse -> CreateWorldTemplateResponse -> Bool
$c== :: CreateWorldTemplateResponse -> CreateWorldTemplateResponse -> Bool
Prelude.Eq, ReadPrec [CreateWorldTemplateResponse]
ReadPrec CreateWorldTemplateResponse
Int -> ReadS CreateWorldTemplateResponse
ReadS [CreateWorldTemplateResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateWorldTemplateResponse]
$creadListPrec :: ReadPrec [CreateWorldTemplateResponse]
readPrec :: ReadPrec CreateWorldTemplateResponse
$creadPrec :: ReadPrec CreateWorldTemplateResponse
readList :: ReadS [CreateWorldTemplateResponse]
$creadList :: ReadS [CreateWorldTemplateResponse]
readsPrec :: Int -> ReadS CreateWorldTemplateResponse
$creadsPrec :: Int -> ReadS CreateWorldTemplateResponse
Prelude.Read, Int -> CreateWorldTemplateResponse -> ShowS
[CreateWorldTemplateResponse] -> ShowS
CreateWorldTemplateResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateWorldTemplateResponse] -> ShowS
$cshowList :: [CreateWorldTemplateResponse] -> ShowS
show :: CreateWorldTemplateResponse -> String
$cshow :: CreateWorldTemplateResponse -> String
showsPrec :: Int -> CreateWorldTemplateResponse -> ShowS
$cshowsPrec :: Int -> CreateWorldTemplateResponse -> ShowS
Prelude.Show, forall x.
Rep CreateWorldTemplateResponse x -> CreateWorldTemplateResponse
forall x.
CreateWorldTemplateResponse -> Rep CreateWorldTemplateResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateWorldTemplateResponse x -> CreateWorldTemplateResponse
$cfrom :: forall x.
CreateWorldTemplateResponse -> Rep CreateWorldTemplateResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateWorldTemplateResponse' 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', 'createWorldTemplateResponse_arn' - The Amazon Resource Name (ARN) of the world template.
--
-- 'clientRequestToken', 'createWorldTemplateResponse_clientRequestToken' - Unique, case-sensitive identifier that you provide to ensure the
-- idempotency of the request.
--
-- 'createdAt', 'createWorldTemplateResponse_createdAt' - The time, in milliseconds since the epoch, when the world template was
-- created.
--
-- 'name', 'createWorldTemplateResponse_name' - The name of the world template.
--
-- 'tags', 'createWorldTemplateResponse_tags' - A map that contains tag keys and tag values that are attached to the
-- world template.
--
-- 'httpStatus', 'createWorldTemplateResponse_httpStatus' - The response's http status code.
newCreateWorldTemplateResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateWorldTemplateResponse
newCreateWorldTemplateResponse :: Int -> CreateWorldTemplateResponse
newCreateWorldTemplateResponse Int
pHttpStatus_ =
  CreateWorldTemplateResponse'
    { $sel:arn:CreateWorldTemplateResponse' :: Maybe Text
arn = forall a. Maybe a
Prelude.Nothing,
      $sel:clientRequestToken:CreateWorldTemplateResponse' :: Maybe Text
clientRequestToken = forall a. Maybe a
Prelude.Nothing,
      $sel:createdAt:CreateWorldTemplateResponse' :: Maybe POSIX
createdAt = forall a. Maybe a
Prelude.Nothing,
      $sel:name:CreateWorldTemplateResponse' :: Maybe Text
name = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:CreateWorldTemplateResponse' :: Maybe (HashMap Text Text)
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateWorldTemplateResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

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

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

-- | The time, in milliseconds since the epoch, when the world template was
-- created.
createWorldTemplateResponse_createdAt :: Lens.Lens' CreateWorldTemplateResponse (Prelude.Maybe Prelude.UTCTime)
createWorldTemplateResponse_createdAt :: Lens' CreateWorldTemplateResponse (Maybe UTCTime)
createWorldTemplateResponse_createdAt = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateWorldTemplateResponse' {Maybe POSIX
createdAt :: Maybe POSIX
$sel:createdAt:CreateWorldTemplateResponse' :: CreateWorldTemplateResponse -> Maybe POSIX
createdAt} -> Maybe POSIX
createdAt) (\s :: CreateWorldTemplateResponse
s@CreateWorldTemplateResponse' {} Maybe POSIX
a -> CreateWorldTemplateResponse
s {$sel:createdAt:CreateWorldTemplateResponse' :: Maybe POSIX
createdAt = Maybe POSIX
a} :: CreateWorldTemplateResponse) 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 name of the world template.
createWorldTemplateResponse_name :: Lens.Lens' CreateWorldTemplateResponse (Prelude.Maybe Prelude.Text)
createWorldTemplateResponse_name :: Lens' CreateWorldTemplateResponse (Maybe Text)
createWorldTemplateResponse_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateWorldTemplateResponse' {Maybe Text
name :: Maybe Text
$sel:name:CreateWorldTemplateResponse' :: CreateWorldTemplateResponse -> Maybe Text
name} -> Maybe Text
name) (\s :: CreateWorldTemplateResponse
s@CreateWorldTemplateResponse' {} Maybe Text
a -> CreateWorldTemplateResponse
s {$sel:name:CreateWorldTemplateResponse' :: Maybe Text
name = Maybe Text
a} :: CreateWorldTemplateResponse)

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

instance Prelude.NFData CreateWorldTemplateResponse where
  rnf :: CreateWorldTemplateResponse -> ()
rnf CreateWorldTemplateResponse' {Int
Maybe Text
Maybe (HashMap Text Text)
Maybe POSIX
httpStatus :: Int
tags :: Maybe (HashMap Text Text)
name :: Maybe Text
createdAt :: Maybe POSIX
clientRequestToken :: Maybe Text
arn :: Maybe Text
$sel:httpStatus:CreateWorldTemplateResponse' :: CreateWorldTemplateResponse -> Int
$sel:tags:CreateWorldTemplateResponse' :: CreateWorldTemplateResponse -> Maybe (HashMap Text Text)
$sel:name:CreateWorldTemplateResponse' :: CreateWorldTemplateResponse -> Maybe Text
$sel:createdAt:CreateWorldTemplateResponse' :: CreateWorldTemplateResponse -> Maybe POSIX
$sel:clientRequestToken:CreateWorldTemplateResponse' :: CreateWorldTemplateResponse -> Maybe Text
$sel:arn:CreateWorldTemplateResponse' :: CreateWorldTemplateResponse -> 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 POSIX
createdAt
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
name
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text Text)
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus