{-# 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.GetHostReservationPurchasePreview
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Preview a reservation purchase with configurations that match those of
-- your Dedicated Host. You must have active Dedicated Hosts in your
-- account before you purchase a reservation.
--
-- This is a preview of the PurchaseHostReservation action and does not
-- result in the offering being purchased.
module Amazonka.EC2.GetHostReservationPurchasePreview
  ( -- * Creating a Request
    GetHostReservationPurchasePreview (..),
    newGetHostReservationPurchasePreview,

    -- * Request Lenses
    getHostReservationPurchasePreview_hostIdSet,
    getHostReservationPurchasePreview_offeringId,

    -- * Destructuring the Response
    GetHostReservationPurchasePreviewResponse (..),
    newGetHostReservationPurchasePreviewResponse,

    -- * Response Lenses
    getHostReservationPurchasePreviewResponse_currencyCode,
    getHostReservationPurchasePreviewResponse_purchase,
    getHostReservationPurchasePreviewResponse_totalHourlyPrice,
    getHostReservationPurchasePreviewResponse_totalUpfrontPrice,
    getHostReservationPurchasePreviewResponse_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:/ 'newGetHostReservationPurchasePreview' smart constructor.
data GetHostReservationPurchasePreview = GetHostReservationPurchasePreview'
  { -- | The IDs of the Dedicated Hosts with which the reservation is associated.
    GetHostReservationPurchasePreview -> [Text]
hostIdSet :: [Prelude.Text],
    -- | The offering ID of the reservation.
    GetHostReservationPurchasePreview -> Text
offeringId :: Prelude.Text
  }
  deriving (GetHostReservationPurchasePreview
-> GetHostReservationPurchasePreview -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetHostReservationPurchasePreview
-> GetHostReservationPurchasePreview -> Bool
$c/= :: GetHostReservationPurchasePreview
-> GetHostReservationPurchasePreview -> Bool
== :: GetHostReservationPurchasePreview
-> GetHostReservationPurchasePreview -> Bool
$c== :: GetHostReservationPurchasePreview
-> GetHostReservationPurchasePreview -> Bool
Prelude.Eq, ReadPrec [GetHostReservationPurchasePreview]
ReadPrec GetHostReservationPurchasePreview
Int -> ReadS GetHostReservationPurchasePreview
ReadS [GetHostReservationPurchasePreview]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetHostReservationPurchasePreview]
$creadListPrec :: ReadPrec [GetHostReservationPurchasePreview]
readPrec :: ReadPrec GetHostReservationPurchasePreview
$creadPrec :: ReadPrec GetHostReservationPurchasePreview
readList :: ReadS [GetHostReservationPurchasePreview]
$creadList :: ReadS [GetHostReservationPurchasePreview]
readsPrec :: Int -> ReadS GetHostReservationPurchasePreview
$creadsPrec :: Int -> ReadS GetHostReservationPurchasePreview
Prelude.Read, Int -> GetHostReservationPurchasePreview -> ShowS
[GetHostReservationPurchasePreview] -> ShowS
GetHostReservationPurchasePreview -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetHostReservationPurchasePreview] -> ShowS
$cshowList :: [GetHostReservationPurchasePreview] -> ShowS
show :: GetHostReservationPurchasePreview -> String
$cshow :: GetHostReservationPurchasePreview -> String
showsPrec :: Int -> GetHostReservationPurchasePreview -> ShowS
$cshowsPrec :: Int -> GetHostReservationPurchasePreview -> ShowS
Prelude.Show, forall x.
Rep GetHostReservationPurchasePreview x
-> GetHostReservationPurchasePreview
forall x.
GetHostReservationPurchasePreview
-> Rep GetHostReservationPurchasePreview x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetHostReservationPurchasePreview x
-> GetHostReservationPurchasePreview
$cfrom :: forall x.
GetHostReservationPurchasePreview
-> Rep GetHostReservationPurchasePreview x
Prelude.Generic)

-- |
-- Create a value of 'GetHostReservationPurchasePreview' 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:
--
-- 'hostIdSet', 'getHostReservationPurchasePreview_hostIdSet' - The IDs of the Dedicated Hosts with which the reservation is associated.
--
-- 'offeringId', 'getHostReservationPurchasePreview_offeringId' - The offering ID of the reservation.
newGetHostReservationPurchasePreview ::
  -- | 'offeringId'
  Prelude.Text ->
  GetHostReservationPurchasePreview
newGetHostReservationPurchasePreview :: Text -> GetHostReservationPurchasePreview
newGetHostReservationPurchasePreview Text
pOfferingId_ =
  GetHostReservationPurchasePreview'
    { $sel:hostIdSet:GetHostReservationPurchasePreview' :: [Text]
hostIdSet =
        forall a. Monoid a => a
Prelude.mempty,
      $sel:offeringId:GetHostReservationPurchasePreview' :: Text
offeringId = Text
pOfferingId_
    }

-- | The IDs of the Dedicated Hosts with which the reservation is associated.
getHostReservationPurchasePreview_hostIdSet :: Lens.Lens' GetHostReservationPurchasePreview [Prelude.Text]
getHostReservationPurchasePreview_hostIdSet :: Lens' GetHostReservationPurchasePreview [Text]
getHostReservationPurchasePreview_hostIdSet = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetHostReservationPurchasePreview' {[Text]
hostIdSet :: [Text]
$sel:hostIdSet:GetHostReservationPurchasePreview' :: GetHostReservationPurchasePreview -> [Text]
hostIdSet} -> [Text]
hostIdSet) (\s :: GetHostReservationPurchasePreview
s@GetHostReservationPurchasePreview' {} [Text]
a -> GetHostReservationPurchasePreview
s {$sel:hostIdSet:GetHostReservationPurchasePreview' :: [Text]
hostIdSet = [Text]
a} :: GetHostReservationPurchasePreview) 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 offering ID of the reservation.
getHostReservationPurchasePreview_offeringId :: Lens.Lens' GetHostReservationPurchasePreview Prelude.Text
getHostReservationPurchasePreview_offeringId :: Lens' GetHostReservationPurchasePreview Text
getHostReservationPurchasePreview_offeringId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetHostReservationPurchasePreview' {Text
offeringId :: Text
$sel:offeringId:GetHostReservationPurchasePreview' :: GetHostReservationPurchasePreview -> Text
offeringId} -> Text
offeringId) (\s :: GetHostReservationPurchasePreview
s@GetHostReservationPurchasePreview' {} Text
a -> GetHostReservationPurchasePreview
s {$sel:offeringId:GetHostReservationPurchasePreview' :: Text
offeringId = Text
a} :: GetHostReservationPurchasePreview)

instance
  Core.AWSRequest
    GetHostReservationPurchasePreview
  where
  type
    AWSResponse GetHostReservationPurchasePreview =
      GetHostReservationPurchasePreviewResponse
  request :: (Service -> Service)
-> GetHostReservationPurchasePreview
-> Request GetHostReservationPurchasePreview
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 GetHostReservationPurchasePreview
-> ClientResponse ClientBody
-> m (Either
        Error
        (ClientResponse (AWSResponse GetHostReservationPurchasePreview)))
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 CurrencyCodeValues
-> Maybe [Purchase]
-> Maybe Text
-> Maybe Text
-> Int
-> GetHostReservationPurchasePreviewResponse
GetHostReservationPurchasePreviewResponse'
            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
"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
    GetHostReservationPurchasePreview
  where
  hashWithSalt :: Int -> GetHostReservationPurchasePreview -> Int
hashWithSalt
    Int
_salt
    GetHostReservationPurchasePreview' {[Text]
Text
offeringId :: Text
hostIdSet :: [Text]
$sel:offeringId:GetHostReservationPurchasePreview' :: GetHostReservationPurchasePreview -> Text
$sel:hostIdSet:GetHostReservationPurchasePreview' :: GetHostReservationPurchasePreview -> [Text]
..} =
      Int
_salt
        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
    GetHostReservationPurchasePreview
  where
  rnf :: GetHostReservationPurchasePreview -> ()
rnf GetHostReservationPurchasePreview' {[Text]
Text
offeringId :: Text
hostIdSet :: [Text]
$sel:offeringId:GetHostReservationPurchasePreview' :: GetHostReservationPurchasePreview -> Text
$sel:hostIdSet:GetHostReservationPurchasePreview' :: GetHostReservationPurchasePreview -> [Text]
..} =
    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
    GetHostReservationPurchasePreview
  where
  toHeaders :: GetHostReservationPurchasePreview -> ResponseHeaders
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

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

instance
  Data.ToQuery
    GetHostReservationPurchasePreview
  where
  toQuery :: GetHostReservationPurchasePreview -> QueryString
toQuery GetHostReservationPurchasePreview' {[Text]
Text
offeringId :: Text
hostIdSet :: [Text]
$sel:offeringId:GetHostReservationPurchasePreview' :: GetHostReservationPurchasePreview -> Text
$sel:hostIdSet:GetHostReservationPurchasePreview' :: GetHostReservationPurchasePreview -> [Text]
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: ( ByteString
"GetHostReservationPurchasePreview" ::
                      Prelude.ByteString
                  ),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2016-11-15" :: Prelude.ByteString),
        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:/ 'newGetHostReservationPurchasePreviewResponse' smart constructor.
data GetHostReservationPurchasePreviewResponse = GetHostReservationPurchasePreviewResponse'
  { -- | The currency in which the @totalUpfrontPrice@ and @totalHourlyPrice@
    -- amounts are specified. At this time, the only supported currency is
    -- @USD@.
    GetHostReservationPurchasePreviewResponse
-> Maybe CurrencyCodeValues
currencyCode :: Prelude.Maybe CurrencyCodeValues,
    -- | The purchase information of the Dedicated Host reservation and the
    -- Dedicated Hosts associated with it.
    GetHostReservationPurchasePreviewResponse -> Maybe [Purchase]
purchase :: Prelude.Maybe [Purchase],
    -- | The potential total hourly price of the reservation per hour.
    GetHostReservationPurchasePreviewResponse -> Maybe Text
totalHourlyPrice :: Prelude.Maybe Prelude.Text,
    -- | The potential total upfront price. This is billed immediately.
    GetHostReservationPurchasePreviewResponse -> Maybe Text
totalUpfrontPrice :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    GetHostReservationPurchasePreviewResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetHostReservationPurchasePreviewResponse
-> GetHostReservationPurchasePreviewResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetHostReservationPurchasePreviewResponse
-> GetHostReservationPurchasePreviewResponse -> Bool
$c/= :: GetHostReservationPurchasePreviewResponse
-> GetHostReservationPurchasePreviewResponse -> Bool
== :: GetHostReservationPurchasePreviewResponse
-> GetHostReservationPurchasePreviewResponse -> Bool
$c== :: GetHostReservationPurchasePreviewResponse
-> GetHostReservationPurchasePreviewResponse -> Bool
Prelude.Eq, ReadPrec [GetHostReservationPurchasePreviewResponse]
ReadPrec GetHostReservationPurchasePreviewResponse
Int -> ReadS GetHostReservationPurchasePreviewResponse
ReadS [GetHostReservationPurchasePreviewResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetHostReservationPurchasePreviewResponse]
$creadListPrec :: ReadPrec [GetHostReservationPurchasePreviewResponse]
readPrec :: ReadPrec GetHostReservationPurchasePreviewResponse
$creadPrec :: ReadPrec GetHostReservationPurchasePreviewResponse
readList :: ReadS [GetHostReservationPurchasePreviewResponse]
$creadList :: ReadS [GetHostReservationPurchasePreviewResponse]
readsPrec :: Int -> ReadS GetHostReservationPurchasePreviewResponse
$creadsPrec :: Int -> ReadS GetHostReservationPurchasePreviewResponse
Prelude.Read, Int -> GetHostReservationPurchasePreviewResponse -> ShowS
[GetHostReservationPurchasePreviewResponse] -> ShowS
GetHostReservationPurchasePreviewResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetHostReservationPurchasePreviewResponse] -> ShowS
$cshowList :: [GetHostReservationPurchasePreviewResponse] -> ShowS
show :: GetHostReservationPurchasePreviewResponse -> String
$cshow :: GetHostReservationPurchasePreviewResponse -> String
showsPrec :: Int -> GetHostReservationPurchasePreviewResponse -> ShowS
$cshowsPrec :: Int -> GetHostReservationPurchasePreviewResponse -> ShowS
Prelude.Show, forall x.
Rep GetHostReservationPurchasePreviewResponse x
-> GetHostReservationPurchasePreviewResponse
forall x.
GetHostReservationPurchasePreviewResponse
-> Rep GetHostReservationPurchasePreviewResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetHostReservationPurchasePreviewResponse x
-> GetHostReservationPurchasePreviewResponse
$cfrom :: forall x.
GetHostReservationPurchasePreviewResponse
-> Rep GetHostReservationPurchasePreviewResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetHostReservationPurchasePreviewResponse' 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', 'getHostReservationPurchasePreviewResponse_currencyCode' - The currency in which the @totalUpfrontPrice@ and @totalHourlyPrice@
-- amounts are specified. At this time, the only supported currency is
-- @USD@.
--
-- 'purchase', 'getHostReservationPurchasePreviewResponse_purchase' - The purchase information of the Dedicated Host reservation and the
-- Dedicated Hosts associated with it.
--
-- 'totalHourlyPrice', 'getHostReservationPurchasePreviewResponse_totalHourlyPrice' - The potential total hourly price of the reservation per hour.
--
-- 'totalUpfrontPrice', 'getHostReservationPurchasePreviewResponse_totalUpfrontPrice' - The potential total upfront price. This is billed immediately.
--
-- 'httpStatus', 'getHostReservationPurchasePreviewResponse_httpStatus' - The response's http status code.
newGetHostReservationPurchasePreviewResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetHostReservationPurchasePreviewResponse
newGetHostReservationPurchasePreviewResponse :: Int -> GetHostReservationPurchasePreviewResponse
newGetHostReservationPurchasePreviewResponse
  Int
pHttpStatus_ =
    GetHostReservationPurchasePreviewResponse'
      { $sel:currencyCode:GetHostReservationPurchasePreviewResponse' :: Maybe CurrencyCodeValues
currencyCode =
          forall a. Maybe a
Prelude.Nothing,
        $sel:purchase:GetHostReservationPurchasePreviewResponse' :: Maybe [Purchase]
purchase = forall a. Maybe a
Prelude.Nothing,
        $sel:totalHourlyPrice:GetHostReservationPurchasePreviewResponse' :: Maybe Text
totalHourlyPrice =
          forall a. Maybe a
Prelude.Nothing,
        $sel:totalUpfrontPrice:GetHostReservationPurchasePreviewResponse' :: Maybe Text
totalUpfrontPrice =
          forall a. Maybe a
Prelude.Nothing,
        $sel:httpStatus:GetHostReservationPurchasePreviewResponse' :: Int
httpStatus = Int
pHttpStatus_
      }

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

-- | The purchase information of the Dedicated Host reservation and the
-- Dedicated Hosts associated with it.
getHostReservationPurchasePreviewResponse_purchase :: Lens.Lens' GetHostReservationPurchasePreviewResponse (Prelude.Maybe [Purchase])
getHostReservationPurchasePreviewResponse_purchase :: Lens' GetHostReservationPurchasePreviewResponse (Maybe [Purchase])
getHostReservationPurchasePreviewResponse_purchase = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetHostReservationPurchasePreviewResponse' {Maybe [Purchase]
purchase :: Maybe [Purchase]
$sel:purchase:GetHostReservationPurchasePreviewResponse' :: GetHostReservationPurchasePreviewResponse -> Maybe [Purchase]
purchase} -> Maybe [Purchase]
purchase) (\s :: GetHostReservationPurchasePreviewResponse
s@GetHostReservationPurchasePreviewResponse' {} Maybe [Purchase]
a -> GetHostReservationPurchasePreviewResponse
s {$sel:purchase:GetHostReservationPurchasePreviewResponse' :: Maybe [Purchase]
purchase = Maybe [Purchase]
a} :: GetHostReservationPurchasePreviewResponse) 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 potential total hourly price of the reservation per hour.
getHostReservationPurchasePreviewResponse_totalHourlyPrice :: Lens.Lens' GetHostReservationPurchasePreviewResponse (Prelude.Maybe Prelude.Text)
getHostReservationPurchasePreviewResponse_totalHourlyPrice :: Lens' GetHostReservationPurchasePreviewResponse (Maybe Text)
getHostReservationPurchasePreviewResponse_totalHourlyPrice = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetHostReservationPurchasePreviewResponse' {Maybe Text
totalHourlyPrice :: Maybe Text
$sel:totalHourlyPrice:GetHostReservationPurchasePreviewResponse' :: GetHostReservationPurchasePreviewResponse -> Maybe Text
totalHourlyPrice} -> Maybe Text
totalHourlyPrice) (\s :: GetHostReservationPurchasePreviewResponse
s@GetHostReservationPurchasePreviewResponse' {} Maybe Text
a -> GetHostReservationPurchasePreviewResponse
s {$sel:totalHourlyPrice:GetHostReservationPurchasePreviewResponse' :: Maybe Text
totalHourlyPrice = Maybe Text
a} :: GetHostReservationPurchasePreviewResponse)

-- | The potential total upfront price. This is billed immediately.
getHostReservationPurchasePreviewResponse_totalUpfrontPrice :: Lens.Lens' GetHostReservationPurchasePreviewResponse (Prelude.Maybe Prelude.Text)
getHostReservationPurchasePreviewResponse_totalUpfrontPrice :: Lens' GetHostReservationPurchasePreviewResponse (Maybe Text)
getHostReservationPurchasePreviewResponse_totalUpfrontPrice = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetHostReservationPurchasePreviewResponse' {Maybe Text
totalUpfrontPrice :: Maybe Text
$sel:totalUpfrontPrice:GetHostReservationPurchasePreviewResponse' :: GetHostReservationPurchasePreviewResponse -> Maybe Text
totalUpfrontPrice} -> Maybe Text
totalUpfrontPrice) (\s :: GetHostReservationPurchasePreviewResponse
s@GetHostReservationPurchasePreviewResponse' {} Maybe Text
a -> GetHostReservationPurchasePreviewResponse
s {$sel:totalUpfrontPrice:GetHostReservationPurchasePreviewResponse' :: Maybe Text
totalUpfrontPrice = Maybe Text
a} :: GetHostReservationPurchasePreviewResponse)

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

instance
  Prelude.NFData
    GetHostReservationPurchasePreviewResponse
  where
  rnf :: GetHostReservationPurchasePreviewResponse -> ()
rnf GetHostReservationPurchasePreviewResponse' {Int
Maybe [Purchase]
Maybe Text
Maybe CurrencyCodeValues
httpStatus :: Int
totalUpfrontPrice :: Maybe Text
totalHourlyPrice :: Maybe Text
purchase :: Maybe [Purchase]
currencyCode :: Maybe CurrencyCodeValues
$sel:httpStatus:GetHostReservationPurchasePreviewResponse' :: GetHostReservationPurchasePreviewResponse -> Int
$sel:totalUpfrontPrice:GetHostReservationPurchasePreviewResponse' :: GetHostReservationPurchasePreviewResponse -> Maybe Text
$sel:totalHourlyPrice:GetHostReservationPurchasePreviewResponse' :: GetHostReservationPurchasePreviewResponse -> Maybe Text
$sel:purchase:GetHostReservationPurchasePreviewResponse' :: GetHostReservationPurchasePreviewResponse -> Maybe [Purchase]
$sel:currencyCode:GetHostReservationPurchasePreviewResponse' :: GetHostReservationPurchasePreviewResponse
-> 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 [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