{-# 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.AppMesh.ListVirtualGateways
-- 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 existing virtual gateways in a service mesh.
--
-- This operation returns paginated results.
module Amazonka.AppMesh.ListVirtualGateways
  ( -- * Creating a Request
    ListVirtualGateways (..),
    newListVirtualGateways,

    -- * Request Lenses
    listVirtualGateways_limit,
    listVirtualGateways_meshOwner,
    listVirtualGateways_nextToken,
    listVirtualGateways_meshName,

    -- * Destructuring the Response
    ListVirtualGatewaysResponse (..),
    newListVirtualGatewaysResponse,

    -- * Response Lenses
    listVirtualGatewaysResponse_nextToken,
    listVirtualGatewaysResponse_httpStatus,
    listVirtualGatewaysResponse_virtualGateways,
  )
where

import Amazonka.AppMesh.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:/ 'newListVirtualGateways' smart constructor.
data ListVirtualGateways = ListVirtualGateways'
  { -- | The maximum number of results returned by @ListVirtualGateways@ in
    -- paginated output. When you use this parameter, @ListVirtualGateways@
    -- returns only @limit@ results in a single page along with a @nextToken@
    -- response element. You can see the remaining results of the initial
    -- request by sending another @ListVirtualGateways@ request with the
    -- returned @nextToken@ value. This value can be between 1 and 100. If you
    -- don\'t use this parameter, @ListVirtualGateways@ returns up to 100
    -- results and a @nextToken@ value if applicable.
    ListVirtualGateways -> Maybe Natural
limit :: Prelude.Maybe Prelude.Natural,
    -- | The Amazon Web Services IAM account ID of the service mesh owner. If the
    -- account ID is not your own, then it\'s the ID of the account that shared
    -- the mesh with your account. For more information about mesh sharing, see
    -- <https://docs.aws.amazon.com/app-mesh/latest/userguide/sharing.html Working with shared meshes>.
    ListVirtualGateways -> Maybe Text
meshOwner :: Prelude.Maybe Prelude.Text,
    -- | The @nextToken@ value returned from a previous paginated
    -- @ListVirtualGateways@ request where @limit@ 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.
    ListVirtualGateways -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The name of the service mesh to list virtual gateways in.
    ListVirtualGateways -> Text
meshName :: Prelude.Text
  }
  deriving (ListVirtualGateways -> ListVirtualGateways -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListVirtualGateways -> ListVirtualGateways -> Bool
$c/= :: ListVirtualGateways -> ListVirtualGateways -> Bool
== :: ListVirtualGateways -> ListVirtualGateways -> Bool
$c== :: ListVirtualGateways -> ListVirtualGateways -> Bool
Prelude.Eq, ReadPrec [ListVirtualGateways]
ReadPrec ListVirtualGateways
Int -> ReadS ListVirtualGateways
ReadS [ListVirtualGateways]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListVirtualGateways]
$creadListPrec :: ReadPrec [ListVirtualGateways]
readPrec :: ReadPrec ListVirtualGateways
$creadPrec :: ReadPrec ListVirtualGateways
readList :: ReadS [ListVirtualGateways]
$creadList :: ReadS [ListVirtualGateways]
readsPrec :: Int -> ReadS ListVirtualGateways
$creadsPrec :: Int -> ReadS ListVirtualGateways
Prelude.Read, Int -> ListVirtualGateways -> ShowS
[ListVirtualGateways] -> ShowS
ListVirtualGateways -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListVirtualGateways] -> ShowS
$cshowList :: [ListVirtualGateways] -> ShowS
show :: ListVirtualGateways -> String
$cshow :: ListVirtualGateways -> String
showsPrec :: Int -> ListVirtualGateways -> ShowS
$cshowsPrec :: Int -> ListVirtualGateways -> ShowS
Prelude.Show, forall x. Rep ListVirtualGateways x -> ListVirtualGateways
forall x. ListVirtualGateways -> Rep ListVirtualGateways x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListVirtualGateways x -> ListVirtualGateways
$cfrom :: forall x. ListVirtualGateways -> Rep ListVirtualGateways x
Prelude.Generic)

-- |
-- Create a value of 'ListVirtualGateways' 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', 'listVirtualGateways_limit' - The maximum number of results returned by @ListVirtualGateways@ in
-- paginated output. When you use this parameter, @ListVirtualGateways@
-- returns only @limit@ results in a single page along with a @nextToken@
-- response element. You can see the remaining results of the initial
-- request by sending another @ListVirtualGateways@ request with the
-- returned @nextToken@ value. This value can be between 1 and 100. If you
-- don\'t use this parameter, @ListVirtualGateways@ returns up to 100
-- results and a @nextToken@ value if applicable.
--
-- 'meshOwner', 'listVirtualGateways_meshOwner' - The Amazon Web Services IAM account ID of the service mesh owner. If the
-- account ID is not your own, then it\'s the ID of the account that shared
-- the mesh with your account. For more information about mesh sharing, see
-- <https://docs.aws.amazon.com/app-mesh/latest/userguide/sharing.html Working with shared meshes>.
--
-- 'nextToken', 'listVirtualGateways_nextToken' - The @nextToken@ value returned from a previous paginated
-- @ListVirtualGateways@ request where @limit@ 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.
--
-- 'meshName', 'listVirtualGateways_meshName' - The name of the service mesh to list virtual gateways in.
newListVirtualGateways ::
  -- | 'meshName'
  Prelude.Text ->
  ListVirtualGateways
newListVirtualGateways :: Text -> ListVirtualGateways
newListVirtualGateways Text
pMeshName_ =
  ListVirtualGateways'
    { $sel:limit:ListVirtualGateways' :: Maybe Natural
limit = forall a. Maybe a
Prelude.Nothing,
      $sel:meshOwner:ListVirtualGateways' :: Maybe Text
meshOwner = forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListVirtualGateways' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:meshName:ListVirtualGateways' :: Text
meshName = Text
pMeshName_
    }

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

-- | The Amazon Web Services IAM account ID of the service mesh owner. If the
-- account ID is not your own, then it\'s the ID of the account that shared
-- the mesh with your account. For more information about mesh sharing, see
-- <https://docs.aws.amazon.com/app-mesh/latest/userguide/sharing.html Working with shared meshes>.
listVirtualGateways_meshOwner :: Lens.Lens' ListVirtualGateways (Prelude.Maybe Prelude.Text)
listVirtualGateways_meshOwner :: Lens' ListVirtualGateways (Maybe Text)
listVirtualGateways_meshOwner = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListVirtualGateways' {Maybe Text
meshOwner :: Maybe Text
$sel:meshOwner:ListVirtualGateways' :: ListVirtualGateways -> Maybe Text
meshOwner} -> Maybe Text
meshOwner) (\s :: ListVirtualGateways
s@ListVirtualGateways' {} Maybe Text
a -> ListVirtualGateways
s {$sel:meshOwner:ListVirtualGateways' :: Maybe Text
meshOwner = Maybe Text
a} :: ListVirtualGateways)

-- | The @nextToken@ value returned from a previous paginated
-- @ListVirtualGateways@ request where @limit@ 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.
listVirtualGateways_nextToken :: Lens.Lens' ListVirtualGateways (Prelude.Maybe Prelude.Text)
listVirtualGateways_nextToken :: Lens' ListVirtualGateways (Maybe Text)
listVirtualGateways_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListVirtualGateways' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListVirtualGateways' :: ListVirtualGateways -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListVirtualGateways
s@ListVirtualGateways' {} Maybe Text
a -> ListVirtualGateways
s {$sel:nextToken:ListVirtualGateways' :: Maybe Text
nextToken = Maybe Text
a} :: ListVirtualGateways)

-- | The name of the service mesh to list virtual gateways in.
listVirtualGateways_meshName :: Lens.Lens' ListVirtualGateways Prelude.Text
listVirtualGateways_meshName :: Lens' ListVirtualGateways Text
listVirtualGateways_meshName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListVirtualGateways' {Text
meshName :: Text
$sel:meshName:ListVirtualGateways' :: ListVirtualGateways -> Text
meshName} -> Text
meshName) (\s :: ListVirtualGateways
s@ListVirtualGateways' {} Text
a -> ListVirtualGateways
s {$sel:meshName:ListVirtualGateways' :: Text
meshName = Text
a} :: ListVirtualGateways)

instance Core.AWSPager ListVirtualGateways where
  page :: ListVirtualGateways
-> AWSResponse ListVirtualGateways -> Maybe ListVirtualGateways
page ListVirtualGateways
rq AWSResponse ListVirtualGateways
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse ListVirtualGateways
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListVirtualGatewaysResponse (Maybe Text)
listVirtualGatewaysResponse_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 ListVirtualGateways
rs
            forall s a. s -> Getting a s a -> a
Lens.^. Lens' ListVirtualGatewaysResponse [VirtualGatewayRef]
listVirtualGatewaysResponse_virtualGateways
        ) =
        forall a. Maybe a
Prelude.Nothing
    | Bool
Prelude.otherwise =
        forall a. a -> Maybe a
Prelude.Just
          forall a b. (a -> b) -> a -> b
Prelude.$ ListVirtualGateways
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' ListVirtualGateways (Maybe Text)
listVirtualGateways_nextToken
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse ListVirtualGateways
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListVirtualGatewaysResponse (Maybe Text)
listVirtualGatewaysResponse_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 ListVirtualGateways where
  type
    AWSResponse ListVirtualGateways =
      ListVirtualGatewaysResponse
  request :: (Service -> Service)
-> ListVirtualGateways -> Request ListVirtualGateways
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 ListVirtualGateways
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse ListVirtualGateways)))
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
-> Int -> [VirtualGatewayRef] -> ListVirtualGatewaysResponse
ListVirtualGatewaysResponse'
            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.<*> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
            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
"virtualGateways"
                            forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty
                        )
      )

instance Prelude.Hashable ListVirtualGateways where
  hashWithSalt :: Int -> ListVirtualGateways -> Int
hashWithSalt Int
_salt ListVirtualGateways' {Maybe Natural
Maybe Text
Text
meshName :: Text
nextToken :: Maybe Text
meshOwner :: Maybe Text
limit :: Maybe Natural
$sel:meshName:ListVirtualGateways' :: ListVirtualGateways -> Text
$sel:nextToken:ListVirtualGateways' :: ListVirtualGateways -> Maybe Text
$sel:meshOwner:ListVirtualGateways' :: ListVirtualGateways -> Maybe Text
$sel:limit:ListVirtualGateways' :: ListVirtualGateways -> 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
meshOwner
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
nextToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
meshName

instance Prelude.NFData ListVirtualGateways where
  rnf :: ListVirtualGateways -> ()
rnf ListVirtualGateways' {Maybe Natural
Maybe Text
Text
meshName :: Text
nextToken :: Maybe Text
meshOwner :: Maybe Text
limit :: Maybe Natural
$sel:meshName:ListVirtualGateways' :: ListVirtualGateways -> Text
$sel:nextToken:ListVirtualGateways' :: ListVirtualGateways -> Maybe Text
$sel:meshOwner:ListVirtualGateways' :: ListVirtualGateways -> Maybe Text
$sel:limit:ListVirtualGateways' :: ListVirtualGateways -> 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
meshOwner
      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
meshName

instance Data.ToHeaders ListVirtualGateways where
  toHeaders :: ListVirtualGateways -> 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 ListVirtualGateways where
  toPath :: ListVirtualGateways -> ByteString
toPath ListVirtualGateways' {Maybe Natural
Maybe Text
Text
meshName :: Text
nextToken :: Maybe Text
meshOwner :: Maybe Text
limit :: Maybe Natural
$sel:meshName:ListVirtualGateways' :: ListVirtualGateways -> Text
$sel:nextToken:ListVirtualGateways' :: ListVirtualGateways -> Maybe Text
$sel:meshOwner:ListVirtualGateways' :: ListVirtualGateways -> Maybe Text
$sel:limit:ListVirtualGateways' :: ListVirtualGateways -> Maybe Natural
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/v20190125/meshes/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
meshName,
        ByteString
"/virtualGateways"
      ]

instance Data.ToQuery ListVirtualGateways where
  toQuery :: ListVirtualGateways -> QueryString
toQuery ListVirtualGateways' {Maybe Natural
Maybe Text
Text
meshName :: Text
nextToken :: Maybe Text
meshOwner :: Maybe Text
limit :: Maybe Natural
$sel:meshName:ListVirtualGateways' :: ListVirtualGateways -> Text
$sel:nextToken:ListVirtualGateways' :: ListVirtualGateways -> Maybe Text
$sel:meshOwner:ListVirtualGateways' :: ListVirtualGateways -> Maybe Text
$sel:limit:ListVirtualGateways' :: ListVirtualGateways -> Maybe Natural
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"limit" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Natural
limit,
        ByteString
"meshOwner" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
meshOwner,
        ByteString
"nextToken" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
nextToken
      ]

-- | /See:/ 'newListVirtualGatewaysResponse' smart constructor.
data ListVirtualGatewaysResponse = ListVirtualGatewaysResponse'
  { -- | The @nextToken@ value to include in a future @ListVirtualGateways@
    -- request. When the results of a @ListVirtualGateways@ request exceed
    -- @limit@, you can use this value to retrieve the next page of results.
    -- This value is @null@ when there are no more results to return.
    ListVirtualGatewaysResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    ListVirtualGatewaysResponse -> Int
httpStatus :: Prelude.Int,
    -- | The list of existing virtual gateways for the specified service mesh.
    ListVirtualGatewaysResponse -> [VirtualGatewayRef]
virtualGateways :: [VirtualGatewayRef]
  }
  deriving (ListVirtualGatewaysResponse -> ListVirtualGatewaysResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListVirtualGatewaysResponse -> ListVirtualGatewaysResponse -> Bool
$c/= :: ListVirtualGatewaysResponse -> ListVirtualGatewaysResponse -> Bool
== :: ListVirtualGatewaysResponse -> ListVirtualGatewaysResponse -> Bool
$c== :: ListVirtualGatewaysResponse -> ListVirtualGatewaysResponse -> Bool
Prelude.Eq, ReadPrec [ListVirtualGatewaysResponse]
ReadPrec ListVirtualGatewaysResponse
Int -> ReadS ListVirtualGatewaysResponse
ReadS [ListVirtualGatewaysResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListVirtualGatewaysResponse]
$creadListPrec :: ReadPrec [ListVirtualGatewaysResponse]
readPrec :: ReadPrec ListVirtualGatewaysResponse
$creadPrec :: ReadPrec ListVirtualGatewaysResponse
readList :: ReadS [ListVirtualGatewaysResponse]
$creadList :: ReadS [ListVirtualGatewaysResponse]
readsPrec :: Int -> ReadS ListVirtualGatewaysResponse
$creadsPrec :: Int -> ReadS ListVirtualGatewaysResponse
Prelude.Read, Int -> ListVirtualGatewaysResponse -> ShowS
[ListVirtualGatewaysResponse] -> ShowS
ListVirtualGatewaysResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListVirtualGatewaysResponse] -> ShowS
$cshowList :: [ListVirtualGatewaysResponse] -> ShowS
show :: ListVirtualGatewaysResponse -> String
$cshow :: ListVirtualGatewaysResponse -> String
showsPrec :: Int -> ListVirtualGatewaysResponse -> ShowS
$cshowsPrec :: Int -> ListVirtualGatewaysResponse -> ShowS
Prelude.Show, forall x.
Rep ListVirtualGatewaysResponse x -> ListVirtualGatewaysResponse
forall x.
ListVirtualGatewaysResponse -> Rep ListVirtualGatewaysResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ListVirtualGatewaysResponse x -> ListVirtualGatewaysResponse
$cfrom :: forall x.
ListVirtualGatewaysResponse -> Rep ListVirtualGatewaysResponse x
Prelude.Generic)

-- |
-- Create a value of 'ListVirtualGatewaysResponse' 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', 'listVirtualGatewaysResponse_nextToken' - The @nextToken@ value to include in a future @ListVirtualGateways@
-- request. When the results of a @ListVirtualGateways@ request exceed
-- @limit@, 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', 'listVirtualGatewaysResponse_httpStatus' - The response's http status code.
--
-- 'virtualGateways', 'listVirtualGatewaysResponse_virtualGateways' - The list of existing virtual gateways for the specified service mesh.
newListVirtualGatewaysResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ListVirtualGatewaysResponse
newListVirtualGatewaysResponse :: Int -> ListVirtualGatewaysResponse
newListVirtualGatewaysResponse Int
pHttpStatus_ =
  ListVirtualGatewaysResponse'
    { $sel:nextToken:ListVirtualGatewaysResponse' :: Maybe Text
nextToken =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ListVirtualGatewaysResponse' :: Int
httpStatus = Int
pHttpStatus_,
      $sel:virtualGateways:ListVirtualGatewaysResponse' :: [VirtualGatewayRef]
virtualGateways = forall a. Monoid a => a
Prelude.mempty
    }

-- | The @nextToken@ value to include in a future @ListVirtualGateways@
-- request. When the results of a @ListVirtualGateways@ request exceed
-- @limit@, you can use this value to retrieve the next page of results.
-- This value is @null@ when there are no more results to return.
listVirtualGatewaysResponse_nextToken :: Lens.Lens' ListVirtualGatewaysResponse (Prelude.Maybe Prelude.Text)
listVirtualGatewaysResponse_nextToken :: Lens' ListVirtualGatewaysResponse (Maybe Text)
listVirtualGatewaysResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListVirtualGatewaysResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListVirtualGatewaysResponse' :: ListVirtualGatewaysResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListVirtualGatewaysResponse
s@ListVirtualGatewaysResponse' {} Maybe Text
a -> ListVirtualGatewaysResponse
s {$sel:nextToken:ListVirtualGatewaysResponse' :: Maybe Text
nextToken = Maybe Text
a} :: ListVirtualGatewaysResponse)

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

-- | The list of existing virtual gateways for the specified service mesh.
listVirtualGatewaysResponse_virtualGateways :: Lens.Lens' ListVirtualGatewaysResponse [VirtualGatewayRef]
listVirtualGatewaysResponse_virtualGateways :: Lens' ListVirtualGatewaysResponse [VirtualGatewayRef]
listVirtualGatewaysResponse_virtualGateways = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListVirtualGatewaysResponse' {[VirtualGatewayRef]
virtualGateways :: [VirtualGatewayRef]
$sel:virtualGateways:ListVirtualGatewaysResponse' :: ListVirtualGatewaysResponse -> [VirtualGatewayRef]
virtualGateways} -> [VirtualGatewayRef]
virtualGateways) (\s :: ListVirtualGatewaysResponse
s@ListVirtualGatewaysResponse' {} [VirtualGatewayRef]
a -> ListVirtualGatewaysResponse
s {$sel:virtualGateways:ListVirtualGatewaysResponse' :: [VirtualGatewayRef]
virtualGateways = [VirtualGatewayRef]
a} :: ListVirtualGatewaysResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

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