{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric      #-}
{-# LANGUAGE OverloadedStrings  #-}
{-# LANGUAGE RecordWildCards    #-}
{-# LANGUAGE TypeFamilies       #-}

{-# OPTIONS_GHC -fno-warn-unused-imports #-}
{-# OPTIONS_GHC -fno-warn-unused-binds   #-}
{-# OPTIONS_GHC -fno-warn-unused-matches #-}

-- Derived from AWS service descriptions, licensed under Apache 2.0.

-- |
-- Module      : Network.AWS.Lambda.UpdateFunctionCode
-- Copyright   : (c) 2013-2016 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay <brendan.g.hay@gmail.com>
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Updates the code for the specified Lambda function. This operation must only be used on an existing Lambda function and cannot be used to update the function configuration.
--
-- If you are using the versioning feature, note this API will always update the >LATEST version of your Lambda function. For information about the versioning feature, see <http://docs.aws.amazon.com/lambda/latest/dg/versioning-aliases.html AWS Lambda Function Versioning and Aliases>.
--
-- This operation requires permission for the 'lambda:UpdateFunctionCode' action.
module Network.AWS.Lambda.UpdateFunctionCode
    (
    -- * Creating a Request
      updateFunctionCode
    , UpdateFunctionCode
    -- * Request Lenses
    , uS3ObjectVersion
    , uS3Key
    , uZipFile
    , uS3Bucket
    , uPublish
    , uFunctionName

    -- * Destructuring the Response
    , functionConfiguration
    , FunctionConfiguration
    -- * Response Lenses
    , fcMemorySize
    , fcRuntime
    , fcFunctionARN
    , fcRole
    , fcVPCConfig
    , fcVersion
    , fcFunctionName
    , fcCodeSize
    , fcHandler
    , fcTimeout
    , fcLastModified
    , fcCodeSha256
    , fcDescription
    ) where

import           Network.AWS.Lambda.Types
import           Network.AWS.Lambda.Types.Product
import           Network.AWS.Lens
import           Network.AWS.Prelude
import           Network.AWS.Request
import           Network.AWS.Response

-- | /See:/ 'updateFunctionCode' smart constructor.
data UpdateFunctionCode = UpdateFunctionCode'
    { _uS3ObjectVersion :: !(Maybe Text)
    , _uS3Key           :: !(Maybe Text)
    , _uZipFile         :: !(Maybe Base64)
    , _uS3Bucket        :: !(Maybe Text)
    , _uPublish         :: !(Maybe Bool)
    , _uFunctionName    :: !Text
    } deriving (Eq,Read,Show,Data,Typeable,Generic)

-- | Creates a value of 'UpdateFunctionCode' with the minimum fields required to make a request.
--
-- Use one of the following lenses to modify other fields as desired:
--
-- * 'uS3ObjectVersion'
--
-- * 'uS3Key'
--
-- * 'uZipFile'
--
-- * 'uS3Bucket'
--
-- * 'uPublish'
--
-- * 'uFunctionName'
updateFunctionCode
    :: Text -- ^ 'uFunctionName'
    -> UpdateFunctionCode
updateFunctionCode pFunctionName_ =
    UpdateFunctionCode'
    { _uS3ObjectVersion = Nothing
    , _uS3Key = Nothing
    , _uZipFile = Nothing
    , _uS3Bucket = Nothing
    , _uPublish = Nothing
    , _uFunctionName = pFunctionName_
    }

-- | The Amazon S3 object (the deployment package) version you want to upload.
uS3ObjectVersion :: Lens' UpdateFunctionCode (Maybe Text)
uS3ObjectVersion = lens _uS3ObjectVersion (\ s a -> s{_uS3ObjectVersion = a});

-- | The Amazon S3 object (the deployment package) key name you want to upload.
uS3Key :: Lens' UpdateFunctionCode (Maybe Text)
uS3Key = lens _uS3Key (\ s a -> s{_uS3Key = a});

-- | Based64-encoded .zip file containing your packaged source code.
--
-- /Note:/ This 'Lens' automatically encodes and decodes Base64 data,
-- despite what the AWS documentation might say.
-- 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.
uZipFile :: Lens' UpdateFunctionCode (Maybe ByteString)
uZipFile = lens _uZipFile (\ s a -> s{_uZipFile = a}) . mapping _Base64;

-- | Amazon S3 bucket name where the .zip file containing your deployment package is stored. This bucket must reside in the same AWS region where you are creating the Lambda function.
uS3Bucket :: Lens' UpdateFunctionCode (Maybe Text)
uS3Bucket = lens _uS3Bucket (\ s a -> s{_uS3Bucket = a});

-- | This boolean parameter can be used to request AWS Lambda to update the Lambda function and publish a version as an atomic operation.
uPublish :: Lens' UpdateFunctionCode (Maybe Bool)
uPublish = lens _uPublish (\ s a -> s{_uPublish = a});

-- | The existing Lambda function name whose code you want to replace.
--
-- You can specify a function name (for example, 'Thumbnail') or you can specify Amazon Resource Name (ARN) of the function (for example, 'arn:aws:lambda:us-west-2:account-id:function:ThumbNail'). AWS Lambda also allows you to specify a partial ARN (for example, 'account-id:Thumbnail'). Note that the length constraint applies only to the ARN. If you specify only the function name, it is limited to 64 character in length.
uFunctionName :: Lens' UpdateFunctionCode Text
uFunctionName = lens _uFunctionName (\ s a -> s{_uFunctionName = a});

instance AWSRequest UpdateFunctionCode where
        type Rs UpdateFunctionCode = FunctionConfiguration
        request = putJSON lambda
        response = receiveJSON (\ s h x -> eitherParseJSON x)

instance Hashable UpdateFunctionCode

instance NFData UpdateFunctionCode

instance ToHeaders UpdateFunctionCode where
        toHeaders = const mempty

instance ToJSON UpdateFunctionCode where
        toJSON UpdateFunctionCode'{..}
          = object
              (catMaybes
                 [("S3ObjectVersion" .=) <$> _uS3ObjectVersion,
                  ("S3Key" .=) <$> _uS3Key,
                  ("ZipFile" .=) <$> _uZipFile,
                  ("S3Bucket" .=) <$> _uS3Bucket,
                  ("Publish" .=) <$> _uPublish])

instance ToPath UpdateFunctionCode where
        toPath UpdateFunctionCode'{..}
          = mconcat
              ["/2015-03-31/functions/", toBS _uFunctionName,
               "/code"]

instance ToQuery UpdateFunctionCode where
        toQuery = const mempty