{-# 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 #-}
module Amazonka.GameLift.UpdateGameServerGroup
(
UpdateGameServerGroup (..),
newUpdateGameServerGroup,
updateGameServerGroup_balancingStrategy,
updateGameServerGroup_gameServerProtectionPolicy,
updateGameServerGroup_instanceDefinitions,
updateGameServerGroup_roleArn,
updateGameServerGroup_gameServerGroupName,
UpdateGameServerGroupResponse (..),
newUpdateGameServerGroupResponse,
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
data UpdateGameServerGroup = UpdateGameServerGroup'
{
UpdateGameServerGroup -> Maybe BalancingStrategy
balancingStrategy :: Prelude.Maybe BalancingStrategy,
UpdateGameServerGroup -> Maybe GameServerProtectionPolicy
gameServerProtectionPolicy :: Prelude.Maybe GameServerProtectionPolicy,
UpdateGameServerGroup -> Maybe (NonEmpty InstanceDefinition)
instanceDefinitions :: Prelude.Maybe (Prelude.NonEmpty InstanceDefinition),
UpdateGameServerGroup -> Maybe Text
roleArn :: Prelude.Maybe Prelude.Text,
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)
newUpdateGameServerGroup ::
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_
}
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)
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)
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
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)
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
data UpdateGameServerGroupResponse = UpdateGameServerGroupResponse'
{
UpdateGameServerGroupResponse -> Maybe GameServerGroup
gameServerGroup :: Prelude.Maybe GameServerGroup,
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)
newUpdateGameServerGroupResponse ::
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_
}
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)
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