{-# 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.ExecutePolicy
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Executes the specified policy. This can be useful for testing the design
-- of your scaling policy.
module Amazonka.AutoScaling.ExecutePolicy
  ( -- * Creating a Request
    ExecutePolicy (..),
    newExecutePolicy,

    -- * Request Lenses
    executePolicy_autoScalingGroupName,
    executePolicy_breachThreshold,
    executePolicy_honorCooldown,
    executePolicy_metricValue,
    executePolicy_policyName,

    -- * Destructuring the Response
    ExecutePolicyResponse (..),
    newExecutePolicyResponse,
  )
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:/ 'newExecutePolicy' smart constructor.
data ExecutePolicy = ExecutePolicy'
  { -- | The name of the Auto Scaling group.
    ExecutePolicy -> Maybe Text
autoScalingGroupName :: Prelude.Maybe Prelude.Text,
    -- | The breach threshold for the alarm.
    --
    -- Required if the policy type is @StepScaling@ and not supported
    -- otherwise.
    ExecutePolicy -> Maybe Double
breachThreshold :: Prelude.Maybe Prelude.Double,
    -- | Indicates whether Amazon EC2 Auto Scaling waits for the cooldown period
    -- to complete before executing the policy.
    --
    -- Valid only if the policy type is @SimpleScaling@. For more information,
    -- see
    -- <https://docs.aws.amazon.com/autoscaling/ec2/userguide/Cooldown.html Scaling cooldowns for Amazon EC2 Auto Scaling>
    -- in the /Amazon EC2 Auto Scaling User Guide/.
    ExecutePolicy -> Maybe Bool
honorCooldown :: Prelude.Maybe Prelude.Bool,
    -- | The metric value to compare to @BreachThreshold@. This enables you to
    -- execute a policy of type @StepScaling@ and determine which step
    -- adjustment to use. For example, if the breach threshold is 50 and you
    -- want to use a step adjustment with a lower bound of 0 and an upper bound
    -- of 10, you can set the metric value to 59.
    --
    -- If you specify a metric value that doesn\'t correspond to a step
    -- adjustment for the policy, the call returns an error.
    --
    -- Required if the policy type is @StepScaling@ and not supported
    -- otherwise.
    ExecutePolicy -> Maybe Double
metricValue :: Prelude.Maybe Prelude.Double,
    -- | The name or ARN of the policy.
    ExecutePolicy -> Text
policyName :: Prelude.Text
  }
  deriving (ExecutePolicy -> ExecutePolicy -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExecutePolicy -> ExecutePolicy -> Bool
$c/= :: ExecutePolicy -> ExecutePolicy -> Bool
== :: ExecutePolicy -> ExecutePolicy -> Bool
$c== :: ExecutePolicy -> ExecutePolicy -> Bool
Prelude.Eq, ReadPrec [ExecutePolicy]
ReadPrec ExecutePolicy
Int -> ReadS ExecutePolicy
ReadS [ExecutePolicy]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ExecutePolicy]
$creadListPrec :: ReadPrec [ExecutePolicy]
readPrec :: ReadPrec ExecutePolicy
$creadPrec :: ReadPrec ExecutePolicy
readList :: ReadS [ExecutePolicy]
$creadList :: ReadS [ExecutePolicy]
readsPrec :: Int -> ReadS ExecutePolicy
$creadsPrec :: Int -> ReadS ExecutePolicy
Prelude.Read, Int -> ExecutePolicy -> ShowS
[ExecutePolicy] -> ShowS
ExecutePolicy -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExecutePolicy] -> ShowS
$cshowList :: [ExecutePolicy] -> ShowS
show :: ExecutePolicy -> String
$cshow :: ExecutePolicy -> String
showsPrec :: Int -> ExecutePolicy -> ShowS
$cshowsPrec :: Int -> ExecutePolicy -> ShowS
Prelude.Show, forall x. Rep ExecutePolicy x -> ExecutePolicy
forall x. ExecutePolicy -> Rep ExecutePolicy x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ExecutePolicy x -> ExecutePolicy
$cfrom :: forall x. ExecutePolicy -> Rep ExecutePolicy x
Prelude.Generic)

-- |
-- Create a value of 'ExecutePolicy' 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:
--
-- 'autoScalingGroupName', 'executePolicy_autoScalingGroupName' - The name of the Auto Scaling group.
--
-- 'breachThreshold', 'executePolicy_breachThreshold' - The breach threshold for the alarm.
--
-- Required if the policy type is @StepScaling@ and not supported
-- otherwise.
--
-- 'honorCooldown', 'executePolicy_honorCooldown' - Indicates whether Amazon EC2 Auto Scaling waits for the cooldown period
-- to complete before executing the policy.
--
-- Valid only if the policy type is @SimpleScaling@. For more information,
-- see
-- <https://docs.aws.amazon.com/autoscaling/ec2/userguide/Cooldown.html Scaling cooldowns for Amazon EC2 Auto Scaling>
-- in the /Amazon EC2 Auto Scaling User Guide/.
--
-- 'metricValue', 'executePolicy_metricValue' - The metric value to compare to @BreachThreshold@. This enables you to
-- execute a policy of type @StepScaling@ and determine which step
-- adjustment to use. For example, if the breach threshold is 50 and you
-- want to use a step adjustment with a lower bound of 0 and an upper bound
-- of 10, you can set the metric value to 59.
--
-- If you specify a metric value that doesn\'t correspond to a step
-- adjustment for the policy, the call returns an error.
--
-- Required if the policy type is @StepScaling@ and not supported
-- otherwise.
--
-- 'policyName', 'executePolicy_policyName' - The name or ARN of the policy.
newExecutePolicy ::
  -- | 'policyName'
  Prelude.Text ->
  ExecutePolicy
newExecutePolicy :: Text -> ExecutePolicy
newExecutePolicy Text
pPolicyName_ =
  ExecutePolicy'
    { $sel:autoScalingGroupName:ExecutePolicy' :: Maybe Text
autoScalingGroupName =
        forall a. Maybe a
Prelude.Nothing,
      $sel:breachThreshold:ExecutePolicy' :: Maybe Double
breachThreshold = forall a. Maybe a
Prelude.Nothing,
      $sel:honorCooldown:ExecutePolicy' :: Maybe Bool
honorCooldown = forall a. Maybe a
Prelude.Nothing,
      $sel:metricValue:ExecutePolicy' :: Maybe Double
metricValue = forall a. Maybe a
Prelude.Nothing,
      $sel:policyName:ExecutePolicy' :: Text
policyName = Text
pPolicyName_
    }

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

-- | The breach threshold for the alarm.
--
-- Required if the policy type is @StepScaling@ and not supported
-- otherwise.
executePolicy_breachThreshold :: Lens.Lens' ExecutePolicy (Prelude.Maybe Prelude.Double)
executePolicy_breachThreshold :: Lens' ExecutePolicy (Maybe Double)
executePolicy_breachThreshold = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ExecutePolicy' {Maybe Double
breachThreshold :: Maybe Double
$sel:breachThreshold:ExecutePolicy' :: ExecutePolicy -> Maybe Double
breachThreshold} -> Maybe Double
breachThreshold) (\s :: ExecutePolicy
s@ExecutePolicy' {} Maybe Double
a -> ExecutePolicy
s {$sel:breachThreshold:ExecutePolicy' :: Maybe Double
breachThreshold = Maybe Double
a} :: ExecutePolicy)

-- | Indicates whether Amazon EC2 Auto Scaling waits for the cooldown period
-- to complete before executing the policy.
--
-- Valid only if the policy type is @SimpleScaling@. For more information,
-- see
-- <https://docs.aws.amazon.com/autoscaling/ec2/userguide/Cooldown.html Scaling cooldowns for Amazon EC2 Auto Scaling>
-- in the /Amazon EC2 Auto Scaling User Guide/.
executePolicy_honorCooldown :: Lens.Lens' ExecutePolicy (Prelude.Maybe Prelude.Bool)
executePolicy_honorCooldown :: Lens' ExecutePolicy (Maybe Bool)
executePolicy_honorCooldown = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ExecutePolicy' {Maybe Bool
honorCooldown :: Maybe Bool
$sel:honorCooldown:ExecutePolicy' :: ExecutePolicy -> Maybe Bool
honorCooldown} -> Maybe Bool
honorCooldown) (\s :: ExecutePolicy
s@ExecutePolicy' {} Maybe Bool
a -> ExecutePolicy
s {$sel:honorCooldown:ExecutePolicy' :: Maybe Bool
honorCooldown = Maybe Bool
a} :: ExecutePolicy)

-- | The metric value to compare to @BreachThreshold@. This enables you to
-- execute a policy of type @StepScaling@ and determine which step
-- adjustment to use. For example, if the breach threshold is 50 and you
-- want to use a step adjustment with a lower bound of 0 and an upper bound
-- of 10, you can set the metric value to 59.
--
-- If you specify a metric value that doesn\'t correspond to a step
-- adjustment for the policy, the call returns an error.
--
-- Required if the policy type is @StepScaling@ and not supported
-- otherwise.
executePolicy_metricValue :: Lens.Lens' ExecutePolicy (Prelude.Maybe Prelude.Double)
executePolicy_metricValue :: Lens' ExecutePolicy (Maybe Double)
executePolicy_metricValue = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ExecutePolicy' {Maybe Double
metricValue :: Maybe Double
$sel:metricValue:ExecutePolicy' :: ExecutePolicy -> Maybe Double
metricValue} -> Maybe Double
metricValue) (\s :: ExecutePolicy
s@ExecutePolicy' {} Maybe Double
a -> ExecutePolicy
s {$sel:metricValue:ExecutePolicy' :: Maybe Double
metricValue = Maybe Double
a} :: ExecutePolicy)

-- | The name or ARN of the policy.
executePolicy_policyName :: Lens.Lens' ExecutePolicy Prelude.Text
executePolicy_policyName :: Lens' ExecutePolicy Text
executePolicy_policyName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ExecutePolicy' {Text
policyName :: Text
$sel:policyName:ExecutePolicy' :: ExecutePolicy -> Text
policyName} -> Text
policyName) (\s :: ExecutePolicy
s@ExecutePolicy' {} Text
a -> ExecutePolicy
s {$sel:policyName:ExecutePolicy' :: Text
policyName = Text
a} :: ExecutePolicy)

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

instance Prelude.Hashable ExecutePolicy where
  hashWithSalt :: Int -> ExecutePolicy -> Int
hashWithSalt Int
_salt ExecutePolicy' {Maybe Bool
Maybe Double
Maybe Text
Text
policyName :: Text
metricValue :: Maybe Double
honorCooldown :: Maybe Bool
breachThreshold :: Maybe Double
autoScalingGroupName :: Maybe Text
$sel:policyName:ExecutePolicy' :: ExecutePolicy -> Text
$sel:metricValue:ExecutePolicy' :: ExecutePolicy -> Maybe Double
$sel:honorCooldown:ExecutePolicy' :: ExecutePolicy -> Maybe Bool
$sel:breachThreshold:ExecutePolicy' :: ExecutePolicy -> Maybe Double
$sel:autoScalingGroupName:ExecutePolicy' :: ExecutePolicy -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
autoScalingGroupName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Double
breachThreshold
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
honorCooldown
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Double
metricValue
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
policyName

instance Prelude.NFData ExecutePolicy where
  rnf :: ExecutePolicy -> ()
rnf ExecutePolicy' {Maybe Bool
Maybe Double
Maybe Text
Text
policyName :: Text
metricValue :: Maybe Double
honorCooldown :: Maybe Bool
breachThreshold :: Maybe Double
autoScalingGroupName :: Maybe Text
$sel:policyName:ExecutePolicy' :: ExecutePolicy -> Text
$sel:metricValue:ExecutePolicy' :: ExecutePolicy -> Maybe Double
$sel:honorCooldown:ExecutePolicy' :: ExecutePolicy -> Maybe Bool
$sel:breachThreshold:ExecutePolicy' :: ExecutePolicy -> Maybe Double
$sel:autoScalingGroupName:ExecutePolicy' :: ExecutePolicy -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
autoScalingGroupName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Double
breachThreshold
      seq :: forall a b. a -> b -> b
`Prelude.seq` 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 Maybe Double
metricValue
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
policyName

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

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

instance Data.ToQuery ExecutePolicy where
  toQuery :: ExecutePolicy -> QueryString
toQuery ExecutePolicy' {Maybe Bool
Maybe Double
Maybe Text
Text
policyName :: Text
metricValue :: Maybe Double
honorCooldown :: Maybe Bool
breachThreshold :: Maybe Double
autoScalingGroupName :: Maybe Text
$sel:policyName:ExecutePolicy' :: ExecutePolicy -> Text
$sel:metricValue:ExecutePolicy' :: ExecutePolicy -> Maybe Double
$sel:honorCooldown:ExecutePolicy' :: ExecutePolicy -> Maybe Bool
$sel:breachThreshold:ExecutePolicy' :: ExecutePolicy -> Maybe Double
$sel:autoScalingGroupName:ExecutePolicy' :: ExecutePolicy -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"ExecutePolicy" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2011-01-01" :: Prelude.ByteString),
        ByteString
"AutoScalingGroupName" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
autoScalingGroupName,
        ByteString
"BreachThreshold" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Double
breachThreshold,
        ByteString
"HonorCooldown" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
honorCooldown,
        ByteString
"MetricValue" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Double
metricValue,
        ByteString
"PolicyName" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
policyName
      ]

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

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

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