{-# 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.ModifyDefaultCreditSpecification
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Modifies the default credit option for CPU usage of burstable
-- performance instances. The default credit option is set at the account
-- level per Amazon Web Services Region, and is specified per instance
-- family. All new burstable performance instances in the account launch
-- using the default credit option.
--
-- @ModifyDefaultCreditSpecification@ is an asynchronous operation, which
-- works at an Amazon Web Services Region level and modifies the credit
-- option for each Availability Zone. All zones in a Region are updated
-- within five minutes. But if instances are launched during this
-- operation, they might not get the new credit option until the zone is
-- updated. To verify whether the update has occurred, you can call
-- @GetDefaultCreditSpecification@ and check @DefaultCreditSpecification@
-- for updates.
--
-- For more information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/burstable-performance-instances.html Burstable performance instances>
-- in the /Amazon EC2 User Guide/.
module Amazonka.EC2.ModifyDefaultCreditSpecification
  ( -- * Creating a Request
    ModifyDefaultCreditSpecification (..),
    newModifyDefaultCreditSpecification,

    -- * Request Lenses
    modifyDefaultCreditSpecification_dryRun,
    modifyDefaultCreditSpecification_instanceFamily,
    modifyDefaultCreditSpecification_cpuCredits,

    -- * Destructuring the Response
    ModifyDefaultCreditSpecificationResponse (..),
    newModifyDefaultCreditSpecificationResponse,

    -- * Response Lenses
    modifyDefaultCreditSpecificationResponse_instanceFamilyCreditSpecification,
    modifyDefaultCreditSpecificationResponse_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

-- | /See:/ 'newModifyDefaultCreditSpecification' smart constructor.
data ModifyDefaultCreditSpecification = ModifyDefaultCreditSpecification'
  { -- | Checks whether you have the required permissions for the action, without
    -- actually making the request, and provides an error response. If you have
    -- the required permissions, the error response is @DryRunOperation@.
    -- Otherwise, it is @UnauthorizedOperation@.
    ModifyDefaultCreditSpecification -> Maybe Bool
dryRun :: Prelude.Maybe Prelude.Bool,
    -- | The instance family.
    ModifyDefaultCreditSpecification
-> UnlimitedSupportedInstanceFamily
instanceFamily :: UnlimitedSupportedInstanceFamily,
    -- | The credit option for CPU usage of the instance family.
    --
    -- Valid Values: @standard@ | @unlimited@
    ModifyDefaultCreditSpecification -> Text
cpuCredits :: Prelude.Text
  }
  deriving (ModifyDefaultCreditSpecification
-> ModifyDefaultCreditSpecification -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModifyDefaultCreditSpecification
-> ModifyDefaultCreditSpecification -> Bool
$c/= :: ModifyDefaultCreditSpecification
-> ModifyDefaultCreditSpecification -> Bool
== :: ModifyDefaultCreditSpecification
-> ModifyDefaultCreditSpecification -> Bool
$c== :: ModifyDefaultCreditSpecification
-> ModifyDefaultCreditSpecification -> Bool
Prelude.Eq, ReadPrec [ModifyDefaultCreditSpecification]
ReadPrec ModifyDefaultCreditSpecification
Int -> ReadS ModifyDefaultCreditSpecification
ReadS [ModifyDefaultCreditSpecification]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ModifyDefaultCreditSpecification]
$creadListPrec :: ReadPrec [ModifyDefaultCreditSpecification]
readPrec :: ReadPrec ModifyDefaultCreditSpecification
$creadPrec :: ReadPrec ModifyDefaultCreditSpecification
readList :: ReadS [ModifyDefaultCreditSpecification]
$creadList :: ReadS [ModifyDefaultCreditSpecification]
readsPrec :: Int -> ReadS ModifyDefaultCreditSpecification
$creadsPrec :: Int -> ReadS ModifyDefaultCreditSpecification
Prelude.Read, Int -> ModifyDefaultCreditSpecification -> ShowS
[ModifyDefaultCreditSpecification] -> ShowS
ModifyDefaultCreditSpecification -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ModifyDefaultCreditSpecification] -> ShowS
$cshowList :: [ModifyDefaultCreditSpecification] -> ShowS
show :: ModifyDefaultCreditSpecification -> String
$cshow :: ModifyDefaultCreditSpecification -> String
showsPrec :: Int -> ModifyDefaultCreditSpecification -> ShowS
$cshowsPrec :: Int -> ModifyDefaultCreditSpecification -> ShowS
Prelude.Show, forall x.
Rep ModifyDefaultCreditSpecification x
-> ModifyDefaultCreditSpecification
forall x.
ModifyDefaultCreditSpecification
-> Rep ModifyDefaultCreditSpecification x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ModifyDefaultCreditSpecification x
-> ModifyDefaultCreditSpecification
$cfrom :: forall x.
ModifyDefaultCreditSpecification
-> Rep ModifyDefaultCreditSpecification x
Prelude.Generic)

-- |
-- Create a value of 'ModifyDefaultCreditSpecification' 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:
--
-- 'dryRun', 'modifyDefaultCreditSpecification_dryRun' - Checks whether you have the required permissions for the action, without
-- actually making the request, and provides an error response. If you have
-- the required permissions, the error response is @DryRunOperation@.
-- Otherwise, it is @UnauthorizedOperation@.
--
-- 'instanceFamily', 'modifyDefaultCreditSpecification_instanceFamily' - The instance family.
--
-- 'cpuCredits', 'modifyDefaultCreditSpecification_cpuCredits' - The credit option for CPU usage of the instance family.
--
-- Valid Values: @standard@ | @unlimited@
newModifyDefaultCreditSpecification ::
  -- | 'instanceFamily'
  UnlimitedSupportedInstanceFamily ->
  -- | 'cpuCredits'
  Prelude.Text ->
  ModifyDefaultCreditSpecification
newModifyDefaultCreditSpecification :: UnlimitedSupportedInstanceFamily
-> Text -> ModifyDefaultCreditSpecification
newModifyDefaultCreditSpecification
  UnlimitedSupportedInstanceFamily
pInstanceFamily_
  Text
pCpuCredits_ =
    ModifyDefaultCreditSpecification'
      { $sel:dryRun:ModifyDefaultCreditSpecification' :: Maybe Bool
dryRun =
          forall a. Maybe a
Prelude.Nothing,
        $sel:instanceFamily:ModifyDefaultCreditSpecification' :: UnlimitedSupportedInstanceFamily
instanceFamily = UnlimitedSupportedInstanceFamily
pInstanceFamily_,
        $sel:cpuCredits:ModifyDefaultCreditSpecification' :: Text
cpuCredits = Text
pCpuCredits_
      }

-- | Checks whether you have the required permissions for the action, without
-- actually making the request, and provides an error response. If you have
-- the required permissions, the error response is @DryRunOperation@.
-- Otherwise, it is @UnauthorizedOperation@.
modifyDefaultCreditSpecification_dryRun :: Lens.Lens' ModifyDefaultCreditSpecification (Prelude.Maybe Prelude.Bool)
modifyDefaultCreditSpecification_dryRun :: Lens' ModifyDefaultCreditSpecification (Maybe Bool)
modifyDefaultCreditSpecification_dryRun = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyDefaultCreditSpecification' {Maybe Bool
dryRun :: Maybe Bool
$sel:dryRun:ModifyDefaultCreditSpecification' :: ModifyDefaultCreditSpecification -> Maybe Bool
dryRun} -> Maybe Bool
dryRun) (\s :: ModifyDefaultCreditSpecification
s@ModifyDefaultCreditSpecification' {} Maybe Bool
a -> ModifyDefaultCreditSpecification
s {$sel:dryRun:ModifyDefaultCreditSpecification' :: Maybe Bool
dryRun = Maybe Bool
a} :: ModifyDefaultCreditSpecification)

-- | The instance family.
modifyDefaultCreditSpecification_instanceFamily :: Lens.Lens' ModifyDefaultCreditSpecification UnlimitedSupportedInstanceFamily
modifyDefaultCreditSpecification_instanceFamily :: Lens'
  ModifyDefaultCreditSpecification UnlimitedSupportedInstanceFamily
modifyDefaultCreditSpecification_instanceFamily = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyDefaultCreditSpecification' {UnlimitedSupportedInstanceFamily
instanceFamily :: UnlimitedSupportedInstanceFamily
$sel:instanceFamily:ModifyDefaultCreditSpecification' :: ModifyDefaultCreditSpecification
-> UnlimitedSupportedInstanceFamily
instanceFamily} -> UnlimitedSupportedInstanceFamily
instanceFamily) (\s :: ModifyDefaultCreditSpecification
s@ModifyDefaultCreditSpecification' {} UnlimitedSupportedInstanceFamily
a -> ModifyDefaultCreditSpecification
s {$sel:instanceFamily:ModifyDefaultCreditSpecification' :: UnlimitedSupportedInstanceFamily
instanceFamily = UnlimitedSupportedInstanceFamily
a} :: ModifyDefaultCreditSpecification)

-- | The credit option for CPU usage of the instance family.
--
-- Valid Values: @standard@ | @unlimited@
modifyDefaultCreditSpecification_cpuCredits :: Lens.Lens' ModifyDefaultCreditSpecification Prelude.Text
modifyDefaultCreditSpecification_cpuCredits :: Lens' ModifyDefaultCreditSpecification Text
modifyDefaultCreditSpecification_cpuCredits = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyDefaultCreditSpecification' {Text
cpuCredits :: Text
$sel:cpuCredits:ModifyDefaultCreditSpecification' :: ModifyDefaultCreditSpecification -> Text
cpuCredits} -> Text
cpuCredits) (\s :: ModifyDefaultCreditSpecification
s@ModifyDefaultCreditSpecification' {} Text
a -> ModifyDefaultCreditSpecification
s {$sel:cpuCredits:ModifyDefaultCreditSpecification' :: Text
cpuCredits = Text
a} :: ModifyDefaultCreditSpecification)

instance
  Core.AWSRequest
    ModifyDefaultCreditSpecification
  where
  type
    AWSResponse ModifyDefaultCreditSpecification =
      ModifyDefaultCreditSpecificationResponse
  request :: (Service -> Service)
-> ModifyDefaultCreditSpecification
-> Request ModifyDefaultCreditSpecification
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 ModifyDefaultCreditSpecification
-> ClientResponse ClientBody
-> m (Either
        Error
        (ClientResponse (AWSResponse ModifyDefaultCreditSpecification)))
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 InstanceFamilyCreditSpecification
-> Int -> ModifyDefaultCreditSpecificationResponse
ModifyDefaultCreditSpecificationResponse'
            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
"instanceFamilyCreditSpecification")
            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
    ModifyDefaultCreditSpecification
  where
  hashWithSalt :: Int -> ModifyDefaultCreditSpecification -> Int
hashWithSalt
    Int
_salt
    ModifyDefaultCreditSpecification' {Maybe Bool
Text
UnlimitedSupportedInstanceFamily
cpuCredits :: Text
instanceFamily :: UnlimitedSupportedInstanceFamily
dryRun :: Maybe Bool
$sel:cpuCredits:ModifyDefaultCreditSpecification' :: ModifyDefaultCreditSpecification -> Text
$sel:instanceFamily:ModifyDefaultCreditSpecification' :: ModifyDefaultCreditSpecification
-> UnlimitedSupportedInstanceFamily
$sel:dryRun:ModifyDefaultCreditSpecification' :: ModifyDefaultCreditSpecification -> Maybe Bool
..} =
      Int
_salt
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
dryRun
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` UnlimitedSupportedInstanceFamily
instanceFamily
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
cpuCredits

instance
  Prelude.NFData
    ModifyDefaultCreditSpecification
  where
  rnf :: ModifyDefaultCreditSpecification -> ()
rnf ModifyDefaultCreditSpecification' {Maybe Bool
Text
UnlimitedSupportedInstanceFamily
cpuCredits :: Text
instanceFamily :: UnlimitedSupportedInstanceFamily
dryRun :: Maybe Bool
$sel:cpuCredits:ModifyDefaultCreditSpecification' :: ModifyDefaultCreditSpecification -> Text
$sel:instanceFamily:ModifyDefaultCreditSpecification' :: ModifyDefaultCreditSpecification
-> UnlimitedSupportedInstanceFamily
$sel:dryRun:ModifyDefaultCreditSpecification' :: ModifyDefaultCreditSpecification -> Maybe Bool
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
dryRun
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf UnlimitedSupportedInstanceFamily
instanceFamily
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
cpuCredits

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

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

instance
  Data.ToQuery
    ModifyDefaultCreditSpecification
  where
  toQuery :: ModifyDefaultCreditSpecification -> QueryString
toQuery ModifyDefaultCreditSpecification' {Maybe Bool
Text
UnlimitedSupportedInstanceFamily
cpuCredits :: Text
instanceFamily :: UnlimitedSupportedInstanceFamily
dryRun :: Maybe Bool
$sel:cpuCredits:ModifyDefaultCreditSpecification' :: ModifyDefaultCreditSpecification -> Text
$sel:instanceFamily:ModifyDefaultCreditSpecification' :: ModifyDefaultCreditSpecification
-> UnlimitedSupportedInstanceFamily
$sel:dryRun:ModifyDefaultCreditSpecification' :: ModifyDefaultCreditSpecification -> Maybe Bool
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: ( ByteString
"ModifyDefaultCreditSpecification" ::
                      Prelude.ByteString
                  ),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2016-11-15" :: Prelude.ByteString),
        ByteString
"DryRun" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
dryRun,
        ByteString
"InstanceFamily" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: UnlimitedSupportedInstanceFamily
instanceFamily,
        ByteString
"CpuCredits" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
cpuCredits
      ]

-- | /See:/ 'newModifyDefaultCreditSpecificationResponse' smart constructor.
data ModifyDefaultCreditSpecificationResponse = ModifyDefaultCreditSpecificationResponse'
  { -- | The default credit option for CPU usage of the instance family.
    ModifyDefaultCreditSpecificationResponse
-> Maybe InstanceFamilyCreditSpecification
instanceFamilyCreditSpecification :: Prelude.Maybe InstanceFamilyCreditSpecification,
    -- | The response's http status code.
    ModifyDefaultCreditSpecificationResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ModifyDefaultCreditSpecificationResponse
-> ModifyDefaultCreditSpecificationResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModifyDefaultCreditSpecificationResponse
-> ModifyDefaultCreditSpecificationResponse -> Bool
$c/= :: ModifyDefaultCreditSpecificationResponse
-> ModifyDefaultCreditSpecificationResponse -> Bool
== :: ModifyDefaultCreditSpecificationResponse
-> ModifyDefaultCreditSpecificationResponse -> Bool
$c== :: ModifyDefaultCreditSpecificationResponse
-> ModifyDefaultCreditSpecificationResponse -> Bool
Prelude.Eq, ReadPrec [ModifyDefaultCreditSpecificationResponse]
ReadPrec ModifyDefaultCreditSpecificationResponse
Int -> ReadS ModifyDefaultCreditSpecificationResponse
ReadS [ModifyDefaultCreditSpecificationResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ModifyDefaultCreditSpecificationResponse]
$creadListPrec :: ReadPrec [ModifyDefaultCreditSpecificationResponse]
readPrec :: ReadPrec ModifyDefaultCreditSpecificationResponse
$creadPrec :: ReadPrec ModifyDefaultCreditSpecificationResponse
readList :: ReadS [ModifyDefaultCreditSpecificationResponse]
$creadList :: ReadS [ModifyDefaultCreditSpecificationResponse]
readsPrec :: Int -> ReadS ModifyDefaultCreditSpecificationResponse
$creadsPrec :: Int -> ReadS ModifyDefaultCreditSpecificationResponse
Prelude.Read, Int -> ModifyDefaultCreditSpecificationResponse -> ShowS
[ModifyDefaultCreditSpecificationResponse] -> ShowS
ModifyDefaultCreditSpecificationResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ModifyDefaultCreditSpecificationResponse] -> ShowS
$cshowList :: [ModifyDefaultCreditSpecificationResponse] -> ShowS
show :: ModifyDefaultCreditSpecificationResponse -> String
$cshow :: ModifyDefaultCreditSpecificationResponse -> String
showsPrec :: Int -> ModifyDefaultCreditSpecificationResponse -> ShowS
$cshowsPrec :: Int -> ModifyDefaultCreditSpecificationResponse -> ShowS
Prelude.Show, forall x.
Rep ModifyDefaultCreditSpecificationResponse x
-> ModifyDefaultCreditSpecificationResponse
forall x.
ModifyDefaultCreditSpecificationResponse
-> Rep ModifyDefaultCreditSpecificationResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ModifyDefaultCreditSpecificationResponse x
-> ModifyDefaultCreditSpecificationResponse
$cfrom :: forall x.
ModifyDefaultCreditSpecificationResponse
-> Rep ModifyDefaultCreditSpecificationResponse x
Prelude.Generic)

-- |
-- Create a value of 'ModifyDefaultCreditSpecificationResponse' 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:
--
-- 'instanceFamilyCreditSpecification', 'modifyDefaultCreditSpecificationResponse_instanceFamilyCreditSpecification' - The default credit option for CPU usage of the instance family.
--
-- 'httpStatus', 'modifyDefaultCreditSpecificationResponse_httpStatus' - The response's http status code.
newModifyDefaultCreditSpecificationResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ModifyDefaultCreditSpecificationResponse
newModifyDefaultCreditSpecificationResponse :: Int -> ModifyDefaultCreditSpecificationResponse
newModifyDefaultCreditSpecificationResponse
  Int
pHttpStatus_ =
    ModifyDefaultCreditSpecificationResponse'
      { $sel:instanceFamilyCreditSpecification:ModifyDefaultCreditSpecificationResponse' :: Maybe InstanceFamilyCreditSpecification
instanceFamilyCreditSpecification =
          forall a. Maybe a
Prelude.Nothing,
        $sel:httpStatus:ModifyDefaultCreditSpecificationResponse' :: Int
httpStatus = Int
pHttpStatus_
      }

-- | The default credit option for CPU usage of the instance family.
modifyDefaultCreditSpecificationResponse_instanceFamilyCreditSpecification :: Lens.Lens' ModifyDefaultCreditSpecificationResponse (Prelude.Maybe InstanceFamilyCreditSpecification)
modifyDefaultCreditSpecificationResponse_instanceFamilyCreditSpecification :: Lens'
  ModifyDefaultCreditSpecificationResponse
  (Maybe InstanceFamilyCreditSpecification)
modifyDefaultCreditSpecificationResponse_instanceFamilyCreditSpecification = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyDefaultCreditSpecificationResponse' {Maybe InstanceFamilyCreditSpecification
instanceFamilyCreditSpecification :: Maybe InstanceFamilyCreditSpecification
$sel:instanceFamilyCreditSpecification:ModifyDefaultCreditSpecificationResponse' :: ModifyDefaultCreditSpecificationResponse
-> Maybe InstanceFamilyCreditSpecification
instanceFamilyCreditSpecification} -> Maybe InstanceFamilyCreditSpecification
instanceFamilyCreditSpecification) (\s :: ModifyDefaultCreditSpecificationResponse
s@ModifyDefaultCreditSpecificationResponse' {} Maybe InstanceFamilyCreditSpecification
a -> ModifyDefaultCreditSpecificationResponse
s {$sel:instanceFamilyCreditSpecification:ModifyDefaultCreditSpecificationResponse' :: Maybe InstanceFamilyCreditSpecification
instanceFamilyCreditSpecification = Maybe InstanceFamilyCreditSpecification
a} :: ModifyDefaultCreditSpecificationResponse)

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

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