{-# 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.CreatePullRequest
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Creates a pull request in the specified repository.
module Amazonka.CodeCommit.CreatePullRequest
  ( -- * Creating a Request
    CreatePullRequest (..),
    newCreatePullRequest,

    -- * Request Lenses
    createPullRequest_clientRequestToken,
    createPullRequest_description,
    createPullRequest_title,
    createPullRequest_targets,

    -- * Destructuring the Response
    CreatePullRequestResponse (..),
    newCreatePullRequestResponse,

    -- * Response Lenses
    createPullRequestResponse_httpStatus,
    createPullRequestResponse_pullRequest,
  )
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:/ 'newCreatePullRequest' smart constructor.
data CreatePullRequest = CreatePullRequest'
  { -- | 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.
    --
    -- The AWS SDKs prepopulate client request tokens. If you are using an AWS
    -- SDK, an idempotency token is created for you.
    CreatePullRequest -> Maybe Text
clientRequestToken :: Prelude.Maybe Prelude.Text,
    -- | A description of the pull request.
    CreatePullRequest -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | The title of the pull request. This title is used to identify the pull
    -- request to other users in the repository.
    CreatePullRequest -> Text
title :: Prelude.Text,
    -- | The targets for the pull request, including the source of the code to be
    -- reviewed (the source branch) and the destination where the creator of
    -- the pull request intends the code to be merged after the pull request is
    -- closed (the destination branch).
    CreatePullRequest -> [Target]
targets :: [Target]
  }
  deriving (CreatePullRequest -> CreatePullRequest -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreatePullRequest -> CreatePullRequest -> Bool
$c/= :: CreatePullRequest -> CreatePullRequest -> Bool
== :: CreatePullRequest -> CreatePullRequest -> Bool
$c== :: CreatePullRequest -> CreatePullRequest -> Bool
Prelude.Eq, ReadPrec [CreatePullRequest]
ReadPrec CreatePullRequest
Int -> ReadS CreatePullRequest
ReadS [CreatePullRequest]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreatePullRequest]
$creadListPrec :: ReadPrec [CreatePullRequest]
readPrec :: ReadPrec CreatePullRequest
$creadPrec :: ReadPrec CreatePullRequest
readList :: ReadS [CreatePullRequest]
$creadList :: ReadS [CreatePullRequest]
readsPrec :: Int -> ReadS CreatePullRequest
$creadsPrec :: Int -> ReadS CreatePullRequest
Prelude.Read, Int -> CreatePullRequest -> ShowS
[CreatePullRequest] -> ShowS
CreatePullRequest -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreatePullRequest] -> ShowS
$cshowList :: [CreatePullRequest] -> ShowS
show :: CreatePullRequest -> String
$cshow :: CreatePullRequest -> String
showsPrec :: Int -> CreatePullRequest -> ShowS
$cshowsPrec :: Int -> CreatePullRequest -> ShowS
Prelude.Show, forall x. Rep CreatePullRequest x -> CreatePullRequest
forall x. CreatePullRequest -> Rep CreatePullRequest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreatePullRequest x -> CreatePullRequest
$cfrom :: forall x. CreatePullRequest -> Rep CreatePullRequest x
Prelude.Generic)

-- |
-- Create a value of 'CreatePullRequest' 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:
--
-- 'clientRequestToken', 'createPullRequest_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.
--
-- The AWS SDKs prepopulate client request tokens. If you are using an AWS
-- SDK, an idempotency token is created for you.
--
-- 'description', 'createPullRequest_description' - A description of the pull request.
--
-- 'title', 'createPullRequest_title' - The title of the pull request. This title is used to identify the pull
-- request to other users in the repository.
--
-- 'targets', 'createPullRequest_targets' - The targets for the pull request, including the source of the code to be
-- reviewed (the source branch) and the destination where the creator of
-- the pull request intends the code to be merged after the pull request is
-- closed (the destination branch).
newCreatePullRequest ::
  -- | 'title'
  Prelude.Text ->
  CreatePullRequest
newCreatePullRequest :: Text -> CreatePullRequest
newCreatePullRequest Text
pTitle_ =
  CreatePullRequest'
    { $sel:clientRequestToken:CreatePullRequest' :: Maybe Text
clientRequestToken =
        forall a. Maybe a
Prelude.Nothing,
      $sel:description:CreatePullRequest' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:title:CreatePullRequest' :: Text
title = Text
pTitle_,
      $sel:targets:CreatePullRequest' :: [Target]
targets = forall a. Monoid a => a
Prelude.mempty
    }

-- | 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.
--
-- The AWS SDKs prepopulate client request tokens. If you are using an AWS
-- SDK, an idempotency token is created for you.
createPullRequest_clientRequestToken :: Lens.Lens' CreatePullRequest (Prelude.Maybe Prelude.Text)
createPullRequest_clientRequestToken :: Lens' CreatePullRequest (Maybe Text)
createPullRequest_clientRequestToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreatePullRequest' {Maybe Text
clientRequestToken :: Maybe Text
$sel:clientRequestToken:CreatePullRequest' :: CreatePullRequest -> Maybe Text
clientRequestToken} -> Maybe Text
clientRequestToken) (\s :: CreatePullRequest
s@CreatePullRequest' {} Maybe Text
a -> CreatePullRequest
s {$sel:clientRequestToken:CreatePullRequest' :: Maybe Text
clientRequestToken = Maybe Text
a} :: CreatePullRequest)

-- | A description of the pull request.
createPullRequest_description :: Lens.Lens' CreatePullRequest (Prelude.Maybe Prelude.Text)
createPullRequest_description :: Lens' CreatePullRequest (Maybe Text)
createPullRequest_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreatePullRequest' {Maybe Text
description :: Maybe Text
$sel:description:CreatePullRequest' :: CreatePullRequest -> Maybe Text
description} -> Maybe Text
description) (\s :: CreatePullRequest
s@CreatePullRequest' {} Maybe Text
a -> CreatePullRequest
s {$sel:description:CreatePullRequest' :: Maybe Text
description = Maybe Text
a} :: CreatePullRequest)

-- | The title of the pull request. This title is used to identify the pull
-- request to other users in the repository.
createPullRequest_title :: Lens.Lens' CreatePullRequest Prelude.Text
createPullRequest_title :: Lens' CreatePullRequest Text
createPullRequest_title = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreatePullRequest' {Text
title :: Text
$sel:title:CreatePullRequest' :: CreatePullRequest -> Text
title} -> Text
title) (\s :: CreatePullRequest
s@CreatePullRequest' {} Text
a -> CreatePullRequest
s {$sel:title:CreatePullRequest' :: Text
title = Text
a} :: CreatePullRequest)

-- | The targets for the pull request, including the source of the code to be
-- reviewed (the source branch) and the destination where the creator of
-- the pull request intends the code to be merged after the pull request is
-- closed (the destination branch).
createPullRequest_targets :: Lens.Lens' CreatePullRequest [Target]
createPullRequest_targets :: Lens' CreatePullRequest [Target]
createPullRequest_targets = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreatePullRequest' {[Target]
targets :: [Target]
$sel:targets:CreatePullRequest' :: CreatePullRequest -> [Target]
targets} -> [Target]
targets) (\s :: CreatePullRequest
s@CreatePullRequest' {} [Target]
a -> CreatePullRequest
s {$sel:targets:CreatePullRequest' :: [Target]
targets = [Target]
a} :: CreatePullRequest) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

instance Core.AWSRequest CreatePullRequest where
  type
    AWSResponse CreatePullRequest =
      CreatePullRequestResponse
  request :: (Service -> Service)
-> CreatePullRequest -> Request CreatePullRequest
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 CreatePullRequest
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CreatePullRequest)))
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 ->
          Int -> PullRequest -> CreatePullRequestResponse
CreatePullRequestResponse'
            forall (f :: * -> *) a b. Functor 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))
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"pullRequest")
      )

instance Prelude.Hashable CreatePullRequest where
  hashWithSalt :: Int -> CreatePullRequest -> Int
hashWithSalt Int
_salt CreatePullRequest' {[Target]
Maybe Text
Text
targets :: [Target]
title :: Text
description :: Maybe Text
clientRequestToken :: Maybe Text
$sel:targets:CreatePullRequest' :: CreatePullRequest -> [Target]
$sel:title:CreatePullRequest' :: CreatePullRequest -> Text
$sel:description:CreatePullRequest' :: CreatePullRequest -> Maybe Text
$sel:clientRequestToken:CreatePullRequest' :: CreatePullRequest -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
clientRequestToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
title
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` [Target]
targets

instance Prelude.NFData CreatePullRequest where
  rnf :: CreatePullRequest -> ()
rnf CreatePullRequest' {[Target]
Maybe Text
Text
targets :: [Target]
title :: Text
description :: Maybe Text
clientRequestToken :: Maybe Text
$sel:targets:CreatePullRequest' :: CreatePullRequest -> [Target]
$sel:title:CreatePullRequest' :: CreatePullRequest -> Text
$sel:description:CreatePullRequest' :: CreatePullRequest -> Maybe Text
$sel:clientRequestToken:CreatePullRequest' :: CreatePullRequest -> Maybe Text
..} =
    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 Text
description
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
title
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf [Target]
targets

instance Data.ToHeaders CreatePullRequest where
  toHeaders :: CreatePullRequest -> 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.CreatePullRequest" ::
                          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 CreatePullRequest where
  toJSON :: CreatePullRequest -> Value
toJSON CreatePullRequest' {[Target]
Maybe Text
Text
targets :: [Target]
title :: Text
description :: Maybe Text
clientRequestToken :: Maybe Text
$sel:targets:CreatePullRequest' :: CreatePullRequest -> [Target]
$sel:title:CreatePullRequest' :: CreatePullRequest -> Text
$sel:description:CreatePullRequest' :: CreatePullRequest -> Maybe Text
$sel:clientRequestToken:CreatePullRequest' :: CreatePullRequest -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (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
"description" 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
description,
            forall a. a -> Maybe a
Prelude.Just (Key
"title" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
title),
            forall a. a -> Maybe a
Prelude.Just (Key
"targets" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= [Target]
targets)
          ]
      )

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

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

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

-- |
-- Create a value of 'CreatePullRequestResponse' 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:
--
-- 'httpStatus', 'createPullRequestResponse_httpStatus' - The response's http status code.
--
-- 'pullRequest', 'createPullRequestResponse_pullRequest' - Information about the newly created pull request.
newCreatePullRequestResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'pullRequest'
  PullRequest ->
  CreatePullRequestResponse
newCreatePullRequestResponse :: Int -> PullRequest -> CreatePullRequestResponse
newCreatePullRequestResponse
  Int
pHttpStatus_
  PullRequest
pPullRequest_ =
    CreatePullRequestResponse'
      { $sel:httpStatus:CreatePullRequestResponse' :: Int
httpStatus =
          Int
pHttpStatus_,
        $sel:pullRequest:CreatePullRequestResponse' :: PullRequest
pullRequest = PullRequest
pPullRequest_
      }

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

-- | Information about the newly created pull request.
createPullRequestResponse_pullRequest :: Lens.Lens' CreatePullRequestResponse PullRequest
createPullRequestResponse_pullRequest :: Lens' CreatePullRequestResponse PullRequest
createPullRequestResponse_pullRequest = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreatePullRequestResponse' {PullRequest
pullRequest :: PullRequest
$sel:pullRequest:CreatePullRequestResponse' :: CreatePullRequestResponse -> PullRequest
pullRequest} -> PullRequest
pullRequest) (\s :: CreatePullRequestResponse
s@CreatePullRequestResponse' {} PullRequest
a -> CreatePullRequestResponse
s {$sel:pullRequest:CreatePullRequestResponse' :: PullRequest
pullRequest = PullRequest
a} :: CreatePullRequestResponse)

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