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

    -- * Request Lenses
    describeWorld_world,

    -- * Destructuring the Response
    DescribeWorldResponse (..),
    newDescribeWorldResponse,

    -- * Response Lenses
    describeWorldResponse_arn,
    describeWorldResponse_createdAt,
    describeWorldResponse_generationJob,
    describeWorldResponse_tags,
    describeWorldResponse_template,
    describeWorldResponse_worldDescriptionBody,
    describeWorldResponse_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:/ 'newDescribeWorld' smart constructor.
data DescribeWorld = DescribeWorld'
  { -- | The Amazon Resource Name (arn) of the world you want to describe.
    DescribeWorld -> Text
world :: Prelude.Text
  }
  deriving (DescribeWorld -> DescribeWorld -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeWorld -> DescribeWorld -> Bool
$c/= :: DescribeWorld -> DescribeWorld -> Bool
== :: DescribeWorld -> DescribeWorld -> Bool
$c== :: DescribeWorld -> DescribeWorld -> Bool
Prelude.Eq, ReadPrec [DescribeWorld]
ReadPrec DescribeWorld
Int -> ReadS DescribeWorld
ReadS [DescribeWorld]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeWorld]
$creadListPrec :: ReadPrec [DescribeWorld]
readPrec :: ReadPrec DescribeWorld
$creadPrec :: ReadPrec DescribeWorld
readList :: ReadS [DescribeWorld]
$creadList :: ReadS [DescribeWorld]
readsPrec :: Int -> ReadS DescribeWorld
$creadsPrec :: Int -> ReadS DescribeWorld
Prelude.Read, Int -> DescribeWorld -> ShowS
[DescribeWorld] -> ShowS
DescribeWorld -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeWorld] -> ShowS
$cshowList :: [DescribeWorld] -> ShowS
show :: DescribeWorld -> String
$cshow :: DescribeWorld -> String
showsPrec :: Int -> DescribeWorld -> ShowS
$cshowsPrec :: Int -> DescribeWorld -> ShowS
Prelude.Show, forall x. Rep DescribeWorld x -> DescribeWorld
forall x. DescribeWorld -> Rep DescribeWorld x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DescribeWorld x -> DescribeWorld
$cfrom :: forall x. DescribeWorld -> Rep DescribeWorld x
Prelude.Generic)

-- |
-- Create a value of 'DescribeWorld' 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:
--
-- 'world', 'describeWorld_world' - The Amazon Resource Name (arn) of the world you want to describe.
newDescribeWorld ::
  -- | 'world'
  Prelude.Text ->
  DescribeWorld
newDescribeWorld :: Text -> DescribeWorld
newDescribeWorld Text
pWorld_ =
  DescribeWorld' {$sel:world:DescribeWorld' :: Text
world = Text
pWorld_}

-- | The Amazon Resource Name (arn) of the world you want to describe.
describeWorld_world :: Lens.Lens' DescribeWorld Prelude.Text
describeWorld_world :: Lens' DescribeWorld Text
describeWorld_world = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeWorld' {Text
world :: Text
$sel:world:DescribeWorld' :: DescribeWorld -> Text
world} -> Text
world) (\s :: DescribeWorld
s@DescribeWorld' {} Text
a -> DescribeWorld
s {$sel:world:DescribeWorld' :: Text
world = Text
a} :: DescribeWorld)

instance Core.AWSRequest DescribeWorld where
  type
    AWSResponse DescribeWorld =
      DescribeWorldResponse
  request :: (Service -> Service) -> DescribeWorld -> Request DescribeWorld
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 DescribeWorld
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse DescribeWorld)))
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
-> Maybe (HashMap Text Text)
-> Maybe Text
-> Maybe Text
-> Int
-> DescribeWorldResponse
DescribeWorldResponse'
            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
"generationJob")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"tags" forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty)
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"template")
            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
"worldDescriptionBody")
            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 DescribeWorld where
  hashWithSalt :: Int -> DescribeWorld -> Int
hashWithSalt Int
_salt DescribeWorld' {Text
world :: Text
$sel:world:DescribeWorld' :: DescribeWorld -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
world

instance Prelude.NFData DescribeWorld where
  rnf :: DescribeWorld -> ()
rnf DescribeWorld' {Text
world :: Text
$sel:world:DescribeWorld' :: DescribeWorld -> Text
..} = forall a. NFData a => a -> ()
Prelude.rnf Text
world

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

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

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

-- | /See:/ 'newDescribeWorldResponse' smart constructor.
data DescribeWorldResponse = DescribeWorldResponse'
  { -- | The Amazon Resource Name (arn) of the world.
    DescribeWorldResponse -> Maybe Text
arn :: Prelude.Maybe Prelude.Text,
    -- | The time, in milliseconds since the epoch, when the world was created.
    DescribeWorldResponse -> Maybe POSIX
createdAt :: Prelude.Maybe Data.POSIX,
    -- | The Amazon Resource Name (arn) of the world generation job that
    -- generated the world.
    DescribeWorldResponse -> Maybe Text
generationJob :: Prelude.Maybe Prelude.Text,
    -- | A map that contains tag keys and tag values that are attached to the
    -- world.
    DescribeWorldResponse -> Maybe (HashMap Text Text)
tags :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | The world template.
    DescribeWorldResponse -> Maybe Text
template :: Prelude.Maybe Prelude.Text,
    -- | Returns the JSON formatted string that describes the contents of your
    -- world.
    DescribeWorldResponse -> Maybe Text
worldDescriptionBody :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    DescribeWorldResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (DescribeWorldResponse -> DescribeWorldResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeWorldResponse -> DescribeWorldResponse -> Bool
$c/= :: DescribeWorldResponse -> DescribeWorldResponse -> Bool
== :: DescribeWorldResponse -> DescribeWorldResponse -> Bool
$c== :: DescribeWorldResponse -> DescribeWorldResponse -> Bool
Prelude.Eq, ReadPrec [DescribeWorldResponse]
ReadPrec DescribeWorldResponse
Int -> ReadS DescribeWorldResponse
ReadS [DescribeWorldResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeWorldResponse]
$creadListPrec :: ReadPrec [DescribeWorldResponse]
readPrec :: ReadPrec DescribeWorldResponse
$creadPrec :: ReadPrec DescribeWorldResponse
readList :: ReadS [DescribeWorldResponse]
$creadList :: ReadS [DescribeWorldResponse]
readsPrec :: Int -> ReadS DescribeWorldResponse
$creadsPrec :: Int -> ReadS DescribeWorldResponse
Prelude.Read, Int -> DescribeWorldResponse -> ShowS
[DescribeWorldResponse] -> ShowS
DescribeWorldResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeWorldResponse] -> ShowS
$cshowList :: [DescribeWorldResponse] -> ShowS
show :: DescribeWorldResponse -> String
$cshow :: DescribeWorldResponse -> String
showsPrec :: Int -> DescribeWorldResponse -> ShowS
$cshowsPrec :: Int -> DescribeWorldResponse -> ShowS
Prelude.Show, forall x. Rep DescribeWorldResponse x -> DescribeWorldResponse
forall x. DescribeWorldResponse -> Rep DescribeWorldResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DescribeWorldResponse x -> DescribeWorldResponse
$cfrom :: forall x. DescribeWorldResponse -> Rep DescribeWorldResponse x
Prelude.Generic)

-- |
-- Create a value of 'DescribeWorldResponse' 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', 'describeWorldResponse_arn' - The Amazon Resource Name (arn) of the world.
--
-- 'createdAt', 'describeWorldResponse_createdAt' - The time, in milliseconds since the epoch, when the world was created.
--
-- 'generationJob', 'describeWorldResponse_generationJob' - The Amazon Resource Name (arn) of the world generation job that
-- generated the world.
--
-- 'tags', 'describeWorldResponse_tags' - A map that contains tag keys and tag values that are attached to the
-- world.
--
-- 'template', 'describeWorldResponse_template' - The world template.
--
-- 'worldDescriptionBody', 'describeWorldResponse_worldDescriptionBody' - Returns the JSON formatted string that describes the contents of your
-- world.
--
-- 'httpStatus', 'describeWorldResponse_httpStatus' - The response's http status code.
newDescribeWorldResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DescribeWorldResponse
newDescribeWorldResponse :: Int -> DescribeWorldResponse
newDescribeWorldResponse Int
pHttpStatus_ =
  DescribeWorldResponse'
    { $sel:arn:DescribeWorldResponse' :: Maybe Text
arn = forall a. Maybe a
Prelude.Nothing,
      $sel:createdAt:DescribeWorldResponse' :: Maybe POSIX
createdAt = forall a. Maybe a
Prelude.Nothing,
      $sel:generationJob:DescribeWorldResponse' :: Maybe Text
generationJob = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:DescribeWorldResponse' :: Maybe (HashMap Text Text)
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:template:DescribeWorldResponse' :: Maybe Text
template = forall a. Maybe a
Prelude.Nothing,
      $sel:worldDescriptionBody:DescribeWorldResponse' :: Maybe Text
worldDescriptionBody = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:DescribeWorldResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

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

-- | The time, in milliseconds since the epoch, when the world was created.
describeWorldResponse_createdAt :: Lens.Lens' DescribeWorldResponse (Prelude.Maybe Prelude.UTCTime)
describeWorldResponse_createdAt :: Lens' DescribeWorldResponse (Maybe UTCTime)
describeWorldResponse_createdAt = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeWorldResponse' {Maybe POSIX
createdAt :: Maybe POSIX
$sel:createdAt:DescribeWorldResponse' :: DescribeWorldResponse -> Maybe POSIX
createdAt} -> Maybe POSIX
createdAt) (\s :: DescribeWorldResponse
s@DescribeWorldResponse' {} Maybe POSIX
a -> DescribeWorldResponse
s {$sel:createdAt:DescribeWorldResponse' :: Maybe POSIX
createdAt = Maybe POSIX
a} :: DescribeWorldResponse) 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 Amazon Resource Name (arn) of the world generation job that
-- generated the world.
describeWorldResponse_generationJob :: Lens.Lens' DescribeWorldResponse (Prelude.Maybe Prelude.Text)
describeWorldResponse_generationJob :: Lens' DescribeWorldResponse (Maybe Text)
describeWorldResponse_generationJob = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeWorldResponse' {Maybe Text
generationJob :: Maybe Text
$sel:generationJob:DescribeWorldResponse' :: DescribeWorldResponse -> Maybe Text
generationJob} -> Maybe Text
generationJob) (\s :: DescribeWorldResponse
s@DescribeWorldResponse' {} Maybe Text
a -> DescribeWorldResponse
s {$sel:generationJob:DescribeWorldResponse' :: Maybe Text
generationJob = Maybe Text
a} :: DescribeWorldResponse)

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

-- | Returns the JSON formatted string that describes the contents of your
-- world.
describeWorldResponse_worldDescriptionBody :: Lens.Lens' DescribeWorldResponse (Prelude.Maybe Prelude.Text)
describeWorldResponse_worldDescriptionBody :: Lens' DescribeWorldResponse (Maybe Text)
describeWorldResponse_worldDescriptionBody = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeWorldResponse' {Maybe Text
worldDescriptionBody :: Maybe Text
$sel:worldDescriptionBody:DescribeWorldResponse' :: DescribeWorldResponse -> Maybe Text
worldDescriptionBody} -> Maybe Text
worldDescriptionBody) (\s :: DescribeWorldResponse
s@DescribeWorldResponse' {} Maybe Text
a -> DescribeWorldResponse
s {$sel:worldDescriptionBody:DescribeWorldResponse' :: Maybe Text
worldDescriptionBody = Maybe Text
a} :: DescribeWorldResponse)

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

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