{-# 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.OpsWorks.CreateLayer
-- 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 layer. For more information, see
-- <https://docs.aws.amazon.com/opsworks/latest/userguide/workinglayers-basics-create.html How to Create a Layer>.
--
-- You should use __CreateLayer__ for noncustom layer types such as PHP App
-- Server only if the stack does not have an existing layer of that type. A
-- stack can have at most one instance of each noncustom layer; if you
-- attempt to create a second instance, __CreateLayer__ fails. A stack can
-- have an arbitrary number of custom layers, so you can call
-- __CreateLayer__ as many times as you like for that layer type.
--
-- __Required Permissions__: To use this action, an IAM user must have a
-- Manage permissions level for the stack, or an attached policy that
-- explicitly grants permissions. For more information on user permissions,
-- see
-- <https://docs.aws.amazon.com/opsworks/latest/userguide/opsworks-security-users.html Managing User Permissions>.
module Amazonka.OpsWorks.CreateLayer
  ( -- * Creating a Request
    CreateLayer (..),
    newCreateLayer,

    -- * Request Lenses
    createLayer_attributes,
    createLayer_autoAssignElasticIps,
    createLayer_autoAssignPublicIps,
    createLayer_cloudWatchLogsConfiguration,
    createLayer_customInstanceProfileArn,
    createLayer_customJson,
    createLayer_customRecipes,
    createLayer_customSecurityGroupIds,
    createLayer_enableAutoHealing,
    createLayer_installUpdatesOnBoot,
    createLayer_lifecycleEventConfiguration,
    createLayer_packages,
    createLayer_useEbsOptimizedInstances,
    createLayer_volumeConfigurations,
    createLayer_stackId,
    createLayer_type,
    createLayer_name,
    createLayer_shortname,

    -- * Destructuring the Response
    CreateLayerResponse (..),
    newCreateLayerResponse,

    -- * Response Lenses
    createLayerResponse_layerId,
    createLayerResponse_httpStatus,
  )
where

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

-- | /See:/ 'newCreateLayer' smart constructor.
data CreateLayer = CreateLayer'
  { -- | One or more user-defined key-value pairs to be added to the stack
    -- attributes.
    --
    -- To create a cluster layer, set the @EcsClusterArn@ attribute to the
    -- cluster\'s ARN.
    CreateLayer -> Maybe (HashMap LayerAttributesKeys (Maybe Text))
attributes :: Prelude.Maybe (Prelude.HashMap LayerAttributesKeys (Prelude.Maybe Prelude.Text)),
    -- | Whether to automatically assign an
    -- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/elastic-ip-addresses-eip.html Elastic IP address>
    -- to the layer\'s instances. For more information, see
    -- <https://docs.aws.amazon.com/opsworks/latest/userguide/workinglayers-basics-edit.html How to Edit a Layer>.
    CreateLayer -> Maybe Bool
autoAssignElasticIps :: Prelude.Maybe Prelude.Bool,
    -- | For stacks that are running in a VPC, whether to automatically assign a
    -- public IP address to the layer\'s instances. For more information, see
    -- <https://docs.aws.amazon.com/opsworks/latest/userguide/workinglayers-basics-edit.html How to Edit a Layer>.
    CreateLayer -> Maybe Bool
autoAssignPublicIps :: Prelude.Maybe Prelude.Bool,
    -- | Specifies CloudWatch Logs configuration options for the layer. For more
    -- information, see CloudWatchLogsLogStream.
    CreateLayer -> Maybe CloudWatchLogsConfiguration
cloudWatchLogsConfiguration :: Prelude.Maybe CloudWatchLogsConfiguration,
    -- | The ARN of an IAM profile to be used for the layer\'s EC2 instances. For
    -- more information about IAM ARNs, see
    -- <https://docs.aws.amazon.com/IAM/latest/UserGuide/Using_Identifiers.html Using Identifiers>.
    CreateLayer -> Maybe Text
customInstanceProfileArn :: Prelude.Maybe Prelude.Text,
    -- | A JSON-formatted string containing custom stack configuration and
    -- deployment attributes to be installed on the layer\'s instances. For
    -- more information, see
    -- <https://docs.aws.amazon.com/opsworks/latest/userguide/workingcookbook-json-override.html Using Custom JSON>.
    -- This feature is supported as of version 1.7.42 of the AWS CLI.
    CreateLayer -> Maybe Text
customJson :: Prelude.Maybe Prelude.Text,
    -- | A @LayerCustomRecipes@ object that specifies the layer custom recipes.
    CreateLayer -> Maybe Recipes
customRecipes :: Prelude.Maybe Recipes,
    -- | An array containing the layer custom security group IDs.
    CreateLayer -> Maybe [Text]
customSecurityGroupIds :: Prelude.Maybe [Prelude.Text],
    -- | Whether to disable auto healing for the layer.
    CreateLayer -> Maybe Bool
enableAutoHealing :: Prelude.Maybe Prelude.Bool,
    -- | Whether to install operating system and package updates when the
    -- instance boots. The default value is @true@. To control when updates are
    -- installed, set this value to @false@. You must then update your
    -- instances manually by using CreateDeployment to run the
    -- @update_dependencies@ stack command or by manually running @yum@ (Amazon
    -- Linux) or @apt-get@ (Ubuntu) on the instances.
    --
    -- To ensure that your instances have the latest security updates, we
    -- strongly recommend using the default value of @true@.
    CreateLayer -> Maybe Bool
installUpdatesOnBoot :: Prelude.Maybe Prelude.Bool,
    -- | A @LifeCycleEventConfiguration@ object that you can use to configure the
    -- Shutdown event to specify an execution timeout and enable or disable
    -- Elastic Load Balancer connection draining.
    CreateLayer -> Maybe LifecycleEventConfiguration
lifecycleEventConfiguration :: Prelude.Maybe LifecycleEventConfiguration,
    -- | An array of @Package@ objects that describes the layer packages.
    CreateLayer -> Maybe [Text]
packages :: Prelude.Maybe [Prelude.Text],
    -- | Whether to use Amazon EBS-optimized instances.
    CreateLayer -> Maybe Bool
useEbsOptimizedInstances :: Prelude.Maybe Prelude.Bool,
    -- | A @VolumeConfigurations@ object that describes the layer\'s Amazon EBS
    -- volumes.
    CreateLayer -> Maybe [VolumeConfiguration]
volumeConfigurations :: Prelude.Maybe [VolumeConfiguration],
    -- | The layer stack ID.
    CreateLayer -> Text
stackId :: Prelude.Text,
    -- | The layer type. A stack cannot have more than one built-in layer of the
    -- same type. It can have any number of custom layers. Built-in layers are
    -- not available in Chef 12 stacks.
    CreateLayer -> LayerType
type' :: LayerType,
    -- | The layer name, which is used by the console.
    CreateLayer -> Text
name :: Prelude.Text,
    -- | For custom layers only, use this parameter to specify the layer\'s short
    -- name, which is used internally by AWS OpsWorks Stacks and by Chef
    -- recipes. The short name is also used as the name for the directory where
    -- your app files are installed. It can have a maximum of 200 characters,
    -- which are limited to the alphanumeric characters, \'-\', \'_\', and
    -- \'.\'.
    --
    -- The built-in layers\' short names are defined by AWS OpsWorks Stacks.
    -- For more information, see the
    -- <https://docs.aws.amazon.com/opsworks/latest/userguide/layers.html Layer Reference>.
    CreateLayer -> Text
shortname :: Prelude.Text
  }
  deriving (CreateLayer -> CreateLayer -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateLayer -> CreateLayer -> Bool
$c/= :: CreateLayer -> CreateLayer -> Bool
== :: CreateLayer -> CreateLayer -> Bool
$c== :: CreateLayer -> CreateLayer -> Bool
Prelude.Eq, ReadPrec [CreateLayer]
ReadPrec CreateLayer
Int -> ReadS CreateLayer
ReadS [CreateLayer]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateLayer]
$creadListPrec :: ReadPrec [CreateLayer]
readPrec :: ReadPrec CreateLayer
$creadPrec :: ReadPrec CreateLayer
readList :: ReadS [CreateLayer]
$creadList :: ReadS [CreateLayer]
readsPrec :: Int -> ReadS CreateLayer
$creadsPrec :: Int -> ReadS CreateLayer
Prelude.Read, Int -> CreateLayer -> ShowS
[CreateLayer] -> ShowS
CreateLayer -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateLayer] -> ShowS
$cshowList :: [CreateLayer] -> ShowS
show :: CreateLayer -> String
$cshow :: CreateLayer -> String
showsPrec :: Int -> CreateLayer -> ShowS
$cshowsPrec :: Int -> CreateLayer -> ShowS
Prelude.Show, forall x. Rep CreateLayer x -> CreateLayer
forall x. CreateLayer -> Rep CreateLayer x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateLayer x -> CreateLayer
$cfrom :: forall x. CreateLayer -> Rep CreateLayer x
Prelude.Generic)

-- |
-- Create a value of 'CreateLayer' 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:
--
-- 'attributes', 'createLayer_attributes' - One or more user-defined key-value pairs to be added to the stack
-- attributes.
--
-- To create a cluster layer, set the @EcsClusterArn@ attribute to the
-- cluster\'s ARN.
--
-- 'autoAssignElasticIps', 'createLayer_autoAssignElasticIps' - Whether to automatically assign an
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/elastic-ip-addresses-eip.html Elastic IP address>
-- to the layer\'s instances. For more information, see
-- <https://docs.aws.amazon.com/opsworks/latest/userguide/workinglayers-basics-edit.html How to Edit a Layer>.
--
-- 'autoAssignPublicIps', 'createLayer_autoAssignPublicIps' - For stacks that are running in a VPC, whether to automatically assign a
-- public IP address to the layer\'s instances. For more information, see
-- <https://docs.aws.amazon.com/opsworks/latest/userguide/workinglayers-basics-edit.html How to Edit a Layer>.
--
-- 'cloudWatchLogsConfiguration', 'createLayer_cloudWatchLogsConfiguration' - Specifies CloudWatch Logs configuration options for the layer. For more
-- information, see CloudWatchLogsLogStream.
--
-- 'customInstanceProfileArn', 'createLayer_customInstanceProfileArn' - The ARN of an IAM profile to be used for the layer\'s EC2 instances. For
-- more information about IAM ARNs, see
-- <https://docs.aws.amazon.com/IAM/latest/UserGuide/Using_Identifiers.html Using Identifiers>.
--
-- 'customJson', 'createLayer_customJson' - A JSON-formatted string containing custom stack configuration and
-- deployment attributes to be installed on the layer\'s instances. For
-- more information, see
-- <https://docs.aws.amazon.com/opsworks/latest/userguide/workingcookbook-json-override.html Using Custom JSON>.
-- This feature is supported as of version 1.7.42 of the AWS CLI.
--
-- 'customRecipes', 'createLayer_customRecipes' - A @LayerCustomRecipes@ object that specifies the layer custom recipes.
--
-- 'customSecurityGroupIds', 'createLayer_customSecurityGroupIds' - An array containing the layer custom security group IDs.
--
-- 'enableAutoHealing', 'createLayer_enableAutoHealing' - Whether to disable auto healing for the layer.
--
-- 'installUpdatesOnBoot', 'createLayer_installUpdatesOnBoot' - Whether to install operating system and package updates when the
-- instance boots. The default value is @true@. To control when updates are
-- installed, set this value to @false@. You must then update your
-- instances manually by using CreateDeployment to run the
-- @update_dependencies@ stack command or by manually running @yum@ (Amazon
-- Linux) or @apt-get@ (Ubuntu) on the instances.
--
-- To ensure that your instances have the latest security updates, we
-- strongly recommend using the default value of @true@.
--
-- 'lifecycleEventConfiguration', 'createLayer_lifecycleEventConfiguration' - A @LifeCycleEventConfiguration@ object that you can use to configure the
-- Shutdown event to specify an execution timeout and enable or disable
-- Elastic Load Balancer connection draining.
--
-- 'packages', 'createLayer_packages' - An array of @Package@ objects that describes the layer packages.
--
-- 'useEbsOptimizedInstances', 'createLayer_useEbsOptimizedInstances' - Whether to use Amazon EBS-optimized instances.
--
-- 'volumeConfigurations', 'createLayer_volumeConfigurations' - A @VolumeConfigurations@ object that describes the layer\'s Amazon EBS
-- volumes.
--
-- 'stackId', 'createLayer_stackId' - The layer stack ID.
--
-- 'type'', 'createLayer_type' - The layer type. A stack cannot have more than one built-in layer of the
-- same type. It can have any number of custom layers. Built-in layers are
-- not available in Chef 12 stacks.
--
-- 'name', 'createLayer_name' - The layer name, which is used by the console.
--
-- 'shortname', 'createLayer_shortname' - For custom layers only, use this parameter to specify the layer\'s short
-- name, which is used internally by AWS OpsWorks Stacks and by Chef
-- recipes. The short name is also used as the name for the directory where
-- your app files are installed. It can have a maximum of 200 characters,
-- which are limited to the alphanumeric characters, \'-\', \'_\', and
-- \'.\'.
--
-- The built-in layers\' short names are defined by AWS OpsWorks Stacks.
-- For more information, see the
-- <https://docs.aws.amazon.com/opsworks/latest/userguide/layers.html Layer Reference>.
newCreateLayer ::
  -- | 'stackId'
  Prelude.Text ->
  -- | 'type''
  LayerType ->
  -- | 'name'
  Prelude.Text ->
  -- | 'shortname'
  Prelude.Text ->
  CreateLayer
newCreateLayer :: Text -> LayerType -> Text -> Text -> CreateLayer
newCreateLayer Text
pStackId_ LayerType
pType_ Text
pName_ Text
pShortname_ =
  CreateLayer'
    { $sel:attributes:CreateLayer' :: Maybe (HashMap LayerAttributesKeys (Maybe Text))
attributes = forall a. Maybe a
Prelude.Nothing,
      $sel:autoAssignElasticIps:CreateLayer' :: Maybe Bool
autoAssignElasticIps = forall a. Maybe a
Prelude.Nothing,
      $sel:autoAssignPublicIps:CreateLayer' :: Maybe Bool
autoAssignPublicIps = forall a. Maybe a
Prelude.Nothing,
      $sel:cloudWatchLogsConfiguration:CreateLayer' :: Maybe CloudWatchLogsConfiguration
cloudWatchLogsConfiguration = forall a. Maybe a
Prelude.Nothing,
      $sel:customInstanceProfileArn:CreateLayer' :: Maybe Text
customInstanceProfileArn = forall a. Maybe a
Prelude.Nothing,
      $sel:customJson:CreateLayer' :: Maybe Text
customJson = forall a. Maybe a
Prelude.Nothing,
      $sel:customRecipes:CreateLayer' :: Maybe Recipes
customRecipes = forall a. Maybe a
Prelude.Nothing,
      $sel:customSecurityGroupIds:CreateLayer' :: Maybe [Text]
customSecurityGroupIds = forall a. Maybe a
Prelude.Nothing,
      $sel:enableAutoHealing:CreateLayer' :: Maybe Bool
enableAutoHealing = forall a. Maybe a
Prelude.Nothing,
      $sel:installUpdatesOnBoot:CreateLayer' :: Maybe Bool
installUpdatesOnBoot = forall a. Maybe a
Prelude.Nothing,
      $sel:lifecycleEventConfiguration:CreateLayer' :: Maybe LifecycleEventConfiguration
lifecycleEventConfiguration = forall a. Maybe a
Prelude.Nothing,
      $sel:packages:CreateLayer' :: Maybe [Text]
packages = forall a. Maybe a
Prelude.Nothing,
      $sel:useEbsOptimizedInstances:CreateLayer' :: Maybe Bool
useEbsOptimizedInstances = forall a. Maybe a
Prelude.Nothing,
      $sel:volumeConfigurations:CreateLayer' :: Maybe [VolumeConfiguration]
volumeConfigurations = forall a. Maybe a
Prelude.Nothing,
      $sel:stackId:CreateLayer' :: Text
stackId = Text
pStackId_,
      $sel:type':CreateLayer' :: LayerType
type' = LayerType
pType_,
      $sel:name:CreateLayer' :: Text
name = Text
pName_,
      $sel:shortname:CreateLayer' :: Text
shortname = Text
pShortname_
    }

-- | One or more user-defined key-value pairs to be added to the stack
-- attributes.
--
-- To create a cluster layer, set the @EcsClusterArn@ attribute to the
-- cluster\'s ARN.
createLayer_attributes :: Lens.Lens' CreateLayer (Prelude.Maybe (Prelude.HashMap LayerAttributesKeys (Prelude.Maybe Prelude.Text)))
createLayer_attributes :: Lens'
  CreateLayer (Maybe (HashMap LayerAttributesKeys (Maybe Text)))
createLayer_attributes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLayer' {Maybe (HashMap LayerAttributesKeys (Maybe Text))
attributes :: Maybe (HashMap LayerAttributesKeys (Maybe Text))
$sel:attributes:CreateLayer' :: CreateLayer -> Maybe (HashMap LayerAttributesKeys (Maybe Text))
attributes} -> Maybe (HashMap LayerAttributesKeys (Maybe Text))
attributes) (\s :: CreateLayer
s@CreateLayer' {} Maybe (HashMap LayerAttributesKeys (Maybe Text))
a -> CreateLayer
s {$sel:attributes:CreateLayer' :: Maybe (HashMap LayerAttributesKeys (Maybe Text))
attributes = Maybe (HashMap LayerAttributesKeys (Maybe Text))
a} :: CreateLayer) 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

-- | Whether to automatically assign an
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/elastic-ip-addresses-eip.html Elastic IP address>
-- to the layer\'s instances. For more information, see
-- <https://docs.aws.amazon.com/opsworks/latest/userguide/workinglayers-basics-edit.html How to Edit a Layer>.
createLayer_autoAssignElasticIps :: Lens.Lens' CreateLayer (Prelude.Maybe Prelude.Bool)
createLayer_autoAssignElasticIps :: Lens' CreateLayer (Maybe Bool)
createLayer_autoAssignElasticIps = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLayer' {Maybe Bool
autoAssignElasticIps :: Maybe Bool
$sel:autoAssignElasticIps:CreateLayer' :: CreateLayer -> Maybe Bool
autoAssignElasticIps} -> Maybe Bool
autoAssignElasticIps) (\s :: CreateLayer
s@CreateLayer' {} Maybe Bool
a -> CreateLayer
s {$sel:autoAssignElasticIps:CreateLayer' :: Maybe Bool
autoAssignElasticIps = Maybe Bool
a} :: CreateLayer)

-- | For stacks that are running in a VPC, whether to automatically assign a
-- public IP address to the layer\'s instances. For more information, see
-- <https://docs.aws.amazon.com/opsworks/latest/userguide/workinglayers-basics-edit.html How to Edit a Layer>.
createLayer_autoAssignPublicIps :: Lens.Lens' CreateLayer (Prelude.Maybe Prelude.Bool)
createLayer_autoAssignPublicIps :: Lens' CreateLayer (Maybe Bool)
createLayer_autoAssignPublicIps = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLayer' {Maybe Bool
autoAssignPublicIps :: Maybe Bool
$sel:autoAssignPublicIps:CreateLayer' :: CreateLayer -> Maybe Bool
autoAssignPublicIps} -> Maybe Bool
autoAssignPublicIps) (\s :: CreateLayer
s@CreateLayer' {} Maybe Bool
a -> CreateLayer
s {$sel:autoAssignPublicIps:CreateLayer' :: Maybe Bool
autoAssignPublicIps = Maybe Bool
a} :: CreateLayer)

-- | Specifies CloudWatch Logs configuration options for the layer. For more
-- information, see CloudWatchLogsLogStream.
createLayer_cloudWatchLogsConfiguration :: Lens.Lens' CreateLayer (Prelude.Maybe CloudWatchLogsConfiguration)
createLayer_cloudWatchLogsConfiguration :: Lens' CreateLayer (Maybe CloudWatchLogsConfiguration)
createLayer_cloudWatchLogsConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLayer' {Maybe CloudWatchLogsConfiguration
cloudWatchLogsConfiguration :: Maybe CloudWatchLogsConfiguration
$sel:cloudWatchLogsConfiguration:CreateLayer' :: CreateLayer -> Maybe CloudWatchLogsConfiguration
cloudWatchLogsConfiguration} -> Maybe CloudWatchLogsConfiguration
cloudWatchLogsConfiguration) (\s :: CreateLayer
s@CreateLayer' {} Maybe CloudWatchLogsConfiguration
a -> CreateLayer
s {$sel:cloudWatchLogsConfiguration:CreateLayer' :: Maybe CloudWatchLogsConfiguration
cloudWatchLogsConfiguration = Maybe CloudWatchLogsConfiguration
a} :: CreateLayer)

-- | The ARN of an IAM profile to be used for the layer\'s EC2 instances. For
-- more information about IAM ARNs, see
-- <https://docs.aws.amazon.com/IAM/latest/UserGuide/Using_Identifiers.html Using Identifiers>.
createLayer_customInstanceProfileArn :: Lens.Lens' CreateLayer (Prelude.Maybe Prelude.Text)
createLayer_customInstanceProfileArn :: Lens' CreateLayer (Maybe Text)
createLayer_customInstanceProfileArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLayer' {Maybe Text
customInstanceProfileArn :: Maybe Text
$sel:customInstanceProfileArn:CreateLayer' :: CreateLayer -> Maybe Text
customInstanceProfileArn} -> Maybe Text
customInstanceProfileArn) (\s :: CreateLayer
s@CreateLayer' {} Maybe Text
a -> CreateLayer
s {$sel:customInstanceProfileArn:CreateLayer' :: Maybe Text
customInstanceProfileArn = Maybe Text
a} :: CreateLayer)

-- | A JSON-formatted string containing custom stack configuration and
-- deployment attributes to be installed on the layer\'s instances. For
-- more information, see
-- <https://docs.aws.amazon.com/opsworks/latest/userguide/workingcookbook-json-override.html Using Custom JSON>.
-- This feature is supported as of version 1.7.42 of the AWS CLI.
createLayer_customJson :: Lens.Lens' CreateLayer (Prelude.Maybe Prelude.Text)
createLayer_customJson :: Lens' CreateLayer (Maybe Text)
createLayer_customJson = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLayer' {Maybe Text
customJson :: Maybe Text
$sel:customJson:CreateLayer' :: CreateLayer -> Maybe Text
customJson} -> Maybe Text
customJson) (\s :: CreateLayer
s@CreateLayer' {} Maybe Text
a -> CreateLayer
s {$sel:customJson:CreateLayer' :: Maybe Text
customJson = Maybe Text
a} :: CreateLayer)

-- | A @LayerCustomRecipes@ object that specifies the layer custom recipes.
createLayer_customRecipes :: Lens.Lens' CreateLayer (Prelude.Maybe Recipes)
createLayer_customRecipes :: Lens' CreateLayer (Maybe Recipes)
createLayer_customRecipes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLayer' {Maybe Recipes
customRecipes :: Maybe Recipes
$sel:customRecipes:CreateLayer' :: CreateLayer -> Maybe Recipes
customRecipes} -> Maybe Recipes
customRecipes) (\s :: CreateLayer
s@CreateLayer' {} Maybe Recipes
a -> CreateLayer
s {$sel:customRecipes:CreateLayer' :: Maybe Recipes
customRecipes = Maybe Recipes
a} :: CreateLayer)

-- | An array containing the layer custom security group IDs.
createLayer_customSecurityGroupIds :: Lens.Lens' CreateLayer (Prelude.Maybe [Prelude.Text])
createLayer_customSecurityGroupIds :: Lens' CreateLayer (Maybe [Text])
createLayer_customSecurityGroupIds = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLayer' {Maybe [Text]
customSecurityGroupIds :: Maybe [Text]
$sel:customSecurityGroupIds:CreateLayer' :: CreateLayer -> Maybe [Text]
customSecurityGroupIds} -> Maybe [Text]
customSecurityGroupIds) (\s :: CreateLayer
s@CreateLayer' {} Maybe [Text]
a -> CreateLayer
s {$sel:customSecurityGroupIds:CreateLayer' :: Maybe [Text]
customSecurityGroupIds = Maybe [Text]
a} :: CreateLayer) 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

-- | Whether to disable auto healing for the layer.
createLayer_enableAutoHealing :: Lens.Lens' CreateLayer (Prelude.Maybe Prelude.Bool)
createLayer_enableAutoHealing :: Lens' CreateLayer (Maybe Bool)
createLayer_enableAutoHealing = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLayer' {Maybe Bool
enableAutoHealing :: Maybe Bool
$sel:enableAutoHealing:CreateLayer' :: CreateLayer -> Maybe Bool
enableAutoHealing} -> Maybe Bool
enableAutoHealing) (\s :: CreateLayer
s@CreateLayer' {} Maybe Bool
a -> CreateLayer
s {$sel:enableAutoHealing:CreateLayer' :: Maybe Bool
enableAutoHealing = Maybe Bool
a} :: CreateLayer)

-- | Whether to install operating system and package updates when the
-- instance boots. The default value is @true@. To control when updates are
-- installed, set this value to @false@. You must then update your
-- instances manually by using CreateDeployment to run the
-- @update_dependencies@ stack command or by manually running @yum@ (Amazon
-- Linux) or @apt-get@ (Ubuntu) on the instances.
--
-- To ensure that your instances have the latest security updates, we
-- strongly recommend using the default value of @true@.
createLayer_installUpdatesOnBoot :: Lens.Lens' CreateLayer (Prelude.Maybe Prelude.Bool)
createLayer_installUpdatesOnBoot :: Lens' CreateLayer (Maybe Bool)
createLayer_installUpdatesOnBoot = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLayer' {Maybe Bool
installUpdatesOnBoot :: Maybe Bool
$sel:installUpdatesOnBoot:CreateLayer' :: CreateLayer -> Maybe Bool
installUpdatesOnBoot} -> Maybe Bool
installUpdatesOnBoot) (\s :: CreateLayer
s@CreateLayer' {} Maybe Bool
a -> CreateLayer
s {$sel:installUpdatesOnBoot:CreateLayer' :: Maybe Bool
installUpdatesOnBoot = Maybe Bool
a} :: CreateLayer)

-- | A @LifeCycleEventConfiguration@ object that you can use to configure the
-- Shutdown event to specify an execution timeout and enable or disable
-- Elastic Load Balancer connection draining.
createLayer_lifecycleEventConfiguration :: Lens.Lens' CreateLayer (Prelude.Maybe LifecycleEventConfiguration)
createLayer_lifecycleEventConfiguration :: Lens' CreateLayer (Maybe LifecycleEventConfiguration)
createLayer_lifecycleEventConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLayer' {Maybe LifecycleEventConfiguration
lifecycleEventConfiguration :: Maybe LifecycleEventConfiguration
$sel:lifecycleEventConfiguration:CreateLayer' :: CreateLayer -> Maybe LifecycleEventConfiguration
lifecycleEventConfiguration} -> Maybe LifecycleEventConfiguration
lifecycleEventConfiguration) (\s :: CreateLayer
s@CreateLayer' {} Maybe LifecycleEventConfiguration
a -> CreateLayer
s {$sel:lifecycleEventConfiguration:CreateLayer' :: Maybe LifecycleEventConfiguration
lifecycleEventConfiguration = Maybe LifecycleEventConfiguration
a} :: CreateLayer)

-- | An array of @Package@ objects that describes the layer packages.
createLayer_packages :: Lens.Lens' CreateLayer (Prelude.Maybe [Prelude.Text])
createLayer_packages :: Lens' CreateLayer (Maybe [Text])
createLayer_packages = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLayer' {Maybe [Text]
packages :: Maybe [Text]
$sel:packages:CreateLayer' :: CreateLayer -> Maybe [Text]
packages} -> Maybe [Text]
packages) (\s :: CreateLayer
s@CreateLayer' {} Maybe [Text]
a -> CreateLayer
s {$sel:packages:CreateLayer' :: Maybe [Text]
packages = Maybe [Text]
a} :: CreateLayer) 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

-- | Whether to use Amazon EBS-optimized instances.
createLayer_useEbsOptimizedInstances :: Lens.Lens' CreateLayer (Prelude.Maybe Prelude.Bool)
createLayer_useEbsOptimizedInstances :: Lens' CreateLayer (Maybe Bool)
createLayer_useEbsOptimizedInstances = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLayer' {Maybe Bool
useEbsOptimizedInstances :: Maybe Bool
$sel:useEbsOptimizedInstances:CreateLayer' :: CreateLayer -> Maybe Bool
useEbsOptimizedInstances} -> Maybe Bool
useEbsOptimizedInstances) (\s :: CreateLayer
s@CreateLayer' {} Maybe Bool
a -> CreateLayer
s {$sel:useEbsOptimizedInstances:CreateLayer' :: Maybe Bool
useEbsOptimizedInstances = Maybe Bool
a} :: CreateLayer)

-- | A @VolumeConfigurations@ object that describes the layer\'s Amazon EBS
-- volumes.
createLayer_volumeConfigurations :: Lens.Lens' CreateLayer (Prelude.Maybe [VolumeConfiguration])
createLayer_volumeConfigurations :: Lens' CreateLayer (Maybe [VolumeConfiguration])
createLayer_volumeConfigurations = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLayer' {Maybe [VolumeConfiguration]
volumeConfigurations :: Maybe [VolumeConfiguration]
$sel:volumeConfigurations:CreateLayer' :: CreateLayer -> Maybe [VolumeConfiguration]
volumeConfigurations} -> Maybe [VolumeConfiguration]
volumeConfigurations) (\s :: CreateLayer
s@CreateLayer' {} Maybe [VolumeConfiguration]
a -> CreateLayer
s {$sel:volumeConfigurations:CreateLayer' :: Maybe [VolumeConfiguration]
volumeConfigurations = Maybe [VolumeConfiguration]
a} :: CreateLayer) 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 layer stack ID.
createLayer_stackId :: Lens.Lens' CreateLayer Prelude.Text
createLayer_stackId :: Lens' CreateLayer Text
createLayer_stackId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLayer' {Text
stackId :: Text
$sel:stackId:CreateLayer' :: CreateLayer -> Text
stackId} -> Text
stackId) (\s :: CreateLayer
s@CreateLayer' {} Text
a -> CreateLayer
s {$sel:stackId:CreateLayer' :: Text
stackId = Text
a} :: CreateLayer)

-- | The layer type. A stack cannot have more than one built-in layer of the
-- same type. It can have any number of custom layers. Built-in layers are
-- not available in Chef 12 stacks.
createLayer_type :: Lens.Lens' CreateLayer LayerType
createLayer_type :: Lens' CreateLayer LayerType
createLayer_type = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLayer' {LayerType
type' :: LayerType
$sel:type':CreateLayer' :: CreateLayer -> LayerType
type'} -> LayerType
type') (\s :: CreateLayer
s@CreateLayer' {} LayerType
a -> CreateLayer
s {$sel:type':CreateLayer' :: LayerType
type' = LayerType
a} :: CreateLayer)

-- | The layer name, which is used by the console.
createLayer_name :: Lens.Lens' CreateLayer Prelude.Text
createLayer_name :: Lens' CreateLayer Text
createLayer_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLayer' {Text
name :: Text
$sel:name:CreateLayer' :: CreateLayer -> Text
name} -> Text
name) (\s :: CreateLayer
s@CreateLayer' {} Text
a -> CreateLayer
s {$sel:name:CreateLayer' :: Text
name = Text
a} :: CreateLayer)

-- | For custom layers only, use this parameter to specify the layer\'s short
-- name, which is used internally by AWS OpsWorks Stacks and by Chef
-- recipes. The short name is also used as the name for the directory where
-- your app files are installed. It can have a maximum of 200 characters,
-- which are limited to the alphanumeric characters, \'-\', \'_\', and
-- \'.\'.
--
-- The built-in layers\' short names are defined by AWS OpsWorks Stacks.
-- For more information, see the
-- <https://docs.aws.amazon.com/opsworks/latest/userguide/layers.html Layer Reference>.
createLayer_shortname :: Lens.Lens' CreateLayer Prelude.Text
createLayer_shortname :: Lens' CreateLayer Text
createLayer_shortname = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLayer' {Text
shortname :: Text
$sel:shortname:CreateLayer' :: CreateLayer -> Text
shortname} -> Text
shortname) (\s :: CreateLayer
s@CreateLayer' {} Text
a -> CreateLayer
s {$sel:shortname:CreateLayer' :: Text
shortname = Text
a} :: CreateLayer)

instance Core.AWSRequest CreateLayer where
  type AWSResponse CreateLayer = CreateLayerResponse
  request :: (Service -> Service) -> CreateLayer -> Request CreateLayer
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 CreateLayer
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CreateLayer)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> Object -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveJSON
      ( \Int
s ResponseHeaders
h Object
x ->
          Maybe Text -> Int -> CreateLayerResponse
CreateLayerResponse'
            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
"LayerId")
            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 CreateLayer where
  hashWithSalt :: Int -> CreateLayer -> Int
hashWithSalt Int
_salt CreateLayer' {Maybe Bool
Maybe [Text]
Maybe [VolumeConfiguration]
Maybe Text
Maybe (HashMap LayerAttributesKeys (Maybe Text))
Maybe CloudWatchLogsConfiguration
Maybe Recipes
Maybe LifecycleEventConfiguration
Text
LayerType
shortname :: Text
name :: Text
type' :: LayerType
stackId :: Text
volumeConfigurations :: Maybe [VolumeConfiguration]
useEbsOptimizedInstances :: Maybe Bool
packages :: Maybe [Text]
lifecycleEventConfiguration :: Maybe LifecycleEventConfiguration
installUpdatesOnBoot :: Maybe Bool
enableAutoHealing :: Maybe Bool
customSecurityGroupIds :: Maybe [Text]
customRecipes :: Maybe Recipes
customJson :: Maybe Text
customInstanceProfileArn :: Maybe Text
cloudWatchLogsConfiguration :: Maybe CloudWatchLogsConfiguration
autoAssignPublicIps :: Maybe Bool
autoAssignElasticIps :: Maybe Bool
attributes :: Maybe (HashMap LayerAttributesKeys (Maybe Text))
$sel:shortname:CreateLayer' :: CreateLayer -> Text
$sel:name:CreateLayer' :: CreateLayer -> Text
$sel:type':CreateLayer' :: CreateLayer -> LayerType
$sel:stackId:CreateLayer' :: CreateLayer -> Text
$sel:volumeConfigurations:CreateLayer' :: CreateLayer -> Maybe [VolumeConfiguration]
$sel:useEbsOptimizedInstances:CreateLayer' :: CreateLayer -> Maybe Bool
$sel:packages:CreateLayer' :: CreateLayer -> Maybe [Text]
$sel:lifecycleEventConfiguration:CreateLayer' :: CreateLayer -> Maybe LifecycleEventConfiguration
$sel:installUpdatesOnBoot:CreateLayer' :: CreateLayer -> Maybe Bool
$sel:enableAutoHealing:CreateLayer' :: CreateLayer -> Maybe Bool
$sel:customSecurityGroupIds:CreateLayer' :: CreateLayer -> Maybe [Text]
$sel:customRecipes:CreateLayer' :: CreateLayer -> Maybe Recipes
$sel:customJson:CreateLayer' :: CreateLayer -> Maybe Text
$sel:customInstanceProfileArn:CreateLayer' :: CreateLayer -> Maybe Text
$sel:cloudWatchLogsConfiguration:CreateLayer' :: CreateLayer -> Maybe CloudWatchLogsConfiguration
$sel:autoAssignPublicIps:CreateLayer' :: CreateLayer -> Maybe Bool
$sel:autoAssignElasticIps:CreateLayer' :: CreateLayer -> Maybe Bool
$sel:attributes:CreateLayer' :: CreateLayer -> Maybe (HashMap LayerAttributesKeys (Maybe Text))
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap LayerAttributesKeys (Maybe Text))
attributes
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
autoAssignElasticIps
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
autoAssignPublicIps
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe CloudWatchLogsConfiguration
cloudWatchLogsConfiguration
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
customInstanceProfileArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
customJson
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Recipes
customRecipes
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
customSecurityGroupIds
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
enableAutoHealing
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
installUpdatesOnBoot
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe LifecycleEventConfiguration
lifecycleEventConfiguration
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
packages
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
useEbsOptimizedInstances
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [VolumeConfiguration]
volumeConfigurations
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
stackId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` LayerType
type'
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
name
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
shortname

instance Prelude.NFData CreateLayer where
  rnf :: CreateLayer -> ()
rnf CreateLayer' {Maybe Bool
Maybe [Text]
Maybe [VolumeConfiguration]
Maybe Text
Maybe (HashMap LayerAttributesKeys (Maybe Text))
Maybe CloudWatchLogsConfiguration
Maybe Recipes
Maybe LifecycleEventConfiguration
Text
LayerType
shortname :: Text
name :: Text
type' :: LayerType
stackId :: Text
volumeConfigurations :: Maybe [VolumeConfiguration]
useEbsOptimizedInstances :: Maybe Bool
packages :: Maybe [Text]
lifecycleEventConfiguration :: Maybe LifecycleEventConfiguration
installUpdatesOnBoot :: Maybe Bool
enableAutoHealing :: Maybe Bool
customSecurityGroupIds :: Maybe [Text]
customRecipes :: Maybe Recipes
customJson :: Maybe Text
customInstanceProfileArn :: Maybe Text
cloudWatchLogsConfiguration :: Maybe CloudWatchLogsConfiguration
autoAssignPublicIps :: Maybe Bool
autoAssignElasticIps :: Maybe Bool
attributes :: Maybe (HashMap LayerAttributesKeys (Maybe Text))
$sel:shortname:CreateLayer' :: CreateLayer -> Text
$sel:name:CreateLayer' :: CreateLayer -> Text
$sel:type':CreateLayer' :: CreateLayer -> LayerType
$sel:stackId:CreateLayer' :: CreateLayer -> Text
$sel:volumeConfigurations:CreateLayer' :: CreateLayer -> Maybe [VolumeConfiguration]
$sel:useEbsOptimizedInstances:CreateLayer' :: CreateLayer -> Maybe Bool
$sel:packages:CreateLayer' :: CreateLayer -> Maybe [Text]
$sel:lifecycleEventConfiguration:CreateLayer' :: CreateLayer -> Maybe LifecycleEventConfiguration
$sel:installUpdatesOnBoot:CreateLayer' :: CreateLayer -> Maybe Bool
$sel:enableAutoHealing:CreateLayer' :: CreateLayer -> Maybe Bool
$sel:customSecurityGroupIds:CreateLayer' :: CreateLayer -> Maybe [Text]
$sel:customRecipes:CreateLayer' :: CreateLayer -> Maybe Recipes
$sel:customJson:CreateLayer' :: CreateLayer -> Maybe Text
$sel:customInstanceProfileArn:CreateLayer' :: CreateLayer -> Maybe Text
$sel:cloudWatchLogsConfiguration:CreateLayer' :: CreateLayer -> Maybe CloudWatchLogsConfiguration
$sel:autoAssignPublicIps:CreateLayer' :: CreateLayer -> Maybe Bool
$sel:autoAssignElasticIps:CreateLayer' :: CreateLayer -> Maybe Bool
$sel:attributes:CreateLayer' :: CreateLayer -> Maybe (HashMap LayerAttributesKeys (Maybe Text))
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap LayerAttributesKeys (Maybe Text))
attributes
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
autoAssignElasticIps
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
autoAssignPublicIps
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe CloudWatchLogsConfiguration
cloudWatchLogsConfiguration
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
customInstanceProfileArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
customJson
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Recipes
customRecipes
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
customSecurityGroupIds
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
enableAutoHealing
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
installUpdatesOnBoot
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe LifecycleEventConfiguration
lifecycleEventConfiguration
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
packages
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
useEbsOptimizedInstances
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [VolumeConfiguration]
volumeConfigurations
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
stackId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf LayerType
type'
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
name
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
shortname

instance Data.ToHeaders CreateLayer where
  toHeaders :: CreateLayer -> 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
"OpsWorks_20130218.CreateLayer" ::
                          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 CreateLayer where
  toJSON :: CreateLayer -> Value
toJSON CreateLayer' {Maybe Bool
Maybe [Text]
Maybe [VolumeConfiguration]
Maybe Text
Maybe (HashMap LayerAttributesKeys (Maybe Text))
Maybe CloudWatchLogsConfiguration
Maybe Recipes
Maybe LifecycleEventConfiguration
Text
LayerType
shortname :: Text
name :: Text
type' :: LayerType
stackId :: Text
volumeConfigurations :: Maybe [VolumeConfiguration]
useEbsOptimizedInstances :: Maybe Bool
packages :: Maybe [Text]
lifecycleEventConfiguration :: Maybe LifecycleEventConfiguration
installUpdatesOnBoot :: Maybe Bool
enableAutoHealing :: Maybe Bool
customSecurityGroupIds :: Maybe [Text]
customRecipes :: Maybe Recipes
customJson :: Maybe Text
customInstanceProfileArn :: Maybe Text
cloudWatchLogsConfiguration :: Maybe CloudWatchLogsConfiguration
autoAssignPublicIps :: Maybe Bool
autoAssignElasticIps :: Maybe Bool
attributes :: Maybe (HashMap LayerAttributesKeys (Maybe Text))
$sel:shortname:CreateLayer' :: CreateLayer -> Text
$sel:name:CreateLayer' :: CreateLayer -> Text
$sel:type':CreateLayer' :: CreateLayer -> LayerType
$sel:stackId:CreateLayer' :: CreateLayer -> Text
$sel:volumeConfigurations:CreateLayer' :: CreateLayer -> Maybe [VolumeConfiguration]
$sel:useEbsOptimizedInstances:CreateLayer' :: CreateLayer -> Maybe Bool
$sel:packages:CreateLayer' :: CreateLayer -> Maybe [Text]
$sel:lifecycleEventConfiguration:CreateLayer' :: CreateLayer -> Maybe LifecycleEventConfiguration
$sel:installUpdatesOnBoot:CreateLayer' :: CreateLayer -> Maybe Bool
$sel:enableAutoHealing:CreateLayer' :: CreateLayer -> Maybe Bool
$sel:customSecurityGroupIds:CreateLayer' :: CreateLayer -> Maybe [Text]
$sel:customRecipes:CreateLayer' :: CreateLayer -> Maybe Recipes
$sel:customJson:CreateLayer' :: CreateLayer -> Maybe Text
$sel:customInstanceProfileArn:CreateLayer' :: CreateLayer -> Maybe Text
$sel:cloudWatchLogsConfiguration:CreateLayer' :: CreateLayer -> Maybe CloudWatchLogsConfiguration
$sel:autoAssignPublicIps:CreateLayer' :: CreateLayer -> Maybe Bool
$sel:autoAssignElasticIps:CreateLayer' :: CreateLayer -> Maybe Bool
$sel:attributes:CreateLayer' :: CreateLayer -> Maybe (HashMap LayerAttributesKeys (Maybe Text))
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"Attributes" 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 (HashMap LayerAttributesKeys (Maybe Text))
attributes,
            (Key
"AutoAssignElasticIps" 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
autoAssignElasticIps,
            (Key
"AutoAssignPublicIps" 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
autoAssignPublicIps,
            (Key
"CloudWatchLogsConfiguration" 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 CloudWatchLogsConfiguration
cloudWatchLogsConfiguration,
            (Key
"CustomInstanceProfileArn" 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
customInstanceProfileArn,
            (Key
"CustomJson" 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
customJson,
            (Key
"CustomRecipes" 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 Recipes
customRecipes,
            (Key
"CustomSecurityGroupIds" 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]
customSecurityGroupIds,
            (Key
"EnableAutoHealing" 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
enableAutoHealing,
            (Key
"InstallUpdatesOnBoot" 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
installUpdatesOnBoot,
            (Key
"LifecycleEventConfiguration" 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 LifecycleEventConfiguration
lifecycleEventConfiguration,
            (Key
"Packages" 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]
packages,
            (Key
"UseEbsOptimizedInstances" 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
useEbsOptimizedInstances,
            (Key
"VolumeConfigurations" 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 [VolumeConfiguration]
volumeConfigurations,
            forall a. a -> Maybe a
Prelude.Just (Key
"StackId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
stackId),
            forall a. a -> Maybe a
Prelude.Just (Key
"Type" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= LayerType
type'),
            forall a. a -> Maybe a
Prelude.Just (Key
"Name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
name),
            forall a. a -> Maybe a
Prelude.Just (Key
"Shortname" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
shortname)
          ]
      )

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

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

-- | Contains the response to a @CreateLayer@ request.
--
-- /See:/ 'newCreateLayerResponse' smart constructor.
data CreateLayerResponse = CreateLayerResponse'
  { -- | The layer ID.
    CreateLayerResponse -> Maybe Text
layerId :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    CreateLayerResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CreateLayerResponse -> CreateLayerResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateLayerResponse -> CreateLayerResponse -> Bool
$c/= :: CreateLayerResponse -> CreateLayerResponse -> Bool
== :: CreateLayerResponse -> CreateLayerResponse -> Bool
$c== :: CreateLayerResponse -> CreateLayerResponse -> Bool
Prelude.Eq, ReadPrec [CreateLayerResponse]
ReadPrec CreateLayerResponse
Int -> ReadS CreateLayerResponse
ReadS [CreateLayerResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateLayerResponse]
$creadListPrec :: ReadPrec [CreateLayerResponse]
readPrec :: ReadPrec CreateLayerResponse
$creadPrec :: ReadPrec CreateLayerResponse
readList :: ReadS [CreateLayerResponse]
$creadList :: ReadS [CreateLayerResponse]
readsPrec :: Int -> ReadS CreateLayerResponse
$creadsPrec :: Int -> ReadS CreateLayerResponse
Prelude.Read, Int -> CreateLayerResponse -> ShowS
[CreateLayerResponse] -> ShowS
CreateLayerResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateLayerResponse] -> ShowS
$cshowList :: [CreateLayerResponse] -> ShowS
show :: CreateLayerResponse -> String
$cshow :: CreateLayerResponse -> String
showsPrec :: Int -> CreateLayerResponse -> ShowS
$cshowsPrec :: Int -> CreateLayerResponse -> ShowS
Prelude.Show, forall x. Rep CreateLayerResponse x -> CreateLayerResponse
forall x. CreateLayerResponse -> Rep CreateLayerResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateLayerResponse x -> CreateLayerResponse
$cfrom :: forall x. CreateLayerResponse -> Rep CreateLayerResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateLayerResponse' 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:
--
-- 'layerId', 'createLayerResponse_layerId' - The layer ID.
--
-- 'httpStatus', 'createLayerResponse_httpStatus' - The response's http status code.
newCreateLayerResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateLayerResponse
newCreateLayerResponse :: Int -> CreateLayerResponse
newCreateLayerResponse Int
pHttpStatus_ =
  CreateLayerResponse'
    { $sel:layerId:CreateLayerResponse' :: Maybe Text
layerId = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateLayerResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The layer ID.
createLayerResponse_layerId :: Lens.Lens' CreateLayerResponse (Prelude.Maybe Prelude.Text)
createLayerResponse_layerId :: Lens' CreateLayerResponse (Maybe Text)
createLayerResponse_layerId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLayerResponse' {Maybe Text
layerId :: Maybe Text
$sel:layerId:CreateLayerResponse' :: CreateLayerResponse -> Maybe Text
layerId} -> Maybe Text
layerId) (\s :: CreateLayerResponse
s@CreateLayerResponse' {} Maybe Text
a -> CreateLayerResponse
s {$sel:layerId:CreateLayerResponse' :: Maybe Text
layerId = Maybe Text
a} :: CreateLayerResponse)

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

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