{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# 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.Types.StackResourceDrift
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
module Amazonka.CloudFormation.Types.StackResourceDrift where

import Amazonka.CloudFormation.Types.ModuleInfo
import Amazonka.CloudFormation.Types.PhysicalResourceIdContextKeyValuePair
import Amazonka.CloudFormation.Types.PropertyDifference
import Amazonka.CloudFormation.Types.StackResourceDriftStatus
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

-- | Contains the drift information for a resource that has been checked for
-- drift. This includes actual and expected property values for resources
-- in which CloudFormation has detected drift. Only resource properties
-- explicitly defined in the stack template are checked for drift. 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>.
--
-- Resources that don\'t currently support drift detection can\'t be
-- checked. For a list of resources that support drift detection, see
-- <http://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 resources in a given stack that
-- support drift detection.
--
-- /See:/ 'newStackResourceDrift' smart constructor.
data StackResourceDrift = StackResourceDrift'
  { -- | A JSON structure containing the actual property values of the stack
    -- resource.
    --
    -- For resources whose @StackResourceDriftStatus@ is @DELETED@, this
    -- structure will not be present.
    StackResourceDrift -> Maybe Text
actualProperties :: Prelude.Maybe Prelude.Text,
    -- | A JSON structure containing the expected property values of the stack
    -- resource, as defined in the stack template and any values specified as
    -- template parameters.
    --
    -- For resources whose @StackResourceDriftStatus@ is @DELETED@, this
    -- structure will not be present.
    StackResourceDrift -> Maybe Text
expectedProperties :: Prelude.Maybe Prelude.Text,
    -- | Contains information about the module from which the resource was
    -- created, if the resource was created from a module included in the stack
    -- template.
    StackResourceDrift -> Maybe ModuleInfo
moduleInfo :: Prelude.Maybe ModuleInfo,
    -- | The name or unique identifier that corresponds to a physical instance ID
    -- of a resource supported by CloudFormation.
    StackResourceDrift -> Maybe Text
physicalResourceId :: Prelude.Maybe Prelude.Text,
    -- | Context information that enables CloudFormation to uniquely identify a
    -- resource. CloudFormation uses context key-value pairs in cases where a
    -- resource\'s logical and physical IDs aren\'t enough to uniquely identify
    -- that resource. Each context key-value pair specifies a unique resource
    -- that contains the targeted resource.
    StackResourceDrift -> Maybe [PhysicalResourceIdContextKeyValuePair]
physicalResourceIdContext :: Prelude.Maybe [PhysicalResourceIdContextKeyValuePair],
    -- | A collection of the resource properties whose actual values differ from
    -- their expected values. These will be present only for resources whose
    -- @StackResourceDriftStatus@ is @MODIFIED@.
    StackResourceDrift -> Maybe [PropertyDifference]
propertyDifferences :: Prelude.Maybe [PropertyDifference],
    -- | The ID of the stack.
    StackResourceDrift -> Text
stackId :: Prelude.Text,
    -- | The logical name of the resource specified in the template.
    StackResourceDrift -> Text
logicalResourceId :: Prelude.Text,
    -- | The type of the resource.
    StackResourceDrift -> Text
resourceType :: Prelude.Text,
    -- | Status of the resource\'s actual configuration compared to its expected
    -- configuration.
    --
    -- -   @DELETED@: The resource differs from its expected template
    --     configuration because the resource has been deleted.
    --
    -- -   @MODIFIED@: One or more resource properties differ from their
    --     expected values (as defined in the stack template and any values
    --     specified as template parameters).
    --
    -- -   @IN_SYNC@: The resource\'s actual configuration matches its expected
    --     template configuration.
    --
    -- -   @NOT_CHECKED@: CloudFormation does not currently return this value.
    StackResourceDrift -> StackResourceDriftStatus
stackResourceDriftStatus :: StackResourceDriftStatus,
    -- | Time at which CloudFormation performed drift detection on the stack
    -- resource.
    StackResourceDrift -> ISO8601
timestamp :: Data.ISO8601
  }
  deriving (StackResourceDrift -> StackResourceDrift -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StackResourceDrift -> StackResourceDrift -> Bool
$c/= :: StackResourceDrift -> StackResourceDrift -> Bool
== :: StackResourceDrift -> StackResourceDrift -> Bool
$c== :: StackResourceDrift -> StackResourceDrift -> Bool
Prelude.Eq, ReadPrec [StackResourceDrift]
ReadPrec StackResourceDrift
Int -> ReadS StackResourceDrift
ReadS [StackResourceDrift]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StackResourceDrift]
$creadListPrec :: ReadPrec [StackResourceDrift]
readPrec :: ReadPrec StackResourceDrift
$creadPrec :: ReadPrec StackResourceDrift
readList :: ReadS [StackResourceDrift]
$creadList :: ReadS [StackResourceDrift]
readsPrec :: Int -> ReadS StackResourceDrift
$creadsPrec :: Int -> ReadS StackResourceDrift
Prelude.Read, Int -> StackResourceDrift -> ShowS
[StackResourceDrift] -> ShowS
StackResourceDrift -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StackResourceDrift] -> ShowS
$cshowList :: [StackResourceDrift] -> ShowS
show :: StackResourceDrift -> String
$cshow :: StackResourceDrift -> String
showsPrec :: Int -> StackResourceDrift -> ShowS
$cshowsPrec :: Int -> StackResourceDrift -> ShowS
Prelude.Show, forall x. Rep StackResourceDrift x -> StackResourceDrift
forall x. StackResourceDrift -> Rep StackResourceDrift x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StackResourceDrift x -> StackResourceDrift
$cfrom :: forall x. StackResourceDrift -> Rep StackResourceDrift x
Prelude.Generic)

-- |
-- Create a value of 'StackResourceDrift' 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:
--
-- 'actualProperties', 'stackResourceDrift_actualProperties' - A JSON structure containing the actual property values of the stack
-- resource.
--
-- For resources whose @StackResourceDriftStatus@ is @DELETED@, this
-- structure will not be present.
--
-- 'expectedProperties', 'stackResourceDrift_expectedProperties' - A JSON structure containing the expected property values of the stack
-- resource, as defined in the stack template and any values specified as
-- template parameters.
--
-- For resources whose @StackResourceDriftStatus@ is @DELETED@, this
-- structure will not be present.
--
-- 'moduleInfo', 'stackResourceDrift_moduleInfo' - Contains information about the module from which the resource was
-- created, if the resource was created from a module included in the stack
-- template.
--
-- 'physicalResourceId', 'stackResourceDrift_physicalResourceId' - The name or unique identifier that corresponds to a physical instance ID
-- of a resource supported by CloudFormation.
--
-- 'physicalResourceIdContext', 'stackResourceDrift_physicalResourceIdContext' - Context information that enables CloudFormation to uniquely identify a
-- resource. CloudFormation uses context key-value pairs in cases where a
-- resource\'s logical and physical IDs aren\'t enough to uniquely identify
-- that resource. Each context key-value pair specifies a unique resource
-- that contains the targeted resource.
--
-- 'propertyDifferences', 'stackResourceDrift_propertyDifferences' - A collection of the resource properties whose actual values differ from
-- their expected values. These will be present only for resources whose
-- @StackResourceDriftStatus@ is @MODIFIED@.
--
-- 'stackId', 'stackResourceDrift_stackId' - The ID of the stack.
--
-- 'logicalResourceId', 'stackResourceDrift_logicalResourceId' - The logical name of the resource specified in the template.
--
-- 'resourceType', 'stackResourceDrift_resourceType' - The type of the resource.
--
-- 'stackResourceDriftStatus', 'stackResourceDrift_stackResourceDriftStatus' - Status of the resource\'s actual configuration compared to its expected
-- configuration.
--
-- -   @DELETED@: The resource differs from its expected template
--     configuration because the resource has been deleted.
--
-- -   @MODIFIED@: One or more resource properties differ from their
--     expected values (as defined in the stack template and any values
--     specified as template parameters).
--
-- -   @IN_SYNC@: The resource\'s actual configuration matches its expected
--     template configuration.
--
-- -   @NOT_CHECKED@: CloudFormation does not currently return this value.
--
-- 'timestamp', 'stackResourceDrift_timestamp' - Time at which CloudFormation performed drift detection on the stack
-- resource.
newStackResourceDrift ::
  -- | 'stackId'
  Prelude.Text ->
  -- | 'logicalResourceId'
  Prelude.Text ->
  -- | 'resourceType'
  Prelude.Text ->
  -- | 'stackResourceDriftStatus'
  StackResourceDriftStatus ->
  -- | 'timestamp'
  Prelude.UTCTime ->
  StackResourceDrift
newStackResourceDrift :: Text
-> Text
-> Text
-> StackResourceDriftStatus
-> UTCTime
-> StackResourceDrift
newStackResourceDrift
  Text
pStackId_
  Text
pLogicalResourceId_
  Text
pResourceType_
  StackResourceDriftStatus
pStackResourceDriftStatus_
  UTCTime
pTimestamp_ =
    StackResourceDrift'
      { $sel:actualProperties:StackResourceDrift' :: Maybe Text
actualProperties =
          forall a. Maybe a
Prelude.Nothing,
        $sel:expectedProperties:StackResourceDrift' :: Maybe Text
expectedProperties = forall a. Maybe a
Prelude.Nothing,
        $sel:moduleInfo:StackResourceDrift' :: Maybe ModuleInfo
moduleInfo = forall a. Maybe a
Prelude.Nothing,
        $sel:physicalResourceId:StackResourceDrift' :: Maybe Text
physicalResourceId = forall a. Maybe a
Prelude.Nothing,
        $sel:physicalResourceIdContext:StackResourceDrift' :: Maybe [PhysicalResourceIdContextKeyValuePair]
physicalResourceIdContext = forall a. Maybe a
Prelude.Nothing,
        $sel:propertyDifferences:StackResourceDrift' :: Maybe [PropertyDifference]
propertyDifferences = forall a. Maybe a
Prelude.Nothing,
        $sel:stackId:StackResourceDrift' :: Text
stackId = Text
pStackId_,
        $sel:logicalResourceId:StackResourceDrift' :: Text
logicalResourceId = Text
pLogicalResourceId_,
        $sel:resourceType:StackResourceDrift' :: Text
resourceType = Text
pResourceType_,
        $sel:stackResourceDriftStatus:StackResourceDrift' :: StackResourceDriftStatus
stackResourceDriftStatus =
          StackResourceDriftStatus
pStackResourceDriftStatus_,
        $sel:timestamp:StackResourceDrift' :: ISO8601
timestamp = forall (a :: Format). Iso' (Time a) UTCTime
Data._Time forall t b. AReview t b -> b -> t
Lens.# UTCTime
pTimestamp_
      }

-- | A JSON structure containing the actual property values of the stack
-- resource.
--
-- For resources whose @StackResourceDriftStatus@ is @DELETED@, this
-- structure will not be present.
stackResourceDrift_actualProperties :: Lens.Lens' StackResourceDrift (Prelude.Maybe Prelude.Text)
stackResourceDrift_actualProperties :: Lens' StackResourceDrift (Maybe Text)
stackResourceDrift_actualProperties = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StackResourceDrift' {Maybe Text
actualProperties :: Maybe Text
$sel:actualProperties:StackResourceDrift' :: StackResourceDrift -> Maybe Text
actualProperties} -> Maybe Text
actualProperties) (\s :: StackResourceDrift
s@StackResourceDrift' {} Maybe Text
a -> StackResourceDrift
s {$sel:actualProperties:StackResourceDrift' :: Maybe Text
actualProperties = Maybe Text
a} :: StackResourceDrift)

-- | A JSON structure containing the expected property values of the stack
-- resource, as defined in the stack template and any values specified as
-- template parameters.
--
-- For resources whose @StackResourceDriftStatus@ is @DELETED@, this
-- structure will not be present.
stackResourceDrift_expectedProperties :: Lens.Lens' StackResourceDrift (Prelude.Maybe Prelude.Text)
stackResourceDrift_expectedProperties :: Lens' StackResourceDrift (Maybe Text)
stackResourceDrift_expectedProperties = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StackResourceDrift' {Maybe Text
expectedProperties :: Maybe Text
$sel:expectedProperties:StackResourceDrift' :: StackResourceDrift -> Maybe Text
expectedProperties} -> Maybe Text
expectedProperties) (\s :: StackResourceDrift
s@StackResourceDrift' {} Maybe Text
a -> StackResourceDrift
s {$sel:expectedProperties:StackResourceDrift' :: Maybe Text
expectedProperties = Maybe Text
a} :: StackResourceDrift)

-- | Contains information about the module from which the resource was
-- created, if the resource was created from a module included in the stack
-- template.
stackResourceDrift_moduleInfo :: Lens.Lens' StackResourceDrift (Prelude.Maybe ModuleInfo)
stackResourceDrift_moduleInfo :: Lens' StackResourceDrift (Maybe ModuleInfo)
stackResourceDrift_moduleInfo = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StackResourceDrift' {Maybe ModuleInfo
moduleInfo :: Maybe ModuleInfo
$sel:moduleInfo:StackResourceDrift' :: StackResourceDrift -> Maybe ModuleInfo
moduleInfo} -> Maybe ModuleInfo
moduleInfo) (\s :: StackResourceDrift
s@StackResourceDrift' {} Maybe ModuleInfo
a -> StackResourceDrift
s {$sel:moduleInfo:StackResourceDrift' :: Maybe ModuleInfo
moduleInfo = Maybe ModuleInfo
a} :: StackResourceDrift)

-- | The name or unique identifier that corresponds to a physical instance ID
-- of a resource supported by CloudFormation.
stackResourceDrift_physicalResourceId :: Lens.Lens' StackResourceDrift (Prelude.Maybe Prelude.Text)
stackResourceDrift_physicalResourceId :: Lens' StackResourceDrift (Maybe Text)
stackResourceDrift_physicalResourceId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StackResourceDrift' {Maybe Text
physicalResourceId :: Maybe Text
$sel:physicalResourceId:StackResourceDrift' :: StackResourceDrift -> Maybe Text
physicalResourceId} -> Maybe Text
physicalResourceId) (\s :: StackResourceDrift
s@StackResourceDrift' {} Maybe Text
a -> StackResourceDrift
s {$sel:physicalResourceId:StackResourceDrift' :: Maybe Text
physicalResourceId = Maybe Text
a} :: StackResourceDrift)

-- | Context information that enables CloudFormation to uniquely identify a
-- resource. CloudFormation uses context key-value pairs in cases where a
-- resource\'s logical and physical IDs aren\'t enough to uniquely identify
-- that resource. Each context key-value pair specifies a unique resource
-- that contains the targeted resource.
stackResourceDrift_physicalResourceIdContext :: Lens.Lens' StackResourceDrift (Prelude.Maybe [PhysicalResourceIdContextKeyValuePair])
stackResourceDrift_physicalResourceIdContext :: Lens'
  StackResourceDrift (Maybe [PhysicalResourceIdContextKeyValuePair])
stackResourceDrift_physicalResourceIdContext = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StackResourceDrift' {Maybe [PhysicalResourceIdContextKeyValuePair]
physicalResourceIdContext :: Maybe [PhysicalResourceIdContextKeyValuePair]
$sel:physicalResourceIdContext:StackResourceDrift' :: StackResourceDrift -> Maybe [PhysicalResourceIdContextKeyValuePair]
physicalResourceIdContext} -> Maybe [PhysicalResourceIdContextKeyValuePair]
physicalResourceIdContext) (\s :: StackResourceDrift
s@StackResourceDrift' {} Maybe [PhysicalResourceIdContextKeyValuePair]
a -> StackResourceDrift
s {$sel:physicalResourceIdContext:StackResourceDrift' :: Maybe [PhysicalResourceIdContextKeyValuePair]
physicalResourceIdContext = Maybe [PhysicalResourceIdContextKeyValuePair]
a} :: StackResourceDrift) 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

-- | A collection of the resource properties whose actual values differ from
-- their expected values. These will be present only for resources whose
-- @StackResourceDriftStatus@ is @MODIFIED@.
stackResourceDrift_propertyDifferences :: Lens.Lens' StackResourceDrift (Prelude.Maybe [PropertyDifference])
stackResourceDrift_propertyDifferences :: Lens' StackResourceDrift (Maybe [PropertyDifference])
stackResourceDrift_propertyDifferences = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StackResourceDrift' {Maybe [PropertyDifference]
propertyDifferences :: Maybe [PropertyDifference]
$sel:propertyDifferences:StackResourceDrift' :: StackResourceDrift -> Maybe [PropertyDifference]
propertyDifferences} -> Maybe [PropertyDifference]
propertyDifferences) (\s :: StackResourceDrift
s@StackResourceDrift' {} Maybe [PropertyDifference]
a -> StackResourceDrift
s {$sel:propertyDifferences:StackResourceDrift' :: Maybe [PropertyDifference]
propertyDifferences = Maybe [PropertyDifference]
a} :: StackResourceDrift) 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 ID of the stack.
stackResourceDrift_stackId :: Lens.Lens' StackResourceDrift Prelude.Text
stackResourceDrift_stackId :: Lens' StackResourceDrift Text
stackResourceDrift_stackId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StackResourceDrift' {Text
stackId :: Text
$sel:stackId:StackResourceDrift' :: StackResourceDrift -> Text
stackId} -> Text
stackId) (\s :: StackResourceDrift
s@StackResourceDrift' {} Text
a -> StackResourceDrift
s {$sel:stackId:StackResourceDrift' :: Text
stackId = Text
a} :: StackResourceDrift)

-- | The logical name of the resource specified in the template.
stackResourceDrift_logicalResourceId :: Lens.Lens' StackResourceDrift Prelude.Text
stackResourceDrift_logicalResourceId :: Lens' StackResourceDrift Text
stackResourceDrift_logicalResourceId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StackResourceDrift' {Text
logicalResourceId :: Text
$sel:logicalResourceId:StackResourceDrift' :: StackResourceDrift -> Text
logicalResourceId} -> Text
logicalResourceId) (\s :: StackResourceDrift
s@StackResourceDrift' {} Text
a -> StackResourceDrift
s {$sel:logicalResourceId:StackResourceDrift' :: Text
logicalResourceId = Text
a} :: StackResourceDrift)

-- | The type of the resource.
stackResourceDrift_resourceType :: Lens.Lens' StackResourceDrift Prelude.Text
stackResourceDrift_resourceType :: Lens' StackResourceDrift Text
stackResourceDrift_resourceType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StackResourceDrift' {Text
resourceType :: Text
$sel:resourceType:StackResourceDrift' :: StackResourceDrift -> Text
resourceType} -> Text
resourceType) (\s :: StackResourceDrift
s@StackResourceDrift' {} Text
a -> StackResourceDrift
s {$sel:resourceType:StackResourceDrift' :: Text
resourceType = Text
a} :: StackResourceDrift)

-- | Status of the resource\'s actual configuration compared to its expected
-- configuration.
--
-- -   @DELETED@: The resource differs from its expected template
--     configuration because the resource has been deleted.
--
-- -   @MODIFIED@: One or more resource properties differ from their
--     expected values (as defined in the stack template and any values
--     specified as template parameters).
--
-- -   @IN_SYNC@: The resource\'s actual configuration matches its expected
--     template configuration.
--
-- -   @NOT_CHECKED@: CloudFormation does not currently return this value.
stackResourceDrift_stackResourceDriftStatus :: Lens.Lens' StackResourceDrift StackResourceDriftStatus
stackResourceDrift_stackResourceDriftStatus :: Lens' StackResourceDrift StackResourceDriftStatus
stackResourceDrift_stackResourceDriftStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StackResourceDrift' {StackResourceDriftStatus
stackResourceDriftStatus :: StackResourceDriftStatus
$sel:stackResourceDriftStatus:StackResourceDrift' :: StackResourceDrift -> StackResourceDriftStatus
stackResourceDriftStatus} -> StackResourceDriftStatus
stackResourceDriftStatus) (\s :: StackResourceDrift
s@StackResourceDrift' {} StackResourceDriftStatus
a -> StackResourceDrift
s {$sel:stackResourceDriftStatus:StackResourceDrift' :: StackResourceDriftStatus
stackResourceDriftStatus = StackResourceDriftStatus
a} :: StackResourceDrift)

-- | Time at which CloudFormation performed drift detection on the stack
-- resource.
stackResourceDrift_timestamp :: Lens.Lens' StackResourceDrift Prelude.UTCTime
stackResourceDrift_timestamp :: Lens' StackResourceDrift UTCTime
stackResourceDrift_timestamp = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StackResourceDrift' {ISO8601
timestamp :: ISO8601
$sel:timestamp:StackResourceDrift' :: StackResourceDrift -> ISO8601
timestamp} -> ISO8601
timestamp) (\s :: StackResourceDrift
s@StackResourceDrift' {} ISO8601
a -> StackResourceDrift
s {$sel:timestamp:StackResourceDrift' :: ISO8601
timestamp = ISO8601
a} :: StackResourceDrift) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (a :: Format). Iso' (Time a) UTCTime
Data._Time

instance Data.FromXML StackResourceDrift where
  parseXML :: [Node] -> Either String StackResourceDrift
parseXML [Node]
x =
    Maybe Text
-> Maybe Text
-> Maybe ModuleInfo
-> Maybe Text
-> Maybe [PhysicalResourceIdContextKeyValuePair]
-> Maybe [PropertyDifference]
-> Text
-> Text
-> Text
-> StackResourceDriftStatus
-> ISO8601
-> StackResourceDrift
StackResourceDrift'
      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
"ActualProperties")
      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
"ExpectedProperties")
      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
"ModuleInfo")
      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
"PhysicalResourceId")
      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
"PhysicalResourceIdContext"
                      forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty
                      forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
Prelude.>>= forall (f :: * -> *) a b.
Applicative f =>
([a] -> f b) -> [a] -> f (Maybe b)
Core.may (forall a. FromXML a => Text -> [Node] -> Either String [a]
Data.parseXMLList Text
"member")
                  )
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ( [Node]
x
                      forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"PropertyDifferences"
                      forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty
                      forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
Prelude.>>= forall (f :: * -> *) a b.
Applicative f =>
([a] -> f b) -> [a] -> f (Maybe b)
Core.may (forall a. FromXML a => Text -> [Node] -> Either String [a]
Data.parseXMLList Text
"member")
                  )
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String a
Data..@ Text
"StackId")
      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
"LogicalResourceId")
      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
"ResourceType")
      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
"StackResourceDriftStatus")
      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
"Timestamp")

instance Prelude.Hashable StackResourceDrift where
  hashWithSalt :: Int -> StackResourceDrift -> Int
hashWithSalt Int
_salt StackResourceDrift' {Maybe [PhysicalResourceIdContextKeyValuePair]
Maybe [PropertyDifference]
Maybe Text
Maybe ModuleInfo
Text
ISO8601
StackResourceDriftStatus
timestamp :: ISO8601
stackResourceDriftStatus :: StackResourceDriftStatus
resourceType :: Text
logicalResourceId :: Text
stackId :: Text
propertyDifferences :: Maybe [PropertyDifference]
physicalResourceIdContext :: Maybe [PhysicalResourceIdContextKeyValuePair]
physicalResourceId :: Maybe Text
moduleInfo :: Maybe ModuleInfo
expectedProperties :: Maybe Text
actualProperties :: Maybe Text
$sel:timestamp:StackResourceDrift' :: StackResourceDrift -> ISO8601
$sel:stackResourceDriftStatus:StackResourceDrift' :: StackResourceDrift -> StackResourceDriftStatus
$sel:resourceType:StackResourceDrift' :: StackResourceDrift -> Text
$sel:logicalResourceId:StackResourceDrift' :: StackResourceDrift -> Text
$sel:stackId:StackResourceDrift' :: StackResourceDrift -> Text
$sel:propertyDifferences:StackResourceDrift' :: StackResourceDrift -> Maybe [PropertyDifference]
$sel:physicalResourceIdContext:StackResourceDrift' :: StackResourceDrift -> Maybe [PhysicalResourceIdContextKeyValuePair]
$sel:physicalResourceId:StackResourceDrift' :: StackResourceDrift -> Maybe Text
$sel:moduleInfo:StackResourceDrift' :: StackResourceDrift -> Maybe ModuleInfo
$sel:expectedProperties:StackResourceDrift' :: StackResourceDrift -> Maybe Text
$sel:actualProperties:StackResourceDrift' :: StackResourceDrift -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
actualProperties
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
expectedProperties
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ModuleInfo
moduleInfo
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
physicalResourceId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [PhysicalResourceIdContextKeyValuePair]
physicalResourceIdContext
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [PropertyDifference]
propertyDifferences
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
stackId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
logicalResourceId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
resourceType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` StackResourceDriftStatus
stackResourceDriftStatus
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` ISO8601
timestamp

instance Prelude.NFData StackResourceDrift where
  rnf :: StackResourceDrift -> ()
rnf StackResourceDrift' {Maybe [PhysicalResourceIdContextKeyValuePair]
Maybe [PropertyDifference]
Maybe Text
Maybe ModuleInfo
Text
ISO8601
StackResourceDriftStatus
timestamp :: ISO8601
stackResourceDriftStatus :: StackResourceDriftStatus
resourceType :: Text
logicalResourceId :: Text
stackId :: Text
propertyDifferences :: Maybe [PropertyDifference]
physicalResourceIdContext :: Maybe [PhysicalResourceIdContextKeyValuePair]
physicalResourceId :: Maybe Text
moduleInfo :: Maybe ModuleInfo
expectedProperties :: Maybe Text
actualProperties :: Maybe Text
$sel:timestamp:StackResourceDrift' :: StackResourceDrift -> ISO8601
$sel:stackResourceDriftStatus:StackResourceDrift' :: StackResourceDrift -> StackResourceDriftStatus
$sel:resourceType:StackResourceDrift' :: StackResourceDrift -> Text
$sel:logicalResourceId:StackResourceDrift' :: StackResourceDrift -> Text
$sel:stackId:StackResourceDrift' :: StackResourceDrift -> Text
$sel:propertyDifferences:StackResourceDrift' :: StackResourceDrift -> Maybe [PropertyDifference]
$sel:physicalResourceIdContext:StackResourceDrift' :: StackResourceDrift -> Maybe [PhysicalResourceIdContextKeyValuePair]
$sel:physicalResourceId:StackResourceDrift' :: StackResourceDrift -> Maybe Text
$sel:moduleInfo:StackResourceDrift' :: StackResourceDrift -> Maybe ModuleInfo
$sel:expectedProperties:StackResourceDrift' :: StackResourceDrift -> Maybe Text
$sel:actualProperties:StackResourceDrift' :: StackResourceDrift -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
actualProperties
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
expectedProperties
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ModuleInfo
moduleInfo
      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 [PhysicalResourceIdContextKeyValuePair]
physicalResourceIdContext
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [PropertyDifference]
propertyDifferences
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
stackId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
logicalResourceId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
resourceType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf StackResourceDriftStatus
stackResourceDriftStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf ISO8601
timestamp