{-# 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.Kafka.ListClustersV2
-- 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 a list of all the MSK clusters in the current Region.
--
-- This operation returns paginated results.
module Amazonka.Kafka.ListClustersV2
  ( -- * Creating a Request
    ListClustersV2 (..),
    newListClustersV2,

    -- * Request Lenses
    listClustersV2_clusterNameFilter,
    listClustersV2_clusterTypeFilter,
    listClustersV2_maxResults,
    listClustersV2_nextToken,

    -- * Destructuring the Response
    ListClustersV2Response (..),
    newListClustersV2Response,

    -- * Response Lenses
    listClustersV2Response_clusterInfoList,
    listClustersV2Response_nextToken,
    listClustersV2Response_httpStatus,
  )
where

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

-- | /See:/ 'newListClustersV2' smart constructor.
data ListClustersV2 = ListClustersV2'
  { -- | Specify a prefix of the names of the clusters that you want to list. The
    -- service lists all the clusters whose names start with this prefix.
    ListClustersV2 -> Maybe Text
clusterNameFilter :: Prelude.Maybe Prelude.Text,
    -- | Specify either PROVISIONED or SERVERLESS.
    ListClustersV2 -> Maybe Text
clusterTypeFilter :: Prelude.Maybe Prelude.Text,
    -- | The maximum number of results to return in the response. If there are
    -- more results, the response includes a NextToken parameter.
    ListClustersV2 -> Maybe Natural
maxResults :: Prelude.Maybe Prelude.Natural,
    -- | The paginated results marker. When the result of the operation is
    -- truncated, the call returns NextToken in the response. To get the next
    -- batch, provide this token in your next request.
    ListClustersV2 -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text
  }
  deriving (ListClustersV2 -> ListClustersV2 -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListClustersV2 -> ListClustersV2 -> Bool
$c/= :: ListClustersV2 -> ListClustersV2 -> Bool
== :: ListClustersV2 -> ListClustersV2 -> Bool
$c== :: ListClustersV2 -> ListClustersV2 -> Bool
Prelude.Eq, ReadPrec [ListClustersV2]
ReadPrec ListClustersV2
Int -> ReadS ListClustersV2
ReadS [ListClustersV2]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListClustersV2]
$creadListPrec :: ReadPrec [ListClustersV2]
readPrec :: ReadPrec ListClustersV2
$creadPrec :: ReadPrec ListClustersV2
readList :: ReadS [ListClustersV2]
$creadList :: ReadS [ListClustersV2]
readsPrec :: Int -> ReadS ListClustersV2
$creadsPrec :: Int -> ReadS ListClustersV2
Prelude.Read, Int -> ListClustersV2 -> ShowS
[ListClustersV2] -> ShowS
ListClustersV2 -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListClustersV2] -> ShowS
$cshowList :: [ListClustersV2] -> ShowS
show :: ListClustersV2 -> String
$cshow :: ListClustersV2 -> String
showsPrec :: Int -> ListClustersV2 -> ShowS
$cshowsPrec :: Int -> ListClustersV2 -> ShowS
Prelude.Show, forall x. Rep ListClustersV2 x -> ListClustersV2
forall x. ListClustersV2 -> Rep ListClustersV2 x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListClustersV2 x -> ListClustersV2
$cfrom :: forall x. ListClustersV2 -> Rep ListClustersV2 x
Prelude.Generic)

-- |
-- Create a value of 'ListClustersV2' 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:
--
-- 'clusterNameFilter', 'listClustersV2_clusterNameFilter' - Specify a prefix of the names of the clusters that you want to list. The
-- service lists all the clusters whose names start with this prefix.
--
-- 'clusterTypeFilter', 'listClustersV2_clusterTypeFilter' - Specify either PROVISIONED or SERVERLESS.
--
-- 'maxResults', 'listClustersV2_maxResults' - The maximum number of results to return in the response. If there are
-- more results, the response includes a NextToken parameter.
--
-- 'nextToken', 'listClustersV2_nextToken' - The paginated results marker. When the result of the operation is
-- truncated, the call returns NextToken in the response. To get the next
-- batch, provide this token in your next request.
newListClustersV2 ::
  ListClustersV2
newListClustersV2 :: ListClustersV2
newListClustersV2 =
  ListClustersV2'
    { $sel:clusterNameFilter:ListClustersV2' :: Maybe Text
clusterNameFilter =
        forall a. Maybe a
Prelude.Nothing,
      $sel:clusterTypeFilter:ListClustersV2' :: Maybe Text
clusterTypeFilter = forall a. Maybe a
Prelude.Nothing,
      $sel:maxResults:ListClustersV2' :: Maybe Natural
maxResults = forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListClustersV2' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing
    }

-- | Specify a prefix of the names of the clusters that you want to list. The
-- service lists all the clusters whose names start with this prefix.
listClustersV2_clusterNameFilter :: Lens.Lens' ListClustersV2 (Prelude.Maybe Prelude.Text)
listClustersV2_clusterNameFilter :: Lens' ListClustersV2 (Maybe Text)
listClustersV2_clusterNameFilter = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListClustersV2' {Maybe Text
clusterNameFilter :: Maybe Text
$sel:clusterNameFilter:ListClustersV2' :: ListClustersV2 -> Maybe Text
clusterNameFilter} -> Maybe Text
clusterNameFilter) (\s :: ListClustersV2
s@ListClustersV2' {} Maybe Text
a -> ListClustersV2
s {$sel:clusterNameFilter:ListClustersV2' :: Maybe Text
clusterNameFilter = Maybe Text
a} :: ListClustersV2)

-- | Specify either PROVISIONED or SERVERLESS.
listClustersV2_clusterTypeFilter :: Lens.Lens' ListClustersV2 (Prelude.Maybe Prelude.Text)
listClustersV2_clusterTypeFilter :: Lens' ListClustersV2 (Maybe Text)
listClustersV2_clusterTypeFilter = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListClustersV2' {Maybe Text
clusterTypeFilter :: Maybe Text
$sel:clusterTypeFilter:ListClustersV2' :: ListClustersV2 -> Maybe Text
clusterTypeFilter} -> Maybe Text
clusterTypeFilter) (\s :: ListClustersV2
s@ListClustersV2' {} Maybe Text
a -> ListClustersV2
s {$sel:clusterTypeFilter:ListClustersV2' :: Maybe Text
clusterTypeFilter = Maybe Text
a} :: ListClustersV2)

-- | The maximum number of results to return in the response. If there are
-- more results, the response includes a NextToken parameter.
listClustersV2_maxResults :: Lens.Lens' ListClustersV2 (Prelude.Maybe Prelude.Natural)
listClustersV2_maxResults :: Lens' ListClustersV2 (Maybe Natural)
listClustersV2_maxResults = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListClustersV2' {Maybe Natural
maxResults :: Maybe Natural
$sel:maxResults:ListClustersV2' :: ListClustersV2 -> Maybe Natural
maxResults} -> Maybe Natural
maxResults) (\s :: ListClustersV2
s@ListClustersV2' {} Maybe Natural
a -> ListClustersV2
s {$sel:maxResults:ListClustersV2' :: Maybe Natural
maxResults = Maybe Natural
a} :: ListClustersV2)

-- | The paginated results marker. When the result of the operation is
-- truncated, the call returns NextToken in the response. To get the next
-- batch, provide this token in your next request.
listClustersV2_nextToken :: Lens.Lens' ListClustersV2 (Prelude.Maybe Prelude.Text)
listClustersV2_nextToken :: Lens' ListClustersV2 (Maybe Text)
listClustersV2_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListClustersV2' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListClustersV2' :: ListClustersV2 -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListClustersV2
s@ListClustersV2' {} Maybe Text
a -> ListClustersV2
s {$sel:nextToken:ListClustersV2' :: Maybe Text
nextToken = Maybe Text
a} :: ListClustersV2)

instance Core.AWSPager ListClustersV2 where
  page :: ListClustersV2
-> AWSResponse ListClustersV2 -> Maybe ListClustersV2
page ListClustersV2
rq AWSResponse ListClustersV2
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse ListClustersV2
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListClustersV2Response (Maybe Text)
listClustersV2Response_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 ListClustersV2
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListClustersV2Response (Maybe [Cluster])
listClustersV2Response_clusterInfoList
            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.$ ListClustersV2
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' ListClustersV2 (Maybe Text)
listClustersV2_nextToken
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse ListClustersV2
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListClustersV2Response (Maybe Text)
listClustersV2Response_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 ListClustersV2 where
  type
    AWSResponse ListClustersV2 =
      ListClustersV2Response
  request :: (Service -> Service) -> ListClustersV2 -> Request ListClustersV2
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 ListClustersV2
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse ListClustersV2)))
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 [Cluster] -> Maybe Text -> Int -> ListClustersV2Response
ListClustersV2Response'
            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
"clusterInfoList"
                            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 ListClustersV2 where
  hashWithSalt :: Int -> ListClustersV2 -> Int
hashWithSalt Int
_salt ListClustersV2' {Maybe Natural
Maybe Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
clusterTypeFilter :: Maybe Text
clusterNameFilter :: Maybe Text
$sel:nextToken:ListClustersV2' :: ListClustersV2 -> Maybe Text
$sel:maxResults:ListClustersV2' :: ListClustersV2 -> Maybe Natural
$sel:clusterTypeFilter:ListClustersV2' :: ListClustersV2 -> Maybe Text
$sel:clusterNameFilter:ListClustersV2' :: ListClustersV2 -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
clusterNameFilter
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
clusterTypeFilter
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
maxResults
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
nextToken

instance Prelude.NFData ListClustersV2 where
  rnf :: ListClustersV2 -> ()
rnf ListClustersV2' {Maybe Natural
Maybe Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
clusterTypeFilter :: Maybe Text
clusterNameFilter :: Maybe Text
$sel:nextToken:ListClustersV2' :: ListClustersV2 -> Maybe Text
$sel:maxResults:ListClustersV2' :: ListClustersV2 -> Maybe Natural
$sel:clusterTypeFilter:ListClustersV2' :: ListClustersV2 -> Maybe Text
$sel:clusterNameFilter:ListClustersV2' :: ListClustersV2 -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
clusterNameFilter
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
clusterTypeFilter
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
maxResults
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
nextToken

instance Data.ToHeaders ListClustersV2 where
  toHeaders :: ListClustersV2 -> 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 ListClustersV2 where
  toPath :: ListClustersV2 -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/api/v2/clusters"

instance Data.ToQuery ListClustersV2 where
  toQuery :: ListClustersV2 -> QueryString
toQuery ListClustersV2' {Maybe Natural
Maybe Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
clusterTypeFilter :: Maybe Text
clusterNameFilter :: Maybe Text
$sel:nextToken:ListClustersV2' :: ListClustersV2 -> Maybe Text
$sel:maxResults:ListClustersV2' :: ListClustersV2 -> Maybe Natural
$sel:clusterTypeFilter:ListClustersV2' :: ListClustersV2 -> Maybe Text
$sel:clusterNameFilter:ListClustersV2' :: ListClustersV2 -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"clusterNameFilter" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
clusterNameFilter,
        ByteString
"clusterTypeFilter" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
clusterTypeFilter,
        ByteString
"maxResults" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Natural
maxResults,
        ByteString
"nextToken" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
nextToken
      ]

-- | /See:/ 'newListClustersV2Response' smart constructor.
data ListClustersV2Response = ListClustersV2Response'
  { -- | Information on each of the MSK clusters in the response.
    ListClustersV2Response -> Maybe [Cluster]
clusterInfoList :: Prelude.Maybe [Cluster],
    -- | The paginated results marker. When the result of a ListClusters
    -- operation is truncated, the call returns NextToken in the response. To
    -- get another batch of clusters, provide this token in your next request.
    ListClustersV2Response -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    ListClustersV2Response -> Int
httpStatus :: Prelude.Int
  }
  deriving (ListClustersV2Response -> ListClustersV2Response -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListClustersV2Response -> ListClustersV2Response -> Bool
$c/= :: ListClustersV2Response -> ListClustersV2Response -> Bool
== :: ListClustersV2Response -> ListClustersV2Response -> Bool
$c== :: ListClustersV2Response -> ListClustersV2Response -> Bool
Prelude.Eq, ReadPrec [ListClustersV2Response]
ReadPrec ListClustersV2Response
Int -> ReadS ListClustersV2Response
ReadS [ListClustersV2Response]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListClustersV2Response]
$creadListPrec :: ReadPrec [ListClustersV2Response]
readPrec :: ReadPrec ListClustersV2Response
$creadPrec :: ReadPrec ListClustersV2Response
readList :: ReadS [ListClustersV2Response]
$creadList :: ReadS [ListClustersV2Response]
readsPrec :: Int -> ReadS ListClustersV2Response
$creadsPrec :: Int -> ReadS ListClustersV2Response
Prelude.Read, Int -> ListClustersV2Response -> ShowS
[ListClustersV2Response] -> ShowS
ListClustersV2Response -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListClustersV2Response] -> ShowS
$cshowList :: [ListClustersV2Response] -> ShowS
show :: ListClustersV2Response -> String
$cshow :: ListClustersV2Response -> String
showsPrec :: Int -> ListClustersV2Response -> ShowS
$cshowsPrec :: Int -> ListClustersV2Response -> ShowS
Prelude.Show, forall x. Rep ListClustersV2Response x -> ListClustersV2Response
forall x. ListClustersV2Response -> Rep ListClustersV2Response x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListClustersV2Response x -> ListClustersV2Response
$cfrom :: forall x. ListClustersV2Response -> Rep ListClustersV2Response x
Prelude.Generic)

-- |
-- Create a value of 'ListClustersV2Response' 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:
--
-- 'clusterInfoList', 'listClustersV2Response_clusterInfoList' - Information on each of the MSK clusters in the response.
--
-- 'nextToken', 'listClustersV2Response_nextToken' - The paginated results marker. When the result of a ListClusters
-- operation is truncated, the call returns NextToken in the response. To
-- get another batch of clusters, provide this token in your next request.
--
-- 'httpStatus', 'listClustersV2Response_httpStatus' - The response's http status code.
newListClustersV2Response ::
  -- | 'httpStatus'
  Prelude.Int ->
  ListClustersV2Response
newListClustersV2Response :: Int -> ListClustersV2Response
newListClustersV2Response Int
pHttpStatus_ =
  ListClustersV2Response'
    { $sel:clusterInfoList:ListClustersV2Response' :: Maybe [Cluster]
clusterInfoList =
        forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListClustersV2Response' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ListClustersV2Response' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Information on each of the MSK clusters in the response.
listClustersV2Response_clusterInfoList :: Lens.Lens' ListClustersV2Response (Prelude.Maybe [Cluster])
listClustersV2Response_clusterInfoList :: Lens' ListClustersV2Response (Maybe [Cluster])
listClustersV2Response_clusterInfoList = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListClustersV2Response' {Maybe [Cluster]
clusterInfoList :: Maybe [Cluster]
$sel:clusterInfoList:ListClustersV2Response' :: ListClustersV2Response -> Maybe [Cluster]
clusterInfoList} -> Maybe [Cluster]
clusterInfoList) (\s :: ListClustersV2Response
s@ListClustersV2Response' {} Maybe [Cluster]
a -> ListClustersV2Response
s {$sel:clusterInfoList:ListClustersV2Response' :: Maybe [Cluster]
clusterInfoList = Maybe [Cluster]
a} :: ListClustersV2Response) 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 paginated results marker. When the result of a ListClusters
-- operation is truncated, the call returns NextToken in the response. To
-- get another batch of clusters, provide this token in your next request.
listClustersV2Response_nextToken :: Lens.Lens' ListClustersV2Response (Prelude.Maybe Prelude.Text)
listClustersV2Response_nextToken :: Lens' ListClustersV2Response (Maybe Text)
listClustersV2Response_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListClustersV2Response' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListClustersV2Response' :: ListClustersV2Response -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListClustersV2Response
s@ListClustersV2Response' {} Maybe Text
a -> ListClustersV2Response
s {$sel:nextToken:ListClustersV2Response' :: Maybe Text
nextToken = Maybe Text
a} :: ListClustersV2Response)

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

instance Prelude.NFData ListClustersV2Response where
  rnf :: ListClustersV2Response -> ()
rnf ListClustersV2Response' {Int
Maybe [Cluster]
Maybe Text
httpStatus :: Int
nextToken :: Maybe Text
clusterInfoList :: Maybe [Cluster]
$sel:httpStatus:ListClustersV2Response' :: ListClustersV2Response -> Int
$sel:nextToken:ListClustersV2Response' :: ListClustersV2Response -> Maybe Text
$sel:clusterInfoList:ListClustersV2Response' :: ListClustersV2Response -> Maybe [Cluster]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [Cluster]
clusterInfoList
      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