{-# 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.StorageGateway.DeleteSnapshotSchedule
-- 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 a snapshot of a volume.
--
-- You can take snapshots of your gateway volumes on a scheduled or ad hoc
-- basis. This API action enables you to delete a snapshot schedule for a
-- volume. For more information, see
-- <https://docs.aws.amazon.com/storagegateway/latest/userguide/backing-up-volumes.html Backing up your volumes>.
-- In the @DeleteSnapshotSchedule@ request, you identify the volume by
-- providing its Amazon Resource Name (ARN). This operation is only
-- supported for cached volume gateway types.
--
-- To list or delete a snapshot, you must use the Amazon EC2 API. For more
-- information, go to
-- <https://docs.aws.amazon.com/AWSEC2/latest/APIReference/API_DescribeSnapshots.html DescribeSnapshots>
-- in the /Amazon Elastic Compute Cloud API Reference/.
module Amazonka.StorageGateway.DeleteSnapshotSchedule
  ( -- * Creating a Request
    DeleteSnapshotSchedule (..),
    newDeleteSnapshotSchedule,

    -- * Request Lenses
    deleteSnapshotSchedule_volumeARN,

    -- * Destructuring the Response
    DeleteSnapshotScheduleResponse (..),
    newDeleteSnapshotScheduleResponse,

    -- * Response Lenses
    deleteSnapshotScheduleResponse_volumeARN,
    deleteSnapshotScheduleResponse_httpStatus,
  )
where

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

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

-- |
-- Create a value of 'DeleteSnapshotSchedule' 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:
--
-- 'volumeARN', 'deleteSnapshotSchedule_volumeARN' - The volume which snapshot schedule to delete.
newDeleteSnapshotSchedule ::
  -- | 'volumeARN'
  Prelude.Text ->
  DeleteSnapshotSchedule
newDeleteSnapshotSchedule :: Text -> DeleteSnapshotSchedule
newDeleteSnapshotSchedule Text
pVolumeARN_ =
  DeleteSnapshotSchedule' {$sel:volumeARN:DeleteSnapshotSchedule' :: Text
volumeARN = Text
pVolumeARN_}

-- | The volume which snapshot schedule to delete.
deleteSnapshotSchedule_volumeARN :: Lens.Lens' DeleteSnapshotSchedule Prelude.Text
deleteSnapshotSchedule_volumeARN :: Lens' DeleteSnapshotSchedule Text
deleteSnapshotSchedule_volumeARN = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteSnapshotSchedule' {Text
volumeARN :: Text
$sel:volumeARN:DeleteSnapshotSchedule' :: DeleteSnapshotSchedule -> Text
volumeARN} -> Text
volumeARN) (\s :: DeleteSnapshotSchedule
s@DeleteSnapshotSchedule' {} Text
a -> DeleteSnapshotSchedule
s {$sel:volumeARN:DeleteSnapshotSchedule' :: Text
volumeARN = Text
a} :: DeleteSnapshotSchedule)

instance Core.AWSRequest DeleteSnapshotSchedule where
  type
    AWSResponse DeleteSnapshotSchedule =
      DeleteSnapshotScheduleResponse
  request :: (Service -> Service)
-> DeleteSnapshotSchedule -> Request DeleteSnapshotSchedule
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 DeleteSnapshotSchedule
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse DeleteSnapshotSchedule)))
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 Text -> Int -> DeleteSnapshotScheduleResponse
DeleteSnapshotScheduleResponse'
            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
"VolumeARN")
            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 DeleteSnapshotSchedule where
  hashWithSalt :: Int -> DeleteSnapshotSchedule -> Int
hashWithSalt Int
_salt DeleteSnapshotSchedule' {Text
volumeARN :: Text
$sel:volumeARN:DeleteSnapshotSchedule' :: DeleteSnapshotSchedule -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
volumeARN

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

instance Data.ToHeaders DeleteSnapshotSchedule where
  toHeaders :: DeleteSnapshotSchedule -> 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
"StorageGateway_20130630.DeleteSnapshotSchedule" ::
                          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 DeleteSnapshotSchedule where
  toJSON :: DeleteSnapshotSchedule -> Value
toJSON DeleteSnapshotSchedule' {Text
volumeARN :: Text
$sel:volumeARN:DeleteSnapshotSchedule' :: DeleteSnapshotSchedule -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [forall a. a -> Maybe a
Prelude.Just (Key
"VolumeARN" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
volumeARN)]
      )

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

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

-- | /See:/ 'newDeleteSnapshotScheduleResponse' smart constructor.
data DeleteSnapshotScheduleResponse = DeleteSnapshotScheduleResponse'
  { -- | The volume which snapshot schedule was deleted.
    DeleteSnapshotScheduleResponse -> Maybe Text
volumeARN :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    DeleteSnapshotScheduleResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (DeleteSnapshotScheduleResponse
-> DeleteSnapshotScheduleResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeleteSnapshotScheduleResponse
-> DeleteSnapshotScheduleResponse -> Bool
$c/= :: DeleteSnapshotScheduleResponse
-> DeleteSnapshotScheduleResponse -> Bool
== :: DeleteSnapshotScheduleResponse
-> DeleteSnapshotScheduleResponse -> Bool
$c== :: DeleteSnapshotScheduleResponse
-> DeleteSnapshotScheduleResponse -> Bool
Prelude.Eq, ReadPrec [DeleteSnapshotScheduleResponse]
ReadPrec DeleteSnapshotScheduleResponse
Int -> ReadS DeleteSnapshotScheduleResponse
ReadS [DeleteSnapshotScheduleResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeleteSnapshotScheduleResponse]
$creadListPrec :: ReadPrec [DeleteSnapshotScheduleResponse]
readPrec :: ReadPrec DeleteSnapshotScheduleResponse
$creadPrec :: ReadPrec DeleteSnapshotScheduleResponse
readList :: ReadS [DeleteSnapshotScheduleResponse]
$creadList :: ReadS [DeleteSnapshotScheduleResponse]
readsPrec :: Int -> ReadS DeleteSnapshotScheduleResponse
$creadsPrec :: Int -> ReadS DeleteSnapshotScheduleResponse
Prelude.Read, Int -> DeleteSnapshotScheduleResponse -> ShowS
[DeleteSnapshotScheduleResponse] -> ShowS
DeleteSnapshotScheduleResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeleteSnapshotScheduleResponse] -> ShowS
$cshowList :: [DeleteSnapshotScheduleResponse] -> ShowS
show :: DeleteSnapshotScheduleResponse -> String
$cshow :: DeleteSnapshotScheduleResponse -> String
showsPrec :: Int -> DeleteSnapshotScheduleResponse -> ShowS
$cshowsPrec :: Int -> DeleteSnapshotScheduleResponse -> ShowS
Prelude.Show, forall x.
Rep DeleteSnapshotScheduleResponse x
-> DeleteSnapshotScheduleResponse
forall x.
DeleteSnapshotScheduleResponse
-> Rep DeleteSnapshotScheduleResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DeleteSnapshotScheduleResponse x
-> DeleteSnapshotScheduleResponse
$cfrom :: forall x.
DeleteSnapshotScheduleResponse
-> Rep DeleteSnapshotScheduleResponse x
Prelude.Generic)

-- |
-- Create a value of 'DeleteSnapshotScheduleResponse' 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:
--
-- 'volumeARN', 'deleteSnapshotScheduleResponse_volumeARN' - The volume which snapshot schedule was deleted.
--
-- 'httpStatus', 'deleteSnapshotScheduleResponse_httpStatus' - The response's http status code.
newDeleteSnapshotScheduleResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DeleteSnapshotScheduleResponse
newDeleteSnapshotScheduleResponse :: Int -> DeleteSnapshotScheduleResponse
newDeleteSnapshotScheduleResponse Int
pHttpStatus_ =
  DeleteSnapshotScheduleResponse'
    { $sel:volumeARN:DeleteSnapshotScheduleResponse' :: Maybe Text
volumeARN =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:DeleteSnapshotScheduleResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The volume which snapshot schedule was deleted.
deleteSnapshotScheduleResponse_volumeARN :: Lens.Lens' DeleteSnapshotScheduleResponse (Prelude.Maybe Prelude.Text)
deleteSnapshotScheduleResponse_volumeARN :: Lens' DeleteSnapshotScheduleResponse (Maybe Text)
deleteSnapshotScheduleResponse_volumeARN = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteSnapshotScheduleResponse' {Maybe Text
volumeARN :: Maybe Text
$sel:volumeARN:DeleteSnapshotScheduleResponse' :: DeleteSnapshotScheduleResponse -> Maybe Text
volumeARN} -> Maybe Text
volumeARN) (\s :: DeleteSnapshotScheduleResponse
s@DeleteSnapshotScheduleResponse' {} Maybe Text
a -> DeleteSnapshotScheduleResponse
s {$sel:volumeARN:DeleteSnapshotScheduleResponse' :: Maybe Text
volumeARN = Maybe Text
a} :: DeleteSnapshotScheduleResponse)

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

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