{-# 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.PostCommentForComparedCommit
-- 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 the comparison between two commits.
module Amazonka.CodeCommit.PostCommentForComparedCommit
  ( -- * Creating a Request
    PostCommentForComparedCommit (..),
    newPostCommentForComparedCommit,

    -- * Request Lenses
    postCommentForComparedCommit_beforeCommitId,
    postCommentForComparedCommit_clientRequestToken,
    postCommentForComparedCommit_location,
    postCommentForComparedCommit_repositoryName,
    postCommentForComparedCommit_afterCommitId,
    postCommentForComparedCommit_content,

    -- * Destructuring the Response
    PostCommentForComparedCommitResponse (..),
    newPostCommentForComparedCommitResponse,

    -- * Response Lenses
    postCommentForComparedCommitResponse_afterBlobId,
    postCommentForComparedCommitResponse_afterCommitId,
    postCommentForComparedCommitResponse_beforeBlobId,
    postCommentForComparedCommitResponse_beforeCommitId,
    postCommentForComparedCommitResponse_comment,
    postCommentForComparedCommitResponse_location,
    postCommentForComparedCommitResponse_repositoryName,
    postCommentForComparedCommitResponse_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:/ 'newPostCommentForComparedCommit' smart constructor.
data PostCommentForComparedCommit = PostCommentForComparedCommit'
  { -- | To establish the directionality of the comparison, the full commit ID of
    -- the before commit. Required for commenting on any commit unless that
    -- commit is the initial commit.
    PostCommentForComparedCommit -> Maybe Text
beforeCommitId :: Prelude.Maybe Prelude.Text,
    -- | 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.
    PostCommentForComparedCommit -> Maybe Text
clientRequestToken :: Prelude.Maybe Prelude.Text,
    -- | The location of the comparison where you want to comment.
    PostCommentForComparedCommit -> Maybe Location
location :: Prelude.Maybe Location,
    -- | The name of the repository where you want to post a comment on the
    -- comparison between commits.
    PostCommentForComparedCommit -> Text
repositoryName :: Prelude.Text,
    -- | To establish the directionality of the comparison, the full commit ID of
    -- the after commit.
    PostCommentForComparedCommit -> Text
afterCommitId :: Prelude.Text,
    -- | The content of the comment you want to make.
    PostCommentForComparedCommit -> Text
content :: Prelude.Text
  }
  deriving (PostCommentForComparedCommit
-> PostCommentForComparedCommit -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostCommentForComparedCommit
-> PostCommentForComparedCommit -> Bool
$c/= :: PostCommentForComparedCommit
-> PostCommentForComparedCommit -> Bool
== :: PostCommentForComparedCommit
-> PostCommentForComparedCommit -> Bool
$c== :: PostCommentForComparedCommit
-> PostCommentForComparedCommit -> Bool
Prelude.Eq, ReadPrec [PostCommentForComparedCommit]
ReadPrec PostCommentForComparedCommit
Int -> ReadS PostCommentForComparedCommit
ReadS [PostCommentForComparedCommit]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PostCommentForComparedCommit]
$creadListPrec :: ReadPrec [PostCommentForComparedCommit]
readPrec :: ReadPrec PostCommentForComparedCommit
$creadPrec :: ReadPrec PostCommentForComparedCommit
readList :: ReadS [PostCommentForComparedCommit]
$creadList :: ReadS [PostCommentForComparedCommit]
readsPrec :: Int -> ReadS PostCommentForComparedCommit
$creadsPrec :: Int -> ReadS PostCommentForComparedCommit
Prelude.Read, Int -> PostCommentForComparedCommit -> ShowS
[PostCommentForComparedCommit] -> ShowS
PostCommentForComparedCommit -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PostCommentForComparedCommit] -> ShowS
$cshowList :: [PostCommentForComparedCommit] -> ShowS
show :: PostCommentForComparedCommit -> String
$cshow :: PostCommentForComparedCommit -> String
showsPrec :: Int -> PostCommentForComparedCommit -> ShowS
$cshowsPrec :: Int -> PostCommentForComparedCommit -> ShowS
Prelude.Show, forall x.
Rep PostCommentForComparedCommit x -> PostCommentForComparedCommit
forall x.
PostCommentForComparedCommit -> Rep PostCommentForComparedCommit x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep PostCommentForComparedCommit x -> PostCommentForComparedCommit
$cfrom :: forall x.
PostCommentForComparedCommit -> Rep PostCommentForComparedCommit x
Prelude.Generic)

-- |
-- Create a value of 'PostCommentForComparedCommit' 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', 'postCommentForComparedCommit_beforeCommitId' - To establish the directionality of the comparison, the full commit ID of
-- the before commit. Required for commenting on any commit unless that
-- commit is the initial commit.
--
-- 'clientRequestToken', 'postCommentForComparedCommit_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', 'postCommentForComparedCommit_location' - The location of the comparison where you want to comment.
--
-- 'repositoryName', 'postCommentForComparedCommit_repositoryName' - The name of the repository where you want to post a comment on the
-- comparison between commits.
--
-- 'afterCommitId', 'postCommentForComparedCommit_afterCommitId' - To establish the directionality of the comparison, the full commit ID of
-- the after commit.
--
-- 'content', 'postCommentForComparedCommit_content' - The content of the comment you want to make.
newPostCommentForComparedCommit ::
  -- | 'repositoryName'
  Prelude.Text ->
  -- | 'afterCommitId'
  Prelude.Text ->
  -- | 'content'
  Prelude.Text ->
  PostCommentForComparedCommit
newPostCommentForComparedCommit :: Text -> Text -> Text -> PostCommentForComparedCommit
newPostCommentForComparedCommit
  Text
pRepositoryName_
  Text
pAfterCommitId_
  Text
pContent_ =
    PostCommentForComparedCommit'
      { $sel:beforeCommitId:PostCommentForComparedCommit' :: Maybe Text
beforeCommitId =
          forall a. Maybe a
Prelude.Nothing,
        $sel:clientRequestToken:PostCommentForComparedCommit' :: Maybe Text
clientRequestToken = forall a. Maybe a
Prelude.Nothing,
        $sel:location:PostCommentForComparedCommit' :: Maybe Location
location = forall a. Maybe a
Prelude.Nothing,
        $sel:repositoryName:PostCommentForComparedCommit' :: Text
repositoryName = Text
pRepositoryName_,
        $sel:afterCommitId:PostCommentForComparedCommit' :: Text
afterCommitId = Text
pAfterCommitId_,
        $sel:content:PostCommentForComparedCommit' :: Text
content = Text
pContent_
      }

-- | To establish the directionality of the comparison, the full commit ID of
-- the before commit. Required for commenting on any commit unless that
-- commit is the initial commit.
postCommentForComparedCommit_beforeCommitId :: Lens.Lens' PostCommentForComparedCommit (Prelude.Maybe Prelude.Text)
postCommentForComparedCommit_beforeCommitId :: Lens' PostCommentForComparedCommit (Maybe Text)
postCommentForComparedCommit_beforeCommitId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PostCommentForComparedCommit' {Maybe Text
beforeCommitId :: Maybe Text
$sel:beforeCommitId:PostCommentForComparedCommit' :: PostCommentForComparedCommit -> Maybe Text
beforeCommitId} -> Maybe Text
beforeCommitId) (\s :: PostCommentForComparedCommit
s@PostCommentForComparedCommit' {} Maybe Text
a -> PostCommentForComparedCommit
s {$sel:beforeCommitId:PostCommentForComparedCommit' :: Maybe Text
beforeCommitId = Maybe Text
a} :: PostCommentForComparedCommit)

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

-- | The location of the comparison where you want to comment.
postCommentForComparedCommit_location :: Lens.Lens' PostCommentForComparedCommit (Prelude.Maybe Location)
postCommentForComparedCommit_location :: Lens' PostCommentForComparedCommit (Maybe Location)
postCommentForComparedCommit_location = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PostCommentForComparedCommit' {Maybe Location
location :: Maybe Location
$sel:location:PostCommentForComparedCommit' :: PostCommentForComparedCommit -> Maybe Location
location} -> Maybe Location
location) (\s :: PostCommentForComparedCommit
s@PostCommentForComparedCommit' {} Maybe Location
a -> PostCommentForComparedCommit
s {$sel:location:PostCommentForComparedCommit' :: Maybe Location
location = Maybe Location
a} :: PostCommentForComparedCommit)

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

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

-- | The content of the comment you want to make.
postCommentForComparedCommit_content :: Lens.Lens' PostCommentForComparedCommit Prelude.Text
postCommentForComparedCommit_content :: Lens' PostCommentForComparedCommit Text
postCommentForComparedCommit_content = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PostCommentForComparedCommit' {Text
content :: Text
$sel:content:PostCommentForComparedCommit' :: PostCommentForComparedCommit -> Text
content} -> Text
content) (\s :: PostCommentForComparedCommit
s@PostCommentForComparedCommit' {} Text
a -> PostCommentForComparedCommit
s {$sel:content:PostCommentForComparedCommit' :: Text
content = Text
a} :: PostCommentForComparedCommit)

instance Core.AWSRequest PostCommentForComparedCommit where
  type
    AWSResponse PostCommentForComparedCommit =
      PostCommentForComparedCommitResponse
  request :: (Service -> Service)
-> PostCommentForComparedCommit
-> Request PostCommentForComparedCommit
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 PostCommentForComparedCommit
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse PostCommentForComparedCommit)))
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
-> Int
-> PostCommentForComparedCommitResponse
PostCommentForComparedCommitResponse'
            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
"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
    PostCommentForComparedCommit
  where
  hashWithSalt :: Int -> PostCommentForComparedCommit -> Int
hashWithSalt Int
_salt PostCommentForComparedCommit' {Maybe Text
Maybe Location
Text
content :: Text
afterCommitId :: Text
repositoryName :: Text
location :: Maybe Location
clientRequestToken :: Maybe Text
beforeCommitId :: Maybe Text
$sel:content:PostCommentForComparedCommit' :: PostCommentForComparedCommit -> Text
$sel:afterCommitId:PostCommentForComparedCommit' :: PostCommentForComparedCommit -> Text
$sel:repositoryName:PostCommentForComparedCommit' :: PostCommentForComparedCommit -> Text
$sel:location:PostCommentForComparedCommit' :: PostCommentForComparedCommit -> Maybe Location
$sel:clientRequestToken:PostCommentForComparedCommit' :: PostCommentForComparedCommit -> Maybe Text
$sel:beforeCommitId:PostCommentForComparedCommit' :: PostCommentForComparedCommit -> 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 Text
clientRequestToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Location
location
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
repositoryName
      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 PostCommentForComparedCommit where
  rnf :: PostCommentForComparedCommit -> ()
rnf PostCommentForComparedCommit' {Maybe Text
Maybe Location
Text
content :: Text
afterCommitId :: Text
repositoryName :: Text
location :: Maybe Location
clientRequestToken :: Maybe Text
beforeCommitId :: Maybe Text
$sel:content:PostCommentForComparedCommit' :: PostCommentForComparedCommit -> Text
$sel:afterCommitId:PostCommentForComparedCommit' :: PostCommentForComparedCommit -> Text
$sel:repositoryName:PostCommentForComparedCommit' :: PostCommentForComparedCommit -> Text
$sel:location:PostCommentForComparedCommit' :: PostCommentForComparedCommit -> Maybe Location
$sel:clientRequestToken:PostCommentForComparedCommit' :: PostCommentForComparedCommit -> Maybe Text
$sel:beforeCommitId:PostCommentForComparedCommit' :: PostCommentForComparedCommit -> 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 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
repositoryName
      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 PostCommentForComparedCommit where
  toHeaders :: PostCommentForComparedCommit -> 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.PostCommentForComparedCommit" ::
                          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 PostCommentForComparedCommit where
  toJSON :: PostCommentForComparedCommit -> Value
toJSON PostCommentForComparedCommit' {Maybe Text
Maybe Location
Text
content :: Text
afterCommitId :: Text
repositoryName :: Text
location :: Maybe Location
clientRequestToken :: Maybe Text
beforeCommitId :: Maybe Text
$sel:content:PostCommentForComparedCommit' :: PostCommentForComparedCommit -> Text
$sel:afterCommitId:PostCommentForComparedCommit' :: PostCommentForComparedCommit -> Text
$sel:repositoryName:PostCommentForComparedCommit' :: PostCommentForComparedCommit -> Text
$sel:location:PostCommentForComparedCommit' :: PostCommentForComparedCommit -> Maybe Location
$sel:clientRequestToken:PostCommentForComparedCommit' :: PostCommentForComparedCommit -> Maybe Text
$sel:beforeCommitId:PostCommentForComparedCommit' :: PostCommentForComparedCommit -> 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
"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
"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),
            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 PostCommentForComparedCommit where
  toPath :: PostCommentForComparedCommit -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

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

-- | /See:/ 'newPostCommentForComparedCommitResponse' smart constructor.
data PostCommentForComparedCommitResponse = PostCommentForComparedCommitResponse'
  { -- | In the directionality you established, the blob ID of the after blob.
    PostCommentForComparedCommitResponse -> Maybe Text
afterBlobId :: Prelude.Maybe Prelude.Text,
    -- | In the directionality you established, the full commit ID of the after
    -- commit.
    PostCommentForComparedCommitResponse -> Maybe Text
afterCommitId :: Prelude.Maybe Prelude.Text,
    -- | In the directionality you established, the blob ID of the before blob.
    PostCommentForComparedCommitResponse -> Maybe Text
beforeBlobId :: Prelude.Maybe Prelude.Text,
    -- | In the directionality you established, the full commit ID of the before
    -- commit.
    PostCommentForComparedCommitResponse -> Maybe Text
beforeCommitId :: Prelude.Maybe Prelude.Text,
    -- | The content of the comment you posted.
    PostCommentForComparedCommitResponse -> Maybe Comment
comment :: Prelude.Maybe Comment,
    -- | The location of the comment in the comparison between the two commits.
    PostCommentForComparedCommitResponse -> Maybe Location
location :: Prelude.Maybe Location,
    -- | The name of the repository where you posted a comment on the comparison
    -- between commits.
    PostCommentForComparedCommitResponse -> Maybe Text
repositoryName :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    PostCommentForComparedCommitResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (PostCommentForComparedCommitResponse
-> PostCommentForComparedCommitResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostCommentForComparedCommitResponse
-> PostCommentForComparedCommitResponse -> Bool
$c/= :: PostCommentForComparedCommitResponse
-> PostCommentForComparedCommitResponse -> Bool
== :: PostCommentForComparedCommitResponse
-> PostCommentForComparedCommitResponse -> Bool
$c== :: PostCommentForComparedCommitResponse
-> PostCommentForComparedCommitResponse -> Bool
Prelude.Eq, ReadPrec [PostCommentForComparedCommitResponse]
ReadPrec PostCommentForComparedCommitResponse
Int -> ReadS PostCommentForComparedCommitResponse
ReadS [PostCommentForComparedCommitResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PostCommentForComparedCommitResponse]
$creadListPrec :: ReadPrec [PostCommentForComparedCommitResponse]
readPrec :: ReadPrec PostCommentForComparedCommitResponse
$creadPrec :: ReadPrec PostCommentForComparedCommitResponse
readList :: ReadS [PostCommentForComparedCommitResponse]
$creadList :: ReadS [PostCommentForComparedCommitResponse]
readsPrec :: Int -> ReadS PostCommentForComparedCommitResponse
$creadsPrec :: Int -> ReadS PostCommentForComparedCommitResponse
Prelude.Read, Int -> PostCommentForComparedCommitResponse -> ShowS
[PostCommentForComparedCommitResponse] -> ShowS
PostCommentForComparedCommitResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PostCommentForComparedCommitResponse] -> ShowS
$cshowList :: [PostCommentForComparedCommitResponse] -> ShowS
show :: PostCommentForComparedCommitResponse -> String
$cshow :: PostCommentForComparedCommitResponse -> String
showsPrec :: Int -> PostCommentForComparedCommitResponse -> ShowS
$cshowsPrec :: Int -> PostCommentForComparedCommitResponse -> ShowS
Prelude.Show, forall x.
Rep PostCommentForComparedCommitResponse x
-> PostCommentForComparedCommitResponse
forall x.
PostCommentForComparedCommitResponse
-> Rep PostCommentForComparedCommitResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep PostCommentForComparedCommitResponse x
-> PostCommentForComparedCommitResponse
$cfrom :: forall x.
PostCommentForComparedCommitResponse
-> Rep PostCommentForComparedCommitResponse x
Prelude.Generic)

-- |
-- Create a value of 'PostCommentForComparedCommitResponse' 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', 'postCommentForComparedCommitResponse_afterBlobId' - In the directionality you established, the blob ID of the after blob.
--
-- 'afterCommitId', 'postCommentForComparedCommitResponse_afterCommitId' - In the directionality you established, the full commit ID of the after
-- commit.
--
-- 'beforeBlobId', 'postCommentForComparedCommitResponse_beforeBlobId' - In the directionality you established, the blob ID of the before blob.
--
-- 'beforeCommitId', 'postCommentForComparedCommitResponse_beforeCommitId' - In the directionality you established, the full commit ID of the before
-- commit.
--
-- 'comment', 'postCommentForComparedCommitResponse_comment' - The content of the comment you posted.
--
-- 'location', 'postCommentForComparedCommitResponse_location' - The location of the comment in the comparison between the two commits.
--
-- 'repositoryName', 'postCommentForComparedCommitResponse_repositoryName' - The name of the repository where you posted a comment on the comparison
-- between commits.
--
-- 'httpStatus', 'postCommentForComparedCommitResponse_httpStatus' - The response's http status code.
newPostCommentForComparedCommitResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  PostCommentForComparedCommitResponse
newPostCommentForComparedCommitResponse :: Int -> PostCommentForComparedCommitResponse
newPostCommentForComparedCommitResponse Int
pHttpStatus_ =
  PostCommentForComparedCommitResponse'
    { $sel:afterBlobId:PostCommentForComparedCommitResponse' :: Maybe Text
afterBlobId =
        forall a. Maybe a
Prelude.Nothing,
      $sel:afterCommitId:PostCommentForComparedCommitResponse' :: Maybe Text
afterCommitId = forall a. Maybe a
Prelude.Nothing,
      $sel:beforeBlobId:PostCommentForComparedCommitResponse' :: Maybe Text
beforeBlobId = forall a. Maybe a
Prelude.Nothing,
      $sel:beforeCommitId:PostCommentForComparedCommitResponse' :: Maybe Text
beforeCommitId = forall a. Maybe a
Prelude.Nothing,
      $sel:comment:PostCommentForComparedCommitResponse' :: Maybe Comment
comment = forall a. Maybe a
Prelude.Nothing,
      $sel:location:PostCommentForComparedCommitResponse' :: Maybe Location
location = forall a. Maybe a
Prelude.Nothing,
      $sel:repositoryName:PostCommentForComparedCommitResponse' :: Maybe Text
repositoryName = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:PostCommentForComparedCommitResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

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

-- | In the directionality you established, the full commit ID of the after
-- commit.
postCommentForComparedCommitResponse_afterCommitId :: Lens.Lens' PostCommentForComparedCommitResponse (Prelude.Maybe Prelude.Text)
postCommentForComparedCommitResponse_afterCommitId :: Lens' PostCommentForComparedCommitResponse (Maybe Text)
postCommentForComparedCommitResponse_afterCommitId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PostCommentForComparedCommitResponse' {Maybe Text
afterCommitId :: Maybe Text
$sel:afterCommitId:PostCommentForComparedCommitResponse' :: PostCommentForComparedCommitResponse -> Maybe Text
afterCommitId} -> Maybe Text
afterCommitId) (\s :: PostCommentForComparedCommitResponse
s@PostCommentForComparedCommitResponse' {} Maybe Text
a -> PostCommentForComparedCommitResponse
s {$sel:afterCommitId:PostCommentForComparedCommitResponse' :: Maybe Text
afterCommitId = Maybe Text
a} :: PostCommentForComparedCommitResponse)

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

-- | In the directionality you established, the full commit ID of the before
-- commit.
postCommentForComparedCommitResponse_beforeCommitId :: Lens.Lens' PostCommentForComparedCommitResponse (Prelude.Maybe Prelude.Text)
postCommentForComparedCommitResponse_beforeCommitId :: Lens' PostCommentForComparedCommitResponse (Maybe Text)
postCommentForComparedCommitResponse_beforeCommitId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PostCommentForComparedCommitResponse' {Maybe Text
beforeCommitId :: Maybe Text
$sel:beforeCommitId:PostCommentForComparedCommitResponse' :: PostCommentForComparedCommitResponse -> Maybe Text
beforeCommitId} -> Maybe Text
beforeCommitId) (\s :: PostCommentForComparedCommitResponse
s@PostCommentForComparedCommitResponse' {} Maybe Text
a -> PostCommentForComparedCommitResponse
s {$sel:beforeCommitId:PostCommentForComparedCommitResponse' :: Maybe Text
beforeCommitId = Maybe Text
a} :: PostCommentForComparedCommitResponse)

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

-- | The location of the comment in the comparison between the two commits.
postCommentForComparedCommitResponse_location :: Lens.Lens' PostCommentForComparedCommitResponse (Prelude.Maybe Location)
postCommentForComparedCommitResponse_location :: Lens' PostCommentForComparedCommitResponse (Maybe Location)
postCommentForComparedCommitResponse_location = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PostCommentForComparedCommitResponse' {Maybe Location
location :: Maybe Location
$sel:location:PostCommentForComparedCommitResponse' :: PostCommentForComparedCommitResponse -> Maybe Location
location} -> Maybe Location
location) (\s :: PostCommentForComparedCommitResponse
s@PostCommentForComparedCommitResponse' {} Maybe Location
a -> PostCommentForComparedCommitResponse
s {$sel:location:PostCommentForComparedCommitResponse' :: Maybe Location
location = Maybe Location
a} :: PostCommentForComparedCommitResponse)

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

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

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