{-# 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.DeleteGameServerGroup
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- __This operation is used with the GameLift FleetIQ solution and game
-- server groups.__
--
-- Terminates a game server group and permanently deletes the game server
-- group record. You have several options for how these resources are
-- impacted when deleting the game server group. Depending on the type of
-- delete operation selected, this operation might affect these resources:
--
-- -   The game server group
--
-- -   The corresponding Auto Scaling group
--
-- -   All game servers that are currently running in the group
--
-- To delete a game server group, identify the game server group to delete
-- and specify the type of delete operation to initiate. Game server groups
-- can only be deleted if they are in @ACTIVE@ or @ERROR@ status.
--
-- If the delete request is successful, a series of operations are kicked
-- off. The game server group status is changed to @DELETE_SCHEDULED@,
-- which prevents new game servers from being registered and stops
-- automatic scaling activity. Once all game servers in the game server
-- group are deregistered, GameLift FleetIQ can begin deleting resources.
-- If any of the delete operations fail, the game server group is placed in
-- @ERROR@ status.
--
-- GameLift FleetIQ emits delete events to Amazon CloudWatch.
--
-- __Learn more__
--
-- <https://docs.aws.amazon.com/gamelift/latest/fleetiqguide/gsg-intro.html GameLift FleetIQ Guide>
module Amazonka.GameLift.DeleteGameServerGroup
  ( -- * Creating a Request
    DeleteGameServerGroup (..),
    newDeleteGameServerGroup,

    -- * Request Lenses
    deleteGameServerGroup_deleteOption,
    deleteGameServerGroup_gameServerGroupName,

    -- * Destructuring the Response
    DeleteGameServerGroupResponse (..),
    newDeleteGameServerGroupResponse,

    -- * Response Lenses
    deleteGameServerGroupResponse_gameServerGroup,
    deleteGameServerGroupResponse_httpStatus,
  )
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:/ 'newDeleteGameServerGroup' smart constructor.
data DeleteGameServerGroup = DeleteGameServerGroup'
  { -- | The type of delete to perform. Options include the following:
    --
    -- -   @SAFE_DELETE@ – (default) Terminates the game server group and
    --     Amazon EC2 Auto Scaling group only when it has no game servers that
    --     are in @UTILIZED@ status.
    --
    -- -   @FORCE_DELETE@ – Terminates the game server group, including all
    --     active game servers regardless of their utilization status, and the
    --     Amazon EC2 Auto Scaling group.
    --
    -- -   @RETAIN@ – Does a safe delete of the game server group but retains
    --     the Amazon EC2 Auto Scaling group as is.
    DeleteGameServerGroup -> Maybe GameServerGroupDeleteOption
deleteOption :: Prelude.Maybe GameServerGroupDeleteOption,
    -- | A unique identifier for the game server group. Use either the name or
    -- ARN value.
    DeleteGameServerGroup -> Text
gameServerGroupName :: Prelude.Text
  }
  deriving (DeleteGameServerGroup -> DeleteGameServerGroup -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeleteGameServerGroup -> DeleteGameServerGroup -> Bool
$c/= :: DeleteGameServerGroup -> DeleteGameServerGroup -> Bool
== :: DeleteGameServerGroup -> DeleteGameServerGroup -> Bool
$c== :: DeleteGameServerGroup -> DeleteGameServerGroup -> Bool
Prelude.Eq, ReadPrec [DeleteGameServerGroup]
ReadPrec DeleteGameServerGroup
Int -> ReadS DeleteGameServerGroup
ReadS [DeleteGameServerGroup]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeleteGameServerGroup]
$creadListPrec :: ReadPrec [DeleteGameServerGroup]
readPrec :: ReadPrec DeleteGameServerGroup
$creadPrec :: ReadPrec DeleteGameServerGroup
readList :: ReadS [DeleteGameServerGroup]
$creadList :: ReadS [DeleteGameServerGroup]
readsPrec :: Int -> ReadS DeleteGameServerGroup
$creadsPrec :: Int -> ReadS DeleteGameServerGroup
Prelude.Read, Int -> DeleteGameServerGroup -> ShowS
[DeleteGameServerGroup] -> ShowS
DeleteGameServerGroup -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeleteGameServerGroup] -> ShowS
$cshowList :: [DeleteGameServerGroup] -> ShowS
show :: DeleteGameServerGroup -> String
$cshow :: DeleteGameServerGroup -> String
showsPrec :: Int -> DeleteGameServerGroup -> ShowS
$cshowsPrec :: Int -> DeleteGameServerGroup -> ShowS
Prelude.Show, forall x. Rep DeleteGameServerGroup x -> DeleteGameServerGroup
forall x. DeleteGameServerGroup -> Rep DeleteGameServerGroup x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DeleteGameServerGroup x -> DeleteGameServerGroup
$cfrom :: forall x. DeleteGameServerGroup -> Rep DeleteGameServerGroup x
Prelude.Generic)

-- |
-- Create a value of 'DeleteGameServerGroup' 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:
--
-- 'deleteOption', 'deleteGameServerGroup_deleteOption' - The type of delete to perform. Options include the following:
--
-- -   @SAFE_DELETE@ – (default) Terminates the game server group and
--     Amazon EC2 Auto Scaling group only when it has no game servers that
--     are in @UTILIZED@ status.
--
-- -   @FORCE_DELETE@ – Terminates the game server group, including all
--     active game servers regardless of their utilization status, and the
--     Amazon EC2 Auto Scaling group.
--
-- -   @RETAIN@ – Does a safe delete of the game server group but retains
--     the Amazon EC2 Auto Scaling group as is.
--
-- 'gameServerGroupName', 'deleteGameServerGroup_gameServerGroupName' - A unique identifier for the game server group. Use either the name or
-- ARN value.
newDeleteGameServerGroup ::
  -- | 'gameServerGroupName'
  Prelude.Text ->
  DeleteGameServerGroup
newDeleteGameServerGroup :: Text -> DeleteGameServerGroup
newDeleteGameServerGroup Text
pGameServerGroupName_ =
  DeleteGameServerGroup'
    { $sel:deleteOption:DeleteGameServerGroup' :: Maybe GameServerGroupDeleteOption
deleteOption =
        forall a. Maybe a
Prelude.Nothing,
      $sel:gameServerGroupName:DeleteGameServerGroup' :: Text
gameServerGroupName = Text
pGameServerGroupName_
    }

-- | The type of delete to perform. Options include the following:
--
-- -   @SAFE_DELETE@ – (default) Terminates the game server group and
--     Amazon EC2 Auto Scaling group only when it has no game servers that
--     are in @UTILIZED@ status.
--
-- -   @FORCE_DELETE@ – Terminates the game server group, including all
--     active game servers regardless of their utilization status, and the
--     Amazon EC2 Auto Scaling group.
--
-- -   @RETAIN@ – Does a safe delete of the game server group but retains
--     the Amazon EC2 Auto Scaling group as is.
deleteGameServerGroup_deleteOption :: Lens.Lens' DeleteGameServerGroup (Prelude.Maybe GameServerGroupDeleteOption)
deleteGameServerGroup_deleteOption :: Lens' DeleteGameServerGroup (Maybe GameServerGroupDeleteOption)
deleteGameServerGroup_deleteOption = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteGameServerGroup' {Maybe GameServerGroupDeleteOption
deleteOption :: Maybe GameServerGroupDeleteOption
$sel:deleteOption:DeleteGameServerGroup' :: DeleteGameServerGroup -> Maybe GameServerGroupDeleteOption
deleteOption} -> Maybe GameServerGroupDeleteOption
deleteOption) (\s :: DeleteGameServerGroup
s@DeleteGameServerGroup' {} Maybe GameServerGroupDeleteOption
a -> DeleteGameServerGroup
s {$sel:deleteOption:DeleteGameServerGroup' :: Maybe GameServerGroupDeleteOption
deleteOption = Maybe GameServerGroupDeleteOption
a} :: DeleteGameServerGroup)

