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

-- | Resources used to host your game servers. A compute resource can be
-- managed GameLift Amazon EC2 instances or your own resources.
--
-- /See:/ 'newCompute' smart constructor.
data Compute = Compute'
  { -- | The ARN that is assigned to the compute resource and uniquely identifies
    -- it. ARNs are unique across locations.
    Compute -> Maybe Text
computeArn :: Prelude.Maybe Prelude.Text,
    -- | A descriptive label that is associated with the compute resource
    -- registered to your fleet.
    Compute -> Maybe Text
computeName :: Prelude.Maybe Prelude.Text,
    -- | Current status of the compute. A compute must have an @ACTIVE@ status to
    -- host game sessions.
    Compute -> Maybe ComputeStatus
computeStatus :: Prelude.Maybe ComputeStatus,
    -- | A time stamp indicating when this data object was created. Format is a
    -- number expressed in Unix time as milliseconds (for example
    -- @\"1469498468.057\"@).
    Compute -> Maybe POSIX
creationTime :: Prelude.Maybe Data.POSIX,
    -- | The DNS name of the compute resource. GameLift requires the DNS name or
    -- IP address to manage your compute resource.
    Compute -> Maybe Text
dnsName :: Prelude.Maybe Prelude.Text,
    -- | The Amazon Resource Name (ARN) of the fleet that the compute is
    -- registered to.
    Compute -> Maybe Text
fleetArn :: Prelude.Maybe Prelude.Text,
    -- | A unique identifier for the fleet that the compute is registered to.
    Compute -> Maybe Text
fleetId :: Prelude.Maybe Prelude.Text,
    -- | The endpoint connection details of the GameLift SDK endpoint that your
    -- game server connects to.
    Compute -> Maybe Text
gameLiftServiceSdkEndpoint :: Prelude.Maybe Prelude.Text,
    -- | The IP address of the compute resource. GameLift requires the DNS name
    -- or IP address to manage your compute resource.
    Compute -> Maybe Text
ipAddress :: Prelude.Maybe Prelude.Text,
    -- | The name of the custom location you added to the fleet that this compute
    -- resource resides in.
    Compute -> Maybe Text
location :: Prelude.Maybe Prelude.Text,
    -- | The type of operating system on your compute resource.
    Compute -> Maybe OperatingSystem
operatingSystem :: Prelude.Maybe OperatingSystem,
    -- | Which compute type that the fleet uses. A fleet can use Anywhere compute
    -- resources owned by you or managed Amazon EC2 instances.
    Compute -> Maybe EC2InstanceType
type' :: Prelude.Maybe EC2InstanceType
  }
  deriving (Compute -> Compute -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Compute -> Compute -> Bool
$c/= :: Compute -> Compute -> Bool
== :: Compute -> Compute -> Bool
$c== :: Compute -> Compute -> Bool
Prelude.Eq, ReadPrec [Compute]
ReadPrec Compute
Int -> ReadS Compute
ReadS [Compute]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Compute]
$creadListPrec :: ReadPrec [Compute]
readPrec :: ReadPrec Compute
$creadPrec :: ReadPrec Compute
readList :: ReadS [Compute]
$creadList :: ReadS [Compute]
readsPrec :: Int -> ReadS Compute
$creadsPrec :: Int -> ReadS Compute
Prelude.Read, Int -> Compute -> ShowS
[Compute] -> ShowS
Compute -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Compute] -> ShowS
$cshowList :: [Compute] -> ShowS
show :: Compute -> String
$cshow :: Compute -> String
showsPrec :: Int -> Compute -> ShowS
$cshowsPrec :: Int -> Compute -> ShowS
Prelude.Show, forall x. Rep Compute x -> Compute
forall x. Compute -> Rep Compute x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Compute x -> Compute
$cfrom :: forall x. Compute -> Rep Compute x
Prelude.Generic)

-- |
-- Create a value of 'Compute' 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:
--
-- 'computeArn', 'compute_computeArn' - The ARN that is assigned to the compute resource and uniquely identifies
-- it. ARNs are unique across locations.
--
-- 'computeName', 'compute_computeName' - A descriptive label that is associated with the compute resource
-- registered to your fleet.
--
-- 'computeStatus', 'compute_computeStatus' - Current status of the compute. A compute must have an @ACTIVE@ status to
-- host game sessions.
--
-- 'creationTime', 'compute_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', 'compute_dnsName' - The DNS name of the compute resource. GameLift requires the DNS name or
-- IP address to manage your compute resource.
--
-- 'fleetArn', 'compute_fleetArn' - The Amazon Resource Name (ARN) of the fleet that the compute is
-- registered to.
--
-- 'fleetId', 'compute_fleetId' - A unique identifier for the fleet that the compute is registered to.
--
-- 'gameLiftServiceSdkEndpoint', 'compute_gameLiftServiceSdkEndpoint' - The endpoint connection details of the GameLift SDK endpoint that your
-- game server connects to.
--
-- 'ipAddress', 'compute_ipAddress' - The IP address of the compute resource. GameLift requires the DNS name
-- or IP address to manage your compute resource.
--
-- 'location', 'compute_location' - The name of the custom location you added to the fleet that this compute
-- resource resides in.
--
-- 'operatingSystem', 'compute_operatingSystem' - The type of operating system on your compute resource.
--
-- 'type'', 'compute_type' - Which compute type that the fleet uses. A fleet can use Anywhere compute
-- resources owned by you or managed Amazon EC2 instances.
newCompute ::
  Compute
newCompute :: Compute
newCompute =
  Compute'
    { $sel:computeArn:Compute' :: Maybe Text
computeArn = forall a. Maybe a
Prelude.Nothing,
      $sel:computeName:Compute' :: Maybe Text
computeName = forall a. Maybe a
Prelude.Nothing,
      $sel:computeStatus:Compute' :: Maybe ComputeStatus
computeStatus = forall a. Maybe a
Prelude.Nothing,
      $sel:creationTime:Compute' :: Maybe POSIX
creationTime = forall a. Maybe a
Prelude.Nothing,
      $sel:dnsName:Compute' :: Maybe Text
dnsName = forall a. Maybe a
Prelude.Nothing,
      $sel:fleetArn:Compute' :: Maybe Text
fleetArn = forall a. Maybe a
Prelude.Nothing,
      $sel:fleetId:Compute' :: Maybe Text
fleetId = forall a. Maybe a
Prelude.Nothing,
      $sel:gameLiftServiceSdkEndpoint:Compute' :: Maybe Text
gameLiftServiceSdkEndpoint = forall a. Maybe a
Prelude.Nothing,
      $sel:ipAddress:Compute' :: Maybe Text
ipAddress = forall a. Maybe a
Prelude.Nothing,
      $sel:location:Compute' :: Maybe Text
location = forall a. Maybe a
Prelude.Nothing,
      $sel:operatingSystem:Compute' :: Maybe OperatingSystem
operatingSystem = forall a. Maybe a
Prelude.Nothing,
      $sel:type':Compute' :: Maybe EC2InstanceType
type' = forall a. Maybe a
Prelude.Nothing
    }

-- | The ARN that is assigned to the compute resource and uniquely identifies
-- it. ARNs are unique across locations.
compute_computeArn :: Lens.Lens' Compute (Prelude.Maybe Prelude.Text)
compute_computeArn :: Lens' Compute (Maybe Text)
compute_computeArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Compute' {Maybe Text
computeArn :: Maybe Text
$sel:computeArn:Compute' :: Compute -> Maybe Text
computeArn} -> Maybe Text
computeArn) (\s :: Compute
s@Compute' {} Maybe Text
a -> Compute
s {$sel:computeArn:Compute' :: Maybe Text
computeArn = Maybe Text
a} :: Compute)

-- | A descriptive label that is associated with the compute resource
-- registered to your fleet.
compute_computeName :: Lens.Lens' Compute (Prelude.Maybe Prelude.Text)
compute_computeName :: Lens' Compute (Maybe Text)
compute_computeName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Compute' {Maybe Text
computeName :: Maybe Text
$sel:computeName:Compute' :: Compute -> Maybe Text
computeName} -> Maybe Text
computeName) (\s :: Compute
s@Compute' {} Maybe Text
a -> Compute
s {$sel:computeName:Compute' :: Maybe Text
computeName = Maybe Text
a} :: Compute)

-- | Current status of the compute. A compute must have an @ACTIVE@ status to
-- host game sessions.
compute_computeStatus :: Lens.Lens' Compute (Prelude.Maybe ComputeStatus)
compute_computeStatus :: Lens' Compute (Maybe ComputeStatus)
compute_computeStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Compute' {Maybe ComputeStatus
computeStatus :: Maybe ComputeStatus
$sel:computeStatus:Compute' :: Compute -> Maybe ComputeStatus
computeStatus} -> Maybe ComputeStatus
computeStatus) (\s :: Compute
s@Compute' {} Maybe ComputeStatus
a -> Compute
s {$sel:computeStatus:Compute' :: Maybe ComputeStatus
computeStatus = Maybe ComputeStatus
a} :: Compute)

-- | A time stamp indicating when this data object was created. Format is a
-- number expressed in Unix time as milliseconds (for example
-- @\"1469498468.057\"@).
compute_creationTime :: Lens.Lens' Compute (Prelude.Maybe Prelude.UTCTime)
compute_creationTime :: Lens' Compute (Maybe UTCTime)
compute_creationTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Compute' {Maybe POSIX
creationTime :: Maybe POSIX
$sel:creationTime:Compute' :: Compute -> Maybe POSIX
creationTime} -> Maybe POSIX
creationTime) (\s :: Compute
s@Compute' {} Maybe POSIX
a -> Compute
s {$sel:creationTime:Compute' :: Maybe POSIX
creationTime = Maybe POSIX
a} :: Compute) 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 name of the compute resource. GameLift requires the DNS name or
-- IP address to manage your compute resource.
compute_dnsName :: Lens.Lens' Compute (Prelude.Maybe Prelude.Text)
compute_dnsName :: Lens' Compute (Maybe Text)
compute_dnsName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Compute' {Maybe Text
dnsName :: Maybe Text
$sel:dnsName:Compute' :: Compute -> Maybe Text
dnsName} -> Maybe Text
dnsName) (\s :: Compute
s@Compute' {} Maybe Text
a -> Compute
s {$sel:dnsName:Compute' :: Maybe Text
dnsName = Maybe Text
a} :: Compute)

-- | The Amazon Resource Name (ARN) of the fleet that the compute is
-- registered to.
compute_fleetArn :: Lens.Lens' Compute (Prelude.Maybe Prelude.Text)
compute_fleetArn :: Lens' Compute (Maybe Text)
compute_fleetArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Compute' {Maybe Text
fleetArn :: Maybe Text
$sel:fleetArn:Compute' :: Compute -> Maybe Text
fleetArn} -> Maybe Text
fleetArn) (\s :: Compute
s@Compute' {} Maybe Text
a -> Compute
s {$sel:fleetArn:Compute' :: Maybe Text
fleetArn = Maybe Text
a} :: Compute)

-- | A unique identifier for the fleet that the compute is registered to.
compute_fleetId :: Lens.Lens' Compute (Prelude.Maybe Prelude.Text)
compute_fleetId :: Lens' Compute (Maybe Text)
compute_fleetId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Compute' {Maybe Text
fleetId :: Maybe Text
$sel:fleetId:Compute' :: Compute -> Maybe Text
fleetId} -> Maybe Text
fleetId) (\s :: Compute
s@Compute' {} Maybe Text
a -> Compute
s {$sel:fleetId:Compute' :: Maybe Text
fleetId = Maybe Text
a} :: Compute)

-- | The endpoint connection details of the GameLift SDK endpoint that your
-- game server connects to.
compute_gameLiftServiceSdkEndpoint :: Lens.Lens' Compute (Prelude.Maybe Prelude.Text)
compute_gameLiftServiceSdkEndpoint :: Lens' Compute (Maybe Text)
compute_gameLiftServiceSdkEndpoint = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Compute' {Maybe Text
gameLiftServiceSdkEndpoint :: Maybe Text
$sel:gameLiftServiceSdkEndpoint:Compute' :: Compute -> Maybe Text
gameLiftServiceSdkEndpoint} -> Maybe Text
gameLiftServiceSdkEndpoint) (\s :: Compute
s@Compute' {} Maybe Text
a -> Compute
s {$sel:gameLiftServiceSdkEndpoint:Compute' :: Maybe Text
gameLiftServiceSdkEndpoint = Maybe Text
a} :: Compute)

-- | The IP address of the compute resource. GameLift requires the DNS name
-- or IP address to manage your compute resource.
compute_ipAddress :: Lens.Lens' Compute (Prelude.Maybe Prelude.Text)
compute_ipAddress :: Lens' Compute (Maybe Text)
compute_ipAddress = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Compute' {Maybe Text
ipAddress :: Maybe Text
$sel:ipAddress:Compute' :: Compute -> Maybe Text
ipAddress} -> Maybe Text
ipAddress) (\s :: Compute
s@Compute' {} Maybe Text
a -> Compute
s {$sel:ipAddress:Compute' :: Maybe Text
ipAddress = Maybe Text
a} :: Compute)

-- | The name of the custom location you added to the fleet that this compute
-- resource resides in.
compute_location :: Lens.Lens' Compute (Prelude.Maybe Prelude.Text)
compute_location :: Lens' Compute (Maybe Text)
compute_location = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Compute' {Maybe Text
location :: Maybe Text
$sel:location:Compute' :: Compute -> Maybe Text
location} -> Maybe Text
location) (\s :: Compute
s@Compute' {} Maybe Text
a -> Compute
s {$sel:location:Compute' :: Maybe Text
location = Maybe Text
a} :: Compute)

-- | The type of operating system on your compute resource.
compute_operatingSystem :: Lens.Lens' Compute (Prelude.Maybe OperatingSystem)
compute_operatingSystem :: Lens' Compute (Maybe OperatingSystem)
compute_operatingSystem = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Compute' {Maybe OperatingSystem
operatingSystem :: Maybe OperatingSystem
$sel:operatingSystem:Compute' :: Compute -> Maybe OperatingSystem
operatingSystem} -> Maybe OperatingSystem
operatingSystem) (\s :: Compute
s@Compute' {} Maybe OperatingSystem
a -> Compute
s {$sel:operatingSystem:Compute' :: Maybe OperatingSystem
operatingSystem = Maybe OperatingSystem
a} :: Compute)

-- | Which compute type that the fleet uses. A fleet can use Anywhere compute
-- resources owned by you or managed Amazon EC2 instances.
compute_type :: Lens.Lens' Compute (Prelude.Maybe EC2InstanceType)
compute_type :: Lens' Compute (Maybe EC2InstanceType)
compute_type = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Compute' {Maybe EC2InstanceType
type' :: Maybe EC2InstanceType
$sel:type':Compute' :: Compute -> Maybe EC2InstanceType
type'} -> Maybe EC2InstanceType
type') (\s :: Compute
s@Compute' {} Maybe EC2InstanceType
a -> Compute
s {$sel:type':Compute' :: Maybe EC2InstanceType
type' = Maybe EC2InstanceType
a} :: Compute)

instance Data.FromJSON Compute where
  parseJSON :: Value -> Parser Compute
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"Compute"
      ( \Object
x ->
          Maybe Text
-> Maybe Text
-> Maybe ComputeStatus
-> Maybe POSIX
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe OperatingSystem
-> Maybe EC2InstanceType
-> Compute
Compute'
            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
"ComputeArn")
            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
"ComputeName")
            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
"ComputeStatus")
            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
"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
"GameLiftServiceSdkEndpoint")
            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
"Type")
      )

instance Prelude.Hashable Compute where
  hashWithSalt :: Int -> Compute -> Int
hashWithSalt Int
_salt Compute' {Maybe Text
Maybe POSIX
Maybe ComputeStatus
Maybe EC2InstanceType
Maybe OperatingSystem
type' :: Maybe EC2InstanceType
operatingSystem :: Maybe OperatingSystem
location :: Maybe Text
ipAddress :: Maybe Text
gameLiftServiceSdkEndpoint :: Maybe Text
fleetId :: Maybe Text
fleetArn :: Maybe Text
dnsName :: Maybe Text
creationTime :: Maybe POSIX
computeStatus :: Maybe ComputeStatus
computeName :: Maybe Text
computeArn :: Maybe Text
$sel:type':Compute' :: Compute -> Maybe EC2InstanceType
$sel:operatingSystem:Compute' :: Compute -> Maybe OperatingSystem
$sel:location:Compute' :: Compute -> Maybe Text
$sel:ipAddress:Compute' :: Compute -> Maybe Text
$sel:gameLiftServiceSdkEndpoint:Compute' :: Compute -> Maybe Text
$sel:fleetId:Compute' :: Compute -> Maybe Text
$sel:fleetArn:Compute' :: Compute -> Maybe Text
$sel:dnsName:Compute' :: Compute -> Maybe Text
$sel:creationTime:Compute' :: Compute -> Maybe POSIX
$sel:computeStatus:Compute' :: Compute -> Maybe ComputeStatus
$sel:computeName:Compute' :: Compute -> Maybe Text
$sel:computeArn:Compute' :: Compute -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
computeArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
computeName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ComputeStatus
computeStatus
      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
gameLiftServiceSdkEndpoint
      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 EC2InstanceType
type'

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