{-# 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.SuspendGameServerGroup
-- 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.__
--
-- Temporarily stops activity on a game server group without terminating
-- instances or the game server group. You can restart activity by calling
-- <gamelift/latest/apireference/API_ResumeGameServerGroup.html ResumeGameServerGroup>.
-- You can suspend the following activity:
--
-- -   __Instance type replacement__ - This activity evaluates the current
--     game hosting viability of all Spot instance types that are defined
--     for the game server group. It updates the Auto Scaling group to
--     remove nonviable Spot Instance types, which have a higher chance of
--     game server interruptions. It then balances capacity across the
--     remaining viable Spot Instance types. When this activity is
--     suspended, the Auto Scaling group continues with its current
--     balance, regardless of viability. Instance protection, utilization
--     metrics, and capacity scaling activities continue to be active.
--
-- To suspend activity, specify a game server group ARN and the type of
-- activity to be suspended. If successful, a @GameServerGroup@ object is
-- returned showing that the activity is listed in @SuspendedActions@.
--
-- __Learn more__
--
-- <https://docs.aws.amazon.com/gamelift/latest/fleetiqguide/gsg-intro.html GameLift FleetIQ Guide>
module Amazonka.GameLift.SuspendGameServerGroup
  ( -- * Creating a Request
    SuspendGameServerGroup (..),
    newSuspendGameServerGroup,

    -- * Request Lenses
    suspendGameServerGroup_gameServerGroupName,
    suspendGameServerGroup_suspendActions,

    -- * Destructuring the Response
    SuspendGameServerGroupResponse (..),
    newSuspendGameServerGroupResponse,

    -- * Response Lenses
    suspendGameServerGroupResponse_gameServerGroup,
    suspendGameServerGroupResponse_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:/ 'newSuspendGameServerGroup' smart constructor.
data SuspendGameServerGroup = SuspendGameServerGroup'
  { -- | A unique identifier for the game server group. Use either the name or
    -- ARN value.
    SuspendGameServerGroup -> Text
gameServerGroupName :: Prelude.Text,
    -- | The activity to suspend for this game server group.
    SuspendGameServerGroup -> NonEmpty GameServerGroupAction
suspendActions :: Prelude.NonEmpty GameServerGroupAction
  }
  deriving (SuspendGameServerGroup -> SuspendGameServerGroup -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SuspendGameServerGroup -> SuspendGameServerGroup -> Bool
$c/= :: SuspendGameServerGroup -> SuspendGameServerGroup -> Bool
== :: SuspendGameServerGroup -> SuspendGameServerGroup -> Bool
$c== :: SuspendGameServerGroup -> SuspendGameServerGroup -> Bool
Prelude.Eq, ReadPrec [SuspendGameServerGroup]
ReadPrec SuspendGameServerGroup
Int -> ReadS SuspendGameServerGroup
ReadS [SuspendGameServerGroup]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SuspendGameServerGroup]
$creadListPrec :: ReadPrec [SuspendGameServerGroup]
readPrec :: ReadPrec SuspendGameServerGroup
$creadPrec :: ReadPrec SuspendGameServerGroup
readList :: ReadS [SuspendGameServerGroup]
$creadList :: ReadS [SuspendGameServerGroup]
readsPrec :: Int -> ReadS SuspendGameServerGroup
$creadsPrec :: Int -> ReadS SuspendGameServerGroup
Prelude.Read, Int -> SuspendGameServerGroup -> ShowS
[SuspendGameServerGroup] -> ShowS
SuspendGameServerGroup -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SuspendGameServerGroup] -> ShowS
$cshowList :: [SuspendGameServerGroup] -> ShowS
show :: SuspendGameServerGroup -> String
$cshow :: SuspendGameServerGroup -> String
showsPrec :: Int -> SuspendGameServerGroup -> ShowS
$cshowsPrec :: Int -> SuspendGameServerGroup -> ShowS
Prelude.Show, forall x. Rep SuspendGameServerGroup x -> SuspendGameServerGroup
forall x. SuspendGameServerGroup -> Rep SuspendGameServerGroup x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SuspendGameServerGroup x -> SuspendGameServerGroup
$cfrom :: forall x. SuspendGameServerGroup -> Rep SuspendGameServerGroup x
Prelude.Generic)

-- |
-- Create a value of 'SuspendGameServerGroup' 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:
--
-- 'gameServerGroupName', 'suspendGameServerGroup_gameServerGroupName' - A unique identifier for the game server group. Use either the name or
-- ARN value.
--
-- 'suspendActions', 'suspendGameServerGroup_suspendActions' - The activity to suspend for this game server group.
newSuspendGameServerGroup ::
  -- | 'gameServerGroupName'
  Prelude.Text ->
  -- | 'suspendActions'
  Prelude.NonEmpty GameServerGroupAction ->
  SuspendGameServerGroup
newSuspendGameServerGroup :: Text -> NonEmpty GameServerGroupAction -> SuspendGameServerGroup
newSuspendGameServerGroup
  Text
pGameServerGroupName_
  NonEmpty GameServerGroupAction
pSuspendActions_ =
    SuspendGameServerGroup'
      { $sel:gameServerGroupName:SuspendGameServerGroup' :: Text
gameServerGroupName =
          Text
pGameServerGroupName_,
        $sel:suspendActions:SuspendGameServerGroup' :: NonEmpty GameServerGroupAction
suspendActions =
          forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced forall t b. AReview t b -> b -> t
Lens.# NonEmpty GameServerGroupAction
pSuspendActions_
      }

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

-- | The activity to suspend for this game server group.
suspendGameServerGroup_suspendActions :: Lens.Lens' SuspendGameServerGroup (Prelude.NonEmpty GameServerGroupAction)
suspendGameServerGroup_suspendActions :: Lens' SuspendGameServerGroup (NonEmpty GameServerGroupAction)
suspendGameServerGroup_suspendActions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SuspendGameServerGroup' {NonEmpty GameServerGroupAction
suspendActions :: NonEmpty GameServerGroupAction
$sel:suspendActions:SuspendGameServerGroup' :: SuspendGameServerGroup -> NonEmpty GameServerGroupAction
suspendActions} -> NonEmpty GameServerGroupAction
suspendActions) (\s :: SuspendGameServerGroup
s@SuspendGameServerGroup' {} NonEmpty GameServerGroupAction
a -> SuspendGameServerGroup
s {$sel:suspendActions:SuspendGameServerGroup' :: NonEmpty GameServerGroupAction
suspendActions = NonEmpty GameServerGroupAction
a} :: SuspendGameServerGroup) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

instance Core.AWSRequest SuspendGameServerGroup where
  type
    AWSResponse SuspendGameServerGroup =
      SuspendGameServerGroupResponse
  request :: (Service -> Service)
-> SuspendGameServerGroup -> Request SuspendGameServerGroup
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 SuspendGameServerGroup
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse SuspendGameServerGroup)))
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 -> SuspendGameServerGroupResponse
SuspendGameServerGroupResponse'
            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 SuspendGameServerGroup where
  hashWithSalt :: Int -> SuspendGameServerGroup -> Int
hashWithSalt Int
_salt SuspendGameServerGroup' {NonEmpty GameServerGroupAction
Text
suspendActions :: NonEmpty GameServerGroupAction
gameServerGroupName :: Text
$sel:suspendActions:SuspendGameServerGroup' :: SuspendGameServerGroup -> NonEmpty GameServerGroupAction
$sel:gameServerGroupName:SuspendGameServerGroup' :: SuspendGameServerGroup -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
gameServerGroupName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` NonEmpty GameServerGroupAction
suspendActions

instance Prelude.NFData SuspendGameServerGroup where
  rnf :: SuspendGameServerGroup -> ()
rnf SuspendGameServerGroup' {NonEmpty GameServerGroupAction
Text
suspendActions :: NonEmpty GameServerGroupAction
gameServerGroupName :: Text
$sel:suspendActions:SuspendGameServerGroup' :: SuspendGameServerGroup -> NonEmpty GameServerGroupAction
$sel:gameServerGroupName:SuspendGameServerGroup' :: SuspendGameServerGroup -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
gameServerGroupName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf NonEmpty GameServerGroupAction
suspendActions

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

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

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

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

-- |
-- Create a value of 'SuspendGameServerGroupResponse' 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', 'suspendGameServerGroupResponse_gameServerGroup' - An object that describes the game server group resource, with the
-- @SuspendedActions@ property updated to reflect the suspended activity.
--
-- 'httpStatus', 'suspendGameServerGroupResponse_httpStatus' - The response's http status code.
newSuspendGameServerGroupResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  SuspendGameServerGroupResponse
newSuspendGameServerGroupResponse :: Int -> SuspendGameServerGroupResponse
newSuspendGameServerGroupResponse Int
pHttpStatus_ =
  SuspendGameServerGroupResponse'
    { $sel:gameServerGroup:SuspendGameServerGroupResponse' :: Maybe GameServerGroup
gameServerGroup =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:SuspendGameServerGroupResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | An object that describes the game server group resource, with the
-- @SuspendedActions@ property updated to reflect the suspended activity.
suspendGameServerGroupResponse_gameServerGroup :: Lens.Lens' SuspendGameServerGroupResponse (Prelude.Maybe GameServerGroup)
suspendGameServerGroupResponse_gameServerGroup :: Lens' SuspendGameServerGroupResponse (Maybe GameServerGroup)
suspendGameServerGroupResponse_gameServerGroup = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SuspendGameServerGroupResponse' {Maybe GameServerGroup
gameServerGroup :: Maybe GameServerGroup
$sel:gameServerGroup:SuspendGameServerGroupResponse' :: SuspendGameServerGroupResponse -> Maybe GameServerGroup
gameServerGroup} -> Maybe GameServerGroup
gameServerGroup) (\s :: SuspendGameServerGroupResponse
s@SuspendGameServerGroupResponse' {} Maybe GameServerGroup
a -> SuspendGameServerGroupResponse
s {$sel:gameServerGroup:SuspendGameServerGroupResponse' :: Maybe GameServerGroup
gameServerGroup = Maybe GameServerGroup
a} :: SuspendGameServerGroupResponse)

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

instance
  Prelude.NFData
    SuspendGameServerGroupResponse
  where
  rnf :: SuspendGameServerGroupResponse -> ()
rnf SuspendGameServerGroupResponse' {Int
Maybe GameServerGroup
httpStatus :: Int
gameServerGroup :: Maybe GameServerGroup
$sel:httpStatus:SuspendGameServerGroupResponse' :: SuspendGameServerGroupResponse -> Int
$sel:gameServerGroup:SuspendGameServerGroupResponse' :: SuspendGameServerGroupResponse -> 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