{-# 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.UpdatePullRequestApprovalRuleContent
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Updates the structure of an approval rule created specifically for a
-- pull request. For example, you can change the number of required
-- approvers and the approval pool for approvers.
module Amazonka.CodeCommit.UpdatePullRequestApprovalRuleContent
  ( -- * Creating a Request
    UpdatePullRequestApprovalRuleContent (..),
    newUpdatePullRequestApprovalRuleContent,

    -- * Request Lenses
    updatePullRequestApprovalRuleContent_existingRuleContentSha256,
    updatePullRequestApprovalRuleContent_pullRequestId,
    updatePullRequestApprovalRuleContent_approvalRuleName,
    updatePullRequestApprovalRuleContent_newRuleContent,

    -- * Destructuring the Response
    UpdatePullRequestApprovalRuleContentResponse (..),
    newUpdatePullRequestApprovalRuleContentResponse,

    -- * Response Lenses
    updatePullRequestApprovalRuleContentResponse_httpStatus,
    updatePullRequestApprovalRuleContentResponse_approvalRule,
  )
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:/ 'newUpdatePullRequestApprovalRuleContent' smart constructor.
data UpdatePullRequestApprovalRuleContent = UpdatePullRequestApprovalRuleContent'
  { -- | The SHA-256 hash signature for the content of the approval rule. You can
    -- retrieve this information by using GetPullRequest.
    UpdatePullRequestApprovalRuleContent -> Maybe Text
existingRuleContentSha256 :: Prelude.Maybe Prelude.Text,
    -- | The system-generated ID of the pull request.
    UpdatePullRequestApprovalRuleContent -> Text
pullRequestId :: Prelude.Text,
    -- | The name of the approval rule you want to update.
    UpdatePullRequestApprovalRuleContent -> Text
approvalRuleName :: Prelude.Text,
    -- | The updated content for the approval rule.
    --
    -- When you update the content of the approval rule, you can specify
    -- approvers in an approval pool in one of two ways:
    --
    -- -   __CodeCommitApprovers__: This option only requires an AWS account
    --     and a resource. It can be used for both IAM users and federated
    --     access users whose name matches the provided resource name. This is
    --     a very powerful option that offers a great deal of flexibility. For
    --     example, if you specify the AWS account /123456789012/ and
    --     /Mary_Major/, all of the following are counted as approvals coming
    --     from that user:
    --
    --     -   An IAM user in the account
    --         (arn:aws:iam::/123456789012/:user\//Mary_Major/)
    --
    --     -   A federated user identified in IAM as Mary_Major
    --         (arn:aws:sts::/123456789012/:federated-user\//Mary_Major/)
    --
    --     This option does not recognize an active session of someone assuming
    --     the role of CodeCommitReview with a role session name of
    --     /Mary_Major/
    --     (arn:aws:sts::/123456789012/:assumed-role\/CodeCommitReview\//Mary_Major/)
    --     unless you include a wildcard (*Mary_Major).
    --
    -- -   __Fully qualified ARN__: This option allows you to specify the fully
    --     qualified Amazon Resource Name (ARN) of the IAM user or role.
    --
    -- For more information about IAM ARNs, wildcards, and formats, see
    -- <https://docs.aws.amazon.com/IAM/latest/UserGuide/reference_identifiers.html IAM Identifiers>
    -- in the /IAM User Guide/.
    UpdatePullRequestApprovalRuleContent -> Text
newRuleContent' :: Prelude.Text
  }
  deriving (UpdatePullRequestApprovalRuleContent
-> UpdatePullRequestApprovalRuleContent -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdatePullRequestApprovalRuleContent
-> UpdatePullRequestApprovalRuleContent -> Bool
$c/= :: UpdatePullRequestApprovalRuleContent
-> UpdatePullRequestApprovalRuleContent -> Bool
== :: UpdatePullRequestApprovalRuleContent
-> UpdatePullRequestApprovalRuleContent -> Bool
$c== :: UpdatePullRequestApprovalRuleContent
-> UpdatePullRequestApprovalRuleContent -> Bool
Prelude.Eq, ReadPrec [UpdatePullRequestApprovalRuleContent]
ReadPrec UpdatePullRequestApprovalRuleContent
Int -> ReadS UpdatePullRequestApprovalRuleContent
ReadS [UpdatePullRequestApprovalRuleContent]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdatePullRequestApprovalRuleContent]
$creadListPrec :: ReadPrec [UpdatePullRequestApprovalRuleContent]
readPrec :: ReadPrec UpdatePullRequestApprovalRuleContent
$creadPrec :: ReadPrec UpdatePullRequestApprovalRuleContent
readList :: ReadS [UpdatePullRequestApprovalRuleContent]
$creadList :: ReadS [UpdatePullRequestApprovalRuleContent]
readsPrec :: Int -> ReadS UpdatePullRequestApprovalRuleContent
$creadsPrec :: Int -> ReadS UpdatePullRequestApprovalRuleContent
Prelude.Read, Int -> UpdatePullRequestApprovalRuleContent -> ShowS
[UpdatePullRequestApprovalRuleContent] -> ShowS
UpdatePullRequestApprovalRuleContent -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdatePullRequestApprovalRuleContent] -> ShowS
$cshowList :: [UpdatePullRequestApprovalRuleContent] -> ShowS
show :: UpdatePullRequestApprovalRuleContent -> String
$cshow :: UpdatePullRequestApprovalRuleContent -> String
showsPrec :: Int -> UpdatePullRequestApprovalRuleContent -> ShowS
$cshowsPrec :: Int -> UpdatePullRequestApprovalRuleContent -> ShowS
Prelude.Show, forall x.
Rep UpdatePullRequestApprovalRuleContent x
-> UpdatePullRequestApprovalRuleContent
forall x.
UpdatePullRequestApprovalRuleContent
-> Rep UpdatePullRequestApprovalRuleContent x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep UpdatePullRequestApprovalRuleContent x
-> UpdatePullRequestApprovalRuleContent
$cfrom :: forall x.
UpdatePullRequestApprovalRuleContent
-> Rep UpdatePullRequestApprovalRuleContent x
Prelude.Generic)

-- |
-- Create a value of 'UpdatePullRequestApprovalRuleContent' 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:
--
-- 'existingRuleContentSha256', 'updatePullRequestApprovalRuleContent_existingRuleContentSha256' - The SHA-256 hash signature for the content of the approval rule. You can
-- retrieve this information by using GetPullRequest.
--
-- 'pullRequestId', 'updatePullRequestApprovalRuleContent_pullRequestId' - The system-generated ID of the pull request.
--
-- 'approvalRuleName', 'updatePullRequestApprovalRuleContent_approvalRuleName' - The name of the approval rule you want to update.
--
-- 'newRuleContent'', 'updatePullRequestApprovalRuleContent_newRuleContent' - The updated content for the approval rule.
--
-- When you update the content of the approval rule, you can specify
-- approvers in an approval pool in one of two ways:
--
-- -   __CodeCommitApprovers__: This option only requires an AWS account
--     and a resource. It can be used for both IAM users and federated
--     access users whose name matches the provided resource name. This is
--     a very powerful option that offers a great deal of flexibility. For
--     example, if you specify the AWS account /123456789012/ and
--     /Mary_Major/, all of the following are counted as approvals coming
--     from that user:
--
--     -   An IAM user in the account
--         (arn:aws:iam::/123456789012/:user\//Mary_Major/)
--
--     -   A federated user identified in IAM as Mary_Major
--         (arn:aws:sts::/123456789012/:federated-user\//Mary_Major/)
--
--     This option does not recognize an active session of someone assuming
--     the role of CodeCommitReview with a role session name of
--     /Mary_Major/
--     (arn:aws:sts::/123456789012/:assumed-role\/CodeCommitReview\//Mary_Major/)
--     unless you include a wildcard (*Mary_Major).
--
-- -   __Fully qualified ARN__: This option allows you to specify the fully
--     qualified Amazon Resource Name (ARN) of the IAM user or role.
--
-- For more information about IAM ARNs, wildcards, and formats, see
-- <https://docs.aws.amazon.com/IAM/latest/UserGuide/reference_identifiers.html IAM Identifiers>
-- in the /IAM User Guide/.
newUpdatePullRequestApprovalRuleContent ::
  -- | 'pullRequestId'
  Prelude.Text ->
  -- | 'approvalRuleName'
  Prelude.Text ->
  -- | 'newRuleContent''
  Prelude.Text ->
  UpdatePullRequestApprovalRuleContent
newUpdatePullRequestApprovalRuleContent :: Text -> Text -> Text -> UpdatePullRequestApprovalRuleContent
newUpdatePullRequestApprovalRuleContent
  Text
pPullRequestId_
  Text
pApprovalRuleName_
  Text
pNewRuleContent_ =
    UpdatePullRequestApprovalRuleContent'
      { $sel:existingRuleContentSha256:UpdatePullRequestApprovalRuleContent' :: Maybe Text
existingRuleContentSha256 =
          forall a. Maybe a
Prelude.Nothing,
        $sel:pullRequestId:UpdatePullRequestApprovalRuleContent' :: Text
pullRequestId = Text
pPullRequestId_,
        $sel:approvalRuleName:UpdatePullRequestApprovalRuleContent' :: Text
approvalRuleName = Text
pApprovalRuleName_,
        $sel:newRuleContent':UpdatePullRequestApprovalRuleContent' :: Text
newRuleContent' = Text
pNewRuleContent_
      }

-- | The SHA-256 hash signature for the content of the approval rule. You can
-- retrieve this information by using GetPullRequest.
updatePullRequestApprovalRuleContent_existingRuleContentSha256 :: Lens.Lens' UpdatePullRequestApprovalRuleContent (Prelude.Maybe Prelude.Text)
updatePullRequestApprovalRuleContent_existingRuleContentSha256 :: Lens' UpdatePullRequestApprovalRuleContent (Maybe Text)
updatePullRequestApprovalRuleContent_existingRuleContentSha256 = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdatePullRequestApprovalRuleContent' {Maybe Text
existingRuleContentSha256 :: Maybe Text
$sel:existingRuleContentSha256:UpdatePullRequestApprovalRuleContent' :: UpdatePullRequestApprovalRuleContent -> Maybe Text
existingRuleContentSha256} -> Maybe Text
existingRuleContentSha256) (\s :: UpdatePullRequestApprovalRuleContent
s@UpdatePullRequestApprovalRuleContent' {} Maybe Text
a -> UpdatePullRequestApprovalRuleContent
s {$sel:existingRuleContentSha256:UpdatePullRequestApprovalRuleContent' :: Maybe Text
existingRuleContentSha256 = Maybe Text
a} :: UpdatePullRequestApprovalRuleContent)

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

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

-- | The updated content for the approval rule.
--
-- When you update the content of the approval rule, you can specify
-- approvers in an approval pool in one of two ways:
--
-- -   __CodeCommitApprovers__: This option only requires an AWS account
--     and a resource. It can be used for both IAM users and federated
--     access users whose name matches the provided resource name. This is
--     a very powerful option that offers a great deal of flexibility. For
--     example, if you specify the AWS account /123456789012/ and
--     /Mary_Major/, all of the following are counted as approvals coming
--     from that user:
--
--     -   An IAM user in the account
--         (arn:aws:iam::/123456789012/:user\//Mary_Major/)
--
--     -   A federated user identified in IAM as Mary_Major
--         (arn:aws:sts::/123456789012/:federated-user\//Mary_Major/)
--
--     This option does not recognize an active session of someone assuming
--     the role of CodeCommitReview with a role session name of
--     /Mary_Major/
--     (arn:aws:sts::/123456789012/:assumed-role\/CodeCommitReview\//Mary_Major/)
--     unless you include a wildcard (*Mary_Major).
--
-- -   __Fully qualified ARN__: This option allows you to specify the fully
--     qualified Amazon Resource Name (ARN) of the IAM user or role.
--
-- For more information about IAM ARNs, wildcards, and formats, see
-- <https://docs.aws.amazon.com/IAM/latest/UserGuide/reference_identifiers.html IAM Identifiers>
-- in the /IAM User Guide/.
updatePullRequestApprovalRuleContent_newRuleContent :: Lens.Lens' UpdatePullRequestApprovalRuleContent Prelude.Text
updatePullRequestApprovalRuleContent_newRuleContent :: Lens' UpdatePullRequestApprovalRuleContent Text
updatePullRequestApprovalRuleContent_newRuleContent = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdatePullRequestApprovalRuleContent' {Text
newRuleContent' :: Text
$sel:newRuleContent':UpdatePullRequestApprovalRuleContent' :: UpdatePullRequestApprovalRuleContent -> Text
newRuleContent'} -> Text
newRuleContent') (\s :: UpdatePullRequestApprovalRuleContent
s@UpdatePullRequestApprovalRuleContent' {} Text
a -> UpdatePullRequestApprovalRuleContent
s {$sel:newRuleContent':UpdatePullRequestApprovalRuleContent' :: Text
newRuleContent' = Text
a} :: UpdatePullRequestApprovalRuleContent)

instance
  Core.AWSRequest
    UpdatePullRequestApprovalRuleContent
  where
  type
    AWSResponse UpdatePullRequestApprovalRuleContent =
      UpdatePullRequestApprovalRuleContentResponse
  request :: (Service -> Service)
-> UpdatePullRequestApprovalRuleContent
-> Request UpdatePullRequestApprovalRuleContent
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 UpdatePullRequestApprovalRuleContent
-> ClientResponse ClientBody
-> m (Either
        Error
        (ClientResponse
           (AWSResponse UpdatePullRequestApprovalRuleContent)))
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 -> ApprovalRule -> UpdatePullRequestApprovalRuleContentResponse
UpdatePullRequestApprovalRuleContentResponse'
            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
"approvalRule")
      )

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

instance
  Prelude.NFData
    UpdatePullRequestApprovalRuleContent
  where
  rnf :: UpdatePullRequestApprovalRuleContent -> ()
rnf UpdatePullRequestApprovalRuleContent' {Maybe Text
Text
newRuleContent' :: Text
approvalRuleName :: Text
pullRequestId :: Text
existingRuleContentSha256 :: Maybe Text
$sel:newRuleContent':UpdatePullRequestApprovalRuleContent' :: UpdatePullRequestApprovalRuleContent -> Text
$sel:approvalRuleName:UpdatePullRequestApprovalRuleContent' :: UpdatePullRequestApprovalRuleContent -> Text
$sel:pullRequestId:UpdatePullRequestApprovalRuleContent' :: UpdatePullRequestApprovalRuleContent -> Text
$sel:existingRuleContentSha256:UpdatePullRequestApprovalRuleContent' :: UpdatePullRequestApprovalRuleContent -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
existingRuleContentSha256
      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
approvalRuleName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
newRuleContent'

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

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

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

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

-- |
-- Create a value of 'UpdatePullRequestApprovalRuleContentResponse' 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', 'updatePullRequestApprovalRuleContentResponse_httpStatus' - The response's http status code.
--
-- 'approvalRule', 'updatePullRequestApprovalRuleContentResponse_approvalRule' - Information about the updated approval rule.
newUpdatePullRequestApprovalRuleContentResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'approvalRule'
  ApprovalRule ->
  UpdatePullRequestApprovalRuleContentResponse
newUpdatePullRequestApprovalRuleContentResponse :: Int -> ApprovalRule -> UpdatePullRequestApprovalRuleContentResponse
newUpdatePullRequestApprovalRuleContentResponse
  Int
pHttpStatus_
  ApprovalRule
pApprovalRule_ =
    UpdatePullRequestApprovalRuleContentResponse'
      { $sel:httpStatus:UpdatePullRequestApprovalRuleContentResponse' :: Int
httpStatus =
          Int
pHttpStatus_,
        $sel:approvalRule:UpdatePullRequestApprovalRuleContentResponse' :: ApprovalRule
approvalRule = ApprovalRule
pApprovalRule_
      }

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

-- | Information about the updated approval rule.
updatePullRequestApprovalRuleContentResponse_approvalRule :: Lens.Lens' UpdatePullRequestApprovalRuleContentResponse ApprovalRule
updatePullRequestApprovalRuleContentResponse_approvalRule :: Lens' UpdatePullRequestApprovalRuleContentResponse ApprovalRule
updatePullRequestApprovalRuleContentResponse_approvalRule = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdatePullRequestApprovalRuleContentResponse' {ApprovalRule
approvalRule :: ApprovalRule
$sel:approvalRule:UpdatePullRequestApprovalRuleContentResponse' :: UpdatePullRequestApprovalRuleContentResponse -> ApprovalRule
approvalRule} -> ApprovalRule
approvalRule) (\s :: UpdatePullRequestApprovalRuleContentResponse
s@UpdatePullRequestApprovalRuleContentResponse' {} ApprovalRule
a -> UpdatePullRequestApprovalRuleContentResponse
s {$sel:approvalRule:UpdatePullRequestApprovalRuleContentResponse' :: ApprovalRule
approvalRule = ApprovalRule
a} :: UpdatePullRequestApprovalRuleContentResponse)

instance
  Prelude.NFData
    UpdatePullRequestApprovalRuleContentResponse
  where
  rnf :: UpdatePullRequestApprovalRuleContentResponse -> ()
rnf UpdatePullRequestApprovalRuleContentResponse' {Int
ApprovalRule
approvalRule :: ApprovalRule
httpStatus :: Int
$sel:approvalRule:UpdatePullRequestApprovalRuleContentResponse' :: UpdatePullRequestApprovalRuleContentResponse -> ApprovalRule
$sel:httpStatus:UpdatePullRequestApprovalRuleContentResponse' :: UpdatePullRequestApprovalRuleContentResponse -> 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 ApprovalRule
approvalRule