{-# 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.ListTasks
-- 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 tasks. You can filter the results by cluster, task
-- definition family, container instance, launch type, what IAM principal
-- started the task, or by the desired status of the task.
--
-- Recently stopped tasks might appear in the returned results. Currently,
-- stopped tasks appear in the returned results for at least one hour.
--
-- This operation returns paginated results.
module Amazonka.ECS.ListTasks
  ( -- * Creating a Request
    ListTasks (..),
    newListTasks,

    -- * Request Lenses
    listTasks_cluster,
    listTasks_containerInstance,
    listTasks_desiredStatus,
    listTasks_family,
    listTasks_launchType,
    listTasks_maxResults,
    listTasks_nextToken,
    listTasks_serviceName,
    listTasks_startedBy,

    -- * Destructuring the Response
    ListTasksResponse (..),
    newListTasksResponse,

    -- * Response Lenses
    listTasksResponse_nextToken,
    listTasksResponse_taskArns,
    listTasksResponse_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:/ 'newListTasks' smart constructor.
data ListTasks = ListTasks'
  { -- | The short name or full Amazon Resource Name (ARN) of the cluster to use
    -- when filtering the @ListTasks@ results. If you do not specify a cluster,
    -- the default cluster is assumed.
    ListTasks -> Maybe Text
cluster :: Prelude.Maybe Prelude.Text,
    -- | The container instance ID or full ARN of the container instance to use
    -- when filtering the @ListTasks@ results. Specifying a @containerInstance@
    -- limits the results to tasks that belong to that container instance.
    ListTasks -> Maybe Text
containerInstance :: Prelude.Maybe Prelude.Text,
    -- | The task desired status to use when filtering the @ListTasks@ results.
    -- Specifying a @desiredStatus@ of @STOPPED@ limits the results to tasks
    -- that Amazon ECS has set the desired status to @STOPPED@. This can be
    -- useful for debugging tasks that aren\'t starting properly or have died
    -- or finished. The default status filter is @RUNNING@, which shows tasks
    -- that Amazon ECS has set the desired status to @RUNNING@.
    --
    -- Although you can filter results based on a desired status of @PENDING@,
    -- this doesn\'t return any results. Amazon ECS never sets the desired
    -- status of a task to that value (only a task\'s @lastStatus@ may have a
    -- value of @PENDING@).
    ListTasks -> Maybe DesiredStatus
desiredStatus :: Prelude.Maybe DesiredStatus,
    -- | The name of the task definition family to use when filtering the
    -- @ListTasks@ results. Specifying a @family@ limits the results to tasks
    -- that belong to that family.
    ListTasks -> Maybe Text
family :: Prelude.Maybe Prelude.Text,
    -- | The launch type to use when filtering the @ListTasks@ results.
    ListTasks -> Maybe LaunchType
launchType :: Prelude.Maybe LaunchType,
    -- | The maximum number of task results that @ListTasks@ returned in
    -- paginated output. When this parameter is used, @ListTasks@ 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 @ListTasks@ request with the returned @nextToken@ value.
    -- This value can be between 1 and 100. If this parameter isn\'t used, then
    -- @ListTasks@ returns up to 100 results and a @nextToken@ value if
    -- applicable.
    ListTasks -> Maybe Int
maxResults :: Prelude.Maybe Prelude.Int,
    -- | The @nextToken@ value returned from a @ListTasks@ request indicating
    -- that more results are available to fulfill the request and further calls
    -- will be 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.
    ListTasks -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The name of the service to use when filtering the @ListTasks@ results.
    -- Specifying a @serviceName@ limits the results to tasks that belong to
    -- that service.
    ListTasks -> Maybe Text
serviceName :: Prelude.Maybe Prelude.Text,
    -- | The @startedBy@ value to filter the task results with. Specifying a
    -- @startedBy@ value limits the results to tasks that were started with
    -- that value.
    --
    -- When you specify @startedBy@ as the filter, it must be the only filter
    -- that you use.
    ListTasks -> Maybe Text
startedBy :: Prelude.Maybe Prelude.Text
  }
  deriving (ListTasks -> ListTasks -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListTasks -> ListTasks -> Bool
$c/= :: ListTasks -> ListTasks -> Bool
== :: ListTasks -> ListTasks -> Bool
$c== :: ListTasks -> ListTasks -> Bool
Prelude.Eq, ReadPrec [ListTasks]
ReadPrec ListTasks
Int -> ReadS ListTasks
ReadS [ListTasks]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListTasks]
$creadListPrec :: ReadPrec [ListTasks]
readPrec :: ReadPrec ListTasks
$creadPrec :: ReadPrec ListTasks
readList :: ReadS [ListTasks]
$creadList :: ReadS [ListTasks]
readsPrec :: Int -> ReadS ListTasks
$creadsPrec :: Int -> ReadS ListTasks
Prelude.Read, Int -> ListTasks -> ShowS
[ListTasks] -> ShowS
ListTasks -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListTasks] -> ShowS
$cshowList :: [ListTasks] -> ShowS
show :: ListTasks -> String
$cshow :: ListTasks -> String
showsPrec :: Int -> ListTasks -> ShowS
$cshowsPrec :: Int -> ListTasks -> ShowS
Prelude.Show, forall x. Rep ListTasks x -> ListTasks
forall x. ListTasks -> Rep ListTasks x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListTasks x -> ListTasks
$cfrom :: forall x. ListTasks -> Rep ListTasks x
Prelude.Generic)

-- |
-- Create a value of 'ListTasks' 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', 'listTasks_cluster' - The short name or full Amazon Resource Name (ARN) of the cluster to use
-- when filtering the @ListTasks@ results. If you do not specify a cluster,
-- the default cluster is assumed.
--
-- 'containerInstance', 'listTasks_containerInstance' - The container instance ID or full ARN of the container instance to use
-- when filtering the @ListTasks@ results. Specifying a @containerInstance@
-- limits the results to tasks that belong to that container instance.
--
-- 'desiredStatus', 'listTasks_desiredStatus' - The task desired status to use when filtering the @ListTasks@ results.
-- Specifying a @desiredStatus@ of @STOPPED@ limits the results to tasks
-- that Amazon ECS has set the desired status to @STOPPED@. This can be
-- useful for debugging tasks that aren\'t starting properly or have died
-- or finished. The default status filter is @RUNNING@, which shows tasks
-- that Amazon ECS has set the desired status to @RUNNING@.
--
-- Although you can filter results based on a desired status of @PENDING@,
-- this doesn\'t return any results. Amazon ECS never sets the desired
-- status of a task to that value (only a task\'s @lastStatus@ may have a
-- value of @PENDING@).
--
-- 'family', 'listTasks_family' - The name of the task definition family to use when filtering the
-- @ListTasks@ results. Specifying a @family@ limits the results to tasks
-- that belong to that family.
--
-- 'launchType', 'listTasks_launchType' - The launch type to use when filtering the @ListTasks@ results.
--
-- 'maxResults', 'listTasks_maxResults' - The maximum number of task results that @ListTasks@ returned in
-- paginated output. When this parameter is used, @ListTasks@ 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 @ListTasks@ request with the returned @nextToken@ value.
-- This value can be between 1 and 100. If this parameter isn\'t used, then
-- @ListTasks@ returns up to 100 results and a @nextToken@ value if
-- applicable.
--
-- 'nextToken', 'listTasks_nextToken' - The @nextToken@ value returned from a @ListTasks@ request indicating
-- that more results are available to fulfill the request and further calls
-- will be 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.
--
-- 'serviceName', 'listTasks_serviceName' - The name of the service to use when filtering the @ListTasks@ results.
-- Specifying a @serviceName@ limits the results to tasks that belong to
-- that service.
--
-- 'startedBy', 'listTasks_startedBy' - The @startedBy@ value to filter the task results with. Specifying a
-- @startedBy@ value limits the results to tasks that were started with
-- that value.
--
-- When you specify @startedBy@ as the filter, it must be the only filter
-- that you use.
newListTasks ::
  ListTasks
newListTasks :: ListTasks
newListTasks =
  ListTasks'
    { $sel:cluster:ListTasks' :: Maybe Text
cluster = forall a. Maybe a
Prelude.Nothing,
      $sel:containerInstance:ListTasks' :: Maybe Text
containerInstance = forall a. Maybe a
Prelude.Nothing,
      $sel:desiredStatus:ListTasks' :: Maybe DesiredStatus
desiredStatus = forall a. Maybe a
Prelude.Nothing,
      $sel:family:ListTasks' :: Maybe Text
family = forall a. Maybe a
Prelude.Nothing,
      $sel:launchType:ListTasks' :: Maybe LaunchType
launchType = forall a. Maybe a
Prelude.Nothing,
      $sel:maxResults:ListTasks' :: Maybe Int
maxResults = forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListTasks' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:serviceName:ListTasks' :: Maybe Text
serviceName = forall a. Maybe a
Prelude.Nothing,
      $sel:startedBy:ListTasks' :: Maybe Text
startedBy = forall a. Maybe a
Prelude.Nothing
    }

-- | The short name or full Amazon Resource Name (ARN) of the cluster to use
-- when filtering the @ListTasks@ results. If you do not specify a cluster,
-- the default cluster is assumed.
listTasks_cluster :: Lens.Lens' ListTasks (Prelude.Maybe Prelude.Text)
listTasks_cluster :: Lens' ListTasks (Maybe Text)
listTasks_cluster = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListTasks' {Maybe Text
cluster :: Maybe Text
$sel:cluster:ListTasks' :: ListTasks -> Maybe Text
cluster} -> Maybe Text
cluster) (\s :: ListTasks
s@ListTasks' {} Maybe Text
a -> ListTasks
s {$sel:cluster:ListTasks' :: Maybe Text
cluster = Maybe Text
a} :: ListTasks)

-- | The container instance ID or full ARN of the container instance to use
-- when filtering the @ListTasks@ results. Specifying a @containerInstance@
-- limits the results to tasks that belong to that container instance.
listTasks_containerInstance :: Lens.Lens' ListTasks (Prelude.Maybe Prelude.Text)
listTasks_containerInstance :: Lens' ListTasks (Maybe Text)
listTasks_containerInstance = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListTasks' {Maybe Text
containerInstance :: Maybe Text
$sel:containerInstance:ListTasks' :: ListTasks -> Maybe Text
containerInstance} -> Maybe Text
containerInstance) (\s :: ListTasks
s@ListTasks' {} Maybe Text
a -> ListTasks
s {$sel:containerInstance:ListTasks' :: Maybe Text
containerInstance = Maybe Text
a} :: ListTasks)

-- | The task desired status to use when filtering the @ListTasks@ results.
-- Specifying a @desiredStatus@ of @STOPPED@ limits the results to tasks
-- that Amazon ECS has set the desired status to @STOPPED@. This can be
-- useful for debugging tasks that aren\'t starting properly or have died
-- or finished. The default status filter is @RUNNING@, which shows tasks
-- that Amazon ECS has set the desired status to @RUNNING@.
--
-- Although you can filter results based on a desired status of @PENDING@,
-- this doesn\'t return any results. Amazon ECS never sets the desired
-- status of a task to that value (only a task\'s @lastStatus@ may have a
-- value of @PENDING@).
listTasks_desiredStatus :: Lens.Lens' ListTasks (Prelude.Maybe DesiredStatus)
listTasks_desiredStatus :: Lens' ListTasks (Maybe DesiredStatus)
listTasks_desiredStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListTasks' {Maybe DesiredStatus
desiredStatus :: Maybe DesiredStatus
$sel:desiredStatus:ListTasks' :: ListTasks -> Maybe DesiredStatus
desiredStatus} -> Maybe DesiredStatus
desiredStatus) (\s :: ListTasks
s@ListTasks' {} Maybe DesiredStatus
a -> ListTasks
s {$sel:desiredStatus:ListTasks' :: Maybe DesiredStatus
desiredStatus = Maybe DesiredStatus
a} :: ListTasks)

-- | The name of the task definition family to use when filtering the
-- @ListTasks@ results. Specifying a @family@ limits the results to tasks
-- that belong to that family.
listTasks_family :: Lens.Lens' ListTasks (Prelude.Maybe Prelude.Text)
listTasks_family :: Lens' ListTasks (Maybe Text)
listTasks_family = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListTasks' {Maybe Text
family :: Maybe Text
$sel:family:ListTasks' :: ListTasks -> Maybe Text
family} -> Maybe Text
family) (\s :: ListTasks
s@ListTasks' {} Maybe Text
a -> ListTasks
s {$sel:family:ListTasks' :: Maybe Text
family = Maybe Text
a} :: ListTasks)

-- | The launch type to use when filtering the @ListTasks@ results.
listTasks_launchType :: Lens.Lens' ListTasks (Prelude.Maybe LaunchType)
listTasks_launchType :: Lens' ListTasks (Maybe LaunchType)
listTasks_launchType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListTasks' {Maybe LaunchType
launchType :: Maybe LaunchType
$sel:launchType:ListTasks' :: ListTasks -> Maybe LaunchType
launchType} -> Maybe LaunchType
launchType) (\s :: ListTasks
s@ListTasks' {} Maybe LaunchType
a -> ListTasks
s {$sel:launchType:ListTasks' :: Maybe LaunchType
launchType = Maybe LaunchType
a} :: ListTasks)

-- | The maximum number of task results that @ListTasks@ returned in
-- paginated output. When this parameter is used, @ListTasks@ 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 @ListTasks@ request with the returned @nextToken@ value.
-- This value can be between 1 and 100. If this parameter isn\'t used, then
-- @ListTasks@ returns up to 100 results and a @nextToken@ value if
-- applicable.
listTasks_maxResults :: Lens.Lens' ListTasks (Prelude.Maybe Prelude.Int)
listTasks_maxResults :: Lens' ListTasks (Maybe Int)
listTasks_maxResults = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListTasks' {Maybe Int
maxResults :: Maybe Int
$sel:maxResults:ListTasks' :: ListTasks -> Maybe Int
maxResults} -> Maybe Int
maxResults) (\s :: ListTasks
s@ListTasks' {} Maybe Int
a -> ListTasks
s {$sel:maxResults:ListTasks' :: Maybe Int
maxResults = Maybe Int
a} :: ListTasks)

-- | The @nextToken@ value returned from a @ListTasks@ request indicating
-- that more results are available to fulfill the request and further calls
-- will be 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.
listTasks_nextToken :: Lens.Lens' ListTasks (Prelude.Maybe Prelude.Text)
listTasks_nextToken :: Lens' ListTasks (Maybe Text)
listTasks_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListTasks' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListTasks' :: ListTasks -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListTasks
s@ListTasks' {} Maybe Text
a -> ListTasks
s {$sel:nextToken:ListTasks' :: Maybe Text
nextToken = Maybe Text
a} :: ListTasks)

-- | The name of the service to use when filtering the @ListTasks@ results.
-- Specifying a @serviceName@ limits the results to tasks that belong to
-- that service.
listTasks_serviceName :: Lens.Lens' ListTasks (Prelude.Maybe Prelude.Text)
listTasks_serviceName :: Lens' ListTasks (Maybe Text)
listTasks_serviceName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListTasks' {Maybe Text
serviceName :: Maybe Text
$sel:serviceName:ListTasks' :: ListTasks -> Maybe Text
serviceName} -> Maybe Text
serviceName) (\s :: ListTasks
s@ListTasks' {} Maybe Text
a -> ListTasks
s {$sel:serviceName:ListTasks' :: Maybe Text
serviceName = Maybe Text
a} :: ListTasks)

-- | The @startedBy@ value to filter the task results with. Specifying a
-- @startedBy@ value limits the results to tasks that were started with
-- that value.
--
-- When you specify @startedBy@ as the filter, it must be the only filter
-- that you use.
listTasks_startedBy :: Lens.Lens' ListTasks (Prelude.Maybe Prelude.Text)
listTasks_startedBy :: Lens' ListTasks (Maybe Text)
listTasks_startedBy = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListTasks' {Maybe Text
startedBy :: Maybe Text
$sel:startedBy:ListTasks' :: ListTasks -> Maybe Text
startedBy} -> Maybe Text
startedBy) (\s :: ListTasks
s@ListTasks' {} Maybe Text
a -> ListTasks
s {$sel:startedBy:ListTasks' :: Maybe Text
startedBy = Maybe Text
a} :: ListTasks)

instance Core.AWSPager ListTasks where
  page :: ListTasks -> AWSResponse ListTasks -> Maybe ListTasks
page ListTasks
rq AWSResponse ListTasks
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse ListTasks
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListTasksResponse (Maybe Text)
listTasksResponse_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 ListTasks
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListTasksResponse (Maybe [Text])
listTasksResponse_taskArns
            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.$ ListTasks
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' ListTasks (Maybe Text)
listTasks_nextToken
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse ListTasks
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListTasksResponse (Maybe Text)
listTasksResponse_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 ListTasks where
  type AWSResponse ListTasks = ListTasksResponse
  request :: (Service -> Service) -> ListTasks -> Request ListTasks
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 ListTasks
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse ListTasks)))
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 -> ListTasksResponse
ListTasksResponse'
            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
"nextToken")
            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
"taskArns" 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.<*> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
      )

instance Prelude.Hashable ListTasks where
  hashWithSalt :: Int -> ListTasks -> Int
hashWithSalt Int
_salt ListTasks' {Maybe Int
Maybe Text
Maybe DesiredStatus
Maybe LaunchType
startedBy :: Maybe Text
serviceName :: Maybe Text
nextToken :: Maybe Text
maxResults :: Maybe Int
launchType :: Maybe LaunchType
family :: Maybe Text
desiredStatus :: Maybe DesiredStatus
containerInstance :: Maybe Text
cluster :: Maybe Text
$sel:startedBy:ListTasks' :: ListTasks -> Maybe Text
$sel:serviceName:ListTasks' :: ListTasks -> Maybe Text
$sel:nextToken:ListTasks' :: ListTasks -> Maybe Text
$sel:maxResults:ListTasks' :: ListTasks -> Maybe Int
$sel:launchType:ListTasks' :: ListTasks -> Maybe LaunchType
$sel:family:ListTasks' :: ListTasks -> Maybe Text
$sel:desiredStatus:ListTasks' :: ListTasks -> Maybe DesiredStatus
$sel:containerInstance:ListTasks' :: ListTasks -> Maybe Text
$sel:cluster:ListTasks' :: ListTasks -> 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
containerInstance
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe DesiredStatus
desiredStatus
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
family
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe LaunchType
launchType
      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 Text
serviceName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
startedBy

instance Prelude.NFData ListTasks where
  rnf :: ListTasks -> ()
rnf ListTasks' {Maybe Int
Maybe Text
Maybe DesiredStatus
Maybe LaunchType
startedBy :: Maybe Text
serviceName :: Maybe Text
nextToken :: Maybe Text
maxResults :: Maybe Int
launchType :: Maybe LaunchType
family :: Maybe Text
desiredStatus :: Maybe DesiredStatus
containerInstance :: Maybe Text
cluster :: Maybe Text
$sel:startedBy:ListTasks' :: ListTasks -> Maybe Text
$sel:serviceName:ListTasks' :: ListTasks -> Maybe Text
$sel:nextToken:ListTasks' :: ListTasks -> Maybe Text
$sel:maxResults:ListTasks' :: ListTasks -> Maybe Int
$sel:launchType:ListTasks' :: ListTasks -> Maybe LaunchType
$sel:family:ListTasks' :: ListTasks -> Maybe Text
$sel:desiredStatus:ListTasks' :: ListTasks -> Maybe DesiredStatus
$sel:containerInstance:ListTasks' :: ListTasks -> Maybe Text
$sel:cluster:ListTasks' :: ListTasks -> 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
containerInstance
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe DesiredStatus
desiredStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
family
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe LaunchType
launchType
      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 Text
serviceName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
startedBy

instance Data.ToHeaders ListTasks where
  toHeaders :: ListTasks -> 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.ListTasks" ::
                          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 ListTasks where
  toJSON :: ListTasks -> Value
toJSON ListTasks' {Maybe Int
Maybe Text
Maybe DesiredStatus
Maybe LaunchType
startedBy :: Maybe Text
serviceName :: Maybe Text
nextToken :: Maybe Text
maxResults :: Maybe Int
launchType :: Maybe LaunchType
family :: Maybe Text
desiredStatus :: Maybe DesiredStatus
containerInstance :: Maybe Text
cluster :: Maybe Text
$sel:startedBy:ListTasks' :: ListTasks -> Maybe Text
$sel:serviceName:ListTasks' :: ListTasks -> Maybe Text
$sel:nextToken:ListTasks' :: ListTasks -> Maybe Text
$sel:maxResults:ListTasks' :: ListTasks -> Maybe Int
$sel:launchType:ListTasks' :: ListTasks -> Maybe LaunchType
$sel:family:ListTasks' :: ListTasks -> Maybe Text
$sel:desiredStatus:ListTasks' :: ListTasks -> Maybe DesiredStatus
$sel:containerInstance:ListTasks' :: ListTasks -> Maybe Text
$sel:cluster:ListTasks' :: ListTasks -> 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
"containerInstance" 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
containerInstance,
            (Key
"desiredStatus" 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 DesiredStatus
desiredStatus,
            (Key
"family" 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
family,
            (Key
"launchType" 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 LaunchType
launchType,
            (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
"serviceName" 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
serviceName,
            (Key
"startedBy" 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
startedBy
          ]
      )

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

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

-- | /See:/ 'newListTasksResponse' smart constructor.
data ListTasksResponse = ListTasksResponse'
  { -- | The @nextToken@ value to include in a future @ListTasks@ request. When
    -- the results of a @ListTasks@ 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.
    ListTasksResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The list of task ARN entries for the @ListTasks@ request.
    ListTasksResponse -> Maybe [Text]
taskArns :: Prelude.Maybe [Prelude.Text],
    -- | The response's http status code.
    ListTasksResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ListTasksResponse -> ListTasksResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListTasksResponse -> ListTasksResponse -> Bool
$c/= :: ListTasksResponse -> ListTasksResponse -> Bool
== :: ListTasksResponse -> ListTasksResponse -> Bool
$c== :: ListTasksResponse -> ListTasksResponse -> Bool
Prelude.Eq, ReadPrec [ListTasksResponse]
ReadPrec ListTasksResponse
Int -> ReadS ListTasksResponse
ReadS [ListTasksResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListTasksResponse]
$creadListPrec :: ReadPrec [ListTasksResponse]
readPrec :: ReadPrec ListTasksResponse
$creadPrec :: ReadPrec ListTasksResponse
readList :: ReadS [ListTasksResponse]
$creadList :: ReadS [ListTasksResponse]
readsPrec :: Int -> ReadS ListTasksResponse
$creadsPrec :: Int -> ReadS ListTasksResponse
Prelude.Read, Int -> ListTasksResponse -> ShowS
[ListTasksResponse] -> ShowS
ListTasksResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListTasksResponse] -> ShowS
$cshowList :: [ListTasksResponse] -> ShowS
show :: ListTasksResponse -> String
$cshow :: ListTasksResponse -> String
showsPrec :: Int -> ListTasksResponse -> ShowS
$cshowsPrec :: Int -> ListTasksResponse -> ShowS
Prelude.Show, forall x. Rep ListTasksResponse x -> ListTasksResponse
forall x. ListTasksResponse -> Rep ListTasksResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListTasksResponse x -> ListTasksResponse
$cfrom :: forall x. ListTasksResponse -> Rep ListTasksResponse x
Prelude.Generic)

-- |
-- Create a value of 'ListTasksResponse' 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:
--
-- 'nextToken', 'listTasksResponse_nextToken' - The @nextToken@ value to include in a future @ListTasks@ request. When
-- the results of a @ListTasks@ 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.
--
-- 'taskArns', 'listTasksResponse_taskArns' - The list of task ARN entries for the @ListTasks@ request.
--
-- 'httpStatus', 'listTasksResponse_httpStatus' - The response's http status code.
newListTasksResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ListTasksResponse
newListTasksResponse :: Int -> ListTasksResponse
newListTasksResponse Int
pHttpStatus_ =
  ListTasksResponse'
    { $sel:nextToken:ListTasksResponse' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:taskArns:ListTasksResponse' :: Maybe [Text]
taskArns = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ListTasksResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The @nextToken@ value to include in a future @ListTasks@ request. When
-- the results of a @ListTasks@ 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.
listTasksResponse_nextToken :: Lens.Lens' ListTasksResponse (Prelude.Maybe Prelude.Text)
listTasksResponse_nextToken :: Lens' ListTasksResponse (Maybe Text)
listTasksResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListTasksResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListTasksResponse' :: ListTasksResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListTasksResponse
s@ListTasksResponse' {} Maybe Text
a -> ListTasksResponse
s {$sel:nextToken:ListTasksResponse' :: Maybe Text
nextToken = Maybe Text
a} :: ListTasksResponse)

-- | The list of task ARN entries for the @ListTasks@ request.
listTasksResponse_taskArns :: Lens.Lens' ListTasksResponse (Prelude.Maybe [Prelude.Text])
listTasksResponse_taskArns :: Lens' ListTasksResponse (Maybe [Text])
listTasksResponse_taskArns = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListTasksResponse' {Maybe [Text]
taskArns :: Maybe [Text]
$sel:taskArns:ListTasksResponse' :: ListTasksResponse -> Maybe [Text]
taskArns} -> Maybe [Text]
taskArns) (\s :: ListTasksResponse
s@ListTasksResponse' {} Maybe [Text]
a -> ListTasksResponse
s {$sel:taskArns:ListTasksResponse' :: Maybe [Text]
taskArns = Maybe [Text]
a} :: ListTasksResponse) 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 response's http status code.
listTasksResponse_httpStatus :: Lens.Lens' ListTasksResponse Prelude.Int
listTasksResponse_httpStatus :: Lens' ListTasksResponse Int
listTasksResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListTasksResponse' {Int
httpStatus :: Int
$sel:httpStatus:ListTasksResponse' :: ListTasksResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: ListTasksResponse
s@ListTasksResponse' {} Int
a -> ListTasksResponse
s {$sel:httpStatus:ListTasksResponse' :: Int
httpStatus = Int
a} :: ListTasksResponse)

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