{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -fno-warn-unused-binds #-}
{-# 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.ListCompute
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Retrieves all compute resources registered to a fleet in your Amazon Web
-- Services account. You can filter the result set by location.
--
-- This operation returns paginated results.
module Amazonka.GameLift.ListCompute
  ( -- * Creating a Request
    ListCompute (..),
    newListCompute,

    -- * Request Lenses
    listCompute_limit,
    listCompute_location,
    listCompute_nextToken,
    listCompute_fleetId,

    -- * Destructuring the Response
    ListComputeResponse (..),
    newListComputeResponse,

    -- * Response Lenses
    listComputeResponse_computeList,
    listComputeResponse_nextToken,
    listComputeResponse_httpStatus,
  )
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
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newListCompute' smart constructor.
data ListCompute = ListCompute'
  { -- | The maximum number of results to return. Use this parameter with
    -- @NextToken@ to get results as a set of sequential pages.
    ListCompute -> Maybe Natural
limit :: Prelude.Maybe Prelude.Natural,
    -- | The name of the custom location that the compute resources are assigned
    -- to.
    ListCompute -> Maybe Text
location :: Prelude.Maybe Prelude.Text,
    -- | A token that indicates the start of the next sequential page of results.
    -- Use the token that is returned with a previous call to this operation.
    -- To start at the beginning of the result set, do not specify a value.
    ListCompute -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | A unique identifier for the fleet the compute resources are registered
    -- to.
    ListCompute -> Text
fleetId :: Prelude.Text
  }
  deriving (ListCompute -> ListCompute -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListCompute -> ListCompute -> Bool
$c/= :: ListCompute -> ListCompute -> Bool
== :: ListCompute -> ListCompute -> Bool
$c== :: ListCompute -> ListCompute -> Bool
Prelude.Eq, ReadPrec [ListCompute]
ReadPrec ListCompute
Int -> ReadS ListCompute
ReadS [ListCompute]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListCompute]
$creadListPrec :: ReadPrec [ListCompute]
readPrec :: ReadPrec ListCompute
$creadPrec :: ReadPrec ListCompute
readList :: ReadS [ListCompute]
$creadList :: ReadS [ListCompute]
readsPrec :: Int -> ReadS ListCompute
$creadsPrec :: Int -> ReadS ListCompute
Prelude.Read, Int -> ListCompute -> ShowS
[ListCompute] -> ShowS
ListCompute -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListCompute] -> ShowS
$cshowList :: [ListCompute] -> ShowS
show :: ListCompute -> String
$cshow :: ListCompute -> String
showsPrec :: Int -> ListCompute -> ShowS
$cshowsPrec :: Int -> ListCompute -> ShowS
Prelude.Show, forall x. Rep ListCompute x -> ListCompute
forall x. ListCompute -> Rep ListCompute x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListCompute x -> ListCompute
$cfrom :: forall x. ListCompute -> Rep ListCompute x
Prelude.Generic)

-- |
-- Create a value of 'ListCompute' 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:
--
-- 'limit', 'listCompute_limit' - The maximum number of results to return. Use this parameter with
-- @NextToken@ to get results as a set of sequential pages.
--
-- 'location', 'listCompute_location' - The name of the custom location that the compute resources are assigned
-- to.
--
-- 'nextToken', 'listCompute_nextToken' - A token that indicates the start of the next sequential page of results.
-- Use the token that is returned with a previous call to this operation.
-- To start at the beginning of the result set, do not specify a value.
--
-- 'fleetId', 'listCompute_fleetId' - A unique identifier for the fleet the compute resources are registered
-- to.
newListCompute ::
  -- | 'fleetId'
  Prelude.Text ->
  ListCompute
newListCompute :: Text -> ListCompute
newListCompute Text
pFleetId_ =
  ListCompute'
    { $sel:limit:ListCompute' :: Maybe Natural
limit = forall a. Maybe a
Prelude.Nothing,
      $sel:location:ListCompute' :: Maybe Text
location = forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListCompute' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:fleetId:ListCompute' :: Text
fleetId = Text
pFleetId_
    }

-- | The maximum number of results to return. Use this parameter with
-- @NextToken@ to get results as a set of sequential pages.
listCompute_limit :: Lens.Lens' ListCompute (Prelude.Maybe Prelude.Natural)
listCompute_limit :: Lens' ListCompute (Maybe Natural)
listCompute_limit = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListCompute' {Maybe Natural
limit :: Maybe Natural
$sel:limit:ListCompute' :: ListCompute -> Maybe Natural
limit} -> Maybe Natural
limit) (\s :: ListCompute
s@ListCompute' {} Maybe Natural
a -> ListCompute
s {$sel:limit:ListCompute' :: Maybe Natural
limit = Maybe Natural
a} :: ListCompute)

-- | The name of the custom location that the compute resources are assigned
-- to.
listCompute_location :: Lens.Lens' ListCompute (Prelude.Maybe Prelude.Text)
listCompute_location :: Lens' ListCompute (Maybe Text)
listCompute_location = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListCompute' {Maybe Text
location :: Maybe Text
$sel:location:ListCompute' :: ListCompute -> Maybe Text
location} -> Maybe Text
location) (\s :: ListCompute
s@ListCompute' {} Maybe Text
a -> ListCompute
s {$sel:location:ListCompute' :: Maybe Text
location = Maybe Text
a} :: ListCompute)

-- | A token that indicates the start of the next sequential page of results.
-- Use the token that is returned with a previous call to this operation.
-- To start at the beginning of the result set, do not specify a value.
listCompute_nextToken :: Lens.Lens' ListCompute (Prelude.Maybe Prelude.Text)
listCompute_nextToken :: Lens' ListCompute (Maybe Text)
listCompute_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListCompute' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListCompute' :: ListCompute -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListCompute
s@ListCompute' {} Maybe Text
a -> ListCompute
s {$sel:nextToken:ListCompute' :: Maybe Text
nextToken = Maybe Text
a} :: ListCompute)

-- | A unique identifier for the fleet the compute resources are registered
-- to.
listCompute_fleetId :: Lens.Lens' ListCompute Prelude.Text
listCompute_fleetId :: Lens' ListCompute Text
listCompute_fleetId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListCompute' {Text
fleetId :: Text
$sel:fleetId:ListCompute' :: ListCompute -> Text
fleetId} -> Text
fleetId) (\s :: ListCompute
s@ListCompute' {} Text
a -> ListCompute
s {$sel:fleetId:ListCompute' :: Text
fleetId = Text
a} :: ListCompute)

instance Core.AWSPager ListCompute where
  page :: ListCompute -> AWSResponse ListCompute -> Maybe ListCompute
page ListCompute
rq AWSResponse ListCompute
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse ListCompute
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListComputeResponse (Maybe Text)
listComputeResponse_nextToken
            forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
        ) =
        forall a. Maybe a
Prelude.Nothing
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse ListCompute
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListComputeResponse (Maybe [Compute])
listComputeResponse_computeList
            forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
        ) =
        forall a. Maybe a
Prelude.Nothing
    | Bool
Prelude.otherwise =
        forall a. a -> Maybe a
Prelude.Just
          forall a b. (a -> b) -> a -> b
Prelude.$ ListCompute
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' ListCompute (Maybe Text)
listCompute_nextToken
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse ListCompute
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListComputeResponse (Maybe Text)
listComputeResponse_nextToken
          forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just

instance Core.AWSRequest ListCompute where
  type AWSResponse ListCompute = ListComputeResponse
  request :: (Service -> Service) -> ListCompute -> Request ListCompute
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.postJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy ListCompute
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse ListCompute)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> Object -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveJSON
      ( \Int
s ResponseHeaders
h Object
x ->
          Maybe [Compute] -> Maybe Text -> Int -> ListComputeResponse
ListComputeResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"ComputeList" forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ 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 -> Either String (Maybe a)
Data..?> Key
"NextToken")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
      )

instance Prelude.Hashable ListCompute where
  hashWithSalt :: Int -> ListCompute -> Int
hashWithSalt Int
_salt ListCompute' {Maybe Natural
Maybe Text
Text
fleetId :: Text
nextToken :: Maybe Text
location :: Maybe Text
limit :: Maybe Natural
$sel:fleetId:ListCompute' :: ListCompute -> Text
$sel:nextToken:ListCompute' :: ListCompute -> Maybe Text
$sel:location:ListCompute' :: ListCompute -> Maybe Text
$sel:limit:ListCompute' :: ListCompute -> Maybe Natural
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
limit
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
location
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
nextToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
fleetId

instance Prelude.NFData ListCompute where
  rnf :: ListCompute -> ()
rnf ListCompute' {Maybe Natural
Maybe Text
Text
fleetId :: Text
nextToken :: Maybe Text
location :: Maybe Text
limit :: Maybe Natural
$sel:fleetId:ListCompute' :: ListCompute -> Text
$sel:nextToken:ListCompute' :: ListCompute -> Maybe Text
$sel:location:ListCompute' :: ListCompute -> Maybe Text
$sel:limit:ListCompute' :: ListCompute -> Maybe Natural
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
limit
      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 Text
nextToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
fleetId

instance Data.ToHeaders ListCompute where
  toHeaders :: ListCompute -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"X-Amz-Target"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# (ByteString
"GameLift.ListCompute" :: Prelude.ByteString),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON ListCompute where
  toJSON :: ListCompute -> Value
toJSON ListCompute' {Maybe Natural
Maybe Text
Text
fleetId :: Text
nextToken :: Maybe Text
location :: Maybe Text
limit :: Maybe Natural
$sel:fleetId:ListCompute' :: ListCompute -> Text
$sel:nextToken:ListCompute' :: ListCompute -> Maybe Text
$sel:location:ListCompute' :: ListCompute -> Maybe Text
$sel:limit:ListCompute' :: ListCompute -> Maybe Natural
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"Limit" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Natural
limit,
            (Key
"Location" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
location,
            (Key
"NextToken" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
nextToken,
            forall a. a -> Maybe a
Prelude.Just (Key
"FleetId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
fleetId)
          ]
      )

instance Data.ToPath ListCompute where
  toPath :: ListCompute -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

instance Data.ToQuery ListCompute where
  toQuery :: ListCompute -> QueryString
toQuery = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

-- | /See:/ 'newListComputeResponse' smart constructor.
data ListComputeResponse = ListComputeResponse'
  { -- | A list of compute resources registered to the fleet you specified.
    ListComputeResponse -> Maybe [Compute]
computeList :: Prelude.Maybe [Compute],
    -- | A token that indicates where to resume retrieving results on the next
    -- call to this operation. If no token is returned, these results represent
    -- the end of the list.
    ListComputeResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    ListComputeResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ListComputeResponse -> ListComputeResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListComputeResponse -> ListComputeResponse -> Bool
$c/= :: ListComputeResponse -> ListComputeResponse -> Bool
== :: ListComputeResponse -> ListComputeResponse -> Bool
$c== :: ListComputeResponse -> ListComputeResponse -> Bool
Prelude.Eq, ReadPrec [ListComputeResponse]
ReadPrec ListComputeResponse
Int -> ReadS ListComputeResponse
ReadS [ListComputeResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListComputeResponse]
$creadListPrec :: ReadPrec [ListComputeResponse]
readPrec :: ReadPrec ListComputeResponse
$creadPrec :: ReadPrec ListComputeResponse
readList :: ReadS [ListComputeResponse]
$creadList :: ReadS [ListComputeResponse]
readsPrec :: Int -> ReadS ListComputeResponse
$creadsPrec :: Int -> ReadS ListComputeResponse
Prelude.Read, Int -> ListComputeResponse -> ShowS
[ListComputeResponse] -> ShowS
ListComputeResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListComputeResponse] -> ShowS
$cshowList :: [ListComputeResponse] -> ShowS
show :: ListComputeResponse -> String
$cshow :: ListComputeResponse -> String
showsPrec :: Int -> ListComputeResponse -> ShowS
$cshowsPrec :: Int -> ListComputeResponse -> ShowS
Prelude.Show, forall x. Rep ListComputeResponse x -> ListComputeResponse
forall x. ListComputeResponse -> Rep ListComputeResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListComputeResponse x -> ListComputeResponse
$cfrom :: forall x. ListComputeResponse -> Rep ListComputeResponse x
Prelude.Generic)

-- |
-- Create a value of 'ListComputeResponse' 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:
--
-- 'computeList', 'listComputeResponse_computeList' - A list of compute resources registered to the fleet you specified.
--
-- 'nextToken', 'listComputeResponse_nextToken' - A token that indicates where to resume retrieving results on the next
-- call to this operation. If no token is returned, these results represent
-- the end of the list.
--
-- 'httpStatus', 'listComputeResponse_httpStatus' - The response's http status code.
newListComputeResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ListComputeResponse
newListComputeResponse :: Int -> ListComputeResponse
newListComputeResponse Int
pHttpStatus_ =
  ListComputeResponse'
    { $sel:computeList:ListComputeResponse' :: Maybe [Compute]
computeList = forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListComputeResponse' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ListComputeResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | A list of compute resources registered to the fleet you specified.
listComputeResponse_computeList :: Lens.Lens' ListComputeResponse (Prelude.Maybe [Compute])
listComputeResponse_computeList :: Lens' ListComputeResponse (Maybe [Compute])
listComputeResponse_computeList = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListComputeResponse' {Maybe [Compute]
computeList :: Maybe [Compute]
$sel:computeList:ListComputeResponse' :: ListComputeResponse -> Maybe [Compute]
computeList} -> Maybe [Compute]
computeList) (\s :: ListComputeResponse
s@ListComputeResponse' {} Maybe [Compute]
a -> ListComputeResponse
s {$sel:computeList:ListComputeResponse' :: Maybe [Compute]
computeList = Maybe [Compute]
a} :: ListComputeResponse) 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

-- | A token that indicates where to resume retrieving results on the next
-- call to this operation. If no token is returned, these results represent
-- the end of the list.
listComputeResponse_nextToken :: Lens.Lens' ListComputeResponse (Prelude.Maybe Prelude.Text)
listComputeResponse_nextToken :: Lens' ListComputeResponse (Maybe Text)
listComputeResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListComputeResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListComputeResponse' :: ListComputeResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListComputeResponse
s@ListComputeResponse' {} Maybe Text
a -> ListComputeResponse
s {$sel:nextToken:ListComputeResponse' :: Maybe Text
nextToken = Maybe Text
a} :: ListComputeResponse)

-- | The response's http status code.
listComputeResponse_httpStatus :: Lens.Lens' ListComputeResponse Prelude.Int
listComputeResponse_httpStatus :: Lens' ListComputeResponse Int
listComputeResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListComputeResponse' {Int
httpStatus :: Int
$sel:httpStatus:ListComputeResponse' :: ListComputeResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: ListComputeResponse
s@ListComputeResponse' {} Int
a -> ListComputeResponse
s {$sel:httpStatus:ListComputeResponse' :: Int
httpStatus = Int
a} :: ListComputeResponse)

instance Prelude.NFData ListComputeResponse where
  rnf :: ListComputeResponse -> ()
rnf ListComputeResponse' {Int
Maybe [Compute]
Maybe Text
httpStatus :: Int
nextToken :: Maybe Text
computeList :: Maybe [Compute]
$sel:httpStatus:ListComputeResponse' :: ListComputeResponse -> Int
$sel:nextToken:ListComputeResponse' :: ListComputeResponse -> Maybe Text
$sel:computeList:ListComputeResponse' :: ListComputeResponse -> Maybe [Compute]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [Compute]
computeList
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
nextToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus