{-# 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.Redshift.Types.UsageLimit
-- 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.Redshift.Types.UsageLimit where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import qualified Amazonka.Prelude as Prelude
import Amazonka.Redshift.Internal
import Amazonka.Redshift.Types.Tag
import Amazonka.Redshift.Types.UsageLimitBreachAction
import Amazonka.Redshift.Types.UsageLimitFeatureType
import Amazonka.Redshift.Types.UsageLimitLimitType
import Amazonka.Redshift.Types.UsageLimitPeriod

-- | Describes a usage limit object for a cluster.
--
-- /See:/ 'newUsageLimit' smart constructor.
data UsageLimit = UsageLimit'
  { -- | The limit amount. If time-based, this amount is in minutes. If
    -- data-based, this amount is in terabytes (TB).
    UsageLimit -> Maybe Integer
amount :: Prelude.Maybe Prelude.Integer,
    -- | The action that Amazon Redshift takes when the limit is reached.
    -- Possible values are:
    --
    -- -   __log__ - To log an event in a system table. The default is log.
    --
    -- -   __emit-metric__ - To emit CloudWatch metrics.
    --
    -- -   __disable__ - To disable the feature until the next usage period
    --     begins.
    UsageLimit -> Maybe UsageLimitBreachAction
breachAction :: Prelude.Maybe UsageLimitBreachAction,
    -- | The identifier of the cluster with a usage limit.
    UsageLimit -> Maybe Text
clusterIdentifier :: Prelude.Maybe Prelude.Text,
    -- | The Amazon Redshift feature to which the limit applies.
    UsageLimit -> Maybe UsageLimitFeatureType
featureType :: Prelude.Maybe UsageLimitFeatureType,
    -- | The type of limit. Depending on the feature type, this can be based on a
    -- time duration or data size.
    UsageLimit -> Maybe UsageLimitLimitType
limitType :: Prelude.Maybe UsageLimitLimitType,
    -- | The time period that the amount applies to. A @weekly@ period begins on
    -- Sunday. The default is @monthly@.
    UsageLimit -> Maybe UsageLimitPeriod
period :: Prelude.Maybe UsageLimitPeriod,
    -- | A list of tag instances.
    UsageLimit -> Maybe [Tag]
tags :: Prelude.Maybe [Tag],
    -- | The identifier of the usage limit.
    UsageLimit -> Maybe Text
usageLimitId :: Prelude.Maybe Prelude.Text
  }
  deriving (UsageLimit -> UsageLimit -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UsageLimit -> UsageLimit -> Bool
$c/= :: UsageLimit -> UsageLimit -> Bool
== :: UsageLimit -> UsageLimit -> Bool
$c== :: UsageLimit -> UsageLimit -> Bool
Prelude.Eq, ReadPrec [UsageLimit]
ReadPrec UsageLimit
Int -> ReadS UsageLimit
ReadS [UsageLimit]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UsageLimit]
$creadListPrec :: ReadPrec [UsageLimit]
readPrec :: ReadPrec UsageLimit
$creadPrec :: ReadPrec UsageLimit
readList :: ReadS [UsageLimit]
$creadList :: ReadS [UsageLimit]
readsPrec :: Int -> ReadS UsageLimit
$creadsPrec :: Int -> ReadS UsageLimit
Prelude.Read, Int -> UsageLimit -> ShowS
[UsageLimit] -> ShowS
UsageLimit -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UsageLimit] -> ShowS
$cshowList :: [UsageLimit] -> ShowS
show :: UsageLimit -> String
$cshow :: UsageLimit -> String
showsPrec :: Int -> UsageLimit -> ShowS
$cshowsPrec :: Int -> UsageLimit -> ShowS
Prelude.Show, forall x. Rep UsageLimit x -> UsageLimit
forall x. UsageLimit -> Rep UsageLimit x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UsageLimit x -> UsageLimit
$cfrom :: forall x. UsageLimit -> Rep UsageLimit x
Prelude.Generic)

-- |
-- Create a value of 'UsageLimit' 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:
--
-- 'amount', 'usageLimit_amount' - The limit amount. If time-based, this amount is in minutes. If
-- data-based, this amount is in terabytes (TB).
--
-- 'breachAction', 'usageLimit_breachAction' - The action that Amazon Redshift takes when the limit is reached.
-- Possible values are:
--
-- -   __log__ - To log an event in a system table. The default is log.
--
-- -   __emit-metric__ - To emit CloudWatch metrics.
--
-- -   __disable__ - To disable the feature until the next usage period
--     begins.
--
-- 'clusterIdentifier', 'usageLimit_clusterIdentifier' - The identifier of the cluster with a usage limit.
--
-- 'featureType', 'usageLimit_featureType' - The Amazon Redshift feature to which the limit applies.
--
-- 'limitType', 'usageLimit_limitType' - The type of limit. Depending on the feature type, this can be based on a
-- time duration or data size.
--
-- 'period', 'usageLimit_period' - The time period that the amount applies to. A @weekly@ period begins on
-- Sunday. The default is @monthly@.
--
-- 'tags', 'usageLimit_tags' - A list of tag instances.
--
-- 'usageLimitId', 'usageLimit_usageLimitId' - The identifier of the usage limit.
newUsageLimit ::
  UsageLimit
newUsageLimit :: UsageLimit
newUsageLimit =
  UsageLimit'
    { $sel:amount:UsageLimit' :: Maybe Integer
amount = forall a. Maybe a
Prelude.Nothing,
      $sel:breachAction:UsageLimit' :: Maybe UsageLimitBreachAction
breachAction = forall a. Maybe a
Prelude.Nothing,
      $sel:clusterIdentifier:UsageLimit' :: Maybe Text
clusterIdentifier = forall a. Maybe a
Prelude.Nothing,
      $sel:featureType:UsageLimit' :: Maybe UsageLimitFeatureType
featureType = forall a. Maybe a
Prelude.Nothing,
      $sel:limitType:UsageLimit' :: Maybe UsageLimitLimitType
limitType = forall a. Maybe a
Prelude.Nothing,
      $sel:period:UsageLimit' :: Maybe UsageLimitPeriod
period = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:UsageLimit' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:usageLimitId:UsageLimit' :: Maybe Text
usageLimitId = forall a. Maybe a
Prelude.Nothing
    }

-- | The limit amount. If time-based, this amount is in minutes. If
-- data-based, this amount is in terabytes (TB).
usageLimit_amount :: Lens.Lens' UsageLimit (Prelude.Maybe Prelude.Integer)
usageLimit_amount :: Lens' UsageLimit (Maybe Integer)
usageLimit_amount = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UsageLimit' {Maybe Integer
amount :: Maybe Integer
$sel:amount:UsageLimit' :: UsageLimit -> Maybe Integer
amount} -> Maybe Integer
amount) (\s :: UsageLimit
s@UsageLimit' {} Maybe Integer
a -> UsageLimit
s {$sel:amount:UsageLimit' :: Maybe Integer
amount = Maybe Integer
a} :: UsageLimit)

-- | The action that Amazon Redshift takes when the limit is reached.
-- Possible values are:
--
-- -   __log__ - To log an event in a system table. The default is log.
--
-- -   __emit-metric__ - To emit CloudWatch metrics.
--
-- -   __disable__ - To disable the feature until the next usage period
--     begins.
usageLimit_breachAction :: Lens.Lens' UsageLimit (Prelude.Maybe UsageLimitBreachAction)
usageLimit_breachAction :: Lens' UsageLimit (Maybe UsageLimitBreachAction)
usageLimit_breachAction = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UsageLimit' {Maybe UsageLimitBreachAction
breachAction :: Maybe UsageLimitBreachAction
$sel:breachAction:UsageLimit' :: UsageLimit -> Maybe UsageLimitBreachAction
breachAction} -> Maybe UsageLimitBreachAction
breachAction) (\s :: UsageLimit
s@UsageLimit' {} Maybe UsageLimitBreachAction
a -> UsageLimit
s {$sel:breachAction:UsageLimit' :: Maybe UsageLimitBreachAction
breachAction = Maybe UsageLimitBreachAction
a} :: UsageLimit)

-- | The identifier of the cluster with a usage limit.
usageLimit_clusterIdentifier :: Lens.Lens' UsageLimit (Prelude.Maybe Prelude.Text)
usageLimit_clusterIdentifier :: Lens' UsageLimit (Maybe Text)
usageLimit_clusterIdentifier = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UsageLimit' {Maybe Text
clusterIdentifier :: Maybe Text
$sel:clusterIdentifier:UsageLimit' :: UsageLimit -> Maybe Text
clusterIdentifier} -> Maybe Text
clusterIdentifier) (\s :: UsageLimit
s@UsageLimit' {} Maybe Text
a -> UsageLimit
s {$sel:clusterIdentifier:UsageLimit' :: Maybe Text
clusterIdentifier = Maybe Text
a} :: UsageLimit)

-- | The Amazon Redshift feature to which the limit applies.
usageLimit_featureType :: Lens.Lens' UsageLimit (Prelude.Maybe UsageLimitFeatureType)
usageLimit_featureType :: Lens' UsageLimit (Maybe UsageLimitFeatureType)
usageLimit_featureType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UsageLimit' {Maybe UsageLimitFeatureType
featureType :: Maybe UsageLimitFeatureType
$sel:featureType:UsageLimit' :: UsageLimit -> Maybe UsageLimitFeatureType
featureType} -> Maybe UsageLimitFeatureType
featureType) (\s :: UsageLimit
s@UsageLimit' {} Maybe UsageLimitFeatureType
a -> UsageLimit
s {$sel:featureType:UsageLimit' :: Maybe UsageLimitFeatureType
featureType = Maybe UsageLimitFeatureType
a} :: UsageLimit)

-- | The type of limit. Depending on the feature type, this can be based on a
-- time duration or data size.
usageLimit_limitType :: Lens.Lens' UsageLimit (Prelude.Maybe UsageLimitLimitType)
usageLimit_limitType :: Lens' UsageLimit (Maybe UsageLimitLimitType)
usageLimit_limitType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UsageLimit' {Maybe UsageLimitLimitType
limitType :: Maybe UsageLimitLimitType
$sel:limitType:UsageLimit' :: UsageLimit -> Maybe UsageLimitLimitType
limitType} -> Maybe UsageLimitLimitType
limitType) (\s :: UsageLimit
s@UsageLimit' {} Maybe UsageLimitLimitType
a -> UsageLimit
s {$sel:limitType:UsageLimit' :: Maybe UsageLimitLimitType
limitType = Maybe UsageLimitLimitType
a} :: UsageLimit)

-- | The time period that the amount applies to. A @weekly@ period begins on
-- Sunday. The default is @monthly@.
usageLimit_period :: Lens.Lens' UsageLimit (Prelude.Maybe UsageLimitPeriod)
usageLimit_period :: Lens' UsageLimit (Maybe UsageLimitPeriod)
usageLimit_period = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UsageLimit' {Maybe UsageLimitPeriod
period :: Maybe UsageLimitPeriod
$sel:period:UsageLimit' :: UsageLimit -> Maybe UsageLimitPeriod
period} -> Maybe UsageLimitPeriod
period) (\s :: UsageLimit
s@UsageLimit' {} Maybe UsageLimitPeriod
a -> UsageLimit
s {$sel:period:UsageLimit' :: Maybe UsageLimitPeriod
period = Maybe UsageLimitPeriod
a} :: UsageLimit)

-- | A list of tag instances.
usageLimit_tags :: Lens.Lens' UsageLimit (Prelude.Maybe [Tag])
usageLimit_tags :: Lens' UsageLimit (Maybe [Tag])
usageLimit_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UsageLimit' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:UsageLimit' :: UsageLimit -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: UsageLimit
s@UsageLimit' {} Maybe [Tag]
a -> UsageLimit
s {$sel:tags:UsageLimit' :: Maybe [Tag]
tags = Maybe [Tag]
a} :: UsageLimit) 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 identifier of the usage limit.
usageLimit_usageLimitId :: Lens.Lens' UsageLimit (Prelude.Maybe Prelude.Text)
usageLimit_usageLimitId :: Lens' UsageLimit (Maybe Text)
usageLimit_usageLimitId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UsageLimit' {Maybe Text
usageLimitId :: Maybe Text
$sel:usageLimitId:UsageLimit' :: UsageLimit -> Maybe Text
usageLimitId} -> Maybe Text
usageLimitId) (\s :: UsageLimit
s@UsageLimit' {} Maybe Text
a -> UsageLimit
s {$sel:usageLimitId:UsageLimit' :: Maybe Text
usageLimitId = Maybe Text
a} :: UsageLimit)

instance Data.FromXML UsageLimit where
  parseXML :: [Node] -> Either String UsageLimit
parseXML [Node]
x =
    Maybe Integer
-> Maybe UsageLimitBreachAction
-> Maybe Text
-> Maybe UsageLimitFeatureType
-> Maybe UsageLimitLimitType
-> Maybe UsageLimitPeriod
-> Maybe [Tag]
-> Maybe Text
-> UsageLimit
UsageLimit'
      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
"Amount")
      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
"BreachAction")
      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
"ClusterIdentifier")
      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
"FeatureType")
      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
"LimitType")
      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
"Period")
      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
"Tags"
                      forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty
                      forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
Prelude.>>= forall (f :: * -> *) a b.
Applicative f =>
([a] -> f b) -> [a] -> f (Maybe b)
Core.may (forall a. FromXML a => Text -> [Node] -> Either String [a]
Data.parseXMLList Text
"Tag")
                  )
      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
"UsageLimitId")

instance Prelude.Hashable UsageLimit where
  hashWithSalt :: Int -> UsageLimit -> Int
hashWithSalt Int
_salt UsageLimit' {Maybe Integer
Maybe [Tag]
Maybe Text
Maybe UsageLimitBreachAction
Maybe UsageLimitFeatureType
Maybe UsageLimitLimitType
Maybe UsageLimitPeriod
usageLimitId :: Maybe Text
tags :: Maybe [Tag]
period :: Maybe UsageLimitPeriod
limitType :: Maybe UsageLimitLimitType
featureType :: Maybe UsageLimitFeatureType
clusterIdentifier :: Maybe Text
breachAction :: Maybe UsageLimitBreachAction
amount :: Maybe Integer
$sel:usageLimitId:UsageLimit' :: UsageLimit -> Maybe Text
$sel:tags:UsageLimit' :: UsageLimit -> Maybe [Tag]
$sel:period:UsageLimit' :: UsageLimit -> Maybe UsageLimitPeriod
$sel:limitType:UsageLimit' :: UsageLimit -> Maybe UsageLimitLimitType
$sel:featureType:UsageLimit' :: UsageLimit -> Maybe UsageLimitFeatureType
$sel:clusterIdentifier:UsageLimit' :: UsageLimit -> Maybe Text
$sel:breachAction:UsageLimit' :: UsageLimit -> Maybe UsageLimitBreachAction
$sel:amount:UsageLimit' :: UsageLimit -> Maybe Integer
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Integer
amount
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe UsageLimitBreachAction
breachAction
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
clusterIdentifier
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe UsageLimitFeatureType
featureType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe UsageLimitLimitType
limitType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe UsageLimitPeriod
period
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Tag]
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
usageLimitId

instance Prelude.NFData UsageLimit where
  rnf :: UsageLimit -> ()
rnf UsageLimit' {Maybe Integer
Maybe [Tag]
Maybe Text
Maybe UsageLimitBreachAction
Maybe UsageLimitFeatureType
Maybe UsageLimitLimitType
Maybe UsageLimitPeriod
usageLimitId :: Maybe Text
tags :: Maybe [Tag]
period :: Maybe UsageLimitPeriod
limitType :: Maybe UsageLimitLimitType
featureType :: Maybe UsageLimitFeatureType
clusterIdentifier :: Maybe Text
breachAction :: Maybe UsageLimitBreachAction
amount :: Maybe Integer
$sel:usageLimitId:UsageLimit' :: UsageLimit -> Maybe Text
$sel:tags:UsageLimit' :: UsageLimit -> Maybe [Tag]
$sel:period:UsageLimit' :: UsageLimit -> Maybe UsageLimitPeriod
$sel:limitType:UsageLimit' :: UsageLimit -> Maybe UsageLimitLimitType
$sel:featureType:UsageLimit' :: UsageLimit -> Maybe UsageLimitFeatureType
$sel:clusterIdentifier:UsageLimit' :: UsageLimit -> Maybe Text
$sel:breachAction:UsageLimit' :: UsageLimit -> Maybe UsageLimitBreachAction
$sel:amount:UsageLimit' :: UsageLimit -> Maybe Integer
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Integer
amount
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe UsageLimitBreachAction
breachAction
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
clusterIdentifier
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe UsageLimitFeatureType
featureType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe UsageLimitLimitType
limitType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe UsageLimitPeriod
period
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Tag]
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
usageLimitId