{-# 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.ServiceCatalog.Types.ResourceChange
-- 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.ServiceCatalog.Types.ResourceChange where

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 Amazonka.ServiceCatalog.Types.ChangeAction
import Amazonka.ServiceCatalog.Types.Replacement
import Amazonka.ServiceCatalog.Types.ResourceAttribute
import Amazonka.ServiceCatalog.Types.ResourceChangeDetail

-- | Information about a resource change that will occur when a plan is
-- executed.
--
-- /See:/ 'newResourceChange' smart constructor.
data ResourceChange = ResourceChange'
  { -- | The change action.
    ResourceChange -> Maybe ChangeAction
action :: Prelude.Maybe ChangeAction,
    -- | Information about the resource changes.
    ResourceChange -> Maybe [ResourceChangeDetail]
details :: Prelude.Maybe [ResourceChangeDetail],
    -- | The ID of the resource, as defined in the CloudFormation template.
    ResourceChange -> Maybe Text
logicalResourceId :: Prelude.Maybe Prelude.Text,
    -- | The ID of the resource, if it was already created.
    ResourceChange -> Maybe Text
physicalResourceId :: Prelude.Maybe Prelude.Text,
    -- | If the change type is @Modify@, indicates whether the existing resource
    -- is deleted and replaced with a new one.
    ResourceChange -> Maybe Replacement
replacement :: Prelude.Maybe Replacement,
    -- | The type of resource.
    ResourceChange -> Maybe Text
resourceType :: Prelude.Maybe Prelude.Text,
    -- | The change scope.
    ResourceChange -> Maybe [ResourceAttribute]
scope :: Prelude.Maybe [ResourceAttribute]
  }
  deriving (ResourceChange -> ResourceChange -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ResourceChange -> ResourceChange -> Bool
$c/= :: ResourceChange -> ResourceChange -> Bool
== :: ResourceChange -> ResourceChange -> Bool
$c== :: ResourceChange -> ResourceChange -> Bool
Prelude.Eq, ReadPrec [ResourceChange]
ReadPrec ResourceChange
Int -> ReadS ResourceChange
ReadS [ResourceChange]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ResourceChange]
$creadListPrec :: ReadPrec [ResourceChange]
readPrec :: ReadPrec ResourceChange
$creadPrec :: ReadPrec ResourceChange
readList :: ReadS [ResourceChange]
$creadList :: ReadS [ResourceChange]
readsPrec :: Int -> ReadS ResourceChange
$creadsPrec :: Int -> ReadS ResourceChange
Prelude.Read, Int -> ResourceChange -> ShowS
[ResourceChange] -> ShowS
ResourceChange -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ResourceChange] -> ShowS
$cshowList :: [ResourceChange] -> ShowS
show :: ResourceChange -> String
$cshow :: ResourceChange -> String
showsPrec :: Int -> ResourceChange -> ShowS
$cshowsPrec :: Int -> ResourceChange -> ShowS
Prelude.Show, forall x. Rep ResourceChange x -> ResourceChange
forall x. ResourceChange -> Rep ResourceChange x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ResourceChange x -> ResourceChange
$cfrom :: forall x. ResourceChange -> Rep ResourceChange x
Prelude.Generic)

-- |
-- Create a value of 'ResourceChange' 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:
--
-- 'action', 'resourceChange_action' - The change action.
--
-- 'details', 'resourceChange_details' - Information about the resource changes.
--
-- 'logicalResourceId', 'resourceChange_logicalResourceId' - The ID of the resource, as defined in the CloudFormation template.
--
-- 'physicalResourceId', 'resourceChange_physicalResourceId' - The ID of the resource, if it was already created.
--
-- 'replacement', 'resourceChange_replacement' - If the change type is @Modify@, indicates whether the existing resource
-- is deleted and replaced with a new one.
--
-- 'resourceType', 'resourceChange_resourceType' - The type of resource.
--
-- 'scope', 'resourceChange_scope' - The change scope.
newResourceChange ::
  ResourceChange
newResourceChange :: ResourceChange
newResourceChange =
  ResourceChange'
    { $sel:action:ResourceChange' :: Maybe ChangeAction
action = forall a. Maybe a
Prelude.Nothing,
      $sel:details:ResourceChange' :: Maybe [ResourceChangeDetail]
details = forall a. Maybe a
Prelude.Nothing,
      $sel:logicalResourceId:ResourceChange' :: Maybe Text
logicalResourceId = forall a. Maybe a
Prelude.Nothing,
      $sel:physicalResourceId:ResourceChange' :: Maybe Text
physicalResourceId = forall a. Maybe a
Prelude.Nothing,
      $sel:replacement:ResourceChange' :: Maybe Replacement
replacement = forall a. Maybe a
Prelude.Nothing,
      $sel:resourceType:ResourceChange' :: Maybe Text
resourceType = forall a. Maybe a
Prelude.Nothing,
      $sel:scope:ResourceChange' :: Maybe [ResourceAttribute]
scope = forall a. Maybe a
Prelude.Nothing
    }

-- | The change action.
resourceChange_action :: Lens.Lens' ResourceChange (Prelude.Maybe ChangeAction)
resourceChange_action :: Lens' ResourceChange (Maybe ChangeAction)
resourceChange_action = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ResourceChange' {Maybe ChangeAction
action :: Maybe ChangeAction
$sel:action:ResourceChange' :: ResourceChange -> Maybe ChangeAction
action} -> Maybe ChangeAction
action) (\s :: ResourceChange
s@ResourceChange' {} Maybe ChangeAction
a -> ResourceChange
s {$sel:action:ResourceChange' :: Maybe ChangeAction
action = Maybe ChangeAction
a} :: ResourceChange)

-- | Information about the resource changes.
resourceChange_details :: Lens.Lens' ResourceChange (Prelude.Maybe [ResourceChangeDetail])
resourceChange_details :: Lens' ResourceChange (Maybe [ResourceChangeDetail])
resourceChange_details = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ResourceChange' {Maybe [ResourceChangeDetail]
details :: Maybe [ResourceChangeDetail]
$sel:details:ResourceChange' :: ResourceChange -> Maybe [ResourceChangeDetail]
details} -> Maybe [ResourceChangeDetail]
details) (\s :: ResourceChange
s@ResourceChange' {} Maybe [ResourceChangeDetail]
a -> ResourceChange
s {$sel:details:ResourceChange' :: Maybe [ResourceChangeDetail]
details = Maybe [ResourceChangeDetail]
a} :: ResourceChange) 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 resource, as defined in the CloudFormation template.
resourceChange_logicalResourceId :: Lens.Lens' ResourceChange (Prelude.Maybe Prelude.Text)
resourceChange_logicalResourceId :: Lens' ResourceChange (Maybe Text)
resourceChange_logicalResourceId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ResourceChange' {Maybe Text
logicalResourceId :: Maybe Text
$sel:logicalResourceId:ResourceChange' :: ResourceChange -> Maybe Text
logicalResourceId} -> Maybe Text
logicalResourceId) (\s :: ResourceChange
s@ResourceChange' {} Maybe Text
a -> ResourceChange
s {$sel:logicalResourceId:ResourceChange' :: Maybe Text
logicalResourceId = Maybe Text
a} :: ResourceChange)

-- | The ID of the resource, if it was already created.
resourceChange_physicalResourceId :: Lens.Lens' ResourceChange (Prelude.Maybe Prelude.Text)
resourceChange_physicalResourceId :: Lens' ResourceChange (Maybe Text)
resourceChange_physicalResourceId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ResourceChange' {Maybe Text
physicalResourceId :: Maybe Text
$sel:physicalResourceId:ResourceChange' :: ResourceChange -> Maybe Text
physicalResourceId} -> Maybe Text
physicalResourceId) (\s :: ResourceChange
s@ResourceChange' {} Maybe Text
a -> ResourceChange
s {$sel:physicalResourceId:ResourceChange' :: Maybe Text
physicalResourceId = Maybe Text
a} :: ResourceChange)

-- | If the change type is @Modify@, indicates whether the existing resource
-- is deleted and replaced with a new one.
resourceChange_replacement :: Lens.Lens' ResourceChange (Prelude.Maybe Replacement)
resourceChange_replacement :: Lens' ResourceChange (Maybe Replacement)
resourceChange_replacement = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ResourceChange' {Maybe Replacement
replacement :: Maybe Replacement
$sel:replacement:ResourceChange' :: ResourceChange -> Maybe Replacement
replacement} -> Maybe Replacement
replacement) (\s :: ResourceChange
s@ResourceChange' {} Maybe Replacement
a -> ResourceChange
s {$sel:replacement:ResourceChange' :: Maybe Replacement
replacement = Maybe Replacement
a} :: ResourceChange)

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

