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

import Amazonka.Budgets.Types.AutoAdjustData
import Amazonka.Budgets.Types.BudgetType
import Amazonka.Budgets.Types.CalculatedSpend
import Amazonka.Budgets.Types.CostTypes
import Amazonka.Budgets.Types.Spend
import Amazonka.Budgets.Types.TimePeriod
import Amazonka.Budgets.Types.TimeUnit
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

-- | Represents the output of the @CreateBudget@ operation. The content
-- consists of the detailed metadata and data file information, and the
-- current status of the @budget@ object.
--
-- This is the Amazon Resource Name (ARN) pattern for a budget:
--
-- @arn:aws:budgets::AccountId:budget\/budgetName@
--
-- /See:/ 'newBudget' smart constructor.
data Budget = Budget'
  { -- | The parameters that determine the budget amount for an auto-adjusting
    -- budget.
    Budget -> Maybe AutoAdjustData
autoAdjustData :: Prelude.Maybe AutoAdjustData,
    -- | The total amount of cost, usage, RI utilization, RI coverage, Savings
    -- Plans utilization, or Savings Plans coverage that you want to track with
    -- your budget.
    --
    -- @BudgetLimit@ is required for cost or usage budgets, but optional for RI
    -- or Savings Plans utilization or coverage budgets. RI and Savings Plans
    -- utilization or coverage budgets default to @100@. This is the only valid
    -- value for RI or Savings Plans utilization or coverage budgets. You
    -- can\'t use @BudgetLimit@ with @PlannedBudgetLimits@ for @CreateBudget@
    -- and @UpdateBudget@ actions.
    Budget -> Maybe Spend
budgetLimit :: Prelude.Maybe Spend,
    -- | The actual and forecasted cost or usage that the budget tracks.
    Budget -> Maybe CalculatedSpend
calculatedSpend :: Prelude.Maybe CalculatedSpend,
    -- | The cost filters, such as @Region@, @Service@, @member account@, @Tag@,
    -- or @Cost Category@, that are applied to a budget.
    --
    -- Amazon Web Services Budgets supports the following services as a
    -- @Service@ filter for RI budgets:
    --
    -- -   Amazon EC2
    --
    -- -   Amazon Redshift
    --
    -- -   Amazon Relational Database Service
    --
    -- -   Amazon ElastiCache
    --
    -- -   Amazon OpenSearch Service
    Budget -> Maybe (HashMap Text [Text])
costFilters :: Prelude.Maybe (Prelude.HashMap Prelude.Text [Prelude.Text]),
    -- | The types of costs that are included in this @COST@ budget.
    --
    -- @USAGE@, @RI_UTILIZATION@, @RI_COVERAGE@, @SAVINGS_PLANS_UTILIZATION@,
    -- and @SAVINGS_PLANS_COVERAGE@ budgets do not have @CostTypes@.
    Budget -> Maybe CostTypes
costTypes :: Prelude.Maybe CostTypes,
    -- | The last time that you updated this budget.
    Budget -> Maybe POSIX
lastUpdatedTime :: Prelude.Maybe Data.POSIX,
    -- | A map containing multiple @BudgetLimit@, including current or future
    -- limits.
    --
    -- @PlannedBudgetLimits@ is available for cost or usage budget and supports
    -- both monthly and quarterly @TimeUnit@.
    --
    -- For monthly budgets, provide 12 months of @PlannedBudgetLimits@ values.
    -- This must start from the current month and include the next 11 months.
    -- The @key@ is the start of the month, @UTC@ in epoch seconds.
    --
    -- For quarterly budgets, provide four quarters of @PlannedBudgetLimits@
    -- value entries in standard calendar quarter increments. This must start
    -- from the current quarter and include the next three quarters. The @key@
    -- is the start of the quarter, @UTC@ in epoch seconds.
    --
    -- If the planned budget expires before 12 months for monthly or four
    -- quarters for quarterly, provide the @PlannedBudgetLimits@ values only
    -- for the remaining periods.
    --
    -- If the budget begins at a date in the future, provide
    -- @PlannedBudgetLimits@ values from the start date of the budget.
    --
    -- After all of the @BudgetLimit@ values in @PlannedBudgetLimits@ are used,
    -- the budget continues to use the last limit as the @BudgetLimit@. At that
    -- point, the planned budget provides the same experience as a fixed
    -- budget.
    --
    -- @DescribeBudget@ and @DescribeBudgets@ response along with
    -- @PlannedBudgetLimits@ also contain @BudgetLimit@ representing the
    -- current month or quarter limit present in @PlannedBudgetLimits@. This
    -- only applies to budgets that are created with @PlannedBudgetLimits@.
    -- Budgets that are created without @PlannedBudgetLimits@ only contain
    -- @BudgetLimit@. They don\'t contain @PlannedBudgetLimits@.
    Budget -> Maybe (HashMap Text Spend)
plannedBudgetLimits :: Prelude.Maybe (Prelude.HashMap Prelude.Text Spend),
    -- | The period of time that\'s covered by a budget. You setthe start date
    -- and end date. The start date must come before the end date. The end date
    -- must come before @06\/15\/87 00:00 UTC@.
    --
    -- If you create your budget and don\'t specify a start date, Amazon Web
    -- Services defaults to the start of your chosen time period (DAILY,
    -- MONTHLY, QUARTERLY, or ANNUALLY). For example, if you created your
    -- budget on January 24, 2018, chose @DAILY@, and didn\'t set a start date,
    -- Amazon Web Services set your start date to @01\/24\/18 00:00 UTC@. If
    -- you chose @MONTHLY@, Amazon Web Services set your start date to
    -- @01\/01\/18 00:00 UTC@. If you didn\'t specify an end date, Amazon Web
    -- Services set your end date to @06\/15\/87 00:00 UTC@. The defaults are
    -- the same for the Billing and Cost Management console and the API.
    --
    -- You can change either date with the @UpdateBudget@ operation.
    --
    -- After the end date, Amazon Web Services deletes the budget and all the
    -- associated notifications and subscribers.
    Budget -> Maybe TimePeriod
timePeriod :: Prelude.Maybe TimePeriod,
    -- | The name of a budget. The name must be unique within an account. The @:@
    -- and @\\@ characters aren\'t allowed in @BudgetName@.
    Budget -> Text
budgetName :: Prelude.Text,
    -- | The length of time until a budget resets the actual and forecasted
    -- spend.
    Budget -> TimeUnit
timeUnit :: TimeUnit,
    -- | Specifies whether this budget tracks costs, usage, RI utilization, RI
    -- coverage, Savings Plans utilization, or Savings Plans coverage.
    Budget -> BudgetType
budgetType :: BudgetType
  }
  deriving (Budget -> Budget -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Budget -> Budget -> Bool
$c/= :: Budget -> Budget -> Bool
== :: Budget -> Budget -> Bool
$c== :: Budget -> Budget -> Bool
Prelude.Eq, ReadPrec [Budget]
ReadPrec Budget
Int -> ReadS Budget
ReadS [Budget]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Budget]
$creadListPrec :: ReadPrec [Budget]
readPrec :: ReadPrec Budget
$creadPrec :: ReadPrec Budget
readList :: ReadS [Budget]
$creadList :: ReadS [Budget]
readsPrec :: Int -> ReadS Budget
$creadsPrec :: Int -> ReadS Budget
Prelude.Read, Int -> Budget -> ShowS
[Budget] -> ShowS
Budget -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Budget] -> ShowS
$cshowList :: [Budget] -> ShowS
show :: Budget -> String
$cshow :: Budget -> String
showsPrec :: Int -> Budget -> ShowS
$cshowsPrec :: Int -> Budget -> ShowS
Prelude.Show, forall x. Rep Budget x -> Budget
forall x. Budget -> Rep Budget x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Budget x -> Budget
$cfrom :: forall x. Budget -> Rep Budget x
Prelude.Generic)

-- |
-- Create a value of 'Budget' 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:
--
-- 'autoAdjustData', 'budget_autoAdjustData' - The parameters that determine the budget amount for an auto-adjusting
-- budget.
--
-- 'budgetLimit', 'budget_budgetLimit' - The total amount of cost, usage, RI utilization, RI coverage, Savings
-- Plans utilization, or Savings Plans coverage that you want to track with
-- your budget.
--
-- @BudgetLimit@ is required for cost or usage budgets, but optional for RI
-- or Savings Plans utilization or coverage budgets. RI and Savings Plans
-- utilization or coverage budgets default to @100@. This is the only valid
-- value for RI or Savings Plans utilization or coverage budgets. You
-- can\'t use @BudgetLimit@ with @PlannedBudgetLimits@ for @CreateBudget@
-- and @UpdateBudget@ actions.
--
-- 'calculatedSpend', 'budget_calculatedSpend' - The actual and forecasted cost or usage that the budget tracks.
--
-- 'costFilters', 'budget_costFilters' - The cost filters, such as @Region@, @Service@, @member account@, @Tag@,
-- or @Cost Category@, that are applied to a budget.
--
-- Amazon Web Services Budgets supports the following services as a
-- @Service@ filter for RI budgets:
--
-- -   Amazon EC2
--
-- -   Amazon Redshift
--
-- -   Amazon Relational Database Service
--
-- -   Amazon ElastiCache
--
-- -   Amazon OpenSearch Service
--
-- 'costTypes', 'budget_costTypes' - The types of costs that are included in this @COST@ budget.
--
-- @USAGE@, @RI_UTILIZATION@, @RI_COVERAGE@, @SAVINGS_PLANS_UTILIZATION@,
-- and @SAVINGS_PLANS_COVERAGE@ budgets do not have @CostTypes@.
--
-- 'lastUpdatedTime', 'budget_lastUpdatedTime' - The last time that you updated this budget.
--
-- 'plannedBudgetLimits', 'budget_plannedBudgetLimits' - A map containing multiple @BudgetLimit@, including current or future
-- limits.
--
-- @PlannedBudgetLimits@ is available for cost or usage budget and supports
-- both monthly and quarterly @TimeUnit@.
--
-- For monthly budgets, provide 12 months of @PlannedBudgetLimits@ values.
-- This must start from the current month and include the next 11 months.
-- The @key@ is the start of the month, @UTC@ in epoch seconds.
--
-- For quarterly budgets, provide four quarters of @PlannedBudgetLimits@
-- value entries in standard calendar quarter increments. This must start
-- from the current quarter and include the next three quarters. The @key@
-- is the start of the quarter, @UTC@ in epoch seconds.
--
-- If the planned budget expires before 12 months for monthly or four
-- quarters for quarterly, provide the @PlannedBudgetLimits@ values only
-- for the remaining periods.
--
-- If the budget begins at a date in the future, provide
-- @PlannedBudgetLimits@ values from the start date of the budget.
--
-- After all of the @BudgetLimit@ values in @PlannedBudgetLimits@ are used,
-- the budget continues to use the last limit as the @BudgetLimit@. At that
-- point, the planned budget provides the same experience as a fixed
-- budget.
--
-- @DescribeBudget@ and @DescribeBudgets@ response along with
-- @PlannedBudgetLimits@ also contain @BudgetLimit@ representing the
-- current month or quarter limit present in @PlannedBudgetLimits@. This
-- only applies to budgets that are created with @PlannedBudgetLimits@.
-- Budgets that are created without @PlannedBudgetLimits@ only contain
-- @BudgetLimit@. They don\'t contain @PlannedBudgetLimits@.
--
-- 'timePeriod', 'budget_timePeriod' - The period of time that\'s covered by a budget. You setthe start date
-- and end date. The start date must come before the end date. The end date
-- must come before @06\/15\/87 00:00 UTC@.
--
-- If you create your budget and don\'t specify a start date, Amazon Web
-- Services defaults to the start of your chosen time period (DAILY,
-- MONTHLY, QUARTERLY, or ANNUALLY). For example, if you created your
-- budget on January 24, 2018, chose @DAILY@, and didn\'t set a start date,
-- Amazon Web Services set your start date to @01\/24\/18 00:00 UTC@. If
-- you chose @MONTHLY@, Amazon Web Services set your start date to
-- @01\/01\/18 00:00 UTC@. If you didn\'t specify an end date, Amazon Web
-- Services set your end date to @06\/15\/87 00:00 UTC@. The defaults are
-- the same for the Billing and Cost Management console and the API.
--
-- You can change either date with the @UpdateBudget@ operation.
--
-- After the end date, Amazon Web Services deletes the budget and all the
-- associated notifications and subscribers.
--
-- 'budgetName', 'budget_budgetName' - The name of a budget. The name must be unique within an account. The @:@
-- and @\\@ characters aren\'t allowed in @BudgetName@.
--
-- 'timeUnit', 'budget_timeUnit' - The length of time until a budget resets the actual and forecasted
-- spend.
--
-- 'budgetType', 'budget_budgetType' - Specifies whether this budget tracks costs, usage, RI utilization, RI
-- coverage, Savings Plans utilization, or Savings Plans coverage.
newBudget ::
  -- | 'budgetName'
  Prelude.Text ->
  -- | 'timeUnit'
  TimeUnit ->
  -- | 'budgetType'
  BudgetType ->
  Budget
newBudget :: Text -> TimeUnit -> BudgetType -> Budget
newBudget Text
pBudgetName_ TimeUnit
pTimeUnit_ BudgetType
pBudgetType_ =
  Budget'
    { $sel:autoAdjustData:Budget' :: Maybe AutoAdjustData
autoAdjustData = forall a. Maybe a
Prelude.Nothing,
      $sel:budgetLimit:Budget' :: Maybe Spend
budgetLimit = forall a. Maybe a
Prelude.Nothing,
      $sel:calculatedSpend:Budget' :: Maybe CalculatedSpend
calculatedSpend = forall a. Maybe a
Prelude.Nothing,
      $sel:costFilters:Budget' :: Maybe (HashMap Text [Text])
costFilters = forall a. Maybe a
Prelude.Nothing,
      $sel:costTypes:Budget' :: Maybe CostTypes
costTypes = forall a. Maybe a
Prelude.Nothing,
      $sel:lastUpdatedTime:Budget' :: Maybe POSIX
lastUpdatedTime = forall a. Maybe a
Prelude.Nothing,
      $sel:plannedBudgetLimits:Budget' :: Maybe (HashMap Text Spend)
plannedBudgetLimits = forall a. Maybe a
Prelude.Nothing,
      $sel:timePeriod:Budget' :: Maybe TimePeriod
timePeriod = forall a. Maybe a
Prelude.Nothing,
      $sel:budgetName:Budget' :: Text
budgetName = Text
pBudgetName_,
      $sel:timeUnit:Budget' :: TimeUnit
timeUnit = TimeUnit
pTimeUnit_,
      $sel:budgetType:Budget' :: BudgetType
budgetType = BudgetType
pBudgetType_
    }

-- | The parameters that determine the budget amount for an auto-adjusting
-- budget.
budget_autoAdjustData :: Lens.Lens' Budget (Prelude.Maybe AutoAdjustData)
budget_autoAdjustData :: Lens' Budget (Maybe AutoAdjustData)
budget_autoAdjustData = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Budget' {Maybe AutoAdjustData
autoAdjustData :: Maybe AutoAdjustData
$sel:autoAdjustData:Budget' :: Budget -> Maybe AutoAdjustData
autoAdjustData} -> Maybe AutoAdjustData
autoAdjustData) (\s :: Budget
s@Budget' {} Maybe AutoAdjustData
a -> Budget
s {$sel:autoAdjustData:Budget' :: Maybe AutoAdjustData
autoAdjustData = Maybe AutoAdjustData
a} :: Budget)

-- | The total amount of cost, usage, RI utilization, RI coverage, Savings
-- Plans utilization, or Savings Plans coverage that you want to track with
-- your budget.
--
-- @BudgetLimit@ is required for cost or usage budgets, but optional for RI
-- or Savings Plans utilization or coverage budgets. RI and Savings Plans
-- utilization or coverage budgets default to @100@. This is the only valid
-- value for RI or Savings Plans utilization or coverage budgets. You
-- can\'t use @BudgetLimit@ with @PlannedBudgetLimits@ for @CreateBudget@
-- and @UpdateBudget@ actions.
budget_budgetLimit :: Lens.Lens' Budget (Prelude.Maybe Spend)
budget_budgetLimit :: Lens' Budget (Maybe Spend)
budget_budgetLimit = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Budget' {Maybe Spend
budgetLimit :: Maybe Spend
$sel:budgetLimit:Budget' :: Budget -> Maybe Spend
budgetLimit} -> Maybe Spend
budgetLimit) (\s :: Budget
s@Budget' {} Maybe Spend
a -> Budget
s {$sel:budgetLimit:Budget' :: Maybe Spend
budgetLimit = Maybe Spend
a} :: Budget)

-- | The actual and forecasted cost or usage that the budget tracks.
budget_calculatedSpend :: Lens.Lens' Budget (Prelude.Maybe CalculatedSpend)
budget_calculatedSpend :: Lens' Budget (Maybe CalculatedSpend)
budget_calculatedSpend = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Budget' {Maybe CalculatedSpend
calculatedSpend :: Maybe CalculatedSpend
$sel:calculatedSpend:Budget' :: Budget -> Maybe CalculatedSpend
calculatedSpend} -> Maybe CalculatedSpend
calculatedSpend) (\s :: Budget
s@Budget' {} Maybe CalculatedSpend
a -> Budget
s {$sel:calculatedSpend:Budget' :: Maybe CalculatedSpend
calculatedSpend = Maybe CalculatedSpend
a} :: Budget)

-- | The cost filters, such as @Region@, @Service@, @member account@, @Tag@,
-- or @Cost Category@, that are applied to a budget.
--
-- Amazon Web Services Budgets supports the following services as a
-- @Service@ filter for RI budgets:
--
-- -   Amazon EC2
--
-- -   Amazon Redshift
--
-- -   Amazon Relational Database Service
--
-- -   Amazon ElastiCache
--
-- -   Amazon OpenSearch Service
budget_costFilters :: Lens.Lens' Budget (Prelude.Maybe (Prelude.HashMap Prelude.Text [Prelude.Text]))
budget_costFilters :: Lens' Budget (Maybe (HashMap Text [Text]))
budget_costFilters = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Budget' {Maybe (HashMap Text [Text])
costFilters :: Maybe (HashMap Text [Text])
$sel:costFilters:Budget' :: Budget -> Maybe (HashMap Text [Text])
costFilters} -> Maybe (HashMap Text [Text])
costFilters) (\s :: Budget
s@Budget' {} Maybe (HashMap Text [Text])
a -> Budget
s {$sel:costFilters:Budget' :: Maybe (HashMap Text [Text])
costFilters = Maybe (HashMap Text [Text])
a} :: Budget) 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 types of costs that are included in this @COST@ budget.
--
-- @USAGE@, @RI_UTILIZATION@, @RI_COVERAGE@, @SAVINGS_PLANS_UTILIZATION@,
-- and @SAVINGS_PLANS_COVERAGE@ budgets do not have @CostTypes@.
budget_costTypes :: Lens.Lens' Budget (Prelude.Maybe CostTypes)
budget_costTypes :: Lens' Budget (Maybe CostTypes)
budget_costTypes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Budget' {Maybe CostTypes
costTypes :: Maybe CostTypes
$sel:costTypes:Budget' :: Budget -> Maybe CostTypes
costTypes} -> Maybe CostTypes
costTypes) (\s :: Budget
s@Budget' {} Maybe CostTypes
a -> Budget
s {$sel:costTypes:Budget' :: Maybe CostTypes
costTypes = Maybe CostTypes
a} :: Budget)

-- | The last time that you updated this budget.
budget_lastUpdatedTime :: Lens.Lens' Budget (Prelude.Maybe Prelude.UTCTime)
budget_lastUpdatedTime :: Lens' Budget (Maybe UTCTime)
budget_lastUpdatedTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Budget' {Maybe POSIX
lastUpdatedTime :: Maybe POSIX
$sel:lastUpdatedTime:Budget' :: Budget -> Maybe POSIX
lastUpdatedTime} -> Maybe POSIX
lastUpdatedTime) (\s :: Budget
s@Budget' {} Maybe POSIX
a -> Budget
s {$sel:lastUpdatedTime:Budget' :: Maybe POSIX
lastUpdatedTime = Maybe POSIX
a} :: Budget) 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 (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | A map containing multiple @BudgetLimit@, including current or future
-- limits.
--
-- @PlannedBudgetLimits@ is available for cost or usage budget and supports
-- both monthly and quarterly @TimeUnit@.
--
-- For monthly budgets, provide 12 months of @PlannedBudgetLimits@ values.
-- This must start from the current month and include the next 11 months.
-- The @key@ is the start of the month, @UTC@ in epoch seconds.
--
-- For quarterly budgets, provide four quarters of @PlannedBudgetLimits@
-- value entries in standard calendar quarter increments. This must start
-- from the current quarter and include the next three quarters. The @key@
-- is the start of the quarter, @UTC@ in epoch seconds.
--
-- If the planned budget expires before 12 months for monthly or four
-- quarters for quarterly, provide the @PlannedBudgetLimits@ values only
-- for the remaining periods.
--
-- If the budget begins at a date in the future, provide
-- @PlannedBudgetLimits@ values from the start date of the budget.
--
-- After all of the @BudgetLimit@ values in @PlannedBudgetLimits@ are used,
-- the budget continues to use the last limit as the @BudgetLimit@. At that
-- point, the planned budget provides the same experience as a fixed
-- budget.
--
-- @DescribeBudget@ and @DescribeBudgets@ response along with
-- @PlannedBudgetLimits@ also contain @BudgetLimit@ representing the
-- current month or quarter limit present in @PlannedBudgetLimits@. This
-- only applies to budgets that are created with @PlannedBudgetLimits@.
-- Budgets that are created without @PlannedBudgetLimits@ only contain
-- @BudgetLimit@. They don\'t contain @PlannedBudgetLimits@.
budget_plannedBudgetLimits :: Lens.Lens' Budget (Prelude.Maybe (Prelude.HashMap Prelude.Text Spend))
budget_plannedBudgetLimits :: Lens' Budget (Maybe (HashMap Text Spend))
budget_plannedBudgetLimits = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Budget' {Maybe (HashMap Text Spend)
plannedBudgetLimits :: Maybe (HashMap Text Spend)
$sel:plannedBudgetLimits:Budget' :: Budget -> Maybe (HashMap Text Spend)
plannedBudgetLimits} -> Maybe (HashMap Text Spend)
plannedBudgetLimits) (\s :: Budget
s@Budget' {} Maybe (HashMap Text Spend)
a -> Budget
s {$sel:plannedBudgetLimits:Budget' :: Maybe (HashMap Text Spend)
plannedBudgetLimits = Maybe (HashMap Text Spend)
a} :: Budget) 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 period of time that\'s covered by a budget. You setthe start date
-- and end date. The start date must come before the end date. The end date
-- must come before @06\/15\/87 00:00 UTC@.
--
-- If you create your budget and don\'t specify a start date, Amazon Web
-- Services defaults to the start of your chosen time period (DAILY,
-- MONTHLY, QUARTERLY, or ANNUALLY). For example, if you created your
-- budget on January 24, 2018, chose @DAILY@, and didn\'t set a start date,
-- Amazon Web Services set your start date to @01\/24\/18 00:00 UTC@. If
-- you chose @MONTHLY@, Amazon Web Services set your start date to
-- @01\/01\/18 00:00 UTC@. If you didn\'t specify an end date, Amazon Web
-- Services set your end date to @06\/15\/87 00:00 UTC@. The defaults are
-- the same for the Billing and Cost Management console and the API.
--
-- You can change either date with the @UpdateBudget@ operation.
--
-- After the end date, Amazon Web Services deletes the budget and all the
-- associated notifications and subscribers.
budget_timePeriod :: Lens.Lens' Budget (Prelude.Maybe TimePeriod)
budget_timePeriod :: Lens' Budget (Maybe TimePeriod)
budget_timePeriod = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Budget' {Maybe TimePeriod
timePeriod :: Maybe TimePeriod
$sel:timePeriod:Budget' :: Budget -> Maybe TimePeriod
timePeriod} -> Maybe TimePeriod
timePeriod) (\s :: Budget
s@Budget' {} Maybe TimePeriod
a -> Budget
s {$sel:timePeriod:Budget' :: Maybe TimePeriod
timePeriod = Maybe TimePeriod
a} :: Budget)

-- | The name of a budget. The name must be unique within an account. The @:@
-- and @\\@ characters aren\'t allowed in @BudgetName@.
budget_budgetName :: Lens.Lens' Budget Prelude.Text
budget_budgetName :: Lens' Budget Text
budget_budgetName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Budget' {Text
budgetName :: Text
$sel:budgetName:Budget' :: Budget -> Text
budgetName} -> Text
budgetName) (\s :: Budget
s@Budget' {} Text
a -> Budget
s {$sel:budgetName:Budget' :: Text
budgetName = Text
a} :: Budget)

-- | The length of time until a budget resets the actual and forecasted
-- spend.
budget_timeUnit :: Lens.Lens' Budget TimeUnit
budget_timeUnit :: Lens' Budget TimeUnit
budget_timeUnit = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Budget' {TimeUnit
timeUnit :: TimeUnit
$sel:timeUnit:Budget' :: Budget -> TimeUnit
timeUnit} -> TimeUnit
timeUnit) (\s :: Budget
s@Budget' {} TimeUnit
a -> Budget
s {$sel:timeUnit:Budget' :: TimeUnit
timeUnit = TimeUnit
a} :: Budget)

-- | Specifies whether this budget tracks costs, usage, RI utilization, RI
-- coverage, Savings Plans utilization, or Savings Plans coverage.
budget_budgetType :: Lens.Lens' Budget BudgetType
budget_budgetType :: Lens' Budget BudgetType
budget_budgetType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Budget' {BudgetType
budgetType :: BudgetType
$sel:budgetType:Budget' :: Budget -> BudgetType
budgetType} -> BudgetType
budgetType) (\s :: Budget
s@Budget' {} BudgetType
a -> Budget
s {$sel:budgetType:Budget' :: BudgetType
budgetType = BudgetType
a} :: Budget)

instance Data.FromJSON Budget where
  parseJSON :: Value -> Parser Budget
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"Budget"
      ( \Object
x ->
          Maybe AutoAdjustData
-> Maybe Spend
-> Maybe CalculatedSpend
-> Maybe (HashMap Text [Text])
-> Maybe CostTypes
-> Maybe POSIX
-> Maybe (HashMap Text Spend)
-> Maybe TimePeriod
-> Text
-> TimeUnit
-> BudgetType
-> Budget
Budget'
            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
"AutoAdjustData")
            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
"BudgetLimit")
            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
"CalculatedSpend")
            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
"CostFilters" 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
"CostTypes")
            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
"LastUpdatedTime")
            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
"PlannedBudgetLimits"
                            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
"TimePeriod")
            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
"TimeUnit")
            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
"BudgetType")
      )

instance Prelude.Hashable Budget where
  hashWithSalt :: Int -> Budget -> Int
hashWithSalt Int
_salt Budget' {Maybe (HashMap Text [Text])
Maybe (HashMap Text Spend)
Maybe POSIX
Maybe CostTypes
Maybe AutoAdjustData
Maybe Spend
Maybe CalculatedSpend
Maybe TimePeriod
Text
BudgetType
TimeUnit
budgetType :: BudgetType
timeUnit :: TimeUnit
budgetName :: Text
timePeriod :: Maybe TimePeriod
plannedBudgetLimits :: Maybe (HashMap Text Spend)
lastUpdatedTime :: Maybe POSIX
costTypes :: Maybe CostTypes
costFilters :: Maybe (HashMap Text [Text])
calculatedSpend :: Maybe CalculatedSpend
budgetLimit :: Maybe Spend
autoAdjustData :: Maybe AutoAdjustData
$sel:budgetType:Budget' :: Budget -> BudgetType
$sel:timeUnit:Budget' :: Budget -> TimeUnit
$sel:budgetName:Budget' :: Budget -> Text
$sel:timePeriod:Budget' :: Budget -> Maybe TimePeriod
$sel:plannedBudgetLimits:Budget' :: Budget -> Maybe (HashMap Text Spend)
$sel:lastUpdatedTime:Budget' :: Budget -> Maybe POSIX
$sel:costTypes:Budget' :: Budget -> Maybe CostTypes
$sel:costFilters:Budget' :: Budget -> Maybe (HashMap Text [Text])
$sel:calculatedSpend:Budget' :: Budget -> Maybe CalculatedSpend
$sel:budgetLimit:Budget' :: Budget -> Maybe Spend
$sel:autoAdjustData:Budget' :: Budget -> Maybe AutoAdjustData
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe AutoAdjustData
autoAdjustData
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Spend
budgetLimit
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe CalculatedSpend
calculatedSpend
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text [Text])
costFilters
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe CostTypes
costTypes
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe POSIX
lastUpdatedTime
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Spend)
plannedBudgetLimits
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe TimePeriod
timePeriod
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
budgetName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` TimeUnit
timeUnit
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` BudgetType
budgetType

instance Prelude.NFData Budget where
  rnf :: Budget -> ()
rnf Budget' {Maybe (HashMap Text [Text])
Maybe (HashMap Text Spend)
Maybe POSIX
Maybe CostTypes
Maybe AutoAdjustData
Maybe Spend
Maybe CalculatedSpend
Maybe TimePeriod
Text
BudgetType
TimeUnit
budgetType :: BudgetType
timeUnit :: TimeUnit
budgetName :: Text
timePeriod :: Maybe TimePeriod
plannedBudgetLimits :: Maybe (HashMap Text Spend)
lastUpdatedTime :: Maybe POSIX
costTypes :: Maybe CostTypes
costFilters :: Maybe (HashMap Text [Text])
calculatedSpend :: Maybe CalculatedSpend
budgetLimit :: Maybe Spend
autoAdjustData :: Maybe AutoAdjustData
$sel:budgetType:Budget' :: Budget -> BudgetType
$sel:timeUnit:Budget' :: Budget -> TimeUnit
$sel:budgetName:Budget' :: Budget -> Text
$sel:timePeriod:Budget' :: Budget -> Maybe TimePeriod
$sel:plannedBudgetLimits:Budget' :: Budget -> Maybe (HashMap Text Spend)
$sel:lastUpdatedTime:Budget' :: Budget -> Maybe POSIX
$sel:costTypes:Budget' :: Budget -> Maybe CostTypes
$sel:costFilters:Budget' :: Budget -> Maybe (HashMap Text [Text])
$sel:calculatedSpend:Budget' :: Budget -> Maybe CalculatedSpend
$sel:budgetLimit:Budget' :: Budget -> Maybe Spend
$sel:autoAdjustData:Budget' :: Budget -> Maybe AutoAdjustData
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe AutoAdjustData
autoAdjustData
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Spend
budgetLimit
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe CalculatedSpend
calculatedSpend
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text [Text])
costFilters
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe CostTypes
costTypes
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
lastUpdatedTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text Spend)
plannedBudgetLimits
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe TimePeriod
timePeriod
      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 TimeUnit
timeUnit
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf BudgetType
budgetType

instance Data.ToJSON Budget where
  toJSON :: Budget -> Value
toJSON Budget' {Maybe (HashMap Text [Text])
Maybe (HashMap Text Spend)
Maybe POSIX
Maybe CostTypes
Maybe AutoAdjustData
Maybe Spend
Maybe CalculatedSpend
Maybe TimePeriod
Text
BudgetType
TimeUnit
budgetType :: BudgetType
timeUnit :: TimeUnit
budgetName :: Text
timePeriod :: Maybe TimePeriod
plannedBudgetLimits :: Maybe (HashMap Text Spend)
lastUpdatedTime :: Maybe POSIX
costTypes :: Maybe CostTypes
costFilters :: Maybe (HashMap Text [Text])
calculatedSpend :: Maybe CalculatedSpend
budgetLimit :: Maybe Spend
autoAdjustData :: Maybe AutoAdjustData
$sel:budgetType:Budget' :: Budget -> BudgetType
$sel:timeUnit:Budget' :: Budget -> TimeUnit
$sel:budgetName:Budget' :: Budget -> Text
$sel:timePeriod:Budget' :: Budget -> Maybe TimePeriod
$sel:plannedBudgetLimits:Budget' :: Budget -> Maybe (HashMap Text Spend)
$sel:lastUpdatedTime:Budget' :: Budget -> Maybe POSIX
$sel:costTypes:Budget' :: Budget -> Maybe CostTypes
$sel:costFilters:Budget' :: Budget -> Maybe (HashMap Text [Text])
$sel:calculatedSpend:Budget' :: Budget -> Maybe CalculatedSpend
$sel:budgetLimit:Budget' :: Budget -> Maybe Spend
$sel:autoAdjustData:Budget' :: Budget -> Maybe AutoAdjustData
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"AutoAdjustData" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe AutoAdjustData
autoAdjustData,
            (Key
"BudgetLimit" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Spend
budgetLimit,
            (Key
"CalculatedSpend" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe CalculatedSpend
calculatedSpend,
            (Key
"CostFilters" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe (HashMap Text [Text])
costFilters,
            (Key
"CostTypes" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe CostTypes
costTypes,
            (Key
"LastUpdatedTime" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe POSIX
lastUpdatedTime,
            (Key
"PlannedBudgetLimits" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe (HashMap Text Spend)
plannedBudgetLimits,
            (Key
"TimePeriod" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe TimePeriod
timePeriod,
            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
"TimeUnit" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= TimeUnit
timeUnit),
            forall a. a -> Maybe a
Prelude.Just (Key
"BudgetType" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= BudgetType
budgetType)
          ]
      )