{-# 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.MergePullRequestByFastForward
-- 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 fast-forward merge strategy. If the merge is successful, it closes
-- the pull request.
module Amazonka.CodeCommit.MergePullRequestByFastForward
  ( -- * Creating a Request
    MergePullRequestByFastForward (..),
    newMergePullRequestByFastForward,

    -- * Request Lenses
    mergePullRequestByFastForward_sourceCommitId,
    mergePullRequestByFastForward_pullRequestId,
    mergePullRequestByFastForward_repositoryName,

    -- * Destructuring the Response
    MergePullRequestByFastForwardResponse (..),
    newMergePullRequestByFastForwardResponse,

    -- * Response Lenses
    mergePullRequestByFastForwardResponse_pullRequest,
    mergePullRequestByFastForwardResponse_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:/ 'newMergePullRequestByFastForward' smart constructor.
data MergePullRequestByFastForward = MergePullRequestByFastForward'
  { -- | 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.
    MergePullRequestByFastForward -> Maybe Text
sourceCommitId :: Prelude.Maybe Prelude.Text,
    -- | The system-generated ID of the pull request. To get this ID, use
    -- ListPullRequests.
    MergePullRequestByFastForward -> Text
pullRequestId :: Prelude.Text,
    -- | The name of the repository where the pull request was created.
    MergePullRequestByFastForward -> Text
repositoryName :: Prelude.Text
  }
  deriving (MergePullRequestByFastForward
-> MergePullRequestByFastForward -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MergePullRequestByFastForward
-> MergePullRequestByFastForward -> Bool
$c/= :: MergePullRequestByFastForward
-> MergePullRequestByFastForward -> Bool
== :: MergePullRequestByFastForward
-> MergePullRequestByFastForward -> Bool
$c== :: MergePullRequestByFastForward
-> MergePullRequestByFastForward -> Bool
Prelude.Eq, ReadPrec [MergePullRequestByFastForward]
ReadPrec MergePullRequestByFastForward
Int -> ReadS MergePullRequestByFastForward
ReadS [MergePullRequestByFastForward]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MergePullRequestByFastForward]
$creadListPrec :: ReadPrec [MergePullRequestByFastForward]
readPrec :: ReadPrec MergePullRequestByFastForward
$creadPrec :: ReadPrec MergePullRequestByFastForward
readList :: ReadS [MergePullRequestByFastForward]
$creadList :: ReadS [MergePullRequestByFastForward]
readsPrec :: Int -> ReadS MergePullRequestByFastForward
$creadsPrec :: Int -> ReadS MergePullRequestByFastForward
Prelude.Read, Int -> MergePullRequestByFastForward -> ShowS
[MergePullRequestByFastForward] -> ShowS
MergePullRequestByFastForward -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MergePullRequestByFastForward] -> ShowS
$cshowList :: [MergePullRequestByFastForward] -> ShowS
show :: MergePullRequestByFastForward -> String
$cshow :: MergePullRequestByFastForward -> String
showsPrec :: Int -> MergePullRequestByFastForward -> ShowS
$cshowsPrec :: Int -> MergePullRequestByFastForward -> ShowS
Prelude.Show, forall x.
Rep MergePullRequestByFastForward x
-> MergePullRequestByFastForward
forall x.
MergePullRequestByFastForward
-> Rep MergePullRequestByFastForward x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep MergePullRequestByFastForward x
-> MergePullRequestByFastForward
$cfrom :: forall x.
MergePullRequestByFastForward
-> Rep MergePullRequestByFastForward x
Prelude.Generic)

-- |
-- Create a value of 'MergePullRequestByFastForward' 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:
--
-- 'sourceCommitId', 'mergePullRequestByFastForward_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', 'mergePullRequestByFastForward_pullRequestId' - The system-generated ID of the pull request. To get this ID, use
-- ListPullRequests.
--
-- 'repositoryName', 'mergePullRequestByFastForward_repositoryName' - The name of the repository where the pull request was created.
newMergePullRequestByFastForward ::
  -- | 'pullRequestId'
  Prelude.Text ->
  -- | 'repositoryName'
  Prelude.Text ->
  MergePullRequestByFastForward
newMergePullRequestByFastForward :: Text -> Text -> MergePullRequestByFastForward
newMergePullRequestByFastForward
  Text
pPullRequestId_
  Text
pRepositoryName_ =
    MergePullRequestByFastForward'
      { $sel:sourceCommitId:MergePullRequestByFastForward' :: Maybe Text
sourceCommitId =
          forall a. Maybe a
Prelude.Nothing,
        $sel:pullRequestId:MergePullRequestByFastForward' :: Text
pullRequestId = Text
pPullRequestId_,
        $sel:repositoryName:MergePullRequestByFastForward' :: Text
repositoryName = Text
pRepositoryName_
      }

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

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

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

instance
  Core.AWSRequest
    MergePullRequestByFastForward
  where
  type
    AWSResponse MergePullRequestByFastForward =
      MergePullRequestByFastForwardResponse
  request :: (Service -> Service)
-> MergePullRequestByFastForward
-> Request MergePullRequestByFastForward
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 MergePullRequestByFastForward
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse MergePullRequestByFastForward)))
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 -> MergePullRequestByFastForwardResponse
MergePullRequestByFastForwardResponse'
            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
    MergePullRequestByFastForward
  where
  hashWithSalt :: Int -> MergePullRequestByFastForward -> Int
hashWithSalt Int
_salt MergePullRequestByFastForward' {Maybe Text
Text
repositoryName :: Text
pullRequestId :: Text
sourceCommitId :: Maybe Text
$sel:repositoryName:MergePullRequestByFastForward' :: MergePullRequestByFastForward -> Text
$sel:pullRequestId:MergePullRequestByFastForward' :: MergePullRequestByFastForward -> Text
$sel:sourceCommitId:MergePullRequestByFastForward' :: MergePullRequestByFastForward -> Maybe Text
..} =
    Int
_salt
      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 MergePullRequestByFastForward where
  rnf :: MergePullRequestByFastForward -> ()
rnf MergePullRequestByFastForward' {Maybe Text
Text
repositoryName :: Text
pullRequestId :: Text
sourceCommitId :: Maybe Text
$sel:repositoryName:MergePullRequestByFastForward' :: MergePullRequestByFastForward -> Text
$sel:pullRequestId:MergePullRequestByFastForward' :: MergePullRequestByFastForward -> Text
$sel:sourceCommitId:MergePullRequestByFastForward' :: MergePullRequestByFastForward -> Maybe Text
..} =
    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 MergePullRequestByFastForward where
  toHeaders :: MergePullRequestByFastForward -> 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.MergePullRequestByFastForward" ::
                          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 MergePullRequestByFastForward where
  toJSON :: MergePullRequestByFastForward -> Value
toJSON MergePullRequestByFastForward' {Maybe Text
Text
repositoryName :: Text
pullRequestId :: Text
sourceCommitId :: Maybe Text
$sel:repositoryName:MergePullRequestByFastForward' :: MergePullRequestByFastForward -> Text
$sel:pullRequestId:MergePullRequestByFastForward' :: MergePullRequestByFastForward -> Text
$sel:sourceCommitId:MergePullRequestByFastForward' :: MergePullRequestByFastForward -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (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 MergePullRequestByFastForward where
  toPath :: MergePullRequestByFastForward -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

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

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

-- |
-- Create a value of 'MergePullRequestByFastForwardResponse' 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', 'mergePullRequestByFastForwardResponse_pullRequest' - Information about the specified pull request, including the merge.
--
-- 'httpStatus', 'mergePullRequestByFastForwardResponse_httpStatus' - The response's http status code.
newMergePullRequestByFastForwardResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  MergePullRequestByFastForwardResponse
newMergePullRequestByFastForwardResponse :: Int -> MergePullRequestByFastForwardResponse
newMergePullRequestByFastForwardResponse Int
pHttpStatus_ =
  MergePullRequestByFastForwardResponse'
    { $sel:pullRequest:MergePullRequestByFastForwardResponse' :: Maybe PullRequest
pullRequest =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:MergePullRequestByFastForwardResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Information about the specified pull request, including the merge.
mergePullRequestByFastForwardResponse_pullRequest :: Lens.Lens' MergePullRequestByFastForwardResponse (Prelude.Maybe PullRequest)
mergePullRequestByFastForwardResponse_pullRequest :: Lens' MergePullRequestByFastForwardResponse (Maybe PullRequest)
mergePullRequestByFastForwardResponse_pullRequest = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\MergePullRequestByFastForwardResponse' {Maybe PullRequest
pullRequest :: Maybe PullRequest
$sel:pullRequest:MergePullRequestByFastForwardResponse' :: MergePullRequestByFastForwardResponse -> Maybe PullRequest
pullRequest} -> Maybe PullRequest
pullRequest) (\s :: MergePullRequestByFastForwardResponse
s@MergePullRequestByFastForwardResponse' {} Maybe PullRequest
a -> MergePullRequestByFastForwardResponse
s {$sel:pullRequest:MergePullRequestByFastForwardResponse' :: Maybe PullRequest
pullRequest = Maybe PullRequest
a} :: MergePullRequestByFastForwardResponse)

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

instance
  Prelude.NFData
    MergePullRequestByFastForwardResponse
  where
  rnf :: MergePullRequestByFastForwardResponse -> ()
rnf MergePullRequestByFastForwardResponse' {Int
Maybe PullRequest
httpStatus :: Int
pullRequest :: Maybe PullRequest
$sel:httpStatus:MergePullRequestByFastForwardResponse' :: MergePullRequestByFastForwardResponse -> Int
$sel:pullRequest:MergePullRequestByFastForwardResponse' :: MergePullRequestByFastForwardResponse -> 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