{-# 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.DirectConnect.Types.Interconnect
-- 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.DirectConnect.Types.Interconnect where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.DirectConnect.Types.HasLogicalRedundancy
import Amazonka.DirectConnect.Types.InterconnectState
import Amazonka.DirectConnect.Types.Tag
import qualified Amazonka.Prelude as Prelude

-- | Information about an interconnect.
--
-- /See:/ 'newInterconnect' smart constructor.
data Interconnect = Interconnect'
  { -- | The Direct Connect endpoint on which the physical connection terminates.
    Interconnect -> Maybe Text
awsDevice :: Prelude.Maybe Prelude.Text,
    -- | The Direct Connect endpoint that terminates the physical connection.
    Interconnect -> Maybe Text
awsDeviceV2 :: Prelude.Maybe Prelude.Text,
    -- | The Direct Connect endpoint that terminates the logical connection. This
    -- device might be different than the device that terminates the physical
    -- connection.
    Interconnect -> Maybe Text
awsLogicalDeviceId :: Prelude.Maybe Prelude.Text,
    -- | The bandwidth of the connection.
    Interconnect -> Maybe Text
bandwidth :: Prelude.Maybe Prelude.Text,
    -- | Indicates whether the interconnect supports a secondary BGP in the same
    -- address family (IPv4\/IPv6).
    Interconnect -> Maybe HasLogicalRedundancy
hasLogicalRedundancy :: Prelude.Maybe HasLogicalRedundancy,
    -- | The ID of the interconnect.
    Interconnect -> Maybe Text
interconnectId :: Prelude.Maybe Prelude.Text,
    -- | The name of the interconnect.
    Interconnect -> Maybe Text
interconnectName :: Prelude.Maybe Prelude.Text,
    -- | The state of the interconnect. The following are the possible values:
    --
    -- -   @requested@: The initial state of an interconnect. The interconnect
    --     stays in the requested state until the Letter of Authorization (LOA)
    --     is sent to the customer.
    --
    -- -   @pending@: The interconnect is approved, and is being initialized.
    --
    -- -   @available@: The network link is up, and the interconnect is ready
    --     for use.
    --
    -- -   @down@: The network link is down.
    --
    -- -   @deleting@: The interconnect is being deleted.
    --
    -- -   @deleted@: The interconnect is deleted.
    --
    -- -   @unknown@: The state of the interconnect is not available.
    Interconnect -> Maybe InterconnectState
interconnectState :: Prelude.Maybe InterconnectState,
    -- | Indicates whether jumbo frames (9001 MTU) are supported.
    Interconnect -> Maybe Bool
jumboFrameCapable :: Prelude.Maybe Prelude.Bool,
    -- | The ID of the LAG.
    Interconnect -> Maybe Text
lagId :: Prelude.Maybe Prelude.Text,
    -- | The time of the most recent call to DescribeLoa for this connection.
    Interconnect -> Maybe POSIX
loaIssueTime :: Prelude.Maybe Data.POSIX,
    -- | The location of the connection.
    Interconnect -> Maybe Text
location :: Prelude.Maybe Prelude.Text,
    -- | The name of the service provider associated with the interconnect.
    Interconnect -> Maybe Text
providerName :: Prelude.Maybe Prelude.Text,
    -- | The Amazon Web Services Region where the connection is located.
    Interconnect -> Maybe Text
region :: Prelude.Maybe Prelude.Text,
    -- | The tags associated with the interconnect.
    Interconnect -> Maybe (NonEmpty Tag)
tags :: Prelude.Maybe (Prelude.NonEmpty Tag)
  }
  deriving (Interconnect -> Interconnect -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Interconnect -> Interconnect -> Bool
$c/= :: Interconnect -> Interconnect -> Bool
== :: Interconnect -> Interconnect -> Bool
$c== :: Interconnect -> Interconnect -> Bool
Prelude.Eq, ReadPrec [Interconnect]
ReadPrec Interconnect
Int -> ReadS Interconnect
ReadS [Interconnect]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Interconnect]
$creadListPrec :: ReadPrec [Interconnect]
readPrec :: ReadPrec Interconnect
$creadPrec :: ReadPrec Interconnect
readList :: ReadS [Interconnect]
$creadList :: ReadS [Interconnect]
readsPrec :: Int -> ReadS Interconnect
$creadsPrec :: Int -> ReadS Interconnect
Prelude.Read, Int -> Interconnect -> ShowS
[Interconnect] -> ShowS
Interconnect -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Interconnect] -> ShowS
$cshowList :: [Interconnect] -> ShowS
show :: Interconnect -> String
$cshow :: Interconnect -> String
showsPrec :: Int -> Interconnect -> ShowS
$cshowsPrec :: Int -> Interconnect -> ShowS
Prelude.Show, forall x. Rep Interconnect x -> Interconnect
forall x. Interconnect -> Rep Interconnect x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Interconnect x -> Interconnect
$cfrom :: forall x. Interconnect -> Rep Interconnect x
Prelude.Generic)

-- |
-- Create a value of 'Interconnect' 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:
--
-- 'awsDevice', 'interconnect_awsDevice' - The Direct Connect endpoint on which the physical connection terminates.
--
-- 'awsDeviceV2', 'interconnect_awsDeviceV2' - The Direct Connect endpoint that terminates the physical connection.
--
-- 'awsLogicalDeviceId', 'interconnect_awsLogicalDeviceId' - The Direct Connect endpoint that terminates the logical connection. This
-- device might be different than the device that terminates the physical
-- connection.
--
-- 'bandwidth', 'interconnect_bandwidth' - The bandwidth of the connection.
--
-- 'hasLogicalRedundancy', 'interconnect_hasLogicalRedundancy' - Indicates whether the interconnect supports a secondary BGP in the same
-- address family (IPv4\/IPv6).
--
-- 'interconnectId', 'interconnect_interconnectId' - The ID of the interconnect.
--
-- 'interconnectName', 'interconnect_interconnectName' - The name of the interconnect.
--
-- 'interconnectState', 'interconnect_interconnectState' - The state of the interconnect. The following are the possible values:
--
-- -   @requested@: The initial state of an interconnect. The interconnect
--     stays in the requested state until the Letter of Authorization (LOA)
--     is sent to the customer.
--
-- -   @pending@: The interconnect is approved, and is being initialized.
--
-- -   @available@: The network link is up, and the interconnect is ready
--     for use.
--
-- -   @down@: The network link is down.
--
-- -   @deleting@: The interconnect is being deleted.
--
-- -   @deleted@: The interconnect is deleted.
--
-- -   @unknown@: The state of the interconnect is not available.
--
-- 'jumboFrameCapable', 'interconnect_jumboFrameCapable' - Indicates whether jumbo frames (9001 MTU) are supported.
--
-- 'lagId', 'interconnect_lagId' - The ID of the LAG.
--
-- 'loaIssueTime', 'interconnect_loaIssueTime' - The time of the most recent call to DescribeLoa for this connection.
--
-- 'location', 'interconnect_location' - The location of the connection.
--
-- 'providerName', 'interconnect_providerName' - The name of the service provider associated with the interconnect.
--
-- 'region', 'interconnect_region' - The Amazon Web Services Region where the connection is located.
--
-- 'tags', 'interconnect_tags' - The tags associated with the interconnect.
newInterconnect ::
  Interconnect
newInterconnect :: Interconnect
newInterconnect =
  Interconnect'
    { $sel:awsDevice:Interconnect' :: Maybe Text
awsDevice = forall a. Maybe a
Prelude.Nothing,
      $sel:awsDeviceV2:Interconnect' :: Maybe Text
awsDeviceV2 = forall a. Maybe a
Prelude.Nothing,
      $sel:awsLogicalDeviceId:Interconnect' :: Maybe Text
awsLogicalDeviceId = forall a. Maybe a
Prelude.Nothing,
      $sel:bandwidth:Interconnect' :: Maybe Text
bandwidth = forall a. Maybe a
Prelude.Nothing,
      $sel:hasLogicalRedundancy:Interconnect' :: Maybe HasLogicalRedundancy
hasLogicalRedundancy = forall a. Maybe a
Prelude.Nothing,
      $sel:interconnectId:Interconnect' :: Maybe Text
interconnectId = forall a. Maybe a
Prelude.Nothing,
      $sel:interconnectName:Interconnect' :: Maybe Text
interconnectName = forall a. Maybe a
Prelude.Nothing,
      $sel:interconnectState:Interconnect' :: Maybe InterconnectState
interconnectState = forall a. Maybe a
Prelude.Nothing,
      $sel:jumboFrameCapable:Interconnect' :: Maybe Bool
jumboFrameCapable = forall a. Maybe a
Prelude.Nothing,
      $sel:lagId:Interconnect' :: Maybe Text
lagId = forall a. Maybe a
Prelude.Nothing,
      $sel:loaIssueTime:Interconnect' :: Maybe POSIX
loaIssueTime = forall a. Maybe a
Prelude.Nothing,
      $sel:location:Interconnect' :: Maybe Text
location = forall a. Maybe a
Prelude.Nothing,
      $sel:providerName:Interconnect' :: Maybe Text
providerName = forall a. Maybe a
Prelude.Nothing,
      $sel:region:Interconnect' :: Maybe Text
region = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:Interconnect' :: Maybe (NonEmpty Tag)
tags = forall a. Maybe a
Prelude.Nothing
    }

-- | The Direct Connect endpoint on which the physical connection terminates.
interconnect_awsDevice :: Lens.Lens' Interconnect (Prelude.Maybe Prelude.Text)
interconnect_awsDevice :: Lens' Interconnect (Maybe Text)
interconnect_awsDevice = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Interconnect' {Maybe Text
awsDevice :: Maybe Text
$sel:awsDevice:Interconnect' :: Interconnect -> Maybe Text
awsDevice} -> Maybe Text
awsDevice) (\s :: Interconnect
s@Interconnect' {} Maybe Text
a -> Interconnect
s {$sel:awsDevice:Interconnect' :: Maybe Text
awsDevice = Maybe Text
a} :: Interconnect)

-- | The Direct Connect endpoint that terminates the physical connection.
interconnect_awsDeviceV2 :: Lens.Lens' Interconnect (Prelude.Maybe Prelude.Text)
interconnect_awsDeviceV2 :: Lens' Interconnect (Maybe Text)
interconnect_awsDeviceV2 = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Interconnect' {Maybe Text
awsDeviceV2 :: Maybe Text
$sel:awsDeviceV2:Interconnect' :: Interconnect -> Maybe Text
awsDeviceV2} -> Maybe Text
awsDeviceV2) (\s :: Interconnect
s@Interconnect' {} Maybe Text
a -> Interconnect
s {$sel:awsDeviceV2:Interconnect' :: Maybe Text
awsDeviceV2 = Maybe Text
a} :: Interconnect)

-- | The Direct Connect endpoint that terminates the logical connection. This
-- device might be different than the device that terminates the physical
-- connection.
interconnect_awsLogicalDeviceId :: Lens.Lens' Interconnect (Prelude.Maybe Prelude.Text)
interconnect_awsLogicalDeviceId :: Lens' Interconnect (Maybe Text)
interconnect_awsLogicalDeviceId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Interconnect' {Maybe Text
awsLogicalDeviceId :: Maybe Text
$sel:awsLogicalDeviceId:Interconnect' :: Interconnect -> Maybe Text
awsLogicalDeviceId} -> Maybe Text
awsLogicalDeviceId) (\s :: Interconnect
s@Interconnect' {} Maybe Text
a -> Interconnect
s {$sel:awsLogicalDeviceId:Interconnect' :: Maybe Text
awsLogicalDeviceId = Maybe Text
a} :: Interconnect)

-- | The bandwidth of the connection.
interconnect_bandwidth :: Lens.Lens' Interconnect (Prelude.Maybe Prelude.Text)
interconnect_bandwidth :: Lens' Interconnect (Maybe Text)
interconnect_bandwidth = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Interconnect' {Maybe Text
bandwidth :: Maybe Text
$sel:bandwidth:Interconnect' :: Interconnect -> Maybe Text
bandwidth} -> Maybe Text
bandwidth) (\s :: Interconnect
s@Interconnect' {} Maybe Text
a -> Interconnect
s {$sel:bandwidth:Interconnect' :: Maybe Text
bandwidth = Maybe Text
a} :: Interconnect)

-- | Indicates whether the interconnect supports a secondary BGP in the same
-- address family (IPv4\/IPv6).
interconnect_hasLogicalRedundancy :: Lens.Lens' Interconnect (Prelude.Maybe HasLogicalRedundancy)
interconnect_hasLogicalRedundancy :: Lens' Interconnect (Maybe HasLogicalRedundancy)
interconnect_hasLogicalRedundancy = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Interconnect' {Maybe HasLogicalRedundancy
hasLogicalRedundancy :: Maybe HasLogicalRedundancy
$sel:hasLogicalRedundancy:Interconnect' :: Interconnect -> Maybe HasLogicalRedundancy
hasLogicalRedundancy} -> Maybe HasLogicalRedundancy
hasLogicalRedundancy) (\s :: Interconnect
s@Interconnect' {} Maybe HasLogicalRedundancy
a -> Interconnect
s {$sel:hasLogicalRedundancy:Interconnect' :: Maybe HasLogicalRedundancy
hasLogicalRedundancy = Maybe HasLogicalRedundancy
a} :: Interconnect)

-- | The ID of the interconnect.
interconnect_interconnectId :: Lens.Lens' Interconnect (Prelude.Maybe Prelude.Text)
interconnect_interconnectId :: Lens' Interconnect (Maybe Text)
interconnect_interconnectId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Interconnect' {Maybe Text
interconnectId :: Maybe Text
$sel:interconnectId:Interconnect' :: Interconnect -> Maybe Text
interconnectId} -> Maybe Text
interconnectId) (\s :: Interconnect
s@Interconnect' {} Maybe Text
a -> Interconnect
s {$sel:interconnectId:Interconnect' :: Maybe Text
interconnectId = Maybe Text
a} :: Interconnect)

-- | The name of the interconnect.
interconnect_interconnectName :: Lens.Lens' Interconnect (Prelude.Maybe Prelude.Text)
interconnect_interconnectName :: Lens' Interconnect (Maybe Text)
interconnect_interconnectName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Interconnect' {Maybe Text
interconnectName :: Maybe Text
$sel:interconnectName:Interconnect' :: Interconnect -> Maybe Text
interconnectName} -> Maybe Text
interconnectName) (\s :: Interconnect
s@Interconnect' {} Maybe Text
a -> Interconnect
s {$sel:interconnectName:Interconnect' :: Maybe Text
interconnectName = Maybe Text
a} :: Interconnect)

-- | The state of the interconnect. The following are the possible values:
--
-- -   @requested@: The initial state of an interconnect. The interconnect
--     stays in the requested state until the Letter of Authorization (LOA)
--     is sent to the customer.
--
-- -   @pending@: The interconnect is approved, and is being initialized.
--
-- -   @available@: The network link is up, and the interconnect is ready
--     for use.
--
-- -   @down@: The network link is down.
--
-- -   @deleting@: The interconnect is being deleted.
--
-- -   @deleted@: The interconnect is deleted.
--
-- -   @unknown@: The state of the interconnect is not available.
interconnect_interconnectState :: Lens.Lens' Interconnect (Prelude.Maybe InterconnectState)
interconnect_interconnectState :: Lens' Interconnect (Maybe InterconnectState)
interconnect_interconnectState = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Interconnect' {Maybe InterconnectState
interconnectState :: Maybe InterconnectState
$sel:interconnectState:Interconnect' :: Interconnect -> Maybe InterconnectState
interconnectState} -> Maybe InterconnectState
interconnectState) (\s :: Interconnect
s@Interconnect' {} Maybe InterconnectState
a -> Interconnect
s {$sel:interconnectState:Interconnect' :: Maybe InterconnectState
interconnectState = Maybe InterconnectState
a} :: Interconnect)

-- | Indicates whether jumbo frames (9001 MTU) are supported.
interconnect_jumboFrameCapable :: Lens.Lens' Interconnect (Prelude.Maybe Prelude.Bool)
interconnect_jumboFrameCapable :: Lens' Interconnect (Maybe Bool)
interconnect_jumboFrameCapable = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Interconnect' {Maybe Bool
jumboFrameCapable :: Maybe Bool
$sel:jumboFrameCapable:Interconnect' :: Interconnect -> Maybe Bool
jumboFrameCapable} -> Maybe Bool
jumboFrameCapable) (\s :: Interconnect
s@Interconnect' {} Maybe Bool
a -> Interconnect
s {$sel:jumboFrameCapable:Interconnect' :: Maybe Bool
jumboFrameCapable = Maybe Bool
a} :: Interconnect)

-- | The ID of the LAG.
interconnect_lagId :: Lens.Lens' Interconnect (Prelude.Maybe Prelude.Text)
interconnect_lagId :: Lens' Interconnect (Maybe Text)
interconnect_lagId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Interconnect' {Maybe Text
lagId :: Maybe Text
$sel:lagId:Interconnect' :: Interconnect -> Maybe Text
lagId} -> Maybe Text
lagId) (\s :: Interconnect
s@Interconnect' {} Maybe Text
a -> Interconnect
s {$sel:lagId:Interconnect' :: Maybe Text
lagId = Maybe Text
a} :: Interconnect)

-- | The time of the most recent call to DescribeLoa for this connection.
interconnect_loaIssueTime :: Lens.Lens' Interconnect (Prelude.Maybe Prelude.UTCTime)
interconnect_loaIssueTime :: Lens' Interconnect (Maybe UTCTime)
interconnect_loaIssueTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Interconnect' {Maybe POSIX
loaIssueTime :: Maybe POSIX
$sel:loaIssueTime:Interconnect' :: Interconnect -> Maybe POSIX
loaIssueTime} -> Maybe POSIX
loaIssueTime) (\s :: Interconnect
s@Interconnect' {} Maybe POSIX
a -> Interconnect
s {$sel:loaIssueTime:Interconnect' :: Maybe POSIX
loaIssueTime = Maybe POSIX
a} :: Interconnect) 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 (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The location of the connection.
interconnect_location :: Lens.Lens' Interconnect (Prelude.Maybe Prelude.Text)
interconnect_location :: Lens' Interconnect (Maybe Text)
interconnect_location = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Interconnect' {Maybe Text
location :: Maybe Text
$sel:location:Interconnect' :: Interconnect -> Maybe Text
location} -> Maybe Text
location) (\s :: Interconnect
s@Interconnect' {} Maybe Text
a -> Interconnect
s {$sel:location:Interconnect' :: Maybe Text
location = Maybe Text
a} :: Interconnect)

-- | The name of the service provider associated with the interconnect.
interconnect_providerName :: Lens.Lens' Interconnect (Prelude.Maybe Prelude.Text)
interconnect_providerName :: Lens' Interconnect (Maybe Text)
interconnect_providerName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Interconnect' {Maybe Text
providerName :: Maybe Text
$sel:providerName:Interconnect' :: Interconnect -> Maybe Text
providerName} -> Maybe Text
providerName) (\s :: Interconnect
s@Interconnect' {} Maybe Text
a -> Interconnect
s {$sel:providerName:Interconnect' :: Maybe Text
providerName = Maybe Text
a} :: Interconnect)

-- | The Amazon Web Services Region where the connection is located.
interconnect_region :: Lens.Lens' Interconnect (Prelude.Maybe Prelude.Text)
interconnect_region :: Lens' Interconnect (Maybe Text)
interconnect_region = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Interconnect' {Maybe Text
region :: Maybe Text
$sel:region:Interconnect' :: Interconnect -> Maybe Text
region} -> Maybe Text
region) (\s :: Interconnect
s@Interconnect' {} Maybe Text
a -> Interconnect
s {$sel:region:Interconnect' :: Maybe Text
region = Maybe Text
a} :: Interconnect)

-- | The tags associated with the interconnect.
interconnect_tags :: Lens.Lens' Interconnect (Prelude.Maybe (Prelude.NonEmpty Tag))
interconnect_tags :: Lens' Interconnect (Maybe (NonEmpty Tag))
interconnect_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Interconnect' {Maybe (NonEmpty Tag)
tags :: Maybe (NonEmpty Tag)
$sel:tags:Interconnect' :: Interconnect -> Maybe (NonEmpty Tag)
tags} -> Maybe (NonEmpty Tag)
tags) (\s :: Interconnect
s@Interconnect' {} Maybe (NonEmpty Tag)
a -> Interconnect
s {$sel:tags:Interconnect' :: Maybe (NonEmpty Tag)
tags = Maybe (NonEmpty Tag)
a} :: Interconnect) 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

instance Data.FromJSON Interconnect where
  parseJSON :: Value -> Parser Interconnect
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"Interconnect"
      ( \Object
x ->
          Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe HasLogicalRedundancy
-> Maybe Text
-> Maybe Text
-> Maybe InterconnectState
-> Maybe Bool
-> Maybe Text
-> Maybe POSIX
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe (NonEmpty Tag)
-> Interconnect
Interconnect'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"awsDevice")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"awsDeviceV2")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"awsLogicalDeviceId")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"bandwidth")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"hasLogicalRedundancy")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"interconnectId")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"interconnectName")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"interconnectState")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"jumboFrameCapable")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"lagId")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"loaIssueTime")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"location")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"providerName")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"region")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"tags")
      )

instance Prelude.Hashable Interconnect where
  hashWithSalt :: Int -> Interconnect -> Int
hashWithSalt Int
_salt Interconnect' {Maybe Bool
Maybe (NonEmpty Tag)
Maybe Text
Maybe POSIX
Maybe HasLogicalRedundancy
Maybe InterconnectState
tags :: Maybe (NonEmpty Tag)
region :: Maybe Text
providerName :: Maybe Text
location :: Maybe Text
loaIssueTime :: Maybe POSIX
lagId :: Maybe Text
jumboFrameCapable :: Maybe Bool
interconnectState :: Maybe InterconnectState
interconnectName :: Maybe Text
interconnectId :: Maybe Text
hasLogicalRedundancy :: Maybe HasLogicalRedundancy
bandwidth :: Maybe Text
awsLogicalDeviceId :: Maybe Text
awsDeviceV2 :: Maybe Text
awsDevice :: Maybe Text
$sel:tags:Interconnect' :: Interconnect -> Maybe (NonEmpty Tag)
$sel:region:Interconnect' :: Interconnect -> Maybe Text
$sel:providerName:Interconnect' :: Interconnect -> Maybe Text
$sel:location:Interconnect' :: Interconnect -> Maybe Text
$sel:loaIssueTime:Interconnect' :: Interconnect -> Maybe POSIX
$sel:lagId:Interconnect' :: Interconnect -> Maybe Text
$sel:jumboFrameCapable:Interconnect' :: Interconnect -> Maybe Bool
$sel:interconnectState:Interconnect' :: Interconnect -> Maybe InterconnectState
$sel:interconnectName:Interconnect' :: Interconnect -> Maybe Text
$sel:interconnectId:Interconnect' :: Interconnect -> Maybe Text
$sel:hasLogicalRedundancy:Interconnect' :: Interconnect -> Maybe HasLogicalRedundancy
$sel:bandwidth:Interconnect' :: Interconnect -> Maybe Text
$sel:awsLogicalDeviceId:Interconnect' :: Interconnect -> Maybe Text
$sel:awsDeviceV2:Interconnect' :: Interconnect -> Maybe Text
$sel:awsDevice:Interconnect' :: Interconnect -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
awsDevice
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
awsDeviceV2
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
awsLogicalDeviceId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
bandwidth
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe HasLogicalRedundancy
hasLogicalRedundancy
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
interconnectId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
interconnectName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe InterconnectState
interconnectState
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
jumboFrameCapable
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
lagId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe POSIX
loaIssueTime
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
location
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
providerName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
region
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (NonEmpty Tag)
tags

instance Prelude.NFData Interconnect where
  rnf :: Interconnect -> ()
rnf Interconnect' {Maybe Bool
Maybe (NonEmpty Tag)
Maybe Text
Maybe POSIX
Maybe HasLogicalRedundancy
Maybe InterconnectState
tags :: Maybe (NonEmpty Tag)
region :: Maybe Text
providerName :: Maybe Text
location :: Maybe Text
loaIssueTime :: Maybe POSIX
lagId :: Maybe Text
jumboFrameCapable :: Maybe Bool
interconnectState :: Maybe InterconnectState
interconnectName :: Maybe Text
interconnectId :: Maybe Text
hasLogicalRedundancy :: Maybe HasLogicalRedundancy
bandwidth :: Maybe Text
awsLogicalDeviceId :: Maybe Text
awsDeviceV2 :: Maybe Text
awsDevice :: Maybe Text
$sel:tags:Interconnect' :: Interconnect -> Maybe (NonEmpty Tag)
$sel:region:Interconnect' :: Interconnect -> Maybe Text
$sel:providerName:Interconnect' :: Interconnect -> Maybe Text
$sel:location:Interconnect' :: Interconnect -> Maybe Text
$sel:loaIssueTime:Interconnect' :: Interconnect -> Maybe POSIX
$sel:lagId:Interconnect' :: Interconnect -> Maybe Text
$sel:jumboFrameCapable:Interconnect' :: Interconnect -> Maybe Bool
$sel:interconnectState:Interconnect' :: Interconnect -> Maybe InterconnectState
$sel:interconnectName:Interconnect' :: Interconnect -> Maybe Text
$sel:interconnectId:Interconnect' :: Interconnect -> Maybe Text
$sel:hasLogicalRedundancy:Interconnect' :: Interconnect -> Maybe HasLogicalRedundancy
$sel:bandwidth:Interconnect' :: Interconnect -> Maybe Text
$sel:awsLogicalDeviceId:Interconnect' :: Interconnect -> Maybe Text
$sel:awsDeviceV2:Interconnect' :: Interconnect -> Maybe Text
$sel:awsDevice:Interconnect' :: Interconnect -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
awsDevice
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
awsDeviceV2
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
awsLogicalDeviceId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
bandwidth
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe HasLogicalRedundancy
hasLogicalRedundancy
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
interconnectId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
interconnectName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe InterconnectState
interconnectState
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
jumboFrameCapable
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
lagId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
loaIssueTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
location
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
providerName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
region
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (NonEmpty Tag)
tags