{-# 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.GetCommentsForComparedCommit
-- 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 information about comments made on the comparison between two
-- commits.
--
-- 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.GetCommentsForComparedCommit
  ( -- * Creating a Request
    GetCommentsForComparedCommit (..),
    newGetCommentsForComparedCommit,

    -- * Request Lenses
    getCommentsForComparedCommit_beforeCommitId,
    getCommentsForComparedCommit_maxResults,
    getCommentsForComparedCommit_nextToken,
    getCommentsForComparedCommit_repositoryName,
    getCommentsForComparedCommit_afterCommitId,

    -- * Destructuring the Response
    GetCommentsForComparedCommitResponse (..),
    newGetCommentsForComparedCommitResponse,

    -- * Response Lenses
    getCommentsForComparedCommitResponse_commentsForComparedCommitData,
    getCommentsForComparedCommitResponse_nextToken,
    getCommentsForComparedCommitResponse_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:/ 'newGetCommentsForComparedCommit' smart constructor.
data GetCommentsForComparedCommit = GetCommentsForComparedCommit'
  { -- | To establish the directionality of the comparison, the full commit ID of
    -- the before commit.
    GetCommentsForComparedCommit -> 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, but you can configure up to 500.
    GetCommentsForComparedCommit -> Maybe Int
maxResults :: Prelude.Maybe Prelude.Int,
    -- | An enumeration token that when provided in a request, returns the next
    -- batch of the results.
    GetCommentsForComparedCommit -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The name of the repository where you want to compare commits.
    GetCommentsForComparedCommit -> Text
repositoryName :: Prelude.Text,
    -- | To establish the directionality of the comparison, the full commit ID of
    -- the after commit.
    GetCommentsForComparedCommit -> Text
afterCommitId :: Prelude.Text
  }
  deriving (GetCommentsForComparedCommit
-> GetCommentsForComparedCommit -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetCommentsForComparedCommit
-> GetCommentsForComparedCommit -> Bool
$c/= :: GetCommentsForComparedCommit
-> GetCommentsForComparedCommit -> Bool
== :: GetCommentsForComparedCommit
-> GetCommentsForComparedCommit -> Bool
$c== :: GetCommentsForComparedCommit
-> GetCommentsForComparedCommit -> Bool
Prelude.Eq, ReadPrec [GetCommentsForComparedCommit]
ReadPrec GetCommentsForComparedCommit
Int -> ReadS GetCommentsForComparedCommit
ReadS [GetCommentsForComparedCommit]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetCommentsForComparedCommit]
$creadListPrec :: ReadPrec [GetCommentsForComparedCommit]
readPrec :: ReadPrec GetCommentsForComparedCommit
$creadPrec :: ReadPrec GetCommentsForComparedCommit
readList :: ReadS [GetCommentsForComparedCommit]
$creadList :: ReadS [GetCommentsForComparedCommit]
readsPrec :: Int -> ReadS GetCommentsForComparedCommit
$creadsPrec :: Int -> ReadS GetCommentsForComparedCommit
Prelude.Read, Int -> GetCommentsForComparedCommit -> ShowS
[GetCommentsForComparedCommit] -> ShowS
GetCommentsForComparedCommit -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetCommentsForComparedCommit] -> ShowS
$cshowList :: [GetCommentsForComparedCommit] -> ShowS
show :: GetCommentsForComparedCommit -> String
$cshow :: GetCommentsForComparedCommit -> String
showsPrec :: Int -> GetCommentsForComparedCommit -> ShowS
$cshowsPrec :: Int -> GetCommentsForComparedCommit -> ShowS
Prelude.Show, forall x.
Rep GetCommentsForComparedCommit x -> GetCommentsForComparedCommit
forall x.
GetCommentsForComparedCommit -> Rep GetCommentsForComparedCommit x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetCommentsForComparedCommit x -> GetCommentsForComparedCommit
$cfrom :: forall x.
GetCommentsForComparedCommit -> Rep GetCommentsForComparedCommit x
Prelude.Generic)

-- |
-- Create a value of 'GetCommentsForComparedCommit' 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:
--
-- 'beforeCommitId', 'getCommentsForComparedCommit_beforeCommitId' - To establish the directionality of the comparison, the full commit ID of
-- the before commit.
--
-- 'maxResults', 'getCommentsForComparedCommit_maxResults' - A non-zero, non-negative integer used to limit the number of returned
-- results. The default is 100 comments, but you can configure up to 500.
--
-- 'nextToken', 'getCommentsForComparedCommit_nextToken' - An enumeration token that when provided in a request, returns the next
-- batch of the results.
--
-- 'repositoryName', 'getCommentsForComparedCommit_repositoryName' - The name of the repository where you want to compare commits.
--
-- 'afterCommitId', 'getCommentsForComparedCommit_afterCommitId' - To establish the directionality of the comparison, the full commit ID of
-- the after commit.
newGetCommentsForComparedCommit ::
  -- | 'repositoryName'
  Prelude.Text ->
  -- | 'afterCommitId'
  Prelude.Text ->
  GetCommentsForComparedCommit
newGetCommentsForComparedCommit :: Text -> Text -> GetCommentsForComparedCommit
newGetCommentsForComparedCommit
  Text
pRepositoryName_
  Text
pAfterCommitId_ =
    GetCommentsForComparedCommit'
      { $sel:beforeCommitId:GetCommentsForComparedCommit' :: Maybe Text
beforeCommitId =
          forall a. Maybe a
Prelude.Nothing,
        $sel:maxResults:GetCommentsForComparedCommit' :: Maybe Int
maxResults = forall a. Maybe a
Prelude.Nothing,
        $sel:nextToken:GetCommentsForComparedCommit' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
        $sel:repositoryName:GetCommentsForComparedCommit' :: Text
repositoryName = Text
pRepositoryName_,
        $sel:afterCommitId:GetCommentsForComparedCommit' :: Text
afterCommitId = Text
pAfterCommitId_
      }

-- | To establish the directionality of the comparison, the full commit ID of
-- the before commit.
getCommentsForComparedCommit_beforeCommitId :: Lens.Lens' GetCommentsForComparedCommit (Prelude.Maybe Prelude.Text)
getCommentsForComparedCommit_beforeCommitId :: Lens' GetCommentsForComparedCommit (Maybe Text)
getCommentsForComparedCommit_beforeCommitId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetCommentsForComparedCommit' {Maybe Text
beforeCommitId :: Maybe Text
$sel:beforeCommitId:GetCommentsForComparedCommit' :: GetCommentsForComparedCommit -> Maybe Text
beforeCommitId} -> Maybe Text
beforeCommitId) (\s :: GetCommentsForComparedCommit
s@GetCommentsForComparedCommit' {} Maybe Text
a -> GetCommentsForComparedCommit
s {$sel:beforeCommitId:GetCommentsForComparedCommit' :: Maybe Text
beforeCommitId = Maybe Text
a} :: GetCommentsForComparedCommit)

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

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

-- | The name of the repository where you want to compare commits.
getCommentsForComparedCommit_repositoryName :: Lens.Lens' GetCommentsForComparedCommit Prelude.Text
getCommentsForComparedCommit_repositoryName :: Lens' GetCommentsForComparedCommit Text
getCommentsForComparedCommit_repositoryName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetCommentsForComparedCommit' {Text
repositoryName :: Text
$sel:repositoryName:GetCommentsForComparedCommit' :: GetCommentsForComparedCommit -> Text
repositoryName} -> Text
repositoryName) (\s :: GetCommentsForComparedCommit
s@GetCommentsForComparedCommit' {} Text
a -> GetCommentsForComparedCommit
s {$sel:repositoryName:GetCommentsForComparedCommit' :: Text
repositoryName = Text
a} :: GetCommentsForComparedCommit)

-- | To establish the directionality of the comparison, the full commit ID of
-- the after commit.
getCommentsForComparedCommit_afterCommitId :: Lens.Lens' GetCommentsForComparedCommit Prelude.Text
getCommentsForComparedCommit_afterCommitId :: Lens' GetCommentsForComparedCommit Text
getCommentsForComparedCommit_afterCommitId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetCommentsForComparedCommit' {Text
afterCommitId :: Text
$sel:afterCommitId:GetCommentsForComparedCommit' :: GetCommentsForComparedCommit -> Text
afterCommitId} -> Text
afterCommitId) (\s :: GetCommentsForComparedCommit
s@GetCommentsForComparedCommit' {} Text
a -> GetCommentsForComparedCommit
s {$sel:afterCommitId:GetCommentsForComparedCommit' :: Text
afterCommitId = Text
a} :: GetCommentsForComparedCommit)

instance Core.AWSPager GetCommentsForComparedCommit where
  page :: GetCommentsForComparedCommit
-> AWSResponse GetCommentsForComparedCommit
-> Maybe GetCommentsForComparedCommit
page GetCommentsForComparedCommit
rq AWSResponse GetCommentsForComparedCommit
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse GetCommentsForComparedCommit
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' GetCommentsForComparedCommitResponse (Maybe Text)
getCommentsForComparedCommitResponse_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 GetCommentsForComparedCommit
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens'
  GetCommentsForComparedCommitResponse
  (Maybe [CommentsForComparedCommit])
getCommentsForComparedCommitResponse_commentsForComparedCommitData
            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.$ GetCommentsForComparedCommit
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' GetCommentsForComparedCommit (Maybe Text)
getCommentsForComparedCommit_nextToken
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse GetCommentsForComparedCommit
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' GetCommentsForComparedCommitResponse (Maybe Text)
getCommentsForComparedCommitResponse_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 GetCommentsForComparedCommit where
  type
    AWSResponse GetCommentsForComparedCommit =
      GetCommentsForComparedCommitResponse
  request :: (Service -> Service)
-> GetCommentsForComparedCommit
-> Request GetCommentsForComparedCommit
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 GetCommentsForComparedCommit
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse GetCommentsForComparedCommit)))
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 [CommentsForComparedCommit]
-> Maybe Text -> Int -> GetCommentsForComparedCommitResponse
GetCommentsForComparedCommitResponse'
            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
"commentsForComparedCommitData"
                            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
    GetCommentsForComparedCommit
  where
  hashWithSalt :: Int -> GetCommentsForComparedCommit -> Int
hashWithSalt Int
_salt GetCommentsForComparedCommit' {Maybe Int
Maybe Text
Text
afterCommitId :: Text
repositoryName :: Text
nextToken :: Maybe Text
maxResults :: Maybe Int
beforeCommitId :: Maybe Text
$sel:afterCommitId:GetCommentsForComparedCommit' :: GetCommentsForComparedCommit -> Text
$sel:repositoryName:GetCommentsForComparedCommit' :: GetCommentsForComparedCommit -> Text
$sel:nextToken:GetCommentsForComparedCommit' :: GetCommentsForComparedCommit -> Maybe Text
$sel:maxResults:GetCommentsForComparedCommit' :: GetCommentsForComparedCommit -> Maybe Int
$sel:beforeCommitId:GetCommentsForComparedCommit' :: GetCommentsForComparedCommit -> Maybe Text
..} =
    Int
_salt
      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` Text
repositoryName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
afterCommitId

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

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

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

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

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

-- |
-- Create a value of 'GetCommentsForComparedCommitResponse' 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:
--
-- 'commentsForComparedCommitData', 'getCommentsForComparedCommitResponse_commentsForComparedCommitData' - A list of comment objects on the compared commit.
--
-- 'nextToken', 'getCommentsForComparedCommitResponse_nextToken' - An enumeration token that can be used in a request to return the next
-- batch of the results.
--
-- 'httpStatus', 'getCommentsForComparedCommitResponse_httpStatus' - The response's http status code.
newGetCommentsForComparedCommitResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetCommentsForComparedCommitResponse
newGetCommentsForComparedCommitResponse :: Int -> GetCommentsForComparedCommitResponse
newGetCommentsForComparedCommitResponse Int
pHttpStatus_ =
  GetCommentsForComparedCommitResponse'
    { $sel:commentsForComparedCommitData:GetCommentsForComparedCommitResponse' :: Maybe [CommentsForComparedCommit]
commentsForComparedCommitData =
        forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:GetCommentsForComparedCommitResponse' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetCommentsForComparedCommitResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | A list of comment objects on the compared commit.
getCommentsForComparedCommitResponse_commentsForComparedCommitData :: Lens.Lens' GetCommentsForComparedCommitResponse (Prelude.Maybe [CommentsForComparedCommit])
getCommentsForComparedCommitResponse_commentsForComparedCommitData :: Lens'
  GetCommentsForComparedCommitResponse
  (Maybe [CommentsForComparedCommit])
getCommentsForComparedCommitResponse_commentsForComparedCommitData = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetCommentsForComparedCommitResponse' {Maybe [CommentsForComparedCommit]
commentsForComparedCommitData :: Maybe [CommentsForComparedCommit]
$sel:commentsForComparedCommitData:GetCommentsForComparedCommitResponse' :: GetCommentsForComparedCommitResponse
-> Maybe [CommentsForComparedCommit]
commentsForComparedCommitData} -> Maybe [CommentsForComparedCommit]
commentsForComparedCommitData) (\s :: GetCommentsForComparedCommitResponse
s@GetCommentsForComparedCommitResponse' {} Maybe [CommentsForComparedCommit]
a -> GetCommentsForComparedCommitResponse
s {$sel:commentsForComparedCommitData:GetCommentsForComparedCommitResponse' :: Maybe [CommentsForComparedCommit]
commentsForComparedCommitData = Maybe [CommentsForComparedCommit]
a} :: GetCommentsForComparedCommitResponse) 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.
getCommentsForComparedCommitResponse_nextToken :: Lens.Lens' GetCommentsForComparedCommitResponse (Prelude.Maybe Prelude.Text)
getCommentsForComparedCommitResponse_nextToken :: Lens' GetCommentsForComparedCommitResponse (Maybe Text)
getCommentsForComparedCommitResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetCommentsForComparedCommitResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:GetCommentsForComparedCommitResponse' :: GetCommentsForComparedCommitResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: GetCommentsForComparedCommitResponse
s@GetCommentsForComparedCommitResponse' {} Maybe Text
a -> GetCommentsForComparedCommitResponse
s {$sel:nextToken:GetCommentsForComparedCommitResponse' :: Maybe Text
nextToken = Maybe Text
a} :: GetCommentsForComparedCommitResponse)

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

instance
  Prelude.NFData
    GetCommentsForComparedCommitResponse
  where
  rnf :: GetCommentsForComparedCommitResponse -> ()
rnf GetCommentsForComparedCommitResponse' {Int
Maybe [CommentsForComparedCommit]
Maybe Text
httpStatus :: Int
nextToken :: Maybe Text
commentsForComparedCommitData :: Maybe [CommentsForComparedCommit]
$sel:httpStatus:GetCommentsForComparedCommitResponse' :: GetCommentsForComparedCommitResponse -> Int
$sel:nextToken:GetCommentsForComparedCommitResponse' :: GetCommentsForComparedCommitResponse -> Maybe Text
$sel:commentsForComparedCommitData:GetCommentsForComparedCommitResponse' :: GetCommentsForComparedCommitResponse
-> Maybe [CommentsForComparedCommit]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [CommentsForComparedCommit]
commentsForComparedCommitData
      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