{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
{-# OPTIONS_GHC -fno-warn-unused-matches #-}

-- Derived from AWS service descriptions, licensed under Apache 2.0.

-- |
-- Module      : Amazonka.ECS.Types.Task
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
module Amazonka.ECS.Types.Task 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.Attachment
import Amazonka.ECS.Types.Attribute
import Amazonka.ECS.Types.Connectivity
import Amazonka.ECS.Types.Container
import Amazonka.ECS.Types.EphemeralStorage
import Amazonka.ECS.Types.HealthStatus
import Amazonka.ECS.Types.InferenceAccelerator
import Amazonka.ECS.Types.LaunchType
import Amazonka.ECS.Types.Tag
import Amazonka.ECS.Types.TaskOverride
import Amazonka.ECS.Types.TaskStopCode
import qualified Amazonka.Prelude as Prelude

-- | Details on a task in a cluster.
--
-- /See:/ 'newTask' smart constructor.
data Task = Task'
  { -- | The Elastic Network Adapter that\'s associated with the task if the task
    -- uses the @awsvpc@ network mode.
    Task -> Maybe [Attachment]
attachments :: Prelude.Maybe [Attachment],
    -- | The attributes of the task
    Task -> Maybe [Attribute]
attributes :: Prelude.Maybe [Attribute],
    -- | The Availability Zone for the task.
    Task -> Maybe Text
availabilityZone :: Prelude.Maybe Prelude.Text,
    -- | The capacity provider that\'s associated with the task.
    Task -> Maybe Text
capacityProviderName :: Prelude.Maybe Prelude.Text,
    -- | The ARN of the cluster that hosts the task.
    Task -> Maybe Text
clusterArn :: Prelude.Maybe Prelude.Text,
    -- | The connectivity status of a task.
    Task -> Maybe Connectivity
connectivity :: Prelude.Maybe Connectivity,
    -- | The Unix timestamp for the time when the task last went into @CONNECTED@
    -- status.
    Task -> Maybe POSIX
connectivityAt :: Prelude.Maybe Data.POSIX,
    -- | The ARN of the container instances that host the task.
    Task -> Maybe Text
containerInstanceArn :: Prelude.Maybe Prelude.Text,
    -- | The containers that\'s associated with the task.
    Task -> Maybe [Container]
containers :: Prelude.Maybe [Container],
    -- | The number of CPU units used by the task as expressed in a task
    -- definition. It can be expressed as an integer using CPU units (for
    -- example, @1024@). It can also be expressed as a string using vCPUs (for
    -- example, @1 vCPU@ or @1 vcpu@). String values are converted to an
    -- integer that indicates the CPU units when the task definition is
    -- registered.
    --
    -- If you use the EC2 launch type, this field is optional. Supported values
    -- are between @128@ CPU units (@0.125@ vCPUs) and @10240@ CPU units (@10@
    -- vCPUs).
    --
    -- If you use the Fargate launch type, this field is required. You must use
    -- one of the following values. These values determine the range of
    -- supported values for the @memory@ parameter:
    --
    -- The CPU units cannot be less than 1 vCPU when you use Windows containers
    -- on Fargate.
    --
    -- -   256 (.25 vCPU) - Available @memory@ values: 512 (0.5 GB), 1024 (1
    --     GB), 2048 (2 GB)
    --
    -- -   512 (.5 vCPU) - Available @memory@ values: 1024 (1 GB), 2048 (2 GB),
    --     3072 (3 GB), 4096 (4 GB)
    --
    -- -   1024 (1 vCPU) - Available @memory@ values: 2048 (2 GB), 3072 (3 GB),
    --     4096 (4 GB), 5120 (5 GB), 6144 (6 GB), 7168 (7 GB), 8192 (8 GB)
    --
    -- -   2048 (2 vCPU) - Available @memory@ values: 4096 (4 GB) and 16384 (16
    --     GB) in increments of 1024 (1 GB)
    --
    -- -   4096 (4 vCPU) - Available @memory@ values: 8192 (8 GB) and 30720 (30
    --     GB) in increments of 1024 (1 GB)
    --
    -- -   8192 (8 vCPU) - Available @memory@ values: 16 GB and 60 GB in 4 GB
    --     increments
    --
    --     This option requires Linux platform @1.4.0@ or later.
    --
    -- -   16384 (16vCPU) - Available @memory@ values: 32GB and 120 GB in 8 GB
    --     increments
    --
    --     This option requires Linux platform @1.4.0@ or later.
    Task -> Maybe Text
cpu :: Prelude.Maybe Prelude.Text,
    -- | The Unix timestamp for the time when the task was created. More
    -- specifically, it\'s for the time when the task entered the @PENDING@
    -- state.
    Task -> Maybe POSIX
createdAt :: Prelude.Maybe Data.POSIX,
    -- | The desired status of the task. For more information, see
    -- <https://docs.aws.amazon.com/AmazonECS/latest/developerguide/task-lifecycle.html Task Lifecycle>.
    Task -> Maybe Text
desiredStatus :: Prelude.Maybe Prelude.Text,
    -- | Determines whether execute command functionality is enabled for this
    -- task. If @true@, execute command functionality is enabled on all the
    -- containers in the task.
    Task -> Maybe Bool
enableExecuteCommand :: Prelude.Maybe Prelude.Bool,
    -- | The ephemeral storage settings for the task.
    Task -> Maybe EphemeralStorage
ephemeralStorage :: Prelude.Maybe EphemeralStorage,
    -- | The Unix timestamp for the time when the task execution stopped.
    Task -> Maybe POSIX
executionStoppedAt :: Prelude.Maybe Data.POSIX,
    -- | The name of the task group that\'s associated with the task.
    Task -> Maybe Text
group' :: Prelude.Maybe Prelude.Text,
    -- | The health status for the task. It\'s determined by the health of the
    -- essential containers in the task. If all essential containers in the
    -- task are reporting as @HEALTHY@, the task status also reports as
    -- @HEALTHY@. If any essential containers in the task are reporting as
    -- @UNHEALTHY@ or @UNKNOWN@, the task status also reports as @UNHEALTHY@ or
    -- @UNKNOWN@.
    --
    -- The Amazon ECS container agent doesn\'t monitor or report on Docker
    -- health checks that are embedded in a container image and not specified
    -- in the container definition. For example, this includes those specified
    -- in a parent image or from the image\'s Dockerfile. Health check
    -- parameters that are specified in a container definition override any
    -- Docker health checks that are found in the container image.
    Task -> Maybe HealthStatus
healthStatus :: Prelude.Maybe HealthStatus,
    -- | The Elastic Inference accelerator that\'s associated with the task.
    Task -> Maybe [InferenceAccelerator]
inferenceAccelerators :: Prelude.Maybe [InferenceAccelerator],
    -- | The last known status for the task. For more information, see
    -- <https://docs.aws.amazon.com/AmazonECS/latest/developerguide/task-lifecycle.html Task Lifecycle>.
    Task -> Maybe Text
lastStatus :: Prelude.Maybe Prelude.Text,
    -- | The infrastructure where your task runs on. For more information, see
    -- <https://docs.aws.amazon.com/AmazonECS/latest/developerguide/launch_types.html Amazon ECS launch types>
    -- in the /Amazon Elastic Container Service Developer Guide/.
    Task -> Maybe LaunchType
launchType :: Prelude.Maybe LaunchType,
    -- | The amount of memory (in MiB) that the task uses as expressed in a task
    -- definition. It can be expressed as an integer using MiB (for example,
    -- @1024@). If it\'s expressed as a string using GB (for example, @1GB@ or
    -- @1 GB@), it\'s converted to an integer indicating the MiB when the task
    -- definition is registered.
    --
    -- If you use the EC2 launch type, this field is optional.
    --
    -- If you use the Fargate launch type, this field is required. You must use
    -- one of the following values. The value that you choose determines the
    -- range of supported values for the @cpu@ parameter.
    --
    -- -   512 (0.5 GB), 1024 (1 GB), 2048 (2 GB) - Available @cpu@ values: 256
    --     (.25 vCPU)
    --
    -- -   1024 (1 GB), 2048 (2 GB), 3072 (3 GB), 4096 (4 GB) - Available @cpu@
    --     values: 512 (.5 vCPU)
    --
    -- -   2048 (2 GB), 3072 (3 GB), 4096 (4 GB), 5120 (5 GB), 6144 (6 GB),
    --     7168 (7 GB), 8192 (8 GB) - Available @cpu@ values: 1024 (1 vCPU)
    --
    -- -   Between 4096 (4 GB) and 16384 (16 GB) in increments of 1024 (1 GB) -
    --     Available @cpu@ values: 2048 (2 vCPU)
    --
    -- -   Between 8192 (8 GB) and 30720 (30 GB) in increments of 1024 (1 GB) -
    --     Available @cpu@ values: 4096 (4 vCPU)
    --
    -- -   Between 16 GB and 60 GB in 4 GB increments - Available @cpu@ values:
    --     8192 (8 vCPU)
    --
    --     This option requires Linux platform @1.4.0@ or later.
    --
    -- -   Between 32GB and 120 GB in 8 GB increments - Available @cpu@ values:
    --     16384 (16 vCPU)
    --
    --     This option requires Linux platform @1.4.0@ or later.
    Task -> Maybe Text
memory :: Prelude.Maybe Prelude.Text,
    -- | One or more container overrides.
    Task -> Maybe TaskOverride
overrides :: Prelude.Maybe TaskOverride,
    -- | The operating system that your tasks are running on. A platform family
    -- is specified only for tasks that use the Fargate launch type.
    --
    -- All tasks that run as part of this service must use the same
    -- @platformFamily@ value as the service (for example, @LINUX.@).
    Task -> Maybe Text
platformFamily :: Prelude.Maybe Prelude.Text,
    -- | The platform version where your task runs on. A platform version is only
    -- specified for tasks that use the Fargate launch type. If you didn\'t
    -- specify one, the @LATEST@ platform version is used. For more
    -- information, see
    -- <https://docs.aws.amazon.com/AmazonECS/latest/developerguide/platform_versions.html Fargate Platform Versions>
    -- in the /Amazon Elastic Container Service Developer Guide/.
    Task -> Maybe Text
platformVersion :: Prelude.Maybe Prelude.Text,
    -- | The Unix timestamp for the time when the container image pull began.
    Task -> Maybe POSIX
pullStartedAt :: Prelude.Maybe Data.POSIX,
    -- | The Unix timestamp for the time when the container image pull completed.
    Task -> Maybe POSIX
pullStoppedAt :: Prelude.Maybe Data.POSIX,
    -- | The Unix timestamp for the time when the task started. More
    -- specifically, it\'s for the time when the task transitioned from the
    -- @PENDING@ state to the @RUNNING@ state.
    Task -> Maybe POSIX
startedAt :: Prelude.Maybe Data.POSIX,
    -- | The tag specified when a task is started. If an Amazon ECS service
    -- started the task, the @startedBy@ parameter contains the deployment ID
    -- of that service.
    Task -> Maybe Text
startedBy :: Prelude.Maybe Prelude.Text,
    -- | The stop code indicating why a task was stopped. The @stoppedReason@
    -- might contain additional details.
    --
    -- The following are valid values:
    --
    -- -   @TaskFailedToStart@
    --
    -- -   @EssentialContainerExited@
    --
    -- -   @UserInitiated@
    --
    -- -   @TerminationNotice@
    --
    -- -   @ServiceSchedulerInitiated@
    --
    -- -   @SpotInterruption@
    Task -> Maybe TaskStopCode
stopCode :: Prelude.Maybe TaskStopCode,
    -- | The Unix timestamp for the time when the task was stopped. More
    -- specifically, it\'s for the time when the task transitioned from the
    -- @RUNNING@ state to the @STOPPED@ state.
    Task -> Maybe POSIX
stoppedAt :: Prelude.Maybe Data.POSIX,
    -- | The reason that the task was stopped.
    Task -> Maybe Text
stoppedReason :: Prelude.Maybe Prelude.Text,
    -- | The Unix timestamp for the time when the task stops. More specifically,
    -- it\'s for the time when the task transitions from the @RUNNING@ state to
    -- @STOPPED@.
    Task -> Maybe POSIX
stoppingAt :: Prelude.Maybe Data.POSIX,
    -- | The metadata that you apply to the task to help you categorize and
    -- organize the task. Each tag consists of a key and an optional value. You
    -- define both the key and value.
    --
    -- The following basic restrictions apply to tags:
    --
    -- -   Maximum number of tags per resource - 50
    --
    -- -   For each resource, each tag key must be unique, and each tag key can
    --     have only one value.
    --
    -- -   Maximum key length - 128 Unicode characters in UTF-8
    --
    -- -   Maximum value length - 256 Unicode characters in UTF-8
    --
    -- -   If your tagging schema is used across multiple services and
    --     resources, remember that other services may have restrictions on
    --     allowed characters. Generally allowed characters are: letters,
    --     numbers, and spaces representable in UTF-8, and the following
    --     characters: + - = . _ : \/ \@.
    --
    -- -   Tag keys and values are case-sensitive.
    --
    -- -   Do not use @aws:@, @AWS:@, or any upper or lowercase combination of
    --     such as a prefix for either keys or values as it is reserved for
    --     Amazon Web Services use. You cannot edit or delete tag keys or
    --     values with this prefix. Tags with this prefix do not count against
    --     your tags per resource limit.
    Task -> Maybe [Tag]
tags :: Prelude.Maybe [Tag],
    -- | The Amazon Resource Name (ARN) of the task.
    Task -> Maybe Text
taskArn :: Prelude.Maybe Prelude.Text,
    -- | The ARN of the task definition that creates the task.
    Task -> Maybe Text
taskDefinitionArn :: Prelude.Maybe Prelude.Text,
    -- | The version counter for the task. Every time a task experiences a change
    -- that starts a CloudWatch event, the version counter is incremented. If
    -- you replicate your Amazon ECS task state with CloudWatch Events, you can
    -- compare the version of a task reported by the Amazon ECS API actions
    -- with the version reported in CloudWatch Events for the task (inside the
    -- @detail@ object) to verify that the version in your event stream is
    -- current.
    Task -> Maybe Integer
version :: Prelude.Maybe Prelude.Integer
  }
  deriving (Task -> Task -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Task -> Task -> Bool
$c/= :: Task -> Task -> Bool
== :: Task -> Task -> Bool
$c== :: Task -> Task -> Bool
Prelude.Eq, ReadPrec [Task]
ReadPrec Task
Int -> ReadS Task
ReadS [Task]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Task]
$creadListPrec :: ReadPrec [Task]
readPrec :: ReadPrec Task
$creadPrec :: ReadPrec Task
readList :: ReadS [Task]
$creadList :: ReadS [Task]
readsPrec :: Int -> ReadS Task
$creadsPrec :: Int -> ReadS Task
Prelude.Read, Int -> Task -> ShowS
[Task] -> ShowS
Task -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Task] -> ShowS
$cshowList :: [Task] -> ShowS
show :: Task -> String
$cshow :: Task -> String
showsPrec :: Int -> Task -> ShowS
$cshowsPrec :: Int -> Task -> ShowS
Prelude.Show, forall x. Rep Task x -> Task
forall x. Task -> Rep Task x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Task x -> Task
$cfrom :: forall x. Task -> Rep Task x
Prelude.Generic)

-- |
-- Create a value of 'Task' 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:
--
-- 'attachments', 'task_attachments' - The Elastic Network Adapter that\'s associated with the task if the task
-- uses the @awsvpc@ network mode.
--
-- 'attributes', 'task_attributes' - The attributes of the task
--
-- 'availabilityZone', 'task_availabilityZone' - The Availability Zone for the task.
--
-- 'capacityProviderName', 'task_capacityProviderName' - The capacity provider that\'s associated with the task.
--
-- 'clusterArn', 'task_clusterArn' - The ARN of the cluster that hosts the task.
--
-- 'connectivity', 'task_connectivity' - The connectivity status of a task.
--
-- 'connectivityAt', 'task_connectivityAt' - The Unix timestamp for the time when the task last went into @CONNECTED@
-- status.
--
-- 'containerInstanceArn', 'task_containerInstanceArn' - The ARN of the container instances that host the task.
--
-- 'containers', 'task_containers' - The containers that\'s associated with the task.
--
-- 'cpu', 'task_cpu' - The number of CPU units used by the task as expressed in a task
-- definition. It can be expressed as an integer using CPU units (for
-- example, @1024@). It can also be expressed as a string using vCPUs (for
-- example, @1 vCPU@ or @1 vcpu@). String values are converted to an
-- integer that indicates the CPU units when the task definition is
-- registered.
--
-- If you use the EC2 launch type, this field is optional. Supported values
-- are between @128@ CPU units (@0.125@ vCPUs) and @10240@ CPU units (@10@
-- vCPUs).
--
-- If you use the Fargate launch type, this field is required. You must use
-- one of the following values. These values determine the range of
-- supported values for the @memory@ parameter:
--
-- The CPU units cannot be less than 1 vCPU when you use Windows containers
-- on Fargate.
--
-- -   256 (.25 vCPU) - Available @memory@ values: 512 (0.5 GB), 1024 (1
--     GB), 2048 (2 GB)
--
-- -   512 (.5 vCPU) - Available @memory@ values: 1024 (1 GB), 2048 (2 GB),
--     3072 (3 GB), 4096 (4 GB)
--
-- -   1024 (1 vCPU) - Available @memory@ values: 2048 (2 GB), 3072 (3 GB),
--     4096 (4 GB), 5120 (5 GB), 6144 (6 GB), 7168 (7 GB), 8192 (8 GB)
--
-- -   2048 (2 vCPU) - Available @memory@ values: 4096 (4 GB) and 16384 (16
--     GB) in increments of 1024 (1 GB)
--
-- -   4096 (4 vCPU) - Available @memory@ values: 8192 (8 GB) and 30720 (30
--     GB) in increments of 1024 (1 GB)
--
-- -   8192 (8 vCPU) - Available @memory@ values: 16 GB and 60 GB in 4 GB
--     increments
--
--     This option requires Linux platform @1.4.0@ or later.
--
-- -   16384 (16vCPU) - Available @memory@ values: 32GB and 120 GB in 8 GB
--     increments
--
--     This option requires Linux platform @1.4.0@ or later.
--
-- 'createdAt', 'task_createdAt' - The Unix timestamp for the time when the task was created. More
-- specifically, it\'s for the time when the task entered the @PENDING@
-- state.
--
-- 'desiredStatus', 'task_desiredStatus' - The desired status of the task. For more information, see
-- <https://docs.aws.amazon.com/AmazonECS/latest/developerguide/task-lifecycle.html Task Lifecycle>.
--
-- 'enableExecuteCommand', 'task_enableExecuteCommand' - Determines whether execute command functionality is enabled for this
-- task. If @true@, execute command functionality is enabled on all the
-- containers in the task.
--
-- 'ephemeralStorage', 'task_ephemeralStorage' - The ephemeral storage settings for the task.
--
-- 'executionStoppedAt', 'task_executionStoppedAt' - The Unix timestamp for the time when the task execution stopped.
--
-- 'group'', 'task_group' - The name of the task group that\'s associated with the task.
--
-- 'healthStatus', 'task_healthStatus' - The health status for the task. It\'s determined by the health of the
-- essential containers in the task. If all essential containers in the
-- task are reporting as @HEALTHY@, the task status also reports as
-- @HEALTHY@. If any essential containers in the task are reporting as
-- @UNHEALTHY@ or @UNKNOWN@, the task status also reports as @UNHEALTHY@ or
-- @UNKNOWN@.
--
-- The Amazon ECS container agent doesn\'t monitor or report on Docker
-- health checks that are embedded in a container image and not specified
-- in the container definition. For example, this includes those specified
-- in a parent image or from the image\'s Dockerfile. Health check
-- parameters that are specified in a container definition override any
-- Docker health checks that are found in the container image.
--
-- 'inferenceAccelerators', 'task_inferenceAccelerators' - The Elastic Inference accelerator that\'s associated with the task.
--
-- 'lastStatus', 'task_lastStatus' - The last known status for the task. For more information, see
-- <https://docs.aws.amazon.com/AmazonECS/latest/developerguide/task-lifecycle.html Task Lifecycle>.
--
-- 'launchType', 'task_launchType' - The infrastructure where your task runs on. For more information, see
-- <https://docs.aws.amazon.com/AmazonECS/latest/developerguide/launch_types.html Amazon ECS launch types>
-- in the /Amazon Elastic Container Service Developer Guide/.
--
-- 'memory', 'task_memory' - The amount of memory (in MiB) that the task uses as expressed in a task
-- definition. It can be expressed as an integer using MiB (for example,
-- @1024@). If it\'s expressed as a string using GB (for example, @1GB@ or
-- @1 GB@), it\'s converted to an integer indicating the MiB when the task
-- definition is registered.
--
-- If you use the EC2 launch type, this field is optional.
--
-- If you use the Fargate launch type, this field is required. You must use
-- one of the following values. The value that you choose determines the
-- range of supported values for the @cpu@ parameter.
--
-- -   512 (0.5 GB), 1024 (1 GB), 2048 (2 GB) - Available @cpu@ values: 256
--     (.25 vCPU)
--
-- -   1024 (1 GB), 2048 (2 GB), 3072 (3 GB), 4096 (4 GB) - Available @cpu@
--     values: 512 (.5 vCPU)
--
-- -   2048 (2 GB), 3072 (3 GB), 4096 (4 GB), 5120 (5 GB), 6144 (6 GB),
--     7168 (7 GB), 8192 (8 GB) - Available @cpu@ values: 1024 (1 vCPU)
--
-- -   Between 4096 (4 GB) and 16384 (16 GB) in increments of 1024 (1 GB) -
--     Available @cpu@ values: 2048 (2 vCPU)
--
-- -   Between 8192 (8 GB) and 30720 (30 GB) in increments of 1024 (1 GB) -
--     Available @cpu@ values: 4096 (4 vCPU)
--
-- -   Between 16 GB and 60 GB in 4 GB increments - Available @cpu@ values:
--     8192 (8 vCPU)
--
--     This option requires Linux platform @1.4.0@ or later.
--
-- -   Between 32GB and 120 GB in 8 GB increments - Available @cpu@ values:
--     16384 (16 vCPU)
--
--     This option requires Linux platform @1.4.0@ or later.
--
-- 'overrides', 'task_overrides' - One or more container overrides.
--
-- 'platformFamily', 'task_platformFamily' - The operating system that your tasks are running on. A platform family
-- is specified only for tasks that use the Fargate launch type.
--
-- All tasks that run as part of this service must use the same
-- @platformFamily@ value as the service (for example, @LINUX.@).
--
-- 'platformVersion', 'task_platformVersion' - The platform version where your task runs on. A platform version is only
-- specified for tasks that use the Fargate launch type. If you didn\'t
-- specify one, the @LATEST@ platform version is used. For more
-- information, see
-- <https://docs.aws.amazon.com/AmazonECS/latest/developerguide/platform_versions.html Fargate Platform Versions>
-- in the /Amazon Elastic Container Service Developer Guide/.
--
-- 'pullStartedAt', 'task_pullStartedAt' - The Unix timestamp for the time when the container image pull began.
--
-- 'pullStoppedAt', 'task_pullStoppedAt' - The Unix timestamp for the time when the container image pull completed.
--
-- 'startedAt', 'task_startedAt' - The Unix timestamp for the time when the task started. More
-- specifically, it\'s for the time when the task transitioned from the
-- @PENDING@ state to the @RUNNING@ state.
--
-- 'startedBy', 'task_startedBy' - The tag specified when a task is started. If an Amazon ECS service
-- started the task, the @startedBy@ parameter contains the deployment ID
-- of that service.
--
-- 'stopCode', 'task_stopCode' - The stop code indicating why a task was stopped. The @stoppedReason@
-- might contain additional details.
--
-- The following are valid values:
--
-- -   @TaskFailedToStart@
--
-- -   @EssentialContainerExited@
--
-- -   @UserInitiated@
--
-- -   @TerminationNotice@
--
-- -   @ServiceSchedulerInitiated@
--
-- -   @SpotInterruption@
--
-- 'stoppedAt', 'task_stoppedAt' - The Unix timestamp for the time when the task was stopped. More
-- specifically, it\'s for the time when the task transitioned from the
-- @RUNNING@ state to the @STOPPED@ state.
--
-- 'stoppedReason', 'task_stoppedReason' - The reason that the task was stopped.
--
-- 'stoppingAt', 'task_stoppingAt' - The Unix timestamp for the time when the task stops. More specifically,
-- it\'s for the time when the task transitions from the @RUNNING@ state to
-- @STOPPED@.
--
-- 'tags', 'task_tags' - The metadata that you apply to the task to help you categorize and
-- organize the task. Each tag consists of a key and an optional value. You
-- define both the key and value.
--
-- The following basic restrictions apply to tags:
--
-- -   Maximum number of tags per resource - 50
--
-- -   For each resource, each tag key must be unique, and each tag key can
--     have only one value.
--
-- -   Maximum key length - 128 Unicode characters in UTF-8
--
-- -   Maximum value length - 256 Unicode characters in UTF-8
--
-- -   If your tagging schema is used across multiple services and
--     resources, remember that other services may have restrictions on
--     allowed characters. Generally allowed characters are: letters,
--     numbers, and spaces representable in UTF-8, and the following
--     characters: + - = . _ : \/ \@.
--
-- -   Tag keys and values are case-sensitive.
--
-- -   Do not use @aws:@, @AWS:@, or any upper or lowercase combination of
--     such as a prefix for either keys or values as it is reserved for
--     Amazon Web Services use. You cannot edit or delete tag keys or
--     values with this prefix. Tags with this prefix do not count against
--     your tags per resource limit.
--
-- 'taskArn', 'task_taskArn' - The Amazon Resource Name (ARN) of the task.
--
-- 'taskDefinitionArn', 'task_taskDefinitionArn' - The ARN of the task definition that creates the task.
--
-- 'version', 'task_version' - The version counter for the task. Every time a task experiences a change
-- that starts a CloudWatch event, the version counter is incremented. If
-- you replicate your Amazon ECS task state with CloudWatch Events, you can
-- compare the version of a task reported by the Amazon ECS API actions
-- with the version reported in CloudWatch Events for the task (inside the
-- @detail@ object) to verify that the version in your event stream is
-- current.
newTask ::
  Task
newTask :: Task
newTask =
  Task'
    { $sel:attachments:Task' :: Maybe [Attachment]
attachments = forall a. Maybe a
Prelude.Nothing,
      $sel:attributes:Task' :: Maybe [Attribute]
attributes = forall a. Maybe a
Prelude.Nothing,
      $sel:availabilityZone:Task' :: Maybe Text
availabilityZone = forall a. Maybe a
Prelude.Nothing,
      $sel:capacityProviderName:Task' :: Maybe Text
capacityProviderName = forall a. Maybe a
Prelude.Nothing,
      $sel:clusterArn:Task' :: Maybe Text
clusterArn = forall a. Maybe a
Prelude.Nothing,
      $sel:connectivity:Task' :: Maybe Connectivity
connectivity = forall a. Maybe a
Prelude.Nothing,
      $sel:connectivityAt:Task' :: Maybe POSIX
connectivityAt = forall a. Maybe a
Prelude.Nothing,
      $sel:containerInstanceArn:Task' :: Maybe Text
containerInstanceArn = forall a. Maybe a
Prelude.Nothing,
      $sel:containers:Task' :: Maybe [Container]
containers = forall a. Maybe a
Prelude.Nothing,
      $sel:cpu:Task' :: Maybe Text
cpu = forall a. Maybe a
Prelude.Nothing,
      $sel:createdAt:Task' :: Maybe POSIX
createdAt = forall a. Maybe a
Prelude.Nothing,
      $sel:desiredStatus:Task' :: Maybe Text
desiredStatus = forall a. Maybe a
Prelude.Nothing,
      $sel:enableExecuteCommand:Task' :: Maybe Bool
enableExecuteCommand = forall a. Maybe a
Prelude.Nothing,
      $sel:ephemeralStorage:Task' :: Maybe EphemeralStorage
ephemeralStorage = forall a. Maybe a
Prelude.Nothing,
      $sel:executionStoppedAt:Task' :: Maybe POSIX
executionStoppedAt = forall a. Maybe a
Prelude.Nothing,
      $sel:group':Task' :: Maybe Text
group' = forall a. Maybe a
Prelude.Nothing,
      $sel:healthStatus:Task' :: Maybe HealthStatus
healthStatus = forall a. Maybe a
Prelude.Nothing,
      $sel:inferenceAccelerators:Task' :: Maybe [InferenceAccelerator]
inferenceAccelerators = forall a. Maybe a
Prelude.Nothing,
      $sel:lastStatus:Task' :: Maybe Text
lastStatus = forall a. Maybe a
Prelude.Nothing,
      $sel:launchType:Task' :: Maybe LaunchType
launchType = forall a. Maybe a
Prelude.Nothing,
      $sel:memory:Task' :: Maybe Text
memory = forall a. Maybe a
Prelude.Nothing,
      $sel:overrides:Task' :: Maybe TaskOverride
overrides = forall a. Maybe a
Prelude.Nothing,
      $sel:platformFamily:Task' :: Maybe Text
platformFamily = forall a. Maybe a
Prelude.Nothing,
      $sel:platformVersion:Task' :: Maybe Text
platformVersion = forall a. Maybe a
Prelude.Nothing,
      $sel:pullStartedAt:Task' :: Maybe POSIX
pullStartedAt = forall a. Maybe a
Prelude.Nothing,
      $sel:pullStoppedAt:Task' :: Maybe POSIX
pullStoppedAt = forall a. Maybe a
Prelude.Nothing,
      $sel:startedAt:Task' :: Maybe POSIX
startedAt = forall a. Maybe a
Prelude.Nothing,
      $sel:startedBy:Task' :: Maybe Text
startedBy = forall a. Maybe a
Prelude.Nothing,
      $sel:stopCode:Task' :: Maybe TaskStopCode
stopCode = forall a. Maybe a
Prelude.Nothing,
      $sel:stoppedAt:Task' :: Maybe POSIX
stoppedAt = forall a. Maybe a
Prelude.Nothing,
      $sel:stoppedReason:Task' :: Maybe Text
stoppedReason = forall a. Maybe a
Prelude.Nothing,
      $sel:stoppingAt:Task' :: Maybe POSIX
stoppingAt = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:Task' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:taskArn:Task' :: Maybe Text
taskArn = forall a. Maybe a
Prelude.Nothing,
      $sel:taskDefinitionArn:Task' :: Maybe Text
taskDefinitionArn = forall a. Maybe a
Prelude.Nothing,
      $sel:version:Task' :: Maybe Integer
version = forall a. Maybe a
Prelude.Nothing
    }

-- | The Elastic Network Adapter that\'s associated with the task if the task
-- uses the @awsvpc@ network mode.
task_attachments :: Lens.Lens' Task (Prelude.Maybe [Attachment])
task_attachments :: Lens' Task (Maybe [Attachment])
task_attachments = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Task' {Maybe [Attachment]
attachments :: Maybe [Attachment]
$sel:attachments:Task' :: Task -> Maybe [Attachment]
attachments} -> Maybe [Attachment]
attachments) (\s :: Task
s@Task' {} Maybe [Attachment]
a -> Task
s {$sel:attachments:Task' :: Maybe [Attachment]
attachments = Maybe [Attachment]
a} :: Task) 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 attributes of the task
task_attributes :: Lens.Lens' Task (Prelude.Maybe [Attribute])
task_attributes :: Lens' Task (Maybe [Attribute])
task_attributes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Task' {Maybe [Attribute]
attributes :: Maybe [Attribute]
$sel:attributes:Task' :: Task -> Maybe [Attribute]
attributes} -> Maybe [Attribute]
attributes) (\s :: Task
s@Task' {} Maybe [Attribute]
a -> Task
s {$sel:attributes:Task' :: Maybe [Attribute]
attributes = Maybe [Attribute]
a} :: Task) 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 Availability Zone for the task.
task_availabilityZone :: Lens.Lens' Task (Prelude.Maybe Prelude.Text)
task_availabilityZone :: Lens' Task (Maybe Text)
task_availabilityZone = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Task' {Maybe Text
availabilityZone :: Maybe Text
$sel:availabilityZone:Task' :: Task -> Maybe Text
availabilityZone} -> Maybe Text
availabilityZone) (\s :: Task
s@Task' {} Maybe Text
a -> Task
s {$sel:availabilityZone:Task' :: Maybe Text
availabilityZone = Maybe Text
a} :: Task)

-- | The capacity provider that\'s associated with the task.
task_capacityProviderName :: Lens.Lens' Task (Prelude.Maybe Prelude.Text)
task_capacityProviderName :: Lens' Task (Maybe Text)
task_capacityProviderName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Task' {Maybe Text
capacityProviderName :: Maybe Text
$sel:capacityProviderName:Task' :: Task -> Maybe Text
capacityProviderName} -> Maybe Text
capacityProviderName) (\s :: Task
s@Task' {} Maybe Text
a -> Task
s {$sel:capacityProviderName:Task' :: Maybe Text
capacityProviderName = Maybe Text
a} :: Task)

-- | The ARN of the cluster that hosts the task.
task_clusterArn :: Lens.Lens' Task (Prelude.Maybe Prelude.Text)
task_clusterArn :: Lens' Task (Maybe Text)
task_clusterArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Task' {Maybe Text
clusterArn :: Maybe Text
$sel:clusterArn:Task' :: Task -> Maybe Text
clusterArn} -> Maybe Text
clusterArn) (\s :: Task
s@Task' {} Maybe Text
a -> Task
s {$sel:clusterArn:Task' :: Maybe Text
clusterArn = Maybe Text
a} :: Task)

-- | The connectivity status of a task.
task_connectivity :: Lens.Lens' Task (Prelude.Maybe Connectivity)
task_connectivity :: Lens' Task (Maybe Connectivity)
task_connectivity = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Task' {Maybe Connectivity
connectivity :: Maybe Connectivity
$sel:connectivity:Task' :: Task -> Maybe Connectivity
connectivity} -> Maybe Connectivity
connectivity) (\s :: Task
s@Task' {} Maybe Connectivity
a -> Task
s {$sel:connectivity:Task' :: Maybe Connectivity
connectivity = Maybe Connectivity
a} :: Task)

-- | The Unix timestamp for the time when the task last went into @CONNECTED@
-- status.
task_connectivityAt :: Lens.Lens' Task (Prelude.Maybe Prelude.UTCTime)
task_connectivityAt :: Lens' Task (Maybe UTCTime)
task_connectivityAt = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Task' {Maybe POSIX
connectivityAt :: Maybe POSIX
$sel:connectivityAt:Task' :: Task -> Maybe POSIX
connectivityAt} -> Maybe POSIX
connectivityAt) (\s :: Task
s@Task' {} Maybe POSIX
a -> Task
s {$sel:connectivityAt:Task' :: Maybe POSIX
connectivityAt = Maybe POSIX
a} :: Task) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The ARN of the container instances that host the task.
task_containerInstanceArn :: Lens.Lens' Task (Prelude.Maybe Prelude.Text)
task_containerInstanceArn :: Lens' Task (Maybe Text)
task_containerInstanceArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Task' {Maybe Text
containerInstanceArn :: Maybe Text
$sel:containerInstanceArn:Task' :: Task -> Maybe Text
containerInstanceArn} -> Maybe Text
containerInstanceArn) (\s :: Task
s@Task' {} Maybe Text
a -> Task
s {$sel:containerInstanceArn:Task' :: Maybe Text
containerInstanceArn = Maybe Text
a} :: Task)

-- | The containers that\'s associated with the task.
task_containers :: Lens.Lens' Task (Prelude.Maybe [Container])
task_containers :: Lens' Task (Maybe [Container])
task_containers = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Task' {Maybe [Container]
containers :: Maybe [Container]
$sel:containers:Task' :: Task -> Maybe [Container]
containers} -> Maybe [Container]
containers) (\s :: Task
s@Task' {} Maybe [Container]
a -> Task
s {$sel:containers:Task' :: Maybe [Container]
containers = Maybe [Container]
a} :: Task) 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 number of CPU units used by the task as expressed in a task
-- definition. It can be expressed as an integer using CPU units (for
-- example, @1024@). It can also be expressed as a string using vCPUs (for
-- example, @1 vCPU@ or @1 vcpu@). String values are converted to an
-- integer that indicates the CPU units when the task definition is
-- registered.
--
-- If you use the EC2 launch type, this field is optional. Supported values
-- are between @128@ CPU units (@0.125@ vCPUs) and @10240@ CPU units (@10@
-- vCPUs).
--
-- If you use the Fargate launch type, this field is required. You must use
-- one of the following values. These values determine the range of
-- supported values for the @memory@ parameter:
--
-- The CPU units cannot be less than 1 vCPU when you use Windows containers
-- on Fargate.
--
-- -   256 (.25 vCPU) - Available @memory@ values: 512 (0.5 GB), 1024 (1
--     GB), 2048 (2 GB)
--
-- -   512 (.5 vCPU) - Available @memory@ values: 1024 (1 GB), 2048 (2 GB),
--     3072 (3 GB), 4096 (4 GB)
--
-- -   1024 (1 vCPU) - Available @memory@ values: 2048 (2 GB), 3072 (3 GB),
--     4096 (4 GB), 5120 (5 GB), 6144 (6 GB), 7168 (7 GB), 8192 (8 GB)
--
-- -   2048 (2 vCPU) - Available @memory@ values: 4096 (4 GB) and 16384 (16
--     GB) in increments of 1024 (1 GB)
--
-- -   4096 (4 vCPU) - Available @memory@ values: 8192 (8 GB) and 30720 (30
--     GB) in increments of 1024 (1 GB)
--
-- -   8192 (8 vCPU) - Available @memory@ values: 16 GB and 60 GB in 4 GB
--     increments
--
--     This option requires Linux platform @1.4.0@ or later.
--
-- -   16384 (16vCPU) - Available @memory@ values: 32GB and 120 GB in 8 GB
--     increments
--
--     This option requires Linux platform @1.4.0@ or later.
task_cpu :: Lens.Lens' Task (Prelude.Maybe Prelude.Text)
task_cpu :: Lens' Task (Maybe Text)
task_cpu = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Task' {Maybe Text
cpu :: Maybe Text
$sel:cpu:Task' :: Task -> Maybe Text
cpu} -> Maybe Text
cpu) (\s :: Task
s@Task' {} Maybe Text
a -> Task
s {$sel:cpu:Task' :: Maybe Text
cpu = Maybe Text
a} :: Task)

-- | The Unix timestamp for the time when the task was created. More
-- specifically, it\'s for the time when the task entered the @PENDING@
-- state.
task_createdAt :: Lens.Lens' Task (Prelude.Maybe Prelude.UTCTime)
task_createdAt :: Lens' Task (Maybe UTCTime)
task_createdAt = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Task' {Maybe POSIX
createdAt :: Maybe POSIX
$sel:createdAt:Task' :: Task -> Maybe POSIX
createdAt} -> Maybe POSIX
createdAt) (\s :: Task
s@Task' {} Maybe POSIX
a -> Task
s {$sel:createdAt:Task' :: Maybe POSIX
createdAt = Maybe POSIX
a} :: Task) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The desired status of the task. For more information, see
-- <https://docs.aws.amazon.com/AmazonECS/latest/developerguide/task-lifecycle.html Task Lifecycle>.
task_desiredStatus :: Lens.Lens' Task (Prelude.Maybe Prelude.Text)
task_desiredStatus :: Lens' Task (Maybe Text)
task_desiredStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Task' {Maybe Text
desiredStatus :: Maybe Text
$sel:desiredStatus:Task' :: Task -> Maybe Text
desiredStatus} -> Maybe Text
desiredStatus) (\s :: Task
s@Task' {} Maybe Text
a -> Task
s {$sel:desiredStatus:Task' :: Maybe Text
desiredStatus = Maybe Text
a} :: Task)

-- | Determines whether execute command functionality is enabled for this
-- task. If @true@, execute command functionality is enabled on all the
-- containers in the task.
task_enableExecuteCommand :: Lens.Lens' Task (Prelude.Maybe Prelude.Bool)
task_enableExecuteCommand :: Lens' Task (Maybe Bool)
task_enableExecuteCommand = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Task' {Maybe Bool
enableExecuteCommand :: Maybe Bool
$sel:enableExecuteCommand:Task' :: Task -> Maybe Bool
enableExecuteCommand} -> Maybe Bool
enableExecuteCommand) (\s :: Task
s@Task' {} Maybe Bool
a -> Task
s {$sel:enableExecuteCommand:Task' :: Maybe Bool
enableExecuteCommand = Maybe Bool
a} :: Task)

-- | The ephemeral storage settings for the task.
task_ephemeralStorage :: Lens.Lens' Task (Prelude.Maybe EphemeralStorage)
task_ephemeralStorage :: Lens' Task (Maybe EphemeralStorage)
task_ephemeralStorage = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Task' {Maybe EphemeralStorage
ephemeralStorage :: Maybe EphemeralStorage
$sel:ephemeralStorage:Task' :: Task -> Maybe EphemeralStorage
ephemeralStorage} -> Maybe EphemeralStorage
ephemeralStorage) (\s :: Task
s@Task' {} Maybe EphemeralStorage
a -> Task
s {$sel:ephemeralStorage:Task' :: Maybe EphemeralStorage
ephemeralStorage = Maybe EphemeralStorage
a} :: Task)

-- | The Unix timestamp for the time when the task execution stopped.
task_executionStoppedAt :: Lens.Lens' Task (Prelude.Maybe Prelude.UTCTime)
task_executionStoppedAt :: Lens' Task (Maybe UTCTime)
task_executionStoppedAt = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Task' {Maybe POSIX
executionStoppedAt :: Maybe POSIX
$sel:executionStoppedAt:Task' :: Task -> Maybe POSIX
executionStoppedAt} -> Maybe POSIX
executionStoppedAt) (\s :: Task
s@Task' {} Maybe POSIX
a -> Task
s {$sel:executionStoppedAt:Task' :: Maybe POSIX
executionStoppedAt = Maybe POSIX
a} :: Task) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The name of the task group that\'s associated with the task.
task_group :: Lens.Lens' Task (Prelude.Maybe Prelude.Text)
task_group :: Lens' Task (Maybe Text)
task_group = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Task' {Maybe Text
group' :: Maybe Text
$sel:group':Task' :: Task -> Maybe Text
group'} -> Maybe Text
group') (\s :: Task
s@Task' {} Maybe Text
a -> Task
s {$sel:group':Task' :: Maybe Text
group' = Maybe Text
a} :: Task)

-- | The health status for the task. It\'s determined by the health of the
-- essential containers in the task. If all essential containers in the
-- task are reporting as @HEALTHY@, the task status also reports as
-- @HEALTHY@. If any essential containers in the task are reporting as
-- @UNHEALTHY@ or @UNKNOWN@, the task status also reports as @UNHEALTHY@ or
-- @UNKNOWN@.
--
-- The Amazon ECS container agent doesn\'t monitor or report on Docker
-- health checks that are embedded in a container image and not specified
-- in the container definition. For example, this includes those specified
-- in a parent image or from the image\'s Dockerfile. Health check
-- parameters that are specified in a container definition override any
-- Docker health checks that are found in the container image.
task_healthStatus :: Lens.Lens' Task (Prelude.Maybe HealthStatus)
task_healthStatus :: Lens' Task (Maybe HealthStatus)
task_healthStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Task' {Maybe HealthStatus
healthStatus :: Maybe HealthStatus
$sel:healthStatus:Task' :: Task -> Maybe HealthStatus
healthStatus} -> Maybe HealthStatus
healthStatus) (\s :: Task
s@Task' {} Maybe HealthStatus
a -> Task
s {$sel:healthStatus:Task' :: Maybe HealthStatus
healthStatus = Maybe HealthStatus
a} :: Task)

-- | The Elastic Inference accelerator that\'s associated with the task.
task_inferenceAccelerators :: Lens.Lens' Task (Prelude.Maybe [InferenceAccelerator])
task_inferenceAccelerators :: Lens' Task (Maybe [InferenceAccelerator])
task_inferenceAccelerators = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Task' {Maybe [InferenceAccelerator]
inferenceAccelerators :: Maybe [InferenceAccelerator]
$sel:inferenceAccelerators:Task' :: Task -> Maybe [InferenceAccelerator]
inferenceAccelerators} -> Maybe [InferenceAccelerator]
inferenceAccelerators) (\s :: Task
s@Task' {} Maybe [InferenceAccelerator]
a -> Task
s {$sel:inferenceAccelerators:Task' :: Maybe [InferenceAccelerator]
inferenceAccelerators = Maybe [InferenceAccelerator]
a} :: Task) 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 last known status for the task. For more information, see
-- <https://docs.aws.amazon.com/AmazonECS/latest/developerguide/task-lifecycle.html Task Lifecycle>.
task_lastStatus :: Lens.Lens' Task (Prelude.Maybe Prelude.Text)
task_lastStatus :: Lens' Task (Maybe Text)
task_lastStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Task' {Maybe Text
lastStatus :: Maybe Text
$sel:lastStatus:Task' :: Task -> Maybe Text
lastStatus} -> Maybe Text
lastStatus) (\s :: Task
s@Task' {} Maybe Text
a -> Task
s {$sel:lastStatus:Task' :: Maybe Text
lastStatus = Maybe Text
a} :: Task)

-- | The infrastructure where your task runs on. For more information, see
-- <https://docs.aws.amazon.com/AmazonECS/latest/developerguide/launch_types.html Amazon ECS launch types>
-- in the /Amazon Elastic Container Service Developer Guide/.
task_launchType :: Lens.Lens' Task (Prelude.Maybe LaunchType)
task_launchType :: Lens' Task (Maybe LaunchType)
task_launchType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Task' {Maybe LaunchType
launchType :: Maybe LaunchType
$sel:launchType:Task' :: Task -> Maybe LaunchType
launchType} -> Maybe LaunchType
launchType) (\s :: Task
s@Task' {} Maybe LaunchType
a -> Task
s {$sel:launchType:Task' :: Maybe LaunchType
launchType = Maybe LaunchType
a} :: Task)

-- | The amount of memory (in MiB) that the task uses as expressed in a task
-- definition. It can be expressed as an integer using MiB (for example,
-- @1024@). If it\'s expressed as a string using GB (for example, @1GB@ or
-- @1 GB@), it\'s converted to an integer indicating the MiB when the task
-- definition is registered.
--
-- If you use the EC2 launch type, this field is optional.
--
-- If you use the Fargate launch type, this field is required. You must use
-- one of the following values. The value that you choose determines the
-- range of supported values for the @cpu@ parameter.
--
-- -   512 (0.5 GB), 1024 (1 GB), 2048 (2 GB) - Available @cpu@ values: 256
--     (.25 vCPU)
--
-- -   1024 (1 GB), 2048 (2 GB), 3072 (3 GB), 4096 (4 GB) - Available @cpu@
--     values: 512 (.5 vCPU)
--
-- -   2048 (2 GB), 3072 (3 GB), 4096 (4 GB), 5120 (5 GB), 6144 (6 GB),
--     7168 (7 GB), 8192 (8 GB) - Available @cpu@ values: 1024 (1 vCPU)
--
-- -   Between 4096 (4 GB) and 16384 (16 GB) in increments of 1024 (1 GB) -
--     Available @cpu@ values: 2048 (2 vCPU)
--
-- -   Between 8192 (8 GB) and 30720 (30 GB) in increments of 1024 (1 GB) -
--     Available @cpu@ values: 4096 (4 vCPU)
--
-- -   Between 16 GB and 60 GB in 4 GB increments - Available @cpu@ values:
--     8192 (8 vCPU)
--
--     This option requires Linux platform @1.4.0@ or later.
--
-- -   Between 32GB and 120 GB in 8 GB increments - Available @cpu@ values:
--     16384 (16 vCPU)
--
--     This option requires Linux platform @1.4.0@ or later.
task_memory :: Lens.Lens' Task (Prelude.Maybe Prelude.Text)
task_memory :: Lens' Task (Maybe Text)
task_memory = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Task' {Maybe Text
memory :: Maybe Text
$sel:memory:Task' :: Task -> Maybe Text
memory} -> Maybe Text
memory) (\s :: Task
s@Task' {} Maybe Text
a -> Task
s {$sel:memory:Task' :: Maybe Text
memory = Maybe Text
a} :: Task)

-- | One or more container overrides.
task_overrides :: Lens.Lens' Task (Prelude.Maybe TaskOverride)
task_overrides :: Lens' Task (Maybe TaskOverride)
task_overrides = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Task' {Maybe TaskOverride
overrides :: Maybe TaskOverride
$sel:overrides:Task' :: Task -> Maybe TaskOverride
overrides} -> Maybe TaskOverride
overrides) (\s :: Task
s@Task' {} Maybe TaskOverride
a -> Task
s {$sel:overrides:Task' :: Maybe TaskOverride
overrides = Maybe TaskOverride
a} :: Task)

-- | The operating system that your tasks are running on. A platform family
-- is specified only for tasks that use the Fargate launch type.
--
-- All tasks that run as part of this service must use the same
-- @platformFamily@ value as the service (for example, @LINUX.@).
task_platformFamily :: Lens.Lens' Task (Prelude.Maybe Prelude.Text)
task_platformFamily :: Lens' Task (Maybe Text)
task_platformFamily = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Task' {Maybe Text
platformFamily :: Maybe Text
$sel:platformFamily:Task' :: Task -> Maybe Text
platformFamily} -> Maybe Text
platformFamily) (\s :: Task
s@Task' {} Maybe Text
a -> Task
s {$sel:platformFamily:Task' :: Maybe Text
platformFamily = Maybe Text
a} :: Task)

-- | The platform version where your task runs on. A platform version is only
-- specified for tasks that use the Fargate launch type. If you didn\'t
-- specify one, the @LATEST@ platform version is used. For more
-- information, see
-- <https://docs.aws.amazon.com/AmazonECS/latest/developerguide/platform_versions.html Fargate Platform Versions>
-- in the /Amazon Elastic Container Service Developer Guide/.
task_platformVersion :: Lens.Lens' Task (Prelude.Maybe Prelude.Text)
task_platformVersion :: Lens' Task (Maybe Text)
task_platformVersion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Task' {Maybe Text
platformVersion :: Maybe Text
$sel:platformVersion:Task' :: Task -> Maybe Text
platformVersion} -> Maybe Text
platformVersion) (\s :: Task
s@Task' {} Maybe Text
a -> Task
s {$sel:platformVersion:Task' :: Maybe Text
platformVersion = Maybe Text
a} :: Task)

-- | The Unix timestamp for the time when the container image pull began.
task_pullStartedAt :: Lens.Lens' Task (Prelude.Maybe Prelude.UTCTime)
task_pullStartedAt :: Lens' Task (Maybe UTCTime)
task_pullStartedAt = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Task' {Maybe POSIX
pullStartedAt :: Maybe POSIX
$sel:pullStartedAt:Task' :: Task -> Maybe POSIX
pullStartedAt} -> Maybe POSIX
pullStartedAt) (\s :: Task
s@Task' {} Maybe POSIX
a -> Task
s {$sel:pullStartedAt:Task' :: Maybe POSIX
pullStartedAt = Maybe POSIX
a} :: Task) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The Unix timestamp for the time when the container image pull completed.
task_pullStoppedAt :: Lens.Lens' Task (Prelude.Maybe Prelude.UTCTime)
task_pullStoppedAt :: Lens' Task (Maybe UTCTime)
task_pullStoppedAt = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Task' {Maybe POSIX
pullStoppedAt :: Maybe POSIX
$sel:pullStoppedAt:Task' :: Task -> Maybe POSIX
pullStoppedAt} -> Maybe POSIX
pullStoppedAt) (\s :: Task
s@Task' {} Maybe POSIX
a -> Task
s {$sel:pullStoppedAt:Task' :: Maybe POSIX
pullStoppedAt = Maybe POSIX
a} :: Task) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The Unix timestamp for the time when the task started. More
-- specifically, it\'s for the time when the task transitioned from the
-- @PENDING@ state to the @RUNNING@ state.
task_startedAt :: Lens.Lens' Task (Prelude.Maybe Prelude.UTCTime)
task_startedAt :: Lens' Task (Maybe UTCTime)
task_startedAt = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Task' {Maybe POSIX
startedAt :: Maybe POSIX
$sel:startedAt:Task' :: Task -> Maybe POSIX
startedAt} -> Maybe POSIX
startedAt) (\s :: Task
s@Task' {} Maybe POSIX
a -> Task
s {$sel:startedAt:Task' :: Maybe POSIX
startedAt = Maybe POSIX
a} :: Task) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The tag specified when a task is started. If an Amazon ECS service
-- started the task, the @startedBy@ parameter contains the deployment ID
-- of that service.
task_startedBy :: Lens.Lens' Task (Prelude.Maybe Prelude.Text)
task_startedBy :: Lens' Task (Maybe Text)
task_startedBy = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Task' {Maybe Text
startedBy :: Maybe Text
$sel:startedBy:Task' :: Task -> Maybe Text
startedBy} -> Maybe Text
startedBy) (\s :: Task
s@Task' {} Maybe Text
a -> Task
s {$sel:startedBy:Task' :: Maybe Text
startedBy = Maybe Text
a} :: Task)

-- | The stop code indicating why a task was stopped. The @stoppedReason@
-- might contain additional details.
--
-- The following are valid values:
--
-- -   @TaskFailedToStart@
--
-- -   @EssentialContainerExited@
--
-- -   @UserInitiated@
--
-- -   @TerminationNotice@
--
-- -   @ServiceSchedulerInitiated@
--
-- -   @SpotInterruption@
task_stopCode :: Lens.Lens' Task (Prelude.Maybe TaskStopCode)
task_stopCode :: Lens' Task (Maybe TaskStopCode)
task_stopCode = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Task' {Maybe TaskStopCode
stopCode :: Maybe TaskStopCode
$sel:stopCode:Task' :: Task -> Maybe TaskStopCode
stopCode} -> Maybe TaskStopCode
stopCode) (\s :: Task
s@Task' {} Maybe TaskStopCode
a -> Task
s {$sel:stopCode:Task' :: Maybe TaskStopCode
stopCode = Maybe TaskStopCode
a} :: Task)

-- | The Unix timestamp for the time when the task was stopped. More
-- specifically, it\'s for the time when the task transitioned from the
-- @RUNNING@ state to the @STOPPED@ state.
task_stoppedAt :: Lens.Lens' Task (Prelude.Maybe Prelude.UTCTime)
task_stoppedAt :: Lens' Task (Maybe UTCTime)
task_stoppedAt = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Task' {Maybe POSIX
stoppedAt :: Maybe POSIX
$sel:stoppedAt:Task' :: Task -> Maybe POSIX
stoppedAt} -> Maybe POSIX
stoppedAt) (\s :: Task
s@Task' {} Maybe POSIX
a -> Task
s {$sel:stoppedAt:Task' :: Maybe POSIX
stoppedAt = Maybe POSIX
a} :: Task) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The reason that the task was stopped.
task_stoppedReason :: Lens.Lens' Task (Prelude.Maybe Prelude.Text)
task_stoppedReason :: Lens' Task (Maybe Text)
task_stoppedReason = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Task' {Maybe Text
stoppedReason :: Maybe Text
$sel:stoppedReason:Task' :: Task -> Maybe Text
stoppedReason} -> Maybe Text
stoppedReason) (\s :: Task
s@Task' {} Maybe Text
a -> Task
s {$sel:stoppedReason:Task' :: Maybe Text
stoppedReason = Maybe Text
a} :: Task)

-- | The Unix timestamp for the time when the task stops. More specifically,
-- it\'s for the time when the task transitions from the @RUNNING@ state to
-- @STOPPED@.
task_stoppingAt :: Lens.Lens' Task (Prelude.Maybe Prelude.UTCTime)
task_stoppingAt :: Lens' Task (Maybe UTCTime)
task_stoppingAt = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Task' {Maybe POSIX
stoppingAt :: Maybe POSIX
$sel:stoppingAt:Task' :: Task -> Maybe POSIX
stoppingAt} -> Maybe POSIX
stoppingAt) (\s :: Task
s@Task' {} Maybe POSIX
a -> Task
s {$sel:stoppingAt:Task' :: Maybe POSIX
stoppingAt = Maybe POSIX
a} :: Task) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The metadata that you apply to the task to help you categorize and
-- organize the task. Each tag consists of a key and an optional value. You
-- define both the key and value.
--
-- The following basic restrictions apply to tags:
--
-- -   Maximum number of tags per resource - 50
--
-- -   For each resource, each tag key must be unique, and each tag key can
--     have only one value.
--
-- -   Maximum key length - 128 Unicode characters in UTF-8
--
-- -   Maximum value length - 256 Unicode characters in UTF-8
--
-- -   If your tagging schema is used across multiple services and
--     resources, remember that other services may have restrictions on
--     allowed characters. Generally allowed characters are: letters,
--     numbers, and spaces representable in UTF-8, and the following
--     characters: + - = . _ : \/ \@.
--
-- -   Tag keys and values are case-sensitive.
--
-- -   Do not use @aws:@, @AWS:@, or any upper or lowercase combination of
--     such as a prefix for either keys or values as it is reserved for
--     Amazon Web Services use. You cannot edit or delete tag keys or
--     values with this prefix. Tags with this prefix do not count against
--     your tags per resource limit.
task_tags :: Lens.Lens' Task (Prelude.Maybe [Tag])
task_tags :: Lens' Task (Maybe [Tag])
task_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Task' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:Task' :: Task -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: Task
s@Task' {} Maybe [Tag]
a -> Task
s {$sel:tags:Task' :: Maybe [Tag]
tags = Maybe [Tag]
a} :: Task) 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 Amazon Resource Name (ARN) of the task.
task_taskArn :: Lens.Lens' Task (Prelude.Maybe Prelude.Text)
task_taskArn :: Lens' Task (Maybe Text)
task_taskArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Task' {Maybe Text
taskArn :: Maybe Text
$sel:taskArn:Task' :: Task -> Maybe Text
taskArn} -> Maybe Text
taskArn) (\s :: Task
s@Task' {} Maybe Text
a -> Task
s {$sel:taskArn:Task' :: Maybe Text
taskArn = Maybe Text
a} :: Task)

-- | The ARN of the task definition that creates the task.
task_taskDefinitionArn :: Lens.Lens' Task (Prelude.Maybe Prelude.Text)
task_taskDefinitionArn :: Lens' Task (Maybe Text)
task_taskDefinitionArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Task' {Maybe Text
taskDefinitionArn :: Maybe Text
$sel:taskDefinitionArn:Task' :: Task -> Maybe Text
taskDefinitionArn} -> Maybe Text
taskDefinitionArn) (\s :: Task
s@Task' {} Maybe Text
a -> Task
s {$sel:taskDefinitionArn:Task' :: Maybe Text
taskDefinitionArn = Maybe Text
a} :: Task)

-- | The version counter for the task. Every time a task experiences a change
-- that starts a CloudWatch event, the version counter is incremented. If
-- you replicate your Amazon ECS task state with CloudWatch Events, you can
-- compare the version of a task reported by the Amazon ECS API actions
-- with the version reported in CloudWatch Events for the task (inside the
-- @detail@ object) to verify that the version in your event stream is
-- current.
task_version :: Lens.Lens' Task (Prelude.Maybe Prelude.Integer)
task_version :: Lens' Task (Maybe Integer)
task_version = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Task' {Maybe Integer
version :: Maybe Integer
$sel:version:Task' :: Task -> Maybe Integer
version} -> Maybe Integer
version) (\s :: Task
s@Task' {} Maybe Integer
a -> Task
s {$sel:version:Task' :: Maybe Integer
version = Maybe Integer
a} :: Task)

instance Data.FromJSON Task where
  parseJSON :: Value -> Parser Task
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"Task"
      ( \Object
x ->
          Maybe [Attachment]
-> Maybe [Attribute]
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Connectivity
-> Maybe POSIX
-> Maybe Text
-> Maybe [Container]
-> Maybe Text
-> Maybe POSIX
-> Maybe Text
-> Maybe Bool
-> Maybe EphemeralStorage
-> Maybe POSIX
-> Maybe Text
-> Maybe HealthStatus
-> Maybe [InferenceAccelerator]
-> Maybe Text
-> Maybe LaunchType
-> Maybe Text
-> Maybe TaskOverride
-> Maybe Text
-> Maybe Text
-> Maybe POSIX
-> Maybe POSIX
-> Maybe POSIX
-> Maybe Text
-> Maybe TaskStopCode
-> Maybe POSIX
-> Maybe Text
-> Maybe POSIX
-> Maybe [Tag]
-> Maybe Text
-> Maybe Text
-> Maybe Integer
-> Task
Task'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"attachments" forall a. Parser (Maybe a) -> a -> Parser a
Data..!= 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 -> Parser (Maybe a)
Data..:? Key
"attributes" forall a. Parser (Maybe a) -> a -> Parser a
Data..!= 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 -> Parser (Maybe a)
Data..:? Key
"availabilityZone")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"capacityProviderName")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"clusterArn")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"connectivity")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"connectivityAt")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"containerInstanceArn")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"containers" forall a. Parser (Maybe a) -> a -> Parser a
Data..!= 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 -> Parser (Maybe a)
Data..:? Key
"cpu")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"createdAt")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"desiredStatus")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"enableExecuteCommand")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"ephemeralStorage")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"executionStoppedAt")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"group")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"healthStatus")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ( Object
x
                            forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"inferenceAccelerators"
                            forall a. Parser (Maybe a) -> a -> Parser a
Data..!= 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 -> Parser (Maybe a)
Data..:? Key
"lastStatus")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"launchType")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"memory")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"overrides")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"platformFamily")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"platformVersion")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"pullStartedAt")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"pullStoppedAt")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"startedAt")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"startedBy")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"stopCode")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"stoppedAt")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"stoppedReason")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"stoppingAt")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"tags" forall a. Parser (Maybe a) -> a -> Parser a
Data..!= 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 -> Parser (Maybe a)
Data..:? Key
"taskArn")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"taskDefinitionArn")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"version")
      )

instance Prelude.Hashable Task where
  hashWithSalt :: Int -> Task -> Int
hashWithSalt Int
_salt Task' {Maybe Bool
Maybe Integer
Maybe [InferenceAccelerator]
Maybe [Attachment]
Maybe [Tag]
Maybe [Attribute]
Maybe [Container]
Maybe Text
Maybe POSIX
Maybe Connectivity
Maybe EphemeralStorage
Maybe HealthStatus
Maybe LaunchType
Maybe TaskOverride
Maybe TaskStopCode
version :: Maybe Integer
taskDefinitionArn :: Maybe Text
taskArn :: Maybe Text
tags :: Maybe [Tag]
stoppingAt :: Maybe POSIX
stoppedReason :: Maybe Text
stoppedAt :: Maybe POSIX
stopCode :: Maybe TaskStopCode
startedBy :: Maybe Text
startedAt :: Maybe POSIX
pullStoppedAt :: Maybe POSIX
pullStartedAt :: Maybe POSIX
platformVersion :: Maybe Text
platformFamily :: Maybe Text
overrides :: Maybe TaskOverride
memory :: Maybe Text
launchType :: Maybe LaunchType
lastStatus :: Maybe Text
inferenceAccelerators :: Maybe [InferenceAccelerator]
healthStatus :: Maybe HealthStatus
group' :: Maybe Text
executionStoppedAt :: Maybe POSIX
ephemeralStorage :: Maybe EphemeralStorage
enableExecuteCommand :: Maybe Bool
desiredStatus :: Maybe Text
createdAt :: Maybe POSIX
cpu :: Maybe Text
containers :: Maybe [Container]
containerInstanceArn :: Maybe Text
connectivityAt :: Maybe POSIX
connectivity :: Maybe Connectivity
clusterArn :: Maybe Text
capacityProviderName :: Maybe Text
availabilityZone :: Maybe Text
attributes :: Maybe [Attribute]
attachments :: Maybe [Attachment]
$sel:version:Task' :: Task -> Maybe Integer
$sel:taskDefinitionArn:Task' :: Task -> Maybe Text
$sel:taskArn:Task' :: Task -> Maybe Text
$sel:tags:Task' :: Task -> Maybe [Tag]
$sel:stoppingAt:Task' :: Task -> Maybe POSIX
$sel:stoppedReason:Task' :: Task -> Maybe Text
$sel:stoppedAt:Task' :: Task -> Maybe POSIX
$sel:stopCode:Task' :: Task -> Maybe TaskStopCode
$sel:startedBy:Task' :: Task -> Maybe Text
$sel:startedAt:Task' :: Task -> Maybe POSIX
$sel:pullStoppedAt:Task' :: Task -> Maybe POSIX
$sel:pullStartedAt:Task' :: Task -> Maybe POSIX
$sel:platformVersion:Task' :: Task -> Maybe Text
$sel:platformFamily:Task' :: Task -> Maybe Text
$sel:overrides:Task' :: Task -> Maybe TaskOverride
$sel:memory:Task' :: Task -> Maybe Text
$sel:launchType:Task' :: Task -> Maybe LaunchType
$sel:lastStatus:Task' :: Task -> Maybe Text
$sel:inferenceAccelerators:Task' :: Task -> Maybe [InferenceAccelerator]
$sel:healthStatus:Task' :: Task -> Maybe HealthStatus
$sel:group':Task' :: Task -> Maybe Text
$sel:executionStoppedAt:Task' :: Task -> Maybe POSIX
$sel:ephemeralStorage:Task' :: Task -> Maybe EphemeralStorage
$sel:enableExecuteCommand:Task' :: Task -> Maybe Bool
$sel:desiredStatus:Task' :: Task -> Maybe Text
$sel:createdAt:Task' :: Task -> Maybe POSIX
$sel:cpu:Task' :: Task -> Maybe Text
$sel:containers:Task' :: Task -> Maybe [Container]
$sel:containerInstanceArn:Task' :: Task -> Maybe Text
$sel:connectivityAt:Task' :: Task -> Maybe POSIX
$sel:connectivity:Task' :: Task -> Maybe Connectivity
$sel:clusterArn:Task' :: Task -> Maybe Text
$sel:capacityProviderName:Task' :: Task -> Maybe Text
$sel:availabilityZone:Task' :: Task -> Maybe Text
$sel:attributes:Task' :: Task -> Maybe [Attribute]
$sel:attachments:Task' :: Task -> Maybe [Attachment]
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Attachment]
attachments
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Attribute]
attributes
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
availabilityZone
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
capacityProviderName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
clusterArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Connectivity
connectivity
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe POSIX
connectivityAt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
containerInstanceArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Container]
containers
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
cpu
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe POSIX
createdAt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
desiredStatus
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
enableExecuteCommand
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe EphemeralStorage
ephemeralStorage
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe POSIX
executionStoppedAt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
group'
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe HealthStatus
healthStatus
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [InferenceAccelerator]
inferenceAccelerators
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
lastStatus
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe LaunchType
launchType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
memory
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe TaskOverride
overrides
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
platformFamily
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
platformVersion
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe POSIX
pullStartedAt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe POSIX
pullStoppedAt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe POSIX
startedAt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
startedBy
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe TaskStopCode
stopCode
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe POSIX
stoppedAt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
stoppedReason
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe POSIX
stoppingAt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Tag]
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
taskArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
taskDefinitionArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Integer
version

instance Prelude.NFData Task where
  rnf :: Task -> ()
rnf Task' {Maybe Bool
Maybe Integer
Maybe [InferenceAccelerator]
Maybe [Attachment]
Maybe [Tag]
Maybe [Attribute]
Maybe [Container]
Maybe Text
Maybe POSIX
Maybe Connectivity
Maybe EphemeralStorage
Maybe HealthStatus
Maybe LaunchType
Maybe TaskOverride
Maybe TaskStopCode
version :: Maybe Integer
taskDefinitionArn :: Maybe Text
taskArn :: Maybe Text
tags :: Maybe [Tag]
stoppingAt :: Maybe POSIX
stoppedReason :: Maybe Text
stoppedAt :: Maybe POSIX
stopCode :: Maybe TaskStopCode
startedBy :: Maybe Text
startedAt :: Maybe POSIX
pullStoppedAt :: Maybe POSIX
pullStartedAt :: Maybe POSIX
platformVersion :: Maybe Text
platformFamily :: Maybe Text
overrides :: Maybe TaskOverride
memory :: Maybe Text
launchType :: Maybe LaunchType
lastStatus :: Maybe Text
inferenceAccelerators :: Maybe [InferenceAccelerator]
healthStatus :: Maybe HealthStatus
group' :: Maybe Text
executionStoppedAt :: Maybe POSIX
ephemeralStorage :: Maybe EphemeralStorage
enableExecuteCommand :: Maybe Bool
desiredStatus :: Maybe Text
createdAt :: Maybe POSIX
cpu :: Maybe Text
containers :: Maybe [Container]
containerInstanceArn :: Maybe Text
connectivityAt :: Maybe POSIX
connectivity :: Maybe Connectivity
clusterArn :: Maybe Text
capacityProviderName :: Maybe Text
availabilityZone :: Maybe Text
attributes :: Maybe [Attribute]
attachments :: Maybe [Attachment]
$sel:version:Task' :: Task -> Maybe Integer
$sel:taskDefinitionArn:Task' :: Task -> Maybe Text
$sel:taskArn:Task' :: Task -> Maybe Text
$sel:tags:Task' :: Task -> Maybe [Tag]
$sel:stoppingAt:Task' :: Task -> Maybe POSIX
$sel:stoppedReason:Task' :: Task -> Maybe Text
$sel:stoppedAt:Task' :: Task -> Maybe POSIX
$sel:stopCode:Task' :: Task -> Maybe TaskStopCode
$sel:startedBy:Task' :: Task -> Maybe Text
$sel:startedAt:Task' :: Task -> Maybe POSIX
$sel:pullStoppedAt:Task' :: Task -> Maybe POSIX
$sel:pullStartedAt:Task' :: Task -> Maybe POSIX
$sel:platformVersion:Task' :: Task -> Maybe Text
$sel:platformFamily:Task' :: Task -> Maybe Text
$sel:overrides:Task' :: Task -> Maybe TaskOverride
$sel:memory:Task' :: Task -> Maybe Text
$sel:launchType:Task' :: Task -> Maybe LaunchType
$sel:lastStatus:Task' :: Task -> Maybe Text
$sel:inferenceAccelerators:Task' :: Task -> Maybe [InferenceAccelerator]
$sel:healthStatus:Task' :: Task -> Maybe HealthStatus
$sel:group':Task' :: Task -> Maybe Text
$sel:executionStoppedAt:Task' :: Task -> Maybe POSIX
$sel:ephemeralStorage:Task' :: Task -> Maybe EphemeralStorage
$sel:enableExecuteCommand:Task' :: Task -> Maybe Bool
$sel:desiredStatus:Task' :: Task -> Maybe Text
$sel:createdAt:Task' :: Task -> Maybe POSIX
$sel:cpu:Task' :: Task -> Maybe Text
$sel:containers:Task' :: Task -> Maybe [Container]
$sel:containerInstanceArn:Task' :: Task -> Maybe Text
$sel:connectivityAt:Task' :: Task -> Maybe POSIX
$sel:connectivity:Task' :: Task -> Maybe Connectivity
$sel:clusterArn:Task' :: Task -> Maybe Text
$sel:capacityProviderName:Task' :: Task -> Maybe Text
$sel:availabilityZone:Task' :: Task -> Maybe Text
$sel:attributes:Task' :: Task -> Maybe [Attribute]
$sel:attachments:Task' :: Task -> Maybe [Attachment]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [Attachment]
attachments
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Attribute]
attributes
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
availabilityZone
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
capacityProviderName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
clusterArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Connectivity
connectivity
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
connectivityAt
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
containerInstanceArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Container]
containers
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
cpu
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
createdAt
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
desiredStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
enableExecuteCommand
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe EphemeralStorage
ephemeralStorage
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
executionStoppedAt
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
group'
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe HealthStatus
healthStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [InferenceAccelerator]
inferenceAccelerators
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
lastStatus
      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 Text
memory
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe TaskOverride
overrides
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        Maybe Text
platformFamily
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        Maybe Text
platformVersion
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        Maybe POSIX
pullStartedAt
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        Maybe POSIX
pullStoppedAt
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        Maybe POSIX
startedAt
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        Maybe Text
startedBy
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        Maybe TaskStopCode
stopCode
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        Maybe POSIX
stoppedAt
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        Maybe Text
stoppedReason
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        Maybe POSIX
stoppingAt
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        Maybe [Tag]
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        Maybe Text
taskArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        Maybe Text
taskDefinitionArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        Maybe Integer
version