{-# 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.HostOffering
-- 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.HostOffering 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

-- | Details about the Dedicated Host Reservation offering.
--
-- /See:/ 'newHostOffering' smart constructor.
data HostOffering = HostOffering'
  { -- | The currency of the offering.
    HostOffering -> Maybe CurrencyCodeValues
currencyCode :: Prelude.Maybe CurrencyCodeValues,
    -- | The duration of the offering (in seconds).
    HostOffering -> Maybe Int
duration :: Prelude.Maybe Prelude.Int,
    -- | The hourly price of the offering.
    HostOffering -> Maybe Text
hourlyPrice :: Prelude.Maybe Prelude.Text,
    -- | The instance family of the offering.
    HostOffering -> Maybe Text
instanceFamily :: Prelude.Maybe Prelude.Text,
    -- | The ID of the offering.
    HostOffering -> Maybe Text
offeringId :: Prelude.Maybe Prelude.Text,
    -- | The available payment option.
    HostOffering -> Maybe PaymentOption
paymentOption :: Prelude.Maybe PaymentOption,
    -- | The upfront price of the offering. Does not apply to No Upfront
    -- offerings.
    HostOffering -> Maybe Text
upfrontPrice :: Prelude.Maybe Prelude.Text
  }
  deriving (HostOffering -> HostOffering -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HostOffering -> HostOffering -> Bool
$c/= :: HostOffering -> HostOffering -> Bool
== :: HostOffering -> HostOffering -> Bool
$c== :: HostOffering -> HostOffering -> Bool
Prelude.Eq, ReadPrec [HostOffering]
ReadPrec HostOffering
Int -> ReadS HostOffering
ReadS [HostOffering]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [HostOffering]
$creadListPrec :: ReadPrec [HostOffering]
readPrec :: ReadPrec HostOffering
$creadPrec :: ReadPrec HostOffering
readList :: ReadS [HostOffering]
$creadList :: ReadS [HostOffering]
readsPrec :: Int -> ReadS HostOffering
$creadsPrec :: Int -> ReadS HostOffering
Prelude.Read, Int -> HostOffering -> ShowS
[HostOffering] -> ShowS
HostOffering -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HostOffering] -> ShowS
$cshowList :: [HostOffering] -> ShowS
show :: HostOffering -> String
$cshow :: HostOffering -> String
showsPrec :: Int -> HostOffering -> ShowS
$cshowsPrec :: Int -> HostOffering -> ShowS
Prelude.Show, forall x. Rep HostOffering x -> HostOffering
forall x. HostOffering -> Rep HostOffering x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep HostOffering x -> HostOffering
$cfrom :: forall x. HostOffering -> Rep HostOffering x
Prelude.Generic)

-- |
-- Create a value of 'HostOffering' 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', 'hostOffering_currencyCode' - The currency of the offering.
--
-- 'duration', 'hostOffering_duration' - The duration of the offering (in seconds).
--
-- 'hourlyPrice', 'hostOffering_hourlyPrice' - The hourly price of the offering.
--
-- 'instanceFamily', 'hostOffering_instanceFamily' - The instance family of the offering.
--
-- 'offeringId', 'hostOffering_offeringId' - The ID of the offering.
--
-- 'paymentOption', 'hostOffering_paymentOption' - The available payment option.
--
-- 'upfrontPrice', 'hostOffering_upfrontPrice' - The upfront price of the offering. Does not apply to No Upfront
-- offerings.
newHostOffering ::
  HostOffering
newHostOffering :: HostOffering
newHostOffering =
  HostOffering'
    { $sel:currencyCode:HostOffering' :: Maybe CurrencyCodeValues
currencyCode = forall a. Maybe a
Prelude.Nothing,
      $sel:duration:HostOffering' :: Maybe Int
duration = forall a. Maybe a
Prelude.Nothing,
      $sel:hourlyPrice:HostOffering' :: Maybe Text
hourlyPrice = forall a. Maybe a
Prelude.Nothing,
      $sel:instanceFamily:HostOffering' :: Maybe Text
instanceFamily = forall a. Maybe a
Prelude.Nothing,
      $sel:offeringId:HostOffering' :: Maybe Text
offeringId = forall a. Maybe a
Prelude.Nothing,
      $sel:paymentOption:HostOffering' :: Maybe PaymentOption
paymentOption = forall a. Maybe a
Prelude.Nothing,
      $sel:upfrontPrice:HostOffering' :: Maybe Text
upfrontPrice = forall a. Maybe a
Prelude.Nothing
    }

-- | The currency of the offering.
hostOffering_currencyCode :: Lens.Lens' HostOffering (Prelude.Maybe CurrencyCodeValues)
hostOffering_currencyCode :: Lens' HostOffering (Maybe CurrencyCodeValues)
hostOffering_currencyCode = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\HostOffering' {Maybe CurrencyCodeValues
currencyCode :: Maybe CurrencyCodeValues
$sel:currencyCode:HostOffering' :: HostOffering -> Maybe CurrencyCodeValues
currencyCode} -> Maybe CurrencyCodeValues
currencyCode) (\s :: HostOffering
s@HostOffering' {} Maybe CurrencyCodeValues
a -> HostOffering
s {$sel:currencyCode:HostOffering' :: Maybe CurrencyCodeValues
currencyCode = Maybe CurrencyCodeValues
a} :: HostOffering)

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

-- | The hourly price of the offering.
hostOffering_hourlyPrice :: Lens.Lens' HostOffering (Prelude.Maybe Prelude.Text)
hostOffering_hourlyPrice :: Lens' HostOffering (Maybe Text)
hostOffering_hourlyPrice = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\HostOffering' {Maybe Text
hourlyPrice :: Maybe Text
$sel:hourlyPrice:HostOffering' :: HostOffering -> Maybe Text
hourlyPrice} -> Maybe Text
hourlyPrice) (\s :: HostOffering
s@HostOffering' {} Maybe Text
a -> HostOffering
s {$sel:hourlyPrice:HostOffering' :: Maybe Text
hourlyPrice = Maybe Text
a} :: HostOffering)

-- | The instance family of the offering.
hostOffering_instanceFamily :: Lens.Lens' HostOffering (Prelude.Maybe Prelude.Text)
hostOffering_instanceFamily :: Lens' HostOffering (Maybe Text)
hostOffering_instanceFamily = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\HostOffering' {Maybe Text
instanceFamily :: Maybe Text
$sel:instanceFamily:HostOffering' :: HostOffering -> Maybe Text
instanceFamily} -> Maybe Text
instanceFamily) (\s :: HostOffering
s@HostOffering' {} Maybe Text
a -> HostOffering
s {$sel:instanceFamily:HostOffering' :: Maybe Text
instanceFamily = Maybe Text
a} :: HostOffering)

-- | The ID of the offering.
hostOffering_offeringId :: Lens.Lens' HostOffering (Prelude.Maybe Prelude.Text)
hostOffering_offeringId :: Lens' HostOffering (Maybe Text)
hostOffering_offeringId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\HostOffering' {Maybe Text
offeringId :: Maybe Text
$sel:offeringId:HostOffering' :: HostOffering -> Maybe Text
offeringId} -> Maybe Text
offeringId) (\s :: HostOffering
s@HostOffering' {} Maybe Text
a -> HostOffering
s {$sel:offeringId:HostOffering' :: Maybe Text
offeringId = Maybe Text
a} :: HostOffering)

-- | The available payment option.
hostOffering_paymentOption :: Lens.Lens' HostOffering (Prelude.Maybe PaymentOption)
hostOffering_paymentOption :: Lens' HostOffering (Maybe PaymentOption)
hostOffering_paymentOption = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\HostOffering' {Maybe PaymentOption
paymentOption :: Maybe PaymentOption
$sel:paymentOption:HostOffering' :: HostOffering -> Maybe PaymentOption
paymentOption} -> Maybe PaymentOption
paymentOption) (\s :: HostOffering
s@HostOffering' {} Maybe PaymentOption
a -> HostOffering
s {$sel:paymentOption:HostOffering' :: Maybe PaymentOption
paymentOption = Maybe PaymentOption
a} :: HostOffering)

-- | The upfront price of the offering. Does not apply to No Upfront
-- offerings.
hostOffering_upfrontPrice :: Lens.Lens' HostOffering (Prelude.Maybe Prelude.Text)
hostOffering_upfrontPrice :: Lens' HostOffering (Maybe Text)
hostOffering_upfrontPrice = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\HostOffering' {Maybe Text
upfrontPrice :: Maybe Text
$sel:upfrontPrice:HostOffering' :: HostOffering -> Maybe Text
upfrontPrice} -> Maybe Text
upfrontPrice) (\s :: HostOffering
s@HostOffering' {} Maybe Text
a -> HostOffering
s {$sel:upfrontPrice:HostOffering' :: Maybe Text
upfrontPrice = Maybe Text
a} :: HostOffering)

instance Data.FromXML HostOffering where
  parseXML :: [Node] -> Either String HostOffering
parseXML [Node]
x =
    Maybe CurrencyCodeValues
-> Maybe Int
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe PaymentOption
-> Maybe Text
-> HostOffering
HostOffering'
      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
"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
"offeringId")
      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 HostOffering where
  hashWithSalt :: Int -> HostOffering -> Int
hashWithSalt Int
_salt HostOffering' {Maybe Int
Maybe Text
Maybe CurrencyCodeValues
Maybe PaymentOption
upfrontPrice :: Maybe Text
paymentOption :: Maybe PaymentOption
offeringId :: Maybe Text
instanceFamily :: Maybe Text
hourlyPrice :: Maybe Text
duration :: Maybe Int
currencyCode :: Maybe CurrencyCodeValues
$sel:upfrontPrice:HostOffering' :: HostOffering -> Maybe Text
$sel:paymentOption:HostOffering' :: HostOffering -> Maybe PaymentOption
$sel:offeringId:HostOffering' :: HostOffering -> Maybe Text
$sel:instanceFamily:HostOffering' :: HostOffering -> Maybe Text
$sel:hourlyPrice:HostOffering' :: HostOffering -> Maybe Text
$sel:duration:HostOffering' :: HostOffering -> Maybe Int
$sel:currencyCode:HostOffering' :: HostOffering -> 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
hourlyPrice
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
instanceFamily
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
offeringId
      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 HostOffering where
  rnf :: HostOffering -> ()
rnf HostOffering' {Maybe Int
Maybe Text
Maybe CurrencyCodeValues
Maybe PaymentOption
upfrontPrice :: Maybe Text
paymentOption :: Maybe PaymentOption
offeringId :: Maybe Text
instanceFamily :: Maybe Text
hourlyPrice :: Maybe Text
duration :: Maybe Int
currencyCode :: Maybe CurrencyCodeValues
$sel:upfrontPrice:HostOffering' :: HostOffering -> Maybe Text
$sel:paymentOption:HostOffering' :: HostOffering -> Maybe PaymentOption
$sel:offeringId:HostOffering' :: HostOffering -> Maybe Text
$sel:instanceFamily:HostOffering' :: HostOffering -> Maybe Text
$sel:hourlyPrice:HostOffering' :: HostOffering -> Maybe Text
$sel:duration:HostOffering' :: HostOffering -> Maybe Int
$sel:currencyCode:HostOffering' :: HostOffering -> 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
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 Text
offeringId
      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