{-# 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.ServiceQuotas.Types.ServiceQuota
-- 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.ServiceQuotas.Types.ServiceQuota 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.ServiceQuotas.Types.ErrorReason
import Amazonka.ServiceQuotas.Types.MetricInfo
import Amazonka.ServiceQuotas.Types.QuotaPeriod

-- | Information about a quota.
--
-- /See:/ 'newServiceQuota' smart constructor.
data ServiceQuota = ServiceQuota'
  { -- | Indicates whether the quota value can be increased.
    ServiceQuota -> Maybe Bool
adjustable :: Prelude.Maybe Prelude.Bool,
    -- | The error code and error reason.
    ServiceQuota -> Maybe ErrorReason
errorReason :: Prelude.Maybe ErrorReason,
    -- | Indicates whether the quota is global.
    ServiceQuota -> Maybe Bool
globalQuota :: Prelude.Maybe Prelude.Bool,
    -- | The period of time.
    ServiceQuota -> Maybe QuotaPeriod
period :: Prelude.Maybe QuotaPeriod,
    -- | The Amazon Resource Name (ARN) of the quota.
    ServiceQuota -> Maybe Text
quotaArn :: Prelude.Maybe Prelude.Text,
    -- | The quota identifier.
    ServiceQuota -> Maybe Text
quotaCode :: Prelude.Maybe Prelude.Text,
    -- | The quota name.
    ServiceQuota -> Maybe Text
quotaName :: Prelude.Maybe Prelude.Text,
    -- | The service identifier.
    ServiceQuota -> Maybe Text
serviceCode :: Prelude.Maybe Prelude.Text,
    -- | The service name.
    ServiceQuota -> Maybe Text
serviceName :: Prelude.Maybe Prelude.Text,
    -- | The unit of measurement.
    ServiceQuota -> Maybe Text
unit :: Prelude.Maybe Prelude.Text,
    -- | Information about the measurement.
    ServiceQuota -> Maybe MetricInfo
usageMetric :: Prelude.Maybe MetricInfo,
    -- | The quota value.
    ServiceQuota -> Maybe Double
value :: Prelude.Maybe Prelude.Double
  }
  deriving (ServiceQuota -> ServiceQuota -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ServiceQuota -> ServiceQuota -> Bool
$c/= :: ServiceQuota -> ServiceQuota -> Bool
== :: ServiceQuota -> ServiceQuota -> Bool
$c== :: ServiceQuota -> ServiceQuota -> Bool
Prelude.Eq, ReadPrec [ServiceQuota]
ReadPrec ServiceQuota
Int -> ReadS ServiceQuota
ReadS [ServiceQuota]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ServiceQuota]
$creadListPrec :: ReadPrec [ServiceQuota]
readPrec :: ReadPrec ServiceQuota
$creadPrec :: ReadPrec ServiceQuota
readList :: ReadS [ServiceQuota]
$creadList :: ReadS [ServiceQuota]
readsPrec :: Int -> ReadS ServiceQuota
$creadsPrec :: Int -> ReadS ServiceQuota
Prelude.Read, Int -> ServiceQuota -> ShowS
[ServiceQuota] -> ShowS
ServiceQuota -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ServiceQuota] -> ShowS
$cshowList :: [ServiceQuota] -> ShowS
show :: ServiceQuota -> String
$cshow :: ServiceQuota -> String
showsPrec :: Int -> ServiceQuota -> ShowS
$cshowsPrec :: Int -> ServiceQuota -> ShowS
Prelude.Show, forall x. Rep ServiceQuota x -> ServiceQuota
forall x. ServiceQuota -> Rep ServiceQuota x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ServiceQuota x -> ServiceQuota
$cfrom :: forall x. ServiceQuota -> Rep ServiceQuota x
Prelude.Generic)

-- |
-- Create a value of 'ServiceQuota' 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:
--
-- 'adjustable', 'serviceQuota_adjustable' - Indicates whether the quota value can be increased.
--
-- 'errorReason', 'serviceQuota_errorReason' - The error code and error reason.
--
-- 'globalQuota', 'serviceQuota_globalQuota' - Indicates whether the quota is global.
--
-- 'period', 'serviceQuota_period' - The period of time.
--
-- 'quotaArn', 'serviceQuota_quotaArn' - The Amazon Resource Name (ARN) of the quota.
--
-- 'quotaCode', 'serviceQuota_quotaCode' - The quota identifier.
--
-- 'quotaName', 'serviceQuota_quotaName' - The quota name.
--
-- 'serviceCode', 'serviceQuota_serviceCode' - The service identifier.
--
-- 'serviceName', 'serviceQuota_serviceName' - The service name.
--
-- 'unit', 'serviceQuota_unit' - The unit of measurement.
--
-- 'usageMetric', 'serviceQuota_usageMetric' - Information about the measurement.
--
-- 'value', 'serviceQuota_value' - The quota value.
newServiceQuota ::
  ServiceQuota
newServiceQuota :: ServiceQuota
newServiceQuota =
  ServiceQuota'
    { $sel:adjustable:ServiceQuota' :: Maybe Bool
adjustable = forall a. Maybe a
Prelude.Nothing,
      $sel:errorReason:ServiceQuota' :: Maybe ErrorReason
errorReason = forall a. Maybe a
Prelude.Nothing,
      $sel:globalQuota:ServiceQuota' :: Maybe Bool
globalQuota = forall a. Maybe a
Prelude.Nothing,
      $sel:period:ServiceQuota' :: Maybe QuotaPeriod
period = forall a. Maybe a
Prelude.Nothing,
      $sel:quotaArn:ServiceQuota' :: Maybe Text
quotaArn = forall a. Maybe a
Prelude.Nothing,
      $sel:quotaCode:ServiceQuota' :: Maybe Text
quotaCode = forall a. Maybe a
Prelude.Nothing,
      $sel:quotaName:ServiceQuota' :: Maybe Text
quotaName = forall a. Maybe a
Prelude.Nothing,
      $sel:serviceCode:ServiceQuota' :: Maybe Text
serviceCode = forall a. Maybe a
Prelude.Nothing,
      $sel:serviceName:ServiceQuota' :: Maybe Text
serviceName = forall a. Maybe a
Prelude.Nothing,
      $sel:unit:ServiceQuota' :: Maybe Text
unit = forall a. Maybe a
Prelude.Nothing,
      $sel:usageMetric:ServiceQuota' :: Maybe MetricInfo
usageMetric = forall a. Maybe a
Prelude.Nothing,
      $sel:value:ServiceQuota' :: Maybe Double
value = forall a. Maybe a
Prelude.Nothing
    }

-- | Indicates whether the quota value can be increased.
serviceQuota_adjustable :: Lens.Lens' ServiceQuota (Prelude.Maybe Prelude.Bool)
serviceQuota_adjustable :: Lens' ServiceQuota (Maybe Bool)
serviceQuota_adjustable = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ServiceQuota' {Maybe Bool
adjustable :: Maybe Bool
$sel:adjustable:ServiceQuota' :: ServiceQuota -> Maybe Bool
adjustable} -> Maybe Bool
adjustable) (\s :: ServiceQuota
s@ServiceQuota' {} Maybe Bool
a -> ServiceQuota
s {$sel:adjustable:ServiceQuota' :: Maybe Bool
adjustable = Maybe Bool
a} :: ServiceQuota)

-- | The error code and error reason.
serviceQuota_errorReason :: Lens.Lens' ServiceQuota (Prelude.Maybe ErrorReason)
serviceQuota_errorReason :: Lens' ServiceQuota (Maybe ErrorReason)
serviceQuota_errorReason = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ServiceQuota' {Maybe ErrorReason
errorReason :: Maybe ErrorReason
$sel:errorReason:ServiceQuota' :: ServiceQuota -> Maybe ErrorReason
errorReason} -> Maybe ErrorReason
errorReason) (\s :: ServiceQuota
s@ServiceQuota' {} Maybe ErrorReason
a -> ServiceQuota
s {$sel:errorReason:ServiceQuota' :: Maybe ErrorReason
errorReason = Maybe ErrorReason
a} :: ServiceQuota)

-- | Indicates whether the quota is global.
serviceQuota_globalQuota :: Lens.Lens' ServiceQuota (Prelude.Maybe Prelude.Bool)
serviceQuota_globalQuota :: Lens' ServiceQuota (Maybe Bool)
serviceQuota_globalQuota = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ServiceQuota' {Maybe Bool
globalQuota :: Maybe Bool
$sel:globalQuota:ServiceQuota' :: ServiceQuota -> Maybe Bool
globalQuota} -> Maybe Bool
globalQuota) (\s :: ServiceQuota
s@ServiceQuota' {} Maybe Bool
a -> ServiceQuota
s {$sel:globalQuota:ServiceQuota' :: Maybe Bool
globalQuota = Maybe Bool
a} :: ServiceQuota)

-- | The period of time.
serviceQuota_period :: Lens.Lens' ServiceQuota (Prelude.Maybe QuotaPeriod)
serviceQuota_period :: Lens' ServiceQuota (Maybe QuotaPeriod)
serviceQuota_period = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ServiceQuota' {Maybe QuotaPeriod
period :: Maybe QuotaPeriod
$sel:period:ServiceQuota' :: ServiceQuota -> Maybe QuotaPeriod
period} -> Maybe QuotaPeriod
period) (\s :: ServiceQuota
s@ServiceQuota' {} Maybe QuotaPeriod
a -> ServiceQuota
s {$sel:period:ServiceQuota' :: Maybe QuotaPeriod
period = Maybe QuotaPeriod
a} :: ServiceQuota)

-- | The Amazon Resource Name (ARN) of the quota.
serviceQuota_quotaArn :: Lens.Lens' ServiceQuota (Prelude.Maybe Prelude.Text)
serviceQuota_quotaArn :: Lens' ServiceQuota (Maybe Text)
serviceQuota_quotaArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ServiceQuota' {Maybe Text
quotaArn :: Maybe Text
$sel:quotaArn:ServiceQuota' :: ServiceQuota -> Maybe Text
quotaArn} -> Maybe Text
quotaArn) (\s :: ServiceQuota
s@ServiceQuota' {} Maybe Text
a -> ServiceQuota
s {$sel:quotaArn:ServiceQuota' :: Maybe Text
quotaArn = Maybe Text
a} :: ServiceQuota)

-- | The quota identifier.
serviceQuota_quotaCode :: Lens.Lens' ServiceQuota (Prelude.Maybe Prelude.Text)
serviceQuota_quotaCode :: Lens' ServiceQuota (Maybe Text)
serviceQuota_quotaCode = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ServiceQuota' {Maybe Text
quotaCode :: Maybe Text
$sel:quotaCode:ServiceQuota' :: ServiceQuota -> Maybe Text
quotaCode} -> Maybe Text
quotaCode) (\s :: ServiceQuota
s@ServiceQuota' {} Maybe Text
a -> ServiceQuota
s {$sel:quotaCode:ServiceQuota' :: Maybe Text
quotaCode = Maybe Text
a} :: ServiceQuota)

-- | The quota name.
serviceQuota_quotaName :: Lens.Lens' ServiceQuota (Prelude.Maybe Prelude.Text)
serviceQuota_quotaName :: Lens' ServiceQuota (Maybe Text)
serviceQuota_quotaName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ServiceQuota' {Maybe Text
quotaName :: Maybe Text
$sel:quotaName:ServiceQuota' :: ServiceQuota -> Maybe Text
quotaName} -> Maybe Text
quotaName) (\s :: ServiceQuota
s@ServiceQuota' {} Maybe Text
a -> ServiceQuota
s {$sel:quotaName:ServiceQuota' :: Maybe Text
quotaName = Maybe Text
a} :: ServiceQuota)

