{-# 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.Budgets.Types.Action
-- 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.Budgets.Types.Action where

import Amazonka.Budgets.Types.ActionStatus
import Amazonka.Budgets.Types.ActionThreshold
import Amazonka.Budgets.Types.ActionType
import Amazonka.Budgets.Types.ApprovalModel
import Amazonka.Budgets.Types.Definition
import Amazonka.Budgets.Types.NotificationType
import Amazonka.Budgets.Types.Subscriber
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

-- | A budget action resource.
--
-- /See:/ 'newAction' smart constructor.
data Action = Action'
  { -- | A system-generated universally unique identifier (UUID) for the action.
    Action -> Text
actionId :: Prelude.Text,
    Action -> Text
budgetName :: Prelude.Text,
    Action -> NotificationType
notificationType :: NotificationType,
    -- | The type of action. This defines the type of tasks that can be carried
    -- out by this action. This field also determines the format for
    -- definition.
    Action -> ActionType
actionType :: ActionType,
    -- | The trigger threshold of the action.
    Action -> ActionThreshold
actionThreshold :: ActionThreshold,
    -- | Where you specify all of the type-specific parameters.
    Action -> Definition
definition :: Definition,
    -- | The role passed for action execution and reversion. Roles and actions
    -- must be in the same account.
    Action -> Text
executionRoleArn :: Prelude.Text,
    -- | This specifies if the action needs manual or automatic approval.
    Action -> ApprovalModel
approvalModel :: ApprovalModel,
    -- | The status of the action.
    Action -> ActionStatus
status :: ActionStatus,
    Action -> NonEmpty Subscriber
subscribers :: Prelude.NonEmpty Subscriber
  }
  deriving (Action -> Action -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Action -> Action -> Bool
$c/= :: Action -> Action -> Bool
== :: Action -> Action -> Bool
$c== :: Action -> Action -> Bool
Prelude.Eq, Int -> Action -> ShowS
[Action] -> ShowS
Action -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Action] -> ShowS
$cshowList :: [Action] -> ShowS
show :: Action -> String
$cshow :: Action -> String
showsPrec :: Int -> Action -> ShowS
$cshowsPrec :: Int -> Action -> ShowS
Prelude.Show, forall x. Rep Action x -> Action
forall x. Action -> Rep Action x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Action x -> Action
$cfrom :: forall x. Action -> Rep Action x
Prelude.Generic)

-- |
-- Create a value of 'Action' 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:
--
-- 'actionId', 'action_actionId' - A system-generated universally unique identifier (UUID) for the action.
--
-- 'budgetName', 'action_budgetName' - Undocumented member.
--
-- 'notificationType', 'action_notificationType' - Undocumented member.
--
-- 'actionType', 'action_actionType' - The type of action. This defines the type of tasks that can be carried
-- out by this action. This field also determines the format for
-- definition.
--
-- 'actionThreshold', 'action_actionThreshold' - The trigger threshold of the action.
--
-- 'definition', 'action_definition' - Where you specify all of the type-specific parameters.
--
-- 'executionRoleArn', 'action_executionRoleArn' - The role passed for action execution and reversion. Roles and actions
-- must be in the same account.
--
-- 'approvalModel', 'action_approvalModel' - This specifies if the action needs manual or automatic approval.
--
-- 'status', 'action_status' - The status of the action.
--
-- 'subscribers', 'action_subscribers' - Undocumented member.
newAction ::
  -- | 'actionId'
  Prelude.Text ->
  -- | 'budgetName'
  Prelude.Text ->
  -- | 'notificationType'
  NotificationType ->
  -- | 'actionType'
  ActionType ->
  -- | 'actionThreshold'
  ActionThreshold ->
  -- | 'definition'
  Definition ->
  -- | 'executionRoleArn'
  Prelude.Text ->
  -- | 'approvalModel'
  ApprovalModel ->
  -- | 'status'
  ActionStatus ->
  -- | 'subscribers'
  Prelude.NonEmpty Subscriber ->
  Action
newAction :: Text
-> Text
-> NotificationType
-> ActionType
-> ActionThreshold
-> Definition
-> Text
-> ApprovalModel
-> ActionStatus
-> NonEmpty Subscriber
-> Action
newAction
  Text
pActionId_
  Text
pBudgetName_
  NotificationType
pNotificationType_
  ActionType
pActionType_
  ActionThreshold
pActionThreshold_
  Definition
pDefinition_
  Text
pExecutionRoleArn_
  ApprovalModel
pApprovalModel_
  ActionStatus
pStatus_
  NonEmpty Subscriber
pSubscribers_ =
    Action'
      { $sel:actionId:Action' :: Text
actionId = Text
pActionId_,
        $sel:budgetName:Action' :: Text
budgetName = Text
pBudgetName_,
        $sel:notificationType:Action' :: NotificationType
notificationType = NotificationType
pNotificationType_,
        $sel:actionType:Action' :: ActionType
actionType = ActionType
pActionType_,
        $sel:actionThreshold:Action' :: ActionThreshold
actionThreshold = ActionThreshold
pActionThreshold_,
        $sel:definition:Action' :: Definition
definition = Definition
pDefinition_,
        $sel:executionRoleArn:Action' :: Text
executionRoleArn = Text
pExecutionRoleArn_,
        $sel:approvalModel:Action' :: ApprovalModel
approvalModel = ApprovalModel
pApprovalModel_,
        $sel:status:Action' :: ActionStatus
status = ActionStatus
pStatus_,
        $sel:subscribers:Action' :: NonEmpty Subscriber
subscribers = forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced forall t b. AReview t b -> b -> t
Lens.# NonEmpty Subscriber
pSubscribers_
      }

-- | A system-generated universally unique identifier (UUID) for the action.
action_actionId :: Lens.Lens' Action Prelude.Text
action_actionId :: Lens' Action Text
action_actionId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Action' {Text
actionId :: Text
$sel:actionId:Action' :: Action -> Text
actionId} -> Text
actionId) (\s :: Action
s@Action' {} Text
a -> Action
s {$sel:actionId:Action' :: Text
actionId = Text
a} :: Action)

-- | Undocumented member.
action_budgetName :: Lens.Lens' Action Prelude.Text
action_budgetName :: Lens' Action Text
action_budgetName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Action' {Text
budgetName :: Text
$sel:budgetName:Action' :: Action -> Text
budgetName} -> Text
budgetName) (\s :: Action
s@Action' {} Text
a -> Action
s {$sel:budgetName:Action' :: Text
budgetName = Text
a} :: Action)

-- | Undocumented member.
action_notificationType :: Lens.Lens' Action NotificationType
action_notificationType :: Lens' Action NotificationType
action_notificationType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Action' {NotificationType
notificationType :: NotificationType
$sel:notificationType:Action' :: Action -> NotificationType
notificationType} -> NotificationType
notificationType) (\s :: Action
s@Action' {} NotificationType
a -> Action
s {$sel:notificationType:Action' :: NotificationType
notificationType = NotificationType
a} :: Action)

-- | The type of action. This defines the type of tasks that can be carried
-- out by this action. This field also determines the format for
-- definition.
action_actionType :: Lens.Lens' Action ActionType
action_actionType :: Lens' Action ActionType
action_actionType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Action' {ActionType
actionType :: ActionType
$sel:actionType:Action' :: Action -> ActionType
actionType} -> ActionType
actionType) (\s :: Action
s@Action' {} ActionType
a -> Action
s {$sel:actionType:Action' :: ActionType
actionType = ActionType
a} :: Action)

-- | The trigger threshold of the action.
action_actionThreshold :: Lens.Lens' Action ActionThreshold
action_actionThreshold :: Lens' Action ActionThreshold
action_actionThreshold = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Action' {ActionThreshold
actionThreshold :: ActionThreshold
$sel:actionThreshold:Action' :: Action -> ActionThreshold
actionThreshold} -> ActionThreshold
actionThreshold) (\s :: Action
s@Action' {} ActionThreshold
a -> Action
s {$sel:actionThreshold:Action' :: ActionThreshold
actionThreshold = ActionThreshold
a} :: Action)

-- | Where you specify all of the type-specific parameters.
action_definition :: Lens.Lens' Action Definition
action_definition :: Lens' Action Definition
action_definition = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Action' {Definition
definition :: Definition
$sel:definition:Action' :: Action -> Definition
definition} -> Definition
definition) (\s :: Action
s@Action' {} Definition
a -> Action
s {$sel:definition:Action' :: Definition
definition = Definition
a} :: Action)

-- | The role passed for action execution and reversion. Roles and actions
-- must be in the same account.
action_executionRoleArn :: Lens.Lens' Action Prelude.Text
action_executionRoleArn :: Lens' Action Text
action_executionRoleArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Action' {Text
executionRoleArn :: Text
$sel:executionRoleArn:Action' :: Action -> Text
executionRoleArn} -> Text
executionRoleArn) (\s :: Action
s@Action' {} Text
a -> Action
s {$sel:executionRoleArn:Action' :: Text
executionRoleArn = Text
a} :: Action)

-- | This specifies if the action needs manual or automatic approval.
action_approvalModel :: Lens.Lens' Action ApprovalModel
action_approvalModel :: Lens' Action ApprovalModel
action_approvalModel = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Action' {ApprovalModel
approvalModel :: ApprovalModel
$sel:approvalModel:Action' :: Action -> ApprovalModel
approvalModel} -> ApprovalModel
approvalModel) (\s :: Action
s@Action' {} ApprovalModel
a -> Action
s {$sel:approvalModel:Action' :: ApprovalModel
approvalModel = ApprovalModel
a} :: Action)

-- | The status of the action.
action_status :: Lens.Lens' Action ActionStatus
action_status :: Lens' Action ActionStatus
action_status = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Action' {ActionStatus
status :: ActionStatus
$sel:status:Action' :: Action -> ActionStatus
status} -> ActionStatus
status) (\s :: Action
s@Action' {} ActionStatus
a -> Action
s {$sel:status:Action' :: ActionStatus
status = ActionStatus
a} :: Action)

-- | Undocumented member.
action_subscribers :: Lens.Lens' Action (Prelude.NonEmpty Subscriber)
action_subscribers :: Lens' Action (NonEmpty Subscriber)
action_subscribers = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Action' {NonEmpty Subscriber
subscribers :: NonEmpty Subscriber
$sel:subscribers:Action' :: Action -> NonEmpty Subscriber
subscribers} -> NonEmpty Subscriber
subscribers) (\s :: Action
s@Action' {} NonEmpty Subscriber
a -> Action
s {$sel:subscribers:Action' :: NonEmpty Subscriber
subscribers = NonEmpty Subscriber
a} :: Action) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

instance Data.FromJSON Action where
  parseJSON :: Value -> Parser Action
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"Action"
      ( \Object
x ->
          Text
-> Text
-> NotificationType
-> ActionType
-> ActionThreshold
-> Definition
-> Text
-> ApprovalModel
-> ActionStatus
-> NonEmpty Subscriber
-> Action
Action'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Parser a
Data..: Key
"ActionId")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser a
Data..: Key
"BudgetName")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser a
Data..: Key
"NotificationType")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser a
Data..: Key
"ActionType")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser a
Data..: Key
"ActionThreshold")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser a
Data..: Key
"Definition")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser a
Data..: Key
"ExecutionRoleArn")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser a
Data..: Key
"ApprovalModel")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser a
Data..: Key
"Status")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser a
Data..: Key
"Subscribers")
      )

instance Prelude.Hashable Action where
  hashWithSalt :: Int -> Action -> Int
hashWithSalt Int
_salt Action' {NonEmpty Subscriber
Text
ActionStatus
ActionType
ApprovalModel
NotificationType
Definition
ActionThreshold
subscribers :: NonEmpty Subscriber
status :: ActionStatus
approvalModel :: ApprovalModel
executionRoleArn :: Text
definition :: Definition
actionThreshold :: ActionThreshold
actionType :: ActionType
notificationType :: NotificationType
budgetName :: Text
actionId :: Text
$sel:subscribers:Action' :: Action -> NonEmpty Subscriber
$sel:status:Action' :: Action -> ActionStatus
$sel:approvalModel:Action' :: Action -> ApprovalModel
$sel:executionRoleArn:Action' :: Action -> Text
$sel:definition:Action' :: Action -> Definition
$sel:actionThreshold:Action' :: Action -> ActionThreshold
$sel:actionType:Action' :: Action -> ActionType
$sel:notificationType:Action' :: Action -> NotificationType
$sel:budgetName:Action' :: Action -> Text
$sel:actionId:Action' :: Action -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
actionId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
budgetName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` NotificationType
notificationType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` ActionType
actionType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` ActionThreshold
actionThreshold
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Definition
definition
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
executionRoleArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` ApprovalModel
approvalModel
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` ActionStatus
status
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` NonEmpty Subscriber
subscribers

instance Prelude.NFData Action where
  rnf :: Action -> ()
rnf Action' {NonEmpty Subscriber
Text
ActionStatus
ActionType
ApprovalModel
NotificationType
Definition
ActionThreshold
subscribers :: NonEmpty Subscriber
status :: ActionStatus
approvalModel :: ApprovalModel
executionRoleArn :: Text
definition :: Definition
actionThreshold :: ActionThreshold
actionType :: ActionType
notificationType :: NotificationType
budgetName :: Text
actionId :: Text
$sel:subscribers:Action' :: Action -> NonEmpty Subscriber
$sel:status:Action' :: Action -> ActionStatus
$sel:approvalModel:Action' :: Action -> ApprovalModel
$sel:executionRoleArn:Action' :: Action -> Text
$sel:definition:Action' :: Action -> Definition
$sel:actionThreshold:Action' :: Action -> ActionThreshold
$sel:actionType:Action' :: Action -> ActionType
$sel:notificationType:Action' :: Action -> NotificationType
$sel:budgetName:Action' :: Action -> Text
$sel:actionId:Action' :: Action -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
actionId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
budgetName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf NotificationType
notificationType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf ActionType
actionType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf ActionThreshold
actionThreshold
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Definition
definition
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
executionRoleArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf ApprovalModel
approvalModel
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf ActionStatus
status
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf NonEmpty Subscriber
subscribers