-- | The change scope.
resourceChange_scope :: Lens.Lens' ResourceChange (Prelude.Maybe [ResourceAttribute])
resourceChange_scope :: Lens' ResourceChange (Maybe [ResourceAttribute])
resourceChange_scope = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ResourceChange' {Maybe [ResourceAttribute]
scope :: Maybe [ResourceAttribute]
$sel:scope:ResourceChange' :: ResourceChange -> Maybe [ResourceAttribute]
scope} -> Maybe [ResourceAttribute]
scope) (\s :: ResourceChange
s@ResourceChange' {} Maybe [ResourceAttribute]
a -> ResourceChange
s {$sel:scope:ResourceChange' :: Maybe [ResourceAttribute]
scope = Maybe [ResourceAttribute]
a} :: ResourceChange) 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

instance Data.FromJSON ResourceChange where
  parseJSON :: Value -> Parser ResourceChange
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"ResourceChange"
      ( \Object
x ->
          Maybe ChangeAction
-> Maybe [ResourceChangeDetail]
-> Maybe Text
-> Maybe Text
-> Maybe Replacement
-> Maybe Text
-> Maybe [ResourceAttribute]
-> ResourceChange
ResourceChange'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"Action")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"Details" forall a. Parser (Maybe a) -> a -> Parser a
Data..!= forall a. Monoid a => a
Prelude.mempty)
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"LogicalResourceId")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"PhysicalResourceId")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"Replacement")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"ResourceType")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"Scope" forall a. Parser (Maybe a) -> a -> Parser a
Data..!= forall a. Monoid a => a
Prelude.mempty)
      )

instance Prelude.Hashable ResourceChange where
  hashWithSalt :: Int -> ResourceChange -> Int
hashWithSalt Int
_salt ResourceChange' {Maybe [ResourceAttribute]
Maybe [ResourceChangeDetail]
Maybe Text
Maybe ChangeAction
Maybe Replacement
scope :: Maybe [ResourceAttribute]
resourceType :: Maybe Text
replacement :: Maybe Replacement
physicalResourceId :: Maybe Text
logicalResourceId :: Maybe Text
details :: Maybe [ResourceChangeDetail]
action :: Maybe ChangeAction
$sel:scope:ResourceChange' :: ResourceChange -> Maybe [ResourceAttribute]
$sel:resourceType:ResourceChange' :: ResourceChange -> Maybe Text
$sel:replacement:ResourceChange' :: ResourceChange -> Maybe Replacement
$sel:physicalResourceId:ResourceChange' :: ResourceChange -> Maybe Text
$sel:logicalResourceId:ResourceChange' :: ResourceChange -> Maybe Text
$sel:details:ResourceChange' :: ResourceChange -> Maybe [ResourceChangeDetail]
$sel:action:ResourceChange' :: ResourceChange -> Maybe ChangeAction
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ChangeAction
action
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [ResourceChangeDetail]
details
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
logicalResourceId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
physicalResourceId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Replacement
replacement
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
resourceType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [ResourceAttribute]
scope

instance Prelude.NFData ResourceChange where
  rnf :: ResourceChange -> ()
rnf ResourceChange' {Maybe [ResourceAttribute]
Maybe [ResourceChangeDetail]
Maybe Text
Maybe ChangeAction
Maybe Replacement
scope :: Maybe [ResourceAttribute]
resourceType :: Maybe Text
replacement :: Maybe Replacement
physicalResourceId :: Maybe Text
logicalResourceId :: Maybe Text
details :: Maybe [ResourceChangeDetail]
action :: Maybe ChangeAction
$sel:scope:ResourceChange' :: ResourceChange -> Maybe [ResourceAttribute]
$sel:resourceType:ResourceChange' :: ResourceChange -> Maybe Text
$sel:replacement:ResourceChange' :: ResourceChange -> Maybe Replacement
$sel:physicalResourceId:ResourceChange' :: ResourceChange -> Maybe Text
$sel:logicalResourceId:ResourceChange' :: ResourceChange -> Maybe Text
$sel:details:ResourceChange' :: ResourceChange -> Maybe [ResourceChangeDetail]
$sel:action:ResourceChange' :: ResourceChange -> Maybe ChangeAction
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe ChangeAction
action
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [ResourceChangeDetail]
details
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
logicalResourceId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
physicalResourceId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Replacement
replacement
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
resourceType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [ResourceAttribute]
scope