{-# 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.CreateAlias
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Creates an alias for a fleet. In most situations, you can use an alias
-- ID in place of a fleet ID. An alias provides a level of abstraction for
-- a fleet that is useful when redirecting player traffic from one fleet to
-- another, such as when updating your game build.
--
-- Amazon GameLift supports two types of routing strategies for aliases:
-- simple and terminal. A simple alias points to an active fleet. A
-- terminal alias is used to display messaging or link to a URL instead of
-- routing players to an active fleet. For example, you might use a
-- terminal alias when a game version is no longer supported and you want
-- to direct players to an upgrade site.
--
-- To create a fleet alias, specify an alias name, routing strategy, and
-- optional description. Each simple alias can point to only one fleet, but
-- a fleet can have multiple aliases. If successful, a new alias record is
-- returned, including an alias ID and an ARN. You can reassign an alias to
-- another fleet by calling @UpdateAlias@.
--
-- __Related actions__
--
-- <https://docs.aws.amazon.com/gamelift/latest/developerguide/reference-awssdk.html#reference-awssdk-resources-fleets All APIs by task>
module Amazonka.GameLift.CreateAlias
  ( -- * Creating a Request
    CreateAlias (..),
    newCreateAlias,

    -- * Request Lenses
    createAlias_description,
    createAlias_tags,
    createAlias_name,
    createAlias_routingStrategy,

    -- * Destructuring the Response
    CreateAliasResponse (..),
    newCreateAliasResponse,

    -- * Response Lenses
    createAliasResponse_alias,
    createAliasResponse_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:/ 'newCreateAlias' smart constructor.
data CreateAlias = CreateAlias'
  { -- | A human-readable description of the alias.
    CreateAlias -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | A list of labels to assign to the new alias resource. Tags are
    -- developer-defined key-value pairs. Tagging Amazon Web Services resources
    -- are useful for resource management, access management and cost
    -- allocation. For more information, see
    -- <https://docs.aws.amazon.com/general/latest/gr/aws_tagging.html Tagging Amazon Web Services Resources>
    -- in the /Amazon Web Services General Reference/.
    CreateAlias -> Maybe [Tag]
tags :: Prelude.Maybe [Tag],
    -- | A descriptive label that is associated with an alias. Alias names do not
    -- need to be unique.
    CreateAlias -> Text
name :: Prelude.Text,
    -- | The routing configuration, including routing type and fleet target, for
    -- the alias.
    CreateAlias -> RoutingStrategy
routingStrategy :: RoutingStrategy
  }
  deriving (CreateAlias -> CreateAlias -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateAlias -> CreateAlias -> Bool
$c/= :: CreateAlias -> CreateAlias -> Bool
== :: CreateAlias -> CreateAlias -> Bool
$c== :: CreateAlias -> CreateAlias -> Bool
Prelude.Eq, ReadPrec [CreateAlias]
ReadPrec CreateAlias
Int -> ReadS CreateAlias
ReadS [CreateAlias]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateAlias]
$creadListPrec :: ReadPrec [CreateAlias]
readPrec :: ReadPrec CreateAlias
$creadPrec :: ReadPrec CreateAlias
readList :: ReadS [CreateAlias]
$creadList :: ReadS [CreateAlias]
readsPrec :: Int -> ReadS CreateAlias
$creadsPrec :: Int -> ReadS CreateAlias
Prelude.Read, Int -> CreateAlias -> ShowS
[CreateAlias] -> ShowS
CreateAlias -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateAlias] -> ShowS
$cshowList :: [CreateAlias] -> ShowS
show :: CreateAlias -> String
$cshow :: CreateAlias -> String
showsPrec :: Int -> CreateAlias -> ShowS
$cshowsPrec :: Int -> CreateAlias -> ShowS
Prelude.Show, forall x. Rep CreateAlias x -> CreateAlias
forall x. CreateAlias -> Rep CreateAlias x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateAlias x -> CreateAlias
$cfrom :: forall x. CreateAlias -> Rep CreateAlias x
Prelude.Generic)

-- |
-- Create a value of 'CreateAlias' 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:
--
-- 'description', 'createAlias_description' - A human-readable description of the alias.
--
-- 'tags', 'createAlias_tags' - A list of labels to assign to the new alias resource. Tags are
-- developer-defined key-value pairs. Tagging Amazon Web Services resources
-- are useful for resource management, access management and cost
-- allocation. For more information, see
-- <https://docs.aws.amazon.com/general/latest/gr/aws_tagging.html Tagging Amazon Web Services Resources>
-- in the /Amazon Web Services General Reference/.
--
-- 'name', 'createAlias_name' - A descriptive label that is associated with an alias. Alias names do not
-- need to be unique.
--
-- 'routingStrategy', 'createAlias_routingStrategy' - The routing configuration, including routing type and fleet target, for
-- the alias.
newCreateAlias ::
  -- | 'name'
  Prelude.Text ->
  -- | 'routingStrategy'
  RoutingStrategy ->
  CreateAlias
newCreateAlias :: Text -> RoutingStrategy -> CreateAlias
newCreateAlias Text
pName_ RoutingStrategy
pRoutingStrategy_ =
  CreateAlias'
    { $sel:description:CreateAlias' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:CreateAlias' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:name:CreateAlias' :: Text
name = Text
pName_,
      $sel:routingStrategy:CreateAlias' :: RoutingStrategy
routingStrategy = RoutingStrategy
pRoutingStrategy_
    }

-- | A human-readable description of the alias.
createAlias_description :: Lens.Lens' CreateAlias (Prelude.Maybe Prelude.Text)
createAlias_description :: Lens' CreateAlias (Maybe Text)
createAlias_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateAlias' {Maybe Text
description :: Maybe Text
$sel:description:CreateAlias' :: CreateAlias -> Maybe Text
description} -> Maybe Text
description) (\s :: CreateAlias
s@CreateAlias' {} Maybe Text
a -> CreateAlias
s {$sel:description:CreateAlias' :: Maybe Text
description = Maybe Text
a} :: CreateAlias)

-- | A list of labels to assign to the new alias resource. Tags are
-- developer-defined key-value pairs. Tagging Amazon Web Services resources
-- are useful for resource management, access management and cost
-- allocation. For more information, see
-- <https://docs.aws.amazon.com/general/latest/gr/aws_tagging.html Tagging Amazon Web Services Resources>
-- in the /Amazon Web Services General Reference/.
createAlias_tags :: Lens.Lens' CreateAlias (Prelude.Maybe [Tag])
createAlias_tags :: Lens' CreateAlias (Maybe [Tag])
createAlias_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateAlias' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:CreateAlias' :: CreateAlias -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: CreateAlias
s@CreateAlias' {} Maybe [Tag]
a -> CreateAlias
s {$sel:tags:CreateAlias' :: Maybe [Tag]
tags = Maybe [Tag]
a} :: CreateAlias) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | A descriptive label that is associated with an alias. Alias names do not
-- need to be unique.
createAlias_name :: Lens.Lens' CreateAlias Prelude.Text
createAlias_name :: Lens' CreateAlias Text
createAlias_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateAlias' {Text
name :: Text
$sel:name:CreateAlias' :: CreateAlias -> Text
name} -> Text
name) (\s :: CreateAlias
s@CreateAlias' {} Text
a -> CreateAlias
s {$sel:name:CreateAlias' :: Text
name = Text
a} :: CreateAlias)

-- | The routing configuration, including routing type and fleet target, for
-- the alias.
createAlias_routingStrategy :: Lens.Lens' CreateAlias RoutingStrategy
createAlias_routingStrategy :: Lens' CreateAlias RoutingStrategy
createAlias_routingStrategy = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateAlias' {RoutingStrategy
routingStrategy :: RoutingStrategy
$sel:routingStrategy:CreateAlias' :: CreateAlias -> RoutingStrategy
routingStrategy} -> RoutingStrategy
routingStrategy) (\s :: CreateAlias
s@CreateAlias' {} RoutingStrategy
a -> CreateAlias
s {$sel:routingStrategy:CreateAlias' :: RoutingStrategy
routingStrategy = RoutingStrategy
a} :: CreateAlias)

instance Core.AWSRequest CreateAlias where
  type AWSResponse CreateAlias = CreateAliasResponse
  request :: (Service -> Service) -> CreateAlias -> Request CreateAlias
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 CreateAlias
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CreateAlias)))
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 -> CreateAliasResponse
CreateAliasResponse'
            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 CreateAlias where
  hashWithSalt :: Int -> CreateAlias -> Int
hashWithSalt Int
_salt CreateAlias' {Maybe [Tag]
Maybe Text
Text
RoutingStrategy
routingStrategy :: RoutingStrategy
name :: Text
tags :: Maybe [Tag]
description :: Maybe Text
$sel:routingStrategy:CreateAlias' :: CreateAlias -> RoutingStrategy
$sel:name:CreateAlias' :: CreateAlias -> Text
$sel:tags:CreateAlias' :: CreateAlias -> Maybe [Tag]
$sel:description:CreateAlias' :: CreateAlias -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Tag]
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
name
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` RoutingStrategy
routingStrategy

instance Prelude.NFData CreateAlias where
  rnf :: CreateAlias -> ()
rnf CreateAlias' {Maybe [Tag]
Maybe Text
Text
RoutingStrategy
routingStrategy :: RoutingStrategy
name :: Text
tags :: Maybe [Tag]
description :: Maybe Text
$sel:routingStrategy:CreateAlias' :: CreateAlias -> RoutingStrategy
$sel:name:CreateAlias' :: CreateAlias -> Text
$sel:tags:CreateAlias' :: CreateAlias -> Maybe [Tag]
$sel:description:CreateAlias' :: CreateAlias -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
description
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Tag]
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
name
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf RoutingStrategy
routingStrategy

instance Data.ToHeaders CreateAlias where
  toHeaders :: CreateAlias -> 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.CreateAlias" :: 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 CreateAlias where
  toJSON :: CreateAlias -> Value
toJSON CreateAlias' {Maybe [Tag]
Maybe Text
Text
RoutingStrategy
routingStrategy :: RoutingStrategy
name :: Text
tags :: Maybe [Tag]
description :: Maybe Text
$sel:routingStrategy:CreateAlias' :: CreateAlias -> RoutingStrategy
$sel:name:CreateAlias' :: CreateAlias -> Text
$sel:tags:CreateAlias' :: CreateAlias -> Maybe [Tag]
$sel:description:CreateAlias' :: CreateAlias -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"Description" 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
description,
            (Key
"Tags" 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 [Tag]
tags,
            forall a. a -> Maybe a
Prelude.Just (Key
"Name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
name),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"RoutingStrategy" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= RoutingStrategy
routingStrategy)
          ]
      )

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

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

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

-- |
-- Create a value of 'CreateAliasResponse' 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', 'createAliasResponse_alias' - The newly created alias resource.
--
-- 'httpStatus', 'createAliasResponse_httpStatus' - The response's http status code.
newCreateAliasResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateAliasResponse
newCreateAliasResponse :: Int -> CreateAliasResponse
newCreateAliasResponse Int
pHttpStatus_ =
  CreateAliasResponse'
    { $sel:alias:CreateAliasResponse' :: Maybe Alias
alias = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateAliasResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

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

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

instance Prelude.NFData CreateAliasResponse where
  rnf :: CreateAliasResponse -> ()
rnf CreateAliasResponse' {Int
Maybe Alias
httpStatus :: Int
alias :: Maybe Alias
$sel:httpStatus:CreateAliasResponse' :: CreateAliasResponse -> Int
$sel:alias:CreateAliasResponse' :: CreateAliasResponse -> 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