{-# 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.CreateInstance
-- 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 an instance in a specified stack. For more information, see
-- <https://docs.aws.amazon.com/opsworks/latest/userguide/workinginstances-add.html Adding an Instance to a Layer>.
--
-- __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.CreateInstance
  ( -- * Creating a Request
    CreateInstance (..),
    newCreateInstance,

    -- * Request Lenses
    createInstance_agentVersion,
    createInstance_amiId,
    createInstance_architecture,
    createInstance_autoScalingType,
    createInstance_availabilityZone,
    createInstance_blockDeviceMappings,
    createInstance_ebsOptimized,
    createInstance_hostname,
    createInstance_installUpdatesOnBoot,
    createInstance_os,
    createInstance_rootDeviceType,
    createInstance_sshKeyName,
    createInstance_subnetId,
    createInstance_tenancy,
    createInstance_virtualizationType,
    createInstance_stackId,
    createInstance_layerIds,
    createInstance_instanceType,

    -- * Destructuring the Response
    CreateInstanceResponse (..),
    newCreateInstanceResponse,

    -- * Response Lenses
    createInstanceResponse_instanceId,
    createInstanceResponse_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:/ 'newCreateInstance' smart constructor.
data CreateInstance = CreateInstance'
  { -- | The default AWS OpsWorks Stacks agent version. You have the following
    -- options:
    --
    -- -   @INHERIT@ - Use the stack\'s default agent version setting.
    --
    -- -   /version_number/ - Use the specified agent version. This value
    --     overrides the stack\'s default setting. To update the agent version,
    --     edit the instance configuration and specify a new version. AWS
    --     OpsWorks Stacks then automatically installs that version on the
    --     instance.
    --
    -- The default setting is @INHERIT@. To specify an agent version, you must
    -- use the complete version number, not the abbreviated number shown on the
    -- console. For a list of available agent version numbers, call
    -- DescribeAgentVersions. AgentVersion cannot be set to Chef 12.2.
    CreateInstance -> Maybe Text
agentVersion :: Prelude.Maybe Prelude.Text,
    -- | A custom AMI ID to be used to create the instance. The AMI should be
    -- based on one of the supported operating systems. For more information,
    -- see
    -- <https://docs.aws.amazon.com/opsworks/latest/userguide/workinginstances-custom-ami.html Using Custom AMIs>.
    --
    -- If you specify a custom AMI, you must set @Os@ to @Custom@.
    CreateInstance -> Maybe Text
amiId :: Prelude.Maybe Prelude.Text,
    -- | The instance architecture. The default option is @x86_64@. Instance
    -- types do not necessarily support both architectures. For a list of the
    -- architectures that are supported by the different instance types, see
    -- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/instance-types.html Instance Families and Types>.
    CreateInstance -> Maybe Architecture
architecture :: Prelude.Maybe Architecture,
    -- | For load-based or time-based instances, the type. Windows stacks can use
    -- only time-based instances.
    CreateInstance -> Maybe AutoScalingType
autoScalingType :: Prelude.Maybe AutoScalingType,
    -- | The instance Availability Zone. For more information, see
    -- <https://docs.aws.amazon.com/general/latest/gr/rande.html Regions and Endpoints>.
    CreateInstance -> Maybe Text
availabilityZone :: Prelude.Maybe Prelude.Text,
    -- | An array of @BlockDeviceMapping@ objects that specify the instance\'s
    -- block devices. For more information, see
    -- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/block-device-mapping-concepts.html Block Device Mapping>.
    -- Note that block device mappings are not supported for custom AMIs.
    CreateInstance -> Maybe [BlockDeviceMapping]
blockDeviceMappings :: Prelude.Maybe [BlockDeviceMapping],
    -- | Whether to create an Amazon EBS-optimized instance.
    CreateInstance -> Maybe Bool
ebsOptimized :: Prelude.Maybe Prelude.Bool,
    -- | The instance host name.
    CreateInstance -> Maybe Text
hostname :: Prelude.Maybe Prelude.Text,
    -- | 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.
    --
    -- We strongly recommend using the default value of @true@ to ensure that
    -- your instances have the latest security updates.
    CreateInstance -> Maybe Bool
installUpdatesOnBoot :: Prelude.Maybe Prelude.Bool,
    -- | The instance\'s operating system, which must be set to one of the
    -- following.
    --
    -- -   A supported Linux operating system: An Amazon Linux version, such as
    --     @Amazon Linux 2018.03@, @Amazon Linux 2017.09@,
    --     @Amazon Linux 2017.03@, @Amazon Linux 2016.09@,
    --     @Amazon Linux 2016.03@, @Amazon Linux 2015.09@, or
    --     @Amazon Linux 2015.03@.
    --
    -- -   A supported Ubuntu operating system, such as @Ubuntu 16.04 LTS@,
    --     @Ubuntu 14.04 LTS@, or @Ubuntu 12.04 LTS@.
    --
    -- -   @CentOS Linux 7@
    --
    -- -   @Red Hat Enterprise Linux 7@
    --
    -- -   A supported Windows operating system, such as
    --     @Microsoft Windows Server 2012 R2 Base@,
    --     @Microsoft Windows Server 2012 R2 with SQL Server Express@,
    --     @Microsoft Windows Server 2012 R2 with SQL Server Standard@, or
    --     @Microsoft Windows Server 2012 R2 with SQL Server Web@.
    --
    -- -   A custom AMI: @Custom@.
    --
    -- For more information about the supported operating systems, see
    -- <https://docs.aws.amazon.com/opsworks/latest/userguide/workinginstances-os.html AWS OpsWorks Stacks Operating Systems>.
    --
    -- The default option is the current Amazon Linux version. If you set this
    -- parameter to @Custom@, you must use the CreateInstance action\'s AmiId
    -- parameter to specify the custom AMI that you want to use. Block device
    -- mappings are not supported if the value is @Custom@. For more
    -- information about supported operating systems, see
    -- <https://docs.aws.amazon.com/opsworks/latest/userguide/workinginstances-os.html Operating Systems>For
    -- more information about how to use custom AMIs with AWS OpsWorks Stacks,
    -- see
    -- <https://docs.aws.amazon.com/opsworks/latest/userguide/workinginstances-custom-ami.html Using Custom AMIs>.
    CreateInstance -> Maybe Text
os :: Prelude.Maybe Prelude.Text,
    -- | The instance root device type. For more information, see
    -- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/ComponentsAMIs.html#storage-for-the-root-device Storage for the Root Device>.
    CreateInstance -> Maybe RootDeviceType
rootDeviceType :: Prelude.Maybe RootDeviceType,
    -- | The instance\'s Amazon EC2 key-pair name.
    CreateInstance -> Maybe Text
sshKeyName :: Prelude.Maybe Prelude.Text,
    -- | The ID of the instance\'s subnet. If the stack is running in a VPC, you
    -- can use this parameter to override the stack\'s default subnet ID value
    -- and direct AWS OpsWorks Stacks to launch the instance in a different
    -- subnet.
    CreateInstance -> Maybe Text
subnetId :: Prelude.Maybe Prelude.Text,
    -- | The instance\'s tenancy option. The default option is no tenancy, or if
    -- the instance is running in a VPC, inherit tenancy settings from the VPC.
    -- The following are valid values for this parameter: @dedicated@,
    -- @default@, or @host@. Because there are costs associated with changes in
    -- tenancy options, we recommend that you research tenancy options before
    -- choosing them for your instances. For more information about dedicated
    -- hosts, see
    -- <http://aws.amazon.com/ec2/dedicated-hosts/ Dedicated Hosts Overview>
    -- and
    -- <http://aws.amazon.com/ec2/dedicated-hosts/ Amazon EC2 Dedicated Hosts>.
    -- For more information about dedicated instances, see
    -- <https://docs.aws.amazon.com/AmazonVPC/latest/UserGuide/dedicated-instance.html Dedicated Instances>
    -- and
    -- <http://aws.amazon.com/ec2/purchasing-options/dedicated-instances/ Amazon EC2 Dedicated Instances>.
    CreateInstance -> Maybe Text
tenancy :: Prelude.Maybe Prelude.Text,
    -- | The instance\'s virtualization type, @paravirtual@ or @hvm@.
    CreateInstance -> Maybe Text
virtualizationType :: Prelude.Maybe Prelude.Text,
    -- | The stack ID.
    CreateInstance -> Text
stackId :: Prelude.Text,
    -- | An array that contains the instance\'s layer IDs.
    CreateInstance -> [Text]
layerIds :: [Prelude.Text],
    -- | The instance type, such as @t2.micro@. For a list of supported instance
    -- types, open the stack in the console, choose __Instances__, and choose
    -- __+ Instance__. The __Size__ list contains the currently supported
    -- types. For more information, see
    -- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/instance-types.html Instance Families and Types>.
    -- The parameter values that you use to specify the various types are in
    -- the __API Name__ column of the __Available Instance Types__ table.
    CreateInstance -> Text
instanceType :: Prelude.Text
  }
  deriving (CreateInstance -> CreateInstance -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateInstance -> CreateInstance -> Bool
$c/= :: CreateInstance -> CreateInstance -> Bool
== :: CreateInstance -> CreateInstance -> Bool
$c== :: CreateInstance -> CreateInstance -> Bool
Prelude.Eq, ReadPrec [CreateInstance]
ReadPrec CreateInstance
Int -> ReadS CreateInstance
ReadS [CreateInstance]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateInstance]
$creadListPrec :: ReadPrec [CreateInstance]
readPrec :: ReadPrec CreateInstance
$creadPrec :: ReadPrec CreateInstance
readList :: ReadS [CreateInstance]
$creadList :: ReadS [CreateInstance]
readsPrec :: Int -> ReadS CreateInstance
$creadsPrec :: Int -> ReadS CreateInstance
Prelude.Read, Int -> CreateInstance -> ShowS
[CreateInstance] -> ShowS
CreateInstance -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateInstance] -> ShowS
$cshowList :: [CreateInstance] -> ShowS
show :: CreateInstance -> String
$cshow :: CreateInstance -> String
showsPrec :: Int -> CreateInstance -> ShowS
$cshowsPrec :: Int -> CreateInstance -> ShowS
Prelude.Show, forall x. Rep CreateInstance x -> CreateInstance
forall x. CreateInstance -> Rep CreateInstance x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateInstance x -> CreateInstance
$cfrom :: forall x. CreateInstance -> Rep CreateInstance x
Prelude.Generic)

-- |
-- Create a value of 'CreateInstance' 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:
--
-- 'agentVersion', 'createInstance_agentVersion' - The default AWS OpsWorks Stacks agent version. You have the following
-- options:
--
-- -   @INHERIT@ - Use the stack\'s default agent version setting.
--
-- -   /version_number/ - Use the specified agent version. This value
--     overrides the stack\'s default setting. To update the agent version,
--     edit the instance configuration and specify a new version. AWS
--     OpsWorks Stacks then automatically installs that version on the
--     instance.
--
-- The default setting is @INHERIT@. To specify an agent version, you must
-- use the complete version number, not the abbreviated number shown on the
-- console. For a list of available agent version numbers, call
-- DescribeAgentVersions. AgentVersion cannot be set to Chef 12.2.
--
-- 'amiId', 'createInstance_amiId' - A custom AMI ID to be used to create the instance. The AMI should be
-- based on one of the supported operating systems. For more information,
-- see
-- <https://docs.aws.amazon.com/opsworks/latest/userguide/workinginstances-custom-ami.html Using Custom AMIs>.
--
-- If you specify a custom AMI, you must set @Os@ to @Custom@.
--
-- 'architecture', 'createInstance_architecture' - The instance architecture. The default option is @x86_64@. Instance
-- types do not necessarily support both architectures. For a list of the
-- architectures that are supported by the different instance types, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/instance-types.html Instance Families and Types>.
--
-- 'autoScalingType', 'createInstance_autoScalingType' - For load-based or time-based instances, the type. Windows stacks can use
-- only time-based instances.
--
-- 'availabilityZone', 'createInstance_availabilityZone' - The instance Availability Zone. For more information, see
-- <https://docs.aws.amazon.com/general/latest/gr/rande.html Regions and Endpoints>.
--
-- 'blockDeviceMappings', 'createInstance_blockDeviceMappings' - An array of @BlockDeviceMapping@ objects that specify the instance\'s
-- block devices. For more information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/block-device-mapping-concepts.html Block Device Mapping>.
-- Note that block device mappings are not supported for custom AMIs.
--
-- 'ebsOptimized', 'createInstance_ebsOptimized' - Whether to create an Amazon EBS-optimized instance.
--
-- 'hostname', 'createInstance_hostname' - The instance host name.
--
-- 'installUpdatesOnBoot', 'createInstance_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.
--
-- We strongly recommend using the default value of @true@ to ensure that
-- your instances have the latest security updates.
--
-- 'os', 'createInstance_os' - The instance\'s operating system, which must be set to one of the
-- following.
--
-- -   A supported Linux operating system: An Amazon Linux version, such as
--     @Amazon Linux 2018.03@, @Amazon Linux 2017.09@,
--     @Amazon Linux 2017.03@, @Amazon Linux 2016.09@,
--     @Amazon Linux 2016.03@, @Amazon Linux 2015.09@, or
--     @Amazon Linux 2015.03@.
--
-- -   A supported Ubuntu operating system, such as @Ubuntu 16.04 LTS@,
--     @Ubuntu 14.04 LTS@, or @Ubuntu 12.04 LTS@.
--
-- -   @CentOS Linux 7@
--
-- -   @Red Hat Enterprise Linux 7@
--
-- -   A supported Windows operating system, such as
--     @Microsoft Windows Server 2012 R2 Base@,
--     @Microsoft Windows Server 2012 R2 with SQL Server Express@,
--     @Microsoft Windows Server 2012 R2 with SQL Server Standard@, or
--     @Microsoft Windows Server 2012 R2 with SQL Server Web@.
--
-- -   A custom AMI: @Custom@.
--
-- For more information about the supported operating systems, see
-- <https://docs.aws.amazon.com/opsworks/latest/userguide/workinginstances-os.html AWS OpsWorks Stacks Operating Systems>.
--
-- The default option is the current Amazon Linux version. If you set this
-- parameter to @Custom@, you must use the CreateInstance action\'s AmiId
-- parameter to specify the custom AMI that you want to use. Block device
-- mappings are not supported if the value is @Custom@. For more
-- information about supported operating systems, see
-- <https://docs.aws.amazon.com/opsworks/latest/userguide/workinginstances-os.html Operating Systems>For
-- more information about how to use custom AMIs with AWS OpsWorks Stacks,
-- see
-- <https://docs.aws.amazon.com/opsworks/latest/userguide/workinginstances-custom-ami.html Using Custom AMIs>.
--
-- 'rootDeviceType', 'createInstance_rootDeviceType' - The instance root device type. For more information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/ComponentsAMIs.html#storage-for-the-root-device Storage for the Root Device>.
--
-- 'sshKeyName', 'createInstance_sshKeyName' - The instance\'s Amazon EC2 key-pair name.
--
-- 'subnetId', 'createInstance_subnetId' - The ID of the instance\'s subnet. If the stack is running in a VPC, you
-- can use this parameter to override the stack\'s default subnet ID value
-- and direct AWS OpsWorks Stacks to launch the instance in a different
-- subnet.
--
-- 'tenancy', 'createInstance_tenancy' - The instance\'s tenancy option. The default option is no tenancy, or if
-- the instance is running in a VPC, inherit tenancy settings from the VPC.
-- The following are valid values for this parameter: @dedicated@,
-- @default@, or @host@. Because there are costs associated with changes in
-- tenancy options, we recommend that you research tenancy options before
-- choosing them for your instances. For more information about dedicated
-- hosts, see
-- <http://aws.amazon.com/ec2/dedicated-hosts/ Dedicated Hosts Overview>
-- and
-- <http://aws.amazon.com/ec2/dedicated-hosts/ Amazon EC2 Dedicated Hosts>.
-- For more information about dedicated instances, see
-- <https://docs.aws.amazon.com/AmazonVPC/latest/UserGuide/dedicated-instance.html Dedicated Instances>
-- and
-- <http://aws.amazon.com/ec2/purchasing-options/dedicated-instances/ Amazon EC2 Dedicated Instances>.
--
-- 'virtualizationType', 'createInstance_virtualizationType' - The instance\'s virtualization type, @paravirtual@ or @hvm@.
--
-- 'stackId', 'createInstance_stackId' - The stack ID.
--
-- 'layerIds', 'createInstance_layerIds' - An array that contains the instance\'s layer IDs.
--
-- 'instanceType', 'createInstance_instanceType' - The instance type, such as @t2.micro@. For a list of supported instance
-- types, open the stack in the console, choose __Instances__, and choose
-- __+ Instance__. The __Size__ list contains the currently supported
-- types. For more information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/instance-types.html Instance Families and Types>.
-- The parameter values that you use to specify the various types are in
-- the __API Name__ column of the __Available Instance Types__ table.
newCreateInstance ::
  -- | 'stackId'
  Prelude.Text ->
  -- | 'instanceType'
  Prelude.Text ->
  CreateInstance
newCreateInstance :: Text -> Text -> CreateInstance
newCreateInstance Text
pStackId_ Text
pInstanceType_ =
  CreateInstance'
    { $sel:agentVersion:CreateInstance' :: Maybe Text
agentVersion = forall a. Maybe a
Prelude.Nothing,
      $sel:amiId:CreateInstance' :: Maybe Text
amiId = forall a. Maybe a
Prelude.Nothing,
      $sel:architecture:CreateInstance' :: Maybe Architecture
architecture = forall a. Maybe a
Prelude.Nothing,
      $sel:autoScalingType:CreateInstance' :: Maybe AutoScalingType
autoScalingType = forall a. Maybe a
Prelude.Nothing,
      $sel:availabilityZone:CreateInstance' :: Maybe Text
availabilityZone = forall a. Maybe a
Prelude.Nothing,
      $sel:blockDeviceMappings:CreateInstance' :: Maybe [BlockDeviceMapping]
blockDeviceMappings = forall a. Maybe a
Prelude.Nothing,
      $sel:ebsOptimized:CreateInstance' :: Maybe Bool
ebsOptimized = forall a. Maybe a
Prelude.Nothing,
      $sel:hostname:CreateInstance' :: Maybe Text
hostname = forall a. Maybe a
Prelude.Nothing,
      $sel:installUpdatesOnBoot:CreateInstance' :: Maybe Bool
installUpdatesOnBoot = forall a. Maybe a
Prelude.Nothing,
      $sel:os:CreateInstance' :: Maybe Text
os = forall a. Maybe a
Prelude.Nothing,
      $sel:rootDeviceType:CreateInstance' :: Maybe RootDeviceType
rootDeviceType = forall a. Maybe a
Prelude.Nothing,
      $sel:sshKeyName:CreateInstance' :: Maybe Text
sshKeyName = forall a. Maybe a
Prelude.Nothing,
      $sel:subnetId:CreateInstance' :: Maybe Text
subnetId = forall a. Maybe a
Prelude.Nothing,
      $sel:tenancy:CreateInstance' :: Maybe Text
tenancy = forall a. Maybe a
Prelude.Nothing,
      $sel:virtualizationType:CreateInstance' :: Maybe Text
virtualizationType = forall a. Maybe a
Prelude.Nothing,
      $sel:stackId:CreateInstance' :: Text
stackId = Text
pStackId_,
      $sel:layerIds:CreateInstance' :: [Text]
layerIds = forall a. Monoid a => a
Prelude.mempty,
      $sel:instanceType:CreateInstance' :: Text
instanceType = Text
pInstanceType_
    }

-- | The default AWS OpsWorks Stacks agent version. You have the following
-- options:
--
-- -   @INHERIT@ - Use the stack\'s default agent version setting.
--
-- -   /version_number/ - Use the specified agent version. This value
--     overrides the stack\'s default setting. To update the agent version,
--     edit the instance configuration and specify a new version. AWS
--     OpsWorks Stacks then automatically installs that version on the
--     instance.
--
-- The default setting is @INHERIT@. To specify an agent version, you must
-- use the complete version number, not the abbreviated number shown on the
-- console. For a list of available agent version numbers, call
-- DescribeAgentVersions. AgentVersion cannot be set to Chef 12.2.
createInstance_agentVersion :: Lens.Lens' CreateInstance (Prelude.Maybe Prelude.Text)
createInstance_agentVersion :: Lens' CreateInstance (Maybe Text)
createInstance_agentVersion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateInstance' {Maybe Text
agentVersion :: Maybe Text
$sel:agentVersion:CreateInstance' :: CreateInstance -> Maybe Text
agentVersion} -> Maybe Text
agentVersion) (\s :: CreateInstance
s@CreateInstance' {} Maybe Text
a -> CreateInstance
s {$sel:agentVersion:CreateInstance' :: Maybe Text
agentVersion = Maybe Text
a} :: CreateInstance)

-- | A custom AMI ID to be used to create the instance. The AMI should be
-- based on one of the supported operating systems. For more information,
-- see
-- <https://docs.aws.amazon.com/opsworks/latest/userguide/workinginstances-custom-ami.html Using Custom AMIs>.
--
-- If you specify a custom AMI, you must set @Os@ to @Custom@.
createInstance_amiId :: Lens.Lens' CreateInstance (Prelude.Maybe Prelude.Text)
createInstance_amiId :: Lens' CreateInstance (Maybe Text)
createInstance_amiId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateInstance' {Maybe Text
amiId :: Maybe Text
$sel:amiId:CreateInstance' :: CreateInstance -> Maybe Text
amiId} -> Maybe Text
amiId) (\s :: CreateInstance
s@CreateInstance' {} Maybe Text
a -> CreateInstance
s {$sel:amiId:CreateInstance' :: Maybe Text
amiId = Maybe Text
a} :: CreateInstance)

-- | The instance architecture. The default option is @x86_64@. Instance
-- types do not necessarily support both architectures. For a list of the
-- architectures that are supported by the different instance types, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/instance-types.html Instance Families and Types>.
createInstance_architecture :: Lens.Lens' CreateInstance (Prelude.Maybe Architecture)
createInstance_architecture :: Lens' CreateInstance (Maybe Architecture)
createInstance_architecture = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateInstance' {Maybe Architecture
architecture :: Maybe Architecture
$sel:architecture:CreateInstance' :: CreateInstance -> Maybe Architecture
architecture} -> Maybe Architecture
architecture) (\s :: CreateInstance
s@CreateInstance' {} Maybe Architecture
a -> CreateInstance
s {$sel:architecture:CreateInstance' :: Maybe Architecture
architecture = Maybe Architecture
a} :: CreateInstance)

-- | For load-based or time-based instances, the type. Windows stacks can use
-- only time-based instances.
createInstance_autoScalingType :: Lens.Lens' CreateInstance (Prelude.Maybe AutoScalingType)
createInstance_autoScalingType :: Lens' CreateInstance (Maybe AutoScalingType)
createInstance_autoScalingType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateInstance' {Maybe AutoScalingType
autoScalingType :: Maybe AutoScalingType
$sel:autoScalingType:CreateInstance' :: CreateInstance -> Maybe AutoScalingType
autoScalingType} -> Maybe AutoScalingType
autoScalingType) (\s :: CreateInstance
s@CreateInstance' {} Maybe AutoScalingType
a -> CreateInstance
s {$sel:autoScalingType:CreateInstance' :: Maybe AutoScalingType
autoScalingType = Maybe AutoScalingType
a} :: CreateInstance)

-- | The instance Availability Zone. For more information, see
-- <https://docs.aws.amazon.com/general/latest/gr/rande.html Regions and Endpoints>.
createInstance_availabilityZone :: Lens.Lens' CreateInstance (Prelude.Maybe Prelude.Text)
createInstance_availabilityZone :: Lens' CreateInstance (Maybe Text)
createInstance_availabilityZone = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateInstance' {Maybe Text
availabilityZone :: Maybe Text
$sel:availabilityZone:CreateInstance' :: CreateInstance -> Maybe Text
availabilityZone} -> Maybe Text
availabilityZone) (\s :: CreateInstance
s@CreateInstance' {} Maybe Text
a -> CreateInstance
s {$sel:availabilityZone:CreateInstance' :: Maybe Text
availabilityZone = Maybe Text
a} :: CreateInstance)

-- | An array of @BlockDeviceMapping@ objects that specify the instance\'s
-- block devices. For more information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/block-device-mapping-concepts.html Block Device Mapping>.
-- Note that block device mappings are not supported for custom AMIs.
createInstance_blockDeviceMappings :: Lens.Lens' CreateInstance (Prelude.Maybe [BlockDeviceMapping])
createInstance_blockDeviceMappings :: Lens' CreateInstance (Maybe [BlockDeviceMapping])
createInstance_blockDeviceMappings = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateInstance' {Maybe [BlockDeviceMapping]
blockDeviceMappings :: Maybe [BlockDeviceMapping]
$sel:blockDeviceMappings:CreateInstance' :: CreateInstance -> Maybe [BlockDeviceMapping]
blockDeviceMappings} -> Maybe [BlockDeviceMapping]
blockDeviceMappings) (\s :: CreateInstance
s@CreateInstance' {} Maybe [BlockDeviceMapping]
a -> CreateInstance
s {$sel:blockDeviceMappings:CreateInstance' :: Maybe [BlockDeviceMapping]
blockDeviceMappings = Maybe [BlockDeviceMapping]
a} :: CreateInstance) 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 create an Amazon EBS-optimized instance.
createInstance_ebsOptimized :: Lens.Lens' CreateInstance (Prelude.Maybe Prelude.Bool)
createInstance_ebsOptimized :: Lens' CreateInstance (Maybe Bool)
createInstance_ebsOptimized = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateInstance' {Maybe Bool
ebsOptimized :: Maybe Bool
$sel:ebsOptimized:CreateInstance' :: CreateInstance -> Maybe Bool
ebsOptimized} -> Maybe Bool
ebsOptimized) (\s :: CreateInstance
s@CreateInstance' {} Maybe Bool
a -> CreateInstance
s {$sel:ebsOptimized:CreateInstance' :: Maybe Bool
ebsOptimized = Maybe Bool
a} :: CreateInstance)

-- | The instance host name.
createInstance_hostname :: Lens.Lens' CreateInstance (Prelude.Maybe Prelude.Text)
createInstance_hostname :: Lens' CreateInstance (Maybe Text)
createInstance_hostname = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateInstance' {Maybe Text
hostname :: Maybe Text
$sel:hostname:CreateInstance' :: CreateInstance -> Maybe Text
hostname} -> Maybe Text
hostname) (\s :: CreateInstance
s@CreateInstance' {} Maybe Text
a -> CreateInstance
s {$sel:hostname:CreateInstance' :: Maybe Text
hostname = Maybe Text
a} :: CreateInstance)

-- | 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.
--
-- We strongly recommend using the default value of @true@ to ensure that
-- your instances have the latest security updates.
createInstance_installUpdatesOnBoot :: Lens.Lens' CreateInstance (Prelude.Maybe Prelude.Bool)
createInstance_installUpdatesOnBoot :: Lens' CreateInstance (Maybe Bool)
createInstance_installUpdatesOnBoot = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateInstance' {Maybe Bool
installUpdatesOnBoot :: Maybe Bool
$sel:installUpdatesOnBoot:CreateInstance' :: CreateInstance -> Maybe Bool
installUpdatesOnBoot} -> Maybe Bool
installUpdatesOnBoot) (\s :: CreateInstance
s@CreateInstance' {} Maybe Bool
a -> CreateInstance
s {$sel:installUpdatesOnBoot:CreateInstance' :: Maybe Bool
installUpdatesOnBoot = Maybe Bool
a} :: CreateInstance)

-- | The instance\'s operating system, which must be set to one of the
-- following.
--
-- -   A supported Linux operating system: An Amazon Linux version, such as
--     @Amazon Linux 2018.03@, @Amazon Linux 2017.09@,
--     @Amazon Linux 2017.03@, @Amazon Linux 2016.09@,
--     @Amazon Linux 2016.03@, @Amazon Linux 2015.09@, or
--     @Amazon Linux 2015.03@.
--
-- -   A supported Ubuntu operating system, such as @Ubuntu 16.04 LTS@,
--     @Ubuntu 14.04 LTS@, or @Ubuntu 12.04 LTS@.
--
-- -   @CentOS Linux 7@
--
-- -   @Red Hat Enterprise Linux 7@
--
-- -   A supported Windows operating system, such as
--     @Microsoft Windows Server 2012 R2 Base@,
--     @Microsoft Windows Server 2012 R2 with SQL Server Express@,
--     @Microsoft Windows Server 2012 R2 with SQL Server Standard@, or
--     @Microsoft Windows Server 2012 R2 with SQL Server Web@.
--
-- -   A custom AMI: @Custom@.
--
-- For more information about the supported operating systems, see
-- <https://docs.aws.amazon.com/opsworks/latest/userguide/workinginstances-os.html AWS OpsWorks Stacks Operating Systems>.
--
-- The default option is the current Amazon Linux version. If you set this
-- parameter to @Custom@, you must use the CreateInstance action\'s AmiId
-- parameter to specify the custom AMI that you want to use. Block device
-- mappings are not supported if the value is @Custom@. For more
-- information about supported operating systems, see
-- <https://docs.aws.amazon.com/opsworks/latest/userguide/workinginstances-os.html Operating Systems>For
-- more information about how to use custom AMIs with AWS OpsWorks Stacks,
-- see
-- <https://docs.aws.amazon.com/opsworks/latest/userguide/workinginstances-custom-ami.html Using Custom AMIs>.
createInstance_os :: Lens.Lens' CreateInstance (Prelude.Maybe Prelude.Text)
createInstance_os :: Lens' CreateInstance (Maybe Text)
createInstance_os = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateInstance' {Maybe Text
os :: Maybe Text
$sel:os:CreateInstance' :: CreateInstance -> Maybe Text
os} -> Maybe Text
os) (\s :: CreateInstance
s@CreateInstance' {} Maybe Text
a -> CreateInstance
s {$sel:os:CreateInstance' :: Maybe Text
os = Maybe Text
a} :: CreateInstance)

-- | The instance root device type. For more information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/ComponentsAMIs.html#storage-for-the-root-device Storage for the Root Device>.
createInstance_rootDeviceType :: Lens.Lens' CreateInstance (Prelude.Maybe RootDeviceType)
createInstance_rootDeviceType :: Lens' CreateInstance (Maybe RootDeviceType)
createInstance_rootDeviceType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateInstance' {Maybe RootDeviceType
rootDeviceType :: Maybe RootDeviceType
$sel:rootDeviceType:CreateInstance' :: CreateInstance -> Maybe RootDeviceType
rootDeviceType} -> Maybe RootDeviceType
rootDeviceType) (\s :: CreateInstance
s@CreateInstance' {} Maybe RootDeviceType
a -> CreateInstance
s {$sel:rootDeviceType:CreateInstance' :: Maybe RootDeviceType
rootDeviceType = Maybe RootDeviceType
a} :: CreateInstance)

-- | The instance\'s Amazon EC2 key-pair name.
createInstance_sshKeyName :: Lens.Lens' CreateInstance (Prelude.Maybe Prelude.Text)
createInstance_sshKeyName :: Lens' CreateInstance (Maybe Text)
createInstance_sshKeyName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateInstance' {Maybe Text
sshKeyName :: Maybe Text
$sel:sshKeyName:CreateInstance' :: CreateInstance -> Maybe Text
sshKeyName} -> Maybe Text
sshKeyName) (\s :: CreateInstance
s@CreateInstance' {} Maybe Text
a -> CreateInstance
s {$sel:sshKeyName:CreateInstance' :: Maybe Text
sshKeyName = Maybe Text
a} :: CreateInstance)

-- | The ID of the instance\'s subnet. If the stack is running in a VPC, you
-- can use this parameter to override the stack\'s default subnet ID value
-- and direct AWS OpsWorks Stacks to launch the instance in a different
-- subnet.
createInstance_subnetId :: Lens.Lens' CreateInstance (Prelude.Maybe Prelude.Text)
createInstance_subnetId :: Lens' CreateInstance (Maybe Text)
createInstance_subnetId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateInstance' {Maybe Text
subnetId :: Maybe Text
$sel:subnetId:CreateInstance' :: CreateInstance -> Maybe Text
subnetId} -> Maybe Text
subnetId) (\s :: CreateInstance
s@CreateInstance' {} Maybe Text
a -> CreateInstance
s {$sel:subnetId:CreateInstance' :: Maybe Text
subnetId = Maybe Text
a} :: CreateInstance)

-- | The instance\'s tenancy option. The default option is no tenancy, or if
-- the instance is running in a VPC, inherit tenancy settings from the VPC.
-- The following are valid values for this parameter: @dedicated@,
-- @default@, or @host@. Because there are costs associated with changes in
-- tenancy options, we recommend that you research tenancy options before
-- choosing them for your instances. For more information about dedicated
-- hosts, see
-- <http://aws.amazon.com/ec2/dedicated-hosts/ Dedicated Hosts Overview>
-- and
-- <http://aws.amazon.com/ec2/dedicated-hosts/ Amazon EC2 Dedicated Hosts>.
-- For more information about dedicated instances, see
-- <https://docs.aws.amazon.com/AmazonVPC/latest/UserGuide/dedicated-instance.html Dedicated Instances>
-- and
-- <http://aws.amazon.com/ec2/purchasing-options/dedicated-instances/ Amazon EC2 Dedicated Instances>.
createInstance_tenancy :: Lens.Lens' CreateInstance (Prelude.Maybe Prelude.Text)
createInstance_tenancy :: Lens' CreateInstance (Maybe Text)
createInstance_tenancy = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateInstance' {Maybe Text
tenancy :: Maybe Text
$sel:tenancy:CreateInstance' :: CreateInstance -> Maybe Text
tenancy} -> Maybe Text
tenancy) (\s :: CreateInstance
s@CreateInstance' {} Maybe Text
a -> CreateInstance
s {$sel:tenancy:CreateInstance' :: Maybe Text
tenancy = Maybe Text
a} :: CreateInstance)

-- | The instance\'s virtualization type, @paravirtual@ or @hvm@.
createInstance_virtualizationType :: Lens.Lens' CreateInstance (Prelude.Maybe Prelude.Text)
createInstance_virtualizationType :: Lens' CreateInstance (Maybe Text)
createInstance_virtualizationType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateInstance' {Maybe Text
virtualizationType :: Maybe Text
$sel:virtualizationType:CreateInstance' :: CreateInstance -> Maybe Text
virtualizationType} -> Maybe Text
virtualizationType) (\s :: CreateInstance
s@CreateInstance' {} Maybe Text
a -> CreateInstance
s {$sel:virtualizationType:CreateInstance' :: Maybe Text
virtualizationType = Maybe Text
a} :: CreateInstance)

-- | The stack ID.
createInstance_stackId :: Lens.Lens' CreateInstance Prelude.Text
createInstance_stackId :: Lens' CreateInstance Text
createInstance_stackId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateInstance' {Text
stackId :: Text
$sel:stackId:CreateInstance' :: CreateInstance -> Text
stackId} -> Text
stackId) (\s :: CreateInstance
s@CreateInstance' {} Text
a -> CreateInstance
s {$sel:stackId:CreateInstance' :: Text
stackId = Text
a} :: CreateInstance)

-- | An array that contains the instance\'s layer IDs.
createInstance_layerIds :: Lens.Lens' CreateInstance [Prelude.Text]
createInstance_layerIds :: Lens' CreateInstance [Text]
createInstance_layerIds = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateInstance' {[Text]
layerIds :: [Text]
$sel:layerIds:CreateInstance' :: CreateInstance -> [Text]
layerIds} -> [Text]
layerIds) (\s :: CreateInstance
s@CreateInstance' {} [Text]
a -> CreateInstance
s {$sel:layerIds:CreateInstance' :: [Text]
layerIds = [Text]
a} :: CreateInstance) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | The instance type, such as @t2.micro@. For a list of supported instance
-- types, open the stack in the console, choose __Instances__, and choose
-- __+ Instance__. The __Size__ list contains the currently supported
-- types. For more information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/instance-types.html Instance Families and Types>.
-- The parameter values that you use to specify the various types are in
-- the __API Name__ column of the __Available Instance Types__ table.
createInstance_instanceType :: Lens.Lens' CreateInstance Prelude.Text
createInstance_instanceType :: Lens' CreateInstance Text
createInstance_instanceType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateInstance' {Text
instanceType :: Text
$sel:instanceType:CreateInstance' :: CreateInstance -> Text
instanceType} -> Text
instanceType) (\s :: CreateInstance
s@CreateInstance' {} Text
a -> CreateInstance
s {$sel:instanceType:CreateInstance' :: Text
instanceType = Text
a} :: CreateInstance)

instance Core.AWSRequest CreateInstance where
  type
    AWSResponse CreateInstance =
      CreateInstanceResponse
  request :: (Service -> Service) -> CreateInstance -> Request CreateInstance
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 CreateInstance
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CreateInstance)))
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 -> CreateInstanceResponse
CreateInstanceResponse'
            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
"InstanceId")
            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 CreateInstance where
  hashWithSalt :: Int -> CreateInstance -> Int
hashWithSalt Int
_salt CreateInstance' {[Text]
Maybe Bool
Maybe [BlockDeviceMapping]
Maybe Text
Maybe Architecture
Maybe AutoScalingType
Maybe RootDeviceType
Text
instanceType :: Text
layerIds :: [Text]
stackId :: Text
virtualizationType :: Maybe Text
tenancy :: Maybe Text
subnetId :: Maybe Text
sshKeyName :: Maybe Text
rootDeviceType :: Maybe RootDeviceType
os :: Maybe Text
installUpdatesOnBoot :: Maybe Bool
hostname :: Maybe Text
ebsOptimized :: Maybe Bool
blockDeviceMappings :: Maybe [BlockDeviceMapping]
availabilityZone :: Maybe Text
autoScalingType :: Maybe AutoScalingType
architecture :: Maybe Architecture
amiId :: Maybe Text
agentVersion :: Maybe Text
$sel:instanceType:CreateInstance' :: CreateInstance -> Text
$sel:layerIds:CreateInstance' :: CreateInstance -> [Text]
$sel:stackId:CreateInstance' :: CreateInstance -> Text
$sel:virtualizationType:CreateInstance' :: CreateInstance -> Maybe Text
$sel:tenancy:CreateInstance' :: CreateInstance -> Maybe Text
$sel:subnetId:CreateInstance' :: CreateInstance -> Maybe Text
$sel:sshKeyName:CreateInstance' :: CreateInstance -> Maybe Text
$sel:rootDeviceType:CreateInstance' :: CreateInstance -> Maybe RootDeviceType
$sel:os:CreateInstance' :: CreateInstance -> Maybe Text
$sel:installUpdatesOnBoot:CreateInstance' :: CreateInstance -> Maybe Bool
$sel:hostname:CreateInstance' :: CreateInstance -> Maybe Text
$sel:ebsOptimized:CreateInstance' :: CreateInstance -> Maybe Bool
$sel:blockDeviceMappings:CreateInstance' :: CreateInstance -> Maybe [BlockDeviceMapping]
$sel:availabilityZone:CreateInstance' :: CreateInstance -> Maybe Text
$sel:autoScalingType:CreateInstance' :: CreateInstance -> Maybe AutoScalingType
$sel:architecture:CreateInstance' :: CreateInstance -> Maybe Architecture
$sel:amiId:CreateInstance' :: CreateInstance -> Maybe Text
$sel:agentVersion:CreateInstance' :: CreateInstance -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
agentVersion
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
amiId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Architecture
architecture
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe AutoScalingType
autoScalingType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
availabilityZone
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [BlockDeviceMapping]
blockDeviceMappings
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
ebsOptimized
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
hostname
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
installUpdatesOnBoot
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
os
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe RootDeviceType
rootDeviceType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
sshKeyName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
subnetId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
tenancy
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
virtualizationType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
stackId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` [Text]
layerIds
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
instanceType

instance Prelude.NFData CreateInstance where
  rnf :: CreateInstance -> ()
rnf CreateInstance' {[Text]
Maybe Bool
Maybe [BlockDeviceMapping]
Maybe Text
Maybe Architecture
Maybe AutoScalingType
Maybe RootDeviceType
Text
instanceType :: Text
layerIds :: [Text]
stackId :: Text
virtualizationType :: Maybe Text
tenancy :: Maybe Text
subnetId :: Maybe Text
sshKeyName :: Maybe Text
rootDeviceType :: Maybe RootDeviceType
os :: Maybe Text
installUpdatesOnBoot :: Maybe Bool
hostname :: Maybe Text
ebsOptimized :: Maybe Bool
blockDeviceMappings :: Maybe [BlockDeviceMapping]
availabilityZone :: Maybe Text
autoScalingType :: Maybe AutoScalingType
architecture :: Maybe Architecture
amiId :: Maybe Text
agentVersion :: Maybe Text
$sel:instanceType:CreateInstance' :: CreateInstance -> Text
$sel:layerIds:CreateInstance' :: CreateInstance -> [Text]
$sel:stackId:CreateInstance' :: CreateInstance -> Text
$sel:virtualizationType:CreateInstance' :: CreateInstance -> Maybe Text
$sel:tenancy:CreateInstance' :: CreateInstance -> Maybe Text
$sel:subnetId:CreateInstance' :: CreateInstance -> Maybe Text
$sel:sshKeyName:CreateInstance' :: CreateInstance -> Maybe Text
$sel:rootDeviceType:CreateInstance' :: CreateInstance -> Maybe RootDeviceType
$sel:os:CreateInstance' :: CreateInstance -> Maybe Text
$sel:installUpdatesOnBoot:CreateInstance' :: CreateInstance -> Maybe Bool
$sel:hostname:CreateInstance' :: CreateInstance -> Maybe Text
$sel:ebsOptimized:CreateInstance' :: CreateInstance -> Maybe Bool
$sel:blockDeviceMappings:CreateInstance' :: CreateInstance -> Maybe [BlockDeviceMapping]
$sel:availabilityZone:CreateInstance' :: CreateInstance -> Maybe Text
$sel:autoScalingType:CreateInstance' :: CreateInstance -> Maybe AutoScalingType
$sel:architecture:CreateInstance' :: CreateInstance -> Maybe Architecture
$sel:amiId:CreateInstance' :: CreateInstance -> Maybe Text
$sel:agentVersion:CreateInstance' :: CreateInstance -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
agentVersion
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
amiId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Architecture
architecture
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe AutoScalingType
autoScalingType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
availabilityZone
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [BlockDeviceMapping]
blockDeviceMappings
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
ebsOptimized
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
hostname
      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 Text
os
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe RootDeviceType
rootDeviceType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
sshKeyName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
subnetId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
tenancy
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
virtualizationType
      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 [Text]
layerIds
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
instanceType

instance Data.ToHeaders CreateInstance where
  toHeaders :: CreateInstance -> 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.CreateInstance" ::
                          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 CreateInstance where
  toJSON :: CreateInstance -> Value
toJSON CreateInstance' {[Text]
Maybe Bool
Maybe [BlockDeviceMapping]
Maybe Text
Maybe Architecture
Maybe AutoScalingType
Maybe RootDeviceType
Text
instanceType :: Text
layerIds :: [Text]
stackId :: Text
virtualizationType :: Maybe Text
tenancy :: Maybe Text
subnetId :: Maybe Text
sshKeyName :: Maybe Text
rootDeviceType :: Maybe RootDeviceType
os :: Maybe Text
installUpdatesOnBoot :: Maybe Bool
hostname :: Maybe Text
ebsOptimized :: Maybe Bool
blockDeviceMappings :: Maybe [BlockDeviceMapping]
availabilityZone :: Maybe Text
autoScalingType :: Maybe AutoScalingType
architecture :: Maybe Architecture
amiId :: Maybe Text
agentVersion :: Maybe Text
$sel:instanceType:CreateInstance' :: CreateInstance -> Text
$sel:layerIds:CreateInstance' :: CreateInstance -> [Text]
$sel:stackId:CreateInstance' :: CreateInstance -> Text
$sel:virtualizationType:CreateInstance' :: CreateInstance -> Maybe Text
$sel:tenancy:CreateInstance' :: CreateInstance -> Maybe Text
$sel:subnetId:CreateInstance' :: CreateInstance -> Maybe Text
$sel:sshKeyName:CreateInstance' :: CreateInstance -> Maybe Text
$sel:rootDeviceType:CreateInstance' :: CreateInstance -> Maybe RootDeviceType
$sel:os:CreateInstance' :: CreateInstance -> Maybe Text
$sel:installUpdatesOnBoot:CreateInstance' :: CreateInstance -> Maybe Bool
$sel:hostname:CreateInstance' :: CreateInstance -> Maybe Text
$sel:ebsOptimized:CreateInstance' :: CreateInstance -> Maybe Bool
$sel:blockDeviceMappings:CreateInstance' :: CreateInstance -> Maybe [BlockDeviceMapping]
$sel:availabilityZone:CreateInstance' :: CreateInstance -> Maybe Text
$sel:autoScalingType:CreateInstance' :: CreateInstance -> Maybe AutoScalingType
$sel:architecture:CreateInstance' :: CreateInstance -> Maybe Architecture
$sel:amiId:CreateInstance' :: CreateInstance -> Maybe Text
$sel:agentVersion:CreateInstance' :: CreateInstance -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"AgentVersion" 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
agentVersion,
            (Key
"AmiId" 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
amiId,
            (Key
"Architecture" 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 Architecture
architecture,
            (Key
"AutoScalingType" 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 AutoScalingType
autoScalingType,
            (Key
"AvailabilityZone" 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
availabilityZone,
            (Key
"BlockDeviceMappings" 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 [BlockDeviceMapping]
blockDeviceMappings,
            (Key
"EbsOptimized" 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
ebsOptimized,
            (Key
"Hostname" 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
hostname,
            (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
"Os" 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
os,
            (Key
"RootDeviceType" 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 RootDeviceType
rootDeviceType,
            (Key
"SshKeyName" 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
sshKeyName,
            (Key
"SubnetId" 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
subnetId,
            (Key
"Tenancy" 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
tenancy,
            (Key
"VirtualizationType" 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
virtualizationType,
            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
"LayerIds" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= [Text]
layerIds),
            forall a. a -> Maybe a
Prelude.Just (Key
"InstanceType" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
instanceType)
          ]
      )

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

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

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

-- |
-- Create a value of 'CreateInstanceResponse' 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:
--
-- 'instanceId', 'createInstanceResponse_instanceId' - The instance ID.
--
-- 'httpStatus', 'createInstanceResponse_httpStatus' - The response's http status code.
newCreateInstanceResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateInstanceResponse
newCreateInstanceResponse :: Int -> CreateInstanceResponse
newCreateInstanceResponse Int
pHttpStatus_ =
  CreateInstanceResponse'
    { $sel:instanceId:CreateInstanceResponse' :: Maybe Text
instanceId =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateInstanceResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The instance ID.
createInstanceResponse_instanceId :: Lens.Lens' CreateInstanceResponse (Prelude.Maybe Prelude.Text)
createInstanceResponse_instanceId :: Lens' CreateInstanceResponse (Maybe Text)
createInstanceResponse_instanceId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateInstanceResponse' {Maybe Text
instanceId :: Maybe Text
$sel:instanceId:CreateInstanceResponse' :: CreateInstanceResponse -> Maybe Text
instanceId} -> Maybe Text
instanceId) (\s :: CreateInstanceResponse
s@CreateInstanceResponse' {} Maybe Text
a -> CreateInstanceResponse
s {$sel:instanceId:CreateInstanceResponse' :: Maybe Text
instanceId = Maybe Text
a} :: CreateInstanceResponse)

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

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