{-# 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.SavingsPlans.CreateSavingsPlan
-- 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 Savings Plan.
module Amazonka.SavingsPlans.CreateSavingsPlan
  ( -- * Creating a Request
    CreateSavingsPlan (..),
    newCreateSavingsPlan,

    -- * Request Lenses
    createSavingsPlan_clientToken,
    createSavingsPlan_purchaseTime,
    createSavingsPlan_tags,
    createSavingsPlan_upfrontPaymentAmount,
    createSavingsPlan_savingsPlanOfferingId,
    createSavingsPlan_commitment,

    -- * Destructuring the Response
    CreateSavingsPlanResponse (..),
    newCreateSavingsPlanResponse,

    -- * Response Lenses
    createSavingsPlanResponse_savingsPlanId,
    createSavingsPlanResponse_httpStatus,
  )
where

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

-- | /See:/ 'newCreateSavingsPlan' smart constructor.
data CreateSavingsPlan = CreateSavingsPlan'
  { -- | Unique, case-sensitive identifier that you provide to ensure the
    -- idempotency of the request.
    CreateSavingsPlan -> Maybe Text
clientToken :: Prelude.Maybe Prelude.Text,
    -- | The time at which to purchase the Savings Plan, in UTC format
    -- (YYYY-MM-DDTHH:MM:SSZ).
    CreateSavingsPlan -> Maybe POSIX
purchaseTime :: Prelude.Maybe Data.POSIX,
    -- | One or more tags.
    CreateSavingsPlan -> Maybe (HashMap Text Text)
tags :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | The up-front payment amount. This is a whole number between 50 and 99
    -- percent of the total value of the Savings Plan. This parameter is
    -- supported only if the payment option is @Partial Upfront@.
    CreateSavingsPlan -> Maybe Text
upfrontPaymentAmount :: Prelude.Maybe Prelude.Text,
    -- | The ID of the offering.
    CreateSavingsPlan -> Text
savingsPlanOfferingId :: Prelude.Text,
    -- | The hourly commitment, in USD. This is a value between 0.001 and 1
    -- million. You cannot specify more than five digits after the decimal
    -- point.
    CreateSavingsPlan -> Text
commitment :: Prelude.Text
  }
  deriving (CreateSavingsPlan -> CreateSavingsPlan -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateSavingsPlan -> CreateSavingsPlan -> Bool
$c/= :: CreateSavingsPlan -> CreateSavingsPlan -> Bool
== :: CreateSavingsPlan -> CreateSavingsPlan -> Bool
$c== :: CreateSavingsPlan -> CreateSavingsPlan -> Bool
Prelude.Eq, ReadPrec [CreateSavingsPlan]
ReadPrec CreateSavingsPlan
Int -> ReadS CreateSavingsPlan
ReadS [CreateSavingsPlan]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateSavingsPlan]
$creadListPrec :: ReadPrec [CreateSavingsPlan]
readPrec :: ReadPrec CreateSavingsPlan
$creadPrec :: ReadPrec CreateSavingsPlan
readList :: ReadS [CreateSavingsPlan]
$creadList :: ReadS [CreateSavingsPlan]
readsPrec :: Int -> ReadS CreateSavingsPlan
$creadsPrec :: Int -> ReadS CreateSavingsPlan
Prelude.Read, Int -> CreateSavingsPlan -> ShowS
[CreateSavingsPlan] -> ShowS
CreateSavingsPlan -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateSavingsPlan] -> ShowS
$cshowList :: [CreateSavingsPlan] -> ShowS
show :: CreateSavingsPlan -> String
$cshow :: CreateSavingsPlan -> String
showsPrec :: Int -> CreateSavingsPlan -> ShowS
$cshowsPrec :: Int -> CreateSavingsPlan -> ShowS
Prelude.Show, forall x. Rep CreateSavingsPlan x -> CreateSavingsPlan
forall x. CreateSavingsPlan -> Rep CreateSavingsPlan x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateSavingsPlan x -> CreateSavingsPlan
$cfrom :: forall x. CreateSavingsPlan -> Rep CreateSavingsPlan x
Prelude.Generic)

-- |
-- Create a value of 'CreateSavingsPlan' 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', 'createSavingsPlan_clientToken' - Unique, case-sensitive identifier that you provide to ensure the
-- idempotency of the request.
--
-- 'purchaseTime', 'createSavingsPlan_purchaseTime' - The time at which to purchase the Savings Plan, in UTC format
-- (YYYY-MM-DDTHH:MM:SSZ).
--
-- 'tags', 'createSavingsPlan_tags' - One or more tags.
--
-- 'upfrontPaymentAmount', 'createSavingsPlan_upfrontPaymentAmount' - The up-front payment amount. This is a whole number between 50 and 99
-- percent of the total value of the Savings Plan. This parameter is
-- supported only if the payment option is @Partial Upfront@.
--
-- 'savingsPlanOfferingId', 'createSavingsPlan_savingsPlanOfferingId' - The ID of the offering.
--
-- 'commitment', 'createSavingsPlan_commitment' - The hourly commitment, in USD. This is a value between 0.001 and 1
-- million. You cannot specify more than five digits after the decimal
-- point.
newCreateSavingsPlan ::
  -- | 'savingsPlanOfferingId'
  Prelude.Text ->
  -- | 'commitment'
  Prelude.Text ->
  CreateSavingsPlan
newCreateSavingsPlan :: Text -> Text -> CreateSavingsPlan
newCreateSavingsPlan
  Text
pSavingsPlanOfferingId_
  Text
pCommitment_ =
    CreateSavingsPlan'
      { $sel:clientToken:CreateSavingsPlan' :: Maybe Text
clientToken = forall a. Maybe a
Prelude.Nothing,
        $sel:purchaseTime:CreateSavingsPlan' :: Maybe POSIX
purchaseTime = forall a. Maybe a
Prelude.Nothing,
        $sel:tags:CreateSavingsPlan' :: Maybe (HashMap Text Text)
tags = forall a. Maybe a
Prelude.Nothing,
        $sel:upfrontPaymentAmount:CreateSavingsPlan' :: Maybe Text
upfrontPaymentAmount = forall a. Maybe a
Prelude.Nothing,
        $sel:savingsPlanOfferingId:CreateSavingsPlan' :: Text
savingsPlanOfferingId = Text
pSavingsPlanOfferingId_,
        $sel:commitment:CreateSavingsPlan' :: Text
commitment = Text
pCommitment_
      }

-- | Unique, case-sensitive identifier that you provide to ensure the
-- idempotency of the request.
createSavingsPlan_clientToken :: Lens.Lens' CreateSavingsPlan (Prelude.Maybe Prelude.Text)
createSavingsPlan_clientToken :: Lens' CreateSavingsPlan (Maybe Text)
createSavingsPlan_clientToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateSavingsPlan' {Maybe Text
clientToken :: Maybe Text
$sel:clientToken:CreateSavingsPlan' :: CreateSavingsPlan -> Maybe Text
clientToken} -> Maybe Text
clientToken) (\s :: CreateSavingsPlan
s@CreateSavingsPlan' {} Maybe Text
a -> CreateSavingsPlan
s {$sel:clientToken:CreateSavingsPlan' :: Maybe Text
clientToken = Maybe Text
a} :: CreateSavingsPlan)

-- | The time at which to purchase the Savings Plan, in UTC format
-- (YYYY-MM-DDTHH:MM:SSZ).
createSavingsPlan_purchaseTime :: Lens.Lens' CreateSavingsPlan (Prelude.Maybe Prelude.UTCTime)
createSavingsPlan_purchaseTime :: Lens' CreateSavingsPlan (Maybe UTCTime)
createSavingsPlan_purchaseTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateSavingsPlan' {Maybe POSIX
purchaseTime :: Maybe POSIX
$sel:purchaseTime:CreateSavingsPlan' :: CreateSavingsPlan -> Maybe POSIX
purchaseTime} -> Maybe POSIX
purchaseTime) (\s :: CreateSavingsPlan
s@CreateSavingsPlan' {} Maybe POSIX
a -> CreateSavingsPlan
s {$sel:purchaseTime:CreateSavingsPlan' :: Maybe POSIX
purchaseTime = Maybe POSIX
a} :: CreateSavingsPlan) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | One or more tags.
createSavingsPlan_tags :: Lens.Lens' CreateSavingsPlan (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
createSavingsPlan_tags :: Lens' CreateSavingsPlan (Maybe (HashMap Text Text))
createSavingsPlan_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateSavingsPlan' {Maybe (HashMap Text Text)
tags :: Maybe (HashMap Text Text)
$sel:tags:CreateSavingsPlan' :: CreateSavingsPlan -> Maybe (HashMap Text Text)
tags} -> Maybe (HashMap Text Text)
tags) (\s :: CreateSavingsPlan
s@CreateSavingsPlan' {} Maybe (HashMap Text Text)
a -> CreateSavingsPlan
s {$sel:tags:CreateSavingsPlan' :: Maybe (HashMap Text Text)
tags = Maybe (HashMap Text Text)
a} :: CreateSavingsPlan) 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 up-front payment amount. This is a whole number between 50 and 99
-- percent of the total value of the Savings Plan. This parameter is
-- supported only if the payment option is @Partial Upfront@.
createSavingsPlan_upfrontPaymentAmount :: Lens.Lens' CreateSavingsPlan (Prelude.Maybe Prelude.Text)
createSavingsPlan_upfrontPaymentAmount :: Lens' CreateSavingsPlan (Maybe Text)
createSavingsPlan_upfrontPaymentAmount = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateSavingsPlan' {Maybe Text
upfrontPaymentAmount :: Maybe Text
$sel:upfrontPaymentAmount:CreateSavingsPlan' :: CreateSavingsPlan -> Maybe Text
upfrontPaymentAmount} -> Maybe Text
upfrontPaymentAmount) (\s :: CreateSavingsPlan
s@CreateSavingsPlan' {} Maybe Text
a -> CreateSavingsPlan
s {$sel:upfrontPaymentAmount:CreateSavingsPlan' :: Maybe Text
upfrontPaymentAmount = Maybe Text
a} :: CreateSavingsPlan)

-- | The ID of the offering.
createSavingsPlan_savingsPlanOfferingId :: Lens.Lens' CreateSavingsPlan Prelude.Text
createSavingsPlan_savingsPlanOfferingId :: Lens' CreateSavingsPlan Text
createSavingsPlan_savingsPlanOfferingId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateSavingsPlan' {Text
savingsPlanOfferingId :: Text
$sel:savingsPlanOfferingId:CreateSavingsPlan' :: CreateSavingsPlan -> Text
savingsPlanOfferingId} -> Text
savingsPlanOfferingId) (\s :: CreateSavingsPlan
s@CreateSavingsPlan' {} Text
a -> CreateSavingsPlan
s {$sel:savingsPlanOfferingId:CreateSavingsPlan' :: Text
savingsPlanOfferingId = Text
a} :: CreateSavingsPlan)

-- | The hourly commitment, in USD. This is a value between 0.001 and 1
-- million. You cannot specify more than five digits after the decimal
-- point.
createSavingsPlan_commitment :: Lens.Lens' CreateSavingsPlan Prelude.Text
createSavingsPlan_commitment :: Lens' CreateSavingsPlan Text
createSavingsPlan_commitment = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateSavingsPlan' {Text
commitment :: Text
$sel:commitment:CreateSavingsPlan' :: CreateSavingsPlan -> Text
commitment} -> Text
commitment) (\s :: CreateSavingsPlan
s@CreateSavingsPlan' {} Text
a -> CreateSavingsPlan
s {$sel:commitment:CreateSavingsPlan' :: Text
commitment = Text
a} :: CreateSavingsPlan)

instance Core.AWSRequest CreateSavingsPlan where
  type
    AWSResponse CreateSavingsPlan =
      CreateSavingsPlanResponse
  request :: (Service -> Service)
-> CreateSavingsPlan -> Request CreateSavingsPlan
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 CreateSavingsPlan
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CreateSavingsPlan)))
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 Text -> Int -> CreateSavingsPlanResponse
CreateSavingsPlanResponse'
            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
"savingsPlanId")
            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 CreateSavingsPlan where
  hashWithSalt :: Int -> CreateSavingsPlan -> Int
hashWithSalt Int
_salt CreateSavingsPlan' {Maybe Text
Maybe (HashMap Text Text)
Maybe POSIX
Text
commitment :: Text
savingsPlanOfferingId :: Text
upfrontPaymentAmount :: Maybe Text
tags :: Maybe (HashMap Text Text)
purchaseTime :: Maybe POSIX
clientToken :: Maybe Text
$sel:commitment:CreateSavingsPlan' :: CreateSavingsPlan -> Text
$sel:savingsPlanOfferingId:CreateSavingsPlan' :: CreateSavingsPlan -> Text
$sel:upfrontPaymentAmount:CreateSavingsPlan' :: CreateSavingsPlan -> Maybe Text
$sel:tags:CreateSavingsPlan' :: CreateSavingsPlan -> Maybe (HashMap Text Text)
$sel:purchaseTime:CreateSavingsPlan' :: CreateSavingsPlan -> Maybe POSIX
$sel:clientToken:CreateSavingsPlan' :: CreateSavingsPlan -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
clientToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe POSIX
purchaseTime
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Text)
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
upfrontPaymentAmount
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
savingsPlanOfferingId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
commitment

instance Prelude.NFData CreateSavingsPlan where
  rnf :: CreateSavingsPlan -> ()
rnf CreateSavingsPlan' {Maybe Text
Maybe (HashMap Text Text)
Maybe POSIX
Text
commitment :: Text
savingsPlanOfferingId :: Text
upfrontPaymentAmount :: Maybe Text
tags :: Maybe (HashMap Text Text)
purchaseTime :: Maybe POSIX
clientToken :: Maybe Text
$sel:commitment:CreateSavingsPlan' :: CreateSavingsPlan -> Text
$sel:savingsPlanOfferingId:CreateSavingsPlan' :: CreateSavingsPlan -> Text
$sel:upfrontPaymentAmount:CreateSavingsPlan' :: CreateSavingsPlan -> Maybe Text
$sel:tags:CreateSavingsPlan' :: CreateSavingsPlan -> Maybe (HashMap Text Text)
$sel:purchaseTime:CreateSavingsPlan' :: CreateSavingsPlan -> Maybe POSIX
$sel:clientToken:CreateSavingsPlan' :: CreateSavingsPlan -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
clientToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
purchaseTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text Text)
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
upfrontPaymentAmount
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
savingsPlanOfferingId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
commitment

instance Data.ToHeaders CreateSavingsPlan where
  toHeaders :: CreateSavingsPlan -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.0" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON CreateSavingsPlan where
  toJSON :: CreateSavingsPlan -> Value
toJSON CreateSavingsPlan' {Maybe Text
Maybe (HashMap Text Text)
Maybe POSIX
Text
commitment :: Text
savingsPlanOfferingId :: Text
upfrontPaymentAmount :: Maybe Text
tags :: Maybe (HashMap Text Text)
purchaseTime :: Maybe POSIX
clientToken :: Maybe Text
$sel:commitment:CreateSavingsPlan' :: CreateSavingsPlan -> Text
$sel:savingsPlanOfferingId:CreateSavingsPlan' :: CreateSavingsPlan -> Text
$sel:upfrontPaymentAmount:CreateSavingsPlan' :: CreateSavingsPlan -> Maybe Text
$sel:tags:CreateSavingsPlan' :: CreateSavingsPlan -> Maybe (HashMap Text Text)
$sel:purchaseTime:CreateSavingsPlan' :: CreateSavingsPlan -> Maybe POSIX
$sel:clientToken:CreateSavingsPlan' :: CreateSavingsPlan -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"clientToken" 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
clientToken,
            (Key
"purchaseTime" 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 POSIX
purchaseTime,
            (Key
"tags" 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 (HashMap Text Text)
tags,
            (Key
"upfrontPaymentAmount" 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
upfrontPaymentAmount,
            forall a. a -> Maybe a
Prelude.Just
              ( Key
"savingsPlanOfferingId"
                  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
savingsPlanOfferingId
              ),
            forall a. a -> Maybe a
Prelude.Just (Key
"commitment" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
commitment)
          ]
      )

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

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

-- | /See:/ 'newCreateSavingsPlanResponse' smart constructor.
data CreateSavingsPlanResponse = CreateSavingsPlanResponse'
  { -- | The ID of the Savings Plan.
    CreateSavingsPlanResponse -> Maybe Text
savingsPlanId :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    CreateSavingsPlanResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CreateSavingsPlanResponse -> CreateSavingsPlanResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateSavingsPlanResponse -> CreateSavingsPlanResponse -> Bool
$c/= :: CreateSavingsPlanResponse -> CreateSavingsPlanResponse -> Bool
== :: CreateSavingsPlanResponse -> CreateSavingsPlanResponse -> Bool
$c== :: CreateSavingsPlanResponse -> CreateSavingsPlanResponse -> Bool
Prelude.Eq, ReadPrec [CreateSavingsPlanResponse]
ReadPrec CreateSavingsPlanResponse
Int -> ReadS CreateSavingsPlanResponse
ReadS [CreateSavingsPlanResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateSavingsPlanResponse]
$creadListPrec :: ReadPrec [CreateSavingsPlanResponse]
readPrec :: ReadPrec CreateSavingsPlanResponse
$creadPrec :: ReadPrec CreateSavingsPlanResponse
readList :: ReadS [CreateSavingsPlanResponse]
$creadList :: ReadS [CreateSavingsPlanResponse]
readsPrec :: Int -> ReadS CreateSavingsPlanResponse
$creadsPrec :: Int -> ReadS CreateSavingsPlanResponse
Prelude.Read, Int -> CreateSavingsPlanResponse -> ShowS
[CreateSavingsPlanResponse] -> ShowS
CreateSavingsPlanResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateSavingsPlanResponse] -> ShowS
$cshowList :: [CreateSavingsPlanResponse] -> ShowS
show :: CreateSavingsPlanResponse -> String
$cshow :: CreateSavingsPlanResponse -> String
showsPrec :: Int -> CreateSavingsPlanResponse -> ShowS
$cshowsPrec :: Int -> CreateSavingsPlanResponse -> ShowS
Prelude.Show, forall x.
Rep CreateSavingsPlanResponse x -> CreateSavingsPlanResponse
forall x.
CreateSavingsPlanResponse -> Rep CreateSavingsPlanResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateSavingsPlanResponse x -> CreateSavingsPlanResponse
$cfrom :: forall x.
CreateSavingsPlanResponse -> Rep CreateSavingsPlanResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateSavingsPlanResponse' 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:
--
-- 'savingsPlanId', 'createSavingsPlanResponse_savingsPlanId' - The ID of the Savings Plan.
--
-- 'httpStatus', 'createSavingsPlanResponse_httpStatus' - The response's http status code.
newCreateSavingsPlanResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateSavingsPlanResponse
newCreateSavingsPlanResponse :: Int -> CreateSavingsPlanResponse
newCreateSavingsPlanResponse Int
pHttpStatus_ =
  CreateSavingsPlanResponse'
    { $sel:savingsPlanId:CreateSavingsPlanResponse' :: Maybe Text
savingsPlanId =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateSavingsPlanResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The ID of the Savings Plan.
createSavingsPlanResponse_savingsPlanId :: Lens.Lens' CreateSavingsPlanResponse (Prelude.Maybe Prelude.Text)
createSavingsPlanResponse_savingsPlanId :: Lens' CreateSavingsPlanResponse (Maybe Text)
createSavingsPlanResponse_savingsPlanId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateSavingsPlanResponse' {Maybe Text
savingsPlanId :: Maybe Text
$sel:savingsPlanId:CreateSavingsPlanResponse' :: CreateSavingsPlanResponse -> Maybe Text
savingsPlanId} -> Maybe Text
savingsPlanId) (\s :: CreateSavingsPlanResponse
s@CreateSavingsPlanResponse' {} Maybe Text
a -> CreateSavingsPlanResponse
s {$sel:savingsPlanId:CreateSavingsPlanResponse' :: Maybe Text
savingsPlanId = Maybe Text
a} :: CreateSavingsPlanResponse)

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

instance Prelude.NFData CreateSavingsPlanResponse where
  rnf :: CreateSavingsPlanResponse -> ()
rnf CreateSavingsPlanResponse' {Int
Maybe Text
httpStatus :: Int
savingsPlanId :: Maybe Text
$sel:httpStatus:CreateSavingsPlanResponse' :: CreateSavingsPlanResponse -> Int
$sel:savingsPlanId:CreateSavingsPlanResponse' :: CreateSavingsPlanResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
savingsPlanId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus