{-# 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.DeleteVolume
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Deletes the specified EBS volume. The volume must be in the @available@
-- state (not attached to an instance).
--
-- The volume can remain in the @deleting@ state for several minutes.
--
-- For more information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/ebs-deleting-volume.html Delete an Amazon EBS volume>
-- in the /Amazon Elastic Compute Cloud User Guide/.
module Amazonka.EC2.DeleteVolume
  ( -- * Creating a Request
    DeleteVolume (..),
    newDeleteVolume,

    -- * Request Lenses
    deleteVolume_dryRun,
    deleteVolume_volumeId,

    -- * Destructuring the Response
    DeleteVolumeResponse (..),
    newDeleteVolumeResponse,
  )
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:/ 'newDeleteVolume' smart constructor.
data DeleteVolume = DeleteVolume'
  { -- | 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@.
    DeleteVolume -> Maybe Bool
dryRun :: Prelude.Maybe Prelude.Bool,
    -- | The ID of the volume.
    DeleteVolume -> Text
volumeId :: Prelude.Text
  }
  deriving (DeleteVolume -> DeleteVolume -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeleteVolume -> DeleteVolume -> Bool
$c/= :: DeleteVolume -> DeleteVolume -> Bool
== :: DeleteVolume -> DeleteVolume -> Bool
$c== :: DeleteVolume -> DeleteVolume -> Bool
Prelude.Eq, ReadPrec [DeleteVolume]
ReadPrec DeleteVolume
Int -> ReadS DeleteVolume
ReadS [DeleteVolume]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeleteVolume]
$creadListPrec :: ReadPrec [DeleteVolume]
readPrec :: ReadPrec DeleteVolume
$creadPrec :: ReadPrec DeleteVolume
readList :: ReadS [DeleteVolume]
$creadList :: ReadS [DeleteVolume]
readsPrec :: Int -> ReadS DeleteVolume
$creadsPrec :: Int -> ReadS DeleteVolume
Prelude.Read, Int -> DeleteVolume -> ShowS
[DeleteVolume] -> ShowS
DeleteVolume -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeleteVolume] -> ShowS
$cshowList :: [DeleteVolume] -> ShowS
show :: DeleteVolume -> String
$cshow :: DeleteVolume -> String
showsPrec :: Int -> DeleteVolume -> ShowS
$cshowsPrec :: Int -> DeleteVolume -> ShowS
Prelude.Show, forall x. Rep DeleteVolume x -> DeleteVolume
forall x. DeleteVolume -> Rep DeleteVolume x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DeleteVolume x -> DeleteVolume
$cfrom :: forall x. DeleteVolume -> Rep DeleteVolume x
Prelude.Generic)

-- |
-- Create a value of 'DeleteVolume' 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', 'deleteVolume_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', 'deleteVolume_volumeId' - The ID of the volume.
newDeleteVolume ::
  -- | 'volumeId'
  Prelude.Text ->
  DeleteVolume
newDeleteVolume :: Text -> DeleteVolume
newDeleteVolume Text
pVolumeId_ =
  DeleteVolume'
    { $sel:dryRun:DeleteVolume' :: Maybe Bool
dryRun = forall a. Maybe a
Prelude.Nothing,
      $sel:volumeId:DeleteVolume' :: 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@.
deleteVolume_dryRun :: Lens.Lens' DeleteVolume (Prelude.Maybe Prelude.Bool)
deleteVolume_dryRun :: Lens' DeleteVolume (Maybe Bool)
deleteVolume_dryRun = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteVolume' {Maybe Bool
dryRun :: Maybe Bool
$sel:dryRun:DeleteVolume' :: DeleteVolume -> Maybe Bool
dryRun} -> Maybe Bool
dryRun) (\s :: DeleteVolume
s@DeleteVolume' {} Maybe Bool
a -> DeleteVolume
s {$sel:dryRun:DeleteVolume' :: Maybe Bool
dryRun = Maybe Bool
a} :: DeleteVolume)

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

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

instance Prelude.Hashable DeleteVolume where
  hashWithSalt :: Int -> DeleteVolume -> Int
hashWithSalt Int
_salt DeleteVolume' {Maybe Bool
Text
volumeId :: Text
dryRun :: Maybe Bool
$sel:volumeId:DeleteVolume' :: DeleteVolume -> Text
$sel:dryRun:DeleteVolume' :: DeleteVolume -> 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` Text
volumeId

instance Prelude.NFData DeleteVolume where
  rnf :: DeleteVolume -> ()
rnf DeleteVolume' {Maybe Bool
Text
volumeId :: Text
dryRun :: Maybe Bool
$sel:volumeId:DeleteVolume' :: DeleteVolume -> Text
$sel:dryRun:DeleteVolume' :: DeleteVolume -> 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 Text
volumeId

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

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

instance Data.ToQuery DeleteVolume where
  toQuery :: DeleteVolume -> QueryString
toQuery DeleteVolume' {Maybe Bool
Text
volumeId :: Text
dryRun :: Maybe Bool
$sel:volumeId:DeleteVolume' :: DeleteVolume -> Text
$sel:dryRun:DeleteVolume' :: DeleteVolume -> Maybe Bool
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"DeleteVolume" :: 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
"VolumeId" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
volumeId
      ]

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

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

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