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

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

-- |
-- Module      : Amazonka.ECS.CreateCluster
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Creates a new Amazon ECS cluster. By default, your account receives a
-- @default@ cluster when you launch your first container instance.
-- However, you can create your own cluster with a unique name with the
-- @CreateCluster@ action.
--
-- When you call the CreateCluster API operation, Amazon ECS attempts to
-- create the Amazon ECS service-linked role for your account. This is so
-- that it can manage required resources in other Amazon Web Services
-- services on your behalf. However, if the IAM user that makes the call
-- doesn\'t have permissions to create the service-linked role, it isn\'t
-- created. For more information, see
-- <https://docs.aws.amazon.com/AmazonECS/latest/developerguide/using-service-linked-roles.html Using service-linked roles for Amazon ECS>
-- in the /Amazon Elastic Container Service Developer Guide/.
module Amazonka.ECS.CreateCluster
  ( -- * Creating a Request
    CreateCluster (..),
    newCreateCluster,

    -- * Request Lenses
    createCluster_capacityProviders,
    createCluster_clusterName,
    createCluster_configuration,
    createCluster_defaultCapacityProviderStrategy,
    createCluster_serviceConnectDefaults,
    createCluster_settings,
    createCluster_tags,

    -- * Destructuring the Response
    CreateClusterResponse (..),
    newCreateClusterResponse,

    -- * Response Lenses
    createClusterResponse_cluster,
    createClusterResponse_httpStatus,
  )
where

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

-- | /See:/ 'newCreateCluster' smart constructor.
data CreateCluster = CreateCluster'
  { -- | The short name of one or more capacity providers to associate with the
    -- cluster. A capacity provider must be associated with a cluster before it
    -- can be included as part of the default capacity provider strategy of the
    -- cluster or used in a capacity provider strategy when calling the
    -- CreateService or RunTask actions.
    --
    -- If specifying a capacity provider that uses an Auto Scaling group, the
    -- capacity provider must be created but not associated with another
    -- cluster. New Auto Scaling group capacity providers can be created with
    -- the CreateCapacityProvider API operation.
    --
    -- To use a Fargate capacity provider, specify either the @FARGATE@ or
    -- @FARGATE_SPOT@ capacity providers. The Fargate capacity providers are
    -- available to all accounts and only need to be associated with a cluster
    -- to be used.
    --
    -- The PutClusterCapacityProviders API operation is used to update the list
    -- of available capacity providers for a cluster after the cluster is
    -- created.
    CreateCluster -> Maybe [Text]
capacityProviders :: Prelude.Maybe [Prelude.Text],
    -- | The name of your cluster. If you don\'t specify a name for your cluster,
    -- you create a cluster that\'s named @default@. Up to 255 letters
    -- (uppercase and lowercase), numbers, underscores, and hyphens are
    -- allowed.
    CreateCluster -> Maybe Text
clusterName :: Prelude.Maybe Prelude.Text,
    -- | The @execute@ command configuration for the cluster.
    CreateCluster -> Maybe ClusterConfiguration
configuration :: Prelude.Maybe ClusterConfiguration,
    -- | The capacity provider strategy to set as the default for the cluster.
    -- After a default capacity provider strategy is set for a cluster, when
    -- you call the RunTask or CreateService APIs with no capacity provider
    -- strategy or launch type specified, the default capacity provider
    -- strategy for the cluster is used.
    --
    -- If a default capacity provider strategy isn\'t defined for a cluster
    -- when it was created, it can be defined later with the
    -- PutClusterCapacityProviders API operation.
    CreateCluster -> Maybe [CapacityProviderStrategyItem]
defaultCapacityProviderStrategy :: Prelude.Maybe [CapacityProviderStrategyItem],
    -- | Use this parameter to set a default Service Connect namespace. After you
    -- set a default Service Connect namespace, any new services with Service
    -- Connect turned on that are created in the cluster are added as client
    -- services in the namespace. This setting only applies to new services
    -- that set the @enabled@ parameter to @true@ in the
    -- @ServiceConnectConfiguration@. You can set the namespace of each service
    -- individually in the @ServiceConnectConfiguration@ to override this
    -- default parameter.
    --
    -- Tasks that run in a namespace can use short names to connect to services
    -- in the namespace. Tasks can connect to services across all of the
    -- clusters in the namespace. Tasks connect through a managed proxy
    -- container that collects logs and metrics for increased visibility. Only
    -- the tasks that Amazon ECS services create are supported with Service
    -- Connect. For more information, see
    -- <https://docs.aws.amazon.com/AmazonECS/latest/developerguide/service-connect.html Service Connect>
    -- in the /Amazon Elastic Container Service Developer Guide/.
    CreateCluster -> Maybe ClusterServiceConnectDefaultsRequest
serviceConnectDefaults :: Prelude.Maybe ClusterServiceConnectDefaultsRequest,
    -- | The setting to use when creating a cluster. This parameter is used to
    -- turn on CloudWatch Container Insights for a cluster. If this value is
    -- specified, it overrides the @containerInsights@ value set with
    -- PutAccountSetting or PutAccountSettingDefault.
    CreateCluster -> Maybe [ClusterSetting]
settings :: Prelude.Maybe [ClusterSetting],
    -- | The metadata that you apply to the cluster 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.
    CreateCluster -> Maybe [Tag]
tags :: Prelude.Maybe [Tag]
  }
  deriving (CreateCluster -> CreateCluster -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateCluster -> CreateCluster -> Bool
$c/= :: CreateCluster -> CreateCluster -> Bool
== :: CreateCluster -> CreateCluster -> Bool
$c== :: CreateCluster -> CreateCluster -> Bool
Prelude.Eq, ReadPrec [CreateCluster]
ReadPrec CreateCluster
Int -> ReadS CreateCluster
ReadS [CreateCluster]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateCluster]
$creadListPrec :: ReadPrec [CreateCluster]
readPrec :: ReadPrec CreateCluster
$creadPrec :: ReadPrec CreateCluster
readList :: ReadS [CreateCluster]
$creadList :: ReadS [CreateCluster]
readsPrec :: Int -> ReadS CreateCluster
$creadsPrec :: Int -> ReadS CreateCluster
Prelude.Read, Int -> CreateCluster -> ShowS
[CreateCluster] -> ShowS
CreateCluster -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateCluster] -> ShowS
$cshowList :: [CreateCluster] -> ShowS
show :: CreateCluster -> String
$cshow :: CreateCluster -> String
showsPrec :: Int -> CreateCluster -> ShowS
$cshowsPrec :: Int -> CreateCluster -> ShowS
Prelude.Show, forall x. Rep CreateCluster x -> CreateCluster
forall x. CreateCluster -> Rep CreateCluster x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateCluster x -> CreateCluster
$cfrom :: forall x. CreateCluster -> Rep CreateCluster x
Prelude.Generic)

-- |
-- Create a value of 'CreateCluster' 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:
--
-- 'capacityProviders', 'createCluster_capacityProviders' - The short name of one or more capacity providers to associate with the
-- cluster. A capacity provider must be associated with a cluster before it
-- can be included as part of the default capacity provider strategy of the
-- cluster or used in a capacity provider strategy when calling the
-- CreateService or RunTask actions.
--
-- If specifying a capacity provider that uses an Auto Scaling group, the
-- capacity provider must be created but not associated with another
-- cluster. New Auto Scaling group capacity providers can be created with
-- the CreateCapacityProvider API operation.
--
-- To use a Fargate capacity provider, specify either the @FARGATE@ or
-- @FARGATE_SPOT@ capacity providers. The Fargate capacity providers are
-- available to all accounts and only need to be associated with a cluster
-- to be used.
--
-- The PutClusterCapacityProviders API operation is used to update the list
-- of available capacity providers for a cluster after the cluster is
-- created.
--
-- 'clusterName', 'createCluster_clusterName' - The name of your cluster. If you don\'t specify a name for your cluster,
-- you create a cluster that\'s named @default@. Up to 255 letters
-- (uppercase and lowercase), numbers, underscores, and hyphens are
-- allowed.
--
-- 'configuration', 'createCluster_configuration' - The @execute@ command configuration for the cluster.
--
-- 'defaultCapacityProviderStrategy', 'createCluster_defaultCapacityProviderStrategy' - The capacity provider strategy to set as the default for the cluster.
-- After a default capacity provider strategy is set for a cluster, when
-- you call the RunTask or CreateService APIs with no capacity provider
-- strategy or launch type specified, the default capacity provider
-- strategy for the cluster is used.
--
-- If a default capacity provider strategy isn\'t defined for a cluster
-- when it was created, it can be defined later with the
-- PutClusterCapacityProviders API operation.
--
-- 'serviceConnectDefaults', 'createCluster_serviceConnectDefaults' - Use this parameter to set a default Service Connect namespace. After you
-- set a default Service Connect namespace, any new services with Service
-- Connect turned on that are created in the cluster are added as client
-- services in the namespace. This setting only applies to new services
-- that set the @enabled@ parameter to @true@ in the
-- @ServiceConnectConfiguration@. You can set the namespace of each service
-- individually in the @ServiceConnectConfiguration@ to override this
-- default parameter.
--
-- Tasks that run in a namespace can use short names to connect to services
-- in the namespace. Tasks can connect to services across all of the
-- clusters in the namespace. Tasks connect through a managed proxy
-- container that collects logs and metrics for increased visibility. Only
-- the tasks that Amazon ECS services create are supported with Service
-- Connect. For more information, see
-- <https://docs.aws.amazon.com/AmazonECS/latest/developerguide/service-connect.html Service Connect>
-- in the /Amazon Elastic Container Service Developer Guide/.
--
-- 'settings', 'createCluster_settings' - The setting to use when creating a cluster. This parameter is used to
-- turn on CloudWatch Container Insights for a cluster. If this value is
-- specified, it overrides the @containerInsights@ value set with
-- PutAccountSetting or PutAccountSettingDefault.
--
-- 'tags', 'createCluster_tags' - The metadata that you apply to the cluster 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.
newCreateCluster ::
  CreateCluster
newCreateCluster :: CreateCluster
newCreateCluster =
  CreateCluster'
    { $sel:capacityProviders:CreateCluster' :: Maybe [Text]
capacityProviders = forall a. Maybe a
Prelude.Nothing,
      $sel:clusterName:CreateCluster' :: Maybe Text
clusterName = forall a. Maybe a
Prelude.Nothing,
      $sel:configuration:CreateCluster' :: Maybe ClusterConfiguration
configuration = forall a. Maybe a
Prelude.Nothing,
      $sel:defaultCapacityProviderStrategy:CreateCluster' :: Maybe [CapacityProviderStrategyItem]
defaultCapacityProviderStrategy = forall a. Maybe a
Prelude.Nothing,
      $sel:serviceConnectDefaults:CreateCluster' :: Maybe ClusterServiceConnectDefaultsRequest
serviceConnectDefaults = forall a. Maybe a
Prelude.Nothing,
      $sel:settings:CreateCluster' :: Maybe [ClusterSetting]
settings = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:CreateCluster' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing
    }

-- | The short name of one or more capacity providers to associate with the
-- cluster. A capacity provider must be associated with a cluster before it
-- can be included as part of the default capacity provider strategy of the
-- cluster or used in a capacity provider strategy when calling the
-- CreateService or RunTask actions.
--
-- If specifying a capacity provider that uses an Auto Scaling group, the
-- capacity provider must be created but not associated with another
-- cluster. New Auto Scaling group capacity providers can be created with
-- the CreateCapacityProvider API operation.
--
-- To use a Fargate capacity provider, specify either the @FARGATE@ or
-- @FARGATE_SPOT@ capacity providers. The Fargate capacity providers are
-- available to all accounts and only need to be associated with a cluster
-- to be used.
--
-- The PutClusterCapacityProviders API operation is used to update the list
-- of available capacity providers for a cluster after the cluster is
-- created.
createCluster_capacityProviders :: Lens.Lens' CreateCluster (Prelude.Maybe [Prelude.Text])
createCluster_capacityProviders :: Lens' CreateCluster (Maybe [Text])
createCluster_capacityProviders = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCluster' {Maybe [Text]
capacityProviders :: Maybe [Text]
$sel:capacityProviders:CreateCluster' :: CreateCluster -> Maybe [Text]
capacityProviders} -> Maybe [Text]
capacityProviders) (\s :: CreateCluster
s@CreateCluster' {} Maybe [Text]
a -> CreateCluster
s {$sel:capacityProviders:CreateCluster' :: Maybe [Text]
capacityProviders = Maybe [Text]
a} :: CreateCluster) 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 name of your cluster. If you don\'t specify a name for your cluster,
-- you create a cluster that\'s named @default@. Up to 255 letters
-- (uppercase and lowercase), numbers, underscores, and hyphens are
-- allowed.
createCluster_clusterName :: Lens.Lens' CreateCluster (Prelude.Maybe Prelude.Text)
createCluster_clusterName :: Lens' CreateCluster (Maybe Text)
createCluster_clusterName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCluster' {Maybe Text
clusterName :: Maybe Text
$sel:clusterName:CreateCluster' :: CreateCluster -> Maybe Text
clusterName} -> Maybe Text
clusterName) (\s :: CreateCluster
s@CreateCluster' {} Maybe Text
a -> CreateCluster
s {$sel:clusterName:CreateCluster' :: Maybe Text
clusterName = Maybe Text
a} :: CreateCluster)

-- | The @execute@ command configuration for the cluster.
createCluster_configuration :: Lens.Lens' CreateCluster (Prelude.Maybe ClusterConfiguration)
createCluster_configuration :: Lens' CreateCluster (Maybe ClusterConfiguration)
createCluster_configuration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCluster' {Maybe ClusterConfiguration
configuration :: Maybe ClusterConfiguration
$sel:configuration:CreateCluster' :: CreateCluster -> Maybe ClusterConfiguration
configuration} -> Maybe ClusterConfiguration
configuration) (\s :: CreateCluster
s@CreateCluster' {} Maybe ClusterConfiguration
a -> CreateCluster
s {$sel:configuration:CreateCluster' :: Maybe ClusterConfiguration
configuration = Maybe ClusterConfiguration
a} :: CreateCluster)

-- | The capacity provider strategy to set as the default for the cluster.
-- After a default capacity provider strategy is set for a cluster, when
-- you call the RunTask or CreateService APIs with no capacity provider
-- strategy or launch type specified, the default capacity provider
-- strategy for the cluster is used.
--
-- If a default capacity provider strategy isn\'t defined for a cluster
-- when it was created, it can be defined later with the
-- PutClusterCapacityProviders API operation.
createCluster_defaultCapacityProviderStrategy :: Lens.Lens' CreateCluster (Prelude.Maybe [CapacityProviderStrategyItem])
createCluster_defaultCapacityProviderStrategy :: Lens' CreateCluster (Maybe [CapacityProviderStrategyItem])
createCluster_defaultCapacityProviderStrategy = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCluster' {Maybe [CapacityProviderStrategyItem]
defaultCapacityProviderStrategy :: Maybe [CapacityProviderStrategyItem]
$sel:defaultCapacityProviderStrategy:CreateCluster' :: CreateCluster -> Maybe [CapacityProviderStrategyItem]
defaultCapacityProviderStrategy} -> Maybe [CapacityProviderStrategyItem]
defaultCapacityProviderStrategy) (\s :: CreateCluster
s@CreateCluster' {} Maybe [CapacityProviderStrategyItem]
a -> CreateCluster
s {$sel:defaultCapacityProviderStrategy:CreateCluster' :: Maybe [CapacityProviderStrategyItem]
defaultCapacityProviderStrategy = Maybe [CapacityProviderStrategyItem]
a} :: CreateCluster) 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

-- | Use this parameter to set a default Service Connect namespace. After you
-- set a default Service Connect namespace, any new services with Service
-- Connect turned on that are created in the cluster are added as client
-- services in the namespace. This setting only applies to new services
-- that set the @enabled@ parameter to @true@ in the
-- @ServiceConnectConfiguration@. You can set the namespace of each service
-- individually in the @ServiceConnectConfiguration@ to override this
-- default parameter.
--
-- Tasks that run in a namespace can use short names to connect to services
-- in the namespace. Tasks can connect to services across all of the
-- clusters in the namespace. Tasks connect through a managed proxy
-- container that collects logs and metrics for increased visibility. Only
-- the tasks that Amazon ECS services create are supported with Service
-- Connect. For more information, see
-- <https://docs.aws.amazon.com/AmazonECS/latest/developerguide/service-connect.html Service Connect>
-- in the /Amazon Elastic Container Service Developer Guide/.
createCluster_serviceConnectDefaults :: Lens.Lens' CreateCluster (Prelude.Maybe ClusterServiceConnectDefaultsRequest)
createCluster_serviceConnectDefaults :: Lens' CreateCluster (Maybe ClusterServiceConnectDefaultsRequest)
createCluster_serviceConnectDefaults = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCluster' {Maybe ClusterServiceConnectDefaultsRequest
serviceConnectDefaults :: Maybe ClusterServiceConnectDefaultsRequest
$sel:serviceConnectDefaults:CreateCluster' :: CreateCluster -> Maybe ClusterServiceConnectDefaultsRequest
serviceConnectDefaults} -> Maybe ClusterServiceConnectDefaultsRequest
serviceConnectDefaults) (\s :: CreateCluster
s@CreateCluster' {} Maybe ClusterServiceConnectDefaultsRequest
a -> CreateCluster
s {$sel:serviceConnectDefaults:CreateCluster' :: Maybe ClusterServiceConnectDefaultsRequest
serviceConnectDefaults = Maybe ClusterServiceConnectDefaultsRequest
a} :: CreateCluster)

-- | The setting to use when creating a cluster. This parameter is used to
-- turn on CloudWatch Container Insights for a cluster. If this value is
-- specified, it overrides the @containerInsights@ value set with
-- PutAccountSetting or PutAccountSettingDefault.
createCluster_settings :: Lens.Lens' CreateCluster (Prelude.Maybe [ClusterSetting])
createCluster_settings :: Lens' CreateCluster (Maybe [ClusterSetting])
createCluster_settings = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCluster' {Maybe [ClusterSetting]
settings :: Maybe [ClusterSetting]
$sel:settings:CreateCluster' :: CreateCluster -> Maybe [ClusterSetting]
settings} -> Maybe [ClusterSetting]
settings) (\s :: CreateCluster
s@CreateCluster' {} Maybe [ClusterSetting]
a -> CreateCluster
s {$sel:settings:CreateCluster' :: Maybe [ClusterSetting]
settings = Maybe [ClusterSetting]
a} :: CreateCluster) 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 metadata that you apply to the cluster 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.
createCluster_tags :: Lens.Lens' CreateCluster (Prelude.Maybe [Tag])
createCluster_tags :: Lens' CreateCluster (Maybe [Tag])
createCluster_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCluster' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:CreateCluster' :: CreateCluster -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: CreateCluster
s@CreateCluster' {} Maybe [Tag]
a -> CreateCluster
s {$sel:tags:CreateCluster' :: Maybe [Tag]
tags = Maybe [Tag]
a} :: CreateCluster) 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

instance Core.AWSRequest CreateCluster where
  type
    AWSResponse CreateCluster =
      CreateClusterResponse
  request :: (Service -> Service) -> CreateCluster -> Request CreateCluster
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.postJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy CreateCluster
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CreateCluster)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> Object -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveJSON
      ( \Int
s ResponseHeaders
h Object
x ->
          Maybe Cluster -> Int -> CreateClusterResponse
CreateClusterResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"cluster")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
      )

instance Prelude.Hashable CreateCluster where
  hashWithSalt :: Int -> CreateCluster -> Int
hashWithSalt Int
_salt CreateCluster' {Maybe [Text]
Maybe [CapacityProviderStrategyItem]
Maybe [ClusterSetting]
Maybe [Tag]
Maybe Text
Maybe ClusterServiceConnectDefaultsRequest
Maybe ClusterConfiguration
tags :: Maybe [Tag]
settings :: Maybe [ClusterSetting]
serviceConnectDefaults :: Maybe ClusterServiceConnectDefaultsRequest
defaultCapacityProviderStrategy :: Maybe [CapacityProviderStrategyItem]
configuration :: Maybe ClusterConfiguration
clusterName :: Maybe Text
capacityProviders :: Maybe [Text]
$sel:tags:CreateCluster' :: CreateCluster -> Maybe [Tag]
$sel:settings:CreateCluster' :: CreateCluster -> Maybe [ClusterSetting]
$sel:serviceConnectDefaults:CreateCluster' :: CreateCluster -> Maybe ClusterServiceConnectDefaultsRequest
$sel:defaultCapacityProviderStrategy:CreateCluster' :: CreateCluster -> Maybe [CapacityProviderStrategyItem]
$sel:configuration:CreateCluster' :: CreateCluster -> Maybe ClusterConfiguration
$sel:clusterName:CreateCluster' :: CreateCluster -> Maybe Text
$sel:capacityProviders:CreateCluster' :: CreateCluster -> Maybe [Text]
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
capacityProviders
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
clusterName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ClusterConfiguration
configuration
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [CapacityProviderStrategyItem]
defaultCapacityProviderStrategy
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ClusterServiceConnectDefaultsRequest
serviceConnectDefaults
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [ClusterSetting]
settings
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Tag]
tags

instance Prelude.NFData CreateCluster where
  rnf :: CreateCluster -> ()
rnf CreateCluster' {Maybe [Text]
Maybe [CapacityProviderStrategyItem]
Maybe [ClusterSetting]
Maybe [Tag]
Maybe Text
Maybe ClusterServiceConnectDefaultsRequest
Maybe ClusterConfiguration
tags :: Maybe [Tag]
settings :: Maybe [ClusterSetting]
serviceConnectDefaults :: Maybe ClusterServiceConnectDefaultsRequest
defaultCapacityProviderStrategy :: Maybe [CapacityProviderStrategyItem]
configuration :: Maybe ClusterConfiguration
clusterName :: Maybe Text
capacityProviders :: Maybe [Text]
$sel:tags:CreateCluster' :: CreateCluster -> Maybe [Tag]
$sel:settings:CreateCluster' :: CreateCluster -> Maybe [ClusterSetting]
$sel:serviceConnectDefaults:CreateCluster' :: CreateCluster -> Maybe ClusterServiceConnectDefaultsRequest
$sel:defaultCapacityProviderStrategy:CreateCluster' :: CreateCluster -> Maybe [CapacityProviderStrategyItem]
$sel:configuration:CreateCluster' :: CreateCluster -> Maybe ClusterConfiguration
$sel:clusterName:CreateCluster' :: CreateCluster -> Maybe Text
$sel:capacityProviders:CreateCluster' :: CreateCluster -> Maybe [Text]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
capacityProviders
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
clusterName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ClusterConfiguration
configuration
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [CapacityProviderStrategyItem]
defaultCapacityProviderStrategy
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ClusterServiceConnectDefaultsRequest
serviceConnectDefaults
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [ClusterSetting]
settings
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Tag]
tags

instance Data.ToHeaders CreateCluster where
  toHeaders :: CreateCluster -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"X-Amz-Target"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"AmazonEC2ContainerServiceV20141113.CreateCluster" ::
                          Prelude.ByteString
                      ),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON CreateCluster where
  toJSON :: CreateCluster -> Value
toJSON CreateCluster' {Maybe [Text]
Maybe [CapacityProviderStrategyItem]
Maybe [ClusterSetting]
Maybe [Tag]
Maybe Text
Maybe ClusterServiceConnectDefaultsRequest
Maybe ClusterConfiguration
tags :: Maybe [Tag]
settings :: Maybe [ClusterSetting]
serviceConnectDefaults :: Maybe ClusterServiceConnectDefaultsRequest
defaultCapacityProviderStrategy :: Maybe [CapacityProviderStrategyItem]
configuration :: Maybe ClusterConfiguration
clusterName :: Maybe Text
capacityProviders :: Maybe [Text]
$sel:tags:CreateCluster' :: CreateCluster -> Maybe [Tag]
$sel:settings:CreateCluster' :: CreateCluster -> Maybe [ClusterSetting]
$sel:serviceConnectDefaults:CreateCluster' :: CreateCluster -> Maybe ClusterServiceConnectDefaultsRequest
$sel:defaultCapacityProviderStrategy:CreateCluster' :: CreateCluster -> Maybe [CapacityProviderStrategyItem]
$sel:configuration:CreateCluster' :: CreateCluster -> Maybe ClusterConfiguration
$sel:clusterName:CreateCluster' :: CreateCluster -> Maybe Text
$sel:capacityProviders:CreateCluster' :: CreateCluster -> Maybe [Text]
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"capacityProviders" 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]
capacityProviders,
            (Key
"clusterName" 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
clusterName,
            (Key
"configuration" 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 ClusterConfiguration
configuration,
            (Key
"defaultCapacityProviderStrategy" 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]
defaultCapacityProviderStrategy,
            (Key
"serviceConnectDefaults" 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 ClusterServiceConnectDefaultsRequest
serviceConnectDefaults,
            (Key
"settings" 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 [ClusterSetting]
settings,
            (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
          ]
      )

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

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

-- | /See:/ 'newCreateClusterResponse' smart constructor.
data CreateClusterResponse = CreateClusterResponse'
  { -- | The full description of your new cluster.
    CreateClusterResponse -> Maybe Cluster
cluster :: Prelude.Maybe Cluster,
    -- | The response's http status code.
    CreateClusterResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CreateClusterResponse -> CreateClusterResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateClusterResponse -> CreateClusterResponse -> Bool
$c/= :: CreateClusterResponse -> CreateClusterResponse -> Bool
== :: CreateClusterResponse -> CreateClusterResponse -> Bool
$c== :: CreateClusterResponse -> CreateClusterResponse -> Bool
Prelude.Eq, ReadPrec [CreateClusterResponse]
ReadPrec CreateClusterResponse
Int -> ReadS CreateClusterResponse
ReadS [CreateClusterResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateClusterResponse]
$creadListPrec :: ReadPrec [CreateClusterResponse]
readPrec :: ReadPrec CreateClusterResponse
$creadPrec :: ReadPrec CreateClusterResponse
readList :: ReadS [CreateClusterResponse]
$creadList :: ReadS [CreateClusterResponse]
readsPrec :: Int -> ReadS CreateClusterResponse
$creadsPrec :: Int -> ReadS CreateClusterResponse
Prelude.Read, Int -> CreateClusterResponse -> ShowS
[CreateClusterResponse] -> ShowS
CreateClusterResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateClusterResponse] -> ShowS
$cshowList :: [CreateClusterResponse] -> ShowS
show :: CreateClusterResponse -> String
$cshow :: CreateClusterResponse -> String
showsPrec :: Int -> CreateClusterResponse -> ShowS
$cshowsPrec :: Int -> CreateClusterResponse -> ShowS
Prelude.Show, forall x. Rep CreateClusterResponse x -> CreateClusterResponse
forall x. CreateClusterResponse -> Rep CreateClusterResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateClusterResponse x -> CreateClusterResponse
$cfrom :: forall x. CreateClusterResponse -> Rep CreateClusterResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateClusterResponse' with all optional fields omitted.
--
-- Use <https://hackage.haskell.org/package/generic-lens generic-lens> or <https://hackage.haskell.org/package/optics optics> to modify other optional fields.
--
-- The following record fields are available, with the corresponding lenses provided
-- for backwards compatibility:
--
-- 'cluster', 'createClusterResponse_cluster' - The full description of your new cluster.
--
-- 'httpStatus', 'createClusterResponse_httpStatus' - The response's http status code.
newCreateClusterResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateClusterResponse
newCreateClusterResponse :: Int -> CreateClusterResponse
newCreateClusterResponse Int
pHttpStatus_ =
  CreateClusterResponse'
    { $sel:cluster:CreateClusterResponse' :: Maybe Cluster
cluster = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateClusterResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The full description of your new cluster.
createClusterResponse_cluster :: Lens.Lens' CreateClusterResponse (Prelude.Maybe Cluster)
createClusterResponse_cluster :: Lens' CreateClusterResponse (Maybe Cluster)
createClusterResponse_cluster = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateClusterResponse' {Maybe Cluster
cluster :: Maybe Cluster
$sel:cluster:CreateClusterResponse' :: CreateClusterResponse -> Maybe Cluster
cluster} -> Maybe Cluster
cluster) (\s :: CreateClusterResponse
s@CreateClusterResponse' {} Maybe Cluster
a -> CreateClusterResponse
s {$sel:cluster:CreateClusterResponse' :: Maybe Cluster
cluster = Maybe Cluster
a} :: CreateClusterResponse)

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

instance Prelude.NFData CreateClusterResponse where
  rnf :: CreateClusterResponse -> ()
rnf CreateClusterResponse' {Int
Maybe Cluster
httpStatus :: Int
cluster :: Maybe Cluster
$sel:httpStatus:CreateClusterResponse' :: CreateClusterResponse -> Int
$sel:cluster:CreateClusterResponse' :: CreateClusterResponse -> Maybe Cluster
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Cluster
cluster
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus