{-# 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.DataExchange.DeleteRevision
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- This operation deletes a revision.
module Amazonka.DataExchange.DeleteRevision
  ( -- * Creating a Request
    DeleteRevision (..),
    newDeleteRevision,

    -- * Request Lenses
    deleteRevision_dataSetId,
    deleteRevision_revisionId,

    -- * Destructuring the Response
    DeleteRevisionResponse (..),
    newDeleteRevisionResponse,
  )
where

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

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

-- |
-- Create a value of 'DeleteRevision' 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:
--
-- 'dataSetId', 'deleteRevision_dataSetId' - The unique identifier for a data set.
--
-- 'revisionId', 'deleteRevision_revisionId' - The unique identifier for a revision.
newDeleteRevision ::
  -- | 'dataSetId'
  Prelude.Text ->
  -- | 'revisionId'
  Prelude.Text ->
  DeleteRevision
newDeleteRevision :: Text -> Text -> DeleteRevision
newDeleteRevision Text
pDataSetId_ Text
pRevisionId_ =
  DeleteRevision'
    { $sel:dataSetId:DeleteRevision' :: Text
dataSetId = Text
pDataSetId_,
      $sel:revisionId:DeleteRevision' :: Text
revisionId = Text
pRevisionId_
    }

-- | The unique identifier for a data set.
deleteRevision_dataSetId :: Lens.Lens' DeleteRevision Prelude.Text
deleteRevision_dataSetId :: Lens' DeleteRevision Text
deleteRevision_dataSetId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteRevision' {Text
dataSetId :: Text
$sel:dataSetId:DeleteRevision' :: DeleteRevision -> Text
dataSetId} -> Text
dataSetId) (\s :: DeleteRevision
s@DeleteRevision' {} Text
a -> DeleteRevision
s {$sel:dataSetId:DeleteRevision' :: Text
dataSetId = Text
a} :: DeleteRevision)

-- | The unique identifier for a revision.
deleteRevision_revisionId :: Lens.Lens' DeleteRevision Prelude.Text
deleteRevision_revisionId :: Lens' DeleteRevision Text
deleteRevision_revisionId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteRevision' {Text
revisionId :: Text
$sel:revisionId:DeleteRevision' :: DeleteRevision -> Text
revisionId} -> Text
revisionId) (\s :: DeleteRevision
s@DeleteRevision' {} Text
a -> DeleteRevision
s {$sel:revisionId:DeleteRevision' :: Text
revisionId = Text
a} :: DeleteRevision)

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

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

instance Prelude.NFData DeleteRevision where
  rnf :: DeleteRevision -> ()
rnf DeleteRevision' {Text
revisionId :: Text
dataSetId :: Text
$sel:revisionId:DeleteRevision' :: DeleteRevision -> Text
$sel:dataSetId:DeleteRevision' :: DeleteRevision -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
dataSetId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
revisionId

instance Data.ToHeaders DeleteRevision where
  toHeaders :: DeleteRevision -> [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 DeleteRevision where
  toPath :: DeleteRevision -> ByteString
toPath DeleteRevision' {Text
revisionId :: Text
dataSetId :: Text
$sel:revisionId:DeleteRevision' :: DeleteRevision -> Text
$sel:dataSetId:DeleteRevision' :: DeleteRevision -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/v1/data-sets/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
dataSetId,
        ByteString
"/revisions/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
revisionId
      ]

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

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

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

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