{-# 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.CloudFormation.GetTemplate
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Returns the template body for a specified stack. You can get the
-- template for running or deleted stacks.
--
-- For deleted stacks, @GetTemplate@ returns the template for up to 90 days
-- after the stack has been deleted.
--
-- If the template doesn\'t exist, a @ValidationError@ is returned.
module Amazonka.CloudFormation.GetTemplate
  ( -- * Creating a Request
    GetTemplate (..),
    newGetTemplate,

    -- * Request Lenses
    getTemplate_changeSetName,
    getTemplate_stackName,
    getTemplate_templateStage,

    -- * Destructuring the Response
    GetTemplateResponse (..),
    newGetTemplateResponse,

    -- * Response Lenses
    getTemplateResponse_stagesAvailable,
    getTemplateResponse_templateBody,
    getTemplateResponse_httpStatus,
  )
where

import Amazonka.CloudFormation.Types
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

-- | The input for a GetTemplate action.
--
-- /See:/ 'newGetTemplate' smart constructor.
data GetTemplate = GetTemplate'
  { -- | The name or Amazon Resource Name (ARN) of a change set for which
    -- CloudFormation returns the associated template. If you specify a name,
    -- you must also specify the @StackName@.
    GetTemplate -> Maybe Text
changeSetName :: Prelude.Maybe Prelude.Text,
    -- | The name or the unique stack ID that\'s associated with the stack, which
    -- aren\'t always interchangeable:
    --
    -- -   Running stacks: You can specify either the stack\'s name or its
    --     unique stack ID.
    --
    -- -   Deleted stacks: You must specify the unique stack ID.
    --
    -- Default: There is no default value.
    GetTemplate -> Maybe Text
stackName :: Prelude.Maybe Prelude.Text,
    -- | For templates that include transforms, the stage of the template that
    -- CloudFormation returns. To get the user-submitted template, specify
    -- @Original@. To get the template after CloudFormation has processed all
    -- transforms, specify @Processed@.
    --
    -- If the template doesn\'t include transforms, @Original@ and @Processed@
    -- return the same template. By default, CloudFormation specifies
    -- @Processed@.
    GetTemplate -> Maybe TemplateStage
templateStage :: Prelude.Maybe TemplateStage
  }
  deriving (GetTemplate -> GetTemplate -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetTemplate -> GetTemplate -> Bool
$c/= :: GetTemplate -> GetTemplate -> Bool
== :: GetTemplate -> GetTemplate -> Bool
$c== :: GetTemplate -> GetTemplate -> Bool
Prelude.Eq, ReadPrec [GetTemplate]
ReadPrec GetTemplate
Int -> ReadS GetTemplate
ReadS [GetTemplate]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetTemplate]
$creadListPrec :: ReadPrec [GetTemplate]
readPrec :: ReadPrec GetTemplate
$creadPrec :: ReadPrec GetTemplate
readList :: ReadS [GetTemplate]
$creadList :: ReadS [GetTemplate]
readsPrec :: Int -> ReadS GetTemplate
$creadsPrec :: Int -> ReadS GetTemplate
Prelude.Read, Int -> GetTemplate -> ShowS
[GetTemplate] -> ShowS
GetTemplate -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetTemplate] -> ShowS
$cshowList :: [GetTemplate] -> ShowS
show :: GetTemplate -> String
$cshow :: GetTemplate -> String
showsPrec :: Int -> GetTemplate -> ShowS
$cshowsPrec :: Int -> GetTemplate -> ShowS
Prelude.Show, forall x. Rep GetTemplate x -> GetTemplate
forall x. GetTemplate -> Rep GetTemplate x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetTemplate x -> GetTemplate
$cfrom :: forall x. GetTemplate -> Rep GetTemplate x
Prelude.Generic)

-- |
-- Create a value of 'GetTemplate' 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:
--
-- 'changeSetName', 'getTemplate_changeSetName' - The name or Amazon Resource Name (ARN) of a change set for which
-- CloudFormation returns the associated template. If you specify a name,
-- you must also specify the @StackName@.
--
-- 'stackName', 'getTemplate_stackName' - The name or the unique stack ID that\'s associated with the stack, which
-- aren\'t always interchangeable:
--
-- -   Running stacks: You can specify either the stack\'s name or its
--     unique stack ID.
--
-- -   Deleted stacks: You must specify the unique stack ID.
--
-- Default: There is no default value.
--
-- 'templateStage', 'getTemplate_templateStage' - For templates that include transforms, the stage of the template that
-- CloudFormation returns. To get the user-submitted template, specify
-- @Original@. To get the template after CloudFormation has processed all
-- transforms, specify @Processed@.
--
-- If the template doesn\'t include transforms, @Original@ and @Processed@
-- return the same template. By default, CloudFormation specifies
-- @Processed@.
newGetTemplate ::
  GetTemplate
newGetTemplate :: GetTemplate
newGetTemplate =
  GetTemplate'
    { $sel:changeSetName:GetTemplate' :: Maybe Text
changeSetName = forall a. Maybe a
Prelude.Nothing,
      $sel:stackName:GetTemplate' :: Maybe Text
stackName = forall a. Maybe a
Prelude.Nothing,
      $sel:templateStage:GetTemplate' :: Maybe TemplateStage
templateStage = forall a. Maybe a
Prelude.Nothing
    }

-- | The name or Amazon Resource Name (ARN) of a change set for which
-- CloudFormation returns the associated template. If you specify a name,
-- you must also specify the @StackName@.
getTemplate_changeSetName :: Lens.Lens' GetTemplate (Prelude.Maybe Prelude.Text)
getTemplate_changeSetName :: Lens' GetTemplate (Maybe Text)
getTemplate_changeSetName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetTemplate' {Maybe Text
changeSetName :: Maybe Text
$sel:changeSetName:GetTemplate' :: GetTemplate -> Maybe Text
changeSetName} -> Maybe Text
changeSetName) (\s :: GetTemplate
s@GetTemplate' {} Maybe Text
a -> GetTemplate
s {$sel:changeSetName:GetTemplate' :: Maybe Text
changeSetName = Maybe Text
a} :: GetTemplate)

-- | The name or the unique stack ID that\'s associated with the stack, which
-- aren\'t always interchangeable:
--
-- -   Running stacks: You can specify either the stack\'s name or its
--     unique stack ID.
--
-- -   Deleted stacks: You must specify the unique stack ID.
--
-- Default: There is no default value.
getTemplate_stackName :: Lens.Lens' GetTemplate (Prelude.Maybe Prelude.Text)
getTemplate_stackName :: Lens' GetTemplate (Maybe Text)
getTemplate_stackName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetTemplate' {Maybe Text
stackName :: Maybe Text
$sel:stackName:GetTemplate' :: GetTemplate -> Maybe Text
stackName} -> Maybe Text
stackName) (\s :: GetTemplate
s@GetTemplate' {} Maybe Text
a -> GetTemplate
s {$sel:stackName:GetTemplate' :: Maybe Text
stackName = Maybe Text
a} :: GetTemplate)

-- | For templates that include transforms, the stage of the template that
-- CloudFormation returns. To get the user-submitted template, specify
-- @Original@. To get the template after CloudFormation has processed all
-- transforms, specify @Processed@.
--
-- If the template doesn\'t include transforms, @Original@ and @Processed@
-- return the same template. By default, CloudFormation specifies
-- @Processed@.
getTemplate_templateStage :: Lens.Lens' GetTemplate (Prelude.Maybe TemplateStage)
getTemplate_templateStage :: Lens' GetTemplate (Maybe TemplateStage)
getTemplate_templateStage = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetTemplate' {Maybe TemplateStage
templateStage :: Maybe TemplateStage
$sel:templateStage:GetTemplate' :: GetTemplate -> Maybe TemplateStage
templateStage} -> Maybe TemplateStage
templateStage) (\s :: GetTemplate
s@GetTemplate' {} Maybe TemplateStage
a -> GetTemplate
s {$sel:templateStage:GetTemplate' :: Maybe TemplateStage
templateStage = Maybe TemplateStage
a} :: GetTemplate)

instance Core.AWSRequest GetTemplate where
  type AWSResponse GetTemplate = GetTemplateResponse
  request :: (Service -> Service) -> GetTemplate -> Request GetTemplate
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.postQuery (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy GetTemplate
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse GetTemplate)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
Text
-> (Int
    -> ResponseHeaders -> [Node] -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveXMLWrapper
      Text
"GetTemplateResult"
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Maybe [TemplateStage] -> Maybe Text -> Int -> GetTemplateResponse
GetTemplateResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> ( [Node]
x
                            forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"StagesAvailable"
                            forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty
                            forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
Prelude.>>= forall (f :: * -> *) a b.
Applicative f =>
([a] -> f b) -> [a] -> f (Maybe b)
Core.may (forall a. FromXML a => Text -> [Node] -> Either String [a]
Data.parseXMLList Text
"member")
                        )
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"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 GetTemplate where
  hashWithSalt :: Int -> GetTemplate -> Int
hashWithSalt Int
_salt GetTemplate' {Maybe Text
Maybe TemplateStage
templateStage :: Maybe TemplateStage
stackName :: Maybe Text
changeSetName :: Maybe Text
$sel:templateStage:GetTemplate' :: GetTemplate -> Maybe TemplateStage
$sel:stackName:GetTemplate' :: GetTemplate -> Maybe Text
$sel:changeSetName:GetTemplate' :: GetTemplate -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
changeSetName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
stackName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe TemplateStage
templateStage

instance Prelude.NFData GetTemplate where
  rnf :: GetTemplate -> ()
rnf GetTemplate' {Maybe Text
Maybe TemplateStage
templateStage :: Maybe TemplateStage
stackName :: Maybe Text
changeSetName :: Maybe Text
$sel:templateStage:GetTemplate' :: GetTemplate -> Maybe TemplateStage
$sel:stackName:GetTemplate' :: GetTemplate -> Maybe Text
$sel:changeSetName:GetTemplate' :: GetTemplate -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
changeSetName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
stackName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe TemplateStage
templateStage

instance Data.ToHeaders GetTemplate where
  toHeaders :: GetTemplate -> ResponseHeaders
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

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

instance Data.ToQuery GetTemplate where
  toQuery :: GetTemplate -> QueryString
toQuery GetTemplate' {Maybe Text
Maybe TemplateStage
templateStage :: Maybe TemplateStage
stackName :: Maybe Text
changeSetName :: Maybe Text
$sel:templateStage:GetTemplate' :: GetTemplate -> Maybe TemplateStage
$sel:stackName:GetTemplate' :: GetTemplate -> Maybe Text
$sel:changeSetName:GetTemplate' :: GetTemplate -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"GetTemplate" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2010-05-15" :: Prelude.ByteString),
        ByteString
"ChangeSetName" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
changeSetName,
        ByteString
"StackName" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
stackName,
        ByteString
"TemplateStage" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe TemplateStage
templateStage
      ]

-- | The output for GetTemplate action.
--
-- /See:/ 'newGetTemplateResponse' smart constructor.
data GetTemplateResponse = GetTemplateResponse'
  { -- | The stage of the template that you can retrieve. For stacks, the
    -- @Original@ and @Processed@ templates are always available. For change
    -- sets, the @Original@ template is always available. After CloudFormation
    -- finishes creating the change set, the @Processed@ template becomes
    -- available.
    GetTemplateResponse -> Maybe [TemplateStage]
stagesAvailable :: Prelude.Maybe [TemplateStage],
    -- | Structure containing the template body. (For more information, go to
    -- <https://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/template-anatomy.html Template Anatomy>
    -- in the CloudFormation User Guide.)
    --
    -- CloudFormation returns the same template that was used when the stack
    -- was created.
    GetTemplateResponse -> Maybe Text
templateBody :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    GetTemplateResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetTemplateResponse -> GetTemplateResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetTemplateResponse -> GetTemplateResponse -> Bool
$c/= :: GetTemplateResponse -> GetTemplateResponse -> Bool
== :: GetTemplateResponse -> GetTemplateResponse -> Bool
$c== :: GetTemplateResponse -> GetTemplateResponse -> Bool
Prelude.Eq, ReadPrec [GetTemplateResponse]
ReadPrec GetTemplateResponse
Int -> ReadS GetTemplateResponse
ReadS [GetTemplateResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetTemplateResponse]
$creadListPrec :: ReadPrec [GetTemplateResponse]
readPrec :: ReadPrec GetTemplateResponse
$creadPrec :: ReadPrec GetTemplateResponse
readList :: ReadS [GetTemplateResponse]
$creadList :: ReadS [GetTemplateResponse]
readsPrec :: Int -> ReadS GetTemplateResponse
$creadsPrec :: Int -> ReadS GetTemplateResponse
Prelude.Read, Int -> GetTemplateResponse -> ShowS
[GetTemplateResponse] -> ShowS
GetTemplateResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetTemplateResponse] -> ShowS
$cshowList :: [GetTemplateResponse] -> ShowS
show :: GetTemplateResponse -> String
$cshow :: GetTemplateResponse -> String
showsPrec :: Int -> GetTemplateResponse -> ShowS
$cshowsPrec :: Int -> GetTemplateResponse -> ShowS
Prelude.Show, forall x. Rep GetTemplateResponse x -> GetTemplateResponse
forall x. GetTemplateResponse -> Rep GetTemplateResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetTemplateResponse x -> GetTemplateResponse
$cfrom :: forall x. GetTemplateResponse -> Rep GetTemplateResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetTemplateResponse' 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:
--
-- 'stagesAvailable', 'getTemplateResponse_stagesAvailable' - The stage of the template that you can retrieve. For stacks, the
-- @Original@ and @Processed@ templates are always available. For change
-- sets, the @Original@ template is always available. After CloudFormation
-- finishes creating the change set, the @Processed@ template becomes
-- available.
--
-- 'templateBody', 'getTemplateResponse_templateBody' - Structure containing the template body. (For more information, go to
-- <https://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/template-anatomy.html Template Anatomy>
-- in the CloudFormation User Guide.)
--
-- CloudFormation returns the same template that was used when the stack
-- was created.
--
-- 'httpStatus', 'getTemplateResponse_httpStatus' - The response's http status code.
newGetTemplateResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetTemplateResponse
newGetTemplateResponse :: Int -> GetTemplateResponse
newGetTemplateResponse Int
pHttpStatus_ =
  GetTemplateResponse'
    { $sel:stagesAvailable:GetTemplateResponse' :: Maybe [TemplateStage]
stagesAvailable =
        forall a. Maybe a
Prelude.Nothing,
      $sel:templateBody:GetTemplateResponse' :: Maybe Text
templateBody = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetTemplateResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The stage of the template that you can retrieve. For stacks, the
-- @Original@ and @Processed@ templates are always available. For change
-- sets, the @Original@ template is always available. After CloudFormation
-- finishes creating the change set, the @Processed@ template becomes
-- available.
getTemplateResponse_stagesAvailable :: Lens.Lens' GetTemplateResponse (Prelude.Maybe [TemplateStage])
getTemplateResponse_stagesAvailable :: Lens' GetTemplateResponse (Maybe [TemplateStage])
getTemplateResponse_stagesAvailable = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetTemplateResponse' {Maybe [TemplateStage]
stagesAvailable :: Maybe [TemplateStage]
$sel:stagesAvailable:GetTemplateResponse' :: GetTemplateResponse -> Maybe [TemplateStage]
stagesAvailable} -> Maybe [TemplateStage]
stagesAvailable) (\s :: GetTemplateResponse
s@GetTemplateResponse' {} Maybe [TemplateStage]
a -> GetTemplateResponse
s {$sel:stagesAvailable:GetTemplateResponse' :: Maybe [TemplateStage]
stagesAvailable = Maybe [TemplateStage]
a} :: GetTemplateResponse) 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

-- | Structure containing the template body. (For more information, go to
-- <https://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/template-anatomy.html Template Anatomy>
-- in the CloudFormation User Guide.)
--
-- CloudFormation returns the same template that was used when the stack
-- was created.
getTemplateResponse_templateBody :: Lens.Lens' GetTemplateResponse (Prelude.Maybe Prelude.Text)
getTemplateResponse_templateBody :: Lens' GetTemplateResponse (Maybe Text)
getTemplateResponse_templateBody = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetTemplateResponse' {Maybe Text
templateBody :: Maybe Text
$sel:templateBody:GetTemplateResponse' :: GetTemplateResponse -> Maybe Text
templateBody} -> Maybe Text
templateBody) (\s :: GetTemplateResponse
s@GetTemplateResponse' {} Maybe Text
a -> GetTemplateResponse
s {$sel:templateBody:GetTemplateResponse' :: Maybe Text
templateBody = Maybe Text
a} :: GetTemplateResponse)

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

instance Prelude.NFData GetTemplateResponse where
  rnf :: GetTemplateResponse -> ()
rnf GetTemplateResponse' {Int
Maybe [TemplateStage]
Maybe Text
httpStatus :: Int
templateBody :: Maybe Text
stagesAvailable :: Maybe [TemplateStage]
$sel:httpStatus:GetTemplateResponse' :: GetTemplateResponse -> Int
$sel:templateBody:GetTemplateResponse' :: GetTemplateResponse -> Maybe Text
$sel:stagesAvailable:GetTemplateResponse' :: GetTemplateResponse -> Maybe [TemplateStage]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [TemplateStage]
stagesAvailable
      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 Int
httpStatus