{-# 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.GameLift.DeleteScalingPolicy
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Deletes a fleet scaling policy. Once deleted, the policy is no longer in
-- force and GameLift removes all record of it. To delete a scaling policy,
-- specify both the scaling policy name and the fleet ID it is associated
-- with.
--
-- To temporarily suspend scaling policies, use
-- <https://docs.aws.amazon.com/gamelift/latest/apireference/API_StopFleetActions.html StopFleetActions>.
-- This operation suspends all policies for the fleet.
module Amazonka.GameLift.DeleteScalingPolicy
  ( -- * Creating a Request
    DeleteScalingPolicy (..),
    newDeleteScalingPolicy,

    -- * Request Lenses
    deleteScalingPolicy_name,
    deleteScalingPolicy_fleetId,

    -- * Destructuring the Response
    DeleteScalingPolicyResponse (..),
    newDeleteScalingPolicyResponse,
  )
where

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

-- | /See:/ 'newDeleteScalingPolicy' smart constructor.
data DeleteScalingPolicy = DeleteScalingPolicy'
  { -- | A descriptive label that is associated with a fleet\'s scaling policy.
    -- Policy names do not need to be unique.
    DeleteScalingPolicy -> Text
name :: Prelude.Text,
    -- | A unique identifier for the fleet to be deleted. You can use either the
    -- fleet ID or ARN value.
    DeleteScalingPolicy -> Text
fleetId :: Prelude.Text
  }
  deriving (DeleteScalingPolicy -> DeleteScalingPolicy -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeleteScalingPolicy -> DeleteScalingPolicy -> Bool
$c/= :: DeleteScalingPolicy -> DeleteScalingPolicy -> Bool
== :: DeleteScalingPolicy -> DeleteScalingPolicy -> Bool
$c== :: DeleteScalingPolicy -> DeleteScalingPolicy -> Bool
Prelude.Eq, ReadPrec [DeleteScalingPolicy]
ReadPrec DeleteScalingPolicy
Int -> ReadS DeleteScalingPolicy
ReadS [DeleteScalingPolicy]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeleteScalingPolicy]
$creadListPrec :: ReadPrec [DeleteScalingPolicy]
readPrec :: ReadPrec DeleteScalingPolicy
$creadPrec :: ReadPrec DeleteScalingPolicy
readList :: ReadS [DeleteScalingPolicy]
$creadList :: ReadS [DeleteScalingPolicy]
readsPrec :: Int -> ReadS DeleteScalingPolicy
$creadsPrec :: Int -> ReadS DeleteScalingPolicy
Prelude.Read, Int -> DeleteScalingPolicy -> ShowS
[DeleteScalingPolicy] -> ShowS
DeleteScalingPolicy -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeleteScalingPolicy] -> ShowS
$cshowList :: [DeleteScalingPolicy] -> ShowS
show :: DeleteScalingPolicy -> String
$cshow :: DeleteScalingPolicy -> String
showsPrec :: Int -> DeleteScalingPolicy -> ShowS
$cshowsPrec :: Int -> DeleteScalingPolicy -> ShowS
Prelude.Show, forall x. Rep DeleteScalingPolicy x -> DeleteScalingPolicy
forall x. DeleteScalingPolicy -> Rep DeleteScalingPolicy x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DeleteScalingPolicy x -> DeleteScalingPolicy
$cfrom :: forall x. DeleteScalingPolicy -> Rep DeleteScalingPolicy x
Prelude.Generic)

-- |
-- Create a value of 'DeleteScalingPolicy' 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:
--
-- 'name', 'deleteScalingPolicy_name' - A descriptive label that is associated with a fleet\'s scaling policy.
-- Policy names do not need to be unique.
--
-- 'fleetId', 'deleteScalingPolicy_fleetId' - A unique identifier for the fleet to be deleted. You can use either the
-- fleet ID or ARN value.
newDeleteScalingPolicy ::
  -- | 'name'
  Prelude.Text ->
  -- | 'fleetId'
  Prelude.Text ->
  DeleteScalingPolicy
newDeleteScalingPolicy :: Text -> Text -> DeleteScalingPolicy
newDeleteScalingPolicy Text
pName_ Text
pFleetId_ =
  DeleteScalingPolicy'
    { $sel:name:DeleteScalingPolicy' :: Text
name = Text
pName_,
      $sel:fleetId:DeleteScalingPolicy' :: Text
fleetId = Text
pFleetId_
    }

-- | A descriptive label that is associated with a fleet\'s scaling policy.
-- Policy names do not need to be unique.
deleteScalingPolicy_name :: Lens.Lens' DeleteScalingPolicy Prelude.Text
deleteScalingPolicy_name :: Lens' DeleteScalingPolicy Text
deleteScalingPolicy_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteScalingPolicy' {Text
name :: Text
$sel:name:DeleteScalingPolicy' :: DeleteScalingPolicy -> Text
name} -> Text
name) (\s :: DeleteScalingPolicy
s@DeleteScalingPolicy' {} Text
a -> DeleteScalingPolicy
s {$sel:name:DeleteScalingPolicy' :: Text
name = Text
a} :: DeleteScalingPolicy)

-- | A unique identifier for the fleet to be deleted. You can use either the
-- fleet ID or ARN value.
deleteScalingPolicy_fleetId :: Lens.Lens' DeleteScalingPolicy Prelude.Text
deleteScalingPolicy_fleetId :: Lens' DeleteScalingPolicy Text
deleteScalingPolicy_fleetId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteScalingPolicy' {Text
fleetId :: Text
$sel:fleetId:DeleteScalingPolicy' :: DeleteScalingPolicy -> Text
fleetId} -> Text
fleetId) (\s :: DeleteScalingPolicy
s@DeleteScalingPolicy' {} Text
a -> DeleteScalingPolicy
s {$sel:fleetId:DeleteScalingPolicy' :: Text
fleetId = Text
a} :: DeleteScalingPolicy)

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

instance Prelude.Hashable DeleteScalingPolicy where
  hashWithSalt :: Int -> DeleteScalingPolicy -> Int
hashWithSalt Int
_salt DeleteScalingPolicy' {Text
fleetId :: Text
name :: Text
$sel:fleetId:DeleteScalingPolicy' :: DeleteScalingPolicy -> Text
$sel:name:DeleteScalingPolicy' :: DeleteScalingPolicy -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
name
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
fleetId

instance Prelude.NFData DeleteScalingPolicy where
  rnf :: DeleteScalingPolicy -> ()
rnf DeleteScalingPolicy' {Text
fleetId :: Text
name :: Text
$sel:fleetId:DeleteScalingPolicy' :: DeleteScalingPolicy -> Text
$sel:name:DeleteScalingPolicy' :: DeleteScalingPolicy -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
name seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
fleetId

instance Data.ToHeaders DeleteScalingPolicy where
  toHeaders :: DeleteScalingPolicy -> [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
"GameLift.DeleteScalingPolicy" ::
                          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 DeleteScalingPolicy where
  toJSON :: DeleteScalingPolicy -> Value
toJSON DeleteScalingPolicy' {Text
fleetId :: Text
name :: Text
$sel:fleetId:DeleteScalingPolicy' :: DeleteScalingPolicy -> Text
$sel:name:DeleteScalingPolicy' :: DeleteScalingPolicy -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just (Key
"Name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
name),
            forall a. a -> Maybe a
Prelude.Just (Key
"FleetId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
fleetId)
          ]
      )

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

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

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

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

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