{-# 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.DetectStackSetDrift
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Detect drift on a stack set. When CloudFormation performs drift
-- detection on a stack set, it performs drift detection on the stack
-- associated with each stack instance in the stack set. For more
-- information, see
-- <https://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/stacksets-drift.html How CloudFormation performs drift detection on a stack set>.
--
-- @DetectStackSetDrift@ returns the @OperationId@ of the stack set drift
-- detection operation. Use this operation id with
-- @ @@DescribeStackSetOperation@@ @ to monitor the progress of the drift
-- detection operation. The drift detection operation may take some time,
-- depending on the number of stack instances included in the stack set, in
-- addition to the number of resources included in each stack.
--
-- Once the operation has completed, use the following actions to return
-- drift information:
--
-- -   Use @ @@DescribeStackSet@@ @ to return detailed information about
--     the stack set, including detailed information about the last
--     /completed/ drift operation performed on the stack set. (Information
--     about drift operations that are in progress isn\'t included.)
--
-- -   Use @ @@ListStackInstances@@ @ to return a list of stack instances
--     belonging to the stack set, including the drift status and last
--     drift time checked of each instance.
--
-- -   Use @ @@DescribeStackInstance@@ @ to return detailed information
--     about a specific stack instance, including its drift status and last
--     drift time checked.
--
-- For more information about performing a drift detection operation on a
-- stack set, see
-- <https://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/stacksets-drift.html Detecting unmanaged changes in stack sets>.
--
-- You can only run a single drift detection operation on a given stack set
-- at one time.
--
-- To stop a drift detection stack set operation, use
-- @ @@StopStackSetOperation@@ @.
module Amazonka.CloudFormation.DetectStackSetDrift
  ( -- * Creating a Request
    DetectStackSetDrift (..),
    newDetectStackSetDrift,

    -- * Request Lenses
    detectStackSetDrift_callAs,
    detectStackSetDrift_operationId,
    detectStackSetDrift_operationPreferences,
    detectStackSetDrift_stackSetName,

    -- * Destructuring the Response
    DetectStackSetDriftResponse (..),
    newDetectStackSetDriftResponse,

    -- * Response Lenses
    detectStackSetDriftResponse_operationId,
    detectStackSetDriftResponse_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

-- | /See:/ 'newDetectStackSetDrift' smart constructor.
data DetectStackSetDrift = DetectStackSetDrift'
  { -- | [Service-managed permissions] Specifies whether you are acting as an
    -- account administrator in the organization\'s management account or as a
    -- delegated administrator in a member account.
    --
    -- By default, @SELF@ is specified. Use @SELF@ for stack sets with
    -- self-managed permissions.
    --
    -- -   If you are signed in to the management account, specify @SELF@.
    --
    -- -   If you are signed in to a delegated administrator account, specify
    --     @DELEGATED_ADMIN@.
    --
    --     Your Amazon Web Services account must be registered as a delegated
    --     administrator in the management account. For more information, see
    --     <https://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/stacksets-orgs-delegated-admin.html Register a delegated administrator>
    --     in the /CloudFormation User Guide/.
    DetectStackSetDrift -> Maybe CallAs
callAs :: Prelude.Maybe CallAs,
    -- | /The ID of the stack set operation./
    DetectStackSetDrift -> Maybe Text
operationId :: Prelude.Maybe Prelude.Text,
    DetectStackSetDrift -> Maybe StackSetOperationPreferences
operationPreferences :: Prelude.Maybe StackSetOperationPreferences,
    -- | The name of the stack set on which to perform the drift detection
    -- operation.
    DetectStackSetDrift -> Text
stackSetName :: Prelude.Text
  }
  deriving (DetectStackSetDrift -> DetectStackSetDrift -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DetectStackSetDrift -> DetectStackSetDrift -> Bool
$c/= :: DetectStackSetDrift -> DetectStackSetDrift -> Bool
== :: DetectStackSetDrift -> DetectStackSetDrift -> Bool
$c== :: DetectStackSetDrift -> DetectStackSetDrift -> Bool
Prelude.Eq, ReadPrec [DetectStackSetDrift]
ReadPrec DetectStackSetDrift
Int -> ReadS DetectStackSetDrift
ReadS [DetectStackSetDrift]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DetectStackSetDrift]
$creadListPrec :: ReadPrec [DetectStackSetDrift]
readPrec :: ReadPrec DetectStackSetDrift
$creadPrec :: ReadPrec DetectStackSetDrift
readList :: ReadS [DetectStackSetDrift]
$creadList :: ReadS [DetectStackSetDrift]
readsPrec :: Int -> ReadS DetectStackSetDrift
$creadsPrec :: Int -> ReadS DetectStackSetDrift
Prelude.Read, Int -> DetectStackSetDrift -> ShowS
[DetectStackSetDrift] -> ShowS
DetectStackSetDrift -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DetectStackSetDrift] -> ShowS
$cshowList :: [DetectStackSetDrift] -> ShowS
show :: DetectStackSetDrift -> String
$cshow :: DetectStackSetDrift -> String
showsPrec :: Int -> DetectStackSetDrift -> ShowS
$cshowsPrec :: Int -> DetectStackSetDrift -> ShowS
Prelude.Show, forall x. Rep DetectStackSetDrift x -> DetectStackSetDrift
forall x. DetectStackSetDrift -> Rep DetectStackSetDrift x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DetectStackSetDrift x -> DetectStackSetDrift
$cfrom :: forall x. DetectStackSetDrift -> Rep DetectStackSetDrift x
Prelude.Generic)

-- |
-- Create a value of 'DetectStackSetDrift' 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:
--
-- 'callAs', 'detectStackSetDrift_callAs' - [Service-managed permissions] Specifies whether you are acting as an
-- account administrator in the organization\'s management account or as a
-- delegated administrator in a member account.
--
-- By default, @SELF@ is specified. Use @SELF@ for stack sets with
-- self-managed permissions.
--
-- -   If you are signed in to the management account, specify @SELF@.
--
-- -   If you are signed in to a delegated administrator account, specify
--     @DELEGATED_ADMIN@.
--
--     Your Amazon Web Services account must be registered as a delegated
--     administrator in the management account. For more information, see
--     <https://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/stacksets-orgs-delegated-admin.html Register a delegated administrator>
--     in the /CloudFormation User Guide/.
--
-- 'operationId', 'detectStackSetDrift_operationId' - /The ID of the stack set operation./
--
-- 'operationPreferences', 'detectStackSetDrift_operationPreferences' - Undocumented member.
--
-- 'stackSetName', 'detectStackSetDrift_stackSetName' - The name of the stack set on which to perform the drift detection
-- operation.
newDetectStackSetDrift ::
  -- | 'stackSetName'
  Prelude.Text ->
  DetectStackSetDrift
newDetectStackSetDrift :: Text -> DetectStackSetDrift
newDetectStackSetDrift Text
pStackSetName_ =
  DetectStackSetDrift'
    { $sel:callAs:DetectStackSetDrift' :: Maybe CallAs
callAs = forall a. Maybe a
Prelude.Nothing,
      $sel:operationId:DetectStackSetDrift' :: Maybe Text
operationId = forall a. Maybe a
Prelude.Nothing,
      $sel:operationPreferences:DetectStackSetDrift' :: Maybe StackSetOperationPreferences
operationPreferences = forall a. Maybe a
Prelude.Nothing,
      $sel:stackSetName:DetectStackSetDrift' :: Text
stackSetName = Text
pStackSetName_
    }

-- | [Service-managed permissions] Specifies whether you are acting as an
-- account administrator in the organization\'s management account or as a
-- delegated administrator in a member account.
--
-- By default, @SELF@ is specified. Use @SELF@ for stack sets with
-- self-managed permissions.
--
-- -   If you are signed in to the management account, specify @SELF@.
--
-- -   If you are signed in to a delegated administrator account, specify
--     @DELEGATED_ADMIN@.
--
--     Your Amazon Web Services account must be registered as a delegated
--     administrator in the management account. For more information, see
--     <https://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/stacksets-orgs-delegated-admin.html Register a delegated administrator>
--     in the /CloudFormation User Guide/.
detectStackSetDrift_callAs :: Lens.Lens' DetectStackSetDrift (Prelude.Maybe CallAs)
detectStackSetDrift_callAs :: Lens' DetectStackSetDrift (Maybe CallAs)
detectStackSetDrift_callAs = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DetectStackSetDrift' {Maybe CallAs
callAs :: Maybe CallAs
$sel:callAs:DetectStackSetDrift' :: DetectStackSetDrift -> Maybe CallAs
callAs} -> Maybe CallAs
callAs) (\s :: DetectStackSetDrift
s@DetectStackSetDrift' {} Maybe CallAs
a -> DetectStackSetDrift
s {$sel:callAs:DetectStackSetDrift' :: Maybe CallAs
callAs = Maybe CallAs
a} :: DetectStackSetDrift)

-- | /The ID of the stack set operation./
detectStackSetDrift_operationId :: Lens.Lens' DetectStackSetDrift (Prelude.Maybe Prelude.Text)
detectStackSetDrift_operationId :: Lens' DetectStackSetDrift (Maybe Text)
detectStackSetDrift_operationId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DetectStackSetDrift' {Maybe Text
operationId :: Maybe Text
$sel:operationId:DetectStackSetDrift' :: DetectStackSetDrift -> Maybe Text
operationId} -> Maybe Text
operationId) (\s :: DetectStackSetDrift
s@DetectStackSetDrift' {} Maybe Text
a -> DetectStackSetDrift
s {$sel:operationId:DetectStackSetDrift' :: Maybe Text
operationId = Maybe Text
a} :: DetectStackSetDrift)

-- | Undocumented member.
detectStackSetDrift_operationPreferences :: Lens.Lens' DetectStackSetDrift (Prelude.Maybe StackSetOperationPreferences)
detectStackSetDrift_operationPreferences :: Lens' DetectStackSetDrift (Maybe StackSetOperationPreferences)
detectStackSetDrift_operationPreferences = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DetectStackSetDrift' {Maybe StackSetOperationPreferences
operationPreferences :: Maybe StackSetOperationPreferences
$sel:operationPreferences:DetectStackSetDrift' :: DetectStackSetDrift -> Maybe StackSetOperationPreferences
operationPreferences} -> Maybe StackSetOperationPreferences
operationPreferences) (\s :: DetectStackSetDrift
s@DetectStackSetDrift' {} Maybe StackSetOperationPreferences
a -> DetectStackSetDrift
s {$sel:operationPreferences:DetectStackSetDrift' :: Maybe StackSetOperationPreferences
operationPreferences = Maybe StackSetOperationPreferences
a} :: DetectStackSetDrift)

-- | The name of the stack set on which to perform the drift detection
-- operation.
detectStackSetDrift_stackSetName :: Lens.Lens' DetectStackSetDrift Prelude.Text
detectStackSetDrift_stackSetName :: Lens' DetectStackSetDrift Text
detectStackSetDrift_stackSetName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DetectStackSetDrift' {Text
stackSetName :: Text
$sel:stackSetName:DetectStackSetDrift' :: DetectStackSetDrift -> Text
stackSetName} -> Text
stackSetName) (\s :: DetectStackSetDrift
s@DetectStackSetDrift' {} Text
a -> DetectStackSetDrift
s {$sel:stackSetName:DetectStackSetDrift' :: Text
stackSetName = Text
a} :: DetectStackSetDrift)

instance Core.AWSRequest DetectStackSetDrift where
  type
    AWSResponse DetectStackSetDrift =
      DetectStackSetDriftResponse
  request :: (Service -> Service)
-> DetectStackSetDrift -> Request DetectStackSetDrift
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 DetectStackSetDrift
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse DetectStackSetDrift)))
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
"DetectStackSetDriftResult"
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Maybe Text -> Int -> DetectStackSetDriftResponse
DetectStackSetDriftResponse'
            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
"OperationId")
            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 DetectStackSetDrift where
  hashWithSalt :: Int -> DetectStackSetDrift -> Int
hashWithSalt Int
_salt DetectStackSetDrift' {Maybe Text
Maybe CallAs
Maybe StackSetOperationPreferences
Text
stackSetName :: Text
operationPreferences :: Maybe StackSetOperationPreferences
operationId :: Maybe Text
callAs :: Maybe CallAs
$sel:stackSetName:DetectStackSetDrift' :: DetectStackSetDrift -> Text
$sel:operationPreferences:DetectStackSetDrift' :: DetectStackSetDrift -> Maybe StackSetOperationPreferences
$sel:operationId:DetectStackSetDrift' :: DetectStackSetDrift -> Maybe Text
$sel:callAs:DetectStackSetDrift' :: DetectStackSetDrift -> Maybe CallAs
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe CallAs
callAs
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
operationId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe StackSetOperationPreferences
operationPreferences
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
stackSetName

instance Prelude.NFData DetectStackSetDrift where
  rnf :: DetectStackSetDrift -> ()
rnf DetectStackSetDrift' {Maybe Text
Maybe CallAs
Maybe StackSetOperationPreferences
Text
stackSetName :: Text
operationPreferences :: Maybe StackSetOperationPreferences
operationId :: Maybe Text
callAs :: Maybe CallAs
$sel:stackSetName:DetectStackSetDrift' :: DetectStackSetDrift -> Text
$sel:operationPreferences:DetectStackSetDrift' :: DetectStackSetDrift -> Maybe StackSetOperationPreferences
$sel:operationId:DetectStackSetDrift' :: DetectStackSetDrift -> Maybe Text
$sel:callAs:DetectStackSetDrift' :: DetectStackSetDrift -> Maybe CallAs
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe CallAs
callAs
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
operationId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe StackSetOperationPreferences
operationPreferences
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
stackSetName

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

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

instance Data.ToQuery DetectStackSetDrift where
  toQuery :: DetectStackSetDrift -> QueryString
toQuery DetectStackSetDrift' {Maybe Text
Maybe CallAs
Maybe StackSetOperationPreferences
Text
stackSetName :: Text
operationPreferences :: Maybe StackSetOperationPreferences
operationId :: Maybe Text
callAs :: Maybe CallAs
$sel:stackSetName:DetectStackSetDrift' :: DetectStackSetDrift -> Text
$sel:operationPreferences:DetectStackSetDrift' :: DetectStackSetDrift -> Maybe StackSetOperationPreferences
$sel:operationId:DetectStackSetDrift' :: DetectStackSetDrift -> Maybe Text
$sel:callAs:DetectStackSetDrift' :: DetectStackSetDrift -> Maybe CallAs
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"DetectStackSetDrift" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2010-05-15" :: Prelude.ByteString),
        ByteString
"CallAs" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe CallAs
callAs,
        ByteString
"OperationId" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
operationId,
        ByteString
"OperationPreferences" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe StackSetOperationPreferences
operationPreferences,
        ByteString
"StackSetName" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
stackSetName
      ]

-- | /See:/ 'newDetectStackSetDriftResponse' smart constructor.
data DetectStackSetDriftResponse = DetectStackSetDriftResponse'
  { -- | The ID of the drift detection stack set operation.
    --
    -- You can use this operation ID with @ @@DescribeStackSetOperation@@ @ to
    -- monitor the progress of the drift detection operation.
    DetectStackSetDriftResponse -> Maybe Text
operationId :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    DetectStackSetDriftResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (DetectStackSetDriftResponse -> DetectStackSetDriftResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DetectStackSetDriftResponse -> DetectStackSetDriftResponse -> Bool
$c/= :: DetectStackSetDriftResponse -> DetectStackSetDriftResponse -> Bool
== :: DetectStackSetDriftResponse -> DetectStackSetDriftResponse -> Bool
$c== :: DetectStackSetDriftResponse -> DetectStackSetDriftResponse -> Bool
Prelude.Eq, ReadPrec [DetectStackSetDriftResponse]
ReadPrec DetectStackSetDriftResponse
Int -> ReadS DetectStackSetDriftResponse
ReadS [DetectStackSetDriftResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DetectStackSetDriftResponse]
$creadListPrec :: ReadPrec [DetectStackSetDriftResponse]
readPrec :: ReadPrec DetectStackSetDriftResponse
$creadPrec :: ReadPrec DetectStackSetDriftResponse
readList :: ReadS [DetectStackSetDriftResponse]
$creadList :: ReadS [DetectStackSetDriftResponse]
readsPrec :: Int -> ReadS DetectStackSetDriftResponse
$creadsPrec :: Int -> ReadS DetectStackSetDriftResponse
Prelude.Read, Int -> DetectStackSetDriftResponse -> ShowS
[DetectStackSetDriftResponse] -> ShowS
DetectStackSetDriftResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DetectStackSetDriftResponse] -> ShowS
$cshowList :: [DetectStackSetDriftResponse] -> ShowS
show :: DetectStackSetDriftResponse -> String
$cshow :: DetectStackSetDriftResponse -> String
showsPrec :: Int -> DetectStackSetDriftResponse -> ShowS
$cshowsPrec :: Int -> DetectStackSetDriftResponse -> ShowS
Prelude.Show, forall x.
Rep DetectStackSetDriftResponse x -> DetectStackSetDriftResponse
forall x.
DetectStackSetDriftResponse -> Rep DetectStackSetDriftResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DetectStackSetDriftResponse x -> DetectStackSetDriftResponse
$cfrom :: forall x.
DetectStackSetDriftResponse -> Rep DetectStackSetDriftResponse x
Prelude.Generic)

-- |
-- Create a value of 'DetectStackSetDriftResponse' 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:
--
-- 'operationId', 'detectStackSetDriftResponse_operationId' - The ID of the drift detection stack set operation.
--
-- You can use this operation ID with @ @@DescribeStackSetOperation@@ @ to
-- monitor the progress of the drift detection operation.
--
-- 'httpStatus', 'detectStackSetDriftResponse_httpStatus' - The response's http status code.
newDetectStackSetDriftResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DetectStackSetDriftResponse
newDetectStackSetDriftResponse :: Int -> DetectStackSetDriftResponse
newDetectStackSetDriftResponse Int
pHttpStatus_ =
  DetectStackSetDriftResponse'
    { $sel:operationId:DetectStackSetDriftResponse' :: Maybe Text
operationId =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:DetectStackSetDriftResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The ID of the drift detection stack set operation.
--
-- You can use this operation ID with @ @@DescribeStackSetOperation@@ @ to
-- monitor the progress of the drift detection operation.
detectStackSetDriftResponse_operationId :: Lens.Lens' DetectStackSetDriftResponse (Prelude.Maybe Prelude.Text)
detectStackSetDriftResponse_operationId :: Lens' DetectStackSetDriftResponse (Maybe Text)
detectStackSetDriftResponse_operationId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DetectStackSetDriftResponse' {Maybe Text
operationId :: Maybe Text
$sel:operationId:DetectStackSetDriftResponse' :: DetectStackSetDriftResponse -> Maybe Text
operationId} -> Maybe Text
operationId) (\s :: DetectStackSetDriftResponse
s@DetectStackSetDriftResponse' {} Maybe Text
a -> DetectStackSetDriftResponse
s {$sel:operationId:DetectStackSetDriftResponse' :: Maybe Text
operationId = Maybe Text
a} :: DetectStackSetDriftResponse)

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

instance Prelude.NFData DetectStackSetDriftResponse where
  rnf :: DetectStackSetDriftResponse -> ()
rnf DetectStackSetDriftResponse' {Int
Maybe Text
httpStatus :: Int
operationId :: Maybe Text
$sel:httpStatus:DetectStackSetDriftResponse' :: DetectStackSetDriftResponse -> Int
$sel:operationId:DetectStackSetDriftResponse' :: DetectStackSetDriftResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
operationId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus