{-# 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.CreateFunction
-- 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 a Lambda function. To create a function, you need a
-- <https://docs.aws.amazon.com/lambda/latest/dg/gettingstarted-package.html deployment package>
-- and an
-- <https://docs.aws.amazon.com/lambda/latest/dg/intro-permission-model.html#lambda-intro-execution-role execution role>.
-- The deployment package is a .zip file archive or container image that
-- contains your function code. The execution role grants the function
-- permission to use Amazon Web Services, such as Amazon CloudWatch Logs
-- for log streaming and X-Ray for request tracing.
--
-- If the deployment package is a
-- <https://docs.aws.amazon.com/lambda/latest/dg/lambda-images.html container image>,
-- then you set the package type to @Image@. For a container image, the
-- code property must include the URI of a container image in the Amazon
-- ECR registry. You do not need to specify the handler and runtime
-- properties.
--
-- If the deployment package is a
-- <https://docs.aws.amazon.com/lambda/latest/dg/gettingstarted-package.html#gettingstarted-package-zip .zip file archive>,
-- then you set the package type to @Zip@. For a .zip file archive, the
-- code property specifies the location of the .zip file. You must also
-- specify the handler and runtime properties. The code in the deployment
-- package must be compatible with the target instruction set architecture
-- of the function (@x86-64@ or @arm64@). If you do not specify the
-- architecture, then the default value is @x86-64@.
--
-- When you create a function, Lambda provisions an instance of the
-- function and its supporting resources. If your function connects to a
-- VPC, this process can take a minute or so. During this time, you can\'t
-- invoke or modify the function. The @State@, @StateReason@, and
-- @StateReasonCode@ fields in the response from GetFunctionConfiguration
-- indicate when the function is ready to invoke. For more information, see
-- <https://docs.aws.amazon.com/lambda/latest/dg/functions-states.html Lambda function states>.
--
-- A function has an unpublished version, and can have published versions
-- and aliases. The unpublished version changes when you update your
-- function\'s code and configuration. A published version is a snapshot of
-- your function code and configuration that can\'t be changed. An alias is
-- a named resource that maps to a version, and can be changed to map to a
-- different version. Use the @Publish@ parameter to create version @1@ of
-- your function from its initial configuration.
--
-- The other parameters let you configure version-specific and
-- function-level settings. You can modify version-specific settings later
-- with UpdateFunctionConfiguration. Function-level settings apply to both
-- the unpublished and published versions of the function, and include tags
-- (TagResource) and per-function concurrency limits
-- (PutFunctionConcurrency).
--
-- You can use code signing if your deployment package is a .zip file
-- archive. To enable code signing for this function, specify the ARN of a
-- code-signing configuration. When a user attempts to deploy a code
-- package with UpdateFunctionCode, Lambda checks that the code package has
-- a valid signature from a trusted publisher. The code-signing
-- configuration includes set of signing profiles, which define the trusted
-- publishers for this function.
--
-- If another Amazon Web Services account or an Amazon Web Service invokes
-- your function, use AddPermission to grant permission by creating a
-- resource-based Identity and Access Management (IAM) policy. You can
-- grant permissions at the function level, on a version, or on an alias.
--
-- To invoke your function directly, use Invoke. To invoke your function in
-- response to events in other Amazon Web Services, create an event source
-- mapping (CreateEventSourceMapping), or configure a function trigger in
-- the other service. For more information, see
-- <https://docs.aws.amazon.com/lambda/latest/dg/lambda-invocation.html Invoking Lambda functions>.
module Amazonka.Lambda.CreateFunction
  ( -- * Creating a Request
    CreateFunction (..),
    newCreateFunction,

    -- * Request Lenses
    createFunction_architectures,
    createFunction_codeSigningConfigArn,
    createFunction_deadLetterConfig,
    createFunction_description,
    createFunction_environment,
    createFunction_ephemeralStorage,
    createFunction_fileSystemConfigs,
    createFunction_handler,
    createFunction_imageConfig,
    createFunction_kmsKeyArn,
    createFunction_layers,
    createFunction_memorySize,
    createFunction_packageType,
    createFunction_publish,
    createFunction_runtime,
    createFunction_snapStart,
    createFunction_tags,
    createFunction_timeout,
    createFunction_tracingConfig,
    createFunction_vpcConfig,
    createFunction_functionName,
    createFunction_role,
    createFunction_code,

    -- * Destructuring the Response
    FunctionConfiguration (..),
    newFunctionConfiguration,

    -- * Response Lenses
    functionConfiguration_architectures,
    functionConfiguration_codeSha256,
    functionConfiguration_codeSize,
    functionConfiguration_deadLetterConfig,
    functionConfiguration_description,
    functionConfiguration_environment,
    functionConfiguration_ephemeralStorage,
    functionConfiguration_fileSystemConfigs,
    functionConfiguration_functionArn,
    functionConfiguration_functionName,
    functionConfiguration_handler,
    functionConfiguration_imageConfigResponse,
    functionConfiguration_kmsKeyArn,
    functionConfiguration_lastModified,
    functionConfiguration_lastUpdateStatus,
    functionConfiguration_lastUpdateStatusReason,
    functionConfiguration_lastUpdateStatusReasonCode,
    functionConfiguration_layers,
    functionConfiguration_masterArn,
    functionConfiguration_memorySize,
    functionConfiguration_packageType,
    functionConfiguration_revisionId,
    functionConfiguration_role,
    functionConfiguration_runtime,
    functionConfiguration_signingJobArn,
    functionConfiguration_signingProfileVersionArn,
    functionConfiguration_snapStart,
    functionConfiguration_state,
    functionConfiguration_stateReason,
    functionConfiguration_stateReasonCode,
    functionConfiguration_timeout,
    functionConfiguration_tracingConfig,
    functionConfiguration_version,
    functionConfiguration_vpcConfig,
  )
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:/ 'newCreateFunction' smart constructor.
data CreateFunction = CreateFunction'
  { -- | The instruction set architecture that the function supports. Enter a
    -- string array with one of the valid values (arm64 or x86_64). The default
    -- value is @x86_64@.
    CreateFunction -> Maybe (NonEmpty Architecture)
architectures :: Prelude.Maybe (Prelude.NonEmpty Architecture),
    -- | To enable code signing for this function, specify the ARN of a
    -- code-signing configuration. A code-signing configuration includes a set
    -- of signing profiles, which define the trusted publishers for this
    -- function.
    CreateFunction -> Maybe Text
codeSigningConfigArn :: Prelude.Maybe Prelude.Text,
    -- | A dead-letter queue configuration that specifies the queue or topic
    -- where Lambda sends asynchronous events when they fail processing. For
    -- more information, see
    -- <https://docs.aws.amazon.com/lambda/latest/dg/invocation-async.html#invocation-dlq Dead-letter queues>.
    CreateFunction -> Maybe DeadLetterConfig
deadLetterConfig :: Prelude.Maybe DeadLetterConfig,
    -- | A description of the function.
    CreateFunction -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | Environment variables that are accessible from function code during
    -- execution.
    CreateFunction -> Maybe Environment
environment :: Prelude.Maybe Environment,
    -- | The size of the function\'s @\/tmp@ directory in MB. The default value
    -- is 512, but can be any whole number between 512 and 10,240 MB.
    CreateFunction -> Maybe EphemeralStorage
ephemeralStorage :: Prelude.Maybe EphemeralStorage,
    -- | Connection settings for an Amazon EFS file system.
    CreateFunction -> Maybe [FileSystemConfig]
fileSystemConfigs :: Prelude.Maybe [FileSystemConfig],
    -- | The name of the method within your code that Lambda calls to run your
    -- function. Handler is required if the deployment package is a .zip file
    -- archive. The format includes the file name. It can also include
    -- namespaces and other qualifiers, depending on the runtime. For more
    -- information, see
    -- <https://docs.aws.amazon.com/lambda/latest/dg/foundation-progmodel.html Lambda programming model>.
    CreateFunction -> Maybe Text
handler :: Prelude.Maybe Prelude.Text,
    -- | Container image
    -- <https://docs.aws.amazon.com/lambda/latest/dg/configuration-images.html#configuration-images-settings configuration values>
    -- that override the values in the container image Dockerfile.
    CreateFunction -> Maybe ImageConfig
imageConfig :: Prelude.Maybe ImageConfig,
    -- | The ARN of the Key Management Service (KMS) key that\'s used to encrypt
    -- your function\'s environment variables. If it\'s not provided, Lambda
    -- uses a default service key.
    CreateFunction -> Maybe Text
kmsKeyArn :: Prelude.Maybe Prelude.Text,
    -- | A list of
    -- <https://docs.aws.amazon.com/lambda/latest/dg/configuration-layers.html function layers>
    -- to add to the function\'s execution environment. Specify each layer by
    -- its ARN, including the version.
    CreateFunction -> Maybe [Text]
layers :: Prelude.Maybe [Prelude.Text],
    -- | The amount of
    -- <https://docs.aws.amazon.com/lambda/latest/dg/configuration-function-common.html#configuration-memory-console memory available to the function>
    -- at runtime. Increasing the function memory also increases its CPU
    -- allocation. The default value is 128 MB. The value can be any multiple
    -- of 1 MB.
    CreateFunction -> Maybe Natural
memorySize :: Prelude.Maybe Prelude.Natural,
    -- | The type of deployment package. Set to @Image@ for container image and
    -- set to @Zip@ for .zip file archive.
    CreateFunction -> Maybe PackageType
packageType :: Prelude.Maybe PackageType,
    -- | Set to true to publish the first version of the function during
    -- creation.
    CreateFunction -> Maybe Bool
publish :: Prelude.Maybe Prelude.Bool,
    -- | The identifier of the function\'s
    -- <https://docs.aws.amazon.com/lambda/latest/dg/lambda-runtimes.html runtime>.
    -- Runtime is required if the deployment package is a .zip file archive.
    CreateFunction -> Maybe Runtime
runtime :: Prelude.Maybe Runtime,
    -- | The function\'s
    -- <https://docs.aws.amazon.com/lambda/latest/dg/snapstart.html SnapStart>
    -- setting.
    CreateFunction -> Maybe SnapStart
snapStart :: Prelude.Maybe SnapStart,
    -- | A list of
    -- <https://docs.aws.amazon.com/lambda/latest/dg/tagging.html tags> to
    -- apply to the function.
    CreateFunction -> Maybe (HashMap Text Text)
tags :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | The amount of time (in seconds) that Lambda allows a function to run
    -- before stopping it. The default is 3 seconds. The maximum allowed value
    -- is 900 seconds. For more information, see
    -- <https://docs.aws.amazon.com/lambda/latest/dg/runtimes-context.html Lambda execution environment>.
    CreateFunction -> Maybe Natural
timeout :: Prelude.Maybe Prelude.Natural,
    -- | Set @Mode@ to @Active@ to sample and trace a subset of incoming requests
    -- with
    -- <https://docs.aws.amazon.com/lambda/latest/dg/services-xray.html X-Ray>.
    CreateFunction -> Maybe TracingConfig
tracingConfig :: Prelude.Maybe TracingConfig,
    -- | For network connectivity to Amazon Web Services resources in a VPC,
    -- specify a list of security groups and subnets in the VPC. When you
    -- connect a function to a VPC, it can access resources and the internet
    -- only through that VPC. For more information, see
    -- <https://docs.aws.amazon.com/lambda/latest/dg/configuration-vpc.html Configuring a Lambda function to access resources in a VPC>.
    CreateFunction -> Maybe VpcConfig
vpcConfig :: Prelude.Maybe VpcConfig,
    -- | The name of the Lambda function.
    --
    -- __Name formats__
    --
    -- -   __Function name__ – @my-function@.
    --
    -- -   __Function ARN__ –
    --     @arn:aws:lambda:us-west-2:123456789012:function:my-function@.
    --
    -- -   __Partial ARN__ – @123456789012:function:my-function@.
    --
    -- The length constraint applies only to the full ARN. If you specify only
    -- the function name, it is limited to 64 characters in length.
    CreateFunction -> Text
functionName :: Prelude.Text,
    -- | The Amazon Resource Name (ARN) of the function\'s execution role.
    CreateFunction -> Text
role' :: Prelude.Text,
    -- | The code for the function.
    CreateFunction -> FunctionCode
code :: FunctionCode
  }
  deriving (CreateFunction -> CreateFunction -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateFunction -> CreateFunction -> Bool
$c/= :: CreateFunction -> CreateFunction -> Bool
== :: CreateFunction -> CreateFunction -> Bool
$c== :: CreateFunction -> CreateFunction -> Bool
Prelude.Eq, Int -> CreateFunction -> ShowS
[CreateFunction] -> ShowS
CreateFunction -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateFunction] -> ShowS
$cshowList :: [CreateFunction] -> ShowS
show :: CreateFunction -> String
$cshow :: CreateFunction -> String
showsPrec :: Int -> CreateFunction -> ShowS
$cshowsPrec :: Int -> CreateFunction -> ShowS
Prelude.Show, forall x. Rep CreateFunction x -> CreateFunction
forall x. CreateFunction -> Rep CreateFunction x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateFunction x -> CreateFunction
$cfrom :: forall x. CreateFunction -> Rep CreateFunction x
Prelude.Generic)

-- |
-- Create a value of 'CreateFunction' 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:
--
-- 'architectures', 'createFunction_architectures' - The instruction set architecture that the function supports. Enter a
-- string array with one of the valid values (arm64 or x86_64). The default
-- value is @x86_64@.
--
-- 'codeSigningConfigArn', 'createFunction_codeSigningConfigArn' - To enable code signing for this function, specify the ARN of a
-- code-signing configuration. A code-signing configuration includes a set
-- of signing profiles, which define the trusted publishers for this
-- function.
--
-- 'deadLetterConfig', 'createFunction_deadLetterConfig' - A dead-letter queue configuration that specifies the queue or topic
-- where Lambda sends asynchronous events when they fail processing. For
-- more information, see
-- <https://docs.aws.amazon.com/lambda/latest/dg/invocation-async.html#invocation-dlq Dead-letter queues>.
--
-- 'description', 'createFunction_description' - A description of the function.
--
-- 'environment', 'createFunction_environment' - Environment variables that are accessible from function code during
-- execution.
--
-- 'ephemeralStorage', 'createFunction_ephemeralStorage' - The size of the function\'s @\/tmp@ directory in MB. The default value
-- is 512, but can be any whole number between 512 and 10,240 MB.
--
-- 'fileSystemConfigs', 'createFunction_fileSystemConfigs' - Connection settings for an Amazon EFS file system.
--
-- 'handler', 'createFunction_handler' - The name of the method within your code that Lambda calls to run your
-- function. Handler is required if the deployment package is a .zip file
-- archive. The format includes the file name. It can also include
-- namespaces and other qualifiers, depending on the runtime. For more
-- information, see
-- <https://docs.aws.amazon.com/lambda/latest/dg/foundation-progmodel.html Lambda programming model>.
--
-- 'imageConfig', 'createFunction_imageConfig' - Container image
-- <https://docs.aws.amazon.com/lambda/latest/dg/configuration-images.html#configuration-images-settings configuration values>
-- that override the values in the container image Dockerfile.
--
-- 'kmsKeyArn', 'createFunction_kmsKeyArn' - The ARN of the Key Management Service (KMS) key that\'s used to encrypt
-- your function\'s environment variables. If it\'s not provided, Lambda
-- uses a default service key.
--
-- 'layers', 'createFunction_layers' - A list of
-- <https://docs.aws.amazon.com/lambda/latest/dg/configuration-layers.html function layers>
-- to add to the function\'s execution environment. Specify each layer by
-- its ARN, including the version.
--
-- 'memorySize', 'createFunction_memorySize' - The amount of
-- <https://docs.aws.amazon.com/lambda/latest/dg/configuration-function-common.html#configuration-memory-console memory available to the function>
-- at runtime. Increasing the function memory also increases its CPU
-- allocation. The default value is 128 MB. The value can be any multiple
-- of 1 MB.
--
-- 'packageType', 'createFunction_packageType' - The type of deployment package. Set to @Image@ for container image and
-- set to @Zip@ for .zip file archive.
--
-- 'publish', 'createFunction_publish' - Set to true to publish the first version of the function during
-- creation.
--
-- 'runtime', 'createFunction_runtime' - The identifier of the function\'s
-- <https://docs.aws.amazon.com/lambda/latest/dg/lambda-runtimes.html runtime>.
-- Runtime is required if the deployment package is a .zip file archive.
--
-- 'snapStart', 'createFunction_snapStart' - The function\'s
-- <https://docs.aws.amazon.com/lambda/latest/dg/snapstart.html SnapStart>
-- setting.
--
-- 'tags', 'createFunction_tags' - A list of
-- <https://docs.aws.amazon.com/lambda/latest/dg/tagging.html tags> to
-- apply to the function.
--
-- 'timeout', 'createFunction_timeout' - The amount of time (in seconds) that Lambda allows a function to run
-- before stopping it. The default is 3 seconds. The maximum allowed value
-- is 900 seconds. For more information, see
-- <https://docs.aws.amazon.com/lambda/latest/dg/runtimes-context.html Lambda execution environment>.
--
-- 'tracingConfig', 'createFunction_tracingConfig' - Set @Mode@ to @Active@ to sample and trace a subset of incoming requests
-- with
-- <https://docs.aws.amazon.com/lambda/latest/dg/services-xray.html X-Ray>.
--
-- 'vpcConfig', 'createFunction_vpcConfig' - For network connectivity to Amazon Web Services resources in a VPC,
-- specify a list of security groups and subnets in the VPC. When you
-- connect a function to a VPC, it can access resources and the internet
-- only through that VPC. For more information, see
-- <https://docs.aws.amazon.com/lambda/latest/dg/configuration-vpc.html Configuring a Lambda function to access resources in a VPC>.
--
-- 'functionName', 'createFunction_functionName' - The name of the Lambda function.
--
-- __Name formats__
--
-- -   __Function name__ – @my-function@.
--
-- -   __Function ARN__ –
--     @arn:aws:lambda:us-west-2:123456789012:function:my-function@.
--
-- -   __Partial ARN__ – @123456789012:function:my-function@.
--
-- The length constraint applies only to the full ARN. If you specify only
-- the function name, it is limited to 64 characters in length.
--
-- 'role'', 'createFunction_role' - The Amazon Resource Name (ARN) of the function\'s execution role.
--
-- 'code', 'createFunction_code' - The code for the function.
newCreateFunction ::
  -- | 'functionName'
  Prelude.Text ->
  -- | 'role''
  Prelude.Text ->
  -- | 'code'
  FunctionCode ->
  CreateFunction
newCreateFunction :: Text -> Text -> FunctionCode -> CreateFunction
newCreateFunction Text
pFunctionName_ Text
pRole_ FunctionCode
pCode_ =
  CreateFunction'
    { $sel:architectures:CreateFunction' :: Maybe (NonEmpty Architecture)
architectures = forall a. Maybe a
Prelude.Nothing,
      $sel:codeSigningConfigArn:CreateFunction' :: Maybe Text
codeSigningConfigArn = forall a. Maybe a
Prelude.Nothing,
      $sel:deadLetterConfig:CreateFunction' :: Maybe DeadLetterConfig
deadLetterConfig = forall a. Maybe a
Prelude.Nothing,
      $sel:description:CreateFunction' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:environment:CreateFunction' :: Maybe Environment
environment = forall a. Maybe a
Prelude.Nothing,
      $sel:ephemeralStorage:CreateFunction' :: Maybe EphemeralStorage
ephemeralStorage = forall a. Maybe a
Prelude.Nothing,
      $sel:fileSystemConfigs:CreateFunction' :: Maybe [FileSystemConfig]
fileSystemConfigs = forall a. Maybe a
Prelude.Nothing,
      $sel:handler:CreateFunction' :: Maybe Text
handler = forall a. Maybe a
Prelude.Nothing,
      $sel:imageConfig:CreateFunction' :: Maybe ImageConfig
imageConfig = forall a. Maybe a
Prelude.Nothing,
      $sel:kmsKeyArn:CreateFunction' :: Maybe Text
kmsKeyArn = forall a. Maybe a
Prelude.Nothing,
      $sel:layers:CreateFunction' :: Maybe [Text]
layers = forall a. Maybe a
Prelude.Nothing,
      $sel:memorySize:CreateFunction' :: Maybe Natural
memorySize = forall a. Maybe a
Prelude.Nothing,
      $sel:packageType:CreateFunction' :: Maybe PackageType
packageType = forall a. Maybe a
Prelude.Nothing,
      $sel:publish:CreateFunction' :: Maybe Bool
publish = forall a. Maybe a
Prelude.Nothing,
      $sel:runtime:CreateFunction' :: Maybe Runtime
runtime = forall a. Maybe a
Prelude.Nothing,
      $sel:snapStart:CreateFunction' :: Maybe SnapStart
snapStart = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:CreateFunction' :: Maybe (HashMap Text Text)
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:timeout:CreateFunction' :: Maybe Natural
timeout = forall a. Maybe a
Prelude.Nothing,
      $sel:tracingConfig:CreateFunction' :: Maybe TracingConfig
tracingConfig = forall a. Maybe a
Prelude.Nothing,
      $sel:vpcConfig:CreateFunction' :: Maybe VpcConfig
vpcConfig = forall a. Maybe a
Prelude.Nothing,
      $sel:functionName:CreateFunction' :: Text
functionName = Text
pFunctionName_,
      $sel:role':CreateFunction' :: Text
role' = Text
pRole_,
      $sel:code:CreateFunction' :: FunctionCode
code = FunctionCode
pCode_
    }

-- | The instruction set architecture that the function supports. Enter a
-- string array with one of the valid values (arm64 or x86_64). The default
-- value is @x86_64@.
createFunction_architectures :: Lens.Lens' CreateFunction (Prelude.Maybe (Prelude.NonEmpty Architecture))
createFunction_architectures :: Lens' CreateFunction (Maybe (NonEmpty Architecture))
createFunction_architectures = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateFunction' {Maybe (NonEmpty Architecture)
architectures :: Maybe (NonEmpty Architecture)
$sel:architectures:CreateFunction' :: CreateFunction -> Maybe (NonEmpty Architecture)
architectures} -> Maybe (NonEmpty Architecture)
architectures) (\s :: CreateFunction
s@CreateFunction' {} Maybe (NonEmpty Architecture)
a -> CreateFunction
s {$sel:architectures:CreateFunction' :: Maybe (NonEmpty Architecture)
architectures = Maybe (NonEmpty Architecture)
a} :: CreateFunction) 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

-- | To enable code signing for this function, specify the ARN of a
-- code-signing configuration. A code-signing configuration includes a set
-- of signing profiles, which define the trusted publishers for this
-- function.
createFunction_codeSigningConfigArn :: Lens.Lens' CreateFunction (Prelude.Maybe Prelude.Text)
createFunction_codeSigningConfigArn :: Lens' CreateFunction (Maybe Text)
createFunction_codeSigningConfigArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateFunction' {Maybe Text
codeSigningConfigArn :: Maybe Text
$sel:codeSigningConfigArn:CreateFunction' :: CreateFunction -> Maybe Text
codeSigningConfigArn} -> Maybe Text
codeSigningConfigArn) (\s :: CreateFunction
s@CreateFunction' {} Maybe Text
a -> CreateFunction
s {$sel:codeSigningConfigArn:CreateFunction' :: Maybe Text
codeSigningConfigArn = Maybe Text
a} :: CreateFunction)

-- | A dead-letter queue configuration that specifies the queue or topic
-- where Lambda sends asynchronous events when they fail processing. For
-- more information, see
-- <https://docs.aws.amazon.com/lambda/latest/dg/invocation-async.html#invocation-dlq Dead-letter queues>.
createFunction_deadLetterConfig :: Lens.Lens' CreateFunction (Prelude.Maybe DeadLetterConfig)
createFunction_deadLetterConfig :: Lens' CreateFunction (Maybe DeadLetterConfig)
createFunction_deadLetterConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateFunction' {Maybe DeadLetterConfig
deadLetterConfig :: Maybe DeadLetterConfig
$sel:deadLetterConfig:CreateFunction' :: CreateFunction -> Maybe DeadLetterConfig
deadLetterConfig} -> Maybe DeadLetterConfig
deadLetterConfig) (\s :: CreateFunction
s@CreateFunction' {} Maybe DeadLetterConfig
a -> CreateFunction
s {$sel:deadLetterConfig:CreateFunction' :: Maybe DeadLetterConfig
deadLetterConfig = Maybe DeadLetterConfig
a} :: CreateFunction)

-- | A description of the function.
createFunction_description :: Lens.Lens' CreateFunction (Prelude.Maybe Prelude.Text)
createFunction_description :: Lens' CreateFunction (Maybe Text)
createFunction_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateFunction' {Maybe Text
description :: Maybe Text
$sel:description:CreateFunction' :: CreateFunction -> Maybe Text
description} -> Maybe Text
description) (\s :: CreateFunction
s@CreateFunction' {} Maybe Text
a -> CreateFunction
s {$sel:description:CreateFunction' :: Maybe Text
description = Maybe Text
a} :: CreateFunction)

-- | Environment variables that are accessible from function code during
-- execution.
createFunction_environment :: Lens.Lens' CreateFunction (Prelude.Maybe Environment)
createFunction_environment :: Lens' CreateFunction (Maybe Environment)
createFunction_environment = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateFunction' {Maybe Environment
environment :: Maybe Environment
$sel:environment:CreateFunction' :: CreateFunction -> Maybe Environment
environment} -> Maybe Environment
environment) (\s :: CreateFunction
s@CreateFunction' {} Maybe Environment
a -> CreateFunction
s {$sel:environment:CreateFunction' :: Maybe Environment
environment = Maybe Environment
a} :: CreateFunction)

-- | The size of the function\'s @\/tmp@ directory in MB. The default value
-- is 512, but can be any whole number between 512 and 10,240 MB.
createFunction_ephemeralStorage :: Lens.Lens' CreateFunction (Prelude.Maybe EphemeralStorage)
createFunction_ephemeralStorage :: Lens' CreateFunction (Maybe EphemeralStorage)
createFunction_ephemeralStorage = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateFunction' {Maybe EphemeralStorage
ephemeralStorage :: Maybe EphemeralStorage
$sel:ephemeralStorage:CreateFunction' :: CreateFunction -> Maybe EphemeralStorage
ephemeralStorage} -> Maybe EphemeralStorage
ephemeralStorage) (\s :: CreateFunction
s@CreateFunction' {} Maybe EphemeralStorage
a -> CreateFunction
s {$sel:ephemeralStorage:CreateFunction' :: Maybe EphemeralStorage
ephemeralStorage = Maybe EphemeralStorage
a} :: CreateFunction)

-- | Connection settings for an Amazon EFS file system.
createFunction_fileSystemConfigs :: Lens.Lens' CreateFunction (Prelude.Maybe [FileSystemConfig])
createFunction_fileSystemConfigs :: Lens' CreateFunction (Maybe [FileSystemConfig])
createFunction_fileSystemConfigs = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateFunction' {Maybe [FileSystemConfig]
fileSystemConfigs :: Maybe [FileSystemConfig]
$sel:fileSystemConfigs:CreateFunction' :: CreateFunction -> Maybe [FileSystemConfig]
fileSystemConfigs} -> Maybe [FileSystemConfig]
fileSystemConfigs) (\s :: CreateFunction
s@CreateFunction' {} Maybe [FileSystemConfig]
a -> CreateFunction
s {$sel:fileSystemConfigs:CreateFunction' :: Maybe [FileSystemConfig]
fileSystemConfigs = Maybe [FileSystemConfig]
a} :: CreateFunction) 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

-- | The name of the method within your code that Lambda calls to run your
-- function. Handler is required if the deployment package is a .zip file
-- archive. The format includes the file name. It can also include
-- namespaces and other qualifiers, depending on the runtime. For more
-- information, see
-- <https://docs.aws.amazon.com/lambda/latest/dg/foundation-progmodel.html Lambda programming model>.
createFunction_handler :: Lens.Lens' CreateFunction (Prelude.Maybe Prelude.Text)
createFunction_handler :: Lens' CreateFunction (Maybe Text)
createFunction_handler = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateFunction' {Maybe Text
handler :: Maybe Text
$sel:handler:CreateFunction' :: CreateFunction -> Maybe Text
handler} -> Maybe Text
handler) (\s :: CreateFunction
s@CreateFunction' {} Maybe Text
a -> CreateFunction
s {$sel:handler:CreateFunction' :: Maybe Text
handler = Maybe Text
a} :: CreateFunction)

-- | Container image
-- <https://docs.aws.amazon.com/lambda/latest/dg/configuration-images.html#configuration-images-settings configuration values>
-- that override the values in the container image Dockerfile.
createFunction_imageConfig :: Lens.Lens' CreateFunction (Prelude.Maybe ImageConfig)
createFunction_imageConfig :: Lens' CreateFunction (Maybe ImageConfig)
createFunction_imageConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateFunction' {Maybe ImageConfig
imageConfig :: Maybe ImageConfig
$sel:imageConfig:CreateFunction' :: CreateFunction -> Maybe ImageConfig
imageConfig} -> Maybe ImageConfig
imageConfig) (\s :: CreateFunction
s@CreateFunction' {} Maybe ImageConfig
a -> CreateFunction
s {$sel:imageConfig:CreateFunction' :: Maybe ImageConfig
imageConfig = Maybe ImageConfig
a} :: CreateFunction)

-- | The ARN of the Key Management Service (KMS) key that\'s used to encrypt
-- your function\'s environment variables. If it\'s not provided, Lambda
-- uses a default service key.
createFunction_kmsKeyArn :: Lens.Lens' CreateFunction (Prelude.Maybe Prelude.Text)
createFunction_kmsKeyArn :: Lens' CreateFunction (Maybe Text)
createFunction_kmsKeyArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateFunction' {Maybe Text
kmsKeyArn :: Maybe Text
$sel:kmsKeyArn:CreateFunction' :: CreateFunction -> Maybe Text
kmsKeyArn} -> Maybe Text
kmsKeyArn) (\s :: CreateFunction
s@CreateFunction' {} Maybe Text
a -> CreateFunction
s {$sel:kmsKeyArn:CreateFunction' :: Maybe Text
kmsKeyArn = Maybe Text
a} :: CreateFunction)

-- | A list of
-- <https://docs.aws.amazon.com/lambda/latest/dg/configuration-layers.html function layers>
-- to add to the function\'s execution environment. Specify each layer by
-- its ARN, including the version.
createFunction_layers :: Lens.Lens' CreateFunction (Prelude.Maybe [Prelude.Text])
createFunction_layers :: Lens' CreateFunction (Maybe [Text])
createFunction_layers = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateFunction' {Maybe [Text]
layers :: Maybe [Text]
$sel:layers:CreateFunction' :: CreateFunction -> Maybe [Text]
layers} -> Maybe [Text]
layers) (\s :: CreateFunction
s@CreateFunction' {} Maybe [Text]
a -> CreateFunction
s {$sel:layers:CreateFunction' :: Maybe [Text]
layers = Maybe [Text]
a} :: CreateFunction) 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

-- | The amount of
-- <https://docs.aws.amazon.com/lambda/latest/dg/configuration-function-common.html#configuration-memory-console memory available to the function>
-- at runtime. Increasing the function memory also increases its CPU
-- allocation. The default value is 128 MB. The value can be any multiple
-- of 1 MB.
createFunction_memorySize :: Lens.Lens' CreateFunction (Prelude.Maybe Prelude.Natural)
createFunction_memorySize :: Lens' CreateFunction (Maybe Natural)
createFunction_memorySize = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateFunction' {Maybe Natural
memorySize :: Maybe Natural
$sel:memorySize:CreateFunction' :: CreateFunction -> Maybe Natural
memorySize} -> Maybe Natural
memorySize) (\s :: CreateFunction
s@CreateFunction' {} Maybe Natural
a -> CreateFunction
s {$sel:memorySize:CreateFunction' :: Maybe Natural
memorySize = Maybe Natural
a} :: CreateFunction)

-- | The type of deployment package. Set to @Image@ for container image and
-- set to @Zip@ for .zip file archive.
createFunction_packageType :: Lens.Lens' CreateFunction (Prelude.Maybe PackageType)
createFunction_packageType :: Lens' CreateFunction (Maybe PackageType)
createFunction_packageType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateFunction' {Maybe PackageType
packageType :: Maybe PackageType
$sel:packageType:CreateFunction' :: CreateFunction -> Maybe PackageType
packageType} -> Maybe PackageType
packageType) (\s :: CreateFunction
s@CreateFunction' {} Maybe PackageType
a -> CreateFunction
s {$sel:packageType:CreateFunction' :: Maybe PackageType
packageType = Maybe PackageType
a} :: CreateFunction)

-- | Set to true to publish the first version of the function during
-- creation.
createFunction_publish :: Lens.Lens' CreateFunction (Prelude.Maybe Prelude.Bool)
createFunction_publish :: Lens' CreateFunction (Maybe Bool)
createFunction_publish = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateFunction' {Maybe Bool
publish :: Maybe Bool
$sel:publish:CreateFunction' :: CreateFunction -> Maybe Bool
publish} -> Maybe Bool
publish) (\s :: CreateFunction
s@CreateFunction' {} Maybe Bool
a -> CreateFunction
s {$sel:publish:CreateFunction' :: Maybe Bool
publish = Maybe Bool
a} :: CreateFunction)

-- | The identifier of the function\'s
-- <https://docs.aws.amazon.com/lambda/latest/dg/lambda-runtimes.html runtime>.
-- Runtime is required if the deployment package is a .zip file archive.
createFunction_runtime :: Lens.Lens' CreateFunction (Prelude.Maybe Runtime)
createFunction_runtime :: Lens' CreateFunction (Maybe Runtime)
createFunction_runtime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateFunction' {Maybe Runtime
runtime :: Maybe Runtime
$sel:runtime:CreateFunction' :: CreateFunction -> Maybe Runtime
runtime} -> Maybe Runtime
runtime) (\s :: CreateFunction
s@CreateFunction' {} Maybe Runtime
a -> CreateFunction
s {$sel:runtime:CreateFunction' :: Maybe Runtime
runtime = Maybe Runtime
a} :: CreateFunction)

-- | The function\'s
-- <https://docs.aws.amazon.com/lambda/latest/dg/snapstart.html SnapStart>
-- setting.
createFunction_snapStart :: Lens.Lens' CreateFunction (Prelude.Maybe SnapStart)
createFunction_snapStart :: Lens' CreateFunction (Maybe SnapStart)
createFunction_snapStart = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateFunction' {Maybe SnapStart
snapStart :: Maybe SnapStart
$sel:snapStart:CreateFunction' :: CreateFunction -> Maybe SnapStart
snapStart} -> Maybe SnapStart
snapStart) (\s :: CreateFunction
s@CreateFunction' {} Maybe SnapStart
a -> CreateFunction
s {$sel:snapStart:CreateFunction' :: Maybe SnapStart
snapStart = Maybe SnapStart
a} :: CreateFunction)

-- | A list of
-- <https://docs.aws.amazon.com/lambda/latest/dg/tagging.html tags> to
-- apply to the function.
createFunction_tags :: Lens.Lens' CreateFunction (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
createFunction_tags :: Lens' CreateFunction (Maybe (HashMap Text Text))
createFunction_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateFunction' {Maybe (HashMap Text Text)
tags :: Maybe (HashMap Text Text)
$sel:tags:CreateFunction' :: CreateFunction -> Maybe (HashMap Text Text)
tags} -> Maybe (HashMap Text Text)
tags) (\s :: CreateFunction
s@CreateFunction' {} Maybe (HashMap Text Text)
a -> CreateFunction
s {$sel:tags:CreateFunction' :: Maybe (HashMap Text Text)
tags = Maybe (HashMap Text Text)
a} :: CreateFunction) 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

-- | The amount of time (in seconds) that Lambda allows a function to run
-- before stopping it. The default is 3 seconds. The maximum allowed value
-- is 900 seconds. For more information, see
-- <https://docs.aws.amazon.com/lambda/latest/dg/runtimes-context.html Lambda execution environment>.
createFunction_timeout :: Lens.Lens' CreateFunction (Prelude.Maybe Prelude.Natural)
createFunction_timeout :: Lens' CreateFunction (Maybe Natural)
createFunction_timeout = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateFunction' {Maybe Natural
timeout :: Maybe Natural
$sel:timeout:CreateFunction' :: CreateFunction -> Maybe Natural
timeout} -> Maybe Natural
timeout) (\s :: CreateFunction
s@CreateFunction' {} Maybe Natural
a -> CreateFunction
s {$sel:timeout:CreateFunction' :: Maybe Natural
timeout = Maybe Natural
a} :: CreateFunction)

-- | Set @Mode@ to @Active@ to sample and trace a subset of incoming requests
-- with
-- <https://docs.aws.amazon.com/lambda/latest/dg/services-xray.html X-Ray>.
createFunction_tracingConfig :: Lens.Lens' CreateFunction (Prelude.Maybe TracingConfig)
createFunction_tracingConfig :: Lens' CreateFunction (Maybe TracingConfig)
createFunction_tracingConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateFunction' {Maybe TracingConfig
tracingConfig :: Maybe TracingConfig
$sel:tracingConfig:CreateFunction' :: CreateFunction -> Maybe TracingConfig
tracingConfig} -> Maybe TracingConfig
tracingConfig) (\s :: CreateFunction
s@CreateFunction' {} Maybe TracingConfig
a -> CreateFunction
s {$sel:tracingConfig:CreateFunction' :: Maybe TracingConfig
tracingConfig = Maybe TracingConfig
a} :: CreateFunction)

-- | For network connectivity to Amazon Web Services resources in a VPC,
-- specify a list of security groups and subnets in the VPC. When you
-- connect a function to a VPC, it can access resources and the internet
-- only through that VPC. For more information, see
-- <https://docs.aws.amazon.com/lambda/latest/dg/configuration-vpc.html Configuring a Lambda function to access resources in a VPC>.
createFunction_vpcConfig :: Lens.Lens' CreateFunction (Prelude.Maybe VpcConfig)
createFunction_vpcConfig :: Lens' CreateFunction (Maybe VpcConfig)
createFunction_vpcConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateFunction' {Maybe VpcConfig
vpcConfig :: Maybe VpcConfig
$sel:vpcConfig:CreateFunction' :: CreateFunction -> Maybe VpcConfig
vpcConfig} -> Maybe VpcConfig
vpcConfig) (\s :: CreateFunction
s@CreateFunction' {} Maybe VpcConfig
a -> CreateFunction
s {$sel:vpcConfig:CreateFunction' :: Maybe VpcConfig
vpcConfig = Maybe VpcConfig
a} :: CreateFunction)

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

-- | The Amazon Resource Name (ARN) of the function\'s execution role.
createFunction_role :: Lens.Lens' CreateFunction Prelude.Text
createFunction_role :: Lens' CreateFunction Text
createFunction_role = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateFunction' {Text
role' :: Text
$sel:role':CreateFunction' :: CreateFunction -> Text
role'} -> Text
role') (\s :: CreateFunction
s@CreateFunction' {} Text
a -> CreateFunction
s {$sel:role':CreateFunction' :: Text
role' = Text
a} :: CreateFunction)

-- | The code for the function.
createFunction_code :: Lens.Lens' CreateFunction FunctionCode
createFunction_code :: Lens' CreateFunction FunctionCode
createFunction_code = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateFunction' {FunctionCode
code :: FunctionCode
$sel:code:CreateFunction' :: CreateFunction -> FunctionCode
code} -> FunctionCode
code) (\s :: CreateFunction
s@CreateFunction' {} FunctionCode
a -> CreateFunction
s {$sel:code:CreateFunction' :: FunctionCode
code = FunctionCode
a} :: CreateFunction)

instance Core.AWSRequest CreateFunction where
  type
    AWSResponse CreateFunction =
      FunctionConfiguration
  request :: (Service -> Service) -> CreateFunction -> Request CreateFunction
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 CreateFunction
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CreateFunction)))
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 CreateFunction where
  hashWithSalt :: Int -> CreateFunction -> Int
hashWithSalt Int
_salt CreateFunction' {Maybe Bool
Maybe Natural
Maybe [Text]
Maybe [FileSystemConfig]
Maybe (NonEmpty Architecture)
Maybe Text
Maybe (HashMap Text Text)
Maybe DeadLetterConfig
Maybe Environment
Maybe EphemeralStorage
Maybe ImageConfig
Maybe PackageType
Maybe Runtime
Maybe SnapStart
Maybe TracingConfig
Maybe VpcConfig
Text
FunctionCode
code :: FunctionCode
role' :: Text
functionName :: Text
vpcConfig :: Maybe VpcConfig
tracingConfig :: Maybe TracingConfig
timeout :: Maybe Natural
tags :: Maybe (HashMap Text Text)
snapStart :: Maybe SnapStart
runtime :: Maybe Runtime
publish :: Maybe Bool
packageType :: Maybe PackageType
memorySize :: Maybe Natural
layers :: Maybe [Text]
kmsKeyArn :: Maybe Text
imageConfig :: Maybe ImageConfig
handler :: Maybe Text
fileSystemConfigs :: Maybe [FileSystemConfig]
ephemeralStorage :: Maybe EphemeralStorage
environment :: Maybe Environment
description :: Maybe Text
deadLetterConfig :: Maybe DeadLetterConfig
codeSigningConfigArn :: Maybe Text
architectures :: Maybe (NonEmpty Architecture)
$sel:code:CreateFunction' :: CreateFunction -> FunctionCode
$sel:role':CreateFunction' :: CreateFunction -> Text
$sel:functionName:CreateFunction' :: CreateFunction -> Text
$sel:vpcConfig:CreateFunction' :: CreateFunction -> Maybe VpcConfig
$sel:tracingConfig:CreateFunction' :: CreateFunction -> Maybe TracingConfig
$sel:timeout:CreateFunction' :: CreateFunction -> Maybe Natural
$sel:tags:CreateFunction' :: CreateFunction -> Maybe (HashMap Text Text)
$sel:snapStart:CreateFunction' :: CreateFunction -> Maybe SnapStart
$sel:runtime:CreateFunction' :: CreateFunction -> Maybe Runtime
$sel:publish:CreateFunction' :: CreateFunction -> Maybe Bool
$sel:packageType:CreateFunction' :: CreateFunction -> Maybe PackageType
$sel:memorySize:CreateFunction' :: CreateFunction -> Maybe Natural
$sel:layers:CreateFunction' :: CreateFunction -> Maybe [Text]
$sel:kmsKeyArn:CreateFunction' :: CreateFunction -> Maybe Text
$sel:imageConfig:CreateFunction' :: CreateFunction -> Maybe ImageConfig
$sel:handler:CreateFunction' :: CreateFunction -> Maybe Text
$sel:fileSystemConfigs:CreateFunction' :: CreateFunction -> Maybe [FileSystemConfig]
$sel:ephemeralStorage:CreateFunction' :: CreateFunction -> Maybe EphemeralStorage
$sel:environment:CreateFunction' :: CreateFunction -> Maybe Environment
$sel:description:CreateFunction' :: CreateFunction -> Maybe Text
$sel:deadLetterConfig:CreateFunction' :: CreateFunction -> Maybe DeadLetterConfig
$sel:codeSigningConfigArn:CreateFunction' :: CreateFunction -> Maybe Text
$sel:architectures:CreateFunction' :: CreateFunction -> Maybe (NonEmpty Architecture)
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (NonEmpty Architecture)
architectures
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
codeSigningConfigArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe DeadLetterConfig
deadLetterConfig
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Environment
environment
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe EphemeralStorage
ephemeralStorage
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [FileSystemConfig]
fileSystemConfigs
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
handler
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ImageConfig
imageConfig
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
kmsKeyArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
layers
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
memorySize
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe PackageType
packageType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
publish
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Runtime
runtime
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe SnapStart
snapStart
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Text)
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
timeout
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe TracingConfig
tracingConfig
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe VpcConfig
vpcConfig
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
functionName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
role'
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` FunctionCode
code

instance Prelude.NFData CreateFunction where
  rnf :: CreateFunction -> ()
rnf CreateFunction' {Maybe Bool
Maybe Natural
Maybe [Text]
Maybe [FileSystemConfig]
Maybe (NonEmpty Architecture)
Maybe Text
Maybe (HashMap Text Text)
Maybe DeadLetterConfig
Maybe Environment
Maybe EphemeralStorage
Maybe ImageConfig
Maybe PackageType
Maybe Runtime
Maybe SnapStart
Maybe TracingConfig
Maybe VpcConfig
Text
FunctionCode
code :: FunctionCode
role' :: Text
functionName :: Text
vpcConfig :: Maybe VpcConfig
tracingConfig :: Maybe TracingConfig
timeout :: Maybe Natural
tags :: Maybe (HashMap Text Text)
snapStart :: Maybe SnapStart
runtime :: Maybe Runtime
publish :: Maybe Bool
packageType :: Maybe PackageType
memorySize :: Maybe Natural
layers :: Maybe [Text]
kmsKeyArn :: Maybe Text
imageConfig :: Maybe ImageConfig
handler :: Maybe Text
fileSystemConfigs :: Maybe [FileSystemConfig]
ephemeralStorage :: Maybe EphemeralStorage
environment :: Maybe Environment
description :: Maybe Text
deadLetterConfig :: Maybe DeadLetterConfig
codeSigningConfigArn :: Maybe Text
architectures :: Maybe (NonEmpty Architecture)
$sel:code:CreateFunction' :: CreateFunction -> FunctionCode
$sel:role':CreateFunction' :: CreateFunction -> Text
$sel:functionName:CreateFunction' :: CreateFunction -> Text
$sel:vpcConfig:CreateFunction' :: CreateFunction -> Maybe VpcConfig
$sel:tracingConfig:CreateFunction' :: CreateFunction -> Maybe TracingConfig
$sel:timeout:CreateFunction' :: CreateFunction -> Maybe Natural
$sel:tags:CreateFunction' :: CreateFunction -> Maybe (HashMap Text Text)
$sel:snapStart:CreateFunction' :: CreateFunction -> Maybe SnapStart
$sel:runtime:CreateFunction' :: CreateFunction -> Maybe Runtime
$sel:publish:CreateFunction' :: CreateFunction -> Maybe Bool
$sel:packageType:CreateFunction' :: CreateFunction -> Maybe PackageType
$sel:memorySize:CreateFunction' :: CreateFunction -> Maybe Natural
$sel:layers:CreateFunction' :: CreateFunction -> Maybe [Text]
$sel:kmsKeyArn:CreateFunction' :: CreateFunction -> Maybe Text
$sel:imageConfig:CreateFunction' :: CreateFunction -> Maybe ImageConfig
$sel:handler:CreateFunction' :: CreateFunction -> Maybe Text
$sel:fileSystemConfigs:CreateFunction' :: CreateFunction -> Maybe [FileSystemConfig]
$sel:ephemeralStorage:CreateFunction' :: CreateFunction -> Maybe EphemeralStorage
$sel:environment:CreateFunction' :: CreateFunction -> Maybe Environment
$sel:description:CreateFunction' :: CreateFunction -> Maybe Text
$sel:deadLetterConfig:CreateFunction' :: CreateFunction -> Maybe DeadLetterConfig
$sel:codeSigningConfigArn:CreateFunction' :: CreateFunction -> Maybe Text
$sel:architectures:CreateFunction' :: CreateFunction -> Maybe (NonEmpty Architecture)
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe (NonEmpty Architecture)
architectures
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
codeSigningConfigArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe DeadLetterConfig
deadLetterConfig
      seq :: forall a b. a -> b -> b
`Prelude.seq` 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 Environment
environment
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe EphemeralStorage
ephemeralStorage
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [FileSystemConfig]
fileSystemConfigs
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
handler
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ImageConfig
imageConfig
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
kmsKeyArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
layers
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
memorySize
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe PackageType
packageType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
publish
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Runtime
runtime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe SnapStart
snapStart
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text Text)
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
timeout
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe TracingConfig
tracingConfig
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe VpcConfig
vpcConfig
      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
role'
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf FunctionCode
code

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

instance Data.ToJSON CreateFunction where
  toJSON :: CreateFunction -> Value
toJSON CreateFunction' {Maybe Bool
Maybe Natural
Maybe [Text]
Maybe [FileSystemConfig]
Maybe (NonEmpty Architecture)
Maybe Text
Maybe (HashMap Text Text)
Maybe DeadLetterConfig
Maybe Environment
Maybe EphemeralStorage
Maybe ImageConfig
Maybe PackageType
Maybe Runtime
Maybe SnapStart
Maybe TracingConfig
Maybe VpcConfig
Text
FunctionCode
code :: FunctionCode
role' :: Text
functionName :: Text
vpcConfig :: Maybe VpcConfig
tracingConfig :: Maybe TracingConfig
timeout :: Maybe Natural
tags :: Maybe (HashMap Text Text)
snapStart :: Maybe SnapStart
runtime :: Maybe Runtime
publish :: Maybe Bool
packageType :: Maybe PackageType
memorySize :: Maybe Natural
layers :: Maybe [Text]
kmsKeyArn :: Maybe Text
imageConfig :: Maybe ImageConfig
handler :: Maybe Text
fileSystemConfigs :: Maybe [FileSystemConfig]
ephemeralStorage :: Maybe EphemeralStorage
environment :: Maybe Environment
description :: Maybe Text
deadLetterConfig :: Maybe DeadLetterConfig
codeSigningConfigArn :: Maybe Text
architectures :: Maybe (NonEmpty Architecture)
$sel:code:CreateFunction' :: CreateFunction -> FunctionCode
$sel:role':CreateFunction' :: CreateFunction -> Text
$sel:functionName:CreateFunction' :: CreateFunction -> Text
$sel:vpcConfig:CreateFunction' :: CreateFunction -> Maybe VpcConfig
$sel:tracingConfig:CreateFunction' :: CreateFunction -> Maybe TracingConfig
$sel:timeout:CreateFunction' :: CreateFunction -> Maybe Natural
$sel:tags:CreateFunction' :: CreateFunction -> Maybe (HashMap Text Text)
$sel:snapStart:CreateFunction' :: CreateFunction -> Maybe SnapStart
$sel:runtime:CreateFunction' :: CreateFunction -> Maybe Runtime
$sel:publish:CreateFunction' :: CreateFunction -> Maybe Bool
$sel:packageType:CreateFunction' :: CreateFunction -> Maybe PackageType
$sel:memorySize:CreateFunction' :: CreateFunction -> Maybe Natural
$sel:layers:CreateFunction' :: CreateFunction -> Maybe [Text]
$sel:kmsKeyArn:CreateFunction' :: CreateFunction -> Maybe Text
$sel:imageConfig:CreateFunction' :: CreateFunction -> Maybe ImageConfig
$sel:handler:CreateFunction' :: CreateFunction -> Maybe Text
$sel:fileSystemConfigs:CreateFunction' :: CreateFunction -> Maybe [FileSystemConfig]
$sel:ephemeralStorage:CreateFunction' :: CreateFunction -> Maybe EphemeralStorage
$sel:environment:CreateFunction' :: CreateFunction -> Maybe Environment
$sel:description:CreateFunction' :: CreateFunction -> Maybe Text
$sel:deadLetterConfig:CreateFunction' :: CreateFunction -> Maybe DeadLetterConfig
$sel:codeSigningConfigArn:CreateFunction' :: CreateFunction -> Maybe Text
$sel:architectures:CreateFunction' :: CreateFunction -> Maybe (NonEmpty Architecture)
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"Architectures" 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 (NonEmpty Architecture)
architectures,
            (Key
"CodeSigningConfigArn" 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
codeSigningConfigArn,
            (Key
"DeadLetterConfig" 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 DeadLetterConfig
deadLetterConfig,
            (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
"Environment" 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 Environment
environment,
            (Key
"EphemeralStorage" 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 EphemeralStorage
ephemeralStorage,
            (Key
"FileSystemConfigs" 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 [FileSystemConfig]
fileSystemConfigs,
            (Key
"Handler" 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
handler,
            (Key
"ImageConfig" 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 ImageConfig
imageConfig,
            (Key
"KMSKeyArn" 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
kmsKeyArn,
            (Key
"Layers" 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]
layers,
            (Key
"MemorySize" 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 Natural
memorySize,
            (Key
"PackageType" 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 PackageType
packageType,
            (Key
"Publish" 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 Bool
publish,
            (Key
"Runtime" 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 Runtime
runtime,
            (Key
"SnapStart" 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 SnapStart
snapStart,
            (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 (HashMap Text Text)
tags,
            (Key
"Timeout" 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 Natural
timeout,
            (Key
"TracingConfig" 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 TracingConfig
tracingConfig,
            (Key
"VpcConfig" 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 VpcConfig
vpcConfig,
            forall a. a -> Maybe a
Prelude.Just (Key
"FunctionName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
functionName),
            forall a. a -> Maybe a
Prelude.Just (Key
"Role" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
role'),
            forall a. a -> Maybe a
Prelude.Just (Key
"Code" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= FunctionCode
code)
          ]
      )

instance Data.ToPath CreateFunction where
  toPath :: CreateFunction -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/2015-03-31/functions"

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