{-# 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.UpdateFunctionCode
-- 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 a Lambda function\'s code. If code signing is enabled for the
-- function, the code package must be signed by a trusted publisher. For
-- more information, see
-- <https://docs.aws.amazon.com/lambda/latest/dg/configuration-codesigning.html Configuring code signing for Lambda>.
--
-- If the function\'s package type is @Image@, then you must specify the
-- code package in @ImageUri@ as the URI of a
-- <https://docs.aws.amazon.com/lambda/latest/dg/lambda-images.html container image>
-- in the Amazon ECR registry.
--
-- If the function\'s package type is @Zip@, then you must specify the
-- deployment package as a
-- <https://docs.aws.amazon.com/lambda/latest/dg/gettingstarted-package.html#gettingstarted-package-zip .zip file archive>.
-- Enter the Amazon S3 bucket and key of the code .zip file location. You
-- can also provide the function code inline using the @ZipFile@ field.
--
-- The code in the deployment package must be compatible with the target
-- instruction set architecture of the function (@x86-64@ or @arm64@).
--
-- The function\'s code is locked when you publish a version. You can\'t
-- modify the code of a published version, only the unpublished version.
--
-- For a function defined as a container image, Lambda resolves the image
-- tag to an image digest. In Amazon ECR, if you update the image tag to a
-- new image, Lambda does not automatically update the function.
module Amazonka.Lambda.UpdateFunctionCode
  ( -- * Creating a Request
    UpdateFunctionCode (..),
    newUpdateFunctionCode,

    -- * Request Lenses
    updateFunctionCode_architectures,
    updateFunctionCode_dryRun,
    updateFunctionCode_imageUri,
    updateFunctionCode_publish,
    updateFunctionCode_revisionId,
    updateFunctionCode_s3Bucket,
    updateFunctionCode_s3Key,
    updateFunctionCode_s3ObjectVersion,
    updateFunctionCode_zipFile,
    updateFunctionCode_functionName,

    -- * 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:/ 'newUpdateFunctionCode' smart constructor.
data UpdateFunctionCode = UpdateFunctionCode'
  { -- | 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@.
    UpdateFunctionCode -> Maybe (NonEmpty Architecture)
architectures :: Prelude.Maybe (Prelude.NonEmpty Architecture),
    -- | Set to true to validate the request parameters and access permissions
    -- without modifying the function code.
    UpdateFunctionCode -> Maybe Bool
dryRun :: Prelude.Maybe Prelude.Bool,
    -- | URI of a container image in the Amazon ECR registry. Do not use for a
    -- function defined with a .zip file archive.
    UpdateFunctionCode -> Maybe Text
imageUri :: Prelude.Maybe Prelude.Text,
    -- | Set to true to publish a new version of the function after updating the
    -- code. This has the same effect as calling PublishVersion separately.
    UpdateFunctionCode -> Maybe Bool
publish :: Prelude.Maybe Prelude.Bool,
    -- | Update the function only if the revision ID matches the ID that\'s
    -- specified. Use this option to avoid modifying a function that has
    -- changed since you last read it.
    UpdateFunctionCode -> Maybe Text
revisionId :: Prelude.Maybe Prelude.Text,
    -- | An Amazon S3 bucket in the same Amazon Web Services Region as your
    -- function. The bucket can be in a different Amazon Web Services account.
    -- Use only with a function defined with a .zip file archive deployment
    -- package.
    UpdateFunctionCode -> Maybe Text
s3Bucket :: Prelude.Maybe Prelude.Text,
    -- | The Amazon S3 key of the deployment package. Use only with a function
    -- defined with a .zip file archive deployment package.
    UpdateFunctionCode -> Maybe Text
s3Key :: Prelude.Maybe Prelude.Text,
    -- | For versioned objects, the version of the deployment package object to
    -- use.
    UpdateFunctionCode -> Maybe Text
s3ObjectVersion :: Prelude.Maybe Prelude.Text,
    -- | The base64-encoded contents of the deployment package. Amazon Web
    -- Services SDK and CLI clients handle the encoding for you. Use only with
    -- a function defined with a .zip file archive deployment package.
    UpdateFunctionCode -> Maybe (Sensitive Base64)
zipFile :: Prelude.Maybe (Data.Sensitive Data.Base64),
    -- | 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.
    UpdateFunctionCode -> Text
functionName :: Prelude.Text
  }
  deriving (UpdateFunctionCode -> UpdateFunctionCode -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateFunctionCode -> UpdateFunctionCode -> Bool
$c/= :: UpdateFunctionCode -> UpdateFunctionCode -> Bool
== :: UpdateFunctionCode -> UpdateFunctionCode -> Bool
$c== :: UpdateFunctionCode -> UpdateFunctionCode -> Bool
Prelude.Eq, Int -> UpdateFunctionCode -> ShowS
[UpdateFunctionCode] -> ShowS
UpdateFunctionCode -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateFunctionCode] -> ShowS
$cshowList :: [UpdateFunctionCode] -> ShowS
show :: UpdateFunctionCode -> String
$cshow :: UpdateFunctionCode -> String
showsPrec :: Int -> UpdateFunctionCode -> ShowS
$cshowsPrec :: Int -> UpdateFunctionCode -> ShowS
Prelude.Show, forall x. Rep UpdateFunctionCode x -> UpdateFunctionCode
forall x. UpdateFunctionCode -> Rep UpdateFunctionCode x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateFunctionCode x -> UpdateFunctionCode
$cfrom :: forall x. UpdateFunctionCode -> Rep UpdateFunctionCode x
Prelude.Generic)

-- |
-- Create a value of 'UpdateFunctionCode' 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', 'updateFunctionCode_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@.
--
-- 'dryRun', 'updateFunctionCode_dryRun' - Set to true to validate the request parameters and access permissions
-- without modifying the function code.
--
-- 'imageUri', 'updateFunctionCode_imageUri' - URI of a container image in the Amazon ECR registry. Do not use for a
-- function defined with a .zip file archive.
--
-- 'publish', 'updateFunctionCode_publish' - Set to true to publish a new version of the function after updating the
-- code. This has the same effect as calling PublishVersion separately.
--
-- 'revisionId', 'updateFunctionCode_revisionId' - Update the function only if the revision ID matches the ID that\'s
-- specified. Use this option to avoid modifying a function that has
-- changed since you last read it.
--
-- 's3Bucket', 'updateFunctionCode_s3Bucket' - An Amazon S3 bucket in the same Amazon Web Services Region as your
-- function. The bucket can be in a different Amazon Web Services account.
-- Use only with a function defined with a .zip file archive deployment
-- package.
--
-- 's3Key', 'updateFunctionCode_s3Key' - The Amazon S3 key of the deployment package. Use only with a function
-- defined with a .zip file archive deployment package.
--
-- 's3ObjectVersion', 'updateFunctionCode_s3ObjectVersion' - For versioned objects, the version of the deployment package object to
-- use.
--
-- 'zipFile', 'updateFunctionCode_zipFile' - The base64-encoded contents of the deployment package. Amazon Web
-- Services SDK and CLI clients handle the encoding for you. Use only with
-- a function defined with a .zip file archive deployment package.--
-- -- /Note:/ This 'Lens' automatically encodes and decodes Base64 data.
-- -- The underlying isomorphism will encode to Base64 representation during
-- -- serialisation, and decode from Base64 representation during deserialisation.
-- -- This 'Lens' accepts and returns only raw unencoded data.
--
-- 'functionName', 'updateFunctionCode_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.
newUpdateFunctionCode ::
  -- | 'functionName'
  Prelude.Text ->
  UpdateFunctionCode
newUpdateFunctionCode :: Text -> UpdateFunctionCode
newUpdateFunctionCode Text
pFunctionName_ =
  UpdateFunctionCode'
    { $sel:architectures:UpdateFunctionCode' :: Maybe (NonEmpty Architecture)
architectures =
        forall a. Maybe a
Prelude.Nothing,
      $sel:dryRun:UpdateFunctionCode' :: Maybe Bool
dryRun = forall a. Maybe a
Prelude.Nothing,
      $sel:imageUri:UpdateFunctionCode' :: Maybe Text
imageUri = forall a. Maybe a
Prelude.Nothing,
      $sel:publish:UpdateFunctionCode' :: Maybe Bool
publish = forall a. Maybe a
Prelude.Nothing,
      $sel:revisionId:UpdateFunctionCode' :: Maybe Text
revisionId = forall a. Maybe a
Prelude.Nothing,
      $sel:s3Bucket:UpdateFunctionCode' :: Maybe Text
s3Bucket = forall a. Maybe a
Prelude.Nothing,
      $sel:s3Key:UpdateFunctionCode' :: Maybe Text
s3Key = forall a. Maybe a
Prelude.Nothing,
      $sel:s3ObjectVersion:UpdateFunctionCode' :: Maybe Text
s3ObjectVersion = forall a. Maybe a
Prelude.Nothing,
      $sel:zipFile:UpdateFunctionCode' :: Maybe (Sensitive Base64)
zipFile = forall a. Maybe a
Prelude.Nothing,
      $sel:functionName:UpdateFunctionCode' :: Text
functionName = Text
pFunctionName_
    }

-- | 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@.
updateFunctionCode_architectures :: Lens.Lens' UpdateFunctionCode (Prelude.Maybe (Prelude.NonEmpty Architecture))
updateFunctionCode_architectures :: Lens' UpdateFunctionCode (Maybe (NonEmpty Architecture))
updateFunctionCode_architectures = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateFunctionCode' {Maybe (NonEmpty Architecture)
architectures :: Maybe (NonEmpty Architecture)
$sel:architectures:UpdateFunctionCode' :: UpdateFunctionCode -> Maybe (NonEmpty Architecture)
architectures} -> Maybe (NonEmpty Architecture)
architectures) (\s :: UpdateFunctionCode
s@UpdateFunctionCode' {} Maybe (NonEmpty Architecture)
a -> UpdateFunctionCode
s {$sel:architectures:UpdateFunctionCode' :: Maybe (NonEmpty Architecture)
architectures = Maybe (NonEmpty Architecture)
a} :: UpdateFunctionCode) 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

-- | Set to true to validate the request parameters and access permissions
-- without modifying the function code.
updateFunctionCode_dryRun :: Lens.Lens' UpdateFunctionCode (Prelude.Maybe Prelude.Bool)
updateFunctionCode_dryRun :: Lens' UpdateFunctionCode (Maybe Bool)
updateFunctionCode_dryRun = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateFunctionCode' {Maybe Bool
dryRun :: Maybe Bool
$sel:dryRun:UpdateFunctionCode' :: UpdateFunctionCode -> Maybe Bool
dryRun} -> Maybe Bool
dryRun) (\s :: UpdateFunctionCode
s@UpdateFunctionCode' {} Maybe Bool
a -> UpdateFunctionCode
s {$sel:dryRun:UpdateFunctionCode' :: Maybe Bool
dryRun = Maybe Bool
a} :: UpdateFunctionCode)

-- | URI of a container image in the Amazon ECR registry. Do not use for a
-- function defined with a .zip file archive.
updateFunctionCode_imageUri :: Lens.Lens' UpdateFunctionCode (Prelude.Maybe Prelude.Text)
updateFunctionCode_imageUri :: Lens' UpdateFunctionCode (Maybe Text)
updateFunctionCode_imageUri = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateFunctionCode' {Maybe Text
imageUri :: Maybe Text
$sel:imageUri:UpdateFunctionCode' :: UpdateFunctionCode -> Maybe Text
imageUri} -> Maybe Text
imageUri) (\s :: UpdateFunctionCode
s@UpdateFunctionCode' {} Maybe Text
a -> UpdateFunctionCode
s {$sel:imageUri:UpdateFunctionCode' :: Maybe Text
imageUri = Maybe Text
a} :: UpdateFunctionCode)

-- | Set to true to publish a new version of the function after updating the
-- code. This has the same effect as calling PublishVersion separately.
updateFunctionCode_publish :: Lens.Lens' UpdateFunctionCode (Prelude.Maybe Prelude.Bool)
updateFunctionCode_publish :: Lens' UpdateFunctionCode (Maybe Bool)
updateFunctionCode_publish = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateFunctionCode' {Maybe Bool
publish :: Maybe Bool
$sel:publish:UpdateFunctionCode' :: UpdateFunctionCode -> Maybe Bool
publish} -> Maybe Bool
publish) (\s :: UpdateFunctionCode
s@UpdateFunctionCode' {} Maybe Bool
a -> UpdateFunctionCode
s {$sel:publish:UpdateFunctionCode' :: Maybe Bool
publish = Maybe Bool
a} :: UpdateFunctionCode)

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

-- | An Amazon S3 bucket in the same Amazon Web Services Region as your
-- function. The bucket can be in a different Amazon Web Services account.
-- Use only with a function defined with a .zip file archive deployment
-- package.
updateFunctionCode_s3Bucket :: Lens.Lens' UpdateFunctionCode (Prelude.Maybe Prelude.Text)
updateFunctionCode_s3Bucket :: Lens' UpdateFunctionCode (Maybe Text)
updateFunctionCode_s3Bucket = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateFunctionCode' {Maybe Text
s3Bucket :: Maybe Text
$sel:s3Bucket:UpdateFunctionCode' :: UpdateFunctionCode -> Maybe Text
s3Bucket} -> Maybe Text
s3Bucket) (\s :: UpdateFunctionCode
s@UpdateFunctionCode' {} Maybe Text
a -> UpdateFunctionCode
s {$sel:s3Bucket:UpdateFunctionCode' :: Maybe Text
s3Bucket = Maybe Text
a} :: UpdateFunctionCode)

-- | The Amazon S3 key of the deployment package. Use only with a function
-- defined with a .zip file archive deployment package.
updateFunctionCode_s3Key :: Lens.Lens' UpdateFunctionCode (Prelude.Maybe Prelude.Text)
updateFunctionCode_s3Key :: Lens' UpdateFunctionCode (Maybe Text)
updateFunctionCode_s3Key = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateFunctionCode' {Maybe Text
s3Key :: Maybe Text
$sel:s3Key:UpdateFunctionCode' :: UpdateFunctionCode -> Maybe Text
s3Key} -> Maybe Text
s3Key) (\s :: UpdateFunctionCode
s@UpdateFunctionCode' {} Maybe Text
a -> UpdateFunctionCode
s {$sel:s3Key:UpdateFunctionCode' :: Maybe Text
s3Key = Maybe Text
a} :: UpdateFunctionCode)

-- | For versioned objects, the version of the deployment package object to
-- use.
updateFunctionCode_s3ObjectVersion :: Lens.Lens' UpdateFunctionCode (Prelude.Maybe Prelude.Text)
updateFunctionCode_s3ObjectVersion :: Lens' UpdateFunctionCode (Maybe Text)
updateFunctionCode_s3ObjectVersion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateFunctionCode' {Maybe Text
s3ObjectVersion :: Maybe Text
$sel:s3ObjectVersion:UpdateFunctionCode' :: UpdateFunctionCode -> Maybe Text
s3ObjectVersion} -> Maybe Text
s3ObjectVersion) (\s :: UpdateFunctionCode
s@UpdateFunctionCode' {} Maybe Text
a -> UpdateFunctionCode
s {$sel:s3ObjectVersion:UpdateFunctionCode' :: Maybe Text
s3ObjectVersion = Maybe Text
a} :: UpdateFunctionCode)

-- | The base64-encoded contents of the deployment package. Amazon Web
-- Services SDK and CLI clients handle the encoding for you. Use only with
-- a function defined with a .zip file archive deployment package.--
-- -- /Note:/ This 'Lens' automatically encodes and decodes Base64 data.
-- -- The underlying isomorphism will encode to Base64 representation during
-- -- serialisation, and decode from Base64 representation during deserialisation.
-- -- This 'Lens' accepts and returns only raw unencoded data.
updateFunctionCode_zipFile :: Lens.Lens' UpdateFunctionCode (Prelude.Maybe Prelude.ByteString)
updateFunctionCode_zipFile :: Lens' UpdateFunctionCode (Maybe ByteString)
updateFunctionCode_zipFile = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateFunctionCode' {Maybe (Sensitive Base64)
zipFile :: Maybe (Sensitive Base64)
$sel:zipFile:UpdateFunctionCode' :: UpdateFunctionCode -> Maybe (Sensitive Base64)
zipFile} -> Maybe (Sensitive Base64)
zipFile) (\s :: UpdateFunctionCode
s@UpdateFunctionCode' {} Maybe (Sensitive Base64)
a -> UpdateFunctionCode
s {$sel:zipFile:UpdateFunctionCode' :: Maybe (Sensitive Base64)
zipFile = Maybe (Sensitive Base64)
a} :: UpdateFunctionCode) 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 a. Iso' (Sensitive a) a
Data._Sensitive forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. Iso' Base64 ByteString
Data._Base64)

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

instance Core.AWSRequest UpdateFunctionCode where
  type
    AWSResponse UpdateFunctionCode =
      FunctionConfiguration
  request :: (Service -> Service)
-> UpdateFunctionCode -> Request UpdateFunctionCode
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 UpdateFunctionCode
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse UpdateFunctionCode)))
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 UpdateFunctionCode where
  hashWithSalt :: Int -> UpdateFunctionCode -> Int
hashWithSalt Int
_salt UpdateFunctionCode' {Maybe Bool
Maybe (NonEmpty Architecture)
Maybe Text
Maybe (Sensitive Base64)
Text
functionName :: Text
zipFile :: Maybe (Sensitive Base64)
s3ObjectVersion :: Maybe Text
s3Key :: Maybe Text
s3Bucket :: Maybe Text
revisionId :: Maybe Text
publish :: Maybe Bool
imageUri :: Maybe Text
dryRun :: Maybe Bool
architectures :: Maybe (NonEmpty Architecture)
$sel:functionName:UpdateFunctionCode' :: UpdateFunctionCode -> Text
$sel:zipFile:UpdateFunctionCode' :: UpdateFunctionCode -> Maybe (Sensitive Base64)
$sel:s3ObjectVersion:UpdateFunctionCode' :: UpdateFunctionCode -> Maybe Text
$sel:s3Key:UpdateFunctionCode' :: UpdateFunctionCode -> Maybe Text
$sel:s3Bucket:UpdateFunctionCode' :: UpdateFunctionCode -> Maybe Text
$sel:revisionId:UpdateFunctionCode' :: UpdateFunctionCode -> Maybe Text
$sel:publish:UpdateFunctionCode' :: UpdateFunctionCode -> Maybe Bool
$sel:imageUri:UpdateFunctionCode' :: UpdateFunctionCode -> Maybe Text
$sel:dryRun:UpdateFunctionCode' :: UpdateFunctionCode -> Maybe Bool
$sel:architectures:UpdateFunctionCode' :: UpdateFunctionCode -> 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 Bool
dryRun
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
imageUri
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
publish
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
revisionId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
s3Bucket
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
s3Key
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
s3ObjectVersion
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (Sensitive Base64)
zipFile
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
functionName

instance Prelude.NFData UpdateFunctionCode where
  rnf :: UpdateFunctionCode -> ()
rnf UpdateFunctionCode' {Maybe Bool
Maybe (NonEmpty Architecture)
Maybe Text
Maybe (Sensitive Base64)
Text
functionName :: Text
zipFile :: Maybe (Sensitive Base64)
s3ObjectVersion :: Maybe Text
s3Key :: Maybe Text
s3Bucket :: Maybe Text
revisionId :: Maybe Text
publish :: Maybe Bool
imageUri :: Maybe Text
dryRun :: Maybe Bool
architectures :: Maybe (NonEmpty Architecture)
$sel:functionName:UpdateFunctionCode' :: UpdateFunctionCode -> Text
$sel:zipFile:UpdateFunctionCode' :: UpdateFunctionCode -> Maybe (Sensitive Base64)
$sel:s3ObjectVersion:UpdateFunctionCode' :: UpdateFunctionCode -> Maybe Text
$sel:s3Key:UpdateFunctionCode' :: UpdateFunctionCode -> Maybe Text
$sel:s3Bucket:UpdateFunctionCode' :: UpdateFunctionCode -> Maybe Text
$sel:revisionId:UpdateFunctionCode' :: UpdateFunctionCode -> Maybe Text
$sel:publish:UpdateFunctionCode' :: UpdateFunctionCode -> Maybe Bool
$sel:imageUri:UpdateFunctionCode' :: UpdateFunctionCode -> Maybe Text
$sel:dryRun:UpdateFunctionCode' :: UpdateFunctionCode -> Maybe Bool
$sel:architectures:UpdateFunctionCode' :: UpdateFunctionCode -> 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 Bool
dryRun
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
imageUri
      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 Text
revisionId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
s3Bucket
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
s3Key
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
s3ObjectVersion
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (Sensitive Base64)
zipFile
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
functionName

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

instance Data.ToJSON UpdateFunctionCode where
  toJSON :: UpdateFunctionCode -> Value
toJSON UpdateFunctionCode' {Maybe Bool
Maybe (NonEmpty Architecture)
Maybe Text
Maybe (Sensitive Base64)
Text
functionName :: Text
zipFile :: Maybe (Sensitive Base64)
s3ObjectVersion :: Maybe Text
s3Key :: Maybe Text
s3Bucket :: Maybe Text
revisionId :: Maybe Text
publish :: Maybe Bool
imageUri :: Maybe Text
dryRun :: Maybe Bool
architectures :: Maybe (NonEmpty Architecture)
$sel:functionName:UpdateFunctionCode' :: UpdateFunctionCode -> Text
$sel:zipFile:UpdateFunctionCode' :: UpdateFunctionCode -> Maybe (Sensitive Base64)
$sel:s3ObjectVersion:UpdateFunctionCode' :: UpdateFunctionCode -> Maybe Text
$sel:s3Key:UpdateFunctionCode' :: UpdateFunctionCode -> Maybe Text
$sel:s3Bucket:UpdateFunctionCode' :: UpdateFunctionCode -> Maybe Text
$sel:revisionId:UpdateFunctionCode' :: UpdateFunctionCode -> Maybe Text
$sel:publish:UpdateFunctionCode' :: UpdateFunctionCode -> Maybe Bool
$sel:imageUri:UpdateFunctionCode' :: UpdateFunctionCode -> Maybe Text
$sel:dryRun:UpdateFunctionCode' :: UpdateFunctionCode -> Maybe Bool
$sel:architectures:UpdateFunctionCode' :: UpdateFunctionCode -> 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
"DryRun" 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
dryRun,
            (Key
"ImageUri" 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
imageUri,
            (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
"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
"S3Bucket" 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
s3Bucket,
            (Key
"S3Key" 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
s3Key,
            (Key
"S3ObjectVersion" 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
s3ObjectVersion,
            (Key
"ZipFile" 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 (Sensitive Base64)
zipFile
          ]
      )

instance Data.ToPath UpdateFunctionCode where
  toPath :: UpdateFunctionCode -> ByteString
toPath UpdateFunctionCode' {Maybe Bool
Maybe (NonEmpty Architecture)
Maybe Text
Maybe (Sensitive Base64)
Text
functionName :: Text
zipFile :: Maybe (Sensitive Base64)
s3ObjectVersion :: Maybe Text
s3Key :: Maybe Text
s3Bucket :: Maybe Text
revisionId :: Maybe Text
publish :: Maybe Bool
imageUri :: Maybe Text
dryRun :: Maybe Bool
architectures :: Maybe (NonEmpty Architecture)
$sel:functionName:UpdateFunctionCode' :: UpdateFunctionCode -> Text
$sel:zipFile:UpdateFunctionCode' :: UpdateFunctionCode -> Maybe (Sensitive Base64)
$sel:s3ObjectVersion:UpdateFunctionCode' :: UpdateFunctionCode -> Maybe Text
$sel:s3Key:UpdateFunctionCode' :: UpdateFunctionCode -> Maybe Text
$sel:s3Bucket:UpdateFunctionCode' :: UpdateFunctionCode -> Maybe Text
$sel:revisionId:UpdateFunctionCode' :: UpdateFunctionCode -> Maybe Text
$sel:publish:UpdateFunctionCode' :: UpdateFunctionCode -> Maybe Bool
$sel:imageUri:UpdateFunctionCode' :: UpdateFunctionCode -> Maybe Text
$sel:dryRun:UpdateFunctionCode' :: UpdateFunctionCode -> Maybe Bool
$sel:architectures:UpdateFunctionCode' :: UpdateFunctionCode -> Maybe (NonEmpty Architecture)
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/2015-03-31/functions/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
functionName,
        ByteString
"/code"
      ]

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