{-# 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.CostExplorer.GetSavingsPlansPurchaseRecommendation
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Retrieves the Savings Plans recommendations for your account. First use
-- @StartSavingsPlansPurchaseRecommendationGeneration@ to generate a new
-- set of recommendations, and then use
-- @GetSavingsPlansPurchaseRecommendation@ to retrieve them.
module Amazonka.CostExplorer.GetSavingsPlansPurchaseRecommendation
  ( -- * Creating a Request
    GetSavingsPlansPurchaseRecommendation (..),
    newGetSavingsPlansPurchaseRecommendation,

    -- * Request Lenses
    getSavingsPlansPurchaseRecommendation_accountScope,
    getSavingsPlansPurchaseRecommendation_filter,
    getSavingsPlansPurchaseRecommendation_nextPageToken,
    getSavingsPlansPurchaseRecommendation_pageSize,
    getSavingsPlansPurchaseRecommendation_savingsPlansType,
    getSavingsPlansPurchaseRecommendation_termInYears,
    getSavingsPlansPurchaseRecommendation_paymentOption,
    getSavingsPlansPurchaseRecommendation_lookbackPeriodInDays,

    -- * Destructuring the Response
    GetSavingsPlansPurchaseRecommendationResponse (..),
    newGetSavingsPlansPurchaseRecommendationResponse,

    -- * Response Lenses
    getSavingsPlansPurchaseRecommendationResponse_metadata,
    getSavingsPlansPurchaseRecommendationResponse_nextPageToken,
    getSavingsPlansPurchaseRecommendationResponse_savingsPlansPurchaseRecommendation,
    getSavingsPlansPurchaseRecommendationResponse_httpStatus,
  )
where

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

-- | /See:/ 'newGetSavingsPlansPurchaseRecommendation' smart constructor.
data GetSavingsPlansPurchaseRecommendation = GetSavingsPlansPurchaseRecommendation'
  { -- | The account scope that you want your recommendations for. Amazon Web
    -- Services calculates recommendations including the management account and
    -- member accounts if the value is set to @PAYER@. If the value is
    -- @LINKED@, recommendations are calculated for individual member accounts
    -- only.
    GetSavingsPlansPurchaseRecommendation -> Maybe AccountScope
accountScope :: Prelude.Maybe AccountScope,
    -- | You can filter your recommendations by Account ID with the
    -- @LINKED_ACCOUNT@ dimension. To filter your recommendations by Account
    -- ID, specify @Key@ as @LINKED_ACCOUNT@ and @Value@ as the comma-separated
    -- Acount ID(s) that you want to see Savings Plans purchase recommendations
    -- for.
    --
    -- For GetSavingsPlansPurchaseRecommendation, the @Filter@ doesn\'t include
    -- @CostCategories@ or @Tags@. It only includes @Dimensions@. With
    -- @Dimensions@, @Key@ must be @LINKED_ACCOUNT@ and @Value@ can be a single
    -- Account ID or multiple comma-separated Account IDs that you want to see
    -- Savings Plans Purchase Recommendations for. @AND@ and @OR@ operators are
    -- not supported.
    GetSavingsPlansPurchaseRecommendation -> Maybe Expression
filter' :: Prelude.Maybe Expression,
    -- | The token to retrieve the next set of results. Amazon Web Services
    -- provides the token when the response from a previous call has more
    -- results than the maximum page size.
    GetSavingsPlansPurchaseRecommendation -> Maybe Text
nextPageToken :: Prelude.Maybe Prelude.Text,
    -- | The number of recommendations that you want returned in a single
    -- response object.
    GetSavingsPlansPurchaseRecommendation -> Maybe Natural
pageSize :: Prelude.Maybe Prelude.Natural,
    -- | The Savings Plans recommendation type that\'s requested.
    GetSavingsPlansPurchaseRecommendation -> SupportedSavingsPlansType
savingsPlansType :: SupportedSavingsPlansType,
    -- | The savings plan recommendation term that\'s used to generate these
    -- recommendations.
    GetSavingsPlansPurchaseRecommendation -> TermInYears
termInYears :: TermInYears,
    -- | The payment option that\'s used to generate these recommendations.
    GetSavingsPlansPurchaseRecommendation -> PaymentOption
paymentOption :: PaymentOption,
    -- | The lookback period that\'s used to generate the recommendation.
    GetSavingsPlansPurchaseRecommendation -> LookbackPeriodInDays
lookbackPeriodInDays :: LookbackPeriodInDays
  }
  deriving (GetSavingsPlansPurchaseRecommendation
-> GetSavingsPlansPurchaseRecommendation -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetSavingsPlansPurchaseRecommendation
-> GetSavingsPlansPurchaseRecommendation -> Bool
$c/= :: GetSavingsPlansPurchaseRecommendation
-> GetSavingsPlansPurchaseRecommendation -> Bool
== :: GetSavingsPlansPurchaseRecommendation
-> GetSavingsPlansPurchaseRecommendation -> Bool
$c== :: GetSavingsPlansPurchaseRecommendation
-> GetSavingsPlansPurchaseRecommendation -> Bool
Prelude.Eq, ReadPrec [GetSavingsPlansPurchaseRecommendation]
ReadPrec GetSavingsPlansPurchaseRecommendation
Int -> ReadS GetSavingsPlansPurchaseRecommendation
ReadS [GetSavingsPlansPurchaseRecommendation]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetSavingsPlansPurchaseRecommendation]
$creadListPrec :: ReadPrec [GetSavingsPlansPurchaseRecommendation]
readPrec :: ReadPrec GetSavingsPlansPurchaseRecommendation
$creadPrec :: ReadPrec GetSavingsPlansPurchaseRecommendation
readList :: ReadS [GetSavingsPlansPurchaseRecommendation]
$creadList :: ReadS [GetSavingsPlansPurchaseRecommendation]
readsPrec :: Int -> ReadS GetSavingsPlansPurchaseRecommendation
$creadsPrec :: Int -> ReadS GetSavingsPlansPurchaseRecommendation
Prelude.Read, Int -> GetSavingsPlansPurchaseRecommendation -> ShowS
[GetSavingsPlansPurchaseRecommendation] -> ShowS
GetSavingsPlansPurchaseRecommendation -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetSavingsPlansPurchaseRecommendation] -> ShowS
$cshowList :: [GetSavingsPlansPurchaseRecommendation] -> ShowS
show :: GetSavingsPlansPurchaseRecommendation -> String
$cshow :: GetSavingsPlansPurchaseRecommendation -> String
showsPrec :: Int -> GetSavingsPlansPurchaseRecommendation -> ShowS
$cshowsPrec :: Int -> GetSavingsPlansPurchaseRecommendation -> ShowS
Prelude.Show, forall x.
Rep GetSavingsPlansPurchaseRecommendation x
-> GetSavingsPlansPurchaseRecommendation
forall x.
GetSavingsPlansPurchaseRecommendation
-> Rep GetSavingsPlansPurchaseRecommendation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetSavingsPlansPurchaseRecommendation x
-> GetSavingsPlansPurchaseRecommendation
$cfrom :: forall x.
GetSavingsPlansPurchaseRecommendation
-> Rep GetSavingsPlansPurchaseRecommendation x
Prelude.Generic)

-- |
-- Create a value of 'GetSavingsPlansPurchaseRecommendation' 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:
--
-- 'accountScope', 'getSavingsPlansPurchaseRecommendation_accountScope' - The account scope that you want your recommendations for. Amazon Web
-- Services calculates recommendations including the management account and
-- member accounts if the value is set to @PAYER@. If the value is
-- @LINKED@, recommendations are calculated for individual member accounts
-- only.
--
-- 'filter'', 'getSavingsPlansPurchaseRecommendation_filter' - You can filter your recommendations by Account ID with the
-- @LINKED_ACCOUNT@ dimension. To filter your recommendations by Account
-- ID, specify @Key@ as @LINKED_ACCOUNT@ and @Value@ as the comma-separated
-- Acount ID(s) that you want to see Savings Plans purchase recommendations
-- for.
--
-- For GetSavingsPlansPurchaseRecommendation, the @Filter@ doesn\'t include
-- @CostCategories@ or @Tags@. It only includes @Dimensions@. With
-- @Dimensions@, @Key@ must be @LINKED_ACCOUNT@ and @Value@ can be a single
-- Account ID or multiple comma-separated Account IDs that you want to see
-- Savings Plans Purchase Recommendations for. @AND@ and @OR@ operators are
-- not supported.
--
-- 'nextPageToken', 'getSavingsPlansPurchaseRecommendation_nextPageToken' - The token to retrieve the next set of results. Amazon Web Services
-- provides the token when the response from a previous call has more
-- results than the maximum page size.
--
-- 'pageSize', 'getSavingsPlansPurchaseRecommendation_pageSize' - The number of recommendations that you want returned in a single
-- response object.
--
-- 'savingsPlansType', 'getSavingsPlansPurchaseRecommendation_savingsPlansType' - The Savings Plans recommendation type that\'s requested.
--
-- 'termInYears', 'getSavingsPlansPurchaseRecommendation_termInYears' - The savings plan recommendation term that\'s used to generate these
-- recommendations.
--
-- 'paymentOption', 'getSavingsPlansPurchaseRecommendation_paymentOption' - The payment option that\'s used to generate these recommendations.
--
-- 'lookbackPeriodInDays', 'getSavingsPlansPurchaseRecommendation_lookbackPeriodInDays' - The lookback period that\'s used to generate the recommendation.
newGetSavingsPlansPurchaseRecommendation ::
  -- | 'savingsPlansType'
  SupportedSavingsPlansType ->
  -- | 'termInYears'
  TermInYears ->
  -- | 'paymentOption'
  PaymentOption ->
  -- | 'lookbackPeriodInDays'
  LookbackPeriodInDays ->
  GetSavingsPlansPurchaseRecommendation
newGetSavingsPlansPurchaseRecommendation :: SupportedSavingsPlansType
-> TermInYears
-> PaymentOption
-> LookbackPeriodInDays
-> GetSavingsPlansPurchaseRecommendation
newGetSavingsPlansPurchaseRecommendation
  SupportedSavingsPlansType
pSavingsPlansType_
  TermInYears
pTermInYears_
  PaymentOption
pPaymentOption_
  LookbackPeriodInDays
pLookbackPeriodInDays_ =
    GetSavingsPlansPurchaseRecommendation'
      { $sel:accountScope:GetSavingsPlansPurchaseRecommendation' :: Maybe AccountScope
accountScope =
          forall a. Maybe a
Prelude.Nothing,
        $sel:filter':GetSavingsPlansPurchaseRecommendation' :: Maybe Expression
filter' = forall a. Maybe a
Prelude.Nothing,
        $sel:nextPageToken:GetSavingsPlansPurchaseRecommendation' :: Maybe Text
nextPageToken = forall a. Maybe a
Prelude.Nothing,
        $sel:pageSize:GetSavingsPlansPurchaseRecommendation' :: Maybe Natural
pageSize = forall a. Maybe a
Prelude.Nothing,
        $sel:savingsPlansType:GetSavingsPlansPurchaseRecommendation' :: SupportedSavingsPlansType
savingsPlansType =
          SupportedSavingsPlansType
pSavingsPlansType_,
        $sel:termInYears:GetSavingsPlansPurchaseRecommendation' :: TermInYears
termInYears = TermInYears
pTermInYears_,
        $sel:paymentOption:GetSavingsPlansPurchaseRecommendation' :: PaymentOption
paymentOption = PaymentOption
pPaymentOption_,
        $sel:lookbackPeriodInDays:GetSavingsPlansPurchaseRecommendation' :: LookbackPeriodInDays
lookbackPeriodInDays =
          LookbackPeriodInDays
pLookbackPeriodInDays_
      }

-- | The account scope that you want your recommendations for. Amazon Web
-- Services calculates recommendations including the management account and
-- member accounts if the value is set to @PAYER@. If the value is
-- @LINKED@, recommendations are calculated for individual member accounts
-- only.
getSavingsPlansPurchaseRecommendation_accountScope :: Lens.Lens' GetSavingsPlansPurchaseRecommendation (Prelude.Maybe AccountScope)
getSavingsPlansPurchaseRecommendation_accountScope :: Lens' GetSavingsPlansPurchaseRecommendation (Maybe AccountScope)
getSavingsPlansPurchaseRecommendation_accountScope = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetSavingsPlansPurchaseRecommendation' {Maybe AccountScope
accountScope :: Maybe AccountScope
$sel:accountScope:GetSavingsPlansPurchaseRecommendation' :: GetSavingsPlansPurchaseRecommendation -> Maybe AccountScope
accountScope} -> Maybe AccountScope
accountScope) (\s :: GetSavingsPlansPurchaseRecommendation
s@GetSavingsPlansPurchaseRecommendation' {} Maybe AccountScope
a -> GetSavingsPlansPurchaseRecommendation
s {$sel:accountScope:GetSavingsPlansPurchaseRecommendation' :: Maybe AccountScope
accountScope = Maybe AccountScope
a} :: GetSavingsPlansPurchaseRecommendation)

-- | You can filter your recommendations by Account ID with the
-- @LINKED_ACCOUNT@ dimension. To filter your recommendations by Account
-- ID, specify @Key@ as @LINKED_ACCOUNT@ and @Value@ as the comma-separated
-- Acount ID(s) that you want to see Savings Plans purchase recommendations
-- for.
--
-- For GetSavingsPlansPurchaseRecommendation, the @Filter@ doesn\'t include
-- @CostCategories@ or @Tags@. It only includes @Dimensions@. With
-- @Dimensions@, @Key@ must be @LINKED_ACCOUNT@ and @Value@ can be a single
-- Account ID or multiple comma-separated Account IDs that you want to see
-- Savings Plans Purchase Recommendations for. @AND@ and @OR@ operators are
-- not supported.
getSavingsPlansPurchaseRecommendation_filter :: Lens.Lens' GetSavingsPlansPurchaseRecommendation (Prelude.Maybe Expression)
getSavingsPlansPurchaseRecommendation_filter :: Lens' GetSavingsPlansPurchaseRecommendation (Maybe Expression)
getSavingsPlansPurchaseRecommendation_filter = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetSavingsPlansPurchaseRecommendation' {Maybe Expression
filter' :: Maybe Expression
$sel:filter':GetSavingsPlansPurchaseRecommendation' :: GetSavingsPlansPurchaseRecommendation -> Maybe Expression
filter'} -> Maybe Expression
filter') (\s :: GetSavingsPlansPurchaseRecommendation
s@GetSavingsPlansPurchaseRecommendation' {} Maybe Expression
a -> GetSavingsPlansPurchaseRecommendation
s {$sel:filter':GetSavingsPlansPurchaseRecommendation' :: Maybe Expression
filter' = Maybe Expression
a} :: GetSavingsPlansPurchaseRecommendation)

-- | The token to retrieve the next set of results. Amazon Web Services
-- provides the token when the response from a previous call has more
-- results than the maximum page size.
getSavingsPlansPurchaseRecommendation_nextPageToken :: Lens.Lens' GetSavingsPlansPurchaseRecommendation (Prelude.Maybe Prelude.Text)
getSavingsPlansPurchaseRecommendation_nextPageToken :: Lens' GetSavingsPlansPurchaseRecommendation (Maybe Text)
getSavingsPlansPurchaseRecommendation_nextPageToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetSavingsPlansPurchaseRecommendation' {Maybe Text
nextPageToken :: Maybe Text
$sel:nextPageToken:GetSavingsPlansPurchaseRecommendation' :: GetSavingsPlansPurchaseRecommendation -> Maybe Text
nextPageToken} -> Maybe Text
nextPageToken) (\s :: GetSavingsPlansPurchaseRecommendation
s@GetSavingsPlansPurchaseRecommendation' {} Maybe Text
a -> GetSavingsPlansPurchaseRecommendation
s {$sel:nextPageToken:GetSavingsPlansPurchaseRecommendation' :: Maybe Text
nextPageToken = Maybe Text
a} :: GetSavingsPlansPurchaseRecommendation)

-- | The number of recommendations that you want returned in a single
-- response object.
getSavingsPlansPurchaseRecommendation_pageSize :: Lens.Lens' GetSavingsPlansPurchaseRecommendation (Prelude.Maybe Prelude.Natural)
getSavingsPlansPurchaseRecommendation_pageSize :: Lens' GetSavingsPlansPurchaseRecommendation (Maybe Natural)
getSavingsPlansPurchaseRecommendation_pageSize = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetSavingsPlansPurchaseRecommendation' {Maybe Natural
pageSize :: Maybe Natural
$sel:pageSize:GetSavingsPlansPurchaseRecommendation' :: GetSavingsPlansPurchaseRecommendation -> Maybe Natural
pageSize} -> Maybe Natural
pageSize) (\s :: GetSavingsPlansPurchaseRecommendation
s@GetSavingsPlansPurchaseRecommendation' {} Maybe Natural
a -> GetSavingsPlansPurchaseRecommendation
s {$sel:pageSize:GetSavingsPlansPurchaseRecommendation' :: Maybe Natural
pageSize = Maybe Natural
a} :: GetSavingsPlansPurchaseRecommendation)

-- | The Savings Plans recommendation type that\'s requested.
getSavingsPlansPurchaseRecommendation_savingsPlansType :: Lens.Lens' GetSavingsPlansPurchaseRecommendation SupportedSavingsPlansType
getSavingsPlansPurchaseRecommendation_savingsPlansType :: Lens'
  GetSavingsPlansPurchaseRecommendation SupportedSavingsPlansType
getSavingsPlansPurchaseRecommendation_savingsPlansType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetSavingsPlansPurchaseRecommendation' {SupportedSavingsPlansType
savingsPlansType :: SupportedSavingsPlansType
$sel:savingsPlansType:GetSavingsPlansPurchaseRecommendation' :: GetSavingsPlansPurchaseRecommendation -> SupportedSavingsPlansType
savingsPlansType} -> SupportedSavingsPlansType
savingsPlansType) (\s :: GetSavingsPlansPurchaseRecommendation
s@GetSavingsPlansPurchaseRecommendation' {} SupportedSavingsPlansType
a -> GetSavingsPlansPurchaseRecommendation
s {$sel:savingsPlansType:GetSavingsPlansPurchaseRecommendation' :: SupportedSavingsPlansType
savingsPlansType = SupportedSavingsPlansType
a} :: GetSavingsPlansPurchaseRecommendation)

-- | The savings plan recommendation term that\'s used to generate these
-- recommendations.
getSavingsPlansPurchaseRecommendation_termInYears :: Lens.Lens' GetSavingsPlansPurchaseRecommendation TermInYears
getSavingsPlansPurchaseRecommendation_termInYears :: Lens' GetSavingsPlansPurchaseRecommendation TermInYears
getSavingsPlansPurchaseRecommendation_termInYears = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetSavingsPlansPurchaseRecommendation' {TermInYears
termInYears :: TermInYears
$sel:termInYears:GetSavingsPlansPurchaseRecommendation' :: GetSavingsPlansPurchaseRecommendation -> TermInYears
termInYears} -> TermInYears
termInYears) (\s :: GetSavingsPlansPurchaseRecommendation
s@GetSavingsPlansPurchaseRecommendation' {} TermInYears
a -> GetSavingsPlansPurchaseRecommendation
s {$sel:termInYears:GetSavingsPlansPurchaseRecommendation' :: TermInYears
termInYears = TermInYears
a} :: GetSavingsPlansPurchaseRecommendation)

-- | The payment option that\'s used to generate these recommendations.
getSavingsPlansPurchaseRecommendation_paymentOption :: Lens.Lens' GetSavingsPlansPurchaseRecommendation PaymentOption
getSavingsPlansPurchaseRecommendation_paymentOption :: Lens' GetSavingsPlansPurchaseRecommendation PaymentOption
getSavingsPlansPurchaseRecommendation_paymentOption = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetSavingsPlansPurchaseRecommendation' {PaymentOption
paymentOption :: PaymentOption
$sel:paymentOption:GetSavingsPlansPurchaseRecommendation' :: GetSavingsPlansPurchaseRecommendation -> PaymentOption
paymentOption} -> PaymentOption
paymentOption) (\s :: GetSavingsPlansPurchaseRecommendation
s@GetSavingsPlansPurchaseRecommendation' {} PaymentOption
a -> GetSavingsPlansPurchaseRecommendation
s {$sel:paymentOption:GetSavingsPlansPurchaseRecommendation' :: PaymentOption
paymentOption = PaymentOption
a} :: GetSavingsPlansPurchaseRecommendation)

-- | The lookback period that\'s used to generate the recommendation.
getSavingsPlansPurchaseRecommendation_lookbackPeriodInDays :: Lens.Lens' GetSavingsPlansPurchaseRecommendation LookbackPeriodInDays
getSavingsPlansPurchaseRecommendation_lookbackPeriodInDays :: Lens' GetSavingsPlansPurchaseRecommendation LookbackPeriodInDays
getSavingsPlansPurchaseRecommendation_lookbackPeriodInDays = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetSavingsPlansPurchaseRecommendation' {LookbackPeriodInDays
lookbackPeriodInDays :: LookbackPeriodInDays
$sel:lookbackPeriodInDays:GetSavingsPlansPurchaseRecommendation' :: GetSavingsPlansPurchaseRecommendation -> LookbackPeriodInDays
lookbackPeriodInDays} -> LookbackPeriodInDays
lookbackPeriodInDays) (\s :: GetSavingsPlansPurchaseRecommendation
s@GetSavingsPlansPurchaseRecommendation' {} LookbackPeriodInDays
a -> GetSavingsPlansPurchaseRecommendation
s {$sel:lookbackPeriodInDays:GetSavingsPlansPurchaseRecommendation' :: LookbackPeriodInDays
lookbackPeriodInDays = LookbackPeriodInDays
a} :: GetSavingsPlansPurchaseRecommendation)

instance
  Core.AWSRequest
    GetSavingsPlansPurchaseRecommendation
  where
  type
    AWSResponse
      GetSavingsPlansPurchaseRecommendation =
      GetSavingsPlansPurchaseRecommendationResponse
  request :: (Service -> Service)
-> GetSavingsPlansPurchaseRecommendation
-> Request GetSavingsPlansPurchaseRecommendation
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.postJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy GetSavingsPlansPurchaseRecommendation
-> ClientResponse ClientBody
-> m (Either
        Error
        (ClientResponse
           (AWSResponse GetSavingsPlansPurchaseRecommendation)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> Object -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveJSON
      ( \Int
s ResponseHeaders
h Object
x ->
          Maybe SavingsPlansPurchaseRecommendationMetadata
-> Maybe Text
-> Maybe SavingsPlansPurchaseRecommendation
-> Int
-> GetSavingsPlansPurchaseRecommendationResponse
GetSavingsPlansPurchaseRecommendationResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"Metadata")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"NextPageToken")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"SavingsPlansPurchaseRecommendation")
            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
    GetSavingsPlansPurchaseRecommendation
  where
  hashWithSalt :: Int -> GetSavingsPlansPurchaseRecommendation -> Int
hashWithSalt
    Int
_salt
    GetSavingsPlansPurchaseRecommendation' {Maybe Natural
Maybe Text
Maybe AccountScope
Maybe Expression
LookbackPeriodInDays
PaymentOption
SupportedSavingsPlansType
TermInYears
lookbackPeriodInDays :: LookbackPeriodInDays
paymentOption :: PaymentOption
termInYears :: TermInYears
savingsPlansType :: SupportedSavingsPlansType
pageSize :: Maybe Natural
nextPageToken :: Maybe Text
filter' :: Maybe Expression
accountScope :: Maybe AccountScope
$sel:lookbackPeriodInDays:GetSavingsPlansPurchaseRecommendation' :: GetSavingsPlansPurchaseRecommendation -> LookbackPeriodInDays
$sel:paymentOption:GetSavingsPlansPurchaseRecommendation' :: GetSavingsPlansPurchaseRecommendation -> PaymentOption
$sel:termInYears:GetSavingsPlansPurchaseRecommendation' :: GetSavingsPlansPurchaseRecommendation -> TermInYears
$sel:savingsPlansType:GetSavingsPlansPurchaseRecommendation' :: GetSavingsPlansPurchaseRecommendation -> SupportedSavingsPlansType
$sel:pageSize:GetSavingsPlansPurchaseRecommendation' :: GetSavingsPlansPurchaseRecommendation -> Maybe Natural
$sel:nextPageToken:GetSavingsPlansPurchaseRecommendation' :: GetSavingsPlansPurchaseRecommendation -> Maybe Text
$sel:filter':GetSavingsPlansPurchaseRecommendation' :: GetSavingsPlansPurchaseRecommendation -> Maybe Expression
$sel:accountScope:GetSavingsPlansPurchaseRecommendation' :: GetSavingsPlansPurchaseRecommendation -> Maybe AccountScope
..} =
      Int
_salt
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe AccountScope
accountScope
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Expression
filter'
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
nextPageToken
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
pageSize
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` SupportedSavingsPlansType
savingsPlansType
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` TermInYears
termInYears
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` PaymentOption
paymentOption
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` LookbackPeriodInDays
lookbackPeriodInDays

instance
  Prelude.NFData
    GetSavingsPlansPurchaseRecommendation
  where
  rnf :: GetSavingsPlansPurchaseRecommendation -> ()
rnf GetSavingsPlansPurchaseRecommendation' {Maybe Natural
Maybe Text
Maybe AccountScope
Maybe Expression
LookbackPeriodInDays
PaymentOption
SupportedSavingsPlansType
TermInYears
lookbackPeriodInDays :: LookbackPeriodInDays
paymentOption :: PaymentOption
termInYears :: TermInYears
savingsPlansType :: SupportedSavingsPlansType
pageSize :: Maybe Natural
nextPageToken :: Maybe Text
filter' :: Maybe Expression
accountScope :: Maybe AccountScope
$sel:lookbackPeriodInDays:GetSavingsPlansPurchaseRecommendation' :: GetSavingsPlansPurchaseRecommendation -> LookbackPeriodInDays
$sel:paymentOption:GetSavingsPlansPurchaseRecommendation' :: GetSavingsPlansPurchaseRecommendation -> PaymentOption
$sel:termInYears:GetSavingsPlansPurchaseRecommendation' :: GetSavingsPlansPurchaseRecommendation -> TermInYears
$sel:savingsPlansType:GetSavingsPlansPurchaseRecommendation' :: GetSavingsPlansPurchaseRecommendation -> SupportedSavingsPlansType
$sel:pageSize:GetSavingsPlansPurchaseRecommendation' :: GetSavingsPlansPurchaseRecommendation -> Maybe Natural
$sel:nextPageToken:GetSavingsPlansPurchaseRecommendation' :: GetSavingsPlansPurchaseRecommendation -> Maybe Text
$sel:filter':GetSavingsPlansPurchaseRecommendation' :: GetSavingsPlansPurchaseRecommendation -> Maybe Expression
$sel:accountScope:GetSavingsPlansPurchaseRecommendation' :: GetSavingsPlansPurchaseRecommendation -> Maybe AccountScope
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe AccountScope
accountScope
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Expression
filter'
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
nextPageToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
pageSize
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf SupportedSavingsPlansType
savingsPlansType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf TermInYears
termInYears
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf PaymentOption
paymentOption
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf LookbackPeriodInDays
lookbackPeriodInDays

instance
  Data.ToHeaders
    GetSavingsPlansPurchaseRecommendation
  where
  toHeaders :: GetSavingsPlansPurchaseRecommendation -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"X-Amz-Target"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"AWSInsightsIndexService.GetSavingsPlansPurchaseRecommendation" ::
                          Prelude.ByteString
                      ),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance
  Data.ToJSON
    GetSavingsPlansPurchaseRecommendation
  where
  toJSON :: GetSavingsPlansPurchaseRecommendation -> Value
toJSON GetSavingsPlansPurchaseRecommendation' {Maybe Natural
Maybe Text
Maybe AccountScope
Maybe Expression
LookbackPeriodInDays
PaymentOption
SupportedSavingsPlansType
TermInYears
lookbackPeriodInDays :: LookbackPeriodInDays
paymentOption :: PaymentOption
termInYears :: TermInYears
savingsPlansType :: SupportedSavingsPlansType
pageSize :: Maybe Natural
nextPageToken :: Maybe Text
filter' :: Maybe Expression
accountScope :: Maybe AccountScope
$sel:lookbackPeriodInDays:GetSavingsPlansPurchaseRecommendation' :: GetSavingsPlansPurchaseRecommendation -> LookbackPeriodInDays
$sel:paymentOption:GetSavingsPlansPurchaseRecommendation' :: GetSavingsPlansPurchaseRecommendation -> PaymentOption
$sel:termInYears:GetSavingsPlansPurchaseRecommendation' :: GetSavingsPlansPurchaseRecommendation -> TermInYears
$sel:savingsPlansType:GetSavingsPlansPurchaseRecommendation' :: GetSavingsPlansPurchaseRecommendation -> SupportedSavingsPlansType
$sel:pageSize:GetSavingsPlansPurchaseRecommendation' :: GetSavingsPlansPurchaseRecommendation -> Maybe Natural
$sel:nextPageToken:GetSavingsPlansPurchaseRecommendation' :: GetSavingsPlansPurchaseRecommendation -> Maybe Text
$sel:filter':GetSavingsPlansPurchaseRecommendation' :: GetSavingsPlansPurchaseRecommendation -> Maybe Expression
$sel:accountScope:GetSavingsPlansPurchaseRecommendation' :: GetSavingsPlansPurchaseRecommendation -> Maybe AccountScope
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"AccountScope" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe AccountScope
accountScope,
            (Key
"Filter" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Expression
filter',
            (Key
"NextPageToken" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
nextPageToken,
            (Key
"PageSize" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Natural
pageSize,
            forall a. a -> Maybe a
Prelude.Just
              (Key
"SavingsPlansType" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= SupportedSavingsPlansType
savingsPlansType),
            forall a. a -> Maybe a
Prelude.Just (Key
"TermInYears" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= TermInYears
termInYears),
            forall a. a -> Maybe a
Prelude.Just (Key
"PaymentOption" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= PaymentOption
paymentOption),
            forall a. a -> Maybe a
Prelude.Just
              ( Key
"LookbackPeriodInDays"
                  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= LookbackPeriodInDays
lookbackPeriodInDays
              )
          ]
      )

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

instance
  Data.ToQuery
    GetSavingsPlansPurchaseRecommendation
  where
  toQuery :: GetSavingsPlansPurchaseRecommendation -> QueryString
toQuery = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

-- | /See:/ 'newGetSavingsPlansPurchaseRecommendationResponse' smart constructor.
data GetSavingsPlansPurchaseRecommendationResponse = GetSavingsPlansPurchaseRecommendationResponse'
  { -- | Information that regards this specific recommendation set.
    GetSavingsPlansPurchaseRecommendationResponse
-> Maybe SavingsPlansPurchaseRecommendationMetadata
metadata :: Prelude.Maybe SavingsPlansPurchaseRecommendationMetadata,
    -- | The token for the next set of retrievable results. Amazon Web Services
    -- provides the token when the response from a previous call has more
    -- results than the maximum page size.
    GetSavingsPlansPurchaseRecommendationResponse -> Maybe Text
nextPageToken :: Prelude.Maybe Prelude.Text,
    -- | Contains your request parameters, Savings Plan Recommendations Summary,
    -- and Details.
    GetSavingsPlansPurchaseRecommendationResponse
-> Maybe SavingsPlansPurchaseRecommendation
savingsPlansPurchaseRecommendation :: Prelude.Maybe SavingsPlansPurchaseRecommendation,
    -- | The response's http status code.
    GetSavingsPlansPurchaseRecommendationResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetSavingsPlansPurchaseRecommendationResponse
-> GetSavingsPlansPurchaseRecommendationResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetSavingsPlansPurchaseRecommendationResponse
-> GetSavingsPlansPurchaseRecommendationResponse -> Bool
$c/= :: GetSavingsPlansPurchaseRecommendationResponse
-> GetSavingsPlansPurchaseRecommendationResponse -> Bool
== :: GetSavingsPlansPurchaseRecommendationResponse
-> GetSavingsPlansPurchaseRecommendationResponse -> Bool
$c== :: GetSavingsPlansPurchaseRecommendationResponse
-> GetSavingsPlansPurchaseRecommendationResponse -> Bool
Prelude.Eq, ReadPrec [GetSavingsPlansPurchaseRecommendationResponse]
ReadPrec GetSavingsPlansPurchaseRecommendationResponse
Int -> ReadS GetSavingsPlansPurchaseRecommendationResponse
ReadS [GetSavingsPlansPurchaseRecommendationResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetSavingsPlansPurchaseRecommendationResponse]
$creadListPrec :: ReadPrec [GetSavingsPlansPurchaseRecommendationResponse]
readPrec :: ReadPrec GetSavingsPlansPurchaseRecommendationResponse
$creadPrec :: ReadPrec GetSavingsPlansPurchaseRecommendationResponse
readList :: ReadS [GetSavingsPlansPurchaseRecommendationResponse]
$creadList :: ReadS [GetSavingsPlansPurchaseRecommendationResponse]
readsPrec :: Int -> ReadS GetSavingsPlansPurchaseRecommendationResponse
$creadsPrec :: Int -> ReadS GetSavingsPlansPurchaseRecommendationResponse
Prelude.Read, Int -> GetSavingsPlansPurchaseRecommendationResponse -> ShowS
[GetSavingsPlansPurchaseRecommendationResponse] -> ShowS
GetSavingsPlansPurchaseRecommendationResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetSavingsPlansPurchaseRecommendationResponse] -> ShowS
$cshowList :: [GetSavingsPlansPurchaseRecommendationResponse] -> ShowS
show :: GetSavingsPlansPurchaseRecommendationResponse -> String
$cshow :: GetSavingsPlansPurchaseRecommendationResponse -> String
showsPrec :: Int -> GetSavingsPlansPurchaseRecommendationResponse -> ShowS
$cshowsPrec :: Int -> GetSavingsPlansPurchaseRecommendationResponse -> ShowS
Prelude.Show, forall x.
Rep GetSavingsPlansPurchaseRecommendationResponse x
-> GetSavingsPlansPurchaseRecommendationResponse
forall x.
GetSavingsPlansPurchaseRecommendationResponse
-> Rep GetSavingsPlansPurchaseRecommendationResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetSavingsPlansPurchaseRecommendationResponse x
-> GetSavingsPlansPurchaseRecommendationResponse
$cfrom :: forall x.
GetSavingsPlansPurchaseRecommendationResponse
-> Rep GetSavingsPlansPurchaseRecommendationResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetSavingsPlansPurchaseRecommendationResponse' 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:
--
-- 'metadata', 'getSavingsPlansPurchaseRecommendationResponse_metadata' - Information that regards this specific recommendation set.
--
-- 'nextPageToken', 'getSavingsPlansPurchaseRecommendationResponse_nextPageToken' - The token for the next set of retrievable results. Amazon Web Services
-- provides the token when the response from a previous call has more
-- results than the maximum page size.
--
-- 'savingsPlansPurchaseRecommendation', 'getSavingsPlansPurchaseRecommendationResponse_savingsPlansPurchaseRecommendation' - Contains your request parameters, Savings Plan Recommendations Summary,
-- and Details.
--
-- 'httpStatus', 'getSavingsPlansPurchaseRecommendationResponse_httpStatus' - The response's http status code.
newGetSavingsPlansPurchaseRecommendationResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetSavingsPlansPurchaseRecommendationResponse
newGetSavingsPlansPurchaseRecommendationResponse :: Int -> GetSavingsPlansPurchaseRecommendationResponse
newGetSavingsPlansPurchaseRecommendationResponse
  Int
pHttpStatus_ =
    GetSavingsPlansPurchaseRecommendationResponse'
      { $sel:metadata:GetSavingsPlansPurchaseRecommendationResponse' :: Maybe SavingsPlansPurchaseRecommendationMetadata
metadata =
          forall a. Maybe a
Prelude.Nothing,
        $sel:nextPageToken:GetSavingsPlansPurchaseRecommendationResponse' :: Maybe Text
nextPageToken =
          forall a. Maybe a
Prelude.Nothing,
        $sel:savingsPlansPurchaseRecommendation:GetSavingsPlansPurchaseRecommendationResponse' :: Maybe SavingsPlansPurchaseRecommendation
savingsPlansPurchaseRecommendation =
          forall a. Maybe a
Prelude.Nothing,
        $sel:httpStatus:GetSavingsPlansPurchaseRecommendationResponse' :: Int
httpStatus = Int
pHttpStatus_
      }

-- | Information that regards this specific recommendation set.
getSavingsPlansPurchaseRecommendationResponse_metadata :: Lens.Lens' GetSavingsPlansPurchaseRecommendationResponse (Prelude.Maybe SavingsPlansPurchaseRecommendationMetadata)
getSavingsPlansPurchaseRecommendationResponse_metadata :: Lens'
  GetSavingsPlansPurchaseRecommendationResponse
  (Maybe SavingsPlansPurchaseRecommendationMetadata)
getSavingsPlansPurchaseRecommendationResponse_metadata = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetSavingsPlansPurchaseRecommendationResponse' {Maybe SavingsPlansPurchaseRecommendationMetadata
metadata :: Maybe SavingsPlansPurchaseRecommendationMetadata
$sel:metadata:GetSavingsPlansPurchaseRecommendationResponse' :: GetSavingsPlansPurchaseRecommendationResponse
-> Maybe SavingsPlansPurchaseRecommendationMetadata
metadata} -> Maybe SavingsPlansPurchaseRecommendationMetadata
metadata) (\s :: GetSavingsPlansPurchaseRecommendationResponse
s@GetSavingsPlansPurchaseRecommendationResponse' {} Maybe SavingsPlansPurchaseRecommendationMetadata
a -> GetSavingsPlansPurchaseRecommendationResponse
s {$sel:metadata:GetSavingsPlansPurchaseRecommendationResponse' :: Maybe SavingsPlansPurchaseRecommendationMetadata
metadata = Maybe SavingsPlansPurchaseRecommendationMetadata
a} :: GetSavingsPlansPurchaseRecommendationResponse)

-- | The token for the next set of retrievable results. Amazon Web Services
-- provides the token when the response from a previous call has more
-- results than the maximum page size.
getSavingsPlansPurchaseRecommendationResponse_nextPageToken :: Lens.Lens' GetSavingsPlansPurchaseRecommendationResponse (Prelude.Maybe Prelude.Text)
getSavingsPlansPurchaseRecommendationResponse_nextPageToken :: Lens' GetSavingsPlansPurchaseRecommendationResponse (Maybe Text)
getSavingsPlansPurchaseRecommendationResponse_nextPageToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetSavingsPlansPurchaseRecommendationResponse' {Maybe Text
nextPageToken :: Maybe Text
$sel:nextPageToken:GetSavingsPlansPurchaseRecommendationResponse' :: GetSavingsPlansPurchaseRecommendationResponse -> Maybe Text
nextPageToken} -> Maybe Text
nextPageToken) (\s :: GetSavingsPlansPurchaseRecommendationResponse
s@GetSavingsPlansPurchaseRecommendationResponse' {} Maybe Text
a -> GetSavingsPlansPurchaseRecommendationResponse
s {$sel:nextPageToken:GetSavingsPlansPurchaseRecommendationResponse' :: Maybe Text
nextPageToken = Maybe Text
a} :: GetSavingsPlansPurchaseRecommendationResponse)

-- | Contains your request parameters, Savings Plan Recommendations Summary,
-- and Details.
getSavingsPlansPurchaseRecommendationResponse_savingsPlansPurchaseRecommendation :: Lens.Lens' GetSavingsPlansPurchaseRecommendationResponse (Prelude.Maybe SavingsPlansPurchaseRecommendation)
getSavingsPlansPurchaseRecommendationResponse_savingsPlansPurchaseRecommendation :: Lens'
  GetSavingsPlansPurchaseRecommendationResponse
  (Maybe SavingsPlansPurchaseRecommendation)
getSavingsPlansPurchaseRecommendationResponse_savingsPlansPurchaseRecommendation = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetSavingsPlansPurchaseRecommendationResponse' {Maybe SavingsPlansPurchaseRecommendation
savingsPlansPurchaseRecommendation :: Maybe SavingsPlansPurchaseRecommendation
$sel:savingsPlansPurchaseRecommendation:GetSavingsPlansPurchaseRecommendationResponse' :: GetSavingsPlansPurchaseRecommendationResponse
-> Maybe SavingsPlansPurchaseRecommendation
savingsPlansPurchaseRecommendation} -> Maybe SavingsPlansPurchaseRecommendation
savingsPlansPurchaseRecommendation) (\s :: GetSavingsPlansPurchaseRecommendationResponse
s@GetSavingsPlansPurchaseRecommendationResponse' {} Maybe SavingsPlansPurchaseRecommendation
a -> GetSavingsPlansPurchaseRecommendationResponse
s {$sel:savingsPlansPurchaseRecommendation:GetSavingsPlansPurchaseRecommendationResponse' :: Maybe SavingsPlansPurchaseRecommendation
savingsPlansPurchaseRecommendation = Maybe SavingsPlansPurchaseRecommendation
a} :: GetSavingsPlansPurchaseRecommendationResponse)

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

instance
  Prelude.NFData
    GetSavingsPlansPurchaseRecommendationResponse
  where
  rnf :: GetSavingsPlansPurchaseRecommendationResponse -> ()
rnf
    GetSavingsPlansPurchaseRecommendationResponse' {Int
Maybe Text
Maybe SavingsPlansPurchaseRecommendationMetadata
Maybe SavingsPlansPurchaseRecommendation
httpStatus :: Int
savingsPlansPurchaseRecommendation :: Maybe SavingsPlansPurchaseRecommendation
nextPageToken :: Maybe Text
metadata :: Maybe SavingsPlansPurchaseRecommendationMetadata
$sel:httpStatus:GetSavingsPlansPurchaseRecommendationResponse' :: GetSavingsPlansPurchaseRecommendationResponse -> Int
$sel:savingsPlansPurchaseRecommendation:GetSavingsPlansPurchaseRecommendationResponse' :: GetSavingsPlansPurchaseRecommendationResponse
-> Maybe SavingsPlansPurchaseRecommendation
$sel:nextPageToken:GetSavingsPlansPurchaseRecommendationResponse' :: GetSavingsPlansPurchaseRecommendationResponse -> Maybe Text
$sel:metadata:GetSavingsPlansPurchaseRecommendationResponse' :: GetSavingsPlansPurchaseRecommendationResponse
-> Maybe SavingsPlansPurchaseRecommendationMetadata
..} =
      forall a. NFData a => a -> ()
Prelude.rnf Maybe SavingsPlansPurchaseRecommendationMetadata
metadata
        seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
nextPageToken
        seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe SavingsPlansPurchaseRecommendation
savingsPlansPurchaseRecommendation
        seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus