{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# 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.Types.NetworkInfo
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
module Amazonka.EC2.Types.NetworkInfo where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.EC2.Internal
import Amazonka.EC2.Types.EfaInfo
import Amazonka.EC2.Types.EnaSupport
import Amazonka.EC2.Types.NetworkCardInfo
import qualified Amazonka.Prelude as Prelude

-- | Describes the networking features of the instance type.
--
-- /See:/ 'newNetworkInfo' smart constructor.
data NetworkInfo = NetworkInfo'
  { -- | The index of the default network card, starting at 0.
    NetworkInfo -> Maybe Int
defaultNetworkCardIndex :: Prelude.Maybe Prelude.Int,
    -- | Describes the Elastic Fabric Adapters for the instance type.
    NetworkInfo -> Maybe EfaInfo
efaInfo :: Prelude.Maybe EfaInfo,
    -- | Indicates whether Elastic Fabric Adapter (EFA) is supported.
    NetworkInfo -> Maybe Bool
efaSupported :: Prelude.Maybe Prelude.Bool,
    -- | Indicates whether the instance type supports ENA Express. ENA Express
    -- uses Amazon Web Services Scalable Reliable Datagram (SRD) technology to
    -- increase the maximum bandwidth used per stream and minimize tail latency
    -- of network traffic between EC2 instances.
    NetworkInfo -> Maybe Bool
enaSrdSupported :: Prelude.Maybe Prelude.Bool,
    -- | Indicates whether Elastic Network Adapter (ENA) is supported.
    NetworkInfo -> Maybe EnaSupport
enaSupport :: Prelude.Maybe EnaSupport,
    -- | Indicates whether the instance type automatically encrypts in-transit
    -- traffic between instances.
    NetworkInfo -> Maybe Bool
encryptionInTransitSupported :: Prelude.Maybe Prelude.Bool,
    -- | The maximum number of IPv4 addresses per network interface.
    NetworkInfo -> Maybe Int
ipv4AddressesPerInterface :: Prelude.Maybe Prelude.Int,
    -- | The maximum number of IPv6 addresses per network interface.
    NetworkInfo -> Maybe Int
ipv6AddressesPerInterface :: Prelude.Maybe Prelude.Int,
    -- | Indicates whether IPv6 is supported.
    NetworkInfo -> Maybe Bool
ipv6Supported :: Prelude.Maybe Prelude.Bool,
    -- | The maximum number of physical network cards that can be allocated to
    -- the instance.
    NetworkInfo -> Maybe Int
maximumNetworkCards :: Prelude.Maybe Prelude.Int,
    -- | The maximum number of network interfaces for the instance type.
    NetworkInfo -> Maybe Int
maximumNetworkInterfaces :: Prelude.Maybe Prelude.Int,
    -- | Describes the network cards for the instance type.
    NetworkInfo -> Maybe [NetworkCardInfo]
networkCards :: Prelude.Maybe [NetworkCardInfo],
    -- | The network performance.
    NetworkInfo -> Maybe Text
networkPerformance :: Prelude.Maybe Prelude.Text
  }
  deriving (NetworkInfo -> NetworkInfo -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NetworkInfo -> NetworkInfo -> Bool
$c/= :: NetworkInfo -> NetworkInfo -> Bool
== :: NetworkInfo -> NetworkInfo -> Bool
$c== :: NetworkInfo -> NetworkInfo -> Bool
Prelude.Eq, ReadPrec [NetworkInfo]
ReadPrec NetworkInfo
Int -> ReadS NetworkInfo
ReadS [NetworkInfo]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [NetworkInfo]
$creadListPrec :: ReadPrec [NetworkInfo]
readPrec :: ReadPrec NetworkInfo
$creadPrec :: ReadPrec NetworkInfo
readList :: ReadS [NetworkInfo]
$creadList :: ReadS [NetworkInfo]
readsPrec :: Int -> ReadS NetworkInfo
$creadsPrec :: Int -> ReadS NetworkInfo
Prelude.Read, Int -> NetworkInfo -> ShowS
[NetworkInfo] -> ShowS
NetworkInfo -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NetworkInfo] -> ShowS
$cshowList :: [NetworkInfo] -> ShowS
show :: NetworkInfo -> String
$cshow :: NetworkInfo -> String
showsPrec :: Int -> NetworkInfo -> ShowS
$cshowsPrec :: Int -> NetworkInfo -> ShowS
Prelude.Show, forall x. Rep NetworkInfo x -> NetworkInfo
forall x. NetworkInfo -> Rep NetworkInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep NetworkInfo x -> NetworkInfo
$cfrom :: forall x. NetworkInfo -> Rep NetworkInfo x
Prelude.Generic)

-- |
-- Create a value of 'NetworkInfo' 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:
--
-- 'defaultNetworkCardIndex', 'networkInfo_defaultNetworkCardIndex' - The index of the default network card, starting at 0.
--
-- 'efaInfo', 'networkInfo_efaInfo' - Describes the Elastic Fabric Adapters for the instance type.
--
-- 'efaSupported', 'networkInfo_efaSupported' - Indicates whether Elastic Fabric Adapter (EFA) is supported.
--
-- 'enaSrdSupported', 'networkInfo_enaSrdSupported' - Indicates whether the instance type supports ENA Express. ENA Express
-- uses Amazon Web Services Scalable Reliable Datagram (SRD) technology to
-- increase the maximum bandwidth used per stream and minimize tail latency
-- of network traffic between EC2 instances.
--
-- 'enaSupport', 'networkInfo_enaSupport' - Indicates whether Elastic Network Adapter (ENA) is supported.
--
-- 'encryptionInTransitSupported', 'networkInfo_encryptionInTransitSupported' - Indicates whether the instance type automatically encrypts in-transit
-- traffic between instances.
--
-- 'ipv4AddressesPerInterface', 'networkInfo_ipv4AddressesPerInterface' - The maximum number of IPv4 addresses per network interface.
--
-- 'ipv6AddressesPerInterface', 'networkInfo_ipv6AddressesPerInterface' - The maximum number of IPv6 addresses per network interface.
--
-- 'ipv6Supported', 'networkInfo_ipv6Supported' - Indicates whether IPv6 is supported.
--
-- 'maximumNetworkCards', 'networkInfo_maximumNetworkCards' - The maximum number of physical network cards that can be allocated to
-- the instance.
--
-- 'maximumNetworkInterfaces', 'networkInfo_maximumNetworkInterfaces' - The maximum number of network interfaces for the instance type.
--
-- 'networkCards', 'networkInfo_networkCards' - Describes the network cards for the instance type.
--
-- 'networkPerformance', 'networkInfo_networkPerformance' - The network performance.
newNetworkInfo ::
  NetworkInfo
newNetworkInfo :: NetworkInfo
newNetworkInfo =
  NetworkInfo'
    { $sel:defaultNetworkCardIndex:NetworkInfo' :: Maybe Int
defaultNetworkCardIndex =
        forall a. Maybe a
Prelude.Nothing,
      $sel:efaInfo:NetworkInfo' :: Maybe EfaInfo
efaInfo = forall a. Maybe a
Prelude.Nothing,
      $sel:efaSupported:NetworkInfo' :: Maybe Bool
efaSupported = forall a. Maybe a
Prelude.Nothing,
      $sel:enaSrdSupported:NetworkInfo' :: Maybe Bool
enaSrdSupported = forall a. Maybe a
Prelude.Nothing,
      $sel:enaSupport:NetworkInfo' :: Maybe EnaSupport
enaSupport = forall a. Maybe a
Prelude.Nothing,
      $sel:encryptionInTransitSupported:NetworkInfo' :: Maybe Bool
encryptionInTransitSupported = forall a. Maybe a
Prelude.Nothing,
      $sel:ipv4AddressesPerInterface:NetworkInfo' :: Maybe Int
ipv4AddressesPerInterface = forall a. Maybe a
Prelude.Nothing,
      $sel:ipv6AddressesPerInterface:NetworkInfo' :: Maybe Int
ipv6AddressesPerInterface = forall a. Maybe a
Prelude.Nothing,
      $sel:ipv6Supported:NetworkInfo' :: Maybe Bool
ipv6Supported = forall a. Maybe a
Prelude.Nothing,
      $sel:maximumNetworkCards:NetworkInfo' :: Maybe Int
maximumNetworkCards = forall a. Maybe a
Prelude.Nothing,
      $sel:maximumNetworkInterfaces:NetworkInfo' :: Maybe Int
maximumNetworkInterfaces = forall a. Maybe a
Prelude.Nothing,
      $sel:networkCards:NetworkInfo' :: Maybe [NetworkCardInfo]
networkCards = forall a. Maybe a
Prelude.Nothing,
      $sel:networkPerformance:NetworkInfo' :: Maybe Text
networkPerformance = forall a. Maybe a
Prelude.Nothing
    }

-- | The index of the default network card, starting at 0.
networkInfo_defaultNetworkCardIndex :: Lens.Lens' NetworkInfo (Prelude.Maybe Prelude.Int)
networkInfo_defaultNetworkCardIndex :: Lens' NetworkInfo (Maybe Int)
networkInfo_defaultNetworkCardIndex = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\NetworkInfo' {Maybe Int
defaultNetworkCardIndex :: Maybe Int
$sel:defaultNetworkCardIndex:NetworkInfo' :: NetworkInfo -> Maybe Int
defaultNetworkCardIndex} -> Maybe Int
defaultNetworkCardIndex) (\s :: NetworkInfo
s@NetworkInfo' {} Maybe Int
a -> NetworkInfo
s {$sel:defaultNetworkCardIndex:NetworkInfo' :: Maybe Int
defaultNetworkCardIndex = Maybe Int
a} :: NetworkInfo)

-- | Describes the Elastic Fabric Adapters for the instance type.
networkInfo_efaInfo :: Lens.Lens' NetworkInfo (Prelude.Maybe EfaInfo)
networkInfo_efaInfo :: Lens' NetworkInfo (Maybe EfaInfo)
networkInfo_efaInfo = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\NetworkInfo' {Maybe EfaInfo
efaInfo :: Maybe EfaInfo
$sel:efaInfo:NetworkInfo' :: NetworkInfo -> Maybe EfaInfo
efaInfo} -> Maybe EfaInfo
efaInfo) (\s :: NetworkInfo
s@NetworkInfo' {} Maybe EfaInfo
a -> NetworkInfo
s {$sel:efaInfo:NetworkInfo' :: Maybe EfaInfo
efaInfo = Maybe EfaInfo
a} :: NetworkInfo)

-- | Indicates whether Elastic Fabric Adapter (EFA) is supported.
networkInfo_efaSupported :: Lens.Lens' NetworkInfo (Prelude.Maybe Prelude.Bool)
networkInfo_efaSupported :: Lens' NetworkInfo (Maybe Bool)
networkInfo_efaSupported = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\NetworkInfo' {Maybe Bool
efaSupported :: Maybe Bool
$sel:efaSupported:NetworkInfo' :: NetworkInfo -> Maybe Bool
efaSupported} -> Maybe Bool
efaSupported) (\s :: NetworkInfo
s@NetworkInfo' {} Maybe Bool
a -> NetworkInfo
s {$sel:efaSupported:NetworkInfo' :: Maybe Bool
efaSupported = Maybe Bool
a} :: NetworkInfo)

-- | Indicates whether the instance type supports ENA Express. ENA Express
-- uses Amazon Web Services Scalable Reliable Datagram (SRD) technology to
-- increase the maximum bandwidth used per stream and minimize tail latency
-- of network traffic between EC2 instances.
networkInfo_enaSrdSupported :: Lens.Lens' NetworkInfo (Prelude.Maybe Prelude.Bool)
networkInfo_enaSrdSupported :: Lens' NetworkInfo (Maybe Bool)
networkInfo_enaSrdSupported = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\NetworkInfo' {Maybe Bool
enaSrdSupported :: Maybe Bool
$sel:enaSrdSupported:NetworkInfo' :: NetworkInfo -> Maybe Bool
enaSrdSupported} -> Maybe Bool
enaSrdSupported) (\s :: NetworkInfo
s@NetworkInfo' {} Maybe Bool
a -> NetworkInfo
s {$sel:enaSrdSupported:NetworkInfo' :: Maybe Bool
enaSrdSupported = Maybe Bool
a} :: NetworkInfo)

-- | Indicates whether Elastic Network Adapter (ENA) is supported.
networkInfo_enaSupport :: Lens.Lens' NetworkInfo (Prelude.Maybe EnaSupport)
networkInfo_enaSupport :: Lens' NetworkInfo (Maybe EnaSupport)
networkInfo_enaSupport = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\NetworkInfo' {Maybe EnaSupport
enaSupport :: Maybe EnaSupport
$sel:enaSupport:NetworkInfo' :: NetworkInfo -> Maybe EnaSupport
enaSupport} -> Maybe EnaSupport
enaSupport) (\s :: NetworkInfo
s@NetworkInfo' {} Maybe EnaSupport
a -> NetworkInfo
s {$sel:enaSupport:NetworkInfo' :: Maybe EnaSupport
enaSupport = Maybe EnaSupport
a} :: NetworkInfo)

-- | Indicates whether the instance type automatically encrypts in-transit
-- traffic between instances.
networkInfo_encryptionInTransitSupported :: Lens.Lens' NetworkInfo (Prelude.Maybe Prelude.Bool)
networkInfo_encryptionInTransitSupported :: Lens' NetworkInfo (Maybe Bool)
networkInfo_encryptionInTransitSupported = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\NetworkInfo' {Maybe Bool
encryptionInTransitSupported :: Maybe Bool
$sel:encryptionInTransitSupported:NetworkInfo' :: NetworkInfo -> Maybe Bool
encryptionInTransitSupported} -> Maybe Bool
encryptionInTransitSupported) (\s :: NetworkInfo
s@NetworkInfo' {} Maybe Bool
a -> NetworkInfo
s {$sel:encryptionInTransitSupported:NetworkInfo' :: Maybe Bool
encryptionInTransitSupported = Maybe Bool
a} :: NetworkInfo)

-- | The maximum number of IPv4 addresses per network interface.
networkInfo_ipv4AddressesPerInterface :: Lens.Lens' NetworkInfo (Prelude.Maybe Prelude.Int)
networkInfo_ipv4AddressesPerInterface :: Lens' NetworkInfo (Maybe Int)
networkInfo_ipv4AddressesPerInterface = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\NetworkInfo' {Maybe Int
ipv4AddressesPerInterface :: Maybe Int
$sel:ipv4AddressesPerInterface:NetworkInfo' :: NetworkInfo -> Maybe Int
ipv4AddressesPerInterface} -> Maybe Int
ipv4AddressesPerInterface) (\s :: NetworkInfo
s@NetworkInfo' {} Maybe Int
a -> NetworkInfo
s {$sel:ipv4AddressesPerInterface:NetworkInfo' :: Maybe Int
ipv4AddressesPerInterface = Maybe Int
a} :: NetworkInfo)

-- | The maximum number of IPv6 addresses per network interface.
networkInfo_ipv6AddressesPerInterface :: Lens.Lens' NetworkInfo (Prelude.Maybe Prelude.Int)
networkInfo_ipv6AddressesPerInterface :: Lens' NetworkInfo (Maybe Int)
networkInfo_ipv6AddressesPerInterface = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\NetworkInfo' {Maybe Int
ipv6AddressesPerInterface :: Maybe Int
$sel:ipv6AddressesPerInterface:NetworkInfo' :: NetworkInfo -> Maybe Int
ipv6AddressesPerInterface} -> Maybe Int
ipv6AddressesPerInterface) (\s :: NetworkInfo
s@NetworkInfo' {} Maybe Int
a -> NetworkInfo
s {$sel:ipv6AddressesPerInterface:NetworkInfo' :: Maybe Int
ipv6AddressesPerInterface = Maybe Int
a} :: NetworkInfo)

-- | Indicates whether IPv6 is supported.
networkInfo_ipv6Supported :: Lens.Lens' NetworkInfo (Prelude.Maybe Prelude.Bool)
networkInfo_ipv6Supported :: Lens' NetworkInfo (Maybe Bool)
networkInfo_ipv6Supported = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\NetworkInfo' {Maybe Bool
ipv6Supported :: Maybe Bool
$sel:ipv6Supported:NetworkInfo' :: NetworkInfo -> Maybe Bool
ipv6Supported} -> Maybe Bool
ipv6Supported) (\s :: NetworkInfo
s@NetworkInfo' {} Maybe Bool
a -> NetworkInfo
s {$sel:ipv6Supported:NetworkInfo' :: Maybe Bool
ipv6Supported = Maybe Bool
a} :: NetworkInfo)

-- | The maximum number of physical network cards that can be allocated to
-- the instance.
networkInfo_maximumNetworkCards :: Lens.Lens' NetworkInfo (Prelude.Maybe Prelude.Int)
networkInfo_maximumNetworkCards :: Lens' NetworkInfo (Maybe Int)
networkInfo_maximumNetworkCards = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\NetworkInfo' {Maybe Int
maximumNetworkCards :: Maybe Int
$sel:maximumNetworkCards:NetworkInfo' :: NetworkInfo -> Maybe Int
maximumNetworkCards} -> Maybe Int
maximumNetworkCards) (\s :: NetworkInfo
s@NetworkInfo' {} Maybe Int
a -> NetworkInfo
s {$sel:maximumNetworkCards:NetworkInfo' :: Maybe Int
maximumNetworkCards = Maybe Int
a} :: NetworkInfo)

-- | The maximum number of network interfaces for the instance type.
networkInfo_maximumNetworkInterfaces :: Lens.Lens' NetworkInfo (Prelude.Maybe Prelude.Int)
networkInfo_maximumNetworkInterfaces :: Lens' NetworkInfo (Maybe Int)
networkInfo_maximumNetworkInterfaces = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\NetworkInfo' {Maybe Int
maximumNetworkInterfaces :: Maybe Int
$sel:maximumNetworkInterfaces:NetworkInfo' :: NetworkInfo -> Maybe Int
maximumNetworkInterfaces} -> Maybe Int
maximumNetworkInterfaces) (\s :: NetworkInfo
s@NetworkInfo' {} Maybe Int
a -> NetworkInfo
s {$sel:maximumNetworkInterfaces:NetworkInfo' :: Maybe Int
maximumNetworkInterfaces = Maybe Int
a} :: NetworkInfo)

-- | Describes the network cards for the instance type.
networkInfo_networkCards :: Lens.Lens' NetworkInfo (Prelude.Maybe [NetworkCardInfo])
networkInfo_networkCards :: Lens' NetworkInfo (Maybe [NetworkCardInfo])
networkInfo_networkCards = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\NetworkInfo' {Maybe [NetworkCardInfo]
networkCards :: Maybe [NetworkCardInfo]
$sel:networkCards:NetworkInfo' :: NetworkInfo -> Maybe [NetworkCardInfo]
networkCards} -> Maybe [NetworkCardInfo]
networkCards) (\s :: NetworkInfo
s@NetworkInfo' {} Maybe [NetworkCardInfo]
a -> NetworkInfo
s {$sel:networkCards:NetworkInfo' :: Maybe [NetworkCardInfo]
networkCards = Maybe [NetworkCardInfo]
a} :: NetworkInfo) 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 network performance.
networkInfo_networkPerformance :: Lens.Lens' NetworkInfo (Prelude.Maybe Prelude.Text)
networkInfo_networkPerformance :: Lens' NetworkInfo (Maybe Text)
networkInfo_networkPerformance = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\NetworkInfo' {Maybe Text
networkPerformance :: Maybe Text
$sel:networkPerformance:NetworkInfo' :: NetworkInfo -> Maybe Text
networkPerformance} -> Maybe Text
networkPerformance) (\s :: NetworkInfo
s@NetworkInfo' {} Maybe Text
a -> NetworkInfo
s {$sel:networkPerformance:NetworkInfo' :: Maybe Text
networkPerformance = Maybe Text
a} :: NetworkInfo)

instance Data.FromXML NetworkInfo where
  parseXML :: [Node] -> Either String NetworkInfo
parseXML [Node]
x =
    Maybe Int
-> Maybe EfaInfo
-> Maybe Bool
-> Maybe Bool
-> Maybe EnaSupport
-> Maybe Bool
-> Maybe Int
-> Maybe Int
-> Maybe Bool
-> Maybe Int
-> Maybe Int
-> Maybe [NetworkCardInfo]
-> Maybe Text
-> NetworkInfo
NetworkInfo'
      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
"defaultNetworkCardIndex")
      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
"efaInfo")
      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
"efaSupported")
      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
"enaSrdSupported")
      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
"enaSupport")
      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
"encryptionInTransitSupported")
      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
"ipv4AddressesPerInterface")
      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
"ipv6AddressesPerInterface")
      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
"ipv6Supported")
      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
"maximumNetworkCards")
      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
"maximumNetworkInterfaces")
      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
"networkCards"
                      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.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"networkPerformance")

instance Prelude.Hashable NetworkInfo where
  hashWithSalt :: Int -> NetworkInfo -> Int
hashWithSalt Int
_salt NetworkInfo' {Maybe Bool
Maybe Int
Maybe [NetworkCardInfo]
Maybe Text
Maybe EfaInfo
Maybe EnaSupport
networkPerformance :: Maybe Text
networkCards :: Maybe [NetworkCardInfo]
maximumNetworkInterfaces :: Maybe Int
maximumNetworkCards :: Maybe Int
ipv6Supported :: Maybe Bool
ipv6AddressesPerInterface :: Maybe Int
ipv4AddressesPerInterface :: Maybe Int
encryptionInTransitSupported :: Maybe Bool
enaSupport :: Maybe EnaSupport
enaSrdSupported :: Maybe Bool
efaSupported :: Maybe Bool
efaInfo :: Maybe EfaInfo
defaultNetworkCardIndex :: Maybe Int
$sel:networkPerformance:NetworkInfo' :: NetworkInfo -> Maybe Text
$sel:networkCards:NetworkInfo' :: NetworkInfo -> Maybe [NetworkCardInfo]
$sel:maximumNetworkInterfaces:NetworkInfo' :: NetworkInfo -> Maybe Int
$sel:maximumNetworkCards:NetworkInfo' :: NetworkInfo -> Maybe Int
$sel:ipv6Supported:NetworkInfo' :: NetworkInfo -> Maybe Bool
$sel:ipv6AddressesPerInterface:NetworkInfo' :: NetworkInfo -> Maybe Int
$sel:ipv4AddressesPerInterface:NetworkInfo' :: NetworkInfo -> Maybe Int
$sel:encryptionInTransitSupported:NetworkInfo' :: NetworkInfo -> Maybe Bool
$sel:enaSupport:NetworkInfo' :: NetworkInfo -> Maybe EnaSupport
$sel:enaSrdSupported:NetworkInfo' :: NetworkInfo -> Maybe Bool
$sel:efaSupported:NetworkInfo' :: NetworkInfo -> Maybe Bool
$sel:efaInfo:NetworkInfo' :: NetworkInfo -> Maybe EfaInfo
$sel:defaultNetworkCardIndex:NetworkInfo' :: NetworkInfo -> Maybe Int
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
defaultNetworkCardIndex
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe EfaInfo
efaInfo
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
efaSupported
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
enaSrdSupported
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe EnaSupport
enaSupport
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
encryptionInTransitSupported
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
ipv4AddressesPerInterface
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
ipv6AddressesPerInterface
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
ipv6Supported
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
maximumNetworkCards
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
maximumNetworkInterfaces
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [NetworkCardInfo]
networkCards
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
networkPerformance

instance Prelude.NFData NetworkInfo where
  rnf :: NetworkInfo -> ()
rnf NetworkInfo' {Maybe Bool
Maybe Int
Maybe [NetworkCardInfo]
Maybe Text
Maybe EfaInfo
Maybe EnaSupport
networkPerformance :: Maybe Text
networkCards :: Maybe [NetworkCardInfo]
maximumNetworkInterfaces :: Maybe Int
maximumNetworkCards :: Maybe Int
ipv6Supported :: Maybe Bool
ipv6AddressesPerInterface :: Maybe Int
ipv4AddressesPerInterface :: Maybe Int
encryptionInTransitSupported :: Maybe Bool
enaSupport :: Maybe EnaSupport
enaSrdSupported :: Maybe Bool
efaSupported :: Maybe Bool
efaInfo :: Maybe EfaInfo
defaultNetworkCardIndex :: Maybe Int
$sel:networkPerformance:NetworkInfo' :: NetworkInfo -> Maybe Text
$sel:networkCards:NetworkInfo' :: NetworkInfo -> Maybe [NetworkCardInfo]
$sel:maximumNetworkInterfaces:NetworkInfo' :: NetworkInfo -> Maybe Int
$sel:maximumNetworkCards:NetworkInfo' :: NetworkInfo -> Maybe Int
$sel:ipv6Supported:NetworkInfo' :: NetworkInfo -> Maybe Bool
$sel:ipv6AddressesPerInterface:NetworkInfo' :: NetworkInfo -> Maybe Int
$sel:ipv4AddressesPerInterface:NetworkInfo' :: NetworkInfo -> Maybe Int
$sel:encryptionInTransitSupported:NetworkInfo' :: NetworkInfo -> Maybe Bool
$sel:enaSupport:NetworkInfo' :: NetworkInfo -> Maybe EnaSupport
$sel:enaSrdSupported:NetworkInfo' :: NetworkInfo -> Maybe Bool
$sel:efaSupported:NetworkInfo' :: NetworkInfo -> Maybe Bool
$sel:efaInfo:NetworkInfo' :: NetworkInfo -> Maybe EfaInfo
$sel:defaultNetworkCardIndex:NetworkInfo' :: NetworkInfo -> Maybe Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
defaultNetworkCardIndex
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe EfaInfo
efaInfo
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
efaSupported
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
enaSrdSupported
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe EnaSupport
enaSupport
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
encryptionInTransitSupported
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
ipv4AddressesPerInterface
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
ipv6AddressesPerInterface
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
ipv6Supported
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
maximumNetworkCards
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
maximumNetworkInterfaces
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [NetworkCardInfo]
networkCards
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
networkPerformance