{-# 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.Redshift.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 schedule.
module Amazonka.Redshift.DeleteSnapshotSchedule
  ( -- * Creating a Request
    DeleteSnapshotSchedule (..),
    newDeleteSnapshotSchedule,

    -- * Request Lenses
    deleteSnapshotSchedule_scheduleIdentifier,

    -- * Destructuring the Response
    DeleteSnapshotScheduleResponse (..),
    newDeleteSnapshotScheduleResponse,
  )
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 Amazonka.Redshift.Types
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newDeleteSnapshotSchedule' smart constructor.
data DeleteSnapshotSchedule = DeleteSnapshotSchedule'
  { -- | A unique identifier of the snapshot schedule to delete.
    DeleteSnapshotSchedule -> Text
scheduleIdentifier :: 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:
--
-- 'scheduleIdentifier', 'deleteSnapshotSchedule_scheduleIdentifier' - A unique identifier of the snapshot schedule to delete.
newDeleteSnapshotSchedule ::
  -- | 'scheduleIdentifier'
  Prelude.Text ->
  DeleteSnapshotSchedule
newDeleteSnapshotSchedule :: Text -> DeleteSnapshotSchedule
newDeleteSnapshotSchedule Text
pScheduleIdentifier_ =
  DeleteSnapshotSchedule'
    { $sel:scheduleIdentifier:DeleteSnapshotSchedule' :: Text
scheduleIdentifier =
        Text
pScheduleIdentifier_
    }

-- | A unique identifier of the snapshot schedule to delete.
deleteSnapshotSchedule_scheduleIdentifier :: Lens.Lens' DeleteSnapshotSchedule Prelude.Text
deleteSnapshotSchedule_scheduleIdentifier :: Lens' DeleteSnapshotSchedule Text
deleteSnapshotSchedule_scheduleIdentifier = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteSnapshotSchedule' {Text
scheduleIdentifier :: Text
$sel:scheduleIdentifier:DeleteSnapshotSchedule' :: DeleteSnapshotSchedule -> Text
scheduleIdentifier} -> Text
scheduleIdentifier) (\s :: DeleteSnapshotSchedule
s@DeleteSnapshotSchedule' {} Text
a -> DeleteSnapshotSchedule
s {$sel:scheduleIdentifier:DeleteSnapshotSchedule' :: Text
scheduleIdentifier = 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 => Service -> a -> Request a
Request.postQuery (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 =>
AWSResponse a
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveNull
      DeleteSnapshotScheduleResponse
DeleteSnapshotScheduleResponse'

instance Prelude.Hashable DeleteSnapshotSchedule where
  hashWithSalt :: Int -> DeleteSnapshotSchedule -> Int
hashWithSalt Int
_salt DeleteSnapshotSchedule' {Text
scheduleIdentifier :: Text
$sel:scheduleIdentifier:DeleteSnapshotSchedule' :: DeleteSnapshotSchedule -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
scheduleIdentifier

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

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

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 DeleteSnapshotSchedule' {Text
scheduleIdentifier :: Text
$sel:scheduleIdentifier:DeleteSnapshotSchedule' :: DeleteSnapshotSchedule -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"DeleteSnapshotSchedule" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2012-12-01" :: Prelude.ByteString),
        ByteString
"ScheduleIdentifier" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
scheduleIdentifier
      ]

-- | /See:/ 'newDeleteSnapshotScheduleResponse' smart constructor.
data DeleteSnapshotScheduleResponse = DeleteSnapshotScheduleResponse'
  {
  }
  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.
newDeleteSnapshotScheduleResponse ::
  DeleteSnapshotScheduleResponse
newDeleteSnapshotScheduleResponse :: DeleteSnapshotScheduleResponse
newDeleteSnapshotScheduleResponse =
  DeleteSnapshotScheduleResponse
DeleteSnapshotScheduleResponse'

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