{-# 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.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
-- <https://docs.aws.amazon.com/lambda/latest/dg/versioning-aliases.html alias>
-- for a Lambda function version. Use aliases to provide clients with a
-- function identifier that you can update to invoke a different version.
--
-- You can also map an alias to split invocation requests between two
-- versions. Use the @RoutingConfig@ parameter to specify a second version
-- and the percentage of invocation requests that it receives.
module Amazonka.Lambda.CreateAlias
  ( -- * Creating a Request
    CreateAlias (..),
    newCreateAlias,

    -- * Request Lenses
    createAlias_description,
    createAlias_routingConfig,
    createAlias_functionName,
    createAlias_name,
    createAlias_functionVersion,

    -- * 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:/ 'newCreateAlias' smart constructor.
data CreateAlias = CreateAlias'
  { -- | A description of the alias.
    CreateAlias -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | The
    -- <https://docs.aws.amazon.com/lambda/latest/dg/configuration-aliases.html#configuring-alias-routing routing configuration>
    -- of the alias.
    CreateAlias -> 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.
    CreateAlias -> Text
functionName :: Prelude.Text,
    -- | The name of the alias.
    CreateAlias -> Text
name :: Prelude.Text,
    -- | The function version that the alias invokes.
    CreateAlias -> Text
functionVersion :: Prelude.Text
  }
  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 description of the alias.
--
-- 'routingConfig', 'createAlias_routingConfig' - The
-- <https://docs.aws.amazon.com/lambda/latest/dg/configuration-aliases.html#configuring-alias-routing routing configuration>
-- of the alias.
--
-- 'functionName', 'createAlias_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', 'createAlias_name' - The name of the alias.
--
-- 'functionVersion', 'createAlias_functionVersion' - The function version that the alias invokes.
newCreateAlias ::
  -- | 'functionName'
  Prelude.Text ->
  -- | 'name'
  Prelude.Text ->
  -- | 'functionVersion'
  Prelude.Text ->
  CreateAlias
newCreateAlias :: Text -> Text -> Text -> CreateAlias
newCreateAlias
  Text
pFunctionName_
  Text
pName_
  Text
pFunctionVersion_ =
    CreateAlias'
      { $sel:description:CreateAlias' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
        $sel:routingConfig:CreateAlias' :: Maybe AliasRoutingConfiguration
routingConfig = forall a. Maybe a
Prelude.Nothing,
        $sel:functionName:CreateAlias' :: Text
functionName = Text
pFunctionName_,
        $sel:name:CreateAlias' :: Text
name = Text
pName_,
        $sel:functionVersion:CreateAlias' :: Text
functionVersion = Text
pFunctionVersion_
      }

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

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

-- | 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.
createAlias_functionName :: Lens.Lens' CreateAlias Prelude.Text
createAlias_functionName :: Lens' CreateAlias Text
createAlias_functionName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateAlias' {Text
functionName :: Text
$sel:functionName:CreateAlias' :: CreateAlias -> Text
functionName} -> Text
functionName) (\s :: CreateAlias
s@CreateAlias' {} Text
a -> CreateAlias
s {$sel:functionName:CreateAlias' :: Text
functionName = Text
a} :: CreateAlias)

-- | The name of the alias.
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 function version that the alias invokes.
createAlias_functionVersion :: Lens.Lens' CreateAlias Prelude.Text
createAlias_functionVersion :: Lens' CreateAlias Text
createAlias_functionVersion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateAlias' {Text
functionVersion :: Text
$sel:functionVersion:CreateAlias' :: CreateAlias -> Text
functionVersion} -> Text
functionVersion) (\s :: CreateAlias
s@CreateAlias' {} Text
a -> CreateAlias
s {$sel:functionVersion:CreateAlias' :: Text
functionVersion = Text
a} :: CreateAlias)

instance Core.AWSRequest CreateAlias where
  type AWSResponse CreateAlias = AliasConfiguration
  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 -> forall a. FromJSON a => Object -> Either String a
Data.eitherParseJSON Object
x)

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

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

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

instance Data.ToJSON CreateAlias where
  toJSON :: CreateAlias -> Value
toJSON CreateAlias' {Maybe Text
Maybe AliasRoutingConfiguration
Text
functionVersion :: Text
name :: Text
functionName :: Text
routingConfig :: Maybe AliasRoutingConfiguration
description :: Maybe Text
$sel:functionVersion:CreateAlias' :: CreateAlias -> Text
$sel:name:CreateAlias' :: CreateAlias -> Text
$sel:functionName:CreateAlias' :: CreateAlias -> Text
$sel:routingConfig:CreateAlias' :: CreateAlias -> Maybe AliasRoutingConfiguration
$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
"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,
            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
"FunctionVersion" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
functionVersion)
          ]
      )

instance Data.ToPath CreateAlias where
  toPath :: CreateAlias -> ByteString
toPath CreateAlias' {Maybe Text
Maybe AliasRoutingConfiguration
Text
functionVersion :: Text
name :: Text
functionName :: Text
routingConfig :: Maybe AliasRoutingConfiguration
description :: Maybe Text
$sel:functionVersion:CreateAlias' :: CreateAlias -> Text
$sel:name:CreateAlias' :: CreateAlias -> Text
$sel:functionName:CreateAlias' :: CreateAlias -> Text
$sel:routingConfig:CreateAlias' :: CreateAlias -> Maybe AliasRoutingConfiguration
$sel:description:CreateAlias' :: CreateAlias -> 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"
      ]

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