-- | A unique identifier for the game server group. Use either the name or
-- ARN value.
deleteGameServerGroup_gameServerGroupName :: Lens.Lens' DeleteGameServerGroup Prelude.Text
deleteGameServerGroup_gameServerGroupName :: Lens' DeleteGameServerGroup Text
deleteGameServerGroup_gameServerGroupName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteGameServerGroup' {Text
gameServerGroupName :: Text
$sel:gameServerGroupName:DeleteGameServerGroup' :: DeleteGameServerGroup -> Text
gameServerGroupName} -> Text
gameServerGroupName) (\s :: DeleteGameServerGroup
s@DeleteGameServerGroup' {} Text
a -> DeleteGameServerGroup
s {$sel:gameServerGroupName:DeleteGameServerGroup' :: Text
gameServerGroupName = Text
a} :: DeleteGameServerGroup)

instance Core.AWSRequest DeleteGameServerGroup where
  type
    AWSResponse DeleteGameServerGroup =
      DeleteGameServerGroupResponse
  request :: (Service -> Service)
-> DeleteGameServerGroup -> Request DeleteGameServerGroup
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 DeleteGameServerGroup
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse DeleteGameServerGroup)))
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 GameServerGroup -> Int -> DeleteGameServerGroupResponse
DeleteGameServerGroupResponse'
            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
"GameServerGroup")
            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 DeleteGameServerGroup where
  hashWithSalt :: Int -> DeleteGameServerGroup -> Int
hashWithSalt Int
_salt DeleteGameServerGroup' {Maybe GameServerGroupDeleteOption
Text
gameServerGroupName :: Text
deleteOption :: Maybe GameServerGroupDeleteOption
$sel:gameServerGroupName:DeleteGameServerGroup' :: DeleteGameServerGroup -> Text
$sel:deleteOption:DeleteGameServerGroup' :: DeleteGameServerGroup -> Maybe GameServerGroupDeleteOption
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe GameServerGroupDeleteOption
deleteOption
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
gameServerGroupName

instance Prelude.NFData DeleteGameServerGroup where
  rnf :: DeleteGameServerGroup -> ()
rnf DeleteGameServerGroup' {Maybe GameServerGroupDeleteOption
Text
gameServerGroupName :: Text
deleteOption :: Maybe GameServerGroupDeleteOption
$sel:gameServerGroupName:DeleteGameServerGroup' :: DeleteGameServerGroup -> Text
$sel:deleteOption:DeleteGameServerGroup' :: DeleteGameServerGroup -> Maybe GameServerGroupDeleteOption
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe GameServerGroupDeleteOption
deleteOption
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
gameServerGroupName

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

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

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

-- | /See:/ 'newDeleteGameServerGroupResponse' smart constructor.
data DeleteGameServerGroupResponse = DeleteGameServerGroupResponse'
  { -- | An object that describes the deleted game server group resource, with
    -- status updated to @DELETE_SCHEDULED@.
    DeleteGameServerGroupResponse -> Maybe GameServerGroup
gameServerGroup :: Prelude.Maybe GameServerGroup,
    -- | The response's http status code.
    DeleteGameServerGroupResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (DeleteGameServerGroupResponse
-> DeleteGameServerGroupResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeleteGameServerGroupResponse
-> DeleteGameServerGroupResponse -> Bool
$c/= :: DeleteGameServerGroupResponse
-> DeleteGameServerGroupResponse -> Bool
== :: DeleteGameServerGroupResponse
-> DeleteGameServerGroupResponse -> Bool
$c== :: DeleteGameServerGroupResponse
-> DeleteGameServerGroupResponse -> Bool
Prelude.Eq, ReadPrec [DeleteGameServerGroupResponse]
ReadPrec DeleteGameServerGroupResponse
Int -> ReadS DeleteGameServerGroupResponse
ReadS [DeleteGameServerGroupResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeleteGameServerGroupResponse]
$creadListPrec :: ReadPrec [DeleteGameServerGroupResponse]
readPrec :: ReadPrec DeleteGameServerGroupResponse
$creadPrec :: ReadPrec DeleteGameServerGroupResponse
readList :: ReadS [DeleteGameServerGroupResponse]
$creadList :: ReadS [DeleteGameServerGroupResponse]
readsPrec :: Int -> ReadS DeleteGameServerGroupResponse
$creadsPrec :: Int -> ReadS DeleteGameServerGroupResponse
Prelude.Read, Int -> DeleteGameServerGroupResponse -> ShowS
[DeleteGameServerGroupResponse] -> ShowS
DeleteGameServerGroupResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeleteGameServerGroupResponse] -> ShowS
$cshowList :: [DeleteGameServerGroupResponse] -> ShowS
show :: DeleteGameServerGroupResponse -> String
$cshow :: DeleteGameServerGroupResponse -> String
showsPrec :: Int -> DeleteGameServerGroupResponse -> ShowS
$cshowsPrec :: Int -> DeleteGameServerGroupResponse -> ShowS
Prelude.Show, forall x.
Rep DeleteGameServerGroupResponse x
-> DeleteGameServerGroupResponse
forall x.
DeleteGameServerGroupResponse
-> Rep DeleteGameServerGroupResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DeleteGameServerGroupResponse x
-> DeleteGameServerGroupResponse
$cfrom :: forall x.
DeleteGameServerGroupResponse
-> Rep DeleteGameServerGroupResponse x
Prelude.Generic)

-- |
-- Create a value of 'DeleteGameServerGroupResponse' 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:
--
-- 'gameServerGroup', 'deleteGameServerGroupResponse_gameServerGroup' - An object that describes the deleted game server group resource, with
-- status updated to @DELETE_SCHEDULED@.
--
-- 'httpStatus', 'deleteGameServerGroupResponse_httpStatus' - The response's http status code.
newDeleteGameServerGroupResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DeleteGameServerGroupResponse
newDeleteGameServerGroupResponse :: Int -> DeleteGameServerGroupResponse
newDeleteGameServerGroupResponse Int
pHttpStatus_ =
  DeleteGameServerGroupResponse'
    { $sel:gameServerGroup:DeleteGameServerGroupResponse' :: Maybe GameServerGroup
gameServerGroup =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:DeleteGameServerGroupResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | An object that describes the deleted game server group resource, with
-- status updated to @DELETE_SCHEDULED@.
deleteGameServerGroupResponse_gameServerGroup :: Lens.Lens' DeleteGameServerGroupResponse (Prelude.Maybe GameServerGroup)
deleteGameServerGroupResponse_gameServerGroup :: Lens' DeleteGameServerGroupResponse (Maybe GameServerGroup)
deleteGameServerGroupResponse_gameServerGroup = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteGameServerGroupResponse' {Maybe GameServerGroup
gameServerGroup :: Maybe GameServerGroup
$sel:gameServerGroup:DeleteGameServerGroupResponse' :: DeleteGameServerGroupResponse -> Maybe GameServerGroup
gameServerGroup} -> Maybe GameServerGroup
gameServerGroup) (\s :: DeleteGameServerGroupResponse
s@DeleteGameServerGroupResponse' {} Maybe GameServerGroup
a -> DeleteGameServerGroupResponse
s {$sel:gameServerGroup:DeleteGameServerGroupResponse' :: Maybe GameServerGroup
gameServerGroup = Maybe GameServerGroup
a} :: DeleteGameServerGroupResponse)

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

instance Prelude.NFData DeleteGameServerGroupResponse where
  rnf :: DeleteGameServerGroupResponse -> ()
rnf DeleteGameServerGroupResponse' {Int
Maybe GameServerGroup
httpStatus :: Int
gameServerGroup :: Maybe GameServerGroup
$sel:httpStatus:DeleteGameServerGroupResponse' :: DeleteGameServerGroupResponse -> Int
$sel:gameServerGroup:DeleteGameServerGroupResponse' :: DeleteGameServerGroupResponse -> Maybe GameServerGroup
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe GameServerGroup
gameServerGroup
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus