{-# 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.Backup.DeleteReportPlan
-- 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 report plan specified by a report plan name.
module Amazonka.Backup.DeleteReportPlan
  ( -- * Creating a Request
    DeleteReportPlan (..),
    newDeleteReportPlan,

    -- * Request Lenses
    deleteReportPlan_reportPlanName,

    -- * Destructuring the Response
    DeleteReportPlanResponse (..),
    newDeleteReportPlanResponse,
  )
where

import Amazonka.Backup.Types
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

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

-- |
-- Create a value of 'DeleteReportPlan' 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:
--
-- 'reportPlanName', 'deleteReportPlan_reportPlanName' - The unique name of a report plan.
newDeleteReportPlan ::
  -- | 'reportPlanName'
  Prelude.Text ->
  DeleteReportPlan
newDeleteReportPlan :: Text -> DeleteReportPlan
newDeleteReportPlan Text
pReportPlanName_ =
  DeleteReportPlan'
    { $sel:reportPlanName:DeleteReportPlan' :: Text
reportPlanName =
        Text
pReportPlanName_
    }

-- | The unique name of a report plan.
deleteReportPlan_reportPlanName :: Lens.Lens' DeleteReportPlan Prelude.Text
deleteReportPlan_reportPlanName :: Lens' DeleteReportPlan Text
deleteReportPlan_reportPlanName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteReportPlan' {Text
reportPlanName :: Text
$sel:reportPlanName:DeleteReportPlan' :: DeleteReportPlan -> Text
reportPlanName} -> Text
reportPlanName) (\s :: DeleteReportPlan
s@DeleteReportPlan' {} Text
a -> DeleteReportPlan
s {$sel:reportPlanName:DeleteReportPlan' :: Text
reportPlanName = Text
a} :: DeleteReportPlan)

instance Core.AWSRequest DeleteReportPlan where
  type
    AWSResponse DeleteReportPlan =
      DeleteReportPlanResponse
  request :: (Service -> Service)
-> DeleteReportPlan -> Request DeleteReportPlan
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.delete (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy DeleteReportPlan
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse DeleteReportPlan)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
AWSResponse a
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveNull DeleteReportPlanResponse
DeleteReportPlanResponse'

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

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

instance Data.ToHeaders DeleteReportPlan where
  toHeaders :: DeleteReportPlan -> [Header]
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> [Header]
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToPath DeleteReportPlan where
  toPath :: DeleteReportPlan -> ByteString
toPath DeleteReportPlan' {Text
reportPlanName :: Text
$sel:reportPlanName:DeleteReportPlan' :: DeleteReportPlan -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ByteString
"/audit/report-plans/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
reportPlanName]

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

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

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

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