{-# 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.EKS.ListFargateProfiles
-- 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 the Fargate profiles associated with the specified cluster in your
-- Amazon Web Services account in the specified Region.
--
-- This operation returns paginated results.
module Amazonka.EKS.ListFargateProfiles
  ( -- * Creating a Request
    ListFargateProfiles (..),
    newListFargateProfiles,

    -- * Request Lenses
    listFargateProfiles_maxResults,
    listFargateProfiles_nextToken,
    listFargateProfiles_clusterName,

    -- * Destructuring the Response
    ListFargateProfilesResponse (..),
    newListFargateProfilesResponse,

    -- * Response Lenses
    listFargateProfilesResponse_fargateProfileNames,
    listFargateProfilesResponse_nextToken,
    listFargateProfilesResponse_httpStatus,
  )
where

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

-- | /See:/ 'newListFargateProfiles' smart constructor.
data ListFargateProfiles = ListFargateProfiles'
  { -- | The maximum number of Fargate profile results returned by
    -- @ListFargateProfiles@ in paginated output. When you use this parameter,
    -- @ListFargateProfiles@ returns only @maxResults@ results in a single page
    -- along with a @nextToken@ response element. You can see the remaining
    -- results of the initial request by sending another @ListFargateProfiles@
    -- request with the returned @nextToken@ value. This value can be between 1
    -- and 100. If you don\'t use this parameter, @ListFargateProfiles@ returns
    -- up to 100 results and a @nextToken@ value if applicable.
    ListFargateProfiles -> Maybe Natural
maxResults :: Prelude.Maybe Prelude.Natural,
    -- | The @nextToken@ value returned from a previous paginated
    -- @ListFargateProfiles@ request where @maxResults@ was used and the
    -- results exceeded the value of that parameter. Pagination continues from
    -- the end of the previous results that returned the @nextToken@ value.
    ListFargateProfiles -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The name of the Amazon EKS cluster that you would like to list Fargate
    -- profiles in.
    ListFargateProfiles -> Text
clusterName :: Prelude.Text
  }
  deriving (ListFargateProfiles -> ListFargateProfiles -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListFargateProfiles -> ListFargateProfiles -> Bool
$c/= :: ListFargateProfiles -> ListFargateProfiles -> Bool
== :: ListFargateProfiles -> ListFargateProfiles -> Bool
$c== :: ListFargateProfiles -> ListFargateProfiles -> Bool
Prelude.Eq, ReadPrec [ListFargateProfiles]
ReadPrec ListFargateProfiles
Int -> ReadS ListFargateProfiles
ReadS [ListFargateProfiles]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListFargateProfiles]
$creadListPrec :: ReadPrec [ListFargateProfiles]
readPrec :: ReadPrec ListFargateProfiles
$creadPrec :: ReadPrec ListFargateProfiles
readList :: ReadS [ListFargateProfiles]
$creadList :: ReadS [ListFargateProfiles]
readsPrec :: Int -> ReadS ListFargateProfiles
$creadsPrec :: Int -> ReadS ListFargateProfiles
Prelude.Read, Int -> ListFargateProfiles -> ShowS
[ListFargateProfiles] -> ShowS
ListFargateProfiles -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListFargateProfiles] -> ShowS
$cshowList :: [ListFargateProfiles] -> ShowS
show :: ListFargateProfiles -> String
$cshow :: ListFargateProfiles -> String
showsPrec :: Int -> ListFargateProfiles -> ShowS
$cshowsPrec :: Int -> ListFargateProfiles -> ShowS
Prelude.Show, forall x. Rep ListFargateProfiles x -> ListFargateProfiles
forall x. ListFargateProfiles -> Rep ListFargateProfiles x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListFargateProfiles x -> ListFargateProfiles
$cfrom :: forall x. ListFargateProfiles -> Rep ListFargateProfiles x
Prelude.Generic)

-- |
-- Create a value of 'ListFargateProfiles' 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:
--
-- 'maxResults', 'listFargateProfiles_maxResults' - The maximum number of Fargate profile results returned by
-- @ListFargateProfiles@ in paginated output. When you use this parameter,
-- @ListFargateProfiles@ returns only @maxResults@ results in a single page
-- along with a @nextToken@ response element. You can see the remaining
-- results of the initial request by sending another @ListFargateProfiles@
-- request with the returned @nextToken@ value. This value can be between 1
-- and 100. If you don\'t use this parameter, @ListFargateProfiles@ returns
-- up to 100 results and a @nextToken@ value if applicable.
--
-- 'nextToken', 'listFargateProfiles_nextToken' - The @nextToken@ value returned from a previous paginated
-- @ListFargateProfiles@ request where @maxResults@ was used and the
-- results exceeded the value of that parameter. Pagination continues from
-- the end of the previous results that returned the @nextToken@ value.
--
-- 'clusterName', 'listFargateProfiles_clusterName' - The name of the Amazon EKS cluster that you would like to list Fargate
-- profiles in.
newListFargateProfiles ::
  -- | 'clusterName'
  Prelude.Text ->
  ListFargateProfiles
newListFargateProfiles :: Text -> ListFargateProfiles
newListFargateProfiles Text
pClusterName_ =
  ListFargateProfiles'
    { $sel:maxResults:ListFargateProfiles' :: Maybe Natural
maxResults = forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListFargateProfiles' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:clusterName:ListFargateProfiles' :: Text
clusterName = Text
pClusterName_
    }

-- | The maximum number of Fargate profile results returned by
-- @ListFargateProfiles@ in paginated output. When you use this parameter,
-- @ListFargateProfiles@ returns only @maxResults@ results in a single page
-- along with a @nextToken@ response element. You can see the remaining
-- results of the initial request by sending another @ListFargateProfiles@
-- request with the returned @nextToken@ value. This value can be between 1
-- and 100. If you don\'t use this parameter, @ListFargateProfiles@ returns
-- up to 100 results and a @nextToken@ value if applicable.
listFargateProfiles_maxResults :: Lens.Lens' ListFargateProfiles (Prelude.Maybe Prelude.Natural)
listFargateProfiles_maxResults :: Lens' ListFargateProfiles (Maybe Natural)
listFargateProfiles_maxResults = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListFargateProfiles' {Maybe Natural
maxResults :: Maybe Natural
$sel:maxResults:ListFargateProfiles' :: ListFargateProfiles -> Maybe Natural
maxResults} -> Maybe Natural
maxResults) (\s :: ListFargateProfiles
s@ListFargateProfiles' {} Maybe Natural
a -> ListFargateProfiles
s {$sel:maxResults:ListFargateProfiles' :: Maybe Natural
maxResults = Maybe Natural
a} :: ListFargateProfiles)

-- | The @nextToken@ value returned from a previous paginated
-- @ListFargateProfiles@ request where @maxResults@ was used and the
-- results exceeded the value of that parameter. Pagination continues from
-- the end of the previous results that returned the @nextToken@ value.
listFargateProfiles_nextToken :: Lens.Lens' ListFargateProfiles (Prelude.Maybe Prelude.Text)
listFargateProfiles_nextToken :: Lens' ListFargateProfiles (Maybe Text)
listFargateProfiles_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListFargateProfiles' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListFargateProfiles' :: ListFargateProfiles -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListFargateProfiles
s@ListFargateProfiles' {} Maybe Text
a -> ListFargateProfiles
s {$sel:nextToken:ListFargateProfiles' :: Maybe Text
nextToken = Maybe Text
a} :: ListFargateProfiles)

-- | The name of the Amazon EKS cluster that you would like to list Fargate
-- profiles in.
listFargateProfiles_clusterName :: Lens.Lens' ListFargateProfiles Prelude.Text
listFargateProfiles_clusterName :: Lens' ListFargateProfiles Text
listFargateProfiles_clusterName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListFargateProfiles' {Text
clusterName :: Text
$sel:clusterName:ListFargateProfiles' :: ListFargateProfiles -> Text
clusterName} -> Text
clusterName) (\s :: ListFargateProfiles
s@ListFargateProfiles' {} Text
a -> ListFargateProfiles
s {$sel:clusterName:ListFargateProfiles' :: Text
clusterName = Text
a} :: ListFargateProfiles)

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

instance Prelude.NFData ListFargateProfiles where
  rnf :: ListFargateProfiles -> ()
rnf ListFargateProfiles' {Maybe Natural
Maybe Text
Text
clusterName :: Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:clusterName:ListFargateProfiles' :: ListFargateProfiles -> Text
$sel:nextToken:ListFargateProfiles' :: ListFargateProfiles -> Maybe Text
$sel:maxResults:ListFargateProfiles' :: ListFargateProfiles -> Maybe Natural
..} =
    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
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
clusterName

instance Data.ToHeaders ListFargateProfiles where
  toHeaders :: ListFargateProfiles -> 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 ListFargateProfiles where
  toPath :: ListFargateProfiles -> ByteString
toPath ListFargateProfiles' {Maybe Natural
Maybe Text
Text
clusterName :: Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:clusterName:ListFargateProfiles' :: ListFargateProfiles -> Text
$sel:nextToken:ListFargateProfiles' :: ListFargateProfiles -> Maybe Text
$sel:maxResults:ListFargateProfiles' :: ListFargateProfiles -> Maybe Natural
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/clusters/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
clusterName,
        ByteString
"/fargate-profiles"
      ]

instance Data.ToQuery ListFargateProfiles where
  toQuery :: ListFargateProfiles -> QueryString
toQuery ListFargateProfiles' {Maybe Natural
Maybe Text
Text
clusterName :: Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:clusterName:ListFargateProfiles' :: ListFargateProfiles -> Text
$sel:nextToken:ListFargateProfiles' :: ListFargateProfiles -> Maybe Text
$sel:maxResults:ListFargateProfiles' :: ListFargateProfiles -> Maybe Natural
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ 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:/ 'newListFargateProfilesResponse' smart constructor.
data ListFargateProfilesResponse = ListFargateProfilesResponse'
  { -- | A list of all of the Fargate profiles associated with the specified
    -- cluster.
    ListFargateProfilesResponse -> Maybe [Text]
fargateProfileNames :: Prelude.Maybe [Prelude.Text],
    -- | The @nextToken@ value to include in a future @ListFargateProfiles@
    -- request. When the results of a @ListFargateProfiles@ request exceed
    -- @maxResults@, you can use this value to retrieve the next page of
    -- results. This value is @null@ when there are no more results to return.
    ListFargateProfilesResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    ListFargateProfilesResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ListFargateProfilesResponse -> ListFargateProfilesResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListFargateProfilesResponse -> ListFargateProfilesResponse -> Bool
$c/= :: ListFargateProfilesResponse -> ListFargateProfilesResponse -> Bool
== :: ListFargateProfilesResponse -> ListFargateProfilesResponse -> Bool
$c== :: ListFargateProfilesResponse -> ListFargateProfilesResponse -> Bool
Prelude.Eq, ReadPrec [ListFargateProfilesResponse]
ReadPrec ListFargateProfilesResponse
Int -> ReadS ListFargateProfilesResponse
ReadS [ListFargateProfilesResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListFargateProfilesResponse]
$creadListPrec :: ReadPrec [ListFargateProfilesResponse]
readPrec :: ReadPrec ListFargateProfilesResponse
$creadPrec :: ReadPrec ListFargateProfilesResponse
readList :: ReadS [ListFargateProfilesResponse]
$creadList :: ReadS [ListFargateProfilesResponse]
readsPrec :: Int -> ReadS ListFargateProfilesResponse
$creadsPrec :: Int -> ReadS ListFargateProfilesResponse
Prelude.Read, Int -> ListFargateProfilesResponse -> ShowS
[ListFargateProfilesResponse] -> ShowS
ListFargateProfilesResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListFargateProfilesResponse] -> ShowS
$cshowList :: [ListFargateProfilesResponse] -> ShowS
show :: ListFargateProfilesResponse -> String
$cshow :: ListFargateProfilesResponse -> String
showsPrec :: Int -> ListFargateProfilesResponse -> ShowS
$cshowsPrec :: Int -> ListFargateProfilesResponse -> ShowS
Prelude.Show, forall x.
Rep ListFargateProfilesResponse x -> ListFargateProfilesResponse
forall x.
ListFargateProfilesResponse -> Rep ListFargateProfilesResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ListFargateProfilesResponse x -> ListFargateProfilesResponse
$cfrom :: forall x.
ListFargateProfilesResponse -> Rep ListFargateProfilesResponse x
Prelude.Generic)

-- |
-- Create a value of 'ListFargateProfilesResponse' 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:
--
-- 'fargateProfileNames', 'listFargateProfilesResponse_fargateProfileNames' - A list of all of the Fargate profiles associated with the specified
-- cluster.
--
-- 'nextToken', 'listFargateProfilesResponse_nextToken' - The @nextToken@ value to include in a future @ListFargateProfiles@
-- request. When the results of a @ListFargateProfiles@ request exceed
-- @maxResults@, you can use this value to retrieve the next page of
-- results. This value is @null@ when there are no more results to return.
--
-- 'httpStatus', 'listFargateProfilesResponse_httpStatus' - The response's http status code.
newListFargateProfilesResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ListFargateProfilesResponse
newListFargateProfilesResponse :: Int -> ListFargateProfilesResponse
newListFargateProfilesResponse Int
pHttpStatus_ =
  ListFargateProfilesResponse'
    { $sel:fargateProfileNames:ListFargateProfilesResponse' :: Maybe [Text]
fargateProfileNames =
        forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListFargateProfilesResponse' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ListFargateProfilesResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | A list of all of the Fargate profiles associated with the specified
-- cluster.
listFargateProfilesResponse_fargateProfileNames :: Lens.Lens' ListFargateProfilesResponse (Prelude.Maybe [Prelude.Text])
listFargateProfilesResponse_fargateProfileNames :: Lens' ListFargateProfilesResponse (Maybe [Text])
listFargateProfilesResponse_fargateProfileNames = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListFargateProfilesResponse' {Maybe [Text]
fargateProfileNames :: Maybe [Text]
$sel:fargateProfileNames:ListFargateProfilesResponse' :: ListFargateProfilesResponse -> Maybe [Text]
fargateProfileNames} -> Maybe [Text]
fargateProfileNames) (\s :: ListFargateProfilesResponse
s@ListFargateProfilesResponse' {} Maybe [Text]
a -> ListFargateProfilesResponse
s {$sel:fargateProfileNames:ListFargateProfilesResponse' :: Maybe [Text]
fargateProfileNames = Maybe [Text]
a} :: ListFargateProfilesResponse) 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 @nextToken@ value to include in a future @ListFargateProfiles@
-- request. When the results of a @ListFargateProfiles@ request exceed
-- @maxResults@, you can use this value to retrieve the next page of
-- results. This value is @null@ when there are no more results to return.
listFargateProfilesResponse_nextToken :: Lens.Lens' ListFargateProfilesResponse (Prelude.Maybe Prelude.Text)
listFargateProfilesResponse_nextToken :: Lens' ListFargateProfilesResponse (Maybe Text)
listFargateProfilesResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListFargateProfilesResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListFargateProfilesResponse' :: ListFargateProfilesResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListFargateProfilesResponse
s@ListFargateProfilesResponse' {} Maybe Text
a -> ListFargateProfilesResponse
s {$sel:nextToken:ListFargateProfilesResponse' :: Maybe Text
nextToken = Maybe Text
a} :: ListFargateProfilesResponse)

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

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