{-# 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.DynamoDB.Types.ConsumedCapacity
-- 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.DynamoDB.Types.ConsumedCapacity where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.DynamoDB.Types.AttributeValue
import Amazonka.DynamoDB.Types.Capacity
import Amazonka.DynamoDB.Types.WriteRequest
import qualified Amazonka.Prelude as Prelude

-- | The capacity units consumed by an operation. The data returned includes
-- the total provisioned throughput consumed, along with statistics for the
-- table and any indexes involved in the operation. @ConsumedCapacity@ is
-- only returned if the request asked for it. For more information, see
-- <https://docs.aws.amazon.com/amazondynamodb/latest/developerguide/ProvisionedThroughputIntro.html Provisioned Throughput>
-- in the /Amazon DynamoDB Developer Guide/.
--
-- /See:/ 'newConsumedCapacity' smart constructor.
data ConsumedCapacity = ConsumedCapacity'
  { -- | The total number of capacity units consumed by the operation.
    ConsumedCapacity -> Maybe Double
capacityUnits :: Prelude.Maybe Prelude.Double,
    -- | The amount of throughput consumed on each global index affected by the
    -- operation.
    ConsumedCapacity -> Maybe (HashMap Text Capacity)
globalSecondaryIndexes :: Prelude.Maybe (Prelude.HashMap Prelude.Text Capacity),
    -- | The amount of throughput consumed on each local index affected by the
    -- operation.
    ConsumedCapacity -> Maybe (HashMap Text Capacity)
localSecondaryIndexes :: Prelude.Maybe (Prelude.HashMap Prelude.Text Capacity),
    -- | The total number of read capacity units consumed by the operation.
    ConsumedCapacity -> Maybe Double
readCapacityUnits :: Prelude.Maybe Prelude.Double,
    -- | The amount of throughput consumed on the table affected by the
    -- operation.
    ConsumedCapacity -> Maybe Capacity
table :: Prelude.Maybe Capacity,
    -- | The name of the table that was affected by the operation.
    ConsumedCapacity -> Maybe Text
tableName :: Prelude.Maybe Prelude.Text,
    -- | The total number of write capacity units consumed by the operation.
    ConsumedCapacity -> Maybe Double
writeCapacityUnits :: Prelude.Maybe Prelude.Double
  }
  deriving (ConsumedCapacity -> ConsumedCapacity -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ConsumedCapacity -> ConsumedCapacity -> Bool
$c/= :: ConsumedCapacity -> ConsumedCapacity -> Bool
== :: ConsumedCapacity -> ConsumedCapacity -> Bool
$c== :: ConsumedCapacity -> ConsumedCapacity -> Bool
Prelude.Eq, ReadPrec [ConsumedCapacity]
ReadPrec ConsumedCapacity
Int -> ReadS ConsumedCapacity
ReadS [ConsumedCapacity]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ConsumedCapacity]
$creadListPrec :: ReadPrec [ConsumedCapacity]
readPrec :: ReadPrec ConsumedCapacity
$creadPrec :: ReadPrec ConsumedCapacity
readList :: ReadS [ConsumedCapacity]
$creadList :: ReadS [ConsumedCapacity]
readsPrec :: Int -> ReadS ConsumedCapacity
$creadsPrec :: Int -> ReadS ConsumedCapacity
Prelude.Read, Int -> ConsumedCapacity -> ShowS
[ConsumedCapacity] -> ShowS
ConsumedCapacity -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ConsumedCapacity] -> ShowS
$cshowList :: [ConsumedCapacity] -> ShowS
show :: ConsumedCapacity -> String
$cshow :: ConsumedCapacity -> String
showsPrec :: Int -> ConsumedCapacity -> ShowS
$cshowsPrec :: Int -> ConsumedCapacity -> ShowS
Prelude.Show, forall x. Rep ConsumedCapacity x -> ConsumedCapacity
forall x. ConsumedCapacity -> Rep ConsumedCapacity x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ConsumedCapacity x -> ConsumedCapacity
$cfrom :: forall x. ConsumedCapacity -> Rep ConsumedCapacity x
Prelude.Generic)

-- |
-- Create a value of 'ConsumedCapacity' 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:
--
-- 'capacityUnits', 'consumedCapacity_capacityUnits' - The total number of capacity units consumed by the operation.
--
-- 'globalSecondaryIndexes', 'consumedCapacity_globalSecondaryIndexes' - The amount of throughput consumed on each global index affected by the
-- operation.
--
-- 'localSecondaryIndexes', 'consumedCapacity_localSecondaryIndexes' - The amount of throughput consumed on each local index affected by the
-- operation.
--
-- 'readCapacityUnits', 'consumedCapacity_readCapacityUnits' - The total number of read capacity units consumed by the operation.
--
-- 'table', 'consumedCapacity_table' - The amount of throughput consumed on the table affected by the
-- operation.
--
-- 'tableName', 'consumedCapacity_tableName' - The name of the table that was affected by the operation.
--
-- 'writeCapacityUnits', 'consumedCapacity_writeCapacityUnits' - The total number of write capacity units consumed by the operation.
newConsumedCapacity ::
  ConsumedCapacity
newConsumedCapacity :: ConsumedCapacity
newConsumedCapacity =
  ConsumedCapacity'
    { $sel:capacityUnits:ConsumedCapacity' :: Maybe Double
capacityUnits = forall a. Maybe a
Prelude.Nothing,
      $sel:globalSecondaryIndexes:ConsumedCapacity' :: Maybe (HashMap Text Capacity)
globalSecondaryIndexes = forall a. Maybe a
Prelude.Nothing,
      $sel:localSecondaryIndexes:ConsumedCapacity' :: Maybe (HashMap Text Capacity)
localSecondaryIndexes = forall a. Maybe a
Prelude.Nothing,
      $sel:readCapacityUnits:ConsumedCapacity' :: Maybe Double
readCapacityUnits = forall a. Maybe a
Prelude.Nothing,
      $sel:table:ConsumedCapacity' :: Maybe Capacity
table = forall a. Maybe a
Prelude.Nothing,
      $sel:tableName:ConsumedCapacity' :: Maybe Text
tableName = forall a. Maybe a
Prelude.Nothing,
      $sel:writeCapacityUnits:ConsumedCapacity' :: Maybe Double
writeCapacityUnits = forall a. Maybe a
Prelude.Nothing
    }

-- | The total number of capacity units consumed by the operation.
consumedCapacity_capacityUnits :: Lens.Lens' ConsumedCapacity (Prelude.Maybe Prelude.Double)
consumedCapacity_capacityUnits :: Lens' ConsumedCapacity (Maybe Double)
consumedCapacity_capacityUnits = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ConsumedCapacity' {Maybe Double
capacityUnits :: Maybe Double
$sel:capacityUnits:ConsumedCapacity' :: ConsumedCapacity -> Maybe Double
capacityUnits} -> Maybe Double
capacityUnits) (\s :: ConsumedCapacity
s@ConsumedCapacity' {} Maybe Double
a -> ConsumedCapacity
s {$sel:capacityUnits:ConsumedCapacity' :: Maybe Double
capacityUnits = Maybe Double
a} :: ConsumedCapacity)

-- | The amount of throughput consumed on each global index affected by the
-- operation.
consumedCapacity_globalSecondaryIndexes :: Lens.Lens' ConsumedCapacity (Prelude.Maybe (Prelude.HashMap Prelude.Text Capacity))
consumedCapacity_globalSecondaryIndexes :: Lens' ConsumedCapacity (Maybe (HashMap Text Capacity))
consumedCapacity_globalSecondaryIndexes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ConsumedCapacity' {Maybe (HashMap Text Capacity)
globalSecondaryIndexes :: Maybe (HashMap Text Capacity)
$sel:globalSecondaryIndexes:ConsumedCapacity' :: ConsumedCapacity -> Maybe (HashMap Text Capacity)
globalSecondaryIndexes} -> Maybe (HashMap Text Capacity)
globalSecondaryIndexes) (\s :: ConsumedCapacity
s@ConsumedCapacity' {} Maybe (HashMap Text Capacity)
a -> ConsumedCapacity
s {$sel:globalSecondaryIndexes:ConsumedCapacity' :: Maybe (HashMap Text Capacity)
globalSecondaryIndexes = Maybe (HashMap Text Capacity)
a} :: ConsumedCapacity) 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 amount of throughput consumed on each local index affected by the
-- operation.
consumedCapacity_localSecondaryIndexes :: Lens.Lens' ConsumedCapacity (Prelude.Maybe (Prelude.HashMap Prelude.Text Capacity))
consumedCapacity_localSecondaryIndexes :: Lens' ConsumedCapacity (Maybe (HashMap Text Capacity))
consumedCapacity_localSecondaryIndexes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ConsumedCapacity' {Maybe (HashMap Text Capacity)
localSecondaryIndexes :: Maybe (HashMap Text Capacity)
$sel:localSecondaryIndexes:ConsumedCapacity' :: ConsumedCapacity -> Maybe (HashMap Text Capacity)
localSecondaryIndexes} -> Maybe (HashMap Text Capacity)
localSecondaryIndexes) (\s :: ConsumedCapacity
s@ConsumedCapacity' {} Maybe (HashMap Text Capacity)
a -> ConsumedCapacity
s {$sel:localSecondaryIndexes:ConsumedCapacity' :: Maybe (HashMap Text Capacity)
localSecondaryIndexes = Maybe (HashMap Text Capacity)
a} :: ConsumedCapacity) 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 total number of read capacity units consumed by the operation.
consumedCapacity_readCapacityUnits :: Lens.Lens' ConsumedCapacity (Prelude.Maybe Prelude.Double)
consumedCapacity_readCapacityUnits :: Lens' ConsumedCapacity (Maybe Double)
consumedCapacity_readCapacityUnits = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ConsumedCapacity' {Maybe Double
readCapacityUnits :: Maybe Double
$sel:readCapacityUnits:ConsumedCapacity' :: ConsumedCapacity -> Maybe Double
readCapacityUnits} -> Maybe Double
readCapacityUnits) (\s :: ConsumedCapacity
s@ConsumedCapacity' {} Maybe Double
a -> ConsumedCapacity
s {$sel:readCapacityUnits:ConsumedCapacity' :: Maybe Double
readCapacityUnits = Maybe Double
a} :: ConsumedCapacity)

-- | The amount of throughput consumed on the table affected by the
-- operation.
consumedCapacity_table :: Lens.Lens' ConsumedCapacity (Prelude.Maybe Capacity)
consumedCapacity_table :: Lens' ConsumedCapacity (Maybe Capacity)
consumedCapacity_table = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ConsumedCapacity' {Maybe Capacity
table :: Maybe Capacity
$sel:table:ConsumedCapacity' :: ConsumedCapacity -> Maybe Capacity
table} -> Maybe Capacity
table) (\s :: ConsumedCapacity
s@ConsumedCapacity' {} Maybe Capacity
a -> ConsumedCapacity
s {$sel:table:ConsumedCapacity' :: Maybe Capacity
table = Maybe Capacity
a} :: ConsumedCapacity)

-- | The name of the table that was affected by the operation.
consumedCapacity_tableName :: Lens.Lens' ConsumedCapacity (Prelude.Maybe Prelude.Text)
consumedCapacity_tableName :: Lens' ConsumedCapacity (Maybe Text)
consumedCapacity_tableName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ConsumedCapacity' {Maybe Text
tableName :: Maybe Text
$sel:tableName:ConsumedCapacity' :: ConsumedCapacity -> Maybe Text
tableName} -> Maybe Text
tableName) (\s :: ConsumedCapacity
s@ConsumedCapacity' {} Maybe Text
a -> ConsumedCapacity
s {$sel:tableName:ConsumedCapacity' :: Maybe Text
tableName = Maybe Text
a} :: ConsumedCapacity)

-- | The total number of write capacity units consumed by the operation.
consumedCapacity_writeCapacityUnits :: Lens.Lens' ConsumedCapacity (Prelude.Maybe Prelude.Double)
consumedCapacity_writeCapacityUnits :: Lens' ConsumedCapacity (Maybe Double)
consumedCapacity_writeCapacityUnits = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ConsumedCapacity' {Maybe Double
writeCapacityUnits :: Maybe Double
$sel:writeCapacityUnits:ConsumedCapacity' :: ConsumedCapacity -> Maybe Double
writeCapacityUnits} -> Maybe Double
writeCapacityUnits) (\s :: ConsumedCapacity
s@ConsumedCapacity' {} Maybe Double
a -> ConsumedCapacity
s {$sel:writeCapacityUnits:ConsumedCapacity' :: Maybe Double
writeCapacityUnits = Maybe Double
a} :: ConsumedCapacity)

instance Data.FromJSON ConsumedCapacity where
  parseJSON :: Value -> Parser ConsumedCapacity
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"ConsumedCapacity"
      ( \Object
x ->
          Maybe Double
-> Maybe (HashMap Text Capacity)
-> Maybe (HashMap Text Capacity)
-> Maybe Double
-> Maybe Capacity
-> Maybe Text
-> Maybe Double
-> ConsumedCapacity
ConsumedCapacity'
            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
"CapacityUnits")
            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
"GlobalSecondaryIndexes"
                            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
"LocalSecondaryIndexes"
                            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
"ReadCapacityUnits")
            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
"Table")
            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
"TableName")
            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
"WriteCapacityUnits")
      )

instance Prelude.Hashable ConsumedCapacity where
  hashWithSalt :: Int -> ConsumedCapacity -> Int
hashWithSalt Int
_salt ConsumedCapacity' {Maybe Double
Maybe Text
Maybe (HashMap Text Capacity)
Maybe Capacity
writeCapacityUnits :: Maybe Double
tableName :: Maybe Text
table :: Maybe Capacity
readCapacityUnits :: Maybe Double
localSecondaryIndexes :: Maybe (HashMap Text Capacity)
globalSecondaryIndexes :: Maybe (HashMap Text Capacity)
capacityUnits :: Maybe Double
$sel:writeCapacityUnits:ConsumedCapacity' :: ConsumedCapacity -> Maybe Double
$sel:tableName:ConsumedCapacity' :: ConsumedCapacity -> Maybe Text
$sel:table:ConsumedCapacity' :: ConsumedCapacity -> Maybe Capacity
$sel:readCapacityUnits:ConsumedCapacity' :: ConsumedCapacity -> Maybe Double
$sel:localSecondaryIndexes:ConsumedCapacity' :: ConsumedCapacity -> Maybe (HashMap Text Capacity)
$sel:globalSecondaryIndexes:ConsumedCapacity' :: ConsumedCapacity -> Maybe (HashMap Text Capacity)
$sel:capacityUnits:ConsumedCapacity' :: ConsumedCapacity -> Maybe Double
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Double
capacityUnits
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Capacity)
globalSecondaryIndexes
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Capacity)
localSecondaryIndexes
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Double
readCapacityUnits
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Capacity
table
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
tableName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Double
writeCapacityUnits

instance Prelude.NFData ConsumedCapacity where
  rnf :: ConsumedCapacity -> ()
rnf ConsumedCapacity' {Maybe Double
Maybe Text
Maybe (HashMap Text Capacity)
Maybe Capacity
writeCapacityUnits :: Maybe Double
tableName :: Maybe Text
table :: Maybe Capacity
readCapacityUnits :: Maybe Double
localSecondaryIndexes :: Maybe (HashMap Text Capacity)
globalSecondaryIndexes :: Maybe (HashMap Text Capacity)
capacityUnits :: Maybe Double
$sel:writeCapacityUnits:ConsumedCapacity' :: ConsumedCapacity -> Maybe Double
$sel:tableName:ConsumedCapacity' :: ConsumedCapacity -> Maybe Text
$sel:table:ConsumedCapacity' :: ConsumedCapacity -> Maybe Capacity
$sel:readCapacityUnits:ConsumedCapacity' :: ConsumedCapacity -> Maybe Double
$sel:localSecondaryIndexes:ConsumedCapacity' :: ConsumedCapacity -> Maybe (HashMap Text Capacity)
$sel:globalSecondaryIndexes:ConsumedCapacity' :: ConsumedCapacity -> Maybe (HashMap Text Capacity)
$sel:capacityUnits:ConsumedCapacity' :: ConsumedCapacity -> Maybe Double
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Double
capacityUnits
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text Capacity)
globalSecondaryIndexes
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text Capacity)
localSecondaryIndexes
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Double
readCapacityUnits
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Capacity
table
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
tableName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Double
writeCapacityUnits