{-# 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.DescribeReservedInstancesListings
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Describes your account\'s Reserved Instance listings in the Reserved
-- Instance Marketplace.
--
-- The Reserved Instance Marketplace matches sellers who want to resell
-- Reserved Instance capacity that they no longer need with buyers who want
-- to purchase additional capacity. Reserved Instances bought and sold
-- through the Reserved Instance Marketplace work like any other Reserved
-- Instances.
--
-- As a seller, you choose to list some or all of your Reserved Instances,
-- and you specify the upfront price to receive for them. Your Reserved
-- Instances are then listed in the Reserved Instance Marketplace and are
-- available for purchase.
--
-- As a buyer, you specify the configuration of the Reserved Instance to
-- purchase, and the Marketplace matches what you\'re searching for with
-- what\'s available. The Marketplace first sells the lowest priced
-- Reserved Instances to you, and continues to sell available Reserved
-- Instance listings to you until your demand is met. You are charged based
-- on the total price of all of the listings that you purchase.
--
-- For more information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/ri-market-general.html Reserved Instance Marketplace>
-- in the /Amazon EC2 User Guide/.
module Amazonka.EC2.DescribeReservedInstancesListings
  ( -- * Creating a Request
    DescribeReservedInstancesListings (..),
    newDescribeReservedInstancesListings,

    -- * Request Lenses
    describeReservedInstancesListings_filters,
    describeReservedInstancesListings_reservedInstancesId,
    describeReservedInstancesListings_reservedInstancesListingId,

    -- * Destructuring the Response
    DescribeReservedInstancesListingsResponse (..),
    newDescribeReservedInstancesListingsResponse,

    -- * Response Lenses
    describeReservedInstancesListingsResponse_reservedInstancesListings,
    describeReservedInstancesListingsResponse_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

-- | Contains the parameters for DescribeReservedInstancesListings.
--
-- /See:/ 'newDescribeReservedInstancesListings' smart constructor.
data DescribeReservedInstancesListings = DescribeReservedInstancesListings'
  { -- | One or more filters.
    --
    -- -   @reserved-instances-id@ - The ID of the Reserved Instances.
    --
    -- -   @reserved-instances-listing-id@ - The ID of the Reserved Instances
    --     listing.
    --
    -- -   @status@ - The status of the Reserved Instance listing (@pending@ |
    --     @active@ | @cancelled@ | @closed@).
    --
    -- -   @status-message@ - The reason for the status.
    DescribeReservedInstancesListings -> Maybe [Filter]
filters :: Prelude.Maybe [Filter],
    -- | One or more Reserved Instance IDs.
    DescribeReservedInstancesListings -> Maybe Text
reservedInstancesId :: Prelude.Maybe Prelude.Text,
    -- | One or more Reserved Instance listing IDs.
    DescribeReservedInstancesListings -> Maybe Text
reservedInstancesListingId :: Prelude.Maybe Prelude.Text
  }
  deriving (DescribeReservedInstancesListings
-> DescribeReservedInstancesListings -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeReservedInstancesListings
-> DescribeReservedInstancesListings -> Bool
$c/= :: DescribeReservedInstancesListings
-> DescribeReservedInstancesListings -> Bool
== :: DescribeReservedInstancesListings
-> DescribeReservedInstancesListings -> Bool
$c== :: DescribeReservedInstancesListings
-> DescribeReservedInstancesListings -> Bool
Prelude.Eq, ReadPrec [DescribeReservedInstancesListings]
ReadPrec DescribeReservedInstancesListings
Int -> ReadS DescribeReservedInstancesListings
ReadS [DescribeReservedInstancesListings]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeReservedInstancesListings]
$creadListPrec :: ReadPrec [DescribeReservedInstancesListings]
readPrec :: ReadPrec DescribeReservedInstancesListings
$creadPrec :: ReadPrec DescribeReservedInstancesListings
readList :: ReadS [DescribeReservedInstancesListings]
$creadList :: ReadS [DescribeReservedInstancesListings]
readsPrec :: Int -> ReadS DescribeReservedInstancesListings
$creadsPrec :: Int -> ReadS DescribeReservedInstancesListings
Prelude.Read, Int -> DescribeReservedInstancesListings -> ShowS
[DescribeReservedInstancesListings] -> ShowS
DescribeReservedInstancesListings -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeReservedInstancesListings] -> ShowS
$cshowList :: [DescribeReservedInstancesListings] -> ShowS
show :: DescribeReservedInstancesListings -> String
$cshow :: DescribeReservedInstancesListings -> String
showsPrec :: Int -> DescribeReservedInstancesListings -> ShowS
$cshowsPrec :: Int -> DescribeReservedInstancesListings -> ShowS
Prelude.Show, forall x.
Rep DescribeReservedInstancesListings x
-> DescribeReservedInstancesListings
forall x.
DescribeReservedInstancesListings
-> Rep DescribeReservedInstancesListings x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DescribeReservedInstancesListings x
-> DescribeReservedInstancesListings
$cfrom :: forall x.
DescribeReservedInstancesListings
-> Rep DescribeReservedInstancesListings x
Prelude.Generic)

