{-# 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.Budgets.CreateBudgetAction
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Creates a budget action.
module Amazonka.Budgets.CreateBudgetAction
  ( -- * Creating a Request
    CreateBudgetAction (..),
    newCreateBudgetAction,

    -- * Request Lenses
    createBudgetAction_accountId,
    createBudgetAction_budgetName,
    createBudgetAction_notificationType,
    createBudgetAction_actionType,
    createBudgetAction_actionThreshold,
    createBudgetAction_definition,
    createBudgetAction_executionRoleArn,
    createBudgetAction_approvalModel,
    createBudgetAction_subscribers,

    -- * Destructuring the Response
    CreateBudgetActionResponse (..),
    newCreateBudgetActionResponse,

    -- * Response Lenses
    createBudgetActionResponse_httpStatus,
    createBudgetActionResponse_accountId,
    createBudgetActionResponse_budgetName,
    createBudgetActionResponse_actionId,
  )
where

import Amazonka.Budgets.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:/ 'newCreateBudgetAction' smart constructor.
data CreateBudgetAction = CreateBudgetAction'
  { CreateBudgetAction -> Text
accountId :: Prelude.Text,
    CreateBudgetAction -> Text
budgetName :: Prelude.Text,
    CreateBudgetAction -> 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.
    CreateBudgetAction -> ActionType
actionType :: ActionType,
    CreateBudgetAction -> ActionThreshold
actionThreshold :: ActionThreshold,
    CreateBudgetAction -> Definition
definition :: Definition,
    -- | The role passed for action execution and reversion. Roles and actions
    -- must be in the same account.
    CreateBudgetAction -> Text
executionRoleArn :: Prelude.Text,
    -- | This specifies if the action needs manual or automatic approval.
    CreateBudgetAction -> ApprovalModel
approvalModel :: ApprovalModel,
    CreateBudgetAction -> NonEmpty Subscriber
subscribers :: Prelude.NonEmpty Subscriber
  }
  deriving (CreateBudgetAction -> CreateBudgetAction -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateBudgetAction -> CreateBudgetAction -> Bool
$c/= :: CreateBudgetAction -> CreateBudgetAction -> Bool
== :: CreateBudgetAction -> CreateBudgetAction -> Bool
$c== :: CreateBudgetAction -> CreateBudgetAction -> Bool
Prelude.Eq, Int -> CreateBudgetAction -> ShowS
[CreateBudgetAction] -> ShowS
CreateBudgetAction -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateBudgetAction] -> ShowS
$cshowList :: [CreateBudgetAction] -> ShowS
show :: CreateBudgetAction -> String
$cshow :: CreateBudgetAction -> String
showsPrec :: Int -> CreateBudgetAction -> ShowS
$cshowsPrec :: Int -> CreateBudgetAction -> ShowS
Prelude.Show, forall x. Rep CreateBudgetAction x -> CreateBudgetAction
forall x. CreateBudgetAction -> Rep CreateBudgetAction x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateBudgetAction x -> CreateBudgetAction
$cfrom :: forall x. CreateBudgetAction -> Rep CreateBudgetAction x
Prelude.Generic)

-- |
-- Create a value of 'CreateBudgetAction' 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:
--
-- 'accountId', 'createBudgetAction_accountId' - Undocumented member.
--
-- 'budgetName', 'createBudgetAction_budgetName' - Undocumented member.
--
-- 'notificationType', 'createBudgetAction_notificationType' - Undocumented member.
--
-- 'actionType', 'createBudgetAction_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', 'createBudgetAction_actionThreshold' - Undocumented member.
--
-- 'definition', 'createBudgetAction_definition' - Undocumented member.
--
-- 'executionRoleArn', 'createBudgetAction_executionRoleArn' - The role passed for action execution and reversion. Roles and actions
-- must be in the same account.
--
-- 'approvalModel', 'createBudgetAction_approvalModel' - This specifies if the action needs manual or automatic approval.
--
-- 'subscribers', 'createBudgetAction_subscribers' - Undocumented member.
newCreateBudgetAction ::
  -- | 'accountId'
  Prelude.Text ->
  -- | 'budgetName'
  Prelude.Text ->
  -- | 'notificationType'
  NotificationType ->
  -- | 'actionType'
  ActionType ->
  -- | 'actionThreshold'
  ActionThreshold ->
  -- | 'definition'
  Definition ->
  -- | 'executionRoleArn'
  Prelude.Text ->
  -- | 'approvalModel'
  ApprovalModel ->
  -- | 'subscribers'
  Prelude.NonEmpty Subscriber ->
  CreateBudgetAction
newCreateBudgetAction :: Text
-> Text
-> NotificationType
-> ActionType
-> ActionThreshold
-> Definition
-> Text
-> ApprovalModel
-> NonEmpty Subscriber
-> CreateBudgetAction
newCreateBudgetAction
  Text
pAccountId_
  Text
pBudgetName_
  NotificationType
pNotificationType_
  ActionType
pActionType_
  ActionThreshold
pActionThreshold_
  Definition
pDefinition_
  Text
pExecutionRoleArn_
  ApprovalModel
pApprovalModel_
  NonEmpty Subscriber
pSubscribers_ =
    CreateBudgetAction'
      { $sel:accountId:CreateBudgetAction' :: Text
accountId = Text
pAccountId_,
        $sel:budgetName:CreateBudgetAction' :: Text
budgetName = Text
pBudgetName_,
        $sel:notificationType:CreateBudgetAction' :: NotificationType
notificationType = NotificationType
pNotificationType_,
        $sel:actionType:CreateBudgetAction' :: ActionType
actionType = ActionType
pActionType_,
        $sel:actionThreshold:CreateBudgetAction' :: ActionThreshold
actionThreshold = ActionThreshold
pActionThreshold_,
        $sel:definition:CreateBudgetAction' :: Definition
definition = Definition
pDefinition_,
        $sel:executionRoleArn:CreateBudgetAction' :: Text
executionRoleArn = Text
pExecutionRoleArn_,
        $sel:approvalModel:CreateBudgetAction' :: ApprovalModel
approvalModel = ApprovalModel
pApprovalModel_,
        $sel:subscribers:CreateBudgetAction' :: 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_
      }

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

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

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

-- | 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.
createBudgetAction_actionType :: Lens.Lens' CreateBudgetAction ActionType
createBudgetAction_actionType :: Lens' CreateBudgetAction ActionType
createBudgetAction_actionType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateBudgetAction' {ActionType
actionType :: ActionType
$sel:actionType:CreateBudgetAction' :: CreateBudgetAction -> ActionType
actionType} -> ActionType
actionType) (\s :: CreateBudgetAction
s@CreateBudgetAction' {} ActionType
a -> CreateBudgetAction
s {$sel:actionType:CreateBudgetAction' :: ActionType
actionType = ActionType
a} :: CreateBudgetAction)

-- | Undocumented member.
createBudgetAction_actionThreshold :: Lens.Lens' CreateBudgetAction ActionThreshold
createBudgetAction_actionThreshold :: Lens' CreateBudgetAction ActionThreshold
createBudgetAction_actionThreshold = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateBudgetAction' {ActionThreshold
actionThreshold :: ActionThreshold
$sel:actionThreshold:CreateBudgetAction' :: CreateBudgetAction -> ActionThreshold
actionThreshold} -> ActionThreshold
actionThreshold) (\s :: CreateBudgetAction
s@CreateBudgetAction' {} ActionThreshold
a -> CreateBudgetAction
s {$sel:actionThreshold:CreateBudgetAction' :: ActionThreshold
actionThreshold = ActionThreshold
a} :: CreateBudgetAction)

-- | Undocumented member.
createBudgetAction_definition :: Lens.Lens' CreateBudgetAction Definition
createBudgetAction_definition :: Lens' CreateBudgetAction Definition
createBudgetAction_definition = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateBudgetAction' {Definition
definition :: Definition
$sel:definition:CreateBudgetAction' :: CreateBudgetAction -> Definition
definition} -> Definition
definition) (\s :: CreateBudgetAction
s@CreateBudgetAction' {} Definition
a -> CreateBudgetAction
s {$sel:definition:CreateBudgetAction' :: Definition
definition = Definition
a} :: CreateBudgetAction)

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

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

-- | Undocumented member.
createBudgetAction_subscribers :: Lens.Lens' CreateBudgetAction (Prelude.NonEmpty Subscriber)
createBudgetAction_subscribers :: Lens' CreateBudgetAction (NonEmpty Subscriber)
createBudgetAction_subscribers = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateBudgetAction' {NonEmpty Subscriber
subscribers :: NonEmpty Subscriber
$sel:subscribers:CreateBudgetAction' :: CreateBudgetAction -> NonEmpty Subscriber
subscribers} -> NonEmpty Subscriber
subscribers) (\s :: CreateBudgetAction
s@CreateBudgetAction' {} NonEmpty Subscriber
a -> CreateBudgetAction
s {$sel:subscribers:CreateBudgetAction' :: NonEmpty Subscriber
subscribers = NonEmpty Subscriber
a} :: CreateBudgetAction) 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 Core.AWSRequest CreateBudgetAction where
  type
    AWSResponse CreateBudgetAction =
      CreateBudgetActionResponse
  request :: (Service -> Service)
-> CreateBudgetAction -> Request CreateBudgetAction
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.postJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy CreateBudgetAction
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CreateBudgetAction)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> Object -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveJSON
      ( \Int
s ResponseHeaders
h Object
x ->
          Int -> Text -> Text -> Text -> CreateBudgetActionResponse
CreateBudgetActionResponse'
            forall (f :: * -> *) a b. Functor 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))
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"AccountId")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String 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 -> Either String a
Data..:> Key
"ActionId")
      )

instance Prelude.Hashable CreateBudgetAction where
  hashWithSalt :: Int -> CreateBudgetAction -> Int
hashWithSalt Int
_salt CreateBudgetAction' {NonEmpty Subscriber
Text
ActionType
ApprovalModel
NotificationType
Definition
ActionThreshold
subscribers :: NonEmpty Subscriber
approvalModel :: ApprovalModel
executionRoleArn :: Text
definition :: Definition
actionThreshold :: ActionThreshold
actionType :: ActionType
notificationType :: NotificationType
budgetName :: Text
accountId :: Text
$sel:subscribers:CreateBudgetAction' :: CreateBudgetAction -> NonEmpty Subscriber
$sel:approvalModel:CreateBudgetAction' :: CreateBudgetAction -> ApprovalModel
$sel:executionRoleArn:CreateBudgetAction' :: CreateBudgetAction -> Text
$sel:definition:CreateBudgetAction' :: CreateBudgetAction -> Definition
$sel:actionThreshold:CreateBudgetAction' :: CreateBudgetAction -> ActionThreshold
$sel:actionType:CreateBudgetAction' :: CreateBudgetAction -> ActionType
$sel:notificationType:CreateBudgetAction' :: CreateBudgetAction -> NotificationType
$sel:budgetName:CreateBudgetAction' :: CreateBudgetAction -> Text
$sel:accountId:CreateBudgetAction' :: CreateBudgetAction -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
accountId
      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` NonEmpty Subscriber
subscribers

instance Prelude.NFData CreateBudgetAction where
  rnf :: CreateBudgetAction -> ()
rnf CreateBudgetAction' {NonEmpty Subscriber
Text
ActionType
ApprovalModel
NotificationType
Definition
ActionThreshold
subscribers :: NonEmpty Subscriber
approvalModel :: ApprovalModel
executionRoleArn :: Text
definition :: Definition
actionThreshold :: ActionThreshold
actionType :: ActionType
notificationType :: NotificationType
budgetName :: Text
accountId :: Text
$sel:subscribers:CreateBudgetAction' :: CreateBudgetAction -> NonEmpty Subscriber
$sel:approvalModel:CreateBudgetAction' :: CreateBudgetAction -> ApprovalModel
$sel:executionRoleArn:CreateBudgetAction' :: CreateBudgetAction -> Text
$sel:definition:CreateBudgetAction' :: CreateBudgetAction -> Definition
$sel:actionThreshold:CreateBudgetAction' :: CreateBudgetAction -> ActionThreshold
$sel:actionType:CreateBudgetAction' :: CreateBudgetAction -> ActionType
$sel:notificationType:CreateBudgetAction' :: CreateBudgetAction -> NotificationType
$sel:budgetName:CreateBudgetAction' :: CreateBudgetAction -> Text
$sel:accountId:CreateBudgetAction' :: CreateBudgetAction -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
accountId
      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 NonEmpty Subscriber
subscribers

instance Data.ToHeaders CreateBudgetAction where
  toHeaders :: CreateBudgetAction -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"X-Amz-Target"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"AWSBudgetServiceGateway.CreateBudgetAction" ::
                          Prelude.ByteString
                      ),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON CreateBudgetAction where
  toJSON :: CreateBudgetAction -> Value
toJSON CreateBudgetAction' {NonEmpty Subscriber
Text
ActionType
ApprovalModel
NotificationType
Definition
ActionThreshold
subscribers :: NonEmpty Subscriber
approvalModel :: ApprovalModel
executionRoleArn :: Text
definition :: Definition
actionThreshold :: ActionThreshold
actionType :: ActionType
notificationType :: NotificationType
budgetName :: Text
accountId :: Text
$sel:subscribers:CreateBudgetAction' :: CreateBudgetAction -> NonEmpty Subscriber
$sel:approvalModel:CreateBudgetAction' :: CreateBudgetAction -> ApprovalModel
$sel:executionRoleArn:CreateBudgetAction' :: CreateBudgetAction -> Text
$sel:definition:CreateBudgetAction' :: CreateBudgetAction -> Definition
$sel:actionThreshold:CreateBudgetAction' :: CreateBudgetAction -> ActionThreshold
$sel:actionType:CreateBudgetAction' :: CreateBudgetAction -> ActionType
$sel:notificationType:CreateBudgetAction' :: CreateBudgetAction -> NotificationType
$sel:budgetName:CreateBudgetAction' :: CreateBudgetAction -> Text
$sel:accountId:CreateBudgetAction' :: CreateBudgetAction -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just (Key
"AccountId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
accountId),
            forall a. a -> Maybe a
Prelude.Just (Key
"BudgetName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
budgetName),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"NotificationType" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= NotificationType
notificationType),
            forall a. a -> Maybe a
Prelude.Just (Key
"ActionType" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= ActionType
actionType),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"ActionThreshold" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= ActionThreshold
actionThreshold),
            forall a. a -> Maybe a
Prelude.Just (Key
"Definition" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Definition
definition),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"ExecutionRoleArn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
executionRoleArn),
            forall a. a -> Maybe a
Prelude.Just (Key
"ApprovalModel" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= ApprovalModel
approvalModel),
            forall a. a -> Maybe a
Prelude.Just (Key
"Subscribers" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= NonEmpty Subscriber
subscribers)
          ]
      )

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

instance Data.ToQuery CreateBudgetAction where
  toQuery :: CreateBudgetAction -> QueryString
toQuery = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

-- | /See:/ 'newCreateBudgetActionResponse' smart constructor.
data CreateBudgetActionResponse = CreateBudgetActionResponse'
  { -- | The response's http status code.
    CreateBudgetActionResponse -> Int
httpStatus :: Prelude.Int,
    CreateBudgetActionResponse -> Text
accountId :: Prelude.Text,
    CreateBudgetActionResponse -> Text
budgetName :: Prelude.Text,
    -- | A system-generated universally unique identifier (UUID) for the action.
    CreateBudgetActionResponse -> Text
actionId :: Prelude.Text
  }
  deriving (CreateBudgetActionResponse -> CreateBudgetActionResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateBudgetActionResponse -> CreateBudgetActionResponse -> Bool
$c/= :: CreateBudgetActionResponse -> CreateBudgetActionResponse -> Bool
== :: CreateBudgetActionResponse -> CreateBudgetActionResponse -> Bool
$c== :: CreateBudgetActionResponse -> CreateBudgetActionResponse -> Bool
Prelude.Eq, ReadPrec [CreateBudgetActionResponse]
ReadPrec CreateBudgetActionResponse
Int -> ReadS CreateBudgetActionResponse
ReadS [CreateBudgetActionResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateBudgetActionResponse]
$creadListPrec :: ReadPrec [CreateBudgetActionResponse]
readPrec :: ReadPrec CreateBudgetActionResponse
$creadPrec :: ReadPrec CreateBudgetActionResponse
readList :: ReadS [CreateBudgetActionResponse]
$creadList :: ReadS [CreateBudgetActionResponse]
readsPrec :: Int -> ReadS CreateBudgetActionResponse
$creadsPrec :: Int -> ReadS CreateBudgetActionResponse
Prelude.Read, Int -> CreateBudgetActionResponse -> ShowS
[CreateBudgetActionResponse] -> ShowS
CreateBudgetActionResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateBudgetActionResponse] -> ShowS
$cshowList :: [CreateBudgetActionResponse] -> ShowS
show :: CreateBudgetActionResponse -> String
$cshow :: CreateBudgetActionResponse -> String
showsPrec :: Int -> CreateBudgetActionResponse -> ShowS
$cshowsPrec :: Int -> CreateBudgetActionResponse -> ShowS
Prelude.Show, forall x.
Rep CreateBudgetActionResponse x -> CreateBudgetActionResponse
forall x.
CreateBudgetActionResponse -> Rep CreateBudgetActionResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateBudgetActionResponse x -> CreateBudgetActionResponse
$cfrom :: forall x.
CreateBudgetActionResponse -> Rep CreateBudgetActionResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateBudgetActionResponse' 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:
--
-- 'httpStatus', 'createBudgetActionResponse_httpStatus' - The response's http status code.
--
-- 'accountId', 'createBudgetActionResponse_accountId' - Undocumented member.
--
-- 'budgetName', 'createBudgetActionResponse_budgetName' - Undocumented member.
--
-- 'actionId', 'createBudgetActionResponse_actionId' - A system-generated universally unique identifier (UUID) for the action.
newCreateBudgetActionResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'accountId'
  Prelude.Text ->
  -- | 'budgetName'
  Prelude.Text ->
  -- | 'actionId'
  Prelude.Text ->
  CreateBudgetActionResponse
newCreateBudgetActionResponse :: Int -> Text -> Text -> Text -> CreateBudgetActionResponse
newCreateBudgetActionResponse
  Int
pHttpStatus_
  Text
pAccountId_
  Text
pBudgetName_
  Text
pActionId_ =
    CreateBudgetActionResponse'
      { $sel:httpStatus:CreateBudgetActionResponse' :: Int
httpStatus =
          Int
pHttpStatus_,
        $sel:accountId:CreateBudgetActionResponse' :: Text
accountId = Text
pAccountId_,
        $sel:budgetName:CreateBudgetActionResponse' :: Text
budgetName = Text
pBudgetName_,
        $sel:actionId:CreateBudgetActionResponse' :: Text
actionId = Text
pActionId_
      }

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

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

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

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

instance Prelude.NFData CreateBudgetActionResponse where
  rnf :: CreateBudgetActionResponse -> ()
rnf CreateBudgetActionResponse' {Int
Text
actionId :: Text
budgetName :: Text
accountId :: Text
httpStatus :: Int
$sel:actionId:CreateBudgetActionResponse' :: CreateBudgetActionResponse -> Text
$sel:budgetName:CreateBudgetActionResponse' :: CreateBudgetActionResponse -> Text
$sel:accountId:CreateBudgetActionResponse' :: CreateBudgetActionResponse -> Text
$sel:httpStatus:CreateBudgetActionResponse' :: CreateBudgetActionResponse -> Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
accountId
      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 Text
actionId