{-# 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.CloudWatchEvents.Types.EcsParameters
-- 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.CloudWatchEvents.Types.EcsParameters where

import Amazonka.CloudWatchEvents.Types.CapacityProviderStrategyItem
import Amazonka.CloudWatchEvents.Types.LaunchType
import Amazonka.CloudWatchEvents.Types.NetworkConfiguration
import Amazonka.CloudWatchEvents.Types.PlacementConstraint
import Amazonka.CloudWatchEvents.Types.PlacementStrategy
import Amazonka.CloudWatchEvents.Types.PropagateTags
import Amazonka.CloudWatchEvents.Types.Tag
import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import qualified Amazonka.Prelude as Prelude

-- | The custom parameters to be used when the target is an Amazon ECS task.
--
-- /See:/ 'newEcsParameters' smart constructor.
data EcsParameters = EcsParameters'
  { -- | The capacity provider strategy to use for the task.
    --
    -- If a @capacityProviderStrategy@ is specified, the @launchType@ parameter
    -- must be omitted. If no @capacityProviderStrategy@ or launchType is
    -- specified, the @defaultCapacityProviderStrategy@ for the cluster is
    -- used.
    EcsParameters -> Maybe [CapacityProviderStrategyItem]
capacityProviderStrategy :: Prelude.Maybe [CapacityProviderStrategyItem],
    -- | Specifies whether to enable Amazon ECS managed tags for the task. For
    -- more information, see
    -- <https://docs.aws.amazon.com/AmazonECS/latest/developerguide/ecs-using-tags.html Tagging Your Amazon ECS Resources>
    -- in the Amazon Elastic Container Service Developer Guide.
    EcsParameters -> Maybe Bool
enableECSManagedTags :: Prelude.Maybe Prelude.Bool,
    -- | Whether or not to enable the execute command functionality for the
    -- containers in this task. If true, this enables execute command
    -- functionality on all containers in the task.
    EcsParameters -> Maybe Bool
enableExecuteCommand :: Prelude.Maybe Prelude.Bool,
    -- | Specifies an ECS task group for the task. The maximum length is 255
    -- characters.
    EcsParameters -> Maybe Text
group' :: Prelude.Maybe Prelude.Text,
    -- | Specifies the launch type on which your task is running. The launch type
    -- that you specify here must match one of the launch type
    -- (compatibilities) of the target task. The @FARGATE@ value is supported
    -- only in the Regions where Fargate with Amazon ECS is supported. For more
    -- information, see
    -- <https://docs.aws.amazon.com/AmazonECS/latest/developerguide/AWS-Fargate.html Fargate on Amazon ECS>
    -- in the /Amazon Elastic Container Service Developer Guide/.
    EcsParameters -> Maybe LaunchType
launchType :: Prelude.Maybe LaunchType,
    -- | Use this structure if the Amazon ECS task uses the @awsvpc@ network
    -- mode. This structure specifies the VPC subnets and security groups
    -- associated with the task, and whether a public IP address is to be used.
    -- This structure is required if @LaunchType@ is @FARGATE@ because the
    -- @awsvpc@ mode is required for Fargate tasks.
    --
    -- If you specify @NetworkConfiguration@ when the target ECS task does not
    -- use the @awsvpc@ network mode, the task fails.
    EcsParameters -> Maybe NetworkConfiguration
networkConfiguration :: Prelude.Maybe NetworkConfiguration,
    -- | An array of placement constraint objects to use for the task. You can
    -- specify up to 10 constraints per task (including constraints in the task
    -- definition and those specified at runtime).
    EcsParameters -> Maybe [PlacementConstraint]
placementConstraints :: Prelude.Maybe [PlacementConstraint],
    -- | The placement strategy objects to use for the task. You can specify a
    -- maximum of five strategy rules per task.
    EcsParameters -> Maybe [PlacementStrategy]
placementStrategy :: Prelude.Maybe [PlacementStrategy],
    -- | Specifies the platform version for the task. Specify only the numeric
    -- portion of the platform version, such as @1.1.0@.
    --
    -- This structure is used only if @LaunchType@ is @FARGATE@. For more
    -- information about valid platform versions, see
    -- <https://docs.aws.amazon.com/AmazonECS/latest/developerguide/platform_versions.html Fargate Platform Versions>
    -- in the /Amazon Elastic Container Service Developer Guide/.
    EcsParameters -> Maybe Text
platformVersion :: Prelude.Maybe Prelude.Text,
    -- | Specifies whether to propagate the tags from the task definition to the
    -- task. If no value is specified, the tags are not propagated. Tags can
    -- only be propagated to the task during task creation. To add tags to a
    -- task after task creation, use the TagResource API action.
    EcsParameters -> Maybe PropagateTags
propagateTags :: Prelude.Maybe PropagateTags,
    -- | The reference ID to use for the task.
    EcsParameters -> Maybe Text
referenceId :: Prelude.Maybe Prelude.Text,
    -- | The metadata that you apply to the task to help you categorize and
    -- organize them. Each tag consists of a key and an optional value, both of
    -- which you define. To learn more, see
    -- <https://docs.aws.amazon.com/AmazonECS/latest/APIReference/API_RunTask.html#ECS-RunTask-request-tags RunTask>
    -- in the Amazon ECS API Reference.
    EcsParameters -> Maybe [Tag]
tags :: Prelude.Maybe [Tag],
    -- | The number of tasks to create based on @TaskDefinition@. The default is
    -- 1.
    EcsParameters -> Maybe Natural
taskCount :: Prelude.Maybe Prelude.Natural,
    -- | The ARN of the task definition to use if the event target is an Amazon
    -- ECS task.
    EcsParameters -> Text
taskDefinitionArn :: Prelude.Text
  }
  deriving (EcsParameters -> EcsParameters -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EcsParameters -> EcsParameters -> Bool
$c/= :: EcsParameters -> EcsParameters -> Bool
== :: EcsParameters -> EcsParameters -> Bool
$c== :: EcsParameters -> EcsParameters -> Bool
Prelude.Eq, ReadPrec [EcsParameters]
ReadPrec EcsParameters
Int -> ReadS EcsParameters
ReadS [EcsParameters]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [EcsParameters]
$creadListPrec :: ReadPrec [EcsParameters]
readPrec :: ReadPrec EcsParameters
$creadPrec :: ReadPrec EcsParameters
readList :: ReadS [EcsParameters]
$creadList :: ReadS [EcsParameters]
readsPrec :: Int -> ReadS EcsParameters
$creadsPrec :: Int -> ReadS EcsParameters
Prelude.Read, Int -> EcsParameters -> ShowS
[EcsParameters] -> ShowS
EcsParameters -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EcsParameters] -> ShowS
$cshowList :: [EcsParameters] -> ShowS
show :: EcsParameters -> String
$cshow :: EcsParameters -> String
showsPrec :: Int -> EcsParameters -> ShowS
$cshowsPrec :: Int -> EcsParameters -> ShowS
Prelude.Show, forall x. Rep EcsParameters x -> EcsParameters
forall x. EcsParameters -> Rep EcsParameters x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep EcsParameters x -> EcsParameters
$cfrom :: forall x. EcsParameters -> Rep EcsParameters x
Prelude.Generic)

-- |
-- Create a value of 'EcsParameters' 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', 'ecsParameters_capacityProviderStrategy' - The capacity provider strategy to use for the task.
--
-- If a @capacityProviderStrategy@ is specified, the @launchType@ parameter
-- must be omitted. If no @capacityProviderStrategy@ or launchType is
-- specified, the @defaultCapacityProviderStrategy@ for the cluster is
-- used.
--
-- 'enableECSManagedTags', 'ecsParameters_enableECSManagedTags' - Specifies whether to enable Amazon ECS managed tags for the task. For
-- more information, see
-- <https://docs.aws.amazon.com/AmazonECS/latest/developerguide/ecs-using-tags.html Tagging Your Amazon ECS Resources>
-- in the Amazon Elastic Container Service Developer Guide.
--
-- 'enableExecuteCommand', 'ecsParameters_enableExecuteCommand' - Whether or not to enable the execute command functionality for the
-- containers in this task. If true, this enables execute command
-- functionality on all containers in the task.
--
-- 'group'', 'ecsParameters_group' - Specifies an ECS task group for the task. The maximum length is 255
-- characters.
--
-- 'launchType', 'ecsParameters_launchType' - Specifies the launch type on which your task is running. The launch type
-- that you specify here must match one of the launch type
-- (compatibilities) of the target task. The @FARGATE@ value is supported
-- only in the Regions where Fargate with Amazon ECS is supported. For more
-- information, see
-- <https://docs.aws.amazon.com/AmazonECS/latest/developerguide/AWS-Fargate.html Fargate on Amazon ECS>
-- in the /Amazon Elastic Container Service Developer Guide/.
--
-- 'networkConfiguration', 'ecsParameters_networkConfiguration' - Use this structure if the Amazon ECS task uses the @awsvpc@ network
-- mode. This structure specifies the VPC subnets and security groups
-- associated with the task, and whether a public IP address is to be used.
-- This structure is required if @LaunchType@ is @FARGATE@ because the
-- @awsvpc@ mode is required for Fargate tasks.
--
-- If you specify @NetworkConfiguration@ when the target ECS task does not
-- use the @awsvpc@ network mode, the task fails.
--
-- 'placementConstraints', 'ecsParameters_placementConstraints' - An array of placement constraint objects to use for the task. You can
-- specify up to 10 constraints per task (including constraints in the task
-- definition and those specified at runtime).
--
-- 'placementStrategy', 'ecsParameters_placementStrategy' - The placement strategy objects to use for the task. You can specify a
-- maximum of five strategy rules per task.
--
-- 'platformVersion', 'ecsParameters_platformVersion' - Specifies the platform version for the task. Specify only the numeric
-- portion of the platform version, such as @1.1.0@.
--
-- This structure is used only if @LaunchType@ is @FARGATE@. For more
-- information about valid platform versions, see
-- <https://docs.aws.amazon.com/AmazonECS/latest/developerguide/platform_versions.html Fargate Platform Versions>
-- in the /Amazon Elastic Container Service Developer Guide/.
--
-- 'propagateTags', 'ecsParameters_propagateTags' - Specifies whether to propagate the tags from the task definition to the
-- task. If no value is specified, the tags are not propagated. Tags can
-- only be propagated to the task during task creation. To add tags to a
-- task after task creation, use the TagResource API action.
--
-- 'referenceId', 'ecsParameters_referenceId' - The reference ID to use for the task.
--
-- 'tags', 'ecsParameters_tags' - The metadata that you apply to the task to help you categorize and
-- organize them. Each tag consists of a key and an optional value, both of
-- which you define. To learn more, see
-- <https://docs.aws.amazon.com/AmazonECS/latest/APIReference/API_RunTask.html#ECS-RunTask-request-tags RunTask>
-- in the Amazon ECS API Reference.
--
-- 'taskCount', 'ecsParameters_taskCount' - The number of tasks to create based on @TaskDefinition@. The default is
-- 1.
--
-- 'taskDefinitionArn', 'ecsParameters_taskDefinitionArn' - The ARN of the task definition to use if the event target is an Amazon
-- ECS task.
newEcsParameters ::
  -- | 'taskDefinitionArn'
  Prelude.Text ->
  EcsParameters
newEcsParameters :: Text -> EcsParameters
newEcsParameters Text
pTaskDefinitionArn_ =
  EcsParameters'
    { $sel:capacityProviderStrategy:EcsParameters' :: Maybe [CapacityProviderStrategyItem]
capacityProviderStrategy =
        forall a. Maybe a
Prelude.Nothing,
      $sel:enableECSManagedTags:EcsParameters' :: Maybe Bool
enableECSManagedTags = forall a. Maybe a
Prelude.Nothing,
      $sel:enableExecuteCommand:EcsParameters' :: Maybe Bool
enableExecuteCommand = forall a. Maybe a
Prelude.Nothing,
      $sel:group':EcsParameters' :: Maybe Text
group' = forall a. Maybe a
Prelude.Nothing,
      $sel:launchType:EcsParameters' :: Maybe LaunchType
launchType = forall a. Maybe a
Prelude.Nothing,
      $sel:networkConfiguration:EcsParameters' :: Maybe NetworkConfiguration
networkConfiguration = forall a. Maybe a
Prelude.Nothing,
      $sel:placementConstraints:EcsParameters' :: Maybe [PlacementConstraint]
placementConstraints = forall a. Maybe a
Prelude.Nothing,
      $sel:placementStrategy:EcsParameters' :: Maybe [PlacementStrategy]
placementStrategy = forall a. Maybe a
Prelude.Nothing,
      $sel:platformVersion:EcsParameters' :: Maybe Text
platformVersion = forall a. Maybe a
Prelude.Nothing,
      $sel:propagateTags:EcsParameters' :: Maybe PropagateTags
propagateTags = forall a. Maybe a
Prelude.Nothing,
      $sel:referenceId:EcsParameters' :: Maybe Text
referenceId = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:EcsParameters' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:taskCount:EcsParameters' :: Maybe Natural
taskCount = forall a. Maybe a
Prelude.Nothing,
      $sel:taskDefinitionArn:EcsParameters' :: Text
taskDefinitionArn = Text
pTaskDefinitionArn_
    }

-- | The capacity provider strategy to use for the task.
--
-- If a @capacityProviderStrategy@ is specified, the @launchType@ parameter
-- must be omitted. If no @capacityProviderStrategy@ or launchType is
-- specified, the @defaultCapacityProviderStrategy@ for the cluster is
-- used.
ecsParameters_capacityProviderStrategy :: Lens.Lens' EcsParameters (Prelude.Maybe [CapacityProviderStrategyItem])
ecsParameters_capacityProviderStrategy :: Lens' EcsParameters (Maybe [CapacityProviderStrategyItem])
ecsParameters_capacityProviderStrategy = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\EcsParameters' {Maybe [CapacityProviderStrategyItem]
capacityProviderStrategy :: Maybe [CapacityProviderStrategyItem]
$sel:capacityProviderStrategy:EcsParameters' :: EcsParameters -> Maybe [CapacityProviderStrategyItem]
capacityProviderStrategy} -> Maybe [CapacityProviderStrategyItem]
capacityProviderStrategy) (\s :: EcsParameters
s@EcsParameters' {} Maybe [CapacityProviderStrategyItem]
a -> EcsParameters
s {$sel:capacityProviderStrategy:EcsParameters' :: Maybe [CapacityProviderStrategyItem]
capacityProviderStrategy = Maybe [CapacityProviderStrategyItem]
a} :: EcsParameters) 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

-- | Specifies whether to enable Amazon ECS managed tags for the task. For
-- more information, see
-- <https://docs.aws.amazon.com/AmazonECS/latest/developerguide/ecs-using-tags.html Tagging Your Amazon ECS Resources>
-- in the Amazon Elastic Container Service Developer Guide.
ecsParameters_enableECSManagedTags :: Lens.Lens' EcsParameters (Prelude.Maybe Prelude.Bool)
ecsParameters_enableECSManagedTags :: Lens' EcsParameters (Maybe Bool)
ecsParameters_enableECSManagedTags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\EcsParameters' {Maybe Bool
enableECSManagedTags :: Maybe Bool
$sel:enableECSManagedTags:EcsParameters' :: EcsParameters -> Maybe Bool
enableECSManagedTags} -> Maybe Bool
enableECSManagedTags) (\s :: EcsParameters
s@EcsParameters' {} Maybe Bool
a -> EcsParameters
s {$sel:enableECSManagedTags:EcsParameters' :: Maybe Bool
enableECSManagedTags = Maybe Bool
a} :: EcsParameters)

-- | Whether or not to enable the execute command functionality for the
-- containers in this task. If true, this enables execute command
-- functionality on all containers in the task.
ecsParameters_enableExecuteCommand :: Lens.Lens' EcsParameters (Prelude.Maybe Prelude.Bool)
ecsParameters_enableExecuteCommand :: Lens' EcsParameters (Maybe Bool)
ecsParameters_enableExecuteCommand = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\EcsParameters' {Maybe Bool
enableExecuteCommand :: Maybe Bool
$sel:enableExecuteCommand:EcsParameters' :: EcsParameters -> Maybe Bool
enableExecuteCommand} -> Maybe Bool
enableExecuteCommand) (\s :: EcsParameters
s@EcsParameters' {} Maybe Bool
a -> EcsParameters
s {$sel:enableExecuteCommand:EcsParameters' :: Maybe Bool
enableExecuteCommand = Maybe Bool
a} :: EcsParameters)

-- | Specifies an ECS task group for the task. The maximum length is 255
-- characters.
ecsParameters_group :: Lens.Lens' EcsParameters (Prelude.Maybe Prelude.Text)
ecsParameters_group :: Lens' EcsParameters (Maybe Text)
ecsParameters_group = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\EcsParameters' {Maybe Text
group' :: Maybe Text
$sel:group':EcsParameters' :: EcsParameters -> Maybe Text
group'} -> Maybe Text
group') (\s :: EcsParameters
s@EcsParameters' {} Maybe Text
a -> EcsParameters
s {$sel:group':EcsParameters' :: Maybe Text
group' = Maybe Text
a} :: EcsParameters)

-- | Specifies the launch type on which your task is running. The launch type
-- that you specify here must match one of the launch type
-- (compatibilities) of the target task. The @FARGATE@ value is supported
-- only in the Regions where Fargate with Amazon ECS is supported. For more
-- information, see
-- <https://docs.aws.amazon.com/AmazonECS/latest/developerguide/AWS-Fargate.html Fargate on Amazon ECS>
-- in the /Amazon Elastic Container Service Developer Guide/.
ecsParameters_launchType :: Lens.Lens' EcsParameters (Prelude.Maybe LaunchType)
ecsParameters_launchType :: Lens' EcsParameters (Maybe LaunchType)
ecsParameters_launchType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\EcsParameters' {Maybe LaunchType
launchType :: Maybe LaunchType
$sel:launchType:EcsParameters' :: EcsParameters -> Maybe LaunchType
launchType} -> Maybe LaunchType
launchType) (\s :: EcsParameters
s@EcsParameters' {} Maybe LaunchType
a -> EcsParameters
s {$sel:launchType:EcsParameters' :: Maybe LaunchType
launchType = Maybe LaunchType
a} :: EcsParameters)

-- | Use this structure if the Amazon ECS task uses the @awsvpc@ network
-- mode. This structure specifies the VPC subnets and security groups
-- associated with the task, and whether a public IP address is to be used.
-- This structure is required if @LaunchType@ is @FARGATE@ because the
-- @awsvpc@ mode is required for Fargate tasks.
--
-- If you specify @NetworkConfiguration@ when the target ECS task does not
-- use the @awsvpc@ network mode, the task fails.
ecsParameters_networkConfiguration :: Lens.Lens' EcsParameters (Prelude.Maybe NetworkConfiguration)
ecsParameters_networkConfiguration :: Lens' EcsParameters (Maybe NetworkConfiguration)
ecsParameters_networkConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\EcsParameters' {Maybe NetworkConfiguration
networkConfiguration :: Maybe NetworkConfiguration
$sel:networkConfiguration:EcsParameters' :: EcsParameters -> Maybe NetworkConfiguration
networkConfiguration} -> Maybe NetworkConfiguration
networkConfiguration) (\s :: EcsParameters
s@EcsParameters' {} Maybe NetworkConfiguration
a -> EcsParameters
s {$sel:networkConfiguration:EcsParameters' :: Maybe NetworkConfiguration
networkConfiguration = Maybe NetworkConfiguration
a} :: EcsParameters)

-- | An array of placement constraint objects to use for the task. You can
-- specify up to 10 constraints per task (including constraints in the task
-- definition and those specified at runtime).
ecsParameters_placementConstraints :: Lens.Lens' EcsParameters (Prelude.Maybe [PlacementConstraint])
ecsParameters_placementConstraints :: Lens' EcsParameters (Maybe [PlacementConstraint])
ecsParameters_placementConstraints = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\EcsParameters' {Maybe [PlacementConstraint]
placementConstraints :: Maybe [PlacementConstraint]
$sel:placementConstraints:EcsParameters' :: EcsParameters -> Maybe [PlacementConstraint]
placementConstraints} -> Maybe [PlacementConstraint]
placementConstraints) (\s :: EcsParameters
s@EcsParameters' {} Maybe [PlacementConstraint]
a -> EcsParameters
s {$sel:placementConstraints:EcsParameters' :: Maybe [PlacementConstraint]
placementConstraints = Maybe [PlacementConstraint]
a} :: EcsParameters) 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 placement strategy objects to use for the task. You can specify a
-- maximum of five strategy rules per task.
ecsParameters_placementStrategy :: Lens.Lens' EcsParameters (Prelude.Maybe [PlacementStrategy])
ecsParameters_placementStrategy :: Lens' EcsParameters (Maybe [PlacementStrategy])
ecsParameters_placementStrategy = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\EcsParameters' {Maybe [PlacementStrategy]
placementStrategy :: Maybe [PlacementStrategy]
$sel:placementStrategy:EcsParameters' :: EcsParameters -> Maybe [PlacementStrategy]
placementStrategy} -> Maybe [PlacementStrategy]
placementStrategy) (\s :: EcsParameters
s@EcsParameters' {} Maybe [PlacementStrategy]
a -> EcsParameters
s {$sel:placementStrategy:EcsParameters' :: Maybe [PlacementStrategy]
placementStrategy = Maybe [PlacementStrategy]
a} :: EcsParameters) 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

-- | Specifies the platform version for the task. Specify only the numeric
-- portion of the platform version, such as @1.1.0@.
--
-- This structure is used only if @LaunchType@ is @FARGATE@. For more
-- information about valid platform versions, see
-- <https://docs.aws.amazon.com/AmazonECS/latest/developerguide/platform_versions.html Fargate Platform Versions>
-- in the /Amazon Elastic Container Service Developer Guide/.
ecsParameters_platformVersion :: Lens.Lens' EcsParameters (Prelude.Maybe Prelude.Text)
ecsParameters_platformVersion :: Lens' EcsParameters (Maybe Text)
ecsParameters_platformVersion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\EcsParameters' {Maybe Text
platformVersion :: Maybe Text
$sel:platformVersion:EcsParameters' :: EcsParameters -> Maybe Text
platformVersion} -> Maybe Text
platformVersion) (\s :: EcsParameters
s@EcsParameters' {} Maybe Text
a -> EcsParameters
s {$sel:platformVersion:EcsParameters' :: Maybe Text
platformVersion = Maybe Text
a} :: EcsParameters)

-- | Specifies whether to propagate the tags from the task definition to the
-- task. If no value is specified, the tags are not propagated. Tags can
-- only be propagated to the task during task creation. To add tags to a
-- task after task creation, use the TagResource API action.
ecsParameters_propagateTags :: Lens.Lens' EcsParameters (Prelude.Maybe PropagateTags)
ecsParameters_propagateTags :: Lens' EcsParameters (Maybe PropagateTags)
ecsParameters_propagateTags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\EcsParameters' {Maybe PropagateTags
propagateTags :: Maybe PropagateTags
$sel:propagateTags:EcsParameters' :: EcsParameters -> Maybe PropagateTags
propagateTags} -> Maybe PropagateTags
propagateTags) (\s :: EcsParameters
s@EcsParameters' {} Maybe PropagateTags
a -> EcsParameters
s {$sel:propagateTags:EcsParameters' :: Maybe PropagateTags
propagateTags = Maybe PropagateTags
a} :: EcsParameters)

-- | The reference ID to use for the task.
ecsParameters_referenceId :: Lens.Lens' EcsParameters (Prelude.Maybe Prelude.Text)
ecsParameters_referenceId :: Lens' EcsParameters (Maybe Text)
ecsParameters_referenceId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\EcsParameters' {Maybe Text
referenceId :: Maybe Text
$sel:referenceId:EcsParameters' :: EcsParameters -> Maybe Text
referenceId} -> Maybe Text
referenceId) (\s :: EcsParameters
s@EcsParameters' {} Maybe Text
a -> EcsParameters
s {$sel:referenceId:EcsParameters' :: Maybe Text
referenceId = Maybe Text
a} :: EcsParameters)

-- | The metadata that you apply to the task to help you categorize and
-- organize them. Each tag consists of a key and an optional value, both of
-- which you define. To learn more, see
-- <https://docs.aws.amazon.com/AmazonECS/latest/APIReference/API_RunTask.html#ECS-RunTask-request-tags RunTask>
-- in the Amazon ECS API Reference.
ecsParameters_tags :: Lens.Lens' EcsParameters (Prelude.Maybe [Tag])
ecsParameters_tags :: Lens' EcsParameters (Maybe [Tag])
ecsParameters_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\EcsParameters' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:EcsParameters' :: EcsParameters -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: EcsParameters
s@EcsParameters' {} Maybe [Tag]
a -> EcsParameters
s {$sel:tags:EcsParameters' :: Maybe [Tag]
tags = Maybe [Tag]
a} :: EcsParameters) 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 tasks to create based on @TaskDefinition@. The default is
-- 1.
ecsParameters_taskCount :: Lens.Lens' EcsParameters (Prelude.Maybe Prelude.Natural)
ecsParameters_taskCount :: Lens' EcsParameters (Maybe Natural)
ecsParameters_taskCount = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\EcsParameters' {Maybe Natural
taskCount :: Maybe Natural
$sel:taskCount:EcsParameters' :: EcsParameters -> Maybe Natural
taskCount} -> Maybe Natural
taskCount) (\s :: EcsParameters
s@EcsParameters' {} Maybe Natural
a -> EcsParameters
s {$sel:taskCount:EcsParameters' :: Maybe Natural
taskCount = Maybe Natural
a} :: EcsParameters)

-- | The ARN of the task definition to use if the event target is an Amazon
-- ECS task.
ecsParameters_taskDefinitionArn :: Lens.Lens' EcsParameters Prelude.Text
ecsParameters_taskDefinitionArn :: Lens' EcsParameters Text
ecsParameters_taskDefinitionArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\EcsParameters' {Text
taskDefinitionArn :: Text
$sel:taskDefinitionArn:EcsParameters' :: EcsParameters -> Text
taskDefinitionArn} -> Text
taskDefinitionArn) (\s :: EcsParameters
s@EcsParameters' {} Text
a -> EcsParameters
s {$sel:taskDefinitionArn:EcsParameters' :: Text
taskDefinitionArn = Text
a} :: EcsParameters)

instance Data.FromJSON EcsParameters where
  parseJSON :: Value -> Parser EcsParameters
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"EcsParameters"
      ( \Object
x ->
          Maybe [CapacityProviderStrategyItem]
-> Maybe Bool
-> Maybe Bool
-> Maybe Text
-> Maybe LaunchType
-> Maybe NetworkConfiguration
-> Maybe [PlacementConstraint]
-> Maybe [PlacementStrategy]
-> Maybe Text
-> Maybe PropagateTags
-> Maybe Text
-> Maybe [Tag]
-> Maybe Natural
-> Text
-> EcsParameters
EcsParameters'
            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
"EnableECSManagedTags")
            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
"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
"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
"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
"PlacementConstraints"
                            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
"PlacementStrategy"
                            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
"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
"PropagateTags")
            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
"ReferenceId")
            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
"TaskCount")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser a
Data..: Key
"TaskDefinitionArn")
      )

instance Prelude.Hashable EcsParameters where
  hashWithSalt :: Int -> EcsParameters -> Int
hashWithSalt Int
_salt EcsParameters' {Maybe Bool
Maybe Natural
Maybe [CapacityProviderStrategyItem]
Maybe [PlacementConstraint]
Maybe [PlacementStrategy]
Maybe [Tag]
Maybe Text
Maybe LaunchType
Maybe NetworkConfiguration
Maybe PropagateTags
Text
taskDefinitionArn :: Text
taskCount :: Maybe Natural
tags :: Maybe [Tag]
referenceId :: Maybe Text
propagateTags :: Maybe PropagateTags
platformVersion :: Maybe Text
placementStrategy :: Maybe [PlacementStrategy]
placementConstraints :: Maybe [PlacementConstraint]
networkConfiguration :: Maybe NetworkConfiguration
launchType :: Maybe LaunchType
group' :: Maybe Text
enableExecuteCommand :: Maybe Bool
enableECSManagedTags :: Maybe Bool
capacityProviderStrategy :: Maybe [CapacityProviderStrategyItem]
$sel:taskDefinitionArn:EcsParameters' :: EcsParameters -> Text
$sel:taskCount:EcsParameters' :: EcsParameters -> Maybe Natural
$sel:tags:EcsParameters' :: EcsParameters -> Maybe [Tag]
$sel:referenceId:EcsParameters' :: EcsParameters -> Maybe Text
$sel:propagateTags:EcsParameters' :: EcsParameters -> Maybe PropagateTags
$sel:platformVersion:EcsParameters' :: EcsParameters -> Maybe Text
$sel:placementStrategy:EcsParameters' :: EcsParameters -> Maybe [PlacementStrategy]
$sel:placementConstraints:EcsParameters' :: EcsParameters -> Maybe [PlacementConstraint]
$sel:networkConfiguration:EcsParameters' :: EcsParameters -> Maybe NetworkConfiguration
$sel:launchType:EcsParameters' :: EcsParameters -> Maybe LaunchType
$sel:group':EcsParameters' :: EcsParameters -> Maybe Text
$sel:enableExecuteCommand:EcsParameters' :: EcsParameters -> Maybe Bool
$sel:enableECSManagedTags:EcsParameters' :: EcsParameters -> Maybe Bool
$sel:capacityProviderStrategy:EcsParameters' :: EcsParameters -> 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 Bool
enableECSManagedTags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
enableExecuteCommand
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
group'
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe LaunchType
launchType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe NetworkConfiguration
networkConfiguration
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [PlacementConstraint]
placementConstraints
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [PlacementStrategy]
placementStrategy
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
platformVersion
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe PropagateTags
propagateTags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
referenceId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Tag]
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
taskCount
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
taskDefinitionArn

instance Prelude.NFData EcsParameters where
  rnf :: EcsParameters -> ()
rnf EcsParameters' {Maybe Bool
Maybe Natural
Maybe [CapacityProviderStrategyItem]
Maybe [PlacementConstraint]
Maybe [PlacementStrategy]
Maybe [Tag]
Maybe Text
Maybe LaunchType
Maybe NetworkConfiguration
Maybe PropagateTags
Text
taskDefinitionArn :: Text
taskCount :: Maybe Natural
tags :: Maybe [Tag]
referenceId :: Maybe Text
propagateTags :: Maybe PropagateTags
platformVersion :: Maybe Text
placementStrategy :: Maybe [PlacementStrategy]
placementConstraints :: Maybe [PlacementConstraint]
networkConfiguration :: Maybe NetworkConfiguration
launchType :: Maybe LaunchType
group' :: Maybe Text
enableExecuteCommand :: Maybe Bool
enableECSManagedTags :: Maybe Bool
capacityProviderStrategy :: Maybe [CapacityProviderStrategyItem]
$sel:taskDefinitionArn:EcsParameters' :: EcsParameters -> Text
$sel:taskCount:EcsParameters' :: EcsParameters -> Maybe Natural
$sel:tags:EcsParameters' :: EcsParameters -> Maybe [Tag]
$sel:referenceId:EcsParameters' :: EcsParameters -> Maybe Text
$sel:propagateTags:EcsParameters' :: EcsParameters -> Maybe PropagateTags
$sel:platformVersion:EcsParameters' :: EcsParameters -> Maybe Text
$sel:placementStrategy:EcsParameters' :: EcsParameters -> Maybe [PlacementStrategy]
$sel:placementConstraints:EcsParameters' :: EcsParameters -> Maybe [PlacementConstraint]
$sel:networkConfiguration:EcsParameters' :: EcsParameters -> Maybe NetworkConfiguration
$sel:launchType:EcsParameters' :: EcsParameters -> Maybe LaunchType
$sel:group':EcsParameters' :: EcsParameters -> Maybe Text
$sel:enableExecuteCommand:EcsParameters' :: EcsParameters -> Maybe Bool
$sel:enableECSManagedTags:EcsParameters' :: EcsParameters -> Maybe Bool
$sel:capacityProviderStrategy:EcsParameters' :: EcsParameters -> 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 Bool
enableECSManagedTags
      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 Text
group'
      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 NetworkConfiguration
networkConfiguration
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [PlacementConstraint]
placementConstraints
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [PlacementStrategy]
placementStrategy
      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 PropagateTags
propagateTags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
referenceId
      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 Natural
taskCount
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
taskDefinitionArn

instance Data.ToJSON EcsParameters where
  toJSON :: EcsParameters -> Value
toJSON EcsParameters' {Maybe Bool
Maybe Natural
Maybe [CapacityProviderStrategyItem]
Maybe [PlacementConstraint]
Maybe [PlacementStrategy]
Maybe [Tag]
Maybe Text
Maybe LaunchType
Maybe NetworkConfiguration
Maybe PropagateTags
Text
taskDefinitionArn :: Text
taskCount :: Maybe Natural
tags :: Maybe [Tag]
referenceId :: Maybe Text
propagateTags :: Maybe PropagateTags
platformVersion :: Maybe Text
placementStrategy :: Maybe [PlacementStrategy]
placementConstraints :: Maybe [PlacementConstraint]
networkConfiguration :: Maybe NetworkConfiguration
launchType :: Maybe LaunchType
group' :: Maybe Text
enableExecuteCommand :: Maybe Bool
enableECSManagedTags :: Maybe Bool
capacityProviderStrategy :: Maybe [CapacityProviderStrategyItem]
$sel:taskDefinitionArn:EcsParameters' :: EcsParameters -> Text
$sel:taskCount:EcsParameters' :: EcsParameters -> Maybe Natural
$sel:tags:EcsParameters' :: EcsParameters -> Maybe [Tag]
$sel:referenceId:EcsParameters' :: EcsParameters -> Maybe Text
$sel:propagateTags:EcsParameters' :: EcsParameters -> Maybe PropagateTags
$sel:platformVersion:EcsParameters' :: EcsParameters -> Maybe Text
$sel:placementStrategy:EcsParameters' :: EcsParameters -> Maybe [PlacementStrategy]
$sel:placementConstraints:EcsParameters' :: EcsParameters -> Maybe [PlacementConstraint]
$sel:networkConfiguration:EcsParameters' :: EcsParameters -> Maybe NetworkConfiguration
$sel:launchType:EcsParameters' :: EcsParameters -> Maybe LaunchType
$sel:group':EcsParameters' :: EcsParameters -> Maybe Text
$sel:enableExecuteCommand:EcsParameters' :: EcsParameters -> Maybe Bool
$sel:enableECSManagedTags:EcsParameters' :: EcsParameters -> Maybe Bool
$sel:capacityProviderStrategy:EcsParameters' :: EcsParameters -> Maybe [CapacityProviderStrategyItem]
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"CapacityProviderStrategy" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [CapacityProviderStrategyItem]
capacityProviderStrategy,
            (Key
"EnableECSManagedTags" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Bool
enableECSManagedTags,
            (Key
"EnableExecuteCommand" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Bool
enableExecuteCommand,
            (Key
"Group" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
group',
            (Key
"LaunchType" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe LaunchType
launchType,
            (Key
"NetworkConfiguration" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe NetworkConfiguration
networkConfiguration,
            (Key
"PlacementConstraints" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [PlacementConstraint]
placementConstraints,
            (Key
"PlacementStrategy" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [PlacementStrategy]
placementStrategy,
            (Key
"PlatformVersion" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
platformVersion,
            (Key
"PropagateTags" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe PropagateTags
propagateTags,
            (Key
"ReferenceId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
referenceId,
            (Key
"Tags" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [Tag]
tags,
            (Key
"TaskCount" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Natural
taskCount,
            forall a. a -> Maybe a
Prelude.Just
              (Key
"TaskDefinitionArn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
taskDefinitionArn)
          ]
      )