{-# 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.Lightsail.DeleteDiskSnapshot
-- 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 disk snapshot.
--
-- When you make periodic snapshots of a disk, the snapshots are
-- incremental, and only the blocks on the device that have changed since
-- your last snapshot are saved in the new snapshot. When you delete a
-- snapshot, only the data not needed for any other snapshot is removed. So
-- regardless of which prior snapshots have been deleted, all active
-- snapshots will have access to all the information needed to restore the
-- disk.
--
-- The @delete disk snapshot@ operation supports tag-based access control
-- via resource tags applied to the resource identified by
-- @disk snapshot name@. For more information, see the
-- <https://lightsail.aws.amazon.com/ls/docs/en_us/articles/amazon-lightsail-controlling-access-using-tags Amazon Lightsail Developer Guide>.
module Amazonka.Lightsail.DeleteDiskSnapshot
  ( -- * Creating a Request
    DeleteDiskSnapshot (..),
    newDeleteDiskSnapshot,

    -- * Request Lenses
    deleteDiskSnapshot_diskSnapshotName,

    -- * Destructuring the Response
    DeleteDiskSnapshotResponse (..),
    newDeleteDiskSnapshotResponse,

    -- * Response Lenses
    deleteDiskSnapshotResponse_operations,
    deleteDiskSnapshotResponse_httpStatus,
  )
where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.Lightsail.Types
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newDeleteDiskSnapshot' smart constructor.
data DeleteDiskSnapshot = DeleteDiskSnapshot'
  { -- | The name of the disk snapshot you want to delete (e.g.,
    -- @my-disk-snapshot@).
    DeleteDiskSnapshot -> Text
diskSnapshotName :: Prelude.Text
  }
  deriving (DeleteDiskSnapshot -> DeleteDiskSnapshot -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeleteDiskSnapshot -> DeleteDiskSnapshot -> Bool
$c/= :: DeleteDiskSnapshot -> DeleteDiskSnapshot -> Bool
== :: DeleteDiskSnapshot -> DeleteDiskSnapshot -> Bool
$c== :: DeleteDiskSnapshot -> DeleteDiskSnapshot -> Bool
Prelude.Eq, ReadPrec [DeleteDiskSnapshot]
ReadPrec DeleteDiskSnapshot
Int -> ReadS DeleteDiskSnapshot
ReadS [DeleteDiskSnapshot]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeleteDiskSnapshot]
$creadListPrec :: ReadPrec [DeleteDiskSnapshot]
readPrec :: ReadPrec DeleteDiskSnapshot
$creadPrec :: ReadPrec DeleteDiskSnapshot
readList :: ReadS [DeleteDiskSnapshot]
$creadList :: ReadS [DeleteDiskSnapshot]
readsPrec :: Int -> ReadS DeleteDiskSnapshot
$creadsPrec :: Int -> ReadS DeleteDiskSnapshot
Prelude.Read, Int -> DeleteDiskSnapshot -> ShowS
[DeleteDiskSnapshot] -> ShowS
DeleteDiskSnapshot -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeleteDiskSnapshot] -> ShowS
$cshowList :: [DeleteDiskSnapshot] -> ShowS
show :: DeleteDiskSnapshot -> String
$cshow :: DeleteDiskSnapshot -> String
showsPrec :: Int -> DeleteDiskSnapshot -> ShowS
$cshowsPrec :: Int -> DeleteDiskSnapshot -> ShowS
Prelude.Show, forall x. Rep DeleteDiskSnapshot x -> DeleteDiskSnapshot
forall x. DeleteDiskSnapshot -> Rep DeleteDiskSnapshot x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DeleteDiskSnapshot x -> DeleteDiskSnapshot
$cfrom :: forall x. DeleteDiskSnapshot -> Rep DeleteDiskSnapshot x
Prelude.Generic)

-- |
-- Create a value of 'DeleteDiskSnapshot' 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:
--
-- 'diskSnapshotName', 'deleteDiskSnapshot_diskSnapshotName' - The name of the disk snapshot you want to delete (e.g.,
-- @my-disk-snapshot@).
newDeleteDiskSnapshot ::
  -- | 'diskSnapshotName'
  Prelude.Text ->
  DeleteDiskSnapshot
newDeleteDiskSnapshot :: Text -> DeleteDiskSnapshot
newDeleteDiskSnapshot Text
pDiskSnapshotName_ =
  DeleteDiskSnapshot'
    { $sel:diskSnapshotName:DeleteDiskSnapshot' :: Text
diskSnapshotName =
        Text
pDiskSnapshotName_
    }

-- | The name of the disk snapshot you want to delete (e.g.,
-- @my-disk-snapshot@).
deleteDiskSnapshot_diskSnapshotName :: Lens.Lens' DeleteDiskSnapshot Prelude.Text
deleteDiskSnapshot_diskSnapshotName :: Lens' DeleteDiskSnapshot Text
deleteDiskSnapshot_diskSnapshotName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteDiskSnapshot' {Text
diskSnapshotName :: Text
$sel:diskSnapshotName:DeleteDiskSnapshot' :: DeleteDiskSnapshot -> Text
diskSnapshotName} -> Text
diskSnapshotName) (\s :: DeleteDiskSnapshot
s@DeleteDiskSnapshot' {} Text
a -> DeleteDiskSnapshot
s {$sel:diskSnapshotName:DeleteDiskSnapshot' :: Text
diskSnapshotName = Text
a} :: DeleteDiskSnapshot)

instance Core.AWSRequest DeleteDiskSnapshot where
  type
    AWSResponse DeleteDiskSnapshot =
      DeleteDiskSnapshotResponse
  request :: (Service -> Service)
-> DeleteDiskSnapshot -> Request DeleteDiskSnapshot
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 DeleteDiskSnapshot
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse DeleteDiskSnapshot)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> Object -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveJSON
      ( \Int
s ResponseHeaders
h Object
x ->
          Maybe [Operation] -> Int -> DeleteDiskSnapshotResponse
DeleteDiskSnapshotResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"operations" forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty)
            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 DeleteDiskSnapshot where
  hashWithSalt :: Int -> DeleteDiskSnapshot -> Int
hashWithSalt Int
_salt DeleteDiskSnapshot' {Text
diskSnapshotName :: Text
$sel:diskSnapshotName:DeleteDiskSnapshot' :: DeleteDiskSnapshot -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
diskSnapshotName

instance Prelude.NFData DeleteDiskSnapshot where
  rnf :: DeleteDiskSnapshot -> ()
rnf DeleteDiskSnapshot' {Text
diskSnapshotName :: Text
$sel:diskSnapshotName:DeleteDiskSnapshot' :: DeleteDiskSnapshot -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
diskSnapshotName

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

instance Data.ToJSON DeleteDiskSnapshot where
  toJSON :: DeleteDiskSnapshot -> Value
toJSON DeleteDiskSnapshot' {Text
diskSnapshotName :: Text
$sel:diskSnapshotName:DeleteDiskSnapshot' :: DeleteDiskSnapshot -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just
              (Key
"diskSnapshotName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
diskSnapshotName)
          ]
      )

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

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

-- | /See:/ 'newDeleteDiskSnapshotResponse' smart constructor.
data DeleteDiskSnapshotResponse = DeleteDiskSnapshotResponse'
  { -- | An array of objects that describe the result of the action, such as the
    -- status of the request, the timestamp of the request, and the resources
    -- affected by the request.
    DeleteDiskSnapshotResponse -> Maybe [Operation]
operations :: Prelude.Maybe [Operation],
    -- | The response's http status code.
    DeleteDiskSnapshotResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (DeleteDiskSnapshotResponse -> DeleteDiskSnapshotResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeleteDiskSnapshotResponse -> DeleteDiskSnapshotResponse -> Bool
$c/= :: DeleteDiskSnapshotResponse -> DeleteDiskSnapshotResponse -> Bool
== :: DeleteDiskSnapshotResponse -> DeleteDiskSnapshotResponse -> Bool
$c== :: DeleteDiskSnapshotResponse -> DeleteDiskSnapshotResponse -> Bool
Prelude.Eq, ReadPrec [DeleteDiskSnapshotResponse]
ReadPrec DeleteDiskSnapshotResponse
Int -> ReadS DeleteDiskSnapshotResponse
ReadS [DeleteDiskSnapshotResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeleteDiskSnapshotResponse]
$creadListPrec :: ReadPrec [DeleteDiskSnapshotResponse]
readPrec :: ReadPrec DeleteDiskSnapshotResponse
$creadPrec :: ReadPrec DeleteDiskSnapshotResponse
readList :: ReadS [DeleteDiskSnapshotResponse]
$creadList :: ReadS [DeleteDiskSnapshotResponse]
readsPrec :: Int -> ReadS DeleteDiskSnapshotResponse
$creadsPrec :: Int -> ReadS DeleteDiskSnapshotResponse
Prelude.Read, Int -> DeleteDiskSnapshotResponse -> ShowS
[DeleteDiskSnapshotResponse] -> ShowS
DeleteDiskSnapshotResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeleteDiskSnapshotResponse] -> ShowS
$cshowList :: [DeleteDiskSnapshotResponse] -> ShowS
show :: DeleteDiskSnapshotResponse -> String
$cshow :: DeleteDiskSnapshotResponse -> String
showsPrec :: Int -> DeleteDiskSnapshotResponse -> ShowS
$cshowsPrec :: Int -> DeleteDiskSnapshotResponse -> ShowS
Prelude.Show, forall x.
Rep DeleteDiskSnapshotResponse x -> DeleteDiskSnapshotResponse
forall x.
DeleteDiskSnapshotResponse -> Rep DeleteDiskSnapshotResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DeleteDiskSnapshotResponse x -> DeleteDiskSnapshotResponse
$cfrom :: forall x.
DeleteDiskSnapshotResponse -> Rep DeleteDiskSnapshotResponse x
Prelude.Generic)

-- |
-- Create a value of 'DeleteDiskSnapshotResponse' 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:
--
-- 'operations', 'deleteDiskSnapshotResponse_operations' - An array of objects that describe the result of the action, such as the
-- status of the request, the timestamp of the request, and the resources
-- affected by the request.
--
-- 'httpStatus', 'deleteDiskSnapshotResponse_httpStatus' - The response's http status code.
newDeleteDiskSnapshotResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DeleteDiskSnapshotResponse
newDeleteDiskSnapshotResponse :: Int -> DeleteDiskSnapshotResponse
newDeleteDiskSnapshotResponse Int
pHttpStatus_ =
  DeleteDiskSnapshotResponse'
    { $sel:operations:DeleteDiskSnapshotResponse' :: Maybe [Operation]
operations =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:DeleteDiskSnapshotResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | An array of objects that describe the result of the action, such as the
-- status of the request, the timestamp of the request, and the resources
-- affected by the request.
deleteDiskSnapshotResponse_operations :: Lens.Lens' DeleteDiskSnapshotResponse (Prelude.Maybe [Operation])
deleteDiskSnapshotResponse_operations :: Lens' DeleteDiskSnapshotResponse (Maybe [Operation])
deleteDiskSnapshotResponse_operations = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteDiskSnapshotResponse' {Maybe [Operation]
operations :: Maybe [Operation]
$sel:operations:DeleteDiskSnapshotResponse' :: DeleteDiskSnapshotResponse -> Maybe [Operation]
operations} -> Maybe [Operation]
operations) (\s :: DeleteDiskSnapshotResponse
s@DeleteDiskSnapshotResponse' {} Maybe [Operation]
a -> DeleteDiskSnapshotResponse
s {$sel:operations:DeleteDiskSnapshotResponse' :: Maybe [Operation]
operations = Maybe [Operation]
a} :: DeleteDiskSnapshotResponse) 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 response's http status code.
deleteDiskSnapshotResponse_httpStatus :: Lens.Lens' DeleteDiskSnapshotResponse Prelude.Int
deleteDiskSnapshotResponse_httpStatus :: Lens' DeleteDiskSnapshotResponse Int
deleteDiskSnapshotResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteDiskSnapshotResponse' {Int
httpStatus :: Int
$sel:httpStatus:DeleteDiskSnapshotResponse' :: DeleteDiskSnapshotResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: DeleteDiskSnapshotResponse
s@DeleteDiskSnapshotResponse' {} Int
a -> DeleteDiskSnapshotResponse
s {$sel:httpStatus:DeleteDiskSnapshotResponse' :: Int
httpStatus = Int
a} :: DeleteDiskSnapshotResponse)

instance Prelude.NFData DeleteDiskSnapshotResponse where
  rnf :: DeleteDiskSnapshotResponse -> ()
rnf DeleteDiskSnapshotResponse' {Int
Maybe [Operation]
httpStatus :: Int
operations :: Maybe [Operation]
$sel:httpStatus:DeleteDiskSnapshotResponse' :: DeleteDiskSnapshotResponse -> Int
$sel:operations:DeleteDiskSnapshotResponse' :: DeleteDiskSnapshotResponse -> Maybe [Operation]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [Operation]
operations
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus