{-# 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.EC2.DescribeClientVpnRoutes
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Describes the routes for the specified Client VPN endpoint.
--
-- This operation returns paginated results.
module Amazonka.EC2.DescribeClientVpnRoutes
  ( -- * Creating a Request
    DescribeClientVpnRoutes (..),
    newDescribeClientVpnRoutes,

    -- * Request Lenses
    describeClientVpnRoutes_dryRun,
    describeClientVpnRoutes_filters,
    describeClientVpnRoutes_maxResults,
    describeClientVpnRoutes_nextToken,
    describeClientVpnRoutes_clientVpnEndpointId,

    -- * Destructuring the Response
    DescribeClientVpnRoutesResponse (..),
    newDescribeClientVpnRoutesResponse,

    -- * Response Lenses
    describeClientVpnRoutesResponse_nextToken,
    describeClientVpnRoutesResponse_routes,
    describeClientVpnRoutesResponse_httpStatus,
  )
where

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

-- | /See:/ 'newDescribeClientVpnRoutes' smart constructor.
data DescribeClientVpnRoutes = DescribeClientVpnRoutes'
  { -- | Checks whether you have the required permissions for the action, without
    -- actually making the request, and provides an error response. If you have
    -- the required permissions, the error response is @DryRunOperation@.
    -- Otherwise, it is @UnauthorizedOperation@.
    DescribeClientVpnRoutes -> Maybe Bool
dryRun :: Prelude.Maybe Prelude.Bool,
    -- | One or more filters. Filter names and values are case-sensitive.
    --
    -- -   @destination-cidr@ - The CIDR of the route destination.
    --
    -- -   @origin@ - How the route was associated with the Client VPN endpoint
    --     (@associate@ | @add-route@).
    --
    -- -   @target-subnet@ - The ID of the subnet through which traffic is
    --     routed.
    DescribeClientVpnRoutes -> Maybe [Filter]
filters :: Prelude.Maybe [Filter],
    -- | The maximum number of results to return for the request in a single
    -- page. The remaining results can be seen by sending another request with
    -- the nextToken value.
    DescribeClientVpnRoutes -> Maybe Natural
maxResults :: Prelude.Maybe Prelude.Natural,
    -- | The token to retrieve the next page of results.
    DescribeClientVpnRoutes -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The ID of the Client VPN endpoint.
    DescribeClientVpnRoutes -> Text
clientVpnEndpointId :: Prelude.Text
  }
  deriving (DescribeClientVpnRoutes -> DescribeClientVpnRoutes -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeClientVpnRoutes -> DescribeClientVpnRoutes -> Bool
$c/= :: DescribeClientVpnRoutes -> DescribeClientVpnRoutes -> Bool
== :: DescribeClientVpnRoutes -> DescribeClientVpnRoutes -> Bool
$c== :: DescribeClientVpnRoutes -> DescribeClientVpnRoutes -> Bool
Prelude.Eq, ReadPrec [DescribeClientVpnRoutes]
ReadPrec DescribeClientVpnRoutes
Int -> ReadS DescribeClientVpnRoutes
ReadS [DescribeClientVpnRoutes]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeClientVpnRoutes]
$creadListPrec :: ReadPrec [DescribeClientVpnRoutes]
readPrec :: ReadPrec DescribeClientVpnRoutes
$creadPrec :: ReadPrec DescribeClientVpnRoutes
readList :: ReadS [DescribeClientVpnRoutes]
$creadList :: ReadS [DescribeClientVpnRoutes]
readsPrec :: Int -> ReadS DescribeClientVpnRoutes
$creadsPrec :: Int -> ReadS DescribeClientVpnRoutes
Prelude.Read, Int -> DescribeClientVpnRoutes -> ShowS
[DescribeClientVpnRoutes] -> ShowS
DescribeClientVpnRoutes -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeClientVpnRoutes] -> ShowS
$cshowList :: [DescribeClientVpnRoutes] -> ShowS
show :: DescribeClientVpnRoutes -> String
$cshow :: DescribeClientVpnRoutes -> String
showsPrec :: Int -> DescribeClientVpnRoutes -> ShowS
$cshowsPrec :: Int -> DescribeClientVpnRoutes -> ShowS
Prelude.Show, forall x. Rep DescribeClientVpnRoutes x -> DescribeClientVpnRoutes
forall x. DescribeClientVpnRoutes -> Rep DescribeClientVpnRoutes x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DescribeClientVpnRoutes x -> DescribeClientVpnRoutes
$cfrom :: forall x. DescribeClientVpnRoutes -> Rep DescribeClientVpnRoutes x
Prelude.Generic)

-- |
-- Create a value of 'DescribeClientVpnRoutes' 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:
--
-- 'dryRun', 'describeClientVpnRoutes_dryRun' - Checks whether you have the required permissions for the action, without
-- actually making the request, and provides an error response. If you have
-- the required permissions, the error response is @DryRunOperation@.
-- Otherwise, it is @UnauthorizedOperation@.
--
-- 'filters', 'describeClientVpnRoutes_filters' - One or more filters. Filter names and values are case-sensitive.
--
-- -   @destination-cidr@ - The CIDR of the route destination.
--
-- -   @origin@ - How the route was associated with the Client VPN endpoint
--     (@associate@ | @add-route@).
--
-- -   @target-subnet@ - The ID of the subnet through which traffic is
--     routed.
--
-- 'maxResults', 'describeClientVpnRoutes_maxResults' - The maximum number of results to return for the request in a single
-- page. The remaining results can be seen by sending another request with
-- the nextToken value.
--
-- 'nextToken', 'describeClientVpnRoutes_nextToken' - The token to retrieve the next page of results.
--
-- 'clientVpnEndpointId', 'describeClientVpnRoutes_clientVpnEndpointId' - The ID of the Client VPN endpoint.
newDescribeClientVpnRoutes ::
  -- | 'clientVpnEndpointId'
  Prelude.Text ->
  DescribeClientVpnRoutes
newDescribeClientVpnRoutes :: Text -> DescribeClientVpnRoutes
newDescribeClientVpnRoutes Text
pClientVpnEndpointId_ =
  DescribeClientVpnRoutes'
    { $sel:dryRun:DescribeClientVpnRoutes' :: Maybe Bool
dryRun = forall a. Maybe a
Prelude.Nothing,
      $sel:filters:DescribeClientVpnRoutes' :: Maybe [Filter]
filters = forall a. Maybe a
Prelude.Nothing,
      $sel:maxResults:DescribeClientVpnRoutes' :: Maybe Natural
maxResults = forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:DescribeClientVpnRoutes' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:clientVpnEndpointId:DescribeClientVpnRoutes' :: Text
clientVpnEndpointId = Text
pClientVpnEndpointId_
    }

-- | Checks whether you have the required permissions for the action, without
-- actually making the request, and provides an error response. If you have
-- the required permissions, the error response is @DryRunOperation@.
-- Otherwise, it is @UnauthorizedOperation@.
describeClientVpnRoutes_dryRun :: Lens.Lens' DescribeClientVpnRoutes (Prelude.Maybe Prelude.Bool)
describeClientVpnRoutes_dryRun :: Lens' DescribeClientVpnRoutes (Maybe Bool)
describeClientVpnRoutes_dryRun = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeClientVpnRoutes' {Maybe Bool
dryRun :: Maybe Bool
$sel:dryRun:DescribeClientVpnRoutes' :: DescribeClientVpnRoutes -> Maybe Bool
dryRun} -> Maybe Bool
dryRun) (\s :: DescribeClientVpnRoutes
s@DescribeClientVpnRoutes' {} Maybe Bool
a -> DescribeClientVpnRoutes
s {$sel:dryRun:DescribeClientVpnRoutes' :: Maybe Bool
dryRun = Maybe Bool
a} :: DescribeClientVpnRoutes)

-- | One or more filters. Filter names and values are case-sensitive.
--
-- -   @destination-cidr@ - The CIDR of the route destination.
--
-- -   @origin@ - How the route was associated with the Client VPN endpoint
--     (@associate@ | @add-route@).
--
-- -   @target-subnet@ - The ID of the subnet through which traffic is
--     routed.
describeClientVpnRoutes_filters :: Lens.Lens' DescribeClientVpnRoutes (Prelude.Maybe [Filter])
describeClientVpnRoutes_filters :: Lens' DescribeClientVpnRoutes (Maybe [Filter])
describeClientVpnRoutes_filters = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeClientVpnRoutes' {Maybe [Filter]
filters :: Maybe [Filter]
$sel:filters:DescribeClientVpnRoutes' :: DescribeClientVpnRoutes -> Maybe [Filter]
filters} -> Maybe [Filter]
filters) (\s :: DescribeClientVpnRoutes
s@DescribeClientVpnRoutes' {} Maybe [Filter]
a -> DescribeClientVpnRoutes
s {$sel:filters:DescribeClientVpnRoutes' :: Maybe [Filter]
filters = Maybe [Filter]
a} :: DescribeClientVpnRoutes) 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 maximum number of results to return for the request in a single
-- page. The remaining results can be seen by sending another request with
-- the nextToken value.
describeClientVpnRoutes_maxResults :: Lens.Lens' DescribeClientVpnRoutes (Prelude.Maybe Prelude.Natural)
describeClientVpnRoutes_maxResults :: Lens' DescribeClientVpnRoutes (Maybe Natural)
describeClientVpnRoutes_maxResults = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeClientVpnRoutes' {Maybe Natural
maxResults :: Maybe Natural
$sel:maxResults:DescribeClientVpnRoutes' :: DescribeClientVpnRoutes -> Maybe Natural
maxResults} -> Maybe Natural
maxResults) (\s :: DescribeClientVpnRoutes
s@DescribeClientVpnRoutes' {} Maybe Natural
a -> DescribeClientVpnRoutes
s {$sel:maxResults:DescribeClientVpnRoutes' :: Maybe Natural
maxResults = Maybe Natural
a} :: DescribeClientVpnRoutes)

-- | The token to retrieve the next page of results.
describeClientVpnRoutes_nextToken :: Lens.Lens' DescribeClientVpnRoutes (Prelude.Maybe Prelude.Text)
describeClientVpnRoutes_nextToken :: Lens' DescribeClientVpnRoutes (Maybe Text)
describeClientVpnRoutes_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeClientVpnRoutes' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:DescribeClientVpnRoutes' :: DescribeClientVpnRoutes -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: DescribeClientVpnRoutes
s@DescribeClientVpnRoutes' {} Maybe Text
a -> DescribeClientVpnRoutes
s {$sel:nextToken:DescribeClientVpnRoutes' :: Maybe Text
nextToken = Maybe Text
a} :: DescribeClientVpnRoutes)

-- | The ID of the Client VPN endpoint.
describeClientVpnRoutes_clientVpnEndpointId :: Lens.Lens' DescribeClientVpnRoutes Prelude.Text
describeClientVpnRoutes_clientVpnEndpointId :: Lens' DescribeClientVpnRoutes Text
describeClientVpnRoutes_clientVpnEndpointId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeClientVpnRoutes' {Text
clientVpnEndpointId :: Text
$sel:clientVpnEndpointId:DescribeClientVpnRoutes' :: DescribeClientVpnRoutes -> Text
clientVpnEndpointId} -> Text
clientVpnEndpointId) (\s :: DescribeClientVpnRoutes
s@DescribeClientVpnRoutes' {} Text
a -> DescribeClientVpnRoutes
s {$sel:clientVpnEndpointId:DescribeClientVpnRoutes' :: Text
clientVpnEndpointId = Text
a} :: DescribeClientVpnRoutes)

instance Core.AWSPager DescribeClientVpnRoutes where
  page :: DescribeClientVpnRoutes
-> AWSResponse DescribeClientVpnRoutes
-> Maybe DescribeClientVpnRoutes
page DescribeClientVpnRoutes
rq AWSResponse DescribeClientVpnRoutes
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse DescribeClientVpnRoutes
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' DescribeClientVpnRoutesResponse (Maybe Text)
describeClientVpnRoutesResponse_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 DescribeClientVpnRoutes
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' DescribeClientVpnRoutesResponse (Maybe [ClientVpnRoute])
describeClientVpnRoutesResponse_routes
            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.$ DescribeClientVpnRoutes
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' DescribeClientVpnRoutes (Maybe Text)
describeClientVpnRoutes_nextToken
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse DescribeClientVpnRoutes
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' DescribeClientVpnRoutesResponse (Maybe Text)
describeClientVpnRoutesResponse_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 DescribeClientVpnRoutes where
  type
    AWSResponse DescribeClientVpnRoutes =
      DescribeClientVpnRoutesResponse
  request :: (Service -> Service)
-> DescribeClientVpnRoutes -> Request DescribeClientVpnRoutes
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.postQuery (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy DescribeClientVpnRoutes
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse DescribeClientVpnRoutes)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> [Node] -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveXML
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Maybe Text
-> Maybe [ClientVpnRoute] -> Int -> DescribeClientVpnRoutesResponse
DescribeClientVpnRoutesResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"nextToken")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ( [Node]
x
                            forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"routes"
                            forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty
                            forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
Prelude.>>= forall (f :: * -> *) a b.
Applicative f =>
([a] -> f b) -> [a] -> f (Maybe b)
Core.may (forall a. FromXML a => Text -> [Node] -> Either String [a]
Data.parseXMLList Text
"item")
                        )
            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 DescribeClientVpnRoutes where
  hashWithSalt :: Int -> DescribeClientVpnRoutes -> Int
hashWithSalt Int
_salt DescribeClientVpnRoutes' {Maybe Bool
Maybe Natural
Maybe [Filter]
Maybe Text
Text
clientVpnEndpointId :: Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
filters :: Maybe [Filter]
dryRun :: Maybe Bool
$sel:clientVpnEndpointId:DescribeClientVpnRoutes' :: DescribeClientVpnRoutes -> Text
$sel:nextToken:DescribeClientVpnRoutes' :: DescribeClientVpnRoutes -> Maybe Text
$sel:maxResults:DescribeClientVpnRoutes' :: DescribeClientVpnRoutes -> Maybe Natural
$sel:filters:DescribeClientVpnRoutes' :: DescribeClientVpnRoutes -> Maybe [Filter]
$sel:dryRun:DescribeClientVpnRoutes' :: DescribeClientVpnRoutes -> Maybe Bool
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
dryRun
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Filter]
filters
      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
clientVpnEndpointId

instance Prelude.NFData DescribeClientVpnRoutes where
  rnf :: DescribeClientVpnRoutes -> ()
rnf DescribeClientVpnRoutes' {Maybe Bool
Maybe Natural
Maybe [Filter]
Maybe Text
Text
clientVpnEndpointId :: Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
filters :: Maybe [Filter]
dryRun :: Maybe Bool
$sel:clientVpnEndpointId:DescribeClientVpnRoutes' :: DescribeClientVpnRoutes -> Text
$sel:nextToken:DescribeClientVpnRoutes' :: DescribeClientVpnRoutes -> Maybe Text
$sel:maxResults:DescribeClientVpnRoutes' :: DescribeClientVpnRoutes -> Maybe Natural
$sel:filters:DescribeClientVpnRoutes' :: DescribeClientVpnRoutes -> Maybe [Filter]
$sel:dryRun:DescribeClientVpnRoutes' :: DescribeClientVpnRoutes -> Maybe Bool
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
dryRun
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Filter]
filters
      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
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
clientVpnEndpointId

instance Data.ToHeaders DescribeClientVpnRoutes where
  toHeaders :: DescribeClientVpnRoutes -> ResponseHeaders
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

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

instance Data.ToQuery DescribeClientVpnRoutes where
  toQuery :: DescribeClientVpnRoutes -> QueryString
toQuery DescribeClientVpnRoutes' {Maybe Bool
Maybe Natural
Maybe [Filter]
Maybe Text
Text
clientVpnEndpointId :: Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
filters :: Maybe [Filter]
dryRun :: Maybe Bool
$sel:clientVpnEndpointId:DescribeClientVpnRoutes' :: DescribeClientVpnRoutes -> Text
$sel:nextToken:DescribeClientVpnRoutes' :: DescribeClientVpnRoutes -> Maybe Text
$sel:maxResults:DescribeClientVpnRoutes' :: DescribeClientVpnRoutes -> Maybe Natural
$sel:filters:DescribeClientVpnRoutes' :: DescribeClientVpnRoutes -> Maybe [Filter]
$sel:dryRun:DescribeClientVpnRoutes' :: DescribeClientVpnRoutes -> Maybe Bool
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"DescribeClientVpnRoutes" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2016-11-15" :: Prelude.ByteString),
        ByteString
"DryRun" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
dryRun,
        forall a. ToQuery a => a -> QueryString
Data.toQuery
          (forall a.
(IsList a, ToQuery (Item a)) =>
ByteString -> a -> QueryString
Data.toQueryList ByteString
"Filter" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [Filter]
filters),
        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,
        ByteString
"ClientVpnEndpointId" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
clientVpnEndpointId
      ]

-- | /See:/ 'newDescribeClientVpnRoutesResponse' smart constructor.
data DescribeClientVpnRoutesResponse = DescribeClientVpnRoutesResponse'
  { -- | The token to use to retrieve the next page of results. This value is
    -- @null@ when there are no more results to return.
    DescribeClientVpnRoutesResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | Information about the Client VPN endpoint routes.
    DescribeClientVpnRoutesResponse -> Maybe [ClientVpnRoute]
routes :: Prelude.Maybe [ClientVpnRoute],
    -- | The response's http status code.
    DescribeClientVpnRoutesResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (DescribeClientVpnRoutesResponse
-> DescribeClientVpnRoutesResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeClientVpnRoutesResponse
-> DescribeClientVpnRoutesResponse -> Bool
$c/= :: DescribeClientVpnRoutesResponse
-> DescribeClientVpnRoutesResponse -> Bool
== :: DescribeClientVpnRoutesResponse
-> DescribeClientVpnRoutesResponse -> Bool
$c== :: DescribeClientVpnRoutesResponse
-> DescribeClientVpnRoutesResponse -> Bool
Prelude.Eq, ReadPrec [DescribeClientVpnRoutesResponse]
ReadPrec DescribeClientVpnRoutesResponse
Int -> ReadS DescribeClientVpnRoutesResponse
ReadS [DescribeClientVpnRoutesResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeClientVpnRoutesResponse]
$creadListPrec :: ReadPrec [DescribeClientVpnRoutesResponse]
readPrec :: ReadPrec DescribeClientVpnRoutesResponse
$creadPrec :: ReadPrec DescribeClientVpnRoutesResponse
readList :: ReadS [DescribeClientVpnRoutesResponse]
$creadList :: ReadS [DescribeClientVpnRoutesResponse]
readsPrec :: Int -> ReadS DescribeClientVpnRoutesResponse
$creadsPrec :: Int -> ReadS DescribeClientVpnRoutesResponse
Prelude.Read, Int -> DescribeClientVpnRoutesResponse -> ShowS
[DescribeClientVpnRoutesResponse] -> ShowS
DescribeClientVpnRoutesResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeClientVpnRoutesResponse] -> ShowS
$cshowList :: [DescribeClientVpnRoutesResponse] -> ShowS
show :: DescribeClientVpnRoutesResponse -> String
$cshow :: DescribeClientVpnRoutesResponse -> String
showsPrec :: Int -> DescribeClientVpnRoutesResponse -> ShowS
$cshowsPrec :: Int -> DescribeClientVpnRoutesResponse -> ShowS
Prelude.Show, forall x.
Rep DescribeClientVpnRoutesResponse x
-> DescribeClientVpnRoutesResponse
forall x.
DescribeClientVpnRoutesResponse
-> Rep DescribeClientVpnRoutesResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DescribeClientVpnRoutesResponse x
-> DescribeClientVpnRoutesResponse
$cfrom :: forall x.
DescribeClientVpnRoutesResponse
-> Rep DescribeClientVpnRoutesResponse x
Prelude.Generic)

-- |
-- Create a value of 'DescribeClientVpnRoutesResponse' 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', 'describeClientVpnRoutesResponse_nextToken' - The token to use to retrieve the next page of results. This value is
-- @null@ when there are no more results to return.
--
-- 'routes', 'describeClientVpnRoutesResponse_routes' - Information about the Client VPN endpoint routes.
--
-- 'httpStatus', 'describeClientVpnRoutesResponse_httpStatus' - The response's http status code.
newDescribeClientVpnRoutesResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DescribeClientVpnRoutesResponse
newDescribeClientVpnRoutesResponse :: Int -> DescribeClientVpnRoutesResponse
newDescribeClientVpnRoutesResponse Int
pHttpStatus_ =
  DescribeClientVpnRoutesResponse'
    { $sel:nextToken:DescribeClientVpnRoutesResponse' :: Maybe Text
nextToken =
        forall a. Maybe a
Prelude.Nothing,
      $sel:routes:DescribeClientVpnRoutesResponse' :: Maybe [ClientVpnRoute]
routes = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:DescribeClientVpnRoutesResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The token to use to retrieve the next page of results. This value is
-- @null@ when there are no more results to return.
describeClientVpnRoutesResponse_nextToken :: Lens.Lens' DescribeClientVpnRoutesResponse (Prelude.Maybe Prelude.Text)
describeClientVpnRoutesResponse_nextToken :: Lens' DescribeClientVpnRoutesResponse (Maybe Text)
describeClientVpnRoutesResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeClientVpnRoutesResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:DescribeClientVpnRoutesResponse' :: DescribeClientVpnRoutesResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: DescribeClientVpnRoutesResponse
s@DescribeClientVpnRoutesResponse' {} Maybe Text
a -> DescribeClientVpnRoutesResponse
s {$sel:nextToken:DescribeClientVpnRoutesResponse' :: Maybe Text
nextToken = Maybe Text
a} :: DescribeClientVpnRoutesResponse)

-- | Information about the Client VPN endpoint routes.
describeClientVpnRoutesResponse_routes :: Lens.Lens' DescribeClientVpnRoutesResponse (Prelude.Maybe [ClientVpnRoute])
describeClientVpnRoutesResponse_routes :: Lens' DescribeClientVpnRoutesResponse (Maybe [ClientVpnRoute])
describeClientVpnRoutesResponse_routes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeClientVpnRoutesResponse' {Maybe [ClientVpnRoute]
routes :: Maybe [ClientVpnRoute]
$sel:routes:DescribeClientVpnRoutesResponse' :: DescribeClientVpnRoutesResponse -> Maybe [ClientVpnRoute]
routes} -> Maybe [ClientVpnRoute]
routes) (\s :: DescribeClientVpnRoutesResponse
s@DescribeClientVpnRoutesResponse' {} Maybe [ClientVpnRoute]
a -> DescribeClientVpnRoutesResponse
s {$sel:routes:DescribeClientVpnRoutesResponse' :: Maybe [ClientVpnRoute]
routes = Maybe [ClientVpnRoute]
a} :: DescribeClientVpnRoutesResponse) 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.
describeClientVpnRoutesResponse_httpStatus :: Lens.Lens' DescribeClientVpnRoutesResponse Prelude.Int
describeClientVpnRoutesResponse_httpStatus :: Lens' DescribeClientVpnRoutesResponse Int
describeClientVpnRoutesResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeClientVpnRoutesResponse' {Int
httpStatus :: Int
$sel:httpStatus:DescribeClientVpnRoutesResponse' :: DescribeClientVpnRoutesResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: DescribeClientVpnRoutesResponse
s@DescribeClientVpnRoutesResponse' {} Int
a -> DescribeClientVpnRoutesResponse
s {$sel:httpStatus:DescribeClientVpnRoutesResponse' :: Int
httpStatus = Int
a} :: DescribeClientVpnRoutesResponse)

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