{-# 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.ResumeGameServerGroup
-- 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.__
--
-- Reinstates activity on a game server group after it has been suspended.
-- A game server group might be suspended by the
-- <gamelift/latest/apireference/API_SuspendGameServerGroup.html SuspendGameServerGroup>
-- operation, or it might be suspended involuntarily due to a configuration
-- problem. In the second case, you can manually resume activity on the
-- group once the configuration problem has been resolved. Refer to the
-- game server group status and status reason for more information on why
-- group activity is suspended.
--
-- To resume activity, specify a game server group ARN and the type of
-- activity to be resumed. If successful, a @GameServerGroup@ object is
-- returned showing that the resumed activity is no longer listed in
-- @SuspendedActions@.
--
-- __Learn more__
--
-- <https://docs.aws.amazon.com/gamelift/latest/fleetiqguide/gsg-intro.html GameLift FleetIQ Guide>
module Amazonka.GameLift.ResumeGameServerGroup
  ( -- * Creating a Request
    ResumeGameServerGroup (..),
    newResumeGameServerGroup,

    -- * Request Lenses
    resumeGameServerGroup_gameServerGroupName,
    resumeGameServerGroup_resumeActions,

    -- * Destructuring the Response
    ResumeGameServerGroupResponse (..),
    newResumeGameServerGroupResponse,

    -- * Response Lenses
    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

-- | /See:/ 'newResumeGameServerGroup' smart constructor.
data ResumeGameServerGroup = ResumeGameServerGroup'
  { -- | A unique identifier for the game server group. Use either the name or
    -- ARN value.
    ResumeGameServerGroup -> Text
gameServerGroupName :: Prelude.Text,
    -- | The activity to resume for this game server group.
    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)

-- |
-- Create a value of 'ResumeGameServerGroup' 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', 'resumeGameServerGroup_gameServerGroupName' - A unique identifier for the game server group. Use either the name or
-- ARN value.
--
-- 'resumeActions', 'resumeGameServerGroup_resumeActions' - The activity to resume for this game server group.
newResumeGameServerGroup ::
  -- | 'gameServerGroupName'
  Prelude.Text ->
  -- | 'resumeActions'
  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_
      }

-- | A unique identifier for the game server group. Use either the name or
-- ARN value.
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)

-- | The activity to resume for this game server group.
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

-- | /See:/ 'newResumeGameServerGroupResponse' smart constructor.
data ResumeGameServerGroupResponse = ResumeGameServerGroupResponse'
  { -- | An object that describes the game server group resource, with the
    -- @SuspendedActions@ property updated to reflect the resumed activity.
    ResumeGameServerGroupResponse -> Maybe GameServerGroup
gameServerGroup :: Prelude.Maybe GameServerGroup,
    -- | The response's http status code.
    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)

-- |
-- Create a value of 'ResumeGameServerGroupResponse' 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', 'resumeGameServerGroupResponse_gameServerGroup' - An object that describes the game server group resource, with the
-- @SuspendedActions@ property updated to reflect the resumed activity.
--
-- 'httpStatus', 'resumeGameServerGroupResponse_httpStatus' - The response's http status code.
newResumeGameServerGroupResponse ::
  -- | 'httpStatus'
  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_
    }

-- | An object that describes the game server group resource, with the
-- @SuspendedActions@ property updated to reflect the resumed activity.
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)

-- | The response's http status code.
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