{-# 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.Lambda.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 the configuration of a Lambda function
-- <https://docs.aws.amazon.com/lambda/latest/dg/versioning-aliases.html alias>.
module Amazonka.Lambda.UpdateAlias
  ( -- * Creating a Request
    UpdateAlias (..),
    newUpdateAlias,

    -- * Request Lenses
    updateAlias_description,
    updateAlias_functionVersion,
    updateAlias_revisionId,
    updateAlias_routingConfig,
    updateAlias_functionName,
    updateAlias_name,

    -- * Destructuring the Response
    AliasConfiguration (..),
    newAliasConfiguration,

    -- * Response Lenses
    aliasConfiguration_aliasArn,
    aliasConfiguration_description,
    aliasConfiguration_functionVersion,
    aliasConfiguration_name,
    aliasConfiguration_revisionId,
    aliasConfiguration_routingConfig,
  )
where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.Lambda.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 description of the alias.
    UpdateAlias -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | The function version that the alias invokes.
    UpdateAlias -> Maybe Text
functionVersion :: Prelude.Maybe Prelude.Text,
    -- | Only update the alias if the revision ID matches the ID that\'s
    -- specified. Use this option to avoid modifying an alias that has changed
    -- since you last read it.
    UpdateAlias -> Maybe Text
revisionId :: Prelude.Maybe Prelude.Text,
    -- | The
    -- <https://docs.aws.amazon.com/lambda/latest/dg/configuration-aliases.html#configuring-alias-routing routing configuration>
    -- of the alias.
    UpdateAlias -> Maybe AliasRoutingConfiguration
routingConfig :: Prelude.Maybe AliasRoutingConfiguration,
    -- | The name of the Lambda function.
    --
    -- __Name formats__
    --
    -- -   __Function name__ - @MyFunction@.
    --
    -- -   __Function ARN__ -
    --     @arn:aws:lambda:us-west-2:123456789012:function:MyFunction@.
    --
    -- -   __Partial ARN__ - @123456789012:function:MyFunction@.
    --
    -- The length constraint applies only to the full ARN. If you specify only
    -- the function name, it is limited to 64 characters in length.
    UpdateAlias -> Text
functionName :: Prelude.Text,
    -- | The name of the alias.
    UpdateAlias -> Text
name :: 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 description of the alias.
--
-- 'functionVersion', 'updateAlias_functionVersion' - The function version that the alias invokes.
--
-- 'revisionId', 'updateAlias_revisionId' - Only update the alias if the revision ID matches the ID that\'s
-- specified. Use this option to avoid modifying an alias that has changed
-- since you last read it.
--
-- 'routingConfig', 'updateAlias_routingConfig' - The
-- <https://docs.aws.amazon.com/lambda/latest/dg/configuration-aliases.html#configuring-alias-routing routing configuration>
-- of the alias.
--
-- 'functionName', 'updateAlias_functionName' - The name of the Lambda function.
--
-- __Name formats__
--
-- -   __Function name__ - @MyFunction@.
--
-- -   __Function ARN__ -
--     @arn:aws:lambda:us-west-2:123456789012:function:MyFunction@.
--
-- -   __Partial ARN__ - @123456789012:function:MyFunction@.
--
-- The length constraint applies only to the full ARN. If you specify only
-- the function name, it is limited to 64 characters in length.
--
-- 'name', 'updateAlias_name' - The name of the alias.
newUpdateAlias ::
  -- | 'functionName'
  Prelude.Text ->
  -- | 'name'
  Prelude.Text ->
  UpdateAlias
newUpdateAlias :: Text -> Text -> UpdateAlias
newUpdateAlias Text
pFunctionName_ Text
pName_ =
  UpdateAlias'
    { $sel:description:UpdateAlias' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:functionVersion:UpdateAlias' :: Maybe Text
functionVersion = forall a. Maybe a
Prelude.Nothing,
      $sel:revisionId:UpdateAlias' :: Maybe Text
revisionId = forall a. Maybe a
Prelude.Nothing,
      $sel:routingConfig:UpdateAlias' :: Maybe AliasRoutingConfiguration
routingConfig = forall a. Maybe a
Prelude.Nothing,
      $sel:functionName:UpdateAlias' :: Text
functionName = Text
pFunctionName_,
      $sel:name:UpdateAlias' :: Text
name = Text
pName_
    }

-- | A 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)

-- | The function version that the alias invokes.
updateAlias_functionVersion :: Lens.Lens' UpdateAlias (Prelude.Maybe Prelude.Text)
updateAlias_functionVersion :: Lens' UpdateAlias (Maybe Text)
updateAlias_functionVersion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateAlias' {Maybe Text
functionVersion :: Maybe Text
$sel:functionVersion:UpdateAlias' :: UpdateAlias -> Maybe Text
functionVersion} -> Maybe Text
functionVersion) (\s :: UpdateAlias
s@UpdateAlias' {} Maybe Text
a -> UpdateAlias
s {$sel:functionVersion:UpdateAlias' :: Maybe Text
functionVersion = Maybe Text
a} :: UpdateAlias)

-- | Only update the alias if the revision ID matches the ID that\'s
-- specified. Use this option to avoid modifying an alias that has changed
-- since you last read it.
updateAlias_revisionId :: Lens.Lens' UpdateAlias (Prelude.Maybe Prelude.Text)
updateAlias_revisionId :: Lens' UpdateAlias (Maybe Text)
updateAlias_revisionId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateAlias' {Maybe Text
revisionId :: Maybe Text
$sel:revisionId:UpdateAlias' :: UpdateAlias -> Maybe Text
revisionId} -> Maybe Text
revisionId) (\s :: UpdateAlias
s@UpdateAlias' {} Maybe Text
a -> UpdateAlias
s {$sel:revisionId:UpdateAlias' :: Maybe Text
revisionId = Maybe Text
a} :: UpdateAlias)

-- | The
-- <https://docs.aws.amazon.com/lambda/latest/dg/configuration-aliases.html#configuring-alias-routing routing configuration>
-- of the alias.
updateAlias_routingConfig :: Lens.Lens' UpdateAlias (Prelude.Maybe AliasRoutingConfiguration)
updateAlias_routingConfig :: Lens' UpdateAlias (Maybe AliasRoutingConfiguration)
updateAlias_routingConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateAlias' {Maybe AliasRoutingConfiguration
routingConfig :: Maybe AliasRoutingConfiguration
$sel:routingConfig:UpdateAlias' :: UpdateAlias -> Maybe AliasRoutingConfiguration
routingConfig} -> Maybe AliasRoutingConfiguration
routingConfig) (\s :: UpdateAlias
s@UpdateAlias' {} Maybe AliasRoutingConfiguration
a -> UpdateAlias
s {$sel:routingConfig:UpdateAlias' :: Maybe AliasRoutingConfiguration
routingConfig = Maybe AliasRoutingConfiguration
a} :: UpdateAlias)

-- | The name of the Lambda function.
--
-- __Name formats__
--
-- -   __Function name__ - @MyFunction@.
--
-- -   __Function ARN__ -
--     @arn:aws:lambda:us-west-2:123456789012:function:MyFunction@.
--
-- -   __Partial ARN__ - @123456789012:function:MyFunction@.
--
-- The length constraint applies only to the full ARN. If you specify only
-- the function name, it is limited to 64 characters in length.
updateAlias_functionName :: Lens.Lens' UpdateAlias Prelude.Text
updateAlias_functionName :: Lens' UpdateAlias Text
updateAlias_functionName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateAlias' {Text
functionName :: Text
$sel:functionName:UpdateAlias' :: UpdateAlias -> Text
functionName} -> Text
functionName) (\s :: UpdateAlias
s@UpdateAlias' {} Text
a -> UpdateAlias
s {$sel:functionName:UpdateAlias' :: Text
functionName = Text
a} :: UpdateAlias)

-- | The name of the alias.
updateAlias_name :: Lens.Lens' UpdateAlias Prelude.Text
updateAlias_name :: Lens' UpdateAlias Text
updateAlias_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateAlias' {Text
name :: Text
$sel:name:UpdateAlias' :: UpdateAlias -> Text
name} -> Text
name) (\s :: UpdateAlias
s@UpdateAlias' {} Text
a -> UpdateAlias
s {$sel:name:UpdateAlias' :: Text
name = Text
a} :: UpdateAlias)

instance Core.AWSRequest UpdateAlias where
  type AWSResponse UpdateAlias = AliasConfiguration
  request :: (Service -> Service) -> UpdateAlias -> Request UpdateAlias
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.putJSON (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 -> forall a. FromJSON a => Object -> Either String a
Data.eitherParseJSON Object
x)

instance Prelude.Hashable UpdateAlias where
  hashWithSalt :: Int -> UpdateAlias -> Int
hashWithSalt Int
_salt UpdateAlias' {Maybe Text
Maybe AliasRoutingConfiguration
Text
name :: Text
functionName :: Text
routingConfig :: Maybe AliasRoutingConfiguration
revisionId :: Maybe Text
functionVersion :: Maybe Text
description :: Maybe Text
$sel:name:UpdateAlias' :: UpdateAlias -> Text
$sel:functionName:UpdateAlias' :: UpdateAlias -> Text
$sel:routingConfig:UpdateAlias' :: UpdateAlias -> Maybe AliasRoutingConfiguration
$sel:revisionId:UpdateAlias' :: UpdateAlias -> Maybe Text
$sel:functionVersion: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
functionVersion
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
revisionId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe AliasRoutingConfiguration
routingConfig
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
functionName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
name

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

instance Data.ToHeaders UpdateAlias where
  toHeaders :: UpdateAlias -> ResponseHeaders
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

instance Data.ToJSON UpdateAlias where
  toJSON :: UpdateAlias -> Value
toJSON UpdateAlias' {Maybe Text
Maybe AliasRoutingConfiguration
Text
name :: Text
functionName :: Text
routingConfig :: Maybe AliasRoutingConfiguration
revisionId :: Maybe Text
functionVersion :: Maybe Text
description :: Maybe Text
$sel:name:UpdateAlias' :: UpdateAlias -> Text
$sel:functionName:UpdateAlias' :: UpdateAlias -> Text
$sel:routingConfig:UpdateAlias' :: UpdateAlias -> Maybe AliasRoutingConfiguration
$sel:revisionId:UpdateAlias' :: UpdateAlias -> Maybe Text
$sel:functionVersion: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
"FunctionVersion" 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
functionVersion,
            (Key
"RevisionId" 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
revisionId,
            (Key
"RoutingConfig" 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 AliasRoutingConfiguration
routingConfig
          ]
      )

instance Data.ToPath UpdateAlias where
  toPath :: UpdateAlias -> ByteString
toPath UpdateAlias' {Maybe Text
Maybe AliasRoutingConfiguration
Text
name :: Text
functionName :: Text
routingConfig :: Maybe AliasRoutingConfiguration
revisionId :: Maybe Text
functionVersion :: Maybe Text
description :: Maybe Text
$sel:name:UpdateAlias' :: UpdateAlias -> Text
$sel:functionName:UpdateAlias' :: UpdateAlias -> Text
$sel:routingConfig:UpdateAlias' :: UpdateAlias -> Maybe AliasRoutingConfiguration
$sel:revisionId:UpdateAlias' :: UpdateAlias -> Maybe Text
$sel:functionVersion:UpdateAlias' :: UpdateAlias -> Maybe Text
$sel:description:UpdateAlias' :: UpdateAlias -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/2015-03-31/functions/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
functionName,
        ByteString
"/aliases/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
name
      ]

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