{-# 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.MergePullRequestByThreeWay
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Attempts to merge the source commit of a pull request into the specified
-- destination branch for that pull request at the specified commit using
-- the three-way merge strategy. If the merge is successful, it closes the
-- pull request.
module Amazonka.CodeCommit.MergePullRequestByThreeWay
  ( -- * Creating a Request
    MergePullRequestByThreeWay (..),
    newMergePullRequestByThreeWay,

    -- * Request Lenses
    mergePullRequestByThreeWay_authorName,
    mergePullRequestByThreeWay_commitMessage,
    mergePullRequestByThreeWay_conflictDetailLevel,
    mergePullRequestByThreeWay_conflictResolution,
    mergePullRequestByThreeWay_conflictResolutionStrategy,
    mergePullRequestByThreeWay_email,
    mergePullRequestByThreeWay_keepEmptyFolders,
    mergePullRequestByThreeWay_sourceCommitId,
    mergePullRequestByThreeWay_pullRequestId,
    mergePullRequestByThreeWay_repositoryName,

    -- * Destructuring the Response
    MergePullRequestByThreeWayResponse (..),
    newMergePullRequestByThreeWayResponse,

    -- * Response Lenses
    mergePullRequestByThreeWayResponse_pullRequest,
    mergePullRequestByThreeWayResponse_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:/ 'newMergePullRequestByThreeWay' smart constructor.
data MergePullRequestByThreeWay = MergePullRequestByThreeWay'
  { -- | The name of the author who created the commit. This information is used
    -- as both the author and committer for the commit.
    MergePullRequestByThreeWay -> Maybe Text
authorName :: Prelude.Maybe Prelude.Text,
    -- | The commit message to include in the commit information for the merge.
    MergePullRequestByThreeWay -> Maybe Text
commitMessage :: Prelude.Maybe Prelude.Text,
    -- | The level of conflict detail to use. If unspecified, the default
    -- FILE_LEVEL is used, which returns a not-mergeable result if the same
    -- file has differences in both branches. If LINE_LEVEL is specified, a
    -- conflict is considered not mergeable if the same file in both branches
    -- has differences on the same line.
    MergePullRequestByThreeWay -> Maybe ConflictDetailLevelTypeEnum
conflictDetailLevel :: Prelude.Maybe ConflictDetailLevelTypeEnum,
    -- | If AUTOMERGE is the conflict resolution strategy, a list of inputs to
    -- use when resolving conflicts during a merge.
    MergePullRequestByThreeWay -> Maybe ConflictResolution
conflictResolution :: Prelude.Maybe ConflictResolution,
    -- | Specifies which branch to use when resolving conflicts, or whether to
    -- attempt automatically merging two versions of a file. The default is
    -- NONE, which requires any conflicts to be resolved manually before the
    -- merge operation is successful.
    MergePullRequestByThreeWay
-> Maybe ConflictResolutionStrategyTypeEnum
conflictResolutionStrategy :: Prelude.Maybe ConflictResolutionStrategyTypeEnum,
    -- | The email address of the person merging the branches. This information
    -- is used in the commit information for the merge.
    MergePullRequestByThreeWay -> Maybe Text
email :: Prelude.Maybe Prelude.Text,
    -- | If the commit contains deletions, whether to keep a folder or folder
    -- structure if the changes leave the folders empty. If true, a .gitkeep
    -- file is created for empty folders. The default is false.
    MergePullRequestByThreeWay -> Maybe Bool
keepEmptyFolders :: Prelude.Maybe Prelude.Bool,
    -- | The full commit ID of the original or updated commit in the pull request
    -- source branch. Pass this value if you want an exception thrown if the
    -- current commit ID of the tip of the source branch does not match this
    -- commit ID.
    MergePullRequestByThreeWay -> Maybe Text
sourceCommitId :: Prelude.Maybe Prelude.Text,
    -- | The system-generated ID of the pull request. To get this ID, use
    -- ListPullRequests.
    MergePullRequestByThreeWay -> Text
pullRequestId :: Prelude.Text,
    -- | The name of the repository where the pull request was created.
    MergePullRequestByThreeWay -> Text
repositoryName :: Prelude.Text
  }
  deriving (MergePullRequestByThreeWay -> MergePullRequestByThreeWay -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MergePullRequestByThreeWay -> MergePullRequestByThreeWay -> Bool
$c/= :: MergePullRequestByThreeWay -> MergePullRequestByThreeWay -> Bool
== :: MergePullRequestByThreeWay -> MergePullRequestByThreeWay -> Bool
$c== :: MergePullRequestByThreeWay -> MergePullRequestByThreeWay -> Bool
Prelude.Eq, ReadPrec [MergePullRequestByThreeWay]
ReadPrec MergePullRequestByThreeWay
Int -> ReadS MergePullRequestByThreeWay
ReadS [MergePullRequestByThreeWay]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MergePullRequestByThreeWay]
$creadListPrec :: ReadPrec [MergePullRequestByThreeWay]
readPrec :: ReadPrec MergePullRequestByThreeWay
$creadPrec :: ReadPrec MergePullRequestByThreeWay
readList :: ReadS [MergePullRequestByThreeWay]
$creadList :: ReadS [MergePullRequestByThreeWay]
readsPrec :: Int -> ReadS MergePullRequestByThreeWay
$creadsPrec :: Int -> ReadS MergePullRequestByThreeWay
Prelude.Read, Int -> MergePullRequestByThreeWay -> ShowS
[MergePullRequestByThreeWay] -> ShowS
MergePullRequestByThreeWay -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MergePullRequestByThreeWay] -> ShowS
$cshowList :: [MergePullRequestByThreeWay] -> ShowS
show :: MergePullRequestByThreeWay -> String
$cshow :: MergePullRequestByThreeWay -> String
showsPrec :: Int -> MergePullRequestByThreeWay -> ShowS
$cshowsPrec :: Int -> MergePullRequestByThreeWay -> ShowS
Prelude.Show, forall x.
Rep MergePullRequestByThreeWay x -> MergePullRequestByThreeWay
forall x.
MergePullRequestByThreeWay -> Rep MergePullRequestByThreeWay x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep MergePullRequestByThreeWay x -> MergePullRequestByThreeWay
$cfrom :: forall x.
MergePullRequestByThreeWay -> Rep MergePullRequestByThreeWay x
Prelude.Generic)

-- |
-- Create a value of 'MergePullRequestByThreeWay' 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:
--
-- 'authorName', 'mergePullRequestByThreeWay_authorName' - The name of the author who created the commit. This information is used
-- as both the author and committer for the commit.
--
-- 'commitMessage', 'mergePullRequestByThreeWay_commitMessage' - The commit message to include in the commit information for the merge.
--
-- 'conflictDetailLevel', 'mergePullRequestByThreeWay_conflictDetailLevel' - The level of conflict detail to use. If unspecified, the default
-- FILE_LEVEL is used, which returns a not-mergeable result if the same
-- file has differences in both branches. If LINE_LEVEL is specified, a
-- conflict is considered not mergeable if the same file in both branches
-- has differences on the same line.
--
-- 'conflictResolution', 'mergePullRequestByThreeWay_conflictResolution' - If AUTOMERGE is the conflict resolution strategy, a list of inputs to
-- use when resolving conflicts during a merge.
--
-- 'conflictResolutionStrategy', 'mergePullRequestByThreeWay_conflictResolutionStrategy' - Specifies which branch to use when resolving conflicts, or whether to
-- attempt automatically merging two versions of a file. The default is
-- NONE, which requires any conflicts to be resolved manually before the
-- merge operation is successful.
--
-- 'email', 'mergePullRequestByThreeWay_email' - The email address of the person merging the branches. This information
-- is used in the commit information for the merge.
--
-- 'keepEmptyFolders', 'mergePullRequestByThreeWay_keepEmptyFolders' - If the commit contains deletions, whether to keep a folder or folder
-- structure if the changes leave the folders empty. If true, a .gitkeep
-- file is created for empty folders. The default is false.
--
-- 'sourceCommitId', 'mergePullRequestByThreeWay_sourceCommitId' - The full commit ID of the original or updated commit in the pull request
-- source branch. Pass this value if you want an exception thrown if the
-- current commit ID of the tip of the source branch does not match this
-- commit ID.
--
-- 'pullRequestId', 'mergePullRequestByThreeWay_pullRequestId' - The system-generated ID of the pull request. To get this ID, use
-- ListPullRequests.
--
-- 'repositoryName', 'mergePullRequestByThreeWay_repositoryName' - The name of the repository where the pull request was created.
newMergePullRequestByThreeWay ::
  -- | 'pullRequestId'
  Prelude.Text ->
  -- | 'repositoryName'
  Prelude.Text ->
  MergePullRequestByThreeWay
newMergePullRequestByThreeWay :: Text -> Text -> MergePullRequestByThreeWay
newMergePullRequestByThreeWay
  Text
pPullRequestId_
  Text
pRepositoryName_ =
    MergePullRequestByThreeWay'
      { $sel:authorName:MergePullRequestByThreeWay' :: Maybe Text
authorName =
          forall a. Maybe a
Prelude.Nothing,
        $sel:commitMessage:MergePullRequestByThreeWay' :: Maybe Text
commitMessage = forall a. Maybe a
Prelude.Nothing,
        $sel:conflictDetailLevel:MergePullRequestByThreeWay' :: Maybe ConflictDetailLevelTypeEnum
conflictDetailLevel = forall a. Maybe a
Prelude.Nothing,
        $sel:conflictResolution:MergePullRequestByThreeWay' :: Maybe ConflictResolution
conflictResolution = forall a. Maybe a
Prelude.Nothing,
        $sel:conflictResolutionStrategy:MergePullRequestByThreeWay' :: Maybe ConflictResolutionStrategyTypeEnum
conflictResolutionStrategy = forall a. Maybe a
Prelude.Nothing,
        $sel:email:MergePullRequestByThreeWay' :: Maybe Text
email = forall a. Maybe a
Prelude.Nothing,
        $sel:keepEmptyFolders:MergePullRequestByThreeWay' :: Maybe Bool
keepEmptyFolders = forall a. Maybe a
Prelude.Nothing,
        $sel:sourceCommitId:MergePullRequestByThreeWay' :: Maybe Text
sourceCommitId = forall a. Maybe a
Prelude.Nothing,
        $sel:pullRequestId:MergePullRequestByThreeWay' :: Text
pullRequestId = Text
pPullRequestId_,
        $sel:repositoryName:MergePullRequestByThreeWay' :: Text
repositoryName = Text
pRepositoryName_
      }

-- | The name of the author who created the commit. This information is used
-- as both the author and committer for the commit.
mergePullRequestByThreeWay_authorName :: Lens.Lens' MergePullRequestByThreeWay (Prelude.Maybe Prelude.Text)
mergePullRequestByThreeWay_authorName :: Lens' MergePullRequestByThreeWay (Maybe Text)
mergePullRequestByThreeWay_authorName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\MergePullRequestByThreeWay' {Maybe Text
authorName :: Maybe Text
$sel:authorName:MergePullRequestByThreeWay' :: MergePullRequestByThreeWay -> Maybe Text
authorName} -> Maybe Text
authorName) (\s :: MergePullRequestByThreeWay
s@MergePullRequestByThreeWay' {} Maybe Text
a -> MergePullRequestByThreeWay
s {$sel:authorName:MergePullRequestByThreeWay' :: Maybe Text
authorName = Maybe Text
a} :: MergePullRequestByThreeWay)

-- | The commit message to include in the commit information for the merge.
mergePullRequestByThreeWay_commitMessage :: Lens.Lens' MergePullRequestByThreeWay (Prelude.Maybe Prelude.Text)
mergePullRequestByThreeWay_commitMessage :: Lens' MergePullRequestByThreeWay (Maybe Text)
mergePullRequestByThreeWay_commitMessage = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\MergePullRequestByThreeWay' {Maybe Text
commitMessage :: Maybe Text
$sel:commitMessage:MergePullRequestByThreeWay' :: MergePullRequestByThreeWay -> Maybe Text
commitMessage} -> Maybe Text
commitMessage) (\s :: MergePullRequestByThreeWay
s@MergePullRequestByThreeWay' {} Maybe Text
a -> MergePullRequestByThreeWay
s {$sel:commitMessage:MergePullRequestByThreeWay' :: Maybe Text
commitMessage = Maybe Text
a} :: MergePullRequestByThreeWay)

-- | The level of conflict detail to use. If unspecified, the default
-- FILE_LEVEL is used, which returns a not-mergeable result if the same
-- file has differences in both branches. If LINE_LEVEL is specified, a
-- conflict is considered not mergeable if the same file in both branches
-- has differences on the same line.
mergePullRequestByThreeWay_conflictDetailLevel :: Lens.Lens' MergePullRequestByThreeWay (Prelude.Maybe ConflictDetailLevelTypeEnum)
mergePullRequestByThreeWay_conflictDetailLevel :: Lens'
  MergePullRequestByThreeWay (Maybe ConflictDetailLevelTypeEnum)
mergePullRequestByThreeWay_conflictDetailLevel = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\MergePullRequestByThreeWay' {Maybe ConflictDetailLevelTypeEnum
conflictDetailLevel :: Maybe ConflictDetailLevelTypeEnum
$sel:conflictDetailLevel:MergePullRequestByThreeWay' :: MergePullRequestByThreeWay -> Maybe ConflictDetailLevelTypeEnum
conflictDetailLevel} -> Maybe ConflictDetailLevelTypeEnum
conflictDetailLevel) (\s :: MergePullRequestByThreeWay
s@MergePullRequestByThreeWay' {} Maybe ConflictDetailLevelTypeEnum
a -> MergePullRequestByThreeWay
s {$sel:conflictDetailLevel:MergePullRequestByThreeWay' :: Maybe ConflictDetailLevelTypeEnum
conflictDetailLevel = Maybe ConflictDetailLevelTypeEnum
a} :: MergePullRequestByThreeWay)

-- | If AUTOMERGE is the conflict resolution strategy, a list of inputs to
-- use when resolving conflicts during a merge.
mergePullRequestByThreeWay_conflictResolution :: Lens.Lens' MergePullRequestByThreeWay (Prelude.Maybe ConflictResolution)
mergePullRequestByThreeWay_conflictResolution :: Lens' MergePullRequestByThreeWay (Maybe ConflictResolution)
mergePullRequestByThreeWay_conflictResolution = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\MergePullRequestByThreeWay' {Maybe ConflictResolution
conflictResolution :: Maybe ConflictResolution
$sel:conflictResolution:MergePullRequestByThreeWay' :: MergePullRequestByThreeWay -> Maybe ConflictResolution
conflictResolution} -> Maybe ConflictResolution
conflictResolution) (\s :: MergePullRequestByThreeWay
s@MergePullRequestByThreeWay' {} Maybe ConflictResolution
a -> MergePullRequestByThreeWay
s {$sel:conflictResolution:MergePullRequestByThreeWay' :: Maybe ConflictResolution
conflictResolution = Maybe ConflictResolution
a} :: MergePullRequestByThreeWay)

-- | Specifies which branch to use when resolving conflicts, or whether to
-- attempt automatically merging two versions of a file. The default is
-- NONE, which requires any conflicts to be resolved manually before the
-- merge operation is successful.
mergePullRequestByThreeWay_conflictResolutionStrategy :: Lens.Lens' MergePullRequestByThreeWay (Prelude.Maybe ConflictResolutionStrategyTypeEnum)
mergePullRequestByThreeWay_conflictResolutionStrategy :: Lens'
  MergePullRequestByThreeWay
  (Maybe ConflictResolutionStrategyTypeEnum)
mergePullRequestByThreeWay_conflictResolutionStrategy = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\MergePullRequestByThreeWay' {Maybe ConflictResolutionStrategyTypeEnum
conflictResolutionStrategy :: Maybe ConflictResolutionStrategyTypeEnum
$sel:conflictResolutionStrategy:MergePullRequestByThreeWay' :: MergePullRequestByThreeWay
-> Maybe ConflictResolutionStrategyTypeEnum
conflictResolutionStrategy} -> Maybe ConflictResolutionStrategyTypeEnum
conflictResolutionStrategy) (\s :: MergePullRequestByThreeWay
s@MergePullRequestByThreeWay' {} Maybe ConflictResolutionStrategyTypeEnum
a -> MergePullRequestByThreeWay
s {$sel:conflictResolutionStrategy:MergePullRequestByThreeWay' :: Maybe ConflictResolutionStrategyTypeEnum
conflictResolutionStrategy = Maybe ConflictResolutionStrategyTypeEnum
a} :: MergePullRequestByThreeWay)

-- | The email address of the person merging the branches. This information
-- is used in the commit information for the merge.
mergePullRequestByThreeWay_email :: Lens.Lens' MergePullRequestByThreeWay (Prelude.Maybe Prelude.Text)
mergePullRequestByThreeWay_email :: Lens' MergePullRequestByThreeWay (Maybe Text)
mergePullRequestByThreeWay_email = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\MergePullRequestByThreeWay' {Maybe Text
email :: Maybe Text
$sel:email:MergePullRequestByThreeWay' :: MergePullRequestByThreeWay -> Maybe Text
email} -> Maybe Text
email) (\s :: MergePullRequestByThreeWay
s@MergePullRequestByThreeWay' {} Maybe Text
a -> MergePullRequestByThreeWay
s {$sel:email:MergePullRequestByThreeWay' :: Maybe Text
email = Maybe Text
a} :: MergePullRequestByThreeWay)

-- | If the commit contains deletions, whether to keep a folder or folder
-- structure if the changes leave the folders empty. If true, a .gitkeep
-- file is created for empty folders. The default is false.
mergePullRequestByThreeWay_keepEmptyFolders :: Lens.Lens' MergePullRequestByThreeWay (Prelude.Maybe Prelude.Bool)
mergePullRequestByThreeWay_keepEmptyFolders :: Lens' MergePullRequestByThreeWay (Maybe Bool)
mergePullRequestByThreeWay_keepEmptyFolders = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\MergePullRequestByThreeWay' {Maybe Bool
keepEmptyFolders :: Maybe Bool
$sel:keepEmptyFolders:MergePullRequestByThreeWay' :: MergePullRequestByThreeWay -> Maybe Bool
keepEmptyFolders} -> Maybe Bool
keepEmptyFolders) (\s :: MergePullRequestByThreeWay
s@MergePullRequestByThreeWay' {} Maybe Bool
a -> MergePullRequestByThreeWay
s {$sel:keepEmptyFolders:MergePullRequestByThreeWay' :: Maybe Bool
keepEmptyFolders = Maybe Bool
a} :: MergePullRequestByThreeWay)

-- | The full commit ID of the original or updated commit in the pull request
-- source branch. Pass this value if you want an exception thrown if the
-- current commit ID of the tip of the source branch does not match this
-- commit ID.
mergePullRequestByThreeWay_sourceCommitId :: Lens.Lens' MergePullRequestByThreeWay (Prelude.Maybe Prelude.Text)
mergePullRequestByThreeWay_sourceCommitId :: Lens' MergePullRequestByThreeWay (Maybe Text)
mergePullRequestByThreeWay_sourceCommitId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\MergePullRequestByThreeWay' {Maybe Text
sourceCommitId :: Maybe Text
$sel:sourceCommitId:MergePullRequestByThreeWay' :: MergePullRequestByThreeWay -> Maybe Text
sourceCommitId} -> Maybe Text
sourceCommitId) (\s :: MergePullRequestByThreeWay
s@MergePullRequestByThreeWay' {} Maybe Text
a -> MergePullRequestByThreeWay
s {$sel:sourceCommitId:MergePullRequestByThreeWay' :: Maybe Text
sourceCommitId = Maybe Text
a} :: MergePullRequestByThreeWay)

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

-- | The name of the repository where the pull request was created.
mergePullRequestByThreeWay_repositoryName :: Lens.Lens' MergePullRequestByThreeWay Prelude.Text
mergePullRequestByThreeWay_repositoryName :: Lens' MergePullRequestByThreeWay Text
mergePullRequestByThreeWay_repositoryName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\MergePullRequestByThreeWay' {Text
repositoryName :: Text
$sel:repositoryName:MergePullRequestByThreeWay' :: MergePullRequestByThreeWay -> Text
repositoryName} -> Text
repositoryName) (\s :: MergePullRequestByThreeWay
s@MergePullRequestByThreeWay' {} Text
a -> MergePullRequestByThreeWay
s {$sel:repositoryName:MergePullRequestByThreeWay' :: Text
repositoryName = Text
a} :: MergePullRequestByThreeWay)

instance Core.AWSRequest MergePullRequestByThreeWay where
  type
    AWSResponse MergePullRequestByThreeWay =
      MergePullRequestByThreeWayResponse
  request :: (Service -> Service)
-> MergePullRequestByThreeWay -> Request MergePullRequestByThreeWay
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 MergePullRequestByThreeWay
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse MergePullRequestByThreeWay)))
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 PullRequest -> Int -> MergePullRequestByThreeWayResponse
MergePullRequestByThreeWayResponse'
            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
"pullRequest")
            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 MergePullRequestByThreeWay where
  hashWithSalt :: Int -> MergePullRequestByThreeWay -> Int
hashWithSalt Int
_salt MergePullRequestByThreeWay' {Maybe Bool
Maybe Text
Maybe ConflictDetailLevelTypeEnum
Maybe ConflictResolutionStrategyTypeEnum
Maybe ConflictResolution
Text
repositoryName :: Text
pullRequestId :: Text
sourceCommitId :: Maybe Text
keepEmptyFolders :: Maybe Bool
email :: Maybe Text
conflictResolutionStrategy :: Maybe ConflictResolutionStrategyTypeEnum
conflictResolution :: Maybe ConflictResolution
conflictDetailLevel :: Maybe ConflictDetailLevelTypeEnum
commitMessage :: Maybe Text
authorName :: Maybe Text
$sel:repositoryName:MergePullRequestByThreeWay' :: MergePullRequestByThreeWay -> Text
$sel:pullRequestId:MergePullRequestByThreeWay' :: MergePullRequestByThreeWay -> Text
$sel:sourceCommitId:MergePullRequestByThreeWay' :: MergePullRequestByThreeWay -> Maybe Text
$sel:keepEmptyFolders:MergePullRequestByThreeWay' :: MergePullRequestByThreeWay -> Maybe Bool
$sel:email:MergePullRequestByThreeWay' :: MergePullRequestByThreeWay -> Maybe Text
$sel:conflictResolutionStrategy:MergePullRequestByThreeWay' :: MergePullRequestByThreeWay
-> Maybe ConflictResolutionStrategyTypeEnum
$sel:conflictResolution:MergePullRequestByThreeWay' :: MergePullRequestByThreeWay -> Maybe ConflictResolution
$sel:conflictDetailLevel:MergePullRequestByThreeWay' :: MergePullRequestByThreeWay -> Maybe ConflictDetailLevelTypeEnum
$sel:commitMessage:MergePullRequestByThreeWay' :: MergePullRequestByThreeWay -> Maybe Text
$sel:authorName:MergePullRequestByThreeWay' :: MergePullRequestByThreeWay -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
authorName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
commitMessage
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ConflictDetailLevelTypeEnum
conflictDetailLevel
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ConflictResolution
conflictResolution
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ConflictResolutionStrategyTypeEnum
conflictResolutionStrategy
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
email
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
keepEmptyFolders
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
sourceCommitId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
pullRequestId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
repositoryName

instance Prelude.NFData MergePullRequestByThreeWay where
  rnf :: MergePullRequestByThreeWay -> ()
rnf MergePullRequestByThreeWay' {Maybe Bool
Maybe Text
Maybe ConflictDetailLevelTypeEnum
Maybe ConflictResolutionStrategyTypeEnum
Maybe ConflictResolution
Text
repositoryName :: Text
pullRequestId :: Text
sourceCommitId :: Maybe Text
keepEmptyFolders :: Maybe Bool
email :: Maybe Text
conflictResolutionStrategy :: Maybe ConflictResolutionStrategyTypeEnum
conflictResolution :: Maybe ConflictResolution
conflictDetailLevel :: Maybe ConflictDetailLevelTypeEnum
commitMessage :: Maybe Text
authorName :: Maybe Text
$sel:repositoryName:MergePullRequestByThreeWay' :: MergePullRequestByThreeWay -> Text
$sel:pullRequestId:MergePullRequestByThreeWay' :: MergePullRequestByThreeWay -> Text
$sel:sourceCommitId:MergePullRequestByThreeWay' :: MergePullRequestByThreeWay -> Maybe Text
$sel:keepEmptyFolders:MergePullRequestByThreeWay' :: MergePullRequestByThreeWay -> Maybe Bool
$sel:email:MergePullRequestByThreeWay' :: MergePullRequestByThreeWay -> Maybe Text
$sel:conflictResolutionStrategy:MergePullRequestByThreeWay' :: MergePullRequestByThreeWay
-> Maybe ConflictResolutionStrategyTypeEnum
$sel:conflictResolution:MergePullRequestByThreeWay' :: MergePullRequestByThreeWay -> Maybe ConflictResolution
$sel:conflictDetailLevel:MergePullRequestByThreeWay' :: MergePullRequestByThreeWay -> Maybe ConflictDetailLevelTypeEnum
$sel:commitMessage:MergePullRequestByThreeWay' :: MergePullRequestByThreeWay -> Maybe Text
$sel:authorName:MergePullRequestByThreeWay' :: MergePullRequestByThreeWay -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
authorName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
commitMessage
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ConflictDetailLevelTypeEnum
conflictDetailLevel
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ConflictResolution
conflictResolution
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ConflictResolutionStrategyTypeEnum
conflictResolutionStrategy
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
email
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
keepEmptyFolders
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
sourceCommitId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
pullRequestId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
repositoryName

instance Data.ToHeaders MergePullRequestByThreeWay where
  toHeaders :: MergePullRequestByThreeWay -> 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.MergePullRequestByThreeWay" ::
                          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 MergePullRequestByThreeWay where
  toJSON :: MergePullRequestByThreeWay -> Value
toJSON MergePullRequestByThreeWay' {Maybe Bool
Maybe Text
Maybe ConflictDetailLevelTypeEnum
Maybe ConflictResolutionStrategyTypeEnum
Maybe ConflictResolution
Text
repositoryName :: Text
pullRequestId :: Text
sourceCommitId :: Maybe Text
keepEmptyFolders :: Maybe Bool
email :: Maybe Text
conflictResolutionStrategy :: Maybe ConflictResolutionStrategyTypeEnum
conflictResolution :: Maybe ConflictResolution
conflictDetailLevel :: Maybe ConflictDetailLevelTypeEnum
commitMessage :: Maybe Text
authorName :: Maybe Text
$sel:repositoryName:MergePullRequestByThreeWay' :: MergePullRequestByThreeWay -> Text
$sel:pullRequestId:MergePullRequestByThreeWay' :: MergePullRequestByThreeWay -> Text
$sel:sourceCommitId:MergePullRequestByThreeWay' :: MergePullRequestByThreeWay -> Maybe Text
$sel:keepEmptyFolders:MergePullRequestByThreeWay' :: MergePullRequestByThreeWay -> Maybe Bool
$sel:email:MergePullRequestByThreeWay' :: MergePullRequestByThreeWay -> Maybe Text
$sel:conflictResolutionStrategy:MergePullRequestByThreeWay' :: MergePullRequestByThreeWay
-> Maybe ConflictResolutionStrategyTypeEnum
$sel:conflictResolution:MergePullRequestByThreeWay' :: MergePullRequestByThreeWay -> Maybe ConflictResolution
$sel:conflictDetailLevel:MergePullRequestByThreeWay' :: MergePullRequestByThreeWay -> Maybe ConflictDetailLevelTypeEnum
$sel:commitMessage:MergePullRequestByThreeWay' :: MergePullRequestByThreeWay -> Maybe Text
$sel:authorName:MergePullRequestByThreeWay' :: MergePullRequestByThreeWay -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"authorName" 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
authorName,
            (Key
"commitMessage" 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
commitMessage,
            (Key
"conflictDetailLevel" 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 ConflictDetailLevelTypeEnum
conflictDetailLevel,
            (Key
"conflictResolution" 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 ConflictResolution
conflictResolution,
            (Key
"conflictResolutionStrategy" 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 ConflictResolutionStrategyTypeEnum
conflictResolutionStrategy,
            (Key
"email" 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
email,
            (Key
"keepEmptyFolders" 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 Bool
keepEmptyFolders,
            (Key
"sourceCommitId" 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
sourceCommitId,
            forall a. a -> Maybe a
Prelude.Just (Key
"pullRequestId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
pullRequestId),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"repositoryName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
repositoryName)
          ]
      )

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

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

-- | /See:/ 'newMergePullRequestByThreeWayResponse' smart constructor.
data MergePullRequestByThreeWayResponse = MergePullRequestByThreeWayResponse'
  { MergePullRequestByThreeWayResponse -> Maybe PullRequest
pullRequest :: Prelude.Maybe PullRequest,
    -- | The response's http status code.
    MergePullRequestByThreeWayResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (MergePullRequestByThreeWayResponse
-> MergePullRequestByThreeWayResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MergePullRequestByThreeWayResponse
-> MergePullRequestByThreeWayResponse -> Bool
$c/= :: MergePullRequestByThreeWayResponse
-> MergePullRequestByThreeWayResponse -> Bool
== :: MergePullRequestByThreeWayResponse
-> MergePullRequestByThreeWayResponse -> Bool
$c== :: MergePullRequestByThreeWayResponse
-> MergePullRequestByThreeWayResponse -> Bool
Prelude.Eq, ReadPrec [MergePullRequestByThreeWayResponse]
ReadPrec MergePullRequestByThreeWayResponse
Int -> ReadS MergePullRequestByThreeWayResponse
ReadS [MergePullRequestByThreeWayResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MergePullRequestByThreeWayResponse]
$creadListPrec :: ReadPrec [MergePullRequestByThreeWayResponse]
readPrec :: ReadPrec MergePullRequestByThreeWayResponse
$creadPrec :: ReadPrec MergePullRequestByThreeWayResponse
readList :: ReadS [MergePullRequestByThreeWayResponse]
$creadList :: ReadS [MergePullRequestByThreeWayResponse]
readsPrec :: Int -> ReadS MergePullRequestByThreeWayResponse
$creadsPrec :: Int -> ReadS MergePullRequestByThreeWayResponse
Prelude.Read, Int -> MergePullRequestByThreeWayResponse -> ShowS
[MergePullRequestByThreeWayResponse] -> ShowS
MergePullRequestByThreeWayResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MergePullRequestByThreeWayResponse] -> ShowS
$cshowList :: [MergePullRequestByThreeWayResponse] -> ShowS
show :: MergePullRequestByThreeWayResponse -> String
$cshow :: MergePullRequestByThreeWayResponse -> String
showsPrec :: Int -> MergePullRequestByThreeWayResponse -> ShowS
$cshowsPrec :: Int -> MergePullRequestByThreeWayResponse -> ShowS
Prelude.Show, forall x.
Rep MergePullRequestByThreeWayResponse x
-> MergePullRequestByThreeWayResponse
forall x.
MergePullRequestByThreeWayResponse
-> Rep MergePullRequestByThreeWayResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep MergePullRequestByThreeWayResponse x
-> MergePullRequestByThreeWayResponse
$cfrom :: forall x.
MergePullRequestByThreeWayResponse
-> Rep MergePullRequestByThreeWayResponse x
Prelude.Generic)

-- |
-- Create a value of 'MergePullRequestByThreeWayResponse' 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:
--
-- 'pullRequest', 'mergePullRequestByThreeWayResponse_pullRequest' - Undocumented member.
--
-- 'httpStatus', 'mergePullRequestByThreeWayResponse_httpStatus' - The response's http status code.
newMergePullRequestByThreeWayResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  MergePullRequestByThreeWayResponse
newMergePullRequestByThreeWayResponse :: Int -> MergePullRequestByThreeWayResponse
newMergePullRequestByThreeWayResponse Int
pHttpStatus_ =
  MergePullRequestByThreeWayResponse'
    { $sel:pullRequest:MergePullRequestByThreeWayResponse' :: Maybe PullRequest
pullRequest =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:MergePullRequestByThreeWayResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Undocumented member.
mergePullRequestByThreeWayResponse_pullRequest :: Lens.Lens' MergePullRequestByThreeWayResponse (Prelude.Maybe PullRequest)
mergePullRequestByThreeWayResponse_pullRequest :: Lens' MergePullRequestByThreeWayResponse (Maybe PullRequest)
mergePullRequestByThreeWayResponse_pullRequest = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\MergePullRequestByThreeWayResponse' {Maybe PullRequest
pullRequest :: Maybe PullRequest
$sel:pullRequest:MergePullRequestByThreeWayResponse' :: MergePullRequestByThreeWayResponse -> Maybe PullRequest
pullRequest} -> Maybe PullRequest
pullRequest) (\s :: MergePullRequestByThreeWayResponse
s@MergePullRequestByThreeWayResponse' {} Maybe PullRequest
a -> MergePullRequestByThreeWayResponse
s {$sel:pullRequest:MergePullRequestByThreeWayResponse' :: Maybe PullRequest
pullRequest = Maybe PullRequest
a} :: MergePullRequestByThreeWayResponse)

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

instance
  Prelude.NFData
    MergePullRequestByThreeWayResponse
  where
  rnf :: MergePullRequestByThreeWayResponse -> ()
rnf MergePullRequestByThreeWayResponse' {Int
Maybe PullRequest
httpStatus :: Int
pullRequest :: Maybe PullRequest
$sel:httpStatus:MergePullRequestByThreeWayResponse' :: MergePullRequestByThreeWayResponse -> Int
$sel:pullRequest:MergePullRequestByThreeWayResponse' :: MergePullRequestByThreeWayResponse -> Maybe PullRequest
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe PullRequest
pullRequest
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus