{-# 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.CodeCommit.UpdateComment
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Replaces the contents of a comment.
module Amazonka.CodeCommit.UpdateComment
  ( -- * Creating a Request
    UpdateComment (..),
    newUpdateComment,

    -- * Request Lenses
    updateComment_commentId,
    updateComment_content,

    -- * Destructuring the Response
    UpdateCommentResponse (..),
    newUpdateCommentResponse,

    -- * Response Lenses
    updateCommentResponse_comment,
    updateCommentResponse_httpStatus,
  )
where

import Amazonka.CodeCommit.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:/ 'newUpdateComment' smart constructor.
data UpdateComment = UpdateComment'
  { -- | The system-generated ID of the comment you want to update. To get this
    -- ID, use GetCommentsForComparedCommit or GetCommentsForPullRequest.
    UpdateComment -> Text
commentId :: Prelude.Text,
    -- | The updated content to replace the existing content of the comment.
    UpdateComment -> Text
content :: Prelude.Text
  }
  deriving (UpdateComment -> UpdateComment -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateComment -> UpdateComment -> Bool
$c/= :: UpdateComment -> UpdateComment -> Bool
== :: UpdateComment -> UpdateComment -> Bool
$c== :: UpdateComment -> UpdateComment -> Bool
Prelude.Eq, ReadPrec [UpdateComment]
ReadPrec UpdateComment
Int -> ReadS UpdateComment
ReadS [UpdateComment]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateComment]
$creadListPrec :: ReadPrec [UpdateComment]
readPrec :: ReadPrec UpdateComment
$creadPrec :: ReadPrec UpdateComment
readList :: ReadS [UpdateComment]
$creadList :: ReadS [UpdateComment]
readsPrec :: Int -> ReadS UpdateComment
$creadsPrec :: Int -> ReadS UpdateComment
Prelude.Read, Int -> UpdateComment -> ShowS
[UpdateComment] -> ShowS
UpdateComment -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateComment] -> ShowS
$cshowList :: [UpdateComment] -> ShowS
show :: UpdateComment -> String
$cshow :: UpdateComment -> String
showsPrec :: Int -> UpdateComment -> ShowS
$cshowsPrec :: Int -> UpdateComment -> ShowS
Prelude.Show, forall x. Rep UpdateComment x -> UpdateComment
forall x. UpdateComment -> Rep UpdateComment x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateComment x -> UpdateComment
$cfrom :: forall x. UpdateComment -> Rep UpdateComment x
Prelude.Generic)

-- |
-- Create a value of 'UpdateComment' 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:
--
-- 'commentId', 'updateComment_commentId' - The system-generated ID of the comment you want to update. To get this
-- ID, use GetCommentsForComparedCommit or GetCommentsForPullRequest.
--
-- 'content', 'updateComment_content' - The updated content to replace the existing content of the comment.
newUpdateComment ::
  -- | 'commentId'
  Prelude.Text ->
  -- | 'content'
  Prelude.Text ->
  UpdateComment
newUpdateComment :: Text -> Text -> UpdateComment
newUpdateComment Text
pCommentId_ Text
pContent_ =
  UpdateComment'
    { $sel:commentId:UpdateComment' :: Text
commentId = Text
pCommentId_,
      $sel:content:UpdateComment' :: Text
content = Text
pContent_
    }

-- | The system-generated ID of the comment you want to update. To get this
-- ID, use GetCommentsForComparedCommit or GetCommentsForPullRequest.
updateComment_commentId :: Lens.Lens' UpdateComment Prelude.Text
updateComment_commentId :: Lens' UpdateComment Text
updateComment_commentId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateComment' {Text
commentId :: Text
$sel:commentId:UpdateComment' :: UpdateComment -> Text
commentId} -> Text
commentId) (\s :: UpdateComment
s@UpdateComment' {} Text
a -> UpdateComment
s {$sel:commentId:UpdateComment' :: Text
commentId = Text
a} :: UpdateComment)

-- | The updated content to replace the existing content of the comment.
updateComment_content :: Lens.Lens' UpdateComment Prelude.Text
updateComment_content :: Lens' UpdateComment Text
updateComment_content = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateComment' {Text
content :: Text
$sel:content:UpdateComment' :: UpdateComment -> Text
content} -> Text
content) (\s :: UpdateComment
s@UpdateComment' {} Text
a -> UpdateComment
s {$sel:content:UpdateComment' :: Text
content = Text
a} :: UpdateComment)

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

instance Prelude.NFData UpdateComment where
  rnf :: UpdateComment -> ()
rnf UpdateComment' {Text
content :: Text
commentId :: Text
$sel:content:UpdateComment' :: UpdateComment -> Text
$sel:commentId:UpdateComment' :: UpdateComment -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
commentId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
content

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

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

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

-- | /See:/ 'newUpdateCommentResponse' smart constructor.
data UpdateCommentResponse = UpdateCommentResponse'
  { -- | Information about the updated comment.
    UpdateCommentResponse -> Maybe Comment
comment :: Prelude.Maybe Comment,
    -- | The response's http status code.
    UpdateCommentResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (UpdateCommentResponse -> UpdateCommentResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateCommentResponse -> UpdateCommentResponse -> Bool
$c/= :: UpdateCommentResponse -> UpdateCommentResponse -> Bool
== :: UpdateCommentResponse -> UpdateCommentResponse -> Bool
$c== :: UpdateCommentResponse -> UpdateCommentResponse -> Bool
Prelude.Eq, ReadPrec [UpdateCommentResponse]
ReadPrec UpdateCommentResponse
Int -> ReadS UpdateCommentResponse
ReadS [UpdateCommentResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateCommentResponse]
$creadListPrec :: ReadPrec [UpdateCommentResponse]
readPrec :: ReadPrec UpdateCommentResponse
$creadPrec :: ReadPrec UpdateCommentResponse
readList :: ReadS [UpdateCommentResponse]
$creadList :: ReadS [UpdateCommentResponse]
readsPrec :: Int -> ReadS UpdateCommentResponse
$creadsPrec :: Int -> ReadS UpdateCommentResponse
Prelude.Read, Int -> UpdateCommentResponse -> ShowS
[UpdateCommentResponse] -> ShowS
UpdateCommentResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateCommentResponse] -> ShowS
$cshowList :: [UpdateCommentResponse] -> ShowS
show :: UpdateCommentResponse -> String
$cshow :: UpdateCommentResponse -> String
showsPrec :: Int -> UpdateCommentResponse -> ShowS
$cshowsPrec :: Int -> UpdateCommentResponse -> ShowS
Prelude.Show, forall x. Rep UpdateCommentResponse x -> UpdateCommentResponse
forall x. UpdateCommentResponse -> Rep UpdateCommentResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateCommentResponse x -> UpdateCommentResponse
$cfrom :: forall x. UpdateCommentResponse -> Rep UpdateCommentResponse x
Prelude.Generic)

-- |
-- Create a value of 'UpdateCommentResponse' 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:
--
-- 'comment', 'updateCommentResponse_comment' - Information about the updated comment.
--
-- 'httpStatus', 'updateCommentResponse_httpStatus' - The response's http status code.
newUpdateCommentResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UpdateCommentResponse
newUpdateCommentResponse :: Int -> UpdateCommentResponse
newUpdateCommentResponse Int
pHttpStatus_ =
  UpdateCommentResponse'
    { $sel:comment:UpdateCommentResponse' :: Maybe Comment
comment = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:UpdateCommentResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Information about the updated comment.
updateCommentResponse_comment :: Lens.Lens' UpdateCommentResponse (Prelude.Maybe Comment)
updateCommentResponse_comment :: Lens' UpdateCommentResponse (Maybe Comment)
updateCommentResponse_comment = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateCommentResponse' {Maybe Comment
comment :: Maybe Comment
$sel:comment:UpdateCommentResponse' :: UpdateCommentResponse -> Maybe Comment
comment} -> Maybe Comment
comment) (\s :: UpdateCommentResponse
s@UpdateCommentResponse' {} Maybe Comment
a -> UpdateCommentResponse
s {$sel:comment:UpdateCommentResponse' :: Maybe Comment
comment = Maybe Comment
a} :: UpdateCommentResponse)

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

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