{-# 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.UpdateInstance
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Updates a specified instance.
--
-- __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.UpdateInstance
  ( -- * Creating a Request
    UpdateInstance (..),
    newUpdateInstance,

    -- * Request Lenses
    updateInstance_agentVersion,
    updateInstance_amiId,
    updateInstance_architecture,
    updateInstance_autoScalingType,
    updateInstance_ebsOptimized,
    updateInstance_hostname,
    updateInstance_installUpdatesOnBoot,
    updateInstance_instanceType,
    updateInstance_layerIds,
    updateInstance_os,
    updateInstance_sshKeyName,
    updateInstance_instanceId,

    -- * Destructuring the Response
    UpdateInstanceResponse (..),
    newUpdateInstanceResponse,
  )
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:/ 'newUpdateInstance' smart constructor.
data UpdateInstance = UpdateInstance'
  { -- | 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,
    --     you must 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.
    UpdateInstance -> Maybe Text
agentVersion :: Prelude.Maybe Prelude.Text,
    -- | The ID of the AMI that was used to create the instance. The value of
    -- this parameter must be the same AMI ID that the instance is already
    -- using. You cannot apply a new AMI to an instance by running
    -- UpdateInstance. UpdateInstance does not work on instances that are using
    -- custom AMIs.
    UpdateInstance -> Maybe Text
amiId :: Prelude.Maybe Prelude.Text,
    -- | The instance architecture. 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>.
    UpdateInstance -> Maybe Architecture
architecture :: Prelude.Maybe Architecture,
    -- | For load-based or time-based instances, the type. Windows stacks can use
    -- only time-based instances.
    UpdateInstance -> Maybe AutoScalingType
autoScalingType :: Prelude.Maybe AutoScalingType,
    -- | This property cannot be updated.
    UpdateInstance -> Maybe Bool
ebsOptimized :: Prelude.Maybe Prelude.Bool,
    -- | The instance host name.
    UpdateInstance -> 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.
    UpdateInstance -> Maybe Bool
installUpdatesOnBoot :: Prelude.Maybe Prelude.Bool,
    -- | 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.
    UpdateInstance -> Maybe Text
instanceType :: Prelude.Maybe Prelude.Text,
    -- | The instance\'s layer IDs.
    UpdateInstance -> Maybe [Text]
layerIds :: Prelude.Maybe [Prelude.Text],
    -- | The instance\'s operating system, which must be set to one of the
    -- following. You cannot update an instance that is using a custom AMI.
    --
    -- -   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@.
    --
    -- For more information about 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 AmiId parameter to specify the
    -- custom AMI that you want to use. 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 OpsWorks, see
    -- <https://docs.aws.amazon.com/opsworks/latest/userguide/workinginstances-custom-ami.html Using Custom AMIs>.
    --
    -- You can specify a different Linux operating system for the updated
    -- stack, but you cannot change from Linux to Windows or Windows to Linux.
    UpdateInstance -> Maybe Text
os :: Prelude.Maybe Prelude.Text,
    -- | The instance\'s Amazon EC2 key name.
    UpdateInstance -> Maybe Text
sshKeyName :: Prelude.Maybe Prelude.Text,
    -- | The instance ID.
    UpdateInstance -> Text
instanceId :: Prelude.Text
  }
  deriving (UpdateInstance -> UpdateInstance -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateInstance -> UpdateInstance -> Bool
$c/= :: UpdateInstance -> UpdateInstance -> Bool
== :: UpdateInstance -> UpdateInstance -> Bool
$c== :: UpdateInstance -> UpdateInstance -> Bool
Prelude.Eq, ReadPrec [UpdateInstance]
ReadPrec UpdateInstance
Int -> ReadS UpdateInstance
ReadS [UpdateInstance]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateInstance]
$creadListPrec :: ReadPrec [UpdateInstance]
readPrec :: ReadPrec UpdateInstance
$creadPrec :: ReadPrec UpdateInstance
readList :: ReadS [UpdateInstance]
$creadList :: ReadS [UpdateInstance]
readsPrec :: Int -> ReadS UpdateInstance
$creadsPrec :: Int -> ReadS UpdateInstance
Prelude.Read, Int -> UpdateInstance -> ShowS
[UpdateInstance] -> ShowS
UpdateInstance -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateInstance] -> ShowS
$cshowList :: [UpdateInstance] -> ShowS
show :: UpdateInstance -> String
$cshow :: UpdateInstance -> String
showsPrec :: Int -> UpdateInstance -> ShowS
$cshowsPrec :: Int -> UpdateInstance -> ShowS
Prelude.Show, forall x. Rep UpdateInstance x -> UpdateInstance
forall x. UpdateInstance -> Rep UpdateInstance x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateInstance x -> UpdateInstance
$cfrom :: forall x. UpdateInstance -> Rep UpdateInstance x
Prelude.Generic)

-- |
-- Create a value of 'UpdateInstance' 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', 'updateInstance_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,
--     you must 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', 'updateInstance_amiId' - The ID of the AMI that was used to create the instance. The value of
-- this parameter must be the same AMI ID that the instance is already
-- using. You cannot apply a new AMI to an instance by running
-- UpdateInstance. UpdateInstance does not work on instances that are using
-- custom AMIs.
--
-- 'architecture', 'updateInstance_architecture' - The instance architecture. 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', 'updateInstance_autoScalingType' - For load-based or time-based instances, the type. Windows stacks can use
-- only time-based instances.
--
-- 'ebsOptimized', 'updateInstance_ebsOptimized' - This property cannot be updated.
--
-- 'hostname', 'updateInstance_hostname' - The instance host name.
--
-- 'installUpdatesOnBoot', 'updateInstance_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.
--
-- 'instanceType', 'updateInstance_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.
--
-- 'layerIds', 'updateInstance_layerIds' - The instance\'s layer IDs.
--
-- 'os', 'updateInstance_os' - The instance\'s operating system, which must be set to one of the
-- following. You cannot update an instance that is using a custom AMI.
--
-- -   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@.
--
-- For more information about 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 AmiId parameter to specify the
-- custom AMI that you want to use. 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 OpsWorks, see
-- <https://docs.aws.amazon.com/opsworks/latest/userguide/workinginstances-custom-ami.html Using Custom AMIs>.
--
-- You can specify a different Linux operating system for the updated
-- stack, but you cannot change from Linux to Windows or Windows to Linux.
--
-- 'sshKeyName', 'updateInstance_sshKeyName' - The instance\'s Amazon EC2 key name.
--
-- 'instanceId', 'updateInstance_instanceId' - The instance ID.
newUpdateInstance ::
  -- | 'instanceId'
  Prelude.Text ->
  UpdateInstance
newUpdateInstance :: Text -> UpdateInstance
newUpdateInstance Text
pInstanceId_ =
  UpdateInstance'
    { $sel:agentVersion:UpdateInstance' :: Maybe Text
agentVersion = forall a. Maybe a
Prelude.Nothing,
      $sel:amiId:UpdateInstance' :: Maybe Text
amiId = forall a. Maybe a
Prelude.Nothing,
      $sel:architecture:UpdateInstance' :: Maybe Architecture
architecture = forall a. Maybe a
Prelude.Nothing,
      $sel:autoScalingType:UpdateInstance' :: Maybe AutoScalingType
autoScalingType = forall a. Maybe a
Prelude.Nothing,
      $sel:ebsOptimized:UpdateInstance' :: Maybe Bool
ebsOptimized = forall a. Maybe a
Prelude.Nothing,
      $sel:hostname:UpdateInstance' :: Maybe Text
hostname = forall a. Maybe a
Prelude.Nothing,
      $sel:installUpdatesOnBoot:UpdateInstance' :: Maybe Bool
installUpdatesOnBoot = forall a. Maybe a
Prelude.Nothing,
      $sel:instanceType:UpdateInstance' :: Maybe Text
instanceType = forall a. Maybe a
Prelude.Nothing,
      $sel:layerIds:UpdateInstance' :: Maybe [Text]
layerIds = forall a. Maybe a
Prelude.Nothing,
      $sel:os:UpdateInstance' :: Maybe Text
os = forall a. Maybe a
Prelude.Nothing,
      $sel:sshKeyName:UpdateInstance' :: Maybe Text
sshKeyName = forall a. Maybe a
Prelude.Nothing,
      $sel:instanceId:UpdateInstance' :: Text
instanceId = Text
pInstanceId_
    }

-- | 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,
--     you must 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.
updateInstance_agentVersion :: Lens.Lens' UpdateInstance (Prelude.Maybe Prelude.Text)
updateInstance_agentVersion :: Lens' UpdateInstance (Maybe Text)
updateInstance_agentVersion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateInstance' {Maybe Text
agentVersion :: Maybe Text
$sel:agentVersion:UpdateInstance' :: UpdateInstance -> Maybe Text
agentVersion} -> Maybe Text
agentVersion) (\s :: UpdateInstance
s@UpdateInstance' {} Maybe Text
a -> UpdateInstance
s {$sel:agentVersion:UpdateInstance' :: Maybe Text
agentVersion = Maybe Text
a} :: UpdateInstance)

-- | The ID of the AMI that was used to create the instance. The value of
-- this parameter must be the same AMI ID that the instance is already
-- using. You cannot apply a new AMI to an instance by running
-- UpdateInstance. UpdateInstance does not work on instances that are using
-- custom AMIs.
updateInstance_amiId :: Lens.Lens' UpdateInstance (Prelude.Maybe Prelude.Text)
updateInstance_amiId :: Lens' UpdateInstance (Maybe Text)
updateInstance_amiId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateInstance' {Maybe Text
amiId :: Maybe Text
$sel:amiId:UpdateInstance' :: UpdateInstance -> Maybe Text
amiId} -> Maybe Text
amiId) (\s :: UpdateInstance
s@UpdateInstance' {} Maybe Text
a -> UpdateInstance
s {$sel:amiId:UpdateInstance' :: Maybe Text
amiId = Maybe Text
a} :: UpdateInstance)

-- | The instance architecture. 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>.
updateInstance_architecture :: Lens.Lens' UpdateInstance (Prelude.Maybe Architecture)
updateInstance_architecture :: Lens' UpdateInstance (Maybe Architecture)
updateInstance_architecture = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateInstance' {Maybe Architecture
architecture :: Maybe Architecture
$sel:architecture:UpdateInstance' :: UpdateInstance -> Maybe Architecture
architecture} -> Maybe Architecture
architecture) (\s :: UpdateInstance
s@UpdateInstance' {} Maybe Architecture
a -> UpdateInstance
s {$sel:architecture:UpdateInstance' :: Maybe Architecture
architecture = Maybe Architecture
a} :: UpdateInstance)

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

-- | This property cannot be updated.
updateInstance_ebsOptimized :: Lens.Lens' UpdateInstance (Prelude.Maybe Prelude.Bool)
updateInstance_ebsOptimized :: Lens' UpdateInstance (Maybe Bool)
updateInstance_ebsOptimized = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateInstance' {Maybe Bool
ebsOptimized :: Maybe Bool
$sel:ebsOptimized:UpdateInstance' :: UpdateInstance -> Maybe Bool
ebsOptimized} -> Maybe Bool
ebsOptimized) (\s :: UpdateInstance
s@UpdateInstance' {} Maybe Bool
a -> UpdateInstance
s {$sel:ebsOptimized:UpdateInstance' :: Maybe Bool
ebsOptimized = Maybe Bool
a} :: UpdateInstance)

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

-- | 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.
updateInstance_installUpdatesOnBoot :: Lens.Lens' UpdateInstance (Prelude.Maybe Prelude.Bool)
updateInstance_installUpdatesOnBoot :: Lens' UpdateInstance (Maybe Bool)
updateInstance_installUpdatesOnBoot = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateInstance' {Maybe Bool
installUpdatesOnBoot :: Maybe Bool
$sel:installUpdatesOnBoot:UpdateInstance' :: UpdateInstance -> Maybe Bool
installUpdatesOnBoot} -> Maybe Bool
installUpdatesOnBoot) (\s :: UpdateInstance
s@UpdateInstance' {} Maybe Bool
a -> UpdateInstance
s {$sel:installUpdatesOnBoot:UpdateInstance' :: Maybe Bool
installUpdatesOnBoot = Maybe Bool
a} :: UpdateInstance)

-- | 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.
updateInstance_instanceType :: Lens.Lens' UpdateInstance (Prelude.Maybe Prelude.Text)
updateInstance_instanceType :: Lens' UpdateInstance (Maybe Text)
updateInstance_instanceType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateInstance' {Maybe Text
instanceType :: Maybe Text
$sel:instanceType:UpdateInstance' :: UpdateInstance -> Maybe Text
instanceType} -> Maybe Text
instanceType) (\s :: UpdateInstance
s@UpdateInstance' {} Maybe Text
a -> UpdateInstance
s {$sel:instanceType:UpdateInstance' :: Maybe Text
instanceType = Maybe Text
a} :: UpdateInstance)

-- | The instance\'s layer IDs.
updateInstance_layerIds :: Lens.Lens' UpdateInstance (Prelude.Maybe [Prelude.Text])
updateInstance_layerIds :: Lens' UpdateInstance (Maybe [Text])
updateInstance_layerIds = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateInstance' {Maybe [Text]
layerIds :: Maybe [Text]
$sel:layerIds:UpdateInstance' :: UpdateInstance -> Maybe [Text]
layerIds} -> Maybe [Text]
layerIds) (\s :: UpdateInstance
s@UpdateInstance' {} Maybe [Text]
a -> UpdateInstance
s {$sel:layerIds:UpdateInstance' :: Maybe [Text]
layerIds = Maybe [Text]
a} :: UpdateInstance) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | The instance\'s operating system, which must be set to one of the
-- following. You cannot update an instance that is using a custom AMI.
--
-- -   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@.
--
-- For more information about 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 AmiId parameter to specify the
-- custom AMI that you want to use. 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 OpsWorks, see
-- <https://docs.aws.amazon.com/opsworks/latest/userguide/workinginstances-custom-ami.html Using Custom AMIs>.
--
-- You can specify a different Linux operating system for the updated
-- stack, but you cannot change from Linux to Windows or Windows to Linux.
updateInstance_os :: Lens.Lens' UpdateInstance (Prelude.Maybe Prelude.Text)
updateInstance_os :: Lens' UpdateInstance (Maybe Text)
updateInstance_os = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateInstance' {Maybe Text
os :: Maybe Text
$sel:os:UpdateInstance' :: UpdateInstance -> Maybe Text
os} -> Maybe Text
os) (\s :: UpdateInstance
s@UpdateInstance' {} Maybe Text
a -> UpdateInstance
s {$sel:os:UpdateInstance' :: Maybe Text
os = Maybe Text
a} :: UpdateInstance)

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

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

instance Core.AWSRequest UpdateInstance where
  type
    AWSResponse UpdateInstance =
      UpdateInstanceResponse
  request :: (Service -> Service) -> UpdateInstance -> Request UpdateInstance
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 UpdateInstance
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse UpdateInstance)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
AWSResponse a
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveNull UpdateInstanceResponse
UpdateInstanceResponse'

instance Prelude.Hashable UpdateInstance where
  hashWithSalt :: Int -> UpdateInstance -> Int
hashWithSalt Int
_salt UpdateInstance' {Maybe Bool
Maybe [Text]
Maybe Text
Maybe Architecture
Maybe AutoScalingType
Text
instanceId :: Text
sshKeyName :: Maybe Text
os :: Maybe Text
layerIds :: Maybe [Text]
instanceType :: Maybe Text
installUpdatesOnBoot :: Maybe Bool
hostname :: Maybe Text
ebsOptimized :: Maybe Bool
autoScalingType :: Maybe AutoScalingType
architecture :: Maybe Architecture
amiId :: Maybe Text
agentVersion :: Maybe Text
$sel:instanceId:UpdateInstance' :: UpdateInstance -> Text
$sel:sshKeyName:UpdateInstance' :: UpdateInstance -> Maybe Text
$sel:os:UpdateInstance' :: UpdateInstance -> Maybe Text
$sel:layerIds:UpdateInstance' :: UpdateInstance -> Maybe [Text]
$sel:instanceType:UpdateInstance' :: UpdateInstance -> Maybe Text
$sel:installUpdatesOnBoot:UpdateInstance' :: UpdateInstance -> Maybe Bool
$sel:hostname:UpdateInstance' :: UpdateInstance -> Maybe Text
$sel:ebsOptimized:UpdateInstance' :: UpdateInstance -> Maybe Bool
$sel:autoScalingType:UpdateInstance' :: UpdateInstance -> Maybe AutoScalingType
$sel:architecture:UpdateInstance' :: UpdateInstance -> Maybe Architecture
$sel:amiId:UpdateInstance' :: UpdateInstance -> Maybe Text
$sel:agentVersion:UpdateInstance' :: UpdateInstance -> 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 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
instanceType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
layerIds
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
os
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
sshKeyName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
instanceId

instance Prelude.NFData UpdateInstance where
  rnf :: UpdateInstance -> ()
rnf UpdateInstance' {Maybe Bool
Maybe [Text]
Maybe Text
Maybe Architecture
Maybe AutoScalingType
Text
instanceId :: Text
sshKeyName :: Maybe Text
os :: Maybe Text
layerIds :: Maybe [Text]
instanceType :: Maybe Text
installUpdatesOnBoot :: Maybe Bool
hostname :: Maybe Text
ebsOptimized :: Maybe Bool
autoScalingType :: Maybe AutoScalingType
architecture :: Maybe Architecture
amiId :: Maybe Text
agentVersion :: Maybe Text
$sel:instanceId:UpdateInstance' :: UpdateInstance -> Text
$sel:sshKeyName:UpdateInstance' :: UpdateInstance -> Maybe Text
$sel:os:UpdateInstance' :: UpdateInstance -> Maybe Text
$sel:layerIds:UpdateInstance' :: UpdateInstance -> Maybe [Text]
$sel:instanceType:UpdateInstance' :: UpdateInstance -> Maybe Text
$sel:installUpdatesOnBoot:UpdateInstance' :: UpdateInstance -> Maybe Bool
$sel:hostname:UpdateInstance' :: UpdateInstance -> Maybe Text
$sel:ebsOptimized:UpdateInstance' :: UpdateInstance -> Maybe Bool
$sel:autoScalingType:UpdateInstance' :: UpdateInstance -> Maybe AutoScalingType
$sel:architecture:UpdateInstance' :: UpdateInstance -> Maybe Architecture
$sel:amiId:UpdateInstance' :: UpdateInstance -> Maybe Text
$sel:agentVersion:UpdateInstance' :: UpdateInstance -> 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 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
instanceType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
layerIds
      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 Text
sshKeyName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
instanceId

instance Data.ToHeaders UpdateInstance where
  toHeaders :: UpdateInstance -> [Header]
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 -> [Header]
Data.=# ( ByteString
"OpsWorks_20130218.UpdateInstance" ::
                          Prelude.ByteString
                      ),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> [Header]
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON UpdateInstance where
  toJSON :: UpdateInstance -> Value
toJSON UpdateInstance' {Maybe Bool
Maybe [Text]
Maybe Text
Maybe Architecture
Maybe AutoScalingType
Text
instanceId :: Text
sshKeyName :: Maybe Text
os :: Maybe Text
layerIds :: Maybe [Text]
instanceType :: Maybe Text
installUpdatesOnBoot :: Maybe Bool
hostname :: Maybe Text
ebsOptimized :: Maybe Bool
autoScalingType :: Maybe AutoScalingType
architecture :: Maybe Architecture
amiId :: Maybe Text
agentVersion :: Maybe Text
$sel:instanceId:UpdateInstance' :: UpdateInstance -> Text
$sel:sshKeyName:UpdateInstance' :: UpdateInstance -> Maybe Text
$sel:os:UpdateInstance' :: UpdateInstance -> Maybe Text
$sel:layerIds:UpdateInstance' :: UpdateInstance -> Maybe [Text]
$sel:instanceType:UpdateInstance' :: UpdateInstance -> Maybe Text
$sel:installUpdatesOnBoot:UpdateInstance' :: UpdateInstance -> Maybe Bool
$sel:hostname:UpdateInstance' :: UpdateInstance -> Maybe Text
$sel:ebsOptimized:UpdateInstance' :: UpdateInstance -> Maybe Bool
$sel:autoScalingType:UpdateInstance' :: UpdateInstance -> Maybe AutoScalingType
$sel:architecture:UpdateInstance' :: UpdateInstance -> Maybe Architecture
$sel:amiId:UpdateInstance' :: UpdateInstance -> Maybe Text
$sel:agentVersion:UpdateInstance' :: UpdateInstance -> 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
"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
"InstanceType" 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
instanceType,
            (Key
"LayerIds" 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]
layerIds,
            (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
"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,
            forall a. a -> Maybe a
Prelude.Just (Key
"InstanceId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
instanceId)
          ]
      )

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

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

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

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

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