{-# 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.Purchase
-- 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.Purchase 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.CurrencyCodeValues
import Amazonka.EC2.Types.PaymentOption
import qualified Amazonka.Prelude as Prelude

-- | Describes the result of the purchase.
--
-- /See:/ 'newPurchase' smart constructor.
data Purchase = Purchase'
  { -- | The currency in which the @UpfrontPrice@ and @HourlyPrice@ amounts are
    -- specified. At this time, the only supported currency is @USD@.
    Purchase -> Maybe CurrencyCodeValues
currencyCode :: Prelude.Maybe CurrencyCodeValues,
    -- | The duration of the reservation\'s term in seconds.
    Purchase -> Maybe Int
duration :: Prelude.Maybe Prelude.Int,
    -- | The IDs of the Dedicated Hosts associated with the reservation.
    Purchase -> Maybe [Text]
hostIdSet :: Prelude.Maybe [Prelude.Text],
    -- | The ID of the reservation.
    Purchase -> Maybe Text
hostReservationId :: Prelude.Maybe Prelude.Text,
    -- | The hourly price of the reservation per hour.
    Purchase -> Maybe Text
hourlyPrice :: Prelude.Maybe Prelude.Text,
    -- | The instance family on the Dedicated Host that the reservation can be
    -- associated with.
    Purchase -> Maybe Text
instanceFamily :: Prelude.Maybe Prelude.Text,
    -- | The payment option for the reservation.
    Purchase -> Maybe PaymentOption
paymentOption :: Prelude.Maybe PaymentOption,
    -- | The upfront price of the reservation.
    Purchase -> Maybe Text
upfrontPrice :: Prelude.Maybe Prelude.Text
  }
  deriving (Purchase -> Purchase -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Purchase -> Purchase -> Bool
$c/= :: Purchase -> Purchase -> Bool
== :: Purchase -> Purchase -> Bool
$c== :: Purchase -> Purchase -> Bool
Prelude.Eq, ReadPrec [Purchase]
ReadPrec Purchase
Int -> ReadS Purchase
ReadS [Purchase]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Purchase]
$creadListPrec :: ReadPrec [Purchase]
readPrec :: ReadPrec Purchase
$creadPrec :: ReadPrec Purchase
readList :: ReadS [Purchase]
$creadList :: ReadS [Purchase]
readsPrec :: Int -> ReadS Purchase
$creadsPrec :: Int -> ReadS Purchase
Prelude.Read, Int -> Purchase -> ShowS
[Purchase] -> ShowS
Purchase -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Purchase] -> ShowS
$cshowList :: [Purchase] -> ShowS
show :: Purchase -> String
$cshow :: Purchase -> String
showsPrec :: Int -> Purchase -> ShowS
$cshowsPrec :: Int -> Purchase -> ShowS
Prelude.Show, forall x. Rep Purchase x -> Purchase
forall x. Purchase -> Rep Purchase x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Purchase x -> Purchase
$cfrom :: forall x. Purchase -> Rep Purchase x
Prelude.Generic)

-- |
-- Create a value of 'Purchase' 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:
--
-- 'currencyCode', 'purchase_currencyCode' - The currency in which the @UpfrontPrice@ and @HourlyPrice@ amounts are
-- specified. At this time, the only supported currency is @USD@.
--
-- 'duration', 'purchase_duration' - The duration of the reservation\'s term in seconds.
--
-- 'hostIdSet', 'purchase_hostIdSet' - The IDs of the Dedicated Hosts associated with the reservation.
--
-- 'hostReservationId', 'purchase_hostReservationId' - The ID of the reservation.
--
-- 'hourlyPrice', 'purchase_hourlyPrice' - The hourly price of the reservation per hour.
--
-- 'instanceFamily', 'purchase_instanceFamily' - The instance family on the Dedicated Host that the reservation can be
-- associated with.
--
-- 'paymentOption', 'purchase_paymentOption' - The payment option for the reservation.
--
-- 'upfrontPrice', 'purchase_upfrontPrice' - The upfront price of the reservation.
newPurchase ::
  Purchase
newPurchase :: Purchase
newPurchase =
  Purchase'
    { $sel:currencyCode:Purchase' :: Maybe CurrencyCodeValues
currencyCode = forall a. Maybe a
Prelude.Nothing,
      $sel:duration:Purchase' :: Maybe Int
duration = forall a. Maybe a
Prelude.Nothing,
      $sel:hostIdSet:Purchase' :: Maybe [Text]
hostIdSet = forall a. Maybe a
Prelude.Nothing,
      $sel:hostReservationId:Purchase' :: Maybe Text
hostReservationId = forall a. Maybe a
Prelude.Nothing,
      $sel:hourlyPrice:Purchase' :: Maybe Text
hourlyPrice = forall a. Maybe a
Prelude.Nothing,
      $sel:instanceFamily:Purchase' :: Maybe Text
instanceFamily = forall a. Maybe a
Prelude.Nothing,
      $sel:paymentOption:Purchase' :: Maybe PaymentOption
paymentOption = forall a. Maybe a
Prelude.Nothing,
      $sel:upfrontPrice:Purchase' :: Maybe Text
upfrontPrice = forall a. Maybe a
Prelude.Nothing
    }

-- | The currency in which the @UpfrontPrice@ and @HourlyPrice@ amounts are
-- specified. At this time, the only supported currency is @USD@.
purchase_currencyCode :: Lens.Lens' Purchase (Prelude.Maybe CurrencyCodeValues)
purchase_currencyCode :: Lens' Purchase (Maybe CurrencyCodeValues)
purchase_currencyCode = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Purchase' {Maybe CurrencyCodeValues
currencyCode :: Maybe CurrencyCodeValues
$sel:currencyCode:Purchase' :: Purchase -> Maybe CurrencyCodeValues
currencyCode} -> Maybe CurrencyCodeValues
currencyCode) (\s :: Purchase
s@Purchase' {} Maybe CurrencyCodeValues
a -> Purchase
s {$sel:currencyCode:Purchase' :: Maybe CurrencyCodeValues
currencyCode = Maybe CurrencyCodeValues
a} :: Purchase)

-- | The duration of the reservation\'s term in seconds.
purchase_duration :: Lens.Lens' Purchase (Prelude.Maybe Prelude.Int)
purchase_duration :: Lens' Purchase (Maybe Int)
purchase_duration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Purchase' {Maybe Int
duration :: Maybe Int
$sel:duration:Purchase' :: Purchase -> Maybe Int
duration} -> Maybe Int
duration) (\s :: Purchase
s@Purchase' {} Maybe Int
a -> Purchase
s {$sel:duration:Purchase' :: Maybe Int
duration = Maybe Int
a} :: Purchase)

-- | The IDs of the Dedicated Hosts associated with the reservation.
purchase_hostIdSet :: Lens.Lens' Purchase (Prelude.Maybe [Prelude.Text])
purchase_hostIdSet :: Lens' Purchase (Maybe [Text])
purchase_hostIdSet = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Purchase' {Maybe [Text]
hostIdSet :: Maybe [Text]
$sel:hostIdSet:Purchase' :: Purchase -> Maybe [Text]
hostIdSet} -> Maybe [Text]
hostIdSet) (\s :: Purchase
s@Purchase' {} Maybe [Text]
a -> Purchase
s {$sel:hostIdSet:Purchase' :: Maybe [Text]
hostIdSet = Maybe [Text]
a} :: Purchase) 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 ID of the reservation.
purchase_hostReservationId :: Lens.Lens' Purchase (Prelude.Maybe Prelude.Text)
purchase_hostReservationId :: Lens' Purchase (Maybe Text)
purchase_hostReservationId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Purchase' {Maybe Text
hostReservationId :: Maybe Text
$sel:hostReservationId:Purchase' :: Purchase -> Maybe Text
hostReservationId} -> Maybe Text
hostReservationId) (\s :: Purchase
s@Purchase' {} Maybe Text
a -> Purchase
s {$sel:hostReservationId:Purchase' :: Maybe Text
hostReservationId = Maybe Text
a} :: Purchase)

-- | The hourly price of the reservation per hour.
purchase_hourlyPrice :: Lens.Lens' Purchase (Prelude.Maybe Prelude.Text)
purchase_hourlyPrice :: Lens' Purchase (Maybe Text)
purchase_hourlyPrice = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Purchase' {Maybe Text
hourlyPrice :: Maybe Text
$sel:hourlyPrice:Purchase' :: Purchase -> Maybe Text
hourlyPrice} -> Maybe Text
hourlyPrice) (\s :: Purchase
s@Purchase' {} Maybe Text
a -> Purchase
s {$sel:hourlyPrice:Purchase' :: Maybe Text
hourlyPrice = Maybe Text
a} :: Purchase)

-- | The instance family on the Dedicated Host that the reservation can be
-- associated with.
purchase_instanceFamily :: Lens.Lens' Purchase (Prelude.Maybe Prelude.Text)
purchase_instanceFamily :: Lens' Purchase (Maybe Text)
purchase_instanceFamily = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Purchase' {Maybe Text
instanceFamily :: Maybe Text
$sel:instanceFamily:Purchase' :: Purchase -> Maybe Text
instanceFamily} -> Maybe Text
instanceFamily) (\s :: Purchase
s@Purchase' {} Maybe Text
a -> Purchase
s {$sel:instanceFamily:Purchase' :: Maybe Text
instanceFamily = Maybe Text
a} :: Purchase)

-- | The payment option for the reservation.
purchase_paymentOption :: Lens.Lens' Purchase (Prelude.Maybe PaymentOption)
purchase_paymentOption :: Lens' Purchase (Maybe PaymentOption)
purchase_paymentOption = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Purchase' {Maybe PaymentOption
paymentOption :: Maybe PaymentOption
$sel:paymentOption:Purchase' :: Purchase -> Maybe PaymentOption
paymentOption} -> Maybe PaymentOption
paymentOption) (\s :: Purchase
s@Purchase' {} Maybe PaymentOption
a -> Purchase
s {$sel:paymentOption:Purchase' :: Maybe PaymentOption
paymentOption = Maybe PaymentOption
a} :: Purchase)

-- | The upfront price of the reservation.
purchase_upfrontPrice :: Lens.Lens' Purchase (Prelude.Maybe Prelude.Text)
purchase_upfrontPrice :: Lens' Purchase (Maybe Text)
purchase_upfrontPrice = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Purchase' {Maybe Text
upfrontPrice :: Maybe Text
$sel:upfrontPrice:Purchase' :: Purchase -> Maybe Text
upfrontPrice} -> Maybe Text
upfrontPrice) (\s :: Purchase
s@Purchase' {} Maybe Text
a -> Purchase
s {$sel:upfrontPrice:Purchase' :: Maybe Text
upfrontPrice = Maybe Text
a} :: Purchase)

instance Data.FromXML Purchase where
  parseXML :: [Node] -> Either String Purchase
parseXML [Node]
x =
    Maybe CurrencyCodeValues
-> Maybe Int
-> Maybe [Text]
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe PaymentOption
-> Maybe Text
-> Purchase
Purchase'
      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
"currencyCode")
      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
"duration")
      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
"hostIdSet"
                      forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty
                      forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
Prelude.>>= forall (f :: * -> *) a b.
Applicative f =>
([a] -> f b) -> [a] -> f (Maybe b)
Core.may (forall a. FromXML a => Text -> [Node] -> Either String [a]
Data.parseXMLList Text
"item")
                  )
      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
"hostReservationId")
      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
"hourlyPrice")
      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
"instanceFamily")
      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
"paymentOption")
      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
"upfrontPrice")

instance Prelude.Hashable Purchase where
  hashWithSalt :: Int -> Purchase -> Int
hashWithSalt Int
_salt Purchase' {Maybe Int
Maybe [Text]
Maybe Text
Maybe CurrencyCodeValues
Maybe PaymentOption
upfrontPrice :: Maybe Text
paymentOption :: Maybe PaymentOption
instanceFamily :: Maybe Text
hourlyPrice :: Maybe Text
hostReservationId :: Maybe Text
hostIdSet :: Maybe [Text]
duration :: Maybe Int
currencyCode :: Maybe CurrencyCodeValues
$sel:upfrontPrice:Purchase' :: Purchase -> Maybe Text
$sel:paymentOption:Purchase' :: Purchase -> Maybe PaymentOption
$sel:instanceFamily:Purchase' :: Purchase -> Maybe Text
$sel:hourlyPrice:Purchase' :: Purchase -> Maybe Text
$sel:hostReservationId:Purchase' :: Purchase -> Maybe Text
$sel:hostIdSet:Purchase' :: Purchase -> Maybe [Text]
$sel:duration:Purchase' :: Purchase -> Maybe Int
$sel:currencyCode:Purchase' :: Purchase -> Maybe CurrencyCodeValues
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe CurrencyCodeValues
currencyCode
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
duration
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
hostIdSet
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
hostReservationId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
hourlyPrice
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
instanceFamily
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe PaymentOption
paymentOption
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
upfrontPrice

instance Prelude.NFData Purchase where
  rnf :: Purchase -> ()
rnf Purchase' {Maybe Int
Maybe [Text]
Maybe Text
Maybe CurrencyCodeValues
Maybe PaymentOption
upfrontPrice :: Maybe Text
paymentOption :: Maybe PaymentOption
instanceFamily :: Maybe Text
hourlyPrice :: Maybe Text
hostReservationId :: Maybe Text
hostIdSet :: Maybe [Text]
duration :: Maybe Int
currencyCode :: Maybe CurrencyCodeValues
$sel:upfrontPrice:Purchase' :: Purchase -> Maybe Text
$sel:paymentOption:Purchase' :: Purchase -> Maybe PaymentOption
$sel:instanceFamily:Purchase' :: Purchase -> Maybe Text
$sel:hourlyPrice:Purchase' :: Purchase -> Maybe Text
$sel:hostReservationId:Purchase' :: Purchase -> Maybe Text
$sel:hostIdSet:Purchase' :: Purchase -> Maybe [Text]
$sel:duration:Purchase' :: Purchase -> Maybe Int
$sel:currencyCode:Purchase' :: Purchase -> Maybe CurrencyCodeValues
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe CurrencyCodeValues
currencyCode
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
duration
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
hostIdSet
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
hostReservationId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
hourlyPrice
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
instanceFamily
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe PaymentOption
paymentOption
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
upfrontPrice