{-# 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.DescribeCompute
-- 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 properties for a compute resource. To request a compute
-- resource specify the fleet ID and compute name. If successful, GameLift
-- returns an object containing the build properties.
module Amazonka.GameLift.DescribeCompute
  ( -- * Creating a Request
    DescribeCompute (..),
    newDescribeCompute,

    -- * Request Lenses
    describeCompute_fleetId,
    describeCompute_computeName,

    -- * Destructuring the Response
    DescribeComputeResponse (..),
    newDescribeComputeResponse,

    -- * Response Lenses
    describeComputeResponse_compute,
    describeComputeResponse_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:/ 'newDescribeCompute' smart constructor.
data DescribeCompute = DescribeCompute'
  { -- | A unique identifier for the fleet the compute is registered to.
    DescribeCompute -> Text
fleetId :: Prelude.Text,
    -- | A descriptive label that is associated with the compute resource
    -- registered to your fleet.
    DescribeCompute -> Text
computeName :: Prelude.Text
  }
  deriving (DescribeCompute -> DescribeCompute -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeCompute -> DescribeCompute -> Bool
$c/= :: DescribeCompute -> DescribeCompute -> Bool
== :: DescribeCompute -> DescribeCompute -> Bool
$c== :: DescribeCompute -> DescribeCompute -> Bool
Prelude.Eq, ReadPrec [DescribeCompute]
ReadPrec DescribeCompute
Int -> ReadS DescribeCompute
ReadS [DescribeCompute]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeCompute]
$creadListPrec :: ReadPrec [DescribeCompute]
readPrec :: ReadPrec DescribeCompute
$creadPrec :: ReadPrec DescribeCompute
readList :: ReadS [DescribeCompute]
$creadList :: ReadS [DescribeCompute]
readsPrec :: Int -> ReadS DescribeCompute
$creadsPrec :: Int -> ReadS DescribeCompute
Prelude.Read, Int -> DescribeCompute -> ShowS
[DescribeCompute] -> ShowS
DescribeCompute -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeCompute] -> ShowS
$cshowList :: [DescribeCompute] -> ShowS
show :: DescribeCompute -> String
$cshow :: DescribeCompute -> String
showsPrec :: Int -> DescribeCompute -> ShowS
$cshowsPrec :: Int -> DescribeCompute -> ShowS
Prelude.Show, forall x. Rep DescribeCompute x -> DescribeCompute
forall x. DescribeCompute -> Rep DescribeCompute x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DescribeCompute x -> DescribeCompute
$cfrom :: forall x. DescribeCompute -> Rep DescribeCompute x
Prelude.Generic)

-- |
-- Create a value of 'DescribeCompute' 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', 'describeCompute_fleetId' - A unique identifier for the fleet the compute is registered to.
--
-- 'computeName', 'describeCompute_computeName' - A descriptive label that is associated with the compute resource
-- registered to your fleet.
newDescribeCompute ::
  -- | 'fleetId'
  Prelude.Text ->
  -- | 'computeName'
  Prelude.Text ->
  DescribeCompute
newDescribeCompute :: Text -> Text -> DescribeCompute
newDescribeCompute Text
pFleetId_ Text
pComputeName_ =
  DescribeCompute'
    { $sel:fleetId:DescribeCompute' :: Text
fleetId = Text
pFleetId_,
      $sel:computeName:DescribeCompute' :: Text
computeName = Text
pComputeName_
    }

-- | A unique identifier for the fleet the compute is registered to.
describeCompute_fleetId :: Lens.Lens' DescribeCompute Prelude.Text
describeCompute_fleetId :: Lens' DescribeCompute Text
describeCompute_fleetId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeCompute' {Text
fleetId :: Text
$sel:fleetId:DescribeCompute' :: DescribeCompute -> Text
fleetId} -> Text
fleetId) (\s :: DescribeCompute
s@DescribeCompute' {} Text
a -> DescribeCompute
s {$sel:fleetId:DescribeCompute' :: Text
fleetId = Text
a} :: DescribeCompute)

-- | A descriptive label that is associated with the compute resource
-- registered to your fleet.
describeCompute_computeName :: Lens.Lens' DescribeCompute Prelude.Text
describeCompute_computeName :: Lens' DescribeCompute Text
describeCompute_computeName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeCompute' {Text
computeName :: Text
$sel:computeName:DescribeCompute' :: DescribeCompute -> Text
computeName} -> Text
computeName) (\s :: DescribeCompute
s@DescribeCompute' {} Text
a -> DescribeCompute
s {$sel:computeName:DescribeCompute' :: Text
computeName = Text
a} :: DescribeCompute)

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

instance Prelude.NFData DescribeCompute where
  rnf :: DescribeCompute -> ()
rnf DescribeCompute' {Text
computeName :: Text
fleetId :: Text
$sel:computeName:DescribeCompute' :: DescribeCompute -> Text
$sel:fleetId:DescribeCompute' :: DescribeCompute -> 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
computeName

instance Data.ToHeaders DescribeCompute where
  toHeaders :: DescribeCompute -> 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.DescribeCompute" :: 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 DescribeCompute where
  toJSON :: DescribeCompute -> Value
toJSON DescribeCompute' {Text
computeName :: Text
fleetId :: Text
$sel:computeName:DescribeCompute' :: DescribeCompute -> Text
$sel:fleetId:DescribeCompute' :: DescribeCompute -> 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
"ComputeName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
computeName)
          ]
      )

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

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

-- | /See:/ 'newDescribeComputeResponse' smart constructor.
data DescribeComputeResponse = DescribeComputeResponse'
  { -- | The details of the compute resource you registered to the specified
    -- fleet.
    DescribeComputeResponse -> Maybe Compute
compute :: Prelude.Maybe Compute,
    -- | The response's http status code.
    DescribeComputeResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (DescribeComputeResponse -> DescribeComputeResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeComputeResponse -> DescribeComputeResponse -> Bool
$c/= :: DescribeComputeResponse -> DescribeComputeResponse -> Bool
== :: DescribeComputeResponse -> DescribeComputeResponse -> Bool
$c== :: DescribeComputeResponse -> DescribeComputeResponse -> Bool
Prelude.Eq, ReadPrec [DescribeComputeResponse]
ReadPrec DescribeComputeResponse
Int -> ReadS DescribeComputeResponse
ReadS [DescribeComputeResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeComputeResponse]
$creadListPrec :: ReadPrec [DescribeComputeResponse]
readPrec :: ReadPrec DescribeComputeResponse
$creadPrec :: ReadPrec DescribeComputeResponse
readList :: ReadS [DescribeComputeResponse]
$creadList :: ReadS [DescribeComputeResponse]
readsPrec :: Int -> ReadS DescribeComputeResponse
$creadsPrec :: Int -> ReadS DescribeComputeResponse
Prelude.Read, Int -> DescribeComputeResponse -> ShowS
[DescribeComputeResponse] -> ShowS
DescribeComputeResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeComputeResponse] -> ShowS
$cshowList :: [DescribeComputeResponse] -> ShowS
show :: DescribeComputeResponse -> String
$cshow :: DescribeComputeResponse -> String
showsPrec :: Int -> DescribeComputeResponse -> ShowS
$cshowsPrec :: Int -> DescribeComputeResponse -> ShowS
Prelude.Show, forall x. Rep DescribeComputeResponse x -> DescribeComputeResponse
forall x. DescribeComputeResponse -> Rep DescribeComputeResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DescribeComputeResponse x -> DescribeComputeResponse
$cfrom :: forall x. DescribeComputeResponse -> Rep DescribeComputeResponse x
Prelude.Generic)

-- |
-- Create a value of 'DescribeComputeResponse' 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:
--
-- 'compute', 'describeComputeResponse_compute' - The details of the compute resource you registered to the specified
-- fleet.
--
-- 'httpStatus', 'describeComputeResponse_httpStatus' - The response's http status code.
newDescribeComputeResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DescribeComputeResponse
newDescribeComputeResponse :: Int -> DescribeComputeResponse
newDescribeComputeResponse Int
pHttpStatus_ =
  DescribeComputeResponse'
    { $sel:compute:DescribeComputeResponse' :: Maybe Compute
compute = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:DescribeComputeResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The details of the compute resource you registered to the specified
-- fleet.
describeComputeResponse_compute :: Lens.Lens' DescribeComputeResponse (Prelude.Maybe Compute)
describeComputeResponse_compute :: Lens' DescribeComputeResponse (Maybe Compute)
describeComputeResponse_compute = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeComputeResponse' {Maybe Compute
compute :: Maybe Compute
$sel:compute:DescribeComputeResponse' :: DescribeComputeResponse -> Maybe Compute
compute} -> Maybe Compute
compute) (\s :: DescribeComputeResponse
s@DescribeComputeResponse' {} Maybe Compute
a -> DescribeComputeResponse
s {$sel:compute:DescribeComputeResponse' :: Maybe Compute
compute = Maybe Compute
a} :: DescribeComputeResponse)

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

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