{-# 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.EMR.ListInstances
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Provides information for all active EC2 instances and EC2 instances
-- terminated in the last 30 days, up to a maximum of 2,000. EC2 instances
-- in any of the following states are considered active:
-- AWAITING_FULFILLMENT, PROVISIONING, BOOTSTRAPPING, RUNNING.
--
-- This operation returns paginated results.
module Amazonka.EMR.ListInstances
  ( -- * Creating a Request
    ListInstances (..),
    newListInstances,

    -- * Request Lenses
    listInstances_instanceFleetId,
    listInstances_instanceFleetType,
    listInstances_instanceGroupId,
    listInstances_instanceGroupTypes,
    listInstances_instanceStates,
    listInstances_marker,
    listInstances_clusterId,

    -- * Destructuring the Response
    ListInstancesResponse (..),
    newListInstancesResponse,

    -- * Response Lenses
    listInstancesResponse_instances,
    listInstancesResponse_marker,
    listInstancesResponse_httpStatus,
  )
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
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | This input determines which instances to list.
--
-- /See:/ 'newListInstances' smart constructor.
data ListInstances = ListInstances'
  { -- | The unique identifier of the instance fleet.
    ListInstances -> Maybe Text
instanceFleetId :: Prelude.Maybe Prelude.Text,
    -- | The node type of the instance fleet. For example MASTER, CORE, or TASK.
    ListInstances -> Maybe InstanceFleetType
instanceFleetType :: Prelude.Maybe InstanceFleetType,
    -- | The identifier of the instance group for which to list the instances.
    ListInstances -> Maybe Text
instanceGroupId :: Prelude.Maybe Prelude.Text,
    -- | The type of instance group for which to list the instances.
    ListInstances -> Maybe [InstanceGroupType]
instanceGroupTypes :: Prelude.Maybe [InstanceGroupType],
    -- | A list of instance states that will filter the instances returned with
    -- this request.
    ListInstances -> Maybe [InstanceState]
instanceStates :: Prelude.Maybe [InstanceState],
    -- | The pagination token that indicates the next set of results to retrieve.
    ListInstances -> Maybe Text
marker :: Prelude.Maybe Prelude.Text,
    -- | The identifier of the cluster for which to list the instances.
    ListInstances -> Text
clusterId :: Prelude.Text
  }
  deriving (ListInstances -> ListInstances -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListInstances -> ListInstances -> Bool
$c/= :: ListInstances -> ListInstances -> Bool
== :: ListInstances -> ListInstances -> Bool
$c== :: ListInstances -> ListInstances -> Bool
Prelude.Eq, ReadPrec [ListInstances]
ReadPrec ListInstances
Int -> ReadS ListInstances
ReadS [ListInstances]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListInstances]
$creadListPrec :: ReadPrec [ListInstances]
readPrec :: ReadPrec ListInstances
$creadPrec :: ReadPrec ListInstances
readList :: ReadS [ListInstances]
$creadList :: ReadS [ListInstances]
readsPrec :: Int -> ReadS ListInstances
$creadsPrec :: Int -> ReadS ListInstances
Prelude.Read, Int -> ListInstances -> ShowS
[ListInstances] -> ShowS
ListInstances -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListInstances] -> ShowS
$cshowList :: [ListInstances] -> ShowS
show :: ListInstances -> String
$cshow :: ListInstances -> String
showsPrec :: Int -> ListInstances -> ShowS
$cshowsPrec :: Int -> ListInstances -> ShowS
Prelude.Show, forall x. Rep ListInstances x -> ListInstances
forall x. ListInstances -> Rep ListInstances x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListInstances x -> ListInstances
$cfrom :: forall x. ListInstances -> Rep ListInstances x
Prelude.Generic)

-- |
-- Create a value of 'ListInstances' 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:
--
-- 'instanceFleetId', 'listInstances_instanceFleetId' - The unique identifier of the instance fleet.
--
-- 'instanceFleetType', 'listInstances_instanceFleetType' - The node type of the instance fleet. For example MASTER, CORE, or TASK.
--
-- 'instanceGroupId', 'listInstances_instanceGroupId' - The identifier of the instance group for which to list the instances.
--
-- 'instanceGroupTypes', 'listInstances_instanceGroupTypes' - The type of instance group for which to list the instances.
--
-- 'instanceStates', 'listInstances_instanceStates' - A list of instance states that will filter the instances returned with
-- this request.
--
-- 'marker', 'listInstances_marker' - The pagination token that indicates the next set of results to retrieve.
--
-- 'clusterId', 'listInstances_clusterId' - The identifier of the cluster for which to list the instances.
newListInstances ::
  -- | 'clusterId'
  Prelude.Text ->
  ListInstances
newListInstances :: Text -> ListInstances
newListInstances Text
pClusterId_ =
  ListInstances'
    { $sel:instanceFleetId:ListInstances' :: Maybe Text
instanceFleetId = forall a. Maybe a
Prelude.Nothing,
      $sel:instanceFleetType:ListInstances' :: Maybe InstanceFleetType
instanceFleetType = forall a. Maybe a
Prelude.Nothing,
      $sel:instanceGroupId:ListInstances' :: Maybe Text
instanceGroupId = forall a. Maybe a
Prelude.Nothing,
      $sel:instanceGroupTypes:ListInstances' :: Maybe [InstanceGroupType]
instanceGroupTypes = forall a. Maybe a
Prelude.Nothing,
      $sel:instanceStates:ListInstances' :: Maybe [InstanceState]
instanceStates = forall a. Maybe a
Prelude.Nothing,
      $sel:marker:ListInstances' :: Maybe Text
marker = forall a. Maybe a
Prelude.Nothing,
      $sel:clusterId:ListInstances' :: Text
clusterId = Text
pClusterId_
    }

-- | The unique identifier of the instance fleet.
listInstances_instanceFleetId :: Lens.Lens' ListInstances (Prelude.Maybe Prelude.Text)
listInstances_instanceFleetId :: Lens' ListInstances (Maybe Text)
listInstances_instanceFleetId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListInstances' {Maybe Text
instanceFleetId :: Maybe Text
$sel:instanceFleetId:ListInstances' :: ListInstances -> Maybe Text
instanceFleetId} -> Maybe Text
instanceFleetId) (\s :: ListInstances
s@ListInstances' {} Maybe Text
a -> ListInstances
s {$sel:instanceFleetId:ListInstances' :: Maybe Text
instanceFleetId = Maybe Text
a} :: ListInstances)

-- | The node type of the instance fleet. For example MASTER, CORE, or TASK.
listInstances_instanceFleetType :: Lens.Lens' ListInstances (Prelude.Maybe InstanceFleetType)
listInstances_instanceFleetType :: Lens' ListInstances (Maybe InstanceFleetType)
listInstances_instanceFleetType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListInstances' {Maybe InstanceFleetType
instanceFleetType :: Maybe InstanceFleetType
$sel:instanceFleetType:ListInstances' :: ListInstances -> Maybe InstanceFleetType
instanceFleetType} -> Maybe InstanceFleetType
instanceFleetType) (\s :: ListInstances
s@ListInstances' {} Maybe InstanceFleetType
a -> ListInstances
s {$sel:instanceFleetType:ListInstances' :: Maybe InstanceFleetType
instanceFleetType = Maybe InstanceFleetType
a} :: ListInstances)

-- | The identifier of the instance group for which to list the instances.
listInstances_instanceGroupId :: Lens.Lens' ListInstances (Prelude.Maybe Prelude.Text)
listInstances_instanceGroupId :: Lens' ListInstances (Maybe Text)
listInstances_instanceGroupId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListInstances' {Maybe Text
instanceGroupId :: Maybe Text
$sel:instanceGroupId:ListInstances' :: ListInstances -> Maybe Text
instanceGroupId} -> Maybe Text
instanceGroupId) (\s :: ListInstances
s@ListInstances' {} Maybe Text
a -> ListInstances
s {$sel:instanceGroupId:ListInstances' :: Maybe Text
instanceGroupId = Maybe Text
a} :: ListInstances)

-- | The type of instance group for which to list the instances.
listInstances_instanceGroupTypes :: Lens.Lens' ListInstances (Prelude.Maybe [InstanceGroupType])
listInstances_instanceGroupTypes :: Lens' ListInstances (Maybe [InstanceGroupType])
listInstances_instanceGroupTypes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListInstances' {Maybe [InstanceGroupType]
instanceGroupTypes :: Maybe [InstanceGroupType]
$sel:instanceGroupTypes:ListInstances' :: ListInstances -> Maybe [InstanceGroupType]
instanceGroupTypes} -> Maybe [InstanceGroupType]
instanceGroupTypes) (\s :: ListInstances
s@ListInstances' {} Maybe [InstanceGroupType]
a -> ListInstances
s {$sel:instanceGroupTypes:ListInstances' :: Maybe [InstanceGroupType]
instanceGroupTypes = Maybe [InstanceGroupType]
a} :: ListInstances) 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 list of instance states that will filter the instances returned with
-- this request.
listInstances_instanceStates :: Lens.Lens' ListInstances (Prelude.Maybe [InstanceState])
listInstances_instanceStates :: Lens' ListInstances (Maybe [InstanceState])
listInstances_instanceStates = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListInstances' {Maybe [InstanceState]
instanceStates :: Maybe [InstanceState]
$sel:instanceStates:ListInstances' :: ListInstances -> Maybe [InstanceState]
instanceStates} -> Maybe [InstanceState]
instanceStates) (\s :: ListInstances
s@ListInstances' {} Maybe [InstanceState]
a -> ListInstances
s {$sel:instanceStates:ListInstances' :: Maybe [InstanceState]
instanceStates = Maybe [InstanceState]
a} :: ListInstances) 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 pagination token that indicates the next set of results to retrieve.
listInstances_marker :: Lens.Lens' ListInstances (Prelude.Maybe Prelude.Text)
listInstances_marker :: Lens' ListInstances (Maybe Text)
listInstances_marker = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListInstances' {Maybe Text
marker :: Maybe Text
$sel:marker:ListInstances' :: ListInstances -> Maybe Text
marker} -> Maybe Text
marker) (\s :: ListInstances
s@ListInstances' {} Maybe Text
a -> ListInstances
s {$sel:marker:ListInstances' :: Maybe Text
marker = Maybe Text
a} :: ListInstances)

-- | The identifier of the cluster for which to list the instances.
listInstances_clusterId :: Lens.Lens' ListInstances Prelude.Text
listInstances_clusterId :: Lens' ListInstances Text
listInstances_clusterId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListInstances' {Text
clusterId :: Text
$sel:clusterId:ListInstances' :: ListInstances -> Text
clusterId} -> Text
clusterId) (\s :: ListInstances
s@ListInstances' {} Text
a -> ListInstances
s {$sel:clusterId:ListInstances' :: Text
clusterId = Text
a} :: ListInstances)

instance Core.AWSPager ListInstances where
  page :: ListInstances -> AWSResponse ListInstances -> Maybe ListInstances
page ListInstances
rq AWSResponse ListInstances
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse ListInstances
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListInstancesResponse (Maybe Text)
listInstancesResponse_marker
            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 ListInstances
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListInstancesResponse (Maybe [Instance])
listInstancesResponse_instances
            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.$ ListInstances
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' ListInstances (Maybe Text)
listInstances_marker
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse ListInstances
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListInstancesResponse (Maybe Text)
listInstancesResponse_marker
          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 ListInstances where
  type
    AWSResponse ListInstances =
      ListInstancesResponse
  request :: (Service -> Service) -> ListInstances -> Request ListInstances
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 ListInstances
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse ListInstances)))
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 [Instance] -> Maybe Text -> Int -> ListInstancesResponse
ListInstancesResponse'
            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
"Instances" 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
"Marker")
            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 ListInstances where
  hashWithSalt :: Int -> ListInstances -> Int
hashWithSalt Int
_salt ListInstances' {Maybe [InstanceGroupType]
Maybe [InstanceState]
Maybe Text
Maybe InstanceFleetType
Text
clusterId :: Text
marker :: Maybe Text
instanceStates :: Maybe [InstanceState]
instanceGroupTypes :: Maybe [InstanceGroupType]
instanceGroupId :: Maybe Text
instanceFleetType :: Maybe InstanceFleetType
instanceFleetId :: Maybe Text
$sel:clusterId:ListInstances' :: ListInstances -> Text
$sel:marker:ListInstances' :: ListInstances -> Maybe Text
$sel:instanceStates:ListInstances' :: ListInstances -> Maybe [InstanceState]
$sel:instanceGroupTypes:ListInstances' :: ListInstances -> Maybe [InstanceGroupType]
$sel:instanceGroupId:ListInstances' :: ListInstances -> Maybe Text
$sel:instanceFleetType:ListInstances' :: ListInstances -> Maybe InstanceFleetType
$sel:instanceFleetId:ListInstances' :: ListInstances -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
instanceFleetId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe InstanceFleetType
instanceFleetType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
instanceGroupId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [InstanceGroupType]
instanceGroupTypes
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [InstanceState]
instanceStates
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
marker
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
clusterId

instance Prelude.NFData ListInstances where
  rnf :: ListInstances -> ()
rnf ListInstances' {Maybe [InstanceGroupType]
Maybe [InstanceState]
Maybe Text
Maybe InstanceFleetType
Text
clusterId :: Text
marker :: Maybe Text
instanceStates :: Maybe [InstanceState]
instanceGroupTypes :: Maybe [InstanceGroupType]
instanceGroupId :: Maybe Text
instanceFleetType :: Maybe InstanceFleetType
instanceFleetId :: Maybe Text
$sel:clusterId:ListInstances' :: ListInstances -> Text
$sel:marker:ListInstances' :: ListInstances -> Maybe Text
$sel:instanceStates:ListInstances' :: ListInstances -> Maybe [InstanceState]
$sel:instanceGroupTypes:ListInstances' :: ListInstances -> Maybe [InstanceGroupType]
$sel:instanceGroupId:ListInstances' :: ListInstances -> Maybe Text
$sel:instanceFleetType:ListInstances' :: ListInstances -> Maybe InstanceFleetType
$sel:instanceFleetId:ListInstances' :: ListInstances -> Maybe Text
..} =
    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 InstanceFleetType
instanceFleetType
      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 [InstanceGroupType]
instanceGroupTypes
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [InstanceState]
instanceStates
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
marker
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
clusterId

instance Data.ToHeaders ListInstances where
  toHeaders :: ListInstances -> 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
"ElasticMapReduce.ListInstances" ::
                          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 ListInstances where
  toJSON :: ListInstances -> Value
toJSON ListInstances' {Maybe [InstanceGroupType]
Maybe [InstanceState]
Maybe Text
Maybe InstanceFleetType
Text
clusterId :: Text
marker :: Maybe Text
instanceStates :: Maybe [InstanceState]
instanceGroupTypes :: Maybe [InstanceGroupType]
instanceGroupId :: Maybe Text
instanceFleetType :: Maybe InstanceFleetType
instanceFleetId :: Maybe Text
$sel:clusterId:ListInstances' :: ListInstances -> Text
$sel:marker:ListInstances' :: ListInstances -> Maybe Text
$sel:instanceStates:ListInstances' :: ListInstances -> Maybe [InstanceState]
$sel:instanceGroupTypes:ListInstances' :: ListInstances -> Maybe [InstanceGroupType]
$sel:instanceGroupId:ListInstances' :: ListInstances -> Maybe Text
$sel:instanceFleetType:ListInstances' :: ListInstances -> Maybe InstanceFleetType
$sel:instanceFleetId:ListInstances' :: ListInstances -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"InstanceFleetId" 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
instanceFleetId,
            (Key
"InstanceFleetType" 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 InstanceFleetType
instanceFleetType,
            (Key
"InstanceGroupId" 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
instanceGroupId,
            (Key
"InstanceGroupTypes" 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 [InstanceGroupType]
instanceGroupTypes,
            (Key
"InstanceStates" 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 [InstanceState]
instanceStates,
            (Key
"Marker" 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
marker,
            forall a. a -> Maybe a
Prelude.Just (Key
"ClusterId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
clusterId)
          ]
      )

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

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

-- | This output contains the list of instances.
--
-- /See:/ 'newListInstancesResponse' smart constructor.
data ListInstancesResponse = ListInstancesResponse'
  { -- | The list of instances for the cluster and given filters.
    ListInstancesResponse -> Maybe [Instance]
instances :: Prelude.Maybe [Instance],
    -- | The pagination token that indicates the next set of results to retrieve.
    ListInstancesResponse -> Maybe Text
marker :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    ListInstancesResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ListInstancesResponse -> ListInstancesResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListInstancesResponse -> ListInstancesResponse -> Bool
$c/= :: ListInstancesResponse -> ListInstancesResponse -> Bool
== :: ListInstancesResponse -> ListInstancesResponse -> Bool
$c== :: ListInstancesResponse -> ListInstancesResponse -> Bool
Prelude.Eq, ReadPrec [ListInstancesResponse]
ReadPrec ListInstancesResponse
Int -> ReadS ListInstancesResponse
ReadS [ListInstancesResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListInstancesResponse]
$creadListPrec :: ReadPrec [ListInstancesResponse]
readPrec :: ReadPrec ListInstancesResponse
$creadPrec :: ReadPrec ListInstancesResponse
readList :: ReadS [ListInstancesResponse]
$creadList :: ReadS [ListInstancesResponse]
readsPrec :: Int -> ReadS ListInstancesResponse
$creadsPrec :: Int -> ReadS ListInstancesResponse
Prelude.Read, Int -> ListInstancesResponse -> ShowS
[ListInstancesResponse] -> ShowS
ListInstancesResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListInstancesResponse] -> ShowS
$cshowList :: [ListInstancesResponse] -> ShowS
show :: ListInstancesResponse -> String
$cshow :: ListInstancesResponse -> String
showsPrec :: Int -> ListInstancesResponse -> ShowS
$cshowsPrec :: Int -> ListInstancesResponse -> ShowS
Prelude.Show, forall x. Rep ListInstancesResponse x -> ListInstancesResponse
forall x. ListInstancesResponse -> Rep ListInstancesResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListInstancesResponse x -> ListInstancesResponse
$cfrom :: forall x. ListInstancesResponse -> Rep ListInstancesResponse x
Prelude.Generic)

-- |
-- Create a value of 'ListInstancesResponse' 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:
--
-- 'instances', 'listInstancesResponse_instances' - The list of instances for the cluster and given filters.
--
-- 'marker', 'listInstancesResponse_marker' - The pagination token that indicates the next set of results to retrieve.
--
-- 'httpStatus', 'listInstancesResponse_httpStatus' - The response's http status code.
newListInstancesResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ListInstancesResponse
newListInstancesResponse :: Int -> ListInstancesResponse
newListInstancesResponse Int
pHttpStatus_ =
  ListInstancesResponse'
    { $sel:instances:ListInstancesResponse' :: Maybe [Instance]
instances = forall a. Maybe a
Prelude.Nothing,
      $sel:marker:ListInstancesResponse' :: Maybe Text
marker = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ListInstancesResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The list of instances for the cluster and given filters.
listInstancesResponse_instances :: Lens.Lens' ListInstancesResponse (Prelude.Maybe [Instance])
listInstancesResponse_instances :: Lens' ListInstancesResponse (Maybe [Instance])
listInstancesResponse_instances = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListInstancesResponse' {Maybe [Instance]
instances :: Maybe [Instance]
$sel:instances:ListInstancesResponse' :: ListInstancesResponse -> Maybe [Instance]
instances} -> Maybe [Instance]
instances) (\s :: ListInstancesResponse
s@ListInstancesResponse' {} Maybe [Instance]
a -> ListInstancesResponse
s {$sel:instances:ListInstancesResponse' :: Maybe [Instance]
instances = Maybe [Instance]
a} :: ListInstancesResponse) 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 pagination token that indicates the next set of results to retrieve.
listInstancesResponse_marker :: Lens.Lens' ListInstancesResponse (Prelude.Maybe Prelude.Text)
listInstancesResponse_marker :: Lens' ListInstancesResponse (Maybe Text)
listInstancesResponse_marker = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListInstancesResponse' {Maybe Text
marker :: Maybe Text
$sel:marker:ListInstancesResponse' :: ListInstancesResponse -> Maybe Text
marker} -> Maybe Text
marker) (\s :: ListInstancesResponse
s@ListInstancesResponse' {} Maybe Text
a -> ListInstancesResponse
s {$sel:marker:ListInstancesResponse' :: Maybe Text
marker = Maybe Text
a} :: ListInstancesResponse)

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

instance Prelude.NFData ListInstancesResponse where
  rnf :: ListInstancesResponse -> ()
rnf ListInstancesResponse' {Int
Maybe [Instance]
Maybe Text
httpStatus :: Int
marker :: Maybe Text
instances :: Maybe [Instance]
$sel:httpStatus:ListInstancesResponse' :: ListInstancesResponse -> Int
$sel:marker:ListInstancesResponse' :: ListInstancesResponse -> Maybe Text
$sel:instances:ListInstancesResponse' :: ListInstancesResponse -> Maybe [Instance]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [Instance]
instances
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
marker
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus