{-# 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.EMR.PutAutoScalingPolicy
-- 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 an automatic scaling policy for a core instance group
-- or task instance group in an Amazon EMR cluster. The automatic scaling
-- policy defines how an instance group dynamically adds and terminates EC2
-- instances in response to the value of a CloudWatch metric.
module Amazonka.EMR.PutAutoScalingPolicy
  ( -- * Creating a Request
    PutAutoScalingPolicy (..),
    newPutAutoScalingPolicy,

    -- * Request Lenses
    putAutoScalingPolicy_clusterId,
    putAutoScalingPolicy_instanceGroupId,
    putAutoScalingPolicy_autoScalingPolicy,

    -- * Destructuring the Response
    PutAutoScalingPolicyResponse (..),
    newPutAutoScalingPolicyResponse,

    -- * Response Lenses
    putAutoScalingPolicyResponse_autoScalingPolicy,
    putAutoScalingPolicyResponse_clusterArn,
    putAutoScalingPolicyResponse_clusterId,
    putAutoScalingPolicyResponse_instanceGroupId,
    putAutoScalingPolicyResponse_httpStatus,
  )
where

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

-- | /See:/ 'newPutAutoScalingPolicy' smart constructor.
data PutAutoScalingPolicy = PutAutoScalingPolicy'
  { -- | Specifies the ID of a cluster. The instance group to which the automatic
    -- scaling policy is applied is within this cluster.
    PutAutoScalingPolicy -> Text
clusterId :: Prelude.Text,
    -- | Specifies the ID of the instance group to which the automatic scaling
    -- policy is applied.
    PutAutoScalingPolicy -> Text
instanceGroupId :: Prelude.Text,
    -- | Specifies the definition of the automatic scaling policy.
    PutAutoScalingPolicy -> AutoScalingPolicy
autoScalingPolicy :: AutoScalingPolicy
  }
  deriving (PutAutoScalingPolicy -> PutAutoScalingPolicy -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PutAutoScalingPolicy -> PutAutoScalingPolicy -> Bool
$c/= :: PutAutoScalingPolicy -> PutAutoScalingPolicy -> Bool
== :: PutAutoScalingPolicy -> PutAutoScalingPolicy -> Bool
$c== :: PutAutoScalingPolicy -> PutAutoScalingPolicy -> Bool
Prelude.Eq, ReadPrec [PutAutoScalingPolicy]
ReadPrec PutAutoScalingPolicy
Int -> ReadS PutAutoScalingPolicy
ReadS [PutAutoScalingPolicy]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PutAutoScalingPolicy]
$creadListPrec :: ReadPrec [PutAutoScalingPolicy]
readPrec :: ReadPrec PutAutoScalingPolicy
$creadPrec :: ReadPrec PutAutoScalingPolicy
readList :: ReadS [PutAutoScalingPolicy]
$creadList :: ReadS [PutAutoScalingPolicy]
readsPrec :: Int -> ReadS PutAutoScalingPolicy
$creadsPrec :: Int -> ReadS PutAutoScalingPolicy
Prelude.Read, Int -> PutAutoScalingPolicy -> ShowS
[PutAutoScalingPolicy] -> ShowS
PutAutoScalingPolicy -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PutAutoScalingPolicy] -> ShowS
$cshowList :: [PutAutoScalingPolicy] -> ShowS
show :: PutAutoScalingPolicy -> String
$cshow :: PutAutoScalingPolicy -> String
showsPrec :: Int -> PutAutoScalingPolicy -> ShowS
$cshowsPrec :: Int -> PutAutoScalingPolicy -> ShowS
Prelude.Show, forall x. Rep PutAutoScalingPolicy x -> PutAutoScalingPolicy
forall x. PutAutoScalingPolicy -> Rep PutAutoScalingPolicy x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PutAutoScalingPolicy x -> PutAutoScalingPolicy
$cfrom :: forall x. PutAutoScalingPolicy -> Rep PutAutoScalingPolicy x
Prelude.Generic)

-- |
-- Create a value of 'PutAutoScalingPolicy' 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:
--
-- 'clusterId', 'putAutoScalingPolicy_clusterId' - Specifies the ID of a cluster. The instance group to which the automatic
-- scaling policy is applied is within this cluster.
--
-- 'instanceGroupId', 'putAutoScalingPolicy_instanceGroupId' - Specifies the ID of the instance group to which the automatic scaling
-- policy is applied.
--
-- 'autoScalingPolicy', 'putAutoScalingPolicy_autoScalingPolicy' - Specifies the definition of the automatic scaling policy.
newPutAutoScalingPolicy ::
  -- | 'clusterId'
  Prelude.Text ->
  -- | 'instanceGroupId'
  Prelude.Text ->
  -- | 'autoScalingPolicy'
  AutoScalingPolicy ->
  PutAutoScalingPolicy
newPutAutoScalingPolicy :: Text -> Text -> AutoScalingPolicy -> PutAutoScalingPolicy
newPutAutoScalingPolicy
  Text
pClusterId_
  Text
pInstanceGroupId_
  AutoScalingPolicy
pAutoScalingPolicy_ =
    PutAutoScalingPolicy'
      { $sel:clusterId:PutAutoScalingPolicy' :: Text
clusterId = Text
pClusterId_,
        $sel:instanceGroupId:PutAutoScalingPolicy' :: Text
instanceGroupId = Text
pInstanceGroupId_,
        $sel:autoScalingPolicy:PutAutoScalingPolicy' :: AutoScalingPolicy
autoScalingPolicy = AutoScalingPolicy
pAutoScalingPolicy_
      }

-- | Specifies the ID of a cluster. The instance group to which the automatic
-- scaling policy is applied is within this cluster.
putAutoScalingPolicy_clusterId :: Lens.Lens' PutAutoScalingPolicy Prelude.Text
putAutoScalingPolicy_clusterId :: Lens' PutAutoScalingPolicy Text
putAutoScalingPolicy_clusterId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutAutoScalingPolicy' {Text
clusterId :: Text
$sel:clusterId:PutAutoScalingPolicy' :: PutAutoScalingPolicy -> Text
clusterId} -> Text
clusterId) (\s :: PutAutoScalingPolicy
s@PutAutoScalingPolicy' {} Text
a -> PutAutoScalingPolicy
s {$sel:clusterId:PutAutoScalingPolicy' :: Text
clusterId = Text
a} :: PutAutoScalingPolicy)

-- | Specifies the ID of the instance group to which the automatic scaling
-- policy is applied.
putAutoScalingPolicy_instanceGroupId :: Lens.Lens' PutAutoScalingPolicy Prelude.Text
putAutoScalingPolicy_instanceGroupId :: Lens' PutAutoScalingPolicy Text
putAutoScalingPolicy_instanceGroupId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutAutoScalingPolicy' {Text
instanceGroupId :: Text
$sel:instanceGroupId:PutAutoScalingPolicy' :: PutAutoScalingPolicy -> Text
instanceGroupId} -> Text
instanceGroupId) (\s :: PutAutoScalingPolicy
s@PutAutoScalingPolicy' {} Text
a -> PutAutoScalingPolicy
s {$sel:instanceGroupId:PutAutoScalingPolicy' :: Text
instanceGroupId = Text
a} :: PutAutoScalingPolicy)

-- | Specifies the definition of the automatic scaling policy.
putAutoScalingPolicy_autoScalingPolicy :: Lens.Lens' PutAutoScalingPolicy AutoScalingPolicy
putAutoScalingPolicy_autoScalingPolicy :: Lens' PutAutoScalingPolicy AutoScalingPolicy
putAutoScalingPolicy_autoScalingPolicy = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutAutoScalingPolicy' {AutoScalingPolicy
autoScalingPolicy :: AutoScalingPolicy
$sel:autoScalingPolicy:PutAutoScalingPolicy' :: PutAutoScalingPolicy -> AutoScalingPolicy
autoScalingPolicy} -> AutoScalingPolicy
autoScalingPolicy) (\s :: PutAutoScalingPolicy
s@PutAutoScalingPolicy' {} AutoScalingPolicy
a -> PutAutoScalingPolicy
s {$sel:autoScalingPolicy:PutAutoScalingPolicy' :: AutoScalingPolicy
autoScalingPolicy = AutoScalingPolicy
a} :: PutAutoScalingPolicy)

instance Core.AWSRequest PutAutoScalingPolicy where
  type
    AWSResponse PutAutoScalingPolicy =
      PutAutoScalingPolicyResponse
  request :: (Service -> Service)
-> PutAutoScalingPolicy -> Request PutAutoScalingPolicy
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 PutAutoScalingPolicy
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse PutAutoScalingPolicy)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> Object -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveJSON
      ( \Int
s ResponseHeaders
h Object
x ->
          Maybe AutoScalingPolicyDescription
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Int
-> PutAutoScalingPolicyResponse
PutAutoScalingPolicyResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"AutoScalingPolicy")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"ClusterArn")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"ClusterId")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"InstanceGroupId")
            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 PutAutoScalingPolicy where
  hashWithSalt :: Int -> PutAutoScalingPolicy -> Int
hashWithSalt Int
_salt PutAutoScalingPolicy' {Text
AutoScalingPolicy
autoScalingPolicy :: AutoScalingPolicy
instanceGroupId :: Text
clusterId :: Text
$sel:autoScalingPolicy:PutAutoScalingPolicy' :: PutAutoScalingPolicy -> AutoScalingPolicy
$sel:instanceGroupId:PutAutoScalingPolicy' :: PutAutoScalingPolicy -> Text
$sel:clusterId:PutAutoScalingPolicy' :: PutAutoScalingPolicy -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
clusterId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
instanceGroupId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` AutoScalingPolicy
autoScalingPolicy

instance Prelude.NFData PutAutoScalingPolicy where
  rnf :: PutAutoScalingPolicy -> ()
rnf PutAutoScalingPolicy' {Text
AutoScalingPolicy
autoScalingPolicy :: AutoScalingPolicy
instanceGroupId :: Text
clusterId :: Text
$sel:autoScalingPolicy:PutAutoScalingPolicy' :: PutAutoScalingPolicy -> AutoScalingPolicy
$sel:instanceGroupId:PutAutoScalingPolicy' :: PutAutoScalingPolicy -> Text
$sel:clusterId:PutAutoScalingPolicy' :: PutAutoScalingPolicy -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
clusterId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
instanceGroupId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf AutoScalingPolicy
autoScalingPolicy

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

instance Data.ToJSON PutAutoScalingPolicy where
  toJSON :: PutAutoScalingPolicy -> Value
toJSON PutAutoScalingPolicy' {Text
AutoScalingPolicy
autoScalingPolicy :: AutoScalingPolicy
instanceGroupId :: Text
clusterId :: Text
$sel:autoScalingPolicy:PutAutoScalingPolicy' :: PutAutoScalingPolicy -> AutoScalingPolicy
$sel:instanceGroupId:PutAutoScalingPolicy' :: PutAutoScalingPolicy -> Text
$sel:clusterId:PutAutoScalingPolicy' :: PutAutoScalingPolicy -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just (Key
"ClusterId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
clusterId),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"InstanceGroupId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
instanceGroupId),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"AutoScalingPolicy" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= AutoScalingPolicy
autoScalingPolicy)
          ]
      )

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

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

-- | /See:/ 'newPutAutoScalingPolicyResponse' smart constructor.
data PutAutoScalingPolicyResponse = PutAutoScalingPolicyResponse'
  { -- | The automatic scaling policy definition.
    PutAutoScalingPolicyResponse -> Maybe AutoScalingPolicyDescription
autoScalingPolicy :: Prelude.Maybe AutoScalingPolicyDescription,
    -- | The Amazon Resource Name (ARN) of the cluster.
    PutAutoScalingPolicyResponse -> Maybe Text
clusterArn :: Prelude.Maybe Prelude.Text,
    -- | Specifies the ID of a cluster. The instance group to which the automatic
    -- scaling policy is applied is within this cluster.
    PutAutoScalingPolicyResponse -> Maybe Text
clusterId :: Prelude.Maybe Prelude.Text,
    -- | Specifies the ID of the instance group to which the scaling policy is
    -- applied.
    PutAutoScalingPolicyResponse -> Maybe Text
instanceGroupId :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    PutAutoScalingPolicyResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (PutAutoScalingPolicyResponse
-> PutAutoScalingPolicyResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PutAutoScalingPolicyResponse
-> PutAutoScalingPolicyResponse -> Bool
$c/= :: PutAutoScalingPolicyResponse
-> PutAutoScalingPolicyResponse -> Bool
== :: PutAutoScalingPolicyResponse
-> PutAutoScalingPolicyResponse -> Bool
$c== :: PutAutoScalingPolicyResponse
-> PutAutoScalingPolicyResponse -> Bool
Prelude.Eq, ReadPrec [PutAutoScalingPolicyResponse]
ReadPrec PutAutoScalingPolicyResponse
Int -> ReadS PutAutoScalingPolicyResponse
ReadS [PutAutoScalingPolicyResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PutAutoScalingPolicyResponse]
$creadListPrec :: ReadPrec [PutAutoScalingPolicyResponse]
readPrec :: ReadPrec PutAutoScalingPolicyResponse
$creadPrec :: ReadPrec PutAutoScalingPolicyResponse
readList :: ReadS [PutAutoScalingPolicyResponse]
$creadList :: ReadS [PutAutoScalingPolicyResponse]
readsPrec :: Int -> ReadS PutAutoScalingPolicyResponse
$creadsPrec :: Int -> ReadS PutAutoScalingPolicyResponse
Prelude.Read, Int -> PutAutoScalingPolicyResponse -> ShowS
[PutAutoScalingPolicyResponse] -> ShowS
PutAutoScalingPolicyResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PutAutoScalingPolicyResponse] -> ShowS
$cshowList :: [PutAutoScalingPolicyResponse] -> ShowS
show :: PutAutoScalingPolicyResponse -> String
$cshow :: PutAutoScalingPolicyResponse -> String
showsPrec :: Int -> PutAutoScalingPolicyResponse -> ShowS
$cshowsPrec :: Int -> PutAutoScalingPolicyResponse -> ShowS
Prelude.Show, forall x.
Rep PutAutoScalingPolicyResponse x -> PutAutoScalingPolicyResponse
forall x.
PutAutoScalingPolicyResponse -> Rep PutAutoScalingPolicyResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep PutAutoScalingPolicyResponse x -> PutAutoScalingPolicyResponse
$cfrom :: forall x.
PutAutoScalingPolicyResponse -> Rep PutAutoScalingPolicyResponse x
Prelude.Generic)

-- |
-- Create a value of 'PutAutoScalingPolicyResponse' 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:
--
-- 'autoScalingPolicy', 'putAutoScalingPolicyResponse_autoScalingPolicy' - The automatic scaling policy definition.
--
-- 'clusterArn', 'putAutoScalingPolicyResponse_clusterArn' - The Amazon Resource Name (ARN) of the cluster.
--
-- 'clusterId', 'putAutoScalingPolicyResponse_clusterId' - Specifies the ID of a cluster. The instance group to which the automatic
-- scaling policy is applied is within this cluster.
--
-- 'instanceGroupId', 'putAutoScalingPolicyResponse_instanceGroupId' - Specifies the ID of the instance group to which the scaling policy is
-- applied.
--
-- 'httpStatus', 'putAutoScalingPolicyResponse_httpStatus' - The response's http status code.
newPutAutoScalingPolicyResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  PutAutoScalingPolicyResponse
newPutAutoScalingPolicyResponse :: Int -> PutAutoScalingPolicyResponse
newPutAutoScalingPolicyResponse Int
pHttpStatus_ =
  PutAutoScalingPolicyResponse'
    { $sel:autoScalingPolicy:PutAutoScalingPolicyResponse' :: Maybe AutoScalingPolicyDescription
autoScalingPolicy =
        forall a. Maybe a
Prelude.Nothing,
      $sel:clusterArn:PutAutoScalingPolicyResponse' :: Maybe Text
clusterArn = forall a. Maybe a
Prelude.Nothing,
      $sel:clusterId:PutAutoScalingPolicyResponse' :: Maybe Text
clusterId = forall a. Maybe a
Prelude.Nothing,
      $sel:instanceGroupId:PutAutoScalingPolicyResponse' :: Maybe Text
instanceGroupId = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:PutAutoScalingPolicyResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The automatic scaling policy definition.
putAutoScalingPolicyResponse_autoScalingPolicy :: Lens.Lens' PutAutoScalingPolicyResponse (Prelude.Maybe AutoScalingPolicyDescription)
putAutoScalingPolicyResponse_autoScalingPolicy :: Lens'
  PutAutoScalingPolicyResponse (Maybe AutoScalingPolicyDescription)
putAutoScalingPolicyResponse_autoScalingPolicy = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutAutoScalingPolicyResponse' {Maybe AutoScalingPolicyDescription
autoScalingPolicy :: Maybe AutoScalingPolicyDescription
$sel:autoScalingPolicy:PutAutoScalingPolicyResponse' :: PutAutoScalingPolicyResponse -> Maybe AutoScalingPolicyDescription
autoScalingPolicy} -> Maybe AutoScalingPolicyDescription
autoScalingPolicy) (\s :: PutAutoScalingPolicyResponse
s@PutAutoScalingPolicyResponse' {} Maybe AutoScalingPolicyDescription
a -> PutAutoScalingPolicyResponse
s {$sel:autoScalingPolicy:PutAutoScalingPolicyResponse' :: Maybe AutoScalingPolicyDescription
autoScalingPolicy = Maybe AutoScalingPolicyDescription
a} :: PutAutoScalingPolicyResponse)

-- | The Amazon Resource Name (ARN) of the cluster.
putAutoScalingPolicyResponse_clusterArn :: Lens.Lens' PutAutoScalingPolicyResponse (Prelude.Maybe Prelude.Text)
putAutoScalingPolicyResponse_clusterArn :: Lens' PutAutoScalingPolicyResponse (Maybe Text)
putAutoScalingPolicyResponse_clusterArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutAutoScalingPolicyResponse' {Maybe Text
clusterArn :: Maybe Text
$sel:clusterArn:PutAutoScalingPolicyResponse' :: PutAutoScalingPolicyResponse -> Maybe Text
clusterArn} -> Maybe Text
clusterArn) (\s :: PutAutoScalingPolicyResponse
s@PutAutoScalingPolicyResponse' {} Maybe Text
a -> PutAutoScalingPolicyResponse
s {$sel:clusterArn:PutAutoScalingPolicyResponse' :: Maybe Text
clusterArn = Maybe Text
a} :: PutAutoScalingPolicyResponse)

-- | Specifies the ID of a cluster. The instance group to which the automatic
-- scaling policy is applied is within this cluster.
putAutoScalingPolicyResponse_clusterId :: Lens.Lens' PutAutoScalingPolicyResponse (Prelude.Maybe Prelude.Text)
putAutoScalingPolicyResponse_clusterId :: Lens' PutAutoScalingPolicyResponse (Maybe Text)
putAutoScalingPolicyResponse_clusterId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutAutoScalingPolicyResponse' {Maybe Text
clusterId :: Maybe Text
$sel:clusterId:PutAutoScalingPolicyResponse' :: PutAutoScalingPolicyResponse -> Maybe Text
clusterId} -> Maybe Text
clusterId) (\s :: PutAutoScalingPolicyResponse
s@PutAutoScalingPolicyResponse' {} Maybe Text
a -> PutAutoScalingPolicyResponse
s {$sel:clusterId:PutAutoScalingPolicyResponse' :: Maybe Text
clusterId = Maybe Text
a} :: PutAutoScalingPolicyResponse)

-- | Specifies the ID of the instance group to which the scaling policy is
-- applied.
putAutoScalingPolicyResponse_instanceGroupId :: Lens.Lens' PutAutoScalingPolicyResponse (Prelude.Maybe Prelude.Text)
putAutoScalingPolicyResponse_instanceGroupId :: Lens' PutAutoScalingPolicyResponse (Maybe Text)
putAutoScalingPolicyResponse_instanceGroupId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutAutoScalingPolicyResponse' {Maybe Text
instanceGroupId :: Maybe Text
$sel:instanceGroupId:PutAutoScalingPolicyResponse' :: PutAutoScalingPolicyResponse -> Maybe Text
instanceGroupId} -> Maybe Text
instanceGroupId) (\s :: PutAutoScalingPolicyResponse
s@PutAutoScalingPolicyResponse' {} Maybe Text
a -> PutAutoScalingPolicyResponse
s {$sel:instanceGroupId:PutAutoScalingPolicyResponse' :: Maybe Text
instanceGroupId = Maybe Text
a} :: PutAutoScalingPolicyResponse)

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

instance Prelude.NFData PutAutoScalingPolicyResponse where
  rnf :: PutAutoScalingPolicyResponse -> ()
rnf PutAutoScalingPolicyResponse' {Int
Maybe Text
Maybe AutoScalingPolicyDescription
httpStatus :: Int
instanceGroupId :: Maybe Text
clusterId :: Maybe Text
clusterArn :: Maybe Text
autoScalingPolicy :: Maybe AutoScalingPolicyDescription
$sel:httpStatus:PutAutoScalingPolicyResponse' :: PutAutoScalingPolicyResponse -> Int
$sel:instanceGroupId:PutAutoScalingPolicyResponse' :: PutAutoScalingPolicyResponse -> Maybe Text
$sel:clusterId:PutAutoScalingPolicyResponse' :: PutAutoScalingPolicyResponse -> Maybe Text
$sel:clusterArn:PutAutoScalingPolicyResponse' :: PutAutoScalingPolicyResponse -> Maybe Text
$sel:autoScalingPolicy:PutAutoScalingPolicyResponse' :: PutAutoScalingPolicyResponse -> Maybe AutoScalingPolicyDescription
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe AutoScalingPolicyDescription
autoScalingPolicy
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
clusterArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
clusterId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
instanceGroupId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus