{-# 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.ListEventSourceMappings
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Lists event source mappings. Specify an @EventSourceArn@ to show only
-- event source mappings for a single event source.
--
-- This operation returns paginated results.
module Amazonka.Lambda.ListEventSourceMappings
  ( -- * Creating a Request
    ListEventSourceMappings (..),
    newListEventSourceMappings,

    -- * Request Lenses
    listEventSourceMappings_eventSourceArn,
    listEventSourceMappings_functionName,
    listEventSourceMappings_marker,
    listEventSourceMappings_maxItems,

    -- * Destructuring the Response
    ListEventSourceMappingsResponse (..),
    newListEventSourceMappingsResponse,

    -- * Response Lenses
    listEventSourceMappingsResponse_eventSourceMappings,
    listEventSourceMappingsResponse_nextMarker,
    listEventSourceMappingsResponse_httpStatus,
  )
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:/ 'newListEventSourceMappings' smart constructor.
data ListEventSourceMappings = ListEventSourceMappings'
  { -- | The Amazon Resource Name (ARN) of the event source.
    --
    -- -   __Amazon Kinesis__ - The ARN of the data stream or a stream
    --     consumer.
    --
    -- -   __Amazon DynamoDB Streams__ - The ARN of the stream.
    --
    -- -   __Amazon Simple Queue Service__ - The ARN of the queue.
    --
    -- -   __Amazon Managed Streaming for Apache Kafka__ - The ARN of the
    --     cluster.
    --
    -- -   __Amazon MQ__ - The ARN of the broker.
    ListEventSourceMappings -> Maybe Text
eventSourceArn :: Prelude.Maybe Prelude.Text,
    -- | The name of the Lambda function.
    --
    -- __Name formats__
    --
    -- -   __Function name__ - @MyFunction@.
    --
    -- -   __Function ARN__ -
    --     @arn:aws:lambda:us-west-2:123456789012:function:MyFunction@.
    --
    -- -   __Version or Alias ARN__ -
    --     @arn:aws:lambda:us-west-2:123456789012:function:MyFunction:PROD@.
    --
    -- -   __Partial ARN__ - @123456789012:function:MyFunction@.
    --
    -- The length constraint applies only to the full ARN. If you specify only
    -- the function name, it\'s limited to 64 characters in length.
    ListEventSourceMappings -> Maybe Text
functionName :: Prelude.Maybe Prelude.Text,
    -- | A pagination token returned by a previous call.
    ListEventSourceMappings -> Maybe Text
marker :: Prelude.Maybe Prelude.Text,
    -- | The maximum number of event source mappings to return. Note that
    -- ListEventSourceMappings returns a maximum of 100 items in each response,
    -- even if you set the number higher.
    ListEventSourceMappings -> Maybe Natural
maxItems :: Prelude.Maybe Prelude.Natural
  }
  deriving (ListEventSourceMappings -> ListEventSourceMappings -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListEventSourceMappings -> ListEventSourceMappings -> Bool
$c/= :: ListEventSourceMappings -> ListEventSourceMappings -> Bool
== :: ListEventSourceMappings -> ListEventSourceMappings -> Bool
$c== :: ListEventSourceMappings -> ListEventSourceMappings -> Bool
Prelude.Eq, ReadPrec [ListEventSourceMappings]
ReadPrec ListEventSourceMappings
Int -> ReadS ListEventSourceMappings
ReadS [ListEventSourceMappings]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListEventSourceMappings]
$creadListPrec :: ReadPrec [ListEventSourceMappings]
readPrec :: ReadPrec ListEventSourceMappings
$creadPrec :: ReadPrec ListEventSourceMappings
readList :: ReadS [ListEventSourceMappings]
$creadList :: ReadS [ListEventSourceMappings]
readsPrec :: Int -> ReadS ListEventSourceMappings
$creadsPrec :: Int -> ReadS ListEventSourceMappings
Prelude.Read, Int -> ListEventSourceMappings -> ShowS
[ListEventSourceMappings] -> ShowS
ListEventSourceMappings -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListEventSourceMappings] -> ShowS
$cshowList :: [ListEventSourceMappings] -> ShowS
show :: ListEventSourceMappings -> String
$cshow :: ListEventSourceMappings -> String
showsPrec :: Int -> ListEventSourceMappings -> ShowS
$cshowsPrec :: Int -> ListEventSourceMappings -> ShowS
Prelude.Show, forall x. Rep ListEventSourceMappings x -> ListEventSourceMappings
forall x. ListEventSourceMappings -> Rep ListEventSourceMappings x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListEventSourceMappings x -> ListEventSourceMappings
$cfrom :: forall x. ListEventSourceMappings -> Rep ListEventSourceMappings x
Prelude.Generic)

-- |
-- Create a value of 'ListEventSourceMappings' 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:
--
-- 'eventSourceArn', 'listEventSourceMappings_eventSourceArn' - The Amazon Resource Name (ARN) of the event source.
--
-- -   __Amazon Kinesis__ - The ARN of the data stream or a stream
--     consumer.
--
-- -   __Amazon DynamoDB Streams__ - The ARN of the stream.
--
-- -   __Amazon Simple Queue Service__ - The ARN of the queue.
--
-- -   __Amazon Managed Streaming for Apache Kafka__ - The ARN of the
--     cluster.
--
-- -   __Amazon MQ__ - The ARN of the broker.
--
-- 'functionName', 'listEventSourceMappings_functionName' - The name of the Lambda function.
--
-- __Name formats__
--
-- -   __Function name__ - @MyFunction@.
--
-- -   __Function ARN__ -
--     @arn:aws:lambda:us-west-2:123456789012:function:MyFunction@.
--
-- -   __Version or Alias ARN__ -
--     @arn:aws:lambda:us-west-2:123456789012:function:MyFunction:PROD@.
--
-- -   __Partial ARN__ - @123456789012:function:MyFunction@.
--
-- The length constraint applies only to the full ARN. If you specify only
-- the function name, it\'s limited to 64 characters in length.
--
-- 'marker', 'listEventSourceMappings_marker' - A pagination token returned by a previous call.
--
-- 'maxItems', 'listEventSourceMappings_maxItems' - The maximum number of event source mappings to return. Note that
-- ListEventSourceMappings returns a maximum of 100 items in each response,
-- even if you set the number higher.
newListEventSourceMappings ::
  ListEventSourceMappings
newListEventSourceMappings :: ListEventSourceMappings
newListEventSourceMappings =
  ListEventSourceMappings'
    { $sel:eventSourceArn:ListEventSourceMappings' :: Maybe Text
eventSourceArn =
        forall a. Maybe a
Prelude.Nothing,
      $sel:functionName:ListEventSourceMappings' :: Maybe Text
functionName = forall a. Maybe a
Prelude.Nothing,
      $sel:marker:ListEventSourceMappings' :: Maybe Text
marker = forall a. Maybe a
Prelude.Nothing,
      $sel:maxItems:ListEventSourceMappings' :: Maybe Natural
maxItems = forall a. Maybe a
Prelude.Nothing
    }

-- | The Amazon Resource Name (ARN) of the event source.
--
-- -   __Amazon Kinesis__ - The ARN of the data stream or a stream
--     consumer.
--
-- -   __Amazon DynamoDB Streams__ - The ARN of the stream.
--
-- -   __Amazon Simple Queue Service__ - The ARN of the queue.
--
-- -   __Amazon Managed Streaming for Apache Kafka__ - The ARN of the
--     cluster.
--
-- -   __Amazon MQ__ - The ARN of the broker.
listEventSourceMappings_eventSourceArn :: Lens.Lens' ListEventSourceMappings (Prelude.Maybe Prelude.Text)
listEventSourceMappings_eventSourceArn :: Lens' ListEventSourceMappings (Maybe Text)
listEventSourceMappings_eventSourceArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListEventSourceMappings' {Maybe Text
eventSourceArn :: Maybe Text
$sel:eventSourceArn:ListEventSourceMappings' :: ListEventSourceMappings -> Maybe Text
eventSourceArn} -> Maybe Text
eventSourceArn) (\s :: ListEventSourceMappings
s@ListEventSourceMappings' {} Maybe Text
a -> ListEventSourceMappings
s {$sel:eventSourceArn:ListEventSourceMappings' :: Maybe Text
eventSourceArn = Maybe Text
a} :: ListEventSourceMappings)

-- | The name of the Lambda function.
--
-- __Name formats__
--
-- -   __Function name__ - @MyFunction@.
--
-- -   __Function ARN__ -
--     @arn:aws:lambda:us-west-2:123456789012:function:MyFunction@.
--
-- -   __Version or Alias ARN__ -
--     @arn:aws:lambda:us-west-2:123456789012:function:MyFunction:PROD@.
--
-- -   __Partial ARN__ - @123456789012:function:MyFunction@.
--
-- The length constraint applies only to the full ARN. If you specify only
-- the function name, it\'s limited to 64 characters in length.
listEventSourceMappings_functionName :: Lens.Lens' ListEventSourceMappings (Prelude.Maybe Prelude.Text)
listEventSourceMappings_functionName :: Lens' ListEventSourceMappings (Maybe Text)
listEventSourceMappings_functionName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListEventSourceMappings' {Maybe Text
functionName :: Maybe Text
$sel:functionName:ListEventSourceMappings' :: ListEventSourceMappings -> Maybe Text
functionName} -> Maybe Text
functionName) (\s :: ListEventSourceMappings
s@ListEventSourceMappings' {} Maybe Text
a -> ListEventSourceMappings
s {$sel:functionName:ListEventSourceMappings' :: Maybe Text
functionName = Maybe Text
a} :: ListEventSourceMappings)

-- | A pagination token returned by a previous call.
listEventSourceMappings_marker :: Lens.Lens' ListEventSourceMappings (Prelude.Maybe Prelude.Text)
listEventSourceMappings_marker :: Lens' ListEventSourceMappings (Maybe Text)
listEventSourceMappings_marker = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListEventSourceMappings' {Maybe Text
marker :: Maybe Text
$sel:marker:ListEventSourceMappings' :: ListEventSourceMappings -> Maybe Text
marker} -> Maybe Text
marker) (\s :: ListEventSourceMappings
s@ListEventSourceMappings' {} Maybe Text
a -> ListEventSourceMappings
s {$sel:marker:ListEventSourceMappings' :: Maybe Text
marker = Maybe Text
a} :: ListEventSourceMappings)

-- | The maximum number of event source mappings to return. Note that
-- ListEventSourceMappings returns a maximum of 100 items in each response,
-- even if you set the number higher.
listEventSourceMappings_maxItems :: Lens.Lens' ListEventSourceMappings (Prelude.Maybe Prelude.Natural)
listEventSourceMappings_maxItems :: Lens' ListEventSourceMappings (Maybe Natural)
listEventSourceMappings_maxItems = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListEventSourceMappings' {Maybe Natural
maxItems :: Maybe Natural
$sel:maxItems:ListEventSourceMappings' :: ListEventSourceMappings -> Maybe Natural
maxItems} -> Maybe Natural
maxItems) (\s :: ListEventSourceMappings
s@ListEventSourceMappings' {} Maybe Natural
a -> ListEventSourceMappings
s {$sel:maxItems:ListEventSourceMappings' :: Maybe Natural
maxItems = Maybe Natural
a} :: ListEventSourceMappings)

instance Core.AWSPager ListEventSourceMappings where
  page :: ListEventSourceMappings
-> AWSResponse ListEventSourceMappings
-> Maybe ListEventSourceMappings
page ListEventSourceMappings
rq AWSResponse ListEventSourceMappings
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse ListEventSourceMappings
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListEventSourceMappingsResponse (Maybe Text)
listEventSourceMappingsResponse_nextMarker
            forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
        ) =
        forall a. Maybe a
Prelude.Nothing
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse ListEventSourceMappings
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens'
  ListEventSourceMappingsResponse
  (Maybe [EventSourceMappingConfiguration])
listEventSourceMappingsResponse_eventSourceMappings
            forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
        ) =
        forall a. Maybe a
Prelude.Nothing
    | Bool
Prelude.otherwise =
        forall a. a -> Maybe a
Prelude.Just
          forall a b. (a -> b) -> a -> b
Prelude.$ ListEventSourceMappings
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' ListEventSourceMappings (Maybe Text)
listEventSourceMappings_marker
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse ListEventSourceMappings
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListEventSourceMappingsResponse (Maybe Text)
listEventSourceMappingsResponse_nextMarker
          forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just

instance Core.AWSRequest ListEventSourceMappings where
  type
    AWSResponse ListEventSourceMappings =
      ListEventSourceMappingsResponse
  request :: (Service -> Service)
-> ListEventSourceMappings -> Request ListEventSourceMappings
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 ListEventSourceMappings
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse ListEventSourceMappings)))
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 [EventSourceMappingConfiguration]
-> Maybe Text -> Int -> ListEventSourceMappingsResponse
ListEventSourceMappingsResponse'
            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
"EventSourceMappings"
                            forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty
                        )
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"NextMarker")
            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 ListEventSourceMappings where
  hashWithSalt :: Int -> ListEventSourceMappings -> Int
hashWithSalt Int
_salt ListEventSourceMappings' {Maybe Natural
Maybe Text
maxItems :: Maybe Natural
marker :: Maybe Text
functionName :: Maybe Text
eventSourceArn :: Maybe Text
$sel:maxItems:ListEventSourceMappings' :: ListEventSourceMappings -> Maybe Natural
$sel:marker:ListEventSourceMappings' :: ListEventSourceMappings -> Maybe Text
$sel:functionName:ListEventSourceMappings' :: ListEventSourceMappings -> Maybe Text
$sel:eventSourceArn:ListEventSourceMappings' :: ListEventSourceMappings -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
eventSourceArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
functionName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
marker
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
maxItems

instance Prelude.NFData ListEventSourceMappings where
  rnf :: ListEventSourceMappings -> ()
rnf ListEventSourceMappings' {Maybe Natural
Maybe Text
maxItems :: Maybe Natural
marker :: Maybe Text
functionName :: Maybe Text
eventSourceArn :: Maybe Text
$sel:maxItems:ListEventSourceMappings' :: ListEventSourceMappings -> Maybe Natural
$sel:marker:ListEventSourceMappings' :: ListEventSourceMappings -> Maybe Text
$sel:functionName:ListEventSourceMappings' :: ListEventSourceMappings -> Maybe Text
$sel:eventSourceArn:ListEventSourceMappings' :: ListEventSourceMappings -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
eventSourceArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
functionName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
marker
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
maxItems

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

instance Data.ToPath ListEventSourceMappings where
  toPath :: ListEventSourceMappings -> ByteString
toPath =
    forall a b. a -> b -> a
Prelude.const ByteString
"/2015-03-31/event-source-mappings/"

instance Data.ToQuery ListEventSourceMappings where
  toQuery :: ListEventSourceMappings -> QueryString
toQuery ListEventSourceMappings' {Maybe Natural
Maybe Text
maxItems :: Maybe Natural
marker :: Maybe Text
functionName :: Maybe Text
eventSourceArn :: Maybe Text
$sel:maxItems:ListEventSourceMappings' :: ListEventSourceMappings -> Maybe Natural
$sel:marker:ListEventSourceMappings' :: ListEventSourceMappings -> Maybe Text
$sel:functionName:ListEventSourceMappings' :: ListEventSourceMappings -> Maybe Text
$sel:eventSourceArn:ListEventSourceMappings' :: ListEventSourceMappings -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"EventSourceArn" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
eventSourceArn,
        ByteString
"FunctionName" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
functionName,
        ByteString
"Marker" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
marker,
        ByteString
"MaxItems" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Natural
maxItems
      ]

-- | /See:/ 'newListEventSourceMappingsResponse' smart constructor.
data ListEventSourceMappingsResponse = ListEventSourceMappingsResponse'
  { -- | A list of event source mappings.
    ListEventSourceMappingsResponse
-> Maybe [EventSourceMappingConfiguration]
eventSourceMappings :: Prelude.Maybe [EventSourceMappingConfiguration],
    -- | A pagination token that\'s returned when the response doesn\'t contain
    -- all event source mappings.
    ListEventSourceMappingsResponse -> Maybe Text
nextMarker :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    ListEventSourceMappingsResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ListEventSourceMappingsResponse
-> ListEventSourceMappingsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListEventSourceMappingsResponse
-> ListEventSourceMappingsResponse -> Bool
$c/= :: ListEventSourceMappingsResponse
-> ListEventSourceMappingsResponse -> Bool
== :: ListEventSourceMappingsResponse
-> ListEventSourceMappingsResponse -> Bool
$c== :: ListEventSourceMappingsResponse
-> ListEventSourceMappingsResponse -> Bool
Prelude.Eq, ReadPrec [ListEventSourceMappingsResponse]
ReadPrec ListEventSourceMappingsResponse
Int -> ReadS ListEventSourceMappingsResponse
ReadS [ListEventSourceMappingsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListEventSourceMappingsResponse]
$creadListPrec :: ReadPrec [ListEventSourceMappingsResponse]
readPrec :: ReadPrec ListEventSourceMappingsResponse
$creadPrec :: ReadPrec ListEventSourceMappingsResponse
readList :: ReadS [ListEventSourceMappingsResponse]
$creadList :: ReadS [ListEventSourceMappingsResponse]
readsPrec :: Int -> ReadS ListEventSourceMappingsResponse
$creadsPrec :: Int -> ReadS ListEventSourceMappingsResponse
Prelude.Read, Int -> ListEventSourceMappingsResponse -> ShowS
[ListEventSourceMappingsResponse] -> ShowS
ListEventSourceMappingsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListEventSourceMappingsResponse] -> ShowS
$cshowList :: [ListEventSourceMappingsResponse] -> ShowS
show :: ListEventSourceMappingsResponse -> String
$cshow :: ListEventSourceMappingsResponse -> String
showsPrec :: Int -> ListEventSourceMappingsResponse -> ShowS
$cshowsPrec :: Int -> ListEventSourceMappingsResponse -> ShowS
Prelude.Show, forall x.
Rep ListEventSourceMappingsResponse x
-> ListEventSourceMappingsResponse
forall x.
ListEventSourceMappingsResponse
-> Rep ListEventSourceMappingsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ListEventSourceMappingsResponse x
-> ListEventSourceMappingsResponse
$cfrom :: forall x.
ListEventSourceMappingsResponse
-> Rep ListEventSourceMappingsResponse x
Prelude.Generic)

-- |
-- Create a value of 'ListEventSourceMappingsResponse' 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:
--
-- 'eventSourceMappings', 'listEventSourceMappingsResponse_eventSourceMappings' - A list of event source mappings.
--
-- 'nextMarker', 'listEventSourceMappingsResponse_nextMarker' - A pagination token that\'s returned when the response doesn\'t contain
-- all event source mappings.
--
-- 'httpStatus', 'listEventSourceMappingsResponse_httpStatus' - The response's http status code.
newListEventSourceMappingsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ListEventSourceMappingsResponse
newListEventSourceMappingsResponse :: Int -> ListEventSourceMappingsResponse
newListEventSourceMappingsResponse Int
pHttpStatus_ =
  ListEventSourceMappingsResponse'
    { $sel:eventSourceMappings:ListEventSourceMappingsResponse' :: Maybe [EventSourceMappingConfiguration]
eventSourceMappings =
        forall a. Maybe a
Prelude.Nothing,
      $sel:nextMarker:ListEventSourceMappingsResponse' :: Maybe Text
nextMarker = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ListEventSourceMappingsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | A list of event source mappings.
listEventSourceMappingsResponse_eventSourceMappings :: Lens.Lens' ListEventSourceMappingsResponse (Prelude.Maybe [EventSourceMappingConfiguration])
listEventSourceMappingsResponse_eventSourceMappings :: Lens'
  ListEventSourceMappingsResponse
  (Maybe [EventSourceMappingConfiguration])
listEventSourceMappingsResponse_eventSourceMappings = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListEventSourceMappingsResponse' {Maybe [EventSourceMappingConfiguration]
eventSourceMappings :: Maybe [EventSourceMappingConfiguration]
$sel:eventSourceMappings:ListEventSourceMappingsResponse' :: ListEventSourceMappingsResponse
-> Maybe [EventSourceMappingConfiguration]
eventSourceMappings} -> Maybe [EventSourceMappingConfiguration]
eventSourceMappings) (\s :: ListEventSourceMappingsResponse
s@ListEventSourceMappingsResponse' {} Maybe [EventSourceMappingConfiguration]
a -> ListEventSourceMappingsResponse
s {$sel:eventSourceMappings:ListEventSourceMappingsResponse' :: Maybe [EventSourceMappingConfiguration]
eventSourceMappings = Maybe [EventSourceMappingConfiguration]
a} :: ListEventSourceMappingsResponse) 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

-- | A pagination token that\'s returned when the response doesn\'t contain
-- all event source mappings.
listEventSourceMappingsResponse_nextMarker :: Lens.Lens' ListEventSourceMappingsResponse (Prelude.Maybe Prelude.Text)
listEventSourceMappingsResponse_nextMarker :: Lens' ListEventSourceMappingsResponse (Maybe Text)
listEventSourceMappingsResponse_nextMarker = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListEventSourceMappingsResponse' {Maybe Text
nextMarker :: Maybe Text
$sel:nextMarker:ListEventSourceMappingsResponse' :: ListEventSourceMappingsResponse -> Maybe Text
nextMarker} -> Maybe Text
nextMarker) (\s :: ListEventSourceMappingsResponse
s@ListEventSourceMappingsResponse' {} Maybe Text
a -> ListEventSourceMappingsResponse
s {$sel:nextMarker:ListEventSourceMappingsResponse' :: Maybe Text
nextMarker = Maybe Text
a} :: ListEventSourceMappingsResponse)

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

instance
  Prelude.NFData
    ListEventSourceMappingsResponse
  where
  rnf :: ListEventSourceMappingsResponse -> ()
rnf ListEventSourceMappingsResponse' {Int
Maybe [EventSourceMappingConfiguration]
Maybe Text
httpStatus :: Int
nextMarker :: Maybe Text
eventSourceMappings :: Maybe [EventSourceMappingConfiguration]
$sel:httpStatus:ListEventSourceMappingsResponse' :: ListEventSourceMappingsResponse -> Int
$sel:nextMarker:ListEventSourceMappingsResponse' :: ListEventSourceMappingsResponse -> Maybe Text
$sel:eventSourceMappings:ListEventSourceMappingsResponse' :: ListEventSourceMappingsResponse
-> Maybe [EventSourceMappingConfiguration]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [EventSourceMappingConfiguration]
eventSourceMappings
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
nextMarker
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus