{-# 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.GetCommentsForPullRequest
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Returns comments made on a pull request.
--
-- Reaction counts might include numbers from user identities who were
-- deleted after the reaction was made. For a count of reactions from
-- active identities, use GetCommentReactions.
--
-- This operation returns paginated results.
module Amazonka.CodeCommit.GetCommentsForPullRequest
  ( -- * Creating a Request
    GetCommentsForPullRequest (..),
    newGetCommentsForPullRequest,

    -- * Request Lenses
    getCommentsForPullRequest_afterCommitId,
    getCommentsForPullRequest_beforeCommitId,
    getCommentsForPullRequest_maxResults,
    getCommentsForPullRequest_nextToken,
    getCommentsForPullRequest_repositoryName,
    getCommentsForPullRequest_pullRequestId,

    -- * Destructuring the Response
    GetCommentsForPullRequestResponse (..),
    newGetCommentsForPullRequestResponse,

    -- * Response Lenses
    getCommentsForPullRequestResponse_commentsForPullRequestData,
    getCommentsForPullRequestResponse_nextToken,
    getCommentsForPullRequestResponse_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:/ 'newGetCommentsForPullRequest' smart constructor.
data GetCommentsForPullRequest = GetCommentsForPullRequest'
  { -- | The full commit ID of the commit in the source branch that was the tip
    -- of the branch at the time the comment was made.
    GetCommentsForPullRequest -> Maybe Text
afterCommitId :: Prelude.Maybe 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.
    GetCommentsForPullRequest -> Maybe Text
beforeCommitId :: Prelude.Maybe Prelude.Text,
    -- | A non-zero, non-negative integer used to limit the number of returned
    -- results. The default is 100 comments. You can return up to 500 comments
    -- with a single request.
    GetCommentsForPullRequest -> Maybe Int
maxResults :: Prelude.Maybe Prelude.Int,
    -- | An enumeration token that, when provided in a request, returns the next
    -- batch of the results.
    GetCommentsForPullRequest -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The name of the repository that contains the pull request.
    GetCommentsForPullRequest -> Maybe Text
repositoryName :: Prelude.Maybe Prelude.Text,
    -- | The system-generated ID of the pull request. To get this ID, use
    -- ListPullRequests.
    GetCommentsForPullRequest -> Text
pullRequestId :: Prelude.Text
  }
  deriving (GetCommentsForPullRequest -> GetCommentsForPullRequest -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetCommentsForPullRequest -> GetCommentsForPullRequest -> Bool
$c/= :: GetCommentsForPullRequest -> GetCommentsForPullRequest -> Bool
== :: GetCommentsForPullRequest -> GetCommentsForPullRequest -> Bool
$c== :: GetCommentsForPullRequest -> GetCommentsForPullRequest -> Bool
Prelude.Eq, ReadPrec [GetCommentsForPullRequest]
ReadPrec GetCommentsForPullRequest
Int -> ReadS GetCommentsForPullRequest
ReadS [GetCommentsForPullRequest]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetCommentsForPullRequest]
$creadListPrec :: ReadPrec [GetCommentsForPullRequest]
readPrec :: ReadPrec GetCommentsForPullRequest
$creadPrec :: ReadPrec GetCommentsForPullRequest
readList :: ReadS [GetCommentsForPullRequest]
$creadList :: ReadS [GetCommentsForPullRequest]
readsPrec :: Int -> ReadS GetCommentsForPullRequest
$creadsPrec :: Int -> ReadS GetCommentsForPullRequest
Prelude.Read, Int -> GetCommentsForPullRequest -> ShowS
[GetCommentsForPullRequest] -> ShowS
GetCommentsForPullRequest -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetCommentsForPullRequest] -> ShowS
$cshowList :: [GetCommentsForPullRequest] -> ShowS
show :: GetCommentsForPullRequest -> String
$cshow :: GetCommentsForPullRequest -> String
showsPrec :: Int -> GetCommentsForPullRequest -> ShowS
$cshowsPrec :: Int -> GetCommentsForPullRequest -> ShowS
Prelude.Show, forall x.
Rep GetCommentsForPullRequest x -> GetCommentsForPullRequest
forall x.
GetCommentsForPullRequest -> Rep GetCommentsForPullRequest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetCommentsForPullRequest x -> GetCommentsForPullRequest
$cfrom :: forall x.
GetCommentsForPullRequest -> Rep GetCommentsForPullRequest x
Prelude.Generic)

-- |
-- Create a value of 'GetCommentsForPullRequest' 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:
--
-- 'afterCommitId', 'getCommentsForPullRequest_afterCommitId' - The full commit ID of the commit in the source branch that was the tip
-- of the branch at the time the comment was made.
--
-- 'beforeCommitId', 'getCommentsForPullRequest_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.
--
-- 'maxResults', 'getCommentsForPullRequest_maxResults' - A non-zero, non-negative integer used to limit the number of returned
-- results. The default is 100 comments. You can return up to 500 comments
-- with a single request.
--
-- 'nextToken', 'getCommentsForPullRequest_nextToken' - An enumeration token that, when provided in a request, returns the next
-- batch of the results.
--
-- 'repositoryName', 'getCommentsForPullRequest_repositoryName' - The name of the repository that contains the pull request.
--
-- 'pullRequestId', 'getCommentsForPullRequest_pullRequestId' - The system-generated ID of the pull request. To get this ID, use
-- ListPullRequests.
newGetCommentsForPullRequest ::
  -- | 'pullRequestId'
  Prelude.Text ->
  GetCommentsForPullRequest
newGetCommentsForPullRequest :: Text -> GetCommentsForPullRequest
newGetCommentsForPullRequest Text
pPullRequestId_ =
  GetCommentsForPullRequest'
    { $sel:afterCommitId:GetCommentsForPullRequest' :: Maybe Text
afterCommitId =
        forall a. Maybe a
Prelude.Nothing,
      $sel:beforeCommitId:GetCommentsForPullRequest' :: Maybe Text
beforeCommitId = forall a. Maybe a
Prelude.Nothing,
      $sel:maxResults:GetCommentsForPullRequest' :: Maybe Int
maxResults = forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:GetCommentsForPullRequest' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:repositoryName:GetCommentsForPullRequest' :: Maybe Text
repositoryName = forall a. Maybe a
Prelude.Nothing,
      $sel:pullRequestId:GetCommentsForPullRequest' :: Text
pullRequestId = Text
pPullRequestId_
    }

-- | The full commit ID of the commit in the source branch that was the tip
-- of the branch at the time the comment was made.
getCommentsForPullRequest_afterCommitId :: Lens.Lens' GetCommentsForPullRequest (Prelude.Maybe Prelude.Text)
getCommentsForPullRequest_afterCommitId :: Lens' GetCommentsForPullRequest (Maybe Text)
getCommentsForPullRequest_afterCommitId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetCommentsForPullRequest' {Maybe Text
afterCommitId :: Maybe Text
$sel:afterCommitId:GetCommentsForPullRequest' :: GetCommentsForPullRequest -> Maybe Text
afterCommitId} -> Maybe Text
afterCommitId) (\s :: GetCommentsForPullRequest
s@GetCommentsForPullRequest' {} Maybe Text
a -> GetCommentsForPullRequest
s {$sel:afterCommitId:GetCommentsForPullRequest' :: Maybe Text
afterCommitId = Maybe Text
a} :: GetCommentsForPullRequest)

-- | 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.
getCommentsForPullRequest_beforeCommitId :: Lens.Lens' GetCommentsForPullRequest (Prelude.Maybe Prelude.Text)
getCommentsForPullRequest_beforeCommitId :: Lens' GetCommentsForPullRequest (Maybe Text)
getCommentsForPullRequest_beforeCommitId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetCommentsForPullRequest' {Maybe Text
beforeCommitId :: Maybe Text
$sel:beforeCommitId:GetCommentsForPullRequest' :: GetCommentsForPullRequest -> Maybe Text
beforeCommitId} -> Maybe Text
beforeCommitId) (\s :: GetCommentsForPullRequest
s@GetCommentsForPullRequest' {} Maybe Text
a -> GetCommentsForPullRequest
s {$sel:beforeCommitId:GetCommentsForPullRequest' :: Maybe Text
beforeCommitId = Maybe Text
a} :: GetCommentsForPullRequest)

-- | A non-zero, non-negative integer used to limit the number of returned
-- results. The default is 100 comments. You can return up to 500 comments
-- with a single request.
getCommentsForPullRequest_maxResults :: Lens.Lens' GetCommentsForPullRequest (Prelude.Maybe Prelude.Int)
getCommentsForPullRequest_maxResults :: Lens' GetCommentsForPullRequest (Maybe Int)
getCommentsForPullRequest_maxResults = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetCommentsForPullRequest' {Maybe Int
maxResults :: Maybe Int
$sel:maxResults:GetCommentsForPullRequest' :: GetCommentsForPullRequest -> Maybe Int
maxResults} -> Maybe Int
maxResults) (\s :: GetCommentsForPullRequest
s@GetCommentsForPullRequest' {} Maybe Int
a -> GetCommentsForPullRequest
s {$sel:maxResults:GetCommentsForPullRequest' :: Maybe Int
maxResults = Maybe Int
a} :: GetCommentsForPullRequest)

-- | An enumeration token that, when provided in a request, returns the next
-- batch of the results.
getCommentsForPullRequest_nextToken :: Lens.Lens' GetCommentsForPullRequest (Prelude.Maybe Prelude.Text)
getCommentsForPullRequest_nextToken :: Lens' GetCommentsForPullRequest (Maybe Text)
getCommentsForPullRequest_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetCommentsForPullRequest' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:GetCommentsForPullRequest' :: GetCommentsForPullRequest -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: GetCommentsForPullRequest
s@GetCommentsForPullRequest' {} Maybe Text
a -> GetCommentsForPullRequest
s {$sel:nextToken:GetCommentsForPullRequest' :: Maybe Text
nextToken = Maybe Text
a} :: GetCommentsForPullRequest)

-- | The name of the repository that contains the pull request.
getCommentsForPullRequest_repositoryName :: Lens.Lens' GetCommentsForPullRequest (Prelude.Maybe Prelude.Text)
getCommentsForPullRequest_repositoryName :: Lens' GetCommentsForPullRequest (Maybe Text)
getCommentsForPullRequest_repositoryName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetCommentsForPullRequest' {Maybe Text
repositoryName :: Maybe Text
$sel:repositoryName:GetCommentsForPullRequest' :: GetCommentsForPullRequest -> Maybe Text
repositoryName} -> Maybe Text
repositoryName) (\s :: GetCommentsForPullRequest
s@GetCommentsForPullRequest' {} Maybe Text
a -> GetCommentsForPullRequest
s {$sel:repositoryName:GetCommentsForPullRequest' :: Maybe Text
repositoryName = Maybe Text
a} :: GetCommentsForPullRequest)

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

instance Core.AWSPager GetCommentsForPullRequest where
  page :: GetCommentsForPullRequest
-> AWSResponse GetCommentsForPullRequest
-> Maybe GetCommentsForPullRequest
page GetCommentsForPullRequest
rq AWSResponse GetCommentsForPullRequest
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse GetCommentsForPullRequest
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' GetCommentsForPullRequestResponse (Maybe Text)
getCommentsForPullRequestResponse_nextToken
            forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
        ) =
        forall a. Maybe a
Prelude.Nothing
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse GetCommentsForPullRequest
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens'
  GetCommentsForPullRequestResponse (Maybe [CommentsForPullRequest])
getCommentsForPullRequestResponse_commentsForPullRequestData
            forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
        ) =
        forall a. Maybe a
Prelude.Nothing
    | Bool
Prelude.otherwise =
        forall a. a -> Maybe a
Prelude.Just
          forall a b. (a -> b) -> a -> b
Prelude.$ GetCommentsForPullRequest
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' GetCommentsForPullRequest (Maybe Text)
getCommentsForPullRequest_nextToken
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse GetCommentsForPullRequest
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' GetCommentsForPullRequestResponse (Maybe Text)
getCommentsForPullRequestResponse_nextToken
          forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just

instance Core.AWSRequest GetCommentsForPullRequest where
  type
    AWSResponse GetCommentsForPullRequest =
      GetCommentsForPullRequestResponse
  request :: (Service -> Service)
-> GetCommentsForPullRequest -> Request GetCommentsForPullRequest
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 GetCommentsForPullRequest
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse GetCommentsForPullRequest)))
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 [CommentsForPullRequest]
-> Maybe Text -> Int -> GetCommentsForPullRequestResponse
GetCommentsForPullRequestResponse'
            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
"commentsForPullRequestData"
                            forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty
                        )
            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
"nextToken")
            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 GetCommentsForPullRequest where
  hashWithSalt :: Int -> GetCommentsForPullRequest -> Int
hashWithSalt Int
_salt GetCommentsForPullRequest' {Maybe Int
Maybe Text
Text
pullRequestId :: Text
repositoryName :: Maybe Text
nextToken :: Maybe Text
maxResults :: Maybe Int
beforeCommitId :: Maybe Text
afterCommitId :: Maybe Text
$sel:pullRequestId:GetCommentsForPullRequest' :: GetCommentsForPullRequest -> Text
$sel:repositoryName:GetCommentsForPullRequest' :: GetCommentsForPullRequest -> Maybe Text
$sel:nextToken:GetCommentsForPullRequest' :: GetCommentsForPullRequest -> Maybe Text
$sel:maxResults:GetCommentsForPullRequest' :: GetCommentsForPullRequest -> Maybe Int
$sel:beforeCommitId:GetCommentsForPullRequest' :: GetCommentsForPullRequest -> Maybe Text
$sel:afterCommitId:GetCommentsForPullRequest' :: GetCommentsForPullRequest -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
afterCommitId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
beforeCommitId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
maxResults
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
nextToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
repositoryName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
pullRequestId

instance Prelude.NFData GetCommentsForPullRequest where
  rnf :: GetCommentsForPullRequest -> ()
rnf GetCommentsForPullRequest' {Maybe Int
Maybe Text
Text
pullRequestId :: Text
repositoryName :: Maybe Text
nextToken :: Maybe Text
maxResults :: Maybe Int
beforeCommitId :: Maybe Text
afterCommitId :: Maybe Text
$sel:pullRequestId:GetCommentsForPullRequest' :: GetCommentsForPullRequest -> Text
$sel:repositoryName:GetCommentsForPullRequest' :: GetCommentsForPullRequest -> Maybe Text
$sel:nextToken:GetCommentsForPullRequest' :: GetCommentsForPullRequest -> Maybe Text
$sel:maxResults:GetCommentsForPullRequest' :: GetCommentsForPullRequest -> Maybe Int
$sel:beforeCommitId:GetCommentsForPullRequest' :: GetCommentsForPullRequest -> Maybe Text
$sel:afterCommitId:GetCommentsForPullRequest' :: GetCommentsForPullRequest -> Maybe Text
..} =
    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
beforeCommitId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
maxResults
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
nextToken
      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 Text
pullRequestId

instance Data.ToHeaders GetCommentsForPullRequest where
  toHeaders :: GetCommentsForPullRequest -> 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.GetCommentsForPullRequest" ::
                          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 GetCommentsForPullRequest where
  toJSON :: GetCommentsForPullRequest -> Value
toJSON GetCommentsForPullRequest' {Maybe Int
Maybe Text
Text
pullRequestId :: Text
repositoryName :: Maybe Text
nextToken :: Maybe Text
maxResults :: Maybe Int
beforeCommitId :: Maybe Text
afterCommitId :: Maybe Text
$sel:pullRequestId:GetCommentsForPullRequest' :: GetCommentsForPullRequest -> Text
$sel:repositoryName:GetCommentsForPullRequest' :: GetCommentsForPullRequest -> Maybe Text
$sel:nextToken:GetCommentsForPullRequest' :: GetCommentsForPullRequest -> Maybe Text
$sel:maxResults:GetCommentsForPullRequest' :: GetCommentsForPullRequest -> Maybe Int
$sel:beforeCommitId:GetCommentsForPullRequest' :: GetCommentsForPullRequest -> Maybe Text
$sel:afterCommitId:GetCommentsForPullRequest' :: GetCommentsForPullRequest -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"afterCommitId" 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
afterCommitId,
            (Key
"beforeCommitId" 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
beforeCommitId,
            (Key
"maxResults" 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 Int
maxResults,
            (Key
"nextToken" 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
nextToken,
            (Key
"repositoryName" 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
repositoryName,
            forall a. a -> Maybe a
Prelude.Just
              (Key
"pullRequestId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
pullRequestId)
          ]
      )

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

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

-- | /See:/ 'newGetCommentsForPullRequestResponse' smart constructor.
data GetCommentsForPullRequestResponse = GetCommentsForPullRequestResponse'
  { -- | An array of comment objects on the pull request.
    GetCommentsForPullRequestResponse -> Maybe [CommentsForPullRequest]
commentsForPullRequestData :: Prelude.Maybe [CommentsForPullRequest],
    -- | An enumeration token that can be used in a request to return the next
    -- batch of the results.
    GetCommentsForPullRequestResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    GetCommentsForPullRequestResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetCommentsForPullRequestResponse
-> GetCommentsForPullRequestResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetCommentsForPullRequestResponse
-> GetCommentsForPullRequestResponse -> Bool
$c/= :: GetCommentsForPullRequestResponse
-> GetCommentsForPullRequestResponse -> Bool
== :: GetCommentsForPullRequestResponse
-> GetCommentsForPullRequestResponse -> Bool
$c== :: GetCommentsForPullRequestResponse
-> GetCommentsForPullRequestResponse -> Bool
Prelude.Eq, ReadPrec [GetCommentsForPullRequestResponse]
ReadPrec GetCommentsForPullRequestResponse
Int -> ReadS GetCommentsForPullRequestResponse
ReadS [GetCommentsForPullRequestResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetCommentsForPullRequestResponse]
$creadListPrec :: ReadPrec [GetCommentsForPullRequestResponse]
readPrec :: ReadPrec GetCommentsForPullRequestResponse
$creadPrec :: ReadPrec GetCommentsForPullRequestResponse
readList :: ReadS [GetCommentsForPullRequestResponse]
$creadList :: ReadS [GetCommentsForPullRequestResponse]
readsPrec :: Int -> ReadS GetCommentsForPullRequestResponse
$creadsPrec :: Int -> ReadS GetCommentsForPullRequestResponse
Prelude.Read, Int -> GetCommentsForPullRequestResponse -> ShowS
[GetCommentsForPullRequestResponse] -> ShowS
GetCommentsForPullRequestResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetCommentsForPullRequestResponse] -> ShowS
$cshowList :: [GetCommentsForPullRequestResponse] -> ShowS
show :: GetCommentsForPullRequestResponse -> String
$cshow :: GetCommentsForPullRequestResponse -> String
showsPrec :: Int -> GetCommentsForPullRequestResponse -> ShowS
$cshowsPrec :: Int -> GetCommentsForPullRequestResponse -> ShowS
Prelude.Show, forall x.
Rep GetCommentsForPullRequestResponse x
-> GetCommentsForPullRequestResponse
forall x.
GetCommentsForPullRequestResponse
-> Rep GetCommentsForPullRequestResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetCommentsForPullRequestResponse x
-> GetCommentsForPullRequestResponse
$cfrom :: forall x.
GetCommentsForPullRequestResponse
-> Rep GetCommentsForPullRequestResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetCommentsForPullRequestResponse' 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:
--
-- 'commentsForPullRequestData', 'getCommentsForPullRequestResponse_commentsForPullRequestData' - An array of comment objects on the pull request.
--
-- 'nextToken', 'getCommentsForPullRequestResponse_nextToken' - An enumeration token that can be used in a request to return the next
-- batch of the results.
--
-- 'httpStatus', 'getCommentsForPullRequestResponse_httpStatus' - The response's http status code.
newGetCommentsForPullRequestResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetCommentsForPullRequestResponse
newGetCommentsForPullRequestResponse :: Int -> GetCommentsForPullRequestResponse
newGetCommentsForPullRequestResponse Int
pHttpStatus_ =
  GetCommentsForPullRequestResponse'
    { $sel:commentsForPullRequestData:GetCommentsForPullRequestResponse' :: Maybe [CommentsForPullRequest]
commentsForPullRequestData =
        forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:GetCommentsForPullRequestResponse' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetCommentsForPullRequestResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | An array of comment objects on the pull request.
getCommentsForPullRequestResponse_commentsForPullRequestData :: Lens.Lens' GetCommentsForPullRequestResponse (Prelude.Maybe [CommentsForPullRequest])
getCommentsForPullRequestResponse_commentsForPullRequestData :: Lens'
  GetCommentsForPullRequestResponse (Maybe [CommentsForPullRequest])
getCommentsForPullRequestResponse_commentsForPullRequestData = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetCommentsForPullRequestResponse' {Maybe [CommentsForPullRequest]
commentsForPullRequestData :: Maybe [CommentsForPullRequest]
$sel:commentsForPullRequestData:GetCommentsForPullRequestResponse' :: GetCommentsForPullRequestResponse -> Maybe [CommentsForPullRequest]
commentsForPullRequestData} -> Maybe [CommentsForPullRequest]
commentsForPullRequestData) (\s :: GetCommentsForPullRequestResponse
s@GetCommentsForPullRequestResponse' {} Maybe [CommentsForPullRequest]
a -> GetCommentsForPullRequestResponse
s {$sel:commentsForPullRequestData:GetCommentsForPullRequestResponse' :: Maybe [CommentsForPullRequest]
commentsForPullRequestData = Maybe [CommentsForPullRequest]
a} :: GetCommentsForPullRequestResponse) 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 s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | An enumeration token that can be used in a request to return the next
-- batch of the results.
getCommentsForPullRequestResponse_nextToken :: Lens.Lens' GetCommentsForPullRequestResponse (Prelude.Maybe Prelude.Text)
getCommentsForPullRequestResponse_nextToken :: Lens' GetCommentsForPullRequestResponse (Maybe Text)
getCommentsForPullRequestResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetCommentsForPullRequestResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:GetCommentsForPullRequestResponse' :: GetCommentsForPullRequestResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: GetCommentsForPullRequestResponse
s@GetCommentsForPullRequestResponse' {} Maybe Text
a -> GetCommentsForPullRequestResponse
s {$sel:nextToken:GetCommentsForPullRequestResponse' :: Maybe Text
nextToken = Maybe Text
a} :: GetCommentsForPullRequestResponse)

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

instance
  Prelude.NFData
    GetCommentsForPullRequestResponse
  where
  rnf :: GetCommentsForPullRequestResponse -> ()
rnf GetCommentsForPullRequestResponse' {Int
Maybe [CommentsForPullRequest]
Maybe Text
httpStatus :: Int
nextToken :: Maybe Text
commentsForPullRequestData :: Maybe [CommentsForPullRequest]
$sel:httpStatus:GetCommentsForPullRequestResponse' :: GetCommentsForPullRequestResponse -> Int
$sel:nextToken:GetCommentsForPullRequestResponse' :: GetCommentsForPullRequestResponse -> Maybe Text
$sel:commentsForPullRequestData:GetCommentsForPullRequestResponse' :: GetCommentsForPullRequestResponse -> Maybe [CommentsForPullRequest]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [CommentsForPullRequest]
commentsForPullRequestData
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
nextToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus