{-# 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.ModifyInstanceMaintenanceOptions
-- 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 recovery behavior of your instance to disable simplified
-- automatic recovery or set the recovery behavior to default. The default
-- configuration will not enable simplified automatic recovery for an
-- unsupported instance type. For more information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/ec2-instance-recover.html#instance-configuration-recovery Simplified automatic recovery>.
module Amazonka.EC2.ModifyInstanceMaintenanceOptions
  ( -- * Creating a Request
    ModifyInstanceMaintenanceOptions (..),
    newModifyInstanceMaintenanceOptions,

    -- * Request Lenses
    modifyInstanceMaintenanceOptions_autoRecovery,
    modifyInstanceMaintenanceOptions_dryRun,
    modifyInstanceMaintenanceOptions_instanceId,

    -- * Destructuring the Response
    ModifyInstanceMaintenanceOptionsResponse (..),
    newModifyInstanceMaintenanceOptionsResponse,

    -- * Response Lenses
    modifyInstanceMaintenanceOptionsResponse_autoRecovery,
    modifyInstanceMaintenanceOptionsResponse_instanceId,
    modifyInstanceMaintenanceOptionsResponse_httpStatus,
  )
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:/ 'newModifyInstanceMaintenanceOptions' smart constructor.
data ModifyInstanceMaintenanceOptions = ModifyInstanceMaintenanceOptions'
  { -- | Disables the automatic recovery behavior of your instance or sets it to
    -- default.
    ModifyInstanceMaintenanceOptions -> Maybe InstanceAutoRecoveryState
autoRecovery :: Prelude.Maybe InstanceAutoRecoveryState,
    -- | 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@.
    ModifyInstanceMaintenanceOptions -> Maybe Bool
dryRun :: Prelude.Maybe Prelude.Bool,
    -- | The ID of the instance.
    ModifyInstanceMaintenanceOptions -> Text
instanceId :: Prelude.Text
  }
  deriving (ModifyInstanceMaintenanceOptions
-> ModifyInstanceMaintenanceOptions -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModifyInstanceMaintenanceOptions
-> ModifyInstanceMaintenanceOptions -> Bool
$c/= :: ModifyInstanceMaintenanceOptions
-> ModifyInstanceMaintenanceOptions -> Bool
== :: ModifyInstanceMaintenanceOptions
-> ModifyInstanceMaintenanceOptions -> Bool
$c== :: ModifyInstanceMaintenanceOptions
-> ModifyInstanceMaintenanceOptions -> Bool
Prelude.Eq, ReadPrec [ModifyInstanceMaintenanceOptions]
ReadPrec ModifyInstanceMaintenanceOptions
Int -> ReadS ModifyInstanceMaintenanceOptions
ReadS [ModifyInstanceMaintenanceOptions]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ModifyInstanceMaintenanceOptions]
$creadListPrec :: ReadPrec [ModifyInstanceMaintenanceOptions]
readPrec :: ReadPrec ModifyInstanceMaintenanceOptions
$creadPrec :: ReadPrec ModifyInstanceMaintenanceOptions
readList :: ReadS [ModifyInstanceMaintenanceOptions]
$creadList :: ReadS [ModifyInstanceMaintenanceOptions]
readsPrec :: Int -> ReadS ModifyInstanceMaintenanceOptions
$creadsPrec :: Int -> ReadS ModifyInstanceMaintenanceOptions
Prelude.Read, Int -> ModifyInstanceMaintenanceOptions -> ShowS
[ModifyInstanceMaintenanceOptions] -> ShowS
ModifyInstanceMaintenanceOptions -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ModifyInstanceMaintenanceOptions] -> ShowS
$cshowList :: [ModifyInstanceMaintenanceOptions] -> ShowS
show :: ModifyInstanceMaintenanceOptions -> String
$cshow :: ModifyInstanceMaintenanceOptions -> String
showsPrec :: Int -> ModifyInstanceMaintenanceOptions -> ShowS
$cshowsPrec :: Int -> ModifyInstanceMaintenanceOptions -> ShowS
Prelude.Show, forall x.
Rep ModifyInstanceMaintenanceOptions x
-> ModifyInstanceMaintenanceOptions
forall x.
ModifyInstanceMaintenanceOptions
-> Rep ModifyInstanceMaintenanceOptions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ModifyInstanceMaintenanceOptions x
-> ModifyInstanceMaintenanceOptions
$cfrom :: forall x.
ModifyInstanceMaintenanceOptions
-> Rep ModifyInstanceMaintenanceOptions x
Prelude.Generic)

-- |
-- Create a value of 'ModifyInstanceMaintenanceOptions' 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:
--
-- 'autoRecovery', 'modifyInstanceMaintenanceOptions_autoRecovery' - Disables the automatic recovery behavior of your instance or sets it to
-- default.
--
-- 'dryRun', 'modifyInstanceMaintenanceOptions_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@.
--
-- 'instanceId', 'modifyInstanceMaintenanceOptions_instanceId' - The ID of the instance.
newModifyInstanceMaintenanceOptions ::
  -- | 'instanceId'
  Prelude.Text ->
  ModifyInstanceMaintenanceOptions
newModifyInstanceMaintenanceOptions :: Text -> ModifyInstanceMaintenanceOptions
newModifyInstanceMaintenanceOptions Text
pInstanceId_ =
  ModifyInstanceMaintenanceOptions'
    { $sel:autoRecovery:ModifyInstanceMaintenanceOptions' :: Maybe InstanceAutoRecoveryState
autoRecovery =
        forall a. Maybe a
Prelude.Nothing,
      $sel:dryRun:ModifyInstanceMaintenanceOptions' :: Maybe Bool
dryRun = forall a. Maybe a
Prelude.Nothing,
      $sel:instanceId:ModifyInstanceMaintenanceOptions' :: Text
instanceId = Text
pInstanceId_
    }

-- | Disables the automatic recovery behavior of your instance or sets it to
-- default.
modifyInstanceMaintenanceOptions_autoRecovery :: Lens.Lens' ModifyInstanceMaintenanceOptions (Prelude.Maybe InstanceAutoRecoveryState)
modifyInstanceMaintenanceOptions_autoRecovery :: Lens'
  ModifyInstanceMaintenanceOptions (Maybe InstanceAutoRecoveryState)
modifyInstanceMaintenanceOptions_autoRecovery = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyInstanceMaintenanceOptions' {Maybe InstanceAutoRecoveryState
autoRecovery :: Maybe InstanceAutoRecoveryState
$sel:autoRecovery:ModifyInstanceMaintenanceOptions' :: ModifyInstanceMaintenanceOptions -> Maybe InstanceAutoRecoveryState
autoRecovery} -> Maybe InstanceAutoRecoveryState
autoRecovery) (\s :: ModifyInstanceMaintenanceOptions
s@ModifyInstanceMaintenanceOptions' {} Maybe InstanceAutoRecoveryState
a -> ModifyInstanceMaintenanceOptions
s {$sel:autoRecovery:ModifyInstanceMaintenanceOptions' :: Maybe InstanceAutoRecoveryState
autoRecovery = Maybe InstanceAutoRecoveryState
a} :: ModifyInstanceMaintenanceOptions)

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

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

instance
  Core.AWSRequest
    ModifyInstanceMaintenanceOptions
  where
  type
    AWSResponse ModifyInstanceMaintenanceOptions =
      ModifyInstanceMaintenanceOptionsResponse
  request :: (Service -> Service)
-> ModifyInstanceMaintenanceOptions
-> Request ModifyInstanceMaintenanceOptions
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 ModifyInstanceMaintenanceOptions
-> ClientResponse ClientBody
-> m (Either
        Error
        (ClientResponse (AWSResponse ModifyInstanceMaintenanceOptions)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> [Node] -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveXML
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Maybe InstanceAutoRecoveryState
-> Maybe Text -> Int -> ModifyInstanceMaintenanceOptionsResponse
ModifyInstanceMaintenanceOptionsResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"autoRecovery")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"instanceId")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
      )

instance
  Prelude.Hashable
    ModifyInstanceMaintenanceOptions
  where
  hashWithSalt :: Int -> ModifyInstanceMaintenanceOptions -> Int
hashWithSalt
    Int
_salt
    ModifyInstanceMaintenanceOptions' {Maybe Bool
Maybe InstanceAutoRecoveryState
Text
instanceId :: Text
dryRun :: Maybe Bool
autoRecovery :: Maybe InstanceAutoRecoveryState
$sel:instanceId:ModifyInstanceMaintenanceOptions' :: ModifyInstanceMaintenanceOptions -> Text
$sel:dryRun:ModifyInstanceMaintenanceOptions' :: ModifyInstanceMaintenanceOptions -> Maybe Bool
$sel:autoRecovery:ModifyInstanceMaintenanceOptions' :: ModifyInstanceMaintenanceOptions -> Maybe InstanceAutoRecoveryState
..} =
      Int
_salt
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe InstanceAutoRecoveryState
autoRecovery
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
dryRun
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
instanceId

instance
  Prelude.NFData
    ModifyInstanceMaintenanceOptions
  where
  rnf :: ModifyInstanceMaintenanceOptions -> ()
rnf ModifyInstanceMaintenanceOptions' {Maybe Bool
Maybe InstanceAutoRecoveryState
Text
instanceId :: Text
dryRun :: Maybe Bool
autoRecovery :: Maybe InstanceAutoRecoveryState
$sel:instanceId:ModifyInstanceMaintenanceOptions' :: ModifyInstanceMaintenanceOptions -> Text
$sel:dryRun:ModifyInstanceMaintenanceOptions' :: ModifyInstanceMaintenanceOptions -> Maybe Bool
$sel:autoRecovery:ModifyInstanceMaintenanceOptions' :: ModifyInstanceMaintenanceOptions -> Maybe InstanceAutoRecoveryState
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe InstanceAutoRecoveryState
autoRecovery
      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 Text
instanceId

instance
  Data.ToHeaders
    ModifyInstanceMaintenanceOptions
  where
  toHeaders :: ModifyInstanceMaintenanceOptions -> ResponseHeaders
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

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

instance
  Data.ToQuery
    ModifyInstanceMaintenanceOptions
  where
  toQuery :: ModifyInstanceMaintenanceOptions -> QueryString
toQuery ModifyInstanceMaintenanceOptions' {Maybe Bool
Maybe InstanceAutoRecoveryState
Text
instanceId :: Text
dryRun :: Maybe Bool
autoRecovery :: Maybe InstanceAutoRecoveryState
$sel:instanceId:ModifyInstanceMaintenanceOptions' :: ModifyInstanceMaintenanceOptions -> Text
$sel:dryRun:ModifyInstanceMaintenanceOptions' :: ModifyInstanceMaintenanceOptions -> Maybe Bool
$sel:autoRecovery:ModifyInstanceMaintenanceOptions' :: ModifyInstanceMaintenanceOptions -> Maybe InstanceAutoRecoveryState
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: ( ByteString
"ModifyInstanceMaintenanceOptions" ::
                      Prelude.ByteString
                  ),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2016-11-15" :: Prelude.ByteString),
        ByteString
"AutoRecovery" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe InstanceAutoRecoveryState
autoRecovery,
        ByteString
"DryRun" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
dryRun,
        ByteString
"InstanceId" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
instanceId
      ]

-- | /See:/ 'newModifyInstanceMaintenanceOptionsResponse' smart constructor.
data ModifyInstanceMaintenanceOptionsResponse = ModifyInstanceMaintenanceOptionsResponse'
  { -- | Provides information on the current automatic recovery behavior of your
    -- instance.
    ModifyInstanceMaintenanceOptionsResponse
-> Maybe InstanceAutoRecoveryState
autoRecovery :: Prelude.Maybe InstanceAutoRecoveryState,
    -- | The ID of the instance.
    ModifyInstanceMaintenanceOptionsResponse -> Maybe Text
instanceId :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    ModifyInstanceMaintenanceOptionsResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ModifyInstanceMaintenanceOptionsResponse
-> ModifyInstanceMaintenanceOptionsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModifyInstanceMaintenanceOptionsResponse
-> ModifyInstanceMaintenanceOptionsResponse -> Bool
$c/= :: ModifyInstanceMaintenanceOptionsResponse
-> ModifyInstanceMaintenanceOptionsResponse -> Bool
== :: ModifyInstanceMaintenanceOptionsResponse
-> ModifyInstanceMaintenanceOptionsResponse -> Bool
$c== :: ModifyInstanceMaintenanceOptionsResponse
-> ModifyInstanceMaintenanceOptionsResponse -> Bool
Prelude.Eq, ReadPrec [ModifyInstanceMaintenanceOptionsResponse]
ReadPrec ModifyInstanceMaintenanceOptionsResponse
Int -> ReadS ModifyInstanceMaintenanceOptionsResponse
ReadS [ModifyInstanceMaintenanceOptionsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ModifyInstanceMaintenanceOptionsResponse]
$creadListPrec :: ReadPrec [ModifyInstanceMaintenanceOptionsResponse]
readPrec :: ReadPrec ModifyInstanceMaintenanceOptionsResponse
$creadPrec :: ReadPrec ModifyInstanceMaintenanceOptionsResponse
readList :: ReadS [ModifyInstanceMaintenanceOptionsResponse]
$creadList :: ReadS [ModifyInstanceMaintenanceOptionsResponse]
readsPrec :: Int -> ReadS ModifyInstanceMaintenanceOptionsResponse
$creadsPrec :: Int -> ReadS ModifyInstanceMaintenanceOptionsResponse
Prelude.Read, Int -> ModifyInstanceMaintenanceOptionsResponse -> ShowS
[ModifyInstanceMaintenanceOptionsResponse] -> ShowS
ModifyInstanceMaintenanceOptionsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ModifyInstanceMaintenanceOptionsResponse] -> ShowS
$cshowList :: [ModifyInstanceMaintenanceOptionsResponse] -> ShowS
show :: ModifyInstanceMaintenanceOptionsResponse -> String
$cshow :: ModifyInstanceMaintenanceOptionsResponse -> String
showsPrec :: Int -> ModifyInstanceMaintenanceOptionsResponse -> ShowS
$cshowsPrec :: Int -> ModifyInstanceMaintenanceOptionsResponse -> ShowS
Prelude.Show, forall x.
Rep ModifyInstanceMaintenanceOptionsResponse x
-> ModifyInstanceMaintenanceOptionsResponse
forall x.
ModifyInstanceMaintenanceOptionsResponse
-> Rep ModifyInstanceMaintenanceOptionsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ModifyInstanceMaintenanceOptionsResponse x
-> ModifyInstanceMaintenanceOptionsResponse
$cfrom :: forall x.
ModifyInstanceMaintenanceOptionsResponse
-> Rep ModifyInstanceMaintenanceOptionsResponse x
Prelude.Generic)

-- |
-- Create a value of 'ModifyInstanceMaintenanceOptionsResponse' 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:
--
-- 'autoRecovery', 'modifyInstanceMaintenanceOptionsResponse_autoRecovery' - Provides information on the current automatic recovery behavior of your
-- instance.
--
-- 'instanceId', 'modifyInstanceMaintenanceOptionsResponse_instanceId' - The ID of the instance.
--
-- 'httpStatus', 'modifyInstanceMaintenanceOptionsResponse_httpStatus' - The response's http status code.
newModifyInstanceMaintenanceOptionsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ModifyInstanceMaintenanceOptionsResponse
newModifyInstanceMaintenanceOptionsResponse :: Int -> ModifyInstanceMaintenanceOptionsResponse
newModifyInstanceMaintenanceOptionsResponse
  Int
pHttpStatus_ =
    ModifyInstanceMaintenanceOptionsResponse'
      { $sel:autoRecovery:ModifyInstanceMaintenanceOptionsResponse' :: Maybe InstanceAutoRecoveryState
autoRecovery =
          forall a. Maybe a
Prelude.Nothing,
        $sel:instanceId:ModifyInstanceMaintenanceOptionsResponse' :: Maybe Text
instanceId = forall a. Maybe a
Prelude.Nothing,
        $sel:httpStatus:ModifyInstanceMaintenanceOptionsResponse' :: Int
httpStatus = Int
pHttpStatus_
      }

-- | Provides information on the current automatic recovery behavior of your
-- instance.
modifyInstanceMaintenanceOptionsResponse_autoRecovery :: Lens.Lens' ModifyInstanceMaintenanceOptionsResponse (Prelude.Maybe InstanceAutoRecoveryState)
modifyInstanceMaintenanceOptionsResponse_autoRecovery :: Lens'
  ModifyInstanceMaintenanceOptionsResponse
  (Maybe InstanceAutoRecoveryState)
modifyInstanceMaintenanceOptionsResponse_autoRecovery = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyInstanceMaintenanceOptionsResponse' {Maybe InstanceAutoRecoveryState
autoRecovery :: Maybe InstanceAutoRecoveryState
$sel:autoRecovery:ModifyInstanceMaintenanceOptionsResponse' :: ModifyInstanceMaintenanceOptionsResponse
-> Maybe InstanceAutoRecoveryState
autoRecovery} -> Maybe InstanceAutoRecoveryState
autoRecovery) (\s :: ModifyInstanceMaintenanceOptionsResponse
s@ModifyInstanceMaintenanceOptionsResponse' {} Maybe InstanceAutoRecoveryState
a -> ModifyInstanceMaintenanceOptionsResponse
s {$sel:autoRecovery:ModifyInstanceMaintenanceOptionsResponse' :: Maybe InstanceAutoRecoveryState
autoRecovery = Maybe InstanceAutoRecoveryState
a} :: ModifyInstanceMaintenanceOptionsResponse)

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

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

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