{-# 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.SetDesiredCapacity
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Sets the size of the specified Auto Scaling group.
--
-- If a scale-in activity occurs as a result of a new @DesiredCapacity@
-- value that is lower than the current size of the group, the Auto Scaling
-- group uses its termination policy to determine which instances to
-- terminate.
--
-- For more information, see
-- <https://docs.aws.amazon.com/autoscaling/ec2/userguide/as-manual-scaling.html Manual scaling>
-- in the /Amazon EC2 Auto Scaling User Guide/.
module Amazonka.AutoScaling.SetDesiredCapacity
  ( -- * Creating a Request
    SetDesiredCapacity (..),
    newSetDesiredCapacity,

    -- * Request Lenses
    setDesiredCapacity_honorCooldown,
    setDesiredCapacity_autoScalingGroupName,
    setDesiredCapacity_desiredCapacity,

    -- * Destructuring the Response
    SetDesiredCapacityResponse (..),
    newSetDesiredCapacityResponse,
  )
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:/ 'newSetDesiredCapacity' smart constructor.
data SetDesiredCapacity = SetDesiredCapacity'
  { -- | Indicates whether Amazon EC2 Auto Scaling waits for the cooldown period
    -- to complete before initiating a scaling activity to set your Auto
    -- Scaling group to its new capacity. By default, Amazon EC2 Auto Scaling
    -- does not honor the cooldown period during manual scaling activities.
    SetDesiredCapacity -> Maybe Bool
honorCooldown :: Prelude.Maybe Prelude.Bool,
    -- | The name of the Auto Scaling group.
    SetDesiredCapacity -> Text
autoScalingGroupName :: Prelude.Text,
    -- | The desired capacity is the initial capacity of the Auto Scaling group
    -- after this operation completes and the capacity it attempts to maintain.
    SetDesiredCapacity -> Int
desiredCapacity :: Prelude.Int
  }
  deriving (SetDesiredCapacity -> SetDesiredCapacity -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SetDesiredCapacity -> SetDesiredCapacity -> Bool
$c/= :: SetDesiredCapacity -> SetDesiredCapacity -> Bool
== :: SetDesiredCapacity -> SetDesiredCapacity -> Bool
$c== :: SetDesiredCapacity -> SetDesiredCapacity -> Bool
Prelude.Eq, ReadPrec [SetDesiredCapacity]
ReadPrec SetDesiredCapacity
Int -> ReadS SetDesiredCapacity
ReadS [SetDesiredCapacity]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SetDesiredCapacity]
$creadListPrec :: ReadPrec [SetDesiredCapacity]
readPrec :: ReadPrec SetDesiredCapacity
$creadPrec :: ReadPrec SetDesiredCapacity
readList :: ReadS [SetDesiredCapacity]
$creadList :: ReadS [SetDesiredCapacity]
readsPrec :: Int -> ReadS SetDesiredCapacity
$creadsPrec :: Int -> ReadS SetDesiredCapacity
Prelude.Read, Int -> SetDesiredCapacity -> ShowS
[SetDesiredCapacity] -> ShowS
SetDesiredCapacity -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SetDesiredCapacity] -> ShowS
$cshowList :: [SetDesiredCapacity] -> ShowS
show :: SetDesiredCapacity -> String
$cshow :: SetDesiredCapacity -> String
showsPrec :: Int -> SetDesiredCapacity -> ShowS
$cshowsPrec :: Int -> SetDesiredCapacity -> ShowS
Prelude.Show, forall x. Rep SetDesiredCapacity x -> SetDesiredCapacity
forall x. SetDesiredCapacity -> Rep SetDesiredCapacity x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SetDesiredCapacity x -> SetDesiredCapacity
$cfrom :: forall x. SetDesiredCapacity -> Rep SetDesiredCapacity x
Prelude.Generic)

-- |
-- Create a value of 'SetDesiredCapacity' 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:
--
-- 'honorCooldown', 'setDesiredCapacity_honorCooldown' - Indicates whether Amazon EC2 Auto Scaling waits for the cooldown period
-- to complete before initiating a scaling activity to set your Auto
-- Scaling group to its new capacity. By default, Amazon EC2 Auto Scaling
-- does not honor the cooldown period during manual scaling activities.
--
-- 'autoScalingGroupName', 'setDesiredCapacity_autoScalingGroupName' - The name of the Auto Scaling group.
--
-- 'desiredCapacity', 'setDesiredCapacity_desiredCapacity' - The desired capacity is the initial capacity of the Auto Scaling group
-- after this operation completes and the capacity it attempts to maintain.
newSetDesiredCapacity ::
  -- | 'autoScalingGroupName'
  Prelude.Text ->
  -- | 'desiredCapacity'
  Prelude.Int ->
  SetDesiredCapacity
newSetDesiredCapacity :: Text -> Int -> SetDesiredCapacity
newSetDesiredCapacity
  Text
pAutoScalingGroupName_
  Int
pDesiredCapacity_ =
    SetDesiredCapacity'
      { $sel:honorCooldown:SetDesiredCapacity' :: Maybe Bool
honorCooldown =
          forall a. Maybe a
Prelude.Nothing,
        $sel:autoScalingGroupName:SetDesiredCapacity' :: Text
autoScalingGroupName = Text
pAutoScalingGroupName_,
        $sel:desiredCapacity:SetDesiredCapacity' :: Int
desiredCapacity = Int
pDesiredCapacity_
      }

-- | Indicates whether Amazon EC2 Auto Scaling waits for the cooldown period
-- to complete before initiating a scaling activity to set your Auto
-- Scaling group to its new capacity. By default, Amazon EC2 Auto Scaling
-- does not honor the cooldown period during manual scaling activities.
setDesiredCapacity_honorCooldown :: Lens.Lens' SetDesiredCapacity (Prelude.Maybe Prelude.Bool)
setDesiredCapacity_honorCooldown :: Lens' SetDesiredCapacity (Maybe Bool)
setDesiredCapacity_honorCooldown = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SetDesiredCapacity' {Maybe Bool
honorCooldown :: Maybe Bool
$sel:honorCooldown:SetDesiredCapacity' :: SetDesiredCapacity -> Maybe Bool
honorCooldown} -> Maybe Bool
honorCooldown) (\s :: SetDesiredCapacity
s@SetDesiredCapacity' {} Maybe Bool
a -> SetDesiredCapacity
s {$sel:honorCooldown:SetDesiredCapacity' :: Maybe Bool
honorCooldown = Maybe Bool
a} :: SetDesiredCapacity)

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

-- | The desired capacity is the initial capacity of the Auto Scaling group
-- after this operation completes and the capacity it attempts to maintain.
setDesiredCapacity_desiredCapacity :: Lens.Lens' SetDesiredCapacity Prelude.Int
setDesiredCapacity_desiredCapacity :: Lens' SetDesiredCapacity Int
setDesiredCapacity_desiredCapacity = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SetDesiredCapacity' {Int
desiredCapacity :: Int
$sel:desiredCapacity:SetDesiredCapacity' :: SetDesiredCapacity -> Int
desiredCapacity} -> Int
desiredCapacity) (\s :: SetDesiredCapacity
s@SetDesiredCapacity' {} Int
a -> SetDesiredCapacity
s {$sel:desiredCapacity:SetDesiredCapacity' :: Int
desiredCapacity = Int
a} :: SetDesiredCapacity)

instance Core.AWSRequest SetDesiredCapacity where
  type
    AWSResponse SetDesiredCapacity =
      SetDesiredCapacityResponse
  request :: (Service -> Service)
-> SetDesiredCapacity -> Request SetDesiredCapacity
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 SetDesiredCapacity
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse SetDesiredCapacity)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
AWSResponse a
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveNull SetDesiredCapacityResponse
SetDesiredCapacityResponse'

instance Prelude.Hashable SetDesiredCapacity where
  hashWithSalt :: Int -> SetDesiredCapacity -> Int
hashWithSalt Int
_salt SetDesiredCapacity' {Int
Maybe Bool
Text
desiredCapacity :: Int
autoScalingGroupName :: Text
honorCooldown :: Maybe Bool
$sel:desiredCapacity:SetDesiredCapacity' :: SetDesiredCapacity -> Int
$sel:autoScalingGroupName:SetDesiredCapacity' :: SetDesiredCapacity -> Text
$sel:honorCooldown:SetDesiredCapacity' :: SetDesiredCapacity -> Maybe Bool
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
honorCooldown
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
autoScalingGroupName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Int
desiredCapacity

instance Prelude.NFData SetDesiredCapacity where
  rnf :: SetDesiredCapacity -> ()
rnf SetDesiredCapacity' {Int
Maybe Bool
Text
desiredCapacity :: Int
autoScalingGroupName :: Text
honorCooldown :: Maybe Bool
$sel:desiredCapacity:SetDesiredCapacity' :: SetDesiredCapacity -> Int
$sel:autoScalingGroupName:SetDesiredCapacity' :: SetDesiredCapacity -> Text
$sel:honorCooldown:SetDesiredCapacity' :: SetDesiredCapacity -> Maybe Bool
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
honorCooldown
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
autoScalingGroupName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
desiredCapacity

instance Data.ToHeaders SetDesiredCapacity where
  toHeaders :: SetDesiredCapacity -> [Header]
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

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

instance Data.ToQuery SetDesiredCapacity where
  toQuery :: SetDesiredCapacity -> QueryString
toQuery SetDesiredCapacity' {Int
Maybe Bool
Text
desiredCapacity :: Int
autoScalingGroupName :: Text
honorCooldown :: Maybe Bool
$sel:desiredCapacity:SetDesiredCapacity' :: SetDesiredCapacity -> Int
$sel:autoScalingGroupName:SetDesiredCapacity' :: SetDesiredCapacity -> Text
$sel:honorCooldown:SetDesiredCapacity' :: SetDesiredCapacity -> Maybe Bool
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"SetDesiredCapacity" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2011-01-01" :: Prelude.ByteString),
        ByteString
"HonorCooldown" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
honorCooldown,
        ByteString
"AutoScalingGroupName" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
autoScalingGroupName,
        ByteString
"DesiredCapacity" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Int
desiredCapacity
      ]

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

-- |
-- Create a value of 'SetDesiredCapacityResponse' 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.
newSetDesiredCapacityResponse ::
  SetDesiredCapacityResponse
newSetDesiredCapacityResponse :: SetDesiredCapacityResponse
newSetDesiredCapacityResponse =
  SetDesiredCapacityResponse
SetDesiredCapacityResponse'

instance Prelude.NFData SetDesiredCapacityResponse where
  rnf :: SetDesiredCapacityResponse -> ()
rnf SetDesiredCapacityResponse
_ = ()