{-# 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.WorkDocs.DeleteComment
-- 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 comment from the document version.
module Amazonka.WorkDocs.DeleteComment
  ( -- * Creating a Request
    DeleteComment (..),
    newDeleteComment,

    -- * Request Lenses
    deleteComment_authenticationToken,
    deleteComment_documentId,
    deleteComment_versionId,
    deleteComment_commentId,

    -- * Destructuring the Response
    DeleteCommentResponse (..),
    newDeleteCommentResponse,
  )
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.WorkDocs.Types

-- | /See:/ 'newDeleteComment' smart constructor.
data DeleteComment = DeleteComment'
  { -- | Amazon WorkDocs authentication token. Not required when using AWS
    -- administrator credentials to access the API.
    DeleteComment -> Maybe (Sensitive Text)
authenticationToken :: Prelude.Maybe (Data.Sensitive Prelude.Text),
    -- | The ID of the document.
    DeleteComment -> Text
documentId :: Prelude.Text,
    -- | The ID of the document version.
    DeleteComment -> Text
versionId :: Prelude.Text,
    -- | The ID of the comment.
    DeleteComment -> Text
commentId :: Prelude.Text
  }
  deriving (DeleteComment -> DeleteComment -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeleteComment -> DeleteComment -> Bool
$c/= :: DeleteComment -> DeleteComment -> Bool
== :: DeleteComment -> DeleteComment -> Bool
$c== :: DeleteComment -> DeleteComment -> Bool
Prelude.Eq, Int -> DeleteComment -> ShowS
[DeleteComment] -> ShowS
DeleteComment -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeleteComment] -> ShowS
$cshowList :: [DeleteComment] -> ShowS
show :: DeleteComment -> String
$cshow :: DeleteComment -> String
showsPrec :: Int -> DeleteComment -> ShowS
$cshowsPrec :: Int -> DeleteComment -> ShowS
Prelude.Show, forall x. Rep DeleteComment x -> DeleteComment
forall x. DeleteComment -> Rep DeleteComment x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DeleteComment x -> DeleteComment
$cfrom :: forall x. DeleteComment -> Rep DeleteComment x
Prelude.Generic)

-- |
-- Create a value of 'DeleteComment' 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:
--
-- 'authenticationToken', 'deleteComment_authenticationToken' - Amazon WorkDocs authentication token. Not required when using AWS
-- administrator credentials to access the API.
--
-- 'documentId', 'deleteComment_documentId' - The ID of the document.
--
-- 'versionId', 'deleteComment_versionId' - The ID of the document version.
--
-- 'commentId', 'deleteComment_commentId' - The ID of the comment.
newDeleteComment ::
  -- | 'documentId'
  Prelude.Text ->
  -- | 'versionId'
  Prelude.Text ->
  -- | 'commentId'
  Prelude.Text ->
  DeleteComment
newDeleteComment :: Text -> Text -> Text -> DeleteComment
newDeleteComment Text
pDocumentId_ Text
pVersionId_ Text
pCommentId_ =
  DeleteComment'
    { $sel:authenticationToken:DeleteComment' :: Maybe (Sensitive Text)
authenticationToken =
        forall a. Maybe a
Prelude.Nothing,
      $sel:documentId:DeleteComment' :: Text
documentId = Text
pDocumentId_,
      $sel:versionId:DeleteComment' :: Text
versionId = Text
pVersionId_,
      $sel:commentId:DeleteComment' :: Text
commentId = Text
pCommentId_
    }

-- | Amazon WorkDocs authentication token. Not required when using AWS
-- administrator credentials to access the API.
deleteComment_authenticationToken :: Lens.Lens' DeleteComment (Prelude.Maybe Prelude.Text)
deleteComment_authenticationToken :: Lens' DeleteComment (Maybe Text)
deleteComment_authenticationToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteComment' {Maybe (Sensitive Text)
authenticationToken :: Maybe (Sensitive Text)
$sel:authenticationToken:DeleteComment' :: DeleteComment -> Maybe (Sensitive Text)
authenticationToken} -> Maybe (Sensitive Text)
authenticationToken) (\s :: DeleteComment
s@DeleteComment' {} Maybe (Sensitive Text)
a -> DeleteComment
s {$sel:authenticationToken:DeleteComment' :: Maybe (Sensitive Text)
authenticationToken = Maybe (Sensitive Text)
a} :: DeleteComment) 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 a. Iso' (Sensitive a) a
Data._Sensitive

-- | The ID of the document.
deleteComment_documentId :: Lens.Lens' DeleteComment Prelude.Text
deleteComment_documentId :: Lens' DeleteComment Text
deleteComment_documentId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteComment' {Text
documentId :: Text
$sel:documentId:DeleteComment' :: DeleteComment -> Text
documentId} -> Text
documentId) (\s :: DeleteComment
s@DeleteComment' {} Text
a -> DeleteComment
s {$sel:documentId:DeleteComment' :: Text
documentId = Text
a} :: DeleteComment)

-- | The ID of the document version.
deleteComment_versionId :: Lens.Lens' DeleteComment Prelude.Text
deleteComment_versionId :: Lens' DeleteComment Text
deleteComment_versionId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteComment' {Text
versionId :: Text
$sel:versionId:DeleteComment' :: DeleteComment -> Text
versionId} -> Text
versionId) (\s :: DeleteComment
s@DeleteComment' {} Text
a -> DeleteComment
s {$sel:versionId:DeleteComment' :: Text
versionId = Text
a} :: DeleteComment)

-- | The ID of the comment.
deleteComment_commentId :: Lens.Lens' DeleteComment Prelude.Text
deleteComment_commentId :: Lens' DeleteComment Text
deleteComment_commentId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteComment' {Text
commentId :: Text
$sel:commentId:DeleteComment' :: DeleteComment -> Text
commentId} -> Text
commentId) (\s :: DeleteComment
s@DeleteComment' {} Text
a -> DeleteComment
s {$sel:commentId:DeleteComment' :: Text
commentId = Text
a} :: DeleteComment)

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

instance Prelude.Hashable DeleteComment where
  hashWithSalt :: Int -> DeleteComment -> Int
hashWithSalt Int
_salt DeleteComment' {Maybe (Sensitive Text)
Text
commentId :: Text
versionId :: Text
documentId :: Text
authenticationToken :: Maybe (Sensitive Text)
$sel:commentId:DeleteComment' :: DeleteComment -> Text
$sel:versionId:DeleteComment' :: DeleteComment -> Text
$sel:documentId:DeleteComment' :: DeleteComment -> Text
$sel:authenticationToken:DeleteComment' :: DeleteComment -> Maybe (Sensitive Text)
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (Sensitive Text)
authenticationToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
documentId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
versionId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
commentId

instance Prelude.NFData DeleteComment where
  rnf :: DeleteComment -> ()
rnf DeleteComment' {Maybe (Sensitive Text)
Text
commentId :: Text
versionId :: Text
documentId :: Text
authenticationToken :: Maybe (Sensitive Text)
$sel:commentId:DeleteComment' :: DeleteComment -> Text
$sel:versionId:DeleteComment' :: DeleteComment -> Text
$sel:documentId:DeleteComment' :: DeleteComment -> Text
$sel:authenticationToken:DeleteComment' :: DeleteComment -> Maybe (Sensitive Text)
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe (Sensitive Text)
authenticationToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
documentId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
versionId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
commentId

instance Data.ToHeaders DeleteComment where
  toHeaders :: DeleteComment -> [Header]
toHeaders DeleteComment' {Maybe (Sensitive Text)
Text
commentId :: Text
versionId :: Text
documentId :: Text
authenticationToken :: Maybe (Sensitive Text)
$sel:commentId:DeleteComment' :: DeleteComment -> Text
$sel:versionId:DeleteComment' :: DeleteComment -> Text
$sel:documentId:DeleteComment' :: DeleteComment -> Text
$sel:authenticationToken:DeleteComment' :: DeleteComment -> Maybe (Sensitive Text)
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ HeaderName
"Authentication" forall a. ToHeader a => HeaderName -> a -> [Header]
Data.=# Maybe (Sensitive Text)
authenticationToken,
        HeaderName
"Content-Type"
          forall a. ToHeader a => HeaderName -> a -> [Header]
Data.=# (ByteString
"application/x-amz-json-1.1" :: Prelude.ByteString)
      ]

instance Data.ToPath DeleteComment where
  toPath :: DeleteComment -> ByteString
toPath DeleteComment' {Maybe (Sensitive Text)
Text
commentId :: Text
versionId :: Text
documentId :: Text
authenticationToken :: Maybe (Sensitive Text)
$sel:commentId:DeleteComment' :: DeleteComment -> Text
$sel:versionId:DeleteComment' :: DeleteComment -> Text
$sel:documentId:DeleteComment' :: DeleteComment -> Text
$sel:authenticationToken:DeleteComment' :: DeleteComment -> Maybe (Sensitive Text)
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/api/v1/documents/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
documentId,
        ByteString
"/versions/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
versionId,
        ByteString
"/comment/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
commentId
      ]

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

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

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

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