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

    -- * Request Lenses
    getPullRequest_pullRequestId,

    -- * Destructuring the Response
    GetPullRequestResponse (..),
    newGetPullRequestResponse,

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

-- |
-- Create a value of 'GetPullRequest' 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:
--
-- 'pullRequestId', 'getPullRequest_pullRequestId' - The system-generated ID of the pull request. To get this ID, use
-- ListPullRequests.
newGetPullRequest ::
  -- | 'pullRequestId'
  Prelude.Text ->
  GetPullRequest
newGetPullRequest :: Text -> GetPullRequest
newGetPullRequest Text
pPullRequestId_ =
  GetPullRequest' {$sel:pullRequestId:GetPullRequest' :: Text
pullRequestId = Text
pPullRequestId_}

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

instance Core.AWSRequest GetPullRequest where
  type
    AWSResponse GetPullRequest =
      GetPullRequestResponse
  request :: (Service -> Service) -> GetPullRequest -> Request GetPullRequest
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 GetPullRequest
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse GetPullRequest)))
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 -> GetPullRequestResponse
GetPullRequestResponse'
            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 GetPullRequest where
  hashWithSalt :: Int -> GetPullRequest -> Int
hashWithSalt Int
_salt GetPullRequest' {Text
pullRequestId :: Text
$sel:pullRequestId:GetPullRequest' :: GetPullRequest -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
pullRequestId

instance Prelude.NFData GetPullRequest where
  rnf :: GetPullRequest -> ()
rnf GetPullRequest' {Text
pullRequestId :: Text
$sel:pullRequestId:GetPullRequest' :: GetPullRequest -> Text
..} = forall a. NFData a => a -> ()
Prelude.rnf Text
pullRequestId

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

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

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

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

-- |
-- Create a value of 'GetPullRequestResponse' 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', 'getPullRequestResponse_httpStatus' - The response's http status code.
--
-- 'pullRequest', 'getPullRequestResponse_pullRequest' - Information about the specified pull request.
newGetPullRequestResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'pullRequest'
  PullRequest ->
  GetPullRequestResponse
newGetPullRequestResponse :: Int -> PullRequest -> GetPullRequestResponse
newGetPullRequestResponse Int
pHttpStatus_ PullRequest
pPullRequest_ =
  GetPullRequestResponse'
    { $sel:httpStatus:GetPullRequestResponse' :: Int
httpStatus = Int
pHttpStatus_,
      $sel:pullRequest:GetPullRequestResponse' :: PullRequest
pullRequest = PullRequest
pPullRequest_
    }

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

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

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