{-# 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.PrivateNetworks.Types.NetworkResource
-- 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.PrivateNetworks.Types.NetworkResource 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.HealthStatus
import Amazonka.PrivateNetworks.Types.NameValuePair
import Amazonka.PrivateNetworks.Types.NetworkResourceStatus
import Amazonka.PrivateNetworks.Types.NetworkResourceType
import Amazonka.PrivateNetworks.Types.Position

-- | Information about a network resource.
--
-- /See:/ 'newNetworkResource' smart constructor.
data NetworkResource = NetworkResource'
  { -- | The attributes of the network resource.
    NetworkResource -> Maybe [NameValuePair]
attributes :: Prelude.Maybe [NameValuePair],
    -- | The creation time of the network resource.
    NetworkResource -> Maybe ISO8601
createdAt :: Prelude.Maybe Data.ISO8601,
    -- | The description of the network resource.
    NetworkResource -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | The health of the network resource.
    NetworkResource -> Maybe HealthStatus
health :: Prelude.Maybe HealthStatus,
    -- | The model of the network resource.
    NetworkResource -> Maybe Text
model :: Prelude.Maybe Prelude.Text,
    -- | The Amazon Resource Name (ARN) of the network on which this network
    -- resource appears.
    NetworkResource -> Maybe Text
networkArn :: Prelude.Maybe Prelude.Text,
    -- | The Amazon Resource Name (ARN) of the network resource.
    NetworkResource -> Maybe Text
networkResourceArn :: Prelude.Maybe Prelude.Text,
    -- | The Amazon Resource Name (ARN) of the network site on which this network
    -- resource appears.
    NetworkResource -> Maybe Text
networkSiteArn :: Prelude.Maybe Prelude.Text,
    -- | The Amazon Resource Name (ARN) of the order used to purchase this
    -- network resource.
    NetworkResource -> Maybe Text
orderArn :: Prelude.Maybe Prelude.Text,
    -- | The position of the network resource.
    NetworkResource -> Maybe Position
position :: Prelude.Maybe Position,
    -- | The serial number of the network resource.
    NetworkResource -> Maybe Text
serialNumber :: Prelude.Maybe Prelude.Text,
    -- | The status of the network resource.
    NetworkResource -> Maybe NetworkResourceStatus
status :: Prelude.Maybe NetworkResourceStatus,
    -- | The status reason of the network resource.
    NetworkResource -> Maybe Text
statusReason :: Prelude.Maybe Prelude.Text,
    -- | The type of the network resource.
    NetworkResource -> Maybe NetworkResourceType
type' :: Prelude.Maybe NetworkResourceType,
    -- | The vendor of the network resource.
    NetworkResource -> Maybe Text
vendor :: Prelude.Maybe Prelude.Text
  }
  deriving (NetworkResource -> NetworkResource -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NetworkResource -> NetworkResource -> Bool
$c/= :: NetworkResource -> NetworkResource -> Bool
== :: NetworkResource -> NetworkResource -> Bool
$c== :: NetworkResource -> NetworkResource -> Bool
Prelude.Eq, ReadPrec [NetworkResource]
ReadPrec NetworkResource
Int -> ReadS NetworkResource
ReadS [NetworkResource]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [NetworkResource]
$creadListPrec :: ReadPrec [NetworkResource]
readPrec :: ReadPrec NetworkResource
$creadPrec :: ReadPrec NetworkResource
readList :: ReadS [NetworkResource]
$creadList :: ReadS [NetworkResource]
readsPrec :: Int -> ReadS NetworkResource
$creadsPrec :: Int -> ReadS NetworkResource
Prelude.Read, Int -> NetworkResource -> ShowS
[NetworkResource] -> ShowS
NetworkResource -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NetworkResource] -> ShowS
$cshowList :: [NetworkResource] -> ShowS
show :: NetworkResource -> String
$cshow :: NetworkResource -> String
showsPrec :: Int -> NetworkResource -> ShowS
$cshowsPrec :: Int -> NetworkResource -> ShowS
Prelude.Show, forall x. Rep NetworkResource x -> NetworkResource
forall x. NetworkResource -> Rep NetworkResource x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep NetworkResource x -> NetworkResource
$cfrom :: forall x. NetworkResource -> Rep NetworkResource x
Prelude.Generic)

-- |
-- Create a value of 'NetworkResource' 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:
--
-- 'attributes', 'networkResource_attributes' - The attributes of the network resource.
--
-- 'createdAt', 'networkResource_createdAt' - The creation time of the network resource.
--
-- 'description', 'networkResource_description' - The description of the network resource.
--
-- 'health', 'networkResource_health' - The health of the network resource.
--
-- 'model', 'networkResource_model' - The model of the network resource.
--
-- 'networkArn', 'networkResource_networkArn' - The Amazon Resource Name (ARN) of the network on which this network
-- resource appears.
--
-- 'networkResourceArn', 'networkResource_networkResourceArn' - The Amazon Resource Name (ARN) of the network resource.
--
-- 'networkSiteArn', 'networkResource_networkSiteArn' - The Amazon Resource Name (ARN) of the network site on which this network
-- resource appears.
--
-- 'orderArn', 'networkResource_orderArn' - The Amazon Resource Name (ARN) of the order used to purchase this
-- network resource.
--
-- 'position', 'networkResource_position' - The position of the network resource.
--
-- 'serialNumber', 'networkResource_serialNumber' - The serial number of the network resource.
--
-- 'status', 'networkResource_status' - The status of the network resource.
--
-- 'statusReason', 'networkResource_statusReason' - The status reason of the network resource.
--
-- 'type'', 'networkResource_type' - The type of the network resource.
--
-- 'vendor', 'networkResource_vendor' - The vendor of the network resource.
newNetworkResource ::
  NetworkResource
newNetworkResource :: NetworkResource
newNetworkResource =
  NetworkResource'
    { $sel:attributes:NetworkResource' :: Maybe [NameValuePair]
attributes = forall a. Maybe a
Prelude.Nothing,
      $sel:createdAt:NetworkResource' :: Maybe ISO8601
createdAt = forall a. Maybe a
Prelude.Nothing,
      $sel:description:NetworkResource' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:health:NetworkResource' :: Maybe HealthStatus
health = forall a. Maybe a
Prelude.Nothing,
      $sel:model:NetworkResource' :: Maybe Text
model = forall a. Maybe a
Prelude.Nothing,
      $sel:networkArn:NetworkResource' :: Maybe Text
networkArn = forall a. Maybe a
Prelude.Nothing,
      $sel:networkResourceArn:NetworkResource' :: Maybe Text
networkResourceArn = forall a. Maybe a
Prelude.Nothing,
      $sel:networkSiteArn:NetworkResource' :: Maybe Text
networkSiteArn = forall a. Maybe a
Prelude.Nothing,
      $sel:orderArn:NetworkResource' :: Maybe Text
orderArn = forall a. Maybe a
Prelude.Nothing,
      $sel:position:NetworkResource' :: Maybe Position
position = forall a. Maybe a
Prelude.Nothing,
      $sel:serialNumber:NetworkResource' :: Maybe Text
serialNumber = forall a. Maybe a
Prelude.Nothing,
      $sel:status:NetworkResource' :: Maybe NetworkResourceStatus
status = forall a. Maybe a
Prelude.Nothing,
      $sel:statusReason:NetworkResource' :: Maybe Text
statusReason = forall a. Maybe a
Prelude.Nothing,
      $sel:type':NetworkResource' :: Maybe NetworkResourceType
type' = forall a. Maybe a
Prelude.Nothing,
      $sel:vendor:NetworkResource' :: Maybe Text
vendor = forall a. Maybe a
Prelude.Nothing
    }

-- | The attributes of the network resource.
networkResource_attributes :: Lens.Lens' NetworkResource (Prelude.Maybe [NameValuePair])
networkResource_attributes :: Lens' NetworkResource (Maybe [NameValuePair])
networkResource_attributes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\NetworkResource' {Maybe [NameValuePair]
attributes :: Maybe [NameValuePair]
$sel:attributes:NetworkResource' :: NetworkResource -> Maybe [NameValuePair]
attributes} -> Maybe [NameValuePair]
attributes) (\s :: NetworkResource
s@NetworkResource' {} Maybe [NameValuePair]
a -> NetworkResource
s {$sel:attributes:NetworkResource' :: Maybe [NameValuePair]
attributes = Maybe [NameValuePair]
a} :: NetworkResource) 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 creation time of the network resource.
networkResource_createdAt :: Lens.Lens' NetworkResource (Prelude.Maybe Prelude.UTCTime)
networkResource_createdAt :: Lens' NetworkResource (Maybe UTCTime)
networkResource_createdAt = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\NetworkResource' {Maybe ISO8601
createdAt :: Maybe ISO8601
$sel:createdAt:NetworkResource' :: NetworkResource -> Maybe ISO8601
createdAt} -> Maybe ISO8601
createdAt) (\s :: NetworkResource
s@NetworkResource' {} Maybe ISO8601
a -> NetworkResource
s {$sel:createdAt:NetworkResource' :: Maybe ISO8601
createdAt = Maybe ISO8601
a} :: NetworkResource) 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 description of the network resource.
networkResource_description :: Lens.Lens' NetworkResource (Prelude.Maybe Prelude.Text)
networkResource_description :: Lens' NetworkResource (Maybe Text)
networkResource_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\NetworkResource' {Maybe Text
description :: Maybe Text
$sel:description:NetworkResource' :: NetworkResource -> Maybe Text
description} -> Maybe Text
description) (\s :: NetworkResource
s@NetworkResource' {} Maybe Text
a -> NetworkResource
s {$sel:description:NetworkResource' :: Maybe Text
description = Maybe Text
a} :: NetworkResource)

-- | The health of the network resource.
networkResource_health :: Lens.Lens' NetworkResource (Prelude.Maybe HealthStatus)
networkResource_health :: Lens' NetworkResource (Maybe HealthStatus)
networkResource_health = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\NetworkResource' {Maybe HealthStatus
health :: Maybe HealthStatus
$sel:health:NetworkResource' :: NetworkResource -> Maybe HealthStatus
health} -> Maybe HealthStatus
health) (\s :: NetworkResource
s@NetworkResource' {} Maybe HealthStatus
a -> NetworkResource
s {$sel:health:NetworkResource' :: Maybe HealthStatus
health = Maybe HealthStatus
a} :: NetworkResource)

-- | The model of the network resource.
networkResource_model :: Lens.Lens' NetworkResource (Prelude.Maybe Prelude.Text)
networkResource_model :: Lens' NetworkResource (Maybe Text)
networkResource_model = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\NetworkResource' {Maybe Text
model :: Maybe Text
$sel:model:NetworkResource' :: NetworkResource -> Maybe Text
model} -> Maybe Text
model) (\s :: NetworkResource
s@NetworkResource' {} Maybe Text
a -> NetworkResource
s {$sel:model:NetworkResource' :: Maybe Text
model = Maybe Text
a} :: NetworkResource)

-- | The Amazon Resource Name (ARN) of the network on which this network
-- resource appears.
networkResource_networkArn :: Lens.Lens' NetworkResource (Prelude.Maybe Prelude.Text)
networkResource_networkArn :: Lens' NetworkResource (Maybe Text)
networkResource_networkArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\NetworkResource' {Maybe Text
networkArn :: Maybe Text
$sel:networkArn:NetworkResource' :: NetworkResource -> Maybe Text
networkArn} -> Maybe Text
networkArn) (\s :: NetworkResource
s@NetworkResource' {} Maybe Text
a -> NetworkResource
s {$sel:networkArn:NetworkResource' :: Maybe Text
networkArn = Maybe Text
a} :: NetworkResource)

-- | The Amazon Resource Name (ARN) of the network resource.
networkResource_networkResourceArn :: Lens.Lens' NetworkResource (Prelude.Maybe Prelude.Text)
networkResource_networkResourceArn :: Lens' NetworkResource (Maybe Text)
networkResource_networkResourceArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\NetworkResource' {Maybe Text
networkResourceArn :: Maybe Text
$sel:networkResourceArn:NetworkResource' :: NetworkResource -> Maybe Text
networkResourceArn} -> Maybe Text
networkResourceArn) (\s :: NetworkResource
s@NetworkResource' {} Maybe Text
a -> NetworkResource
s {$sel:networkResourceArn:NetworkResource' :: Maybe Text
networkResourceArn = Maybe Text
a} :: NetworkResource)

-- | The Amazon Resource Name (ARN) of the network site on which this network
-- resource appears.
networkResource_networkSiteArn :: Lens.Lens' NetworkResource (Prelude.Maybe Prelude.Text)
networkResource_networkSiteArn :: Lens' NetworkResource (Maybe Text)
networkResource_networkSiteArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\NetworkResource' {Maybe Text
networkSiteArn :: Maybe Text
$sel:networkSiteArn:NetworkResource' :: NetworkResource -> Maybe Text
networkSiteArn} -> Maybe Text
networkSiteArn) (\s :: NetworkResource
s@NetworkResource' {} Maybe Text
a -> NetworkResource
s {$sel:networkSiteArn:NetworkResource' :: Maybe Text
networkSiteArn = Maybe Text
a} :: NetworkResource)

-- | The Amazon Resource Name (ARN) of the order used to purchase this
-- network resource.
networkResource_orderArn :: Lens.Lens' NetworkResource (Prelude.Maybe Prelude.Text)
networkResource_orderArn :: Lens' NetworkResource (Maybe Text)
networkResource_orderArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\NetworkResource' {Maybe Text
orderArn :: Maybe Text
$sel:orderArn:NetworkResource' :: NetworkResource -> Maybe Text
orderArn} -> Maybe Text
orderArn) (\s :: NetworkResource
s@NetworkResource' {} Maybe Text
a -> NetworkResource
s {$sel:orderArn:NetworkResource' :: Maybe Text
orderArn = Maybe Text
a} :: NetworkResource)

-- | The position of the network resource.
networkResource_position :: Lens.Lens' NetworkResource (Prelude.Maybe Position)
networkResource_position :: Lens' NetworkResource (Maybe Position)
networkResource_position = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\NetworkResource' {Maybe Position
position :: Maybe Position
$sel:position:NetworkResource' :: NetworkResource -> Maybe Position
position} -> Maybe Position
position) (\s :: NetworkResource
s@NetworkResource' {} Maybe Position
a -> NetworkResource
s {$sel:position:NetworkResource' :: Maybe Position
position = Maybe Position
a} :: NetworkResource)

-- | The serial number of the network resource.
networkResource_serialNumber :: Lens.Lens' NetworkResource (Prelude.Maybe Prelude.Text)
networkResource_serialNumber :: Lens' NetworkResource (Maybe Text)
networkResource_serialNumber = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\NetworkResource' {Maybe Text
serialNumber :: Maybe Text
$sel:serialNumber:NetworkResource' :: NetworkResource -> Maybe Text
serialNumber} -> Maybe Text
serialNumber) (\s :: NetworkResource
s@NetworkResource' {} Maybe Text
a -> NetworkResource
s {$sel:serialNumber:NetworkResource' :: Maybe Text
serialNumber = Maybe Text
a} :: NetworkResource)

-- | The status of the network resource.
networkResource_status :: Lens.Lens' NetworkResource (Prelude.Maybe NetworkResourceStatus)
networkResource_status :: Lens' NetworkResource (Maybe NetworkResourceStatus)
networkResource_status = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\NetworkResource' {Maybe NetworkResourceStatus
status :: Maybe NetworkResourceStatus
$sel:status:NetworkResource' :: NetworkResource -> Maybe NetworkResourceStatus
status} -> Maybe NetworkResourceStatus
status) (\s :: NetworkResource
s@NetworkResource' {} Maybe NetworkResourceStatus
a -> NetworkResource
s {$sel:status:NetworkResource' :: Maybe NetworkResourceStatus
status = Maybe NetworkResourceStatus
a} :: NetworkResource)

-- | The status reason of the network resource.
networkResource_statusReason :: Lens.Lens' NetworkResource (Prelude.Maybe Prelude.Text)
networkResource_statusReason :: Lens' NetworkResource (Maybe Text)
networkResource_statusReason = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\NetworkResource' {Maybe Text
statusReason :: Maybe Text
$sel:statusReason:NetworkResource' :: NetworkResource -> Maybe Text
statusReason} -> Maybe Text
statusReason) (\s :: NetworkResource
s@NetworkResource' {} Maybe Text
a -> NetworkResource
s {$sel:statusReason:NetworkResource' :: Maybe Text
statusReason = Maybe Text
a} :: NetworkResource)

-- | The type of the network resource.
networkResource_type :: Lens.Lens' NetworkResource (Prelude.Maybe NetworkResourceType)
networkResource_type :: Lens' NetworkResource (Maybe NetworkResourceType)
networkResource_type = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\NetworkResource' {Maybe NetworkResourceType
type' :: Maybe NetworkResourceType
$sel:type':NetworkResource' :: NetworkResource -> Maybe NetworkResourceType
type'} -> Maybe NetworkResourceType
type') (\s :: NetworkResource
s@NetworkResource' {} Maybe NetworkResourceType
a -> NetworkResource
s {$sel:type':NetworkResource' :: Maybe NetworkResourceType
type' = Maybe NetworkResourceType
a} :: NetworkResource)

-- | The vendor of the network resource.
networkResource_vendor :: Lens.Lens' NetworkResource (Prelude.Maybe Prelude.Text)
networkResource_vendor :: Lens' NetworkResource (Maybe Text)
networkResource_vendor = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\NetworkResource' {Maybe Text
vendor :: Maybe Text
$sel:vendor:NetworkResource' :: NetworkResource -> Maybe Text
vendor} -> Maybe Text
vendor) (\s :: NetworkResource
s@NetworkResource' {} Maybe Text
a -> NetworkResource
s {$sel:vendor:NetworkResource' :: Maybe Text
vendor = Maybe Text
a} :: NetworkResource)

instance Data.FromJSON NetworkResource where
  parseJSON :: Value -> Parser NetworkResource
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"NetworkResource"
      ( \Object
x ->
          Maybe [NameValuePair]
-> Maybe ISO8601
-> Maybe Text
-> Maybe HealthStatus
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Position
-> Maybe Text
-> Maybe NetworkResourceStatus
-> Maybe Text
-> Maybe NetworkResourceType
-> Maybe Text
-> NetworkResource
NetworkResource'
            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
"attributes" forall a. Parser (Maybe a) -> a -> Parser a
Data..!= 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 -> Parser (Maybe a)
Data..:? Key
"createdAt")
            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
"description")
            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
"health")
            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
"model")
            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
"networkArn")
            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
"networkResourceArn")
            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
"networkSiteArn")
            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
"orderArn")
            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
"position")
            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
"serialNumber")
            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
"status")
            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
"statusReason")
            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
"type")
            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
"vendor")
      )

instance Prelude.Hashable NetworkResource where
  hashWithSalt :: Int -> NetworkResource -> Int
hashWithSalt Int
_salt NetworkResource' {Maybe [NameValuePair]
Maybe Text
Maybe ISO8601
Maybe HealthStatus
Maybe NetworkResourceStatus
Maybe NetworkResourceType
Maybe Position
vendor :: Maybe Text
type' :: Maybe NetworkResourceType
statusReason :: Maybe Text
status :: Maybe NetworkResourceStatus
serialNumber :: Maybe Text
position :: Maybe Position
orderArn :: Maybe Text
networkSiteArn :: Maybe Text
networkResourceArn :: Maybe Text
networkArn :: Maybe Text
model :: Maybe Text
health :: Maybe HealthStatus
description :: Maybe Text
createdAt :: Maybe ISO8601
attributes :: Maybe [NameValuePair]
$sel:vendor:NetworkResource' :: NetworkResource -> Maybe Text
$sel:type':NetworkResource' :: NetworkResource -> Maybe NetworkResourceType
$sel:statusReason:NetworkResource' :: NetworkResource -> Maybe Text
$sel:status:NetworkResource' :: NetworkResource -> Maybe NetworkResourceStatus
$sel:serialNumber:NetworkResource' :: NetworkResource -> Maybe Text
$sel:position:NetworkResource' :: NetworkResource -> Maybe Position
$sel:orderArn:NetworkResource' :: NetworkResource -> Maybe Text
$sel:networkSiteArn:NetworkResource' :: NetworkResource -> Maybe Text
$sel:networkResourceArn:NetworkResource' :: NetworkResource -> Maybe Text
$sel:networkArn:NetworkResource' :: NetworkResource -> Maybe Text
$sel:model:NetworkResource' :: NetworkResource -> Maybe Text
$sel:health:NetworkResource' :: NetworkResource -> Maybe HealthStatus
$sel:description:NetworkResource' :: NetworkResource -> Maybe Text
$sel:createdAt:NetworkResource' :: NetworkResource -> Maybe ISO8601
$sel:attributes:NetworkResource' :: NetworkResource -> Maybe [NameValuePair]
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [NameValuePair]
attributes
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ISO8601
createdAt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe HealthStatus
health
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
model
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
networkArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
networkResourceArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
networkSiteArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
orderArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Position
position
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
serialNumber
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe NetworkResourceStatus
status
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
statusReason
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe NetworkResourceType
type'
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
vendor

instance Prelude.NFData NetworkResource where
  rnf :: NetworkResource -> ()
rnf NetworkResource' {Maybe [NameValuePair]
Maybe Text
Maybe ISO8601
Maybe HealthStatus
Maybe NetworkResourceStatus
Maybe NetworkResourceType
Maybe Position
vendor :: Maybe Text
type' :: Maybe NetworkResourceType
statusReason :: Maybe Text
status :: Maybe NetworkResourceStatus
serialNumber :: Maybe Text
position :: Maybe Position
orderArn :: Maybe Text
networkSiteArn :: Maybe Text
networkResourceArn :: Maybe Text
networkArn :: Maybe Text
model :: Maybe Text
health :: Maybe HealthStatus
description :: Maybe Text
createdAt :: Maybe ISO8601
attributes :: Maybe [NameValuePair]
$sel:vendor:NetworkResource' :: NetworkResource -> Maybe Text
$sel:type':NetworkResource' :: NetworkResource -> Maybe NetworkResourceType
$sel:statusReason:NetworkResource' :: NetworkResource -> Maybe Text
$sel:status:NetworkResource' :: NetworkResource -> Maybe NetworkResourceStatus
$sel:serialNumber:NetworkResource' :: NetworkResource -> Maybe Text
$sel:position:NetworkResource' :: NetworkResource -> Maybe Position
$sel:orderArn:NetworkResource' :: NetworkResource -> Maybe Text
$sel:networkSiteArn:NetworkResource' :: NetworkResource -> Maybe Text
$sel:networkResourceArn:NetworkResource' :: NetworkResource -> Maybe Text
$sel:networkArn:NetworkResource' :: NetworkResource -> Maybe Text
$sel:model:NetworkResource' :: NetworkResource -> Maybe Text
$sel:health:NetworkResource' :: NetworkResource -> Maybe HealthStatus
$sel:description:NetworkResource' :: NetworkResource -> Maybe Text
$sel:createdAt:NetworkResource' :: NetworkResource -> Maybe ISO8601
$sel:attributes:NetworkResource' :: NetworkResource -> Maybe [NameValuePair]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [NameValuePair]
attributes
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ISO8601
createdAt
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
description
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe HealthStatus
health
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
model
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
networkArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
networkResourceArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
networkSiteArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
orderArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Position
position
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
serialNumber
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe NetworkResourceStatus
status
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
statusReason
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe NetworkResourceType
type'
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
vendor