-- | The service identifier.
serviceQuota_serviceCode :: Lens.Lens' ServiceQuota (Prelude.Maybe Prelude.Text)
serviceQuota_serviceCode :: Lens' ServiceQuota (Maybe Text)
serviceQuota_serviceCode = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ServiceQuota' {Maybe Text
serviceCode :: Maybe Text
$sel:serviceCode:ServiceQuota' :: ServiceQuota -> Maybe Text
serviceCode} -> Maybe Text
serviceCode) (\s :: ServiceQuota
s@ServiceQuota' {} Maybe Text
a -> ServiceQuota
s {$sel:serviceCode:ServiceQuota' :: Maybe Text
serviceCode = Maybe Text
a} :: ServiceQuota)

-- | The service name.
serviceQuota_serviceName :: Lens.Lens' ServiceQuota (Prelude.Maybe Prelude.Text)
serviceQuota_serviceName :: Lens' ServiceQuota (Maybe Text)
serviceQuota_serviceName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ServiceQuota' {Maybe Text
serviceName :: Maybe Text
$sel:serviceName:ServiceQuota' :: ServiceQuota -> Maybe Text
serviceName} -> Maybe Text
serviceName) (\s :: ServiceQuota
s@ServiceQuota' {} Maybe Text
a -> ServiceQuota
s {$sel:serviceName:ServiceQuota' :: Maybe Text
serviceName = Maybe Text
a} :: ServiceQuota)

-- | The unit of measurement.
serviceQuota_unit :: Lens.Lens' ServiceQuota (Prelude.Maybe Prelude.Text)
serviceQuota_unit :: Lens' ServiceQuota (Maybe Text)
serviceQuota_unit = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ServiceQuota' {Maybe Text
unit :: Maybe Text
$sel:unit:ServiceQuota' :: ServiceQuota -> Maybe Text
unit} -> Maybe Text
unit) (\s :: ServiceQuota
s@ServiceQuota' {} Maybe Text
a -> ServiceQuota
s {$sel:unit:ServiceQuota' :: Maybe Text
unit = Maybe Text
a} :: ServiceQuota)

-- | Information about the measurement.
serviceQuota_usageMetric :: Lens.Lens' ServiceQuota (Prelude.Maybe MetricInfo)
serviceQuota_usageMetric :: Lens' ServiceQuota (Maybe MetricInfo)
serviceQuota_usageMetric = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ServiceQuota' {Maybe MetricInfo
usageMetric :: Maybe MetricInfo
$sel:usageMetric:ServiceQuota' :: ServiceQuota -> Maybe MetricInfo
usageMetric} -> Maybe MetricInfo
usageMetric) (\s :: ServiceQuota
s@ServiceQuota' {} Maybe MetricInfo
a -> ServiceQuota
s {$sel:usageMetric:ServiceQuota' :: Maybe MetricInfo
usageMetric = Maybe MetricInfo
a} :: ServiceQuota)

-- | The quota value.
serviceQuota_value :: Lens.Lens' ServiceQuota (Prelude.Maybe Prelude.Double)
serviceQuota_value :: Lens' ServiceQuota (Maybe Double)
serviceQuota_value = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ServiceQuota' {Maybe Double
value :: Maybe Double
$sel:value:ServiceQuota' :: ServiceQuota -> Maybe Double
value} -> Maybe Double
value) (\s :: ServiceQuota
s@ServiceQuota' {} Maybe Double
a -> ServiceQuota
s {$sel:value:ServiceQuota' :: Maybe Double
value = Maybe Double
a} :: ServiceQuota)

instance Data.FromJSON ServiceQuota where
  parseJSON :: Value -> Parser ServiceQuota
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"ServiceQuota"
      ( \Object
x ->
          Maybe Bool
-> Maybe ErrorReason
-> Maybe Bool
-> Maybe QuotaPeriod
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe MetricInfo
-> Maybe Double
-> ServiceQuota
ServiceQuota'
            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
"Adjustable")
            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
"ErrorReason")
            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
"GlobalQuota")
            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
"Period")
            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
"QuotaArn")
            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
"QuotaCode")
            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
"QuotaName")
            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
"ServiceCode")
            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
"ServiceName")
            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
"Unit")
            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
"UsageMetric")
            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
"Value")
      )

instance Prelude.Hashable ServiceQuota where
  hashWithSalt :: Int -> ServiceQuota -> Int
hashWithSalt Int
_salt ServiceQuota' {Maybe Bool
Maybe Double
Maybe Text
Maybe ErrorReason
Maybe MetricInfo
Maybe QuotaPeriod
value :: Maybe Double
usageMetric :: Maybe MetricInfo
unit :: Maybe Text
serviceName :: Maybe Text
serviceCode :: Maybe Text
quotaName :: Maybe Text
quotaCode :: Maybe Text
quotaArn :: Maybe Text
period :: Maybe QuotaPeriod
globalQuota :: Maybe Bool
errorReason :: Maybe ErrorReason
adjustable :: Maybe Bool
$sel:value:ServiceQuota' :: ServiceQuota -> Maybe Double
$sel:usageMetric:ServiceQuota' :: ServiceQuota -> Maybe MetricInfo
$sel:unit:ServiceQuota' :: ServiceQuota -> Maybe Text
$sel:serviceName:ServiceQuota' :: ServiceQuota -> Maybe Text
$sel:serviceCode:ServiceQuota' :: ServiceQuota -> Maybe Text
$sel:quotaName:ServiceQuota' :: ServiceQuota -> Maybe Text
$sel:quotaCode:ServiceQuota' :: ServiceQuota -> Maybe Text
$sel:quotaArn:ServiceQuota' :: ServiceQuota -> Maybe Text
$sel:period:ServiceQuota' :: ServiceQuota -> Maybe QuotaPeriod
$sel:globalQuota:ServiceQuota' :: ServiceQuota -> Maybe Bool
$sel:errorReason:ServiceQuota' :: ServiceQuota -> Maybe ErrorReason
$sel:adjustable:ServiceQuota' :: ServiceQuota -> Maybe Bool
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
adjustable
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ErrorReason
errorReason
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
globalQuota
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe QuotaPeriod
period
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
quotaArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
quotaCode
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
quotaName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
serviceCode
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
serviceName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
unit
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe MetricInfo
usageMetric
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Double
value

instance Prelude.NFData ServiceQuota where
  rnf :: ServiceQuota -> ()
rnf ServiceQuota' {Maybe Bool
Maybe Double
Maybe Text
Maybe ErrorReason
Maybe MetricInfo
Maybe QuotaPeriod
value :: Maybe Double
usageMetric :: Maybe MetricInfo
unit :: Maybe Text
serviceName :: Maybe Text
serviceCode :: Maybe Text
quotaName :: Maybe Text
quotaCode :: Maybe Text
quotaArn :: Maybe Text
period :: Maybe QuotaPeriod
globalQuota :: Maybe Bool
errorReason :: Maybe ErrorReason
adjustable :: Maybe Bool
$sel:value:ServiceQuota' :: ServiceQuota -> Maybe Double
$sel:usageMetric:ServiceQuota' :: ServiceQuota -> Maybe MetricInfo
$sel:unit:ServiceQuota' :: ServiceQuota -> Maybe Text
$sel:serviceName:ServiceQuota' :: ServiceQuota -> Maybe Text
$sel:serviceCode:ServiceQuota' :: ServiceQuota -> Maybe Text
$sel:quotaName:ServiceQuota' :: ServiceQuota -> Maybe Text
$sel:quotaCode:ServiceQuota' :: ServiceQuota -> Maybe Text
$sel:quotaArn:ServiceQuota' :: ServiceQuota -> Maybe Text
$sel:period:ServiceQuota' :: ServiceQuota -> Maybe QuotaPeriod
$sel:globalQuota:ServiceQuota' :: ServiceQuota -> Maybe Bool
$sel:errorReason:ServiceQuota' :: ServiceQuota -> Maybe ErrorReason
$sel:adjustable:ServiceQuota' :: ServiceQuota -> Maybe Bool
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
adjustable
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ErrorReason
errorReason
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
globalQuota
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe QuotaPeriod
period
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
quotaArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
quotaCode
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
quotaName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
serviceCode
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
serviceName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
unit
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe MetricInfo
usageMetric
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Double
value