{-# 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.PostCommentForPullRequest
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Posts a comment on a pull request.
module Amazonka.CodeCommit.PostCommentForPullRequest
  ( -- * Creating a Request
    PostCommentForPullRequest (..),
    newPostCommentForPullRequest,

    -- * Request Lenses
    postCommentForPullRequest_clientRequestToken,
    postCommentForPullRequest_location,
    postCommentForPullRequest_pullRequestId,
    postCommentForPullRequest_repositoryName,
    postCommentForPullRequest_beforeCommitId,
    postCommentForPullRequest_afterCommitId,
    postCommentForPullRequest_content,

    -- * Destructuring the Response
    PostCommentForPullRequestResponse (..),
    newPostCommentForPullRequestResponse,

    -- * Response Lenses
    postCommentForPullRequestResponse_afterBlobId,
    postCommentForPullRequestResponse_afterCommitId,
    postCommentForPullRequestResponse_beforeBlobId,
    postCommentForPullRequestResponse_beforeCommitId,
    postCommentForPullRequestResponse_comment,
    postCommentForPullRequestResponse_location,
    postCommentForPullRequestResponse_pullRequestId,
    postCommentForPullRequestResponse_repositoryName,
    postCommentForPullRequestResponse_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:/ 'newPostCommentForPullRequest' smart constructor.
data PostCommentForPullRequest = PostCommentForPullRequest'
  { -- | A unique, client-generated idempotency token that, when provided in a
    -- request, ensures the request cannot be repeated with a changed
    -- parameter. If a request is received with the same parameters and a token
    -- is included, the request returns information about the initial request
    -- that used that token.
    PostCommentForPullRequest -> Maybe Text
clientRequestToken :: Prelude.Maybe Prelude.Text,
    -- | The location of the change where you want to post your comment. If no
    -- location is provided, the comment is posted as a general comment on the
    -- pull request difference between the before commit ID and the after
    -- commit ID.
    PostCommentForPullRequest -> Maybe Location
location :: Prelude.Maybe Location,
    -- | The system-generated ID of the pull request. To get this ID, use
    -- ListPullRequests.
    PostCommentForPullRequest -> Text
pullRequestId :: Prelude.Text,
    -- | The name of the repository where you want to post a comment on a pull
    -- request.
    PostCommentForPullRequest -> Text
repositoryName :: Prelude.Text,
    -- | The full commit ID of the commit in the destination branch that was the
    -- tip of the branch at the time the pull request was created.
    PostCommentForPullRequest -> Text
beforeCommitId :: Prelude.Text,
    -- | The full commit ID of the commit in the source branch that is the
    -- current tip of the branch for the pull request when you post the
    -- comment.
    PostCommentForPullRequest -> Text
afterCommitId :: Prelude.Text,
    -- | The content of your comment on the change.
    PostCommentForPullRequest -> Text
content :: Prelude.Text
  }
  deriving (PostCommentForPullRequest -> PostCommentForPullRequest -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostCommentForPullRequest -> PostCommentForPullRequest -> Bool
$c/= :: PostCommentForPullRequest -> PostCommentForPullRequest -> Bool
== :: PostCommentForPullRequest -> PostCommentForPullRequest -> Bool
$c== :: PostCommentForPullRequest -> PostCommentForPullRequest -> Bool
Prelude.Eq, ReadPrec [PostCommentForPullRequest]
ReadPrec PostCommentForPullRequest
Int -> ReadS PostCommentForPullRequest
ReadS [PostCommentForPullRequest]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PostCommentForPullRequest]
$creadListPrec :: ReadPrec [PostCommentForPullRequest]
readPrec :: ReadPrec PostCommentForPullRequest
$creadPrec :: ReadPrec PostCommentForPullRequest
readList :: ReadS [PostCommentForPullRequest]
$creadList :: ReadS [PostCommentForPullRequest]
readsPrec :: Int -> ReadS PostCommentForPullRequest
$creadsPrec :: Int -> ReadS PostCommentForPullRequest
Prelude.Read, Int -> PostCommentForPullRequest -> ShowS
[PostCommentForPullRequest] -> ShowS
PostCommentForPullRequest -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PostCommentForPullRequest] -> ShowS
$cshowList :: [PostCommentForPullRequest] -> ShowS
show :: PostCommentForPullRequest -> String
$cshow :: PostCommentForPullRequest -> String
showsPrec :: Int -> PostCommentForPullRequest -> ShowS
$cshowsPrec :: Int -> PostCommentForPullRequest -> ShowS
Prelude.Show, forall x.
Rep PostCommentForPullRequest x -> PostCommentForPullRequest
forall x.
PostCommentForPullRequest -> Rep PostCommentForPullRequest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep PostCommentForPullRequest x -> PostCommentForPullRequest
$cfrom :: forall x.
PostCommentForPullRequest -> Rep PostCommentForPullRequest x
Prelude.Generic)

-- |
-- Create a value of 'PostCommentForPullRequest' 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:
--
-- 'clientRequestToken', 'postCommentForPullRequest_clientRequestToken' - A unique, client-generated idempotency token that, when provided in a
-- request, ensures the request cannot be repeated with a changed
-- parameter. If a request is received with the same parameters and a token
-- is included, the request returns information about the initial request
-- that used that token.
--
-- 'location', 'postCommentForPullRequest_location' - The location of the change where you want to post your comment. If no
-- location is provided, the comment is posted as a general comment on the
-- pull request difference between the before commit ID and the after
-- commit ID.
--
-- 'pullRequestId', 'postCommentForPullRequest_pullRequestId' - The system-generated ID of the pull request. To get this ID, use
-- ListPullRequests.
--
-- 'repositoryName', 'postCommentForPullRequest_repositoryName' - The name of the repository where you want to post a comment on a pull
-- request.
--
-- 'beforeCommitId', 'postCommentForPullRequest_beforeCommitId' - The full commit ID of the commit in the destination branch that was the
-- tip of the branch at the time the pull request was created.
--
-- 'afterCommitId', 'postCommentForPullRequest_afterCommitId' - The full commit ID of the commit in the source branch that is the
-- current tip of the branch for the pull request when you post the
-- comment.
--
-- 'content', 'postCommentForPullRequest_content' - The content of your comment on the change.
newPostCommentForPullRequest ::
  -- | 'pullRequestId'
  Prelude.Text ->
  -- | 'repositoryName'
  Prelude.Text ->
  -- | 'beforeCommitId'
  Prelude.Text ->
  -- | 'afterCommitId'
  Prelude.Text ->
  -- | 'content'
  Prelude.Text ->
  PostCommentForPullRequest
newPostCommentForPullRequest :: Text -> Text -> Text -> Text -> Text -> PostCommentForPullRequest
newPostCommentForPullRequest
  Text
pPullRequestId_
  Text
pRepositoryName_
  Text
pBeforeCommitId_
  Text
pAfterCommitId_
  Text
pContent_ =
    PostCommentForPullRequest'
      { $sel:clientRequestToken:PostCommentForPullRequest' :: Maybe Text
clientRequestToken =
          forall a. Maybe a
Prelude.Nothing,
        $sel:location:PostCommentForPullRequest' :: Maybe Location
location = forall a. Maybe a
Prelude.Nothing,
        $sel:pullRequestId:PostCommentForPullRequest' :: Text
pullRequestId = Text
pPullRequestId_,
        $sel:repositoryName:PostCommentForPullRequest' :: Text
repositoryName = Text
pRepositoryName_,
        $sel:beforeCommitId:PostCommentForPullRequest' :: Text
beforeCommitId = Text
pBeforeCommitId_,
        $sel:afterCommitId:PostCommentForPullRequest' :: Text
afterCommitId = Text
pAfterCommitId_,
        $sel:content:PostCommentForPullRequest' :: Text
content = Text
pContent_
      }

-- | A unique, client-generated idempotency token that, when provided in a
-- request, ensures the request cannot be repeated with a changed
-- parameter. If a request is received with the same parameters and a token
-- is included, the request returns information about the initial request
-- that used that token.
postCommentForPullRequest_clientRequestToken :: Lens.Lens' PostCommentForPullRequest (Prelude.Maybe Prelude.Text)
postCommentForPullRequest_clientRequestToken :: Lens' PostCommentForPullRequest (Maybe Text)
postCommentForPullRequest_clientRequestToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PostCommentForPullRequest' {Maybe Text
clientRequestToken :: Maybe Text
$sel:clientRequestToken:PostCommentForPullRequest' :: PostCommentForPullRequest -> Maybe Text
clientRequestToken} -> Maybe Text
clientRequestToken) (\s :: PostCommentForPullRequest
s@PostCommentForPullRequest' {} Maybe Text
a -> PostCommentForPullRequest
s {$sel:clientRequestToken:PostCommentForPullRequest' :: Maybe Text
clientRequestToken = Maybe Text
a} :: PostCommentForPullRequest)

-- | The location of the change where you want to post your comment. If no
-- location is provided, the comment is posted as a general comment on the
-- pull request difference between the before commit ID and the after
-- commit ID.
postCommentForPullRequest_location :: Lens.Lens' PostCommentForPullRequest (Prelude.Maybe Location)
postCommentForPullRequest_location :: Lens' PostCommentForPullRequest (Maybe Location)
postCommentForPullRequest_location = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PostCommentForPullRequest' {Maybe Location
location :: Maybe Location
$sel:location:PostCommentForPullRequest' :: PostCommentForPullRequest -> Maybe Location
location} -> Maybe Location
location) (\s :: PostCommentForPullRequest
s@PostCommentForPullRequest' {} Maybe Location
a -> PostCommentForPullRequest
s {$sel:location:PostCommentForPullRequest' :: Maybe Location
location = Maybe Location
a} :: PostCommentForPullRequest)

-- | The system-generated ID of the pull request. To get this ID, use
-- ListPullRequests.
postCommentForPullRequest_pullRequestId :: Lens.Lens' PostCommentForPullRequest Prelude.Text
postCommentForPullRequest_pullRequestId :: Lens' PostCommentForPullRequest Text
postCommentForPullRequest_pullRequestId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PostCommentForPullRequest' {Text
pullRequestId :: Text
$sel:pullRequestId:PostCommentForPullRequest' :: PostCommentForPullRequest -> Text
pullRequestId} -> Text
pullRequestId) (\s :: PostCommentForPullRequest
s@PostCommentForPullRequest' {} Text
a -> PostCommentForPullRequest
s {$sel:pullRequestId:PostCommentForPullRequest' :: Text
pullRequestId = Text
a} :: PostCommentForPullRequest)

-- | The name of the repository where you want to post a comment on a pull
-- request.
postCommentForPullRequest_repositoryName :: Lens.Lens' PostCommentForPullRequest Prelude.Text
postCommentForPullRequest_repositoryName :: Lens' PostCommentForPullRequest Text
postCommentForPullRequest_repositoryName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PostCommentForPullRequest' {Text
repositoryName :: Text
$sel:repositoryName:PostCommentForPullRequest' :: PostCommentForPullRequest -> Text
repositoryName} -> Text
repositoryName) (\s :: PostCommentForPullRequest
s@PostCommentForPullRequest' {} Text
a -> PostCommentForPullRequest
s {$sel:repositoryName:PostCommentForPullRequest' :: Text
repositoryName = Text
a} :: PostCommentForPullRequest)

-- | The full commit ID of the commit in the destination branch that was the
-- tip of the branch at the time the pull request was created.
postCommentForPullRequest_beforeCommitId :: Lens.Lens' PostCommentForPullRequest Prelude.Text
postCommentForPullRequest_beforeCommitId :: Lens' PostCommentForPullRequest Text
postCommentForPullRequest_beforeCommitId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PostCommentForPullRequest' {Text
beforeCommitId :: Text
$sel:beforeCommitId:PostCommentForPullRequest' :: PostCommentForPullRequest -> Text
beforeCommitId} -> Text
beforeCommitId) (\s :: PostCommentForPullRequest
s@PostCommentForPullRequest' {} Text
a -> PostCommentForPullRequest
s {$sel:beforeCommitId:PostCommentForPullRequest' :: Text
beforeCommitId = Text
a} :: PostCommentForPullRequest)

-- | The full commit ID of the commit in the source branch that is the
-- current tip of the branch for the pull request when you post the
-- comment.
postCommentForPullRequest_afterCommitId :: Lens.Lens' PostCommentForPullRequest Prelude.Text
postCommentForPullRequest_afterCommitId :: Lens' PostCommentForPullRequest Text
postCommentForPullRequest_afterCommitId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PostCommentForPullRequest' {Text
afterCommitId :: Text
$sel:afterCommitId:PostCommentForPullRequest' :: PostCommentForPullRequest -> Text
afterCommitId} -> Text
afterCommitId) (\s :: PostCommentForPullRequest
s@PostCommentForPullRequest' {} Text
a -> PostCommentForPullRequest
s {$sel:afterCommitId:PostCommentForPullRequest' :: Text
afterCommitId = Text
a} :: PostCommentForPullRequest)

-- | The content of your comment on the change.
postCommentForPullRequest_content :: Lens.Lens' PostCommentForPullRequest Prelude.Text
postCommentForPullRequest_content :: Lens' PostCommentForPullRequest Text
postCommentForPullRequest_content = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PostCommentForPullRequest' {Text
content :: Text
$sel:content:PostCommentForPullRequest' :: PostCommentForPullRequest -> Text
content} -> Text
content) (\s :: PostCommentForPullRequest
s@PostCommentForPullRequest' {} Text
a -> PostCommentForPullRequest
s {$sel:content:PostCommentForPullRequest' :: Text
content = Text
a} :: PostCommentForPullRequest)

instance Core.AWSRequest PostCommentForPullRequest where
  type
    AWSResponse PostCommentForPullRequest =
      PostCommentForPullRequestResponse
  request :: (Service -> Service)
-> PostCommentForPullRequest -> Request PostCommentForPullRequest
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 PostCommentForPullRequest
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse PostCommentForPullRequest)))
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 Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Comment
-> Maybe Location
-> Maybe Text
-> Maybe Text
-> Int
-> PostCommentForPullRequestResponse
PostCommentForPullRequestResponse'
            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
"afterBlobId")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"afterCommitId")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"beforeBlobId")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"beforeCommitId")
            forall (f :: * -> *) a b. Applicative f => 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.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"location")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"pullRequestId")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"repositoryName")
            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 PostCommentForPullRequest where
  hashWithSalt :: Int -> PostCommentForPullRequest -> Int
hashWithSalt Int
_salt PostCommentForPullRequest' {Maybe Text
Maybe Location
Text
content :: Text
afterCommitId :: Text
beforeCommitId :: Text
repositoryName :: Text
pullRequestId :: Text
location :: Maybe Location
clientRequestToken :: Maybe Text
$sel:content:PostCommentForPullRequest' :: PostCommentForPullRequest -> Text
$sel:afterCommitId:PostCommentForPullRequest' :: PostCommentForPullRequest -> Text
$sel:beforeCommitId:PostCommentForPullRequest' :: PostCommentForPullRequest -> Text
$sel:repositoryName:PostCommentForPullRequest' :: PostCommentForPullRequest -> Text
$sel:pullRequestId:PostCommentForPullRequest' :: PostCommentForPullRequest -> Text
$sel:location:PostCommentForPullRequest' :: PostCommentForPullRequest -> Maybe Location
$sel:clientRequestToken:PostCommentForPullRequest' :: PostCommentForPullRequest -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
clientRequestToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Location
location
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
pullRequestId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
repositoryName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
beforeCommitId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
afterCommitId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
content

instance Prelude.NFData PostCommentForPullRequest where
  rnf :: PostCommentForPullRequest -> ()
rnf PostCommentForPullRequest' {Maybe Text
Maybe Location
Text
content :: Text
afterCommitId :: Text
beforeCommitId :: Text
repositoryName :: Text
pullRequestId :: Text
location :: Maybe Location
clientRequestToken :: Maybe Text
$sel:content:PostCommentForPullRequest' :: PostCommentForPullRequest -> Text
$sel:afterCommitId:PostCommentForPullRequest' :: PostCommentForPullRequest -> Text
$sel:beforeCommitId:PostCommentForPullRequest' :: PostCommentForPullRequest -> Text
$sel:repositoryName:PostCommentForPullRequest' :: PostCommentForPullRequest -> Text
$sel:pullRequestId:PostCommentForPullRequest' :: PostCommentForPullRequest -> Text
$sel:location:PostCommentForPullRequest' :: PostCommentForPullRequest -> Maybe Location
$sel:clientRequestToken:PostCommentForPullRequest' :: PostCommentForPullRequest -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
clientRequestToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Location
location
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
pullRequestId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
repositoryName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
beforeCommitId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
afterCommitId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
content

instance Data.ToHeaders PostCommentForPullRequest where
  toHeaders :: PostCommentForPullRequest -> 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.PostCommentForPullRequest" ::
                          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 PostCommentForPullRequest where
  toJSON :: PostCommentForPullRequest -> Value
toJSON PostCommentForPullRequest' {Maybe Text
Maybe Location
Text
content :: Text
afterCommitId :: Text
beforeCommitId :: Text
repositoryName :: Text
pullRequestId :: Text
location :: Maybe Location
clientRequestToken :: Maybe Text
$sel:content:PostCommentForPullRequest' :: PostCommentForPullRequest -> Text
$sel:afterCommitId:PostCommentForPullRequest' :: PostCommentForPullRequest -> Text
$sel:beforeCommitId:PostCommentForPullRequest' :: PostCommentForPullRequest -> Text
$sel:repositoryName:PostCommentForPullRequest' :: PostCommentForPullRequest -> Text
$sel:pullRequestId:PostCommentForPullRequest' :: PostCommentForPullRequest -> Text
$sel:location:PostCommentForPullRequest' :: PostCommentForPullRequest -> Maybe Location
$sel:clientRequestToken:PostCommentForPullRequest' :: PostCommentForPullRequest -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"clientRequestToken" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
clientRequestToken,
            (Key
"location" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Location
location,
            forall a. a -> Maybe a
Prelude.Just (Key
"pullRequestId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
pullRequestId),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"repositoryName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
repositoryName),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"beforeCommitId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
beforeCommitId),
            forall a. a -> Maybe a
Prelude.Just (Key
"afterCommitId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
afterCommitId),
            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 PostCommentForPullRequest where
  toPath :: PostCommentForPullRequest -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

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

-- | /See:/ 'newPostCommentForPullRequestResponse' smart constructor.
data PostCommentForPullRequestResponse = PostCommentForPullRequestResponse'
  { -- | In the directionality of the pull request, the blob ID of the after
    -- blob.
    PostCommentForPullRequestResponse -> Maybe Text
afterBlobId :: Prelude.Maybe Prelude.Text,
    -- | The full commit ID of the commit in the destination branch where the
    -- pull request is merged.
    PostCommentForPullRequestResponse -> Maybe Text
afterCommitId :: Prelude.Maybe Prelude.Text,
    -- | In the directionality of the pull request, the blob ID of the before
    -- blob.
    PostCommentForPullRequestResponse -> Maybe Text
beforeBlobId :: Prelude.Maybe Prelude.Text,
    -- | The full commit ID of the commit in the source branch used to create the
    -- pull request, or in the case of an updated pull request, the full commit
    -- ID of the commit used to update the pull request.
    PostCommentForPullRequestResponse -> Maybe Text
beforeCommitId :: Prelude.Maybe Prelude.Text,
    -- | The content of the comment you posted.
    PostCommentForPullRequestResponse -> Maybe Comment
comment :: Prelude.Maybe Comment,
    -- | The location of the change where you posted your comment.
    PostCommentForPullRequestResponse -> Maybe Location
location :: Prelude.Maybe Location,
    -- | The system-generated ID of the pull request.
    PostCommentForPullRequestResponse -> Maybe Text
pullRequestId :: Prelude.Maybe Prelude.Text,
    -- | The name of the repository where you posted a comment on a pull request.
    PostCommentForPullRequestResponse -> Maybe Text
repositoryName :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    PostCommentForPullRequestResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (PostCommentForPullRequestResponse
-> PostCommentForPullRequestResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostCommentForPullRequestResponse
-> PostCommentForPullRequestResponse -> Bool
$c/= :: PostCommentForPullRequestResponse
-> PostCommentForPullRequestResponse -> Bool
== :: PostCommentForPullRequestResponse
-> PostCommentForPullRequestResponse -> Bool
$c== :: PostCommentForPullRequestResponse
-> PostCommentForPullRequestResponse -> Bool
Prelude.Eq, ReadPrec [PostCommentForPullRequestResponse]
ReadPrec PostCommentForPullRequestResponse
Int -> ReadS PostCommentForPullRequestResponse
ReadS [PostCommentForPullRequestResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PostCommentForPullRequestResponse]
$creadListPrec :: ReadPrec [PostCommentForPullRequestResponse]
readPrec :: ReadPrec PostCommentForPullRequestResponse
$creadPrec :: ReadPrec PostCommentForPullRequestResponse
readList :: ReadS [PostCommentForPullRequestResponse]
$creadList :: ReadS [PostCommentForPullRequestResponse]
readsPrec :: Int -> ReadS PostCommentForPullRequestResponse
$creadsPrec :: Int -> ReadS PostCommentForPullRequestResponse
Prelude.Read, Int -> PostCommentForPullRequestResponse -> ShowS
[PostCommentForPullRequestResponse] -> ShowS
PostCommentForPullRequestResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PostCommentForPullRequestResponse] -> ShowS
$cshowList :: [PostCommentForPullRequestResponse] -> ShowS
show :: PostCommentForPullRequestResponse -> String
$cshow :: PostCommentForPullRequestResponse -> String
showsPrec :: Int -> PostCommentForPullRequestResponse -> ShowS
$cshowsPrec :: Int -> PostCommentForPullRequestResponse -> ShowS
Prelude.Show, forall x.
Rep PostCommentForPullRequestResponse x
-> PostCommentForPullRequestResponse
forall x.
PostCommentForPullRequestResponse
-> Rep PostCommentForPullRequestResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep PostCommentForPullRequestResponse x
-> PostCommentForPullRequestResponse
$cfrom :: forall x.
PostCommentForPullRequestResponse
-> Rep PostCommentForPullRequestResponse x
Prelude.Generic)

-- |
-- Create a value of 'PostCommentForPullRequestResponse' 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:
--
-- 'afterBlobId', 'postCommentForPullRequestResponse_afterBlobId' - In the directionality of the pull request, the blob ID of the after
-- blob.
--
-- 'afterCommitId', 'postCommentForPullRequestResponse_afterCommitId' - The full commit ID of the commit in the destination branch where the
-- pull request is merged.
--
-- 'beforeBlobId', 'postCommentForPullRequestResponse_beforeBlobId' - In the directionality of the pull request, the blob ID of the before
-- blob.
--
-- 'beforeCommitId', 'postCommentForPullRequestResponse_beforeCommitId' - The full commit ID of the commit in the source branch used to create the
-- pull request, or in the case of an updated pull request, the full commit
-- ID of the commit used to update the pull request.
--
-- 'comment', 'postCommentForPullRequestResponse_comment' - The content of the comment you posted.
--
-- 'location', 'postCommentForPullRequestResponse_location' - The location of the change where you posted your comment.
--
-- 'pullRequestId', 'postCommentForPullRequestResponse_pullRequestId' - The system-generated ID of the pull request.
--
-- 'repositoryName', 'postCommentForPullRequestResponse_repositoryName' - The name of the repository where you posted a comment on a pull request.
--
-- 'httpStatus', 'postCommentForPullRequestResponse_httpStatus' - The response's http status code.
newPostCommentForPullRequestResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  PostCommentForPullRequestResponse
newPostCommentForPullRequestResponse :: Int -> PostCommentForPullRequestResponse
newPostCommentForPullRequestResponse Int
pHttpStatus_ =
  PostCommentForPullRequestResponse'
    { $sel:afterBlobId:PostCommentForPullRequestResponse' :: Maybe Text
afterBlobId =
        forall a. Maybe a
Prelude.Nothing,
      $sel:afterCommitId:PostCommentForPullRequestResponse' :: Maybe Text
afterCommitId = forall a. Maybe a
Prelude.Nothing,
      $sel:beforeBlobId:PostCommentForPullRequestResponse' :: Maybe Text
beforeBlobId = forall a. Maybe a
Prelude.Nothing,
      $sel:beforeCommitId:PostCommentForPullRequestResponse' :: Maybe Text
beforeCommitId = forall a. Maybe a
Prelude.Nothing,
      $sel:comment:PostCommentForPullRequestResponse' :: Maybe Comment
comment = forall a. Maybe a
Prelude.Nothing,
      $sel:location:PostCommentForPullRequestResponse' :: Maybe Location
location = forall a. Maybe a
Prelude.Nothing,
      $sel:pullRequestId:PostCommentForPullRequestResponse' :: Maybe Text
pullRequestId = forall a. Maybe a
Prelude.Nothing,
      $sel:repositoryName:PostCommentForPullRequestResponse' :: Maybe Text
repositoryName = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:PostCommentForPullRequestResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | In the directionality of the pull request, the blob ID of the after
-- blob.
postCommentForPullRequestResponse_afterBlobId :: Lens.Lens' PostCommentForPullRequestResponse (Prelude.Maybe Prelude.Text)
postCommentForPullRequestResponse_afterBlobId :: Lens' PostCommentForPullRequestResponse (Maybe Text)
postCommentForPullRequestResponse_afterBlobId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PostCommentForPullRequestResponse' {Maybe Text
afterBlobId :: Maybe Text
$sel:afterBlobId:PostCommentForPullRequestResponse' :: PostCommentForPullRequestResponse -> Maybe Text
afterBlobId} -> Maybe Text
afterBlobId) (\s :: PostCommentForPullRequestResponse
s@PostCommentForPullRequestResponse' {} Maybe Text
a -> PostCommentForPullRequestResponse
s {$sel:afterBlobId:PostCommentForPullRequestResponse' :: Maybe Text
afterBlobId = Maybe Text
a} :: PostCommentForPullRequestResponse)

-- | The full commit ID of the commit in the destination branch where the
-- pull request is merged.
postCommentForPullRequestResponse_afterCommitId :: Lens.Lens' PostCommentForPullRequestResponse (Prelude.Maybe Prelude.Text)
postCommentForPullRequestResponse_afterCommitId :: Lens' PostCommentForPullRequestResponse (Maybe Text)
postCommentForPullRequestResponse_afterCommitId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PostCommentForPullRequestResponse' {Maybe Text
afterCommitId :: Maybe Text
$sel:afterCommitId:PostCommentForPullRequestResponse' :: PostCommentForPullRequestResponse -> Maybe Text
afterCommitId} -> Maybe Text
afterCommitId) (\s :: PostCommentForPullRequestResponse
s@PostCommentForPullRequestResponse' {} Maybe Text
a -> PostCommentForPullRequestResponse
s {$sel:afterCommitId:PostCommentForPullRequestResponse' :: Maybe Text
afterCommitId = Maybe Text
a} :: PostCommentForPullRequestResponse)

-- | In the directionality of the pull request, the blob ID of the before
-- blob.
postCommentForPullRequestResponse_beforeBlobId :: Lens.Lens' PostCommentForPullRequestResponse (Prelude.Maybe Prelude.Text)
postCommentForPullRequestResponse_beforeBlobId :: Lens' PostCommentForPullRequestResponse (Maybe Text)
postCommentForPullRequestResponse_beforeBlobId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PostCommentForPullRequestResponse' {Maybe Text
beforeBlobId :: Maybe Text
$sel:beforeBlobId:PostCommentForPullRequestResponse' :: PostCommentForPullRequestResponse -> Maybe Text
beforeBlobId} -> Maybe Text
beforeBlobId) (\s :: PostCommentForPullRequestResponse
s@PostCommentForPullRequestResponse' {} Maybe Text
a -> PostCommentForPullRequestResponse
s {$sel:beforeBlobId:PostCommentForPullRequestResponse' :: Maybe Text
beforeBlobId = Maybe Text
a} :: PostCommentForPullRequestResponse)

-- | The full commit ID of the commit in the source branch used to create the
-- pull request, or in the case of an updated pull request, the full commit
-- ID of the commit used to update the pull request.
postCommentForPullRequestResponse_beforeCommitId :: Lens.Lens' PostCommentForPullRequestResponse (Prelude.Maybe Prelude.Text)
postCommentForPullRequestResponse_beforeCommitId :: Lens' PostCommentForPullRequestResponse (Maybe Text)
postCommentForPullRequestResponse_beforeCommitId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PostCommentForPullRequestResponse' {Maybe Text
beforeCommitId :: Maybe Text
$sel:beforeCommitId:PostCommentForPullRequestResponse' :: PostCommentForPullRequestResponse -> Maybe Text
beforeCommitId} -> Maybe Text
beforeCommitId) (\s :: PostCommentForPullRequestResponse
s@PostCommentForPullRequestResponse' {} Maybe Text
a -> PostCommentForPullRequestResponse
s {$sel:beforeCommitId:PostCommentForPullRequestResponse' :: Maybe Text
beforeCommitId = Maybe Text
a} :: PostCommentForPullRequestResponse)

-- | The content of the comment you posted.
postCommentForPullRequestResponse_comment :: Lens.Lens' PostCommentForPullRequestResponse (Prelude.Maybe Comment)
postCommentForPullRequestResponse_comment :: Lens' PostCommentForPullRequestResponse (Maybe Comment)
postCommentForPullRequestResponse_comment = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PostCommentForPullRequestResponse' {Maybe Comment
comment :: Maybe Comment
$sel:comment:PostCommentForPullRequestResponse' :: PostCommentForPullRequestResponse -> Maybe Comment
comment} -> Maybe Comment
comment) (\s :: PostCommentForPullRequestResponse
s@PostCommentForPullRequestResponse' {} Maybe Comment
a -> PostCommentForPullRequestResponse
s {$sel:comment:PostCommentForPullRequestResponse' :: Maybe Comment
comment = Maybe Comment
a} :: PostCommentForPullRequestResponse)

-- | The location of the change where you posted your comment.
postCommentForPullRequestResponse_location :: Lens.Lens' PostCommentForPullRequestResponse (Prelude.Maybe Location)
postCommentForPullRequestResponse_location :: Lens' PostCommentForPullRequestResponse (Maybe Location)
postCommentForPullRequestResponse_location = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PostCommentForPullRequestResponse' {Maybe Location
location :: Maybe Location
$sel:location:PostCommentForPullRequestResponse' :: PostCommentForPullRequestResponse -> Maybe Location
location} -> Maybe Location
location) (\s :: PostCommentForPullRequestResponse
s@PostCommentForPullRequestResponse' {} Maybe Location
a -> PostCommentForPullRequestResponse
s {$sel:location:PostCommentForPullRequestResponse' :: Maybe Location
location = Maybe Location
a} :: PostCommentForPullRequestResponse)

-- | The system-generated ID of the pull request.
postCommentForPullRequestResponse_pullRequestId :: Lens.Lens' PostCommentForPullRequestResponse (Prelude.Maybe Prelude.Text)
postCommentForPullRequestResponse_pullRequestId :: Lens' PostCommentForPullRequestResponse (Maybe Text)
postCommentForPullRequestResponse_pullRequestId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PostCommentForPullRequestResponse' {Maybe Text
pullRequestId :: Maybe Text
$sel:pullRequestId:PostCommentForPullRequestResponse' :: PostCommentForPullRequestResponse -> Maybe Text
pullRequestId} -> Maybe Text
pullRequestId) (\s :: PostCommentForPullRequestResponse
s@PostCommentForPullRequestResponse' {} Maybe Text
a -> PostCommentForPullRequestResponse
s {$sel:pullRequestId:PostCommentForPullRequestResponse' :: Maybe Text
pullRequestId = Maybe Text
a} :: PostCommentForPullRequestResponse)

-- | The name of the repository where you posted a comment on a pull request.
postCommentForPullRequestResponse_repositoryName :: Lens.Lens' PostCommentForPullRequestResponse (Prelude.Maybe Prelude.Text)
postCommentForPullRequestResponse_repositoryName :: Lens' PostCommentForPullRequestResponse (Maybe Text)
postCommentForPullRequestResponse_repositoryName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PostCommentForPullRequestResponse' {Maybe Text
repositoryName :: Maybe Text
$sel:repositoryName:PostCommentForPullRequestResponse' :: PostCommentForPullRequestResponse -> Maybe Text
repositoryName} -> Maybe Text
repositoryName) (\s :: PostCommentForPullRequestResponse
s@PostCommentForPullRequestResponse' {} Maybe Text
a -> PostCommentForPullRequestResponse
s {$sel:repositoryName:PostCommentForPullRequestResponse' :: Maybe Text
repositoryName = Maybe Text
a} :: PostCommentForPullRequestResponse)

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

instance
  Prelude.NFData
    PostCommentForPullRequestResponse
  where
  rnf :: PostCommentForPullRequestResponse -> ()
rnf PostCommentForPullRequestResponse' {Int
Maybe Text
Maybe Comment
Maybe Location
httpStatus :: Int
repositoryName :: Maybe Text
pullRequestId :: Maybe Text
location :: Maybe Location
comment :: Maybe Comment
beforeCommitId :: Maybe Text
beforeBlobId :: Maybe Text
afterCommitId :: Maybe Text
afterBlobId :: Maybe Text
$sel:httpStatus:PostCommentForPullRequestResponse' :: PostCommentForPullRequestResponse -> Int
$sel:repositoryName:PostCommentForPullRequestResponse' :: PostCommentForPullRequestResponse -> Maybe Text
$sel:pullRequestId:PostCommentForPullRequestResponse' :: PostCommentForPullRequestResponse -> Maybe Text
$sel:location:PostCommentForPullRequestResponse' :: PostCommentForPullRequestResponse -> Maybe Location
$sel:comment:PostCommentForPullRequestResponse' :: PostCommentForPullRequestResponse -> Maybe Comment
$sel:beforeCommitId:PostCommentForPullRequestResponse' :: PostCommentForPullRequestResponse -> Maybe Text
$sel:beforeBlobId:PostCommentForPullRequestResponse' :: PostCommentForPullRequestResponse -> Maybe Text
$sel:afterCommitId:PostCommentForPullRequestResponse' :: PostCommentForPullRequestResponse -> Maybe Text
$sel:afterBlobId:PostCommentForPullRequestResponse' :: PostCommentForPullRequestResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
afterBlobId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
afterCommitId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
beforeBlobId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
beforeCommitId
      seq :: forall a b. a -> b -> b
`Prelude.seq` 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 Maybe Location
location
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
pullRequestId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
repositoryName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus