{-# 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.Outposts.Types.AssetInfo
-- 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.Outposts.Types.AssetInfo where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.Outposts.Types.AssetLocation
import Amazonka.Outposts.Types.AssetType
import Amazonka.Outposts.Types.ComputeAttributes
import qualified Amazonka.Prelude as Prelude

-- | Information about hardware assets.
--
-- /See:/ 'newAssetInfo' smart constructor.
data AssetInfo = AssetInfo'
  { -- | The ID of the asset.
    AssetInfo -> Maybe Text
assetId :: Prelude.Maybe Prelude.Text,
    -- | The position of an asset in a rack.
    AssetInfo -> Maybe AssetLocation
assetLocation :: Prelude.Maybe AssetLocation,
    -- | The type of the asset.
    AssetInfo -> Maybe AssetType
assetType :: Prelude.Maybe AssetType,
    -- | Information about compute hardware assets.
    AssetInfo -> Maybe ComputeAttributes
computeAttributes :: Prelude.Maybe ComputeAttributes,
    -- | The rack ID of the asset.
    AssetInfo -> Maybe Text
rackId :: Prelude.Maybe Prelude.Text
  }
  deriving (AssetInfo -> AssetInfo -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AssetInfo -> AssetInfo -> Bool
$c/= :: AssetInfo -> AssetInfo -> Bool
== :: AssetInfo -> AssetInfo -> Bool
$c== :: AssetInfo -> AssetInfo -> Bool
Prelude.Eq, ReadPrec [AssetInfo]
ReadPrec AssetInfo
Int -> ReadS AssetInfo
ReadS [AssetInfo]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AssetInfo]
$creadListPrec :: ReadPrec [AssetInfo]
readPrec :: ReadPrec AssetInfo
$creadPrec :: ReadPrec AssetInfo
readList :: ReadS [AssetInfo]
$creadList :: ReadS [AssetInfo]
readsPrec :: Int -> ReadS AssetInfo
$creadsPrec :: Int -> ReadS AssetInfo
Prelude.Read, Int -> AssetInfo -> ShowS
[AssetInfo] -> ShowS
AssetInfo -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AssetInfo] -> ShowS
$cshowList :: [AssetInfo] -> ShowS
show :: AssetInfo -> String
$cshow :: AssetInfo -> String
showsPrec :: Int -> AssetInfo -> ShowS
$cshowsPrec :: Int -> AssetInfo -> ShowS
Prelude.Show, forall x. Rep AssetInfo x -> AssetInfo
forall x. AssetInfo -> Rep AssetInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AssetInfo x -> AssetInfo
$cfrom :: forall x. AssetInfo -> Rep AssetInfo x
Prelude.Generic)

-- |
-- Create a value of 'AssetInfo' 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:
--
-- 'assetId', 'assetInfo_assetId' - The ID of the asset.
--
-- 'assetLocation', 'assetInfo_assetLocation' - The position of an asset in a rack.
--
-- 'assetType', 'assetInfo_assetType' - The type of the asset.
--
-- 'computeAttributes', 'assetInfo_computeAttributes' - Information about compute hardware assets.
--
-- 'rackId', 'assetInfo_rackId' - The rack ID of the asset.
newAssetInfo ::
  AssetInfo
newAssetInfo :: AssetInfo
newAssetInfo =
  AssetInfo'
    { $sel:assetId:AssetInfo' :: Maybe Text
assetId = forall a. Maybe a
Prelude.Nothing,
      $sel:assetLocation:AssetInfo' :: Maybe AssetLocation
assetLocation = forall a. Maybe a
Prelude.Nothing,
      $sel:assetType:AssetInfo' :: Maybe AssetType
assetType = forall a. Maybe a
Prelude.Nothing,
      $sel:computeAttributes:AssetInfo' :: Maybe ComputeAttributes
computeAttributes = forall a. Maybe a
Prelude.Nothing,
      $sel:rackId:AssetInfo' :: Maybe Text
rackId = forall a. Maybe a
Prelude.Nothing
    }

-- | The ID of the asset.
assetInfo_assetId :: Lens.Lens' AssetInfo (Prelude.Maybe Prelude.Text)
assetInfo_assetId :: Lens' AssetInfo (Maybe Text)
assetInfo_assetId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AssetInfo' {Maybe Text
assetId :: Maybe Text
$sel:assetId:AssetInfo' :: AssetInfo -> Maybe Text
assetId} -> Maybe Text
assetId) (\s :: AssetInfo
s@AssetInfo' {} Maybe Text
a -> AssetInfo
s {$sel:assetId:AssetInfo' :: Maybe Text
assetId = Maybe Text
a} :: AssetInfo)

-- | The position of an asset in a rack.
assetInfo_assetLocation :: Lens.Lens' AssetInfo (Prelude.Maybe AssetLocation)
assetInfo_assetLocation :: Lens' AssetInfo (Maybe AssetLocation)
assetInfo_assetLocation = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AssetInfo' {Maybe AssetLocation
assetLocation :: Maybe AssetLocation
$sel:assetLocation:AssetInfo' :: AssetInfo -> Maybe AssetLocation
assetLocation} -> Maybe AssetLocation
assetLocation) (\s :: AssetInfo
s@AssetInfo' {} Maybe AssetLocation
a -> AssetInfo
s {$sel:assetLocation:AssetInfo' :: Maybe AssetLocation
assetLocation = Maybe AssetLocation
a} :: AssetInfo)

-- | The type of the asset.
assetInfo_assetType :: Lens.Lens' AssetInfo (Prelude.Maybe AssetType)
assetInfo_assetType :: Lens' AssetInfo (Maybe AssetType)
assetInfo_assetType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AssetInfo' {Maybe AssetType
assetType :: Maybe AssetType
$sel:assetType:AssetInfo' :: AssetInfo -> Maybe AssetType
assetType} -> Maybe AssetType
assetType) (\s :: AssetInfo
s@AssetInfo' {} Maybe AssetType
a -> AssetInfo
s {$sel:assetType:AssetInfo' :: Maybe AssetType
assetType = Maybe AssetType
a} :: AssetInfo)

-- | Information about compute hardware assets.
assetInfo_computeAttributes :: Lens.Lens' AssetInfo (Prelude.Maybe ComputeAttributes)
assetInfo_computeAttributes :: Lens' AssetInfo (Maybe ComputeAttributes)
assetInfo_computeAttributes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AssetInfo' {Maybe ComputeAttributes
computeAttributes :: Maybe ComputeAttributes
$sel:computeAttributes:AssetInfo' :: AssetInfo -> Maybe ComputeAttributes
computeAttributes} -> Maybe ComputeAttributes
computeAttributes) (\s :: AssetInfo
s@AssetInfo' {} Maybe ComputeAttributes
a -> AssetInfo
s {$sel:computeAttributes:AssetInfo' :: Maybe ComputeAttributes
computeAttributes = Maybe ComputeAttributes
a} :: AssetInfo)

-- | The rack ID of the asset.
assetInfo_rackId :: Lens.Lens' AssetInfo (Prelude.Maybe Prelude.Text)
assetInfo_rackId :: Lens' AssetInfo (Maybe Text)
assetInfo_rackId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AssetInfo' {Maybe Text
rackId :: Maybe Text
$sel:rackId:AssetInfo' :: AssetInfo -> Maybe Text
rackId} -> Maybe Text
rackId) (\s :: AssetInfo
s@AssetInfo' {} Maybe Text
a -> AssetInfo
s {$sel:rackId:AssetInfo' :: Maybe Text
rackId = Maybe Text
a} :: AssetInfo)

instance Data.FromJSON AssetInfo where
  parseJSON :: Value -> Parser AssetInfo
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"AssetInfo"
      ( \Object
x ->
          Maybe Text
-> Maybe AssetLocation
-> Maybe AssetType
-> Maybe ComputeAttributes
-> Maybe Text
-> AssetInfo
AssetInfo'
            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
"AssetId")
            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
"AssetLocation")
            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
"AssetType")
            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
"ComputeAttributes")
            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
"RackId")
      )

instance Prelude.Hashable AssetInfo where
  hashWithSalt :: Int -> AssetInfo -> Int
hashWithSalt Int
_salt AssetInfo' {Maybe Text
Maybe AssetLocation
Maybe AssetType
Maybe ComputeAttributes
rackId :: Maybe Text
computeAttributes :: Maybe ComputeAttributes
assetType :: Maybe AssetType
assetLocation :: Maybe AssetLocation
assetId :: Maybe Text
$sel:rackId:AssetInfo' :: AssetInfo -> Maybe Text
$sel:computeAttributes:AssetInfo' :: AssetInfo -> Maybe ComputeAttributes
$sel:assetType:AssetInfo' :: AssetInfo -> Maybe AssetType
$sel:assetLocation:AssetInfo' :: AssetInfo -> Maybe AssetLocation
$sel:assetId:AssetInfo' :: AssetInfo -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
assetId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe AssetLocation
assetLocation
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe AssetType
assetType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ComputeAttributes
computeAttributes
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
rackId

instance Prelude.NFData AssetInfo where
  rnf :: AssetInfo -> ()
rnf AssetInfo' {Maybe Text
Maybe AssetLocation
Maybe AssetType
Maybe ComputeAttributes
rackId :: Maybe Text
computeAttributes :: Maybe ComputeAttributes
assetType :: Maybe AssetType
assetLocation :: Maybe AssetLocation
assetId :: Maybe Text
$sel:rackId:AssetInfo' :: AssetInfo -> Maybe Text
$sel:computeAttributes:AssetInfo' :: AssetInfo -> Maybe ComputeAttributes
$sel:assetType:AssetInfo' :: AssetInfo -> Maybe AssetType
$sel:assetLocation:AssetInfo' :: AssetInfo -> Maybe AssetLocation
$sel:assetId:AssetInfo' :: AssetInfo -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
assetId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe AssetLocation
assetLocation
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe AssetType
assetType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ComputeAttributes
computeAttributes
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
rackId