{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -fno-warn-unused-binds #-}
{-# 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.PurchaseHostReservation
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Purchase a reservation with configurations that match those of your
-- Dedicated Host. You must have active Dedicated Hosts in your account
-- before you purchase a reservation. This action results in the specified
-- reservation being purchased and charged to your account.
module Amazonka.EC2.PurchaseHostReservation
  ( -- * Creating a Request
    PurchaseHostReservation (..),
    newPurchaseHostReservation,

    -- * Request Lenses
    purchaseHostReservation_clientToken,
    purchaseHostReservation_currencyCode,
    purchaseHostReservation_limitPrice,
    purchaseHostReservation_tagSpecifications,
    purchaseHostReservation_hostIdSet,
    purchaseHostReservation_offeringId,

    -- * Destructuring the Response
    PurchaseHostReservationResponse (..),
    newPurchaseHostReservationResponse,

    -- * Response Lenses
    purchaseHostReservationResponse_clientToken,
    purchaseHostReservationResponse_currencyCode,
    purchaseHostReservationResponse_purchase,
    purchaseHostReservationResponse_totalHourlyPrice,
    purchaseHostReservationResponse_totalUpfrontPrice,
    purchaseHostReservationResponse_httpStatus,
  )
where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.EC2.Types
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newPurchaseHostReservation' smart constructor.
data PurchaseHostReservation = PurchaseHostReservation'
  { -- | Unique, case-sensitive identifier that you provide to ensure the
    -- idempotency of the request. For more information, see
    -- <https://docs.aws.amazon.com/AWSEC2/latest/APIReference/Run_Instance_Idempotency.html Ensuring Idempotency>.
    PurchaseHostReservation -> Maybe Text
clientToken :: Prelude.Maybe Prelude.Text,
    -- | The currency in which the @totalUpfrontPrice@, @LimitPrice@, and
    -- @totalHourlyPrice@ amounts are specified. At this time, the only
    -- supported currency is @USD@.
    PurchaseHostReservation -> Maybe CurrencyCodeValues
currencyCode :: Prelude.Maybe CurrencyCodeValues,
    -- | The specified limit is checked against the total upfront cost of the
    -- reservation (calculated as the offering\'s upfront cost multiplied by
    -- the host count). If the total upfront cost is greater than the specified
    -- price limit, the request fails. This is used to ensure that the purchase
    -- does not exceed the expected upfront cost of the purchase. At this time,
    -- the only supported currency is @USD@. For example, to indicate a limit
    -- price of USD 100, specify 100.00.
    PurchaseHostReservation -> Maybe Text
limitPrice :: Prelude.Maybe Prelude.Text,
    -- | The tags to apply to the Dedicated Host Reservation during purchase.
    PurchaseHostReservation -> Maybe [TagSpecification]
tagSpecifications :: Prelude.Maybe [TagSpecification],
    -- | The IDs of the Dedicated Hosts with which the reservation will be
    -- associated.
    PurchaseHostReservation -> [Text]
hostIdSet :: [Prelude.Text],
    -- | The ID of the offering.
    PurchaseHostReservation -> Text
offeringId :: Prelude.Text
  }
  deriving (PurchaseHostReservation -> PurchaseHostReservation -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PurchaseHostReservation -> PurchaseHostReservation -> Bool
$c/= :: PurchaseHostReservation -> PurchaseHostReservation -> Bool
== :: PurchaseHostReservation -> PurchaseHostReservation -> Bool
$c== :: PurchaseHostReservation -> PurchaseHostReservation -> Bool
Prelude.Eq, ReadPrec [PurchaseHostReservation]
ReadPrec PurchaseHostReservation
Int -> ReadS PurchaseHostReservation
ReadS [PurchaseHostReservation]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PurchaseHostReservation]
$creadListPrec :: ReadPrec [PurchaseHostReservation]
readPrec :: ReadPrec PurchaseHostReservation
$creadPrec :: ReadPrec PurchaseHostReservation
readList :: ReadS [PurchaseHostReservation]
$creadList :: ReadS [PurchaseHostReservation]
readsPrec :: Int -> ReadS PurchaseHostReservation
$creadsPrec :: Int -> ReadS PurchaseHostReservation
Prelude.Read, Int -> PurchaseHostReservation -> ShowS
[PurchaseHostReservation] -> ShowS
PurchaseHostReservation -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PurchaseHostReservation] -> ShowS
$cshowList :: [PurchaseHostReservation] -> ShowS
show :: PurchaseHostReservation -> String
$cshow :: PurchaseHostReservation -> String
showsPrec :: Int -> PurchaseHostReservation -> ShowS
$cshowsPrec :: Int -> PurchaseHostReservation -> ShowS
Prelude.Show, forall x. Rep PurchaseHostReservation x -> PurchaseHostReservation
forall x. PurchaseHostReservation -> Rep PurchaseHostReservation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PurchaseHostReservation x -> PurchaseHostReservation
$cfrom :: forall x. PurchaseHostReservation -> Rep PurchaseHostReservation x
Prelude.Generic)

-- |
-- Create a value of 'PurchaseHostReservation' 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:
--
-- 'clientToken', 'purchaseHostReservation_clientToken' - Unique, case-sensitive identifier that you provide to ensure the
-- idempotency of the request. For more information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/APIReference/Run_Instance_Idempotency.html Ensuring Idempotency>.
--
-- 'currencyCode', 'purchaseHostReservation_currencyCode' - The currency in which the @totalUpfrontPrice@, @LimitPrice@, and
-- @totalHourlyPrice@ amounts are specified. At this time, the only
-- supported currency is @USD@.
--
-- 'limitPrice', 'purchaseHostReservation_limitPrice' - The specified limit is checked against the total upfront cost of the
-- reservation (calculated as the offering\'s upfront cost multiplied by
-- the host count). If the total upfront cost is greater than the specified
-- price limit, the request fails. This is used to ensure that the purchase
-- does not exceed the expected upfront cost of the purchase. At this time,
-- the only supported currency is @USD@. For example, to indicate a limit
-- price of USD 100, specify 100.00.
--
-- 'tagSpecifications', 'purchaseHostReservation_tagSpecifications' - The tags to apply to the Dedicated Host Reservation during purchase.
--
-- 'hostIdSet', 'purchaseHostReservation_hostIdSet' - The IDs of the Dedicated Hosts with which the reservation will be
-- associated.
--
-- 'offeringId', 'purchaseHostReservation_offeringId' - The ID of the offering.
newPurchaseHostReservation ::
  -- | 'offeringId'
  Prelude.Text ->
  PurchaseHostReservation
newPurchaseHostReservation :: Text -> PurchaseHostReservation
newPurchaseHostReservation Text
pOfferingId_ =
  PurchaseHostReservation'
    { $sel:clientToken:PurchaseHostReservation' :: Maybe Text
clientToken =
        forall a. Maybe a
Prelude.Nothing,
      $sel:currencyCode:PurchaseHostReservation' :: Maybe CurrencyCodeValues
currencyCode = forall a. Maybe a
Prelude.Nothing,
      $sel:limitPrice:PurchaseHostReservation' :: Maybe Text
limitPrice = forall a. Maybe a
Prelude.Nothing,
      $sel:tagSpecifications:PurchaseHostReservation' :: Maybe [TagSpecification]
tagSpecifications = forall a. Maybe a
Prelude.Nothing,
      $sel:hostIdSet:PurchaseHostReservation' :: [Text]
hostIdSet = forall a. Monoid a => a
Prelude.mempty,
      $sel:offeringId:PurchaseHostReservation' :: Text
offeringId = Text
pOfferingId_
    }

-- | Unique, case-sensitive identifier that you provide to ensure the
-- idempotency of the request. For more information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/APIReference/Run_Instance_Idempotency.html Ensuring Idempotency>.
purchaseHostReservation_clientToken :: Lens.Lens' PurchaseHostReservation (Prelude.Maybe Prelude.Text)
purchaseHostReservation_clientToken :: Lens' PurchaseHostReservation (Maybe Text)
purchaseHostReservation_clientToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PurchaseHostReservation' {Maybe Text
clientToken :: Maybe Text
$sel:clientToken:PurchaseHostReservation' :: PurchaseHostReservation -> Maybe Text
clientToken} -> Maybe Text
clientToken) (\s :: PurchaseHostReservation
s@PurchaseHostReservation' {} Maybe Text
a -> PurchaseHostReservation
s {$sel:clientToken:PurchaseHostReservation' :: Maybe Text
clientToken = Maybe Text
a} :: PurchaseHostReservation)

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

-- | The specified limit is checked against the total upfront cost of the
-- reservation (calculated as the offering\'s upfront cost multiplied by
-- the host count). If the total upfront cost is greater than the specified
-- price limit, the request fails. This is used to ensure that the purchase
-- does not exceed the expected upfront cost of the purchase. At this time,
-- the only supported currency is @USD@. For example, to indicate a limit
-- price of USD 100, specify 100.00.
purchaseHostReservation_limitPrice :: Lens.Lens' PurchaseHostReservation (Prelude.Maybe Prelude.Text)
purchaseHostReservation_limitPrice :: Lens' PurchaseHostReservation (Maybe Text)
purchaseHostReservation_limitPrice = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PurchaseHostReservation' {Maybe Text
limitPrice :: Maybe Text
$sel:limitPrice:PurchaseHostReservation' :: PurchaseHostReservation -> Maybe Text
limitPrice} -> Maybe Text
limitPrice) (\s :: PurchaseHostReservation
s@PurchaseHostReservation' {} Maybe Text
a -> PurchaseHostReservation
s {$sel:limitPrice:PurchaseHostReservation' :: Maybe Text
limitPrice = Maybe Text
a} :: PurchaseHostReservation)

-- | The tags to apply to the Dedicated Host Reservation during purchase.
purchaseHostReservation_tagSpecifications :: Lens.Lens' PurchaseHostReservation (Prelude.Maybe [TagSpecification])
purchaseHostReservation_tagSpecifications :: Lens' PurchaseHostReservation (Maybe [TagSpecification])
purchaseHostReservation_tagSpecifications = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PurchaseHostReservation' {Maybe [TagSpecification]
tagSpecifications :: Maybe [TagSpecification]
$sel:tagSpecifications:PurchaseHostReservation' :: PurchaseHostReservation -> Maybe [TagSpecification]
tagSpecifications} -> Maybe [TagSpecification]
tagSpecifications) (\s :: PurchaseHostReservation
s@PurchaseHostReservation' {} Maybe [TagSpecification]
a -> PurchaseHostReservation
s {$sel:tagSpecifications:PurchaseHostReservation' :: Maybe [TagSpecification]
tagSpecifications = Maybe [TagSpecification]
a} :: PurchaseHostReservation) 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 IDs of the Dedicated Hosts with which the reservation will be
-- associated.
purchaseHostReservation_hostIdSet :: Lens.Lens' PurchaseHostReservation [Prelude.Text]
purchaseHostReservation_hostIdSet :: Lens' PurchaseHostReservation [Text]
purchaseHostReservation_hostIdSet = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PurchaseHostReservation' {[Text]
hostIdSet :: [Text]
$sel:hostIdSet:PurchaseHostReservation' :: PurchaseHostReservation -> [Text]
hostIdSet} -> [Text]
hostIdSet) (\s :: PurchaseHostReservation
s@PurchaseHostReservation' {} [Text]
a -> PurchaseHostReservation
s {$sel:hostIdSet:PurchaseHostReservation' :: [Text]
hostIdSet = [Text]
a} :: PurchaseHostReservation) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

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

instance Core.AWSRequest PurchaseHostReservation where
  type
    AWSResponse PurchaseHostReservation =
      PurchaseHostReservationResponse
  request :: (Service -> Service)
-> PurchaseHostReservation -> Request PurchaseHostReservation
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.postQuery (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy PurchaseHostReservation
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse PurchaseHostReservation)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> [Node] -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveXML
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Maybe Text
-> Maybe CurrencyCodeValues
-> Maybe [Purchase]
-> Maybe Text
-> Maybe Text
-> Int
-> PurchaseHostReservationResponse
PurchaseHostReservationResponse'
            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
"clientToken")
            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
"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
"purchase"
                            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
"totalHourlyPrice")
            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
"totalUpfrontPrice")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
      )

instance Prelude.Hashable PurchaseHostReservation where
  hashWithSalt :: Int -> PurchaseHostReservation -> Int
hashWithSalt Int
_salt PurchaseHostReservation' {[Text]
Maybe [TagSpecification]
Maybe Text
Maybe CurrencyCodeValues
Text
offeringId :: Text
hostIdSet :: [Text]
tagSpecifications :: Maybe [TagSpecification]
limitPrice :: Maybe Text
currencyCode :: Maybe CurrencyCodeValues
clientToken :: Maybe Text
$sel:offeringId:PurchaseHostReservation' :: PurchaseHostReservation -> Text
$sel:hostIdSet:PurchaseHostReservation' :: PurchaseHostReservation -> [Text]
$sel:tagSpecifications:PurchaseHostReservation' :: PurchaseHostReservation -> Maybe [TagSpecification]
$sel:limitPrice:PurchaseHostReservation' :: PurchaseHostReservation -> Maybe Text
$sel:currencyCode:PurchaseHostReservation' :: PurchaseHostReservation -> Maybe CurrencyCodeValues
$sel:clientToken:PurchaseHostReservation' :: PurchaseHostReservation -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
clientToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe CurrencyCodeValues
currencyCode
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
limitPrice
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [TagSpecification]
tagSpecifications
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` [Text]
hostIdSet
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
offeringId

instance Prelude.NFData PurchaseHostReservation where
  rnf :: PurchaseHostReservation -> ()
rnf PurchaseHostReservation' {[Text]
Maybe [TagSpecification]
Maybe Text
Maybe CurrencyCodeValues
Text
offeringId :: Text
hostIdSet :: [Text]
tagSpecifications :: Maybe [TagSpecification]
limitPrice :: Maybe Text
currencyCode :: Maybe CurrencyCodeValues
clientToken :: Maybe Text
$sel:offeringId:PurchaseHostReservation' :: PurchaseHostReservation -> Text
$sel:hostIdSet:PurchaseHostReservation' :: PurchaseHostReservation -> [Text]
$sel:tagSpecifications:PurchaseHostReservation' :: PurchaseHostReservation -> Maybe [TagSpecification]
$sel:limitPrice:PurchaseHostReservation' :: PurchaseHostReservation -> Maybe Text
$sel:currencyCode:PurchaseHostReservation' :: PurchaseHostReservation -> Maybe CurrencyCodeValues
$sel:clientToken:PurchaseHostReservation' :: PurchaseHostReservation -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
clientToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` 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 Text
limitPrice
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [TagSpecification]
tagSpecifications
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf [Text]
hostIdSet
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
offeringId

instance Data.ToHeaders PurchaseHostReservation where
  toHeaders :: PurchaseHostReservation -> ResponseHeaders
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

instance Data.ToPath PurchaseHostReservation where
  toPath :: PurchaseHostReservation -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

instance Data.ToQuery PurchaseHostReservation where
  toQuery :: PurchaseHostReservation -> QueryString
toQuery PurchaseHostReservation' {[Text]
Maybe [TagSpecification]
Maybe Text
Maybe CurrencyCodeValues
Text
offeringId :: Text
hostIdSet :: [Text]
tagSpecifications :: Maybe [TagSpecification]
limitPrice :: Maybe Text
currencyCode :: Maybe CurrencyCodeValues
clientToken :: Maybe Text
$sel:offeringId:PurchaseHostReservation' :: PurchaseHostReservation -> Text
$sel:hostIdSet:PurchaseHostReservation' :: PurchaseHostReservation -> [Text]
$sel:tagSpecifications:PurchaseHostReservation' :: PurchaseHostReservation -> Maybe [TagSpecification]
$sel:limitPrice:PurchaseHostReservation' :: PurchaseHostReservation -> Maybe Text
$sel:currencyCode:PurchaseHostReservation' :: PurchaseHostReservation -> Maybe CurrencyCodeValues
$sel:clientToken:PurchaseHostReservation' :: PurchaseHostReservation -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"PurchaseHostReservation" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2016-11-15" :: Prelude.ByteString),
        ByteString
"ClientToken" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
clientToken,
        ByteString
"CurrencyCode" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe CurrencyCodeValues
currencyCode,
        ByteString
"LimitPrice" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
limitPrice,
        forall a. ToQuery a => a -> QueryString
Data.toQuery
          ( forall a.
(IsList a, ToQuery (Item a)) =>
ByteString -> a -> QueryString
Data.toQueryList ByteString
"TagSpecification"
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [TagSpecification]
tagSpecifications
          ),
        forall a.
(IsList a, ToQuery (Item a)) =>
ByteString -> a -> QueryString
Data.toQueryList ByteString
"HostIdSet" [Text]
hostIdSet,
        ByteString
"OfferingId" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
offeringId
      ]

-- | /See:/ 'newPurchaseHostReservationResponse' smart constructor.
data PurchaseHostReservationResponse = PurchaseHostReservationResponse'
  { -- | Unique, case-sensitive identifier that you provide to ensure the
    -- idempotency of the request. For more information, see
    -- <https://docs.aws.amazon.com/AWSEC2/latest/APIReference/Run_Instance_Idempotency.html Ensuring Idempotency>.
    PurchaseHostReservationResponse -> Maybe Text
clientToken :: Prelude.Maybe Prelude.Text,
    -- | The currency in which the @totalUpfrontPrice@ and @totalHourlyPrice@
    -- amounts are specified. At this time, the only supported currency is
    -- @USD@.
    PurchaseHostReservationResponse -> Maybe CurrencyCodeValues
currencyCode :: Prelude.Maybe CurrencyCodeValues,
    -- | Describes the details of the purchase.
    PurchaseHostReservationResponse -> Maybe [Purchase]
purchase :: Prelude.Maybe [Purchase],
    -- | The total hourly price of the reservation calculated per hour.
    PurchaseHostReservationResponse -> Maybe Text
totalHourlyPrice :: Prelude.Maybe Prelude.Text,
    -- | The total amount charged to your account when you purchase the
    -- reservation.
    PurchaseHostReservationResponse -> Maybe Text
totalUpfrontPrice :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    PurchaseHostReservationResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (PurchaseHostReservationResponse
-> PurchaseHostReservationResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PurchaseHostReservationResponse
-> PurchaseHostReservationResponse -> Bool
$c/= :: PurchaseHostReservationResponse
-> PurchaseHostReservationResponse -> Bool
== :: PurchaseHostReservationResponse
-> PurchaseHostReservationResponse -> Bool
$c== :: PurchaseHostReservationResponse
-> PurchaseHostReservationResponse -> Bool
Prelude.Eq, ReadPrec [PurchaseHostReservationResponse]
ReadPrec PurchaseHostReservationResponse
Int -> ReadS PurchaseHostReservationResponse
ReadS [PurchaseHostReservationResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PurchaseHostReservationResponse]
$creadListPrec :: ReadPrec [PurchaseHostReservationResponse]
readPrec :: ReadPrec PurchaseHostReservationResponse
$creadPrec :: ReadPrec PurchaseHostReservationResponse
readList :: ReadS [PurchaseHostReservationResponse]
$creadList :: ReadS [PurchaseHostReservationResponse]
readsPrec :: Int -> ReadS PurchaseHostReservationResponse
$creadsPrec :: Int -> ReadS PurchaseHostReservationResponse
Prelude.Read, Int -> PurchaseHostReservationResponse -> ShowS
[PurchaseHostReservationResponse] -> ShowS
PurchaseHostReservationResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PurchaseHostReservationResponse] -> ShowS
$cshowList :: [PurchaseHostReservationResponse] -> ShowS
show :: PurchaseHostReservationResponse -> String
$cshow :: PurchaseHostReservationResponse -> String
showsPrec :: Int -> PurchaseHostReservationResponse -> ShowS
$cshowsPrec :: Int -> PurchaseHostReservationResponse -> ShowS
Prelude.Show, forall x.
Rep PurchaseHostReservationResponse x
-> PurchaseHostReservationResponse
forall x.
PurchaseHostReservationResponse
-> Rep PurchaseHostReservationResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep PurchaseHostReservationResponse x
-> PurchaseHostReservationResponse
$cfrom :: forall x.
PurchaseHostReservationResponse
-> Rep PurchaseHostReservationResponse x
Prelude.Generic)

-- |
-- Create a value of 'PurchaseHostReservationResponse' 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:
--
-- 'clientToken', 'purchaseHostReservationResponse_clientToken' - Unique, case-sensitive identifier that you provide to ensure the
-- idempotency of the request. For more information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/APIReference/Run_Instance_Idempotency.html Ensuring Idempotency>.
--
-- 'currencyCode', 'purchaseHostReservationResponse_currencyCode' - The currency in which the @totalUpfrontPrice@ and @totalHourlyPrice@
-- amounts are specified. At this time, the only supported currency is
-- @USD@.
--
-- 'purchase', 'purchaseHostReservationResponse_purchase' - Describes the details of the purchase.
--
-- 'totalHourlyPrice', 'purchaseHostReservationResponse_totalHourlyPrice' - The total hourly price of the reservation calculated per hour.
--
-- 'totalUpfrontPrice', 'purchaseHostReservationResponse_totalUpfrontPrice' - The total amount charged to your account when you purchase the
-- reservation.
--
-- 'httpStatus', 'purchaseHostReservationResponse_httpStatus' - The response's http status code.
newPurchaseHostReservationResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  PurchaseHostReservationResponse
newPurchaseHostReservationResponse :: Int -> PurchaseHostReservationResponse
newPurchaseHostReservationResponse Int
pHttpStatus_ =
  PurchaseHostReservationResponse'
    { $sel:clientToken:PurchaseHostReservationResponse' :: Maybe Text
clientToken =
        forall a. Maybe a
Prelude.Nothing,
      $sel:currencyCode:PurchaseHostReservationResponse' :: Maybe CurrencyCodeValues
currencyCode = forall a. Maybe a
Prelude.Nothing,
      $sel:purchase:PurchaseHostReservationResponse' :: Maybe [Purchase]
purchase = forall a. Maybe a
Prelude.Nothing,
      $sel:totalHourlyPrice:PurchaseHostReservationResponse' :: Maybe Text
totalHourlyPrice = forall a. Maybe a
Prelude.Nothing,
      $sel:totalUpfrontPrice:PurchaseHostReservationResponse' :: Maybe Text
totalUpfrontPrice = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:PurchaseHostReservationResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Unique, case-sensitive identifier that you provide to ensure the
-- idempotency of the request. For more information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/APIReference/Run_Instance_Idempotency.html Ensuring Idempotency>.
purchaseHostReservationResponse_clientToken :: Lens.Lens' PurchaseHostReservationResponse (Prelude.Maybe Prelude.Text)
purchaseHostReservationResponse_clientToken :: Lens' PurchaseHostReservationResponse (Maybe Text)
purchaseHostReservationResponse_clientToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PurchaseHostReservationResponse' {Maybe Text
clientToken :: Maybe Text
$sel:clientToken:PurchaseHostReservationResponse' :: PurchaseHostReservationResponse -> Maybe Text
clientToken} -> Maybe Text
clientToken) (\s :: PurchaseHostReservationResponse
s@PurchaseHostReservationResponse' {} Maybe Text
a -> PurchaseHostReservationResponse
s {$sel:clientToken:PurchaseHostReservationResponse' :: Maybe Text
clientToken = Maybe Text
a} :: PurchaseHostReservationResponse)

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

-- | Describes the details of the purchase.
purchaseHostReservationResponse_purchase :: Lens.Lens' PurchaseHostReservationResponse (Prelude.Maybe [Purchase])
purchaseHostReservationResponse_purchase :: Lens' PurchaseHostReservationResponse (Maybe [Purchase])
purchaseHostReservationResponse_purchase = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PurchaseHostReservationResponse' {Maybe [Purchase]
purchase :: Maybe [Purchase]
$sel:purchase:PurchaseHostReservationResponse' :: PurchaseHostReservationResponse -> Maybe [Purchase]
purchase} -> Maybe [Purchase]
purchase) (\s :: PurchaseHostReservationResponse
s@PurchaseHostReservationResponse' {} Maybe [Purchase]
a -> PurchaseHostReservationResponse
s {$sel:purchase:PurchaseHostReservationResponse' :: Maybe [Purchase]
purchase = Maybe [Purchase]
a} :: PurchaseHostReservationResponse) 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 total hourly price of the reservation calculated per hour.
purchaseHostReservationResponse_totalHourlyPrice :: Lens.Lens' PurchaseHostReservationResponse (Prelude.Maybe Prelude.Text)
purchaseHostReservationResponse_totalHourlyPrice :: Lens' PurchaseHostReservationResponse (Maybe Text)
purchaseHostReservationResponse_totalHourlyPrice = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PurchaseHostReservationResponse' {Maybe Text
totalHourlyPrice :: Maybe Text
$sel:totalHourlyPrice:PurchaseHostReservationResponse' :: PurchaseHostReservationResponse -> Maybe Text
totalHourlyPrice} -> Maybe Text
totalHourlyPrice) (\s :: PurchaseHostReservationResponse
s@PurchaseHostReservationResponse' {} Maybe Text
a -> PurchaseHostReservationResponse
s {$sel:totalHourlyPrice:PurchaseHostReservationResponse' :: Maybe Text
totalHourlyPrice = Maybe Text
a} :: PurchaseHostReservationResponse)

-- | The total amount charged to your account when you purchase the
-- reservation.
purchaseHostReservationResponse_totalUpfrontPrice :: Lens.Lens' PurchaseHostReservationResponse (Prelude.Maybe Prelude.Text)
purchaseHostReservationResponse_totalUpfrontPrice :: Lens' PurchaseHostReservationResponse (Maybe Text)
purchaseHostReservationResponse_totalUpfrontPrice = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PurchaseHostReservationResponse' {Maybe Text
totalUpfrontPrice :: Maybe Text
$sel:totalUpfrontPrice:PurchaseHostReservationResponse' :: PurchaseHostReservationResponse -> Maybe Text
totalUpfrontPrice} -> Maybe Text
totalUpfrontPrice) (\s :: PurchaseHostReservationResponse
s@PurchaseHostReservationResponse' {} Maybe Text
a -> PurchaseHostReservationResponse
s {$sel:totalUpfrontPrice:PurchaseHostReservationResponse' :: Maybe Text
totalUpfrontPrice = Maybe Text
a} :: PurchaseHostReservationResponse)

-- | The response's http status code.
purchaseHostReservationResponse_httpStatus :: Lens.Lens' PurchaseHostReservationResponse Prelude.Int
purchaseHostReservationResponse_httpStatus :: Lens' PurchaseHostReservationResponse Int
purchaseHostReservationResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PurchaseHostReservationResponse' {Int
httpStatus :: Int
$sel:httpStatus:PurchaseHostReservationResponse' :: PurchaseHostReservationResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: PurchaseHostReservationResponse
s@PurchaseHostReservationResponse' {} Int
a -> PurchaseHostReservationResponse
s {$sel:httpStatus:PurchaseHostReservationResponse' :: Int
httpStatus = Int
a} :: PurchaseHostReservationResponse)

instance
  Prelude.NFData
    PurchaseHostReservationResponse
  where
  rnf :: PurchaseHostReservationResponse -> ()
rnf PurchaseHostReservationResponse' {Int
Maybe [Purchase]
Maybe Text
Maybe CurrencyCodeValues
httpStatus :: Int
totalUpfrontPrice :: Maybe Text
totalHourlyPrice :: Maybe Text
purchase :: Maybe [Purchase]
currencyCode :: Maybe CurrencyCodeValues
clientToken :: Maybe Text
$sel:httpStatus:PurchaseHostReservationResponse' :: PurchaseHostReservationResponse -> Int
$sel:totalUpfrontPrice:PurchaseHostReservationResponse' :: PurchaseHostReservationResponse -> Maybe Text
$sel:totalHourlyPrice:PurchaseHostReservationResponse' :: PurchaseHostReservationResponse -> Maybe Text
$sel:purchase:PurchaseHostReservationResponse' :: PurchaseHostReservationResponse -> Maybe [Purchase]
$sel:currencyCode:PurchaseHostReservationResponse' :: PurchaseHostReservationResponse -> Maybe CurrencyCodeValues
$sel:clientToken:PurchaseHostReservationResponse' :: PurchaseHostReservationResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
clientToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` 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 [Purchase]
purchase
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
totalHourlyPrice
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
totalUpfrontPrice
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus