{-# 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.MediaConvert.Types.ReservationPlan
-- 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.MediaConvert.Types.ReservationPlan where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.MediaConvert.Types.Commitment
import Amazonka.MediaConvert.Types.RenewalType
import Amazonka.MediaConvert.Types.ReservationPlanStatus
import qualified Amazonka.Prelude as Prelude

-- | Details about the pricing plan for your reserved queue. Required for
-- reserved queues and not applicable to on-demand queues.
--
-- /See:/ 'newReservationPlan' smart constructor.
data ReservationPlan = ReservationPlan'
  { -- | The length of the term of your reserved queue pricing plan commitment.
    ReservationPlan -> Maybe Commitment
commitment :: Prelude.Maybe Commitment,
    -- | The timestamp in epoch seconds for when the current pricing plan term
    -- for this reserved queue expires.
    ReservationPlan -> Maybe POSIX
expiresAt :: Prelude.Maybe Data.POSIX,
    -- | The timestamp in epoch seconds for when you set up the current pricing
    -- plan for this reserved queue.
    ReservationPlan -> Maybe POSIX
purchasedAt :: Prelude.Maybe Data.POSIX,
    -- | Specifies whether the term of your reserved queue pricing plan is
    -- automatically extended (AUTO_RENEW) or expires (EXPIRE) at the end of
    -- the term.
    ReservationPlan -> Maybe RenewalType
renewalType :: Prelude.Maybe RenewalType,
    -- | Specifies the number of reserved transcode slots (RTS) for this queue.
    -- The number of RTS determines how many jobs the queue can process in
    -- parallel; each RTS can process one job at a time. When you increase this
    -- number, you extend your existing commitment with a new 12-month
    -- commitment for a larger number of RTS. The new commitment begins when
    -- you purchase the additional capacity. You can\'t decrease the number of
    -- RTS in your reserved queue.
    ReservationPlan -> Maybe Int
reservedSlots :: Prelude.Maybe Prelude.Int,
    -- | Specifies whether the pricing plan for your reserved queue is ACTIVE or
    -- EXPIRED.
    ReservationPlan -> Maybe ReservationPlanStatus
status :: Prelude.Maybe ReservationPlanStatus
  }
  deriving (ReservationPlan -> ReservationPlan -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ReservationPlan -> ReservationPlan -> Bool
$c/= :: ReservationPlan -> ReservationPlan -> Bool
== :: ReservationPlan -> ReservationPlan -> Bool
$c== :: ReservationPlan -> ReservationPlan -> Bool
Prelude.Eq, ReadPrec [ReservationPlan]
ReadPrec ReservationPlan
Int -> ReadS ReservationPlan
ReadS [ReservationPlan]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ReservationPlan]
$creadListPrec :: ReadPrec [ReservationPlan]
readPrec :: ReadPrec ReservationPlan
$creadPrec :: ReadPrec ReservationPlan
readList :: ReadS [ReservationPlan]
$creadList :: ReadS [ReservationPlan]
readsPrec :: Int -> ReadS ReservationPlan
$creadsPrec :: Int -> ReadS ReservationPlan
Prelude.Read, Int -> ReservationPlan -> ShowS
[ReservationPlan] -> ShowS
ReservationPlan -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ReservationPlan] -> ShowS
$cshowList :: [ReservationPlan] -> ShowS
show :: ReservationPlan -> String
$cshow :: ReservationPlan -> String
showsPrec :: Int -> ReservationPlan -> ShowS
$cshowsPrec :: Int -> ReservationPlan -> ShowS
Prelude.Show, forall x. Rep ReservationPlan x -> ReservationPlan
forall x. ReservationPlan -> Rep ReservationPlan x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ReservationPlan x -> ReservationPlan
$cfrom :: forall x. ReservationPlan -> Rep ReservationPlan x
Prelude.Generic)

-- |
-- Create a value of 'ReservationPlan' 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:
--
-- 'commitment', 'reservationPlan_commitment' - The length of the term of your reserved queue pricing plan commitment.
--
-- 'expiresAt', 'reservationPlan_expiresAt' - The timestamp in epoch seconds for when the current pricing plan term
-- for this reserved queue expires.
--
-- 'purchasedAt', 'reservationPlan_purchasedAt' - The timestamp in epoch seconds for when you set up the current pricing
-- plan for this reserved queue.
--
-- 'renewalType', 'reservationPlan_renewalType' - Specifies whether the term of your reserved queue pricing plan is
-- automatically extended (AUTO_RENEW) or expires (EXPIRE) at the end of
-- the term.
--
-- 'reservedSlots', 'reservationPlan_reservedSlots' - Specifies the number of reserved transcode slots (RTS) for this queue.
-- The number of RTS determines how many jobs the queue can process in
-- parallel; each RTS can process one job at a time. When you increase this
-- number, you extend your existing commitment with a new 12-month
-- commitment for a larger number of RTS. The new commitment begins when
-- you purchase the additional capacity. You can\'t decrease the number of
-- RTS in your reserved queue.
--
-- 'status', 'reservationPlan_status' - Specifies whether the pricing plan for your reserved queue is ACTIVE or
-- EXPIRED.
newReservationPlan ::
  ReservationPlan
newReservationPlan :: ReservationPlan
newReservationPlan =
  ReservationPlan'
    { $sel:commitment:ReservationPlan' :: Maybe Commitment
commitment = forall a. Maybe a
Prelude.Nothing,
      $sel:expiresAt:ReservationPlan' :: Maybe POSIX
expiresAt = forall a. Maybe a
Prelude.Nothing,
      $sel:purchasedAt:ReservationPlan' :: Maybe POSIX
purchasedAt = forall a. Maybe a
Prelude.Nothing,
      $sel:renewalType:ReservationPlan' :: Maybe RenewalType
renewalType = forall a. Maybe a
Prelude.Nothing,
      $sel:reservedSlots:ReservationPlan' :: Maybe Int
reservedSlots = forall a. Maybe a
Prelude.Nothing,
      $sel:status:ReservationPlan' :: Maybe ReservationPlanStatus
status = forall a. Maybe a
Prelude.Nothing
    }

-- | The length of the term of your reserved queue pricing plan commitment.
reservationPlan_commitment :: Lens.Lens' ReservationPlan (Prelude.Maybe Commitment)
reservationPlan_commitment :: Lens' ReservationPlan (Maybe Commitment)
reservationPlan_commitment = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ReservationPlan' {Maybe Commitment
commitment :: Maybe Commitment
$sel:commitment:ReservationPlan' :: ReservationPlan -> Maybe Commitment
commitment} -> Maybe Commitment
commitment) (\s :: ReservationPlan
s@ReservationPlan' {} Maybe Commitment
a -> ReservationPlan
s {$sel:commitment:ReservationPlan' :: Maybe Commitment
commitment = Maybe Commitment
a} :: ReservationPlan)

-- | The timestamp in epoch seconds for when the current pricing plan term
-- for this reserved queue expires.
reservationPlan_expiresAt :: Lens.Lens' ReservationPlan (Prelude.Maybe Prelude.UTCTime)
reservationPlan_expiresAt :: Lens' ReservationPlan (Maybe UTCTime)
reservationPlan_expiresAt = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ReservationPlan' {Maybe POSIX
expiresAt :: Maybe POSIX
$sel:expiresAt:ReservationPlan' :: ReservationPlan -> Maybe POSIX
expiresAt} -> Maybe POSIX
expiresAt) (\s :: ReservationPlan
s@ReservationPlan' {} Maybe POSIX
a -> ReservationPlan
s {$sel:expiresAt:ReservationPlan' :: Maybe POSIX
expiresAt = Maybe POSIX
a} :: ReservationPlan) 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

-- | The timestamp in epoch seconds for when you set up the current pricing
-- plan for this reserved queue.
reservationPlan_purchasedAt :: Lens.Lens' ReservationPlan (Prelude.Maybe Prelude.UTCTime)
reservationPlan_purchasedAt :: Lens' ReservationPlan (Maybe UTCTime)
reservationPlan_purchasedAt = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ReservationPlan' {Maybe POSIX
purchasedAt :: Maybe POSIX
$sel:purchasedAt:ReservationPlan' :: ReservationPlan -> Maybe POSIX
purchasedAt} -> Maybe POSIX
purchasedAt) (\s :: ReservationPlan
s@ReservationPlan' {} Maybe POSIX
a -> ReservationPlan
s {$sel:purchasedAt:ReservationPlan' :: Maybe POSIX
purchasedAt = Maybe POSIX
a} :: ReservationPlan) 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

-- | Specifies whether the term of your reserved queue pricing plan is
-- automatically extended (AUTO_RENEW) or expires (EXPIRE) at the end of
-- the term.
reservationPlan_renewalType :: Lens.Lens' ReservationPlan (Prelude.Maybe RenewalType)
reservationPlan_renewalType :: Lens' ReservationPlan (Maybe RenewalType)
reservationPlan_renewalType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ReservationPlan' {Maybe RenewalType
renewalType :: Maybe RenewalType
$sel:renewalType:ReservationPlan' :: ReservationPlan -> Maybe RenewalType
renewalType} -> Maybe RenewalType
renewalType) (\s :: ReservationPlan
s@ReservationPlan' {} Maybe RenewalType
a -> ReservationPlan
s {$sel:renewalType:ReservationPlan' :: Maybe RenewalType
renewalType = Maybe RenewalType
a} :: ReservationPlan)

-- | Specifies the number of reserved transcode slots (RTS) for this queue.
-- The number of RTS determines how many jobs the queue can process in
-- parallel; each RTS can process one job at a time. When you increase this
-- number, you extend your existing commitment with a new 12-month
-- commitment for a larger number of RTS. The new commitment begins when
-- you purchase the additional capacity. You can\'t decrease the number of
-- RTS in your reserved queue.
reservationPlan_reservedSlots :: Lens.Lens' ReservationPlan (Prelude.Maybe Prelude.Int)
reservationPlan_reservedSlots :: Lens' ReservationPlan (Maybe Int)
reservationPlan_reservedSlots = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ReservationPlan' {Maybe Int
reservedSlots :: Maybe Int
$sel:reservedSlots:ReservationPlan' :: ReservationPlan -> Maybe Int
reservedSlots} -> Maybe Int
reservedSlots) (\s :: ReservationPlan
s@ReservationPlan' {} Maybe Int
a -> ReservationPlan
s {$sel:reservedSlots:ReservationPlan' :: Maybe Int
reservedSlots = Maybe Int
a} :: ReservationPlan)

-- | Specifies whether the pricing plan for your reserved queue is ACTIVE or
-- EXPIRED.
reservationPlan_status :: Lens.Lens' ReservationPlan (Prelude.Maybe ReservationPlanStatus)
reservationPlan_status :: Lens' ReservationPlan (Maybe ReservationPlanStatus)
reservationPlan_status = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ReservationPlan' {Maybe ReservationPlanStatus
status :: Maybe ReservationPlanStatus
$sel:status:ReservationPlan' :: ReservationPlan -> Maybe ReservationPlanStatus
status} -> Maybe ReservationPlanStatus
status) (\s :: ReservationPlan
s@ReservationPlan' {} Maybe ReservationPlanStatus
a -> ReservationPlan
s {$sel:status:ReservationPlan' :: Maybe ReservationPlanStatus
status = Maybe ReservationPlanStatus
a} :: ReservationPlan)

instance Data.FromJSON ReservationPlan where
  parseJSON :: Value -> Parser ReservationPlan
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"ReservationPlan"
      ( \Object
x ->
          Maybe Commitment
-> Maybe POSIX
-> Maybe POSIX
-> Maybe RenewalType
-> Maybe Int
-> Maybe ReservationPlanStatus
-> ReservationPlan
ReservationPlan'
            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
"commitment")
            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
"expiresAt")
            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
"purchasedAt")
            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
"renewalType")
            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
"reservedSlots")
            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
"status")
      )

instance Prelude.Hashable ReservationPlan where
  hashWithSalt :: Int -> ReservationPlan -> Int
hashWithSalt Int
_salt ReservationPlan' {Maybe Int
Maybe POSIX
Maybe Commitment
Maybe RenewalType
Maybe ReservationPlanStatus
status :: Maybe ReservationPlanStatus
reservedSlots :: Maybe Int
renewalType :: Maybe RenewalType
purchasedAt :: Maybe POSIX
expiresAt :: Maybe POSIX
commitment :: Maybe Commitment
$sel:status:ReservationPlan' :: ReservationPlan -> Maybe ReservationPlanStatus
$sel:reservedSlots:ReservationPlan' :: ReservationPlan -> Maybe Int
$sel:renewalType:ReservationPlan' :: ReservationPlan -> Maybe RenewalType
$sel:purchasedAt:ReservationPlan' :: ReservationPlan -> Maybe POSIX
$sel:expiresAt:ReservationPlan' :: ReservationPlan -> Maybe POSIX
$sel:commitment:ReservationPlan' :: ReservationPlan -> Maybe Commitment
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Commitment
commitment
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe POSIX
expiresAt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe POSIX
purchasedAt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe RenewalType
renewalType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
reservedSlots
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ReservationPlanStatus
status

instance Prelude.NFData ReservationPlan where
  rnf :: ReservationPlan -> ()
rnf ReservationPlan' {Maybe Int
Maybe POSIX
Maybe Commitment
Maybe RenewalType
Maybe ReservationPlanStatus
status :: Maybe ReservationPlanStatus
reservedSlots :: Maybe Int
renewalType :: Maybe RenewalType
purchasedAt :: Maybe POSIX
expiresAt :: Maybe POSIX
commitment :: Maybe Commitment
$sel:status:ReservationPlan' :: ReservationPlan -> Maybe ReservationPlanStatus
$sel:reservedSlots:ReservationPlan' :: ReservationPlan -> Maybe Int
$sel:renewalType:ReservationPlan' :: ReservationPlan -> Maybe RenewalType
$sel:purchasedAt:ReservationPlan' :: ReservationPlan -> Maybe POSIX
$sel:expiresAt:ReservationPlan' :: ReservationPlan -> Maybe POSIX
$sel:commitment:ReservationPlan' :: ReservationPlan -> Maybe Commitment
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Commitment
commitment
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
expiresAt
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
purchasedAt
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe RenewalType
renewalType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
reservedSlots
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ReservationPlanStatus
status