{-# 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.DetectStackDrift
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Detects whether a stack\'s actual configuration differs, or has
-- /drifted/, from it\'s expected configuration, as defined in the stack
-- template and any values specified as template parameters. For each
-- resource in the stack that supports drift detection, CloudFormation
-- compares the actual configuration of the resource with its expected
-- template configuration. Only resource properties explicitly defined in
-- the stack template are checked for drift. A stack is considered to have
-- drifted if one or more of its resources differ from their expected
-- template configurations. For more information, see
-- <https://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/using-cfn-stack-drift.html Detecting Unregulated Configuration Changes to Stacks and Resources>.
--
-- Use @DetectStackDrift@ to detect drift on all supported resources for a
-- given stack, or DetectStackResourceDrift to detect drift on individual
-- resources.
--
-- For a list of stack resources that currently support drift detection,
-- see
-- <https://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/using-cfn-stack-drift-resource-list.html Resources that Support Drift Detection>.
--
-- @DetectStackDrift@ can take up to several minutes, depending on the
-- number of resources contained within the stack. Use
-- DescribeStackDriftDetectionStatus to monitor the progress of a detect
-- stack drift operation. Once the drift detection operation has completed,
-- use DescribeStackResourceDrifts to return drift information about the
-- stack and its resources.
--
-- When detecting drift on a stack, CloudFormation doesn\'t detect drift on
-- any nested stacks belonging to that stack. Perform @DetectStackDrift@
-- directly on the nested stack itself.
module Amazonka.CloudFormation.DetectStackDrift
  ( -- * Creating a Request
    DetectStackDrift (..),
    newDetectStackDrift,

    -- * Request Lenses
    detectStackDrift_logicalResourceIds,
    detectStackDrift_stackName,

    -- * Destructuring the Response
    DetectStackDriftResponse (..),
    newDetectStackDriftResponse,

    -- * Response Lenses
    detectStackDriftResponse_httpStatus,
    detectStackDriftResponse_stackDriftDetectionId,
  )
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:/ 'newDetectStackDrift' smart constructor.
data DetectStackDrift = DetectStackDrift'
  { -- | The logical names of any resources you want to use as filters.
    DetectStackDrift -> Maybe (NonEmpty Text)
logicalResourceIds :: Prelude.Maybe (Prelude.NonEmpty Prelude.Text),
    -- | The name of the stack for which you want to detect drift.
    DetectStackDrift -> Text
stackName :: Prelude.Text
  }
  deriving (DetectStackDrift -> DetectStackDrift -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DetectStackDrift -> DetectStackDrift -> Bool
$c/= :: DetectStackDrift -> DetectStackDrift -> Bool
== :: DetectStackDrift -> DetectStackDrift -> Bool
$c== :: DetectStackDrift -> DetectStackDrift -> Bool
Prelude.Eq, ReadPrec [DetectStackDrift]
ReadPrec DetectStackDrift
Int -> ReadS DetectStackDrift
ReadS [DetectStackDrift]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DetectStackDrift]
$creadListPrec :: ReadPrec [DetectStackDrift]
readPrec :: ReadPrec DetectStackDrift
$creadPrec :: ReadPrec DetectStackDrift
readList :: ReadS [DetectStackDrift]
$creadList :: ReadS [DetectStackDrift]
readsPrec :: Int -> ReadS DetectStackDrift
$creadsPrec :: Int -> ReadS DetectStackDrift
Prelude.Read, Int -> DetectStackDrift -> ShowS
[DetectStackDrift] -> ShowS
DetectStackDrift -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DetectStackDrift] -> ShowS
$cshowList :: [DetectStackDrift] -> ShowS
show :: DetectStackDrift -> String
$cshow :: DetectStackDrift -> String
showsPrec :: Int -> DetectStackDrift -> ShowS
$cshowsPrec :: Int -> DetectStackDrift -> ShowS
Prelude.Show, forall x. Rep DetectStackDrift x -> DetectStackDrift
forall x. DetectStackDrift -> Rep DetectStackDrift x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DetectStackDrift x -> DetectStackDrift
$cfrom :: forall x. DetectStackDrift -> Rep DetectStackDrift x
Prelude.Generic)

-- |
-- Create a value of 'DetectStackDrift' 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:
--
-- 'logicalResourceIds', 'detectStackDrift_logicalResourceIds' - The logical names of any resources you want to use as filters.
--
-- 'stackName', 'detectStackDrift_stackName' - The name of the stack for which you want to detect drift.
newDetectStackDrift ::
  -- | 'stackName'
  Prelude.Text ->
  DetectStackDrift
newDetectStackDrift :: Text -> DetectStackDrift
newDetectStackDrift Text
pStackName_ =
  DetectStackDrift'
    { $sel:logicalResourceIds:DetectStackDrift' :: Maybe (NonEmpty Text)
logicalResourceIds =
        forall a. Maybe a
Prelude.Nothing,
      $sel:stackName:DetectStackDrift' :: Text
stackName = Text
pStackName_
    }

-- | The logical names of any resources you want to use as filters.
detectStackDrift_logicalResourceIds :: Lens.Lens' DetectStackDrift (Prelude.Maybe (Prelude.NonEmpty Prelude.Text))
detectStackDrift_logicalResourceIds :: Lens' DetectStackDrift (Maybe (NonEmpty Text))
detectStackDrift_logicalResourceIds = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DetectStackDrift' {Maybe (NonEmpty Text)
logicalResourceIds :: Maybe (NonEmpty Text)
$sel:logicalResourceIds:DetectStackDrift' :: DetectStackDrift -> Maybe (NonEmpty Text)
logicalResourceIds} -> Maybe (NonEmpty Text)
logicalResourceIds) (\s :: DetectStackDrift
s@DetectStackDrift' {} Maybe (NonEmpty Text)
a -> DetectStackDrift
s {$sel:logicalResourceIds:DetectStackDrift' :: Maybe (NonEmpty Text)
logicalResourceIds = Maybe (NonEmpty Text)
a} :: DetectStackDrift) 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 to detect drift.
detectStackDrift_stackName :: Lens.Lens' DetectStackDrift Prelude.Text
detectStackDrift_stackName :: Lens' DetectStackDrift Text
detectStackDrift_stackName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DetectStackDrift' {Text
stackName :: Text
$sel:stackName:DetectStackDrift' :: DetectStackDrift -> Text
stackName} -> Text
stackName) (\s :: DetectStackDrift
s@DetectStackDrift' {} Text
a -> DetectStackDrift
s {$sel:stackName:DetectStackDrift' :: Text
stackName = Text
a} :: DetectStackDrift)

instance Core.AWSRequest DetectStackDrift where
  type
    AWSResponse DetectStackDrift =
      DetectStackDriftResponse
  request :: (Service -> Service)
-> DetectStackDrift -> Request DetectStackDrift
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 DetectStackDrift
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse DetectStackDrift)))
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
"DetectStackDriftResult"
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Int -> Text -> DetectStackDriftResponse
DetectStackDriftResponse'
            forall (f :: * -> *) a b. Functor 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 a
Data..@ Text
"StackDriftDetectionId")
      )

instance Prelude.Hashable DetectStackDrift where
  hashWithSalt :: Int -> DetectStackDrift -> Int
hashWithSalt Int
_salt DetectStackDrift' {Maybe (NonEmpty Text)
Text
stackName :: Text
logicalResourceIds :: Maybe (NonEmpty Text)
$sel:stackName:DetectStackDrift' :: DetectStackDrift -> Text
$sel:logicalResourceIds:DetectStackDrift' :: DetectStackDrift -> Maybe (NonEmpty Text)
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (NonEmpty Text)
logicalResourceIds
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
stackName

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

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

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

instance Data.ToQuery DetectStackDrift where
  toQuery :: DetectStackDrift -> QueryString
toQuery DetectStackDrift' {Maybe (NonEmpty Text)
Text
stackName :: Text
logicalResourceIds :: Maybe (NonEmpty Text)
$sel:stackName:DetectStackDrift' :: DetectStackDrift -> Text
$sel:logicalResourceIds:DetectStackDrift' :: DetectStackDrift -> Maybe (NonEmpty Text)
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"DetectStackDrift" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2010-05-15" :: Prelude.ByteString),
        ByteString
"LogicalResourceIds"
          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 Text)
logicalResourceIds
            ),
        ByteString
"StackName" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
stackName
      ]

-- | /See:/ 'newDetectStackDriftResponse' smart constructor.
data DetectStackDriftResponse = DetectStackDriftResponse'
  { -- | The response's http status code.
    DetectStackDriftResponse -> Int
httpStatus :: Prelude.Int,
    -- | The ID of the drift detection results of this operation.
    --
    -- CloudFormation generates new results, with a new drift detection ID,
    -- each time this operation is run. However, the number of drift results
    -- CloudFormation retains for any given stack, and for how long, may vary.
    DetectStackDriftResponse -> Text
stackDriftDetectionId :: Prelude.Text
  }
  deriving (DetectStackDriftResponse -> DetectStackDriftResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DetectStackDriftResponse -> DetectStackDriftResponse -> Bool
$c/= :: DetectStackDriftResponse -> DetectStackDriftResponse -> Bool
== :: DetectStackDriftResponse -> DetectStackDriftResponse -> Bool
$c== :: DetectStackDriftResponse -> DetectStackDriftResponse -> Bool
Prelude.Eq, ReadPrec [DetectStackDriftResponse]
ReadPrec DetectStackDriftResponse
Int -> ReadS DetectStackDriftResponse
ReadS [DetectStackDriftResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DetectStackDriftResponse]
$creadListPrec :: ReadPrec [DetectStackDriftResponse]
readPrec :: ReadPrec DetectStackDriftResponse
$creadPrec :: ReadPrec DetectStackDriftResponse
readList :: ReadS [DetectStackDriftResponse]
$creadList :: ReadS [DetectStackDriftResponse]
readsPrec :: Int -> ReadS DetectStackDriftResponse
$creadsPrec :: Int -> ReadS DetectStackDriftResponse
Prelude.Read, Int -> DetectStackDriftResponse -> ShowS
[DetectStackDriftResponse] -> ShowS
DetectStackDriftResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DetectStackDriftResponse] -> ShowS
$cshowList :: [DetectStackDriftResponse] -> ShowS
show :: DetectStackDriftResponse -> String
$cshow :: DetectStackDriftResponse -> String
showsPrec :: Int -> DetectStackDriftResponse -> ShowS
$cshowsPrec :: Int -> DetectStackDriftResponse -> ShowS
Prelude.Show, forall x.
Rep DetectStackDriftResponse x -> DetectStackDriftResponse
forall x.
DetectStackDriftResponse -> Rep DetectStackDriftResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DetectStackDriftResponse x -> DetectStackDriftResponse
$cfrom :: forall x.
DetectStackDriftResponse -> Rep DetectStackDriftResponse x
Prelude.Generic)

-- |
-- Create a value of 'DetectStackDriftResponse' 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:
--
-- 'httpStatus', 'detectStackDriftResponse_httpStatus' - The response's http status code.
--
-- 'stackDriftDetectionId', 'detectStackDriftResponse_stackDriftDetectionId' - The ID of the drift detection results of this operation.
--
-- CloudFormation generates new results, with a new drift detection ID,
-- each time this operation is run. However, the number of drift results
-- CloudFormation retains for any given stack, and for how long, may vary.
newDetectStackDriftResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'stackDriftDetectionId'
  Prelude.Text ->
  DetectStackDriftResponse
newDetectStackDriftResponse :: Int -> Text -> DetectStackDriftResponse
newDetectStackDriftResponse
  Int
pHttpStatus_
  Text
pStackDriftDetectionId_ =
    DetectStackDriftResponse'
      { $sel:httpStatus:DetectStackDriftResponse' :: Int
httpStatus =
          Int
pHttpStatus_,
        $sel:stackDriftDetectionId:DetectStackDriftResponse' :: Text
stackDriftDetectionId = Text
pStackDriftDetectionId_
      }

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

-- | The ID of the drift detection results of this operation.
--
-- CloudFormation generates new results, with a new drift detection ID,
-- each time this operation is run. However, the number of drift results
-- CloudFormation retains for any given stack, and for how long, may vary.
detectStackDriftResponse_stackDriftDetectionId :: Lens.Lens' DetectStackDriftResponse Prelude.Text
detectStackDriftResponse_stackDriftDetectionId :: Lens' DetectStackDriftResponse Text
detectStackDriftResponse_stackDriftDetectionId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DetectStackDriftResponse' {Text
stackDriftDetectionId :: Text
$sel:stackDriftDetectionId:DetectStackDriftResponse' :: DetectStackDriftResponse -> Text
stackDriftDetectionId} -> Text
stackDriftDetectionId) (\s :: DetectStackDriftResponse
s@DetectStackDriftResponse' {} Text
a -> DetectStackDriftResponse
s {$sel:stackDriftDetectionId:DetectStackDriftResponse' :: Text
stackDriftDetectionId = Text
a} :: DetectStackDriftResponse)

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