{-# 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.ModifyVolume
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- You can modify several parameters of an existing EBS volume, including
-- volume size, volume type, and IOPS capacity. If your EBS volume is
-- attached to a current-generation EC2 instance type, you might be able to
-- apply these changes without stopping the instance or detaching the
-- volume from it. For more information about modifying EBS volumes, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/ebs-modify-volume.html Amazon EBS Elastic Volumes>
-- (Linux instances) or
-- <https://docs.aws.amazon.com/AWSEC2/latest/WindowsGuide/ebs-modify-volume.html Amazon EBS Elastic Volumes>
-- (Windows instances).
--
-- When you complete a resize operation on your volume, you need to extend
-- the volume\'s file-system size to take advantage of the new storage
-- capacity. For more information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/ebs-expand-volume.html#recognize-expanded-volume-linux Extend a Linux file system>
-- or
-- <https://docs.aws.amazon.com/AWSEC2/latest/WindowsGuide/ebs-expand-volume.html#recognize-expanded-volume-windows Extend a Windows file system>.
--
-- You can use CloudWatch Events to check the status of a modification to
-- an EBS volume. For information about CloudWatch Events, see the
-- <https://docs.aws.amazon.com/AmazonCloudWatch/latest/events/ Amazon CloudWatch Events User Guide>.
-- You can also track the status of a modification using
-- DescribeVolumesModifications. For information about tracking status
-- changes using either method, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/monitoring-volume-modifications.html Monitor the progress of volume modifications>.
--
-- With previous-generation instance types, resizing an EBS volume might
-- require detaching and reattaching the volume or stopping and restarting
-- the instance.
--
-- After modifying a volume, you must wait at least six hours and ensure
-- that the volume is in the @in-use@ or @available@ state before you can
-- modify the same volume. This is sometimes referred to as a cooldown
-- period.
module Amazonka.EC2.ModifyVolume
  ( -- * Creating a Request
    ModifyVolume (..),
    newModifyVolume,

    -- * Request Lenses
    modifyVolume_dryRun,
    modifyVolume_iops,
    modifyVolume_multiAttachEnabled,
    modifyVolume_size,
    modifyVolume_throughput,
    modifyVolume_volumeType,
    modifyVolume_volumeId,

    -- * Destructuring the Response
    ModifyVolumeResponse (..),
    newModifyVolumeResponse,

    -- * Response Lenses
    modifyVolumeResponse_volumeModification,
    modifyVolumeResponse_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:/ 'newModifyVolume' smart constructor.
data ModifyVolume = ModifyVolume'
  { -- | 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@.
    ModifyVolume -> Maybe Bool
dryRun :: Prelude.Maybe Prelude.Bool,
    -- | The target IOPS rate of the volume. This parameter is valid only for
    -- @gp3@, @io1@, and @io2@ volumes.
    --
    -- The following are the supported values for each volume type:
    --
    -- -   @gp3@: 3,000-16,000 IOPS
    --
    -- -   @io1@: 100-64,000 IOPS
    --
    -- -   @io2@: 100-64,000 IOPS
    --
    -- Default: The existing value is retained if you keep the same volume
    -- type. If you change the volume type to @io1@, @io2@, or @gp3@, the
    -- default is 3,000.
    ModifyVolume -> Maybe Int
iops :: Prelude.Maybe Prelude.Int,
    -- | Specifies whether to enable Amazon EBS Multi-Attach. If you enable
    -- Multi-Attach, you can attach the volume to up to 16
    -- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/instance-types.html#ec2-nitro-instances Nitro-based instances>
    -- in the same Availability Zone. This parameter is supported with @io1@
    -- and @io2@ volumes only. For more information, see
    -- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/ebs-volumes-multi.html Amazon EBS Multi-Attach>
    -- in the /Amazon Elastic Compute Cloud User Guide/.
    ModifyVolume -> Maybe Bool
multiAttachEnabled :: Prelude.Maybe Prelude.Bool,
    -- | The target size of the volume, in GiB. The target volume size must be
    -- greater than or equal to the existing size of the volume.
    --
    -- The following are the supported volumes sizes for each volume type:
    --
    -- -   @gp2@ and @gp3@: 1-16,384
    --
    -- -   @io1@ and @io2@: 4-16,384
    --
    -- -   @st1@ and @sc1@: 125-16,384
    --
    -- -   @standard@: 1-1,024
    --
    -- Default: The existing size is retained.
    ModifyVolume -> Maybe Int
size :: Prelude.Maybe Prelude.Int,
    -- | The target throughput of the volume, in MiB\/s. This parameter is valid
    -- only for @gp3@ volumes. The maximum value is 1,000.
    --
    -- Default: The existing value is retained if the source and target volume
    -- type is @gp3@. Otherwise, the default value is 125.
    --
    -- Valid Range: Minimum value of 125. Maximum value of 1000.
    ModifyVolume -> Maybe Int
throughput :: Prelude.Maybe Prelude.Int,
    -- | The target EBS volume type of the volume. For more information, see
    -- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/EBSVolumeTypes.html Amazon EBS volume types>
    -- in the /Amazon Elastic Compute Cloud User Guide/.
    --
    -- Default: The existing type is retained.
    ModifyVolume -> Maybe VolumeType
volumeType :: Prelude.Maybe VolumeType,
    -- | The ID of the volume.
    ModifyVolume -> Text
volumeId :: Prelude.Text
  }
  deriving (ModifyVolume -> ModifyVolume -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModifyVolume -> ModifyVolume -> Bool
$c/= :: ModifyVolume -> ModifyVolume -> Bool
== :: ModifyVolume -> ModifyVolume -> Bool
$c== :: ModifyVolume -> ModifyVolume -> Bool
Prelude.Eq, ReadPrec [ModifyVolume]
ReadPrec ModifyVolume
Int -> ReadS ModifyVolume
ReadS [ModifyVolume]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ModifyVolume]
$creadListPrec :: ReadPrec [ModifyVolume]
readPrec :: ReadPrec ModifyVolume
$creadPrec :: ReadPrec ModifyVolume
readList :: ReadS [ModifyVolume]
$creadList :: ReadS [ModifyVolume]
readsPrec :: Int -> ReadS ModifyVolume
$creadsPrec :: Int -> ReadS ModifyVolume
Prelude.Read, Int -> ModifyVolume -> ShowS
[ModifyVolume] -> ShowS
ModifyVolume -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ModifyVolume] -> ShowS
$cshowList :: [ModifyVolume] -> ShowS
show :: ModifyVolume -> String
$cshow :: ModifyVolume -> String
showsPrec :: Int -> ModifyVolume -> ShowS
$cshowsPrec :: Int -> ModifyVolume -> ShowS
Prelude.Show, forall x. Rep ModifyVolume x -> ModifyVolume
forall x. ModifyVolume -> Rep ModifyVolume x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ModifyVolume x -> ModifyVolume
$cfrom :: forall x. ModifyVolume -> Rep ModifyVolume x
Prelude.Generic)

-- |
-- Create a value of 'ModifyVolume' 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:
--
-- 'dryRun', 'modifyVolume_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@.
--
-- 'iops', 'modifyVolume_iops' - The target IOPS rate of the volume. This parameter is valid only for
-- @gp3@, @io1@, and @io2@ volumes.
--
-- The following are the supported values for each volume type:
--
-- -   @gp3@: 3,000-16,000 IOPS
--
-- -   @io1@: 100-64,000 IOPS
--
-- -   @io2@: 100-64,000 IOPS
--
-- Default: The existing value is retained if you keep the same volume
-- type. If you change the volume type to @io1@, @io2@, or @gp3@, the
-- default is 3,000.
--
-- 'multiAttachEnabled', 'modifyVolume_multiAttachEnabled' - Specifies whether to enable Amazon EBS Multi-Attach. If you enable
-- Multi-Attach, you can attach the volume to up to 16
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/instance-types.html#ec2-nitro-instances Nitro-based instances>
-- in the same Availability Zone. This parameter is supported with @io1@
-- and @io2@ volumes only. For more information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/ebs-volumes-multi.html Amazon EBS Multi-Attach>
-- in the /Amazon Elastic Compute Cloud User Guide/.
--
-- 'size', 'modifyVolume_size' - The target size of the volume, in GiB. The target volume size must be
-- greater than or equal to the existing size of the volume.
--
-- The following are the supported volumes sizes for each volume type:
--
-- -   @gp2@ and @gp3@: 1-16,384
--
-- -   @io1@ and @io2@: 4-16,384
--
-- -   @st1@ and @sc1@: 125-16,384
--
-- -   @standard@: 1-1,024
--
-- Default: The existing size is retained.
--
-- 'throughput', 'modifyVolume_throughput' - The target throughput of the volume, in MiB\/s. This parameter is valid
-- only for @gp3@ volumes. The maximum value is 1,000.
--
-- Default: The existing value is retained if the source and target volume
-- type is @gp3@. Otherwise, the default value is 125.
--
-- Valid Range: Minimum value of 125. Maximum value of 1000.
--
-- 'volumeType', 'modifyVolume_volumeType' - The target EBS volume type of the volume. For more information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/EBSVolumeTypes.html Amazon EBS volume types>
-- in the /Amazon Elastic Compute Cloud User Guide/.
--
-- Default: The existing type is retained.
--
-- 'volumeId', 'modifyVolume_volumeId' - The ID of the volume.
newModifyVolume ::
  -- | 'volumeId'
  Prelude.Text ->
  ModifyVolume
