{-# 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.UpdateGameServerGroup
-- 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.__
--
-- Updates GameLift FleetIQ-specific properties for a game server group.
-- Many Auto Scaling group properties are updated on the Auto Scaling group
-- directly, including the launch template, Auto Scaling policies, and
-- maximum\/minimum\/desired instance counts.
--
-- To update the game server group, specify the game server group ID and
-- provide the updated values. Before applying the updates, the new values
-- are validated to ensure that GameLift FleetIQ can continue to perform
-- instance balancing activity. If successful, a @GameServerGroup@ object
-- is returned.
--
-- __Learn more__
--
-- <https://docs.aws.amazon.com/gamelift/latest/fleetiqguide/gsg-intro.html GameLift FleetIQ Guide>
module Amazonka.GameLift.UpdateGameServerGroup
  ( -- * Creating a Request
    UpdateGameServerGroup (..),
    newUpdateGameServerGroup,

    -- * Request Lenses
    updateGameServerGroup_balancingStrategy,
    updateGameServerGroup_gameServerProtectionPolicy,
    updateGameServerGroup_instanceDefinitions,
    updateGameServerGroup_roleArn,
    updateGameServerGroup_gameServerGroupName,

    -- * Destructuring the Response
    UpdateGameServerGroupResponse (..),
    newUpdateGameServerGroupResponse,

    -- * Response Lenses
    updateGameServerGroupResponse_gameServerGroup,
    updateGameServerGroupResponse_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:/ 'newUpdateGameServerGroup' smart constructor.
data UpdateGameServerGroup = UpdateGameServerGroup'
  { -- | Indicates how GameLift FleetIQ balances the use of Spot Instances and
    -- On-Demand Instances in the game server group. Method options include the
    -- following:
    --
    -- -   @SPOT_ONLY@ - Only Spot Instances are used in the game server group.
    --     If Spot Instances are unavailable or not viable for game hosting,
    --     the game server group provides no hosting capacity until Spot
    --     Instances can again be used. Until then, no new instances are
    --     started, and the existing nonviable Spot Instances are terminated
    --     (after current gameplay ends) and are not replaced.
    --
    -- -   @SPOT_PREFERRED@ - (default value) Spot Instances are used whenever
    --     available in the game server group. If Spot Instances are
    --     unavailable, the game server group continues to provide hosting
    --     capacity by falling back to On-Demand Instances. Existing nonviable
    --     Spot Instances are terminated (after current gameplay ends) and are
    --     replaced with new On-Demand Instances.
    --
    -- -   @ON_DEMAND_ONLY@ - Only On-Demand Instances are used in the game
    --     server group. No Spot Instances are used, even when available, while
    --     this balancing strategy is in force.
    UpdateGameServerGroup -> Maybe BalancingStrategy
balancingStrategy :: Prelude.Maybe BalancingStrategy,
    -- | A flag that indicates whether instances in the game server group are
    -- protected from early termination. Unprotected instances that have active
    -- game servers running might be terminated during a scale-down event,
    -- causing players to be dropped from the game. Protected instances cannot
    -- be terminated while there are active game servers running except in the
    -- event of a forced game server group deletion (see ). An exception to
    -- this is with Spot Instances, which can be terminated by Amazon Web
    -- Services regardless of protection status. This property is set to
    -- @NO_PROTECTION@ by default.
    UpdateGameServerGroup -> Maybe GameServerProtectionPolicy
gameServerProtectionPolicy :: Prelude.Maybe GameServerProtectionPolicy,
    -- | An updated list of Amazon EC2 instance types to use in the Auto Scaling
    -- group. The instance definitions must specify at least two different
    -- instance types that are supported by GameLift FleetIQ. This updated list
    -- replaces the entire current list of instance definitions for the game
    -- server group. For more information on instance types, see
    -- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/instance-types.html EC2 Instance Types>
    -- in the /Amazon EC2 User Guide/. You can optionally specify capacity
    -- weighting for each instance type. If no weight value is specified for an
    -- instance type, it is set to the default value \"1\". For more
    -- information about capacity weighting, see
    -- <https://docs.aws.amazon.com/autoscaling/ec2/userguide/asg-instance-weighting.html Instance Weighting for Amazon EC2 Auto Scaling>
    -- in the Amazon EC2 Auto Scaling User Guide.
    UpdateGameServerGroup -> Maybe (NonEmpty InstanceDefinition)
instanceDefinitions :: Prelude.Maybe (Prelude.NonEmpty InstanceDefinition),
    -- | The Amazon Resource Name
    -- (<https://docs.aws.amazon.com/AmazonS3/latest/dev/s3-arn-format.html ARN>)
    -- for an IAM role that allows Amazon GameLift to access your Amazon EC2
    -- Auto Scaling groups.
    UpdateGameServerGroup -> Maybe Text
roleArn :: Prelude.Maybe Prelude.Text,
    -- | A unique identifier for the game server group. Use either the name or
    -- ARN value.
    UpdateGameServerGroup -> Text
gameServerGroupName :: Prelude.Text
  }
  deriving (UpdateGameServerGroup -> UpdateGameServerGroup -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateGameServerGroup -> UpdateGameServerGroup -> Bool
$c/= :: UpdateGameServerGroup -> UpdateGameServerGroup -> Bool
== :: UpdateGameServerGroup -> UpdateGameServerGroup -> Bool
$c== :: UpdateGameServerGroup -> UpdateGameServerGroup -> Bool
Prelude.Eq, ReadPrec [UpdateGameServerGroup]
ReadPrec UpdateGameServerGroup
Int -> ReadS UpdateGameServerGroup
ReadS [UpdateGameServerGroup]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateGameServerGroup]
$creadListPrec :: ReadPrec [UpdateGameServerGroup]
readPrec :: ReadPrec UpdateGameServerGroup
$creadPrec :: ReadPrec UpdateGameServerGroup
readList :: ReadS [UpdateGameServerGroup]
$creadList :: ReadS [UpdateGameServerGroup]
readsPrec :: Int -> ReadS UpdateGameServerGroup
$creadsPrec :: Int -> ReadS UpdateGameServerGroup
Prelude.Read, Int -> UpdateGameServerGroup -> ShowS
[UpdateGameServerGroup] -> ShowS
UpdateGameServerGroup -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateGameServerGroup] -> ShowS
$cshowList :: [UpdateGameServerGroup] -> ShowS
show :: UpdateGameServerGroup -> String
$cshow :: UpdateGameServerGroup -> String
showsPrec :: Int -> UpdateGameServerGroup -> ShowS
$cshowsPrec :: Int -> UpdateGameServerGroup -> ShowS
Prelude.Show, forall x. Rep UpdateGameServerGroup x -> UpdateGameServerGroup
forall x. UpdateGameServerGroup -> Rep UpdateGameServerGroup x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateGameServerGroup x -> UpdateGameServerGroup
$cfrom :: forall x. UpdateGameServerGroup -> Rep UpdateGameServerGroup x
Prelude.Generic)

-- |
-- Create a value of 'UpdateGameServerGroup' 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:
--
-- 'balancingStrategy', 'updateGameServerGroup_balancingStrategy' - Indicates how GameLift FleetIQ balances the use of Spot Instances and
-- On-Demand Instances in the game server group. Method options include the
-- following:
--
-- -   @SPOT_ONLY@ - Only Spot Instances are used in the game server group.
--     If Spot Instances are unavailable or not viable for game hosting,
--     the game server group provides no hosting capacity until Spot
--     Instances can again be used. Until then, no new instances are
--     started, and the existing nonviable Spot Instances are terminated
--     (after current gameplay ends) and are not replaced.
--
-- -   @SPOT_PREFERRED@ - (default value) Spot Instances are used whenever
--     available in the game server group. If Spot Instances are
--     unavailable, the game server group continues to provide hosting
--     capacity by falling back to On-Demand Instances. Existing nonviable
--     Spot Instances are terminated (after current gameplay ends) and are
--     replaced with new On-Demand Instances.
--
-- -   @ON_DEMAND_ONLY@ - Only On-Demand Instances are used in the game
--     server group. No Spot Instances are used, even when available, while
--     this balancing strategy is in force.
--
-- 'gameServerProtectionPolicy', 'updateGameServerGroup_gameServerProtectionPolicy' - A flag that indicates whether instances in the game server group are
-- protected from early termination. Unprotected instances that have active
-- game servers running might be terminated during a scale-down event,
-- causing players to be dropped from the game. Protected instances cannot
-- be terminated while there are active game servers running except in the
-- event of a forced game server group deletion (see ). An exception to
-- this is with Spot Instances, which can be terminated by Amazon Web
-- Services regardless of protection status. This property is set to
-- @NO_PROTECTION@ by default.
--
-- 'instanceDefinitions', 'updateGameServerGroup_instanceDefinitions' - An updated list of Amazon EC2 instance types to use in the Auto Scaling
-- group. The instance definitions must specify at least two different
-- instance types that are supported by GameLift FleetIQ. This updated list
-- replaces the entire current list of instance definitions for the game
-- server group. For more information on instance types, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/instance-types.html EC2 Instance Types>
-- in the /Amazon EC2 User Guide/. You can optionally specify capacity
-- weighting for each instance type. If no weight value is specified for an
-- instance type, it is set to the default value \"1\". For more
-- information about capacity weighting, see
-- <https://docs.aws.amazon.com/autoscaling/ec2/userguide/asg-instance-weighting.html Instance Weighting for Amazon EC2 Auto Scaling>
-- in the Amazon EC2 Auto Scaling User Guide.
--
-- 'roleArn', 'updateGameServerGroup_roleArn' - The Amazon Resource Name
-- (<https://docs.aws.amazon.com/AmazonS3/latest/dev/s3-arn-format.html ARN>)
-- for an IAM role that allows Amazon GameLift to access your Amazon EC2
-- Auto Scaling groups.
--
-- 'gameServerGroupName', 'updateGameServerGroup_gameServerGroupName' - A unique identifier for the game server group. Use either the name or
-- ARN value.
newUpdateGameServerGroup ::
  -- | 'gameServerGroupName'
  Prelude.Text ->
  UpdateGameServerGroup
newUpdateGameServerGroup :: Text -> UpdateGameServerGroup
newUpdateGameServerGroup Text
pGameServerGroupName_ =
  UpdateGameServerGroup'
    { $sel:balancingStrategy:UpdateGameServerGroup' :: Maybe BalancingStrategy
balancingStrategy =
        forall a. Maybe a
Prelude.Nothing,
      $sel:gameServerProtectionPolicy:UpdateGameServerGroup' :: Maybe GameServerProtectionPolicy
gameServerProtectionPolicy = forall a. Maybe a
Prelude.Nothing,
      $sel:instanceDefinitions:UpdateGameServerGroup' :: Maybe (NonEmpty InstanceDefinition)
instanceDefinitions = forall a. Maybe a
Prelude.Nothing,
      $sel:roleArn:UpdateGameServerGroup' :: Maybe Text
roleArn = forall a. Maybe a
Prelude.Nothing,
      $sel:gameServerGroupName:UpdateGameServerGroup' :: Text
gameServerGroupName = Text
pGameServerGroupName_
    }

-- | Indicates how GameLift FleetIQ balances the use of Spot Instances and
-- On-Demand Instances in the game server group. Method options include the
-- following:
--
-- -   @SPOT_ONLY@ - Only Spot Instances are used in the game server group.
--     If Spot Instances are unavailable or not viable for game hosting,
--     the game server group provides no hosting capacity until Spot
--     Instances can again be used. Until then, no new instances are
--     started, and the existing nonviable Spot Instances are terminated
--     (after current gameplay ends) and are not replaced.
--
-- -   @SPOT_PREFERRED@ - (default value) Spot Instances are used whenever
--     available in the game server group. If Spot Instances are
--     unavailable, the game server group continues to provide hosting
--     capacity by falling back to On-Demand Instances. Existing nonviable
--     Spot Instances are terminated (after current gameplay ends) and are
--     replaced with new On-Demand Instances.
--
-- -   @ON_DEMAND_ONLY@ - Only On-Demand Instances are used in the game
--     server group. No Spot Instances are used, even when available, while
--     this balancing strategy is in force.
updateGameServerGroup_balancingStrategy :: Lens.Lens' UpdateGameServerGroup (Prelude.Maybe BalancingStrategy)
updateGameServerGroup_balancingStrategy :: Lens' UpdateGameServerGroup (Maybe BalancingStrategy)
updateGameServerGroup_balancingStrategy = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateGameServerGroup' {Maybe BalancingStrategy
balancingStrategy :: Maybe BalancingStrategy
$sel:balancingStrategy:UpdateGameServerGroup' :: UpdateGameServerGroup -> Maybe BalancingStrategy
balancingStrategy} -> Maybe BalancingStrategy
balancingStrategy) (\s :: UpdateGameServerGroup
s@UpdateGameServerGroup' {} Maybe BalancingStrategy
a -> UpdateGameServerGroup
s {$sel:balancingStrategy:UpdateGameServerGroup' :: Maybe BalancingStrategy
balancingStrategy = Maybe BalancingStrategy
a} :: UpdateGameServerGroup)

-- | A flag that indicates whether instances in the game server group are
-- protected from early termination. Unprotected instances that have active
-- game servers running might be terminated during a scale-down event,
-- causing players to be dropped from the game. Protected instances cannot
-- be terminated while there are active game servers running except in the
-- event of a forced game server group deletion (see ). An exception to
-- this is with Spot Instances, which can be terminated by Amazon Web
-- Services regardless of protection status. This property is set to
-- @NO_PROTECTION@ by default.
updateGameServerGroup_gameServerProtectionPolicy :: Lens.Lens' UpdateGameServerGroup (Prelude.Maybe GameServerProtectionPolicy)
updateGameServerGroup_gameServerProtectionPolicy :: Lens' UpdateGameServerGroup (Maybe GameServerProtectionPolicy)
updateGameServerGroup_gameServerProtectionPolicy = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateGameServerGroup' {Maybe GameServerProtectionPolicy
gameServerProtectionPolicy :: Maybe GameServerProtectionPolicy
$sel:gameServerProtectionPolicy:UpdateGameServerGroup' :: UpdateGameServerGroup -> Maybe GameServerProtectionPolicy
gameServerProtectionPolicy} -> Maybe GameServerProtectionPolicy
gameServerProtectionPolicy) (\s :: UpdateGameServerGroup
s@UpdateGameServerGroup' {} Maybe GameServerProtectionPolicy
a -> UpdateGameServerGroup
s {$sel:gameServerProtectionPolicy:UpdateGameServerGroup' :: Maybe GameServerProtectionPolicy
gameServerProtectionPolicy = Maybe GameServerProtectionPolicy
a} :: UpdateGameServerGroup)

-- | An updated list of Amazon EC2 instance types to use in the Auto Scaling
-- group. The instance definitions must specify at least two different
-- instance types that are supported by GameLift FleetIQ. This updated list
-- replaces the entire current list of instance definitions for the game
-- server group. For more information on instance types, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/instance-types.html EC2 Instance Types>
-- in the /Amazon EC2 User Guide/. You can optionally specify capacity
-- weighting for each instance type. If no weight value is specified for an
-- instance type, it is set to the default value \"1\". For more
-- information about capacity weighting, see
-- <https://docs.aws.amazon.com/autoscaling/ec2/userguide/asg-instance-weighting.html Instance Weighting for Amazon EC2 Auto Scaling>
-- in the Amazon EC2 Auto Scaling User Guide.
updateGameServerGroup_instanceDefinitions :: Lens.Lens' UpdateGameServerGroup (Prelude.Maybe (Prelude.NonEmpty InstanceDefinition))
updateGameServerGroup_instanceDefinitions :: Lens' UpdateGameServerGroup (Maybe (NonEmpty InstanceDefinition))
updateGameServerGroup_instanceDefinitions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateGameServerGroup' {Maybe (NonEmpty InstanceDefinition)
instanceDefinitions :: Maybe (NonEmpty InstanceDefinition)
$sel:instanceDefinitions:UpdateGameServerGroup' :: UpdateGameServerGroup -> Maybe (NonEmpty InstanceDefinition)
instanceDefinitions} -> Maybe (NonEmpty InstanceDefinition)
instanceDefinitions) (\s :: UpdateGameServerGroup
s@UpdateGameServerGroup' {} Maybe (NonEmpty InstanceDefinition)
a -> UpdateGameServerGroup
s {$sel:instanceDefinitions:UpdateGameServerGroup' :: Maybe (NonEmpty InstanceDefinition)
instanceDefinitions = Maybe (NonEmpty InstanceDefinition)
a} :: UpdateGameServerGroup) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | The Amazon Resource Name
-- (<https://docs.aws.amazon.com/AmazonS3/latest/dev/s3-arn-format.html ARN>)
-- for an IAM role that allows Amazon GameLift to access your Amazon EC2
-- Auto Scaling groups.
updateGameServerGroup_roleArn :: Lens.Lens' UpdateGameServerGroup (Prelude.Maybe Prelude.Text)
updateGameServerGroup_roleArn :: Lens' UpdateGameServerGroup (Maybe Text)
updateGameServerGroup_roleArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateGameServerGroup' {Maybe Text
roleArn :: Maybe Text
$sel:roleArn:UpdateGameServerGroup' :: UpdateGameServerGroup -> Maybe Text
roleArn} -> Maybe Text
roleArn) (\s :: UpdateGameServerGroup
s@UpdateGameServerGroup' {} Maybe Text
a -> UpdateGameServerGroup
s {$sel:roleArn:UpdateGameServerGroup' :: Maybe Text
roleArn = Maybe Text
a} :: UpdateGameServerGroup)

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

instance Core.AWSRequest UpdateGameServerGroup where
  type
    AWSResponse UpdateGameServerGroup =
      UpdateGameServerGroupResponse
  request :: (Service -> Service)
-> UpdateGameServerGroup -> Request UpdateGameServerGroup
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 UpdateGameServerGroup
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse UpdateGameServerGroup)))
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 -> UpdateGameServerGroupResponse
UpdateGameServerGroupResponse'
            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 UpdateGameServerGroup where
  hashWithSalt :: Int -> UpdateGameServerGroup -> Int
hashWithSalt Int
_salt UpdateGameServerGroup' {Maybe (NonEmpty InstanceDefinition)
Maybe Text
Maybe BalancingStrategy
Maybe GameServerProtectionPolicy
Text
gameServerGroupName :: Text
roleArn :: Maybe Text
instanceDefinitions :: Maybe (NonEmpty InstanceDefinition)
gameServerProtectionPolicy :: Maybe GameServerProtectionPolicy
balancingStrategy :: Maybe BalancingStrategy
$sel:gameServerGroupName:UpdateGameServerGroup' :: UpdateGameServerGroup -> Text
$sel:roleArn:UpdateGameServerGroup' :: UpdateGameServerGroup -> Maybe Text
$sel:instanceDefinitions:UpdateGameServerGroup' :: UpdateGameServerGroup -> Maybe (NonEmpty InstanceDefinition)
$sel:gameServerProtectionPolicy:UpdateGameServerGroup' :: UpdateGameServerGroup -> Maybe GameServerProtectionPolicy
$sel:balancingStrategy:UpdateGameServerGroup' :: UpdateGameServerGroup -> Maybe BalancingStrategy
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe BalancingStrategy
balancingStrategy
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe GameServerProtectionPolicy
gameServerProtectionPolicy
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (NonEmpty InstanceDefinition)
instanceDefinitions
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
roleArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
gameServerGroupName

instance Prelude.NFData UpdateGameServerGroup where
  rnf :: UpdateGameServerGroup -> ()
rnf UpdateGameServerGroup' {Maybe (NonEmpty InstanceDefinition)
Maybe Text
Maybe BalancingStrategy
Maybe GameServerProtectionPolicy
Text
gameServerGroupName :: Text
roleArn :: Maybe Text
instanceDefinitions :: Maybe (NonEmpty InstanceDefinition)
gameServerProtectionPolicy :: Maybe GameServerProtectionPolicy
balancingStrategy :: Maybe BalancingStrategy
$sel:gameServerGroupName:UpdateGameServerGroup' :: UpdateGameServerGroup -> Text
$sel:roleArn:UpdateGameServerGroup' :: UpdateGameServerGroup -> Maybe Text
$sel:instanceDefinitions:UpdateGameServerGroup' :: UpdateGameServerGroup -> Maybe (NonEmpty InstanceDefinition)
$sel:gameServerProtectionPolicy:UpdateGameServerGroup' :: UpdateGameServerGroup -> Maybe GameServerProtectionPolicy
$sel:balancingStrategy:UpdateGameServerGroup' :: UpdateGameServerGroup -> Maybe BalancingStrategy
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe BalancingStrategy
balancingStrategy
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe GameServerProtectionPolicy
gameServerProtectionPolicy
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (NonEmpty InstanceDefinition)
instanceDefinitions
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
roleArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
gameServerGroupName

instance Data.ToHeaders UpdateGameServerGroup where
  toHeaders :: UpdateGameServerGroup -> 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.UpdateGameServerGroup" ::
                          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 UpdateGameServerGroup where
  toJSON :: UpdateGameServerGroup -> Value
toJSON UpdateGameServerGroup' {Maybe (NonEmpty InstanceDefinition)
Maybe Text
Maybe BalancingStrategy
Maybe GameServerProtectionPolicy
Text
gameServerGroupName :: Text
roleArn :: Maybe Text
instanceDefinitions :: Maybe (NonEmpty InstanceDefinition)
gameServerProtectionPolicy :: Maybe GameServerProtectionPolicy
balancingStrategy :: Maybe BalancingStrategy
$sel:gameServerGroupName:UpdateGameServerGroup' :: UpdateGameServerGroup -> Text
$sel:roleArn:UpdateGameServerGroup' :: UpdateGameServerGroup -> Maybe Text
$sel:instanceDefinitions:UpdateGameServerGroup' :: UpdateGameServerGroup -> Maybe (NonEmpty InstanceDefinition)
$sel:gameServerProtectionPolicy:UpdateGameServerGroup' :: UpdateGameServerGroup -> Maybe GameServerProtectionPolicy
$sel:balancingStrategy:UpdateGameServerGroup' :: UpdateGameServerGroup -> Maybe BalancingStrategy
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"BalancingStrategy" 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 BalancingStrategy
balancingStrategy,
            (Key
"GameServerProtectionPolicy" 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 GameServerProtectionPolicy
gameServerProtectionPolicy,
            (Key
"InstanceDefinitions" 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 (NonEmpty InstanceDefinition)
instanceDefinitions,
            (Key
"RoleArn" 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 Text
roleArn,
            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 UpdateGameServerGroup where
  toPath :: UpdateGameServerGroup -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

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

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

-- |
-- Create a value of 'UpdateGameServerGroupResponse' 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', 'updateGameServerGroupResponse_gameServerGroup' - An object that describes the game server group resource with updated
-- properties.
--
-- 'httpStatus', 'updateGameServerGroupResponse_httpStatus' - The response's http status code.
newUpdateGameServerGroupResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UpdateGameServerGroupResponse
newUpdateGameServerGroupResponse :: Int -> UpdateGameServerGroupResponse
newUpdateGameServerGroupResponse Int
pHttpStatus_ =
  UpdateGameServerGroupResponse'
    { $sel:gameServerGroup:UpdateGameServerGroupResponse' :: Maybe GameServerGroup
gameServerGroup =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:UpdateGameServerGroupResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | An object that describes the game server group resource with updated
-- properties.
updateGameServerGroupResponse_gameServerGroup :: Lens.Lens' UpdateGameServerGroupResponse (Prelude.Maybe GameServerGroup)
updateGameServerGroupResponse_gameServerGroup :: Lens' UpdateGameServerGroupResponse (Maybe GameServerGroup)
updateGameServerGroupResponse_gameServerGroup = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateGameServerGroupResponse' {Maybe GameServerGroup
gameServerGroup :: Maybe GameServerGroup
$sel:gameServerGroup:UpdateGameServerGroupResponse' :: UpdateGameServerGroupResponse -> Maybe GameServerGroup
gameServerGroup} -> Maybe GameServerGroup
gameServerGroup) (\s :: UpdateGameServerGroupResponse
s@UpdateGameServerGroupResponse' {} Maybe GameServerGroup
a -> UpdateGameServerGroupResponse
s {$sel:gameServerGroup:UpdateGameServerGroupResponse' :: Maybe GameServerGroup
gameServerGroup = Maybe GameServerGroup
a} :: UpdateGameServerGroupResponse)

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

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