{-# 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.ValidateTemplate
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Validates a specified template. CloudFormation first checks if the
-- template is valid JSON. If it isn\'t, CloudFormation checks if the
-- template is valid YAML. If both these checks fail, CloudFormation
-- returns a template validation error.
module Amazonka.CloudFormation.ValidateTemplate
  ( -- * Creating a Request
    ValidateTemplate (..),
    newValidateTemplate,

    -- * Request Lenses
    validateTemplate_templateBody,
    validateTemplate_templateURL,

    -- * Destructuring the Response
    ValidateTemplateResponse (..),
    newValidateTemplateResponse,

    -- * Response Lenses
    validateTemplateResponse_capabilities,
    validateTemplateResponse_capabilitiesReason,
    validateTemplateResponse_declaredTransforms,
    validateTemplateResponse_description,
    validateTemplateResponse_parameters,
    validateTemplateResponse_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 ValidateTemplate action.
--
-- /See:/ 'newValidateTemplate' smart constructor.
data ValidateTemplate = ValidateTemplate'
  { -- | Structure containing the template body with a minimum length of 1 byte
    -- and a maximum length of 51,200 bytes. For more information, go to
    -- <https://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/template-anatomy.html Template Anatomy>
    -- in the CloudFormation User Guide.
    --
    -- Conditional: You must pass @TemplateURL@ or @TemplateBody@. If both are
    -- passed, only @TemplateBody@ is used.
    ValidateTemplate -> Maybe Text
templateBody :: Prelude.Maybe Prelude.Text,
    -- | Location of file containing the template body. The URL must point to a
    -- template (max size: 460,800 bytes) that is located in an Amazon S3
    -- bucket or a Systems Manager document. For more information, go to
    -- <https://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/template-anatomy.html Template Anatomy>
    -- in the CloudFormation User Guide.
    --
    -- Conditional: You must pass @TemplateURL@ or @TemplateBody@. If both are
    -- passed, only @TemplateBody@ is used.
    ValidateTemplate -> Maybe Text
templateURL :: Prelude.Maybe Prelude.Text
  }
  deriving (ValidateTemplate -> ValidateTemplate -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ValidateTemplate -> ValidateTemplate -> Bool
$c/= :: ValidateTemplate -> ValidateTemplate -> Bool
== :: ValidateTemplate -> ValidateTemplate -> Bool
$c== :: ValidateTemplate -> ValidateTemplate -> Bool
Prelude.Eq, ReadPrec [ValidateTemplate]
ReadPrec ValidateTemplate
Int -> ReadS ValidateTemplate
ReadS [ValidateTemplate]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ValidateTemplate]
$creadListPrec :: ReadPrec [ValidateTemplate]
readPrec :: ReadPrec ValidateTemplate
$creadPrec :: ReadPrec ValidateTemplate
readList :: ReadS [ValidateTemplate]
$creadList :: ReadS [ValidateTemplate]
readsPrec :: Int -> ReadS ValidateTemplate
$creadsPrec :: Int -> ReadS ValidateTemplate
Prelude.Read, Int -> ValidateTemplate -> ShowS
[ValidateTemplate] -> ShowS
ValidateTemplate -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ValidateTemplate] -> ShowS
$cshowList :: [ValidateTemplate] -> ShowS
show :: ValidateTemplate -> String
$cshow :: ValidateTemplate -> String
showsPrec :: Int -> ValidateTemplate -> ShowS
$cshowsPrec :: Int -> ValidateTemplate -> ShowS
Prelude.Show, forall x. Rep ValidateTemplate x -> ValidateTemplate
forall x. ValidateTemplate -> Rep ValidateTemplate x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ValidateTemplate x -> ValidateTemplate
$cfrom :: forall x. ValidateTemplate -> Rep ValidateTemplate x
Prelude.Generic)

-- |
-- Create a value of 'ValidateTemplate' 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', 'validateTemplate_templateBody' - Structure containing the template body with a minimum length of 1 byte
-- and a maximum length of 51,200 bytes. For more information, go to
-- <https://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/template-anatomy.html Template Anatomy>
-- in the CloudFormation User Guide.
--
-- Conditional: You must pass @TemplateURL@ or @TemplateBody@. If both are
-- passed, only @TemplateBody@ is used.
--
-- 'templateURL', 'validateTemplate_templateURL' - Location of file containing the template body. The URL must point to a
-- template (max size: 460,800 bytes) that is located in an Amazon S3
-- bucket or a Systems Manager document. For more information, go to
-- <https://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/template-anatomy.html Template Anatomy>
-- in the CloudFormation User Guide.
--
-- Conditional: You must pass @TemplateURL@ or @TemplateBody@. If both are
-- passed, only @TemplateBody@ is used.
newValidateTemplate ::
  ValidateTemplate
newValidateTemplate :: ValidateTemplate
newValidateTemplate =
  ValidateTemplate'
    { $sel:templateBody:ValidateTemplate' :: Maybe Text
templateBody = forall a. Maybe a
Prelude.Nothing,
      $sel:templateURL:ValidateTemplate' :: Maybe Text
templateURL = forall a. Maybe a
Prelude.Nothing
    }

-- | Structure containing the template body with a minimum length of 1 byte
-- and a maximum length of 51,200 bytes. For more information, go to
-- <https://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/template-anatomy.html Template Anatomy>
-- in the CloudFormation User Guide.
--
-- Conditional: You must pass @TemplateURL@ or @TemplateBody@. If both are
-- passed, only @TemplateBody@ is used.
validateTemplate_templateBody :: Lens.Lens' ValidateTemplate (Prelude.Maybe Prelude.Text)
validateTemplate_templateBody :: Lens' ValidateTemplate (Maybe Text)
validateTemplate_templateBody = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ValidateTemplate' {Maybe Text
templateBody :: Maybe Text
$sel:templateBody:ValidateTemplate' :: ValidateTemplate -> Maybe Text
templateBody} -> Maybe Text
templateBody) (\s :: ValidateTemplate
s@ValidateTemplate' {} Maybe Text
a -> ValidateTemplate
s {$sel:templateBody:ValidateTemplate' :: Maybe Text
templateBody = Maybe Text
a} :: ValidateTemplate)

-- | Location of file containing the template body. The URL must point to a
-- template (max size: 460,800 bytes) that is located in an Amazon S3
-- bucket or a Systems Manager document. For more information, go to
-- <https://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/template-anatomy.html Template Anatomy>
-- in the CloudFormation User Guide.
--
-- Conditional: You must pass @TemplateURL@ or @TemplateBody@. If both are
-- passed, only @TemplateBody@ is used.
validateTemplate_templateURL :: Lens.Lens' ValidateTemplate (Prelude.Maybe Prelude.Text)
validateTemplate_templateURL :: Lens' ValidateTemplate (Maybe Text)
validateTemplate_templateURL = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ValidateTemplate' {Maybe Text
templateURL :: Maybe Text
$sel:templateURL:ValidateTemplate' :: ValidateTemplate -> Maybe Text
templateURL} -> Maybe Text
templateURL) (\s :: ValidateTemplate
s@ValidateTemplate' {} Maybe Text
a -> ValidateTemplate
s {$sel:templateURL:ValidateTemplate' :: Maybe Text
templateURL = Maybe Text
a} :: ValidateTemplate)

instance Core.AWSRequest ValidateTemplate where
  type
    AWSResponse ValidateTemplate =
      ValidateTemplateResponse
  request :: (Service -> Service)
-> ValidateTemplate -> Request ValidateTemplate
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 ValidateTemplate
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse ValidateTemplate)))
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
"ValidateTemplateResult"
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Maybe [Capability]
-> Maybe Text
-> Maybe [Text]
-> Maybe Text
-> Maybe [TemplateParameter]
-> Int
-> ValidateTemplateResponse
ValidateTemplateResponse'
            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
"Capabilities"
                            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
"CapabilitiesReason")
            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
"DeclaredTransforms"
                            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
"Description")
            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
"Parameters"
                            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.<*> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
      )

instance Prelude.Hashable ValidateTemplate where
  hashWithSalt :: Int -> ValidateTemplate -> Int
hashWithSalt Int
_salt ValidateTemplate' {Maybe Text
templateURL :: Maybe Text
templateBody :: Maybe Text
$sel:templateURL:ValidateTemplate' :: ValidateTemplate -> Maybe Text
$sel:templateBody:ValidateTemplate' :: ValidateTemplate -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
templateBody
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
templateURL

instance Prelude.NFData ValidateTemplate where
  rnf :: ValidateTemplate -> ()
rnf ValidateTemplate' {Maybe Text
templateURL :: Maybe Text
templateBody :: Maybe Text
$sel:templateURL:ValidateTemplate' :: ValidateTemplate -> Maybe Text
$sel:templateBody:ValidateTemplate' :: ValidateTemplate -> 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 Maybe Text
templateURL

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

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

instance Data.ToQuery ValidateTemplate where
  toQuery :: ValidateTemplate -> QueryString
toQuery ValidateTemplate' {Maybe Text
templateURL :: Maybe Text
templateBody :: Maybe Text
$sel:templateURL:ValidateTemplate' :: ValidateTemplate -> Maybe Text
$sel:templateBody:ValidateTemplate' :: ValidateTemplate -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"ValidateTemplate" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2010-05-15" :: Prelude.ByteString),
        ByteString
"TemplateBody" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
templateBody,
        ByteString
"TemplateURL" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
templateURL
      ]

-- | The output for ValidateTemplate action.
--
-- /See:/ 'newValidateTemplateResponse' smart constructor.
data ValidateTemplateResponse = ValidateTemplateResponse'
  { -- | The capabilities found within the template. If your template contains
    -- IAM resources, you must specify the CAPABILITY_IAM or
    -- CAPABILITY_NAMED_IAM value for this parameter when you use the
    -- CreateStack or UpdateStack actions with your template; otherwise, those
    -- actions return an InsufficientCapabilities error.
    --
    -- For more information, see
    -- <https://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/using-iam-template.html#capabilities Acknowledging IAM Resources in CloudFormation Templates>.
    ValidateTemplateResponse -> Maybe [Capability]
capabilities :: Prelude.Maybe [Capability],
    -- | The list of resources that generated the values in the @Capabilities@
    -- response element.
    ValidateTemplateResponse -> Maybe Text
capabilitiesReason :: Prelude.Maybe Prelude.Text,
    -- | A list of the transforms that are declared in the template.
    ValidateTemplateResponse -> Maybe [Text]
declaredTransforms :: Prelude.Maybe [Prelude.Text],
    -- | The description found within the template.
    ValidateTemplateResponse -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | A list of @TemplateParameter@ structures.
    ValidateTemplateResponse -> Maybe [TemplateParameter]
parameters :: Prelude.Maybe [TemplateParameter],
    -- | The response's http status code.
    ValidateTemplateResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ValidateTemplateResponse -> ValidateTemplateResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ValidateTemplateResponse -> ValidateTemplateResponse -> Bool
$c/= :: ValidateTemplateResponse -> ValidateTemplateResponse -> Bool
== :: ValidateTemplateResponse -> ValidateTemplateResponse -> Bool
$c== :: ValidateTemplateResponse -> ValidateTemplateResponse -> Bool
Prelude.Eq, ReadPrec [ValidateTemplateResponse]
ReadPrec ValidateTemplateResponse
Int -> ReadS ValidateTemplateResponse
ReadS [ValidateTemplateResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ValidateTemplateResponse]
$creadListPrec :: ReadPrec [ValidateTemplateResponse]
readPrec :: ReadPrec ValidateTemplateResponse
$creadPrec :: ReadPrec ValidateTemplateResponse
readList :: ReadS [ValidateTemplateResponse]
$creadList :: ReadS [ValidateTemplateResponse]
readsPrec :: Int -> ReadS ValidateTemplateResponse
$creadsPrec :: Int -> ReadS ValidateTemplateResponse
Prelude.Read, Int -> ValidateTemplateResponse -> ShowS
[ValidateTemplateResponse] -> ShowS
ValidateTemplateResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ValidateTemplateResponse] -> ShowS
$cshowList :: [ValidateTemplateResponse] -> ShowS
show :: ValidateTemplateResponse -> String
$cshow :: ValidateTemplateResponse -> String
showsPrec :: Int -> ValidateTemplateResponse -> ShowS
$cshowsPrec :: Int -> ValidateTemplateResponse -> ShowS
Prelude.Show, forall x.
Rep ValidateTemplateResponse x -> ValidateTemplateResponse
forall x.
ValidateTemplateResponse -> Rep ValidateTemplateResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ValidateTemplateResponse x -> ValidateTemplateResponse
$cfrom :: forall x.
ValidateTemplateResponse -> Rep ValidateTemplateResponse x
Prelude.Generic)

-- |
-- Create a value of 'ValidateTemplateResponse' 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:
--
-- 'capabilities', 'validateTemplateResponse_capabilities' - The capabilities found within the template. If your template contains
-- IAM resources, you must specify the CAPABILITY_IAM or
-- CAPABILITY_NAMED_IAM value for this parameter when you use the
-- CreateStack or UpdateStack actions with your template; otherwise, those
-- actions return an InsufficientCapabilities error.
--
-- For more information, see
-- <https://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/using-iam-template.html#capabilities Acknowledging IAM Resources in CloudFormation Templates>.
--
-- 'capabilitiesReason', 'validateTemplateResponse_capabilitiesReason' - The list of resources that generated the values in the @Capabilities@
-- response element.
--
-- 'declaredTransforms', 'validateTemplateResponse_declaredTransforms' - A list of the transforms that are declared in the template.
--
-- 'description', 'validateTemplateResponse_description' - The description found within the template.
--
-- 'parameters', 'validateTemplateResponse_parameters' - A list of @TemplateParameter@ structures.
--
-- 'httpStatus', 'validateTemplateResponse_httpStatus' - The response's http status code.
newValidateTemplateResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ValidateTemplateResponse
newValidateTemplateResponse :: Int -> ValidateTemplateResponse
newValidateTemplateResponse Int
pHttpStatus_ =
  ValidateTemplateResponse'
    { $sel:capabilities:ValidateTemplateResponse' :: Maybe [Capability]
capabilities =
        forall a. Maybe a
Prelude.Nothing,
      $sel:capabilitiesReason:ValidateTemplateResponse' :: Maybe Text
capabilitiesReason = forall a. Maybe a
Prelude.Nothing,
      $sel:declaredTransforms:ValidateTemplateResponse' :: Maybe [Text]
declaredTransforms = forall a. Maybe a
Prelude.Nothing,
      $sel:description:ValidateTemplateResponse' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:parameters:ValidateTemplateResponse' :: Maybe [TemplateParameter]
parameters = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ValidateTemplateResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The capabilities found within the template. If your template contains
-- IAM resources, you must specify the CAPABILITY_IAM or
-- CAPABILITY_NAMED_IAM value for this parameter when you use the
-- CreateStack or UpdateStack actions with your template; otherwise, those
-- actions return an InsufficientCapabilities error.
--
-- For more information, see
-- <https://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/using-iam-template.html#capabilities Acknowledging IAM Resources in CloudFormation Templates>.
validateTemplateResponse_capabilities :: Lens.Lens' ValidateTemplateResponse (Prelude.Maybe [Capability])
validateTemplateResponse_capabilities :: Lens' ValidateTemplateResponse (Maybe [Capability])
validateTemplateResponse_capabilities = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ValidateTemplateResponse' {Maybe [Capability]
capabilities :: Maybe [Capability]
$sel:capabilities:ValidateTemplateResponse' :: ValidateTemplateResponse -> Maybe [Capability]
capabilities} -> Maybe [Capability]
capabilities) (\s :: ValidateTemplateResponse
s@ValidateTemplateResponse' {} Maybe [Capability]
a -> ValidateTemplateResponse
s {$sel:capabilities:ValidateTemplateResponse' :: Maybe [Capability]
capabilities = Maybe [Capability]
a} :: ValidateTemplateResponse) 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 list of resources that generated the values in the @Capabilities@
-- response element.
validateTemplateResponse_capabilitiesReason :: Lens.Lens' ValidateTemplateResponse (Prelude.Maybe Prelude.Text)
validateTemplateResponse_capabilitiesReason :: Lens' ValidateTemplateResponse (Maybe Text)
validateTemplateResponse_capabilitiesReason = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ValidateTemplateResponse' {Maybe Text
capabilitiesReason :: Maybe Text
$sel:capabilitiesReason:ValidateTemplateResponse' :: ValidateTemplateResponse -> Maybe Text
capabilitiesReason} -> Maybe Text
capabilitiesReason) (\s :: ValidateTemplateResponse
s@ValidateTemplateResponse' {} Maybe Text
a -> ValidateTemplateResponse
s {$sel:capabilitiesReason:ValidateTemplateResponse' :: Maybe Text
capabilitiesReason = Maybe Text
a} :: ValidateTemplateResponse)

-- | A list of the transforms that are declared in the template.
validateTemplateResponse_declaredTransforms :: Lens.Lens' ValidateTemplateResponse (Prelude.Maybe [Prelude.Text])
validateTemplateResponse_declaredTransforms :: Lens' ValidateTemplateResponse (Maybe [Text])
validateTemplateResponse_declaredTransforms = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ValidateTemplateResponse' {Maybe [Text]
declaredTransforms :: Maybe [Text]
$sel:declaredTransforms:ValidateTemplateResponse' :: ValidateTemplateResponse -> Maybe [Text]
declaredTransforms} -> Maybe [Text]
declaredTransforms) (\s :: ValidateTemplateResponse
s@ValidateTemplateResponse' {} Maybe [Text]
a -> ValidateTemplateResponse
s {$sel:declaredTransforms:ValidateTemplateResponse' :: Maybe [Text]
declaredTransforms = Maybe [Text]
a} :: ValidateTemplateResponse) 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 description found within the template.
validateTemplateResponse_description :: Lens.Lens' ValidateTemplateResponse (Prelude.Maybe Prelude.Text)
validateTemplateResponse_description :: Lens' ValidateTemplateResponse (Maybe Text)
validateTemplateResponse_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ValidateTemplateResponse' {Maybe Text
description :: Maybe Text
$sel:description:ValidateTemplateResponse' :: ValidateTemplateResponse -> Maybe Text
description} -> Maybe Text
description) (\s :: ValidateTemplateResponse
s@ValidateTemplateResponse' {} Maybe Text
a -> ValidateTemplateResponse
s {$sel:description:ValidateTemplateResponse' :: Maybe Text
description = Maybe Text
a} :: ValidateTemplateResponse)

-- | A list of @TemplateParameter@ structures.
validateTemplateResponse_parameters :: Lens.Lens' ValidateTemplateResponse (Prelude.Maybe [TemplateParameter])
validateTemplateResponse_parameters :: Lens' ValidateTemplateResponse (Maybe [TemplateParameter])
validateTemplateResponse_parameters = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ValidateTemplateResponse' {Maybe [TemplateParameter]
parameters :: Maybe [TemplateParameter]
$sel:parameters:ValidateTemplateResponse' :: ValidateTemplateResponse -> Maybe [TemplateParameter]
parameters} -> Maybe [TemplateParameter]
parameters) (\s :: ValidateTemplateResponse
s@ValidateTemplateResponse' {} Maybe [TemplateParameter]
a -> ValidateTemplateResponse
s {$sel:parameters:ValidateTemplateResponse' :: Maybe [TemplateParameter]
parameters = Maybe [TemplateParameter]
a} :: ValidateTemplateResponse) 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.
validateTemplateResponse_httpStatus :: Lens.Lens' ValidateTemplateResponse Prelude.Int
validateTemplateResponse_httpStatus :: Lens' ValidateTemplateResponse Int
validateTemplateResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ValidateTemplateResponse' {Int
httpStatus :: Int
$sel:httpStatus:ValidateTemplateResponse' :: ValidateTemplateResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: ValidateTemplateResponse
s@ValidateTemplateResponse' {} Int
a -> ValidateTemplateResponse
s {$sel:httpStatus:ValidateTemplateResponse' :: Int
httpStatus = Int
a} :: ValidateTemplateResponse)

instance Prelude.NFData ValidateTemplateResponse where
  rnf :: ValidateTemplateResponse -> ()
rnf ValidateTemplateResponse' {Int
Maybe [Text]
Maybe [Capability]
Maybe [TemplateParameter]
Maybe Text
httpStatus :: Int
parameters :: Maybe [TemplateParameter]
description :: Maybe Text
declaredTransforms :: Maybe [Text]
capabilitiesReason :: Maybe Text
capabilities :: Maybe [Capability]
$sel:httpStatus:ValidateTemplateResponse' :: ValidateTemplateResponse -> Int
$sel:parameters:ValidateTemplateResponse' :: ValidateTemplateResponse -> Maybe [TemplateParameter]
$sel:description:ValidateTemplateResponse' :: ValidateTemplateResponse -> Maybe Text
$sel:declaredTransforms:ValidateTemplateResponse' :: ValidateTemplateResponse -> Maybe [Text]
$sel:capabilitiesReason:ValidateTemplateResponse' :: ValidateTemplateResponse -> Maybe Text
$sel:capabilities:ValidateTemplateResponse' :: ValidateTemplateResponse -> Maybe [Capability]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [Capability]
capabilities
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
capabilitiesReason
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
declaredTransforms
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
description
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [TemplateParameter]
parameters
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus