{-# 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.GetEventSourceMapping
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Returns details about an event source mapping. You can get the
-- identifier of a mapping from the output of ListEventSourceMappings.
module Amazonka.Lambda.GetEventSourceMapping
  ( -- * Creating a Request
    GetEventSourceMapping (..),
    newGetEventSourceMapping,

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

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

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

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

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

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

instance Data.ToPath GetEventSourceMapping where
  toPath :: GetEventSourceMapping -> ByteString
toPath GetEventSourceMapping' {Text
uuid :: Text
$sel:uuid:GetEventSourceMapping' :: GetEventSourceMapping -> 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 GetEventSourceMapping where
  toQuery :: GetEventSourceMapping -> QueryString
toQuery = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty