{-# 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.DeletePullRequestApprovalRule
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Deletes an approval rule from a specified pull request. Approval rules
-- can be deleted from a pull request only if the pull request is open, and
-- if the approval rule was created specifically for a pull request and not
-- generated from an approval rule template associated with the repository
-- where the pull request was created. You cannot delete an approval rule
-- from a merged or closed pull request.
module Amazonka.CodeCommit.DeletePullRequestApprovalRule
  ( -- * Creating a Request
    DeletePullRequestApprovalRule (..),
    newDeletePullRequestApprovalRule,

    -- * Request Lenses
    deletePullRequestApprovalRule_pullRequestId,
    deletePullRequestApprovalRule_approvalRuleName,

    -- * Destructuring the Response
    DeletePullRequestApprovalRuleResponse (..),
    newDeletePullRequestApprovalRuleResponse,

    -- * Response Lenses
    deletePullRequestApprovalRuleResponse_httpStatus,
    deletePullRequestApprovalRuleResponse_approvalRuleId,
  )
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:/ 'newDeletePullRequestApprovalRule' smart constructor.
data DeletePullRequestApprovalRule = DeletePullRequestApprovalRule'
  { -- | The system-generated ID of the pull request that contains the approval
    -- rule you want to delete.
    DeletePullRequestApprovalRule -> Text
pullRequestId :: Prelude.Text,
    -- | The name of the approval rule you want to delete.
    DeletePullRequestApprovalRule -> Text
approvalRuleName :: Prelude.Text
  }
  deriving (DeletePullRequestApprovalRule
-> DeletePullRequestApprovalRule -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeletePullRequestApprovalRule
-> DeletePullRequestApprovalRule -> Bool
$c/= :: DeletePullRequestApprovalRule
-> DeletePullRequestApprovalRule -> Bool
== :: DeletePullRequestApprovalRule
-> DeletePullRequestApprovalRule -> Bool
$c== :: DeletePullRequestApprovalRule
-> DeletePullRequestApprovalRule -> Bool
Prelude.Eq, ReadPrec [DeletePullRequestApprovalRule]
ReadPrec DeletePullRequestApprovalRule
Int -> ReadS DeletePullRequestApprovalRule
ReadS [DeletePullRequestApprovalRule]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeletePullRequestApprovalRule]
$creadListPrec :: ReadPrec [DeletePullRequestApprovalRule]
readPrec :: ReadPrec DeletePullRequestApprovalRule
$creadPrec :: ReadPrec DeletePullRequestApprovalRule
readList :: ReadS [DeletePullRequestApprovalRule]
$creadList :: ReadS [DeletePullRequestApprovalRule]
readsPrec :: Int -> ReadS DeletePullRequestApprovalRule
$creadsPrec :: Int -> ReadS DeletePullRequestApprovalRule
Prelude.Read, Int -> DeletePullRequestApprovalRule -> ShowS
[DeletePullRequestApprovalRule] -> ShowS
DeletePullRequestApprovalRule -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeletePullRequestApprovalRule] -> ShowS
$cshowList :: [DeletePullRequestApprovalRule] -> ShowS
show :: DeletePullRequestApprovalRule -> String
$cshow :: DeletePullRequestApprovalRule -> String
showsPrec :: Int -> DeletePullRequestApprovalRule -> ShowS
$cshowsPrec :: Int -> DeletePullRequestApprovalRule -> ShowS
Prelude.Show, forall x.
Rep DeletePullRequestApprovalRule x
-> DeletePullRequestApprovalRule
forall x.
DeletePullRequestApprovalRule
-> Rep DeletePullRequestApprovalRule x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DeletePullRequestApprovalRule x
-> DeletePullRequestApprovalRule
$cfrom :: forall x.
DeletePullRequestApprovalRule
-> Rep DeletePullRequestApprovalRule x
Prelude.Generic)

-- |
-- Create a value of 'DeletePullRequestApprovalRule' 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', 'deletePullRequestApprovalRule_pullRequestId' - The system-generated ID of the pull request that contains the approval
-- rule you want to delete.
--
-- 'approvalRuleName', 'deletePullRequestApprovalRule_approvalRuleName' - The name of the approval rule you want to delete.
newDeletePullRequestApprovalRule ::
  -- | 'pullRequestId'
  Prelude.Text ->
  -- | 'approvalRuleName'
  Prelude.Text ->
  DeletePullRequestApprovalRule
newDeletePullRequestApprovalRule :: Text -> Text -> DeletePullRequestApprovalRule
newDeletePullRequestApprovalRule
  Text
pPullRequestId_
  Text
pApprovalRuleName_ =
    DeletePullRequestApprovalRule'
      { $sel:pullRequestId:DeletePullRequestApprovalRule' :: Text
pullRequestId =
          Text
pPullRequestId_,
        $sel:approvalRuleName:DeletePullRequestApprovalRule' :: Text
approvalRuleName = Text
pApprovalRuleName_
      }

-- | The system-generated ID of the pull request that contains the approval
-- rule you want to delete.
deletePullRequestApprovalRule_pullRequestId :: Lens.Lens' DeletePullRequestApprovalRule Prelude.Text
deletePullRequestApprovalRule_pullRequestId :: Lens' DeletePullRequestApprovalRule Text
deletePullRequestApprovalRule_pullRequestId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeletePullRequestApprovalRule' {Text
pullRequestId :: Text
$sel:pullRequestId:DeletePullRequestApprovalRule' :: DeletePullRequestApprovalRule -> Text
pullRequestId} -> Text
pullRequestId) (\s :: DeletePullRequestApprovalRule
s@DeletePullRequestApprovalRule' {} Text
a -> DeletePullRequestApprovalRule
s {$sel:pullRequestId:DeletePullRequestApprovalRule' :: Text
pullRequestId = Text
a} :: DeletePullRequestApprovalRule)

-- | The name of the approval rule you want to delete.
deletePullRequestApprovalRule_approvalRuleName :: Lens.Lens' DeletePullRequestApprovalRule Prelude.Text
deletePullRequestApprovalRule_approvalRuleName :: Lens' DeletePullRequestApprovalRule Text
deletePullRequestApprovalRule_approvalRuleName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeletePullRequestApprovalRule' {Text
approvalRuleName :: Text
$sel:approvalRuleName:DeletePullRequestApprovalRule' :: DeletePullRequestApprovalRule -> Text
approvalRuleName} -> Text
approvalRuleName) (\s :: DeletePullRequestApprovalRule
s@DeletePullRequestApprovalRule' {} Text
a -> DeletePullRequestApprovalRule
s {$sel:approvalRuleName:DeletePullRequestApprovalRule' :: Text
approvalRuleName = Text
a} :: DeletePullRequestApprovalRule)

instance
  Core.AWSRequest
    DeletePullRequestApprovalRule
  where
  type
    AWSResponse DeletePullRequestApprovalRule =
      DeletePullRequestApprovalRuleResponse
  request :: (Service -> Service)
-> DeletePullRequestApprovalRule
-> Request DeletePullRequestApprovalRule
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 DeletePullRequestApprovalRule
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse DeletePullRequestApprovalRule)))
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 -> Text -> DeletePullRequestApprovalRuleResponse
DeletePullRequestApprovalRuleResponse'
            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
"approvalRuleId")
      )

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

instance Prelude.NFData DeletePullRequestApprovalRule where
  rnf :: DeletePullRequestApprovalRule -> ()
rnf DeletePullRequestApprovalRule' {Text
approvalRuleName :: Text
pullRequestId :: Text
$sel:approvalRuleName:DeletePullRequestApprovalRule' :: DeletePullRequestApprovalRule -> Text
$sel:pullRequestId:DeletePullRequestApprovalRule' :: DeletePullRequestApprovalRule -> 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
approvalRuleName

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

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

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

-- | /See:/ 'newDeletePullRequestApprovalRuleResponse' smart constructor.
data DeletePullRequestApprovalRuleResponse = DeletePullRequestApprovalRuleResponse'
  { -- | The response's http status code.
    DeletePullRequestApprovalRuleResponse -> Int
httpStatus :: Prelude.Int,
    -- | The ID of the deleted approval rule.
    --
    -- If the approval rule was deleted in an earlier API call, the response is
    -- 200 OK without content.
    DeletePullRequestApprovalRuleResponse -> Text
approvalRuleId :: Prelude.Text
  }
  deriving (DeletePullRequestApprovalRuleResponse
-> DeletePullRequestApprovalRuleResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeletePullRequestApprovalRuleResponse
-> DeletePullRequestApprovalRuleResponse -> Bool
$c/= :: DeletePullRequestApprovalRuleResponse
-> DeletePullRequestApprovalRuleResponse -> Bool
== :: DeletePullRequestApprovalRuleResponse
-> DeletePullRequestApprovalRuleResponse -> Bool
$c== :: DeletePullRequestApprovalRuleResponse
-> DeletePullRequestApprovalRuleResponse -> Bool
Prelude.Eq, ReadPrec [DeletePullRequestApprovalRuleResponse]
ReadPrec DeletePullRequestApprovalRuleResponse
Int -> ReadS DeletePullRequestApprovalRuleResponse
ReadS [DeletePullRequestApprovalRuleResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeletePullRequestApprovalRuleResponse]
$creadListPrec :: ReadPrec [DeletePullRequestApprovalRuleResponse]
readPrec :: ReadPrec DeletePullRequestApprovalRuleResponse
$creadPrec :: ReadPrec DeletePullRequestApprovalRuleResponse
readList :: ReadS [DeletePullRequestApprovalRuleResponse]
$creadList :: ReadS [DeletePullRequestApprovalRuleResponse]
readsPrec :: Int -> ReadS DeletePullRequestApprovalRuleResponse
$creadsPrec :: Int -> ReadS DeletePullRequestApprovalRuleResponse
Prelude.Read, Int -> DeletePullRequestApprovalRuleResponse -> ShowS
[DeletePullRequestApprovalRuleResponse] -> ShowS
DeletePullRequestApprovalRuleResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeletePullRequestApprovalRuleResponse] -> ShowS
$cshowList :: [DeletePullRequestApprovalRuleResponse] -> ShowS
show :: DeletePullRequestApprovalRuleResponse -> String
$cshow :: DeletePullRequestApprovalRuleResponse -> String
showsPrec :: Int -> DeletePullRequestApprovalRuleResponse -> ShowS
$cshowsPrec :: Int -> DeletePullRequestApprovalRuleResponse -> ShowS
Prelude.Show, forall x.
Rep DeletePullRequestApprovalRuleResponse x
-> DeletePullRequestApprovalRuleResponse
forall x.
DeletePullRequestApprovalRuleResponse
-> Rep DeletePullRequestApprovalRuleResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DeletePullRequestApprovalRuleResponse x
-> DeletePullRequestApprovalRuleResponse
$cfrom :: forall x.
DeletePullRequestApprovalRuleResponse
-> Rep DeletePullRequestApprovalRuleResponse x
Prelude.Generic)

-- |
-- Create a value of 'DeletePullRequestApprovalRuleResponse' 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', 'deletePullRequestApprovalRuleResponse_httpStatus' - The response's http status code.
--
-- 'approvalRuleId', 'deletePullRequestApprovalRuleResponse_approvalRuleId' - The ID of the deleted approval rule.
--
-- If the approval rule was deleted in an earlier API call, the response is
-- 200 OK without content.
newDeletePullRequestApprovalRuleResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'approvalRuleId'
  Prelude.Text ->
  DeletePullRequestApprovalRuleResponse
newDeletePullRequestApprovalRuleResponse :: Int -> Text -> DeletePullRequestApprovalRuleResponse
newDeletePullRequestApprovalRuleResponse
  Int
pHttpStatus_
  Text
pApprovalRuleId_ =
    DeletePullRequestApprovalRuleResponse'
      { $sel:httpStatus:DeletePullRequestApprovalRuleResponse' :: Int
httpStatus =
          Int
pHttpStatus_,
        $sel:approvalRuleId:DeletePullRequestApprovalRuleResponse' :: Text
approvalRuleId = Text
pApprovalRuleId_
      }

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

-- | The ID of the deleted approval rule.
--
-- If the approval rule was deleted in an earlier API call, the response is
-- 200 OK without content.
deletePullRequestApprovalRuleResponse_approvalRuleId :: Lens.Lens' DeletePullRequestApprovalRuleResponse Prelude.Text
deletePullRequestApprovalRuleResponse_approvalRuleId :: Lens' DeletePullRequestApprovalRuleResponse Text
deletePullRequestApprovalRuleResponse_approvalRuleId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeletePullRequestApprovalRuleResponse' {Text
approvalRuleId :: Text
$sel:approvalRuleId:DeletePullRequestApprovalRuleResponse' :: DeletePullRequestApprovalRuleResponse -> Text
approvalRuleId} -> Text
approvalRuleId) (\s :: DeletePullRequestApprovalRuleResponse
s@DeletePullRequestApprovalRuleResponse' {} Text
a -> DeletePullRequestApprovalRuleResponse
s {$sel:approvalRuleId:DeletePullRequestApprovalRuleResponse' :: Text
approvalRuleId = Text
a} :: DeletePullRequestApprovalRuleResponse)

instance
  Prelude.NFData
    DeletePullRequestApprovalRuleResponse
  where
  rnf :: DeletePullRequestApprovalRuleResponse -> ()
rnf DeletePullRequestApprovalRuleResponse' {Int
Text
approvalRuleId :: Text
httpStatus :: Int
$sel:approvalRuleId:DeletePullRequestApprovalRuleResponse' :: DeletePullRequestApprovalRuleResponse -> Text
$sel:httpStatus:DeletePullRequestApprovalRuleResponse' :: DeletePullRequestApprovalRuleResponse -> 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 Text
approvalRuleId