{-# 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.EC2.Types.TargetReservationValue
-- 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.EC2.Types.TargetReservationValue where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.EC2.Internal
import Amazonka.EC2.Types.ReservationValue
import Amazonka.EC2.Types.TargetConfiguration
import qualified Amazonka.Prelude as Prelude

-- | The total value of the new Convertible Reserved Instances.
--
-- /See:/ 'newTargetReservationValue' smart constructor.
data TargetReservationValue = TargetReservationValue'
  { -- | The total value of the Convertible Reserved Instances that make up the
    -- exchange. This is the sum of the list value, remaining upfront price,
    -- and additional upfront cost of the exchange.
    TargetReservationValue -> Maybe ReservationValue
reservationValue :: Prelude.Maybe ReservationValue,
    -- | The configuration of the Convertible Reserved Instances that make up the
    -- exchange.
    TargetReservationValue -> Maybe TargetConfiguration
targetConfiguration :: Prelude.Maybe TargetConfiguration
  }
  deriving (TargetReservationValue -> TargetReservationValue -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TargetReservationValue -> TargetReservationValue -> Bool
$c/= :: TargetReservationValue -> TargetReservationValue -> Bool
== :: TargetReservationValue -> TargetReservationValue -> Bool
$c== :: TargetReservationValue -> TargetReservationValue -> Bool
Prelude.Eq, ReadPrec [TargetReservationValue]
ReadPrec TargetReservationValue
Int -> ReadS TargetReservationValue
ReadS [TargetReservationValue]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [TargetReservationValue]
$creadListPrec :: ReadPrec [TargetReservationValue]
readPrec :: ReadPrec TargetReservationValue
$creadPrec :: ReadPrec TargetReservationValue
readList :: ReadS [TargetReservationValue]
$creadList :: ReadS [TargetReservationValue]
readsPrec :: Int -> ReadS TargetReservationValue
$creadsPrec :: Int -> ReadS TargetReservationValue
Prelude.Read, Int -> TargetReservationValue -> ShowS
[TargetReservationValue] -> ShowS
TargetReservationValue -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TargetReservationValue] -> ShowS
$cshowList :: [TargetReservationValue] -> ShowS
show :: TargetReservationValue -> String
$cshow :: TargetReservationValue -> String
showsPrec :: Int -> TargetReservationValue -> ShowS
$cshowsPrec :: Int -> TargetReservationValue -> ShowS
Prelude.Show, forall x. Rep TargetReservationValue x -> TargetReservationValue
forall x. TargetReservationValue -> Rep TargetReservationValue x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TargetReservationValue x -> TargetReservationValue
$cfrom :: forall x. TargetReservationValue -> Rep TargetReservationValue x
Prelude.Generic)

-- |
-- Create a value of 'TargetReservationValue' 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:
--
-- 'reservationValue', 'targetReservationValue_reservationValue' - The total value of the Convertible Reserved Instances that make up the
-- exchange. This is the sum of the list value, remaining upfront price,
-- and additional upfront cost of the exchange.
--
-- 'targetConfiguration', 'targetReservationValue_targetConfiguration' - The configuration of the Convertible Reserved Instances that make up the
-- exchange.
newTargetReservationValue ::
  TargetReservationValue
newTargetReservationValue :: TargetReservationValue
newTargetReservationValue =
  TargetReservationValue'
    { $sel:reservationValue:TargetReservationValue' :: Maybe ReservationValue
reservationValue =
        forall a. Maybe a
Prelude.Nothing,
      $sel:targetConfiguration:TargetReservationValue' :: Maybe TargetConfiguration
targetConfiguration = forall a. Maybe a
Prelude.Nothing
    }

-- | The total value of the Convertible Reserved Instances that make up the
-- exchange. This is the sum of the list value, remaining upfront price,
-- and additional upfront cost of the exchange.
targetReservationValue_reservationValue :: Lens.Lens' TargetReservationValue (Prelude.Maybe ReservationValue)
targetReservationValue_reservationValue :: Lens' TargetReservationValue (Maybe ReservationValue)
targetReservationValue_reservationValue = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TargetReservationValue' {Maybe ReservationValue
reservationValue :: Maybe ReservationValue
$sel:reservationValue:TargetReservationValue' :: TargetReservationValue -> Maybe ReservationValue
reservationValue} -> Maybe ReservationValue
reservationValue) (\s :: TargetReservationValue
s@TargetReservationValue' {} Maybe ReservationValue
a -> TargetReservationValue
s {$sel:reservationValue:TargetReservationValue' :: Maybe ReservationValue
reservationValue = Maybe ReservationValue
a} :: TargetReservationValue)

-- | The configuration of the Convertible Reserved Instances that make up the
-- exchange.
targetReservationValue_targetConfiguration :: Lens.Lens' TargetReservationValue (Prelude.Maybe TargetConfiguration)
targetReservationValue_targetConfiguration :: Lens' TargetReservationValue (Maybe TargetConfiguration)
targetReservationValue_targetConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TargetReservationValue' {Maybe TargetConfiguration
targetConfiguration :: Maybe TargetConfiguration
$sel:targetConfiguration:TargetReservationValue' :: TargetReservationValue -> Maybe TargetConfiguration
targetConfiguration} -> Maybe TargetConfiguration
targetConfiguration) (\s :: TargetReservationValue
s@TargetReservationValue' {} Maybe TargetConfiguration
a -> TargetReservationValue
s {$sel:targetConfiguration:TargetReservationValue' :: Maybe TargetConfiguration
targetConfiguration = Maybe TargetConfiguration
a} :: TargetReservationValue)

instance Data.FromXML TargetReservationValue where
  parseXML :: [Node] -> Either String TargetReservationValue
parseXML [Node]
x =
    Maybe ReservationValue
-> Maybe TargetConfiguration -> TargetReservationValue
TargetReservationValue'
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"reservationValue")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"targetConfiguration")

instance Prelude.Hashable TargetReservationValue where
  hashWithSalt :: Int -> TargetReservationValue -> Int
hashWithSalt Int
_salt TargetReservationValue' {Maybe ReservationValue
Maybe TargetConfiguration
targetConfiguration :: Maybe TargetConfiguration
reservationValue :: Maybe ReservationValue
$sel:targetConfiguration:TargetReservationValue' :: TargetReservationValue -> Maybe TargetConfiguration
$sel:reservationValue:TargetReservationValue' :: TargetReservationValue -> Maybe ReservationValue
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ReservationValue
reservationValue
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe TargetConfiguration
targetConfiguration

instance Prelude.NFData TargetReservationValue where
  rnf :: TargetReservationValue -> ()
rnf TargetReservationValue' {Maybe ReservationValue
Maybe TargetConfiguration
targetConfiguration :: Maybe TargetConfiguration
reservationValue :: Maybe ReservationValue
$sel:targetConfiguration:TargetReservationValue' :: TargetReservationValue -> Maybe TargetConfiguration
$sel:reservationValue:TargetReservationValue' :: TargetReservationValue -> Maybe ReservationValue
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe ReservationValue
reservationValue
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe TargetConfiguration
targetConfiguration