{-# 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.ReservedInstancesListing
-- 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.ReservedInstancesListing 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.InstanceCount
import Amazonka.EC2.Types.ListingStatus
import Amazonka.EC2.Types.PriceSchedule
import Amazonka.EC2.Types.Tag
import qualified Amazonka.Prelude as Prelude

-- | Describes a Reserved Instance listing.
--
-- /See:/ 'newReservedInstancesListing' smart constructor.
data ReservedInstancesListing = ReservedInstancesListing'
  { -- | A unique, case-sensitive key supplied by the client to ensure that the
    -- request is idempotent. For more information, see
    -- <https://docs.aws.amazon.com/AWSEC2/latest/APIReference/Run_Instance_Idempotency.html Ensuring Idempotency>.
    ReservedInstancesListing -> Maybe Text
clientToken :: Prelude.Maybe Prelude.Text,
    -- | The time the listing was created.
    ReservedInstancesListing -> Maybe ISO8601
createDate :: Prelude.Maybe Data.ISO8601,
    -- | The number of instances in this state.
    ReservedInstancesListing -> Maybe [InstanceCount]
instanceCounts :: Prelude.Maybe [InstanceCount],
    -- | The price of the Reserved Instance listing.
    ReservedInstancesListing -> Maybe [PriceSchedule]
priceSchedules :: Prelude.Maybe [PriceSchedule],
    -- | The ID of the Reserved Instance.
    ReservedInstancesListing -> Maybe Text
reservedInstancesId :: Prelude.Maybe Prelude.Text,
    -- | The ID of the Reserved Instance listing.
    ReservedInstancesListing -> Maybe Text
reservedInstancesListingId :: Prelude.Maybe Prelude.Text,
    -- | The status of the Reserved Instance listing.
    ReservedInstancesListing -> Maybe ListingStatus
status :: Prelude.Maybe ListingStatus,
    -- | The reason for the current status of the Reserved Instance listing. The
    -- response can be blank.
    ReservedInstancesListing -> Maybe Text
statusMessage :: Prelude.Maybe Prelude.Text,
    -- | Any tags assigned to the resource.
    ReservedInstancesListing -> Maybe [Tag]
tags :: Prelude.Maybe [Tag],
    -- | The last modified timestamp of the listing.
    ReservedInstancesListing -> Maybe ISO8601
updateDate :: Prelude.Maybe Data.ISO8601
  }
  deriving (ReservedInstancesListing -> ReservedInstancesListing -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ReservedInstancesListing -> ReservedInstancesListing -> Bool
$c/= :: ReservedInstancesListing -> ReservedInstancesListing -> Bool
== :: ReservedInstancesListing -> ReservedInstancesListing -> Bool
$c== :: ReservedInstancesListing -> ReservedInstancesListing -> Bool
Prelude.Eq, ReadPrec [ReservedInstancesListing]
ReadPrec ReservedInstancesListing
Int -> ReadS ReservedInstancesListing
ReadS [ReservedInstancesListing]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ReservedInstancesListing]
$creadListPrec :: ReadPrec [ReservedInstancesListing]
readPrec :: ReadPrec ReservedInstancesListing
$creadPrec :: ReadPrec ReservedInstancesListing
readList :: ReadS [ReservedInstancesListing]
$creadList :: ReadS [ReservedInstancesListing]
readsPrec :: Int -> ReadS ReservedInstancesListing
$creadsPrec :: Int -> ReadS ReservedInstancesListing
Prelude.Read, Int -> ReservedInstancesListing -> ShowS
[ReservedInstancesListing] -> ShowS
ReservedInstancesListing -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ReservedInstancesListing] -> ShowS
$cshowList :: [ReservedInstancesListing] -> ShowS
show :: ReservedInstancesListing -> String
$cshow :: ReservedInstancesListing -> String
showsPrec :: Int -> ReservedInstancesListing -> ShowS
$cshowsPrec :: Int -> ReservedInstancesListing -> ShowS
Prelude.Show, forall x.
Rep ReservedInstancesListing x -> ReservedInstancesListing
forall x.
ReservedInstancesListing -> Rep ReservedInstancesListing x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ReservedInstancesListing x -> ReservedInstancesListing
$cfrom :: forall x.
ReservedInstancesListing -> Rep ReservedInstancesListing x
Prelude.Generic)

-- |
-- Create a value of 'ReservedInstancesListing' 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', 'reservedInstancesListing_clientToken' - A unique, case-sensitive key supplied by the client to ensure that the
-- request is idempotent. For more information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/APIReference/Run_Instance_Idempotency.html Ensuring Idempotency>.
--
-- 'createDate', 'reservedInstancesListing_createDate' - The time the listing was created.
--
-- 'instanceCounts', 'reservedInstancesListing_instanceCounts' - The number of instances in this state.
--
-- 'priceSchedules', 'reservedInstancesListing_priceSchedules' - The price of the Reserved Instance listing.
--
-- 'reservedInstancesId', 'reservedInstancesListing_reservedInstancesId' - The ID of the Reserved Instance.
--
-- 'reservedInstancesListingId', 'reservedInstancesListing_reservedInstancesListingId' - The ID of the Reserved Instance listing.
--
-- 'status', 'reservedInstancesListing_status' - The status of the Reserved Instance listing.
--
-- 'statusMessage', 'reservedInstancesListing_statusMessage' - The reason for the current status of the Reserved Instance listing. The
-- response can be blank.
--
-- 'tags', 'reservedInstancesListing_tags' - Any tags assigned to the resource.
--
-- 'updateDate', 'reservedInstancesListing_updateDate' - The last modified timestamp of the listing.
newReservedInstancesListing ::
  ReservedInstancesListing
newReservedInstancesListing :: ReservedInstancesListing
newReservedInstancesListing =
  ReservedInstancesListing'
    { $sel:clientToken:ReservedInstancesListing' :: Maybe Text
clientToken =
        forall a. Maybe a
Prelude.Nothing,
      $sel:createDate:ReservedInstancesListing' :: Maybe ISO8601
createDate = forall a. Maybe a
Prelude.Nothing,
      $sel:instanceCounts:ReservedInstancesListing' :: Maybe [InstanceCount]
instanceCounts = forall a. Maybe a
Prelude.Nothing,
      $sel:priceSchedules:ReservedInstancesListing' :: Maybe [PriceSchedule]
priceSchedules = forall a. Maybe a
Prelude.Nothing,
      $sel:reservedInstancesId:ReservedInstancesListing' :: Maybe Text
reservedInstancesId = forall a. Maybe a
Prelude.Nothing,
      $sel:reservedInstancesListingId:ReservedInstancesListing' :: Maybe Text
reservedInstancesListingId = forall a. Maybe a
Prelude.Nothing,
      $sel:status:ReservedInstancesListing' :: Maybe ListingStatus
status = forall a. Maybe a
Prelude.Nothing,
      $sel:statusMessage:ReservedInstancesListing' :: Maybe Text
statusMessage = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:ReservedInstancesListing' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:updateDate:ReservedInstancesListing' :: Maybe ISO8601
updateDate = forall a. Maybe a
Prelude.Nothing
    }

-- | A unique, case-sensitive key supplied by the client to ensure that the
-- request is idempotent. For more information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/APIReference/Run_Instance_Idempotency.html Ensuring Idempotency>.
reservedInstancesListing_clientToken :: Lens.Lens' ReservedInstancesListing (Prelude.Maybe Prelude.Text)
reservedInstancesListing_clientToken :: Lens' ReservedInstancesListing (Maybe Text)
reservedInstancesListing_clientToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ReservedInstancesListing' {Maybe Text
clientToken :: Maybe Text
$sel:clientToken:ReservedInstancesListing' :: ReservedInstancesListing -> Maybe Text
clientToken} -> Maybe Text
clientToken) (\s :: ReservedInstancesListing
s@ReservedInstancesListing' {} Maybe Text
a -> ReservedInstancesListing
s {$sel:clientToken:ReservedInstancesListing' :: Maybe Text
clientToken = Maybe Text
a} :: ReservedInstancesListing)

-- | The time the listing was created.
reservedInstancesListing_createDate :: Lens.Lens' ReservedInstancesListing (Prelude.Maybe Prelude.UTCTime)
reservedInstancesListing_createDate :: Lens' ReservedInstancesListing (Maybe UTCTime)
reservedInstancesListing_createDate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ReservedInstancesListing' {Maybe ISO8601
createDate :: Maybe ISO8601
$sel:createDate:ReservedInstancesListing' :: ReservedInstancesListing -> Maybe ISO8601
createDate} -> Maybe ISO8601
createDate) (\s :: ReservedInstancesListing
s@ReservedInstancesListing' {} Maybe ISO8601
a -> ReservedInstancesListing
s {$sel:createDate:ReservedInstancesListing' :: Maybe ISO8601
createDate = Maybe ISO8601
a} :: ReservedInstancesListing) 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 (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The number of instances in this state.
reservedInstancesListing_instanceCounts :: Lens.Lens' ReservedInstancesListing (Prelude.Maybe [InstanceCount])
reservedInstancesListing_instanceCounts :: Lens' ReservedInstancesListing (Maybe [InstanceCount])
reservedInstancesListing_instanceCounts = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ReservedInstancesListing' {Maybe [InstanceCount]
instanceCounts :: Maybe [InstanceCount]
$sel:instanceCounts:ReservedInstancesListing' :: ReservedInstancesListing -> Maybe [InstanceCount]
instanceCounts} -> Maybe [InstanceCount]
instanceCounts) (\s :: ReservedInstancesListing
s@ReservedInstancesListing' {} Maybe [InstanceCount]
a -> ReservedInstancesListing
s {$sel:instanceCounts:ReservedInstancesListing' :: Maybe [InstanceCount]
instanceCounts = Maybe [InstanceCount]
a} :: ReservedInstancesListing) 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 price of the Reserved Instance listing.
reservedInstancesListing_priceSchedules :: Lens.Lens' ReservedInstancesListing (Prelude.Maybe [PriceSchedule])
reservedInstancesListing_priceSchedules :: Lens' ReservedInstancesListing (Maybe [PriceSchedule])
reservedInstancesListing_priceSchedules = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ReservedInstancesListing' {Maybe [PriceSchedule]
priceSchedules :: Maybe [PriceSchedule]
$sel:priceSchedules:ReservedInstancesListing' :: ReservedInstancesListing -> Maybe [PriceSchedule]
priceSchedules} -> Maybe [PriceSchedule]
priceSchedules) (\s :: ReservedInstancesListing
s@ReservedInstancesListing' {} Maybe [PriceSchedule]
a -> ReservedInstancesListing
s {$sel:priceSchedules:ReservedInstancesListing' :: Maybe [PriceSchedule]
priceSchedules = Maybe [PriceSchedule]
a} :: ReservedInstancesListing) 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 Reserved Instance.
reservedInstancesListing_reservedInstancesId :: Lens.Lens' ReservedInstancesListing (Prelude.Maybe Prelude.Text)
reservedInstancesListing_reservedInstancesId :: Lens' ReservedInstancesListing (Maybe Text)
reservedInstancesListing_reservedInstancesId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ReservedInstancesListing' {Maybe Text
reservedInstancesId :: Maybe Text
$sel:reservedInstancesId:ReservedInstancesListing' :: ReservedInstancesListing -> Maybe Text
reservedInstancesId} -> Maybe Text
reservedInstancesId) (\s :: ReservedInstancesListing
s@ReservedInstancesListing' {} Maybe Text
a -> ReservedInstancesListing
s {$sel:reservedInstancesId:ReservedInstancesListing' :: Maybe Text
reservedInstancesId = Maybe Text
a} :: ReservedInstancesListing)

-- | The ID of the Reserved Instance listing.
reservedInstancesListing_reservedInstancesListingId :: Lens.Lens' ReservedInstancesListing (Prelude.Maybe Prelude.Text)
reservedInstancesListing_reservedInstancesListingId :: Lens' ReservedInstancesListing (Maybe Text)
reservedInstancesListing_reservedInstancesListingId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ReservedInstancesListing' {Maybe Text
reservedInstancesListingId :: Maybe Text
$sel:reservedInstancesListingId:ReservedInstancesListing' :: ReservedInstancesListing -> Maybe Text
reservedInstancesListingId} -> Maybe Text
reservedInstancesListingId) (\s :: ReservedInstancesListing
s@ReservedInstancesListing' {} Maybe Text
a -> ReservedInstancesListing
s {$sel:reservedInstancesListingId:ReservedInstancesListing' :: Maybe Text
reservedInstancesListingId = Maybe Text
a} :: ReservedInstancesListing)

-- | The status of the Reserved Instance listing.
reservedInstancesListing_status :: Lens.Lens' ReservedInstancesListing (Prelude.Maybe ListingStatus)
reservedInstancesListing_status :: Lens' ReservedInstancesListing (Maybe ListingStatus)
reservedInstancesListing_status = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ReservedInstancesListing' {Maybe ListingStatus
status :: Maybe ListingStatus
$sel:status:ReservedInstancesListing' :: ReservedInstancesListing -> Maybe ListingStatus
status} -> Maybe ListingStatus
status) (\s :: ReservedInstancesListing
s@ReservedInstancesListing' {} Maybe ListingStatus
a -> ReservedInstancesListing
s {$sel:status:ReservedInstancesListing' :: Maybe ListingStatus
status = Maybe ListingStatus
a} :: ReservedInstancesListing)

-- | The reason for the current status of the Reserved Instance listing. The
-- response can be blank.
reservedInstancesListing_statusMessage :: Lens.Lens' ReservedInstancesListing (Prelude.Maybe Prelude.Text)
reservedInstancesListing_statusMessage :: Lens' ReservedInstancesListing (Maybe Text)
reservedInstancesListing_statusMessage = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ReservedInstancesListing' {Maybe Text
statusMessage :: Maybe Text
$sel:statusMessage:ReservedInstancesListing' :: ReservedInstancesListing -> Maybe Text
statusMessage} -> Maybe Text
statusMessage) (\s :: ReservedInstancesListing
s@ReservedInstancesListing' {} Maybe Text
a -> ReservedInstancesListing
s {$sel:statusMessage:ReservedInstancesListing' :: Maybe Text
statusMessage = Maybe Text
a} :: ReservedInstancesListing)

-- | Any tags assigned to the resource.
reservedInstancesListing_tags :: Lens.Lens' ReservedInstancesListing (Prelude.Maybe [Tag])
reservedInstancesListing_tags :: Lens' ReservedInstancesListing (Maybe [Tag])
reservedInstancesListing_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ReservedInstancesListing' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:ReservedInstancesListing' :: ReservedInstancesListing -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: ReservedInstancesListing
s@ReservedInstancesListing' {} Maybe [Tag]
a -> ReservedInstancesListing
s {$sel:tags:ReservedInstancesListing' :: Maybe [Tag]
tags = Maybe [Tag]
a} :: ReservedInstancesListing) 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 last modified timestamp of the listing.
reservedInstancesListing_updateDate :: Lens.Lens' ReservedInstancesListing (Prelude.Maybe Prelude.UTCTime)
reservedInstancesListing_updateDate :: Lens' ReservedInstancesListing (Maybe UTCTime)
reservedInstancesListing_updateDate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ReservedInstancesListing' {Maybe ISO8601
updateDate :: Maybe ISO8601
$sel:updateDate:ReservedInstancesListing' :: ReservedInstancesListing -> Maybe ISO8601
updateDate} -> Maybe ISO8601
updateDate) (\s :: ReservedInstancesListing
s@ReservedInstancesListing' {} Maybe ISO8601
a -> ReservedInstancesListing
s {$sel:updateDate:ReservedInstancesListing' :: Maybe ISO8601
updateDate = Maybe ISO8601
a} :: ReservedInstancesListing) 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 (a :: Format). Iso' (Time a) UTCTime
Data._Time

instance Data.FromXML ReservedInstancesListing where
  parseXML :: [Node] -> Either String ReservedInstancesListing
parseXML [Node]
x =
    Maybe Text
-> Maybe ISO8601
-> Maybe [InstanceCount]
-> Maybe [PriceSchedule]
-> Maybe Text
-> Maybe Text
-> Maybe ListingStatus
-> Maybe Text
-> Maybe [Tag]
-> Maybe ISO8601
-> ReservedInstancesListing
ReservedInstancesListing'
      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
"createDate")
      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
"instanceCounts"
                      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
"priceSchedules"
                      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
"reservedInstancesId")
      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
"reservedInstancesListingId")
      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
"status")
      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
"statusMessage")
      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
"tagSet"
                      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
"updateDate")

instance Prelude.Hashable ReservedInstancesListing where
  hashWithSalt :: Int -> ReservedInstancesListing -> Int
hashWithSalt Int
_salt ReservedInstancesListing' {Maybe [InstanceCount]
Maybe [PriceSchedule]
Maybe [Tag]
Maybe Text
Maybe ISO8601
Maybe ListingStatus
updateDate :: Maybe ISO8601
tags :: Maybe [Tag]
statusMessage :: Maybe Text
status :: Maybe ListingStatus
reservedInstancesListingId :: Maybe Text
reservedInstancesId :: Maybe Text
priceSchedules :: Maybe [PriceSchedule]
instanceCounts :: Maybe [InstanceCount]
createDate :: Maybe ISO8601
clientToken :: Maybe Text
$sel:updateDate:ReservedInstancesListing' :: ReservedInstancesListing -> Maybe ISO8601
$sel:tags:ReservedInstancesListing' :: ReservedInstancesListing -> Maybe [Tag]
$sel:statusMessage:ReservedInstancesListing' :: ReservedInstancesListing -> Maybe Text
$sel:status:ReservedInstancesListing' :: ReservedInstancesListing -> Maybe ListingStatus
$sel:reservedInstancesListingId:ReservedInstancesListing' :: ReservedInstancesListing -> Maybe Text
$sel:reservedInstancesId:ReservedInstancesListing' :: ReservedInstancesListing -> Maybe Text
$sel:priceSchedules:ReservedInstancesListing' :: ReservedInstancesListing -> Maybe [PriceSchedule]
$sel:instanceCounts:ReservedInstancesListing' :: ReservedInstancesListing -> Maybe [InstanceCount]
$sel:createDate:ReservedInstancesListing' :: ReservedInstancesListing -> Maybe ISO8601
$sel:clientToken:ReservedInstancesListing' :: ReservedInstancesListing -> 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 ISO8601
createDate
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [InstanceCount]
instanceCounts
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [PriceSchedule]
priceSchedules
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
reservedInstancesId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
reservedInstancesListingId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ListingStatus
status
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
statusMessage
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Tag]
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ISO8601
updateDate

instance Prelude.NFData ReservedInstancesListing where
  rnf :: ReservedInstancesListing -> ()
rnf ReservedInstancesListing' {Maybe [InstanceCount]
Maybe [PriceSchedule]
Maybe [Tag]
Maybe Text
Maybe ISO8601
Maybe ListingStatus
updateDate :: Maybe ISO8601
tags :: Maybe [Tag]
statusMessage :: Maybe Text
status :: Maybe ListingStatus
reservedInstancesListingId :: Maybe Text
reservedInstancesId :: Maybe Text
priceSchedules :: Maybe [PriceSchedule]
instanceCounts :: Maybe [InstanceCount]
createDate :: Maybe ISO8601
clientToken :: Maybe Text
$sel:updateDate:ReservedInstancesListing' :: ReservedInstancesListing -> Maybe ISO8601
$sel:tags:ReservedInstancesListing' :: ReservedInstancesListing -> Maybe [Tag]
$sel:statusMessage:ReservedInstancesListing' :: ReservedInstancesListing -> Maybe Text
$sel:status:ReservedInstancesListing' :: ReservedInstancesListing -> Maybe ListingStatus
$sel:reservedInstancesListingId:ReservedInstancesListing' :: ReservedInstancesListing -> Maybe Text
$sel:reservedInstancesId:ReservedInstancesListing' :: ReservedInstancesListing -> Maybe Text
$sel:priceSchedules:ReservedInstancesListing' :: ReservedInstancesListing -> Maybe [PriceSchedule]
$sel:instanceCounts:ReservedInstancesListing' :: ReservedInstancesListing -> Maybe [InstanceCount]
$sel:createDate:ReservedInstancesListing' :: ReservedInstancesListing -> Maybe ISO8601
$sel:clientToken:ReservedInstancesListing' :: ReservedInstancesListing -> 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 ISO8601
createDate
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [InstanceCount]
instanceCounts
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [PriceSchedule]
priceSchedules
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
reservedInstancesId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
reservedInstancesListingId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ListingStatus
status
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
statusMessage
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Tag]
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ISO8601
updateDate