{-# 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.PutCommentReaction
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Adds or updates a reaction to a specified comment for the user whose
-- identity is used to make the request. You can only add or update a
-- reaction for yourself. You cannot add, modify, or delete a reaction for
-- another user.
module Amazonka.CodeCommit.PutCommentReaction
  ( -- * Creating a Request
    PutCommentReaction (..),
    newPutCommentReaction,

    -- * Request Lenses
    putCommentReaction_commentId,
    putCommentReaction_reactionValue,

    -- * Destructuring the Response
    PutCommentReactionResponse (..),
    newPutCommentReactionResponse,
  )
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:/ 'newPutCommentReaction' smart constructor.
data PutCommentReaction = PutCommentReaction'
  { -- | The ID of the comment to which you want to add or update a reaction.
    PutCommentReaction -> Text
commentId :: Prelude.Text,
    -- | The emoji reaction you want to add or update. To remove a reaction,
    -- provide a value of blank or null. You can also provide the value of
    -- none. For information about emoji reaction values supported in AWS
    -- CodeCommit, see the
    -- <https://docs.aws.amazon.com/codecommit/latest/userguide/how-to-commit-comment.html#emoji-reaction-table AWS CodeCommit User Guide>.
    PutCommentReaction -> Text
reactionValue :: Prelude.Text
  }
  deriving (PutCommentReaction -> PutCommentReaction -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PutCommentReaction -> PutCommentReaction -> Bool
$c/= :: PutCommentReaction -> PutCommentReaction -> Bool
== :: PutCommentReaction -> PutCommentReaction -> Bool
$c== :: PutCommentReaction -> PutCommentReaction -> Bool
Prelude.Eq, ReadPrec [PutCommentReaction]
ReadPrec PutCommentReaction
Int -> ReadS PutCommentReaction
ReadS [PutCommentReaction]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PutCommentReaction]
$creadListPrec :: ReadPrec [PutCommentReaction]
readPrec :: ReadPrec PutCommentReaction
$creadPrec :: ReadPrec PutCommentReaction
readList :: ReadS [PutCommentReaction]
$creadList :: ReadS [PutCommentReaction]
readsPrec :: Int -> ReadS PutCommentReaction
$creadsPrec :: Int -> ReadS PutCommentReaction
Prelude.Read, Int -> PutCommentReaction -> ShowS
[PutCommentReaction] -> ShowS
PutCommentReaction -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PutCommentReaction] -> ShowS
$cshowList :: [PutCommentReaction] -> ShowS
show :: PutCommentReaction -> String
$cshow :: PutCommentReaction -> String
showsPrec :: Int -> PutCommentReaction -> ShowS
$cshowsPrec :: Int -> PutCommentReaction -> ShowS
Prelude.Show, forall x. Rep PutCommentReaction x -> PutCommentReaction
forall x. PutCommentReaction -> Rep PutCommentReaction x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PutCommentReaction x -> PutCommentReaction
$cfrom :: forall x. PutCommentReaction -> Rep PutCommentReaction x
Prelude.Generic)

-- |
-- Create a value of 'PutCommentReaction' with all optional fields omitted.
--
-- Use <https://hackage.haskell.org/package/generic-lens generic-lens> or <https://hackage.haskell.org/package/optics optics> to modify other optional fields.
--
-- The following record fields are available, with the corresponding lenses provided
-- for backwards compatibility:
--
-- 'commentId', 'putCommentReaction_commentId' - The ID of the comment to which you want to add or update a reaction.
--
-- 'reactionValue', 'putCommentReaction_reactionValue' - The emoji reaction you want to add or update. To remove a reaction,
-- provide a value of blank or null. You can also provide the value of
-- none. For information about emoji reaction values supported in AWS
-- CodeCommit, see the
-- <https://docs.aws.amazon.com/codecommit/latest/userguide/how-to-commit-comment.html#emoji-reaction-table AWS CodeCommit User Guide>.
newPutCommentReaction ::
  -- | 'commentId'
  Prelude.Text ->
  -- | 'reactionValue'
  Prelude.Text ->
  PutCommentReaction
newPutCommentReaction :: Text -> Text -> PutCommentReaction
newPutCommentReaction Text
pCommentId_ Text
pReactionValue_ =
  PutCommentReaction'
    { $sel:commentId:PutCommentReaction' :: Text
commentId = Text
pCommentId_,
      $sel:reactionValue:PutCommentReaction' :: Text
reactionValue = Text
pReactionValue_
    }

-- | The ID of the comment to which you want to add or update a reaction.
putCommentReaction_commentId :: Lens.Lens' PutCommentReaction Prelude.Text
putCommentReaction_commentId :: Lens' PutCommentReaction Text
putCommentReaction_commentId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutCommentReaction' {Text
commentId :: Text
$sel:commentId:PutCommentReaction' :: PutCommentReaction -> Text
commentId} -> Text
commentId) (\s :: PutCommentReaction
s@PutCommentReaction' {} Text
a -> PutCommentReaction
s {$sel:commentId:PutCommentReaction' :: Text
commentId = Text
a} :: PutCommentReaction)

-- | The emoji reaction you want to add or update. To remove a reaction,
-- provide a value of blank or null. You can also provide the value of
-- none. For information about emoji reaction values supported in AWS
-- CodeCommit, see the
-- <https://docs.aws.amazon.com/codecommit/latest/userguide/how-to-commit-comment.html#emoji-reaction-table AWS CodeCommit User Guide>.
putCommentReaction_reactionValue :: Lens.Lens' PutCommentReaction Prelude.Text
putCommentReaction_reactionValue :: Lens' PutCommentReaction Text
putCommentReaction_reactionValue = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutCommentReaction' {Text
reactionValue :: Text
$sel:reactionValue:PutCommentReaction' :: PutCommentReaction -> Text
reactionValue} -> Text
reactionValue) (\s :: PutCommentReaction
s@PutCommentReaction' {} Text
a -> PutCommentReaction
s {$sel:reactionValue:PutCommentReaction' :: Text
reactionValue = Text
a} :: PutCommentReaction)

instance Core.AWSRequest PutCommentReaction where
  type
    AWSResponse PutCommentReaction =
      PutCommentReactionResponse
  request :: (Service -> Service)
-> PutCommentReaction -> Request PutCommentReaction
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 PutCommentReaction
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse PutCommentReaction)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
AWSResponse a
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveNull PutCommentReactionResponse
PutCommentReactionResponse'

instance Prelude.Hashable PutCommentReaction where
  hashWithSalt :: Int -> PutCommentReaction -> Int
hashWithSalt Int
_salt PutCommentReaction' {Text
reactionValue :: Text
commentId :: Text
$sel:reactionValue:PutCommentReaction' :: PutCommentReaction -> Text
$sel:commentId:PutCommentReaction' :: PutCommentReaction -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
commentId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
reactionValue

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

instance Data.ToHeaders PutCommentReaction where
  toHeaders :: PutCommentReaction -> [Header]
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 -> [Header]
Data.=# ( ByteString
"CodeCommit_20150413.PutCommentReaction" ::
                          Prelude.ByteString
                      ),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> [Header]
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON PutCommentReaction where
  toJSON :: PutCommentReaction -> Value
toJSON PutCommentReaction' {Text
reactionValue :: Text
commentId :: Text
$sel:reactionValue:PutCommentReaction' :: PutCommentReaction -> Text
$sel:commentId:PutCommentReaction' :: PutCommentReaction -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just (Key
"commentId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
commentId),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"reactionValue" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
reactionValue)
          ]
      )

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

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

-- | /See:/ 'newPutCommentReactionResponse' smart constructor.
data PutCommentReactionResponse = PutCommentReactionResponse'
  {
  }
  deriving (PutCommentReactionResponse -> PutCommentReactionResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PutCommentReactionResponse -> PutCommentReactionResponse -> Bool
$c/= :: PutCommentReactionResponse -> PutCommentReactionResponse -> Bool
== :: PutCommentReactionResponse -> PutCommentReactionResponse -> Bool
$c== :: PutCommentReactionResponse -> PutCommentReactionResponse -> Bool
Prelude.Eq, ReadPrec [PutCommentReactionResponse]
ReadPrec PutCommentReactionResponse
Int -> ReadS PutCommentReactionResponse
ReadS [PutCommentReactionResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PutCommentReactionResponse]
$creadListPrec :: ReadPrec [PutCommentReactionResponse]
readPrec :: ReadPrec PutCommentReactionResponse
$creadPrec :: ReadPrec PutCommentReactionResponse
readList :: ReadS [PutCommentReactionResponse]
$creadList :: ReadS [PutCommentReactionResponse]
readsPrec :: Int -> ReadS PutCommentReactionResponse
$creadsPrec :: Int -> ReadS PutCommentReactionResponse
Prelude.Read, Int -> PutCommentReactionResponse -> ShowS
[PutCommentReactionResponse] -> ShowS
PutCommentReactionResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PutCommentReactionResponse] -> ShowS
$cshowList :: [PutCommentReactionResponse] -> ShowS
show :: PutCommentReactionResponse -> String
$cshow :: PutCommentReactionResponse -> String
showsPrec :: Int -> PutCommentReactionResponse -> ShowS
$cshowsPrec :: Int -> PutCommentReactionResponse -> ShowS
Prelude.Show, forall x.
Rep PutCommentReactionResponse x -> PutCommentReactionResponse
forall x.
PutCommentReactionResponse -> Rep PutCommentReactionResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep PutCommentReactionResponse x -> PutCommentReactionResponse
$cfrom :: forall x.
PutCommentReactionResponse -> Rep PutCommentReactionResponse x
Prelude.Generic)

-- |
-- Create a value of 'PutCommentReactionResponse' 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.
newPutCommentReactionResponse ::
  PutCommentReactionResponse
newPutCommentReactionResponse :: PutCommentReactionResponse
newPutCommentReactionResponse =
  PutCommentReactionResponse
PutCommentReactionResponse'

instance Prelude.NFData PutCommentReactionResponse where
  rnf :: PutCommentReactionResponse -> ()
rnf PutCommentReactionResponse
_ = ()