{-# 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.Lambda.DeleteEventSourceMapping
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Deletes an
-- <https://docs.aws.amazon.com/lambda/latest/dg/intro-invocation-modes.html event source mapping>.
-- You can get the identifier of a mapping from the output of
-- ListEventSourceMappings.
--
-- When you delete an event source mapping, it enters a @Deleting@ state
-- and might not be completely deleted for several seconds.
module Amazonka.Lambda.DeleteEventSourceMapping
  ( -- * Creating a Request
    DeleteEventSourceMapping (..),
    newDeleteEventSourceMapping,

    -- * Request Lenses
    deleteEventSourceMapping_uuid,

    -- * Destructuring the Response
    EventSourceMappingConfiguration (..),
    newEventSourceMappingConfiguration,

    -- * Response Lenses
    eventSourceMappingConfiguration_amazonManagedKafkaEventSourceConfig,
    eventSourceMappingConfiguration_batchSize,
    eventSourceMappingConfiguration_bisectBatchOnFunctionError,
    eventSourceMappingConfiguration_destinationConfig,
    eventSourceMappingConfiguration_eventSourceArn,
    eventSourceMappingConfiguration_filterCriteria,
    eventSourceMappingConfiguration_functionArn,
    eventSourceMappingConfiguration_functionResponseTypes,
    eventSourceMappingConfiguration_lastModified,
    eventSourceMappingConfiguration_lastProcessingResult,
    eventSourceMappingConfiguration_maximumBatchingWindowInSeconds,
    eventSourceMappingConfiguration_maximumRecordAgeInSeconds,
    eventSourceMappingConfiguration_maximumRetryAttempts,
    eventSourceMappingConfiguration_parallelizationFactor,
    eventSourceMappingConfiguration_queues,
    eventSourceMappingConfiguration_selfManagedEventSource,
    eventSourceMappingConfiguration_selfManagedKafkaEventSourceConfig,
    eventSourceMappingConfiguration_sourceAccessConfigurations,
    eventSourceMappingConfiguration_startingPosition,
    eventSourceMappingConfiguration_startingPositionTimestamp,
    eventSourceMappingConfiguration_state,
    eventSourceMappingConfiguration_stateTransitionReason,
    eventSourceMappingConfiguration_topics,
    eventSourceMappingConfiguration_tumblingWindowInSeconds,
    eventSourceMappingConfiguration_uuid,
  )
where

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

-- | /See:/ 'newDeleteEventSourceMapping' smart constructor.
data DeleteEventSourceMapping = DeleteEventSourceMapping'
  { -- | The identifier of the event source mapping.
    DeleteEventSourceMapping -> Text
uuid :: Prelude.Text
  }
  deriving (DeleteEventSourceMapping -> DeleteEventSourceMapping -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeleteEventSourceMapping -> DeleteEventSourceMapping -> Bool
$c/= :: DeleteEventSourceMapping -> DeleteEventSourceMapping -> Bool
== :: DeleteEventSourceMapping -> DeleteEventSourceMapping -> Bool
$c== :: DeleteEventSourceMapping -> DeleteEventSourceMapping -> Bool
Prelude.Eq, ReadPrec [DeleteEventSourceMapping]
ReadPrec DeleteEventSourceMapping
Int -> ReadS DeleteEventSourceMapping
ReadS [DeleteEventSourceMapping]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeleteEventSourceMapping]
$creadListPrec :: ReadPrec [DeleteEventSourceMapping]
readPrec :: ReadPrec DeleteEventSourceMapping
$creadPrec :: ReadPrec DeleteEventSourceMapping
readList :: ReadS [DeleteEventSourceMapping]
$creadList :: ReadS [DeleteEventSourceMapping]
readsPrec :: Int -> ReadS DeleteEventSourceMapping
$creadsPrec :: Int -> ReadS DeleteEventSourceMapping
Prelude.Read, Int -> DeleteEventSourceMapping -> ShowS
[DeleteEventSourceMapping] -> ShowS
DeleteEventSourceMapping -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeleteEventSourceMapping] -> ShowS
$cshowList :: [DeleteEventSourceMapping] -> ShowS
show :: DeleteEventSourceMapping -> String
$cshow :: DeleteEventSourceMapping -> String
showsPrec :: Int -> DeleteEventSourceMapping -> ShowS
$cshowsPrec :: Int -> DeleteEventSourceMapping -> ShowS
Prelude.Show, forall x.
Rep DeleteEventSourceMapping x -> DeleteEventSourceMapping
forall x.
DeleteEventSourceMapping -> Rep DeleteEventSourceMapping x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DeleteEventSourceMapping x -> DeleteEventSourceMapping
$cfrom :: forall x.
DeleteEventSourceMapping -> Rep DeleteEventSourceMapping x
Prelude.Generic)

-- |
-- Create a value of 'DeleteEventSourceMapping' 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:
--
-- 'uuid', 'deleteEventSourceMapping_uuid' - The identifier of the event source mapping.
newDeleteEventSourceMapping ::
  -- | 'uuid'
  Prelude.Text ->
  DeleteEventSourceMapping
newDeleteEventSourceMapping :: Text -> DeleteEventSourceMapping
newDeleteEventSourceMapping Text
pUUID_ =
  DeleteEventSourceMapping' {$sel:uuid:DeleteEventSourceMapping' :: Text
uuid = Text
pUUID_}

-- | The identifier of the event source mapping.
deleteEventSourceMapping_uuid :: Lens.Lens' DeleteEventSourceMapping Prelude.Text
deleteEventSourceMapping_uuid :: Lens' DeleteEventSourceMapping Text
deleteEventSourceMapping_uuid = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteEventSourceMapping' {Text
uuid :: Text
$sel:uuid:DeleteEventSourceMapping' :: DeleteEventSourceMapping -> Text
uuid} -> Text
uuid) (\s :: DeleteEventSourceMapping
s@DeleteEventSourceMapping' {} Text
a -> DeleteEventSourceMapping
s {$sel:uuid:DeleteEventSourceMapping' :: Text
uuid = Text
a} :: DeleteEventSourceMapping)

instance Core.AWSRequest DeleteEventSourceMapping where
  type
    AWSResponse DeleteEventSourceMapping =
      EventSourceMappingConfiguration
  request :: (Service -> Service)
-> DeleteEventSourceMapping -> Request DeleteEventSourceMapping
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.delete (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy DeleteEventSourceMapping
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse DeleteEventSourceMapping)))
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 DeleteEventSourceMapping where
  hashWithSalt :: Int -> DeleteEventSourceMapping -> Int
hashWithSalt Int
_salt DeleteEventSourceMapping' {Text
uuid :: Text
$sel:uuid:DeleteEventSourceMapping' :: DeleteEventSourceMapping -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
uuid

instance Prelude.NFData DeleteEventSourceMapping where
  rnf :: DeleteEventSourceMapping -> ()
rnf DeleteEventSourceMapping' {Text
uuid :: Text
$sel:uuid:DeleteEventSourceMapping' :: DeleteEventSourceMapping -> Text
..} = forall a. NFData a => a -> ()
Prelude.rnf Text
uuid

instance Data.ToHeaders DeleteEventSourceMapping where
  toHeaders :: DeleteEventSourceMapping -> ResponseHeaders
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

instance Data.ToPath DeleteEventSourceMapping where
  toPath :: DeleteEventSourceMapping -> ByteString
toPath DeleteEventSourceMapping' {Text
uuid :: Text
$sel:uuid:DeleteEventSourceMapping' :: DeleteEventSourceMapping -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/2015-03-31/event-source-mappings/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
uuid
      ]

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