{-# 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.EMR.Types.Instance
-- 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.EMR.Types.Instance where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.EMR.Types.EbsVolume
import Amazonka.EMR.Types.InstanceStatus
import Amazonka.EMR.Types.MarketType
import qualified Amazonka.Prelude as Prelude

-- | Represents an EC2 instance provisioned as part of cluster.
--
-- /See:/ 'newInstance' smart constructor.
data Instance = Instance'
  { -- | The list of Amazon EBS volumes that are attached to this instance.
    Instance -> Maybe [EbsVolume]
ebsVolumes :: Prelude.Maybe [EbsVolume],
    -- | The unique identifier of the instance in Amazon EC2.
    Instance -> Maybe Text
ec2InstanceId :: Prelude.Maybe Prelude.Text,
    -- | The unique identifier for the instance in Amazon EMR.
    Instance -> Maybe Text
id :: Prelude.Maybe Prelude.Text,
    -- | The unique identifier of the instance fleet to which an EC2 instance
    -- belongs.
    Instance -> Maybe Text
instanceFleetId :: Prelude.Maybe Prelude.Text,
    -- | The identifier of the instance group to which this instance belongs.
    Instance -> Maybe Text
instanceGroupId :: Prelude.Maybe Prelude.Text,
    -- | The EC2 instance type, for example @m3.xlarge@.
    Instance -> Maybe Text
instanceType :: Prelude.Maybe Prelude.Text,
    -- | The instance purchasing option. Valid values are @ON_DEMAND@ or @SPOT@.
    Instance -> Maybe MarketType
market :: Prelude.Maybe MarketType,
    -- | The private DNS name of the instance.
    Instance -> Maybe Text
privateDnsName :: Prelude.Maybe Prelude.Text,
    -- | The private IP address of the instance.
    Instance -> Maybe Text
privateIpAddress :: Prelude.Maybe Prelude.Text,
    -- | The public DNS name of the instance.
    Instance -> Maybe Text
publicDnsName :: Prelude.Maybe Prelude.Text,
    -- | The public IP address of the instance.
    Instance -> Maybe Text
publicIpAddress :: Prelude.Maybe Prelude.Text,
    -- | The current status of the instance.
    Instance -> Maybe InstanceStatus
status :: Prelude.Maybe InstanceStatus
  }
  deriving (Instance -> Instance -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Instance -> Instance -> Bool
$c/= :: Instance -> Instance -> Bool
== :: Instance -> Instance -> Bool
$c== :: Instance -> Instance -> Bool
Prelude.Eq, ReadPrec [Instance]
ReadPrec Instance
Int -> ReadS Instance
ReadS [Instance]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Instance]
$creadListPrec :: ReadPrec [Instance]
readPrec :: ReadPrec Instance
$creadPrec :: ReadPrec Instance
readList :: ReadS [Instance]
$creadList :: ReadS [Instance]
readsPrec :: Int -> ReadS Instance
$creadsPrec :: Int -> ReadS Instance
Prelude.Read, Int -> Instance -> ShowS
[Instance] -> ShowS
Instance -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Instance] -> ShowS
$cshowList :: [Instance] -> ShowS
show :: Instance -> String
$cshow :: Instance -> String
showsPrec :: Int -> Instance -> ShowS
$cshowsPrec :: Int -> Instance -> ShowS
Prelude.Show, forall x. Rep Instance x -> Instance
forall x. Instance -> Rep Instance x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Instance x -> Instance
$cfrom :: forall x. Instance -> Rep Instance x
Prelude.Generic)

-- |
-- Create a value of 'Instance' 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:
--
-- 'ebsVolumes', 'instance_ebsVolumes' - The list of Amazon EBS volumes that are attached to this instance.
--
-- 'ec2InstanceId', 'instance_ec2InstanceId' - The unique identifier of the instance in Amazon EC2.
--
-- 'id', 'instance_id' - The unique identifier for the instance in Amazon EMR.
--
-- 'instanceFleetId', 'instance_instanceFleetId' - The unique identifier of the instance fleet to which an EC2 instance
-- belongs.
--
-- 'instanceGroupId', 'instance_instanceGroupId' - The identifier of the instance group to which this instance belongs.
--
-- 'instanceType', 'instance_instanceType' - The EC2 instance type, for example @m3.xlarge@.
--
-- 'market', 'instance_market' - The instance purchasing option. Valid values are @ON_DEMAND@ or @SPOT@.
--
-- 'privateDnsName', 'instance_privateDnsName' - The private DNS name of the instance.
--
-- 'privateIpAddress', 'instance_privateIpAddress' - The private IP address of the instance.
--
-- 'publicDnsName', 'instance_publicDnsName' - The public DNS name of the instance.
--
-- 'publicIpAddress', 'instance_publicIpAddress' - The public IP address of the instance.
--
-- 'status', 'instance_status' - The current status of the instance.
newInstance ::
  Instance
newInstance :: Instance
newInstance =
  Instance'
    { $sel:ebsVolumes:Instance' :: Maybe [EbsVolume]
ebsVolumes = forall a. Maybe a
Prelude.Nothing,
      $sel:ec2InstanceId:Instance' :: Maybe Text
ec2InstanceId = forall a. Maybe a
Prelude.Nothing,
      $sel:id:Instance' :: Maybe Text
id = forall a. Maybe a
Prelude.Nothing,
      $sel:instanceFleetId:Instance' :: Maybe Text
instanceFleetId = forall a. Maybe a
Prelude.Nothing,
      $sel:instanceGroupId:Instance' :: Maybe Text
instanceGroupId = forall a. Maybe a
Prelude.Nothing,
      $sel:instanceType:Instance' :: Maybe Text
instanceType = forall a. Maybe a
Prelude.Nothing,
      $sel:market:Instance' :: Maybe MarketType
market = forall a. Maybe a
Prelude.Nothing,
      $sel:privateDnsName:Instance' :: Maybe Text
privateDnsName = forall a. Maybe a
Prelude.Nothing,
      $sel:privateIpAddress:Instance' :: Maybe Text
privateIpAddress = forall a. Maybe a
Prelude.Nothing,
      $sel:publicDnsName:Instance' :: Maybe Text
publicDnsName = forall a. Maybe a
Prelude.Nothing,
      $sel:publicIpAddress:Instance' :: Maybe Text
publicIpAddress = forall a. Maybe a
Prelude.Nothing,
      $sel:status:Instance' :: Maybe InstanceStatus
status = forall a. Maybe a
Prelude.Nothing
    }

-- | The list of Amazon EBS volumes that are attached to this instance.
instance_ebsVolumes :: Lens.Lens' Instance (Prelude.Maybe [EbsVolume])
instance_ebsVolumes :: Lens' Instance (Maybe [EbsVolume])
instance_ebsVolumes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Instance' {Maybe [EbsVolume]
ebsVolumes :: Maybe [EbsVolume]
$sel:ebsVolumes:Instance' :: Instance -> Maybe [EbsVolume]
ebsVolumes} -> Maybe [EbsVolume]
ebsVolumes) (\s :: Instance
s@Instance' {} Maybe [EbsVolume]
a -> Instance
s {$sel:ebsVolumes:Instance' :: Maybe [EbsVolume]
ebsVolumes = Maybe [EbsVolume]
a} :: Instance) 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 unique identifier of the instance in Amazon EC2.
instance_ec2InstanceId :: Lens.Lens' Instance (Prelude.Maybe Prelude.Text)
instance_ec2InstanceId :: Lens' Instance (Maybe Text)
instance_ec2InstanceId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Instance' {Maybe Text
ec2InstanceId :: Maybe Text
$sel:ec2InstanceId:Instance' :: Instance -> Maybe Text
ec2InstanceId} -> Maybe Text
ec2InstanceId) (\s :: Instance
s@Instance' {} Maybe Text
a -> Instance
s {$sel:ec2InstanceId:Instance' :: Maybe Text
ec2InstanceId = Maybe Text
a} :: Instance)

-- | The unique identifier for the instance in Amazon EMR.
instance_id :: Lens.Lens' Instance (Prelude.Maybe Prelude.Text)
instance_id :: Lens' Instance (Maybe Text)
instance_id = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Instance' {Maybe Text
id :: Maybe Text
$sel:id:Instance' :: Instance -> Maybe Text
id} -> Maybe Text
id) (\s :: Instance
s@Instance' {} Maybe Text
a -> Instance
s {$sel:id:Instance' :: Maybe Text
id = Maybe Text
a} :: Instance)

-- | The unique identifier of the instance fleet to which an EC2 instance
-- belongs.
instance_instanceFleetId :: Lens.Lens' Instance (Prelude.Maybe Prelude.Text)
instance_instanceFleetId :: Lens' Instance (Maybe Text)
instance_instanceFleetId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Instance' {Maybe Text
instanceFleetId :: Maybe Text
$sel:instanceFleetId:Instance' :: Instance -> Maybe Text
instanceFleetId} -> Maybe Text
instanceFleetId) (\s :: Instance
s@Instance' {} Maybe Text
a -> Instance
s {$sel:instanceFleetId:Instance' :: Maybe Text
instanceFleetId = Maybe Text
a} :: Instance)

-- | The identifier of the instance group to which this instance belongs.
instance_instanceGroupId :: Lens.Lens' Instance (Prelude.Maybe Prelude.Text)
instance_instanceGroupId :: Lens' Instance (Maybe Text)
instance_instanceGroupId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Instance' {Maybe Text
instanceGroupId :: Maybe Text
$sel:instanceGroupId:Instance' :: Instance -> Maybe Text
instanceGroupId} -> Maybe Text
instanceGroupId) (\s :: Instance
s@Instance' {} Maybe Text
a -> Instance
s {$sel:instanceGroupId:Instance' :: Maybe Text
instanceGroupId = Maybe Text
a} :: Instance)

-- | The EC2 instance type, for example @m3.xlarge@.
instance_instanceType :: Lens.Lens' Instance (Prelude.Maybe Prelude.Text)
instance_instanceType :: Lens' Instance (Maybe Text)
instance_instanceType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Instance' {Maybe Text
instanceType :: Maybe Text
$sel:instanceType:Instance' :: Instance -> Maybe Text
instanceType} -> Maybe Text
instanceType) (\s :: Instance
s@Instance' {} Maybe Text
a -> Instance
s {$sel:instanceType:Instance' :: Maybe Text
instanceType = Maybe Text
a} :: Instance)

-- | The instance purchasing option. Valid values are @ON_DEMAND@ or @SPOT@.
instance_market :: Lens.Lens' Instance (Prelude.Maybe MarketType)
instance_market :: Lens' Instance (Maybe MarketType)
instance_market = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Instance' {Maybe MarketType
market :: Maybe MarketType
$sel:market:Instance' :: Instance -> Maybe MarketType
market} -> Maybe MarketType
market) (\s :: Instance
s@Instance' {} Maybe MarketType
a -> Instance
s {$sel:market:Instance' :: Maybe MarketType
market = Maybe MarketType
a} :: Instance)

-- | The private DNS name of the instance.
instance_privateDnsName :: Lens.Lens' Instance (Prelude.Maybe Prelude.Text)
instance_privateDnsName :: Lens' Instance (Maybe Text)
instance_privateDnsName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Instance' {Maybe Text
privateDnsName :: Maybe Text
$sel:privateDnsName:Instance' :: Instance -> Maybe Text
privateDnsName} -> Maybe Text
privateDnsName) (\s :: Instance
s@Instance' {} Maybe Text
a -> Instance
s {$sel:privateDnsName:Instance' :: Maybe Text
privateDnsName = Maybe Text
a} :: Instance)

-- | The private IP address of the instance.
instance_privateIpAddress :: Lens.Lens' Instance (Prelude.Maybe Prelude.Text)
instance_privateIpAddress :: Lens' Instance (Maybe Text)
instance_privateIpAddress = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Instance' {Maybe Text
privateIpAddress :: Maybe Text
$sel:privateIpAddress:Instance' :: Instance -> Maybe Text
privateIpAddress} -> Maybe Text
privateIpAddress) (\s :: Instance
s@Instance' {} Maybe Text
a -> Instance
s {$sel:privateIpAddress:Instance' :: Maybe Text
privateIpAddress = Maybe Text
a} :: Instance)

-- | The public DNS name of the instance.
instance_publicDnsName :: Lens.Lens' Instance (Prelude.Maybe Prelude.Text)
instance_publicDnsName :: Lens' Instance (Maybe Text)
instance_publicDnsName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Instance' {Maybe Text
publicDnsName :: Maybe Text
$sel:publicDnsName:Instance' :: Instance -> Maybe Text
publicDnsName} -> Maybe Text
publicDnsName) (\s :: Instance
s@Instance' {} Maybe Text
a -> Instance
s {$sel:publicDnsName:Instance' :: Maybe Text
publicDnsName = Maybe Text
a} :: Instance)

-- | The public IP address of the instance.
instance_publicIpAddress :: Lens.Lens' Instance (Prelude.Maybe Prelude.Text)
instance_publicIpAddress :: Lens' Instance (Maybe Text)
instance_publicIpAddress = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Instance' {Maybe Text
publicIpAddress :: Maybe Text
$sel:publicIpAddress:Instance' :: Instance -> Maybe Text
publicIpAddress} -> Maybe Text
publicIpAddress) (\s :: Instance
s@Instance' {} Maybe Text
a -> Instance
s {$sel:publicIpAddress:Instance' :: Maybe Text
publicIpAddress = Maybe Text
a} :: Instance)

-- | The current status of the instance.
instance_status :: Lens.Lens' Instance (Prelude.Maybe InstanceStatus)
instance_status :: Lens' Instance (Maybe InstanceStatus)
instance_status = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Instance' {Maybe InstanceStatus
status :: Maybe InstanceStatus
$sel:status:Instance' :: Instance -> Maybe InstanceStatus
status} -> Maybe InstanceStatus
status) (\s :: Instance
s@Instance' {} Maybe InstanceStatus
a -> Instance
s {$sel:status:Instance' :: Maybe InstanceStatus
status = Maybe InstanceStatus
a} :: Instance)

instance Data.FromJSON Instance where
  parseJSON :: Value -> Parser Instance
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"Instance"
      ( \Object
x ->
          Maybe [EbsVolume]
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe MarketType
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe InstanceStatus
-> Instance
Instance'
            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
"EbsVolumes" 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
"Ec2InstanceId")
            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
"Id")
            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
"InstanceFleetId")
            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
"InstanceGroupId")
            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
"InstanceType")
            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
"Market")
            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
"PrivateDnsName")
            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
"PrivateIpAddress")
            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
"PublicDnsName")
            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
"PublicIpAddress")
            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")
      )

instance Prelude.Hashable Instance where
  hashWithSalt :: Int -> Instance -> Int
hashWithSalt Int
_salt Instance' {Maybe [EbsVolume]
Maybe Text
Maybe InstanceStatus
Maybe MarketType
status :: Maybe InstanceStatus
publicIpAddress :: Maybe Text
publicDnsName :: Maybe Text
privateIpAddress :: Maybe Text
privateDnsName :: Maybe Text
market :: Maybe MarketType
instanceType :: Maybe Text
instanceGroupId :: Maybe Text
instanceFleetId :: Maybe Text
id :: Maybe Text
ec2InstanceId :: Maybe Text
ebsVolumes :: Maybe [EbsVolume]
$sel:status:Instance' :: Instance -> Maybe InstanceStatus
$sel:publicIpAddress:Instance' :: Instance -> Maybe Text
$sel:publicDnsName:Instance' :: Instance -> Maybe Text
$sel:privateIpAddress:Instance' :: Instance -> Maybe Text
$sel:privateDnsName:Instance' :: Instance -> Maybe Text
$sel:market:Instance' :: Instance -> Maybe MarketType
$sel:instanceType:Instance' :: Instance -> Maybe Text
$sel:instanceGroupId:Instance' :: Instance -> Maybe Text
$sel:instanceFleetId:Instance' :: Instance -> Maybe Text
$sel:id:Instance' :: Instance -> Maybe Text
$sel:ec2InstanceId:Instance' :: Instance -> Maybe Text
$sel:ebsVolumes:Instance' :: Instance -> Maybe [EbsVolume]
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [EbsVolume]
ebsVolumes
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
ec2InstanceId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
id
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
instanceFleetId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
instanceGroupId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
instanceType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe MarketType
market
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
privateDnsName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
privateIpAddress
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
publicDnsName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
publicIpAddress
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe InstanceStatus
status

instance Prelude.NFData Instance where
  rnf :: Instance -> ()
rnf Instance' {Maybe [EbsVolume]
Maybe Text
Maybe InstanceStatus
Maybe MarketType
status :: Maybe InstanceStatus
publicIpAddress :: Maybe Text
publicDnsName :: Maybe Text
privateIpAddress :: Maybe Text
privateDnsName :: Maybe Text
market :: Maybe MarketType
instanceType :: Maybe Text
instanceGroupId :: Maybe Text
instanceFleetId :: Maybe Text
id :: Maybe Text
ec2InstanceId :: Maybe Text
ebsVolumes :: Maybe [EbsVolume]
$sel:status:Instance' :: Instance -> Maybe InstanceStatus
$sel:publicIpAddress:Instance' :: Instance -> Maybe Text
$sel:publicDnsName:Instance' :: Instance -> Maybe Text
$sel:privateIpAddress:Instance' :: Instance -> Maybe Text
$sel:privateDnsName:Instance' :: Instance -> Maybe Text
$sel:market:Instance' :: Instance -> Maybe MarketType
$sel:instanceType:Instance' :: Instance -> Maybe Text
$sel:instanceGroupId:Instance' :: Instance -> Maybe Text
$sel:instanceFleetId:Instance' :: Instance -> Maybe Text
$sel:id:Instance' :: Instance -> Maybe Text
$sel:ec2InstanceId:Instance' :: Instance -> Maybe Text
$sel:ebsVolumes:Instance' :: Instance -> Maybe [EbsVolume]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [EbsVolume]
ebsVolumes
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
ec2InstanceId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
id
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
instanceFleetId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
instanceGroupId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
instanceType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe MarketType
market
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
privateDnsName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
privateIpAddress
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
publicDnsName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
publicIpAddress
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe InstanceStatus
status