{-# 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.AutoScaling.PutWarmPool
-- 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 or updates a warm pool for the specified Auto Scaling group. A
-- warm pool is a pool of pre-initialized EC2 instances that sits alongside
-- the Auto Scaling group. Whenever your application needs to scale out,
-- the Auto Scaling group can draw on the warm pool to meet its new desired
-- capacity. For more information and example configurations, see
-- <https://docs.aws.amazon.com/autoscaling/ec2/userguide/ec2-auto-scaling-warm-pools.html Warm pools for Amazon EC2 Auto Scaling>
-- in the /Amazon EC2 Auto Scaling User Guide/.
--
-- This operation must be called from the Region in which the Auto Scaling
-- group was created. This operation cannot be called on an Auto Scaling
-- group that has a mixed instances policy or a launch template or launch
-- configuration that requests Spot Instances.
--
-- You can view the instances in the warm pool using the DescribeWarmPool
-- API call. If you are no longer using a warm pool, you can delete it by
-- calling the DeleteWarmPool API.
module Amazonka.AutoScaling.PutWarmPool
  ( -- * Creating a Request
    PutWarmPool (..),
    newPutWarmPool,

    -- * Request Lenses
    putWarmPool_instanceReusePolicy,
    putWarmPool_maxGroupPreparedCapacity,
    putWarmPool_minSize,
    putWarmPool_poolState,
    putWarmPool_autoScalingGroupName,

    -- * Destructuring the Response
    PutWarmPoolResponse (..),
    newPutWarmPoolResponse,

    -- * Response Lenses
    putWarmPoolResponse_httpStatus,
  )
where

import Amazonka.AutoScaling.Types
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

-- | /See:/ 'newPutWarmPool' smart constructor.
data PutWarmPool = PutWarmPool'
  { -- | Indicates whether instances in the Auto Scaling group can be returned to
    -- the warm pool on scale in. The default is to terminate instances in the
    -- Auto Scaling group when the group scales in.
    PutWarmPool -> Maybe InstanceReusePolicy
instanceReusePolicy :: Prelude.Maybe InstanceReusePolicy,
    -- | Specifies the maximum number of instances that are allowed to be in the
    -- warm pool or in any state except @Terminated@ for the Auto Scaling
    -- group. This is an optional property. Specify it only if you do not want
    -- the warm pool size to be determined by the difference between the
    -- group\'s maximum capacity and its desired capacity.
    --
    -- If a value for @MaxGroupPreparedCapacity@ is not specified, Amazon EC2
    -- Auto Scaling launches and maintains the difference between the group\'s
    -- maximum capacity and its desired capacity. If you specify a value for
    -- @MaxGroupPreparedCapacity@, Amazon EC2 Auto Scaling uses the difference
    -- between the @MaxGroupPreparedCapacity@ and the desired capacity instead.
    --
    -- The size of the warm pool is dynamic. Only when
    -- @MaxGroupPreparedCapacity@ and @MinSize@ are set to the same value does
    -- the warm pool have an absolute size.
    --
    -- If the desired capacity of the Auto Scaling group is higher than the
    -- @MaxGroupPreparedCapacity@, the capacity of the warm pool is 0, unless
    -- you specify a value for @MinSize@. To remove a value that you previously
    -- set, include the property but specify -1 for the value.
    PutWarmPool -> Maybe Int
maxGroupPreparedCapacity :: Prelude.Maybe Prelude.Int,
    -- | Specifies the minimum number of instances to maintain in the warm pool.
    -- This helps you to ensure that there is always a certain number of warmed
    -- instances available to handle traffic spikes. Defaults to 0 if not
    -- specified.
    PutWarmPool -> Maybe Natural
minSize :: Prelude.Maybe Prelude.Natural,
    -- | Sets the instance state to transition to after the lifecycle actions are
    -- complete. Default is @Stopped@.
    PutWarmPool -> Maybe WarmPoolState
poolState :: Prelude.Maybe WarmPoolState,
    -- | The name of the Auto Scaling group.
    PutWarmPool -> Text
autoScalingGroupName :: Prelude.Text
  }
  deriving (PutWarmPool -> PutWarmPool -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PutWarmPool -> PutWarmPool -> Bool
$c/= :: PutWarmPool -> PutWarmPool -> Bool
== :: PutWarmPool -> PutWarmPool -> Bool
$c== :: PutWarmPool -> PutWarmPool -> Bool
Prelude.Eq, ReadPrec [PutWarmPool]
ReadPrec PutWarmPool
Int -> ReadS PutWarmPool
ReadS [PutWarmPool]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PutWarmPool]
$creadListPrec :: ReadPrec [PutWarmPool]
readPrec :: ReadPrec PutWarmPool
$creadPrec :: ReadPrec PutWarmPool
readList :: ReadS [PutWarmPool]
$creadList :: ReadS [PutWarmPool]
readsPrec :: Int -> ReadS PutWarmPool
$creadsPrec :: Int -> ReadS PutWarmPool
Prelude.Read, Int -> PutWarmPool -> ShowS
[PutWarmPool] -> ShowS
PutWarmPool -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PutWarmPool] -> ShowS
$cshowList :: [PutWarmPool] -> ShowS
show :: PutWarmPool -> String
$cshow :: PutWarmPool -> String
showsPrec :: Int -> PutWarmPool -> ShowS
$cshowsPrec :: Int -> PutWarmPool -> ShowS
Prelude.Show, forall x. Rep PutWarmPool x -> PutWarmPool
forall x. PutWarmPool -> Rep PutWarmPool x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PutWarmPool x -> PutWarmPool
$cfrom :: forall x. PutWarmPool -> Rep PutWarmPool x
Prelude.Generic)

-- |
-- Create a value of 'PutWarmPool' 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:
--
-- 'instanceReusePolicy', 'putWarmPool_instanceReusePolicy' - Indicates whether instances in the Auto Scaling group can be returned to
-- the warm pool on scale in. The default is to terminate instances in the
-- Auto Scaling group when the group scales in.
--
-- 'maxGroupPreparedCapacity', 'putWarmPool_maxGroupPreparedCapacity' - Specifies the maximum number of instances that are allowed to be in the
-- warm pool or in any state except @Terminated@ for the Auto Scaling
-- group. This is an optional property. Specify it only if you do not want
-- the warm pool size to be determined by the difference between the
-- group\'s maximum capacity and its desired capacity.
--
-- If a value for @MaxGroupPreparedCapacity@ is not specified, Amazon EC2
-- Auto Scaling launches and maintains the difference between the group\'s
-- maximum capacity and its desired capacity. If you specify a value for
-- @MaxGroupPreparedCapacity@, Amazon EC2 Auto Scaling uses the difference
-- between the @MaxGroupPreparedCapacity@ and the desired capacity instead.
--
-- The size of the warm pool is dynamic. Only when
-- @MaxGroupPreparedCapacity@ and @MinSize@ are set to the same value does
-- the warm pool have an absolute size.
--
-- If the desired capacity of the Auto Scaling group is higher than the
-- @MaxGroupPreparedCapacity@, the capacity of the warm pool is 0, unless
-- you specify a value for @MinSize@. To remove a value that you previously
-- set, include the property but specify -1 for the value.
--
-- 'minSize', 'putWarmPool_minSize' - Specifies the minimum number of instances to maintain in the warm pool.
-- This helps you to ensure that there is always a certain number of warmed
-- instances available to handle traffic spikes. Defaults to 0 if not
-- specified.
--
-- 'poolState', 'putWarmPool_poolState' - Sets the instance state to transition to after the lifecycle actions are
-- complete. Default is @Stopped@.
--
-- 'autoScalingGroupName', 'putWarmPool_autoScalingGroupName' - The name of the Auto Scaling group.
newPutWarmPool ::
  -- | 'autoScalingGroupName'
  Prelude.Text ->
  PutWarmPool
newPutWarmPool :: Text -> PutWarmPool
newPutWarmPool Text
pAutoScalingGroupName_ =
  PutWarmPool'
    { $sel:instanceReusePolicy:PutWarmPool' :: Maybe InstanceReusePolicy
instanceReusePolicy = forall a. Maybe a
Prelude.Nothing,
      $sel:maxGroupPreparedCapacity:PutWarmPool' :: Maybe Int
maxGroupPreparedCapacity = forall a. Maybe a
Prelude.Nothing,
      $sel:minSize:PutWarmPool' :: Maybe Natural
minSize = forall a. Maybe a
Prelude.Nothing,
      $sel:poolState:PutWarmPool' :: Maybe WarmPoolState
poolState = forall a. Maybe a
Prelude.Nothing,
      $sel:autoScalingGroupName:PutWarmPool' :: Text
autoScalingGroupName = Text
pAutoScalingGroupName_
    }

-- | Indicates whether instances in the Auto Scaling group can be returned to
-- the warm pool on scale in. The default is to terminate instances in the
-- Auto Scaling group when the group scales in.
putWarmPool_instanceReusePolicy :: Lens.Lens' PutWarmPool (Prelude.Maybe InstanceReusePolicy)
putWarmPool_instanceReusePolicy :: Lens' PutWarmPool (Maybe InstanceReusePolicy)
putWarmPool_instanceReusePolicy = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutWarmPool' {Maybe InstanceReusePolicy
instanceReusePolicy :: Maybe InstanceReusePolicy
$sel:instanceReusePolicy:PutWarmPool' :: PutWarmPool -> Maybe InstanceReusePolicy
instanceReusePolicy} -> Maybe InstanceReusePolicy
instanceReusePolicy) (\s :: PutWarmPool
s@PutWarmPool' {} Maybe InstanceReusePolicy
a -> PutWarmPool
s {$sel:instanceReusePolicy:PutWarmPool' :: Maybe InstanceReusePolicy
instanceReusePolicy = Maybe InstanceReusePolicy
a} :: PutWarmPool)

-- | Specifies the maximum number of instances that are allowed to be in the
-- warm pool or in any state except @Terminated@ for the Auto Scaling
-- group. This is an optional property. Specify it only if you do not want
-- the warm pool size to be determined by the difference between the
-- group\'s maximum capacity and its desired capacity.
--
-- If a value for @MaxGroupPreparedCapacity@ is not specified, Amazon EC2
-- Auto Scaling launches and maintains the difference between the group\'s
-- maximum capacity and its desired capacity. If you specify a value for
-- @MaxGroupPreparedCapacity@, Amazon EC2 Auto Scaling uses the difference
-- between the @MaxGroupPreparedCapacity@ and the desired capacity instead.
--
-- The size of the warm pool is dynamic. Only when
-- @MaxGroupPreparedCapacity@ and @MinSize@ are set to the same value does
-- the warm pool have an absolute size.
--
-- If the desired capacity of the Auto Scaling group is higher than the
-- @MaxGroupPreparedCapacity@, the capacity of the warm pool is 0, unless
-- you specify a value for @MinSize@. To remove a value that you previously
-- set, include the property but specify -1 for the value.
putWarmPool_maxGroupPreparedCapacity :: Lens.Lens' PutWarmPool (Prelude.Maybe Prelude.Int)
putWarmPool_maxGroupPreparedCapacity :: Lens' PutWarmPool (Maybe Int)
putWarmPool_maxGroupPreparedCapacity = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutWarmPool' {Maybe Int
maxGroupPreparedCapacity :: Maybe Int
$sel:maxGroupPreparedCapacity:PutWarmPool' :: PutWarmPool -> Maybe Int
maxGroupPreparedCapacity} -> Maybe Int
maxGroupPreparedCapacity) (\s :: PutWarmPool
s@PutWarmPool' {} Maybe Int
a -> PutWarmPool
s {$sel:maxGroupPreparedCapacity:PutWarmPool' :: Maybe Int
maxGroupPreparedCapacity = Maybe Int
a} :: PutWarmPool)

-- | Specifies the minimum number of instances to maintain in the warm pool.
-- This helps you to ensure that there is always a certain number of warmed
-- instances available to handle traffic spikes. Defaults to 0 if not
-- specified.
putWarmPool_minSize :: Lens.Lens' PutWarmPool (Prelude.Maybe Prelude.Natural)
putWarmPool_minSize :: Lens' PutWarmPool (Maybe Natural)
putWarmPool_minSize = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutWarmPool' {Maybe Natural
minSize :: Maybe Natural
$sel:minSize:PutWarmPool' :: PutWarmPool -> Maybe Natural
minSize} -> Maybe Natural
minSize) (\s :: PutWarmPool
s@PutWarmPool' {} Maybe Natural
a -> PutWarmPool
s {$sel:minSize:PutWarmPool' :: Maybe Natural
minSize = Maybe Natural
a} :: PutWarmPool)

-- | Sets the instance state to transition to after the lifecycle actions are
-- complete. Default is @Stopped@.
putWarmPool_poolState :: Lens.Lens' PutWarmPool (Prelude.Maybe WarmPoolState)
putWarmPool_poolState :: Lens' PutWarmPool (Maybe WarmPoolState)
putWarmPool_poolState = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutWarmPool' {Maybe WarmPoolState
poolState :: Maybe WarmPoolState
$sel:poolState:PutWarmPool' :: PutWarmPool -> Maybe WarmPoolState
poolState} -> Maybe WarmPoolState
poolState) (\s :: PutWarmPool
s@PutWarmPool' {} Maybe WarmPoolState
a -> PutWarmPool
s {$sel:poolState:PutWarmPool' :: Maybe WarmPoolState
poolState = Maybe WarmPoolState
a} :: PutWarmPool)

-- | The name of the Auto Scaling group.
putWarmPool_autoScalingGroupName :: Lens.Lens' PutWarmPool Prelude.Text
putWarmPool_autoScalingGroupName :: Lens' PutWarmPool Text
putWarmPool_autoScalingGroupName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutWarmPool' {Text
autoScalingGroupName :: Text
$sel:autoScalingGroupName:PutWarmPool' :: PutWarmPool -> Text
autoScalingGroupName} -> Text
autoScalingGroupName) (\s :: PutWarmPool
s@PutWarmPool' {} Text
a -> PutWarmPool
s {$sel:autoScalingGroupName:PutWarmPool' :: Text
autoScalingGroupName = Text
a} :: PutWarmPool)

instance Core.AWSRequest PutWarmPool where
  type AWSResponse PutWarmPool = PutWarmPoolResponse
  request :: (Service -> Service) -> PutWarmPool -> Request PutWarmPool
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 PutWarmPool
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse PutWarmPool)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
Text
-> (Int
    -> ResponseHeaders -> [Node] -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveXMLWrapper
      Text
"PutWarmPoolResult"
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Int -> PutWarmPoolResponse
PutWarmPoolResponse'
            forall (f :: * -> *) a b. Functor 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 PutWarmPool where
  hashWithSalt :: Int -> PutWarmPool -> Int
hashWithSalt Int
_salt PutWarmPool' {Maybe Int
Maybe Natural
Maybe InstanceReusePolicy
Maybe WarmPoolState
Text
autoScalingGroupName :: Text
poolState :: Maybe WarmPoolState
minSize :: Maybe Natural
maxGroupPreparedCapacity :: Maybe Int
instanceReusePolicy :: Maybe InstanceReusePolicy
$sel:autoScalingGroupName:PutWarmPool' :: PutWarmPool -> Text
$sel:poolState:PutWarmPool' :: PutWarmPool -> Maybe WarmPoolState
$sel:minSize:PutWarmPool' :: PutWarmPool -> Maybe Natural
$sel:maxGroupPreparedCapacity:PutWarmPool' :: PutWarmPool -> Maybe Int
$sel:instanceReusePolicy:PutWarmPool' :: PutWarmPool -> Maybe InstanceReusePolicy
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe InstanceReusePolicy
instanceReusePolicy
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
maxGroupPreparedCapacity
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
minSize
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe WarmPoolState
poolState
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
autoScalingGroupName

instance Prelude.NFData PutWarmPool where
  rnf :: PutWarmPool -> ()
rnf PutWarmPool' {Maybe Int
Maybe Natural
Maybe InstanceReusePolicy
Maybe WarmPoolState
Text
autoScalingGroupName :: Text
poolState :: Maybe WarmPoolState
minSize :: Maybe Natural
maxGroupPreparedCapacity :: Maybe Int
instanceReusePolicy :: Maybe InstanceReusePolicy
$sel:autoScalingGroupName:PutWarmPool' :: PutWarmPool -> Text
$sel:poolState:PutWarmPool' :: PutWarmPool -> Maybe WarmPoolState
$sel:minSize:PutWarmPool' :: PutWarmPool -> Maybe Natural
$sel:maxGroupPreparedCapacity:PutWarmPool' :: PutWarmPool -> Maybe Int
$sel:instanceReusePolicy:PutWarmPool' :: PutWarmPool -> Maybe InstanceReusePolicy
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe InstanceReusePolicy
instanceReusePolicy
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
maxGroupPreparedCapacity
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
minSize
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe WarmPoolState
poolState
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
autoScalingGroupName

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

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

instance Data.ToQuery PutWarmPool where
  toQuery :: PutWarmPool -> QueryString
toQuery PutWarmPool' {Maybe Int
Maybe Natural
Maybe InstanceReusePolicy
Maybe WarmPoolState
Text
autoScalingGroupName :: Text
poolState :: Maybe WarmPoolState
minSize :: Maybe Natural
maxGroupPreparedCapacity :: Maybe Int
instanceReusePolicy :: Maybe InstanceReusePolicy
$sel:autoScalingGroupName:PutWarmPool' :: PutWarmPool -> Text
$sel:poolState:PutWarmPool' :: PutWarmPool -> Maybe WarmPoolState
$sel:minSize:PutWarmPool' :: PutWarmPool -> Maybe Natural
$sel:maxGroupPreparedCapacity:PutWarmPool' :: PutWarmPool -> Maybe Int
$sel:instanceReusePolicy:PutWarmPool' :: PutWarmPool -> Maybe InstanceReusePolicy
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"PutWarmPool" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2011-01-01" :: Prelude.ByteString),
        ByteString
"InstanceReusePolicy" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe InstanceReusePolicy
instanceReusePolicy,
        ByteString
"MaxGroupPreparedCapacity"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Int
maxGroupPreparedCapacity,
        ByteString
"MinSize" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Natural
minSize,
        ByteString
"PoolState" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe WarmPoolState
poolState,
        ByteString
"AutoScalingGroupName" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
autoScalingGroupName
      ]

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

-- |
-- Create a value of 'PutWarmPoolResponse' 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:
--
-- 'httpStatus', 'putWarmPoolResponse_httpStatus' - The response's http status code.
newPutWarmPoolResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  PutWarmPoolResponse
newPutWarmPoolResponse :: Int -> PutWarmPoolResponse
newPutWarmPoolResponse Int
pHttpStatus_ =
  PutWarmPoolResponse' {$sel:httpStatus:PutWarmPoolResponse' :: Int
httpStatus = Int
pHttpStatus_}

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

instance Prelude.NFData PutWarmPoolResponse where
  rnf :: PutWarmPoolResponse -> ()
rnf PutWarmPoolResponse' {Int
httpStatus :: Int
$sel:httpStatus:PutWarmPoolResponse' :: PutWarmPoolResponse -> Int
..} = forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus