{-# 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.ManagedBlockChain.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)
--
-- Returns information about the networks in which the current Amazon Web
-- Services account participates.
--
-- Applies to Hyperledger Fabric and Ethereum.
module Amazonka.ManagedBlockChain.ListNetworks
  ( -- * Creating a Request
    ListNetworks (..),
    newListNetworks,

    -- * Request Lenses
    listNetworks_framework,
    listNetworks_maxResults,
    listNetworks_name,
    listNetworks_nextToken,
    listNetworks_status,

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

-- | /See:/ 'newListNetworks' smart constructor.
data ListNetworks = ListNetworks'
  { -- | An optional framework specifier. If provided, only networks of this
    -- framework type are listed.
    ListNetworks -> Maybe Framework
framework :: Prelude.Maybe Framework,
    -- | The maximum number of networks to list.
    ListNetworks -> Maybe Natural
maxResults :: Prelude.Maybe Prelude.Natural,
    -- | The name of the network.
    ListNetworks -> Maybe Text
name :: Prelude.Maybe Prelude.Text,
    -- | The pagination token that indicates the next set of results to retrieve.
    ListNetworks -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | An optional status specifier. If provided, only networks currently in
    -- this status are listed.
    --
    -- Applies only to Hyperledger Fabric.
    ListNetworks -> Maybe NetworkStatus
status :: Prelude.Maybe NetworkStatus
  }
  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:
--
-- 'framework', 'listNetworks_framework' - An optional framework specifier. If provided, only networks of this
-- framework type are listed.
--
-- 'maxResults', 'listNetworks_maxResults' - The maximum number of networks to list.
--
-- 'name', 'listNetworks_name' - The name of the network.
--
-- 'nextToken', 'listNetworks_nextToken' - The pagination token that indicates the next set of results to retrieve.
--
-- 'status', 'listNetworks_status' - An optional status specifier. If provided, only networks currently in
-- this status are listed.
--
-- Applies only to Hyperledger Fabric.
newListNetworks ::
  ListNetworks
newListNetworks :: ListNetworks
newListNetworks =
  ListNetworks'
    { $sel:framework:ListNetworks' :: Maybe Framework
framework = forall a. Maybe a
Prelude.Nothing,
      $sel:maxResults:ListNetworks' :: Maybe Natural
maxResults = forall a. Maybe a
Prelude.Nothing,
      $sel:name:ListNetworks' :: Maybe Text
name = forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListNetworks' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:status:ListNetworks' :: Maybe NetworkStatus
status = forall a. Maybe a
Prelude.Nothing
    }

-- | An optional framework specifier. If provided, only networks of this
-- framework type are listed.
listNetworks_framework :: Lens.Lens' ListNetworks (Prelude.Maybe Framework)
listNetworks_framework :: Lens' ListNetworks (Maybe Framework)
listNetworks_framework = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListNetworks' {Maybe Framework
framework :: Maybe Framework
$sel:framework:ListNetworks' :: ListNetworks -> Maybe Framework
framework} -> Maybe Framework
framework) (\s :: ListNetworks
s@ListNetworks' {} Maybe Framework
a -> ListNetworks
s {$sel:framework:ListNetworks' :: Maybe Framework
framework = Maybe Framework
a} :: ListNetworks)

-- | The maximum number of networks to list.
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 name of the network.
listNetworks_name :: Lens.Lens' ListNetworks (Prelude.Maybe Prelude.Text)
listNetworks_name :: Lens' ListNetworks (Maybe Text)
listNetworks_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListNetworks' {Maybe Text
name :: Maybe Text
$sel:name:ListNetworks' :: ListNetworks -> Maybe Text
name} -> Maybe Text
name) (\s :: ListNetworks
s@ListNetworks' {} Maybe Text
a -> ListNetworks
s {$sel:name:ListNetworks' :: Maybe Text
name = Maybe Text
a} :: ListNetworks)

-- | The pagination token that indicates the next set of results to retrieve.
listNetworks_nextToken :: Lens.Lens' ListNetworks (Prelude.Maybe Prelude.Text)
listNetworks_nextToken :: Lens' ListNetworks (Maybe Text)
listNetworks_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListNetworks' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListNetworks' :: ListNetworks -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListNetworks
s@ListNetworks' {} Maybe Text
a -> ListNetworks
s {$sel:nextToken:ListNetworks' :: Maybe Text
nextToken = Maybe Text
a} :: ListNetworks)

-- | An optional status specifier. If provided, only networks currently in
-- this status are listed.
--
-- Applies only to Hyperledger Fabric.
listNetworks_status :: Lens.Lens' ListNetworks (Prelude.Maybe NetworkStatus)
listNetworks_status :: Lens' ListNetworks (Maybe NetworkStatus)
listNetworks_status = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListNetworks' {Maybe NetworkStatus
status :: Maybe NetworkStatus
$sel:status:ListNetworks' :: ListNetworks -> Maybe NetworkStatus
status} -> Maybe NetworkStatus
status) (\s :: ListNetworks
s@ListNetworks' {} Maybe NetworkStatus
a -> ListNetworks
s {$sel:status:ListNetworks' :: Maybe NetworkStatus
status = Maybe NetworkStatus
a} :: ListNetworks)

instance Core.AWSRequest ListNetworks where
  type AWSResponse ListNetworks = ListNetworksResponse
  request :: (Service -> Service) -> ListNetworks -> Request ListNetworks
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 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 [NetworkSummary] -> 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 Framework
Maybe NetworkStatus
status :: Maybe NetworkStatus
nextToken :: Maybe Text
name :: Maybe Text
maxResults :: Maybe Natural
framework :: Maybe Framework
$sel:status:ListNetworks' :: ListNetworks -> Maybe NetworkStatus
$sel:nextToken:ListNetworks' :: ListNetworks -> Maybe Text
$sel:name:ListNetworks' :: ListNetworks -> Maybe Text
$sel:maxResults:ListNetworks' :: ListNetworks -> Maybe Natural
$sel:framework:ListNetworks' :: ListNetworks -> Maybe Framework
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Framework
framework
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
maxResults
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
name
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
nextToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe NetworkStatus
status

instance Prelude.NFData ListNetworks where
  rnf :: ListNetworks -> ()
rnf ListNetworks' {Maybe Natural
Maybe Text
Maybe Framework
Maybe NetworkStatus
status :: Maybe NetworkStatus
nextToken :: Maybe Text
name :: Maybe Text
maxResults :: Maybe Natural
framework :: Maybe Framework
$sel:status:ListNetworks' :: ListNetworks -> Maybe NetworkStatus
$sel:nextToken:ListNetworks' :: ListNetworks -> Maybe Text
$sel:name:ListNetworks' :: ListNetworks -> Maybe Text
$sel:maxResults:ListNetworks' :: ListNetworks -> Maybe Natural
$sel:framework:ListNetworks' :: ListNetworks -> Maybe Framework
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Framework
framework
      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
name
      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 Maybe NetworkStatus
status

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.ToPath ListNetworks where
  toPath :: ListNetworks -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/networks"

instance Data.ToQuery ListNetworks where
  toQuery :: ListNetworks -> QueryString
toQuery ListNetworks' {Maybe Natural
Maybe Text
Maybe Framework
Maybe NetworkStatus
status :: Maybe NetworkStatus
nextToken :: Maybe Text
name :: Maybe Text
maxResults :: Maybe Natural
framework :: Maybe Framework
$sel:status:ListNetworks' :: ListNetworks -> Maybe NetworkStatus
$sel:nextToken:ListNetworks' :: ListNetworks -> Maybe Text
$sel:name:ListNetworks' :: ListNetworks -> Maybe Text
$sel:maxResults:ListNetworks' :: ListNetworks -> Maybe Natural
$sel:framework:ListNetworks' :: ListNetworks -> Maybe Framework
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"framework" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Framework
framework,
        ByteString
"maxResults" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Natural
maxResults,
        ByteString
"name" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
name,
        ByteString
"nextToken" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
nextToken,
        ByteString
"status" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe NetworkStatus
status
      ]

-- | /See:/ 'newListNetworksResponse' smart constructor.
data ListNetworksResponse = ListNetworksResponse'
  { -- | An array of @NetworkSummary@ objects that contain configuration
    -- properties for each network.
    ListNetworksResponse -> Maybe [NetworkSummary]
networks :: Prelude.Maybe [NetworkSummary],
    -- | The pagination token that indicates the next set of results to retrieve.
    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' - An array of @NetworkSummary@ objects that contain configuration
-- properties for each network.
--
-- 'nextToken', 'listNetworksResponse_nextToken' - The pagination token that indicates the next set of results to retrieve.
--
-- '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 [NetworkSummary]
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_
    }

-- | An array of @NetworkSummary@ objects that contain configuration
-- properties for each network.
listNetworksResponse_networks :: Lens.Lens' ListNetworksResponse (Prelude.Maybe [NetworkSummary])
listNetworksResponse_networks :: Lens' ListNetworksResponse (Maybe [NetworkSummary])
listNetworksResponse_networks = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListNetworksResponse' {Maybe [NetworkSummary]
networks :: Maybe [NetworkSummary]
$sel:networks:ListNetworksResponse' :: ListNetworksResponse -> Maybe [NetworkSummary]
networks} -> Maybe [NetworkSummary]
networks) (\s :: ListNetworksResponse
s@ListNetworksResponse' {} Maybe [NetworkSummary]
a -> ListNetworksResponse
s {$sel:networks:ListNetworksResponse' :: Maybe [NetworkSummary]
networks = Maybe [NetworkSummary]
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 pagination token that indicates the next set of results to retrieve.
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 [NetworkSummary]
Maybe Text
httpStatus :: Int
nextToken :: Maybe Text
networks :: Maybe [NetworkSummary]
$sel:httpStatus:ListNetworksResponse' :: ListNetworksResponse -> Int
$sel:nextToken:ListNetworksResponse' :: ListNetworksResponse -> Maybe Text
$sel:networks:ListNetworksResponse' :: ListNetworksResponse -> Maybe [NetworkSummary]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [NetworkSummary]
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