{-# 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.ChangeSetHook
-- 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.ChangeSetHook where

import Amazonka.CloudFormation.Types.ChangeSetHookTargetDetails
import Amazonka.CloudFormation.Types.HookFailureMode
import Amazonka.CloudFormation.Types.HookInvocationPoint
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

-- | Specifies the resource, the hook, and the hook version to be invoked.
--
-- /See:/ 'newChangeSetHook' smart constructor.
data ChangeSetHook = ChangeSetHook'
  { -- | Specify the hook failure mode for non-compliant resources in the
    -- followings ways.
    --
    -- -   @FAIL@ Stops provisioning resources.
    --
    -- -   @WARN@ Allows provisioning to continue with a warning message.
    ChangeSetHook -> Maybe HookFailureMode
failureMode :: Prelude.Maybe HookFailureMode,
    -- | Specifies the points in provisioning logic where a hook is invoked.
    ChangeSetHook -> Maybe HookInvocationPoint
invocationPoint :: Prelude.Maybe HookInvocationPoint,
    -- | Specifies details about the target that the hook will run against.
    ChangeSetHook -> Maybe ChangeSetHookTargetDetails
targetDetails :: Prelude.Maybe ChangeSetHookTargetDetails,
    -- | The version ID of the type configuration.
    ChangeSetHook -> Maybe Text
typeConfigurationVersionId :: Prelude.Maybe Prelude.Text,
    -- | The unique name for your hook. Specifies a three-part namespace for your
    -- hook, with a recommended pattern of @Organization::Service::Hook@.
    --
    -- The following organization namespaces are reserved and can\'t be used in
    -- your hook type names:
    --
    -- -   @Alexa@
    --
    -- -   @AMZN@
    --
    -- -   @Amazon@
    --
    -- -   @ASK@
    --
    -- -   @AWS@
    --
    -- -   @Custom@
    --
    -- -   @Dev@
    ChangeSetHook -> Maybe Text
typeName :: Prelude.Maybe Prelude.Text,
    -- | The version ID of the type specified.
    ChangeSetHook -> Maybe Text
typeVersionId :: Prelude.Maybe Prelude.Text
  }
  deriving (ChangeSetHook -> ChangeSetHook -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ChangeSetHook -> ChangeSetHook -> Bool
$c/= :: ChangeSetHook -> ChangeSetHook -> Bool
== :: ChangeSetHook -> ChangeSetHook -> Bool
$c== :: ChangeSetHook -> ChangeSetHook -> Bool
Prelude.Eq, ReadPrec [ChangeSetHook]
ReadPrec ChangeSetHook
Int -> ReadS ChangeSetHook
ReadS [ChangeSetHook]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ChangeSetHook]
$creadListPrec :: ReadPrec [ChangeSetHook]
readPrec :: ReadPrec ChangeSetHook
$creadPrec :: ReadPrec ChangeSetHook
readList :: ReadS [ChangeSetHook]
$creadList :: ReadS [ChangeSetHook]
readsPrec :: Int -> ReadS ChangeSetHook
$creadsPrec :: Int -> ReadS ChangeSetHook
Prelude.Read, Int -> ChangeSetHook -> ShowS
[ChangeSetHook] -> ShowS
ChangeSetHook -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ChangeSetHook] -> ShowS
$cshowList :: [ChangeSetHook] -> ShowS
show :: ChangeSetHook -> String
$cshow :: ChangeSetHook -> String
showsPrec :: Int -> ChangeSetHook -> ShowS
$cshowsPrec :: Int -> ChangeSetHook -> ShowS
Prelude.Show, forall x. Rep ChangeSetHook x -> ChangeSetHook
forall x. ChangeSetHook -> Rep ChangeSetHook x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ChangeSetHook x -> ChangeSetHook
$cfrom :: forall x. ChangeSetHook -> Rep ChangeSetHook x
Prelude.Generic)

-- |
-- Create a value of 'ChangeSetHook' 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:
--
-- 'failureMode', 'changeSetHook_failureMode' - Specify the hook failure mode for non-compliant resources in the
-- followings ways.
--
-- -   @FAIL@ Stops provisioning resources.
--
-- -   @WARN@ Allows provisioning to continue with a warning message.
--
-- 'invocationPoint', 'changeSetHook_invocationPoint' - Specifies the points in provisioning logic where a hook is invoked.
--
-- 'targetDetails', 'changeSetHook_targetDetails' - Specifies details about the target that the hook will run against.
--
-- 'typeConfigurationVersionId', 'changeSetHook_typeConfigurationVersionId' - The version ID of the type configuration.
--
-- 'typeName', 'changeSetHook_typeName' - The unique name for your hook. Specifies a three-part namespace for your
-- hook, with a recommended pattern of @Organization::Service::Hook@.
--
-- The following organization namespaces are reserved and can\'t be used in
-- your hook type names:
--
-- -   @Alexa@
--
-- -   @AMZN@
--
-- -   @Amazon@
--
-- -   @ASK@
--
-- -   @AWS@
--
-- -   @Custom@
--
-- -   @Dev@
--
-- 'typeVersionId', 'changeSetHook_typeVersionId' - The version ID of the type specified.
newChangeSetHook ::
  ChangeSetHook
newChangeSetHook :: ChangeSetHook
newChangeSetHook =
  ChangeSetHook'
    { $sel:failureMode:ChangeSetHook' :: Maybe HookFailureMode
failureMode = forall a. Maybe a
Prelude.Nothing,
      $sel:invocationPoint:ChangeSetHook' :: Maybe HookInvocationPoint
invocationPoint = forall a. Maybe a
Prelude.Nothing,
      $sel:targetDetails:ChangeSetHook' :: Maybe ChangeSetHookTargetDetails
targetDetails = forall a. Maybe a
Prelude.Nothing,
      $sel:typeConfigurationVersionId:ChangeSetHook' :: Maybe Text
typeConfigurationVersionId = forall a. Maybe a
Prelude.Nothing,
      $sel:typeName:ChangeSetHook' :: Maybe Text
typeName = forall a. Maybe a
Prelude.Nothing,
      $sel:typeVersionId:ChangeSetHook' :: Maybe Text
typeVersionId = forall a. Maybe a
Prelude.Nothing
    }

-- | Specify the hook failure mode for non-compliant resources in the
-- followings ways.
--
-- -   @FAIL@ Stops provisioning resources.
--
-- -   @WARN@ Allows provisioning to continue with a warning message.
changeSetHook_failureMode :: Lens.Lens' ChangeSetHook (Prelude.Maybe HookFailureMode)
changeSetHook_failureMode :: Lens' ChangeSetHook (Maybe HookFailureMode)
changeSetHook_failureMode = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ChangeSetHook' {Maybe HookFailureMode
failureMode :: Maybe HookFailureMode
$sel:failureMode:ChangeSetHook' :: ChangeSetHook -> Maybe HookFailureMode
failureMode} -> Maybe HookFailureMode
failureMode) (\s :: ChangeSetHook
s@ChangeSetHook' {} Maybe HookFailureMode
a -> ChangeSetHook
s {$sel:failureMode:ChangeSetHook' :: Maybe HookFailureMode
failureMode = Maybe HookFailureMode
a} :: ChangeSetHook)

-- | Specifies the points in provisioning logic where a hook is invoked.
changeSetHook_invocationPoint :: Lens.Lens' ChangeSetHook (Prelude.Maybe HookInvocationPoint)
changeSetHook_invocationPoint :: Lens' ChangeSetHook (Maybe HookInvocationPoint)
changeSetHook_invocationPoint = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ChangeSetHook' {Maybe HookInvocationPoint
invocationPoint :: Maybe HookInvocationPoint
$sel:invocationPoint:ChangeSetHook' :: ChangeSetHook -> Maybe HookInvocationPoint
invocationPoint} -> Maybe HookInvocationPoint
invocationPoint) (\s :: ChangeSetHook
s@ChangeSetHook' {} Maybe HookInvocationPoint
a -> ChangeSetHook
s {$sel:invocationPoint:ChangeSetHook' :: Maybe HookInvocationPoint
invocationPoint = Maybe HookInvocationPoint
a} :: ChangeSetHook)

-- | Specifies details about the target that the hook will run against.
changeSetHook_targetDetails :: Lens.Lens' ChangeSetHook (Prelude.Maybe ChangeSetHookTargetDetails)
changeSetHook_targetDetails :: Lens' ChangeSetHook (Maybe ChangeSetHookTargetDetails)
changeSetHook_targetDetails = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ChangeSetHook' {Maybe ChangeSetHookTargetDetails
targetDetails :: Maybe ChangeSetHookTargetDetails
$sel:targetDetails:ChangeSetHook' :: ChangeSetHook -> Maybe ChangeSetHookTargetDetails
targetDetails} -> Maybe ChangeSetHookTargetDetails
targetDetails) (\s :: ChangeSetHook
s@ChangeSetHook' {} Maybe ChangeSetHookTargetDetails
a -> ChangeSetHook
s {$sel:targetDetails:ChangeSetHook' :: Maybe ChangeSetHookTargetDetails
targetDetails = Maybe ChangeSetHookTargetDetails
a} :: ChangeSetHook)

-- | The version ID of the type configuration.
changeSetHook_typeConfigurationVersionId :: Lens.Lens' ChangeSetHook (Prelude.Maybe Prelude.Text)
changeSetHook_typeConfigurationVersionId :: Lens' ChangeSetHook (Maybe Text)
changeSetHook_typeConfigurationVersionId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ChangeSetHook' {Maybe Text
typeConfigurationVersionId :: Maybe Text
$sel:typeConfigurationVersionId:ChangeSetHook' :: ChangeSetHook -> Maybe Text
typeConfigurationVersionId} -> Maybe Text
typeConfigurationVersionId) (\s :: ChangeSetHook
s@ChangeSetHook' {} Maybe Text
a -> ChangeSetHook
s {$sel:typeConfigurationVersionId:ChangeSetHook' :: Maybe Text
typeConfigurationVersionId = Maybe Text
a} :: ChangeSetHook)

-- | The unique name for your hook. Specifies a three-part namespace for your
-- hook, with a recommended pattern of @Organization::Service::Hook@.
--
-- The following organization namespaces are reserved and can\'t be used in
-- your hook type names:
--
-- -   @Alexa@
--
-- -   @AMZN@
--
-- -   @Amazon@
--
-- -   @ASK@
--
-- -   @AWS@
--
-- -   @Custom@
--
-- -   @Dev@
changeSetHook_typeName :: Lens.Lens' ChangeSetHook (Prelude.Maybe Prelude.Text)
changeSetHook_typeName :: Lens' ChangeSetHook (Maybe Text)
changeSetHook_typeName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ChangeSetHook' {Maybe Text
typeName :: Maybe Text
$sel:typeName:ChangeSetHook' :: ChangeSetHook -> Maybe Text
typeName} -> Maybe Text
typeName) (\s :: ChangeSetHook
s@ChangeSetHook' {} Maybe Text
a -> ChangeSetHook
s {$sel:typeName:ChangeSetHook' :: Maybe Text
typeName = Maybe Text
a} :: ChangeSetHook)

-- | The version ID of the type specified.
changeSetHook_typeVersionId :: Lens.Lens' ChangeSetHook (Prelude.Maybe Prelude.Text)
changeSetHook_typeVersionId :: Lens' ChangeSetHook (Maybe Text)
changeSetHook_typeVersionId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ChangeSetHook' {Maybe Text
typeVersionId :: Maybe Text
$sel:typeVersionId:ChangeSetHook' :: ChangeSetHook -> Maybe Text
typeVersionId} -> Maybe Text
typeVersionId) (\s :: ChangeSetHook
s@ChangeSetHook' {} Maybe Text
a -> ChangeSetHook
s {$sel:typeVersionId:ChangeSetHook' :: Maybe Text
typeVersionId = Maybe Text
a} :: ChangeSetHook)

instance Data.FromXML ChangeSetHook where
  parseXML :: [Node] -> Either String ChangeSetHook
parseXML [Node]
x =
    Maybe HookFailureMode
-> Maybe HookInvocationPoint
-> Maybe ChangeSetHookTargetDetails
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> ChangeSetHook
ChangeSetHook'
      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
"FailureMode")
      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
"InvocationPoint")
      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
"TargetDetails")
      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
"TypeConfigurationVersionId")
      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
"TypeName")
      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
"TypeVersionId")

instance Prelude.Hashable ChangeSetHook where
  hashWithSalt :: Int -> ChangeSetHook -> Int
hashWithSalt Int
_salt ChangeSetHook' {Maybe Text
Maybe HookFailureMode
Maybe HookInvocationPoint
Maybe ChangeSetHookTargetDetails
typeVersionId :: Maybe Text
typeName :: Maybe Text
typeConfigurationVersionId :: Maybe Text
targetDetails :: Maybe ChangeSetHookTargetDetails
invocationPoint :: Maybe HookInvocationPoint
failureMode :: Maybe HookFailureMode
$sel:typeVersionId:ChangeSetHook' :: ChangeSetHook -> Maybe Text
$sel:typeName:ChangeSetHook' :: ChangeSetHook -> Maybe Text
$sel:typeConfigurationVersionId:ChangeSetHook' :: ChangeSetHook -> Maybe Text
$sel:targetDetails:ChangeSetHook' :: ChangeSetHook -> Maybe ChangeSetHookTargetDetails
$sel:invocationPoint:ChangeSetHook' :: ChangeSetHook -> Maybe HookInvocationPoint
$sel:failureMode:ChangeSetHook' :: ChangeSetHook -> Maybe HookFailureMode
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe HookFailureMode
failureMode
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe HookInvocationPoint
invocationPoint
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ChangeSetHookTargetDetails
targetDetails
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
typeConfigurationVersionId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
typeName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
typeVersionId

instance Prelude.NFData ChangeSetHook where
  rnf :: ChangeSetHook -> ()
rnf ChangeSetHook' {Maybe Text
Maybe HookFailureMode
Maybe HookInvocationPoint
Maybe ChangeSetHookTargetDetails
typeVersionId :: Maybe Text
typeName :: Maybe Text
typeConfigurationVersionId :: Maybe Text
targetDetails :: Maybe ChangeSetHookTargetDetails
invocationPoint :: Maybe HookInvocationPoint
failureMode :: Maybe HookFailureMode
$sel:typeVersionId:ChangeSetHook' :: ChangeSetHook -> Maybe Text
$sel:typeName:ChangeSetHook' :: ChangeSetHook -> Maybe Text
$sel:typeConfigurationVersionId:ChangeSetHook' :: ChangeSetHook -> Maybe Text
$sel:targetDetails:ChangeSetHook' :: ChangeSetHook -> Maybe ChangeSetHookTargetDetails
$sel:invocationPoint:ChangeSetHook' :: ChangeSetHook -> Maybe HookInvocationPoint
$sel:failureMode:ChangeSetHook' :: ChangeSetHook -> Maybe HookFailureMode
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe HookFailureMode
failureMode
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe HookInvocationPoint
invocationPoint
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ChangeSetHookTargetDetails
targetDetails
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
typeConfigurationVersionId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
typeName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
typeVersionId