{-# 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.MacieV2.Types.UsageByAccount
-- 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.MacieV2.Types.UsageByAccount where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.MacieV2.Types.Currency
import Amazonka.MacieV2.Types.ServiceLimit
import Amazonka.MacieV2.Types.UsageType
import qualified Amazonka.Prelude as Prelude

-- | Provides data for a specific usage metric and the corresponding quota
-- for an Amazon Macie account.
--
-- /See:/ 'newUsageByAccount' smart constructor.
data UsageByAccount = UsageByAccount'
  { -- | The type of currency that the value for the metric (estimatedCost) is
    -- reported in.
    UsageByAccount -> Maybe Currency
currency :: Prelude.Maybe Currency,
    -- | The estimated value for the metric.
    UsageByAccount -> Maybe Text
estimatedCost :: Prelude.Maybe Prelude.Text,
    -- | The current value for the quota that corresponds to the metric specified
    -- by the type field.
    UsageByAccount -> Maybe ServiceLimit
serviceLimit :: Prelude.Maybe ServiceLimit,
    -- | The name of the metric. Possible values are:
    -- AUTOMATED_OBJECT_MONITORING, to monitor S3 objects for automated
    -- sensitive data discovery; AUTOMATED_SENSITIVE_DATA_DISCOVERY, to analyze
    -- S3 objects for automated sensitive data discovery;
    -- DATA_INVENTORY_EVALUATION, to monitor S3 buckets; and,
    -- SENSITIVE_DATA_DISCOVERY, to run classification jobs.
    UsageByAccount -> Maybe UsageType
type' :: Prelude.Maybe UsageType
  }
  deriving (UsageByAccount -> UsageByAccount -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UsageByAccount -> UsageByAccount -> Bool
$c/= :: UsageByAccount -> UsageByAccount -> Bool
== :: UsageByAccount -> UsageByAccount -> Bool
$c== :: UsageByAccount -> UsageByAccount -> Bool
Prelude.Eq, ReadPrec [UsageByAccount]
ReadPrec UsageByAccount
Int -> ReadS UsageByAccount
ReadS [UsageByAccount]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UsageByAccount]
$creadListPrec :: ReadPrec [UsageByAccount]
readPrec :: ReadPrec UsageByAccount
$creadPrec :: ReadPrec UsageByAccount
readList :: ReadS [UsageByAccount]
$creadList :: ReadS [UsageByAccount]
readsPrec :: Int -> ReadS UsageByAccount
$creadsPrec :: Int -> ReadS UsageByAccount
Prelude.Read, Int -> UsageByAccount -> ShowS
[UsageByAccount] -> ShowS
UsageByAccount -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UsageByAccount] -> ShowS
$cshowList :: [UsageByAccount] -> ShowS
show :: UsageByAccount -> String
$cshow :: UsageByAccount -> String
showsPrec :: Int -> UsageByAccount -> ShowS
$cshowsPrec :: Int -> UsageByAccount -> ShowS
Prelude.Show, forall x. Rep UsageByAccount x -> UsageByAccount
forall x. UsageByAccount -> Rep UsageByAccount x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UsageByAccount x -> UsageByAccount
$cfrom :: forall x. UsageByAccount -> Rep UsageByAccount x
Prelude.Generic)

-- |
-- Create a value of 'UsageByAccount' 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:
--
-- 'currency', 'usageByAccount_currency' - The type of currency that the value for the metric (estimatedCost) is
-- reported in.
--
-- 'estimatedCost', 'usageByAccount_estimatedCost' - The estimated value for the metric.
--
-- 'serviceLimit', 'usageByAccount_serviceLimit' - The current value for the quota that corresponds to the metric specified
-- by the type field.
--
-- 'type'', 'usageByAccount_type' - The name of the metric. Possible values are:
-- AUTOMATED_OBJECT_MONITORING, to monitor S3 objects for automated
-- sensitive data discovery; AUTOMATED_SENSITIVE_DATA_DISCOVERY, to analyze
-- S3 objects for automated sensitive data discovery;
-- DATA_INVENTORY_EVALUATION, to monitor S3 buckets; and,
-- SENSITIVE_DATA_DISCOVERY, to run classification jobs.
newUsageByAccount ::
  UsageByAccount
newUsageByAccount :: UsageByAccount
newUsageByAccount =
  UsageByAccount'
    { $sel:currency:UsageByAccount' :: Maybe Currency
currency = forall a. Maybe a
Prelude.Nothing,
      $sel:estimatedCost:UsageByAccount' :: Maybe Text
estimatedCost = forall a. Maybe a
Prelude.Nothing,
      $sel:serviceLimit:UsageByAccount' :: Maybe ServiceLimit
serviceLimit = forall a. Maybe a
Prelude.Nothing,
      $sel:type':UsageByAccount' :: Maybe UsageType
type' = forall a. Maybe a
Prelude.Nothing
    }

-- | The type of currency that the value for the metric (estimatedCost) is
-- reported in.
usageByAccount_currency :: Lens.Lens' UsageByAccount (Prelude.Maybe Currency)
usageByAccount_currency :: Lens' UsageByAccount (Maybe Currency)
usageByAccount_currency = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UsageByAccount' {Maybe Currency
currency :: Maybe Currency
$sel:currency:UsageByAccount' :: UsageByAccount -> Maybe Currency
currency} -> Maybe Currency
currency) (\s :: UsageByAccount
s@UsageByAccount' {} Maybe Currency
a -> UsageByAccount
s {$sel:currency:UsageByAccount' :: Maybe Currency
currency = Maybe Currency
a} :: UsageByAccount)

-- | The estimated value for the metric.
usageByAccount_estimatedCost :: Lens.Lens' UsageByAccount (Prelude.Maybe Prelude.Text)
usageByAccount_estimatedCost :: Lens' UsageByAccount (Maybe Text)
usageByAccount_estimatedCost = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UsageByAccount' {Maybe Text
estimatedCost :: Maybe Text
$sel:estimatedCost:UsageByAccount' :: UsageByAccount -> Maybe Text
estimatedCost} -> Maybe Text
estimatedCost) (\s :: UsageByAccount
s@UsageByAccount' {} Maybe Text
a -> UsageByAccount
s {$sel:estimatedCost:UsageByAccount' :: Maybe Text
estimatedCost = Maybe Text
a} :: UsageByAccount)

-- | The current value for the quota that corresponds to the metric specified
-- by the type field.
usageByAccount_serviceLimit :: Lens.Lens' UsageByAccount (Prelude.Maybe ServiceLimit)
usageByAccount_serviceLimit :: Lens' UsageByAccount (Maybe ServiceLimit)
usageByAccount_serviceLimit = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UsageByAccount' {Maybe ServiceLimit
serviceLimit :: Maybe ServiceLimit
$sel:serviceLimit:UsageByAccount' :: UsageByAccount -> Maybe ServiceLimit
serviceLimit} -> Maybe ServiceLimit
serviceLimit) (\s :: UsageByAccount
s@UsageByAccount' {} Maybe ServiceLimit
a -> UsageByAccount
s {$sel:serviceLimit:UsageByAccount' :: Maybe ServiceLimit
serviceLimit = Maybe ServiceLimit
a} :: UsageByAccount)

-- | The name of the metric. Possible values are:
-- AUTOMATED_OBJECT_MONITORING, to monitor S3 objects for automated
-- sensitive data discovery; AUTOMATED_SENSITIVE_DATA_DISCOVERY, to analyze
-- S3 objects for automated sensitive data discovery;
-- DATA_INVENTORY_EVALUATION, to monitor S3 buckets; and,
-- SENSITIVE_DATA_DISCOVERY, to run classification jobs.
usageByAccount_type :: Lens.Lens' UsageByAccount (Prelude.Maybe UsageType)
usageByAccount_type :: Lens' UsageByAccount (Maybe UsageType)
usageByAccount_type = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UsageByAccount' {Maybe UsageType
type' :: Maybe UsageType
$sel:type':UsageByAccount' :: UsageByAccount -> Maybe UsageType
type'} -> Maybe UsageType
type') (\s :: UsageByAccount
s@UsageByAccount' {} Maybe UsageType
a -> UsageByAccount
s {$sel:type':UsageByAccount' :: Maybe UsageType
type' = Maybe UsageType
a} :: UsageByAccount)

instance Data.FromJSON UsageByAccount where
  parseJSON :: Value -> Parser UsageByAccount
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"UsageByAccount"
      ( \Object
x ->
          Maybe Currency
-> Maybe Text
-> Maybe ServiceLimit
-> Maybe UsageType
-> UsageByAccount
UsageByAccount'
            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
"currency")
            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
"estimatedCost")
            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
"serviceLimit")
            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
"type")
      )

instance Prelude.Hashable UsageByAccount where
  hashWithSalt :: Int -> UsageByAccount -> Int
hashWithSalt Int
_salt UsageByAccount' {Maybe Text
Maybe Currency
Maybe ServiceLimit
Maybe UsageType
type' :: Maybe UsageType
serviceLimit :: Maybe ServiceLimit
estimatedCost :: Maybe Text
currency :: Maybe Currency
$sel:type':UsageByAccount' :: UsageByAccount -> Maybe UsageType
$sel:serviceLimit:UsageByAccount' :: UsageByAccount -> Maybe ServiceLimit
$sel:estimatedCost:UsageByAccount' :: UsageByAccount -> Maybe Text
$sel:currency:UsageByAccount' :: UsageByAccount -> Maybe Currency
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Currency
currency
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
estimatedCost
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ServiceLimit
serviceLimit
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe UsageType
type'

instance Prelude.NFData UsageByAccount where
  rnf :: UsageByAccount -> ()
rnf UsageByAccount' {Maybe Text
Maybe Currency
Maybe ServiceLimit
Maybe UsageType
type' :: Maybe UsageType
serviceLimit :: Maybe ServiceLimit
estimatedCost :: Maybe Text
currency :: Maybe Currency
$sel:type':UsageByAccount' :: UsageByAccount -> Maybe UsageType
$sel:serviceLimit:UsageByAccount' :: UsageByAccount -> Maybe ServiceLimit
$sel:estimatedCost:UsageByAccount' :: UsageByAccount -> Maybe Text
$sel:currency:UsageByAccount' :: UsageByAccount -> Maybe Currency
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Currency
currency
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
estimatedCost
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ServiceLimit
serviceLimit
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe UsageType
type'