{-# 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.DescribeFleetLocationCapacity
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Retrieves the resource capacity settings for a fleet location. The data
-- returned includes the current capacity (number of EC2 instances) and
-- some scaling settings for the requested fleet location. Use this
-- operation to retrieve capacity information for a fleet\'s remote
-- location or home Region (you can also retrieve home Region capacity by
-- calling @DescribeFleetCapacity@).
--
-- To retrieve capacity data, identify a fleet and location.
--
-- If successful, a @FleetCapacity@ object is returned for the requested
-- fleet location.
--
-- __Learn more__
--
-- <https://docs.aws.amazon.com/gamelift/latest/developerguide/fleets-intro.html Setting up GameLift fleets>
--
-- <https://docs.aws.amazon.com/gamelift/latest/developerguide/monitoring-cloudwatch.html#gamelift-metrics-fleet GameLift metrics for fleets>
module Amazonka.GameLift.DescribeFleetLocationCapacity
  ( -- * Creating a Request
    DescribeFleetLocationCapacity (..),
    newDescribeFleetLocationCapacity,

    -- * Request Lenses
    describeFleetLocationCapacity_fleetId,
    describeFleetLocationCapacity_location,

    -- * Destructuring the Response
    DescribeFleetLocationCapacityResponse (..),
    newDescribeFleetLocationCapacityResponse,

    -- * Response Lenses
    describeFleetLocationCapacityResponse_fleetCapacity,
    describeFleetLocationCapacityResponse_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:/ 'newDescribeFleetLocationCapacity' smart constructor.
data DescribeFleetLocationCapacity = DescribeFleetLocationCapacity'
  { -- | A unique identifier for the fleet to request location capacity for. You
    -- can use either the fleet ID or ARN value.
    DescribeFleetLocationCapacity -> Text
fleetId :: Prelude.Text,
    -- | The fleet location to retrieve capacity information for. Specify a
    -- location in the form of an Amazon Web Services Region code, such as
    -- @us-west-2@.
    DescribeFleetLocationCapacity -> Text
location :: Prelude.Text
  }
  deriving (DescribeFleetLocationCapacity
-> DescribeFleetLocationCapacity -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeFleetLocationCapacity
-> DescribeFleetLocationCapacity -> Bool
$c/= :: DescribeFleetLocationCapacity
-> DescribeFleetLocationCapacity -> Bool
== :: DescribeFleetLocationCapacity
-> DescribeFleetLocationCapacity -> Bool
$c== :: DescribeFleetLocationCapacity
-> DescribeFleetLocationCapacity -> Bool
Prelude.Eq, ReadPrec [DescribeFleetLocationCapacity]
ReadPrec DescribeFleetLocationCapacity
Int -> ReadS DescribeFleetLocationCapacity
ReadS [DescribeFleetLocationCapacity]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeFleetLocationCapacity]
$creadListPrec :: ReadPrec [DescribeFleetLocationCapacity]
readPrec :: ReadPrec DescribeFleetLocationCapacity
$creadPrec :: ReadPrec DescribeFleetLocationCapacity
readList :: ReadS [DescribeFleetLocationCapacity]
$creadList :: ReadS [DescribeFleetLocationCapacity]
readsPrec :: Int -> ReadS DescribeFleetLocationCapacity
$creadsPrec :: Int -> ReadS DescribeFleetLocationCapacity
Prelude.Read, Int -> DescribeFleetLocationCapacity -> ShowS
[DescribeFleetLocationCapacity] -> ShowS
DescribeFleetLocationCapacity -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeFleetLocationCapacity] -> ShowS
$cshowList :: [DescribeFleetLocationCapacity] -> ShowS
show :: DescribeFleetLocationCapacity -> String
$cshow :: DescribeFleetLocationCapacity -> String
showsPrec :: Int -> DescribeFleetLocationCapacity -> ShowS
$cshowsPrec :: Int -> DescribeFleetLocationCapacity -> ShowS
Prelude.Show, forall x.
Rep DescribeFleetLocationCapacity x
-> DescribeFleetLocationCapacity
forall x.
DescribeFleetLocationCapacity
-> Rep DescribeFleetLocationCapacity x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DescribeFleetLocationCapacity x
-> DescribeFleetLocationCapacity
$cfrom :: forall x.
DescribeFleetLocationCapacity
-> Rep DescribeFleetLocationCapacity x
Prelude.Generic)

-- |
-- Create a value of 'DescribeFleetLocationCapacity' 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:
--
-- 'fleetId', 'describeFleetLocationCapacity_fleetId' - A unique identifier for the fleet to request location capacity for. You
-- can use either the fleet ID or ARN value.
--
-- 'location', 'describeFleetLocationCapacity_location' - The fleet location to retrieve capacity information for. Specify a
-- location in the form of an Amazon Web Services Region code, such as
-- @us-west-2@.
newDescribeFleetLocationCapacity ::
  -- | 'fleetId'
  Prelude.Text ->
  -- | 'location'
  Prelude.Text ->
  DescribeFleetLocationCapacity
newDescribeFleetLocationCapacity :: Text -> Text -> DescribeFleetLocationCapacity
newDescribeFleetLocationCapacity Text
pFleetId_ Text
pLocation_ =
  DescribeFleetLocationCapacity'
    { $sel:fleetId:DescribeFleetLocationCapacity' :: Text
fleetId = Text
pFleetId_,
      $sel:location:DescribeFleetLocationCapacity' :: Text
location = Text
pLocation_
    }

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

-- | The fleet location to retrieve capacity information for. Specify a
-- location in the form of an Amazon Web Services Region code, such as
-- @us-west-2@.
describeFleetLocationCapacity_location :: Lens.Lens' DescribeFleetLocationCapacity Prelude.Text
describeFleetLocationCapacity_location :: Lens' DescribeFleetLocationCapacity Text
describeFleetLocationCapacity_location = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeFleetLocationCapacity' {Text
location :: Text
$sel:location:DescribeFleetLocationCapacity' :: DescribeFleetLocationCapacity -> Text
location} -> Text
location) (\s :: DescribeFleetLocationCapacity
s@DescribeFleetLocationCapacity' {} Text
a -> DescribeFleetLocationCapacity
s {$sel:location:DescribeFleetLocationCapacity' :: Text
location = Text
a} :: DescribeFleetLocationCapacity)

instance
  Core.AWSRequest
    DescribeFleetLocationCapacity
  where
  type
    AWSResponse DescribeFleetLocationCapacity =
      DescribeFleetLocationCapacityResponse
  request :: (Service -> Service)
-> DescribeFleetLocationCapacity
-> Request DescribeFleetLocationCapacity
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 DescribeFleetLocationCapacity
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse DescribeFleetLocationCapacity)))
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 FleetCapacity -> Int -> DescribeFleetLocationCapacityResponse
DescribeFleetLocationCapacityResponse'
            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
"FleetCapacity")
            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
    DescribeFleetLocationCapacity
  where
  hashWithSalt :: Int -> DescribeFleetLocationCapacity -> Int
hashWithSalt Int
_salt DescribeFleetLocationCapacity' {Text
location :: Text
fleetId :: Text
$sel:location:DescribeFleetLocationCapacity' :: DescribeFleetLocationCapacity -> Text
$sel:fleetId:DescribeFleetLocationCapacity' :: DescribeFleetLocationCapacity -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
fleetId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
location

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

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

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

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

-- | /See:/ 'newDescribeFleetLocationCapacityResponse' smart constructor.
data DescribeFleetLocationCapacityResponse = DescribeFleetLocationCapacityResponse'
  { -- | Resource capacity information for the requested fleet location. Capacity
    -- objects are returned only for fleets and locations that currently exist.
    DescribeFleetLocationCapacityResponse -> Maybe FleetCapacity
fleetCapacity :: Prelude.Maybe FleetCapacity,
    -- | The response's http status code.
    DescribeFleetLocationCapacityResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (DescribeFleetLocationCapacityResponse
-> DescribeFleetLocationCapacityResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeFleetLocationCapacityResponse
-> DescribeFleetLocationCapacityResponse -> Bool
$c/= :: DescribeFleetLocationCapacityResponse
-> DescribeFleetLocationCapacityResponse -> Bool
== :: DescribeFleetLocationCapacityResponse
-> DescribeFleetLocationCapacityResponse -> Bool
$c== :: DescribeFleetLocationCapacityResponse
-> DescribeFleetLocationCapacityResponse -> Bool
Prelude.Eq, ReadPrec [DescribeFleetLocationCapacityResponse]
ReadPrec DescribeFleetLocationCapacityResponse
Int -> ReadS DescribeFleetLocationCapacityResponse
ReadS [DescribeFleetLocationCapacityResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeFleetLocationCapacityResponse]
$creadListPrec :: ReadPrec [DescribeFleetLocationCapacityResponse]
readPrec :: ReadPrec DescribeFleetLocationCapacityResponse
$creadPrec :: ReadPrec DescribeFleetLocationCapacityResponse
readList :: ReadS [DescribeFleetLocationCapacityResponse]
$creadList :: ReadS [DescribeFleetLocationCapacityResponse]
readsPrec :: Int -> ReadS DescribeFleetLocationCapacityResponse
$creadsPrec :: Int -> ReadS DescribeFleetLocationCapacityResponse
Prelude.Read, Int -> DescribeFleetLocationCapacityResponse -> ShowS
[DescribeFleetLocationCapacityResponse] -> ShowS
DescribeFleetLocationCapacityResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeFleetLocationCapacityResponse] -> ShowS
$cshowList :: [DescribeFleetLocationCapacityResponse] -> ShowS
show :: DescribeFleetLocationCapacityResponse -> String
$cshow :: DescribeFleetLocationCapacityResponse -> String
showsPrec :: Int -> DescribeFleetLocationCapacityResponse -> ShowS
$cshowsPrec :: Int -> DescribeFleetLocationCapacityResponse -> ShowS
Prelude.Show, forall x.
Rep DescribeFleetLocationCapacityResponse x
-> DescribeFleetLocationCapacityResponse
forall x.
DescribeFleetLocationCapacityResponse
-> Rep DescribeFleetLocationCapacityResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DescribeFleetLocationCapacityResponse x
-> DescribeFleetLocationCapacityResponse
$cfrom :: forall x.
DescribeFleetLocationCapacityResponse
-> Rep DescribeFleetLocationCapacityResponse x
Prelude.Generic)

-- |
-- Create a value of 'DescribeFleetLocationCapacityResponse' 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:
--
-- 'fleetCapacity', 'describeFleetLocationCapacityResponse_fleetCapacity' - Resource capacity information for the requested fleet location. Capacity
-- objects are returned only for fleets and locations that currently exist.
--
-- 'httpStatus', 'describeFleetLocationCapacityResponse_httpStatus' - The response's http status code.
newDescribeFleetLocationCapacityResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DescribeFleetLocationCapacityResponse
newDescribeFleetLocationCapacityResponse :: Int -> DescribeFleetLocationCapacityResponse
newDescribeFleetLocationCapacityResponse Int
pHttpStatus_ =
  DescribeFleetLocationCapacityResponse'
    { $sel:fleetCapacity:DescribeFleetLocationCapacityResponse' :: Maybe FleetCapacity
fleetCapacity =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:DescribeFleetLocationCapacityResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Resource capacity information for the requested fleet location. Capacity
-- objects are returned only for fleets and locations that currently exist.
describeFleetLocationCapacityResponse_fleetCapacity :: Lens.Lens' DescribeFleetLocationCapacityResponse (Prelude.Maybe FleetCapacity)
describeFleetLocationCapacityResponse_fleetCapacity :: Lens' DescribeFleetLocationCapacityResponse (Maybe FleetCapacity)
describeFleetLocationCapacityResponse_fleetCapacity = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeFleetLocationCapacityResponse' {Maybe FleetCapacity
fleetCapacity :: Maybe FleetCapacity
$sel:fleetCapacity:DescribeFleetLocationCapacityResponse' :: DescribeFleetLocationCapacityResponse -> Maybe FleetCapacity
fleetCapacity} -> Maybe FleetCapacity
fleetCapacity) (\s :: DescribeFleetLocationCapacityResponse
s@DescribeFleetLocationCapacityResponse' {} Maybe FleetCapacity
a -> DescribeFleetLocationCapacityResponse
s {$sel:fleetCapacity:DescribeFleetLocationCapacityResponse' :: Maybe FleetCapacity
fleetCapacity = Maybe FleetCapacity
a} :: DescribeFleetLocationCapacityResponse)

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

instance
  Prelude.NFData
    DescribeFleetLocationCapacityResponse
  where
  rnf :: DescribeFleetLocationCapacityResponse -> ()
rnf DescribeFleetLocationCapacityResponse' {Int
Maybe FleetCapacity
httpStatus :: Int
fleetCapacity :: Maybe FleetCapacity
$sel:httpStatus:DescribeFleetLocationCapacityResponse' :: DescribeFleetLocationCapacityResponse -> Int
$sel:fleetCapacity:DescribeFleetLocationCapacityResponse' :: DescribeFleetLocationCapacityResponse -> Maybe FleetCapacity
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe FleetCapacity
fleetCapacity
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus