{-# 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.APIGateway.PutIntegration
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Sets up a method\'s integration.
module Amazonka.APIGateway.PutIntegration
  ( -- * Creating a Request
    PutIntegration (..),
    newPutIntegration,

    -- * Request Lenses
    putIntegration_cacheKeyParameters,
    putIntegration_cacheNamespace,
    putIntegration_connectionId,
    putIntegration_connectionType,
    putIntegration_contentHandling,
    putIntegration_credentials,
    putIntegration_integrationHttpMethod,
    putIntegration_passthroughBehavior,
    putIntegration_requestParameters,
    putIntegration_requestTemplates,
    putIntegration_timeoutInMillis,
    putIntegration_tlsConfig,
    putIntegration_uri,
    putIntegration_restApiId,
    putIntegration_resourceId,
    putIntegration_httpMethod,
    putIntegration_type,

    -- * Destructuring the Response
    Integration (..),
    newIntegration,

    -- * Response Lenses
    integration_cacheKeyParameters,
    integration_cacheNamespace,
    integration_connectionId,
    integration_connectionType,
    integration_contentHandling,
    integration_credentials,
    integration_httpMethod,
    integration_integrationResponses,
    integration_passthroughBehavior,
    integration_requestParameters,
    integration_requestTemplates,
    integration_timeoutInMillis,
    integration_tlsConfig,
    integration_type,
    integration_uri,
  )
where

import Amazonka.APIGateway.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

-- | Sets up a method\'s integration.
--
-- /See:/ 'newPutIntegration' smart constructor.
data PutIntegration = PutIntegration'
  { -- | A list of request parameters whose values API Gateway caches. To be
    -- valid values for @cacheKeyParameters@, these parameters must also be
    -- specified for Method @requestParameters@.
    PutIntegration -> Maybe [Text]
cacheKeyParameters :: Prelude.Maybe [Prelude.Text],
    -- | Specifies a group of related cached parameters. By default, API Gateway
    -- uses the resource ID as the @cacheNamespace@. You can specify the same
    -- @cacheNamespace@ across resources to return the same cached data for
    -- requests to different resources.
    PutIntegration -> Maybe Text
cacheNamespace :: Prelude.Maybe Prelude.Text,
    -- | The ID of the VpcLink used for the integration. Specify this value only
    -- if you specify @VPC_LINK@ as the connection type.
    PutIntegration -> Maybe Text
connectionId :: Prelude.Maybe Prelude.Text,
    -- | The type of the network connection to the integration endpoint. The
    -- valid value is @INTERNET@ for connections through the public routable
    -- internet or @VPC_LINK@ for private connections between API Gateway and a
    -- network load balancer in a VPC. The default value is @INTERNET@.
    PutIntegration -> Maybe ConnectionType
connectionType :: Prelude.Maybe ConnectionType,
    -- | Specifies how to handle request payload content type conversions.
    -- Supported values are @CONVERT_TO_BINARY@ and @CONVERT_TO_TEXT@, with the
    -- following behaviors:
    --
    -- If this property is not defined, the request payload will be passed
    -- through from the method request to integration request without
    -- modification, provided that the @passthroughBehavior@ is configured to
    -- support payload pass-through.
    PutIntegration -> Maybe ContentHandlingStrategy
contentHandling :: Prelude.Maybe ContentHandlingStrategy,
    -- | Specifies whether credentials are required for a put integration.
    PutIntegration -> Maybe Text
credentials :: Prelude.Maybe Prelude.Text,
    -- | The HTTP method for the integration.
    PutIntegration -> Maybe Text
integrationHttpMethod :: Prelude.Maybe Prelude.Text,
    -- | Specifies the pass-through behavior for incoming requests based on the
    -- Content-Type header in the request, and the available mapping templates
    -- specified as the @requestTemplates@ property on the Integration
    -- resource. There are three valid values: @WHEN_NO_MATCH@,
    -- @WHEN_NO_TEMPLATES@, and @NEVER@.
    PutIntegration -> Maybe Text
passthroughBehavior :: Prelude.Maybe Prelude.Text,
    -- | A key-value map specifying request parameters that are passed from the
    -- method request to the back end. The key is an integration request
    -- parameter name and the associated value is a method request parameter
    -- value or static value that must be enclosed within single quotes and
    -- pre-encoded as required by the back end. The method request parameter
    -- value must match the pattern of @method.request.{location}.{name}@,
    -- where @location@ is @querystring@, @path@, or @header@ and @name@ must
    -- be a valid and unique method request parameter name.
    PutIntegration -> Maybe (HashMap Text Text)
requestParameters :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | Represents a map of Velocity templates that are applied on the request
    -- payload based on the value of the Content-Type header sent by the
    -- client. The content type value is the key in this map, and the template
    -- (as a String) is the value.
    PutIntegration -> Maybe (HashMap Text Text)
requestTemplates :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | Custom timeout between 50 and 29,000 milliseconds. The default value is
    -- 29,000 milliseconds or 29 seconds.
    PutIntegration -> Maybe Int
timeoutInMillis :: Prelude.Maybe Prelude.Int,
    PutIntegration -> Maybe TlsConfig
tlsConfig :: Prelude.Maybe TlsConfig,
    -- | Specifies Uniform Resource Identifier (URI) of the integration endpoint.
    -- For HTTP or @HTTP_PROXY@ integrations, the URI must be a fully formed,
    -- encoded HTTP(S) URL according to the RFC-3986 specification, for either
    -- standard integration, where @connectionType@ is not @VPC_LINK@, or
    -- private integration, where @connectionType@ is @VPC_LINK@. For a private
    -- HTTP integration, the URI is not used for routing. For @AWS@ or
    -- @AWS_PROXY@ integrations, the URI is of the form
    -- @arn:aws:apigateway:{region}:{subdomain.service|service}:path|action\/{service_api@}.
    -- Here, {Region} is the API Gateway region (e.g., us-east-1); {service} is
    -- the name of the integrated Amazon Web Services service (e.g., s3); and
    -- {subdomain} is a designated subdomain supported by certain Amazon Web
    -- Services service for fast host-name lookup. action can be used for an
    -- Amazon Web Services service action-based API, using an
    -- Action={name}&{p1}={v1}&p2={v2}... query string. The ensuing
    -- {service_api} refers to a supported action {name} plus any required
    -- input parameters. Alternatively, path can be used for an Amazon Web
    -- Services service path-based API. The ensuing service_api refers to the
    -- path to an Amazon Web Services service resource, including the region of
    -- the integrated Amazon Web Services service, if applicable. For example,
    -- for integration with the S3 API of @GetObject@, the @uri@ can be either
    -- @arn:aws:apigateway:us-west-2:s3:action\/GetObject&Bucket={bucket}&Key={key}@
    -- or @arn:aws:apigateway:us-west-2:s3:path\/{bucket}\/{key}@.
    PutIntegration -> Maybe Text
uri :: Prelude.Maybe Prelude.Text,
    -- | The string identifier of the associated RestApi.
    PutIntegration -> Text
restApiId :: Prelude.Text,
    -- | Specifies a put integration request\'s resource ID.
    PutIntegration -> Text
resourceId :: Prelude.Text,
    -- | Specifies the HTTP method for the integration.
    PutIntegration -> Text
httpMethod :: Prelude.Text,
    -- | Specifies a put integration input\'s type.
    PutIntegration -> IntegrationType
type' :: IntegrationType
  }
  deriving (PutIntegration -> PutIntegration -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PutIntegration -> PutIntegration -> Bool
$c/= :: PutIntegration -> PutIntegration -> Bool
== :: PutIntegration -> PutIntegration -> Bool
$c== :: PutIntegration -> PutIntegration -> Bool
Prelude.Eq, ReadPrec [PutIntegration]
ReadPrec PutIntegration
Int -> ReadS PutIntegration
ReadS [PutIntegration]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PutIntegration]
$creadListPrec :: ReadPrec [PutIntegration]
readPrec :: ReadPrec PutIntegration
$creadPrec :: ReadPrec PutIntegration
readList :: ReadS [PutIntegration]
$creadList :: ReadS [PutIntegration]
readsPrec :: Int -> ReadS PutIntegration
$creadsPrec :: Int -> ReadS PutIntegration
Prelude.Read, Int -> PutIntegration -> ShowS
[PutIntegration] -> ShowS
PutIntegration -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PutIntegration] -> ShowS
$cshowList :: [PutIntegration] -> ShowS
show :: PutIntegration -> String
$cshow :: PutIntegration -> String
showsPrec :: Int -> PutIntegration -> ShowS
$cshowsPrec :: Int -> PutIntegration -> ShowS
Prelude.Show, forall x. Rep PutIntegration x -> PutIntegration
forall x. PutIntegration -> Rep PutIntegration x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PutIntegration x -> PutIntegration
$cfrom :: forall x. PutIntegration -> Rep PutIntegration x
Prelude.Generic)

-- |
-- Create a value of 'PutIntegration' 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:
--
-- 'cacheKeyParameters', 'putIntegration_cacheKeyParameters' - A list of request parameters whose values API Gateway caches. To be
-- valid values for @cacheKeyParameters@, these parameters must also be
-- specified for Method @requestParameters@.
--
-- 'cacheNamespace', 'putIntegration_cacheNamespace' - Specifies a group of related cached parameters. By default, API Gateway
-- uses the resource ID as the @cacheNamespace@. You can specify the same
-- @cacheNamespace@ across resources to return the same cached data for
-- requests to different resources.
--
-- 'connectionId', 'putIntegration_connectionId' - The ID of the VpcLink used for the integration. Specify this value only
-- if you specify @VPC_LINK@ as the connection type.
--
-- 'connectionType', 'putIntegration_connectionType' - The type of the network connection to the integration endpoint. The
-- valid value is @INTERNET@ for connections through the public routable
-- internet or @VPC_LINK@ for private connections between API Gateway and a
-- network load balancer in a VPC. The default value is @INTERNET@.
--
-- 'contentHandling', 'putIntegration_contentHandling' - Specifies how to handle request payload content type conversions.
-- Supported values are @CONVERT_TO_BINARY@ and @CONVERT_TO_TEXT@, with the
-- following behaviors:
--
-- If this property is not defined, the request payload will be passed
-- through from the method request to integration request without
-- modification, provided that the @passthroughBehavior@ is configured to
-- support payload pass-through.
--
-- 'credentials', 'putIntegration_credentials' - Specifies whether credentials are required for a put integration.
--
-- 'integrationHttpMethod', 'putIntegration_integrationHttpMethod' - The HTTP method for the integration.
--
-- 'passthroughBehavior', 'putIntegration_passthroughBehavior' - Specifies the pass-through behavior for incoming requests based on the
-- Content-Type header in the request, and the available mapping templates
-- specified as the @requestTemplates@ property on the Integration
-- resource. There are three valid values: @WHEN_NO_MATCH@,
-- @WHEN_NO_TEMPLATES@, and @NEVER@.
--
-- 'requestParameters', 'putIntegration_requestParameters' - A key-value map specifying request parameters that are passed from the
-- method request to the back end. The key is an integration request
-- parameter name and the associated value is a method request parameter
-- value or static value that must be enclosed within single quotes and
-- pre-encoded as required by the back end. The method request parameter
-- value must match the pattern of @method.request.{location}.{name}@,
-- where @location@ is @querystring@, @path@, or @header@ and @name@ must
-- be a valid and unique method request parameter name.
--
-- 'requestTemplates', 'putIntegration_requestTemplates' - Represents a map of Velocity templates that are applied on the request
-- payload based on the value of the Content-Type header sent by the
-- client. The content type value is the key in this map, and the template
-- (as a String) is the value.
--
-- 'timeoutInMillis', 'putIntegration_timeoutInMillis' - Custom timeout between 50 and 29,000 milliseconds. The default value is
-- 29,000 milliseconds or 29 seconds.
--
-- 'tlsConfig', 'putIntegration_tlsConfig' - Undocumented member.
--
-- 'uri', 'putIntegration_uri' - Specifies Uniform Resource Identifier (URI) of the integration endpoint.
-- For HTTP or @HTTP_PROXY@ integrations, the URI must be a fully formed,
-- encoded HTTP(S) URL according to the RFC-3986 specification, for either
-- standard integration, where @connectionType@ is not @VPC_LINK@, or
-- private integration, where @connectionType@ is @VPC_LINK@. For a private
-- HTTP integration, the URI is not used for routing. For @AWS@ or
-- @AWS_PROXY@ integrations, the URI is of the form
-- @arn:aws:apigateway:{region}:{subdomain.service|service}:path|action\/{service_api@}.
-- Here, {Region} is the API Gateway region (e.g., us-east-1); {service} is
-- the name of the integrated Amazon Web Services service (e.g., s3); and
-- {subdomain} is a designated subdomain supported by certain Amazon Web
-- Services service for fast host-name lookup. action can be used for an
-- Amazon Web Services service action-based API, using an
-- Action={name}&{p1}={v1}&p2={v2}... query string. The ensuing
-- {service_api} refers to a supported action {name} plus any required
-- input parameters. Alternatively, path can be used for an Amazon Web
-- Services service path-based API. The ensuing service_api refers to the
-- path to an Amazon Web Services service resource, including the region of
-- the integrated Amazon Web Services service, if applicable. For example,
-- for integration with the S3 API of @GetObject@, the @uri@ can be either
-- @arn:aws:apigateway:us-west-2:s3:action\/GetObject&Bucket={bucket}&Key={key}@
-- or @arn:aws:apigateway:us-west-2:s3:path\/{bucket}\/{key}@.
--
-- 'restApiId', 'putIntegration_restApiId' - The string identifier of the associated RestApi.
--
-- 'resourceId', 'putIntegration_resourceId' - Specifies a put integration request\'s resource ID.
--
-- 'httpMethod', 'putIntegration_httpMethod' - Specifies the HTTP method for the integration.
--
-- 'type'', 'putIntegration_type' - Specifies a put integration input\'s type.
newPutIntegration ::
  -- | 'restApiId'
  Prelude.Text ->
  -- | 'resourceId'
  Prelude.Text ->
  -- | 'httpMethod'
  Prelude.Text ->
  -- | 'type''
  IntegrationType ->
  PutIntegration
newPutIntegration :: Text -> Text -> Text -> IntegrationType -> PutIntegration
newPutIntegration
  Text
pRestApiId_
  Text
pResourceId_
  Text
pHttpMethod_
  IntegrationType
pType_ =
    PutIntegration'
      { $sel:cacheKeyParameters:PutIntegration' :: Maybe [Text]
cacheKeyParameters =
          forall a. Maybe a
Prelude.Nothing,
        $sel:cacheNamespace:PutIntegration' :: Maybe Text
cacheNamespace = forall a. Maybe a
Prelude.Nothing,
        $sel:connectionId:PutIntegration' :: Maybe Text
connectionId = forall a. Maybe a
Prelude.Nothing,
        $sel:connectionType:PutIntegration' :: Maybe ConnectionType
connectionType = forall a. Maybe a
Prelude.Nothing,
        $sel:contentHandling:PutIntegration' :: Maybe ContentHandlingStrategy
contentHandling = forall a. Maybe a
Prelude.Nothing,
        $sel:credentials:PutIntegration' :: Maybe Text
credentials = forall a. Maybe a
Prelude.Nothing,
        $sel:integrationHttpMethod:PutIntegration' :: Maybe Text
integrationHttpMethod = forall a. Maybe a
Prelude.Nothing,
        $sel:passthroughBehavior:PutIntegration' :: Maybe Text
passthroughBehavior = forall a. Maybe a
Prelude.Nothing,
        $sel:requestParameters:PutIntegration' :: Maybe (HashMap Text Text)
requestParameters = forall a. Maybe a
Prelude.Nothing,
        $sel:requestTemplates:PutIntegration' :: Maybe (HashMap Text Text)
requestTemplates = forall a. Maybe a
Prelude.Nothing,
        $sel:timeoutInMillis:PutIntegration' :: Maybe Int
timeoutInMillis = forall a. Maybe a
Prelude.Nothing,
        $sel:tlsConfig:PutIntegration' :: Maybe TlsConfig
tlsConfig = forall a. Maybe a
Prelude.Nothing,
        $sel:uri:PutIntegration' :: Maybe Text
uri = forall a. Maybe a
Prelude.Nothing,
        $sel:restApiId:PutIntegration' :: Text
restApiId = Text
pRestApiId_,
        $sel:resourceId:PutIntegration' :: Text
resourceId = Text
pResourceId_,
        $sel:httpMethod:PutIntegration' :: Text
httpMethod = Text
pHttpMethod_,
        $sel:type':PutIntegration' :: IntegrationType
type' = IntegrationType
pType_
      }

-- | A list of request parameters whose values API Gateway caches. To be
-- valid values for @cacheKeyParameters@, these parameters must also be
-- specified for Method @requestParameters@.
putIntegration_cacheKeyParameters :: Lens.Lens' PutIntegration (Prelude.Maybe [Prelude.Text])
putIntegration_cacheKeyParameters :: Lens' PutIntegration (Maybe [Text])
putIntegration_cacheKeyParameters = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutIntegration' {Maybe [Text]
cacheKeyParameters :: Maybe [Text]
$sel:cacheKeyParameters:PutIntegration' :: PutIntegration -> Maybe [Text]
cacheKeyParameters} -> Maybe [Text]
cacheKeyParameters) (\s :: PutIntegration
s@PutIntegration' {} Maybe [Text]
a -> PutIntegration
s {$sel:cacheKeyParameters:PutIntegration' :: Maybe [Text]
cacheKeyParameters = Maybe [Text]
a} :: PutIntegration) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | Specifies a group of related cached parameters. By default, API Gateway
-- uses the resource ID as the @cacheNamespace@. You can specify the same
-- @cacheNamespace@ across resources to return the same cached data for
-- requests to different resources.
putIntegration_cacheNamespace :: Lens.Lens' PutIntegration (Prelude.Maybe Prelude.Text)
putIntegration_cacheNamespace :: Lens' PutIntegration (Maybe Text)
putIntegration_cacheNamespace = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutIntegration' {Maybe Text
cacheNamespace :: Maybe Text
$sel:cacheNamespace:PutIntegration' :: PutIntegration -> Maybe Text
cacheNamespace} -> Maybe Text
cacheNamespace) (\s :: PutIntegration
s@PutIntegration' {} Maybe Text
a -> PutIntegration
s {$sel:cacheNamespace:PutIntegration' :: Maybe Text
cacheNamespace = Maybe Text
a} :: PutIntegration)

-- | The ID of the VpcLink used for the integration. Specify this value only
-- if you specify @VPC_LINK@ as the connection type.
putIntegration_connectionId :: Lens.Lens' PutIntegration (Prelude.Maybe Prelude.Text)
putIntegration_connectionId :: Lens' PutIntegration (Maybe Text)
putIntegration_connectionId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutIntegration' {Maybe Text
connectionId :: Maybe Text
$sel:connectionId:PutIntegration' :: PutIntegration -> Maybe Text
connectionId} -> Maybe Text
connectionId) (\s :: PutIntegration
s@PutIntegration' {} Maybe Text
a -> PutIntegration
s {$sel:connectionId:PutIntegration' :: Maybe Text
connectionId = Maybe Text
a} :: PutIntegration)

-- | The type of the network connection to the integration endpoint. The
-- valid value is @INTERNET@ for connections through the public routable
-- internet or @VPC_LINK@ for private connections between API Gateway and a
-- network load balancer in a VPC. The default value is @INTERNET@.
putIntegration_connectionType :: Lens.Lens' PutIntegration (Prelude.Maybe ConnectionType)
putIntegration_connectionType :: Lens' PutIntegration (Maybe ConnectionType)
putIntegration_connectionType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutIntegration' {Maybe ConnectionType
connectionType :: Maybe ConnectionType
$sel:connectionType:PutIntegration' :: PutIntegration -> Maybe ConnectionType
connectionType} -> Maybe ConnectionType
connectionType) (\s :: PutIntegration
s@PutIntegration' {} Maybe ConnectionType
a -> PutIntegration
s {$sel:connectionType:PutIntegration' :: Maybe ConnectionType
connectionType = Maybe ConnectionType
a} :: PutIntegration)

-- | Specifies how to handle request payload content type conversions.
-- Supported values are @CONVERT_TO_BINARY@ and @CONVERT_TO_TEXT@, with the
-- following behaviors:
--
-- If this property is not defined, the request payload will be passed
-- through from the method request to integration request without
-- modification, provided that the @passthroughBehavior@ is configured to
-- support payload pass-through.
putIntegration_contentHandling :: Lens.Lens' PutIntegration (Prelude.Maybe ContentHandlingStrategy)
putIntegration_contentHandling :: Lens' PutIntegration (Maybe ContentHandlingStrategy)
putIntegration_contentHandling = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutIntegration' {Maybe ContentHandlingStrategy
contentHandling :: Maybe ContentHandlingStrategy
$sel:contentHandling:PutIntegration' :: PutIntegration -> Maybe ContentHandlingStrategy
contentHandling} -> Maybe ContentHandlingStrategy
contentHandling) (\s :: PutIntegration
s@PutIntegration' {} Maybe ContentHandlingStrategy
a -> PutIntegration
s {$sel:contentHandling:PutIntegration' :: Maybe ContentHandlingStrategy
contentHandling = Maybe ContentHandlingStrategy
a} :: PutIntegration)

-- | Specifies whether credentials are required for a put integration.
putIntegration_credentials :: Lens.Lens' PutIntegration (Prelude.Maybe Prelude.Text)
putIntegration_credentials :: Lens' PutIntegration (Maybe Text)
putIntegration_credentials = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutIntegration' {Maybe Text
credentials :: Maybe Text
$sel:credentials:PutIntegration' :: PutIntegration -> Maybe Text
credentials} -> Maybe Text
credentials) (\s :: PutIntegration
s@PutIntegration' {} Maybe Text
a -> PutIntegration
s {$sel:credentials:PutIntegration' :: Maybe Text
credentials = Maybe Text
a} :: PutIntegration)

-- | The HTTP method for the integration.
putIntegration_integrationHttpMethod :: Lens.Lens' PutIntegration (Prelude.Maybe Prelude.Text)
putIntegration_integrationHttpMethod :: Lens' PutIntegration (Maybe Text)
putIntegration_integrationHttpMethod = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutIntegration' {Maybe Text
integrationHttpMethod :: Maybe Text
$sel:integrationHttpMethod:PutIntegration' :: PutIntegration -> Maybe Text
integrationHttpMethod} -> Maybe Text
integrationHttpMethod) (\s :: PutIntegration
s@PutIntegration' {} Maybe Text
a -> PutIntegration
s {$sel:integrationHttpMethod:PutIntegration' :: Maybe Text
integrationHttpMethod = Maybe Text
a} :: PutIntegration)

-- | Specifies the pass-through behavior for incoming requests based on the
-- Content-Type header in the request, and the available mapping templates
-- specified as the @requestTemplates@ property on the Integration
-- resource. There are three valid values: @WHEN_NO_MATCH@,
-- @WHEN_NO_TEMPLATES@, and @NEVER@.
putIntegration_passthroughBehavior :: Lens.Lens' PutIntegration (Prelude.Maybe Prelude.Text)
putIntegration_passthroughBehavior :: Lens' PutIntegration (Maybe Text)
putIntegration_passthroughBehavior = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutIntegration' {Maybe Text
passthroughBehavior :: Maybe Text
$sel:passthroughBehavior:PutIntegration' :: PutIntegration -> Maybe Text
passthroughBehavior} -> Maybe Text
passthroughBehavior) (\s :: PutIntegration
s@PutIntegration' {} Maybe Text
a -> PutIntegration
s {$sel:passthroughBehavior:PutIntegration' :: Maybe Text
passthroughBehavior = Maybe Text
a} :: PutIntegration)

-- | A key-value map specifying request parameters that are passed from the
-- method request to the back end. The key is an integration request
-- parameter name and the associated value is a method request parameter
-- value or static value that must be enclosed within single quotes and
-- pre-encoded as required by the back end. The method request parameter
-- value must match the pattern of @method.request.{location}.{name}@,
-- where @location@ is @querystring@, @path@, or @header@ and @name@ must
-- be a valid and unique method request parameter name.
putIntegration_requestParameters :: Lens.Lens' PutIntegration (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
putIntegration_requestParameters :: Lens' PutIntegration (Maybe (HashMap Text Text))
putIntegration_requestParameters = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutIntegration' {Maybe (HashMap Text Text)
requestParameters :: Maybe (HashMap Text Text)
$sel:requestParameters:PutIntegration' :: PutIntegration -> Maybe (HashMap Text Text)
requestParameters} -> Maybe (HashMap Text Text)
requestParameters) (\s :: PutIntegration
s@PutIntegration' {} Maybe (HashMap Text Text)
a -> PutIntegration
s {$sel:requestParameters:PutIntegration' :: Maybe (HashMap Text Text)
requestParameters = Maybe (HashMap Text Text)
a} :: PutIntegration) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | Represents a map of Velocity templates that are applied on the request
-- payload based on the value of the Content-Type header sent by the
-- client. The content type value is the key in this map, and the template
-- (as a String) is the value.
putIntegration_requestTemplates :: Lens.Lens' PutIntegration (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
putIntegration_requestTemplates :: Lens' PutIntegration (Maybe (HashMap Text Text))
putIntegration_requestTemplates = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutIntegration' {Maybe (HashMap Text Text)
requestTemplates :: Maybe (HashMap Text Text)
$sel:requestTemplates:PutIntegration' :: PutIntegration -> Maybe (HashMap Text Text)
requestTemplates} -> Maybe (HashMap Text Text)
requestTemplates) (\s :: PutIntegration
s@PutIntegration' {} Maybe (HashMap Text Text)
a -> PutIntegration
s {$sel:requestTemplates:PutIntegration' :: Maybe (HashMap Text Text)
requestTemplates = Maybe (HashMap Text Text)
a} :: PutIntegration) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | Custom timeout between 50 and 29,000 milliseconds. The default value is
-- 29,000 milliseconds or 29 seconds.
putIntegration_timeoutInMillis :: Lens.Lens' PutIntegration (Prelude.Maybe Prelude.Int)
putIntegration_timeoutInMillis :: Lens' PutIntegration (Maybe Int)
putIntegration_timeoutInMillis = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutIntegration' {Maybe Int
timeoutInMillis :: Maybe Int
$sel:timeoutInMillis:PutIntegration' :: PutIntegration -> Maybe Int
timeoutInMillis} -> Maybe Int
timeoutInMillis) (\s :: PutIntegration
s@PutIntegration' {} Maybe Int
a -> PutIntegration
s {$sel:timeoutInMillis:PutIntegration' :: Maybe Int
timeoutInMillis = Maybe Int
a} :: PutIntegration)

-- | Undocumented member.
putIntegration_tlsConfig :: Lens.Lens' PutIntegration (Prelude.Maybe TlsConfig)
putIntegration_tlsConfig :: Lens' PutIntegration (Maybe TlsConfig)
putIntegration_tlsConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutIntegration' {Maybe TlsConfig
tlsConfig :: Maybe TlsConfig
$sel:tlsConfig:PutIntegration' :: PutIntegration -> Maybe TlsConfig
tlsConfig} -> Maybe TlsConfig
tlsConfig) (\s :: PutIntegration
s@PutIntegration' {} Maybe TlsConfig
a -> PutIntegration
s {$sel:tlsConfig:PutIntegration' :: Maybe TlsConfig
tlsConfig = Maybe TlsConfig
a} :: PutIntegration)

-- | Specifies Uniform Resource Identifier (URI) of the integration endpoint.
-- For HTTP or @HTTP_PROXY@ integrations, the URI must be a fully formed,
-- encoded HTTP(S) URL according to the RFC-3986 specification, for either
-- standard integration, where @connectionType@ is not @VPC_LINK@, or
-- private integration, where @connectionType@ is @VPC_LINK@. For a private
-- HTTP integration, the URI is not used for routing. For @AWS@ or
-- @AWS_PROXY@ integrations, the URI is of the form
-- @arn:aws:apigateway:{region}:{subdomain.service|service}:path|action\/{service_api@}.
-- Here, {Region} is the API Gateway region (e.g., us-east-1); {service} is
-- the name of the integrated Amazon Web Services service (e.g., s3); and
-- {subdomain} is a designated subdomain supported by certain Amazon Web
-- Services service for fast host-name lookup. action can be used for an
-- Amazon Web Services service action-based API, using an
-- Action={name}&{p1}={v1}&p2={v2}... query string. The ensuing
-- {service_api} refers to a supported action {name} plus any required
-- input parameters. Alternatively, path can be used for an Amazon Web
-- Services service path-based API. The ensuing service_api refers to the
-- path to an Amazon Web Services service resource, including the region of
-- the integrated Amazon Web Services service, if applicable. For example,
-- for integration with the S3 API of @GetObject@, the @uri@ can be either
-- @arn:aws:apigateway:us-west-2:s3:action\/GetObject&Bucket={bucket}&Key={key}@
-- or @arn:aws:apigateway:us-west-2:s3:path\/{bucket}\/{key}@.
putIntegration_uri :: Lens.Lens' PutIntegration (Prelude.Maybe Prelude.Text)
putIntegration_uri :: Lens' PutIntegration (Maybe Text)
putIntegration_uri = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutIntegration' {Maybe Text
uri :: Maybe Text
$sel:uri:PutIntegration' :: PutIntegration -> Maybe Text
uri} -> Maybe Text
uri) (\s :: PutIntegration
s@PutIntegration' {} Maybe Text
a -> PutIntegration
s {$sel:uri:PutIntegration' :: Maybe Text
uri = Maybe Text
a} :: PutIntegration)

-- | The string identifier of the associated RestApi.
putIntegration_restApiId :: Lens.Lens' PutIntegration Prelude.Text
putIntegration_restApiId :: Lens' PutIntegration Text
putIntegration_restApiId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutIntegration' {Text
restApiId :: Text
$sel:restApiId:PutIntegration' :: PutIntegration -> Text
restApiId} -> Text
restApiId) (\s :: PutIntegration
s@PutIntegration' {} Text
a -> PutIntegration
s {$sel:restApiId:PutIntegration' :: Text
restApiId = Text
a} :: PutIntegration)

-- | Specifies a put integration request\'s resource ID.
putIntegration_resourceId :: Lens.Lens' PutIntegration Prelude.Text
putIntegration_resourceId :: Lens' PutIntegration Text
putIntegration_resourceId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutIntegration' {Text
resourceId :: Text
$sel:resourceId:PutIntegration' :: PutIntegration -> Text
resourceId} -> Text
resourceId) (\s :: PutIntegration
s@PutIntegration' {} Text
a -> PutIntegration
s {$sel:resourceId:PutIntegration' :: Text
resourceId = Text
a} :: PutIntegration)

-- | Specifies the HTTP method for the integration.
putIntegration_httpMethod :: Lens.Lens' PutIntegration Prelude.Text
putIntegration_httpMethod :: Lens' PutIntegration Text
putIntegration_httpMethod = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutIntegration' {Text
httpMethod :: Text
$sel:httpMethod:PutIntegration' :: PutIntegration -> Text
httpMethod} -> Text
httpMethod) (\s :: PutIntegration
s@PutIntegration' {} Text
a -> PutIntegration
s {$sel:httpMethod:PutIntegration' :: Text
httpMethod = Text
a} :: PutIntegration)

-- | Specifies a put integration input\'s type.
putIntegration_type :: Lens.Lens' PutIntegration IntegrationType
putIntegration_type :: Lens' PutIntegration IntegrationType
putIntegration_type = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutIntegration' {IntegrationType
type' :: IntegrationType
$sel:type':PutIntegration' :: PutIntegration -> IntegrationType
type'} -> IntegrationType
type') (\s :: PutIntegration
s@PutIntegration' {} IntegrationType
a -> PutIntegration
s {$sel:type':PutIntegration' :: IntegrationType
type' = IntegrationType
a} :: PutIntegration)

instance Core.AWSRequest PutIntegration where
  type AWSResponse PutIntegration = Integration
  request :: (Service -> Service) -> PutIntegration -> Request PutIntegration
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.putJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy PutIntegration
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse PutIntegration)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> Object -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveJSON
      (\Int
s ResponseHeaders
h Object
x -> forall a. FromJSON a => Object -> Either String a
Data.eitherParseJSON Object
x)

instance Prelude.Hashable PutIntegration where
  hashWithSalt :: Int -> PutIntegration -> Int
hashWithSalt Int
_salt PutIntegration' {Maybe Int
Maybe [Text]
Maybe Text
Maybe (HashMap Text Text)
Maybe ConnectionType
Maybe ContentHandlingStrategy
Maybe TlsConfig
Text
IntegrationType
type' :: IntegrationType
httpMethod :: Text
resourceId :: Text
restApiId :: Text
uri :: Maybe Text
tlsConfig :: Maybe TlsConfig
timeoutInMillis :: Maybe Int
requestTemplates :: Maybe (HashMap Text Text)
requestParameters :: Maybe (HashMap Text Text)
passthroughBehavior :: Maybe Text
integrationHttpMethod :: Maybe Text
credentials :: Maybe Text
contentHandling :: Maybe ContentHandlingStrategy
connectionType :: Maybe ConnectionType
connectionId :: Maybe Text
cacheNamespace :: Maybe Text
cacheKeyParameters :: Maybe [Text]
$sel:type':PutIntegration' :: PutIntegration -> IntegrationType
$sel:httpMethod:PutIntegration' :: PutIntegration -> Text
$sel:resourceId:PutIntegration' :: PutIntegration -> Text
$sel:restApiId:PutIntegration' :: PutIntegration -> Text
$sel:uri:PutIntegration' :: PutIntegration -> Maybe Text
$sel:tlsConfig:PutIntegration' :: PutIntegration -> Maybe TlsConfig
$sel:timeoutInMillis:PutIntegration' :: PutIntegration -> Maybe Int
$sel:requestTemplates:PutIntegration' :: PutIntegration -> Maybe (HashMap Text Text)
$sel:requestParameters:PutIntegration' :: PutIntegration -> Maybe (HashMap Text Text)
$sel:passthroughBehavior:PutIntegration' :: PutIntegration -> Maybe Text
$sel:integrationHttpMethod:PutIntegration' :: PutIntegration -> Maybe Text
$sel:credentials:PutIntegration' :: PutIntegration -> Maybe Text
$sel:contentHandling:PutIntegration' :: PutIntegration -> Maybe ContentHandlingStrategy
$sel:connectionType:PutIntegration' :: PutIntegration -> Maybe ConnectionType
$sel:connectionId:PutIntegration' :: PutIntegration -> Maybe Text
$sel:cacheNamespace:PutIntegration' :: PutIntegration -> Maybe Text
$sel:cacheKeyParameters:PutIntegration' :: PutIntegration -> Maybe [Text]
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
cacheKeyParameters
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
cacheNamespace
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
connectionId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ConnectionType
connectionType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ContentHandlingStrategy
contentHandling
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
credentials
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
integrationHttpMethod
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
passthroughBehavior
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Text)
requestParameters
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Text)
requestTemplates
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
timeoutInMillis
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe TlsConfig
tlsConfig
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
uri
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
restApiId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
resourceId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
httpMethod
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` IntegrationType
type'

instance Prelude.NFData PutIntegration where
  rnf :: PutIntegration -> ()
rnf PutIntegration' {Maybe Int
Maybe [Text]
Maybe Text
Maybe (HashMap Text Text)
Maybe ConnectionType
Maybe ContentHandlingStrategy
Maybe TlsConfig
Text
IntegrationType
type' :: IntegrationType
httpMethod :: Text
resourceId :: Text
restApiId :: Text
uri :: Maybe Text
tlsConfig :: Maybe TlsConfig
timeoutInMillis :: Maybe Int
requestTemplates :: Maybe (HashMap Text Text)
requestParameters :: Maybe (HashMap Text Text)
passthroughBehavior :: Maybe Text
integrationHttpMethod :: Maybe Text
credentials :: Maybe Text
contentHandling :: Maybe ContentHandlingStrategy
connectionType :: Maybe ConnectionType
connectionId :: Maybe Text
cacheNamespace :: Maybe Text
cacheKeyParameters :: Maybe [Text]
$sel:type':PutIntegration' :: PutIntegration -> IntegrationType
$sel:httpMethod:PutIntegration' :: PutIntegration -> Text
$sel:resourceId:PutIntegration' :: PutIntegration -> Text
$sel:restApiId:PutIntegration' :: PutIntegration -> Text
$sel:uri:PutIntegration' :: PutIntegration -> Maybe Text
$sel:tlsConfig:PutIntegration' :: PutIntegration -> Maybe TlsConfig
$sel:timeoutInMillis:PutIntegration' :: PutIntegration -> Maybe Int
$sel:requestTemplates:PutIntegration' :: PutIntegration -> Maybe (HashMap Text Text)
$sel:requestParameters:PutIntegration' :: PutIntegration -> Maybe (HashMap Text Text)
$sel:passthroughBehavior:PutIntegration' :: PutIntegration -> Maybe Text
$sel:integrationHttpMethod:PutIntegration' :: PutIntegration -> Maybe Text
$sel:credentials:PutIntegration' :: PutIntegration -> Maybe Text
$sel:contentHandling:PutIntegration' :: PutIntegration -> Maybe ContentHandlingStrategy
$sel:connectionType:PutIntegration' :: PutIntegration -> Maybe ConnectionType
$sel:connectionId:PutIntegration' :: PutIntegration -> Maybe Text
$sel:cacheNamespace:PutIntegration' :: PutIntegration -> Maybe Text
$sel:cacheKeyParameters:PutIntegration' :: PutIntegration -> Maybe [Text]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
cacheKeyParameters
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
cacheNamespace
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
connectionId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ConnectionType
connectionType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ContentHandlingStrategy
contentHandling
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
credentials
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
integrationHttpMethod
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
passthroughBehavior
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text Text)
requestParameters
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text Text)
requestTemplates
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
timeoutInMillis
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe TlsConfig
tlsConfig
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
uri
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
restApiId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
resourceId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
httpMethod
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf IntegrationType
type'

instance Data.ToHeaders PutIntegration where
  toHeaders :: PutIntegration -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"Accept"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# (ByteString
"application/json" :: Prelude.ByteString)
          ]
      )

instance Data.ToJSON PutIntegration where
  toJSON :: PutIntegration -> Value
toJSON PutIntegration' {Maybe Int
Maybe [Text]
Maybe Text
Maybe (HashMap Text Text)
Maybe ConnectionType
Maybe ContentHandlingStrategy
Maybe TlsConfig
Text
IntegrationType
type' :: IntegrationType
httpMethod :: Text
resourceId :: Text
restApiId :: Text
uri :: Maybe Text
tlsConfig :: Maybe TlsConfig
timeoutInMillis :: Maybe Int
requestTemplates :: Maybe (HashMap Text Text)
requestParameters :: Maybe (HashMap Text Text)
passthroughBehavior :: Maybe Text
integrationHttpMethod :: Maybe Text
credentials :: Maybe Text
contentHandling :: Maybe ContentHandlingStrategy
connectionType :: Maybe ConnectionType
connectionId :: Maybe Text
cacheNamespace :: Maybe Text
cacheKeyParameters :: Maybe [Text]
$sel:type':PutIntegration' :: PutIntegration -> IntegrationType
$sel:httpMethod:PutIntegration' :: PutIntegration -> Text
$sel:resourceId:PutIntegration' :: PutIntegration -> Text
$sel:restApiId:PutIntegration' :: PutIntegration -> Text
$sel:uri:PutIntegration' :: PutIntegration -> Maybe Text
$sel:tlsConfig:PutIntegration' :: PutIntegration -> Maybe TlsConfig
$sel:timeoutInMillis:PutIntegration' :: PutIntegration -> Maybe Int
$sel:requestTemplates:PutIntegration' :: PutIntegration -> Maybe (HashMap Text Text)
$sel:requestParameters:PutIntegration' :: PutIntegration -> Maybe (HashMap Text Text)
$sel:passthroughBehavior:PutIntegration' :: PutIntegration -> Maybe Text
$sel:integrationHttpMethod:PutIntegration' :: PutIntegration -> Maybe Text
$sel:credentials:PutIntegration' :: PutIntegration -> Maybe Text
$sel:contentHandling:PutIntegration' :: PutIntegration -> Maybe ContentHandlingStrategy
$sel:connectionType:PutIntegration' :: PutIntegration -> Maybe ConnectionType
$sel:connectionId:PutIntegration' :: PutIntegration -> Maybe Text
$sel:cacheNamespace:PutIntegration' :: PutIntegration -> Maybe Text
$sel:cacheKeyParameters:PutIntegration' :: PutIntegration -> Maybe [Text]
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"cacheKeyParameters" 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]
cacheKeyParameters,
            (Key
"cacheNamespace" 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
cacheNamespace,
            (Key
"connectionId" 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
connectionId,
            (Key
"connectionType" 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 ConnectionType
connectionType,
            (Key
"contentHandling" 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 ContentHandlingStrategy
contentHandling,
            (Key
"credentials" 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
credentials,
            (Key
"httpMethod" 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
integrationHttpMethod,
            (Key
"passthroughBehavior" 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
passthroughBehavior,
            (Key
"requestParameters" 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 (HashMap Text Text)
requestParameters,
            (Key
"requestTemplates" 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 (HashMap Text Text)
requestTemplates,
            (Key
"timeoutInMillis" 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 Int
timeoutInMillis,
            (Key
"tlsConfig" 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 TlsConfig
tlsConfig,
            (Key
"uri" 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
uri,
            forall a. a -> Maybe a
Prelude.Just (Key
"type" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= IntegrationType
type')
          ]
      )

instance Data.ToPath PutIntegration where
  toPath :: PutIntegration -> ByteString
toPath PutIntegration' {Maybe Int
Maybe [Text]
Maybe Text
Maybe (HashMap Text Text)
Maybe ConnectionType
Maybe ContentHandlingStrategy
Maybe TlsConfig
Text
IntegrationType
type' :: IntegrationType
httpMethod :: Text
resourceId :: Text
restApiId :: Text
uri :: Maybe Text
tlsConfig :: Maybe TlsConfig
timeoutInMillis :: Maybe Int
requestTemplates :: Maybe (HashMap Text Text)
requestParameters :: Maybe (HashMap Text Text)
passthroughBehavior :: Maybe Text
integrationHttpMethod :: Maybe Text
credentials :: Maybe Text
contentHandling :: Maybe ContentHandlingStrategy
connectionType :: Maybe ConnectionType
connectionId :: Maybe Text
cacheNamespace :: Maybe Text
cacheKeyParameters :: Maybe [Text]
$sel:type':PutIntegration' :: PutIntegration -> IntegrationType
$sel:httpMethod:PutIntegration' :: PutIntegration -> Text
$sel:resourceId:PutIntegration' :: PutIntegration -> Text
$sel:restApiId:PutIntegration' :: PutIntegration -> Text
$sel:uri:PutIntegration' :: PutIntegration -> Maybe Text
$sel:tlsConfig:PutIntegration' :: PutIntegration -> Maybe TlsConfig
$sel:timeoutInMillis:PutIntegration' :: PutIntegration -> Maybe Int
$sel:requestTemplates:PutIntegration' :: PutIntegration -> Maybe (HashMap Text Text)
$sel:requestParameters:PutIntegration' :: PutIntegration -> Maybe (HashMap Text Text)
$sel:passthroughBehavior:PutIntegration' :: PutIntegration -> Maybe Text
$sel:integrationHttpMethod:PutIntegration' :: PutIntegration -> Maybe Text
$sel:credentials:PutIntegration' :: PutIntegration -> Maybe Text
$sel:contentHandling:PutIntegration' :: PutIntegration -> Maybe ContentHandlingStrategy
$sel:connectionType:PutIntegration' :: PutIntegration -> Maybe ConnectionType
$sel:connectionId:PutIntegration' :: PutIntegration -> Maybe Text
$sel:cacheNamespace:PutIntegration' :: PutIntegration -> Maybe Text
$sel:cacheKeyParameters:PutIntegration' :: PutIntegration -> Maybe [Text]
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/restapis/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
restApiId,
        ByteString
"/resources/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
resourceId,
        ByteString
"/methods/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
httpMethod,
        ByteString
"/integration"
      ]

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