-- |
-- Create a value of 'DescribeReservedInstancesListings' 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:
--
-- 'filters', 'describeReservedInstancesListings_filters' - One or more filters.
--
-- -   @reserved-instances-id@ - The ID of the Reserved Instances.
--
-- -   @reserved-instances-listing-id@ - The ID of the Reserved Instances
--     listing.
--
-- -   @status@ - The status of the Reserved Instance listing (@pending@ |
--     @active@ | @cancelled@ | @closed@).
--
-- -   @status-message@ - The reason for the status.
--
-- 'reservedInstancesId', 'describeReservedInstancesListings_reservedInstancesId' - One or more Reserved Instance IDs.
--
-- 'reservedInstancesListingId', 'describeReservedInstancesListings_reservedInstancesListingId' - One or more Reserved Instance listing IDs.
newDescribeReservedInstancesListings ::
  DescribeReservedInstancesListings
newDescribeReservedInstancesListings :: DescribeReservedInstancesListings
newDescribeReservedInstancesListings =
  DescribeReservedInstancesListings'
    { $sel:filters:DescribeReservedInstancesListings' :: Maybe [Filter]
filters =
        forall a. Maybe a
Prelude.Nothing,
      $sel:reservedInstancesId:DescribeReservedInstancesListings' :: Maybe Text
reservedInstancesId = forall a. Maybe a
Prelude.Nothing,
      $sel:reservedInstancesListingId:DescribeReservedInstancesListings' :: Maybe Text
reservedInstancesListingId =
        forall a. Maybe a
Prelude.Nothing
    }

-- | One or more filters.
--
-- -   @reserved-instances-id@ - The ID of the Reserved Instances.
--
-- -   @reserved-instances-listing-id@ - The ID of the Reserved Instances
--     listing.
--
-- -   @status@ - The status of the Reserved Instance listing (@pending@ |
--     @active@ | @cancelled@ | @closed@).
--
-- -   @status-message@ - The reason for the status.
describeReservedInstancesListings_filters :: Lens.Lens' DescribeReservedInstancesListings (Prelude.Maybe [Filter])
describeReservedInstancesListings_filters :: Lens' DescribeReservedInstancesListings (Maybe [Filter])
describeReservedInstancesListings_filters = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeReservedInstancesListings' {Maybe [Filter]
filters :: Maybe [Filter]
$sel:filters:DescribeReservedInstancesListings' :: DescribeReservedInstancesListings -> Maybe [Filter]
filters} -> Maybe [Filter]
filters) (\s :: DescribeReservedInstancesListings
s@DescribeReservedInstancesListings' {} Maybe [Filter]
a -> DescribeReservedInstancesListings
s {$sel:filters:DescribeReservedInstancesListings' :: Maybe [Filter]
filters = Maybe [Filter]
a} :: DescribeReservedInstancesListings) 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

-- | One or more Reserved Instance IDs.
describeReservedInstancesListings_reservedInstancesId :: Lens.Lens' DescribeReservedInstancesListings (Prelude.Maybe Prelude.Text)
describeReservedInstancesListings_reservedInstancesId :: Lens' DescribeReservedInstancesListings (Maybe Text)
describeReservedInstancesListings_reservedInstancesId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeReservedInstancesListings' {Maybe Text
reservedInstancesId :: Maybe Text
$sel:reservedInstancesId:DescribeReservedInstancesListings' :: DescribeReservedInstancesListings -> Maybe Text
reservedInstancesId} -> Maybe Text
reservedInstancesId) (\s :: DescribeReservedInstancesListings
s@DescribeReservedInstancesListings' {} Maybe Text
a -> DescribeReservedInstancesListings
s {$sel:reservedInstancesId:DescribeReservedInstancesListings' :: Maybe Text
reservedInstancesId = Maybe Text
a} :: DescribeReservedInstancesListings)

-- | One or more Reserved Instance listing IDs.
describeReservedInstancesListings_reservedInstancesListingId :: Lens.Lens' DescribeReservedInstancesListings (Prelude.Maybe Prelude.Text)
describeReservedInstancesListings_reservedInstancesListingId :: Lens' DescribeReservedInstancesListings (Maybe Text)
describeReservedInstancesListings_reservedInstancesListingId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeReservedInstancesListings' {Maybe Text
reservedInstancesListingId :: Maybe Text
$sel:reservedInstancesListingId:DescribeReservedInstancesListings' :: DescribeReservedInstancesListings -> Maybe Text
reservedInstancesListingId} -> Maybe Text
reservedInstancesListingId) (\s :: DescribeReservedInstancesListings
s@DescribeReservedInstancesListings' {} Maybe Text
a -> DescribeReservedInstancesListings
s {$sel:reservedInstancesListingId:DescribeReservedInstancesListings' :: Maybe Text
reservedInstancesListingId = Maybe Text
a} :: DescribeReservedInstancesListings)

instance
  Core.AWSRequest
    DescribeReservedInstancesListings
  where
  type
    AWSResponse DescribeReservedInstancesListings =
      DescribeReservedInstancesListingsResponse
  request :: (Service -> Service)
-> DescribeReservedInstancesListings
-> Request DescribeReservedInstancesListings
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 DescribeReservedInstancesListings
-> ClientResponse ClientBody
-> m (Either
        Error
        (ClientResponse (AWSResponse DescribeReservedInstancesListings)))
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 [ReservedInstancesListing]
-> Int -> DescribeReservedInstancesListingsResponse
DescribeReservedInstancesListingsResponse'
            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
"reservedInstancesListingsSet"
                            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.<*> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
      )

instance
  Prelude.Hashable
    DescribeReservedInstancesListings
  where
  hashWithSalt :: Int -> DescribeReservedInstancesListings -> Int
hashWithSalt
    Int
_salt
    DescribeReservedInstancesListings' {Maybe [Filter]
Maybe Text
reservedInstancesListingId :: Maybe Text
reservedInstancesId :: Maybe Text
filters :: Maybe [Filter]
$sel:reservedInstancesListingId:DescribeReservedInstancesListings' :: DescribeReservedInstancesListings -> Maybe Text
$sel:reservedInstancesId:DescribeReservedInstancesListings' :: DescribeReservedInstancesListings -> Maybe Text
$sel:filters:DescribeReservedInstancesListings' :: DescribeReservedInstancesListings -> Maybe [Filter]
..} =
      Int
_salt
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Filter]
filters
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
reservedInstancesId
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
reservedInstancesListingId

instance
  Prelude.NFData
    DescribeReservedInstancesListings
  where
  rnf :: DescribeReservedInstancesListings -> ()
rnf DescribeReservedInstancesListings' {Maybe [Filter]
Maybe Text
reservedInstancesListingId :: Maybe Text
reservedInstancesId :: Maybe Text
filters :: Maybe [Filter]
$sel:reservedInstancesListingId:DescribeReservedInstancesListings' :: DescribeReservedInstancesListings -> Maybe Text
$sel:reservedInstancesId:DescribeReservedInstancesListings' :: DescribeReservedInstancesListings -> Maybe Text
$sel:filters:DescribeReservedInstancesListings' :: DescribeReservedInstancesListings -> Maybe [Filter]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [Filter]
filters
      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

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

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

instance
  Data.ToQuery
    DescribeReservedInstancesListings
  where
  toQuery :: DescribeReservedInstancesListings -> QueryString
toQuery DescribeReservedInstancesListings' {Maybe [Filter]
Maybe Text
reservedInstancesListingId :: Maybe Text
reservedInstancesId :: Maybe Text
filters :: Maybe [Filter]
$sel:reservedInstancesListingId:DescribeReservedInstancesListings' :: DescribeReservedInstancesListings -> Maybe Text
$sel:reservedInstancesId:DescribeReservedInstancesListings' :: DescribeReservedInstancesListings -> Maybe Text
$sel:filters:DescribeReservedInstancesListings' :: DescribeReservedInstancesListings -> Maybe [Filter]
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: ( ByteString
"DescribeReservedInstancesListings" ::
                      Prelude.ByteString
                  ),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2016-11-15" :: Prelude.ByteString),
        forall a. ToQuery a => a -> QueryString
Data.toQuery
          (forall a.
(IsList a, ToQuery (Item a)) =>
ByteString -> a -> QueryString
Data.toQueryList ByteString
"Filter" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [Filter]
filters),
        ByteString
"ReservedInstancesId" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
reservedInstancesId,
        ByteString
"ReservedInstancesListingId"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
reservedInstancesListingId
      ]

-- | Contains the output of DescribeReservedInstancesListings.
--
-- /See:/ 'newDescribeReservedInstancesListingsResponse' smart constructor.
data DescribeReservedInstancesListingsResponse = DescribeReservedInstancesListingsResponse'
  { -- | Information about the Reserved Instance listing.
    DescribeReservedInstancesListingsResponse
-> Maybe [ReservedInstancesListing]
reservedInstancesListings :: Prelude.Maybe [ReservedInstancesListing],
    -- | The response's http status code.
    DescribeReservedInstancesListingsResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (DescribeReservedInstancesListingsResponse
-> DescribeReservedInstancesListingsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeReservedInstancesListingsResponse
-> DescribeReservedInstancesListingsResponse -> Bool
$c/= :: DescribeReservedInstancesListingsResponse
-> DescribeReservedInstancesListingsResponse -> Bool
== :: DescribeReservedInstancesListingsResponse
-> DescribeReservedInstancesListingsResponse -> Bool
$c== :: DescribeReservedInstancesListingsResponse
-> DescribeReservedInstancesListingsResponse -> Bool
Prelude.Eq, ReadPrec [DescribeReservedInstancesListingsResponse]
ReadPrec DescribeReservedInstancesListingsResponse
Int -> ReadS DescribeReservedInstancesListingsResponse
ReadS [DescribeReservedInstancesListingsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeReservedInstancesListingsResponse]
$creadListPrec :: ReadPrec [DescribeReservedInstancesListingsResponse]
readPrec :: ReadPrec DescribeReservedInstancesListingsResponse
$creadPrec :: ReadPrec DescribeReservedInstancesListingsResponse
readList :: ReadS [DescribeReservedInstancesListingsResponse]
$creadList :: ReadS [DescribeReservedInstancesListingsResponse]
readsPrec :: Int -> ReadS DescribeReservedInstancesListingsResponse
$creadsPrec :: Int -> ReadS DescribeReservedInstancesListingsResponse
Prelude.Read, Int -> DescribeReservedInstancesListingsResponse -> ShowS
[DescribeReservedInstancesListingsResponse] -> ShowS
DescribeReservedInstancesListingsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeReservedInstancesListingsResponse] -> ShowS
$cshowList :: [DescribeReservedInstancesListingsResponse] -> ShowS
show :: DescribeReservedInstancesListingsResponse -> String
$cshow :: DescribeReservedInstancesListingsResponse -> String
showsPrec :: Int -> DescribeReservedInstancesListingsResponse -> ShowS
$cshowsPrec :: Int -> DescribeReservedInstancesListingsResponse -> ShowS
Prelude.Show, forall x.
Rep DescribeReservedInstancesListingsResponse x
-> DescribeReservedInstancesListingsResponse
forall x.
DescribeReservedInstancesListingsResponse
-> Rep DescribeReservedInstancesListingsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DescribeReservedInstancesListingsResponse x
-> DescribeReservedInstancesListingsResponse
$cfrom :: forall x.
DescribeReservedInstancesListingsResponse
-> Rep DescribeReservedInstancesListingsResponse x
Prelude.Generic)

-- |
-- Create a value of 'DescribeReservedInstancesListingsResponse' 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:
--
-- 'reservedInstancesListings', 'describeReservedInstancesListingsResponse_reservedInstancesListings' - Information about the Reserved Instance listing.
--
-- 'httpStatus', 'describeReservedInstancesListingsResponse_httpStatus' - The response's http status code.
newDescribeReservedInstancesListingsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DescribeReservedInstancesListingsResponse
newDescribeReservedInstancesListingsResponse :: Int -> DescribeReservedInstancesListingsResponse
newDescribeReservedInstancesListingsResponse
  Int
pHttpStatus_ =
    DescribeReservedInstancesListingsResponse'
      { $sel:reservedInstancesListings:DescribeReservedInstancesListingsResponse' :: Maybe [ReservedInstancesListing]
reservedInstancesListings =
          forall a. Maybe a
Prelude.Nothing,
        $sel:httpStatus:DescribeReservedInstancesListingsResponse' :: Int
httpStatus = Int
pHttpStatus_
      }

-- | Information about the Reserved Instance listing.
describeReservedInstancesListingsResponse_reservedInstancesListings :: Lens.Lens' DescribeReservedInstancesListingsResponse (Prelude.Maybe [ReservedInstancesListing])
describeReservedInstancesListingsResponse_reservedInstancesListings :: Lens'
  DescribeReservedInstancesListingsResponse
  (Maybe [ReservedInstancesListing])
describeReservedInstancesListingsResponse_reservedInstancesListings = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeReservedInstancesListingsResponse' {Maybe [ReservedInstancesListing]
reservedInstancesListings :: Maybe [ReservedInstancesListing]
$sel:reservedInstancesListings:DescribeReservedInstancesListingsResponse' :: DescribeReservedInstancesListingsResponse
-> Maybe [ReservedInstancesListing]
reservedInstancesListings} -> Maybe [ReservedInstancesListing]
reservedInstancesListings) (\s :: DescribeReservedInstancesListingsResponse
s@DescribeReservedInstancesListingsResponse' {} Maybe [ReservedInstancesListing]
a -> DescribeReservedInstancesListingsResponse
s {$sel:reservedInstancesListings:DescribeReservedInstancesListingsResponse' :: Maybe [ReservedInstancesListing]
reservedInstancesListings = Maybe [ReservedInstancesListing]
a} :: DescribeReservedInstancesListingsResponse) 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 response's http status code.
describeReservedInstancesListingsResponse_httpStatus :: Lens.Lens' DescribeReservedInstancesListingsResponse Prelude.Int
describeReservedInstancesListingsResponse_httpStatus :: Lens' DescribeReservedInstancesListingsResponse Int
describeReservedInstancesListingsResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeReservedInstancesListingsResponse' {Int
httpStatus :: Int
$sel:httpStatus:DescribeReservedInstancesListingsResponse' :: DescribeReservedInstancesListingsResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: DescribeReservedInstancesListingsResponse
s@DescribeReservedInstancesListingsResponse' {} Int
a -> DescribeReservedInstancesListingsResponse
s {$sel:httpStatus:DescribeReservedInstancesListingsResponse' :: Int
httpStatus = Int
a} :: DescribeReservedInstancesListingsResponse)

instance
  Prelude.NFData
    DescribeReservedInstancesListingsResponse
  where
  rnf :: DescribeReservedInstancesListingsResponse -> ()
rnf DescribeReservedInstancesListingsResponse' {Int
Maybe [ReservedInstancesListing]
httpStatus :: Int
reservedInstancesListings :: Maybe [ReservedInstancesListing]
$sel:httpStatus:DescribeReservedInstancesListingsResponse' :: DescribeReservedInstancesListingsResponse -> Int
$sel:reservedInstancesListings:DescribeReservedInstancesListingsResponse' :: DescribeReservedInstancesListingsResponse
-> Maybe [ReservedInstancesListing]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [ReservedInstancesListing]
reservedInstancesListings
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus