{-# 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.UpdateWorldTemplate
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Updates a world template.
module Amazonka.RobOMaker.UpdateWorldTemplate
  ( -- * Creating a Request
    UpdateWorldTemplate (..),
    newUpdateWorldTemplate,

    -- * Request Lenses
    updateWorldTemplate_name,
    updateWorldTemplate_templateBody,
    updateWorldTemplate_templateLocation,
    updateWorldTemplate_template,

    -- * Destructuring the Response
    UpdateWorldTemplateResponse (..),
    newUpdateWorldTemplateResponse,

    -- * Response Lenses
    updateWorldTemplateResponse_arn,
    updateWorldTemplateResponse_createdAt,
    updateWorldTemplateResponse_lastUpdatedAt,
    updateWorldTemplateResponse_name,
    updateWorldTemplateResponse_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:/ 'newUpdateWorldTemplate' smart constructor.
data UpdateWorldTemplate = UpdateWorldTemplate'
  { -- | The name of the template.
    UpdateWorldTemplate -> Maybe Text
name :: Prelude.Maybe Prelude.Text,
    -- | The world template body.
    UpdateWorldTemplate -> Maybe Text
templateBody :: Prelude.Maybe Prelude.Text,
    -- | The location of the world template.
    UpdateWorldTemplate -> Maybe TemplateLocation
templateLocation :: Prelude.Maybe TemplateLocation,
    -- | The Amazon Resource Name (arn) of the world template to update.
    UpdateWorldTemplate -> Text
template :: Prelude.Text
  }
  deriving (UpdateWorldTemplate -> UpdateWorldTemplate -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateWorldTemplate -> UpdateWorldTemplate -> Bool
$c/= :: UpdateWorldTemplate -> UpdateWorldTemplate -> Bool
== :: UpdateWorldTemplate -> UpdateWorldTemplate -> Bool
$c== :: UpdateWorldTemplate -> UpdateWorldTemplate -> Bool
Prelude.Eq, ReadPrec [UpdateWorldTemplate]
ReadPrec UpdateWorldTemplate
Int -> ReadS UpdateWorldTemplate
ReadS [UpdateWorldTemplate]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateWorldTemplate]
$creadListPrec :: ReadPrec [UpdateWorldTemplate]
readPrec :: ReadPrec UpdateWorldTemplate
$creadPrec :: ReadPrec UpdateWorldTemplate
readList :: ReadS [UpdateWorldTemplate]
$creadList :: ReadS [UpdateWorldTemplate]
readsPrec :: Int -> ReadS UpdateWorldTemplate
$creadsPrec :: Int -> ReadS UpdateWorldTemplate
Prelude.Read, Int -> UpdateWorldTemplate -> ShowS
[UpdateWorldTemplate] -> ShowS
UpdateWorldTemplate -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateWorldTemplate] -> ShowS
$cshowList :: [UpdateWorldTemplate] -> ShowS
show :: UpdateWorldTemplate -> String
$cshow :: UpdateWorldTemplate -> String
showsPrec :: Int -> UpdateWorldTemplate -> ShowS
$cshowsPrec :: Int -> UpdateWorldTemplate -> ShowS
Prelude.Show, forall x. Rep UpdateWorldTemplate x -> UpdateWorldTemplate
forall x. UpdateWorldTemplate -> Rep UpdateWorldTemplate x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateWorldTemplate x -> UpdateWorldTemplate
$cfrom :: forall x. UpdateWorldTemplate -> Rep UpdateWorldTemplate x
Prelude.Generic)

-- |
-- Create a value of 'UpdateWorldTemplate' 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:
--
-- 'name', 'updateWorldTemplate_name' - The name of the template.
--
-- 'templateBody', 'updateWorldTemplate_templateBody' - The world template body.
--
-- 'templateLocation', 'updateWorldTemplate_templateLocation' - The location of the world template.
--
-- 'template', 'updateWorldTemplate_template' - The Amazon Resource Name (arn) of the world template to update.
newUpdateWorldTemplate ::
  -- | 'template'
  Prelude.Text ->
  UpdateWorldTemplate
newUpdateWorldTemplate :: Text -> UpdateWorldTemplate
newUpdateWorldTemplate Text
pTemplate_ =
  UpdateWorldTemplate'
    { $sel:name:UpdateWorldTemplate' :: Maybe Text
name = forall a. Maybe a
Prelude.Nothing,
      $sel:templateBody:UpdateWorldTemplate' :: Maybe Text
templateBody = forall a. Maybe a
Prelude.Nothing,
      $sel:templateLocation:UpdateWorldTemplate' :: Maybe TemplateLocation
templateLocation = forall a. Maybe a
Prelude.Nothing,
      $sel:template:UpdateWorldTemplate' :: Text
template = Text
pTemplate_
    }

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

-- | The world template body.
updateWorldTemplate_templateBody :: Lens.Lens' UpdateWorldTemplate (Prelude.Maybe Prelude.Text)
updateWorldTemplate_templateBody :: Lens' UpdateWorldTemplate (Maybe Text)
updateWorldTemplate_templateBody = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateWorldTemplate' {Maybe Text
templateBody :: Maybe Text
$sel:templateBody:UpdateWorldTemplate' :: UpdateWorldTemplate -> Maybe Text
templateBody} -> Maybe Text
templateBody) (\s :: UpdateWorldTemplate
s@UpdateWorldTemplate' {} Maybe Text
a -> UpdateWorldTemplate
s {$sel:templateBody:UpdateWorldTemplate' :: Maybe Text
templateBody = Maybe Text
a} :: UpdateWorldTemplate)

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

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

instance Core.AWSRequest UpdateWorldTemplate where
  type
    AWSResponse UpdateWorldTemplate =
      UpdateWorldTemplateResponse
  request :: (Service -> Service)
-> UpdateWorldTemplate -> Request UpdateWorldTemplate
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 UpdateWorldTemplate
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse UpdateWorldTemplate)))
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 POSIX
-> Maybe Text
-> Int
-> UpdateWorldTemplateResponse
UpdateWorldTemplateResponse'
            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
"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
"lastUpdatedAt")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"name")
            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 UpdateWorldTemplate where
  hashWithSalt :: Int -> UpdateWorldTemplate -> Int
hashWithSalt Int
_salt UpdateWorldTemplate' {Maybe Text
Maybe TemplateLocation
Text
template :: Text
templateLocation :: Maybe TemplateLocation
templateBody :: Maybe Text
name :: Maybe Text
$sel:template:UpdateWorldTemplate' :: UpdateWorldTemplate -> Text
$sel:templateLocation:UpdateWorldTemplate' :: UpdateWorldTemplate -> Maybe TemplateLocation
$sel:templateBody:UpdateWorldTemplate' :: UpdateWorldTemplate -> Maybe Text
$sel:name:UpdateWorldTemplate' :: UpdateWorldTemplate -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
name
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
templateBody
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe TemplateLocation
templateLocation
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
template

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

instance Data.ToHeaders UpdateWorldTemplate where
  toHeaders :: UpdateWorldTemplate -> 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 UpdateWorldTemplate where
  toJSON :: UpdateWorldTemplate -> Value
toJSON UpdateWorldTemplate' {Maybe Text
Maybe TemplateLocation
Text
template :: Text
templateLocation :: Maybe TemplateLocation
templateBody :: Maybe Text
name :: Maybe Text
$sel:template:UpdateWorldTemplate' :: UpdateWorldTemplate -> Text
$sel:templateLocation:UpdateWorldTemplate' :: UpdateWorldTemplate -> Maybe TemplateLocation
$sel:templateBody:UpdateWorldTemplate' :: UpdateWorldTemplate -> Maybe Text
$sel:name:UpdateWorldTemplate' :: UpdateWorldTemplate -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (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
"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,
            forall a. a -> Maybe a
Prelude.Just (Key
"template" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
template)
          ]
      )

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

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

-- | /See:/ 'newUpdateWorldTemplateResponse' smart constructor.
data UpdateWorldTemplateResponse = UpdateWorldTemplateResponse'
  { -- | The Amazon Resource Name (arn) of the world template.
    UpdateWorldTemplateResponse -> Maybe Text
arn :: Prelude.Maybe Prelude.Text,
    -- | The time, in milliseconds since the epoch, when the world template was
    -- created.
    UpdateWorldTemplateResponse -> Maybe POSIX
createdAt :: Prelude.Maybe Data.POSIX,
    -- | The time, in milliseconds since the epoch, when the world template was
    -- last updated.
    UpdateWorldTemplateResponse -> Maybe POSIX
lastUpdatedAt :: Prelude.Maybe Data.POSIX,
    -- | The name of the world template.
    UpdateWorldTemplateResponse -> Maybe Text
name :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    UpdateWorldTemplateResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (UpdateWorldTemplateResponse -> UpdateWorldTemplateResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateWorldTemplateResponse -> UpdateWorldTemplateResponse -> Bool
$c/= :: UpdateWorldTemplateResponse -> UpdateWorldTemplateResponse -> Bool
== :: UpdateWorldTemplateResponse -> UpdateWorldTemplateResponse -> Bool
$c== :: UpdateWorldTemplateResponse -> UpdateWorldTemplateResponse -> Bool
Prelude.Eq, ReadPrec [UpdateWorldTemplateResponse]
ReadPrec UpdateWorldTemplateResponse
Int -> ReadS UpdateWorldTemplateResponse
ReadS [UpdateWorldTemplateResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateWorldTemplateResponse]
$creadListPrec :: ReadPrec [UpdateWorldTemplateResponse]
readPrec :: ReadPrec UpdateWorldTemplateResponse
$creadPrec :: ReadPrec UpdateWorldTemplateResponse
readList :: ReadS [UpdateWorldTemplateResponse]
$creadList :: ReadS [UpdateWorldTemplateResponse]
readsPrec :: Int -> ReadS UpdateWorldTemplateResponse
$creadsPrec :: Int -> ReadS UpdateWorldTemplateResponse
Prelude.Read, Int -> UpdateWorldTemplateResponse -> ShowS
[UpdateWorldTemplateResponse] -> ShowS
UpdateWorldTemplateResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateWorldTemplateResponse] -> ShowS
$cshowList :: [UpdateWorldTemplateResponse] -> ShowS
show :: UpdateWorldTemplateResponse -> String
$cshow :: UpdateWorldTemplateResponse -> String
showsPrec :: Int -> UpdateWorldTemplateResponse -> ShowS
$cshowsPrec :: Int -> UpdateWorldTemplateResponse -> ShowS
Prelude.Show, forall x.
Rep UpdateWorldTemplateResponse x -> UpdateWorldTemplateResponse
forall x.
UpdateWorldTemplateResponse -> Rep UpdateWorldTemplateResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep UpdateWorldTemplateResponse x -> UpdateWorldTemplateResponse
$cfrom :: forall x.
UpdateWorldTemplateResponse -> Rep UpdateWorldTemplateResponse x
Prelude.Generic)

-- |
-- Create a value of 'UpdateWorldTemplateResponse' 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', 'updateWorldTemplateResponse_arn' - The Amazon Resource Name (arn) of the world template.
--
-- 'createdAt', 'updateWorldTemplateResponse_createdAt' - The time, in milliseconds since the epoch, when the world template was
-- created.
--
-- 'lastUpdatedAt', 'updateWorldTemplateResponse_lastUpdatedAt' - The time, in milliseconds since the epoch, when the world template was
-- last updated.
--
-- 'name', 'updateWorldTemplateResponse_name' - The name of the world template.
--
-- 'httpStatus', 'updateWorldTemplateResponse_httpStatus' - The response's http status code.
newUpdateWorldTemplateResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UpdateWorldTemplateResponse
newUpdateWorldTemplateResponse :: Int -> UpdateWorldTemplateResponse
newUpdateWorldTemplateResponse Int
pHttpStatus_ =
  UpdateWorldTemplateResponse'
    { $sel:arn:UpdateWorldTemplateResponse' :: Maybe Text
arn = forall a. Maybe a
Prelude.Nothing,
      $sel:createdAt:UpdateWorldTemplateResponse' :: Maybe POSIX
createdAt = forall a. Maybe a
Prelude.Nothing,
      $sel:lastUpdatedAt:UpdateWorldTemplateResponse' :: Maybe POSIX
lastUpdatedAt = forall a. Maybe a
Prelude.Nothing,
      $sel:name:UpdateWorldTemplateResponse' :: Maybe Text
name = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:UpdateWorldTemplateResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

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

-- | The time, in milliseconds since the epoch, when the world template was
-- created.
updateWorldTemplateResponse_createdAt :: Lens.Lens' UpdateWorldTemplateResponse (Prelude.Maybe Prelude.UTCTime)
updateWorldTemplateResponse_createdAt :: Lens' UpdateWorldTemplateResponse (Maybe UTCTime)
updateWorldTemplateResponse_createdAt = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateWorldTemplateResponse' {Maybe POSIX
createdAt :: Maybe POSIX
$sel:createdAt:UpdateWorldTemplateResponse' :: UpdateWorldTemplateResponse -> Maybe POSIX
createdAt} -> Maybe POSIX
createdAt) (\s :: UpdateWorldTemplateResponse
s@UpdateWorldTemplateResponse' {} Maybe POSIX
a -> UpdateWorldTemplateResponse
s {$sel:createdAt:UpdateWorldTemplateResponse' :: Maybe POSIX
createdAt = Maybe POSIX
a} :: UpdateWorldTemplateResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The time, in milliseconds since the epoch, when the world template was
-- last updated.
updateWorldTemplateResponse_lastUpdatedAt :: Lens.Lens' UpdateWorldTemplateResponse (Prelude.Maybe Prelude.UTCTime)
updateWorldTemplateResponse_lastUpdatedAt :: Lens' UpdateWorldTemplateResponse (Maybe UTCTime)
updateWorldTemplateResponse_lastUpdatedAt = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateWorldTemplateResponse' {Maybe POSIX
lastUpdatedAt :: Maybe POSIX
$sel:lastUpdatedAt:UpdateWorldTemplateResponse' :: UpdateWorldTemplateResponse -> Maybe POSIX
lastUpdatedAt} -> Maybe POSIX
lastUpdatedAt) (\s :: UpdateWorldTemplateResponse
s@UpdateWorldTemplateResponse' {} Maybe POSIX
a -> UpdateWorldTemplateResponse
s {$sel:lastUpdatedAt:UpdateWorldTemplateResponse' :: Maybe POSIX
lastUpdatedAt = Maybe POSIX
a} :: UpdateWorldTemplateResponse) 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.
updateWorldTemplateResponse_name :: Lens.Lens' UpdateWorldTemplateResponse (Prelude.Maybe Prelude.Text)
updateWorldTemplateResponse_name :: Lens' UpdateWorldTemplateResponse (Maybe Text)
updateWorldTemplateResponse_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateWorldTemplateResponse' {Maybe Text
name :: Maybe Text
$sel:name:UpdateWorldTemplateResponse' :: UpdateWorldTemplateResponse -> Maybe Text
name} -> Maybe Text
name) (\s :: UpdateWorldTemplateResponse
s@UpdateWorldTemplateResponse' {} Maybe Text
a -> UpdateWorldTemplateResponse
s {$sel:name:UpdateWorldTemplateResponse' :: Maybe Text
name = Maybe Text
a} :: UpdateWorldTemplateResponse)

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

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