{-# 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.EC2.ModifyInstanceAttribute
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Modifies the specified attribute of the specified instance. You can
-- specify only one attribute at a time.
--
-- __Note:__ Using this action to change the security groups associated
-- with an elastic network interface (ENI) attached to an instance in a VPC
-- can result in an error if the instance has more than one ENI. To change
-- the security groups associated with an ENI attached to an instance that
-- has multiple ENIs, we recommend that you use the
-- ModifyNetworkInterfaceAttribute action.
--
-- To modify some attributes, the instance must be stopped. For more
-- information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/Using_ChangingAttributesWhileInstanceStopped.html Modify a stopped instance>
-- in the /Amazon EC2 User Guide/.
module Amazonka.EC2.ModifyInstanceAttribute
  ( -- * Creating a Request
    ModifyInstanceAttribute (..),
    newModifyInstanceAttribute,

    -- * Request Lenses
    modifyInstanceAttribute_attribute,
    modifyInstanceAttribute_blockDeviceMappings,
    modifyInstanceAttribute_disableApiStop,
    modifyInstanceAttribute_disableApiTermination,
    modifyInstanceAttribute_dryRun,
    modifyInstanceAttribute_ebsOptimized,
    modifyInstanceAttribute_enaSupport,
    modifyInstanceAttribute_groups,
    modifyInstanceAttribute_instanceInitiatedShutdownBehavior,
    modifyInstanceAttribute_instanceType,
    modifyInstanceAttribute_kernel,
    modifyInstanceAttribute_ramdisk,
    modifyInstanceAttribute_sourceDestCheck,
    modifyInstanceAttribute_sriovNetSupport,
    modifyInstanceAttribute_userData,
    modifyInstanceAttribute_value,
    modifyInstanceAttribute_instanceId,

    -- * Destructuring the Response
    ModifyInstanceAttributeResponse (..),
    newModifyInstanceAttributeResponse,
  )
where

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

-- | /See:/ 'newModifyInstanceAttribute' smart constructor.
data ModifyInstanceAttribute = ModifyInstanceAttribute'
  { -- | The name of the attribute to modify.
    --
    -- You can modify the following attributes only: @disableApiTermination@ |
    -- @instanceType@ | @kernel@ | @ramdisk@ |
    -- @instanceInitiatedShutdownBehavior@ | @blockDeviceMapping@ | @userData@
    -- | @sourceDestCheck@ | @groupSet@ | @ebsOptimized@ | @sriovNetSupport@ |
    -- @enaSupport@ | @nvmeSupport@ | @disableApiStop@ | @enclaveOptions@
    ModifyInstanceAttribute -> Maybe InstanceAttributeName
attribute :: Prelude.Maybe InstanceAttributeName,
    -- | Modifies the @DeleteOnTermination@ attribute for volumes that are
    -- currently attached. The volume must be owned by the caller. If no value
    -- is specified for @DeleteOnTermination@, the default is @true@ and the
    -- volume is deleted when the instance is terminated.
    --
    -- To add instance store volumes to an Amazon EBS-backed instance, you must
    -- add them when you launch the instance. For more information, see
    -- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/block-device-mapping-concepts.html#Using_OverridingAMIBDM Update the block device mapping when launching an instance>
    -- in the /Amazon EC2 User Guide/.
    ModifyInstanceAttribute
-> Maybe [InstanceBlockDeviceMappingSpecification]
blockDeviceMappings :: Prelude.Maybe [InstanceBlockDeviceMappingSpecification],
    -- | Indicates whether an instance is enabled for stop protection. For more
    -- information, see
    -- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/Stop_Start.html#Using_StopProtection Stop Protection>.
    ModifyInstanceAttribute -> Maybe AttributeBooleanValue
disableApiStop :: Prelude.Maybe AttributeBooleanValue,
    -- | If the value is @true@, you can\'t terminate the instance using the
    -- Amazon EC2 console, CLI, or API; otherwise, you can. You cannot use this
    -- parameter for Spot Instances.
    ModifyInstanceAttribute -> Maybe AttributeBooleanValue
disableApiTermination :: Prelude.Maybe AttributeBooleanValue,
    -- | Checks whether you have the required permissions for the action, without
    -- actually making the request, and provides an error response. If you have
    -- the required permissions, the error response is @DryRunOperation@.
    -- Otherwise, it is @UnauthorizedOperation@.
    ModifyInstanceAttribute -> Maybe Bool
dryRun :: Prelude.Maybe Prelude.Bool,
    -- | Specifies whether the instance is optimized for Amazon EBS I\/O. This
    -- optimization provides dedicated throughput to Amazon EBS and an
    -- optimized configuration stack to provide optimal EBS I\/O performance.
    -- This optimization isn\'t available with all instance types. Additional
    -- usage charges apply when using an EBS Optimized instance.
    ModifyInstanceAttribute -> Maybe AttributeBooleanValue
ebsOptimized :: Prelude.Maybe AttributeBooleanValue,
    -- | Set to @true@ to enable enhanced networking with ENA for the instance.
    --
    -- This option is supported only for HVM instances. Specifying this option
    -- with a PV instance can make it unreachable.
    ModifyInstanceAttribute -> Maybe AttributeBooleanValue
enaSupport :: Prelude.Maybe AttributeBooleanValue,
    -- | [EC2-VPC] Replaces the security groups of the instance with the
    -- specified security groups. You must specify at least one security group,
    -- even if it\'s just the default security group for the VPC. You must
    -- specify the security group ID, not the security group name.
    ModifyInstanceAttribute -> Maybe [Text]
groups :: Prelude.Maybe [Prelude.Text],
    -- | Specifies whether an instance stops or terminates when you initiate
    -- shutdown from the instance (using the operating system command for
    -- system shutdown).
    ModifyInstanceAttribute -> Maybe AttributeValue
instanceInitiatedShutdownBehavior :: Prelude.Maybe AttributeValue,
    -- | Changes the instance type to the specified value. For more information,
    -- see
    -- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/instance-types.html Instance types>
    -- in the /Amazon EC2 User Guide/. If the instance type is not valid, the
    -- error returned is @InvalidInstanceAttributeValue@.
    ModifyInstanceAttribute -> Maybe AttributeValue
instanceType :: Prelude.Maybe AttributeValue,
    -- | Changes the instance\'s kernel to the specified value. We recommend that
    -- you use PV-GRUB instead of kernels and RAM disks. For more information,
    -- see
    -- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/UserProvidedKernels.html PV-GRUB>.
    ModifyInstanceAttribute -> Maybe AttributeValue
kernel :: Prelude.Maybe AttributeValue,
    -- | Changes the instance\'s RAM disk to the specified value. We recommend
    -- that you use PV-GRUB instead of kernels and RAM disks. For more
    -- information, see
    -- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/UserProvidedKernels.html PV-GRUB>.
    ModifyInstanceAttribute -> Maybe AttributeValue
ramdisk :: Prelude.Maybe AttributeValue,
    -- | Enable or disable source\/destination checks, which ensure that the
    -- instance is either the source or the destination of any traffic that it
    -- receives. If the value is @true@, source\/destination checks are
    -- enabled; otherwise, they are disabled. The default value is @true@. You
    -- must disable source\/destination checks if the instance runs services
    -- such as network address translation, routing, or firewalls.
    ModifyInstanceAttribute -> Maybe AttributeBooleanValue
sourceDestCheck :: Prelude.Maybe AttributeBooleanValue,
    -- | Set to @simple@ to enable enhanced networking with the Intel 82599
    -- Virtual Function interface for the instance.
    --
    -- There is no way to disable enhanced networking with the Intel 82599
    -- Virtual Function interface at this time.
    --
    -- This option is supported only for HVM instances. Specifying this option
    -- with a PV instance can make it unreachable.
    ModifyInstanceAttribute -> Maybe AttributeValue
sriovNetSupport :: Prelude.Maybe AttributeValue,
    -- | Changes the instance\'s user data to the specified value. If you are
    -- using an Amazon Web Services SDK or command line tool, base64-encoding
    -- is performed for you, and you can load the text from a file. Otherwise,
    -- you must provide base64-encoded text.
    ModifyInstanceAttribute -> Maybe BlobAttributeValue
userData :: Prelude.Maybe BlobAttributeValue,
    -- | A new value for the attribute. Use only with the @kernel@, @ramdisk@,
    -- @userData@, @disableApiTermination@, or
    -- @instanceInitiatedShutdownBehavior@ attribute.
    ModifyInstanceAttribute -> Maybe Text
value :: Prelude.Maybe Prelude.Text,
    -- | The ID of the instance.
    ModifyInstanceAttribute -> Text
instanceId :: Prelude.Text
  }
  deriving (ModifyInstanceAttribute -> ModifyInstanceAttribute -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModifyInstanceAttribute -> ModifyInstanceAttribute -> Bool
$c/= :: ModifyInstanceAttribute -> ModifyInstanceAttribute -> Bool
== :: ModifyInstanceAttribute -> ModifyInstanceAttribute -> Bool
$c== :: ModifyInstanceAttribute -> ModifyInstanceAttribute -> Bool
Prelude.Eq, ReadPrec [ModifyInstanceAttribute]
ReadPrec ModifyInstanceAttribute
Int -> ReadS ModifyInstanceAttribute
ReadS [ModifyInstanceAttribute]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ModifyInstanceAttribute]
$creadListPrec :: ReadPrec [ModifyInstanceAttribute]
readPrec :: ReadPrec ModifyInstanceAttribute
$creadPrec :: ReadPrec ModifyInstanceAttribute
readList :: ReadS [ModifyInstanceAttribute]
$creadList :: ReadS [ModifyInstanceAttribute]
readsPrec :: Int -> ReadS ModifyInstanceAttribute
$creadsPrec :: Int -> ReadS ModifyInstanceAttribute
Prelude.Read, Int -> ModifyInstanceAttribute -> ShowS
[ModifyInstanceAttribute] -> ShowS
ModifyInstanceAttribute -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ModifyInstanceAttribute] -> ShowS
$cshowList :: [ModifyInstanceAttribute] -> ShowS
show :: ModifyInstanceAttribute -> String
$cshow :: ModifyInstanceAttribute -> String
showsPrec :: Int -> ModifyInstanceAttribute -> ShowS
$cshowsPrec :: Int -> ModifyInstanceAttribute -> ShowS
Prelude.Show, forall x. Rep ModifyInstanceAttribute x -> ModifyInstanceAttribute
forall x. ModifyInstanceAttribute -> Rep ModifyInstanceAttribute x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ModifyInstanceAttribute x -> ModifyInstanceAttribute
$cfrom :: forall x. ModifyInstanceAttribute -> Rep ModifyInstanceAttribute x
Prelude.Generic)

-- |
-- Create a value of 'ModifyInstanceAttribute' 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:
--
-- 'attribute', 'modifyInstanceAttribute_attribute' - The name of the attribute to modify.
--
-- You can modify the following attributes only: @disableApiTermination@ |
-- @instanceType@ | @kernel@ | @ramdisk@ |
-- @instanceInitiatedShutdownBehavior@ | @blockDeviceMapping@ | @userData@
-- | @sourceDestCheck@ | @groupSet@ | @ebsOptimized@ | @sriovNetSupport@ |
-- @enaSupport@ | @nvmeSupport@ | @disableApiStop@ | @enclaveOptions@
--
-- 'blockDeviceMappings', 'modifyInstanceAttribute_blockDeviceMappings' - Modifies the @DeleteOnTermination@ attribute for volumes that are
-- currently attached. The volume must be owned by the caller. If no value
-- is specified for @DeleteOnTermination@, the default is @true@ and the
-- volume is deleted when the instance is terminated.
--
-- To add instance store volumes to an Amazon EBS-backed instance, you must
-- add them when you launch the instance. For more information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/block-device-mapping-concepts.html#Using_OverridingAMIBDM Update the block device mapping when launching an instance>
-- in the /Amazon EC2 User Guide/.
--
-- 'disableApiStop', 'modifyInstanceAttribute_disableApiStop' - Indicates whether an instance is enabled for stop protection. For more
-- information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/Stop_Start.html#Using_StopProtection Stop Protection>.
--
-- 'disableApiTermination', 'modifyInstanceAttribute_disableApiTermination' - If the value is @true@, you can\'t terminate the instance using the
-- Amazon EC2 console, CLI, or API; otherwise, you can. You cannot use this
-- parameter for Spot Instances.
--
-- 'dryRun', 'modifyInstanceAttribute_dryRun' - Checks whether you have the required permissions for the action, without
-- actually making the request, and provides an error response. If you have
-- the required permissions, the error response is @DryRunOperation@.
-- Otherwise, it is @UnauthorizedOperation@.
--
-- 'ebsOptimized', 'modifyInstanceAttribute_ebsOptimized' - Specifies whether the instance is optimized for Amazon EBS I\/O. This
-- optimization provides dedicated throughput to Amazon EBS and an
-- optimized configuration stack to provide optimal EBS I\/O performance.
-- This optimization isn\'t available with all instance types. Additional
-- usage charges apply when using an EBS Optimized instance.
--
-- 'enaSupport', 'modifyInstanceAttribute_enaSupport' - Set to @true@ to enable enhanced networking with ENA for the instance.
--
-- This option is supported only for HVM instances. Specifying this option
-- with a PV instance can make it unreachable.
--
-- 'groups', 'modifyInstanceAttribute_groups' - [EC2-VPC] Replaces the security groups of the instance with the
-- specified security groups. You must specify at least one security group,
-- even if it\'s just the default security group for the VPC. You must
-- specify the security group ID, not the security group name.
--
-- 'instanceInitiatedShutdownBehavior', 'modifyInstanceAttribute_instanceInitiatedShutdownBehavior' - Specifies whether an instance stops or terminates when you initiate
-- shutdown from the instance (using the operating system command for
-- system shutdown).
--
-- 'instanceType', 'modifyInstanceAttribute_instanceType' - Changes the instance type to the specified value. For more information,
-- see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/instance-types.html Instance types>
-- in the /Amazon EC2 User Guide/. If the instance type is not valid, the
-- error returned is @InvalidInstanceAttributeValue@.
--
-- 'kernel', 'modifyInstanceAttribute_kernel' - Changes the instance\'s kernel to the specified value. We recommend that
-- you use PV-GRUB instead of kernels and RAM disks. For more information,
-- see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/UserProvidedKernels.html PV-GRUB>.
--
-- 'ramdisk', 'modifyInstanceAttribute_ramdisk' - Changes the instance\'s RAM disk to the specified value. We recommend
-- that you use PV-GRUB instead of kernels and RAM disks. For more
-- information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/UserProvidedKernels.html PV-GRUB>.
--
-- 'sourceDestCheck', 'modifyInstanceAttribute_sourceDestCheck' - Enable or disable source\/destination checks, which ensure that the
-- instance is either the source or the destination of any traffic that it
-- receives. If the value is @true@, source\/destination checks are
-- enabled; otherwise, they are disabled. The default value is @true@. You
-- must disable source\/destination checks if the instance runs services
-- such as network address translation, routing, or firewalls.
--
-- 'sriovNetSupport', 'modifyInstanceAttribute_sriovNetSupport' - Set to @simple@ to enable enhanced networking with the Intel 82599
-- Virtual Function interface for the instance.
--
-- There is no way to disable enhanced networking with the Intel 82599
-- Virtual Function interface at this time.
--
-- This option is supported only for HVM instances. Specifying this option
-- with a PV instance can make it unreachable.
--
-- 'userData', 'modifyInstanceAttribute_userData' - Changes the instance\'s user data to the specified value. If you are
-- using an Amazon Web Services SDK or command line tool, base64-encoding
-- is performed for you, and you can load the text from a file. Otherwise,
-- you must provide base64-encoded text.
--
-- 'value', 'modifyInstanceAttribute_value' - A new value for the attribute. Use only with the @kernel@, @ramdisk@,
-- @userData@, @disableApiTermination@, or
-- @instanceInitiatedShutdownBehavior@ attribute.
--
-- 'instanceId', 'modifyInstanceAttribute_instanceId' - The ID of the instance.
newModifyInstanceAttribute ::
  -- | 'instanceId'
  Prelude.Text ->
  ModifyInstanceAttribute
newModifyInstanceAttribute :: Text -> ModifyInstanceAttribute
newModifyInstanceAttribute Text
pInstanceId_ =
  ModifyInstanceAttribute'
    { $sel:attribute:ModifyInstanceAttribute' :: Maybe InstanceAttributeName
attribute =
        forall a. Maybe a
Prelude.Nothing,
      $sel:blockDeviceMappings:ModifyInstanceAttribute' :: Maybe [InstanceBlockDeviceMappingSpecification]
blockDeviceMappings = forall a. Maybe a
Prelude.Nothing,
      $sel:disableApiStop:ModifyInstanceAttribute' :: Maybe AttributeBooleanValue
disableApiStop = forall a. Maybe a
Prelude.Nothing,
      $sel:disableApiTermination:ModifyInstanceAttribute' :: Maybe AttributeBooleanValue
disableApiTermination = forall a. Maybe a
Prelude.Nothing,
      $sel:dryRun:ModifyInstanceAttribute' :: Maybe Bool
dryRun = forall a. Maybe a
Prelude.Nothing,
      $sel:ebsOptimized:ModifyInstanceAttribute' :: Maybe AttributeBooleanValue
ebsOptimized = forall a. Maybe a
Prelude.Nothing,
      $sel:enaSupport:ModifyInstanceAttribute' :: Maybe AttributeBooleanValue
enaSupport = forall a. Maybe a
Prelude.Nothing,
      $sel:groups:ModifyInstanceAttribute' :: Maybe [Text]
groups = forall a. Maybe a
Prelude.Nothing,
      $sel:instanceInitiatedShutdownBehavior:ModifyInstanceAttribute' :: Maybe AttributeValue
instanceInitiatedShutdownBehavior =
        forall a. Maybe a
Prelude.Nothing,
      $sel:instanceType:ModifyInstanceAttribute' :: Maybe AttributeValue
instanceType = forall a. Maybe a
Prelude.Nothing,
      $sel:kernel:ModifyInstanceAttribute' :: Maybe AttributeValue
kernel = forall a. Maybe a
Prelude.Nothing,
      $sel:ramdisk:ModifyInstanceAttribute' :: Maybe AttributeValue
ramdisk = forall a. Maybe a
Prelude.Nothing,
      $sel:sourceDestCheck:ModifyInstanceAttribute' :: Maybe AttributeBooleanValue
sourceDestCheck = forall a. Maybe a
Prelude.Nothing,
      $sel:sriovNetSupport:ModifyInstanceAttribute' :: Maybe AttributeValue
sriovNetSupport = forall a. Maybe a
Prelude.Nothing,
      $sel:userData:ModifyInstanceAttribute' :: Maybe BlobAttributeValue
userData = forall a. Maybe a
Prelude.Nothing,
      $sel:value:ModifyInstanceAttribute' :: Maybe Text
value = forall a. Maybe a
Prelude.Nothing,
      $sel:instanceId:ModifyInstanceAttribute' :: Text
instanceId = Text
pInstanceId_
    }

-- | The name of the attribute to modify.
--
-- You can modify the following attributes only: @disableApiTermination@ |
-- @instanceType@ | @kernel@ | @ramdisk@ |
-- @instanceInitiatedShutdownBehavior@ | @blockDeviceMapping@ | @userData@
-- | @sourceDestCheck@ | @groupSet@ | @ebsOptimized@ | @sriovNetSupport@ |
-- @enaSupport@ | @nvmeSupport@ | @disableApiStop@ | @enclaveOptions@
modifyInstanceAttribute_attribute :: Lens.Lens' ModifyInstanceAttribute (Prelude.Maybe InstanceAttributeName)
modifyInstanceAttribute_attribute :: Lens' ModifyInstanceAttribute (Maybe InstanceAttributeName)
modifyInstanceAttribute_attribute = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyInstanceAttribute' {Maybe InstanceAttributeName
attribute :: Maybe InstanceAttributeName
$sel:attribute:ModifyInstanceAttribute' :: ModifyInstanceAttribute -> Maybe InstanceAttributeName
attribute} -> Maybe InstanceAttributeName
attribute) (\s :: ModifyInstanceAttribute
s@ModifyInstanceAttribute' {} Maybe InstanceAttributeName
a -> ModifyInstanceAttribute
s {$sel:attribute:ModifyInstanceAttribute' :: Maybe InstanceAttributeName
attribute = Maybe InstanceAttributeName
a} :: ModifyInstanceAttribute)

-- | Modifies the @DeleteOnTermination@ attribute for volumes that are
-- currently attached. The volume must be owned by the caller. If no value
-- is specified for @DeleteOnTermination@, the default is @true@ and the
-- volume is deleted when the instance is terminated.
--
-- To add instance store volumes to an Amazon EBS-backed instance, you must
-- add them when you launch the instance. For more information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/block-device-mapping-concepts.html#Using_OverridingAMIBDM Update the block device mapping when launching an instance>
-- in the /Amazon EC2 User Guide/.
modifyInstanceAttribute_blockDeviceMappings :: Lens.Lens' ModifyInstanceAttribute (Prelude.Maybe [InstanceBlockDeviceMappingSpecification])
modifyInstanceAttribute_blockDeviceMappings :: Lens'
  ModifyInstanceAttribute
  (Maybe [InstanceBlockDeviceMappingSpecification])
modifyInstanceAttribute_blockDeviceMappings = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyInstanceAttribute' {Maybe [InstanceBlockDeviceMappingSpecification]
blockDeviceMappings :: Maybe [InstanceBlockDeviceMappingSpecification]
$sel:blockDeviceMappings:ModifyInstanceAttribute' :: ModifyInstanceAttribute
-> Maybe [InstanceBlockDeviceMappingSpecification]
blockDeviceMappings} -> Maybe [InstanceBlockDeviceMappingSpecification]
blockDeviceMappings) (\s :: ModifyInstanceAttribute
s@ModifyInstanceAttribute' {} Maybe [InstanceBlockDeviceMappingSpecification]
a -> ModifyInstanceAttribute
s {$sel:blockDeviceMappings:ModifyInstanceAttribute' :: Maybe [InstanceBlockDeviceMappingSpecification]
blockDeviceMappings = Maybe [InstanceBlockDeviceMappingSpecification]
a} :: ModifyInstanceAttribute) 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

-- | Indicates whether an instance is enabled for stop protection. For more
-- information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/Stop_Start.html#Using_StopProtection Stop Protection>.
modifyInstanceAttribute_disableApiStop :: Lens.Lens' ModifyInstanceAttribute (Prelude.Maybe AttributeBooleanValue)
modifyInstanceAttribute_disableApiStop :: Lens' ModifyInstanceAttribute (Maybe AttributeBooleanValue)
modifyInstanceAttribute_disableApiStop = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyInstanceAttribute' {Maybe AttributeBooleanValue
disableApiStop :: Maybe AttributeBooleanValue
$sel:disableApiStop:ModifyInstanceAttribute' :: ModifyInstanceAttribute -> Maybe AttributeBooleanValue
disableApiStop} -> Maybe AttributeBooleanValue
disableApiStop) (\s :: ModifyInstanceAttribute
s@ModifyInstanceAttribute' {} Maybe AttributeBooleanValue
a -> ModifyInstanceAttribute
s {$sel:disableApiStop:ModifyInstanceAttribute' :: Maybe AttributeBooleanValue
disableApiStop = Maybe AttributeBooleanValue
a} :: ModifyInstanceAttribute)

-- | If the value is @true@, you can\'t terminate the instance using the
-- Amazon EC2 console, CLI, or API; otherwise, you can. You cannot use this
-- parameter for Spot Instances.
modifyInstanceAttribute_disableApiTermination :: Lens.Lens' ModifyInstanceAttribute (Prelude.Maybe AttributeBooleanValue)
modifyInstanceAttribute_disableApiTermination :: Lens' ModifyInstanceAttribute (Maybe AttributeBooleanValue)
modifyInstanceAttribute_disableApiTermination = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyInstanceAttribute' {Maybe AttributeBooleanValue
disableApiTermination :: Maybe AttributeBooleanValue
$sel:disableApiTermination:ModifyInstanceAttribute' :: ModifyInstanceAttribute -> Maybe AttributeBooleanValue
disableApiTermination} -> Maybe AttributeBooleanValue
disableApiTermination) (\s :: ModifyInstanceAttribute
s@ModifyInstanceAttribute' {} Maybe AttributeBooleanValue
a -> ModifyInstanceAttribute
s {$sel:disableApiTermination:ModifyInstanceAttribute' :: Maybe AttributeBooleanValue
disableApiTermination = Maybe AttributeBooleanValue
a} :: ModifyInstanceAttribute)

-- | Checks whether you have the required permissions for the action, without
-- actually making the request, and provides an error response. If you have
-- the required permissions, the error response is @DryRunOperation@.
-- Otherwise, it is @UnauthorizedOperation@.
modifyInstanceAttribute_dryRun :: Lens.Lens' ModifyInstanceAttribute (Prelude.Maybe Prelude.Bool)
modifyInstanceAttribute_dryRun :: Lens' ModifyInstanceAttribute (Maybe Bool)
modifyInstanceAttribute_dryRun = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyInstanceAttribute' {Maybe Bool
dryRun :: Maybe Bool
$sel:dryRun:ModifyInstanceAttribute' :: ModifyInstanceAttribute -> Maybe Bool
dryRun} -> Maybe Bool
dryRun) (\s :: ModifyInstanceAttribute
s@ModifyInstanceAttribute' {} Maybe Bool
a -> ModifyInstanceAttribute
s {$sel:dryRun:ModifyInstanceAttribute' :: Maybe Bool
dryRun = Maybe Bool
a} :: ModifyInstanceAttribute)

-- | Specifies whether the instance is optimized for Amazon EBS I\/O. This
-- optimization provides dedicated throughput to Amazon EBS and an
-- optimized configuration stack to provide optimal EBS I\/O performance.
-- This optimization isn\'t available with all instance types. Additional
-- usage charges apply when using an EBS Optimized instance.
modifyInstanceAttribute_ebsOptimized :: Lens.Lens' ModifyInstanceAttribute (Prelude.Maybe AttributeBooleanValue)
modifyInstanceAttribute_ebsOptimized :: Lens' ModifyInstanceAttribute (Maybe AttributeBooleanValue)
modifyInstanceAttribute_ebsOptimized = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyInstanceAttribute' {Maybe AttributeBooleanValue
ebsOptimized :: Maybe AttributeBooleanValue
$sel:ebsOptimized:ModifyInstanceAttribute' :: ModifyInstanceAttribute -> Maybe AttributeBooleanValue
ebsOptimized} -> Maybe AttributeBooleanValue
ebsOptimized) (\s :: ModifyInstanceAttribute
s@ModifyInstanceAttribute' {} Maybe AttributeBooleanValue
a -> ModifyInstanceAttribute
s {$sel:ebsOptimized:ModifyInstanceAttribute' :: Maybe AttributeBooleanValue
ebsOptimized = Maybe AttributeBooleanValue
a} :: ModifyInstanceAttribute)

-- | Set to @true@ to enable enhanced networking with ENA for the instance.
--
-- This option is supported only for HVM instances. Specifying this option
-- with a PV instance can make it unreachable.
modifyInstanceAttribute_enaSupport :: Lens.Lens' ModifyInstanceAttribute (Prelude.Maybe AttributeBooleanValue)
modifyInstanceAttribute_enaSupport :: Lens' ModifyInstanceAttribute (Maybe AttributeBooleanValue)
modifyInstanceAttribute_enaSupport = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyInstanceAttribute' {Maybe AttributeBooleanValue
enaSupport :: Maybe AttributeBooleanValue
$sel:enaSupport:ModifyInstanceAttribute' :: ModifyInstanceAttribute -> Maybe AttributeBooleanValue
enaSupport} -> Maybe AttributeBooleanValue
enaSupport) (\s :: ModifyInstanceAttribute
s@ModifyInstanceAttribute' {} Maybe AttributeBooleanValue
a -> ModifyInstanceAttribute
s {$sel:enaSupport:ModifyInstanceAttribute' :: Maybe AttributeBooleanValue
enaSupport = Maybe AttributeBooleanValue
a} :: ModifyInstanceAttribute)

-- | [EC2-VPC] Replaces the security groups of the instance with the
-- specified security groups. You must specify at least one security group,
-- even if it\'s just the default security group for the VPC. You must
-- specify the security group ID, not the security group name.
modifyInstanceAttribute_groups :: Lens.Lens' ModifyInstanceAttribute (Prelude.Maybe [Prelude.Text])
modifyInstanceAttribute_groups :: Lens' ModifyInstanceAttribute (Maybe [Text])
modifyInstanceAttribute_groups = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyInstanceAttribute' {Maybe [Text]
groups :: Maybe [Text]
$sel:groups:ModifyInstanceAttribute' :: ModifyInstanceAttribute -> Maybe [Text]
groups} -> Maybe [Text]
groups) (\s :: ModifyInstanceAttribute
s@ModifyInstanceAttribute' {} Maybe [Text]
a -> ModifyInstanceAttribute
s {$sel:groups:ModifyInstanceAttribute' :: Maybe [Text]
groups = Maybe [Text]
a} :: ModifyInstanceAttribute) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | Specifies whether an instance stops or terminates when you initiate
-- shutdown from the instance (using the operating system command for
-- system shutdown).
modifyInstanceAttribute_instanceInitiatedShutdownBehavior :: Lens.Lens' ModifyInstanceAttribute (Prelude.Maybe AttributeValue)
modifyInstanceAttribute_instanceInitiatedShutdownBehavior :: Lens' ModifyInstanceAttribute (Maybe AttributeValue)
modifyInstanceAttribute_instanceInitiatedShutdownBehavior = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyInstanceAttribute' {Maybe AttributeValue
instanceInitiatedShutdownBehavior :: Maybe AttributeValue
$sel:instanceInitiatedShutdownBehavior:ModifyInstanceAttribute' :: ModifyInstanceAttribute -> Maybe AttributeValue
instanceInitiatedShutdownBehavior} -> Maybe AttributeValue
instanceInitiatedShutdownBehavior) (\s :: ModifyInstanceAttribute
s@ModifyInstanceAttribute' {} Maybe AttributeValue
a -> ModifyInstanceAttribute
s {$sel:instanceInitiatedShutdownBehavior:ModifyInstanceAttribute' :: Maybe AttributeValue
instanceInitiatedShutdownBehavior = Maybe AttributeValue
a} :: ModifyInstanceAttribute)

-- | Changes the instance type to the specified value. For more information,
-- see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/instance-types.html Instance types>
-- in the /Amazon EC2 User Guide/. If the instance type is not valid, the
-- error returned is @InvalidInstanceAttributeValue@.
modifyInstanceAttribute_instanceType :: Lens.Lens' ModifyInstanceAttribute (Prelude.Maybe AttributeValue)
modifyInstanceAttribute_instanceType :: Lens' ModifyInstanceAttribute (Maybe AttributeValue)
modifyInstanceAttribute_instanceType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyInstanceAttribute' {Maybe AttributeValue
instanceType :: Maybe AttributeValue
$sel:instanceType:ModifyInstanceAttribute' :: ModifyInstanceAttribute -> Maybe AttributeValue
instanceType} -> Maybe AttributeValue
instanceType) (\s :: ModifyInstanceAttribute
s@ModifyInstanceAttribute' {} Maybe AttributeValue
a -> ModifyInstanceAttribute
s {$sel:instanceType:ModifyInstanceAttribute' :: Maybe AttributeValue
instanceType = Maybe AttributeValue
a} :: ModifyInstanceAttribute)

-- | Changes the instance\'s kernel to the specified value. We recommend that
-- you use PV-GRUB instead of kernels and RAM disks. For more information,
-- see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/UserProvidedKernels.html PV-GRUB>.
modifyInstanceAttribute_kernel :: Lens.Lens' ModifyInstanceAttribute (Prelude.Maybe AttributeValue)
modifyInstanceAttribute_kernel :: Lens' ModifyInstanceAttribute (Maybe AttributeValue)
modifyInstanceAttribute_kernel = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyInstanceAttribute' {Maybe AttributeValue
kernel :: Maybe AttributeValue
$sel:kernel:ModifyInstanceAttribute' :: ModifyInstanceAttribute -> Maybe AttributeValue
kernel} -> Maybe AttributeValue
kernel) (\s :: ModifyInstanceAttribute
s@ModifyInstanceAttribute' {} Maybe AttributeValue
a -> ModifyInstanceAttribute
s {$sel:kernel:ModifyInstanceAttribute' :: Maybe AttributeValue
kernel = Maybe AttributeValue
a} :: ModifyInstanceAttribute)

-- | Changes the instance\'s RAM disk to the specified value. We recommend
-- that you use PV-GRUB instead of kernels and RAM disks. For more
-- information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/UserProvidedKernels.html PV-GRUB>.
modifyInstanceAttribute_ramdisk :: Lens.Lens' ModifyInstanceAttribute (Prelude.Maybe AttributeValue)
modifyInstanceAttribute_ramdisk :: Lens' ModifyInstanceAttribute (Maybe AttributeValue)
modifyInstanceAttribute_ramdisk = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyInstanceAttribute' {Maybe AttributeValue
ramdisk :: Maybe AttributeValue
$sel:ramdisk:ModifyInstanceAttribute' :: ModifyInstanceAttribute -> Maybe AttributeValue
ramdisk} -> Maybe AttributeValue
ramdisk) (\s :: ModifyInstanceAttribute
s@ModifyInstanceAttribute' {} Maybe AttributeValue
a -> ModifyInstanceAttribute
s {$sel:ramdisk:ModifyInstanceAttribute' :: Maybe AttributeValue
ramdisk = Maybe AttributeValue
a} :: ModifyInstanceAttribute)

-- | Enable or disable source\/destination checks, which ensure that the
-- instance is either the source or the destination of any traffic that it
-- receives. If the value is @true@, source\/destination checks are
-- enabled; otherwise, they are disabled. The default value is @true@. You
-- must disable source\/destination checks if the instance runs services
-- such as network address translation, routing, or firewalls.
modifyInstanceAttribute_sourceDestCheck :: Lens.Lens' ModifyInstanceAttribute (Prelude.Maybe AttributeBooleanValue)
modifyInstanceAttribute_sourceDestCheck :: Lens' ModifyInstanceAttribute (Maybe AttributeBooleanValue)
modifyInstanceAttribute_sourceDestCheck = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyInstanceAttribute' {Maybe AttributeBooleanValue
sourceDestCheck :: Maybe AttributeBooleanValue
$sel:sourceDestCheck:ModifyInstanceAttribute' :: ModifyInstanceAttribute -> Maybe AttributeBooleanValue
sourceDestCheck} -> Maybe AttributeBooleanValue
sourceDestCheck) (\s :: ModifyInstanceAttribute
s@ModifyInstanceAttribute' {} Maybe AttributeBooleanValue
a -> ModifyInstanceAttribute
s {$sel:sourceDestCheck:ModifyInstanceAttribute' :: Maybe AttributeBooleanValue
sourceDestCheck = Maybe AttributeBooleanValue
a} :: ModifyInstanceAttribute)

-- | Set to @simple@ to enable enhanced networking with the Intel 82599
-- Virtual Function interface for the instance.
--
-- There is no way to disable enhanced networking with the Intel 82599
-- Virtual Function interface at this time.
--
-- This option is supported only for HVM instances. Specifying this option
-- with a PV instance can make it unreachable.
modifyInstanceAttribute_sriovNetSupport :: Lens.Lens' ModifyInstanceAttribute (Prelude.Maybe AttributeValue)
modifyInstanceAttribute_sriovNetSupport :: Lens' ModifyInstanceAttribute (Maybe AttributeValue)
modifyInstanceAttribute_sriovNetSupport = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyInstanceAttribute' {Maybe AttributeValue
sriovNetSupport :: Maybe AttributeValue
$sel:sriovNetSupport:ModifyInstanceAttribute' :: ModifyInstanceAttribute -> Maybe AttributeValue
sriovNetSupport} -> Maybe AttributeValue
sriovNetSupport) (\s :: ModifyInstanceAttribute
s@ModifyInstanceAttribute' {} Maybe AttributeValue
a -> ModifyInstanceAttribute
s {$sel:sriovNetSupport:ModifyInstanceAttribute' :: Maybe AttributeValue
sriovNetSupport = Maybe AttributeValue
a} :: ModifyInstanceAttribute)

-- | Changes the instance\'s user data to the specified value. If you are
-- using an Amazon Web Services SDK or command line tool, base64-encoding
-- is performed for you, and you can load the text from a file. Otherwise,
-- you must provide base64-encoded text.
modifyInstanceAttribute_userData :: Lens.Lens' ModifyInstanceAttribute (Prelude.Maybe BlobAttributeValue)
modifyInstanceAttribute_userData :: Lens' ModifyInstanceAttribute (Maybe BlobAttributeValue)
modifyInstanceAttribute_userData = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyInstanceAttribute' {Maybe BlobAttributeValue
userData :: Maybe BlobAttributeValue
$sel:userData:ModifyInstanceAttribute' :: ModifyInstanceAttribute -> Maybe BlobAttributeValue
userData} -> Maybe BlobAttributeValue
userData) (\s :: ModifyInstanceAttribute
s@ModifyInstanceAttribute' {} Maybe BlobAttributeValue
a -> ModifyInstanceAttribute
s {$sel:userData:ModifyInstanceAttribute' :: Maybe BlobAttributeValue
userData = Maybe BlobAttributeValue
a} :: ModifyInstanceAttribute)

-- | A new value for the attribute. Use only with the @kernel@, @ramdisk@,
-- @userData@, @disableApiTermination@, or
-- @instanceInitiatedShutdownBehavior@ attribute.
modifyInstanceAttribute_value :: Lens.Lens' ModifyInstanceAttribute (Prelude.Maybe Prelude.Text)
modifyInstanceAttribute_value :: Lens' ModifyInstanceAttribute (Maybe Text)
modifyInstanceAttribute_value = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyInstanceAttribute' {Maybe Text
value :: Maybe Text
$sel:value:ModifyInstanceAttribute' :: ModifyInstanceAttribute -> Maybe Text
value} -> Maybe Text
value) (\s :: ModifyInstanceAttribute
s@ModifyInstanceAttribute' {} Maybe Text
a -> ModifyInstanceAttribute
s {$sel:value:ModifyInstanceAttribute' :: Maybe Text
value = Maybe Text
a} :: ModifyInstanceAttribute)

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

instance Core.AWSRequest ModifyInstanceAttribute where
  type
    AWSResponse ModifyInstanceAttribute =
      ModifyInstanceAttributeResponse
  request :: (Service -> Service)
-> ModifyInstanceAttribute -> Request ModifyInstanceAttribute
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.postQuery (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy ModifyInstanceAttribute
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse ModifyInstanceAttribute)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
AWSResponse a
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveNull
      ModifyInstanceAttributeResponse
ModifyInstanceAttributeResponse'

instance Prelude.Hashable ModifyInstanceAttribute where
  hashWithSalt :: Int -> ModifyInstanceAttribute -> Int
hashWithSalt Int
_salt ModifyInstanceAttribute' {Maybe Bool
Maybe [Text]
Maybe [InstanceBlockDeviceMappingSpecification]
Maybe Text
Maybe AttributeBooleanValue
Maybe AttributeValue
Maybe BlobAttributeValue
Maybe InstanceAttributeName
Text
instanceId :: Text
value :: Maybe Text
userData :: Maybe BlobAttributeValue
sriovNetSupport :: Maybe AttributeValue
sourceDestCheck :: Maybe AttributeBooleanValue
ramdisk :: Maybe AttributeValue
kernel :: Maybe AttributeValue
instanceType :: Maybe AttributeValue
instanceInitiatedShutdownBehavior :: Maybe AttributeValue
groups :: Maybe [Text]
enaSupport :: Maybe AttributeBooleanValue
ebsOptimized :: Maybe AttributeBooleanValue
dryRun :: Maybe Bool
disableApiTermination :: Maybe AttributeBooleanValue
disableApiStop :: Maybe AttributeBooleanValue
blockDeviceMappings :: Maybe [InstanceBlockDeviceMappingSpecification]
attribute :: Maybe InstanceAttributeName
$sel:instanceId:ModifyInstanceAttribute' :: ModifyInstanceAttribute -> Text
$sel:value:ModifyInstanceAttribute' :: ModifyInstanceAttribute -> Maybe Text
$sel:userData:ModifyInstanceAttribute' :: ModifyInstanceAttribute -> Maybe BlobAttributeValue
$sel:sriovNetSupport:ModifyInstanceAttribute' :: ModifyInstanceAttribute -> Maybe AttributeValue
$sel:sourceDestCheck:ModifyInstanceAttribute' :: ModifyInstanceAttribute -> Maybe AttributeBooleanValue
$sel:ramdisk:ModifyInstanceAttribute' :: ModifyInstanceAttribute -> Maybe AttributeValue
$sel:kernel:ModifyInstanceAttribute' :: ModifyInstanceAttribute -> Maybe AttributeValue
$sel:instanceType:ModifyInstanceAttribute' :: ModifyInstanceAttribute -> Maybe AttributeValue
$sel:instanceInitiatedShutdownBehavior:ModifyInstanceAttribute' :: ModifyInstanceAttribute -> Maybe AttributeValue
$sel:groups:ModifyInstanceAttribute' :: ModifyInstanceAttribute -> Maybe [Text]
$sel:enaSupport:ModifyInstanceAttribute' :: ModifyInstanceAttribute -> Maybe AttributeBooleanValue
$sel:ebsOptimized:ModifyInstanceAttribute' :: ModifyInstanceAttribute -> Maybe AttributeBooleanValue
$sel:dryRun:ModifyInstanceAttribute' :: ModifyInstanceAttribute -> Maybe Bool
$sel:disableApiTermination:ModifyInstanceAttribute' :: ModifyInstanceAttribute -> Maybe AttributeBooleanValue
$sel:disableApiStop:ModifyInstanceAttribute' :: ModifyInstanceAttribute -> Maybe AttributeBooleanValue
$sel:blockDeviceMappings:ModifyInstanceAttribute' :: ModifyInstanceAttribute
-> Maybe [InstanceBlockDeviceMappingSpecification]
$sel:attribute:ModifyInstanceAttribute' :: ModifyInstanceAttribute -> Maybe InstanceAttributeName
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe InstanceAttributeName
attribute
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [InstanceBlockDeviceMappingSpecification]
blockDeviceMappings
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe AttributeBooleanValue
disableApiStop
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe AttributeBooleanValue
disableApiTermination
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
dryRun
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe AttributeBooleanValue
ebsOptimized
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe AttributeBooleanValue
enaSupport
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
groups
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe AttributeValue
instanceInitiatedShutdownBehavior
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe AttributeValue
instanceType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe AttributeValue
kernel
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe AttributeValue
ramdisk
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe AttributeBooleanValue
sourceDestCheck
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe AttributeValue
sriovNetSupport
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe BlobAttributeValue
userData
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
value
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
instanceId

instance Prelude.NFData ModifyInstanceAttribute where
  rnf :: ModifyInstanceAttribute -> ()
rnf ModifyInstanceAttribute' {Maybe Bool
Maybe [Text]
Maybe [InstanceBlockDeviceMappingSpecification]
Maybe Text
Maybe AttributeBooleanValue
Maybe AttributeValue
Maybe BlobAttributeValue
Maybe InstanceAttributeName
Text
instanceId :: Text
value :: Maybe Text
userData :: Maybe BlobAttributeValue
sriovNetSupport :: Maybe AttributeValue
sourceDestCheck :: Maybe AttributeBooleanValue
ramdisk :: Maybe AttributeValue
kernel :: Maybe AttributeValue
instanceType :: Maybe AttributeValue
instanceInitiatedShutdownBehavior :: Maybe AttributeValue
groups :: Maybe [Text]
enaSupport :: Maybe AttributeBooleanValue
ebsOptimized :: Maybe AttributeBooleanValue
dryRun :: Maybe Bool
disableApiTermination :: Maybe AttributeBooleanValue
disableApiStop :: Maybe AttributeBooleanValue
blockDeviceMappings :: Maybe [InstanceBlockDeviceMappingSpecification]
attribute :: Maybe InstanceAttributeName
$sel:instanceId:ModifyInstanceAttribute' :: ModifyInstanceAttribute -> Text
$sel:value:ModifyInstanceAttribute' :: ModifyInstanceAttribute -> Maybe Text
$sel:userData:ModifyInstanceAttribute' :: ModifyInstanceAttribute -> Maybe BlobAttributeValue
$sel:sriovNetSupport:ModifyInstanceAttribute' :: ModifyInstanceAttribute -> Maybe AttributeValue
$sel:sourceDestCheck:ModifyInstanceAttribute' :: ModifyInstanceAttribute -> Maybe AttributeBooleanValue
$sel:ramdisk:ModifyInstanceAttribute' :: ModifyInstanceAttribute -> Maybe AttributeValue
$sel:kernel:ModifyInstanceAttribute' :: ModifyInstanceAttribute -> Maybe AttributeValue
$sel:instanceType:ModifyInstanceAttribute' :: ModifyInstanceAttribute -> Maybe AttributeValue
$sel:instanceInitiatedShutdownBehavior:ModifyInstanceAttribute' :: ModifyInstanceAttribute -> Maybe AttributeValue
$sel:groups:ModifyInstanceAttribute' :: ModifyInstanceAttribute -> Maybe [Text]
$sel:enaSupport:ModifyInstanceAttribute' :: ModifyInstanceAttribute -> Maybe AttributeBooleanValue
$sel:ebsOptimized:ModifyInstanceAttribute' :: ModifyInstanceAttribute -> Maybe AttributeBooleanValue
$sel:dryRun:ModifyInstanceAttribute' :: ModifyInstanceAttribute -> Maybe Bool
$sel:disableApiTermination:ModifyInstanceAttribute' :: ModifyInstanceAttribute -> Maybe AttributeBooleanValue
$sel:disableApiStop:ModifyInstanceAttribute' :: ModifyInstanceAttribute -> Maybe AttributeBooleanValue
$sel:blockDeviceMappings:ModifyInstanceAttribute' :: ModifyInstanceAttribute
-> Maybe [InstanceBlockDeviceMappingSpecification]
$sel:attribute:ModifyInstanceAttribute' :: ModifyInstanceAttribute -> Maybe InstanceAttributeName
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe InstanceAttributeName
attribute
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [InstanceBlockDeviceMappingSpecification]
blockDeviceMappings
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe AttributeBooleanValue
disableApiStop
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe AttributeBooleanValue
disableApiTermination
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
dryRun
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe AttributeBooleanValue
ebsOptimized
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe AttributeBooleanValue
enaSupport
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
groups
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe AttributeValue
instanceInitiatedShutdownBehavior
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe AttributeValue
instanceType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe AttributeValue
kernel
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe AttributeValue
ramdisk
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe AttributeBooleanValue
sourceDestCheck
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe AttributeValue
sriovNetSupport
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe BlobAttributeValue
userData
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
value
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
instanceId

instance Data.ToHeaders ModifyInstanceAttribute where
  toHeaders :: ModifyInstanceAttribute -> [Header]
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

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

instance Data.ToQuery ModifyInstanceAttribute where
  toQuery :: ModifyInstanceAttribute -> QueryString
toQuery ModifyInstanceAttribute' {Maybe Bool
Maybe [Text]
Maybe [InstanceBlockDeviceMappingSpecification]
Maybe Text
Maybe AttributeBooleanValue
Maybe AttributeValue
Maybe BlobAttributeValue
Maybe InstanceAttributeName
Text
instanceId :: Text
value :: Maybe Text
userData :: Maybe BlobAttributeValue
sriovNetSupport :: Maybe AttributeValue
sourceDestCheck :: Maybe AttributeBooleanValue
ramdisk :: Maybe AttributeValue
kernel :: Maybe AttributeValue
instanceType :: Maybe AttributeValue
instanceInitiatedShutdownBehavior :: Maybe AttributeValue
groups :: Maybe [Text]
enaSupport :: Maybe AttributeBooleanValue
ebsOptimized :: Maybe AttributeBooleanValue
dryRun :: Maybe Bool
disableApiTermination :: Maybe AttributeBooleanValue
disableApiStop :: Maybe AttributeBooleanValue
blockDeviceMappings :: Maybe [InstanceBlockDeviceMappingSpecification]
attribute :: Maybe InstanceAttributeName
$sel:instanceId:ModifyInstanceAttribute' :: ModifyInstanceAttribute -> Text
$sel:value:ModifyInstanceAttribute' :: ModifyInstanceAttribute -> Maybe Text
$sel:userData:ModifyInstanceAttribute' :: ModifyInstanceAttribute -> Maybe BlobAttributeValue
$sel:sriovNetSupport:ModifyInstanceAttribute' :: ModifyInstanceAttribute -> Maybe AttributeValue
$sel:sourceDestCheck:ModifyInstanceAttribute' :: ModifyInstanceAttribute -> Maybe AttributeBooleanValue
$sel:ramdisk:ModifyInstanceAttribute' :: ModifyInstanceAttribute -> Maybe AttributeValue
$sel:kernel:ModifyInstanceAttribute' :: ModifyInstanceAttribute -> Maybe AttributeValue
$sel:instanceType:ModifyInstanceAttribute' :: ModifyInstanceAttribute -> Maybe AttributeValue
$sel:instanceInitiatedShutdownBehavior:ModifyInstanceAttribute' :: ModifyInstanceAttribute -> Maybe AttributeValue
$sel:groups:ModifyInstanceAttribute' :: ModifyInstanceAttribute -> Maybe [Text]
$sel:enaSupport:ModifyInstanceAttribute' :: ModifyInstanceAttribute -> Maybe AttributeBooleanValue
$sel:ebsOptimized:ModifyInstanceAttribute' :: ModifyInstanceAttribute -> Maybe AttributeBooleanValue
$sel:dryRun:ModifyInstanceAttribute' :: ModifyInstanceAttribute -> Maybe Bool
$sel:disableApiTermination:ModifyInstanceAttribute' :: ModifyInstanceAttribute -> Maybe AttributeBooleanValue
$sel:disableApiStop:ModifyInstanceAttribute' :: ModifyInstanceAttribute -> Maybe AttributeBooleanValue
$sel:blockDeviceMappings:ModifyInstanceAttribute' :: ModifyInstanceAttribute
-> Maybe [InstanceBlockDeviceMappingSpecification]
$sel:attribute:ModifyInstanceAttribute' :: ModifyInstanceAttribute -> Maybe InstanceAttributeName
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"ModifyInstanceAttribute" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2016-11-15" :: Prelude.ByteString),
        ByteString
"Attribute" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe InstanceAttributeName
attribute,
        forall a. ToQuery a => a -> QueryString
Data.toQuery
          ( forall a.
(IsList a, ToQuery (Item a)) =>
ByteString -> a -> QueryString
Data.toQueryList ByteString
"BlockDeviceMapping"
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [InstanceBlockDeviceMappingSpecification]
blockDeviceMappings
          ),
        ByteString
"DisableApiStop" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe AttributeBooleanValue
disableApiStop,
        ByteString
"DisableApiTermination"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe AttributeBooleanValue
disableApiTermination,
        ByteString
"DryRun" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
dryRun,
        ByteString
"EbsOptimized" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe AttributeBooleanValue
ebsOptimized,
        ByteString
"EnaSupport" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe AttributeBooleanValue
enaSupport,
        forall a. ToQuery a => a -> QueryString
Data.toQuery
          (forall a.
(IsList a, ToQuery (Item a)) =>
ByteString -> a -> QueryString
Data.toQueryList ByteString
"GroupId" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [Text]
groups),
        ByteString
"InstanceInitiatedShutdownBehavior"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe AttributeValue
instanceInitiatedShutdownBehavior,
        ByteString
"InstanceType" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe AttributeValue
instanceType,
        ByteString
"Kernel" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe AttributeValue
kernel,
        ByteString
"Ramdisk" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe AttributeValue
ramdisk,
        ByteString
"SourceDestCheck" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe AttributeBooleanValue
sourceDestCheck,
        ByteString
"SriovNetSupport" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe AttributeValue
sriovNetSupport,
        ByteString
"UserData" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe BlobAttributeValue
userData,
        ByteString
"Value" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
value,
        ByteString
"InstanceId" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
instanceId
      ]

-- | /See:/ 'newModifyInstanceAttributeResponse' smart constructor.
data ModifyInstanceAttributeResponse = ModifyInstanceAttributeResponse'
  {
  }
  deriving (ModifyInstanceAttributeResponse
-> ModifyInstanceAttributeResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModifyInstanceAttributeResponse
-> ModifyInstanceAttributeResponse -> Bool
$c/= :: ModifyInstanceAttributeResponse
-> ModifyInstanceAttributeResponse -> Bool
== :: ModifyInstanceAttributeResponse
-> ModifyInstanceAttributeResponse -> Bool
$c== :: ModifyInstanceAttributeResponse
-> ModifyInstanceAttributeResponse -> Bool
Prelude.Eq, ReadPrec [ModifyInstanceAttributeResponse]
ReadPrec ModifyInstanceAttributeResponse
Int -> ReadS ModifyInstanceAttributeResponse
ReadS [ModifyInstanceAttributeResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ModifyInstanceAttributeResponse]
$creadListPrec :: ReadPrec [ModifyInstanceAttributeResponse]
readPrec :: ReadPrec ModifyInstanceAttributeResponse
$creadPrec :: ReadPrec ModifyInstanceAttributeResponse
readList :: ReadS [ModifyInstanceAttributeResponse]
$creadList :: ReadS [ModifyInstanceAttributeResponse]
readsPrec :: Int -> ReadS ModifyInstanceAttributeResponse
$creadsPrec :: Int -> ReadS ModifyInstanceAttributeResponse
Prelude.Read, Int -> ModifyInstanceAttributeResponse -> ShowS
[ModifyInstanceAttributeResponse] -> ShowS
ModifyInstanceAttributeResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ModifyInstanceAttributeResponse] -> ShowS
$cshowList :: [ModifyInstanceAttributeResponse] -> ShowS
show :: ModifyInstanceAttributeResponse -> String
$cshow :: ModifyInstanceAttributeResponse -> String
showsPrec :: Int -> ModifyInstanceAttributeResponse -> ShowS
$cshowsPrec :: Int -> ModifyInstanceAttributeResponse -> ShowS
Prelude.Show, forall x.
Rep ModifyInstanceAttributeResponse x
-> ModifyInstanceAttributeResponse
forall x.
ModifyInstanceAttributeResponse
-> Rep ModifyInstanceAttributeResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ModifyInstanceAttributeResponse x
-> ModifyInstanceAttributeResponse
$cfrom :: forall x.
ModifyInstanceAttributeResponse
-> Rep ModifyInstanceAttributeResponse x
Prelude.Generic)

-- |
-- Create a value of 'ModifyInstanceAttributeResponse' 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.
newModifyInstanceAttributeResponse ::
  ModifyInstanceAttributeResponse
newModifyInstanceAttributeResponse :: ModifyInstanceAttributeResponse
newModifyInstanceAttributeResponse =
  ModifyInstanceAttributeResponse
ModifyInstanceAttributeResponse'

instance
  Prelude.NFData
    ModifyInstanceAttributeResponse
  where
  rnf :: ModifyInstanceAttributeResponse -> ()
rnf ModifyInstanceAttributeResponse
_ = ()