{-# 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.ResumeGameServerGroup
(
ResumeGameServerGroup (..),
newResumeGameServerGroup,
resumeGameServerGroup_gameServerGroupName,
resumeGameServerGroup_resumeActions,
ResumeGameServerGroupResponse (..),
newResumeGameServerGroupResponse,
resumeGameServerGroupResponse_gameServerGroup,
resumeGameServerGroupResponse_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 ResumeGameServerGroup = ResumeGameServerGroup'
{
ResumeGameServerGroup -> Text
gameServerGroupName :: Prelude.Text,
ResumeGameServerGroup -> NonEmpty GameServerGroupAction
resumeActions :: Prelude.NonEmpty GameServerGroupAction
}
deriving (ResumeGameServerGroup -> ResumeGameServerGroup -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ResumeGameServerGroup -> ResumeGameServerGroup -> Bool
$c/= :: ResumeGameServerGroup -> ResumeGameServerGroup -> Bool
== :: ResumeGameServerGroup -> ResumeGameServerGroup -> Bool
$c== :: ResumeGameServerGroup -> ResumeGameServerGroup -> Bool
Prelude.Eq, ReadPrec [ResumeGameServerGroup]
ReadPrec ResumeGameServerGroup
Int -> ReadS ResumeGameServerGroup
ReadS [ResumeGameServerGroup]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ResumeGameServerGroup]
$creadListPrec :: ReadPrec [ResumeGameServerGroup]
readPrec :: ReadPrec ResumeGameServerGroup
$creadPrec :: ReadPrec ResumeGameServerGroup
readList :: ReadS [ResumeGameServerGroup]
$creadList :: ReadS [ResumeGameServerGroup]
readsPrec :: Int -> ReadS ResumeGameServerGroup
$creadsPrec :: Int -> ReadS ResumeGameServerGroup
Prelude.Read, Int -> ResumeGameServerGroup -> ShowS
[ResumeGameServerGroup] -> ShowS
ResumeGameServerGroup -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ResumeGameServerGroup] -> ShowS
$cshowList :: [ResumeGameServerGroup] -> ShowS
show :: ResumeGameServerGroup -> String
$cshow :: ResumeGameServerGroup -> String
showsPrec :: Int -> ResumeGameServerGroup -> ShowS
$cshowsPrec :: Int -> ResumeGameServerGroup -> ShowS
Prelude.Show, forall x. Rep ResumeGameServerGroup x -> ResumeGameServerGroup
forall x. ResumeGameServerGroup -> Rep ResumeGameServerGroup x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ResumeGameServerGroup x -> ResumeGameServerGroup
$cfrom :: forall x. ResumeGameServerGroup -> Rep ResumeGameServerGroup x
Prelude.Generic)
newResumeGameServerGroup ::
Prelude.Text ->
Prelude.NonEmpty GameServerGroupAction ->
ResumeGameServerGroup
newResumeGameServerGroup :: Text -> NonEmpty GameServerGroupAction -> ResumeGameServerGroup
newResumeGameServerGroup
Text
pGameServerGroupName_
NonEmpty GameServerGroupAction
pResumeActions_ =
ResumeGameServerGroup'
{ $sel:gameServerGroupName:ResumeGameServerGroup' :: Text
gameServerGroupName =
Text
pGameServerGroupName_,
$sel:resumeActions:ResumeGameServerGroup' :: NonEmpty GameServerGroupAction
resumeActions = 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
pResumeActions_
}
resumeGameServerGroup_gameServerGroupName :: Lens.Lens' ResumeGameServerGroup Prelude.Text
resumeGameServerGroup_gameServerGroupName :: Lens' ResumeGameServerGroup Text
resumeGameServerGroup_gameServerGroupName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ResumeGameServerGroup' {Text
gameServerGroupName :: Text
$sel:gameServerGroupName:ResumeGameServerGroup' :: ResumeGameServerGroup -> Text
gameServerGroupName} -> Text
gameServerGroupName) (\s :: ResumeGameServerGroup
s@ResumeGameServerGroup' {} Text
a -> ResumeGameServerGroup
s {$sel:gameServerGroupName:ResumeGameServerGroup' :: Text
gameServerGroupName = Text
a} :: ResumeGameServerGroup)
resumeGameServerGroup_resumeActions :: Lens.Lens' ResumeGameServerGroup (Prelude.NonEmpty GameServerGroupAction)
resumeGameServerGroup_resumeActions :: Lens' ResumeGameServerGroup (NonEmpty GameServerGroupAction)
resumeGameServerGroup_resumeActions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ResumeGameServerGroup' {NonEmpty GameServerGroupAction
resumeActions :: NonEmpty GameServerGroupAction
$sel:resumeActions:ResumeGameServerGroup' :: ResumeGameServerGroup -> NonEmpty GameServerGroupAction
resumeActions} -> NonEmpty GameServerGroupAction
resumeActions) (\s :: ResumeGameServerGroup
s@ResumeGameServerGroup' {} NonEmpty GameServerGroupAction
a -> ResumeGameServerGroup
s {$sel:resumeActions:ResumeGameServerGroup' :: NonEmpty GameServerGroupAction
resumeActions = NonEmpty GameServerGroupAction
a} :: ResumeGameServerGroup) 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 ResumeGameServerGroup where
type
AWSResponse ResumeGameServerGroup =
ResumeGameServerGroupResponse
request :: (Service -> Service)
-> ResumeGameServerGroup -> Request ResumeGameServerGroup
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 ResumeGameServerGroup
-> ClientResponse ClientBody
-> m (Either
Error (ClientResponse (AWSResponse ResumeGameServerGroup)))
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 -> ResumeGameServerGroupResponse
ResumeGameServerGroupResponse'
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 ResumeGameServerGroup where
hashWithSalt :: Int -> ResumeGameServerGroup -> Int
hashWithSalt Int
_salt ResumeGameServerGroup' {NonEmpty GameServerGroupAction
Text
resumeActions :: NonEmpty GameServerGroupAction
gameServerGroupName :: Text
$sel:resumeActions:ResumeGameServerGroup' :: ResumeGameServerGroup -> NonEmpty GameServerGroupAction
$sel:gameServerGroupName:ResumeGameServerGroup' :: ResumeGameServerGroup -> 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
resumeActions
instance Prelude.NFData ResumeGameServerGroup where
rnf :: ResumeGameServerGroup -> ()
rnf ResumeGameServerGroup' {NonEmpty GameServerGroupAction
Text
resumeActions :: NonEmpty GameServerGroupAction
gameServerGroupName :: Text
$sel:resumeActions:ResumeGameServerGroup' :: ResumeGameServerGroup -> NonEmpty GameServerGroupAction
$sel:gameServerGroupName:ResumeGameServerGroup' :: ResumeGameServerGroup -> 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
resumeActions
instance Data.ToHeaders ResumeGameServerGroup where
toHeaders :: ResumeGameServerGroup -> 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.ResumeGameServerGroup" ::
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 ResumeGameServerGroup where
toJSON :: ResumeGameServerGroup -> Value
toJSON ResumeGameServerGroup' {NonEmpty GameServerGroupAction
Text
resumeActions :: NonEmpty GameServerGroupAction
gameServerGroupName :: Text
$sel:resumeActions:ResumeGameServerGroup' :: ResumeGameServerGroup -> NonEmpty GameServerGroupAction
$sel:gameServerGroupName:ResumeGameServerGroup' :: ResumeGameServerGroup -> 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
"ResumeActions" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= NonEmpty GameServerGroupAction
resumeActions)
]
)
instance Data.ToPath ResumeGameServerGroup where
toPath :: ResumeGameServerGroup -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"
instance Data.ToQuery ResumeGameServerGroup where
toQuery :: ResumeGameServerGroup -> QueryString
toQuery = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty
data ResumeGameServerGroupResponse = ResumeGameServerGroupResponse'
{
ResumeGameServerGroupResponse -> Maybe GameServerGroup
gameServerGroup :: Prelude.Maybe GameServerGroup,
ResumeGameServerGroupResponse -> Int
httpStatus :: Prelude.Int
}
deriving (ResumeGameServerGroupResponse
-> ResumeGameServerGroupResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ResumeGameServerGroupResponse
-> ResumeGameServerGroupResponse -> Bool
$c/= :: ResumeGameServerGroupResponse
-> ResumeGameServerGroupResponse -> Bool
== :: ResumeGameServerGroupResponse
-> ResumeGameServerGroupResponse -> Bool
$c== :: ResumeGameServerGroupResponse
-> ResumeGameServerGroupResponse -> Bool
Prelude.Eq, ReadPrec [ResumeGameServerGroupResponse]
ReadPrec ResumeGameServerGroupResponse
Int -> ReadS ResumeGameServerGroupResponse
ReadS [ResumeGameServerGroupResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ResumeGameServerGroupResponse]
$creadListPrec :: ReadPrec [ResumeGameServerGroupResponse]
readPrec :: ReadPrec ResumeGameServerGroupResponse
$creadPrec :: ReadPrec ResumeGameServerGroupResponse
readList :: ReadS [ResumeGameServerGroupResponse]
$creadList :: ReadS [ResumeGameServerGroupResponse]
readsPrec :: Int -> ReadS ResumeGameServerGroupResponse
$creadsPrec :: Int -> ReadS ResumeGameServerGroupResponse
Prelude.Read, Int -> ResumeGameServerGroupResponse -> ShowS
[ResumeGameServerGroupResponse] -> ShowS
ResumeGameServerGroupResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ResumeGameServerGroupResponse] -> ShowS
$cshowList :: [ResumeGameServerGroupResponse] -> ShowS
show :: ResumeGameServerGroupResponse -> String
$cshow :: ResumeGameServerGroupResponse -> String
showsPrec :: Int -> ResumeGameServerGroupResponse -> ShowS
$cshowsPrec :: Int -> ResumeGameServerGroupResponse -> ShowS
Prelude.Show, forall x.
Rep ResumeGameServerGroupResponse x
-> ResumeGameServerGroupResponse
forall x.
ResumeGameServerGroupResponse
-> Rep ResumeGameServerGroupResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ResumeGameServerGroupResponse x
-> ResumeGameServerGroupResponse
$cfrom :: forall x.
ResumeGameServerGroupResponse
-> Rep ResumeGameServerGroupResponse x
Prelude.Generic)
newResumeGameServerGroupResponse ::
Prelude.Int ->
ResumeGameServerGroupResponse
newResumeGameServerGroupResponse :: Int -> ResumeGameServerGroupResponse
newResumeGameServerGroupResponse Int
pHttpStatus_ =
ResumeGameServerGroupResponse'
{ $sel:gameServerGroup:ResumeGameServerGroupResponse' :: Maybe GameServerGroup
gameServerGroup =
forall a. Maybe a
Prelude.Nothing,
$sel:httpStatus:ResumeGameServerGroupResponse' :: Int
httpStatus = Int
pHttpStatus_
}
resumeGameServerGroupResponse_gameServerGroup :: Lens.Lens' ResumeGameServerGroupResponse (Prelude.Maybe GameServerGroup)
resumeGameServerGroupResponse_gameServerGroup :: Lens' ResumeGameServerGroupResponse (Maybe GameServerGroup)
resumeGameServerGroupResponse_gameServerGroup = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ResumeGameServerGroupResponse' {Maybe GameServerGroup
gameServerGroup :: Maybe GameServerGroup
$sel:gameServerGroup:ResumeGameServerGroupResponse' :: ResumeGameServerGroupResponse -> Maybe GameServerGroup
gameServerGroup} -> Maybe GameServerGroup
gameServerGroup) (\s :: ResumeGameServerGroupResponse
s@ResumeGameServerGroupResponse' {} Maybe GameServerGroup
a -> ResumeGameServerGroupResponse
s {$sel:gameServerGroup:ResumeGameServerGroupResponse' :: Maybe GameServerGroup
gameServerGroup = Maybe GameServerGroup
a} :: ResumeGameServerGroupResponse)
resumeGameServerGroupResponse_httpStatus :: Lens.Lens' ResumeGameServerGroupResponse Prelude.Int
resumeGameServerGroupResponse_httpStatus :: Lens' ResumeGameServerGroupResponse Int
resumeGameServerGroupResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ResumeGameServerGroupResponse' {Int
httpStatus :: Int
$sel:httpStatus:ResumeGameServerGroupResponse' :: ResumeGameServerGroupResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: ResumeGameServerGroupResponse
s@ResumeGameServerGroupResponse' {} Int
a -> ResumeGameServerGroupResponse
s {$sel:httpStatus:ResumeGameServerGroupResponse' :: Int
httpStatus = Int
a} :: ResumeGameServerGroupResponse)
instance Prelude.NFData ResumeGameServerGroupResponse where
rnf :: ResumeGameServerGroupResponse -> ()
rnf ResumeGameServerGroupResponse' {Int
Maybe GameServerGroup
httpStatus :: Int
gameServerGroup :: Maybe GameServerGroup
$sel:httpStatus:ResumeGameServerGroupResponse' :: ResumeGameServerGroupResponse -> Int
$sel:gameServerGroup:ResumeGameServerGroupResponse' :: ResumeGameServerGroupResponse -> 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