newModifyVolume :: Text -> ModifyVolume
newModifyVolume Text
pVolumeId_ =
  ModifyVolume'
    { $sel:dryRun:ModifyVolume' :: Maybe Bool
dryRun = forall a. Maybe a
Prelude.Nothing,
      $sel:iops:ModifyVolume' :: Maybe Int
iops = forall a. Maybe a
Prelude.Nothing,
      $sel:multiAttachEnabled:ModifyVolume' :: Maybe Bool
multiAttachEnabled = forall a. Maybe a
Prelude.Nothing,
      $sel:size:ModifyVolume' :: Maybe Int
size = forall a. Maybe a
Prelude.Nothing,
      $sel:throughput:ModifyVolume' :: Maybe Int
throughput = forall a. Maybe a
Prelude.Nothing,
      $sel:volumeType:ModifyVolume' :: Maybe VolumeType
volumeType = forall a. Maybe a
Prelude.Nothing,
      $sel:volumeId:ModifyVolume' :: Text
volumeId = Text
pVolumeId_
    }

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

-- | The target IOPS rate of the volume. This parameter is valid only for
-- @gp3@, @io1@, and @io2@ volumes.
--
-- The following are the supported values for each volume type:
--
-- -   @gp3@: 3,000-16,000 IOPS
--
-- -   @io1@: 100-64,000 IOPS
--
-- -   @io2@: 100-64,000 IOPS
--
-- Default: The existing value is retained if you keep the same volume
-- type. If you change the volume type to @io1@, @io2@, or @gp3@, the
-- default is 3,000.
modifyVolume_iops :: Lens.Lens' ModifyVolume (Prelude.Maybe Prelude.Int)
modifyVolume_iops :: Lens' ModifyVolume (Maybe Int)
modifyVolume_iops = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyVolume' {Maybe Int
iops :: Maybe Int
$sel:iops:ModifyVolume' :: ModifyVolume -> Maybe Int
iops} -> Maybe Int
iops) (\s :: ModifyVolume
s@ModifyVolume' {} Maybe Int
a -> ModifyVolume
s {$sel:iops:ModifyVolume' :: Maybe Int
iops = Maybe Int
a} :: ModifyVolume)

-- | Specifies whether to enable Amazon EBS Multi-Attach. If you enable
-- Multi-Attach, you can attach the volume to up to 16
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/instance-types.html#ec2-nitro-instances Nitro-based instances>
-- in the same Availability Zone. This parameter is supported with @io1@
-- and @io2@ volumes only. For more information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/ebs-volumes-multi.html Amazon EBS Multi-Attach>
-- in the /Amazon Elastic Compute Cloud User Guide/.
modifyVolume_multiAttachEnabled :: Lens.Lens' ModifyVolume (Prelude.Maybe Prelude.Bool)
modifyVolume_multiAttachEnabled :: Lens' ModifyVolume (Maybe Bool)
modifyVolume_multiAttachEnabled = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyVolume' {Maybe Bool
multiAttachEnabled :: Maybe Bool
$sel:multiAttachEnabled:ModifyVolume' :: ModifyVolume -> Maybe Bool
multiAttachEnabled} -> Maybe Bool
multiAttachEnabled) (\s :: ModifyVolume
s@ModifyVolume' {} Maybe Bool
a -> ModifyVolume
s {$sel:multiAttachEnabled:ModifyVolume' :: Maybe Bool
multiAttachEnabled = Maybe Bool
a} :: ModifyVolume)

-- | The target size of the volume, in GiB. The target volume size must be
-- greater than or equal to the existing size of the volume.
--
-- The following are the supported volumes sizes for each volume type:
--
-- -   @gp2@ and @gp3@: 1-16,384
--
-- -   @io1@ and @io2@: 4-16,384
--
-- -   @st1@ and @sc1@: 125-16,384
--
-- -   @standard@: 1-1,024
--
-- Default: The existing size is retained.
modifyVolume_size :: Lens.Lens' ModifyVolume (Prelude.Maybe Prelude.Int)
modifyVolume_size :: Lens' ModifyVolume (Maybe Int)
modifyVolume_size = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyVolume' {Maybe Int
size :: Maybe Int
$sel:size:ModifyVolume' :: ModifyVolume -> Maybe Int
size} -> Maybe Int
size) (\s :: ModifyVolume
s@ModifyVolume' {} Maybe Int
a -> ModifyVolume
s {$sel:size:ModifyVolume' :: Maybe Int
size = Maybe Int
a} :: ModifyVolume)

-- | The target throughput of the volume, in MiB\/s. This parameter is valid
-- only for @gp3@ volumes. The maximum value is 1,000.
--
-- Default: The existing value is retained if the source and target volume
-- type is @gp3@. Otherwise, the default value is 125.
--
-- Valid Range: Minimum value of 125. Maximum value of 1000.
modifyVolume_throughput :: Lens.Lens' ModifyVolume (Prelude.Maybe Prelude.Int)
modifyVolume_throughput :: Lens' ModifyVolume (Maybe Int)
modifyVolume_throughput = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyVolume' {Maybe Int
throughput :: Maybe Int
$sel:throughput:ModifyVolume' :: ModifyVolume -> Maybe Int
throughput} -> Maybe Int
throughput) (\s :: ModifyVolume
s@ModifyVolume' {} Maybe Int
a -> ModifyVolume
s {$sel:throughput:ModifyVolume' :: Maybe Int
throughput = Maybe Int
a} :: ModifyVolume)

-- | The target EBS volume type of the volume. For more information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/EBSVolumeTypes.html Amazon EBS volume types>
-- in the /Amazon Elastic Compute Cloud User Guide/.
--
-- Default: The existing type is retained.
modifyVolume_volumeType :: Lens.Lens' ModifyVolume (Prelude.Maybe VolumeType)
modifyVolume_volumeType :: Lens' ModifyVolume (Maybe VolumeType)
modifyVolume_volumeType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyVolume' {Maybe VolumeType
volumeType :: Maybe VolumeType
$sel:volumeType:ModifyVolume' :: ModifyVolume -> Maybe VolumeType
volumeType} -> Maybe VolumeType
volumeType) (\s :: ModifyVolume
s@ModifyVolume' {} Maybe VolumeType
a -> ModifyVolume
s {$sel:volumeType:ModifyVolume' :: Maybe VolumeType
volumeType = Maybe VolumeType
a} :: ModifyVolume)

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

instance Core.AWSRequest ModifyVolume where
  type AWSResponse ModifyVolume = ModifyVolumeResponse
  request :: (Service -> Service) -> ModifyVolume -> Request ModifyVolume
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 ModifyVolume
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse ModifyVolume)))
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 VolumeModification -> Int -> ModifyVolumeResponse
ModifyVolumeResponse'
            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
"volumeModification")
            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 ModifyVolume where
  hashWithSalt :: Int -> ModifyVolume -> Int
hashWithSalt Int
_salt ModifyVolume' {Maybe Bool
Maybe Int
Maybe VolumeType
Text
volumeId :: Text
volumeType :: Maybe VolumeType
throughput :: Maybe Int
size :: Maybe Int
multiAttachEnabled :: Maybe Bool
iops :: Maybe Int
dryRun :: Maybe Bool
$sel:volumeId:ModifyVolume' :: ModifyVolume -> Text
$sel:volumeType:ModifyVolume' :: ModifyVolume -> Maybe VolumeType
$sel:throughput:ModifyVolume' :: ModifyVolume -> Maybe Int
$sel:size:ModifyVolume' :: ModifyVolume -> Maybe Int
$sel:multiAttachEnabled:ModifyVolume' :: ModifyVolume -> Maybe Bool
$sel:iops:ModifyVolume' :: ModifyVolume -> Maybe Int
$sel:dryRun:ModifyVolume' :: ModifyVolume -> Maybe Bool
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
dryRun
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
iops
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
multiAttachEnabled
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
size
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
throughput
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe VolumeType
volumeType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
volumeId

instance Prelude.NFData ModifyVolume where
  rnf :: ModifyVolume -> ()
rnf ModifyVolume' {Maybe Bool
Maybe Int
Maybe VolumeType
Text
volumeId :: Text
volumeType :: Maybe VolumeType
throughput :: Maybe Int
size :: Maybe Int
multiAttachEnabled :: Maybe Bool
iops :: Maybe Int
dryRun :: Maybe Bool
$sel:volumeId:ModifyVolume' :: ModifyVolume -> Text
$sel:volumeType:ModifyVolume' :: ModifyVolume -> Maybe VolumeType
$sel:throughput:ModifyVolume' :: ModifyVolume -> Maybe Int
$sel:size:ModifyVolume' :: ModifyVolume -> Maybe Int
$sel:multiAttachEnabled:ModifyVolume' :: ModifyVolume -> Maybe Bool
$sel:iops:ModifyVolume' :: ModifyVolume -> Maybe Int
$sel:dryRun:ModifyVolume' :: ModifyVolume -> Maybe Bool
..} =
    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 Int
iops
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
multiAttachEnabled
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
size
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
throughput
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe VolumeType
volumeType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
volumeId

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

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

instance Data.ToQuery ModifyVolume where
  toQuery :: ModifyVolume -> QueryString
toQuery ModifyVolume' {Maybe Bool
Maybe Int
Maybe VolumeType
Text
volumeId :: Text
volumeType :: Maybe VolumeType
throughput :: Maybe Int
size :: Maybe Int
multiAttachEnabled :: Maybe Bool
iops :: Maybe Int
dryRun :: Maybe Bool
$sel:volumeId:ModifyVolume' :: ModifyVolume -> Text
$sel:volumeType:ModifyVolume' :: ModifyVolume -> Maybe VolumeType
$sel:throughput:ModifyVolume' :: ModifyVolume -> Maybe Int
$sel:size:ModifyVolume' :: ModifyVolume -> Maybe Int
$sel:multiAttachEnabled:ModifyVolume' :: ModifyVolume -> Maybe Bool
$sel:iops:ModifyVolume' :: ModifyVolume -> Maybe Int
$sel:dryRun:ModifyVolume' :: ModifyVolume -> Maybe Bool
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"ModifyVolume" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2016-11-15" :: Prelude.ByteString),
        ByteString
"DryRun" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
dryRun,
        ByteString
"Iops" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Int
iops,
        ByteString
"MultiAttachEnabled" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
multiAttachEnabled,
        ByteString
"Size" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Int
size,
        ByteString
"Throughput" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Int
throughput,
        ByteString
"VolumeType" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe VolumeType
volumeType,
        ByteString
"VolumeId" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
volumeId
      ]

-- | /See:/ 'newModifyVolumeResponse' smart constructor.
data ModifyVolumeResponse = ModifyVolumeResponse'
  { -- | Information about the volume modification.
    ModifyVolumeResponse -> Maybe VolumeModification
volumeModification :: Prelude.Maybe VolumeModification,
    -- | The response's http status code.
    ModifyVolumeResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ModifyVolumeResponse -> ModifyVolumeResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModifyVolumeResponse -> ModifyVolumeResponse -> Bool
$c/= :: ModifyVolumeResponse -> ModifyVolumeResponse -> Bool
== :: ModifyVolumeResponse -> ModifyVolumeResponse -> Bool
$c== :: ModifyVolumeResponse -> ModifyVolumeResponse -> Bool
Prelude.Eq, ReadPrec [ModifyVolumeResponse]
ReadPrec ModifyVolumeResponse
Int -> ReadS ModifyVolumeResponse
ReadS [ModifyVolumeResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ModifyVolumeResponse]
$creadListPrec :: ReadPrec [ModifyVolumeResponse]
readPrec :: ReadPrec ModifyVolumeResponse
$creadPrec :: ReadPrec ModifyVolumeResponse
readList :: ReadS [ModifyVolumeResponse]
$creadList :: ReadS [ModifyVolumeResponse]
readsPrec :: Int -> ReadS ModifyVolumeResponse
$creadsPrec :: Int -> ReadS ModifyVolumeResponse
Prelude.Read, Int -> ModifyVolumeResponse -> ShowS
[ModifyVolumeResponse] -> ShowS
ModifyVolumeResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ModifyVolumeResponse] -> ShowS
$cshowList :: [ModifyVolumeResponse] -> ShowS
show :: ModifyVolumeResponse -> String
$cshow :: ModifyVolumeResponse -> String
showsPrec :: Int -> ModifyVolumeResponse -> ShowS
$cshowsPrec :: Int -> ModifyVolumeResponse -> ShowS
Prelude.Show, forall x. Rep ModifyVolumeResponse x -> ModifyVolumeResponse
forall x. ModifyVolumeResponse -> Rep ModifyVolumeResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ModifyVolumeResponse x -> ModifyVolumeResponse
$cfrom :: forall x. ModifyVolumeResponse -> Rep ModifyVolumeResponse x
Prelude.Generic)

-- |
-- Create a value of 'ModifyVolumeResponse' 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:
--
-- 'volumeModification', 'modifyVolumeResponse_volumeModification' - Information about the volume modification.
--
-- 'httpStatus', 'modifyVolumeResponse_httpStatus' - The response's http status code.
newModifyVolumeResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ModifyVolumeResponse
newModifyVolumeResponse :: Int -> ModifyVolumeResponse
newModifyVolumeResponse Int
pHttpStatus_ =
  ModifyVolumeResponse'
    { $sel:volumeModification:ModifyVolumeResponse' :: Maybe VolumeModification
volumeModification =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ModifyVolumeResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Information about the volume modification.
modifyVolumeResponse_volumeModification :: Lens.Lens' ModifyVolumeResponse (Prelude.Maybe VolumeModification)
modifyVolumeResponse_volumeModification :: Lens' ModifyVolumeResponse (Maybe VolumeModification)
modifyVolumeResponse_volumeModification = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyVolumeResponse' {Maybe VolumeModification
volumeModification :: Maybe VolumeModification
$sel:volumeModification:ModifyVolumeResponse' :: ModifyVolumeResponse -> Maybe VolumeModification
volumeModification} -> Maybe VolumeModification
volumeModification) (\s :: ModifyVolumeResponse
s@ModifyVolumeResponse' {} Maybe VolumeModification
a -> ModifyVolumeResponse
s {$sel:volumeModification:ModifyVolumeResponse' :: Maybe VolumeModification
volumeModification = Maybe VolumeModification
a} :: ModifyVolumeResponse)

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

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