{-# 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.Pipes.ListPipes
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Get the pipes associated with this account. For more information about
-- pipes, see
-- <https://docs.aws.amazon.com/eventbridge/latest/userguide/eb-pipes.html Amazon EventBridge Pipes>
-- in the Amazon EventBridge User Guide.
--
-- This operation returns paginated results.
module Amazonka.Pipes.ListPipes
  ( -- * Creating a Request
    ListPipes (..),
    newListPipes,

    -- * Request Lenses
    listPipes_currentState,
    listPipes_desiredState,
    listPipes_limit,
    listPipes_namePrefix,
    listPipes_nextToken,
    listPipes_sourcePrefix,
    listPipes_targetPrefix,

    -- * Destructuring the Response
    ListPipesResponse (..),
    newListPipesResponse,

    -- * Response Lenses
    listPipesResponse_nextToken,
    listPipesResponse_pipes,
    listPipesResponse_httpStatus,
  )
where

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

-- | /See:/ 'newListPipes' smart constructor.
data ListPipes = ListPipes'
  { -- | The state the pipe is in.
    ListPipes -> Maybe PipeState
currentState :: Prelude.Maybe PipeState,
    -- | The state the pipe should be in.
    ListPipes -> Maybe RequestedPipeState
desiredState :: Prelude.Maybe RequestedPipeState,
    -- | The maximum number of pipes to include in the response.
    ListPipes -> Maybe Natural
limit :: Prelude.Maybe Prelude.Natural,
    -- | A value that will return a subset of the pipes associated with this
    -- account. For example, @\"NamePrefix\": \"ABC\"@ will return all
    -- endpoints with \"ABC\" in the name.
    ListPipes -> Maybe Text
namePrefix :: Prelude.Maybe Prelude.Text,
    -- | If @nextToken@ is returned, there are more results available. The value
    -- of @nextToken@ is a unique pagination token for each page. Make the call
    -- again using the returned token to retrieve the next page. Keep all other
    -- arguments unchanged. Each pagination token expires after 24 hours. Using
    -- an expired pagination token will return an HTTP 400 InvalidToken error.
    ListPipes -> Maybe (Sensitive Text)
nextToken :: Prelude.Maybe (Data.Sensitive Prelude.Text),
    -- | The prefix matching the pipe source.
    ListPipes -> Maybe Text
sourcePrefix :: Prelude.Maybe Prelude.Text,
    -- | The prefix matching the pipe target.
    ListPipes -> Maybe Text
targetPrefix :: Prelude.Maybe Prelude.Text
  }
  deriving (ListPipes -> ListPipes -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListPipes -> ListPipes -> Bool
$c/= :: ListPipes -> ListPipes -> Bool
== :: ListPipes -> ListPipes -> Bool
$c== :: ListPipes -> ListPipes -> Bool
Prelude.Eq, Int -> ListPipes -> ShowS
[ListPipes] -> ShowS
ListPipes -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListPipes] -> ShowS
$cshowList :: [ListPipes] -> ShowS
show :: ListPipes -> String
$cshow :: ListPipes -> String
showsPrec :: Int -> ListPipes -> ShowS
$cshowsPrec :: Int -> ListPipes -> ShowS
Prelude.Show, forall x. Rep ListPipes x -> ListPipes
forall x. ListPipes -> Rep ListPipes x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListPipes x -> ListPipes
$cfrom :: forall x. ListPipes -> Rep ListPipes x
Prelude.Generic)

-- |
-- Create a value of 'ListPipes' 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:
--
-- 'currentState', 'listPipes_currentState' - The state the pipe is in.
--
-- 'desiredState', 'listPipes_desiredState' - The state the pipe should be in.
--
-- 'limit', 'listPipes_limit' - The maximum number of pipes to include in the response.
--
-- 'namePrefix', 'listPipes_namePrefix' - A value that will return a subset of the pipes associated with this
-- account. For example, @\"NamePrefix\": \"ABC\"@ will return all
-- endpoints with \"ABC\" in the name.
--
-- 'nextToken', 'listPipes_nextToken' - If @nextToken@ is returned, there are more results available. The value
-- of @nextToken@ is a unique pagination token for each page. Make the call
-- again using the returned token to retrieve the next page. Keep all other
-- arguments unchanged. Each pagination token expires after 24 hours. Using
-- an expired pagination token will return an HTTP 400 InvalidToken error.
--
-- 'sourcePrefix', 'listPipes_sourcePrefix' - The prefix matching the pipe source.
--
-- 'targetPrefix', 'listPipes_targetPrefix' - The prefix matching the pipe target.
newListPipes ::
  ListPipes
newListPipes :: ListPipes
newListPipes =
  ListPipes'
    { $sel:currentState:ListPipes' :: Maybe PipeState
currentState = forall a. Maybe a
Prelude.Nothing,
      $sel:desiredState:ListPipes' :: Maybe RequestedPipeState
desiredState = forall a. Maybe a
Prelude.Nothing,
      $sel:limit:ListPipes' :: Maybe Natural
limit = forall a. Maybe a
Prelude.Nothing,
      $sel:namePrefix:ListPipes' :: Maybe Text
namePrefix = forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListPipes' :: Maybe (Sensitive Text)
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:sourcePrefix:ListPipes' :: Maybe Text
sourcePrefix = forall a. Maybe a
Prelude.Nothing,
      $sel:targetPrefix:ListPipes' :: Maybe Text
targetPrefix = forall a. Maybe a
Prelude.Nothing
    }

-- | The state the pipe is in.
listPipes_currentState :: Lens.Lens' ListPipes (Prelude.Maybe PipeState)
listPipes_currentState :: Lens' ListPipes (Maybe PipeState)
listPipes_currentState = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListPipes' {Maybe PipeState
currentState :: Maybe PipeState
$sel:currentState:ListPipes' :: ListPipes -> Maybe PipeState
currentState} -> Maybe PipeState
currentState) (\s :: ListPipes
s@ListPipes' {} Maybe PipeState
a -> ListPipes
s {$sel:currentState:ListPipes' :: Maybe PipeState
currentState = Maybe PipeState
a} :: ListPipes)

-- | The state the pipe should be in.
listPipes_desiredState :: Lens.Lens' ListPipes (Prelude.Maybe RequestedPipeState)
listPipes_desiredState :: Lens' ListPipes (Maybe RequestedPipeState)
listPipes_desiredState = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListPipes' {Maybe RequestedPipeState
desiredState :: Maybe RequestedPipeState
$sel:desiredState:ListPipes' :: ListPipes -> Maybe RequestedPipeState
desiredState} -> Maybe RequestedPipeState
desiredState) (\s :: ListPipes
s@ListPipes' {} Maybe RequestedPipeState
a -> ListPipes
s {$sel:desiredState:ListPipes' :: Maybe RequestedPipeState
desiredState = Maybe RequestedPipeState
a} :: ListPipes)

-- | The maximum number of pipes to include in the response.
listPipes_limit :: Lens.Lens' ListPipes (Prelude.Maybe Prelude.Natural)
listPipes_limit :: Lens' ListPipes (Maybe Natural)
listPipes_limit = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListPipes' {Maybe Natural
limit :: Maybe Natural
$sel:limit:ListPipes' :: ListPipes -> Maybe Natural
limit} -> Maybe Natural
limit) (\s :: ListPipes
s@ListPipes' {} Maybe Natural
a -> ListPipes
s {$sel:limit:ListPipes' :: Maybe Natural
limit = Maybe Natural
a} :: ListPipes)

-- | A value that will return a subset of the pipes associated with this
-- account. For example, @\"NamePrefix\": \"ABC\"@ will return all
-- endpoints with \"ABC\" in the name.
listPipes_namePrefix :: Lens.Lens' ListPipes (Prelude.Maybe Prelude.Text)
listPipes_namePrefix :: Lens' ListPipes (Maybe Text)
listPipes_namePrefix = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListPipes' {Maybe Text
namePrefix :: Maybe Text
$sel:namePrefix:ListPipes' :: ListPipes -> Maybe Text
namePrefix} -> Maybe Text
namePrefix) (\s :: ListPipes
s@ListPipes' {} Maybe Text
a -> ListPipes
s {$sel:namePrefix:ListPipes' :: Maybe Text
namePrefix = Maybe Text
a} :: ListPipes)

-- | If @nextToken@ is returned, there are more results available. The value
-- of @nextToken@ is a unique pagination token for each page. Make the call
-- again using the returned token to retrieve the next page. Keep all other
-- arguments unchanged. Each pagination token expires after 24 hours. Using
-- an expired pagination token will return an HTTP 400 InvalidToken error.
listPipes_nextToken :: Lens.Lens' ListPipes (Prelude.Maybe Prelude.Text)
listPipes_nextToken :: Lens' ListPipes (Maybe Text)
listPipes_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListPipes' {Maybe (Sensitive Text)
nextToken :: Maybe (Sensitive Text)
$sel:nextToken:ListPipes' :: ListPipes -> Maybe (Sensitive Text)
nextToken} -> Maybe (Sensitive Text)
nextToken) (\s :: ListPipes
s@ListPipes' {} Maybe (Sensitive Text)
a -> ListPipes
s {$sel:nextToken:ListPipes' :: Maybe (Sensitive Text)
nextToken = Maybe (Sensitive Text)
a} :: ListPipes) 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 a. Iso' (Sensitive a) a
Data._Sensitive

-- | The prefix matching the pipe source.
listPipes_sourcePrefix :: Lens.Lens' ListPipes (Prelude.Maybe Prelude.Text)
listPipes_sourcePrefix :: Lens' ListPipes (Maybe Text)
listPipes_sourcePrefix = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListPipes' {Maybe Text
sourcePrefix :: Maybe Text
$sel:sourcePrefix:ListPipes' :: ListPipes -> Maybe Text
sourcePrefix} -> Maybe Text
sourcePrefix) (\s :: ListPipes
s@ListPipes' {} Maybe Text
a -> ListPipes
s {$sel:sourcePrefix:ListPipes' :: Maybe Text
sourcePrefix = Maybe Text
a} :: ListPipes)

-- | The prefix matching the pipe target.
listPipes_targetPrefix :: Lens.Lens' ListPipes (Prelude.Maybe Prelude.Text)
listPipes_targetPrefix :: Lens' ListPipes (Maybe Text)
listPipes_targetPrefix = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListPipes' {Maybe Text
targetPrefix :: Maybe Text
$sel:targetPrefix:ListPipes' :: ListPipes -> Maybe Text
targetPrefix} -> Maybe Text
targetPrefix) (\s :: ListPipes
s@ListPipes' {} Maybe Text
a -> ListPipes
s {$sel:targetPrefix:ListPipes' :: Maybe Text
targetPrefix = Maybe Text
a} :: ListPipes)

instance Core.AWSPager ListPipes where
  page :: ListPipes -> AWSResponse ListPipes -> Maybe ListPipes
page ListPipes
rq AWSResponse ListPipes
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse ListPipes
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListPipesResponse (Maybe Text)
listPipesResponse_nextToken
            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 ListPipes
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListPipesResponse (Maybe [Pipe])
listPipesResponse_pipes
            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.$ ListPipes
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' ListPipes (Maybe Text)
listPipes_nextToken
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse ListPipes
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListPipesResponse (Maybe Text)
listPipesResponse_nextToken
          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 ListPipes where
  type AWSResponse ListPipes = ListPipesResponse
  request :: (Service -> Service) -> ListPipes -> Request ListPipes
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 ListPipes
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse ListPipes)))
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 (Sensitive Text) -> Maybe [Pipe] -> Int -> ListPipesResponse
ListPipesResponse'
            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
"NextToken")
            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
"Pipes" 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.<*> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
      )

instance Prelude.Hashable ListPipes where
  hashWithSalt :: Int -> ListPipes -> Int
hashWithSalt Int
_salt ListPipes' {Maybe Natural
Maybe Text
Maybe (Sensitive Text)
Maybe PipeState
Maybe RequestedPipeState
targetPrefix :: Maybe Text
sourcePrefix :: Maybe Text
nextToken :: Maybe (Sensitive Text)
namePrefix :: Maybe Text
limit :: Maybe Natural
desiredState :: Maybe RequestedPipeState
currentState :: Maybe PipeState
$sel:targetPrefix:ListPipes' :: ListPipes -> Maybe Text
$sel:sourcePrefix:ListPipes' :: ListPipes -> Maybe Text
$sel:nextToken:ListPipes' :: ListPipes -> Maybe (Sensitive Text)
$sel:namePrefix:ListPipes' :: ListPipes -> Maybe Text
$sel:limit:ListPipes' :: ListPipes -> Maybe Natural
$sel:desiredState:ListPipes' :: ListPipes -> Maybe RequestedPipeState
$sel:currentState:ListPipes' :: ListPipes -> Maybe PipeState
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe PipeState
currentState
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe RequestedPipeState
desiredState
      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 (Sensitive Text)
nextToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
sourcePrefix
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
targetPrefix

instance Prelude.NFData ListPipes where
  rnf :: ListPipes -> ()
rnf ListPipes' {Maybe Natural
Maybe Text
Maybe (Sensitive Text)
Maybe PipeState
Maybe RequestedPipeState
targetPrefix :: Maybe Text
sourcePrefix :: Maybe Text
nextToken :: Maybe (Sensitive Text)
namePrefix :: Maybe Text
limit :: Maybe Natural
desiredState :: Maybe RequestedPipeState
currentState :: Maybe PipeState
$sel:targetPrefix:ListPipes' :: ListPipes -> Maybe Text
$sel:sourcePrefix:ListPipes' :: ListPipes -> Maybe Text
$sel:nextToken:ListPipes' :: ListPipes -> Maybe (Sensitive Text)
$sel:namePrefix:ListPipes' :: ListPipes -> Maybe Text
$sel:limit:ListPipes' :: ListPipes -> Maybe Natural
$sel:desiredState:ListPipes' :: ListPipes -> Maybe RequestedPipeState
$sel:currentState:ListPipes' :: ListPipes -> Maybe PipeState
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe PipeState
currentState
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe RequestedPipeState
desiredState
      seq :: forall a b. a -> b -> b
`Prelude.seq` 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 (Sensitive Text)
nextToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
sourcePrefix
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
targetPrefix

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

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

instance Data.ToQuery ListPipes where
  toQuery :: ListPipes -> QueryString
toQuery ListPipes' {Maybe Natural
Maybe Text
Maybe (Sensitive Text)
Maybe PipeState
Maybe RequestedPipeState
targetPrefix :: Maybe Text
sourcePrefix :: Maybe Text
nextToken :: Maybe (Sensitive Text)
namePrefix :: Maybe Text
limit :: Maybe Natural
desiredState :: Maybe RequestedPipeState
currentState :: Maybe PipeState
$sel:targetPrefix:ListPipes' :: ListPipes -> Maybe Text
$sel:sourcePrefix:ListPipes' :: ListPipes -> Maybe Text
$sel:nextToken:ListPipes' :: ListPipes -> Maybe (Sensitive Text)
$sel:namePrefix:ListPipes' :: ListPipes -> Maybe Text
$sel:limit:ListPipes' :: ListPipes -> Maybe Natural
$sel:desiredState:ListPipes' :: ListPipes -> Maybe RequestedPipeState
$sel:currentState:ListPipes' :: ListPipes -> Maybe PipeState
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"CurrentState" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe PipeState
currentState,
        ByteString
"DesiredState" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe RequestedPipeState
desiredState,
        ByteString
"Limit" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Natural
limit,
        ByteString
"NamePrefix" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
namePrefix,
        ByteString
"NextToken" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe (Sensitive Text)
nextToken,
        ByteString
"SourcePrefix" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
sourcePrefix,
        ByteString
"TargetPrefix" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
targetPrefix
      ]

-- | /See:/ 'newListPipesResponse' smart constructor.
data ListPipesResponse = ListPipesResponse'
  { -- | If @nextToken@ is returned, there are more results available. The value
    -- of @nextToken@ is a unique pagination token for each page. Make the call
    -- again using the returned token to retrieve the next page. Keep all other
    -- arguments unchanged. Each pagination token expires after 24 hours. Using
    -- an expired pagination token will return an HTTP 400 InvalidToken error.
    ListPipesResponse -> Maybe (Sensitive Text)
nextToken :: Prelude.Maybe (Data.Sensitive Prelude.Text),
    -- | The pipes returned by the call.
    ListPipesResponse -> Maybe [Pipe]
pipes :: Prelude.Maybe [Pipe],
    -- | The response's http status code.
    ListPipesResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ListPipesResponse -> ListPipesResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListPipesResponse -> ListPipesResponse -> Bool
$c/= :: ListPipesResponse -> ListPipesResponse -> Bool
== :: ListPipesResponse -> ListPipesResponse -> Bool
$c== :: ListPipesResponse -> ListPipesResponse -> Bool
Prelude.Eq, Int -> ListPipesResponse -> ShowS
[ListPipesResponse] -> ShowS
ListPipesResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListPipesResponse] -> ShowS
$cshowList :: [ListPipesResponse] -> ShowS
show :: ListPipesResponse -> String
$cshow :: ListPipesResponse -> String
showsPrec :: Int -> ListPipesResponse -> ShowS
$cshowsPrec :: Int -> ListPipesResponse -> ShowS
Prelude.Show, forall x. Rep ListPipesResponse x -> ListPipesResponse
forall x. ListPipesResponse -> Rep ListPipesResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListPipesResponse x -> ListPipesResponse
$cfrom :: forall x. ListPipesResponse -> Rep ListPipesResponse x
Prelude.Generic)

-- |
-- Create a value of 'ListPipesResponse' 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:
--
-- 'nextToken', 'listPipesResponse_nextToken' - If @nextToken@ is returned, there are more results available. The value
-- of @nextToken@ is a unique pagination token for each page. Make the call
-- again using the returned token to retrieve the next page. Keep all other
-- arguments unchanged. Each pagination token expires after 24 hours. Using
-- an expired pagination token will return an HTTP 400 InvalidToken error.
--
-- 'pipes', 'listPipesResponse_pipes' - The pipes returned by the call.
--
-- 'httpStatus', 'listPipesResponse_httpStatus' - The response's http status code.
newListPipesResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ListPipesResponse
newListPipesResponse :: Int -> ListPipesResponse
newListPipesResponse Int
pHttpStatus_ =
  ListPipesResponse'
    { $sel:nextToken:ListPipesResponse' :: Maybe (Sensitive Text)
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:pipes:ListPipesResponse' :: Maybe [Pipe]
pipes = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ListPipesResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | If @nextToken@ is returned, there are more results available. The value
-- of @nextToken@ is a unique pagination token for each page. Make the call
-- again using the returned token to retrieve the next page. Keep all other
-- arguments unchanged. Each pagination token expires after 24 hours. Using
-- an expired pagination token will return an HTTP 400 InvalidToken error.
listPipesResponse_nextToken :: Lens.Lens' ListPipesResponse (Prelude.Maybe Prelude.Text)
listPipesResponse_nextToken :: Lens' ListPipesResponse (Maybe Text)
listPipesResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListPipesResponse' {Maybe (Sensitive Text)
nextToken :: Maybe (Sensitive Text)
$sel:nextToken:ListPipesResponse' :: ListPipesResponse -> Maybe (Sensitive Text)
nextToken} -> Maybe (Sensitive Text)
nextToken) (\s :: ListPipesResponse
s@ListPipesResponse' {} Maybe (Sensitive Text)
a -> ListPipesResponse
s {$sel:nextToken:ListPipesResponse' :: Maybe (Sensitive Text)
nextToken = Maybe (Sensitive Text)
a} :: ListPipesResponse) 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 a. Iso' (Sensitive a) a
Data._Sensitive

-- | The pipes returned by the call.
listPipesResponse_pipes :: Lens.Lens' ListPipesResponse (Prelude.Maybe [Pipe])
listPipesResponse_pipes :: Lens' ListPipesResponse (Maybe [Pipe])
listPipesResponse_pipes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListPipesResponse' {Maybe [Pipe]
pipes :: Maybe [Pipe]
$sel:pipes:ListPipesResponse' :: ListPipesResponse -> Maybe [Pipe]
pipes} -> Maybe [Pipe]
pipes) (\s :: ListPipesResponse
s@ListPipesResponse' {} Maybe [Pipe]
a -> ListPipesResponse
s {$sel:pipes:ListPipesResponse' :: Maybe [Pipe]
pipes = Maybe [Pipe]
a} :: ListPipesResponse) 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

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

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