{-# 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.CloudWatchEvents.ListEventBuses
-- 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 all the event buses in your account, including the default event
-- bus, custom event buses, and partner event buses.
module Amazonka.CloudWatchEvents.ListEventBuses
  ( -- * Creating a Request
    ListEventBuses (..),
    newListEventBuses,

    -- * Request Lenses
    listEventBuses_limit,
    listEventBuses_namePrefix,
    listEventBuses_nextToken,

    -- * Destructuring the Response
    ListEventBusesResponse (..),
    newListEventBusesResponse,

    -- * Response Lenses
    listEventBusesResponse_eventBuses,
    listEventBusesResponse_nextToken,
    listEventBusesResponse_httpStatus,
  )
where

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

-- | /See:/ 'newListEventBuses' smart constructor.
data ListEventBuses = ListEventBuses'
  { -- | Specifying this limits the number of results returned by this operation.
    -- The operation also returns a NextToken which you can use in a subsequent
    -- operation to retrieve the next set of results.
    ListEventBuses -> Maybe Natural
limit :: Prelude.Maybe Prelude.Natural,
    -- | Specifying this limits the results to only those event buses with names
    -- that start with the specified prefix.
    ListEventBuses -> Maybe Text
namePrefix :: Prelude.Maybe Prelude.Text,
    -- | The token returned by a previous call to retrieve the next set of
    -- results.
    ListEventBuses -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text
  }
  deriving (ListEventBuses -> ListEventBuses -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListEventBuses -> ListEventBuses -> Bool
$c/= :: ListEventBuses -> ListEventBuses -> Bool
== :: ListEventBuses -> ListEventBuses -> Bool
$c== :: ListEventBuses -> ListEventBuses -> Bool
Prelude.Eq, ReadPrec [ListEventBuses]
ReadPrec ListEventBuses
Int -> ReadS ListEventBuses
ReadS [ListEventBuses]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListEventBuses]
$creadListPrec :: ReadPrec [ListEventBuses]
readPrec :: ReadPrec ListEventBuses
$creadPrec :: ReadPrec ListEventBuses
readList :: ReadS [ListEventBuses]
$creadList :: ReadS [ListEventBuses]
readsPrec :: Int -> ReadS ListEventBuses
$creadsPrec :: Int -> ReadS ListEventBuses
Prelude.Read, Int -> ListEventBuses -> ShowS
[ListEventBuses] -> ShowS
ListEventBuses -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListEventBuses] -> ShowS
$cshowList :: [ListEventBuses] -> ShowS
show :: ListEventBuses -> String
$cshow :: ListEventBuses -> String
showsPrec :: Int -> ListEventBuses -> ShowS
$cshowsPrec :: Int -> ListEventBuses -> ShowS
Prelude.Show, forall x. Rep ListEventBuses x -> ListEventBuses
forall x. ListEventBuses -> Rep ListEventBuses x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListEventBuses x -> ListEventBuses
$cfrom :: forall x. ListEventBuses -> Rep ListEventBuses x
Prelude.Generic)

-- |
-- Create a value of 'ListEventBuses' 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:
--
-- 'limit', 'listEventBuses_limit' - Specifying this limits the number of results returned by this operation.
-- The operation also returns a NextToken which you can use in a subsequent
-- operation to retrieve the next set of results.
--
-- 'namePrefix', 'listEventBuses_namePrefix' - Specifying this limits the results to only those event buses with names
-- that start with the specified prefix.
--
-- 'nextToken', 'listEventBuses_nextToken' - The token returned by a previous call to retrieve the next set of
-- results.
newListEventBuses ::
  ListEventBuses
newListEventBuses :: ListEventBuses
newListEventBuses =
  ListEventBuses'
    { $sel:limit:ListEventBuses' :: Maybe Natural
limit = forall a. Maybe a
Prelude.Nothing,
      $sel:namePrefix:ListEventBuses' :: Maybe Text
namePrefix = forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListEventBuses' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing
    }

-- | Specifying this limits the number of results returned by this operation.
-- The operation also returns a NextToken which you can use in a subsequent
-- operation to retrieve the next set of results.
listEventBuses_limit :: Lens.Lens' ListEventBuses (Prelude.Maybe Prelude.Natural)
listEventBuses_limit :: Lens' ListEventBuses (Maybe Natural)
listEventBuses_limit = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListEventBuses' {Maybe Natural
limit :: Maybe Natural
$sel:limit:ListEventBuses' :: ListEventBuses -> Maybe Natural
limit} -> Maybe Natural
limit) (\s :: ListEventBuses
s@ListEventBuses' {} Maybe Natural
a -> ListEventBuses
s {$sel:limit:ListEventBuses' :: Maybe Natural
limit = Maybe Natural
a} :: ListEventBuses)

-- | Specifying this limits the results to only those event buses with names
-- that start with the specified prefix.
listEventBuses_namePrefix :: Lens.Lens' ListEventBuses (Prelude.Maybe Prelude.Text)
listEventBuses_namePrefix :: Lens' ListEventBuses (Maybe Text)
listEventBuses_namePrefix = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListEventBuses' {Maybe Text
namePrefix :: Maybe Text
$sel:namePrefix:ListEventBuses' :: ListEventBuses -> Maybe Text
namePrefix} -> Maybe Text
namePrefix) (\s :: ListEventBuses
s@ListEventBuses' {} Maybe Text
a -> ListEventBuses
s {$sel:namePrefix:ListEventBuses' :: Maybe Text
namePrefix = Maybe Text
a} :: ListEventBuses)

-- | The token returned by a previous call to retrieve the next set of
-- results.
listEventBuses_nextToken :: Lens.Lens' ListEventBuses (Prelude.Maybe Prelude.Text)
listEventBuses_nextToken :: Lens' ListEventBuses (Maybe Text)
listEventBuses_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListEventBuses' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListEventBuses' :: ListEventBuses -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListEventBuses
s@ListEventBuses' {} Maybe Text
a -> ListEventBuses
s {$sel:nextToken:ListEventBuses' :: Maybe Text
nextToken = Maybe Text
a} :: ListEventBuses)

instance Core.AWSRequest ListEventBuses where
  type
    AWSResponse ListEventBuses =
      ListEventBusesResponse
  request :: (Service -> Service) -> ListEventBuses -> Request ListEventBuses
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.postJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy ListEventBuses
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse ListEventBuses)))
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 [EventBus] -> Maybe Text -> Int -> ListEventBusesResponse
ListEventBusesResponse'
            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
"EventBuses" 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
"NextToken")
            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 ListEventBuses where
  hashWithSalt :: Int -> ListEventBuses -> Int
hashWithSalt Int
_salt ListEventBuses' {Maybe Natural
Maybe Text
nextToken :: Maybe Text
namePrefix :: Maybe Text
limit :: Maybe Natural
$sel:nextToken:ListEventBuses' :: ListEventBuses -> Maybe Text
$sel:namePrefix:ListEventBuses' :: ListEventBuses -> Maybe Text
$sel:limit:ListEventBuses' :: ListEventBuses -> Maybe Natural
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
limit
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
namePrefix
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
nextToken

instance Prelude.NFData ListEventBuses where
  rnf :: ListEventBuses -> ()
rnf ListEventBuses' {Maybe Natural
Maybe Text
nextToken :: Maybe Text
namePrefix :: Maybe Text
limit :: Maybe Natural
$sel:nextToken:ListEventBuses' :: ListEventBuses -> Maybe Text
$sel:namePrefix:ListEventBuses' :: ListEventBuses -> Maybe Text
$sel:limit:ListEventBuses' :: ListEventBuses -> Maybe Natural
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
limit
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
namePrefix
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
nextToken

instance Data.ToHeaders ListEventBuses where
  toHeaders :: ListEventBuses -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"X-Amz-Target"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# (ByteString
"AWSEvents.ListEventBuses" :: Prelude.ByteString),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON ListEventBuses where
  toJSON :: ListEventBuses -> Value
toJSON ListEventBuses' {Maybe Natural
Maybe Text
nextToken :: Maybe Text
namePrefix :: Maybe Text
limit :: Maybe Natural
$sel:nextToken:ListEventBuses' :: ListEventBuses -> Maybe Text
$sel:namePrefix:ListEventBuses' :: ListEventBuses -> Maybe Text
$sel:limit:ListEventBuses' :: ListEventBuses -> Maybe Natural
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"Limit" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Natural
limit,
            (Key
"NamePrefix" 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
namePrefix,
            (Key
"NextToken" 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
nextToken
          ]
      )

instance Data.ToPath ListEventBuses where
  toPath :: ListEventBuses -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

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

-- | /See:/ 'newListEventBusesResponse' smart constructor.
data ListEventBusesResponse = ListEventBusesResponse'
  { -- | This list of event buses.
    ListEventBusesResponse -> Maybe [EventBus]
eventBuses :: Prelude.Maybe [EventBus],
    -- | A token you can use in a subsequent operation to retrieve the next set
    -- of results.
    ListEventBusesResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    ListEventBusesResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ListEventBusesResponse -> ListEventBusesResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListEventBusesResponse -> ListEventBusesResponse -> Bool
$c/= :: ListEventBusesResponse -> ListEventBusesResponse -> Bool
== :: ListEventBusesResponse -> ListEventBusesResponse -> Bool
$c== :: ListEventBusesResponse -> ListEventBusesResponse -> Bool
Prelude.Eq, ReadPrec [ListEventBusesResponse]
ReadPrec ListEventBusesResponse
Int -> ReadS ListEventBusesResponse
ReadS [ListEventBusesResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListEventBusesResponse]
$creadListPrec :: ReadPrec [ListEventBusesResponse]
readPrec :: ReadPrec ListEventBusesResponse
$creadPrec :: ReadPrec ListEventBusesResponse
readList :: ReadS [ListEventBusesResponse]
$creadList :: ReadS [ListEventBusesResponse]
readsPrec :: Int -> ReadS ListEventBusesResponse
$creadsPrec :: Int -> ReadS ListEventBusesResponse
Prelude.Read, Int -> ListEventBusesResponse -> ShowS
[ListEventBusesResponse] -> ShowS
ListEventBusesResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListEventBusesResponse] -> ShowS
$cshowList :: [ListEventBusesResponse] -> ShowS
show :: ListEventBusesResponse -> String
$cshow :: ListEventBusesResponse -> String
showsPrec :: Int -> ListEventBusesResponse -> ShowS
$cshowsPrec :: Int -> ListEventBusesResponse -> ShowS
Prelude.Show, forall x. Rep ListEventBusesResponse x -> ListEventBusesResponse
forall x. ListEventBusesResponse -> Rep ListEventBusesResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListEventBusesResponse x -> ListEventBusesResponse
$cfrom :: forall x. ListEventBusesResponse -> Rep ListEventBusesResponse x
Prelude.Generic)

-- |
-- Create a value of 'ListEventBusesResponse' 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:
--
-- 'eventBuses', 'listEventBusesResponse_eventBuses' - This list of event buses.
--
-- 'nextToken', 'listEventBusesResponse_nextToken' - A token you can use in a subsequent operation to retrieve the next set
-- of results.
--
-- 'httpStatus', 'listEventBusesResponse_httpStatus' - The response's http status code.
newListEventBusesResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ListEventBusesResponse
newListEventBusesResponse :: Int -> ListEventBusesResponse
newListEventBusesResponse Int
pHttpStatus_ =
  ListEventBusesResponse'
    { $sel:eventBuses:ListEventBusesResponse' :: Maybe [EventBus]
eventBuses =
        forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListEventBusesResponse' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ListEventBusesResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | This list of event buses.
listEventBusesResponse_eventBuses :: Lens.Lens' ListEventBusesResponse (Prelude.Maybe [EventBus])
listEventBusesResponse_eventBuses :: Lens' ListEventBusesResponse (Maybe [EventBus])
listEventBusesResponse_eventBuses = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListEventBusesResponse' {Maybe [EventBus]
eventBuses :: Maybe [EventBus]
$sel:eventBuses:ListEventBusesResponse' :: ListEventBusesResponse -> Maybe [EventBus]
eventBuses} -> Maybe [EventBus]
eventBuses) (\s :: ListEventBusesResponse
s@ListEventBusesResponse' {} Maybe [EventBus]
a -> ListEventBusesResponse
s {$sel:eventBuses:ListEventBusesResponse' :: Maybe [EventBus]
eventBuses = Maybe [EventBus]
a} :: ListEventBusesResponse) 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 token you can use in a subsequent operation to retrieve the next set
-- of results.
listEventBusesResponse_nextToken :: Lens.Lens' ListEventBusesResponse (Prelude.Maybe Prelude.Text)
listEventBusesResponse_nextToken :: Lens' ListEventBusesResponse (Maybe Text)
listEventBusesResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListEventBusesResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListEventBusesResponse' :: ListEventBusesResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListEventBusesResponse
s@ListEventBusesResponse' {} Maybe Text
a -> ListEventBusesResponse
s {$sel:nextToken:ListEventBusesResponse' :: Maybe Text
nextToken = Maybe Text
a} :: ListEventBusesResponse)

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

instance Prelude.NFData ListEventBusesResponse where
  rnf :: ListEventBusesResponse -> ()
rnf ListEventBusesResponse' {Int
Maybe [EventBus]
Maybe Text
httpStatus :: Int
nextToken :: Maybe Text
eventBuses :: Maybe [EventBus]
$sel:httpStatus:ListEventBusesResponse' :: ListEventBusesResponse -> Int
$sel:nextToken:ListEventBusesResponse' :: ListEventBusesResponse -> Maybe Text
$sel:eventBuses:ListEventBusesResponse' :: ListEventBusesResponse -> Maybe [EventBus]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [EventBus]
eventBuses
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
nextToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus