{-# 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.TaskSet
-- 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.TaskSet 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.CapacityProviderStrategyItem
import Amazonka.ECS.Types.LaunchType
import Amazonka.ECS.Types.LoadBalancer
import Amazonka.ECS.Types.NetworkConfiguration
import Amazonka.ECS.Types.Scale
import Amazonka.ECS.Types.ServiceRegistry
import Amazonka.ECS.Types.StabilityStatus
import Amazonka.ECS.Types.Tag
import qualified Amazonka.Prelude as Prelude

-- | Information about a set of Amazon ECS tasks in either an CodeDeploy or
-- an @EXTERNAL@ deployment. An Amazon ECS task set includes details such
-- as the desired number of tasks, how many tasks are running, and whether
-- the task set serves production traffic.
--
-- /See:/ 'newTaskSet' smart constructor.
data TaskSet = TaskSet'
  { -- | The capacity provider strategy that are associated with the task set.
    TaskSet -> Maybe [CapacityProviderStrategyItem]
capacityProviderStrategy :: Prelude.Maybe [CapacityProviderStrategyItem],
    -- | The Amazon Resource Name (ARN) of the cluster that the service that
    -- hosts the task set exists in.
    TaskSet -> Maybe Text
clusterArn :: Prelude.Maybe Prelude.Text,
    -- | The computed desired count for the task set. This is calculated by
    -- multiplying the service\'s @desiredCount@ by the task set\'s @scale@
    -- percentage. The result is always rounded up. For example, if the
    -- computed desired count is 1.2, it rounds up to 2 tasks.
    TaskSet -> Maybe Int
computedDesiredCount :: Prelude.Maybe Prelude.Int,
    -- | The Unix timestamp for the time when the task set was created.
    TaskSet -> Maybe POSIX
createdAt :: Prelude.Maybe Data.POSIX,
    -- | The external ID associated with the task set.
    --
    -- If an CodeDeploy deployment created a task set, the @externalId@
    -- parameter contains the CodeDeploy deployment ID.
    --
    -- If a task set is created for an external deployment and is associated
    -- with a service discovery registry, the @externalId@ parameter contains
    -- the @ECS_TASK_SET_EXTERNAL_ID@ Cloud Map attribute.
    TaskSet -> Maybe Text
externalId :: Prelude.Maybe Prelude.Text,
    -- | The ID of the task set.
    TaskSet -> Maybe Text
id :: Prelude.Maybe Prelude.Text,
    -- | The launch type the tasks in the task set are using. 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/.
    TaskSet -> Maybe LaunchType
launchType :: Prelude.Maybe LaunchType,
    -- | Details on a load balancer that are used with a task set.
    TaskSet -> Maybe [LoadBalancer]
loadBalancers :: Prelude.Maybe [LoadBalancer],
    -- | The network configuration for the task set.
    TaskSet -> Maybe NetworkConfiguration
networkConfiguration :: Prelude.Maybe NetworkConfiguration,
    -- | The number of tasks in the task set that are in the @PENDING@ status
    -- during a deployment. A task in the @PENDING@ state is preparing to enter
    -- the @RUNNING@ state. A task set enters the @PENDING@ status when it
    -- launches for the first time or when it\'s restarted after being in the
    -- @STOPPED@ state.
    TaskSet -> Maybe Int
pendingCount :: Prelude.Maybe Prelude.Int,
    -- | The operating system that your tasks in the set are running on. A
    -- platform family is specified only for tasks that use the Fargate launch
    -- type.
    --
    -- All tasks in the set must have the same value.
    TaskSet -> Maybe Text
platformFamily :: Prelude.Maybe Prelude.Text,
    -- | The Fargate platform version where the tasks in the task set are
    -- running. A platform version is only specified for tasks run on Fargate.
    -- 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/.
    TaskSet -> Maybe Text
platformVersion :: Prelude.Maybe Prelude.Text,
    -- | The number of tasks in the task set that are in the @RUNNING@ status
    -- during a deployment. A task in the @RUNNING@ state is running and ready
    -- for use.
    TaskSet -> Maybe Int
runningCount :: Prelude.Maybe Prelude.Int,
    -- | A floating-point percentage of your desired number of tasks to place and
    -- keep running in the task set.
    TaskSet -> Maybe Scale
scale :: Prelude.Maybe Scale,
    -- | The Amazon Resource Name (ARN) of the service the task set exists in.
    TaskSet -> Maybe Text
serviceArn :: Prelude.Maybe Prelude.Text,
    -- | The details for the service discovery registries to assign to this task
    -- set. For more information, see
    -- <https://docs.aws.amazon.com/AmazonECS/latest/developerguide/service-discovery.html Service discovery>.
    TaskSet -> Maybe [ServiceRegistry]
serviceRegistries :: Prelude.Maybe [ServiceRegistry],
    -- | The stability status. This indicates whether the task set has reached a
    -- steady state. If the following conditions are met, the task set are in
    -- @STEADY_STATE@:
    --
    -- -   The task @runningCount@ is equal to the @computedDesiredCount@.
    --
    -- -   The @pendingCount@ is @0@.
    --
    -- -   There are no tasks that are running on container instances in the
    --     @DRAINING@ status.
    --
    -- -   All tasks are reporting a healthy status from the load balancers,
    --     service discovery, and container health checks.
    --
    -- If any of those conditions aren\'t met, the stability status returns
    -- @STABILIZING@.
    TaskSet -> Maybe StabilityStatus
stabilityStatus :: Prelude.Maybe StabilityStatus,
    -- | The Unix timestamp for the time when the task set stability status was
    -- retrieved.
    TaskSet -> Maybe POSIX
stabilityStatusAt :: Prelude.Maybe Data.POSIX,
    -- | The tag specified when a task set is started. If an CodeDeploy
    -- deployment created the task set, the @startedBy@ parameter is
    -- @CODE_DEPLOY@. If an external deployment created the task set, the
    -- @startedBy@ field isn\'t used.
    TaskSet -> Maybe Text
startedBy :: Prelude.Maybe Prelude.Text,
    -- | The status of the task set. The following describes each state.
    --
    -- [PRIMARY]
    --     The task set is serving production traffic.
    --
    -- [ACTIVE]
    --     The task set isn\'t serving production traffic.
    --
    -- [DRAINING]
    --     The tasks in the task set are being stopped, and their corresponding
    --     targets are being deregistered from their target group.
    TaskSet -> Maybe Text
status :: Prelude.Maybe Prelude.Text,
    -- | The metadata that you apply to the task set to help you categorize and
    -- organize them. Each tag consists of a key and an optional value. You
    -- define both.
    --
    -- 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.
    TaskSet -> Maybe [Tag]
tags :: Prelude.Maybe [Tag],
    -- | The task definition that the task set is using.
    TaskSet -> Maybe Text
taskDefinition :: Prelude.Maybe Prelude.Text,
    -- | The Amazon Resource Name (ARN) of the task set.
    TaskSet -> Maybe Text
taskSetArn :: Prelude.Maybe Prelude.Text,
    -- | The Unix timestamp for the time when the task set was last updated.
    TaskSet -> Maybe POSIX
updatedAt :: Prelude.Maybe Data.POSIX
  }
  deriving (TaskSet -> TaskSet -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TaskSet -> TaskSet -> Bool
$c/= :: TaskSet -> TaskSet -> Bool
== :: TaskSet -> TaskSet -> Bool
$c== :: TaskSet -> TaskSet -> Bool
Prelude.Eq, ReadPrec [TaskSet]
ReadPrec TaskSet
Int -> ReadS TaskSet
ReadS [TaskSet]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [TaskSet]
$creadListPrec :: ReadPrec [TaskSet]
readPrec :: ReadPrec TaskSet
$creadPrec :: ReadPrec TaskSet
readList :: ReadS [TaskSet]
$creadList :: ReadS [TaskSet]
readsPrec :: Int -> ReadS TaskSet
$creadsPrec :: Int -> ReadS TaskSet
Prelude.Read, Int -> TaskSet -> ShowS
[TaskSet] -> ShowS
TaskSet -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TaskSet] -> ShowS
$cshowList :: [TaskSet] -> ShowS
show :: TaskSet -> String
$cshow :: TaskSet -> String
showsPrec :: Int -> TaskSet -> ShowS
$cshowsPrec :: Int -> TaskSet -> ShowS
Prelude.Show, forall x. Rep TaskSet x -> TaskSet
forall x. TaskSet -> Rep TaskSet x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TaskSet x -> TaskSet
$cfrom :: forall x. TaskSet -> Rep TaskSet x
Prelude.Generic)

-- |
-- Create a value of 'TaskSet' 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:
--
-- 'capacityProviderStrategy', 'taskSet_capacityProviderStrategy' - The capacity provider strategy that are associated with the task set.
--
-- 'clusterArn', 'taskSet_clusterArn' - The Amazon Resource Name (ARN) of the cluster that the service that
-- hosts the task set exists in.
--
-- 'computedDesiredCount', 'taskSet_computedDesiredCount' - The computed desired count for the task set. This is calculated by
-- multiplying the service\'s @desiredCount@ by the task set\'s @scale@
-- percentage. The result is always rounded up. For example, if the
-- computed desired count is 1.2, it rounds up to 2 tasks.
--
-- 'createdAt', 'taskSet_createdAt' - The Unix timestamp for the time when the task set was created.
--
-- 'externalId', 'taskSet_externalId' - The external ID associated with the task set.
--
-- If an CodeDeploy deployment created a task set, the @externalId@
-- parameter contains the CodeDeploy deployment ID.
--
-- If a task set is created for an external deployment and is associated
-- with a service discovery registry, the @externalId@ parameter contains
-- the @ECS_TASK_SET_EXTERNAL_ID@ Cloud Map attribute.
--
-- 'id', 'taskSet_id' - The ID of the task set.
--
-- 'launchType', 'taskSet_launchType' - The launch type the tasks in the task set are using. 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/.
--
-- 'loadBalancers', 'taskSet_loadBalancers' - Details on a load balancer that are used with a task set.
--
-- 'networkConfiguration', 'taskSet_networkConfiguration' - The network configuration for the task set.
--
-- 'pendingCount', 'taskSet_pendingCount' - The number of tasks in the task set that are in the @PENDING@ status
-- during a deployment. A task in the @PENDING@ state is preparing to enter
-- the @RUNNING@ state. A task set enters the @PENDING@ status when it
-- launches for the first time or when it\'s restarted after being in the
-- @STOPPED@ state.
--
-- 'platformFamily', 'taskSet_platformFamily' - The operating system that your tasks in the set are running on. A
-- platform family is specified only for tasks that use the Fargate launch
-- type.
--
-- All tasks in the set must have the same value.
--
-- 'platformVersion', 'taskSet_platformVersion' - The Fargate platform version where the tasks in the task set are
-- running. A platform version is only specified for tasks run on Fargate.
-- 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/.
--
-- 'runningCount', 'taskSet_runningCount' - The number of tasks in the task set that are in the @RUNNING@ status
-- during a deployment. A task in the @RUNNING@ state is running and ready
-- for use.
--
-- 'scale', 'taskSet_scale' - A floating-point percentage of your desired number of tasks to place and
-- keep running in the task set.
--
-- 'serviceArn', 'taskSet_serviceArn' - The Amazon Resource Name (ARN) of the service the task set exists in.
--
-- 'serviceRegistries', 'taskSet_serviceRegistries' - The details for the service discovery registries to assign to this task
-- set. For more information, see
-- <https://docs.aws.amazon.com/AmazonECS/latest/developerguide/service-discovery.html Service discovery>.
--
-- 'stabilityStatus', 'taskSet_stabilityStatus' - The stability status. This indicates whether the task set has reached a
-- steady state. If the following conditions are met, the task set are in
-- @STEADY_STATE@:
--
-- -   The task @runningCount@ is equal to the @computedDesiredCount@.
--
-- -   The @pendingCount@ is @0@.
--
-- -   There are no tasks that are running on container instances in the
--     @DRAINING@ status.
--
-- -   All tasks are reporting a healthy status from the load balancers,
--     service discovery, and container health checks.
--
-- If any of those conditions aren\'t met, the stability status returns
-- @STABILIZING@.
--
-- 'stabilityStatusAt', 'taskSet_stabilityStatusAt' - The Unix timestamp for the time when the task set stability status was
-- retrieved.
--
-- 'startedBy', 'taskSet_startedBy' - The tag specified when a task set is started. If an CodeDeploy
-- deployment created the task set, the @startedBy@ parameter is
-- @CODE_DEPLOY@. If an external deployment created the task set, the
-- @startedBy@ field isn\'t used.
--
-- 'status', 'taskSet_status' - The status of the task set. The following describes each state.
--
-- [PRIMARY]
--     The task set is serving production traffic.
--
-- [ACTIVE]
--     The task set isn\'t serving production traffic.
--
-- [DRAINING]
--     The tasks in the task set are being stopped, and their corresponding
--     targets are being deregistered from their target group.
--
-- 'tags', 'taskSet_tags' - The metadata that you apply to the task set to help you categorize and
-- organize them. Each tag consists of a key and an optional value. You
-- define both.
--
-- 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.
--
-- 'taskDefinition', 'taskSet_taskDefinition' - The task definition that the task set is using.
--
-- 'taskSetArn', 'taskSet_taskSetArn' - The Amazon Resource Name (ARN) of the task set.
--
-- 'updatedAt', 'taskSet_updatedAt' - The Unix timestamp for the time when the task set was last updated.
newTaskSet ::
  TaskSet
newTaskSet :: TaskSet
newTaskSet =
  TaskSet'
    { $sel:capacityProviderStrategy:TaskSet' :: Maybe [CapacityProviderStrategyItem]
capacityProviderStrategy =
        forall a. Maybe a
Prelude.Nothing,
      $sel:clusterArn:TaskSet' :: Maybe Text
clusterArn = forall a. Maybe a
Prelude.Nothing,
      $sel:computedDesiredCount:TaskSet' :: Maybe Int
computedDesiredCount = forall a. Maybe a
Prelude.Nothing,
      $sel:createdAt:TaskSet' :: Maybe POSIX
createdAt = forall a. Maybe a
Prelude.Nothing,
      $sel:externalId:TaskSet' :: Maybe Text
externalId = forall a. Maybe a
Prelude.Nothing,
      $sel:id:TaskSet' :: Maybe Text
id = forall a. Maybe a
Prelude.Nothing,
      $sel:launchType:TaskSet' :: Maybe LaunchType
launchType = forall a. Maybe a
Prelude.Nothing,
      $sel:loadBalancers:TaskSet' :: Maybe [LoadBalancer]
loadBalancers = forall a. Maybe a
Prelude.Nothing,
      $sel:networkConfiguration:TaskSet' :: Maybe NetworkConfiguration
networkConfiguration = forall a. Maybe a
Prelude.Nothing,
      $sel:pendingCount:TaskSet' :: Maybe Int
pendingCount = forall a. Maybe a
Prelude.Nothing,
      $sel:platformFamily:TaskSet' :: Maybe Text
platformFamily = forall a. Maybe a
Prelude.Nothing,
      $sel:platformVersion:TaskSet' :: Maybe Text
platformVersion = forall a. Maybe a
Prelude.Nothing,
      $sel:runningCount:TaskSet' :: Maybe Int
runningCount = forall a. Maybe a
Prelude.Nothing,
      $sel:scale:TaskSet' :: Maybe Scale
scale = forall a. Maybe a
Prelude.Nothing,
      $sel:serviceArn:TaskSet' :: Maybe Text
serviceArn = forall a. Maybe a
Prelude.Nothing,
      $sel:serviceRegistries:TaskSet' :: Maybe [ServiceRegistry]
serviceRegistries = forall a. Maybe a
Prelude.Nothing,
      $sel:stabilityStatus:TaskSet' :: Maybe StabilityStatus
stabilityStatus = forall a. Maybe a
Prelude.Nothing,
      $sel:stabilityStatusAt:TaskSet' :: Maybe POSIX
stabilityStatusAt = forall a. Maybe a
Prelude.Nothing,
      $sel:startedBy:TaskSet' :: Maybe Text
startedBy = forall a. Maybe a
Prelude.Nothing,
      $sel:status:TaskSet' :: Maybe Text
status = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:TaskSet' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:taskDefinition:TaskSet' :: Maybe Text
taskDefinition = forall a. Maybe a
Prelude.Nothing,
      $sel:taskSetArn:TaskSet' :: Maybe Text
taskSetArn = forall a. Maybe a
Prelude.Nothing,
      $sel:updatedAt:TaskSet' :: Maybe POSIX
updatedAt = forall a. Maybe a
Prelude.Nothing
    }

-- | The capacity provider strategy that are associated with the task set.
taskSet_capacityProviderStrategy :: Lens.Lens' TaskSet (Prelude.Maybe [CapacityProviderStrategyItem])
taskSet_capacityProviderStrategy :: Lens' TaskSet (Maybe [CapacityProviderStrategyItem])
taskSet_capacityProviderStrategy = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TaskSet' {Maybe [CapacityProviderStrategyItem]
capacityProviderStrategy :: Maybe [CapacityProviderStrategyItem]
$sel:capacityProviderStrategy:TaskSet' :: TaskSet -> Maybe [CapacityProviderStrategyItem]
capacityProviderStrategy} -> Maybe [CapacityProviderStrategyItem]
capacityProviderStrategy) (\s :: TaskSet
s@TaskSet' {} Maybe [CapacityProviderStrategyItem]
a -> TaskSet
s {$sel:capacityProviderStrategy:TaskSet' :: Maybe [CapacityProviderStrategyItem]
capacityProviderStrategy = Maybe [CapacityProviderStrategyItem]
a} :: TaskSet) 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 cluster that the service that
-- hosts the task set exists in.
taskSet_clusterArn :: Lens.Lens' TaskSet (Prelude.Maybe Prelude.Text)
taskSet_clusterArn :: Lens' TaskSet (Maybe Text)
taskSet_clusterArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TaskSet' {Maybe Text
clusterArn :: Maybe Text
$sel:clusterArn:TaskSet' :: TaskSet -> Maybe Text
clusterArn} -> Maybe Text
clusterArn) (\s :: TaskSet
s@TaskSet' {} Maybe Text
a -> TaskSet
s {$sel:clusterArn:TaskSet' :: Maybe Text
clusterArn = Maybe Text
a} :: TaskSet)

-- | The computed desired count for the task set. This is calculated by
-- multiplying the service\'s @desiredCount@ by the task set\'s @scale@
-- percentage. The result is always rounded up. For example, if the
-- computed desired count is 1.2, it rounds up to 2 tasks.
taskSet_computedDesiredCount :: Lens.Lens' TaskSet (Prelude.Maybe Prelude.Int)
taskSet_computedDesiredCount :: Lens' TaskSet (Maybe Int)
taskSet_computedDesiredCount = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TaskSet' {Maybe Int
computedDesiredCount :: Maybe Int
$sel:computedDesiredCount:TaskSet' :: TaskSet -> Maybe Int
computedDesiredCount} -> Maybe Int
computedDesiredCount) (\s :: TaskSet
s@TaskSet' {} Maybe Int
a -> TaskSet
s {$sel:computedDesiredCount:TaskSet' :: Maybe Int
computedDesiredCount = Maybe Int
a} :: TaskSet)

-- | The Unix timestamp for the time when the task set was created.
taskSet_createdAt :: Lens.Lens' TaskSet (Prelude.Maybe Prelude.UTCTime)
taskSet_createdAt :: Lens' TaskSet (Maybe UTCTime)
taskSet_createdAt = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TaskSet' {Maybe POSIX
createdAt :: Maybe POSIX
$sel:createdAt:TaskSet' :: TaskSet -> Maybe POSIX
createdAt} -> Maybe POSIX
createdAt) (\s :: TaskSet
s@TaskSet' {} Maybe POSIX
a -> TaskSet
s {$sel:createdAt:TaskSet' :: Maybe POSIX
createdAt = Maybe POSIX
a} :: TaskSet) 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 external ID associated with the task set.
--
-- If an CodeDeploy deployment created a task set, the @externalId@
-- parameter contains the CodeDeploy deployment ID.
--
-- If a task set is created for an external deployment and is associated
-- with a service discovery registry, the @externalId@ parameter contains
-- the @ECS_TASK_SET_EXTERNAL_ID@ Cloud Map attribute.
taskSet_externalId :: Lens.Lens' TaskSet (Prelude.Maybe Prelude.Text)
taskSet_externalId :: Lens' TaskSet (Maybe Text)
taskSet_externalId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TaskSet' {Maybe Text
externalId :: Maybe Text
$sel:externalId:TaskSet' :: TaskSet -> Maybe Text
externalId} -> Maybe Text
externalId) (\s :: TaskSet
s@TaskSet' {} Maybe Text
a -> TaskSet
s {$sel:externalId:TaskSet' :: Maybe Text
externalId = Maybe Text
a} :: TaskSet)

-- | The ID of the task set.
taskSet_id :: Lens.Lens' TaskSet (Prelude.Maybe Prelude.Text)
taskSet_id :: Lens' TaskSet (Maybe Text)
taskSet_id = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TaskSet' {Maybe Text
id :: Maybe Text
$sel:id:TaskSet' :: TaskSet -> Maybe Text
id} -> Maybe Text
id) (\s :: TaskSet
s@TaskSet' {} Maybe Text
a -> TaskSet
s {$sel:id:TaskSet' :: Maybe Text
id = Maybe Text
a} :: TaskSet)

-- | The launch type the tasks in the task set are using. 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/.
taskSet_launchType :: Lens.Lens' TaskSet (Prelude.Maybe LaunchType)
taskSet_launchType :: Lens' TaskSet (Maybe LaunchType)
taskSet_launchType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TaskSet' {Maybe LaunchType
launchType :: Maybe LaunchType
$sel:launchType:TaskSet' :: TaskSet -> Maybe LaunchType
launchType} -> Maybe LaunchType
launchType) (\s :: TaskSet
s@TaskSet' {} Maybe LaunchType
a -> TaskSet
s {$sel:launchType:TaskSet' :: Maybe LaunchType
launchType = Maybe LaunchType
a} :: TaskSet)

-- | Details on a load balancer that are used with a task set.
taskSet_loadBalancers :: Lens.Lens' TaskSet (Prelude.Maybe [LoadBalancer])
taskSet_loadBalancers :: Lens' TaskSet (Maybe [LoadBalancer])
taskSet_loadBalancers = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TaskSet' {Maybe [LoadBalancer]
loadBalancers :: Maybe [LoadBalancer]
$sel:loadBalancers:TaskSet' :: TaskSet -> Maybe [LoadBalancer]
loadBalancers} -> Maybe [LoadBalancer]
loadBalancers) (\s :: TaskSet
s@TaskSet' {} Maybe [LoadBalancer]
a -> TaskSet
s {$sel:loadBalancers:TaskSet' :: Maybe [LoadBalancer]
loadBalancers = Maybe [LoadBalancer]
a} :: TaskSet) 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 network configuration for the task set.
taskSet_networkConfiguration :: Lens.Lens' TaskSet (Prelude.Maybe NetworkConfiguration)
taskSet_networkConfiguration :: Lens' TaskSet (Maybe NetworkConfiguration)
taskSet_networkConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TaskSet' {Maybe NetworkConfiguration
networkConfiguration :: Maybe NetworkConfiguration
$sel:networkConfiguration:TaskSet' :: TaskSet -> Maybe NetworkConfiguration
networkConfiguration} -> Maybe NetworkConfiguration
networkConfiguration) (\s :: TaskSet
s@TaskSet' {} Maybe NetworkConfiguration
a -> TaskSet
s {$sel:networkConfiguration:TaskSet' :: Maybe NetworkConfiguration
networkConfiguration = Maybe NetworkConfiguration
a} :: TaskSet)

-- | The number of tasks in the task set that are in the @PENDING@ status
-- during a deployment. A task in the @PENDING@ state is preparing to enter
-- the @RUNNING@ state. A task set enters the @PENDING@ status when it
-- launches for the first time or when it\'s restarted after being in the
-- @STOPPED@ state.
taskSet_pendingCount :: Lens.Lens' TaskSet (Prelude.Maybe Prelude.Int)
taskSet_pendingCount :: Lens' TaskSet (Maybe Int)
taskSet_pendingCount = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TaskSet' {Maybe Int
pendingCount :: Maybe Int
$sel:pendingCount:TaskSet' :: TaskSet -> Maybe Int
pendingCount} -> Maybe Int
pendingCount) (\s :: TaskSet
s@TaskSet' {} Maybe Int
a -> TaskSet
s {$sel:pendingCount:TaskSet' :: Maybe Int
pendingCount = Maybe Int
a} :: TaskSet)

-- | The operating system that your tasks in the set are running on. A
-- platform family is specified only for tasks that use the Fargate launch
-- type.
--
-- All tasks in the set must have the same value.
taskSet_platformFamily :: Lens.Lens' TaskSet (Prelude.Maybe Prelude.Text)
taskSet_platformFamily :: Lens' TaskSet (Maybe Text)
taskSet_platformFamily = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TaskSet' {Maybe Text
platformFamily :: Maybe Text
$sel:platformFamily:TaskSet' :: TaskSet -> Maybe Text
platformFamily} -> Maybe Text
platformFamily) (\s :: TaskSet
s@TaskSet' {} Maybe Text
a -> TaskSet
s {$sel:platformFamily:TaskSet' :: Maybe Text
platformFamily = Maybe Text
a} :: TaskSet)

-- | The Fargate platform version where the tasks in the task set are
-- running. A platform version is only specified for tasks run on Fargate.
-- 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/.
taskSet_platformVersion :: Lens.Lens' TaskSet (Prelude.Maybe Prelude.Text)
taskSet_platformVersion :: Lens' TaskSet (Maybe Text)
taskSet_platformVersion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TaskSet' {Maybe Text
platformVersion :: Maybe Text
$sel:platformVersion:TaskSet' :: TaskSet -> Maybe Text
platformVersion} -> Maybe Text
platformVersion) (\s :: TaskSet
s@TaskSet' {} Maybe Text
a -> TaskSet
s {$sel:platformVersion:TaskSet' :: Maybe Text
platformVersion = Maybe Text
a} :: TaskSet)

-- | The number of tasks in the task set that are in the @RUNNING@ status
-- during a deployment. A task in the @RUNNING@ state is running and ready
-- for use.
taskSet_runningCount :: Lens.Lens' TaskSet (Prelude.Maybe Prelude.Int)
taskSet_runningCount :: Lens' TaskSet (Maybe Int)
taskSet_runningCount = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TaskSet' {Maybe Int
runningCount :: Maybe Int
$sel:runningCount:TaskSet' :: TaskSet -> Maybe Int
runningCount} -> Maybe Int
runningCount) (\s :: TaskSet
s@TaskSet' {} Maybe Int
a -> TaskSet
s {$sel:runningCount:TaskSet' :: Maybe Int
runningCount = Maybe Int
a} :: TaskSet)

-- | A floating-point percentage of your desired number of tasks to place and
-- keep running in the task set.
taskSet_scale :: Lens.Lens' TaskSet (Prelude.Maybe Scale)
taskSet_scale :: Lens' TaskSet (Maybe Scale)
taskSet_scale = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TaskSet' {Maybe Scale
scale :: Maybe Scale
$sel:scale:TaskSet' :: TaskSet -> Maybe Scale
scale} -> Maybe Scale
scale) (\s :: TaskSet
s@TaskSet' {} Maybe Scale
a -> TaskSet
s {$sel:scale:TaskSet' :: Maybe Scale
scale = Maybe Scale
a} :: TaskSet)

-- | The Amazon Resource Name (ARN) of the service the task set exists in.
taskSet_serviceArn :: Lens.Lens' TaskSet (Prelude.Maybe Prelude.Text)
taskSet_serviceArn :: Lens' TaskSet (Maybe Text)
taskSet_serviceArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TaskSet' {Maybe Text
serviceArn :: Maybe Text
$sel:serviceArn:TaskSet' :: TaskSet -> Maybe Text
serviceArn} -> Maybe Text
serviceArn) (\s :: TaskSet
s@TaskSet' {} Maybe Text
a -> TaskSet
s {$sel:serviceArn:TaskSet' :: Maybe Text
serviceArn = Maybe Text
a} :: TaskSet)

-- | The details for the service discovery registries to assign to this task
-- set. For more information, see
-- <https://docs.aws.amazon.com/AmazonECS/latest/developerguide/service-discovery.html Service discovery>.
taskSet_serviceRegistries :: Lens.Lens' TaskSet (Prelude.Maybe [ServiceRegistry])
taskSet_serviceRegistries :: Lens' TaskSet (Maybe [ServiceRegistry])
taskSet_serviceRegistries = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TaskSet' {Maybe [ServiceRegistry]
serviceRegistries :: Maybe [ServiceRegistry]
$sel:serviceRegistries:TaskSet' :: TaskSet -> Maybe [ServiceRegistry]
serviceRegistries} -> Maybe [ServiceRegistry]
serviceRegistries) (\s :: TaskSet
s@TaskSet' {} Maybe [ServiceRegistry]
a -> TaskSet
s {$sel:serviceRegistries:TaskSet' :: Maybe [ServiceRegistry]
serviceRegistries = Maybe [ServiceRegistry]
a} :: TaskSet) 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 stability status. This indicates whether the task set has reached a
-- steady state. If the following conditions are met, the task set are in
-- @STEADY_STATE@:
--
-- -   The task @runningCount@ is equal to the @computedDesiredCount@.
--
-- -   The @pendingCount@ is @0@.
--
-- -   There are no tasks that are running on container instances in the
--     @DRAINING@ status.
--
-- -   All tasks are reporting a healthy status from the load balancers,
--     service discovery, and container health checks.
--
-- If any of those conditions aren\'t met, the stability status returns
-- @STABILIZING@.
taskSet_stabilityStatus :: Lens.Lens' TaskSet (Prelude.Maybe StabilityStatus)
taskSet_stabilityStatus :: Lens' TaskSet (Maybe StabilityStatus)
taskSet_stabilityStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TaskSet' {Maybe StabilityStatus
stabilityStatus :: Maybe StabilityStatus
$sel:stabilityStatus:TaskSet' :: TaskSet -> Maybe StabilityStatus
stabilityStatus} -> Maybe StabilityStatus
stabilityStatus) (\s :: TaskSet
s@TaskSet' {} Maybe StabilityStatus
a -> TaskSet
s {$sel:stabilityStatus:TaskSet' :: Maybe StabilityStatus
stabilityStatus = Maybe StabilityStatus
a} :: TaskSet)

-- | The Unix timestamp for the time when the task set stability status was
-- retrieved.
taskSet_stabilityStatusAt :: Lens.Lens' TaskSet (Prelude.Maybe Prelude.UTCTime)
taskSet_stabilityStatusAt :: Lens' TaskSet (Maybe UTCTime)
taskSet_stabilityStatusAt = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TaskSet' {Maybe POSIX
stabilityStatusAt :: Maybe POSIX
$sel:stabilityStatusAt:TaskSet' :: TaskSet -> Maybe POSIX
stabilityStatusAt} -> Maybe POSIX
stabilityStatusAt) (\s :: TaskSet
s@TaskSet' {} Maybe POSIX
a -> TaskSet
s {$sel:stabilityStatusAt:TaskSet' :: Maybe POSIX
stabilityStatusAt = Maybe POSIX
a} :: TaskSet) 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 set is started. If an CodeDeploy
-- deployment created the task set, the @startedBy@ parameter is
-- @CODE_DEPLOY@. If an external deployment created the task set, the
-- @startedBy@ field isn\'t used.
taskSet_startedBy :: Lens.Lens' TaskSet (Prelude.Maybe Prelude.Text)
taskSet_startedBy :: Lens' TaskSet (Maybe Text)
taskSet_startedBy = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TaskSet' {Maybe Text
startedBy :: Maybe Text
$sel:startedBy:TaskSet' :: TaskSet -> Maybe Text
startedBy} -> Maybe Text
startedBy) (\s :: TaskSet
s@TaskSet' {} Maybe Text
a -> TaskSet
s {$sel:startedBy:TaskSet' :: Maybe Text
startedBy = Maybe Text
a} :: TaskSet)

-- | The status of the task set. The following describes each state.
--
-- [PRIMARY]
--     The task set is serving production traffic.
--
-- [ACTIVE]
--     The task set isn\'t serving production traffic.
--
-- [DRAINING]
--     The tasks in the task set are being stopped, and their corresponding
--     targets are being deregistered from their target group.
taskSet_status :: Lens.Lens' TaskSet (Prelude.Maybe Prelude.Text)
taskSet_status :: Lens' TaskSet (Maybe Text)
taskSet_status = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TaskSet' {Maybe Text
status :: Maybe Text
$sel:status:TaskSet' :: TaskSet -> Maybe Text
status} -> Maybe Text
status) (\s :: TaskSet
s@TaskSet' {} Maybe Text
a -> TaskSet
s {$sel:status:TaskSet' :: Maybe Text
status = Maybe Text
a} :: TaskSet)

-- | The metadata that you apply to the task set to help you categorize and
-- organize them. Each tag consists of a key and an optional value. You
-- define both.
--
-- 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.
taskSet_tags :: Lens.Lens' TaskSet (Prelude.Maybe [Tag])
taskSet_tags :: Lens' TaskSet (Maybe [Tag])
taskSet_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TaskSet' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:TaskSet' :: TaskSet -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: TaskSet
s@TaskSet' {} Maybe [Tag]
a -> TaskSet
s {$sel:tags:TaskSet' :: Maybe [Tag]
tags = Maybe [Tag]
a} :: TaskSet) 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 task definition that the task set is using.
taskSet_taskDefinition :: Lens.Lens' TaskSet (Prelude.Maybe Prelude.Text)
taskSet_taskDefinition :: Lens' TaskSet (Maybe Text)
taskSet_taskDefinition = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TaskSet' {Maybe Text
taskDefinition :: Maybe Text
$sel:taskDefinition:TaskSet' :: TaskSet -> Maybe Text
taskDefinition} -> Maybe Text
taskDefinition) (\s :: TaskSet
s@TaskSet' {} Maybe Text
a -> TaskSet
s {$sel:taskDefinition:TaskSet' :: Maybe Text
taskDefinition = Maybe Text
a} :: TaskSet)

-- | The Amazon Resource Name (ARN) of the task set.
taskSet_taskSetArn :: Lens.Lens' TaskSet (Prelude.Maybe Prelude.Text)
taskSet_taskSetArn :: Lens' TaskSet (Maybe Text)
taskSet_taskSetArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TaskSet' {Maybe Text
taskSetArn :: Maybe Text
$sel:taskSetArn:TaskSet' :: TaskSet -> Maybe Text
taskSetArn} -> Maybe Text
taskSetArn) (\s :: TaskSet
s@TaskSet' {} Maybe Text
a -> TaskSet
s {$sel:taskSetArn:TaskSet' :: Maybe Text
taskSetArn = Maybe Text
a} :: TaskSet)

-- | The Unix timestamp for the time when the task set was last updated.
taskSet_updatedAt :: Lens.Lens' TaskSet (Prelude.Maybe Prelude.UTCTime)
taskSet_updatedAt :: Lens' TaskSet (Maybe UTCTime)
taskSet_updatedAt = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TaskSet' {Maybe POSIX
updatedAt :: Maybe POSIX
$sel:updatedAt:TaskSet' :: TaskSet -> Maybe POSIX
updatedAt} -> Maybe POSIX
updatedAt) (\s :: TaskSet
s@TaskSet' {} Maybe POSIX
a -> TaskSet
s {$sel:updatedAt:TaskSet' :: Maybe POSIX
updatedAt = Maybe POSIX
a} :: TaskSet) 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

instance Data.FromJSON TaskSet where
  parseJSON :: Value -> Parser TaskSet
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"TaskSet"
      ( \Object
x ->
          Maybe [CapacityProviderStrategyItem]
-> Maybe Text
-> Maybe Int
-> Maybe POSIX
-> Maybe Text
-> Maybe Text
-> Maybe LaunchType
-> Maybe [LoadBalancer]
-> Maybe NetworkConfiguration
-> Maybe Int
-> Maybe Text
-> Maybe Text
-> Maybe Int
-> Maybe Scale
-> Maybe Text
-> Maybe [ServiceRegistry]
-> Maybe StabilityStatus
-> Maybe POSIX
-> Maybe Text
-> Maybe Text
-> Maybe [Tag]
-> Maybe Text
-> Maybe Text
-> Maybe POSIX
-> TaskSet
TaskSet'
            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
"capacityProviderStrategy"
                            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
"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
"computedDesiredCount")
            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
"externalId")
            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
"id")
            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
"loadBalancers" 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
"networkConfiguration")
            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
"pendingCount")
            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
"runningCount")
            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
"scale")
            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
"serviceArn")
            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
"serviceRegistries"
                            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
"stabilityStatus")
            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
"stabilityStatusAt")
            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
"status")
            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
"taskDefinition")
            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
"taskSetArn")
            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
"updatedAt")
      )

instance Prelude.Hashable TaskSet where
  hashWithSalt :: Int -> TaskSet -> Int
hashWithSalt Int
_salt TaskSet' {Maybe Int
Maybe [CapacityProviderStrategyItem]
Maybe [LoadBalancer]
Maybe [ServiceRegistry]
Maybe [Tag]
Maybe Text
Maybe POSIX
Maybe LaunchType
Maybe NetworkConfiguration
Maybe Scale
Maybe StabilityStatus
updatedAt :: Maybe POSIX
taskSetArn :: Maybe Text
taskDefinition :: Maybe Text
tags :: Maybe [Tag]
status :: Maybe Text
startedBy :: Maybe Text
stabilityStatusAt :: Maybe POSIX
stabilityStatus :: Maybe StabilityStatus
serviceRegistries :: Maybe [ServiceRegistry]
serviceArn :: Maybe Text
scale :: Maybe Scale
runningCount :: Maybe Int
platformVersion :: Maybe Text
platformFamily :: Maybe Text
pendingCount :: Maybe Int
networkConfiguration :: Maybe NetworkConfiguration
loadBalancers :: Maybe [LoadBalancer]
launchType :: Maybe LaunchType
id :: Maybe Text
externalId :: Maybe Text
createdAt :: Maybe POSIX
computedDesiredCount :: Maybe Int
clusterArn :: Maybe Text
capacityProviderStrategy :: Maybe [CapacityProviderStrategyItem]
$sel:updatedAt:TaskSet' :: TaskSet -> Maybe POSIX
$sel:taskSetArn:TaskSet' :: TaskSet -> Maybe Text
$sel:taskDefinition:TaskSet' :: TaskSet -> Maybe Text
$sel:tags:TaskSet' :: TaskSet -> Maybe [Tag]
$sel:status:TaskSet' :: TaskSet -> Maybe Text
$sel:startedBy:TaskSet' :: TaskSet -> Maybe Text
$sel:stabilityStatusAt:TaskSet' :: TaskSet -> Maybe POSIX
$sel:stabilityStatus:TaskSet' :: TaskSet -> Maybe StabilityStatus
$sel:serviceRegistries:TaskSet' :: TaskSet -> Maybe [ServiceRegistry]
$sel:serviceArn:TaskSet' :: TaskSet -> Maybe Text
$sel:scale:TaskSet' :: TaskSet -> Maybe Scale
$sel:runningCount:TaskSet' :: TaskSet -> Maybe Int
$sel:platformVersion:TaskSet' :: TaskSet -> Maybe Text
$sel:platformFamily:TaskSet' :: TaskSet -> Maybe Text
$sel:pendingCount:TaskSet' :: TaskSet -> Maybe Int
$sel:networkConfiguration:TaskSet' :: TaskSet -> Maybe NetworkConfiguration
$sel:loadBalancers:TaskSet' :: TaskSet -> Maybe [LoadBalancer]
$sel:launchType:TaskSet' :: TaskSet -> Maybe LaunchType
$sel:id:TaskSet' :: TaskSet -> Maybe Text
$sel:externalId:TaskSet' :: TaskSet -> Maybe Text
$sel:createdAt:TaskSet' :: TaskSet -> Maybe POSIX
$sel:computedDesiredCount:TaskSet' :: TaskSet -> Maybe Int
$sel:clusterArn:TaskSet' :: TaskSet -> Maybe Text
$sel:capacityProviderStrategy:TaskSet' :: TaskSet -> Maybe [CapacityProviderStrategyItem]
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [CapacityProviderStrategyItem]
capacityProviderStrategy
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
clusterArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
computedDesiredCount
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe POSIX
createdAt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
externalId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
id
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe LaunchType
launchType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [LoadBalancer]
loadBalancers
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe NetworkConfiguration
networkConfiguration
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
pendingCount
      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 Int
runningCount
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Scale
scale
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
serviceArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [ServiceRegistry]
serviceRegistries
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe StabilityStatus
stabilityStatus
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe POSIX
stabilityStatusAt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
startedBy
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
status
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Tag]
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
taskDefinition
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
taskSetArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe POSIX
updatedAt

instance Prelude.NFData TaskSet where
  rnf :: TaskSet -> ()
rnf TaskSet' {Maybe Int
Maybe [CapacityProviderStrategyItem]
Maybe [LoadBalancer]
Maybe [ServiceRegistry]
Maybe [Tag]
Maybe Text
Maybe POSIX
Maybe LaunchType
Maybe NetworkConfiguration
Maybe Scale
Maybe StabilityStatus
updatedAt :: Maybe POSIX
taskSetArn :: Maybe Text
taskDefinition :: Maybe Text
tags :: Maybe [Tag]
status :: Maybe Text
startedBy :: Maybe Text
stabilityStatusAt :: Maybe POSIX
stabilityStatus :: Maybe StabilityStatus
serviceRegistries :: Maybe [ServiceRegistry]
serviceArn :: Maybe Text
scale :: Maybe Scale
runningCount :: Maybe Int
platformVersion :: Maybe Text
platformFamily :: Maybe Text
pendingCount :: Maybe Int
networkConfiguration :: Maybe NetworkConfiguration
loadBalancers :: Maybe [LoadBalancer]
launchType :: Maybe LaunchType
id :: Maybe Text
externalId :: Maybe Text
createdAt :: Maybe POSIX
computedDesiredCount :: Maybe Int
clusterArn :: Maybe Text
capacityProviderStrategy :: Maybe [CapacityProviderStrategyItem]
$sel:updatedAt:TaskSet' :: TaskSet -> Maybe POSIX
$sel:taskSetArn:TaskSet' :: TaskSet -> Maybe Text
$sel:taskDefinition:TaskSet' :: TaskSet -> Maybe Text
$sel:tags:TaskSet' :: TaskSet -> Maybe [Tag]
$sel:status:TaskSet' :: TaskSet -> Maybe Text
$sel:startedBy:TaskSet' :: TaskSet -> Maybe Text
$sel:stabilityStatusAt:TaskSet' :: TaskSet -> Maybe POSIX
$sel:stabilityStatus:TaskSet' :: TaskSet -> Maybe StabilityStatus
$sel:serviceRegistries:TaskSet' :: TaskSet -> Maybe [ServiceRegistry]
$sel:serviceArn:TaskSet' :: TaskSet -> Maybe Text
$sel:scale:TaskSet' :: TaskSet -> Maybe Scale
$sel:runningCount:TaskSet' :: TaskSet -> Maybe Int
$sel:platformVersion:TaskSet' :: TaskSet -> Maybe Text
$sel:platformFamily:TaskSet' :: TaskSet -> Maybe Text
$sel:pendingCount:TaskSet' :: TaskSet -> Maybe Int
$sel:networkConfiguration:TaskSet' :: TaskSet -> Maybe NetworkConfiguration
$sel:loadBalancers:TaskSet' :: TaskSet -> Maybe [LoadBalancer]
$sel:launchType:TaskSet' :: TaskSet -> Maybe LaunchType
$sel:id:TaskSet' :: TaskSet -> Maybe Text
$sel:externalId:TaskSet' :: TaskSet -> Maybe Text
$sel:createdAt:TaskSet' :: TaskSet -> Maybe POSIX
$sel:computedDesiredCount:TaskSet' :: TaskSet -> Maybe Int
$sel:clusterArn:TaskSet' :: TaskSet -> Maybe Text
$sel:capacityProviderStrategy:TaskSet' :: TaskSet -> Maybe [CapacityProviderStrategyItem]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [CapacityProviderStrategyItem]
capacityProviderStrategy
      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 Int
computedDesiredCount
      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
externalId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
id
      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 [LoadBalancer]
loadBalancers
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe NetworkConfiguration
networkConfiguration
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
pendingCount
      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 Int
runningCount
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Scale
scale
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
serviceArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [ServiceRegistry]
serviceRegistries
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe StabilityStatus
stabilityStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
stabilityStatusAt
      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 Text
status
      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
taskDefinition
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
taskSetArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
updatedAt