{-# 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.CreateReservedInstancesListing
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Creates a listing for Amazon EC2 Standard Reserved Instances to be sold
-- in the Reserved Instance Marketplace. You can submit one Standard
-- Reserved Instance listing at a time. To get a list of your Standard
-- Reserved Instances, you can use the DescribeReservedInstances operation.
--
-- Only Standard Reserved Instances can be sold in the Reserved Instance
-- Marketplace. Convertible Reserved Instances cannot be sold.
--
-- The Reserved Instance Marketplace matches sellers who want to resell
-- Standard 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.
--
-- To sell your Standard Reserved Instances, you must first register as a
-- seller in the Reserved Instance Marketplace. After completing the
-- registration process, you can create a Reserved Instance Marketplace
-- listing of some or all of your Standard Reserved Instances, and specify
-- the upfront price to receive for them. Your Standard Reserved Instance
-- listings then become available for purchase. To view the details of your
-- Standard Reserved Instance listing, you can use the
-- DescribeReservedInstancesListings operation.
--
-- 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.CreateReservedInstancesListing
  ( -- * Creating a Request
    CreateReservedInstancesListing (..),
    newCreateReservedInstancesListing,

    -- * Request Lenses
    createReservedInstancesListing_clientToken,
    createReservedInstancesListing_instanceCount,
    createReservedInstancesListing_priceSchedules,
    createReservedInstancesListing_reservedInstancesId,

    -- * Destructuring the Response
    CreateReservedInstancesListingResponse (..),
    newCreateReservedInstancesListingResponse,

    -- * Response Lenses
    createReservedInstancesListingResponse_reservedInstancesListings,
    createReservedInstancesListingResponse_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 CreateReservedInstancesListing.
--
-- /See:/ 'newCreateReservedInstancesListing' smart constructor.
data CreateReservedInstancesListing = CreateReservedInstancesListing'
  { -- | Unique, case-sensitive identifier you provide to ensure idempotency of
    -- your listings. This helps avoid duplicate listings. For more
    -- information, see
    -- <https://docs.aws.amazon.com/AWSEC2/latest/APIReference/Run_Instance_Idempotency.html Ensuring Idempotency>.
    CreateReservedInstancesListing -> Text
clientToken :: Prelude.Text,
    -- | The number of instances that are a part of a Reserved Instance account
    -- to be listed in the Reserved Instance Marketplace. This number should be
    -- less than or equal to the instance count associated with the Reserved
    -- Instance ID specified in this call.
    CreateReservedInstancesListing -> Int
instanceCount :: Prelude.Int,
    -- | A list specifying the price of the Standard Reserved Instance for each
    -- month remaining in the Reserved Instance term.
    CreateReservedInstancesListing -> [PriceScheduleSpecification]
priceSchedules :: [PriceScheduleSpecification],
    -- | The ID of the active Standard Reserved Instance.
    CreateReservedInstancesListing -> Text
reservedInstancesId :: Prelude.Text
  }
  deriving (CreateReservedInstancesListing
-> CreateReservedInstancesListing -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateReservedInstancesListing
-> CreateReservedInstancesListing -> Bool
$c/= :: CreateReservedInstancesListing
-> CreateReservedInstancesListing -> Bool
== :: CreateReservedInstancesListing
-> CreateReservedInstancesListing -> Bool
$c== :: CreateReservedInstancesListing
-> CreateReservedInstancesListing -> Bool
Prelude.Eq, ReadPrec [CreateReservedInstancesListing]
ReadPrec CreateReservedInstancesListing
Int -> ReadS CreateReservedInstancesListing
ReadS [CreateReservedInstancesListing]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateReservedInstancesListing]
$creadListPrec :: ReadPrec [CreateReservedInstancesListing]
readPrec :: ReadPrec CreateReservedInstancesListing
$creadPrec :: ReadPrec CreateReservedInstancesListing
readList :: ReadS [CreateReservedInstancesListing]
$creadList :: ReadS [CreateReservedInstancesListing]
readsPrec :: Int -> ReadS CreateReservedInstancesListing
$creadsPrec :: Int -> ReadS CreateReservedInstancesListing
Prelude.Read, Int -> CreateReservedInstancesListing -> ShowS
[CreateReservedInstancesListing] -> ShowS
CreateReservedInstancesListing -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateReservedInstancesListing] -> ShowS
$cshowList :: [CreateReservedInstancesListing] -> ShowS
show :: CreateReservedInstancesListing -> String
$cshow :: CreateReservedInstancesListing -> String
showsPrec :: Int -> CreateReservedInstancesListing -> ShowS
$cshowsPrec :: Int -> CreateReservedInstancesListing -> ShowS
Prelude.Show, forall x.
Rep CreateReservedInstancesListing x
-> CreateReservedInstancesListing
forall x.
CreateReservedInstancesListing
-> Rep CreateReservedInstancesListing x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateReservedInstancesListing x
-> CreateReservedInstancesListing
$cfrom :: forall x.
CreateReservedInstancesListing
-> Rep CreateReservedInstancesListing x
Prelude.Generic)

-- |
-- Create a value of 'CreateReservedInstancesListing' 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', 'createReservedInstancesListing_clientToken' - Unique, case-sensitive identifier you provide to ensure idempotency of
-- your listings. This helps avoid duplicate listings. For more
-- information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/APIReference/Run_Instance_Idempotency.html Ensuring Idempotency>.
--
-- 'instanceCount', 'createReservedInstancesListing_instanceCount' - The number of instances that are a part of a Reserved Instance account
-- to be listed in the Reserved Instance Marketplace. This number should be
-- less than or equal to the instance count associated with the Reserved
-- Instance ID specified in this call.
--
-- 'priceSchedules', 'createReservedInstancesListing_priceSchedules' - A list specifying the price of the Standard Reserved Instance for each
-- month remaining in the Reserved Instance term.
--
-- 'reservedInstancesId', 'createReservedInstancesListing_reservedInstancesId' - The ID of the active Standard Reserved Instance.
newCreateReservedInstancesListing ::
  -- | 'clientToken'
  Prelude.Text ->
  -- | 'instanceCount'
  Prelude.Int ->
  -- | 'reservedInstancesId'
  Prelude.Text ->
  CreateReservedInstancesListing
newCreateReservedInstancesListing :: Text -> Int -> Text -> CreateReservedInstancesListing
newCreateReservedInstancesListing
  Text
pClientToken_
  Int
pInstanceCount_
  Text
pReservedInstancesId_ =
    CreateReservedInstancesListing'
      { $sel:clientToken:CreateReservedInstancesListing' :: Text
clientToken =
          Text
pClientToken_,
        $sel:instanceCount:CreateReservedInstancesListing' :: Int
instanceCount = Int
pInstanceCount_,
        $sel:priceSchedules:CreateReservedInstancesListing' :: [PriceScheduleSpecification]
priceSchedules = forall a. Monoid a => a
Prelude.mempty,
        $sel:reservedInstancesId:CreateReservedInstancesListing' :: Text
reservedInstancesId = Text
pReservedInstancesId_
      }

-- | Unique, case-sensitive identifier you provide to ensure idempotency of
-- your listings. This helps avoid duplicate listings. For more
-- information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/APIReference/Run_Instance_Idempotency.html Ensuring Idempotency>.
createReservedInstancesListing_clientToken :: Lens.Lens' CreateReservedInstancesListing Prelude.Text
createReservedInstancesListing_clientToken :: Lens' CreateReservedInstancesListing Text
createReservedInstancesListing_clientToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateReservedInstancesListing' {Text
clientToken :: Text
$sel:clientToken:CreateReservedInstancesListing' :: CreateReservedInstancesListing -> Text
clientToken} -> Text
clientToken) (\s :: CreateReservedInstancesListing
s@CreateReservedInstancesListing' {} Text
a -> CreateReservedInstancesListing
s {$sel:clientToken:CreateReservedInstancesListing' :: Text
clientToken = Text
a} :: CreateReservedInstancesListing)

-- | The number of instances that are a part of a Reserved Instance account
-- to be listed in the Reserved Instance Marketplace. This number should be
-- less than or equal to the instance count associated with the Reserved
-- Instance ID specified in this call.
createReservedInstancesListing_instanceCount :: Lens.Lens' CreateReservedInstancesListing Prelude.Int
createReservedInstancesListing_instanceCount :: Lens' CreateReservedInstancesListing Int
createReservedInstancesListing_instanceCount = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateReservedInstancesListing' {Int
instanceCount :: Int
$sel:instanceCount:CreateReservedInstancesListing' :: CreateReservedInstancesListing -> Int
instanceCount} -> Int
instanceCount) (\s :: CreateReservedInstancesListing
s@CreateReservedInstancesListing' {} Int
a -> CreateReservedInstancesListing
s {$sel:instanceCount:CreateReservedInstancesListing' :: Int
instanceCount = Int
a} :: CreateReservedInstancesListing)

-- | A list specifying the price of the Standard Reserved Instance for each
-- month remaining in the Reserved Instance term.
createReservedInstancesListing_priceSchedules :: Lens.Lens' CreateReservedInstancesListing [PriceScheduleSpecification]
createReservedInstancesListing_priceSchedules :: Lens' CreateReservedInstancesListing [PriceScheduleSpecification]
createReservedInstancesListing_priceSchedules = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateReservedInstancesListing' {[PriceScheduleSpecification]
priceSchedules :: [PriceScheduleSpecification]
$sel:priceSchedules:CreateReservedInstancesListing' :: CreateReservedInstancesListing -> [PriceScheduleSpecification]
priceSchedules} -> [PriceScheduleSpecification]
priceSchedules) (\s :: CreateReservedInstancesListing
s@CreateReservedInstancesListing' {} [PriceScheduleSpecification]
a -> CreateReservedInstancesListing
s {$sel:priceSchedules:CreateReservedInstancesListing' :: [PriceScheduleSpecification]
priceSchedules = [PriceScheduleSpecification]
a} :: CreateReservedInstancesListing) 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 active Standard Reserved Instance.
createReservedInstancesListing_reservedInstancesId :: Lens.Lens' CreateReservedInstancesListing Prelude.Text
createReservedInstancesListing_reservedInstancesId :: Lens' CreateReservedInstancesListing Text
createReservedInstancesListing_reservedInstancesId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateReservedInstancesListing' {Text
reservedInstancesId :: Text
$sel:reservedInstancesId:CreateReservedInstancesListing' :: CreateReservedInstancesListing -> Text
reservedInstancesId} -> Text
reservedInstancesId) (\s :: CreateReservedInstancesListing
s@CreateReservedInstancesListing' {} Text
a -> CreateReservedInstancesListing
s {$sel:reservedInstancesId:CreateReservedInstancesListing' :: Text
reservedInstancesId = Text
a} :: CreateReservedInstancesListing)

instance
  Core.AWSRequest
    CreateReservedInstancesListing
  where
  type
    AWSResponse CreateReservedInstancesListing =
      CreateReservedInstancesListingResponse
  request :: (Service -> Service)
-> CreateReservedInstancesListing
-> Request CreateReservedInstancesListing
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 CreateReservedInstancesListing
-> ClientResponse ClientBody
-> m (Either
        Error
        (ClientResponse (AWSResponse CreateReservedInstancesListing)))
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 -> CreateReservedInstancesListingResponse
CreateReservedInstancesListingResponse'
            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
    CreateReservedInstancesListing
  where
  hashWithSalt :: Int -> CreateReservedInstancesListing -> Int
hashWithSalt
    Int
_salt
    CreateReservedInstancesListing' {Int
[PriceScheduleSpecification]
Text
reservedInstancesId :: Text
priceSchedules :: [PriceScheduleSpecification]
instanceCount :: Int
clientToken :: Text
$sel:reservedInstancesId:CreateReservedInstancesListing' :: CreateReservedInstancesListing -> Text
$sel:priceSchedules:CreateReservedInstancesListing' :: CreateReservedInstancesListing -> [PriceScheduleSpecification]
$sel:instanceCount:CreateReservedInstancesListing' :: CreateReservedInstancesListing -> Int
$sel:clientToken:CreateReservedInstancesListing' :: CreateReservedInstancesListing -> Text
..} =
      Int
_salt
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
clientToken
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Int
instanceCount
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` [PriceScheduleSpecification]
priceSchedules
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
reservedInstancesId

instance
  Prelude.NFData
    CreateReservedInstancesListing
  where
  rnf :: CreateReservedInstancesListing -> ()
rnf CreateReservedInstancesListing' {Int
[PriceScheduleSpecification]
Text
reservedInstancesId :: Text
priceSchedules :: [PriceScheduleSpecification]
instanceCount :: Int
clientToken :: Text
$sel:reservedInstancesId:CreateReservedInstancesListing' :: CreateReservedInstancesListing -> Text
$sel:priceSchedules:CreateReservedInstancesListing' :: CreateReservedInstancesListing -> [PriceScheduleSpecification]
$sel:instanceCount:CreateReservedInstancesListing' :: CreateReservedInstancesListing -> Int
$sel:clientToken:CreateReservedInstancesListing' :: CreateReservedInstancesListing -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
clientToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
instanceCount
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf [PriceScheduleSpecification]
priceSchedules
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
reservedInstancesId

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

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

instance Data.ToQuery CreateReservedInstancesListing where
  toQuery :: CreateReservedInstancesListing -> QueryString
toQuery CreateReservedInstancesListing' {Int
[PriceScheduleSpecification]
Text
reservedInstancesId :: Text
priceSchedules :: [PriceScheduleSpecification]
instanceCount :: Int
clientToken :: Text
$sel:reservedInstancesId:CreateReservedInstancesListing' :: CreateReservedInstancesListing -> Text
$sel:priceSchedules:CreateReservedInstancesListing' :: CreateReservedInstancesListing -> [PriceScheduleSpecification]
$sel:instanceCount:CreateReservedInstancesListing' :: CreateReservedInstancesListing -> Int
$sel:clientToken:CreateReservedInstancesListing' :: CreateReservedInstancesListing -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: ( ByteString
"CreateReservedInstancesListing" ::
                      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.=: Text
clientToken,
        ByteString
"InstanceCount" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Int
instanceCount,
        forall a.
(IsList a, ToQuery (Item a)) =>
ByteString -> a -> QueryString
Data.toQueryList ByteString
"PriceSchedules" [PriceScheduleSpecification]
priceSchedules,
        ByteString
"ReservedInstancesId" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
reservedInstancesId
      ]

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

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

-- | Information about the Standard Reserved Instance listing.
createReservedInstancesListingResponse_reservedInstancesListings :: Lens.Lens' CreateReservedInstancesListingResponse (Prelude.Maybe [ReservedInstancesListing])
createReservedInstancesListingResponse_reservedInstancesListings :: Lens'
  CreateReservedInstancesListingResponse
  (Maybe [ReservedInstancesListing])
createReservedInstancesListingResponse_reservedInstancesListings = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateReservedInstancesListingResponse' {Maybe [ReservedInstancesListing]
reservedInstancesListings :: Maybe [ReservedInstancesListing]
$sel:reservedInstancesListings:CreateReservedInstancesListingResponse' :: CreateReservedInstancesListingResponse
-> Maybe [ReservedInstancesListing]
reservedInstancesListings} -> Maybe [ReservedInstancesListing]
reservedInstancesListings) (\s :: CreateReservedInstancesListingResponse
s@CreateReservedInstancesListingResponse' {} Maybe [ReservedInstancesListing]
a -> CreateReservedInstancesListingResponse
s {$sel:reservedInstancesListings:CreateReservedInstancesListingResponse' :: Maybe [ReservedInstancesListing]
reservedInstancesListings = Maybe [ReservedInstancesListing]
a} :: CreateReservedInstancesListingResponse) 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.
createReservedInstancesListingResponse_httpStatus :: Lens.Lens' CreateReservedInstancesListingResponse Prelude.Int
createReservedInstancesListingResponse_httpStatus :: Lens' CreateReservedInstancesListingResponse Int
createReservedInstancesListingResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateReservedInstancesListingResponse' {Int
httpStatus :: Int
$sel:httpStatus:CreateReservedInstancesListingResponse' :: CreateReservedInstancesListingResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: CreateReservedInstancesListingResponse
s@CreateReservedInstancesListingResponse' {} Int
a -> CreateReservedInstancesListingResponse
s {$sel:httpStatus:CreateReservedInstancesListingResponse' :: Int
httpStatus = Int
a} :: CreateReservedInstancesListingResponse)

instance
  Prelude.NFData
    CreateReservedInstancesListingResponse
  where
  rnf :: CreateReservedInstancesListingResponse -> ()
rnf CreateReservedInstancesListingResponse' {Int
Maybe [ReservedInstancesListing]
httpStatus :: Int
reservedInstancesListings :: Maybe [ReservedInstancesListing]
$sel:httpStatus:CreateReservedInstancesListingResponse' :: CreateReservedInstancesListingResponse -> Int
$sel:reservedInstancesListings:CreateReservedInstancesListingResponse' :: CreateReservedInstancesListingResponse
-> 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