{-# 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.PrivateNetworks.ListNetworks
-- 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 networks. Add filters to your request to return a more specific
-- list of results. Use filters to match the status of the network.
--
-- This operation returns paginated results.
module Amazonka.PrivateNetworks.ListNetworks
  ( -- * Creating a Request
    ListNetworks (..),
    newListNetworks,

    -- * Request Lenses
    listNetworks_filters,
    listNetworks_maxResults,
    listNetworks_startToken,

    -- * Destructuring the Response
    ListNetworksResponse (..),
    newListNetworksResponse,

    -- * Response Lenses
    listNetworksResponse_networks,
    listNetworksResponse_nextToken,
    listNetworksResponse_httpStatus,
  )
where

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 Amazonka.PrivateNetworks.Types
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newListNetworks' smart constructor.
data ListNetworks = ListNetworks'
  { -- | The filters.
    --
    -- -   @STATUS@ - The status (@AVAILABLE@ | @CREATED@ | @DELETED@ |
    --     @DEPROVISIONING@ | @PROVISIONING@).
    --
    -- Filter values are case sensitive. If you specify multiple values for a
    -- filter, the values are joined with an @OR@, and the request returns all
    -- results that match any of the specified values.
    ListNetworks -> Maybe (HashMap NetworkFilterKeys [Text])
filters :: Prelude.Maybe (Prelude.HashMap NetworkFilterKeys [Prelude.Text]),
    -- | The maximum number of results to return.
    ListNetworks -> Maybe Natural
maxResults :: Prelude.Maybe Prelude.Natural,
    -- | The token for the next page of results.
    ListNetworks -> Maybe Text
startToken :: Prelude.Maybe Prelude.Text
  }
  deriving (ListNetworks -> ListNetworks -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListNetworks -> ListNetworks -> Bool
$c/= :: ListNetworks -> ListNetworks -> Bool
== :: ListNetworks -> ListNetworks -> Bool
$c== :: ListNetworks -> ListNetworks -> Bool
Prelude.Eq, ReadPrec [ListNetworks]
ReadPrec ListNetworks
Int -> ReadS ListNetworks
ReadS [ListNetworks]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListNetworks]
$creadListPrec :: ReadPrec [ListNetworks]
readPrec :: ReadPrec ListNetworks
$creadPrec :: ReadPrec ListNetworks
readList :: ReadS [ListNetworks]
$creadList :: ReadS [ListNetworks]
readsPrec :: Int -> ReadS ListNetworks
$creadsPrec :: Int -> ReadS ListNetworks
Prelude.Read, Int -> ListNetworks -> ShowS
[ListNetworks] -> ShowS
ListNetworks -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListNetworks] -> ShowS
$cshowList :: [ListNetworks] -> ShowS
show :: ListNetworks -> String
$cshow :: ListNetworks -> String
showsPrec :: Int -> ListNetworks -> ShowS
$cshowsPrec :: Int -> ListNetworks -> ShowS
Prelude.Show, forall x. Rep ListNetworks x -> ListNetworks
forall x. ListNetworks -> Rep ListNetworks x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListNetworks x -> ListNetworks
$cfrom :: forall x. ListNetworks -> Rep ListNetworks x
Prelude.Generic)

-- |
-- Create a value of 'ListNetworks' 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:
--
-- 'filters', 'listNetworks_filters' - The filters.
--
-- -   @STATUS@ - The status (@AVAILABLE@ | @CREATED@ | @DELETED@ |
--     @DEPROVISIONING@ | @PROVISIONING@).
--
-- Filter values are case sensitive. If you specify multiple values for a
-- filter, the values are joined with an @OR@, and the request returns all
-- results that match any of the specified values.
--
-- 'maxResults', 'listNetworks_maxResults' - The maximum number of results to return.
--
-- 'startToken', 'listNetworks_startToken' - The token for the next page of results.
newListNetworks ::
  ListNetworks
newListNetworks :: ListNetworks
newListNetworks =
  ListNetworks'
    { $sel:filters:ListNetworks' :: Maybe (HashMap NetworkFilterKeys [Text])
filters = forall a. Maybe a
Prelude.Nothing,
      $sel:maxResults:ListNetworks' :: Maybe Natural
maxResults = forall a. Maybe a
Prelude.Nothing,
      $sel:startToken:ListNetworks' :: Maybe Text
startToken = forall a. Maybe a
Prelude.Nothing
    }

-- | The filters.
--
-- -   @STATUS@ - The status (@AVAILABLE@ | @CREATED@ | @DELETED@ |
--     @DEPROVISIONING@ | @PROVISIONING@).
--
-- Filter values are case sensitive. If you specify multiple values for a
-- filter, the values are joined with an @OR@, and the request returns all
-- results that match any of the specified values.
listNetworks_filters :: Lens.Lens' ListNetworks (Prelude.Maybe (Prelude.HashMap NetworkFilterKeys [Prelude.Text]))
listNetworks_filters :: Lens' ListNetworks (Maybe (HashMap NetworkFilterKeys [Text]))
listNetworks_filters = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListNetworks' {Maybe (HashMap NetworkFilterKeys [Text])
filters :: Maybe (HashMap NetworkFilterKeys [Text])
$sel:filters:ListNetworks' :: ListNetworks -> Maybe (HashMap NetworkFilterKeys [Text])
filters} -> Maybe (HashMap NetworkFilterKeys [Text])
filters) (\s :: ListNetworks
s@ListNetworks' {} Maybe (HashMap NetworkFilterKeys [Text])
a -> ListNetworks
s {$sel:filters:ListNetworks' :: Maybe (HashMap NetworkFilterKeys [Text])
filters = Maybe (HashMap NetworkFilterKeys [Text])
a} :: ListNetworks) 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.
listNetworks_maxResults :: Lens.Lens' ListNetworks (Prelude.Maybe Prelude.Natural)
listNetworks_maxResults :: Lens' ListNetworks (Maybe Natural)
listNetworks_maxResults = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListNetworks' {Maybe Natural
maxResults :: Maybe Natural
$sel:maxResults:ListNetworks' :: ListNetworks -> Maybe Natural
maxResults} -> Maybe Natural
maxResults) (\s :: ListNetworks
s@ListNetworks' {} Maybe Natural
a -> ListNetworks
s {$sel:maxResults:ListNetworks' :: Maybe Natural
maxResults = Maybe Natural
a} :: ListNetworks)

-- | The token for the next page of results.
listNetworks_startToken :: Lens.Lens' ListNetworks (Prelude.Maybe Prelude.Text)
listNetworks_startToken :: Lens' ListNetworks (Maybe Text)
listNetworks_startToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListNetworks' {Maybe Text
startToken :: Maybe Text
$sel:startToken:ListNetworks' :: ListNetworks -> Maybe Text
startToken} -> Maybe Text
startToken) (\s :: ListNetworks
s@ListNetworks' {} Maybe Text
a -> ListNetworks
s {$sel:startToken:ListNetworks' :: Maybe Text
startToken = Maybe Text
a} :: ListNetworks)

instance Core.AWSPager ListNetworks where
  page :: ListNetworks -> AWSResponse ListNetworks -> Maybe ListNetworks
page ListNetworks
rq AWSResponse ListNetworks
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse ListNetworks
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListNetworksResponse (Maybe Text)
listNetworksResponse_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 ListNetworks
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListNetworksResponse (Maybe [Network])
listNetworksResponse_networks
            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.$ ListNetworks
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' ListNetworks (Maybe Text)
listNetworks_startToken
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse ListNetworks
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListNetworksResponse (Maybe Text)
listNetworksResponse_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 ListNetworks where
  type AWSResponse ListNetworks = ListNetworksResponse
  request :: (Service -> Service) -> ListNetworks -> Request ListNetworks
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.postJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy ListNetworks
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse ListNetworks)))
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 [Network] -> Maybe Text -> Int -> ListNetworksResponse
ListNetworksResponse'
            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
"networks" 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 ListNetworks where
  hashWithSalt :: Int -> ListNetworks -> Int
hashWithSalt Int
_salt ListNetworks' {Maybe Natural
Maybe Text
Maybe (HashMap NetworkFilterKeys [Text])
startToken :: Maybe Text
maxResults :: Maybe Natural
filters :: Maybe (HashMap NetworkFilterKeys [Text])
$sel:startToken:ListNetworks' :: ListNetworks -> Maybe Text
$sel:maxResults:ListNetworks' :: ListNetworks -> Maybe Natural
$sel:filters:ListNetworks' :: ListNetworks -> Maybe (HashMap NetworkFilterKeys [Text])
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap NetworkFilterKeys [Text])
filters
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
maxResults
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
startToken

instance Prelude.NFData ListNetworks where
  rnf :: ListNetworks -> ()
rnf ListNetworks' {Maybe Natural
Maybe Text
Maybe (HashMap NetworkFilterKeys [Text])
startToken :: Maybe Text
maxResults :: Maybe Natural
filters :: Maybe (HashMap NetworkFilterKeys [Text])
$sel:startToken:ListNetworks' :: ListNetworks -> Maybe Text
$sel:maxResults:ListNetworks' :: ListNetworks -> Maybe Natural
$sel:filters:ListNetworks' :: ListNetworks -> Maybe (HashMap NetworkFilterKeys [Text])
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap NetworkFilterKeys [Text])
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
startToken

instance Data.ToHeaders ListNetworks where
  toHeaders :: ListNetworks -> 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.ToJSON ListNetworks where
  toJSON :: ListNetworks -> Value
toJSON ListNetworks' {Maybe Natural
Maybe Text
Maybe (HashMap NetworkFilterKeys [Text])
startToken :: Maybe Text
maxResults :: Maybe Natural
filters :: Maybe (HashMap NetworkFilterKeys [Text])
$sel:startToken:ListNetworks' :: ListNetworks -> Maybe Text
$sel:maxResults:ListNetworks' :: ListNetworks -> Maybe Natural
$sel:filters:ListNetworks' :: ListNetworks -> Maybe (HashMap NetworkFilterKeys [Text])
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"filters" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe (HashMap NetworkFilterKeys [Text])
filters,
            (Key
"maxResults" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Natural
maxResults,
            (Key
"startToken" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
startToken
          ]
      )

instance Data.ToPath ListNetworks where
  toPath :: ListNetworks -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/v1/networks/list"

instance Data.ToQuery ListNetworks where
  toQuery :: ListNetworks -> QueryString
toQuery = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

-- | /See:/ 'newListNetworksResponse' smart constructor.
data ListNetworksResponse = ListNetworksResponse'
  { -- | The networks.
    ListNetworksResponse -> Maybe [Network]
networks :: Prelude.Maybe [Network],
    -- | The token for the next page of results.
    ListNetworksResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    ListNetworksResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ListNetworksResponse -> ListNetworksResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListNetworksResponse -> ListNetworksResponse -> Bool
$c/= :: ListNetworksResponse -> ListNetworksResponse -> Bool
== :: ListNetworksResponse -> ListNetworksResponse -> Bool
$c== :: ListNetworksResponse -> ListNetworksResponse -> Bool
Prelude.Eq, ReadPrec [ListNetworksResponse]
ReadPrec ListNetworksResponse
Int -> ReadS ListNetworksResponse
ReadS [ListNetworksResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListNetworksResponse]
$creadListPrec :: ReadPrec [ListNetworksResponse]
readPrec :: ReadPrec ListNetworksResponse
$creadPrec :: ReadPrec ListNetworksResponse
readList :: ReadS [ListNetworksResponse]
$creadList :: ReadS [ListNetworksResponse]
readsPrec :: Int -> ReadS ListNetworksResponse
$creadsPrec :: Int -> ReadS ListNetworksResponse
Prelude.Read, Int -> ListNetworksResponse -> ShowS
[ListNetworksResponse] -> ShowS
ListNetworksResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListNetworksResponse] -> ShowS
$cshowList :: [ListNetworksResponse] -> ShowS
show :: ListNetworksResponse -> String
$cshow :: ListNetworksResponse -> String
showsPrec :: Int -> ListNetworksResponse -> ShowS
$cshowsPrec :: Int -> ListNetworksResponse -> ShowS
Prelude.Show, forall x. Rep ListNetworksResponse x -> ListNetworksResponse
forall x. ListNetworksResponse -> Rep ListNetworksResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListNetworksResponse x -> ListNetworksResponse
$cfrom :: forall x. ListNetworksResponse -> Rep ListNetworksResponse x
Prelude.Generic)

-- |
-- Create a value of 'ListNetworksResponse' 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:
--
-- 'networks', 'listNetworksResponse_networks' - The networks.
--
-- 'nextToken', 'listNetworksResponse_nextToken' - The token for the next page of results.
--
-- 'httpStatus', 'listNetworksResponse_httpStatus' - The response's http status code.
newListNetworksResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ListNetworksResponse
newListNetworksResponse :: Int -> ListNetworksResponse
newListNetworksResponse Int
pHttpStatus_ =
  ListNetworksResponse'
    { $sel:networks:ListNetworksResponse' :: Maybe [Network]
networks = forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListNetworksResponse' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ListNetworksResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The networks.
listNetworksResponse_networks :: Lens.Lens' ListNetworksResponse (Prelude.Maybe [Network])
listNetworksResponse_networks :: Lens' ListNetworksResponse (Maybe [Network])
listNetworksResponse_networks = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListNetworksResponse' {Maybe [Network]
networks :: Maybe [Network]
$sel:networks:ListNetworksResponse' :: ListNetworksResponse -> Maybe [Network]
networks} -> Maybe [Network]
networks) (\s :: ListNetworksResponse
s@ListNetworksResponse' {} Maybe [Network]
a -> ListNetworksResponse
s {$sel:networks:ListNetworksResponse' :: Maybe [Network]
networks = Maybe [Network]
a} :: ListNetworksResponse) 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 token for the next page of results.
listNetworksResponse_nextToken :: Lens.Lens' ListNetworksResponse (Prelude.Maybe Prelude.Text)
listNetworksResponse_nextToken :: Lens' ListNetworksResponse (Maybe Text)
listNetworksResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListNetworksResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListNetworksResponse' :: ListNetworksResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListNetworksResponse
s@ListNetworksResponse' {} Maybe Text
a -> ListNetworksResponse
s {$sel:nextToken:ListNetworksResponse' :: Maybe Text
nextToken = Maybe Text
a} :: ListNetworksResponse)

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

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