{-# 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.DescribeStackResources
-- 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 Amazon Web Services resource descriptions for running and
-- deleted stacks. If @StackName@ is specified, all the associated
-- resources that are part of the stack are returned. If
-- @PhysicalResourceId@ is specified, the associated resources of the stack
-- that the resource belongs to are returned.
--
-- Only the first 100 resources will be returned. If your stack has more
-- resources than this, you should use @ListStackResources@ instead.
--
-- For deleted stacks, @DescribeStackResources@ returns resource
-- information for up to 90 days after the stack has been deleted.
--
-- You must specify either @StackName@ or @PhysicalResourceId@, but not
-- both. In addition, you can specify @LogicalResourceId@ to filter the
-- returned result. For more information about resources, the
-- @LogicalResourceId@ and @PhysicalResourceId@, go to the
-- <https://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/ CloudFormation User Guide>.
--
-- A @ValidationError@ is returned if you specify both @StackName@ and
-- @PhysicalResourceId@ in the same request.
module Amazonka.CloudFormation.DescribeStackResources
  ( -- * Creating a Request
    DescribeStackResources (..),
    newDescribeStackResources,

    -- * Request Lenses
    describeStackResources_logicalResourceId,
    describeStackResources_physicalResourceId,
    describeStackResources_stackName,

    -- * Destructuring the Response
    DescribeStackResourcesResponse (..),
    newDescribeStackResourcesResponse,

    -- * Response Lenses
    describeStackResourcesResponse_stackResources,
    describeStackResourcesResponse_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 DescribeStackResources action.
--
-- /See:/ 'newDescribeStackResources' smart constructor.
data DescribeStackResources = DescribeStackResources'
  { -- | The logical name of the resource as specified in the template.
    --
    -- Default: There is no default value.
    DescribeStackResources -> Maybe Text
logicalResourceId :: Prelude.Maybe Prelude.Text,
    -- | The name or unique identifier that corresponds to a physical instance ID
    -- of a resource supported by CloudFormation.
    --
    -- For example, for an Amazon Elastic Compute Cloud (EC2) instance,
    -- @PhysicalResourceId@ corresponds to the @InstanceId@. You can pass the
    -- EC2 @InstanceId@ to @DescribeStackResources@ to find which stack the
    -- instance belongs to and what other resources are part of the stack.
    --
    -- Required: Conditional. If you don\'t specify @PhysicalResourceId@, you
    -- must specify @StackName@.
    --
    -- Default: There is no default value.
    DescribeStackResources -> Maybe Text
physicalResourceId :: Prelude.Maybe Prelude.Text,
    -- | The name or the unique stack ID that is 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.
    --
    -- Required: Conditional. If you don\'t specify @StackName@, you must
    -- specify @PhysicalResourceId@.
    DescribeStackResources -> Maybe Text
stackName :: Prelude.Maybe Prelude.Text
  }
  deriving (DescribeStackResources -> DescribeStackResources -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeStackResources -> DescribeStackResources -> Bool
$c/= :: DescribeStackResources -> DescribeStackResources -> Bool
== :: DescribeStackResources -> DescribeStackResources -> Bool
$c== :: DescribeStackResources -> DescribeStackResources -> Bool
Prelude.Eq, ReadPrec [DescribeStackResources]
ReadPrec DescribeStackResources
Int -> ReadS DescribeStackResources
ReadS [DescribeStackResources]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeStackResources]
$creadListPrec :: ReadPrec [DescribeStackResources]
readPrec :: ReadPrec DescribeStackResources
$creadPrec :: ReadPrec DescribeStackResources
readList :: ReadS [DescribeStackResources]
$creadList :: ReadS [DescribeStackResources]
readsPrec :: Int -> ReadS DescribeStackResources
$creadsPrec :: Int -> ReadS DescribeStackResources
Prelude.Read, Int -> DescribeStackResources -> ShowS
[DescribeStackResources] -> ShowS
DescribeStackResources -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeStackResources] -> ShowS
$cshowList :: [DescribeStackResources] -> ShowS
show :: DescribeStackResources -> String
$cshow :: DescribeStackResources -> String
showsPrec :: Int -> DescribeStackResources -> ShowS
$cshowsPrec :: Int -> DescribeStackResources -> ShowS
Prelude.Show, forall x. Rep DescribeStackResources x -> DescribeStackResources
forall x. DescribeStackResources -> Rep DescribeStackResources x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DescribeStackResources x -> DescribeStackResources
$cfrom :: forall x. DescribeStackResources -> Rep DescribeStackResources x
Prelude.Generic)

-- |
-- Create a value of 'DescribeStackResources' 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:
--
-- 'logicalResourceId', 'describeStackResources_logicalResourceId' - The logical name of the resource as specified in the template.
--
-- Default: There is no default value.
--
-- 'physicalResourceId', 'describeStackResources_physicalResourceId' - The name or unique identifier that corresponds to a physical instance ID
-- of a resource supported by CloudFormation.
--
-- For example, for an Amazon Elastic Compute Cloud (EC2) instance,
-- @PhysicalResourceId@ corresponds to the @InstanceId@. You can pass the
-- EC2 @InstanceId@ to @DescribeStackResources@ to find which stack the
-- instance belongs to and what other resources are part of the stack.
--
-- Required: Conditional. If you don\'t specify @PhysicalResourceId@, you
-- must specify @StackName@.
--
-- Default: There is no default value.
--
-- 'stackName', 'describeStackResources_stackName' - The name or the unique stack ID that is 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.
--
-- Required: Conditional. If you don\'t specify @StackName@, you must
-- specify @PhysicalResourceId@.
newDescribeStackResources ::
  DescribeStackResources
newDescribeStackResources :: DescribeStackResources
newDescribeStackResources =
  DescribeStackResources'
    { $sel:logicalResourceId:DescribeStackResources' :: Maybe Text
logicalResourceId =
        forall a. Maybe a
Prelude.Nothing,
      $sel:physicalResourceId:DescribeStackResources' :: Maybe Text
physicalResourceId = forall a. Maybe a
Prelude.Nothing,
      $sel:stackName:DescribeStackResources' :: Maybe Text
stackName = forall a. Maybe a
Prelude.Nothing
    }

-- | The logical name of the resource as specified in the template.
--
-- Default: There is no default value.
describeStackResources_logicalResourceId :: Lens.Lens' DescribeStackResources (Prelude.Maybe Prelude.Text)
describeStackResources_logicalResourceId :: Lens' DescribeStackResources (Maybe Text)
describeStackResources_logicalResourceId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeStackResources' {Maybe Text
logicalResourceId :: Maybe Text
$sel:logicalResourceId:DescribeStackResources' :: DescribeStackResources -> Maybe Text
logicalResourceId} -> Maybe Text
logicalResourceId) (\s :: DescribeStackResources
s@DescribeStackResources' {} Maybe Text
a -> DescribeStackResources
s {$sel:logicalResourceId:DescribeStackResources' :: Maybe Text
logicalResourceId = Maybe Text
a} :: DescribeStackResources)

-- | The name or unique identifier that corresponds to a physical instance ID
-- of a resource supported by CloudFormation.
--
-- For example, for an Amazon Elastic Compute Cloud (EC2) instance,
-- @PhysicalResourceId@ corresponds to the @InstanceId@. You can pass the
-- EC2 @InstanceId@ to @DescribeStackResources@ to find which stack the
-- instance belongs to and what other resources are part of the stack.
--
-- Required: Conditional. If you don\'t specify @PhysicalResourceId@, you
-- must specify @StackName@.
--
-- Default: There is no default value.
describeStackResources_physicalResourceId :: Lens.Lens' DescribeStackResources (Prelude.Maybe Prelude.Text)
describeStackResources_physicalResourceId :: Lens' DescribeStackResources (Maybe Text)
describeStackResources_physicalResourceId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeStackResources' {Maybe Text
physicalResourceId :: Maybe Text
$sel:physicalResourceId:DescribeStackResources' :: DescribeStackResources -> Maybe Text
physicalResourceId} -> Maybe Text
physicalResourceId) (\s :: DescribeStackResources
s@DescribeStackResources' {} Maybe Text
a -> DescribeStackResources
s {$sel:physicalResourceId:DescribeStackResources' :: Maybe Text
physicalResourceId = Maybe Text
a} :: DescribeStackResources)

-- | The name or the unique stack ID that is 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.
--
-- Required: Conditional. If you don\'t specify @StackName@, you must
-- specify @PhysicalResourceId@.
describeStackResources_stackName :: Lens.Lens' DescribeStackResources (Prelude.Maybe Prelude.Text)
describeStackResources_stackName :: Lens' DescribeStackResources (Maybe Text)
describeStackResources_stackName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeStackResources' {Maybe Text
stackName :: Maybe Text
$sel:stackName:DescribeStackResources' :: DescribeStackResources -> Maybe Text
stackName} -> Maybe Text
stackName) (\s :: DescribeStackResources
s@DescribeStackResources' {} Maybe Text
a -> DescribeStackResources
s {$sel:stackName:DescribeStackResources' :: Maybe Text
stackName = Maybe Text
a} :: DescribeStackResources)

instance Core.AWSRequest DescribeStackResources where
  type
    AWSResponse DescribeStackResources =
      DescribeStackResourcesResponse
  request :: (Service -> Service)
-> DescribeStackResources -> Request DescribeStackResources
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 DescribeStackResources
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse DescribeStackResources)))
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
"DescribeStackResourcesResult"
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Maybe [StackResource] -> Int -> DescribeStackResourcesResponse
DescribeStackResourcesResponse'
            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
"StackResources"
                            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 DescribeStackResources where
  hashWithSalt :: Int -> DescribeStackResources -> Int
hashWithSalt Int
_salt DescribeStackResources' {Maybe Text
stackName :: Maybe Text
physicalResourceId :: Maybe Text
logicalResourceId :: Maybe Text
$sel:stackName:DescribeStackResources' :: DescribeStackResources -> Maybe Text
$sel:physicalResourceId:DescribeStackResources' :: DescribeStackResources -> Maybe Text
$sel:logicalResourceId:DescribeStackResources' :: DescribeStackResources -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
logicalResourceId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
physicalResourceId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
stackName

instance Prelude.NFData DescribeStackResources where
  rnf :: DescribeStackResources -> ()
rnf DescribeStackResources' {Maybe Text
stackName :: Maybe Text
physicalResourceId :: Maybe Text
logicalResourceId :: Maybe Text
$sel:stackName:DescribeStackResources' :: DescribeStackResources -> Maybe Text
$sel:physicalResourceId:DescribeStackResources' :: DescribeStackResources -> Maybe Text
$sel:logicalResourceId:DescribeStackResources' :: DescribeStackResources -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
logicalResourceId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
physicalResourceId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
stackName

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

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

instance Data.ToQuery DescribeStackResources where
  toQuery :: DescribeStackResources -> QueryString
toQuery DescribeStackResources' {Maybe Text
stackName :: Maybe Text
physicalResourceId :: Maybe Text
logicalResourceId :: Maybe Text
$sel:stackName:DescribeStackResources' :: DescribeStackResources -> Maybe Text
$sel:physicalResourceId:DescribeStackResources' :: DescribeStackResources -> Maybe Text
$sel:logicalResourceId:DescribeStackResources' :: DescribeStackResources -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"DescribeStackResources" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2010-05-15" :: Prelude.ByteString),
        ByteString
"LogicalResourceId" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
logicalResourceId,
        ByteString
"PhysicalResourceId" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
physicalResourceId,
        ByteString
"StackName" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
stackName
      ]

-- | The output for a DescribeStackResources action.
--
-- /See:/ 'newDescribeStackResourcesResponse' smart constructor.
data DescribeStackResourcesResponse = DescribeStackResourcesResponse'
  { -- | A list of @StackResource@ structures.
    DescribeStackResourcesResponse -> Maybe [StackResource]
stackResources :: Prelude.Maybe [StackResource],
    -- | The response's http status code.
    DescribeStackResourcesResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (DescribeStackResourcesResponse
-> DescribeStackResourcesResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeStackResourcesResponse
-> DescribeStackResourcesResponse -> Bool
$c/= :: DescribeStackResourcesResponse
-> DescribeStackResourcesResponse -> Bool
== :: DescribeStackResourcesResponse
-> DescribeStackResourcesResponse -> Bool
$c== :: DescribeStackResourcesResponse
-> DescribeStackResourcesResponse -> Bool
Prelude.Eq, ReadPrec [DescribeStackResourcesResponse]
ReadPrec DescribeStackResourcesResponse
Int -> ReadS DescribeStackResourcesResponse
ReadS [DescribeStackResourcesResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeStackResourcesResponse]
$creadListPrec :: ReadPrec [DescribeStackResourcesResponse]
readPrec :: ReadPrec DescribeStackResourcesResponse
$creadPrec :: ReadPrec DescribeStackResourcesResponse
readList :: ReadS [DescribeStackResourcesResponse]
$creadList :: ReadS [DescribeStackResourcesResponse]
readsPrec :: Int -> ReadS DescribeStackResourcesResponse
$creadsPrec :: Int -> ReadS DescribeStackResourcesResponse
Prelude.Read, Int -> DescribeStackResourcesResponse -> ShowS
[DescribeStackResourcesResponse] -> ShowS
DescribeStackResourcesResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeStackResourcesResponse] -> ShowS
$cshowList :: [DescribeStackResourcesResponse] -> ShowS
show :: DescribeStackResourcesResponse -> String
$cshow :: DescribeStackResourcesResponse -> String
showsPrec :: Int -> DescribeStackResourcesResponse -> ShowS
$cshowsPrec :: Int -> DescribeStackResourcesResponse -> ShowS
Prelude.Show, forall x.
Rep DescribeStackResourcesResponse x
-> DescribeStackResourcesResponse
forall x.
DescribeStackResourcesResponse
-> Rep DescribeStackResourcesResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DescribeStackResourcesResponse x
-> DescribeStackResourcesResponse
$cfrom :: forall x.
DescribeStackResourcesResponse
-> Rep DescribeStackResourcesResponse x
Prelude.Generic)

-- |
-- Create a value of 'DescribeStackResourcesResponse' 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:
--
-- 'stackResources', 'describeStackResourcesResponse_stackResources' - A list of @StackResource@ structures.
--
-- 'httpStatus', 'describeStackResourcesResponse_httpStatus' - The response's http status code.
newDescribeStackResourcesResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DescribeStackResourcesResponse
newDescribeStackResourcesResponse :: Int -> DescribeStackResourcesResponse
newDescribeStackResourcesResponse Int
pHttpStatus_ =
  DescribeStackResourcesResponse'
    { $sel:stackResources:DescribeStackResourcesResponse' :: Maybe [StackResource]
stackResources =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:DescribeStackResourcesResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | A list of @StackResource@ structures.
describeStackResourcesResponse_stackResources :: Lens.Lens' DescribeStackResourcesResponse (Prelude.Maybe [StackResource])
describeStackResourcesResponse_stackResources :: Lens' DescribeStackResourcesResponse (Maybe [StackResource])
describeStackResourcesResponse_stackResources = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeStackResourcesResponse' {Maybe [StackResource]
stackResources :: Maybe [StackResource]
$sel:stackResources:DescribeStackResourcesResponse' :: DescribeStackResourcesResponse -> Maybe [StackResource]
stackResources} -> Maybe [StackResource]
stackResources) (\s :: DescribeStackResourcesResponse
s@DescribeStackResourcesResponse' {} Maybe [StackResource]
a -> DescribeStackResourcesResponse
s {$sel:stackResources:DescribeStackResourcesResponse' :: Maybe [StackResource]
stackResources = Maybe [StackResource]
a} :: DescribeStackResourcesResponse) 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.
describeStackResourcesResponse_httpStatus :: Lens.Lens' DescribeStackResourcesResponse Prelude.Int
describeStackResourcesResponse_httpStatus :: Lens' DescribeStackResourcesResponse Int
describeStackResourcesResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeStackResourcesResponse' {Int
httpStatus :: Int
$sel:httpStatus:DescribeStackResourcesResponse' :: DescribeStackResourcesResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: DescribeStackResourcesResponse
s@DescribeStackResourcesResponse' {} Int
a -> DescribeStackResourcesResponse
s {$sel:httpStatus:DescribeStackResourcesResponse' :: Int
httpStatus = Int
a} :: DescribeStackResourcesResponse)

instance
  Prelude.NFData
    DescribeStackResourcesResponse
  where
  rnf :: DescribeStackResourcesResponse -> ()
rnf DescribeStackResourcesResponse' {Int
Maybe [StackResource]
httpStatus :: Int
stackResources :: Maybe [StackResource]
$sel:httpStatus:DescribeStackResourcesResponse' :: DescribeStackResourcesResponse -> Int
$sel:stackResources:DescribeStackResourcesResponse' :: DescribeStackResourcesResponse -> Maybe [StackResource]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [StackResource]
stackResources
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus