{-# 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.OpsWorks.SetLoadBasedAutoScaling
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Specify the load-based auto scaling configuration for a specified layer.
-- For more information, see
-- <https://docs.aws.amazon.com/opsworks/latest/userguide/workinginstances-autoscaling.html Managing Load with Time-based and Load-based Instances>.
--
-- To use load-based auto scaling, you must create a set of load-based auto
-- scaling instances. Load-based auto scaling operates only on the
-- instances from that set, so you must ensure that you have created enough
-- instances to handle the maximum anticipated load.
--
-- __Required Permissions__: To use this action, an IAM user must have a
-- Manage permissions level for the stack, or an attached policy that
-- explicitly grants permissions. For more information on user permissions,
-- see
-- <https://docs.aws.amazon.com/opsworks/latest/userguide/opsworks-security-users.html Managing User Permissions>.
module Amazonka.OpsWorks.SetLoadBasedAutoScaling
  ( -- * Creating a Request
    SetLoadBasedAutoScaling (..),
    newSetLoadBasedAutoScaling,

    -- * Request Lenses
    setLoadBasedAutoScaling_downScaling,
    setLoadBasedAutoScaling_enable,
    setLoadBasedAutoScaling_upScaling,
    setLoadBasedAutoScaling_layerId,

    -- * Destructuring the Response
    SetLoadBasedAutoScalingResponse (..),
    newSetLoadBasedAutoScalingResponse,
  )
where

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

-- | /See:/ 'newSetLoadBasedAutoScaling' smart constructor.
data SetLoadBasedAutoScaling = SetLoadBasedAutoScaling'
  { -- | An @AutoScalingThresholds@ object with the downscaling threshold
    -- configuration. If the load falls below these thresholds for a specified
    -- amount of time, AWS OpsWorks Stacks stops a specified number of
    -- instances.
    SetLoadBasedAutoScaling -> Maybe AutoScalingThresholds
downScaling :: Prelude.Maybe AutoScalingThresholds,
    -- | Enables load-based auto scaling for the layer.
    SetLoadBasedAutoScaling -> Maybe Bool
enable :: Prelude.Maybe Prelude.Bool,
    -- | An @AutoScalingThresholds@ object with the upscaling threshold
    -- configuration. If the load exceeds these thresholds for a specified
    -- amount of time, AWS OpsWorks Stacks starts a specified number of
    -- instances.
    SetLoadBasedAutoScaling -> Maybe AutoScalingThresholds
upScaling :: Prelude.Maybe AutoScalingThresholds,
    -- | The layer ID.
    SetLoadBasedAutoScaling -> Text
layerId :: Prelude.Text
  }
  deriving (SetLoadBasedAutoScaling -> SetLoadBasedAutoScaling -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SetLoadBasedAutoScaling -> SetLoadBasedAutoScaling -> Bool
$c/= :: SetLoadBasedAutoScaling -> SetLoadBasedAutoScaling -> Bool
== :: SetLoadBasedAutoScaling -> SetLoadBasedAutoScaling -> Bool
$c== :: SetLoadBasedAutoScaling -> SetLoadBasedAutoScaling -> Bool
Prelude.Eq, ReadPrec [SetLoadBasedAutoScaling]
ReadPrec SetLoadBasedAutoScaling
Int -> ReadS SetLoadBasedAutoScaling
ReadS [SetLoadBasedAutoScaling]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SetLoadBasedAutoScaling]
$creadListPrec :: ReadPrec [SetLoadBasedAutoScaling]
readPrec :: ReadPrec SetLoadBasedAutoScaling
$creadPrec :: ReadPrec SetLoadBasedAutoScaling
readList :: ReadS [SetLoadBasedAutoScaling]
$creadList :: ReadS [SetLoadBasedAutoScaling]
readsPrec :: Int -> ReadS SetLoadBasedAutoScaling
$creadsPrec :: Int -> ReadS SetLoadBasedAutoScaling
Prelude.Read, Int -> SetLoadBasedAutoScaling -> ShowS
[SetLoadBasedAutoScaling] -> ShowS
SetLoadBasedAutoScaling -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SetLoadBasedAutoScaling] -> ShowS
$cshowList :: [SetLoadBasedAutoScaling] -> ShowS
show :: SetLoadBasedAutoScaling -> String
$cshow :: SetLoadBasedAutoScaling -> String
showsPrec :: Int -> SetLoadBasedAutoScaling -> ShowS
$cshowsPrec :: Int -> SetLoadBasedAutoScaling -> ShowS
Prelude.Show, forall x. Rep SetLoadBasedAutoScaling x -> SetLoadBasedAutoScaling
forall x. SetLoadBasedAutoScaling -> Rep SetLoadBasedAutoScaling x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SetLoadBasedAutoScaling x -> SetLoadBasedAutoScaling
$cfrom :: forall x. SetLoadBasedAutoScaling -> Rep SetLoadBasedAutoScaling x
Prelude.Generic)

-- |
-- Create a value of 'SetLoadBasedAutoScaling' 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:
--
-- 'downScaling', 'setLoadBasedAutoScaling_downScaling' - An @AutoScalingThresholds@ object with the downscaling threshold
-- configuration. If the load falls below these thresholds for a specified
-- amount of time, AWS OpsWorks Stacks stops a specified number of
-- instances.
--
-- 'enable', 'setLoadBasedAutoScaling_enable' - Enables load-based auto scaling for the layer.
--
-- 'upScaling', 'setLoadBasedAutoScaling_upScaling' - An @AutoScalingThresholds@ object with the upscaling threshold
-- configuration. If the load exceeds these thresholds for a specified
-- amount of time, AWS OpsWorks Stacks starts a specified number of
-- instances.
--
-- 'layerId', 'setLoadBasedAutoScaling_layerId' - The layer ID.
newSetLoadBasedAutoScaling ::
  -- | 'layerId'
  Prelude.Text ->
  SetLoadBasedAutoScaling
newSetLoadBasedAutoScaling :: Text -> SetLoadBasedAutoScaling
newSetLoadBasedAutoScaling Text
pLayerId_ =
  SetLoadBasedAutoScaling'
    { $sel:downScaling:SetLoadBasedAutoScaling' :: Maybe AutoScalingThresholds
downScaling =
        forall a. Maybe a
Prelude.Nothing,
      $sel:enable:SetLoadBasedAutoScaling' :: Maybe Bool
enable = forall a. Maybe a
Prelude.Nothing,
      $sel:upScaling:SetLoadBasedAutoScaling' :: Maybe AutoScalingThresholds
upScaling = forall a. Maybe a
Prelude.Nothing,
      $sel:layerId:SetLoadBasedAutoScaling' :: Text
layerId = Text
pLayerId_
    }

-- | An @AutoScalingThresholds@ object with the downscaling threshold
-- configuration. If the load falls below these thresholds for a specified
-- amount of time, AWS OpsWorks Stacks stops a specified number of
-- instances.
setLoadBasedAutoScaling_downScaling :: Lens.Lens' SetLoadBasedAutoScaling (Prelude.Maybe AutoScalingThresholds)
setLoadBasedAutoScaling_downScaling :: Lens' SetLoadBasedAutoScaling (Maybe AutoScalingThresholds)
setLoadBasedAutoScaling_downScaling = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SetLoadBasedAutoScaling' {Maybe AutoScalingThresholds
downScaling :: Maybe AutoScalingThresholds
$sel:downScaling:SetLoadBasedAutoScaling' :: SetLoadBasedAutoScaling -> Maybe AutoScalingThresholds
downScaling} -> Maybe AutoScalingThresholds
downScaling) (\s :: SetLoadBasedAutoScaling
s@SetLoadBasedAutoScaling' {} Maybe AutoScalingThresholds
a -> SetLoadBasedAutoScaling
s {$sel:downScaling:SetLoadBasedAutoScaling' :: Maybe AutoScalingThresholds
downScaling = Maybe AutoScalingThresholds
a} :: SetLoadBasedAutoScaling)

-- | Enables load-based auto scaling for the layer.
setLoadBasedAutoScaling_enable :: Lens.Lens' SetLoadBasedAutoScaling (Prelude.Maybe Prelude.Bool)
setLoadBasedAutoScaling_enable :: Lens' SetLoadBasedAutoScaling (Maybe Bool)
setLoadBasedAutoScaling_enable = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SetLoadBasedAutoScaling' {Maybe Bool
enable :: Maybe Bool
$sel:enable:SetLoadBasedAutoScaling' :: SetLoadBasedAutoScaling -> Maybe Bool
enable} -> Maybe Bool
enable) (\s :: SetLoadBasedAutoScaling
s@SetLoadBasedAutoScaling' {} Maybe Bool
a -> SetLoadBasedAutoScaling
s {$sel:enable:SetLoadBasedAutoScaling' :: Maybe Bool
enable = Maybe Bool
a} :: SetLoadBasedAutoScaling)

-- | An @AutoScalingThresholds@ object with the upscaling threshold
-- configuration. If the load exceeds these thresholds for a specified
-- amount of time, AWS OpsWorks Stacks starts a specified number of
-- instances.
setLoadBasedAutoScaling_upScaling :: Lens.Lens' SetLoadBasedAutoScaling (Prelude.Maybe AutoScalingThresholds)
setLoadBasedAutoScaling_upScaling :: Lens' SetLoadBasedAutoScaling (Maybe AutoScalingThresholds)
setLoadBasedAutoScaling_upScaling = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SetLoadBasedAutoScaling' {Maybe AutoScalingThresholds
upScaling :: Maybe AutoScalingThresholds
$sel:upScaling:SetLoadBasedAutoScaling' :: SetLoadBasedAutoScaling -> Maybe AutoScalingThresholds
upScaling} -> Maybe AutoScalingThresholds
upScaling) (\s :: SetLoadBasedAutoScaling
s@SetLoadBasedAutoScaling' {} Maybe AutoScalingThresholds
a -> SetLoadBasedAutoScaling
s {$sel:upScaling:SetLoadBasedAutoScaling' :: Maybe AutoScalingThresholds
upScaling = Maybe AutoScalingThresholds
a} :: SetLoadBasedAutoScaling)

-- | The layer ID.
setLoadBasedAutoScaling_layerId :: Lens.Lens' SetLoadBasedAutoScaling Prelude.Text
setLoadBasedAutoScaling_layerId :: Lens' SetLoadBasedAutoScaling Text
setLoadBasedAutoScaling_layerId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SetLoadBasedAutoScaling' {Text
layerId :: Text
$sel:layerId:SetLoadBasedAutoScaling' :: SetLoadBasedAutoScaling -> Text
layerId} -> Text
layerId) (\s :: SetLoadBasedAutoScaling
s@SetLoadBasedAutoScaling' {} Text
a -> SetLoadBasedAutoScaling
s {$sel:layerId:SetLoadBasedAutoScaling' :: Text
layerId = Text
a} :: SetLoadBasedAutoScaling)

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

instance Prelude.Hashable SetLoadBasedAutoScaling where
  hashWithSalt :: Int -> SetLoadBasedAutoScaling -> Int
hashWithSalt Int
_salt SetLoadBasedAutoScaling' {Maybe Bool
Maybe AutoScalingThresholds
Text
layerId :: Text
upScaling :: Maybe AutoScalingThresholds
enable :: Maybe Bool
downScaling :: Maybe AutoScalingThresholds
$sel:layerId:SetLoadBasedAutoScaling' :: SetLoadBasedAutoScaling -> Text
$sel:upScaling:SetLoadBasedAutoScaling' :: SetLoadBasedAutoScaling -> Maybe AutoScalingThresholds
$sel:enable:SetLoadBasedAutoScaling' :: SetLoadBasedAutoScaling -> Maybe Bool
$sel:downScaling:SetLoadBasedAutoScaling' :: SetLoadBasedAutoScaling -> Maybe AutoScalingThresholds
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe AutoScalingThresholds
downScaling
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
enable
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe AutoScalingThresholds
upScaling
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
layerId

instance Prelude.NFData SetLoadBasedAutoScaling where
  rnf :: SetLoadBasedAutoScaling -> ()
rnf SetLoadBasedAutoScaling' {Maybe Bool
Maybe AutoScalingThresholds
Text
layerId :: Text
upScaling :: Maybe AutoScalingThresholds
enable :: Maybe Bool
downScaling :: Maybe AutoScalingThresholds
$sel:layerId:SetLoadBasedAutoScaling' :: SetLoadBasedAutoScaling -> Text
$sel:upScaling:SetLoadBasedAutoScaling' :: SetLoadBasedAutoScaling -> Maybe AutoScalingThresholds
$sel:enable:SetLoadBasedAutoScaling' :: SetLoadBasedAutoScaling -> Maybe Bool
$sel:downScaling:SetLoadBasedAutoScaling' :: SetLoadBasedAutoScaling -> Maybe AutoScalingThresholds
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe AutoScalingThresholds
downScaling
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
enable
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe AutoScalingThresholds
upScaling
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
layerId

instance Data.ToHeaders SetLoadBasedAutoScaling where
  toHeaders :: SetLoadBasedAutoScaling -> [Header]
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 -> [Header]
Data.=# ( ByteString
"OpsWorks_20130218.SetLoadBasedAutoScaling" ::
                          Prelude.ByteString
                      ),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> [Header]
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON SetLoadBasedAutoScaling where
  toJSON :: SetLoadBasedAutoScaling -> Value
toJSON SetLoadBasedAutoScaling' {Maybe Bool
Maybe AutoScalingThresholds
Text
layerId :: Text
upScaling :: Maybe AutoScalingThresholds
enable :: Maybe Bool
downScaling :: Maybe AutoScalingThresholds
$sel:layerId:SetLoadBasedAutoScaling' :: SetLoadBasedAutoScaling -> Text
$sel:upScaling:SetLoadBasedAutoScaling' :: SetLoadBasedAutoScaling -> Maybe AutoScalingThresholds
$sel:enable:SetLoadBasedAutoScaling' :: SetLoadBasedAutoScaling -> Maybe Bool
$sel:downScaling:SetLoadBasedAutoScaling' :: SetLoadBasedAutoScaling -> Maybe AutoScalingThresholds
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"DownScaling" 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 AutoScalingThresholds
downScaling,
            (Key
"Enable" 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 Bool
enable,
            (Key
"UpScaling" 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 AutoScalingThresholds
upScaling,
            forall a. a -> Maybe a
Prelude.Just (Key
"LayerId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
layerId)
          ]
      )

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

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

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

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

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