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

    -- * Request Lenses
    getWorldTemplateBody_generationJob,
    getWorldTemplateBody_template,

    -- * Destructuring the Response
    GetWorldTemplateBodyResponse (..),
    newGetWorldTemplateBodyResponse,

    -- * Response Lenses
    getWorldTemplateBodyResponse_templateBody,
    getWorldTemplateBodyResponse_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:/ 'newGetWorldTemplateBody' smart constructor.
data GetWorldTemplateBody = GetWorldTemplateBody'
  { -- | The Amazon Resource Name (arn) of the world generator job.
    GetWorldTemplateBody -> Maybe Text
generationJob :: Prelude.Maybe Prelude.Text,
    -- | The Amazon Resource Name (arn) of the world template.
    GetWorldTemplateBody -> Maybe Text
template :: Prelude.Maybe Prelude.Text
  }
  deriving (GetWorldTemplateBody -> GetWorldTemplateBody -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetWorldTemplateBody -> GetWorldTemplateBody -> Bool
$c/= :: GetWorldTemplateBody -> GetWorldTemplateBody -> Bool
== :: GetWorldTemplateBody -> GetWorldTemplateBody -> Bool
$c== :: GetWorldTemplateBody -> GetWorldTemplateBody -> Bool
Prelude.Eq, ReadPrec [GetWorldTemplateBody]
ReadPrec GetWorldTemplateBody
Int -> ReadS GetWorldTemplateBody
ReadS [GetWorldTemplateBody]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetWorldTemplateBody]
$creadListPrec :: ReadPrec [GetWorldTemplateBody]
readPrec :: ReadPrec GetWorldTemplateBody
$creadPrec :: ReadPrec GetWorldTemplateBody
readList :: ReadS [GetWorldTemplateBody]
$creadList :: ReadS [GetWorldTemplateBody]
readsPrec :: Int -> ReadS GetWorldTemplateBody
$creadsPrec :: Int -> ReadS GetWorldTemplateBody
Prelude.Read, Int -> GetWorldTemplateBody -> ShowS
[GetWorldTemplateBody] -> ShowS
GetWorldTemplateBody -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetWorldTemplateBody] -> ShowS
$cshowList :: [GetWorldTemplateBody] -> ShowS
show :: GetWorldTemplateBody -> String
$cshow :: GetWorldTemplateBody -> String
showsPrec :: Int -> GetWorldTemplateBody -> ShowS
$cshowsPrec :: Int -> GetWorldTemplateBody -> ShowS
Prelude.Show, forall x. Rep GetWorldTemplateBody x -> GetWorldTemplateBody
forall x. GetWorldTemplateBody -> Rep GetWorldTemplateBody x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetWorldTemplateBody x -> GetWorldTemplateBody
$cfrom :: forall x. GetWorldTemplateBody -> Rep GetWorldTemplateBody x
Prelude.Generic)

-- |
-- Create a value of 'GetWorldTemplateBody' 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:
--
-- 'generationJob', 'getWorldTemplateBody_generationJob' - The Amazon Resource Name (arn) of the world generator job.
--
-- 'template', 'getWorldTemplateBody_template' - The Amazon Resource Name (arn) of the world template.
newGetWorldTemplateBody ::
  GetWorldTemplateBody
newGetWorldTemplateBody :: GetWorldTemplateBody
newGetWorldTemplateBody =
  GetWorldTemplateBody'
    { $sel:generationJob:GetWorldTemplateBody' :: Maybe Text
generationJob =
        forall a. Maybe a
Prelude.Nothing,
      $sel:template:GetWorldTemplateBody' :: Maybe Text
template = forall a. Maybe a
Prelude.Nothing
    }

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

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

instance Core.AWSRequest GetWorldTemplateBody where
  type
    AWSResponse GetWorldTemplateBody =
      GetWorldTemplateBodyResponse
  request :: (Service -> Service)
-> GetWorldTemplateBody -> Request GetWorldTemplateBody
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 GetWorldTemplateBody
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse GetWorldTemplateBody)))
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 -> Int -> GetWorldTemplateBodyResponse
GetWorldTemplateBodyResponse'
            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
"templateBody")
            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 GetWorldTemplateBody where
  hashWithSalt :: Int -> GetWorldTemplateBody -> Int
hashWithSalt Int
_salt GetWorldTemplateBody' {Maybe Text
template :: Maybe Text
generationJob :: Maybe Text
$sel:template:GetWorldTemplateBody' :: GetWorldTemplateBody -> Maybe Text
$sel:generationJob:GetWorldTemplateBody' :: GetWorldTemplateBody -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
generationJob
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
template

instance Prelude.NFData GetWorldTemplateBody where
  rnf :: GetWorldTemplateBody -> ()
rnf GetWorldTemplateBody' {Maybe Text
template :: Maybe Text
generationJob :: Maybe Text
$sel:template:GetWorldTemplateBody' :: GetWorldTemplateBody -> Maybe Text
$sel:generationJob:GetWorldTemplateBody' :: GetWorldTemplateBody -> Maybe Text
..} =
    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 Text
template

instance Data.ToHeaders GetWorldTemplateBody where
  toHeaders :: GetWorldTemplateBody -> 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 GetWorldTemplateBody where
  toJSON :: GetWorldTemplateBody -> Value
toJSON GetWorldTemplateBody' {Maybe Text
template :: Maybe Text
generationJob :: Maybe Text
$sel:template:GetWorldTemplateBody' :: GetWorldTemplateBody -> Maybe Text
$sel:generationJob:GetWorldTemplateBody' :: GetWorldTemplateBody -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"generationJob" 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
generationJob,
            (Key
"template" 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
template
          ]
      )

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

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

-- | /See:/ 'newGetWorldTemplateBodyResponse' smart constructor.
data GetWorldTemplateBodyResponse = GetWorldTemplateBodyResponse'
  { -- | The world template body.
    GetWorldTemplateBodyResponse -> Maybe Text
templateBody :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    GetWorldTemplateBodyResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetWorldTemplateBodyResponse
-> GetWorldTemplateBodyResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetWorldTemplateBodyResponse
-> GetWorldTemplateBodyResponse -> Bool
$c/= :: GetWorldTemplateBodyResponse
-> GetWorldTemplateBodyResponse -> Bool
== :: GetWorldTemplateBodyResponse
-> GetWorldTemplateBodyResponse -> Bool
$c== :: GetWorldTemplateBodyResponse
-> GetWorldTemplateBodyResponse -> Bool
Prelude.Eq, ReadPrec [GetWorldTemplateBodyResponse]
ReadPrec GetWorldTemplateBodyResponse
Int -> ReadS GetWorldTemplateBodyResponse
ReadS [GetWorldTemplateBodyResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetWorldTemplateBodyResponse]
$creadListPrec :: ReadPrec [GetWorldTemplateBodyResponse]
readPrec :: ReadPrec GetWorldTemplateBodyResponse
$creadPrec :: ReadPrec GetWorldTemplateBodyResponse
readList :: ReadS [GetWorldTemplateBodyResponse]
$creadList :: ReadS [GetWorldTemplateBodyResponse]
readsPrec :: Int -> ReadS GetWorldTemplateBodyResponse
$creadsPrec :: Int -> ReadS GetWorldTemplateBodyResponse
Prelude.Read, Int -> GetWorldTemplateBodyResponse -> ShowS
[GetWorldTemplateBodyResponse] -> ShowS
GetWorldTemplateBodyResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetWorldTemplateBodyResponse] -> ShowS
$cshowList :: [GetWorldTemplateBodyResponse] -> ShowS
show :: GetWorldTemplateBodyResponse -> String
$cshow :: GetWorldTemplateBodyResponse -> String
showsPrec :: Int -> GetWorldTemplateBodyResponse -> ShowS
$cshowsPrec :: Int -> GetWorldTemplateBodyResponse -> ShowS
Prelude.Show, forall x.
Rep GetWorldTemplateBodyResponse x -> GetWorldTemplateBodyResponse
forall x.
GetWorldTemplateBodyResponse -> Rep GetWorldTemplateBodyResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetWorldTemplateBodyResponse x -> GetWorldTemplateBodyResponse
$cfrom :: forall x.
GetWorldTemplateBodyResponse -> Rep GetWorldTemplateBodyResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetWorldTemplateBodyResponse' 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:
--
-- 'templateBody', 'getWorldTemplateBodyResponse_templateBody' - The world template body.
--
-- 'httpStatus', 'getWorldTemplateBodyResponse_httpStatus' - The response's http status code.
newGetWorldTemplateBodyResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetWorldTemplateBodyResponse
newGetWorldTemplateBodyResponse :: Int -> GetWorldTemplateBodyResponse
newGetWorldTemplateBodyResponse Int
pHttpStatus_ =
  GetWorldTemplateBodyResponse'
    { $sel:templateBody:GetWorldTemplateBodyResponse' :: Maybe Text
templateBody =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetWorldTemplateBodyResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

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

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

instance Prelude.NFData GetWorldTemplateBodyResponse where
  rnf :: GetWorldTemplateBodyResponse -> ()
rnf GetWorldTemplateBodyResponse' {Int
Maybe Text
httpStatus :: Int
templateBody :: Maybe Text
$sel:httpStatus:GetWorldTemplateBodyResponse' :: GetWorldTemplateBodyResponse -> Int
$sel:templateBody:GetWorldTemplateBodyResponse' :: GetWorldTemplateBodyResponse -> Maybe Text
..} =
    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 Int
httpStatus