{-# 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.UpdateAlias
-- 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 properties for an alias. To update properties, specify the alias
-- ID to be updated and provide the information to be changed. To reassign
-- an alias to another fleet, provide an updated routing strategy. If
-- successful, the updated 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.UpdateAlias
  ( -- * Creating a Request
    UpdateAlias (..),
    newUpdateAlias,

    -- * Request Lenses
    updateAlias_description,
    updateAlias_name,
    updateAlias_routingStrategy,
    updateAlias_aliasId,

    -- * Destructuring the Response
    UpdateAliasResponse (..),
    newUpdateAliasResponse,

    -- * Response Lenses
    updateAliasResponse_alias,
    updateAliasResponse_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:/ 'newUpdateAlias' smart constructor.
data UpdateAlias = UpdateAlias'
  { -- | A human-readable description of the alias.
    UpdateAlias -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | A descriptive label that is associated with an alias. Alias names do not
    -- need to be unique.
    UpdateAlias -> Maybe Text
name :: Prelude.Maybe Prelude.Text,
    -- | The routing configuration, including routing type and fleet target, for
    -- the alias.
    UpdateAlias -> Maybe RoutingStrategy
routingStrategy :: Prelude.Maybe RoutingStrategy,
    -- | A unique identifier for the alias that you want to update. You can use
    -- either the alias ID or ARN value.
    UpdateAlias -> Text
aliasId :: Prelude.Text
  }
  deriving (UpdateAlias -> UpdateAlias -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateAlias -> UpdateAlias -> Bool
$c/= :: UpdateAlias -> UpdateAlias -> Bool
== :: UpdateAlias -> UpdateAlias -> Bool
$c== :: UpdateAlias -> UpdateAlias -> Bool
Prelude.Eq, ReadPrec [UpdateAlias]
ReadPrec UpdateAlias
Int -> ReadS UpdateAlias
ReadS [UpdateAlias]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateAlias]
$creadListPrec :: ReadPrec [UpdateAlias]
readPrec :: ReadPrec UpdateAlias
$creadPrec :: ReadPrec UpdateAlias
readList :: ReadS [UpdateAlias]
$creadList :: ReadS [UpdateAlias]
readsPrec :: Int -> ReadS UpdateAlias
$creadsPrec :: Int -> ReadS UpdateAlias
Prelude.Read, Int -> UpdateAlias -> ShowS
[UpdateAlias] -> ShowS
UpdateAlias -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateAlias] -> ShowS
$cshowList :: [UpdateAlias] -> ShowS
show :: UpdateAlias -> String
$cshow :: UpdateAlias -> String
showsPrec :: Int -> UpdateAlias -> ShowS
$cshowsPrec :: Int -> UpdateAlias -> ShowS
Prelude.Show, forall x. Rep UpdateAlias x -> UpdateAlias
forall x. UpdateAlias -> Rep UpdateAlias x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateAlias x -> UpdateAlias
$cfrom :: forall x. UpdateAlias -> Rep UpdateAlias x
Prelude.Generic)

-- |
-- Create a value of 'UpdateAlias' 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', 'updateAlias_description' - A human-readable description of the alias.
--
-- 'name', 'updateAlias_name' - A descriptive label that is associated with an alias. Alias names do not
-- need to be unique.
--
-- 'routingStrategy', 'updateAlias_routingStrategy' - The routing configuration, including routing type and fleet target, for
-- the alias.
--
-- 'aliasId', 'updateAlias_aliasId' - A unique identifier for the alias that you want to update. You can use
-- either the alias ID or ARN value.
newUpdateAlias ::
  -- | 'aliasId'
  Prelude.Text ->
  UpdateAlias
newUpdateAlias :: Text -> UpdateAlias
newUpdateAlias Text
pAliasId_ =
  UpdateAlias'
    { $sel:description:UpdateAlias' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:name:UpdateAlias' :: Maybe Text
name = forall a. Maybe a
Prelude.Nothing,
      $sel:routingStrategy:UpdateAlias' :: Maybe RoutingStrategy
routingStrategy = forall a. Maybe a
Prelude.Nothing,
      $sel:aliasId:UpdateAlias' :: Text
aliasId = Text
pAliasId_
    }

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

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

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

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

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

instance Prelude.NFData UpdateAlias where
  rnf :: UpdateAlias -> ()
rnf UpdateAlias' {Maybe Text
Maybe RoutingStrategy
Text
aliasId :: Text
routingStrategy :: Maybe RoutingStrategy
name :: Maybe Text
description :: Maybe Text
$sel:aliasId:UpdateAlias' :: UpdateAlias -> Text
$sel:routingStrategy:UpdateAlias' :: UpdateAlias -> Maybe RoutingStrategy
$sel:name:UpdateAlias' :: UpdateAlias -> Maybe Text
$sel:description:UpdateAlias' :: UpdateAlias -> 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 Text
name
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe RoutingStrategy
routingStrategy
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
aliasId

instance Data.ToHeaders UpdateAlias where
  toHeaders :: UpdateAlias -> 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.UpdateAlias" :: 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 UpdateAlias where
  toJSON :: UpdateAlias -> Value
toJSON UpdateAlias' {Maybe Text
Maybe RoutingStrategy
Text
aliasId :: Text
routingStrategy :: Maybe RoutingStrategy
name :: Maybe Text
description :: Maybe Text
$sel:aliasId:UpdateAlias' :: UpdateAlias -> Text
$sel:routingStrategy:UpdateAlias' :: UpdateAlias -> Maybe RoutingStrategy
$sel:name:UpdateAlias' :: UpdateAlias -> Maybe Text
$sel:description:UpdateAlias' :: UpdateAlias -> 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
"Name" 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
name,
            (Key
"RoutingStrategy" 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 RoutingStrategy
routingStrategy,
            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 UpdateAlias where
  toPath :: UpdateAlias -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

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

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

-- |
-- Create a value of 'UpdateAliasResponse' 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', 'updateAliasResponse_alias' - The updated alias resource.
--
-- 'httpStatus', 'updateAliasResponse_httpStatus' - The response's http status code.
newUpdateAliasResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UpdateAliasResponse
newUpdateAliasResponse :: Int -> UpdateAliasResponse
newUpdateAliasResponse Int
pHttpStatus_ =
  UpdateAliasResponse'
    { $sel:alias:UpdateAliasResponse' :: Maybe Alias
alias = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:UpdateAliasResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

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

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

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