{-# 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.DescribeAlias
-- 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 an alias. This operation returns all alias
-- metadata and settings. To get an alias\'s target fleet ID only, use
-- @ResolveAlias@.
--
-- To get alias properties, specify the alias ID. If successful, the
-- requested alias record is returned.
--
-- __Related actions__
--
-- <https://docs.aws.amazon.com/gamelift/latest/developerguide/reference-awssdk.html#reference-awssdk-resources-fleets All APIs by task>
module Amazonka.GameLift.DescribeAlias
  ( -- * Creating a Request
    DescribeAlias (..),
    newDescribeAlias,

    -- * Request Lenses
    describeAlias_aliasId,

    -- * Destructuring the Response
    DescribeAliasResponse (..),
    newDescribeAliasResponse,

    -- * Response Lenses
    describeAliasResponse_alias,
    describeAliasResponse_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:/ 'newDescribeAlias' smart constructor.
data DescribeAlias = DescribeAlias'
  { -- | The unique identifier for the fleet alias that you want to retrieve. You
    -- can use either the alias ID or ARN value.
    DescribeAlias -> Text
aliasId :: Prelude.Text
  }
  deriving (DescribeAlias -> DescribeAlias -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeAlias -> DescribeAlias -> Bool
$c/= :: DescribeAlias -> DescribeAlias -> Bool
== :: DescribeAlias -> DescribeAlias -> Bool
$c== :: DescribeAlias -> DescribeAlias -> Bool
Prelude.Eq, ReadPrec [DescribeAlias]
ReadPrec DescribeAlias
Int -> ReadS DescribeAlias
ReadS [DescribeAlias]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeAlias]
$creadListPrec :: ReadPrec [DescribeAlias]
readPrec :: ReadPrec DescribeAlias
$creadPrec :: ReadPrec DescribeAlias
readList :: ReadS [DescribeAlias]
$creadList :: ReadS [DescribeAlias]
readsPrec :: Int -> ReadS DescribeAlias
$creadsPrec :: Int -> ReadS DescribeAlias
Prelude.Read, Int -> DescribeAlias -> ShowS
[DescribeAlias] -> ShowS
DescribeAlias -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeAlias] -> ShowS
$cshowList :: [DescribeAlias] -> ShowS
show :: DescribeAlias -> String
$cshow :: DescribeAlias -> String
showsPrec :: Int -> DescribeAlias -> ShowS
$cshowsPrec :: Int -> DescribeAlias -> ShowS
Prelude.Show, forall x. Rep DescribeAlias x -> DescribeAlias
forall x. DescribeAlias -> Rep DescribeAlias x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DescribeAlias x -> DescribeAlias
$cfrom :: forall x. DescribeAlias -> Rep DescribeAlias x
Prelude.Generic)

-- |
-- Create a value of 'DescribeAlias' 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:
--
-- 'aliasId', 'describeAlias_aliasId' - The unique identifier for the fleet alias that you want to retrieve. You
-- can use either the alias ID or ARN value.
newDescribeAlias ::
  -- | 'aliasId'
  Prelude.Text ->
  DescribeAlias
newDescribeAlias :: Text -> DescribeAlias
newDescribeAlias Text
pAliasId_ =
  DescribeAlias' {$sel:aliasId:DescribeAlias' :: Text
aliasId = Text
pAliasId_}

-- | The unique identifier for the fleet alias that you want to retrieve. You
-- can use either the alias ID or ARN value.
describeAlias_aliasId :: Lens.Lens' DescribeAlias Prelude.Text
describeAlias_aliasId :: Lens' DescribeAlias Text
describeAlias_aliasId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeAlias' {Text
aliasId :: Text
$sel:aliasId:DescribeAlias' :: DescribeAlias -> Text
aliasId} -> Text
aliasId) (\s :: DescribeAlias
s@DescribeAlias' {} Text
a -> DescribeAlias
s {$sel:aliasId:DescribeAlias' :: Text
aliasId = Text
a} :: DescribeAlias)

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

instance Prelude.NFData DescribeAlias where
  rnf :: DescribeAlias -> ()
rnf DescribeAlias' {Text
aliasId :: Text
$sel:aliasId:DescribeAlias' :: DescribeAlias -> Text
..} = forall a. NFData a => a -> ()
Prelude.rnf Text
aliasId

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

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

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

-- | /See:/ 'newDescribeAliasResponse' smart constructor.
data DescribeAliasResponse = DescribeAliasResponse'
  { -- | The requested alias resource.
    DescribeAliasResponse -> Maybe Alias
alias :: Prelude.Maybe Alias,
    -- | The response's http status code.
    DescribeAliasResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (DescribeAliasResponse -> DescribeAliasResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeAliasResponse -> DescribeAliasResponse -> Bool
$c/= :: DescribeAliasResponse -> DescribeAliasResponse -> Bool
== :: DescribeAliasResponse -> DescribeAliasResponse -> Bool
$c== :: DescribeAliasResponse -> DescribeAliasResponse -> Bool
Prelude.Eq, ReadPrec [DescribeAliasResponse]
ReadPrec DescribeAliasResponse
Int -> ReadS DescribeAliasResponse
ReadS [DescribeAliasResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeAliasResponse]
$creadListPrec :: ReadPrec [DescribeAliasResponse]
readPrec :: ReadPrec DescribeAliasResponse
$creadPrec :: ReadPrec DescribeAliasResponse
readList :: ReadS [DescribeAliasResponse]
$creadList :: ReadS [DescribeAliasResponse]
readsPrec :: Int -> ReadS DescribeAliasResponse
$creadsPrec :: Int -> ReadS DescribeAliasResponse
Prelude.Read, Int -> DescribeAliasResponse -> ShowS
[DescribeAliasResponse] -> ShowS
DescribeAliasResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeAliasResponse] -> ShowS
$cshowList :: [DescribeAliasResponse] -> ShowS
show :: DescribeAliasResponse -> String
$cshow :: DescribeAliasResponse -> String
showsPrec :: Int -> DescribeAliasResponse -> ShowS
$cshowsPrec :: Int -> DescribeAliasResponse -> ShowS
Prelude.Show, forall x. Rep DescribeAliasResponse x -> DescribeAliasResponse
forall x. DescribeAliasResponse -> Rep DescribeAliasResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DescribeAliasResponse x -> DescribeAliasResponse
$cfrom :: forall x. DescribeAliasResponse -> Rep DescribeAliasResponse x
Prelude.Generic)

-- |
-- Create a value of 'DescribeAliasResponse' 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:
--
-- 'alias', 'describeAliasResponse_alias' - The requested alias resource.
--
-- 'httpStatus', 'describeAliasResponse_httpStatus' - The response's http status code.
newDescribeAliasResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DescribeAliasResponse
newDescribeAliasResponse :: Int -> DescribeAliasResponse
newDescribeAliasResponse Int
pHttpStatus_ =
  DescribeAliasResponse'
    { $sel:alias:DescribeAliasResponse' :: Maybe Alias
alias = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:DescribeAliasResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The requested alias resource.
describeAliasResponse_alias :: Lens.Lens' DescribeAliasResponse (Prelude.Maybe Alias)
describeAliasResponse_alias :: Lens' DescribeAliasResponse (Maybe Alias)
describeAliasResponse_alias = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeAliasResponse' {Maybe Alias
alias :: Maybe Alias
$sel:alias:DescribeAliasResponse' :: DescribeAliasResponse -> Maybe Alias
alias} -> Maybe Alias
alias) (\s :: DescribeAliasResponse
s@DescribeAliasResponse' {} Maybe Alias
a -> DescribeAliasResponse
s {$sel:alias:DescribeAliasResponse' :: Maybe Alias
alias = Maybe Alias
a} :: DescribeAliasResponse)

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

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