{-# 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.CloudFront.UpdateFunction
-- 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 CloudFront function.
--
-- You can update a function\'s code or the comment that describes the
-- function. You cannot update a function\'s name.
--
-- To update a function, you provide the function\'s name and version
-- (@ETag@ value) along with the updated function code. To get the name and
-- version, you can use @ListFunctions@ and @DescribeFunction@.
module Amazonka.CloudFront.UpdateFunction
  ( -- * Creating a Request
    UpdateFunction (..),
    newUpdateFunction,

    -- * Request Lenses
    updateFunction_ifMatch,
    updateFunction_functionConfig,
    updateFunction_functionCode,
    updateFunction_name,

    -- * Destructuring the Response
    UpdateFunctionResponse (..),
    newUpdateFunctionResponse,

    -- * Response Lenses
    updateFunctionResponse_eTag,
    updateFunctionResponse_functionSummary,
    updateFunctionResponse_httpStatus,
  )
where

import Amazonka.CloudFront.Types
import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newUpdateFunction' smart constructor.
data UpdateFunction = UpdateFunction'
  { -- | The current version (@ETag@ value) of the function that you are
    -- updating, which you can get using @DescribeFunction@.
    UpdateFunction -> Text
ifMatch :: Prelude.Text,
    -- | Configuration information about the function.
    UpdateFunction -> FunctionConfig
functionConfig :: FunctionConfig,
    -- | The function code. For more information about writing a CloudFront
    -- function, see
    -- <https://docs.aws.amazon.com/AmazonCloudFront/latest/DeveloperGuide/writing-function-code.html Writing function code for CloudFront Functions>
    -- in the /Amazon CloudFront Developer Guide/.
    UpdateFunction -> Sensitive Base64
functionCode :: Data.Sensitive Data.Base64,
    -- | The name of the function that you are updating.
    UpdateFunction -> Text
name :: Prelude.Text
  }
  deriving (UpdateFunction -> UpdateFunction -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateFunction -> UpdateFunction -> Bool
$c/= :: UpdateFunction -> UpdateFunction -> Bool
== :: UpdateFunction -> UpdateFunction -> Bool
$c== :: UpdateFunction -> UpdateFunction -> Bool
Prelude.Eq, Int -> UpdateFunction -> ShowS
[UpdateFunction] -> ShowS
UpdateFunction -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateFunction] -> ShowS
$cshowList :: [UpdateFunction] -> ShowS
show :: UpdateFunction -> String
$cshow :: UpdateFunction -> String
showsPrec :: Int -> UpdateFunction -> ShowS
$cshowsPrec :: Int -> UpdateFunction -> ShowS
Prelude.Show, forall x. Rep UpdateFunction x -> UpdateFunction
forall x. UpdateFunction -> Rep UpdateFunction x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateFunction x -> UpdateFunction
$cfrom :: forall x. UpdateFunction -> Rep UpdateFunction x
Prelude.Generic)

-- |
-- Create a value of 'UpdateFunction' 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:
--
-- 'ifMatch', 'updateFunction_ifMatch' - The current version (@ETag@ value) of the function that you are
-- updating, which you can get using @DescribeFunction@.
--
-- 'functionConfig', 'updateFunction_functionConfig' - Configuration information about the function.
--
-- 'functionCode', 'updateFunction_functionCode' - The function code. For more information about writing a CloudFront
-- function, see
-- <https://docs.aws.amazon.com/AmazonCloudFront/latest/DeveloperGuide/writing-function-code.html Writing function code for CloudFront Functions>
-- in the /Amazon CloudFront Developer Guide/.--
-- -- /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.
--
-- 'name', 'updateFunction_name' - The name of the function that you are updating.
newUpdateFunction ::
  -- | 'ifMatch'
  Prelude.Text ->
  -- | 'functionConfig'
  FunctionConfig ->
  -- | 'functionCode'
  Prelude.ByteString ->
  -- | 'name'
  Prelude.Text ->
  UpdateFunction
newUpdateFunction :: Text -> FunctionConfig -> ByteString -> Text -> UpdateFunction
newUpdateFunction
  Text
pIfMatch_
  FunctionConfig
pFunctionConfig_
  ByteString
pFunctionCode_
  Text
pName_ =
    UpdateFunction'
      { $sel:ifMatch:UpdateFunction' :: Text
ifMatch = Text
pIfMatch_,
        $sel:functionConfig:UpdateFunction' :: FunctionConfig
functionConfig = FunctionConfig
pFunctionConfig_,
        $sel:functionCode:UpdateFunction' :: Sensitive Base64
functionCode =
          forall a. Iso' (Sensitive a) a
Data._Sensitive
            forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. Iso' Base64 ByteString
Data._Base64
            forall t b. AReview t b -> b -> t
Lens.# ByteString
pFunctionCode_,
        $sel:name:UpdateFunction' :: Text
name = Text
pName_
      }

-- | The current version (@ETag@ value) of the function that you are
-- updating, which you can get using @DescribeFunction@.
updateFunction_ifMatch :: Lens.Lens' UpdateFunction Prelude.Text
updateFunction_ifMatch :: Lens' UpdateFunction Text
updateFunction_ifMatch = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateFunction' {Text
ifMatch :: Text
$sel:ifMatch:UpdateFunction' :: UpdateFunction -> Text
ifMatch} -> Text
ifMatch) (\s :: UpdateFunction
s@UpdateFunction' {} Text
a -> UpdateFunction
s {$sel:ifMatch:UpdateFunction' :: Text
ifMatch = Text
a} :: UpdateFunction)

-- | Configuration information about the function.
updateFunction_functionConfig :: Lens.Lens' UpdateFunction FunctionConfig
updateFunction_functionConfig :: Lens' UpdateFunction FunctionConfig
updateFunction_functionConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateFunction' {FunctionConfig
functionConfig :: FunctionConfig
$sel:functionConfig:UpdateFunction' :: UpdateFunction -> FunctionConfig
functionConfig} -> FunctionConfig
functionConfig) (\s :: UpdateFunction
s@UpdateFunction' {} FunctionConfig
a -> UpdateFunction
s {$sel:functionConfig:UpdateFunction' :: FunctionConfig
functionConfig = FunctionConfig
a} :: UpdateFunction)

-- | The function code. For more information about writing a CloudFront
-- function, see
-- <https://docs.aws.amazon.com/AmazonCloudFront/latest/DeveloperGuide/writing-function-code.html Writing function code for CloudFront Functions>
-- in the /Amazon CloudFront Developer Guide/.--
-- -- /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.
updateFunction_functionCode :: Lens.Lens' UpdateFunction Prelude.ByteString
updateFunction_functionCode :: Lens' UpdateFunction ByteString
updateFunction_functionCode = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateFunction' {Sensitive Base64
functionCode :: Sensitive Base64
$sel:functionCode:UpdateFunction' :: UpdateFunction -> Sensitive Base64
functionCode} -> Sensitive Base64
functionCode) (\s :: UpdateFunction
s@UpdateFunction' {} Sensitive Base64
a -> UpdateFunction
s {$sel:functionCode:UpdateFunction' :: Sensitive Base64
functionCode = Sensitive Base64
a} :: UpdateFunction) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. 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 function that you are updating.
updateFunction_name :: Lens.Lens' UpdateFunction Prelude.Text
updateFunction_name :: Lens' UpdateFunction Text
updateFunction_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateFunction' {Text
name :: Text
$sel:name:UpdateFunction' :: UpdateFunction -> Text
name} -> Text
name) (\s :: UpdateFunction
s@UpdateFunction' {} Text
a -> UpdateFunction
s {$sel:name:UpdateFunction' :: Text
name = Text
a} :: UpdateFunction)

instance Core.AWSRequest UpdateFunction where
  type
    AWSResponse UpdateFunction =
      UpdateFunctionResponse
  request :: (Service -> Service) -> UpdateFunction -> Request UpdateFunction
request Service -> Service
overrides =
    forall a. (ToRequest a, ToElement a) => Service -> a -> Request a
Request.putXML (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy UpdateFunction
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse UpdateFunction)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> [Node] -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveXML
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Maybe Text
-> Maybe FunctionSummary -> Int -> UpdateFunctionResponse
UpdateFunctionResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (ResponseHeaders
h forall a.
FromText a =>
ResponseHeaders -> HeaderName -> Either String (Maybe a)
Data..#? HeaderName
"ETtag")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (forall a. FromXML a => [Node] -> Either String a
Data.parseXML [Node]
x)
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
      )

instance Prelude.Hashable UpdateFunction where
  hashWithSalt :: Int -> UpdateFunction -> Int
hashWithSalt Int
_salt UpdateFunction' {Text
Sensitive Base64
FunctionConfig
name :: Text
functionCode :: Sensitive Base64
functionConfig :: FunctionConfig
ifMatch :: Text
$sel:name:UpdateFunction' :: UpdateFunction -> Text
$sel:functionCode:UpdateFunction' :: UpdateFunction -> Sensitive Base64
$sel:functionConfig:UpdateFunction' :: UpdateFunction -> FunctionConfig
$sel:ifMatch:UpdateFunction' :: UpdateFunction -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
ifMatch
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` FunctionConfig
functionConfig
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Sensitive Base64
functionCode
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
name

instance Prelude.NFData UpdateFunction where
  rnf :: UpdateFunction -> ()
rnf UpdateFunction' {Text
Sensitive Base64
FunctionConfig
name :: Text
functionCode :: Sensitive Base64
functionConfig :: FunctionConfig
ifMatch :: Text
$sel:name:UpdateFunction' :: UpdateFunction -> Text
$sel:functionCode:UpdateFunction' :: UpdateFunction -> Sensitive Base64
$sel:functionConfig:UpdateFunction' :: UpdateFunction -> FunctionConfig
$sel:ifMatch:UpdateFunction' :: UpdateFunction -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
ifMatch
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf FunctionConfig
functionConfig
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Sensitive Base64
functionCode
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
name

instance Data.ToElement UpdateFunction where
  toElement :: UpdateFunction -> Element
toElement =
    forall a. ToXML a => Name -> a -> Element
Data.mkElement
      Name
"{http://cloudfront.amazonaws.com/doc/2020-05-31/}UpdateFunctionRequest"

instance Data.ToHeaders UpdateFunction where
  toHeaders :: UpdateFunction -> ResponseHeaders
toHeaders UpdateFunction' {Text
Sensitive Base64
FunctionConfig
name :: Text
functionCode :: Sensitive Base64
functionConfig :: FunctionConfig
ifMatch :: Text
$sel:name:UpdateFunction' :: UpdateFunction -> Text
$sel:functionCode:UpdateFunction' :: UpdateFunction -> Sensitive Base64
$sel:functionConfig:UpdateFunction' :: UpdateFunction -> FunctionConfig
$sel:ifMatch:UpdateFunction' :: UpdateFunction -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat [HeaderName
"If-Match" forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# Text
ifMatch]

instance Data.ToPath UpdateFunction where
  toPath :: UpdateFunction -> ByteString
toPath UpdateFunction' {Text
Sensitive Base64
FunctionConfig
name :: Text
functionCode :: Sensitive Base64
functionConfig :: FunctionConfig
ifMatch :: Text
$sel:name:UpdateFunction' :: UpdateFunction -> Text
$sel:functionCode:UpdateFunction' :: UpdateFunction -> Sensitive Base64
$sel:functionConfig:UpdateFunction' :: UpdateFunction -> FunctionConfig
$sel:ifMatch:UpdateFunction' :: UpdateFunction -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ByteString
"/2020-05-31/function/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
name]

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

instance Data.ToXML UpdateFunction where
  toXML :: UpdateFunction -> XML
toXML UpdateFunction' {Text
Sensitive Base64
FunctionConfig
name :: Text
functionCode :: Sensitive Base64
functionConfig :: FunctionConfig
ifMatch :: Text
$sel:name:UpdateFunction' :: UpdateFunction -> Text
$sel:functionCode:UpdateFunction' :: UpdateFunction -> Sensitive Base64
$sel:functionConfig:UpdateFunction' :: UpdateFunction -> FunctionConfig
$sel:ifMatch:UpdateFunction' :: UpdateFunction -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ Name
"FunctionConfig" forall a. ToXML a => Name -> a -> XML
Data.@= FunctionConfig
functionConfig,
        Name
"FunctionCode" forall a. ToXML a => Name -> a -> XML
Data.@= Sensitive Base64
functionCode
      ]

-- | /See:/ 'newUpdateFunctionResponse' smart constructor.
data UpdateFunctionResponse = UpdateFunctionResponse'
  { -- | The version identifier for the current version of the CloudFront
    -- function.
    UpdateFunctionResponse -> Maybe Text
eTag :: Prelude.Maybe Prelude.Text,
    -- | Contains configuration information and metadata about a CloudFront
    -- function.
    UpdateFunctionResponse -> Maybe FunctionSummary
functionSummary :: Prelude.Maybe FunctionSummary,
    -- | The response's http status code.
    UpdateFunctionResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (UpdateFunctionResponse -> UpdateFunctionResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateFunctionResponse -> UpdateFunctionResponse -> Bool
$c/= :: UpdateFunctionResponse -> UpdateFunctionResponse -> Bool
== :: UpdateFunctionResponse -> UpdateFunctionResponse -> Bool
$c== :: UpdateFunctionResponse -> UpdateFunctionResponse -> Bool
Prelude.Eq, ReadPrec [UpdateFunctionResponse]
ReadPrec UpdateFunctionResponse
Int -> ReadS UpdateFunctionResponse
ReadS [UpdateFunctionResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateFunctionResponse]
$creadListPrec :: ReadPrec [UpdateFunctionResponse]
readPrec :: ReadPrec UpdateFunctionResponse
$creadPrec :: ReadPrec UpdateFunctionResponse
readList :: ReadS [UpdateFunctionResponse]
$creadList :: ReadS [UpdateFunctionResponse]
readsPrec :: Int -> ReadS UpdateFunctionResponse
$creadsPrec :: Int -> ReadS UpdateFunctionResponse
Prelude.Read, Int -> UpdateFunctionResponse -> ShowS
[UpdateFunctionResponse] -> ShowS
UpdateFunctionResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateFunctionResponse] -> ShowS
$cshowList :: [UpdateFunctionResponse] -> ShowS
show :: UpdateFunctionResponse -> String
$cshow :: UpdateFunctionResponse -> String
showsPrec :: Int -> UpdateFunctionResponse -> ShowS
$cshowsPrec :: Int -> UpdateFunctionResponse -> ShowS
Prelude.Show, forall x. Rep UpdateFunctionResponse x -> UpdateFunctionResponse
forall x. UpdateFunctionResponse -> Rep UpdateFunctionResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateFunctionResponse x -> UpdateFunctionResponse
$cfrom :: forall x. UpdateFunctionResponse -> Rep UpdateFunctionResponse x
Prelude.Generic)

-- |
-- Create a value of 'UpdateFunctionResponse' 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:
--
-- 'eTag', 'updateFunctionResponse_eTag' - The version identifier for the current version of the CloudFront
-- function.
--
-- 'functionSummary', 'updateFunctionResponse_functionSummary' - Contains configuration information and metadata about a CloudFront
-- function.
--
-- 'httpStatus', 'updateFunctionResponse_httpStatus' - The response's http status code.
newUpdateFunctionResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UpdateFunctionResponse
newUpdateFunctionResponse :: Int -> UpdateFunctionResponse
newUpdateFunctionResponse Int
pHttpStatus_ =
  UpdateFunctionResponse'
    { $sel:eTag:UpdateFunctionResponse' :: Maybe Text
eTag = forall a. Maybe a
Prelude.Nothing,
      $sel:functionSummary:UpdateFunctionResponse' :: Maybe FunctionSummary
functionSummary = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:UpdateFunctionResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The version identifier for the current version of the CloudFront
-- function.
updateFunctionResponse_eTag :: Lens.Lens' UpdateFunctionResponse (Prelude.Maybe Prelude.Text)
updateFunctionResponse_eTag :: Lens' UpdateFunctionResponse (Maybe Text)
updateFunctionResponse_eTag = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateFunctionResponse' {Maybe Text
eTag :: Maybe Text
$sel:eTag:UpdateFunctionResponse' :: UpdateFunctionResponse -> Maybe Text
eTag} -> Maybe Text
eTag) (\s :: UpdateFunctionResponse
s@UpdateFunctionResponse' {} Maybe Text
a -> UpdateFunctionResponse
s {$sel:eTag:UpdateFunctionResponse' :: Maybe Text
eTag = Maybe Text
a} :: UpdateFunctionResponse)

-- | Contains configuration information and metadata about a CloudFront
-- function.
updateFunctionResponse_functionSummary :: Lens.Lens' UpdateFunctionResponse (Prelude.Maybe FunctionSummary)
updateFunctionResponse_functionSummary :: Lens' UpdateFunctionResponse (Maybe FunctionSummary)
updateFunctionResponse_functionSummary = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateFunctionResponse' {Maybe FunctionSummary
functionSummary :: Maybe FunctionSummary
$sel:functionSummary:UpdateFunctionResponse' :: UpdateFunctionResponse -> Maybe FunctionSummary
functionSummary} -> Maybe FunctionSummary
functionSummary) (\s :: UpdateFunctionResponse
s@UpdateFunctionResponse' {} Maybe FunctionSummary
a -> UpdateFunctionResponse
s {$sel:functionSummary:UpdateFunctionResponse' :: Maybe FunctionSummary
functionSummary = Maybe FunctionSummary
a} :: UpdateFunctionResponse)

-- | The response's http status code.
updateFunctionResponse_httpStatus :: Lens.Lens' UpdateFunctionResponse Prelude.Int
updateFunctionResponse_httpStatus :: Lens' UpdateFunctionResponse Int
updateFunctionResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateFunctionResponse' {Int
httpStatus :: Int
$sel:httpStatus:UpdateFunctionResponse' :: UpdateFunctionResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: UpdateFunctionResponse
s@UpdateFunctionResponse' {} Int
a -> UpdateFunctionResponse
s {$sel:httpStatus:UpdateFunctionResponse' :: Int
httpStatus = Int
a} :: UpdateFunctionResponse)

instance Prelude.NFData UpdateFunctionResponse where
  rnf :: UpdateFunctionResponse -> ()
rnf UpdateFunctionResponse' {Int
Maybe Text
Maybe FunctionSummary
httpStatus :: Int
functionSummary :: Maybe FunctionSummary
eTag :: Maybe Text
$sel:httpStatus:UpdateFunctionResponse' :: UpdateFunctionResponse -> Int
$sel:functionSummary:UpdateFunctionResponse' :: UpdateFunctionResponse -> Maybe FunctionSummary
$sel:eTag:UpdateFunctionResponse' :: UpdateFunctionResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
eTag
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe FunctionSummary
functionSummary
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus