{-# 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.ModifyVolumeAttribute
-- 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 a volume attribute.
--
-- By default, all I\/O operations for the volume are suspended when the
-- data on the volume is determined to be potentially inconsistent, to
-- prevent undetectable, latent data corruption. The I\/O access to the
-- volume can be resumed by first enabling I\/O access and then checking
-- the data consistency on your volume.
--
-- You can change the default behavior to resume I\/O operations. We
-- recommend that you change this only for boot volumes or for volumes that
-- are stateless or disposable.
module Amazonka.EC2.ModifyVolumeAttribute
  ( -- * Creating a Request
    ModifyVolumeAttribute (..),
    newModifyVolumeAttribute,

    -- * Request Lenses
    modifyVolumeAttribute_autoEnableIO,
    modifyVolumeAttribute_dryRun,
    modifyVolumeAttribute_volumeId,

    -- * Destructuring the Response
    ModifyVolumeAttributeResponse (..),
    newModifyVolumeAttributeResponse,
  )
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:/ 'newModifyVolumeAttribute' smart constructor.
data ModifyVolumeAttribute = ModifyVolumeAttribute'
  { -- | Indicates whether the volume should be auto-enabled for I\/O operations.
    ModifyVolumeAttribute -> Maybe AttributeBooleanValue
autoEnableIO :: 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@.
    ModifyVolumeAttribute -> Maybe Bool
dryRun :: Prelude.Maybe Prelude.Bool,
    -- | The ID of the volume.
    ModifyVolumeAttribute -> Text
volumeId :: Prelude.Text
  }
  deriving (ModifyVolumeAttribute -> ModifyVolumeAttribute -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModifyVolumeAttribute -> ModifyVolumeAttribute -> Bool
$c/= :: ModifyVolumeAttribute -> ModifyVolumeAttribute -> Bool
== :: ModifyVolumeAttribute -> ModifyVolumeAttribute -> Bool
$c== :: ModifyVolumeAttribute -> ModifyVolumeAttribute -> Bool
Prelude.Eq, ReadPrec [ModifyVolumeAttribute]
ReadPrec ModifyVolumeAttribute
Int -> ReadS ModifyVolumeAttribute
ReadS [ModifyVolumeAttribute]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ModifyVolumeAttribute]
$creadListPrec :: ReadPrec [ModifyVolumeAttribute]
readPrec :: ReadPrec ModifyVolumeAttribute
$creadPrec :: ReadPrec ModifyVolumeAttribute
readList :: ReadS [ModifyVolumeAttribute]
$creadList :: ReadS [ModifyVolumeAttribute]
readsPrec :: Int -> ReadS ModifyVolumeAttribute
$creadsPrec :: Int -> ReadS ModifyVolumeAttribute
Prelude.Read, Int -> ModifyVolumeAttribute -> ShowS
[ModifyVolumeAttribute] -> ShowS
ModifyVolumeAttribute -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ModifyVolumeAttribute] -> ShowS
$cshowList :: [ModifyVolumeAttribute] -> ShowS
show :: ModifyVolumeAttribute -> String
$cshow :: ModifyVolumeAttribute -> String
showsPrec :: Int -> ModifyVolumeAttribute -> ShowS
$cshowsPrec :: Int -> ModifyVolumeAttribute -> ShowS
Prelude.Show, forall x. Rep ModifyVolumeAttribute x -> ModifyVolumeAttribute
forall x. ModifyVolumeAttribute -> Rep ModifyVolumeAttribute x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ModifyVolumeAttribute x -> ModifyVolumeAttribute
$cfrom :: forall x. ModifyVolumeAttribute -> Rep ModifyVolumeAttribute x
Prelude.Generic)

-- |
-- Create a value of 'ModifyVolumeAttribute' 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:
--
-- 'autoEnableIO', 'modifyVolumeAttribute_autoEnableIO' - Indicates whether the volume should be auto-enabled for I\/O operations.
--
-- 'dryRun', 'modifyVolumeAttribute_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@.
--
-- 'volumeId', 'modifyVolumeAttribute_volumeId' - The ID of the volume.
newModifyVolumeAttribute ::
  -- | 'volumeId'
  Prelude.Text ->
  ModifyVolumeAttribute
newModifyVolumeAttribute :: Text -> ModifyVolumeAttribute
newModifyVolumeAttribute Text
pVolumeId_ =
  ModifyVolumeAttribute'
    { $sel:autoEnableIO:ModifyVolumeAttribute' :: Maybe AttributeBooleanValue
autoEnableIO =
        forall a. Maybe a
Prelude.Nothing,
      $sel:dryRun:ModifyVolumeAttribute' :: Maybe Bool
dryRun = forall a. Maybe a
Prelude.Nothing,
      $sel:volumeId:ModifyVolumeAttribute' :: Text
volumeId = Text
pVolumeId_
    }

-- | Indicates whether the volume should be auto-enabled for I\/O operations.
modifyVolumeAttribute_autoEnableIO :: Lens.Lens' ModifyVolumeAttribute (Prelude.Maybe AttributeBooleanValue)
modifyVolumeAttribute_autoEnableIO :: Lens' ModifyVolumeAttribute (Maybe AttributeBooleanValue)
modifyVolumeAttribute_autoEnableIO = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyVolumeAttribute' {Maybe AttributeBooleanValue
autoEnableIO :: Maybe AttributeBooleanValue
$sel:autoEnableIO:ModifyVolumeAttribute' :: ModifyVolumeAttribute -> Maybe AttributeBooleanValue
autoEnableIO} -> Maybe AttributeBooleanValue
autoEnableIO) (\s :: ModifyVolumeAttribute
s@ModifyVolumeAttribute' {} Maybe AttributeBooleanValue
a -> ModifyVolumeAttribute
s {$sel:autoEnableIO:ModifyVolumeAttribute' :: Maybe AttributeBooleanValue
autoEnableIO = Maybe AttributeBooleanValue
a} :: ModifyVolumeAttribute)

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

-- | The ID of the volume.
modifyVolumeAttribute_volumeId :: Lens.Lens' ModifyVolumeAttribute Prelude.Text
modifyVolumeAttribute_volumeId :: Lens' ModifyVolumeAttribute Text
modifyVolumeAttribute_volumeId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyVolumeAttribute' {Text
volumeId :: Text
$sel:volumeId:ModifyVolumeAttribute' :: ModifyVolumeAttribute -> Text
volumeId} -> Text
volumeId) (\s :: ModifyVolumeAttribute
s@ModifyVolumeAttribute' {} Text
a -> ModifyVolumeAttribute
s {$sel:volumeId:ModifyVolumeAttribute' :: Text
volumeId = Text
a} :: ModifyVolumeAttribute)

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

instance Prelude.Hashable ModifyVolumeAttribute where
  hashWithSalt :: Int -> ModifyVolumeAttribute -> Int
hashWithSalt Int
_salt ModifyVolumeAttribute' {Maybe Bool
Maybe AttributeBooleanValue
Text
volumeId :: Text
dryRun :: Maybe Bool
autoEnableIO :: Maybe AttributeBooleanValue
$sel:volumeId:ModifyVolumeAttribute' :: ModifyVolumeAttribute -> Text
$sel:dryRun:ModifyVolumeAttribute' :: ModifyVolumeAttribute -> Maybe Bool
$sel:autoEnableIO:ModifyVolumeAttribute' :: ModifyVolumeAttribute -> Maybe AttributeBooleanValue
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe AttributeBooleanValue
autoEnableIO
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
dryRun
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
volumeId

instance Prelude.NFData ModifyVolumeAttribute where
  rnf :: ModifyVolumeAttribute -> ()
rnf ModifyVolumeAttribute' {Maybe Bool
Maybe AttributeBooleanValue
Text
volumeId :: Text
dryRun :: Maybe Bool
autoEnableIO :: Maybe AttributeBooleanValue
$sel:volumeId:ModifyVolumeAttribute' :: ModifyVolumeAttribute -> Text
$sel:dryRun:ModifyVolumeAttribute' :: ModifyVolumeAttribute -> Maybe Bool
$sel:autoEnableIO:ModifyVolumeAttribute' :: ModifyVolumeAttribute -> Maybe AttributeBooleanValue
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe AttributeBooleanValue
autoEnableIO
      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
volumeId

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

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

instance Data.ToQuery ModifyVolumeAttribute where
  toQuery :: ModifyVolumeAttribute -> QueryString
toQuery ModifyVolumeAttribute' {Maybe Bool
Maybe AttributeBooleanValue
Text
volumeId :: Text
dryRun :: Maybe Bool
autoEnableIO :: Maybe AttributeBooleanValue
$sel:volumeId:ModifyVolumeAttribute' :: ModifyVolumeAttribute -> Text
$sel:dryRun:ModifyVolumeAttribute' :: ModifyVolumeAttribute -> Maybe Bool
$sel:autoEnableIO:ModifyVolumeAttribute' :: ModifyVolumeAttribute -> Maybe AttributeBooleanValue
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"ModifyVolumeAttribute" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2016-11-15" :: Prelude.ByteString),
        ByteString
"AutoEnableIO" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe AttributeBooleanValue
autoEnableIO,
        ByteString
"DryRun" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
dryRun,
        ByteString
"VolumeId" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
volumeId
      ]

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

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

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