{-# 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.DescribeStackResourceDrifts
-- 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 drift information for the resources that have been checked for
-- drift in the specified stack. This includes actual and expected
-- configuration values for resources where CloudFormation detects
-- configuration drift.
--
-- For a given stack, there will be one @StackResourceDrift@ for each stack
-- resource that has been checked for drift. Resources that haven\'t yet
-- been checked for drift aren\'t included. Resources that don\'t currently
-- support drift detection aren\'t checked, and so not included. For a list
-- of resources that support drift detection, see
-- <https://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/using-cfn-stack-drift-resource-list.html Resources that Support Drift Detection>.
--
-- Use DetectStackResourceDrift to detect drift on individual resources, or
-- DetectStackDrift to detect drift on all supported resources for a given
-- stack.
module Amazonka.CloudFormation.DescribeStackResourceDrifts
  ( -- * Creating a Request
    DescribeStackResourceDrifts (..),
    newDescribeStackResourceDrifts,

    -- * Request Lenses
    describeStackResourceDrifts_maxResults,
    describeStackResourceDrifts_nextToken,
    describeStackResourceDrifts_stackResourceDriftStatusFilters,
    describeStackResourceDrifts_stackName,

    -- * Destructuring the Response
    DescribeStackResourceDriftsResponse (..),
    newDescribeStackResourceDriftsResponse,

    -- * Response Lenses
    describeStackResourceDriftsResponse_nextToken,
    describeStackResourceDriftsResponse_httpStatus,
    describeStackResourceDriftsResponse_stackResourceDrifts,
  )
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

-- | /See:/ 'newDescribeStackResourceDrifts' smart constructor.
data DescribeStackResourceDrifts = DescribeStackResourceDrifts'
  { -- | The maximum number of results to be returned with a single call. If the
    -- number of available results exceeds this maximum, the response includes
    -- a @NextToken@ value that you can assign to the @NextToken@ request
    -- parameter to get the next set of results.
    DescribeStackResourceDrifts -> Maybe Natural
maxResults :: Prelude.Maybe Prelude.Natural,
    -- | A string that identifies the next page of stack resource drift results.
    DescribeStackResourceDrifts -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The resource drift status values to use as filters for the resource
    -- drift results returned.
    --
    -- -   @DELETED@: The resource differs from its expected template
    --     configuration in that the resource has been deleted.
    --
    -- -   @MODIFIED@: One or more resource properties differ from their
    --     expected template values.
    --
    -- -   @IN_SYNC@: The resource\'s actual configuration matches its expected
    --     template configuration.
    --
    -- -   @NOT_CHECKED@: CloudFormation doesn\'t currently return this value.
    DescribeStackResourceDrifts
-> Maybe (NonEmpty StackResourceDriftStatus)
stackResourceDriftStatusFilters :: Prelude.Maybe (Prelude.NonEmpty StackResourceDriftStatus),
    -- | The name of the stack for which you want drift information.
    DescribeStackResourceDrifts -> Text
stackName :: Prelude.Text
  }
  deriving (DescribeStackResourceDrifts -> DescribeStackResourceDrifts -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeStackResourceDrifts -> DescribeStackResourceDrifts -> Bool
$c/= :: DescribeStackResourceDrifts -> DescribeStackResourceDrifts -> Bool
== :: DescribeStackResourceDrifts -> DescribeStackResourceDrifts -> Bool
$c== :: DescribeStackResourceDrifts -> DescribeStackResourceDrifts -> Bool
Prelude.Eq, ReadPrec [DescribeStackResourceDrifts]
ReadPrec DescribeStackResourceDrifts
Int -> ReadS DescribeStackResourceDrifts
ReadS [DescribeStackResourceDrifts]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeStackResourceDrifts]
$creadListPrec :: ReadPrec [DescribeStackResourceDrifts]
readPrec :: ReadPrec DescribeStackResourceDrifts
$creadPrec :: ReadPrec DescribeStackResourceDrifts
readList :: ReadS [DescribeStackResourceDrifts]
$creadList :: ReadS [DescribeStackResourceDrifts]
readsPrec :: Int -> ReadS DescribeStackResourceDrifts
$creadsPrec :: Int -> ReadS DescribeStackResourceDrifts
Prelude.Read, Int -> DescribeStackResourceDrifts -> ShowS
[DescribeStackResourceDrifts] -> ShowS
DescribeStackResourceDrifts -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeStackResourceDrifts] -> ShowS
$cshowList :: [DescribeStackResourceDrifts] -> ShowS
show :: DescribeStackResourceDrifts -> String
$cshow :: DescribeStackResourceDrifts -> String
showsPrec :: Int -> DescribeStackResourceDrifts -> ShowS
$cshowsPrec :: Int -> DescribeStackResourceDrifts -> ShowS
Prelude.Show, forall x.
Rep DescribeStackResourceDrifts x -> DescribeStackResourceDrifts
forall x.
DescribeStackResourceDrifts -> Rep DescribeStackResourceDrifts x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DescribeStackResourceDrifts x -> DescribeStackResourceDrifts
$cfrom :: forall x.
DescribeStackResourceDrifts -> Rep DescribeStackResourceDrifts x
Prelude.Generic)

-- |
-- Create a value of 'DescribeStackResourceDrifts' 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:
--
-- 'maxResults', 'describeStackResourceDrifts_maxResults' - The maximum number of results to be returned with a single call. If the
-- number of available results exceeds this maximum, the response includes
-- a @NextToken@ value that you can assign to the @NextToken@ request
-- parameter to get the next set of results.
--
-- 'nextToken', 'describeStackResourceDrifts_nextToken' - A string that identifies the next page of stack resource drift results.
--
-- 'stackResourceDriftStatusFilters', 'describeStackResourceDrifts_stackResourceDriftStatusFilters' - The resource drift status values to use as filters for the resource
-- drift results returned.
--
-- -   @DELETED@: The resource differs from its expected template
--     configuration in that the resource has been deleted.
--
-- -   @MODIFIED@: One or more resource properties differ from their
--     expected template values.
--
-- -   @IN_SYNC@: The resource\'s actual configuration matches its expected
--     template configuration.
--
-- -   @NOT_CHECKED@: CloudFormation doesn\'t currently return this value.
--
-- 'stackName', 'describeStackResourceDrifts_stackName' - The name of the stack for which you want drift information.
newDescribeStackResourceDrifts ::
  -- | 'stackName'
  Prelude.Text ->
  DescribeStackResourceDrifts
newDescribeStackResourceDrifts :: Text -> DescribeStackResourceDrifts
newDescribeStackResourceDrifts Text
pStackName_ =
  DescribeStackResourceDrifts'
    { $sel:maxResults:DescribeStackResourceDrifts' :: Maybe Natural
maxResults =
        forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:DescribeStackResourceDrifts' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:stackResourceDriftStatusFilters:DescribeStackResourceDrifts' :: Maybe (NonEmpty StackResourceDriftStatus)
stackResourceDriftStatusFilters =
        forall a. Maybe a
Prelude.Nothing,
      $sel:stackName:DescribeStackResourceDrifts' :: Text
stackName = Text
pStackName_
    }

-- | The maximum number of results to be returned with a single call. If the
-- number of available results exceeds this maximum, the response includes
-- a @NextToken@ value that you can assign to the @NextToken@ request
-- parameter to get the next set of results.
describeStackResourceDrifts_maxResults :: Lens.Lens' DescribeStackResourceDrifts (Prelude.Maybe Prelude.Natural)
describeStackResourceDrifts_maxResults :: Lens' DescribeStackResourceDrifts (Maybe Natural)
describeStackResourceDrifts_maxResults = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeStackResourceDrifts' {Maybe Natural
maxResults :: Maybe Natural
$sel:maxResults:DescribeStackResourceDrifts' :: DescribeStackResourceDrifts -> Maybe Natural
maxResults} -> Maybe Natural
maxResults) (\s :: DescribeStackResourceDrifts
s@DescribeStackResourceDrifts' {} Maybe Natural
a -> DescribeStackResourceDrifts
s {$sel:maxResults:DescribeStackResourceDrifts' :: Maybe Natural
maxResults = Maybe Natural
a} :: DescribeStackResourceDrifts)

-- | A string that identifies the next page of stack resource drift results.
describeStackResourceDrifts_nextToken :: Lens.Lens' DescribeStackResourceDrifts (Prelude.Maybe Prelude.Text)
describeStackResourceDrifts_nextToken :: Lens' DescribeStackResourceDrifts (Maybe Text)
describeStackResourceDrifts_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeStackResourceDrifts' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:DescribeStackResourceDrifts' :: DescribeStackResourceDrifts -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: DescribeStackResourceDrifts
s@DescribeStackResourceDrifts' {} Maybe Text
a -> DescribeStackResourceDrifts
s {$sel:nextToken:DescribeStackResourceDrifts' :: Maybe Text
nextToken = Maybe Text
a} :: DescribeStackResourceDrifts)

-- | The resource drift status values to use as filters for the resource
-- drift results returned.
--
-- -   @DELETED@: The resource differs from its expected template
--     configuration in that the resource has been deleted.
--
-- -   @MODIFIED@: One or more resource properties differ from their
--     expected template values.
--
-- -   @IN_SYNC@: The resource\'s actual configuration matches its expected
--     template configuration.
--
-- -   @NOT_CHECKED@: CloudFormation doesn\'t currently return this value.
describeStackResourceDrifts_stackResourceDriftStatusFilters :: Lens.Lens' DescribeStackResourceDrifts (Prelude.Maybe (Prelude.NonEmpty StackResourceDriftStatus))
describeStackResourceDrifts_stackResourceDriftStatusFilters :: Lens'
  DescribeStackResourceDrifts
  (Maybe (NonEmpty StackResourceDriftStatus))
describeStackResourceDrifts_stackResourceDriftStatusFilters = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeStackResourceDrifts' {Maybe (NonEmpty StackResourceDriftStatus)
stackResourceDriftStatusFilters :: Maybe (NonEmpty StackResourceDriftStatus)
$sel:stackResourceDriftStatusFilters:DescribeStackResourceDrifts' :: DescribeStackResourceDrifts
-> Maybe (NonEmpty StackResourceDriftStatus)
stackResourceDriftStatusFilters} -> Maybe (NonEmpty StackResourceDriftStatus)
stackResourceDriftStatusFilters) (\s :: DescribeStackResourceDrifts
s@DescribeStackResourceDrifts' {} Maybe (NonEmpty StackResourceDriftStatus)
a -> DescribeStackResourceDrifts
s {$sel:stackResourceDriftStatusFilters:DescribeStackResourceDrifts' :: Maybe (NonEmpty StackResourceDriftStatus)
stackResourceDriftStatusFilters = Maybe (NonEmpty StackResourceDriftStatus)
a} :: DescribeStackResourceDrifts) 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 name of the stack for which you want drift information.
describeStackResourceDrifts_stackName :: Lens.Lens' DescribeStackResourceDrifts Prelude.Text
describeStackResourceDrifts_stackName :: Lens' DescribeStackResourceDrifts Text
describeStackResourceDrifts_stackName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeStackResourceDrifts' {Text
stackName :: Text
$sel:stackName:DescribeStackResourceDrifts' :: DescribeStackResourceDrifts -> Text
stackName} -> Text
stackName) (\s :: DescribeStackResourceDrifts
s@DescribeStackResourceDrifts' {} Text
a -> DescribeStackResourceDrifts
s {$sel:stackName:DescribeStackResourceDrifts' :: Text
stackName = Text
a} :: DescribeStackResourceDrifts)

instance Core.AWSRequest DescribeStackResourceDrifts where
  type
    AWSResponse DescribeStackResourceDrifts =
      DescribeStackResourceDriftsResponse
  request :: (Service -> Service)
-> DescribeStackResourceDrifts
-> Request DescribeStackResourceDrifts
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 DescribeStackResourceDrifts
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse DescribeStackResourceDrifts)))
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
"DescribeStackResourceDriftsResult"
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Maybe Text
-> Int
-> [StackResourceDrift]
-> DescribeStackResourceDriftsResponse
DescribeStackResourceDriftsResponse'
            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
"NextToken")
            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))
            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
"StackResourceDrifts"
                            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 a. FromXML a => Text -> [Node] -> Either String [a]
Data.parseXMLList Text
"member"
                        )
      )

instance Prelude.Hashable DescribeStackResourceDrifts where
  hashWithSalt :: Int -> DescribeStackResourceDrifts -> Int
hashWithSalt Int
_salt DescribeStackResourceDrifts' {Maybe Natural
Maybe (NonEmpty StackResourceDriftStatus)
Maybe Text
Text
stackName :: Text
stackResourceDriftStatusFilters :: Maybe (NonEmpty StackResourceDriftStatus)
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:stackName:DescribeStackResourceDrifts' :: DescribeStackResourceDrifts -> Text
$sel:stackResourceDriftStatusFilters:DescribeStackResourceDrifts' :: DescribeStackResourceDrifts
-> Maybe (NonEmpty StackResourceDriftStatus)
$sel:nextToken:DescribeStackResourceDrifts' :: DescribeStackResourceDrifts -> Maybe Text
$sel:maxResults:DescribeStackResourceDrifts' :: DescribeStackResourceDrifts -> Maybe Natural
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
maxResults
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
nextToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (NonEmpty StackResourceDriftStatus)
stackResourceDriftStatusFilters
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
stackName

instance Prelude.NFData DescribeStackResourceDrifts where
  rnf :: DescribeStackResourceDrifts -> ()
rnf DescribeStackResourceDrifts' {Maybe Natural
Maybe (NonEmpty StackResourceDriftStatus)
Maybe Text
Text
stackName :: Text
stackResourceDriftStatusFilters :: Maybe (NonEmpty StackResourceDriftStatus)
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:stackName:DescribeStackResourceDrifts' :: DescribeStackResourceDrifts -> Text
$sel:stackResourceDriftStatusFilters:DescribeStackResourceDrifts' :: DescribeStackResourceDrifts
-> Maybe (NonEmpty StackResourceDriftStatus)
$sel:nextToken:DescribeStackResourceDrifts' :: DescribeStackResourceDrifts -> Maybe Text
$sel:maxResults:DescribeStackResourceDrifts' :: DescribeStackResourceDrifts -> Maybe Natural
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
maxResults
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
nextToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (NonEmpty StackResourceDriftStatus)
stackResourceDriftStatusFilters
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
stackName

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

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

instance Data.ToQuery DescribeStackResourceDrifts where
  toQuery :: DescribeStackResourceDrifts -> QueryString
toQuery DescribeStackResourceDrifts' {Maybe Natural
Maybe (NonEmpty StackResourceDriftStatus)
Maybe Text
Text
stackName :: Text
stackResourceDriftStatusFilters :: Maybe (NonEmpty StackResourceDriftStatus)
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:stackName:DescribeStackResourceDrifts' :: DescribeStackResourceDrifts -> Text
$sel:stackResourceDriftStatusFilters:DescribeStackResourceDrifts' :: DescribeStackResourceDrifts
-> Maybe (NonEmpty StackResourceDriftStatus)
$sel:nextToken:DescribeStackResourceDrifts' :: DescribeStackResourceDrifts -> Maybe Text
$sel:maxResults:DescribeStackResourceDrifts' :: DescribeStackResourceDrifts -> Maybe Natural
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: ( ByteString
"DescribeStackResourceDrifts" ::
                      Prelude.ByteString
                  ),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2010-05-15" :: Prelude.ByteString),
        ByteString
"MaxResults" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Natural
maxResults,
        ByteString
"NextToken" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
nextToken,
        ByteString
"StackResourceDriftStatusFilters"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: forall a. ToQuery a => a -> QueryString
Data.toQuery
            ( forall a.
(IsList a, ToQuery (Item a)) =>
ByteString -> a -> QueryString
Data.toQueryList ByteString
"member"
                forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe (NonEmpty StackResourceDriftStatus)
stackResourceDriftStatusFilters
            ),
        ByteString
"StackName" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
stackName
      ]

-- | /See:/ 'newDescribeStackResourceDriftsResponse' smart constructor.
data DescribeStackResourceDriftsResponse = DescribeStackResourceDriftsResponse'
  { -- | If the request doesn\'t return all the remaining results, @NextToken@ is
    -- set to a token. To retrieve the next set of results, call
    -- @DescribeStackResourceDrifts@ again and assign that token to the request
    -- object\'s @NextToken@ parameter. If the request returns all results,
    -- @NextToken@ is set to @null@.
    DescribeStackResourceDriftsResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    DescribeStackResourceDriftsResponse -> Int
httpStatus :: Prelude.Int,
    -- | Drift information for the resources that have been checked for drift in
    -- the specified stack. This includes actual and expected configuration
    -- values for resources where CloudFormation detects drift.
    --
    -- For a given stack, there will be one @StackResourceDrift@ for each stack
    -- resource that has been checked for drift. Resources that haven\'t yet
    -- been checked for drift aren\'t included. Resources that do not currently
    -- support drift detection aren\'t checked, and so not included. For a list
    -- of resources that support drift detection, see
    -- <https://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/using-cfn-stack-drift-resource-list.html Resources that Support Drift Detection>.
    DescribeStackResourceDriftsResponse -> [StackResourceDrift]
stackResourceDrifts :: [StackResourceDrift]
  }
  deriving (DescribeStackResourceDriftsResponse
-> DescribeStackResourceDriftsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeStackResourceDriftsResponse
-> DescribeStackResourceDriftsResponse -> Bool
$c/= :: DescribeStackResourceDriftsResponse
-> DescribeStackResourceDriftsResponse -> Bool
== :: DescribeStackResourceDriftsResponse
-> DescribeStackResourceDriftsResponse -> Bool
$c== :: DescribeStackResourceDriftsResponse
-> DescribeStackResourceDriftsResponse -> Bool
Prelude.Eq, ReadPrec [DescribeStackResourceDriftsResponse]
ReadPrec DescribeStackResourceDriftsResponse
Int -> ReadS DescribeStackResourceDriftsResponse
ReadS [DescribeStackResourceDriftsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeStackResourceDriftsResponse]
$creadListPrec :: ReadPrec [DescribeStackResourceDriftsResponse]
readPrec :: ReadPrec DescribeStackResourceDriftsResponse
$creadPrec :: ReadPrec DescribeStackResourceDriftsResponse
readList :: ReadS [DescribeStackResourceDriftsResponse]
$creadList :: ReadS [DescribeStackResourceDriftsResponse]
readsPrec :: Int -> ReadS DescribeStackResourceDriftsResponse
$creadsPrec :: Int -> ReadS DescribeStackResourceDriftsResponse
Prelude.Read, Int -> DescribeStackResourceDriftsResponse -> ShowS
[DescribeStackResourceDriftsResponse] -> ShowS
DescribeStackResourceDriftsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeStackResourceDriftsResponse] -> ShowS
$cshowList :: [DescribeStackResourceDriftsResponse] -> ShowS
show :: DescribeStackResourceDriftsResponse -> String
$cshow :: DescribeStackResourceDriftsResponse -> String
showsPrec :: Int -> DescribeStackResourceDriftsResponse -> ShowS
$cshowsPrec :: Int -> DescribeStackResourceDriftsResponse -> ShowS
Prelude.Show, forall x.
Rep DescribeStackResourceDriftsResponse x
-> DescribeStackResourceDriftsResponse
forall x.
DescribeStackResourceDriftsResponse
-> Rep DescribeStackResourceDriftsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DescribeStackResourceDriftsResponse x
-> DescribeStackResourceDriftsResponse
$cfrom :: forall x.
DescribeStackResourceDriftsResponse
-> Rep DescribeStackResourceDriftsResponse x
Prelude.Generic)

-- |
-- Create a value of 'DescribeStackResourceDriftsResponse' 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:
--
-- 'nextToken', 'describeStackResourceDriftsResponse_nextToken' - If the request doesn\'t return all the remaining results, @NextToken@ is
-- set to a token. To retrieve the next set of results, call
-- @DescribeStackResourceDrifts@ again and assign that token to the request
-- object\'s @NextToken@ parameter. If the request returns all results,
-- @NextToken@ is set to @null@.
--
-- 'httpStatus', 'describeStackResourceDriftsResponse_httpStatus' - The response's http status code.
--
-- 'stackResourceDrifts', 'describeStackResourceDriftsResponse_stackResourceDrifts' - Drift information for the resources that have been checked for drift in
-- the specified stack. This includes actual and expected configuration
-- values for resources where CloudFormation detects drift.
--
-- For a given stack, there will be one @StackResourceDrift@ for each stack
-- resource that has been checked for drift. Resources that haven\'t yet
-- been checked for drift aren\'t included. Resources that do not currently
-- support drift detection aren\'t checked, and so not included. For a list
-- of resources that support drift detection, see
-- <https://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/using-cfn-stack-drift-resource-list.html Resources that Support Drift Detection>.
newDescribeStackResourceDriftsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DescribeStackResourceDriftsResponse
newDescribeStackResourceDriftsResponse :: Int -> DescribeStackResourceDriftsResponse
newDescribeStackResourceDriftsResponse Int
pHttpStatus_ =
  DescribeStackResourceDriftsResponse'
    { $sel:nextToken:DescribeStackResourceDriftsResponse' :: Maybe Text
nextToken =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:DescribeStackResourceDriftsResponse' :: Int
httpStatus = Int
pHttpStatus_,
      $sel:stackResourceDrifts:DescribeStackResourceDriftsResponse' :: [StackResourceDrift]
stackResourceDrifts = forall a. Monoid a => a
Prelude.mempty
    }

-- | If the request doesn\'t return all the remaining results, @NextToken@ is
-- set to a token. To retrieve the next set of results, call
-- @DescribeStackResourceDrifts@ again and assign that token to the request
-- object\'s @NextToken@ parameter. If the request returns all results,
-- @NextToken@ is set to @null@.
describeStackResourceDriftsResponse_nextToken :: Lens.Lens' DescribeStackResourceDriftsResponse (Prelude.Maybe Prelude.Text)
describeStackResourceDriftsResponse_nextToken :: Lens' DescribeStackResourceDriftsResponse (Maybe Text)
describeStackResourceDriftsResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeStackResourceDriftsResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:DescribeStackResourceDriftsResponse' :: DescribeStackResourceDriftsResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: DescribeStackResourceDriftsResponse
s@DescribeStackResourceDriftsResponse' {} Maybe Text
a -> DescribeStackResourceDriftsResponse
s {$sel:nextToken:DescribeStackResourceDriftsResponse' :: Maybe Text
nextToken = Maybe Text
a} :: DescribeStackResourceDriftsResponse)

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

-- | Drift information for the resources that have been checked for drift in
-- the specified stack. This includes actual and expected configuration
-- values for resources where CloudFormation detects drift.
--
-- For a given stack, there will be one @StackResourceDrift@ for each stack
-- resource that has been checked for drift. Resources that haven\'t yet
-- been checked for drift aren\'t included. Resources that do not currently
-- support drift detection aren\'t checked, and so not included. For a list
-- of resources that support drift detection, see
-- <https://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/using-cfn-stack-drift-resource-list.html Resources that Support Drift Detection>.
describeStackResourceDriftsResponse_stackResourceDrifts :: Lens.Lens' DescribeStackResourceDriftsResponse [StackResourceDrift]
describeStackResourceDriftsResponse_stackResourceDrifts :: Lens' DescribeStackResourceDriftsResponse [StackResourceDrift]
describeStackResourceDriftsResponse_stackResourceDrifts = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeStackResourceDriftsResponse' {[StackResourceDrift]
stackResourceDrifts :: [StackResourceDrift]
$sel:stackResourceDrifts:DescribeStackResourceDriftsResponse' :: DescribeStackResourceDriftsResponse -> [StackResourceDrift]
stackResourceDrifts} -> [StackResourceDrift]
stackResourceDrifts) (\s :: DescribeStackResourceDriftsResponse
s@DescribeStackResourceDriftsResponse' {} [StackResourceDrift]
a -> DescribeStackResourceDriftsResponse
s {$sel:stackResourceDrifts:DescribeStackResourceDriftsResponse' :: [StackResourceDrift]
stackResourceDrifts = [StackResourceDrift]
a} :: DescribeStackResourceDriftsResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

instance
  Prelude.NFData
    DescribeStackResourceDriftsResponse
  where
  rnf :: DescribeStackResourceDriftsResponse -> ()
rnf DescribeStackResourceDriftsResponse' {Int
[StackResourceDrift]
Maybe Text
stackResourceDrifts :: [StackResourceDrift]
httpStatus :: Int
nextToken :: Maybe Text
$sel:stackResourceDrifts:DescribeStackResourceDriftsResponse' :: DescribeStackResourceDriftsResponse -> [StackResourceDrift]
$sel:httpStatus:DescribeStackResourceDriftsResponse' :: DescribeStackResourceDriftsResponse -> Int
$sel:nextToken:DescribeStackResourceDriftsResponse' :: DescribeStackResourceDriftsResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
nextToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf [StackResourceDrift]
stackResourceDrifts