{-# 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.SecretsManager.ValidateResourcePolicy
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Validates that a resource policy does not grant a wide range of
-- principals access to your secret. A resource-based policy is optional
-- for secrets.
--
-- The API performs three checks when validating the policy:
--
-- -   Sends a call to
--     <https://aws.amazon.com/blogs/security/protect-sensitive-data-in-the-cloud-with-automated-reasoning-zelkova/ Zelkova>,
--     an automated reasoning engine, to ensure your resource policy does
--     not allow broad access to your secret, for example policies that use
--     a wildcard for the principal.
--
-- -   Checks for correct syntax in a policy.
--
-- -   Verifies the policy does not lock out a caller.
--
-- Secrets Manager generates a CloudTrail log entry when you call this
-- action. Do not include sensitive information in request parameters
-- because it might be logged. For more information, see
-- <https://docs.aws.amazon.com/secretsmanager/latest/userguide/retrieve-ct-entries.html Logging Secrets Manager events with CloudTrail>.
--
-- __Required permissions:__ @secretsmanager:ValidateResourcePolicy@. For
-- more information, see
-- <https://docs.aws.amazon.com/secretsmanager/latest/userguide/reference_iam-permissions.html#reference_iam-permissions_actions IAM policy actions for Secrets Manager>
-- and
-- <https://docs.aws.amazon.com/secretsmanager/latest/userguide/auth-and-access.html Authentication and access control in Secrets Manager>.
module Amazonka.SecretsManager.ValidateResourcePolicy
  ( -- * Creating a Request
    ValidateResourcePolicy (..),
    newValidateResourcePolicy,

    -- * Request Lenses
    validateResourcePolicy_secretId,
    validateResourcePolicy_resourcePolicy,

    -- * Destructuring the Response
    ValidateResourcePolicyResponse (..),
    newValidateResourcePolicyResponse,

    -- * Response Lenses
    validateResourcePolicyResponse_policyValidationPassed,
    validateResourcePolicyResponse_validationErrors,
    validateResourcePolicyResponse_httpStatus,
  )
where

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
import Amazonka.SecretsManager.Types

-- | /See:/ 'newValidateResourcePolicy' smart constructor.
data ValidateResourcePolicy = ValidateResourcePolicy'
  { -- | This field is reserved for internal use.
    ValidateResourcePolicy -> Maybe Text
secretId :: Prelude.Maybe Prelude.Text,
    -- | A JSON-formatted string that contains an Amazon Web Services
    -- resource-based policy. The policy in the string identifies who can
    -- access or manage this secret and its versions. For example policies, see
    -- <https://docs.aws.amazon.com/secretsmanager/latest/userguide/auth-and-access_examples.html Permissions policy examples>.
    ValidateResourcePolicy -> Text
resourcePolicy :: Prelude.Text
  }
  deriving (ValidateResourcePolicy -> ValidateResourcePolicy -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ValidateResourcePolicy -> ValidateResourcePolicy -> Bool
$c/= :: ValidateResourcePolicy -> ValidateResourcePolicy -> Bool
== :: ValidateResourcePolicy -> ValidateResourcePolicy -> Bool
$c== :: ValidateResourcePolicy -> ValidateResourcePolicy -> Bool
Prelude.Eq, ReadPrec [ValidateResourcePolicy]
ReadPrec ValidateResourcePolicy
Int -> ReadS ValidateResourcePolicy
ReadS [ValidateResourcePolicy]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ValidateResourcePolicy]
$creadListPrec :: ReadPrec [ValidateResourcePolicy]
readPrec :: ReadPrec ValidateResourcePolicy
$creadPrec :: ReadPrec ValidateResourcePolicy
readList :: ReadS [ValidateResourcePolicy]
$creadList :: ReadS [ValidateResourcePolicy]
readsPrec :: Int -> ReadS ValidateResourcePolicy
$creadsPrec :: Int -> ReadS ValidateResourcePolicy
Prelude.Read, Int -> ValidateResourcePolicy -> ShowS
[ValidateResourcePolicy] -> ShowS
ValidateResourcePolicy -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ValidateResourcePolicy] -> ShowS
$cshowList :: [ValidateResourcePolicy] -> ShowS
show :: ValidateResourcePolicy -> String
$cshow :: ValidateResourcePolicy -> String
showsPrec :: Int -> ValidateResourcePolicy -> ShowS
$cshowsPrec :: Int -> ValidateResourcePolicy -> ShowS
Prelude.Show, forall x. Rep ValidateResourcePolicy x -> ValidateResourcePolicy
forall x. ValidateResourcePolicy -> Rep ValidateResourcePolicy x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ValidateResourcePolicy x -> ValidateResourcePolicy
$cfrom :: forall x. ValidateResourcePolicy -> Rep ValidateResourcePolicy x
Prelude.Generic)

-- |
-- Create a value of 'ValidateResourcePolicy' 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:
--
-- 'secretId', 'validateResourcePolicy_secretId' - This field is reserved for internal use.
--
-- 'resourcePolicy', 'validateResourcePolicy_resourcePolicy' - A JSON-formatted string that contains an Amazon Web Services
-- resource-based policy. The policy in the string identifies who can
-- access or manage this secret and its versions. For example policies, see
-- <https://docs.aws.amazon.com/secretsmanager/latest/userguide/auth-and-access_examples.html Permissions policy examples>.
newValidateResourcePolicy ::
  -- | 'resourcePolicy'
  Prelude.Text ->
  ValidateResourcePolicy
newValidateResourcePolicy :: Text -> ValidateResourcePolicy
newValidateResourcePolicy Text
pResourcePolicy_ =
  ValidateResourcePolicy'
    { $sel:secretId:ValidateResourcePolicy' :: Maybe Text
secretId = forall a. Maybe a
Prelude.Nothing,
      $sel:resourcePolicy:ValidateResourcePolicy' :: Text
resourcePolicy = Text
pResourcePolicy_
    }

-- | This field is reserved for internal use.
validateResourcePolicy_secretId :: Lens.Lens' ValidateResourcePolicy (Prelude.Maybe Prelude.Text)
validateResourcePolicy_secretId :: Lens' ValidateResourcePolicy (Maybe Text)
validateResourcePolicy_secretId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ValidateResourcePolicy' {Maybe Text
secretId :: Maybe Text
$sel:secretId:ValidateResourcePolicy' :: ValidateResourcePolicy -> Maybe Text
secretId} -> Maybe Text
secretId) (\s :: ValidateResourcePolicy
s@ValidateResourcePolicy' {} Maybe Text
a -> ValidateResourcePolicy
s {$sel:secretId:ValidateResourcePolicy' :: Maybe Text
secretId = Maybe Text
a} :: ValidateResourcePolicy)

-- | A JSON-formatted string that contains an Amazon Web Services
-- resource-based policy. The policy in the string identifies who can
-- access or manage this secret and its versions. For example policies, see
-- <https://docs.aws.amazon.com/secretsmanager/latest/userguide/auth-and-access_examples.html Permissions policy examples>.
validateResourcePolicy_resourcePolicy :: Lens.Lens' ValidateResourcePolicy Prelude.Text
validateResourcePolicy_resourcePolicy :: Lens' ValidateResourcePolicy Text
validateResourcePolicy_resourcePolicy = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ValidateResourcePolicy' {Text
resourcePolicy :: Text
$sel:resourcePolicy:ValidateResourcePolicy' :: ValidateResourcePolicy -> Text
resourcePolicy} -> Text
resourcePolicy) (\s :: ValidateResourcePolicy
s@ValidateResourcePolicy' {} Text
a -> ValidateResourcePolicy
s {$sel:resourcePolicy:ValidateResourcePolicy' :: Text
resourcePolicy = Text
a} :: ValidateResourcePolicy)

instance Core.AWSRequest ValidateResourcePolicy where
  type
    AWSResponse ValidateResourcePolicy =
      ValidateResourcePolicyResponse
  request :: (Service -> Service)
-> ValidateResourcePolicy -> Request ValidateResourcePolicy
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 ValidateResourcePolicy
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse ValidateResourcePolicy)))
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 ->
          Maybe Bool
-> Maybe [ValidationErrorsEntry]
-> Int
-> ValidateResourcePolicyResponse
ValidateResourcePolicyResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"PolicyValidationPassed")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ( Object
x
                            forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"ValidationErrors"
                            forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty
                        )
            forall (f :: * -> *) a b. Applicative f => 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))
      )

instance Prelude.Hashable ValidateResourcePolicy where
  hashWithSalt :: Int -> ValidateResourcePolicy -> Int
hashWithSalt Int
_salt ValidateResourcePolicy' {Maybe Text
Text
resourcePolicy :: Text
secretId :: Maybe Text
$sel:resourcePolicy:ValidateResourcePolicy' :: ValidateResourcePolicy -> Text
$sel:secretId:ValidateResourcePolicy' :: ValidateResourcePolicy -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
secretId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
resourcePolicy

instance Prelude.NFData ValidateResourcePolicy where
  rnf :: ValidateResourcePolicy -> ()
rnf ValidateResourcePolicy' {Maybe Text
Text
resourcePolicy :: Text
secretId :: Maybe Text
$sel:resourcePolicy:ValidateResourcePolicy' :: ValidateResourcePolicy -> Text
$sel:secretId:ValidateResourcePolicy' :: ValidateResourcePolicy -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
secretId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
resourcePolicy

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

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

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

-- | /See:/ 'newValidateResourcePolicyResponse' smart constructor.
data ValidateResourcePolicyResponse = ValidateResourcePolicyResponse'
  { -- | True if your policy passes validation, otherwise false.
    ValidateResourcePolicyResponse -> Maybe Bool
policyValidationPassed :: Prelude.Maybe Prelude.Bool,
    -- | Validation errors if your policy didn\'t pass validation.
    ValidateResourcePolicyResponse -> Maybe [ValidationErrorsEntry]
validationErrors :: Prelude.Maybe [ValidationErrorsEntry],
    -- | The response's http status code.
    ValidateResourcePolicyResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ValidateResourcePolicyResponse
-> ValidateResourcePolicyResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ValidateResourcePolicyResponse
-> ValidateResourcePolicyResponse -> Bool
$c/= :: ValidateResourcePolicyResponse
-> ValidateResourcePolicyResponse -> Bool
== :: ValidateResourcePolicyResponse
-> ValidateResourcePolicyResponse -> Bool
$c== :: ValidateResourcePolicyResponse
-> ValidateResourcePolicyResponse -> Bool
Prelude.Eq, ReadPrec [ValidateResourcePolicyResponse]
ReadPrec ValidateResourcePolicyResponse
Int -> ReadS ValidateResourcePolicyResponse
ReadS [ValidateResourcePolicyResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ValidateResourcePolicyResponse]
$creadListPrec :: ReadPrec [ValidateResourcePolicyResponse]
readPrec :: ReadPrec ValidateResourcePolicyResponse
$creadPrec :: ReadPrec ValidateResourcePolicyResponse
readList :: ReadS [ValidateResourcePolicyResponse]
$creadList :: ReadS [ValidateResourcePolicyResponse]
readsPrec :: Int -> ReadS ValidateResourcePolicyResponse
$creadsPrec :: Int -> ReadS ValidateResourcePolicyResponse
Prelude.Read, Int -> ValidateResourcePolicyResponse -> ShowS
[ValidateResourcePolicyResponse] -> ShowS
ValidateResourcePolicyResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ValidateResourcePolicyResponse] -> ShowS
$cshowList :: [ValidateResourcePolicyResponse] -> ShowS
show :: ValidateResourcePolicyResponse -> String
$cshow :: ValidateResourcePolicyResponse -> String
showsPrec :: Int -> ValidateResourcePolicyResponse -> ShowS
$cshowsPrec :: Int -> ValidateResourcePolicyResponse -> ShowS
Prelude.Show, forall x.
Rep ValidateResourcePolicyResponse x
-> ValidateResourcePolicyResponse
forall x.
ValidateResourcePolicyResponse
-> Rep ValidateResourcePolicyResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ValidateResourcePolicyResponse x
-> ValidateResourcePolicyResponse
$cfrom :: forall x.
ValidateResourcePolicyResponse
-> Rep ValidateResourcePolicyResponse x
Prelude.Generic)

-- |
-- Create a value of 'ValidateResourcePolicyResponse' 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:
--
-- 'policyValidationPassed', 'validateResourcePolicyResponse_policyValidationPassed' - True if your policy passes validation, otherwise false.
--
-- 'validationErrors', 'validateResourcePolicyResponse_validationErrors' - Validation errors if your policy didn\'t pass validation.
--
-- 'httpStatus', 'validateResourcePolicyResponse_httpStatus' - The response's http status code.
newValidateResourcePolicyResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ValidateResourcePolicyResponse
newValidateResourcePolicyResponse :: Int -> ValidateResourcePolicyResponse
newValidateResourcePolicyResponse Int
pHttpStatus_ =
  ValidateResourcePolicyResponse'
    { $sel:policyValidationPassed:ValidateResourcePolicyResponse' :: Maybe Bool
policyValidationPassed =
        forall a. Maybe a
Prelude.Nothing,
      $sel:validationErrors:ValidateResourcePolicyResponse' :: Maybe [ValidationErrorsEntry]
validationErrors = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ValidateResourcePolicyResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | True if your policy passes validation, otherwise false.
validateResourcePolicyResponse_policyValidationPassed :: Lens.Lens' ValidateResourcePolicyResponse (Prelude.Maybe Prelude.Bool)
validateResourcePolicyResponse_policyValidationPassed :: Lens' ValidateResourcePolicyResponse (Maybe Bool)
validateResourcePolicyResponse_policyValidationPassed = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ValidateResourcePolicyResponse' {Maybe Bool
policyValidationPassed :: Maybe Bool
$sel:policyValidationPassed:ValidateResourcePolicyResponse' :: ValidateResourcePolicyResponse -> Maybe Bool
policyValidationPassed} -> Maybe Bool
policyValidationPassed) (\s :: ValidateResourcePolicyResponse
s@ValidateResourcePolicyResponse' {} Maybe Bool
a -> ValidateResourcePolicyResponse
s {$sel:policyValidationPassed:ValidateResourcePolicyResponse' :: Maybe Bool
policyValidationPassed = Maybe Bool
a} :: ValidateResourcePolicyResponse)

-- | Validation errors if your policy didn\'t pass validation.
validateResourcePolicyResponse_validationErrors :: Lens.Lens' ValidateResourcePolicyResponse (Prelude.Maybe [ValidationErrorsEntry])
validateResourcePolicyResponse_validationErrors :: Lens'
  ValidateResourcePolicyResponse (Maybe [ValidationErrorsEntry])
validateResourcePolicyResponse_validationErrors = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ValidateResourcePolicyResponse' {Maybe [ValidationErrorsEntry]
validationErrors :: Maybe [ValidationErrorsEntry]
$sel:validationErrors:ValidateResourcePolicyResponse' :: ValidateResourcePolicyResponse -> Maybe [ValidationErrorsEntry]
validationErrors} -> Maybe [ValidationErrorsEntry]
validationErrors) (\s :: ValidateResourcePolicyResponse
s@ValidateResourcePolicyResponse' {} Maybe [ValidationErrorsEntry]
a -> ValidateResourcePolicyResponse
s {$sel:validationErrors:ValidateResourcePolicyResponse' :: Maybe [ValidationErrorsEntry]
validationErrors = Maybe [ValidationErrorsEntry]
a} :: ValidateResourcePolicyResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

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

instance
  Prelude.NFData
    ValidateResourcePolicyResponse
  where
  rnf :: ValidateResourcePolicyResponse -> ()
rnf ValidateResourcePolicyResponse' {Int
Maybe Bool
Maybe [ValidationErrorsEntry]
httpStatus :: Int
validationErrors :: Maybe [ValidationErrorsEntry]
policyValidationPassed :: Maybe Bool
$sel:httpStatus:ValidateResourcePolicyResponse' :: ValidateResourcePolicyResponse -> Int
$sel:validationErrors:ValidateResourcePolicyResponse' :: ValidateResourcePolicyResponse -> Maybe [ValidationErrorsEntry]
$sel:policyValidationPassed:ValidateResourcePolicyResponse' :: ValidateResourcePolicyResponse -> Maybe Bool
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
policyValidationPassed
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [ValidationErrorsEntry]
validationErrors
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus