{-# 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.AppSync.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 @Function@ object.
module Amazonka.AppSync.UpdateFunction
  ( -- * Creating a Request
    UpdateFunction (..),
    newUpdateFunction,

    -- * Request Lenses
    updateFunction_code,
    updateFunction_description,
    updateFunction_functionVersion,
    updateFunction_maxBatchSize,
    updateFunction_requestMappingTemplate,
    updateFunction_responseMappingTemplate,
    updateFunction_runtime,
    updateFunction_syncConfig,
    updateFunction_apiId,
    updateFunction_name,
    updateFunction_functionId,
    updateFunction_dataSourceName,

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

    -- * Response Lenses
    updateFunctionResponse_functionConfiguration,
    updateFunctionResponse_httpStatus,
  )
where

import Amazonka.AppSync.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 @function@ code that contains the request and response functions.
    -- When code is used, the @runtime@ is required. The @runtime@ value must
    -- be @APPSYNC_JS@.
    UpdateFunction -> Maybe Text
code :: Prelude.Maybe Prelude.Text,
    -- | The @Function@ description.
    UpdateFunction -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | The @version@ of the request mapping template. Currently, the supported
    -- value is 2018-05-29. Note that when using VTL and mapping templates, the
    -- @functionVersion@ is required.
    UpdateFunction -> Maybe Text
functionVersion :: Prelude.Maybe Prelude.Text,
    -- | The maximum batching size for a resolver.
    UpdateFunction -> Maybe Natural
maxBatchSize :: Prelude.Maybe Prelude.Natural,
    -- | The @Function@ request mapping template. Functions support only the
    -- 2018-05-29 version of the request mapping template.
    UpdateFunction -> Maybe Text
requestMappingTemplate :: Prelude.Maybe Prelude.Text,
    -- | The @Function@ request mapping template.
    UpdateFunction -> Maybe Text
responseMappingTemplate :: Prelude.Maybe Prelude.Text,
    UpdateFunction -> Maybe AppSyncRuntime
runtime :: Prelude.Maybe AppSyncRuntime,
    UpdateFunction -> Maybe SyncConfig
syncConfig :: Prelude.Maybe SyncConfig,
    -- | The GraphQL API ID.
    UpdateFunction -> Text
apiId :: Prelude.Text,
    -- | The @Function@ name.
    UpdateFunction -> Text
name :: Prelude.Text,
    -- | The function ID.
    UpdateFunction -> Text
functionId :: Prelude.Text,
    -- | The @Function@ @DataSource@ name.
    UpdateFunction -> Text
dataSourceName :: 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, ReadPrec [UpdateFunction]
ReadPrec UpdateFunction
Int -> ReadS UpdateFunction
ReadS [UpdateFunction]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateFunction]
$creadListPrec :: ReadPrec [UpdateFunction]
readPrec :: ReadPrec UpdateFunction
$creadPrec :: ReadPrec UpdateFunction
readList :: ReadS [UpdateFunction]
$creadList :: ReadS [UpdateFunction]
readsPrec :: Int -> ReadS UpdateFunction
$creadsPrec :: Int -> ReadS UpdateFunction
Prelude.Read, 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:
--
-- 'code', 'updateFunction_code' - The @function@ code that contains the request and response functions.
-- When code is used, the @runtime@ is required. The @runtime@ value must
-- be @APPSYNC_JS@.
--
-- 'description', 'updateFunction_description' - The @Function@ description.
--
-- 'functionVersion', 'updateFunction_functionVersion' - The @version@ of the request mapping template. Currently, the supported
-- value is 2018-05-29. Note that when using VTL and mapping templates, the
-- @functionVersion@ is required.
--
-- 'maxBatchSize', 'updateFunction_maxBatchSize' - The maximum batching size for a resolver.
--
-- 'requestMappingTemplate', 'updateFunction_requestMappingTemplate' - The @Function@ request mapping template. Functions support only the
-- 2018-05-29 version of the request mapping template.
--
-- 'responseMappingTemplate', 'updateFunction_responseMappingTemplate' - The @Function@ request mapping template.
--
-- 'runtime', 'updateFunction_runtime' - Undocumented member.
--
-- 'syncConfig', 'updateFunction_syncConfig' - Undocumented member.
--
-- 'apiId', 'updateFunction_apiId' - The GraphQL API ID.
--
-- 'name', 'updateFunction_name' - The @Function@ name.
--
-- 'functionId', 'updateFunction_functionId' - The function ID.
--
-- 'dataSourceName', 'updateFunction_dataSourceName' - The @Function@ @DataSource@ name.
newUpdateFunction ::
  -- | 'apiId'
  Prelude.Text ->
  -- | 'name'
  Prelude.Text ->
  -- | 'functionId'
  Prelude.Text ->
  -- | 'dataSourceName'
  Prelude.Text ->
  UpdateFunction
newUpdateFunction :: Text -> Text -> Text -> Text -> UpdateFunction
newUpdateFunction
  Text
pApiId_
  Text
pName_
  Text
pFunctionId_
  Text
pDataSourceName_ =
    UpdateFunction'
      { $sel:code:UpdateFunction' :: Maybe Text
code = forall a. Maybe a
Prelude.Nothing,
        $sel:description:UpdateFunction' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
        $sel:functionVersion:UpdateFunction' :: Maybe Text
functionVersion = forall a. Maybe a
Prelude.Nothing,
        $sel:maxBatchSize:UpdateFunction' :: Maybe Natural
maxBatchSize = forall a. Maybe a
Prelude.Nothing,
        $sel:requestMappingTemplate:UpdateFunction' :: Maybe Text
requestMappingTemplate = forall a. Maybe a
Prelude.Nothing,
        $sel:responseMappingTemplate:UpdateFunction' :: Maybe Text
responseMappingTemplate = forall a. Maybe a
Prelude.Nothing,
        $sel:runtime:UpdateFunction' :: Maybe AppSyncRuntime
runtime = forall a. Maybe a
Prelude.Nothing,
        $sel:syncConfig:UpdateFunction' :: Maybe SyncConfig
syncConfig = forall a. Maybe a
Prelude.Nothing,
        $sel:apiId:UpdateFunction' :: Text
apiId = Text
pApiId_,
        $sel:name:UpdateFunction' :: Text
name = Text
pName_,
        $sel:functionId:UpdateFunction' :: Text
functionId = Text
pFunctionId_,
        $sel:dataSourceName:UpdateFunction' :: Text
dataSourceName = Text
pDataSourceName_
      }

-- | The @function@ code that contains the request and response functions.
-- When code is used, the @runtime@ is required. The @runtime@ value must
-- be @APPSYNC_JS@.
updateFunction_code :: Lens.Lens' UpdateFunction (Prelude.Maybe Prelude.Text)
updateFunction_code :: Lens' UpdateFunction (Maybe Text)
updateFunction_code = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateFunction' {Maybe Text
code :: Maybe Text
$sel:code:UpdateFunction' :: UpdateFunction -> Maybe Text
code} -> Maybe Text
code) (\s :: UpdateFunction
s@UpdateFunction' {} Maybe Text
a -> UpdateFunction
s {$sel:code:UpdateFunction' :: Maybe Text
code = Maybe Text
a} :: UpdateFunction)

-- | The @Function@ description.
updateFunction_description :: Lens.Lens' UpdateFunction (Prelude.Maybe Prelude.Text)
updateFunction_description :: Lens' UpdateFunction (Maybe Text)
updateFunction_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateFunction' {Maybe Text
description :: Maybe Text
$sel:description:UpdateFunction' :: UpdateFunction -> Maybe Text
description} -> Maybe Text
description) (\s :: UpdateFunction
s@UpdateFunction' {} Maybe Text
a -> UpdateFunction
s {$sel:description:UpdateFunction' :: Maybe Text
description = Maybe Text
a} :: UpdateFunction)

-- | The @version@ of the request mapping template. Currently, the supported
-- value is 2018-05-29. Note that when using VTL and mapping templates, the
-- @functionVersion@ is required.
updateFunction_functionVersion :: Lens.Lens' UpdateFunction (Prelude.Maybe Prelude.Text)
updateFunction_functionVersion :: Lens' UpdateFunction (Maybe Text)
updateFunction_functionVersion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateFunction' {Maybe Text
functionVersion :: Maybe Text
$sel:functionVersion:UpdateFunction' :: UpdateFunction -> Maybe Text
functionVersion} -> Maybe Text
functionVersion) (\s :: UpdateFunction
s@UpdateFunction' {} Maybe Text
a -> UpdateFunction
s {$sel:functionVersion:UpdateFunction' :: Maybe Text
functionVersion = Maybe Text
a} :: UpdateFunction)

-- | The maximum batching size for a resolver.
updateFunction_maxBatchSize :: Lens.Lens' UpdateFunction (Prelude.Maybe Prelude.Natural)
updateFunction_maxBatchSize :: Lens' UpdateFunction (Maybe Natural)
updateFunction_maxBatchSize = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateFunction' {Maybe Natural
maxBatchSize :: Maybe Natural
$sel:maxBatchSize:UpdateFunction' :: UpdateFunction -> Maybe Natural
maxBatchSize} -> Maybe Natural
maxBatchSize) (\s :: UpdateFunction
s@UpdateFunction' {} Maybe Natural
a -> UpdateFunction
s {$sel:maxBatchSize:UpdateFunction' :: Maybe Natural
maxBatchSize = Maybe Natural
a} :: UpdateFunction)

-- | The @Function@ request mapping template. Functions support only the
-- 2018-05-29 version of the request mapping template.
updateFunction_requestMappingTemplate :: Lens.Lens' UpdateFunction (Prelude.Maybe Prelude.Text)
updateFunction_requestMappingTemplate :: Lens' UpdateFunction (Maybe Text)
updateFunction_requestMappingTemplate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateFunction' {Maybe Text
requestMappingTemplate :: Maybe Text
$sel:requestMappingTemplate:UpdateFunction' :: UpdateFunction -> Maybe Text
requestMappingTemplate} -> Maybe Text
requestMappingTemplate) (\s :: UpdateFunction
s@UpdateFunction' {} Maybe Text
a -> UpdateFunction
s {$sel:requestMappingTemplate:UpdateFunction' :: Maybe Text
requestMappingTemplate = Maybe Text
a} :: UpdateFunction)

-- | The @Function@ request mapping template.
updateFunction_responseMappingTemplate :: Lens.Lens' UpdateFunction (Prelude.Maybe Prelude.Text)
updateFunction_responseMappingTemplate :: Lens' UpdateFunction (Maybe Text)
updateFunction_responseMappingTemplate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateFunction' {Maybe Text
responseMappingTemplate :: Maybe Text
$sel:responseMappingTemplate:UpdateFunction' :: UpdateFunction -> Maybe Text
responseMappingTemplate} -> Maybe Text
responseMappingTemplate) (\s :: UpdateFunction
s@UpdateFunction' {} Maybe Text
a -> UpdateFunction
s {$sel:responseMappingTemplate:UpdateFunction' :: Maybe Text
responseMappingTemplate = Maybe Text
a} :: UpdateFunction)

-- | Undocumented member.
updateFunction_runtime :: Lens.Lens' UpdateFunction (Prelude.Maybe AppSyncRuntime)
updateFunction_runtime :: Lens' UpdateFunction (Maybe AppSyncRuntime)
updateFunction_runtime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateFunction' {Maybe AppSyncRuntime
runtime :: Maybe AppSyncRuntime
$sel:runtime:UpdateFunction' :: UpdateFunction -> Maybe AppSyncRuntime
runtime} -> Maybe AppSyncRuntime
runtime) (\s :: UpdateFunction
s@UpdateFunction' {} Maybe AppSyncRuntime
a -> UpdateFunction
s {$sel:runtime:UpdateFunction' :: Maybe AppSyncRuntime
runtime = Maybe AppSyncRuntime
a} :: UpdateFunction)

-- | Undocumented member.
updateFunction_syncConfig :: Lens.Lens' UpdateFunction (Prelude.Maybe SyncConfig)
updateFunction_syncConfig :: Lens' UpdateFunction (Maybe SyncConfig)
updateFunction_syncConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateFunction' {Maybe SyncConfig
syncConfig :: Maybe SyncConfig
$sel:syncConfig:UpdateFunction' :: UpdateFunction -> Maybe SyncConfig
syncConfig} -> Maybe SyncConfig
syncConfig) (\s :: UpdateFunction
s@UpdateFunction' {} Maybe SyncConfig
a -> UpdateFunction
s {$sel:syncConfig:UpdateFunction' :: Maybe SyncConfig
syncConfig = Maybe SyncConfig
a} :: UpdateFunction)

-- | The GraphQL API ID.
updateFunction_apiId :: Lens.Lens' UpdateFunction Prelude.Text
updateFunction_apiId :: Lens' UpdateFunction Text
updateFunction_apiId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateFunction' {Text
apiId :: Text
$sel:apiId:UpdateFunction' :: UpdateFunction -> Text
apiId} -> Text
apiId) (\s :: UpdateFunction
s@UpdateFunction' {} Text
a -> UpdateFunction
s {$sel:apiId:UpdateFunction' :: Text
apiId = Text
a} :: UpdateFunction)

-- | The @Function@ name.
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)

-- | The function ID.
updateFunction_functionId :: Lens.Lens' UpdateFunction Prelude.Text
updateFunction_functionId :: Lens' UpdateFunction Text
updateFunction_functionId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateFunction' {Text
functionId :: Text
$sel:functionId:UpdateFunction' :: UpdateFunction -> Text
functionId} -> Text
functionId) (\s :: UpdateFunction
s@UpdateFunction' {} Text
a -> UpdateFunction
s {$sel:functionId:UpdateFunction' :: Text
functionId = Text
a} :: UpdateFunction)

-- | The @Function@ @DataSource@ name.
updateFunction_dataSourceName :: Lens.Lens' UpdateFunction Prelude.Text
updateFunction_dataSourceName :: Lens' UpdateFunction Text
updateFunction_dataSourceName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateFunction' {Text
dataSourceName :: Text
$sel:dataSourceName:UpdateFunction' :: UpdateFunction -> Text
dataSourceName} -> Text
dataSourceName) (\s :: UpdateFunction
s@UpdateFunction' {} Text
a -> UpdateFunction
s {$sel:dataSourceName:UpdateFunction' :: Text
dataSourceName = 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, ToJSON a) => Service -> a -> Request a
Request.postJSON (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 -> 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 ->
          Maybe FunctionConfiguration -> Int -> UpdateFunctionResponse
UpdateFunctionResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"functionConfiguration")
            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' {Maybe Natural
Maybe Text
Maybe AppSyncRuntime
Maybe SyncConfig
Text
dataSourceName :: Text
functionId :: Text
name :: Text
apiId :: Text
syncConfig :: Maybe SyncConfig
runtime :: Maybe AppSyncRuntime
responseMappingTemplate :: Maybe Text
requestMappingTemplate :: Maybe Text
maxBatchSize :: Maybe Natural
functionVersion :: Maybe Text
description :: Maybe Text
code :: Maybe Text
$sel:dataSourceName:UpdateFunction' :: UpdateFunction -> Text
$sel:functionId:UpdateFunction' :: UpdateFunction -> Text
$sel:name:UpdateFunction' :: UpdateFunction -> Text
$sel:apiId:UpdateFunction' :: UpdateFunction -> Text
$sel:syncConfig:UpdateFunction' :: UpdateFunction -> Maybe SyncConfig
$sel:runtime:UpdateFunction' :: UpdateFunction -> Maybe AppSyncRuntime
$sel:responseMappingTemplate:UpdateFunction' :: UpdateFunction -> Maybe Text
$sel:requestMappingTemplate:UpdateFunction' :: UpdateFunction -> Maybe Text
$sel:maxBatchSize:UpdateFunction' :: UpdateFunction -> Maybe Natural
$sel:functionVersion:UpdateFunction' :: UpdateFunction -> Maybe Text
$sel:description:UpdateFunction' :: UpdateFunction -> Maybe Text
$sel:code:UpdateFunction' :: UpdateFunction -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
code
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
functionVersion
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
maxBatchSize
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
requestMappingTemplate
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
responseMappingTemplate
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe AppSyncRuntime
runtime
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe SyncConfig
syncConfig
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
apiId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
name
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
functionId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
dataSourceName

instance Prelude.NFData UpdateFunction where
  rnf :: UpdateFunction -> ()
rnf UpdateFunction' {Maybe Natural
Maybe Text
Maybe AppSyncRuntime
Maybe SyncConfig
Text
dataSourceName :: Text
functionId :: Text
name :: Text
apiId :: Text
syncConfig :: Maybe SyncConfig
runtime :: Maybe AppSyncRuntime
responseMappingTemplate :: Maybe Text
requestMappingTemplate :: Maybe Text
maxBatchSize :: Maybe Natural
functionVersion :: Maybe Text
description :: Maybe Text
code :: Maybe Text
$sel:dataSourceName:UpdateFunction' :: UpdateFunction -> Text
$sel:functionId:UpdateFunction' :: UpdateFunction -> Text
$sel:name:UpdateFunction' :: UpdateFunction -> Text
$sel:apiId:UpdateFunction' :: UpdateFunction -> Text
$sel:syncConfig:UpdateFunction' :: UpdateFunction -> Maybe SyncConfig
$sel:runtime:UpdateFunction' :: UpdateFunction -> Maybe AppSyncRuntime
$sel:responseMappingTemplate:UpdateFunction' :: UpdateFunction -> Maybe Text
$sel:requestMappingTemplate:UpdateFunction' :: UpdateFunction -> Maybe Text
$sel:maxBatchSize:UpdateFunction' :: UpdateFunction -> Maybe Natural
$sel:functionVersion:UpdateFunction' :: UpdateFunction -> Maybe Text
$sel:description:UpdateFunction' :: UpdateFunction -> Maybe Text
$sel:code:UpdateFunction' :: UpdateFunction -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
code
      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 Text
functionVersion
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
maxBatchSize
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
requestMappingTemplate
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
responseMappingTemplate
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe AppSyncRuntime
runtime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe SyncConfig
syncConfig
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
apiId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
name
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
functionId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
dataSourceName

instance Data.ToHeaders UpdateFunction where
  toHeaders :: UpdateFunction -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON UpdateFunction where
  toJSON :: UpdateFunction -> Value
toJSON UpdateFunction' {Maybe Natural
Maybe Text
Maybe AppSyncRuntime
Maybe SyncConfig
Text
dataSourceName :: Text
functionId :: Text
name :: Text
apiId :: Text
syncConfig :: Maybe SyncConfig
runtime :: Maybe AppSyncRuntime
responseMappingTemplate :: Maybe Text
requestMappingTemplate :: Maybe Text
maxBatchSize :: Maybe Natural
functionVersion :: Maybe Text
description :: Maybe Text
code :: Maybe Text
$sel:dataSourceName:UpdateFunction' :: UpdateFunction -> Text
$sel:functionId:UpdateFunction' :: UpdateFunction -> Text
$sel:name:UpdateFunction' :: UpdateFunction -> Text
$sel:apiId:UpdateFunction' :: UpdateFunction -> Text
$sel:syncConfig:UpdateFunction' :: UpdateFunction -> Maybe SyncConfig
$sel:runtime:UpdateFunction' :: UpdateFunction -> Maybe AppSyncRuntime
$sel:responseMappingTemplate:UpdateFunction' :: UpdateFunction -> Maybe Text
$sel:requestMappingTemplate:UpdateFunction' :: UpdateFunction -> Maybe Text
$sel:maxBatchSize:UpdateFunction' :: UpdateFunction -> Maybe Natural
$sel:functionVersion:UpdateFunction' :: UpdateFunction -> Maybe Text
$sel:description:UpdateFunction' :: UpdateFunction -> Maybe Text
$sel:code:UpdateFunction' :: UpdateFunction -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"code" 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
code,
            (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
"functionVersion" 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
functionVersion,
            (Key
"maxBatchSize" 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
maxBatchSize,
            (Key
"requestMappingTemplate" 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
requestMappingTemplate,
            (Key
"responseMappingTemplate" 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
responseMappingTemplate,
            (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 AppSyncRuntime
runtime,
            (Key
"syncConfig" 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 SyncConfig
syncConfig,
            forall a. a -> Maybe a
Prelude.Just (Key
"name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
name),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"dataSourceName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
dataSourceName)
          ]
      )

instance Data.ToPath UpdateFunction where
  toPath :: UpdateFunction -> ByteString
toPath UpdateFunction' {Maybe Natural
Maybe Text
Maybe AppSyncRuntime
Maybe SyncConfig
Text
dataSourceName :: Text
functionId :: Text
name :: Text
apiId :: Text
syncConfig :: Maybe SyncConfig
runtime :: Maybe AppSyncRuntime
responseMappingTemplate :: Maybe Text
requestMappingTemplate :: Maybe Text
maxBatchSize :: Maybe Natural
functionVersion :: Maybe Text
description :: Maybe Text
code :: Maybe Text
$sel:dataSourceName:UpdateFunction' :: UpdateFunction -> Text
$sel:functionId:UpdateFunction' :: UpdateFunction -> Text
$sel:name:UpdateFunction' :: UpdateFunction -> Text
$sel:apiId:UpdateFunction' :: UpdateFunction -> Text
$sel:syncConfig:UpdateFunction' :: UpdateFunction -> Maybe SyncConfig
$sel:runtime:UpdateFunction' :: UpdateFunction -> Maybe AppSyncRuntime
$sel:responseMappingTemplate:UpdateFunction' :: UpdateFunction -> Maybe Text
$sel:requestMappingTemplate:UpdateFunction' :: UpdateFunction -> Maybe Text
$sel:maxBatchSize:UpdateFunction' :: UpdateFunction -> Maybe Natural
$sel:functionVersion:UpdateFunction' :: UpdateFunction -> Maybe Text
$sel:description:UpdateFunction' :: UpdateFunction -> Maybe Text
$sel:code:UpdateFunction' :: UpdateFunction -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/v1/apis/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
apiId,
        ByteString
"/functions/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
functionId
      ]

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

-- | /See:/ 'newUpdateFunctionResponse' smart constructor.
data UpdateFunctionResponse = UpdateFunctionResponse'
  { -- | The @Function@ object.
    UpdateFunctionResponse -> Maybe FunctionConfiguration
functionConfiguration :: Prelude.Maybe FunctionConfiguration,
    -- | 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:
--
-- 'functionConfiguration', 'updateFunctionResponse_functionConfiguration' - The @Function@ object.
--
-- 'httpStatus', 'updateFunctionResponse_httpStatus' - The response's http status code.
newUpdateFunctionResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UpdateFunctionResponse
newUpdateFunctionResponse :: Int -> UpdateFunctionResponse
newUpdateFunctionResponse Int
pHttpStatus_ =
  UpdateFunctionResponse'
    { $sel:functionConfiguration:UpdateFunctionResponse' :: Maybe FunctionConfiguration
functionConfiguration =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:UpdateFunctionResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The @Function@ object.
updateFunctionResponse_functionConfiguration :: Lens.Lens' UpdateFunctionResponse (Prelude.Maybe FunctionConfiguration)
updateFunctionResponse_functionConfiguration :: Lens' UpdateFunctionResponse (Maybe FunctionConfiguration)
updateFunctionResponse_functionConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateFunctionResponse' {Maybe FunctionConfiguration
functionConfiguration :: Maybe FunctionConfiguration
$sel:functionConfiguration:UpdateFunctionResponse' :: UpdateFunctionResponse -> Maybe FunctionConfiguration
functionConfiguration} -> Maybe FunctionConfiguration
functionConfiguration) (\s :: UpdateFunctionResponse
s@UpdateFunctionResponse' {} Maybe FunctionConfiguration
a -> UpdateFunctionResponse
s {$sel:functionConfiguration:UpdateFunctionResponse' :: Maybe FunctionConfiguration
functionConfiguration = Maybe FunctionConfiguration
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 FunctionConfiguration
httpStatus :: Int
functionConfiguration :: Maybe FunctionConfiguration
$sel:httpStatus:UpdateFunctionResponse' :: UpdateFunctionResponse -> Int
$sel:functionConfiguration:UpdateFunctionResponse' :: UpdateFunctionResponse -> Maybe FunctionConfiguration
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe FunctionConfiguration
functionConfiguration
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus