{-# 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.BillingModeSummary
-- 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.BillingModeSummary 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.BillingMode
import Amazonka.DynamoDB.Types.WriteRequest
import qualified Amazonka.Prelude as Prelude

-- | Contains the details for the read\/write capacity mode. This page talks
-- about @PROVISIONED@ and @PAY_PER_REQUEST@ billing modes. For more
-- information about these modes, see
-- <https://docs.aws.amazon.com/amazondynamodb/latest/developerguide/HowItWorks.ReadWriteCapacityMode.html Read\/write capacity mode>.
--
-- You may need to switch to on-demand mode at least once in order to
-- return a @BillingModeSummary@ response.
--
-- /See:/ 'newBillingModeSummary' smart constructor.
data BillingModeSummary = BillingModeSummary'
  { -- | Controls how you are charged for read and write throughput and how you
    -- manage capacity. This setting can be changed later.
    --
    -- -   @PROVISIONED@ - Sets the read\/write capacity mode to @PROVISIONED@.
    --     We recommend using @PROVISIONED@ for predictable workloads.
    --
    -- -   @PAY_PER_REQUEST@ - Sets the read\/write capacity mode to
    --     @PAY_PER_REQUEST@. We recommend using @PAY_PER_REQUEST@ for
    --     unpredictable workloads.
    BillingModeSummary -> Maybe BillingMode
billingMode :: Prelude.Maybe BillingMode,
    -- | Represents the time when @PAY_PER_REQUEST@ was last set as the
    -- read\/write capacity mode.
    BillingModeSummary -> Maybe POSIX
lastUpdateToPayPerRequestDateTime :: Prelude.Maybe Data.POSIX
  }
  deriving (BillingModeSummary -> BillingModeSummary -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BillingModeSummary -> BillingModeSummary -> Bool
$c/= :: BillingModeSummary -> BillingModeSummary -> Bool
== :: BillingModeSummary -> BillingModeSummary -> Bool
$c== :: BillingModeSummary -> BillingModeSummary -> Bool
Prelude.Eq, ReadPrec [BillingModeSummary]
ReadPrec BillingModeSummary
Int -> ReadS BillingModeSummary
ReadS [BillingModeSummary]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [BillingModeSummary]
$creadListPrec :: ReadPrec [BillingModeSummary]
readPrec :: ReadPrec BillingModeSummary
$creadPrec :: ReadPrec BillingModeSummary
readList :: ReadS [BillingModeSummary]
$creadList :: ReadS [BillingModeSummary]
readsPrec :: Int -> ReadS BillingModeSummary
$creadsPrec :: Int -> ReadS BillingModeSummary
Prelude.Read, Int -> BillingModeSummary -> ShowS
[BillingModeSummary] -> ShowS
BillingModeSummary -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BillingModeSummary] -> ShowS
$cshowList :: [BillingModeSummary] -> ShowS
show :: BillingModeSummary -> String
$cshow :: BillingModeSummary -> String
showsPrec :: Int -> BillingModeSummary -> ShowS
$cshowsPrec :: Int -> BillingModeSummary -> ShowS
Prelude.Show, forall x. Rep BillingModeSummary x -> BillingModeSummary
forall x. BillingModeSummary -> Rep BillingModeSummary x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BillingModeSummary x -> BillingModeSummary
$cfrom :: forall x. BillingModeSummary -> Rep BillingModeSummary x
Prelude.Generic)

-- |
-- Create a value of 'BillingModeSummary' 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:
--
-- 'billingMode', 'billingModeSummary_billingMode' - Controls how you are charged for read and write throughput and how you
-- manage capacity. This setting can be changed later.
--
-- -   @PROVISIONED@ - Sets the read\/write capacity mode to @PROVISIONED@.
--     We recommend using @PROVISIONED@ for predictable workloads.
--
-- -   @PAY_PER_REQUEST@ - Sets the read\/write capacity mode to
--     @PAY_PER_REQUEST@. We recommend using @PAY_PER_REQUEST@ for
--     unpredictable workloads.
--
-- 'lastUpdateToPayPerRequestDateTime', 'billingModeSummary_lastUpdateToPayPerRequestDateTime' - Represents the time when @PAY_PER_REQUEST@ was last set as the
-- read\/write capacity mode.
newBillingModeSummary ::
  BillingModeSummary
newBillingModeSummary :: BillingModeSummary
newBillingModeSummary =
  BillingModeSummary'
    { $sel:billingMode:BillingModeSummary' :: Maybe BillingMode
billingMode = forall a. Maybe a
Prelude.Nothing,
      $sel:lastUpdateToPayPerRequestDateTime:BillingModeSummary' :: Maybe POSIX
lastUpdateToPayPerRequestDateTime = forall a. Maybe a
Prelude.Nothing
    }

-- | Controls how you are charged for read and write throughput and how you
-- manage capacity. This setting can be changed later.
--
-- -   @PROVISIONED@ - Sets the read\/write capacity mode to @PROVISIONED@.
--     We recommend using @PROVISIONED@ for predictable workloads.
--
-- -   @PAY_PER_REQUEST@ - Sets the read\/write capacity mode to
--     @PAY_PER_REQUEST@. We recommend using @PAY_PER_REQUEST@ for
--     unpredictable workloads.
billingModeSummary_billingMode :: Lens.Lens' BillingModeSummary (Prelude.Maybe BillingMode)
billingModeSummary_billingMode :: Lens' BillingModeSummary (Maybe BillingMode)
billingModeSummary_billingMode = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BillingModeSummary' {Maybe BillingMode
billingMode :: Maybe BillingMode
$sel:billingMode:BillingModeSummary' :: BillingModeSummary -> Maybe BillingMode
billingMode} -> Maybe BillingMode
billingMode) (\s :: BillingModeSummary
s@BillingModeSummary' {} Maybe BillingMode
a -> BillingModeSummary
s {$sel:billingMode:BillingModeSummary' :: Maybe BillingMode
billingMode = Maybe BillingMode
a} :: BillingModeSummary)

-- | Represents the time when @PAY_PER_REQUEST@ was last set as the
-- read\/write capacity mode.
billingModeSummary_lastUpdateToPayPerRequestDateTime :: Lens.Lens' BillingModeSummary (Prelude.Maybe Prelude.UTCTime)
billingModeSummary_lastUpdateToPayPerRequestDateTime :: Lens' BillingModeSummary (Maybe UTCTime)
billingModeSummary_lastUpdateToPayPerRequestDateTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BillingModeSummary' {Maybe POSIX
lastUpdateToPayPerRequestDateTime :: Maybe POSIX
$sel:lastUpdateToPayPerRequestDateTime:BillingModeSummary' :: BillingModeSummary -> Maybe POSIX
lastUpdateToPayPerRequestDateTime} -> Maybe POSIX
lastUpdateToPayPerRequestDateTime) (\s :: BillingModeSummary
s@BillingModeSummary' {} Maybe POSIX
a -> BillingModeSummary
s {$sel:lastUpdateToPayPerRequestDateTime:BillingModeSummary' :: Maybe POSIX
lastUpdateToPayPerRequestDateTime = Maybe POSIX
a} :: BillingModeSummary) 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

instance Data.FromJSON BillingModeSummary where
  parseJSON :: Value -> Parser BillingModeSummary
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"BillingModeSummary"
      ( \Object
x ->
          Maybe BillingMode -> Maybe POSIX -> BillingModeSummary
BillingModeSummary'
            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
"BillingMode")
            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
"LastUpdateToPayPerRequestDateTime")
      )

instance Prelude.Hashable BillingModeSummary where
  hashWithSalt :: Int -> BillingModeSummary -> Int
hashWithSalt Int
_salt BillingModeSummary' {Maybe POSIX
Maybe BillingMode
lastUpdateToPayPerRequestDateTime :: Maybe POSIX
billingMode :: Maybe BillingMode
$sel:lastUpdateToPayPerRequestDateTime:BillingModeSummary' :: BillingModeSummary -> Maybe POSIX
$sel:billingMode:BillingModeSummary' :: BillingModeSummary -> Maybe BillingMode
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe BillingMode
billingMode
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe POSIX
lastUpdateToPayPerRequestDateTime

instance Prelude.NFData BillingModeSummary where
  rnf :: BillingModeSummary -> ()
rnf BillingModeSummary' {Maybe POSIX
Maybe BillingMode
lastUpdateToPayPerRequestDateTime :: Maybe POSIX
billingMode :: Maybe BillingMode
$sel:lastUpdateToPayPerRequestDateTime:BillingModeSummary' :: BillingModeSummary -> Maybe POSIX
$sel:billingMode:BillingModeSummary' :: BillingModeSummary -> Maybe BillingMode
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe BillingMode
billingMode
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
lastUpdateToPayPerRequestDateTime