{-# 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.UpdateFleetCapacity
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Updates capacity settings for a fleet. For fleets with multiple
-- locations, use this operation to manage capacity settings in each
-- location individually. Fleet capacity determines the number of game
-- sessions and players that can be hosted based on the fleet
-- configuration. Use this operation to set the following fleet capacity
-- properties:
--
-- -   Minimum\/maximum size: Set hard limits on fleet capacity. GameLift
--     cannot set the fleet\'s capacity to a value outside of this range,
--     whether the capacity is changed manually or through automatic
--     scaling.
--
-- -   Desired capacity: Manually set the number of Amazon EC2 instances to
--     be maintained in a fleet location. Before changing a fleet\'s
--     desired capacity, you may want to call
--     <https://docs.aws.amazon.com/gamelift/latest/apireference/API_DescribeEC2InstanceLimits.html DescribeEC2InstanceLimits>
--     to get the maximum capacity of the fleet\'s Amazon EC2 instance
--     type. Alternatively, consider using automatic scaling to adjust
--     capacity based on player demand.
--
-- This operation can be used in the following ways:
--
-- -   To update capacity for a fleet\'s home Region, or if the fleet has
--     no remote locations, omit the @Location@ parameter. The fleet must
--     be in @ACTIVE@ status.
--
-- -   To update capacity for a fleet\'s remote location, include the
--     @Location@ parameter set to the location to be updated. The location
--     must be in @ACTIVE@ status.
--
-- If successful, capacity settings are updated immediately. In response a
-- change in desired capacity, GameLift initiates steps to start new
-- instances or terminate existing instances in the requested fleet
-- location. This continues until the location\'s active instance count
-- matches the new desired instance count. You can track a fleet\'s current
-- capacity by calling
-- <https://docs.aws.amazon.com/gamelift/latest/apireference/API_DescribeFleetCapacity.html DescribeFleetCapacity>
-- or
-- <https://docs.aws.amazon.com/gamelift/latest/apireference/API_DescribeFleetLocationCapacity.html DescribeFleetLocationCapacity>.
-- If the requested desired instance count is higher than the instance
-- type\'s limit, the @LimitExceeded@ exception occurs.
--
-- __Learn more__
--
-- <https://docs.aws.amazon.com/gamelift/latest/developerguide/fleets-manage-capacity.html Scaling fleet capacity>
module Amazonka.GameLift.UpdateFleetCapacity
  ( -- * Creating a Request
    UpdateFleetCapacity (..),
    newUpdateFleetCapacity,

    -- * Request Lenses
    updateFleetCapacity_desiredInstances,
    updateFleetCapacity_location,
    updateFleetCapacity_maxSize,
    updateFleetCapacity_minSize,
    updateFleetCapacity_fleetId,

    -- * Destructuring the Response
    UpdateFleetCapacityResponse (..),
    newUpdateFleetCapacityResponse,

    -- * Response Lenses
    updateFleetCapacityResponse_fleetArn,
    updateFleetCapacityResponse_fleetId,
    updateFleetCapacityResponse_location,
    updateFleetCapacityResponse_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:/ 'newUpdateFleetCapacity' smart constructor.
data UpdateFleetCapacity = UpdateFleetCapacity'
  { -- | The number of Amazon EC2 instances you want to maintain in the specified
    -- fleet location. This value must fall between the minimum and maximum
    -- size limits.
    UpdateFleetCapacity -> Maybe Natural
desiredInstances :: Prelude.Maybe Prelude.Natural,
    -- | The name of a remote location to update fleet capacity settings for, in
    -- the form of an Amazon Web Services Region code such as @us-west-2@.
    UpdateFleetCapacity -> Maybe Text
location :: Prelude.Maybe Prelude.Text,
    -- | The maximum number of instances that are allowed in the specified fleet
    -- location. If this parameter is not set, the default is 1.
    UpdateFleetCapacity -> Maybe Natural
maxSize :: Prelude.Maybe Prelude.Natural,
    -- | The minimum number of instances that are allowed in the specified fleet
    -- location. If this parameter is not set, the default is 0.
    UpdateFleetCapacity -> Maybe Natural
minSize :: Prelude.Maybe Prelude.Natural,
    -- | A unique identifier for the fleet to update capacity settings for. You
    -- can use either the fleet ID or ARN value.
    UpdateFleetCapacity -> Text
fleetId :: Prelude.Text
  }
  deriving (UpdateFleetCapacity -> UpdateFleetCapacity -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateFleetCapacity -> UpdateFleetCapacity -> Bool
$c/= :: UpdateFleetCapacity -> UpdateFleetCapacity -> Bool
== :: UpdateFleetCapacity -> UpdateFleetCapacity -> Bool
$c== :: UpdateFleetCapacity -> UpdateFleetCapacity -> Bool
Prelude.Eq, ReadPrec [UpdateFleetCapacity]
ReadPrec UpdateFleetCapacity
Int -> ReadS UpdateFleetCapacity
ReadS [UpdateFleetCapacity]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateFleetCapacity]
$creadListPrec :: ReadPrec [UpdateFleetCapacity]
readPrec :: ReadPrec UpdateFleetCapacity
$creadPrec :: ReadPrec UpdateFleetCapacity
readList :: ReadS [UpdateFleetCapacity]
$creadList :: ReadS [UpdateFleetCapacity]
readsPrec :: Int -> ReadS UpdateFleetCapacity
$creadsPrec :: Int -> ReadS UpdateFleetCapacity
Prelude.Read, Int -> UpdateFleetCapacity -> ShowS
[UpdateFleetCapacity] -> ShowS
UpdateFleetCapacity -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateFleetCapacity] -> ShowS
$cshowList :: [UpdateFleetCapacity] -> ShowS
show :: UpdateFleetCapacity -> String
$cshow :: UpdateFleetCapacity -> String
showsPrec :: Int -> UpdateFleetCapacity -> ShowS
$cshowsPrec :: Int -> UpdateFleetCapacity -> ShowS
Prelude.Show, forall x. Rep UpdateFleetCapacity x -> UpdateFleetCapacity
forall x. UpdateFleetCapacity -> Rep UpdateFleetCapacity x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateFleetCapacity x -> UpdateFleetCapacity
$cfrom :: forall x. UpdateFleetCapacity -> Rep UpdateFleetCapacity x
Prelude.Generic)

-- |
-- Create a value of 'UpdateFleetCapacity' 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:
--
-- 'desiredInstances', 'updateFleetCapacity_desiredInstances' - The number of Amazon EC2 instances you want to maintain in the specified
-- fleet location. This value must fall between the minimum and maximum
-- size limits.
--
-- 'location', 'updateFleetCapacity_location' - The name of a remote location to update fleet capacity settings for, in
-- the form of an Amazon Web Services Region code such as @us-west-2@.
--
-- 'maxSize', 'updateFleetCapacity_maxSize' - The maximum number of instances that are allowed in the specified fleet
-- location. If this parameter is not set, the default is 1.
--
-- 'minSize', 'updateFleetCapacity_minSize' - The minimum number of instances that are allowed in the specified fleet
-- location. If this parameter is not set, the default is 0.
--
-- 'fleetId', 'updateFleetCapacity_fleetId' - A unique identifier for the fleet to update capacity settings for. You
-- can use either the fleet ID or ARN value.
newUpdateFleetCapacity ::
  -- | 'fleetId'
  Prelude.Text ->
  UpdateFleetCapacity
newUpdateFleetCapacity :: Text -> UpdateFleetCapacity
newUpdateFleetCapacity Text
pFleetId_ =
  UpdateFleetCapacity'
    { $sel:desiredInstances:UpdateFleetCapacity' :: Maybe Natural
desiredInstances =
        forall a. Maybe a
Prelude.Nothing,
      $sel:location:UpdateFleetCapacity' :: Maybe Text
location = forall a. Maybe a
Prelude.Nothing,
      $sel:maxSize:UpdateFleetCapacity' :: Maybe Natural
maxSize = forall a. Maybe a
Prelude.Nothing,
      $sel:minSize:UpdateFleetCapacity' :: Maybe Natural
minSize = forall a. Maybe a
Prelude.Nothing,
      $sel:fleetId:UpdateFleetCapacity' :: Text
fleetId = Text
pFleetId_
    }

-- | The number of Amazon EC2 instances you want to maintain in the specified
-- fleet location. This value must fall between the minimum and maximum
-- size limits.
updateFleetCapacity_desiredInstances :: Lens.Lens' UpdateFleetCapacity (Prelude.Maybe Prelude.Natural)
updateFleetCapacity_desiredInstances :: Lens' UpdateFleetCapacity (Maybe Natural)
updateFleetCapacity_desiredInstances = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateFleetCapacity' {Maybe Natural
desiredInstances :: Maybe Natural
$sel:desiredInstances:UpdateFleetCapacity' :: UpdateFleetCapacity -> Maybe Natural
desiredInstances} -> Maybe Natural
desiredInstances) (\s :: UpdateFleetCapacity
s@UpdateFleetCapacity' {} Maybe Natural
a -> UpdateFleetCapacity
s {$sel:desiredInstances:UpdateFleetCapacity' :: Maybe Natural
desiredInstances = Maybe Natural
a} :: UpdateFleetCapacity)

-- | The name of a remote location to update fleet capacity settings for, in
-- the form of an Amazon Web Services Region code such as @us-west-2@.
updateFleetCapacity_location :: Lens.Lens' UpdateFleetCapacity (Prelude.Maybe Prelude.Text)
updateFleetCapacity_location :: Lens' UpdateFleetCapacity (Maybe Text)
updateFleetCapacity_location = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateFleetCapacity' {Maybe Text
location :: Maybe Text
$sel:location:UpdateFleetCapacity' :: UpdateFleetCapacity -> Maybe Text
location} -> Maybe Text
location) (\s :: UpdateFleetCapacity
s@UpdateFleetCapacity' {} Maybe Text
a -> UpdateFleetCapacity
s {$sel:location:UpdateFleetCapacity' :: Maybe Text
location = Maybe Text
a} :: UpdateFleetCapacity)

-- | The maximum number of instances that are allowed in the specified fleet
-- location. If this parameter is not set, the default is 1.
updateFleetCapacity_maxSize :: Lens.Lens' UpdateFleetCapacity (Prelude.Maybe Prelude.Natural)
updateFleetCapacity_maxSize :: Lens' UpdateFleetCapacity (Maybe Natural)
updateFleetCapacity_maxSize = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateFleetCapacity' {Maybe Natural
maxSize :: Maybe Natural
$sel:maxSize:UpdateFleetCapacity' :: UpdateFleetCapacity -> Maybe Natural
maxSize} -> Maybe Natural
maxSize) (\s :: UpdateFleetCapacity
s@UpdateFleetCapacity' {} Maybe Natural
a -> UpdateFleetCapacity
s {$sel:maxSize:UpdateFleetCapacity' :: Maybe Natural
maxSize = Maybe Natural
a} :: UpdateFleetCapacity)

-- | The minimum number of instances that are allowed in the specified fleet
-- location. If this parameter is not set, the default is 0.
updateFleetCapacity_minSize :: Lens.Lens' UpdateFleetCapacity (Prelude.Maybe Prelude.Natural)
updateFleetCapacity_minSize :: Lens' UpdateFleetCapacity (Maybe Natural)
updateFleetCapacity_minSize = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateFleetCapacity' {Maybe Natural
minSize :: Maybe Natural
$sel:minSize:UpdateFleetCapacity' :: UpdateFleetCapacity -> Maybe Natural
minSize} -> Maybe Natural
minSize) (\s :: UpdateFleetCapacity
s@UpdateFleetCapacity' {} Maybe Natural
a -> UpdateFleetCapacity
s {$sel:minSize:UpdateFleetCapacity' :: Maybe Natural
minSize = Maybe Natural
a} :: UpdateFleetCapacity)

-- | A unique identifier for the fleet to update capacity settings for. You
-- can use either the fleet ID or ARN value.
updateFleetCapacity_fleetId :: Lens.Lens' UpdateFleetCapacity Prelude.Text
updateFleetCapacity_fleetId :: Lens' UpdateFleetCapacity Text
updateFleetCapacity_fleetId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateFleetCapacity' {Text
fleetId :: Text
$sel:fleetId:UpdateFleetCapacity' :: UpdateFleetCapacity -> Text
fleetId} -> Text
fleetId) (\s :: UpdateFleetCapacity
s@UpdateFleetCapacity' {} Text
a -> UpdateFleetCapacity
s {$sel:fleetId:UpdateFleetCapacity' :: Text
fleetId = Text
a} :: UpdateFleetCapacity)

instance Core.AWSRequest UpdateFleetCapacity where
  type
    AWSResponse UpdateFleetCapacity =
      UpdateFleetCapacityResponse
  request :: (Service -> Service)
-> UpdateFleetCapacity -> Request UpdateFleetCapacity
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 UpdateFleetCapacity
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse UpdateFleetCapacity)))
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 Text
-> Maybe Text -> Maybe Text -> Int -> UpdateFleetCapacityResponse
UpdateFleetCapacityResponse'
            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
"FleetArn")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"FleetId")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"Location")
            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 UpdateFleetCapacity where
  hashWithSalt :: Int -> UpdateFleetCapacity -> Int
hashWithSalt Int
_salt UpdateFleetCapacity' {Maybe Natural
Maybe Text
Text
fleetId :: Text
minSize :: Maybe Natural
maxSize :: Maybe Natural
location :: Maybe Text
desiredInstances :: Maybe Natural
$sel:fleetId:UpdateFleetCapacity' :: UpdateFleetCapacity -> Text
$sel:minSize:UpdateFleetCapacity' :: UpdateFleetCapacity -> Maybe Natural
$sel:maxSize:UpdateFleetCapacity' :: UpdateFleetCapacity -> Maybe Natural
$sel:location:UpdateFleetCapacity' :: UpdateFleetCapacity -> Maybe Text
$sel:desiredInstances:UpdateFleetCapacity' :: UpdateFleetCapacity -> Maybe Natural
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
desiredInstances
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
location
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
maxSize
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
minSize
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
fleetId

instance Prelude.NFData UpdateFleetCapacity where
  rnf :: UpdateFleetCapacity -> ()
rnf UpdateFleetCapacity' {Maybe Natural
Maybe Text
Text
fleetId :: Text
minSize :: Maybe Natural
maxSize :: Maybe Natural
location :: Maybe Text
desiredInstances :: Maybe Natural
$sel:fleetId:UpdateFleetCapacity' :: UpdateFleetCapacity -> Text
$sel:minSize:UpdateFleetCapacity' :: UpdateFleetCapacity -> Maybe Natural
$sel:maxSize:UpdateFleetCapacity' :: UpdateFleetCapacity -> Maybe Natural
$sel:location:UpdateFleetCapacity' :: UpdateFleetCapacity -> Maybe Text
$sel:desiredInstances:UpdateFleetCapacity' :: UpdateFleetCapacity -> Maybe Natural
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
desiredInstances
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
location
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
maxSize
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
minSize
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
fleetId

instance Data.ToHeaders UpdateFleetCapacity where
  toHeaders :: UpdateFleetCapacity -> 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.UpdateFleetCapacity" ::
                          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 UpdateFleetCapacity where
  toJSON :: UpdateFleetCapacity -> Value
toJSON UpdateFleetCapacity' {Maybe Natural
Maybe Text
Text
fleetId :: Text
minSize :: Maybe Natural
maxSize :: Maybe Natural
location :: Maybe Text
desiredInstances :: Maybe Natural
$sel:fleetId:UpdateFleetCapacity' :: UpdateFleetCapacity -> Text
$sel:minSize:UpdateFleetCapacity' :: UpdateFleetCapacity -> Maybe Natural
$sel:maxSize:UpdateFleetCapacity' :: UpdateFleetCapacity -> Maybe Natural
$sel:location:UpdateFleetCapacity' :: UpdateFleetCapacity -> Maybe Text
$sel:desiredInstances:UpdateFleetCapacity' :: UpdateFleetCapacity -> Maybe Natural
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"DesiredInstances" 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 Natural
desiredInstances,
            (Key
"Location" 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
location,
            (Key
"MaxSize" 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 Natural
maxSize,
            (Key
"MinSize" 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 Natural
minSize,
            forall a. a -> Maybe a
Prelude.Just (Key
"FleetId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
fleetId)
          ]
      )

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

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

-- | /See:/ 'newUpdateFleetCapacityResponse' smart constructor.
data UpdateFleetCapacityResponse = UpdateFleetCapacityResponse'
  { -- | The Amazon Resource Name
    -- (<https://docs.aws.amazon.com/AmazonS3/latest/dev/s3-arn-format.html ARN>)
    -- that is assigned to a GameLift fleet resource and uniquely identifies
    -- it. ARNs are unique across all Regions. Format is
    -- @arn:aws:gamelift:\<region>::fleet\/fleet-a1234567-b8c9-0d1e-2fa3-b45c6d7e8912@.
    UpdateFleetCapacityResponse -> Maybe Text
fleetArn :: Prelude.Maybe Prelude.Text,
    -- | A unique identifier for the fleet that was updated.
    UpdateFleetCapacityResponse -> Maybe Text
fleetId :: Prelude.Maybe Prelude.Text,
    -- | The remote location being updated, expressed as an Amazon Web Services
    -- Region code, such as @us-west-2@.
    UpdateFleetCapacityResponse -> Maybe Text
location :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    UpdateFleetCapacityResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (UpdateFleetCapacityResponse -> UpdateFleetCapacityResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateFleetCapacityResponse -> UpdateFleetCapacityResponse -> Bool
$c/= :: UpdateFleetCapacityResponse -> UpdateFleetCapacityResponse -> Bool
== :: UpdateFleetCapacityResponse -> UpdateFleetCapacityResponse -> Bool
$c== :: UpdateFleetCapacityResponse -> UpdateFleetCapacityResponse -> Bool
Prelude.Eq, ReadPrec [UpdateFleetCapacityResponse]
ReadPrec UpdateFleetCapacityResponse
Int -> ReadS UpdateFleetCapacityResponse
ReadS [UpdateFleetCapacityResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateFleetCapacityResponse]
$creadListPrec :: ReadPrec [UpdateFleetCapacityResponse]
readPrec :: ReadPrec UpdateFleetCapacityResponse
$creadPrec :: ReadPrec UpdateFleetCapacityResponse
readList :: ReadS [UpdateFleetCapacityResponse]
$creadList :: ReadS [UpdateFleetCapacityResponse]
readsPrec :: Int -> ReadS UpdateFleetCapacityResponse
$creadsPrec :: Int -> ReadS UpdateFleetCapacityResponse
Prelude.Read, Int -> UpdateFleetCapacityResponse -> ShowS
[UpdateFleetCapacityResponse] -> ShowS
UpdateFleetCapacityResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateFleetCapacityResponse] -> ShowS
$cshowList :: [UpdateFleetCapacityResponse] -> ShowS
show :: UpdateFleetCapacityResponse -> String
$cshow :: UpdateFleetCapacityResponse -> String
showsPrec :: Int -> UpdateFleetCapacityResponse -> ShowS
$cshowsPrec :: Int -> UpdateFleetCapacityResponse -> ShowS
Prelude.Show, forall x.
Rep UpdateFleetCapacityResponse x -> UpdateFleetCapacityResponse
forall x.
UpdateFleetCapacityResponse -> Rep UpdateFleetCapacityResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep UpdateFleetCapacityResponse x -> UpdateFleetCapacityResponse
$cfrom :: forall x.
UpdateFleetCapacityResponse -> Rep UpdateFleetCapacityResponse x
Prelude.Generic)

-- |
-- Create a value of 'UpdateFleetCapacityResponse' 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:
--
-- 'fleetArn', 'updateFleetCapacityResponse_fleetArn' - The Amazon Resource Name
-- (<https://docs.aws.amazon.com/AmazonS3/latest/dev/s3-arn-format.html ARN>)
-- that is assigned to a GameLift fleet resource and uniquely identifies
-- it. ARNs are unique across all Regions. Format is
-- @arn:aws:gamelift:\<region>::fleet\/fleet-a1234567-b8c9-0d1e-2fa3-b45c6d7e8912@.
--
-- 'fleetId', 'updateFleetCapacityResponse_fleetId' - A unique identifier for the fleet that was updated.
--
-- 'location', 'updateFleetCapacityResponse_location' - The remote location being updated, expressed as an Amazon Web Services
-- Region code, such as @us-west-2@.
--
-- 'httpStatus', 'updateFleetCapacityResponse_httpStatus' - The response's http status code.
newUpdateFleetCapacityResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UpdateFleetCapacityResponse
newUpdateFleetCapacityResponse :: Int -> UpdateFleetCapacityResponse
newUpdateFleetCapacityResponse Int
pHttpStatus_ =
  UpdateFleetCapacityResponse'
    { $sel:fleetArn:UpdateFleetCapacityResponse' :: Maybe Text
fleetArn =
        forall a. Maybe a
Prelude.Nothing,
      $sel:fleetId:UpdateFleetCapacityResponse' :: Maybe Text
fleetId = forall a. Maybe a
Prelude.Nothing,
      $sel:location:UpdateFleetCapacityResponse' :: Maybe Text
location = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:UpdateFleetCapacityResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The Amazon Resource Name
-- (<https://docs.aws.amazon.com/AmazonS3/latest/dev/s3-arn-format.html ARN>)
-- that is assigned to a GameLift fleet resource and uniquely identifies
-- it. ARNs are unique across all Regions. Format is
-- @arn:aws:gamelift:\<region>::fleet\/fleet-a1234567-b8c9-0d1e-2fa3-b45c6d7e8912@.
updateFleetCapacityResponse_fleetArn :: Lens.Lens' UpdateFleetCapacityResponse (Prelude.Maybe Prelude.Text)
updateFleetCapacityResponse_fleetArn :: Lens' UpdateFleetCapacityResponse (Maybe Text)
updateFleetCapacityResponse_fleetArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateFleetCapacityResponse' {Maybe Text
fleetArn :: Maybe Text
$sel:fleetArn:UpdateFleetCapacityResponse' :: UpdateFleetCapacityResponse -> Maybe Text
fleetArn} -> Maybe Text
fleetArn) (\s :: UpdateFleetCapacityResponse
s@UpdateFleetCapacityResponse' {} Maybe Text
a -> UpdateFleetCapacityResponse
s {$sel:fleetArn:UpdateFleetCapacityResponse' :: Maybe Text
fleetArn = Maybe Text
a} :: UpdateFleetCapacityResponse)

-- | A unique identifier for the fleet that was updated.
updateFleetCapacityResponse_fleetId :: Lens.Lens' UpdateFleetCapacityResponse (Prelude.Maybe Prelude.Text)
updateFleetCapacityResponse_fleetId :: Lens' UpdateFleetCapacityResponse (Maybe Text)
updateFleetCapacityResponse_fleetId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateFleetCapacityResponse' {Maybe Text
fleetId :: Maybe Text
$sel:fleetId:UpdateFleetCapacityResponse' :: UpdateFleetCapacityResponse -> Maybe Text
fleetId} -> Maybe Text
fleetId) (\s :: UpdateFleetCapacityResponse
s@UpdateFleetCapacityResponse' {} Maybe Text
a -> UpdateFleetCapacityResponse
s {$sel:fleetId:UpdateFleetCapacityResponse' :: Maybe Text
fleetId = Maybe Text
a} :: UpdateFleetCapacityResponse)

-- | The remote location being updated, expressed as an Amazon Web Services
-- Region code, such as @us-west-2@.
updateFleetCapacityResponse_location :: Lens.Lens' UpdateFleetCapacityResponse (Prelude.Maybe Prelude.Text)
updateFleetCapacityResponse_location :: Lens' UpdateFleetCapacityResponse (Maybe Text)
updateFleetCapacityResponse_location = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateFleetCapacityResponse' {Maybe Text
location :: Maybe Text
$sel:location:UpdateFleetCapacityResponse' :: UpdateFleetCapacityResponse -> Maybe Text
location} -> Maybe Text
location) (\s :: UpdateFleetCapacityResponse
s@UpdateFleetCapacityResponse' {} Maybe Text
a -> UpdateFleetCapacityResponse
s {$sel:location:UpdateFleetCapacityResponse' :: Maybe Text
location = Maybe Text
a} :: UpdateFleetCapacityResponse)

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

instance Prelude.NFData UpdateFleetCapacityResponse where
  rnf :: UpdateFleetCapacityResponse -> ()
rnf UpdateFleetCapacityResponse' {Int
Maybe Text
httpStatus :: Int
location :: Maybe Text
fleetId :: Maybe Text
fleetArn :: Maybe Text
$sel:httpStatus:UpdateFleetCapacityResponse' :: UpdateFleetCapacityResponse -> Int
$sel:location:UpdateFleetCapacityResponse' :: UpdateFleetCapacityResponse -> Maybe Text
$sel:fleetId:UpdateFleetCapacityResponse' :: UpdateFleetCapacityResponse -> Maybe Text
$sel:fleetArn:UpdateFleetCapacityResponse' :: UpdateFleetCapacityResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
fleetArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
fleetId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
location
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus