{-# 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.ECS.ListContainerInstances
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Returns a list of container instances in a specified cluster. You can
-- filter the results of a @ListContainerInstances@ operation with cluster
-- query language statements inside the @filter@ parameter. For more
-- information, see
-- <https://docs.aws.amazon.com/AmazonECS/latest/developerguide/cluster-query-language.html Cluster Query Language>
-- in the /Amazon Elastic Container Service Developer Guide/.
--
-- This operation returns paginated results.
module Amazonka.ECS.ListContainerInstances
  ( -- * Creating a Request
    ListContainerInstances (..),
    newListContainerInstances,

    -- * Request Lenses
    listContainerInstances_cluster,
    listContainerInstances_filter,
    listContainerInstances_maxResults,
    listContainerInstances_nextToken,
    listContainerInstances_status,

    -- * Destructuring the Response
    ListContainerInstancesResponse (..),
    newListContainerInstancesResponse,

    -- * Response Lenses
    listContainerInstancesResponse_containerInstanceArns,
    listContainerInstancesResponse_nextToken,
    listContainerInstancesResponse_httpStatus,
  )
where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.ECS.Types
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newListContainerInstances' smart constructor.
data ListContainerInstances = ListContainerInstances'
  { -- | The short name or full Amazon Resource Name (ARN) of the cluster that
    -- hosts the container instances to list. If you do not specify a cluster,
    -- the default cluster is assumed.
    ListContainerInstances -> Maybe Text
cluster :: Prelude.Maybe Prelude.Text,
    -- | You can filter the results of a @ListContainerInstances@ operation with
    -- cluster query language statements. For more information, see
    -- <https://docs.aws.amazon.com/AmazonECS/latest/developerguide/cluster-query-language.html Cluster Query Language>
    -- in the /Amazon Elastic Container Service Developer Guide/.
    ListContainerInstances -> Maybe Text
filter' :: Prelude.Maybe Prelude.Text,
    -- | The maximum number of container instance results that
    -- @ListContainerInstances@ returned in paginated output. When this
    -- parameter is used, @ListContainerInstances@ only returns @maxResults@
    -- results in a single page along with a @nextToken@ response element. The
    -- remaining results of the initial request can be seen by sending another
    -- @ListContainerInstances@ request with the returned @nextToken@ value.
    -- This value can be between 1 and 100. If this parameter isn\'t used, then
    -- @ListContainerInstances@ returns up to 100 results and a @nextToken@
    -- value if applicable.
    ListContainerInstances -> Maybe Int
maxResults :: Prelude.Maybe Prelude.Int,
    -- | The @nextToken@ value returned from a @ListContainerInstances@ request
    -- indicating that more results are available to fulfill the request and
    -- further calls are needed. If @maxResults@ was provided, it\'s possible
    -- the number of results to be fewer than @maxResults@.
    --
    -- This token should be treated as an opaque identifier that is only used
    -- to retrieve the next items in a list and not for other programmatic
    -- purposes.
    ListContainerInstances -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | Filters the container instances by status. For example, if you specify
    -- the @DRAINING@ status, the results include only container instances that
    -- have been set to @DRAINING@ using UpdateContainerInstancesState. If you
    -- don\'t specify this parameter, the default is to include container
    -- instances set to all states other than @INACTIVE@.
    ListContainerInstances -> Maybe ContainerInstanceStatus
status :: Prelude.Maybe ContainerInstanceStatus
  }
  deriving (ListContainerInstances -> ListContainerInstances -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListContainerInstances -> ListContainerInstances -> Bool
$c/= :: ListContainerInstances -> ListContainerInstances -> Bool
== :: ListContainerInstances -> ListContainerInstances -> Bool
$c== :: ListContainerInstances -> ListContainerInstances -> Bool
Prelude.Eq, ReadPrec [ListContainerInstances]
ReadPrec ListContainerInstances
Int -> ReadS ListContainerInstances
ReadS [ListContainerInstances]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListContainerInstances]
$creadListPrec :: ReadPrec [ListContainerInstances]
readPrec :: ReadPrec ListContainerInstances
$creadPrec :: ReadPrec ListContainerInstances
readList :: ReadS [ListContainerInstances]
$creadList :: ReadS [ListContainerInstances]
readsPrec :: Int -> ReadS ListContainerInstances
$creadsPrec :: Int -> ReadS ListContainerInstances
Prelude.Read, Int -> ListContainerInstances -> ShowS
[ListContainerInstances] -> ShowS
ListContainerInstances -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListContainerInstances] -> ShowS
$cshowList :: [ListContainerInstances] -> ShowS
show :: ListContainerInstances -> String
$cshow :: ListContainerInstances -> String
showsPrec :: Int -> ListContainerInstances -> ShowS
$cshowsPrec :: Int -> ListContainerInstances -> ShowS
Prelude.Show, forall x. Rep ListContainerInstances x -> ListContainerInstances
forall x. ListContainerInstances -> Rep ListContainerInstances x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListContainerInstances x -> ListContainerInstances
$cfrom :: forall x. ListContainerInstances -> Rep ListContainerInstances x
Prelude.Generic)

-- |
-- Create a value of 'ListContainerInstances' 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:
--
-- 'cluster', 'listContainerInstances_cluster' - The short name or full Amazon Resource Name (ARN) of the cluster that
-- hosts the container instances to list. If you do not specify a cluster,
-- the default cluster is assumed.
--
-- 'filter'', 'listContainerInstances_filter' - You can filter the results of a @ListContainerInstances@ operation with
-- cluster query language statements. For more information, see
-- <https://docs.aws.amazon.com/AmazonECS/latest/developerguide/cluster-query-language.html Cluster Query Language>
-- in the /Amazon Elastic Container Service Developer Guide/.
--
-- 'maxResults', 'listContainerInstances_maxResults' - The maximum number of container instance results that
-- @ListContainerInstances@ returned in paginated output. When this
-- parameter is used, @ListContainerInstances@ only returns @maxResults@
-- results in a single page along with a @nextToken@ response element. The
-- remaining results of the initial request can be seen by sending another
-- @ListContainerInstances@ request with the returned @nextToken@ value.
-- This value can be between 1 and 100. If this parameter isn\'t used, then
-- @ListContainerInstances@ returns up to 100 results and a @nextToken@
-- value if applicable.
--
-- 'nextToken', 'listContainerInstances_nextToken' - The @nextToken@ value returned from a @ListContainerInstances@ request
-- indicating that more results are available to fulfill the request and
-- further calls are needed. If @maxResults@ was provided, it\'s possible
-- the number of results to be fewer than @maxResults@.
--
-- This token should be treated as an opaque identifier that is only used
-- to retrieve the next items in a list and not for other programmatic
-- purposes.
--
-- 'status', 'listContainerInstances_status' - Filters the container instances by status. For example, if you specify
-- the @DRAINING@ status, the results include only container instances that
-- have been set to @DRAINING@ using UpdateContainerInstancesState. If you
-- don\'t specify this parameter, the default is to include container
-- instances set to all states other than @INACTIVE@.
newListContainerInstances ::
  ListContainerInstances
newListContainerInstances :: ListContainerInstances
newListContainerInstances =
  ListContainerInstances'
    { $sel:cluster:ListContainerInstances' :: Maybe Text
cluster = forall a. Maybe a
Prelude.Nothing,
      $sel:filter':ListContainerInstances' :: Maybe Text
filter' = forall a. Maybe a
Prelude.Nothing,
      $sel:maxResults:ListContainerInstances' :: Maybe Int
maxResults = forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListContainerInstances' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:status:ListContainerInstances' :: Maybe ContainerInstanceStatus
status = forall a. Maybe a
Prelude.Nothing
    }

-- | The short name or full Amazon Resource Name (ARN) of the cluster that
-- hosts the container instances to list. If you do not specify a cluster,
-- the default cluster is assumed.
listContainerInstances_cluster :: Lens.Lens' ListContainerInstances (Prelude.Maybe Prelude.Text)
listContainerInstances_cluster :: Lens' ListContainerInstances (Maybe Text)
listContainerInstances_cluster = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListContainerInstances' {Maybe Text
cluster :: Maybe Text
$sel:cluster:ListContainerInstances' :: ListContainerInstances -> Maybe Text
cluster} -> Maybe Text
cluster) (\s :: ListContainerInstances
s@ListContainerInstances' {} Maybe Text
a -> ListContainerInstances
s {$sel:cluster:ListContainerInstances' :: Maybe Text
cluster = Maybe Text
a} :: ListContainerInstances)

-- | You can filter the results of a @ListContainerInstances@ operation with
-- cluster query language statements. For more information, see
-- <https://docs.aws.amazon.com/AmazonECS/latest/developerguide/cluster-query-language.html Cluster Query Language>
-- in the /Amazon Elastic Container Service Developer Guide/.
listContainerInstances_filter :: Lens.Lens' ListContainerInstances (Prelude.Maybe Prelude.Text)
listContainerInstances_filter :: Lens' ListContainerInstances (Maybe Text)
listContainerInstances_filter = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListContainerInstances' {Maybe Text
filter' :: Maybe Text
$sel:filter':ListContainerInstances' :: ListContainerInstances -> Maybe Text
filter'} -> Maybe Text
filter') (\s :: ListContainerInstances
s@ListContainerInstances' {} Maybe Text
a -> ListContainerInstances
s {$sel:filter':ListContainerInstances' :: Maybe Text
filter' = Maybe Text
a} :: ListContainerInstances)

-- | The maximum number of container instance results that
-- @ListContainerInstances@ returned in paginated output. When this
-- parameter is used, @ListContainerInstances@ only returns @maxResults@
-- results in a single page along with a @nextToken@ response element. The
-- remaining results of the initial request can be seen by sending another
-- @ListContainerInstances@ request with the returned @nextToken@ value.
-- This value can be between 1 and 100. If this parameter isn\'t used, then
-- @ListContainerInstances@ returns up to 100 results and a @nextToken@
-- value if applicable.
listContainerInstances_maxResults :: Lens.Lens' ListContainerInstances (Prelude.Maybe Prelude.Int)
listContainerInstances_maxResults :: Lens' ListContainerInstances (Maybe Int)
listContainerInstances_maxResults = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListContainerInstances' {Maybe Int
maxResults :: Maybe Int
$sel:maxResults:ListContainerInstances' :: ListContainerInstances -> Maybe Int
maxResults} -> Maybe Int
maxResults) (\s :: ListContainerInstances
s@ListContainerInstances' {} Maybe Int
a -> ListContainerInstances
s {$sel:maxResults:ListContainerInstances' :: Maybe Int
maxResults = Maybe Int
a} :: ListContainerInstances)

-- | The @nextToken@ value returned from a @ListContainerInstances@ request
-- indicating that more results are available to fulfill the request and
-- further calls are needed. If @maxResults@ was provided, it\'s possible
-- the number of results to be fewer than @maxResults@.
--
-- This token should be treated as an opaque identifier that is only used
-- to retrieve the next items in a list and not for other programmatic
-- purposes.
listContainerInstances_nextToken :: Lens.Lens' ListContainerInstances (Prelude.Maybe Prelude.Text)
listContainerInstances_nextToken :: Lens' ListContainerInstances (Maybe Text)
listContainerInstances_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListContainerInstances' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListContainerInstances' :: ListContainerInstances -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListContainerInstances
s@ListContainerInstances' {} Maybe Text
a -> ListContainerInstances
s {$sel:nextToken:ListContainerInstances' :: Maybe Text
nextToken = Maybe Text
a} :: ListContainerInstances)

-- | Filters the container instances by status. For example, if you specify
-- the @DRAINING@ status, the results include only container instances that
-- have been set to @DRAINING@ using UpdateContainerInstancesState. If you
-- don\'t specify this parameter, the default is to include container
-- instances set to all states other than @INACTIVE@.
listContainerInstances_status :: Lens.Lens' ListContainerInstances (Prelude.Maybe ContainerInstanceStatus)
listContainerInstances_status :: Lens' ListContainerInstances (Maybe ContainerInstanceStatus)
listContainerInstances_status = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListContainerInstances' {Maybe ContainerInstanceStatus
status :: Maybe ContainerInstanceStatus
$sel:status:ListContainerInstances' :: ListContainerInstances -> Maybe ContainerInstanceStatus
status} -> Maybe ContainerInstanceStatus
status) (\s :: ListContainerInstances
s@ListContainerInstances' {} Maybe ContainerInstanceStatus
a -> ListContainerInstances
s {$sel:status:ListContainerInstances' :: Maybe ContainerInstanceStatus
status = Maybe ContainerInstanceStatus
a} :: ListContainerInstances)

instance Core.AWSPager ListContainerInstances where
  page :: ListContainerInstances
-> AWSResponse ListContainerInstances
-> Maybe ListContainerInstances
page ListContainerInstances
rq AWSResponse ListContainerInstances
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse ListContainerInstances
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListContainerInstancesResponse (Maybe Text)
listContainerInstancesResponse_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 ListContainerInstances
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListContainerInstancesResponse (Maybe [Text])
listContainerInstancesResponse_containerInstanceArns
            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.$ ListContainerInstances
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' ListContainerInstances (Maybe Text)
listContainerInstances_nextToken
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse ListContainerInstances
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListContainerInstancesResponse (Maybe Text)
listContainerInstancesResponse_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 ListContainerInstances where
  type
    AWSResponse ListContainerInstances =
      ListContainerInstancesResponse
  request :: (Service -> Service)
-> ListContainerInstances -> Request ListContainerInstances
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 ListContainerInstances
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse ListContainerInstances)))
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 [Text] -> Maybe Text -> Int -> ListContainerInstancesResponse
ListContainerInstancesResponse'
            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
"containerInstanceArns"
                            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 ListContainerInstances where
  hashWithSalt :: Int -> ListContainerInstances -> Int
hashWithSalt Int
_salt ListContainerInstances' {Maybe Int
Maybe Text
Maybe ContainerInstanceStatus
status :: Maybe ContainerInstanceStatus
nextToken :: Maybe Text
maxResults :: Maybe Int
filter' :: Maybe Text
cluster :: Maybe Text
$sel:status:ListContainerInstances' :: ListContainerInstances -> Maybe ContainerInstanceStatus
$sel:nextToken:ListContainerInstances' :: ListContainerInstances -> Maybe Text
$sel:maxResults:ListContainerInstances' :: ListContainerInstances -> Maybe Int
$sel:filter':ListContainerInstances' :: ListContainerInstances -> Maybe Text
$sel:cluster:ListContainerInstances' :: ListContainerInstances -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
cluster
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
filter'
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
maxResults
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
nextToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ContainerInstanceStatus
status

instance Prelude.NFData ListContainerInstances where
  rnf :: ListContainerInstances -> ()
rnf ListContainerInstances' {Maybe Int
Maybe Text
Maybe ContainerInstanceStatus
status :: Maybe ContainerInstanceStatus
nextToken :: Maybe Text
maxResults :: Maybe Int
filter' :: Maybe Text
cluster :: Maybe Text
$sel:status:ListContainerInstances' :: ListContainerInstances -> Maybe ContainerInstanceStatus
$sel:nextToken:ListContainerInstances' :: ListContainerInstances -> Maybe Text
$sel:maxResults:ListContainerInstances' :: ListContainerInstances -> Maybe Int
$sel:filter':ListContainerInstances' :: ListContainerInstances -> Maybe Text
$sel:cluster:ListContainerInstances' :: ListContainerInstances -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
cluster
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
filter'
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
maxResults
      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 Maybe ContainerInstanceStatus
status

instance Data.ToHeaders ListContainerInstances where
  toHeaders :: ListContainerInstances -> 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
"AmazonEC2ContainerServiceV20141113.ListContainerInstances" ::
                          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 ListContainerInstances where
  toJSON :: ListContainerInstances -> Value
toJSON ListContainerInstances' {Maybe Int
Maybe Text
Maybe ContainerInstanceStatus
status :: Maybe ContainerInstanceStatus
nextToken :: Maybe Text
maxResults :: Maybe Int
filter' :: Maybe Text
cluster :: Maybe Text
$sel:status:ListContainerInstances' :: ListContainerInstances -> Maybe ContainerInstanceStatus
$sel:nextToken:ListContainerInstances' :: ListContainerInstances -> Maybe Text
$sel:maxResults:ListContainerInstances' :: ListContainerInstances -> Maybe Int
$sel:filter':ListContainerInstances' :: ListContainerInstances -> Maybe Text
$sel:cluster:ListContainerInstances' :: ListContainerInstances -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"cluster" 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
cluster,
            (Key
"filter" 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
filter',
            (Key
"maxResults" 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 Int
maxResults,
            (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,
            (Key
"status" 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 ContainerInstanceStatus
status
          ]
      )

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

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

-- | /See:/ 'newListContainerInstancesResponse' smart constructor.
data ListContainerInstancesResponse = ListContainerInstancesResponse'
  { -- | The list of container instances with full ARN entries for each container
    -- instance associated with the specified cluster.
    ListContainerInstancesResponse -> Maybe [Text]
containerInstanceArns :: Prelude.Maybe [Prelude.Text],
    -- | The @nextToken@ value to include in a future @ListContainerInstances@
    -- request. When the results of a @ListContainerInstances@ request exceed
    -- @maxResults@, this value can be used to retrieve the next page of
    -- results. This value is @null@ when there are no more results to return.
    ListContainerInstancesResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    ListContainerInstancesResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ListContainerInstancesResponse
-> ListContainerInstancesResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListContainerInstancesResponse
-> ListContainerInstancesResponse -> Bool
$c/= :: ListContainerInstancesResponse
-> ListContainerInstancesResponse -> Bool
== :: ListContainerInstancesResponse
-> ListContainerInstancesResponse -> Bool
$c== :: ListContainerInstancesResponse
-> ListContainerInstancesResponse -> Bool
Prelude.Eq, ReadPrec [ListContainerInstancesResponse]
ReadPrec ListContainerInstancesResponse
Int -> ReadS ListContainerInstancesResponse
ReadS [ListContainerInstancesResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListContainerInstancesResponse]
$creadListPrec :: ReadPrec [ListContainerInstancesResponse]
readPrec :: ReadPrec ListContainerInstancesResponse
$creadPrec :: ReadPrec ListContainerInstancesResponse
readList :: ReadS [ListContainerInstancesResponse]
$creadList :: ReadS [ListContainerInstancesResponse]
readsPrec :: Int -> ReadS ListContainerInstancesResponse
$creadsPrec :: Int -> ReadS ListContainerInstancesResponse
Prelude.Read, Int -> ListContainerInstancesResponse -> ShowS
[ListContainerInstancesResponse] -> ShowS
ListContainerInstancesResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListContainerInstancesResponse] -> ShowS
$cshowList :: [ListContainerInstancesResponse] -> ShowS
show :: ListContainerInstancesResponse -> String
$cshow :: ListContainerInstancesResponse -> String
showsPrec :: Int -> ListContainerInstancesResponse -> ShowS
$cshowsPrec :: Int -> ListContainerInstancesResponse -> ShowS
Prelude.Show, forall x.
Rep ListContainerInstancesResponse x
-> ListContainerInstancesResponse
forall x.
ListContainerInstancesResponse
-> Rep ListContainerInstancesResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ListContainerInstancesResponse x
-> ListContainerInstancesResponse
$cfrom :: forall x.
ListContainerInstancesResponse
-> Rep ListContainerInstancesResponse x
Prelude.Generic)

-- |
-- Create a value of 'ListContainerInstancesResponse' 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:
--
-- 'containerInstanceArns', 'listContainerInstancesResponse_containerInstanceArns' - The list of container instances with full ARN entries for each container
-- instance associated with the specified cluster.
--
-- 'nextToken', 'listContainerInstancesResponse_nextToken' - The @nextToken@ value to include in a future @ListContainerInstances@
-- request. When the results of a @ListContainerInstances@ request exceed
-- @maxResults@, this value can be used to retrieve the next page of
-- results. This value is @null@ when there are no more results to return.
--
-- 'httpStatus', 'listContainerInstancesResponse_httpStatus' - The response's http status code.
newListContainerInstancesResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ListContainerInstancesResponse
newListContainerInstancesResponse :: Int -> ListContainerInstancesResponse
newListContainerInstancesResponse Int
pHttpStatus_ =
  ListContainerInstancesResponse'
    { $sel:containerInstanceArns:ListContainerInstancesResponse' :: Maybe [Text]
containerInstanceArns =
        forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListContainerInstancesResponse' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ListContainerInstancesResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The list of container instances with full ARN entries for each container
-- instance associated with the specified cluster.
listContainerInstancesResponse_containerInstanceArns :: Lens.Lens' ListContainerInstancesResponse (Prelude.Maybe [Prelude.Text])
listContainerInstancesResponse_containerInstanceArns :: Lens' ListContainerInstancesResponse (Maybe [Text])
listContainerInstancesResponse_containerInstanceArns = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListContainerInstancesResponse' {Maybe [Text]
containerInstanceArns :: Maybe [Text]
$sel:containerInstanceArns:ListContainerInstancesResponse' :: ListContainerInstancesResponse -> Maybe [Text]
containerInstanceArns} -> Maybe [Text]
containerInstanceArns) (\s :: ListContainerInstancesResponse
s@ListContainerInstancesResponse' {} Maybe [Text]
a -> ListContainerInstancesResponse
s {$sel:containerInstanceArns:ListContainerInstancesResponse' :: Maybe [Text]
containerInstanceArns = Maybe [Text]
a} :: ListContainerInstancesResponse) 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 @nextToken@ value to include in a future @ListContainerInstances@
-- request. When the results of a @ListContainerInstances@ request exceed
-- @maxResults@, this value can be used to retrieve the next page of
-- results. This value is @null@ when there are no more results to return.
listContainerInstancesResponse_nextToken :: Lens.Lens' ListContainerInstancesResponse (Prelude.Maybe Prelude.Text)
listContainerInstancesResponse_nextToken :: Lens' ListContainerInstancesResponse (Maybe Text)
listContainerInstancesResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListContainerInstancesResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListContainerInstancesResponse' :: ListContainerInstancesResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListContainerInstancesResponse
s@ListContainerInstancesResponse' {} Maybe Text
a -> ListContainerInstancesResponse
s {$sel:nextToken:ListContainerInstancesResponse' :: Maybe Text
nextToken = Maybe Text
a} :: ListContainerInstancesResponse)

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

instance
  Prelude.NFData
    ListContainerInstancesResponse
  where
  rnf :: ListContainerInstancesResponse -> ()
rnf ListContainerInstancesResponse' {Int
Maybe [Text]
Maybe Text
httpStatus :: Int
nextToken :: Maybe Text
containerInstanceArns :: Maybe [Text]
$sel:httpStatus:ListContainerInstancesResponse' :: ListContainerInstancesResponse -> Int
$sel:nextToken:ListContainerInstancesResponse' :: ListContainerInstancesResponse -> Maybe Text
$sel:containerInstanceArns:ListContainerInstancesResponse' :: ListContainerInstancesResponse -> Maybe [Text]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
containerInstanceArns
      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