{-# 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.GameLift.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.GameLift.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.GameLift.Types.EC2InstanceType
import Amazonka.GameLift.Types.InstanceStatus
import Amazonka.GameLift.Types.OperatingSystem
import qualified Amazonka.Prelude as Prelude

-- | Represents an EC2 instance of virtual computing resources that hosts one
-- or more game servers. In GameLift, a fleet can contain zero or more
-- instances.
--
-- __Related actions__
--
-- /See:/ 'newInstance' smart constructor.
data Instance = Instance'
  { -- | A time stamp indicating when this data object was created. Format is a
    -- number expressed in Unix time as milliseconds (for example
    -- @\"1469498468.057\"@).
    Instance -> Maybe POSIX
creationTime :: Prelude.Maybe Data.POSIX,
    -- | The DNS identifier assigned to the instance that is running the game
    -- session. Values have the following format:
    --
    -- -   TLS-enabled fleets:
    --     @\<unique identifier>.\<region identifier>.amazongamelift.com@.
    --
    -- -   Non-TLS-enabled fleets:
    --     @ec2-\<unique identifier>.compute.amazonaws.com@. (See
    --     <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/using-instance-addressing.html#concepts-public-addresses Amazon EC2 Instance IP Addressing>.)
    --
    -- When connecting to a game session that is running on a TLS-enabled
    -- fleet, you must use the DNS name, not the IP address.
    Instance -> Maybe Text
dnsName :: Prelude.Maybe Prelude.Text,
    -- | The Amazon Resource Name
    -- (<https://docs.aws.amazon.com/AmazonS3/latest/dev/s3-arn-format.html ARN>)
    -- that is assigned to a GameLift fleet resource and uniquely identifies
    -- it. ARNs are unique across all Regions. Format is
    -- @arn:aws:gamelift:\<region>::fleet\/fleet-a1234567-b8c9-0d1e-2fa3-b45c6d7e8912@.
    Instance -> Maybe Text
fleetArn :: Prelude.Maybe Prelude.Text,
    -- | A unique identifier for the fleet that the instance is in.
    Instance -> Maybe Text
fleetId :: Prelude.Maybe Prelude.Text,
    -- | A unique identifier for the instance.
    Instance -> Maybe Text
instanceId :: Prelude.Maybe Prelude.Text,
    -- | IP address that is assigned to the instance.
    Instance -> Maybe Text
ipAddress :: Prelude.Maybe Prelude.Text,
    -- | The fleet location of the instance, expressed as an Amazon Web Services
    -- Region code, such as @us-west-2@.
    Instance -> Maybe Text
location :: Prelude.Maybe Prelude.Text,
    -- | Operating system that is running on this instance.
    Instance -> Maybe OperatingSystem
operatingSystem :: Prelude.Maybe OperatingSystem,
    -- | Current status of the instance. Possible statuses include the following:
    --
    -- -   __PENDING__ -- The instance is in the process of being created and
    --     launching server processes as defined in the fleet\'s run-time
    --     configuration.
    --
    -- -   __ACTIVE__ -- The instance has been successfully created and at
    --     least one server process has successfully launched and reported back
    --     to GameLift that it is ready to host a game session. The instance is
    --     now considered ready to host game sessions.
    --
    -- -   __TERMINATING__ -- The instance is in the process of shutting down.
    --     This may happen to reduce capacity during a scaling down event or to
    --     recycle resources in the event of a problem.
    Instance -> Maybe InstanceStatus
status :: Prelude.Maybe InstanceStatus,
    -- | Amazon EC2 instance type that defines the computing resources of this
    -- instance.
    Instance -> Maybe EC2InstanceType
type' :: Prelude.Maybe EC2InstanceType
  }
  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:
--
-- 'creationTime', 'instance_creationTime' - A time stamp indicating when this data object was created. Format is a
-- number expressed in Unix time as milliseconds (for example
-- @\"1469498468.057\"@).
--
-- 'dnsName', 'instance_dnsName' - The DNS identifier assigned to the instance that is running the game
-- session. Values have the following format:
--
-- -   TLS-enabled fleets:
--     @\<unique identifier>.\<region identifier>.amazongamelift.com@.
--
-- -   Non-TLS-enabled fleets:
--     @ec2-\<unique identifier>.compute.amazonaws.com@. (See
--     <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/using-instance-addressing.html#concepts-public-addresses Amazon EC2 Instance IP Addressing>.)
--
-- When connecting to a game session that is running on a TLS-enabled
-- fleet, you must use the DNS name, not the IP address.
--
-- 'fleetArn', 'instance_fleetArn' - The Amazon Resource Name
-- (<https://docs.aws.amazon.com/AmazonS3/latest/dev/s3-arn-format.html ARN>)
-- that is assigned to a GameLift fleet resource and uniquely identifies
-- it. ARNs are unique across all Regions. Format is
-- @arn:aws:gamelift:\<region>::fleet\/fleet-a1234567-b8c9-0d1e-2fa3-b45c6d7e8912@.
--
-- 'fleetId', 'instance_fleetId' - A unique identifier for the fleet that the instance is in.
--
-- 'instanceId', 'instance_instanceId' - A unique identifier for the instance.
--
-- 'ipAddress', 'instance_ipAddress' - IP address that is assigned to the instance.
--
-- 'location', 'instance_location' - The fleet location of the instance, expressed as an Amazon Web Services
-- Region code, such as @us-west-2@.
--
-- 'operatingSystem', 'instance_operatingSystem' - Operating system that is running on this instance.
--
-- 'status', 'instance_status' - Current status of the instance. Possible statuses include the following:
--
-- -   __PENDING__ -- The instance is in the process of being created and
--     launching server processes as defined in the fleet\'s run-time
--     configuration.
--
-- -   __ACTIVE__ -- The instance has been successfully created and at
--     least one server process has successfully launched and reported back
--     to GameLift that it is ready to host a game session. The instance is
--     now considered ready to host game sessions.
--
-- -   __TERMINATING__ -- The instance is in the process of shutting down.
--     This may happen to reduce capacity during a scaling down event or to
--     recycle resources in the event of a problem.
--
-- 'type'', 'instance_type' - Amazon EC2 instance type that defines the computing resources of this
-- instance.
newInstance ::
  Instance
newInstance :: Instance
newInstance =
  Instance'
    { $sel:creationTime:Instance' :: Maybe POSIX
creationTime = forall a. Maybe a
Prelude.Nothing,
      $sel:dnsName:Instance' :: Maybe Text
dnsName = forall a. Maybe a
Prelude.Nothing,
      $sel:fleetArn:Instance' :: Maybe Text
fleetArn = forall a. Maybe a
Prelude.Nothing,
      $sel:fleetId:Instance' :: Maybe Text
fleetId = forall a. Maybe a
Prelude.Nothing,
      $sel:instanceId:Instance' :: Maybe Text
instanceId = forall a. Maybe a
Prelude.Nothing,
      $sel:ipAddress:Instance' :: Maybe Text
ipAddress = forall a. Maybe a
Prelude.Nothing,
      $sel:location:Instance' :: Maybe Text
location = forall a. Maybe a
Prelude.Nothing,
      $sel:operatingSystem:Instance' :: Maybe OperatingSystem
operatingSystem = forall a. Maybe a
Prelude.Nothing,
      $sel:status:Instance' :: Maybe InstanceStatus
status = forall a. Maybe a
Prelude.Nothing,
      $sel:type':Instance' :: Maybe EC2InstanceType
type' = forall a. Maybe a
Prelude.Nothing
    }

-- | A time stamp indicating when this data object was created. Format is a
-- number expressed in Unix time as milliseconds (for example
-- @\"1469498468.057\"@).
instance_creationTime :: Lens.Lens' Instance (Prelude.Maybe Prelude.UTCTime)
instance_creationTime :: Lens' Instance (Maybe UTCTime)
instance_creationTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Instance' {Maybe POSIX
creationTime :: Maybe POSIX
$sel:creationTime:Instance' :: Instance -> Maybe POSIX
creationTime} -> Maybe POSIX
creationTime) (\s :: Instance
s@Instance' {} Maybe POSIX
a -> Instance
s {$sel:creationTime:Instance' :: Maybe POSIX
creationTime = Maybe POSIX
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 (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The DNS identifier assigned to the instance that is running the game
-- session. Values have the following format:
--
-- -   TLS-enabled fleets:
--     @\<unique identifier>.\<region identifier>.amazongamelift.com@.
--
-- -   Non-TLS-enabled fleets:
--     @ec2-\<unique identifier>.compute.amazonaws.com@. (See
--     <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/using-instance-addressing.html#concepts-public-addresses Amazon EC2 Instance IP Addressing>.)
--
-- When connecting to a game session that is running on a TLS-enabled
-- fleet, you must use the DNS name, not the IP address.
instance_dnsName :: Lens.Lens' Instance (Prelude.Maybe Prelude.Text)
instance_dnsName :: Lens' Instance (Maybe Text)
instance_dnsName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Instance' {Maybe Text
dnsName :: Maybe Text
$sel:dnsName:Instance' :: Instance -> Maybe Text
dnsName} -> Maybe Text
dnsName) (\s :: Instance
s@Instance' {} Maybe Text
a -> Instance
s {$sel:dnsName:Instance' :: Maybe Text
dnsName = Maybe Text
a} :: Instance)

-- | The Amazon Resource Name
-- (<https://docs.aws.amazon.com/AmazonS3/latest/dev/s3-arn-format.html ARN>)
-- that is assigned to a GameLift fleet resource and uniquely identifies
-- it. ARNs are unique across all Regions. Format is
-- @arn:aws:gamelift:\<region>::fleet\/fleet-a1234567-b8c9-0d1e-2fa3-b45c6d7e8912@.
instance_fleetArn :: Lens.Lens' Instance (Prelude.Maybe Prelude.Text)
instance_fleetArn :: Lens' Instance (Maybe Text)
instance_fleetArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Instance' {Maybe Text
fleetArn :: Maybe Text
$sel:fleetArn:Instance' :: Instance -> Maybe Text
fleetArn} -> Maybe Text
fleetArn) (\s :: Instance
s@Instance' {} Maybe Text
a -> Instance
s {$sel:fleetArn:Instance' :: Maybe Text
fleetArn = Maybe Text
a} :: Instance)

-- | A unique identifier for the fleet that the instance is in.
instance_fleetId :: Lens.Lens' Instance (Prelude.Maybe Prelude.Text)
instance_fleetId :: Lens' Instance (Maybe Text)
instance_fleetId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Instance' {Maybe Text
fleetId :: Maybe Text
$sel:fleetId:Instance' :: Instance -> Maybe Text
fleetId} -> Maybe Text
fleetId) (\s :: Instance
s@Instance' {} Maybe Text
a -> Instance
s {$sel:fleetId:Instance' :: Maybe Text
fleetId = Maybe Text
a} :: Instance)

-- | A unique identifier for the instance.
instance_instanceId :: Lens.Lens' Instance (Prelude.Maybe Prelude.Text)
instance_instanceId :: Lens' Instance (Maybe Text)
instance_instanceId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Instance' {Maybe Text
instanceId :: Maybe Text
$sel:instanceId:Instance' :: Instance -> Maybe Text
instanceId} -> Maybe Text
instanceId) (\s :: Instance
s@Instance' {} Maybe Text
a -> Instance
s {$sel:instanceId:Instance' :: Maybe Text
instanceId = Maybe Text
a} :: Instance)

-- | IP address that is assigned to the instance.
instance_ipAddress :: Lens.Lens' Instance (Prelude.Maybe Prelude.Text)
instance_ipAddress :: Lens' Instance (Maybe Text)
instance_ipAddress = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Instance' {Maybe Text
ipAddress :: Maybe Text
$sel:ipAddress:Instance' :: Instance -> Maybe Text
ipAddress} -> Maybe Text
ipAddress) (\s :: Instance
s@Instance' {} Maybe Text
a -> Instance
s {$sel:ipAddress:Instance' :: Maybe Text
ipAddress = Maybe Text
a} :: Instance)

-- | The fleet location of the instance, expressed as an Amazon Web Services
-- Region code, such as @us-west-2@.
instance_location :: Lens.Lens' Instance (Prelude.Maybe Prelude.Text)
instance_location :: Lens' Instance (Maybe Text)
instance_location = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Instance' {Maybe Text
location :: Maybe Text
$sel:location:Instance' :: Instance -> Maybe Text
location} -> Maybe Text
location) (\s :: Instance
s@Instance' {} Maybe Text
a -> Instance
s {$sel:location:Instance' :: Maybe Text
location = Maybe Text
a} :: Instance)

-- | Operating system that is running on this instance.
instance_operatingSystem :: Lens.Lens' Instance (Prelude.Maybe OperatingSystem)
instance_operatingSystem :: Lens' Instance (Maybe OperatingSystem)
instance_operatingSystem = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Instance' {Maybe OperatingSystem
operatingSystem :: Maybe OperatingSystem
$sel:operatingSystem:Instance' :: Instance -> Maybe OperatingSystem
operatingSystem} -> Maybe OperatingSystem
operatingSystem) (\s :: Instance
s@Instance' {} Maybe OperatingSystem
a -> Instance
s {$sel:operatingSystem:Instance' :: Maybe OperatingSystem
operatingSystem = Maybe OperatingSystem
a} :: Instance)

-- | Current status of the instance. Possible statuses include the following:
--
-- -   __PENDING__ -- The instance is in the process of being created and
--     launching server processes as defined in the fleet\'s run-time
--     configuration.
--
-- -   __ACTIVE__ -- The instance has been successfully created and at
--     least one server process has successfully launched and reported back
--     to GameLift that it is ready to host a game session. The instance is
--     now considered ready to host game sessions.
--
-- -   __TERMINATING__ -- The instance is in the process of shutting down.
--     This may happen to reduce capacity during a scaling down event or to
--     recycle resources in the event of a problem.
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)

-- | Amazon EC2 instance type that defines the computing resources of this
-- instance.
instance_type :: Lens.Lens' Instance (Prelude.Maybe EC2InstanceType)
instance_type :: Lens' Instance (Maybe EC2InstanceType)
instance_type = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Instance' {Maybe EC2InstanceType
type' :: Maybe EC2InstanceType
$sel:type':Instance' :: Instance -> Maybe EC2InstanceType
type'} -> Maybe EC2InstanceType
type') (\s :: Instance
s@Instance' {} Maybe EC2InstanceType
a -> Instance
s {$sel:type':Instance' :: Maybe EC2InstanceType
type' = Maybe EC2InstanceType
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 POSIX
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe OperatingSystem
-> Maybe InstanceStatus
-> Maybe EC2InstanceType
-> 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
"CreationTime")
            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
"DnsName")
            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
"FleetArn")
            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
"FleetId")
            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
"InstanceId")
            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
"IpAddress")
            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
"OperatingSystem")
            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
"Type")
      )

instance Prelude.Hashable Instance where
  hashWithSalt :: Int -> Instance -> Int
hashWithSalt Int
_salt Instance' {Maybe Text
Maybe POSIX
Maybe EC2InstanceType
Maybe InstanceStatus
Maybe OperatingSystem
type' :: Maybe EC2InstanceType
status :: Maybe InstanceStatus
operatingSystem :: Maybe OperatingSystem
location :: Maybe Text
ipAddress :: Maybe Text
instanceId :: Maybe Text
fleetId :: Maybe Text
fleetArn :: Maybe Text
dnsName :: Maybe Text
creationTime :: Maybe POSIX
$sel:type':Instance' :: Instance -> Maybe EC2InstanceType
$sel:status:Instance' :: Instance -> Maybe InstanceStatus
$sel:operatingSystem:Instance' :: Instance -> Maybe OperatingSystem
$sel:location:Instance' :: Instance -> Maybe Text
$sel:ipAddress:Instance' :: Instance -> Maybe Text
$sel:instanceId:Instance' :: Instance -> Maybe Text
$sel:fleetId:Instance' :: Instance -> Maybe Text
$sel:fleetArn:Instance' :: Instance -> Maybe Text
$sel:dnsName:Instance' :: Instance -> Maybe Text
$sel:creationTime:Instance' :: Instance -> Maybe POSIX
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe POSIX
creationTime
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
dnsName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
fleetArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
fleetId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
instanceId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
ipAddress
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
location
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe OperatingSystem
operatingSystem
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe InstanceStatus
status
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe EC2InstanceType
type'

instance Prelude.NFData Instance where
  rnf :: Instance -> ()
rnf Instance' {Maybe Text
Maybe POSIX
Maybe EC2InstanceType
Maybe InstanceStatus
Maybe OperatingSystem
type' :: Maybe EC2InstanceType
status :: Maybe InstanceStatus
operatingSystem :: Maybe OperatingSystem
location :: Maybe Text
ipAddress :: Maybe Text
instanceId :: Maybe Text
fleetId :: Maybe Text
fleetArn :: Maybe Text
dnsName :: Maybe Text
creationTime :: Maybe POSIX
$sel:type':Instance' :: Instance -> Maybe EC2InstanceType
$sel:status:Instance' :: Instance -> Maybe InstanceStatus
$sel:operatingSystem:Instance' :: Instance -> Maybe OperatingSystem
$sel:location:Instance' :: Instance -> Maybe Text
$sel:ipAddress:Instance' :: Instance -> Maybe Text
$sel:instanceId:Instance' :: Instance -> Maybe Text
$sel:fleetId:Instance' :: Instance -> Maybe Text
$sel:fleetArn:Instance' :: Instance -> Maybe Text
$sel:dnsName:Instance' :: Instance -> Maybe Text
$sel:creationTime:Instance' :: Instance -> Maybe POSIX
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
creationTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
dnsName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
fleetArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
fleetId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
instanceId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
ipAddress
      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 OperatingSystem
operatingSystem
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe InstanceStatus
status
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe EC2InstanceType
type'