{-# 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.EvaluatePullRequestApprovalRules
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Evaluates whether a pull request has met all the conditions specified in
-- its associated approval rules.
module Amazonka.CodeCommit.EvaluatePullRequestApprovalRules
  ( -- * Creating a Request
    EvaluatePullRequestApprovalRules (..),
    newEvaluatePullRequestApprovalRules,

    -- * Request Lenses
    evaluatePullRequestApprovalRules_pullRequestId,
    evaluatePullRequestApprovalRules_revisionId,

    -- * Destructuring the Response
    EvaluatePullRequestApprovalRulesResponse (..),
    newEvaluatePullRequestApprovalRulesResponse,

    -- * Response Lenses
    evaluatePullRequestApprovalRulesResponse_httpStatus,
    evaluatePullRequestApprovalRulesResponse_evaluation,
  )
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:/ 'newEvaluatePullRequestApprovalRules' smart constructor.
data EvaluatePullRequestApprovalRules = EvaluatePullRequestApprovalRules'
  { -- | The system-generated ID of the pull request you want to evaluate.
    EvaluatePullRequestApprovalRules -> Text
pullRequestId :: Prelude.Text,
    -- | The system-generated ID for the pull request revision. To retrieve the
    -- most recent revision ID for a pull request, use GetPullRequest.
    EvaluatePullRequestApprovalRules -> Text
revisionId :: Prelude.Text
  }
  deriving (EvaluatePullRequestApprovalRules
-> EvaluatePullRequestApprovalRules -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EvaluatePullRequestApprovalRules
-> EvaluatePullRequestApprovalRules -> Bool
$c/= :: EvaluatePullRequestApprovalRules
-> EvaluatePullRequestApprovalRules -> Bool
== :: EvaluatePullRequestApprovalRules
-> EvaluatePullRequestApprovalRules -> Bool
$c== :: EvaluatePullRequestApprovalRules
-> EvaluatePullRequestApprovalRules -> Bool
Prelude.Eq, ReadPrec [EvaluatePullRequestApprovalRules]
ReadPrec EvaluatePullRequestApprovalRules
Int -> ReadS EvaluatePullRequestApprovalRules
ReadS [EvaluatePullRequestApprovalRules]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [EvaluatePullRequestApprovalRules]
$creadListPrec :: ReadPrec [EvaluatePullRequestApprovalRules]
readPrec :: ReadPrec EvaluatePullRequestApprovalRules
$creadPrec :: ReadPrec EvaluatePullRequestApprovalRules
readList :: ReadS [EvaluatePullRequestApprovalRules]
$creadList :: ReadS [EvaluatePullRequestApprovalRules]
readsPrec :: Int -> ReadS EvaluatePullRequestApprovalRules
$creadsPrec :: Int -> ReadS EvaluatePullRequestApprovalRules
Prelude.Read, Int -> EvaluatePullRequestApprovalRules -> ShowS
[EvaluatePullRequestApprovalRules] -> ShowS
EvaluatePullRequestApprovalRules -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EvaluatePullRequestApprovalRules] -> ShowS
$cshowList :: [EvaluatePullRequestApprovalRules] -> ShowS
show :: EvaluatePullRequestApprovalRules -> String
$cshow :: EvaluatePullRequestApprovalRules -> String
showsPrec :: Int -> EvaluatePullRequestApprovalRules -> ShowS
$cshowsPrec :: Int -> EvaluatePullRequestApprovalRules -> ShowS
Prelude.Show, forall x.
Rep EvaluatePullRequestApprovalRules x
-> EvaluatePullRequestApprovalRules
forall x.
EvaluatePullRequestApprovalRules
-> Rep EvaluatePullRequestApprovalRules x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep EvaluatePullRequestApprovalRules x
-> EvaluatePullRequestApprovalRules
$cfrom :: forall x.
EvaluatePullRequestApprovalRules
-> Rep EvaluatePullRequestApprovalRules x
Prelude.Generic)

-- |
-- Create a value of 'EvaluatePullRequestApprovalRules' 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', 'evaluatePullRequestApprovalRules_pullRequestId' - The system-generated ID of the pull request you want to evaluate.
--
-- 'revisionId', 'evaluatePullRequestApprovalRules_revisionId' - The system-generated ID for the pull request revision. To retrieve the
-- most recent revision ID for a pull request, use GetPullRequest.
newEvaluatePullRequestApprovalRules ::
  -- | 'pullRequestId'
  Prelude.Text ->
  -- | 'revisionId'
  Prelude.Text ->
  EvaluatePullRequestApprovalRules
newEvaluatePullRequestApprovalRules :: Text -> Text -> EvaluatePullRequestApprovalRules
newEvaluatePullRequestApprovalRules
  Text
pPullRequestId_
  Text
pRevisionId_ =
    EvaluatePullRequestApprovalRules'
      { $sel:pullRequestId:EvaluatePullRequestApprovalRules' :: Text
pullRequestId =
          Text
pPullRequestId_,
        $sel:revisionId:EvaluatePullRequestApprovalRules' :: Text
revisionId = Text
pRevisionId_
      }

-- | The system-generated ID of the pull request you want to evaluate.
evaluatePullRequestApprovalRules_pullRequestId :: Lens.Lens' EvaluatePullRequestApprovalRules Prelude.Text
evaluatePullRequestApprovalRules_pullRequestId :: Lens' EvaluatePullRequestApprovalRules Text
evaluatePullRequestApprovalRules_pullRequestId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\EvaluatePullRequestApprovalRules' {Text
pullRequestId :: Text
$sel:pullRequestId:EvaluatePullRequestApprovalRules' :: EvaluatePullRequestApprovalRules -> Text
pullRequestId} -> Text
pullRequestId) (\s :: EvaluatePullRequestApprovalRules
s@EvaluatePullRequestApprovalRules' {} Text
a -> EvaluatePullRequestApprovalRules
s {$sel:pullRequestId:EvaluatePullRequestApprovalRules' :: Text
pullRequestId = Text
a} :: EvaluatePullRequestApprovalRules)

-- | The system-generated ID for the pull request revision. To retrieve the
-- most recent revision ID for a pull request, use GetPullRequest.
evaluatePullRequestApprovalRules_revisionId :: Lens.Lens' EvaluatePullRequestApprovalRules Prelude.Text
evaluatePullRequestApprovalRules_revisionId :: Lens' EvaluatePullRequestApprovalRules Text
evaluatePullRequestApprovalRules_revisionId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\EvaluatePullRequestApprovalRules' {Text
revisionId :: Text
$sel:revisionId:EvaluatePullRequestApprovalRules' :: EvaluatePullRequestApprovalRules -> Text
revisionId} -> Text
revisionId) (\s :: EvaluatePullRequestApprovalRules
s@EvaluatePullRequestApprovalRules' {} Text
a -> EvaluatePullRequestApprovalRules
s {$sel:revisionId:EvaluatePullRequestApprovalRules' :: Text
revisionId = Text
a} :: EvaluatePullRequestApprovalRules)

instance
  Core.AWSRequest
    EvaluatePullRequestApprovalRules
  where
  type
    AWSResponse EvaluatePullRequestApprovalRules =
      EvaluatePullRequestApprovalRulesResponse
  request :: (Service -> Service)
-> EvaluatePullRequestApprovalRules
-> Request EvaluatePullRequestApprovalRules
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 EvaluatePullRequestApprovalRules
-> ClientResponse ClientBody
-> m (Either
        Error
        (ClientResponse (AWSResponse EvaluatePullRequestApprovalRules)))
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 -> Evaluation -> EvaluatePullRequestApprovalRulesResponse
EvaluatePullRequestApprovalRulesResponse'
            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
"evaluation")
      )

instance
  Prelude.Hashable
    EvaluatePullRequestApprovalRules
  where
  hashWithSalt :: Int -> EvaluatePullRequestApprovalRules -> Int
hashWithSalt
    Int
_salt
    EvaluatePullRequestApprovalRules' {Text
revisionId :: Text
pullRequestId :: Text
$sel:revisionId:EvaluatePullRequestApprovalRules' :: EvaluatePullRequestApprovalRules -> Text
$sel:pullRequestId:EvaluatePullRequestApprovalRules' :: EvaluatePullRequestApprovalRules -> Text
..} =
      Int
_salt
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
pullRequestId
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
revisionId

instance
  Prelude.NFData
    EvaluatePullRequestApprovalRules
  where
  rnf :: EvaluatePullRequestApprovalRules -> ()
rnf EvaluatePullRequestApprovalRules' {Text
revisionId :: Text
pullRequestId :: Text
$sel:revisionId:EvaluatePullRequestApprovalRules' :: EvaluatePullRequestApprovalRules -> Text
$sel:pullRequestId:EvaluatePullRequestApprovalRules' :: EvaluatePullRequestApprovalRules -> Text
..} =
    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
revisionId

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

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

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

-- | /See:/ 'newEvaluatePullRequestApprovalRulesResponse' smart constructor.
data EvaluatePullRequestApprovalRulesResponse = EvaluatePullRequestApprovalRulesResponse'
  { -- | The response's http status code.
    EvaluatePullRequestApprovalRulesResponse -> Int
httpStatus :: Prelude.Int,
    -- | The result of the evaluation, including the names of the rules whose
    -- conditions have been met (if any), the names of the rules whose
    -- conditions have not been met (if any), whether the pull request is in
    -- the approved state, and whether the pull request approval rule has been
    -- set aside by an override.
    EvaluatePullRequestApprovalRulesResponse -> Evaluation
evaluation :: Evaluation
  }
  deriving (EvaluatePullRequestApprovalRulesResponse
-> EvaluatePullRequestApprovalRulesResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EvaluatePullRequestApprovalRulesResponse
-> EvaluatePullRequestApprovalRulesResponse -> Bool
$c/= :: EvaluatePullRequestApprovalRulesResponse
-> EvaluatePullRequestApprovalRulesResponse -> Bool
== :: EvaluatePullRequestApprovalRulesResponse
-> EvaluatePullRequestApprovalRulesResponse -> Bool
$c== :: EvaluatePullRequestApprovalRulesResponse
-> EvaluatePullRequestApprovalRulesResponse -> Bool
Prelude.Eq, ReadPrec [EvaluatePullRequestApprovalRulesResponse]
ReadPrec EvaluatePullRequestApprovalRulesResponse
Int -> ReadS EvaluatePullRequestApprovalRulesResponse
ReadS [EvaluatePullRequestApprovalRulesResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [EvaluatePullRequestApprovalRulesResponse]
$creadListPrec :: ReadPrec [EvaluatePullRequestApprovalRulesResponse]
readPrec :: ReadPrec EvaluatePullRequestApprovalRulesResponse
$creadPrec :: ReadPrec EvaluatePullRequestApprovalRulesResponse
readList :: ReadS [EvaluatePullRequestApprovalRulesResponse]
$creadList :: ReadS [EvaluatePullRequestApprovalRulesResponse]
readsPrec :: Int -> ReadS EvaluatePullRequestApprovalRulesResponse
$creadsPrec :: Int -> ReadS EvaluatePullRequestApprovalRulesResponse
Prelude.Read, Int -> EvaluatePullRequestApprovalRulesResponse -> ShowS
[EvaluatePullRequestApprovalRulesResponse] -> ShowS
EvaluatePullRequestApprovalRulesResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EvaluatePullRequestApprovalRulesResponse] -> ShowS
$cshowList :: [EvaluatePullRequestApprovalRulesResponse] -> ShowS
show :: EvaluatePullRequestApprovalRulesResponse -> String
$cshow :: EvaluatePullRequestApprovalRulesResponse -> String
showsPrec :: Int -> EvaluatePullRequestApprovalRulesResponse -> ShowS
$cshowsPrec :: Int -> EvaluatePullRequestApprovalRulesResponse -> ShowS
Prelude.Show, forall x.
Rep EvaluatePullRequestApprovalRulesResponse x
-> EvaluatePullRequestApprovalRulesResponse
forall x.
EvaluatePullRequestApprovalRulesResponse
-> Rep EvaluatePullRequestApprovalRulesResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep EvaluatePullRequestApprovalRulesResponse x
-> EvaluatePullRequestApprovalRulesResponse
$cfrom :: forall x.
EvaluatePullRequestApprovalRulesResponse
-> Rep EvaluatePullRequestApprovalRulesResponse x
Prelude.Generic)

-- |
-- Create a value of 'EvaluatePullRequestApprovalRulesResponse' 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', 'evaluatePullRequestApprovalRulesResponse_httpStatus' - The response's http status code.
--
-- 'evaluation', 'evaluatePullRequestApprovalRulesResponse_evaluation' - The result of the evaluation, including the names of the rules whose
-- conditions have been met (if any), the names of the rules whose
-- conditions have not been met (if any), whether the pull request is in
-- the approved state, and whether the pull request approval rule has been
-- set aside by an override.
newEvaluatePullRequestApprovalRulesResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'evaluation'
  Evaluation ->
  EvaluatePullRequestApprovalRulesResponse
newEvaluatePullRequestApprovalRulesResponse :: Int -> Evaluation -> EvaluatePullRequestApprovalRulesResponse
newEvaluatePullRequestApprovalRulesResponse
  Int
pHttpStatus_
  Evaluation
pEvaluation_ =
    EvaluatePullRequestApprovalRulesResponse'
      { $sel:httpStatus:EvaluatePullRequestApprovalRulesResponse' :: Int
httpStatus =
          Int
pHttpStatus_,
        $sel:evaluation:EvaluatePullRequestApprovalRulesResponse' :: Evaluation
evaluation = Evaluation
pEvaluation_
      }

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

-- | The result of the evaluation, including the names of the rules whose
-- conditions have been met (if any), the names of the rules whose
-- conditions have not been met (if any), whether the pull request is in
-- the approved state, and whether the pull request approval rule has been
-- set aside by an override.
evaluatePullRequestApprovalRulesResponse_evaluation :: Lens.Lens' EvaluatePullRequestApprovalRulesResponse Evaluation
evaluatePullRequestApprovalRulesResponse_evaluation :: Lens' EvaluatePullRequestApprovalRulesResponse Evaluation
evaluatePullRequestApprovalRulesResponse_evaluation = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\EvaluatePullRequestApprovalRulesResponse' {Evaluation
evaluation :: Evaluation
$sel:evaluation:EvaluatePullRequestApprovalRulesResponse' :: EvaluatePullRequestApprovalRulesResponse -> Evaluation
evaluation} -> Evaluation
evaluation) (\s :: EvaluatePullRequestApprovalRulesResponse
s@EvaluatePullRequestApprovalRulesResponse' {} Evaluation
a -> EvaluatePullRequestApprovalRulesResponse
s {$sel:evaluation:EvaluatePullRequestApprovalRulesResponse' :: Evaluation
evaluation = Evaluation
a} :: EvaluatePullRequestApprovalRulesResponse)

instance
  Prelude.NFData
    EvaluatePullRequestApprovalRulesResponse
  where
  rnf :: EvaluatePullRequestApprovalRulesResponse -> ()
rnf EvaluatePullRequestApprovalRulesResponse' {Int
Evaluation
evaluation :: Evaluation
httpStatus :: Int
$sel:evaluation:EvaluatePullRequestApprovalRulesResponse' :: EvaluatePullRequestApprovalRulesResponse -> Evaluation
$sel:httpStatus:EvaluatePullRequestApprovalRulesResponse' :: EvaluatePullRequestApprovalRulesResponse -> 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 Evaluation
evaluation