{-# 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.CreateFunction
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Creates a @Function@ object.
--
-- A function is a reusable entity. You can use multiple functions to
-- compose the resolver logic.
module Amazonka.AppSync.CreateFunction
  ( -- * Creating a Request
    CreateFunction (..),
    newCreateFunction,

    -- * Request Lenses
    createFunction_code,
    createFunction_description,
    createFunction_functionVersion,
    createFunction_maxBatchSize,
    createFunction_requestMappingTemplate,
    createFunction_responseMappingTemplate,
    createFunction_runtime,
    createFunction_syncConfig,
    createFunction_apiId,
    createFunction_name,
    createFunction_dataSourceName,

    -- * Destructuring the Response
    CreateFunctionResponse (..),
    newCreateFunctionResponse,

    -- * Response Lenses
    createFunctionResponse_functionConfiguration,
    createFunctionResponse_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:/ 'newCreateFunction' smart constructor.
data CreateFunction = CreateFunction'
  { -- | 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@.
    CreateFunction -> Maybe Text
code :: Prelude.Maybe Prelude.Text,
    -- | The @Function@ description.
    CreateFunction -> 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.
    CreateFunction -> Maybe Text
functionVersion :: Prelude.Maybe Prelude.Text,
    -- | The maximum batching size for a resolver.
    CreateFunction -> 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.
    CreateFunction -> Maybe Text
requestMappingTemplate :: Prelude.Maybe Prelude.Text,
    -- | The @Function@ response mapping template.
    CreateFunction -> Maybe Text
responseMappingTemplate :: Prelude.Maybe Prelude.Text,
    CreateFunction -> Maybe AppSyncRuntime
runtime :: Prelude.Maybe AppSyncRuntime,
    CreateFunction -> Maybe SyncConfig
syncConfig :: Prelude.Maybe SyncConfig,
    -- | The GraphQL API ID.
    CreateFunction -> Text
apiId :: Prelude.Text,
    -- | The @Function@ name. The function name does not have to be unique.
    CreateFunction -> Text
name :: Prelude.Text,
    -- | The @Function@ @DataSource@ name.
    CreateFunction -> Text
dataSourceName :: Prelude.Text
  }
  deriving (CreateFunction -> CreateFunction -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateFunction -> CreateFunction -> Bool
$c/= :: CreateFunction -> CreateFunction -> Bool
== :: CreateFunction -> CreateFunction -> Bool
$c== :: CreateFunction -> CreateFunction -> Bool
Prelude.Eq, ReadPrec [CreateFunction]
ReadPrec CreateFunction
Int -> ReadS CreateFunction
ReadS [CreateFunction]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateFunction]
$creadListPrec :: ReadPrec [CreateFunction]
readPrec :: ReadPrec CreateFunction
$creadPrec :: ReadPrec CreateFunction
readList :: ReadS [CreateFunction]
$creadList :: ReadS [CreateFunction]
readsPrec :: Int -> ReadS CreateFunction
$creadsPrec :: Int -> ReadS CreateFunction
Prelude.Read, Int -> CreateFunction -> ShowS
[CreateFunction] -> ShowS
CreateFunction -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateFunction] -> ShowS
$cshowList :: [CreateFunction] -> ShowS
show :: CreateFunction -> String
$cshow :: CreateFunction -> String
showsPrec :: Int -> CreateFunction -> ShowS
$cshowsPrec :: Int -> CreateFunction -> ShowS
Prelude.Show, forall x. Rep CreateFunction x -> CreateFunction
forall x. CreateFunction -> Rep CreateFunction x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateFunction x -> CreateFunction
$cfrom :: forall x. CreateFunction -> Rep CreateFunction x
Prelude.Generic)

-- |
-- Create a value of 'CreateFunction' with all optional fields omitted.
--
-- Use <https://hackage.haskell.org/package/generic-lens generic-lens> or <https://hackage.haskell.org/package/optics optics> to modify other optional fields.
--
-- The following record fields are available, with the corresponding lenses provided
-- for backwards compatibility:
--
-- 'code', 'createFunction_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', 'createFunction_description' - The @Function@ description.
--
-- 'functionVersion', 'createFunction_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', 'createFunction_maxBatchSize' - The maximum batching size for a resolver.
--
-- 'requestMappingTemplate', 'createFunction_requestMappingTemplate' - The @Function@ request mapping template. Functions support only the
-- 2018-05-29 version of the request mapping template.
--
-- 'responseMappingTemplate', 'createFunction_responseMappingTemplate' - The @Function@ response mapping template.
--
-- 'runtime', 'createFunction_runtime' - Undocumented member.
--
-- 'syncConfig', 'createFunction_syncConfig' - Undocumented member.
--
-- 'apiId', 'createFunction_apiId' - The GraphQL API ID.
--
-- 'name', 'createFunction_name' - The @Function@ name. The function name does not have to be unique.
--
-- 'dataSourceName', 'createFunction_dataSourceName' - The @Function@ @DataSource@ name.
newCreateFunction ::
  -- | 'apiId'
  Prelude.Text ->
  -- | 'name'
  Prelude.Text ->
  -- | 'dataSourceName'
  Prelude.Text ->
  CreateFunction
newCreateFunction :: Text -> Text -> Text -> CreateFunction
newCreateFunction Text
pApiId_ Text
pName_ Text
pDataSourceName_ =
  CreateFunction'
    { $sel:code:CreateFunction' :: Maybe Text
code = forall a. Maybe a
Prelude.Nothing,
      $sel:description:CreateFunction' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:functionVersion:CreateFunction' :: Maybe Text
functionVersion = forall a. Maybe a
Prelude.Nothing,
      $sel:maxBatchSize:CreateFunction' :: Maybe Natural
maxBatchSize = forall a. Maybe a
Prelude.Nothing,
      $sel:requestMappingTemplate:CreateFunction' :: Maybe Text
requestMappingTemplate = forall a. Maybe a
Prelude.Nothing,
      $sel:responseMappingTemplate:CreateFunction' :: Maybe Text
responseMappingTemplate = forall a. Maybe a
Prelude.Nothing,
      $sel:runtime:CreateFunction' :: Maybe AppSyncRuntime
runtime = forall a. Maybe a
Prelude.Nothing,
      $sel:syncConfig:CreateFunction' :: Maybe SyncConfig
syncConfig = forall a. Maybe a
Prelude.Nothing,
      $sel:apiId:CreateFunction' :: Text
apiId = Text
pApiId_,
      $sel:name:CreateFunction' :: Text
name = Text
pName_,
      $sel:dataSourceName:CreateFunction' :: 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@.
createFunction_code :: Lens.Lens' CreateFunction (Prelude.Maybe Prelude.Text)
createFunction_code :: Lens' CreateFunction (Maybe Text)
createFunction_code = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateFunction' {Maybe Text
code :: Maybe Text
$sel:code:CreateFunction' :: CreateFunction -> Maybe Text
code} -> Maybe Text
code) (\s :: CreateFunction
s@CreateFunction' {} Maybe Text
a -> CreateFunction
s {$sel:code:CreateFunction' :: Maybe Text
code = Maybe Text
a} :: CreateFunction)

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

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

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

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

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

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

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

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

-- | The @Function@ name. The function name does not have to be unique.
createFunction_name :: Lens.Lens' CreateFunction Prelude.Text
createFunction_name :: Lens' CreateFunction Text
createFunction_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateFunction' {Text
name :: Text
$sel:name:CreateFunction' :: CreateFunction -> Text
name} -> Text
name) (\s :: CreateFunction
s@CreateFunction' {} Text
a -> CreateFunction
s {$sel:name:CreateFunction' :: Text
name = Text
a} :: CreateFunction)

-- | The @Function@ @DataSource@ name.
createFunction_dataSourceName :: Lens.Lens' CreateFunction Prelude.Text
createFunction_dataSourceName :: Lens' CreateFunction Text
createFunction_dataSourceName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateFunction' {Text
dataSourceName :: Text
$sel:dataSourceName:CreateFunction' :: CreateFunction -> Text
dataSourceName} -> Text
dataSourceName) (\s :: CreateFunction
s@CreateFunction' {} Text
a -> CreateFunction
s {$sel:dataSourceName:CreateFunction' :: Text
dataSourceName = Text
a} :: CreateFunction)

instance Core.AWSRequest CreateFunction where
  type
    AWSResponse CreateFunction =
      CreateFunctionResponse
  request :: (Service -> Service) -> CreateFunction -> Request CreateFunction
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.postJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy CreateFunction
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CreateFunction)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> Object -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveJSON
      ( \Int
s ResponseHeaders
h Object
x ->
          Maybe FunctionConfiguration -> Int -> CreateFunctionResponse
CreateFunctionResponse'
            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 CreateFunction where
  hashWithSalt :: Int -> CreateFunction -> Int
hashWithSalt Int
_salt CreateFunction' {Maybe Natural
Maybe Text
Maybe AppSyncRuntime
Maybe SyncConfig
Text
dataSourceName :: 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:CreateFunction' :: CreateFunction -> Text
$sel:name:CreateFunction' :: CreateFunction -> Text
$sel:apiId:CreateFunction' :: CreateFunction -> Text
$sel:syncConfig:CreateFunction' :: CreateFunction -> Maybe SyncConfig
$sel:runtime:CreateFunction' :: CreateFunction -> Maybe AppSyncRuntime
$sel:responseMappingTemplate:CreateFunction' :: CreateFunction -> Maybe Text
$sel:requestMappingTemplate:CreateFunction' :: CreateFunction -> Maybe Text
$sel:maxBatchSize:CreateFunction' :: CreateFunction -> Maybe Natural
$sel:functionVersion:CreateFunction' :: CreateFunction -> Maybe Text
$sel:description:CreateFunction' :: CreateFunction -> Maybe Text
$sel:code:CreateFunction' :: CreateFunction -> 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
dataSourceName

instance Prelude.NFData CreateFunction where
  rnf :: CreateFunction -> ()
rnf CreateFunction' {Maybe Natural
Maybe Text
Maybe AppSyncRuntime
Maybe SyncConfig
Text
dataSourceName :: 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:CreateFunction' :: CreateFunction -> Text
$sel:name:CreateFunction' :: CreateFunction -> Text
$sel:apiId:CreateFunction' :: CreateFunction -> Text
$sel:syncConfig:CreateFunction' :: CreateFunction -> Maybe SyncConfig
$sel:runtime:CreateFunction' :: CreateFunction -> Maybe AppSyncRuntime
$sel:responseMappingTemplate:CreateFunction' :: CreateFunction -> Maybe Text
$sel:requestMappingTemplate:CreateFunction' :: CreateFunction -> Maybe Text
$sel:maxBatchSize:CreateFunction' :: CreateFunction -> Maybe Natural
$sel:functionVersion:CreateFunction' :: CreateFunction -> Maybe Text
$sel:description:CreateFunction' :: CreateFunction -> Maybe Text
$sel:code:CreateFunction' :: CreateFunction -> 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
dataSourceName

instance Data.ToHeaders CreateFunction where
  toHeaders :: CreateFunction -> 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 CreateFunction where
  toJSON :: CreateFunction -> Value
toJSON CreateFunction' {Maybe Natural
Maybe Text
Maybe AppSyncRuntime
Maybe SyncConfig
Text
dataSourceName :: 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:CreateFunction' :: CreateFunction -> Text
$sel:name:CreateFunction' :: CreateFunction -> Text
$sel:apiId:CreateFunction' :: CreateFunction -> Text
$sel:syncConfig:CreateFunction' :: CreateFunction -> Maybe SyncConfig
$sel:runtime:CreateFunction' :: CreateFunction -> Maybe AppSyncRuntime
$sel:responseMappingTemplate:CreateFunction' :: CreateFunction -> Maybe Text
$sel:requestMappingTemplate:CreateFunction' :: CreateFunction -> Maybe Text
$sel:maxBatchSize:CreateFunction' :: CreateFunction -> Maybe Natural
$sel:functionVersion:CreateFunction' :: CreateFunction -> Maybe Text
$sel:description:CreateFunction' :: CreateFunction -> Maybe Text
$sel:code:CreateFunction' :: CreateFunction -> 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 CreateFunction where
  toPath :: CreateFunction -> ByteString
toPath CreateFunction' {Maybe Natural
Maybe Text
Maybe AppSyncRuntime
Maybe SyncConfig
Text
dataSourceName :: 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:CreateFunction' :: CreateFunction -> Text
$sel:name:CreateFunction' :: CreateFunction -> Text
$sel:apiId:CreateFunction' :: CreateFunction -> Text
$sel:syncConfig:CreateFunction' :: CreateFunction -> Maybe SyncConfig
$sel:runtime:CreateFunction' :: CreateFunction -> Maybe AppSyncRuntime
$sel:responseMappingTemplate:CreateFunction' :: CreateFunction -> Maybe Text
$sel:requestMappingTemplate:CreateFunction' :: CreateFunction -> Maybe Text
$sel:maxBatchSize:CreateFunction' :: CreateFunction -> Maybe Natural
$sel:functionVersion:CreateFunction' :: CreateFunction -> Maybe Text
$sel:description:CreateFunction' :: CreateFunction -> Maybe Text
$sel:code:CreateFunction' :: CreateFunction -> 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"]

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

-- | /See:/ 'newCreateFunctionResponse' smart constructor.
data CreateFunctionResponse = CreateFunctionResponse'
  { -- | The @Function@ object.
    CreateFunctionResponse -> Maybe FunctionConfiguration
functionConfiguration :: Prelude.Maybe FunctionConfiguration,
    -- | The response's http status code.
    CreateFunctionResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CreateFunctionResponse -> CreateFunctionResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateFunctionResponse -> CreateFunctionResponse -> Bool
$c/= :: CreateFunctionResponse -> CreateFunctionResponse -> Bool
== :: CreateFunctionResponse -> CreateFunctionResponse -> Bool
$c== :: CreateFunctionResponse -> CreateFunctionResponse -> Bool
Prelude.Eq, ReadPrec [CreateFunctionResponse]
ReadPrec CreateFunctionResponse
Int -> ReadS CreateFunctionResponse
ReadS [CreateFunctionResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateFunctionResponse]
$creadListPrec :: ReadPrec [CreateFunctionResponse]
readPrec :: ReadPrec CreateFunctionResponse
$creadPrec :: ReadPrec CreateFunctionResponse
readList :: ReadS [CreateFunctionResponse]
$creadList :: ReadS [CreateFunctionResponse]
readsPrec :: Int -> ReadS CreateFunctionResponse
$creadsPrec :: Int -> ReadS CreateFunctionResponse
Prelude.Read, Int -> CreateFunctionResponse -> ShowS
[CreateFunctionResponse] -> ShowS
CreateFunctionResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateFunctionResponse] -> ShowS
$cshowList :: [CreateFunctionResponse] -> ShowS
show :: CreateFunctionResponse -> String
$cshow :: CreateFunctionResponse -> String
showsPrec :: Int -> CreateFunctionResponse -> ShowS
$cshowsPrec :: Int -> CreateFunctionResponse -> ShowS
Prelude.Show, forall x. Rep CreateFunctionResponse x -> CreateFunctionResponse
forall x. CreateFunctionResponse -> Rep CreateFunctionResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateFunctionResponse x -> CreateFunctionResponse
$cfrom :: forall x. CreateFunctionResponse -> Rep CreateFunctionResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateFunctionResponse' 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', 'createFunctionResponse_functionConfiguration' - The @Function@ object.
--
-- 'httpStatus', 'createFunctionResponse_httpStatus' - The response's http status code.
newCreateFunctionResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateFunctionResponse
newCreateFunctionResponse :: Int -> CreateFunctionResponse
newCreateFunctionResponse Int
pHttpStatus_ =
  CreateFunctionResponse'
    { $sel:functionConfiguration:CreateFunctionResponse' :: Maybe FunctionConfiguration
functionConfiguration =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateFunctionResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The @Function@ object.
createFunctionResponse_functionConfiguration :: Lens.Lens' CreateFunctionResponse (Prelude.Maybe FunctionConfiguration)
createFunctionResponse_functionConfiguration :: Lens' CreateFunctionResponse (Maybe FunctionConfiguration)
createFunctionResponse_functionConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateFunctionResponse' {Maybe FunctionConfiguration
functionConfiguration :: Maybe FunctionConfiguration
$sel:functionConfiguration:CreateFunctionResponse' :: CreateFunctionResponse -> Maybe FunctionConfiguration
functionConfiguration} -> Maybe FunctionConfiguration
functionConfiguration) (\s :: CreateFunctionResponse
s@CreateFunctionResponse' {} Maybe FunctionConfiguration
a -> CreateFunctionResponse
s {$sel:functionConfiguration:CreateFunctionResponse' :: Maybe FunctionConfiguration
functionConfiguration = Maybe FunctionConfiguration
a} :: CreateFunctionResponse)

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

instance Prelude.NFData CreateFunctionResponse where
  rnf :: CreateFunctionResponse -> ()
rnf CreateFunctionResponse' {Int
Maybe FunctionConfiguration
httpStatus :: Int
functionConfiguration :: Maybe FunctionConfiguration
$sel:httpStatus:CreateFunctionResponse' :: CreateFunctionResponse -> Int
$sel:functionConfiguration:CreateFunctionResponse' :: CreateFunctionResponse -> 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