{-# 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.AccessAnalyzer.ValidatePolicy
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Requests the validation of a policy and returns a list of findings. The
-- findings help you identify issues and provide actionable recommendations
-- to resolve the issue and enable you to author functional policies that
-- meet security best practices.
--
-- This operation returns paginated results.
module Amazonka.AccessAnalyzer.ValidatePolicy
  ( -- * Creating a Request
    ValidatePolicy (..),
    newValidatePolicy,

    -- * Request Lenses
    validatePolicy_locale,
    validatePolicy_maxResults,
    validatePolicy_nextToken,
    validatePolicy_validatePolicyResourceType,
    validatePolicy_policyDocument,
    validatePolicy_policyType,

    -- * Destructuring the Response
    ValidatePolicyResponse (..),
    newValidatePolicyResponse,

    -- * Response Lenses
    validatePolicyResponse_nextToken,
    validatePolicyResponse_httpStatus,
    validatePolicyResponse_findings,
  )
where

import Amazonka.AccessAnalyzer.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:/ 'newValidatePolicy' smart constructor.
data ValidatePolicy = ValidatePolicy'
  { -- | The locale to use for localizing the findings.
    ValidatePolicy -> Maybe Locale
locale :: Prelude.Maybe Locale,
    -- | The maximum number of results to return in the response.
    ValidatePolicy -> Maybe Int
maxResults :: Prelude.Maybe Prelude.Int,
    -- | A token used for pagination of results returned.
    ValidatePolicy -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The type of resource to attach to your resource policy. Specify a value
    -- for the policy validation resource type only if the policy type is
    -- @RESOURCE_POLICY@. For example, to validate a resource policy to attach
    -- to an Amazon S3 bucket, you can choose @AWS::S3::Bucket@ for the policy
    -- validation resource type.
    --
    -- For resource types not supported as valid values, IAM Access Analyzer
    -- runs policy checks that apply to all resource policies. For example, to
    -- validate a resource policy to attach to a KMS key, do not specify a
    -- value for the policy validation resource type and IAM Access Analyzer
    -- will run policy checks that apply to all resource policies.
    ValidatePolicy -> Maybe ValidatePolicyResourceType
validatePolicyResourceType :: Prelude.Maybe ValidatePolicyResourceType,
    -- | The JSON policy document to use as the content for the policy.
    ValidatePolicy -> Text
policyDocument :: Prelude.Text,
    -- | The type of policy to validate. Identity policies grant permissions to
    -- IAM principals. Identity policies include managed and inline policies
    -- for IAM roles, users, and groups. They also include service-control
    -- policies (SCPs) that are attached to an Amazon Web Services
    -- organization, organizational unit (OU), or an account.
    --
    -- Resource policies grant permissions on Amazon Web Services resources.
    -- Resource policies include trust policies for IAM roles and bucket
    -- policies for Amazon S3 buckets. You can provide a generic input such as
    -- identity policy or resource policy or a specific input such as managed
    -- policy or Amazon S3 bucket policy.
    ValidatePolicy -> PolicyType
policyType :: PolicyType
  }
  deriving (ValidatePolicy -> ValidatePolicy -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ValidatePolicy -> ValidatePolicy -> Bool
$c/= :: ValidatePolicy -> ValidatePolicy -> Bool
== :: ValidatePolicy -> ValidatePolicy -> Bool
$c== :: ValidatePolicy -> ValidatePolicy -> Bool
Prelude.Eq, ReadPrec [ValidatePolicy]
ReadPrec ValidatePolicy
Int -> ReadS ValidatePolicy
ReadS [ValidatePolicy]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ValidatePolicy]
$creadListPrec :: ReadPrec [ValidatePolicy]
readPrec :: ReadPrec ValidatePolicy
$creadPrec :: ReadPrec ValidatePolicy
readList :: ReadS [ValidatePolicy]
$creadList :: ReadS [ValidatePolicy]
readsPrec :: Int -> ReadS ValidatePolicy
$creadsPrec :: Int -> ReadS ValidatePolicy
Prelude.Read, Int -> ValidatePolicy -> ShowS
[ValidatePolicy] -> ShowS
ValidatePolicy -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ValidatePolicy] -> ShowS
$cshowList :: [ValidatePolicy] -> ShowS
show :: ValidatePolicy -> String
$cshow :: ValidatePolicy -> String
showsPrec :: Int -> ValidatePolicy -> ShowS
$cshowsPrec :: Int -> ValidatePolicy -> ShowS
Prelude.Show, forall x. Rep ValidatePolicy x -> ValidatePolicy
forall x. ValidatePolicy -> Rep ValidatePolicy x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ValidatePolicy x -> ValidatePolicy
$cfrom :: forall x. ValidatePolicy -> Rep ValidatePolicy x
Prelude.Generic)

-- |
-- Create a value of 'ValidatePolicy' 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:
--
-- 'locale', 'validatePolicy_locale' - The locale to use for localizing the findings.
--
-- 'maxResults', 'validatePolicy_maxResults' - The maximum number of results to return in the response.
--
-- 'nextToken', 'validatePolicy_nextToken' - A token used for pagination of results returned.
--
-- 'validatePolicyResourceType', 'validatePolicy_validatePolicyResourceType' - The type of resource to attach to your resource policy. Specify a value
-- for the policy validation resource type only if the policy type is
-- @RESOURCE_POLICY@. For example, to validate a resource policy to attach
-- to an Amazon S3 bucket, you can choose @AWS::S3::Bucket@ for the policy
-- validation resource type.
--
-- For resource types not supported as valid values, IAM Access Analyzer
-- runs policy checks that apply to all resource policies. For example, to
-- validate a resource policy to attach to a KMS key, do not specify a
-- value for the policy validation resource type and IAM Access Analyzer
-- will run policy checks that apply to all resource policies.
--
-- 'policyDocument', 'validatePolicy_policyDocument' - The JSON policy document to use as the content for the policy.
--
-- 'policyType', 'validatePolicy_policyType' - The type of policy to validate. Identity policies grant permissions to
-- IAM principals. Identity policies include managed and inline policies
-- for IAM roles, users, and groups. They also include service-control
-- policies (SCPs) that are attached to an Amazon Web Services
-- organization, organizational unit (OU), or an account.
--
-- Resource policies grant permissions on Amazon Web Services resources.
-- Resource policies include trust policies for IAM roles and bucket
-- policies for Amazon S3 buckets. You can provide a generic input such as
-- identity policy or resource policy or a specific input such as managed
-- policy or Amazon S3 bucket policy.
newValidatePolicy ::
  -- | 'policyDocument'
  Prelude.Text ->
  -- | 'policyType'
  PolicyType ->
  ValidatePolicy
newValidatePolicy :: Text -> PolicyType -> ValidatePolicy
newValidatePolicy Text
pPolicyDocument_ PolicyType
pPolicyType_ =
  ValidatePolicy'
    { $sel:locale:ValidatePolicy' :: Maybe Locale
locale = forall a. Maybe a
Prelude.Nothing,
      $sel:maxResults:ValidatePolicy' :: Maybe Int
maxResults = forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ValidatePolicy' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:validatePolicyResourceType:ValidatePolicy' :: Maybe ValidatePolicyResourceType
validatePolicyResourceType = forall a. Maybe a
Prelude.Nothing,
      $sel:policyDocument:ValidatePolicy' :: Text
policyDocument = Text
pPolicyDocument_,
      $sel:policyType:ValidatePolicy' :: PolicyType
policyType = PolicyType
pPolicyType_
    }

-- | The locale to use for localizing the findings.
validatePolicy_locale :: Lens.Lens' ValidatePolicy (Prelude.Maybe Locale)
validatePolicy_locale :: Lens' ValidatePolicy (Maybe Locale)
validatePolicy_locale = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ValidatePolicy' {Maybe Locale
locale :: Maybe Locale
$sel:locale:ValidatePolicy' :: ValidatePolicy -> Maybe Locale
locale} -> Maybe Locale
locale) (\s :: ValidatePolicy
s@ValidatePolicy' {} Maybe Locale
a -> ValidatePolicy
s {$sel:locale:ValidatePolicy' :: Maybe Locale
locale = Maybe Locale
a} :: ValidatePolicy)

-- | The maximum number of results to return in the response.
validatePolicy_maxResults :: Lens.Lens' ValidatePolicy (Prelude.Maybe Prelude.Int)
validatePolicy_maxResults :: Lens' ValidatePolicy (Maybe Int)
validatePolicy_maxResults = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ValidatePolicy' {Maybe Int
maxResults :: Maybe Int
$sel:maxResults:ValidatePolicy' :: ValidatePolicy -> Maybe Int
maxResults} -> Maybe Int
maxResults) (\s :: ValidatePolicy
s@ValidatePolicy' {} Maybe Int
a -> ValidatePolicy
s {$sel:maxResults:ValidatePolicy' :: Maybe Int
maxResults = Maybe Int
a} :: ValidatePolicy)

-- | A token used for pagination of results returned.
validatePolicy_nextToken :: Lens.Lens' ValidatePolicy (Prelude.Maybe Prelude.Text)
validatePolicy_nextToken :: Lens' ValidatePolicy (Maybe Text)
validatePolicy_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ValidatePolicy' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ValidatePolicy' :: ValidatePolicy -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ValidatePolicy
s@ValidatePolicy' {} Maybe Text
a -> ValidatePolicy
s {$sel:nextToken:ValidatePolicy' :: Maybe Text
nextToken = Maybe Text
a} :: ValidatePolicy)

-- | The type of resource to attach to your resource policy. Specify a value
-- for the policy validation resource type only if the policy type is
-- @RESOURCE_POLICY@. For example, to validate a resource policy to attach
-- to an Amazon S3 bucket, you can choose @AWS::S3::Bucket@ for the policy
-- validation resource type.
--
-- For resource types not supported as valid values, IAM Access Analyzer
-- runs policy checks that apply to all resource policies. For example, to
-- validate a resource policy to attach to a KMS key, do not specify a
-- value for the policy validation resource type and IAM Access Analyzer
-- will run policy checks that apply to all resource policies.
validatePolicy_validatePolicyResourceType :: Lens.Lens' ValidatePolicy (Prelude.Maybe ValidatePolicyResourceType)
validatePolicy_validatePolicyResourceType :: Lens' ValidatePolicy (Maybe ValidatePolicyResourceType)
validatePolicy_validatePolicyResourceType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ValidatePolicy' {Maybe ValidatePolicyResourceType
validatePolicyResourceType :: Maybe ValidatePolicyResourceType
$sel:validatePolicyResourceType:ValidatePolicy' :: ValidatePolicy -> Maybe ValidatePolicyResourceType
validatePolicyResourceType} -> Maybe ValidatePolicyResourceType
validatePolicyResourceType) (\s :: ValidatePolicy
s@ValidatePolicy' {} Maybe ValidatePolicyResourceType
a -> ValidatePolicy
s {$sel:validatePolicyResourceType:ValidatePolicy' :: Maybe ValidatePolicyResourceType
validatePolicyResourceType = Maybe ValidatePolicyResourceType
a} :: ValidatePolicy)

-- | The JSON policy document to use as the content for the policy.
validatePolicy_policyDocument :: Lens.Lens' ValidatePolicy Prelude.Text
validatePolicy_policyDocument :: Lens' ValidatePolicy Text
validatePolicy_policyDocument = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ValidatePolicy' {Text
policyDocument :: Text
$sel:policyDocument:ValidatePolicy' :: ValidatePolicy -> Text
policyDocument} -> Text
policyDocument) (\s :: ValidatePolicy
s@ValidatePolicy' {} Text
a -> ValidatePolicy
s {$sel:policyDocument:ValidatePolicy' :: Text
policyDocument = Text
a} :: ValidatePolicy)

-- | The type of policy to validate. Identity policies grant permissions to
-- IAM principals. Identity policies include managed and inline policies
-- for IAM roles, users, and groups. They also include service-control
-- policies (SCPs) that are attached to an Amazon Web Services
-- organization, organizational unit (OU), or an account.
--
-- Resource policies grant permissions on Amazon Web Services resources.
-- Resource policies include trust policies for IAM roles and bucket
-- policies for Amazon S3 buckets. You can provide a generic input such as
-- identity policy or resource policy or a specific input such as managed
-- policy or Amazon S3 bucket policy.
validatePolicy_policyType :: Lens.Lens' ValidatePolicy PolicyType
validatePolicy_policyType :: Lens' ValidatePolicy PolicyType
validatePolicy_policyType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ValidatePolicy' {PolicyType
policyType :: PolicyType
$sel:policyType:ValidatePolicy' :: ValidatePolicy -> PolicyType
policyType} -> PolicyType
policyType) (\s :: ValidatePolicy
s@ValidatePolicy' {} PolicyType
a -> ValidatePolicy
s {$sel:policyType:ValidatePolicy' :: PolicyType
policyType = PolicyType
a} :: ValidatePolicy)

instance Core.AWSPager ValidatePolicy where
  page :: ValidatePolicy
-> AWSResponse ValidatePolicy -> Maybe ValidatePolicy
page ValidatePolicy
rq AWSResponse ValidatePolicy
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse ValidatePolicy
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ValidatePolicyResponse (Maybe Text)
validatePolicyResponse_nextToken
            forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
        ) =
        forall a. Maybe a
Prelude.Nothing
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        (AWSResponse ValidatePolicy
rs forall s a. s -> Getting a s a -> a
Lens.^. Lens' ValidatePolicyResponse [ValidatePolicyFinding]
validatePolicyResponse_findings) =
        forall a. Maybe a
Prelude.Nothing
    | Bool
Prelude.otherwise =
        forall a. a -> Maybe a
Prelude.Just
          forall a b. (a -> b) -> a -> b
Prelude.$ ValidatePolicy
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' ValidatePolicy (Maybe Text)
validatePolicy_nextToken
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse ValidatePolicy
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ValidatePolicyResponse (Maybe Text)
validatePolicyResponse_nextToken
          forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just

instance Core.AWSRequest ValidatePolicy where
  type
    AWSResponse ValidatePolicy =
      ValidatePolicyResponse
  request :: (Service -> Service) -> ValidatePolicy -> Request ValidatePolicy
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 ValidatePolicy
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse ValidatePolicy)))
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 Text
-> Int -> [ValidatePolicyFinding] -> ValidatePolicyResponse
ValidatePolicyResponse'
            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
"nextToken")
            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))
            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
"findings" forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty)
      )

instance Prelude.Hashable ValidatePolicy where
  hashWithSalt :: Int -> ValidatePolicy -> Int
hashWithSalt Int
_salt ValidatePolicy' {Maybe Int
Maybe Text
Maybe Locale
Maybe ValidatePolicyResourceType
Text
PolicyType
policyType :: PolicyType
policyDocument :: Text
validatePolicyResourceType :: Maybe ValidatePolicyResourceType
nextToken :: Maybe Text
maxResults :: Maybe Int
locale :: Maybe Locale
$sel:policyType:ValidatePolicy' :: ValidatePolicy -> PolicyType
$sel:policyDocument:ValidatePolicy' :: ValidatePolicy -> Text
$sel:validatePolicyResourceType:ValidatePolicy' :: ValidatePolicy -> Maybe ValidatePolicyResourceType
$sel:nextToken:ValidatePolicy' :: ValidatePolicy -> Maybe Text
$sel:maxResults:ValidatePolicy' :: ValidatePolicy -> Maybe Int
$sel:locale:ValidatePolicy' :: ValidatePolicy -> Maybe Locale
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Locale
locale
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
maxResults
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
nextToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ValidatePolicyResourceType
validatePolicyResourceType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
policyDocument
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` PolicyType
policyType

instance Prelude.NFData ValidatePolicy where
  rnf :: ValidatePolicy -> ()
rnf ValidatePolicy' {Maybe Int
Maybe Text
Maybe Locale
Maybe ValidatePolicyResourceType
Text
PolicyType
policyType :: PolicyType
policyDocument :: Text
validatePolicyResourceType :: Maybe ValidatePolicyResourceType
nextToken :: Maybe Text
maxResults :: Maybe Int
locale :: Maybe Locale
$sel:policyType:ValidatePolicy' :: ValidatePolicy -> PolicyType
$sel:policyDocument:ValidatePolicy' :: ValidatePolicy -> Text
$sel:validatePolicyResourceType:ValidatePolicy' :: ValidatePolicy -> Maybe ValidatePolicyResourceType
$sel:nextToken:ValidatePolicy' :: ValidatePolicy -> Maybe Text
$sel:maxResults:ValidatePolicy' :: ValidatePolicy -> Maybe Int
$sel:locale:ValidatePolicy' :: ValidatePolicy -> Maybe Locale
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Locale
locale
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
maxResults
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
nextToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ValidatePolicyResourceType
validatePolicyResourceType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
policyDocument
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf PolicyType
policyType

instance Data.ToHeaders ValidatePolicy where
  toHeaders :: ValidatePolicy -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON ValidatePolicy where
  toJSON :: ValidatePolicy -> Value
toJSON ValidatePolicy' {Maybe Int
Maybe Text
Maybe Locale
Maybe ValidatePolicyResourceType
Text
PolicyType
policyType :: PolicyType
policyDocument :: Text
validatePolicyResourceType :: Maybe ValidatePolicyResourceType
nextToken :: Maybe Text
maxResults :: Maybe Int
locale :: Maybe Locale
$sel:policyType:ValidatePolicy' :: ValidatePolicy -> PolicyType
$sel:policyDocument:ValidatePolicy' :: ValidatePolicy -> Text
$sel:validatePolicyResourceType:ValidatePolicy' :: ValidatePolicy -> Maybe ValidatePolicyResourceType
$sel:nextToken:ValidatePolicy' :: ValidatePolicy -> Maybe Text
$sel:maxResults:ValidatePolicy' :: ValidatePolicy -> Maybe Int
$sel:locale:ValidatePolicy' :: ValidatePolicy -> Maybe Locale
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"locale" 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 Locale
locale,
            (Key
"validatePolicyResourceType" 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 ValidatePolicyResourceType
validatePolicyResourceType,
            forall a. a -> Maybe a
Prelude.Just
              (Key
"policyDocument" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
policyDocument),
            forall a. a -> Maybe a
Prelude.Just (Key
"policyType" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= PolicyType
policyType)
          ]
      )

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

instance Data.ToQuery ValidatePolicy where
  toQuery :: ValidatePolicy -> QueryString
toQuery ValidatePolicy' {Maybe Int
Maybe Text
Maybe Locale
Maybe ValidatePolicyResourceType
Text
PolicyType
policyType :: PolicyType
policyDocument :: Text
validatePolicyResourceType :: Maybe ValidatePolicyResourceType
nextToken :: Maybe Text
maxResults :: Maybe Int
locale :: Maybe Locale
$sel:policyType:ValidatePolicy' :: ValidatePolicy -> PolicyType
$sel:policyDocument:ValidatePolicy' :: ValidatePolicy -> Text
$sel:validatePolicyResourceType:ValidatePolicy' :: ValidatePolicy -> Maybe ValidatePolicyResourceType
$sel:nextToken:ValidatePolicy' :: ValidatePolicy -> Maybe Text
$sel:maxResults:ValidatePolicy' :: ValidatePolicy -> Maybe Int
$sel:locale:ValidatePolicy' :: ValidatePolicy -> Maybe Locale
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"maxResults" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Int
maxResults,
        ByteString
"nextToken" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
nextToken
      ]

-- | /See:/ 'newValidatePolicyResponse' smart constructor.
data ValidatePolicyResponse = ValidatePolicyResponse'
  { -- | A token used for pagination of results returned.
    ValidatePolicyResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    ValidatePolicyResponse -> Int
httpStatus :: Prelude.Int,
    -- | The list of findings in a policy returned by IAM Access Analyzer based
    -- on its suite of policy checks.
    ValidatePolicyResponse -> [ValidatePolicyFinding]
findings :: [ValidatePolicyFinding]
  }
  deriving (ValidatePolicyResponse -> ValidatePolicyResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ValidatePolicyResponse -> ValidatePolicyResponse -> Bool
$c/= :: ValidatePolicyResponse -> ValidatePolicyResponse -> Bool
== :: ValidatePolicyResponse -> ValidatePolicyResponse -> Bool
$c== :: ValidatePolicyResponse -> ValidatePolicyResponse -> Bool
Prelude.Eq, ReadPrec [ValidatePolicyResponse]
ReadPrec ValidatePolicyResponse
Int -> ReadS ValidatePolicyResponse
ReadS [ValidatePolicyResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ValidatePolicyResponse]
$creadListPrec :: ReadPrec [ValidatePolicyResponse]
readPrec :: ReadPrec ValidatePolicyResponse
$creadPrec :: ReadPrec ValidatePolicyResponse
readList :: ReadS [ValidatePolicyResponse]
$creadList :: ReadS [ValidatePolicyResponse]
readsPrec :: Int -> ReadS ValidatePolicyResponse
$creadsPrec :: Int -> ReadS ValidatePolicyResponse
Prelude.Read, Int -> ValidatePolicyResponse -> ShowS
[ValidatePolicyResponse] -> ShowS
ValidatePolicyResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ValidatePolicyResponse] -> ShowS
$cshowList :: [ValidatePolicyResponse] -> ShowS
show :: ValidatePolicyResponse -> String
$cshow :: ValidatePolicyResponse -> String
showsPrec :: Int -> ValidatePolicyResponse -> ShowS
$cshowsPrec :: Int -> ValidatePolicyResponse -> ShowS
Prelude.Show, forall x. Rep ValidatePolicyResponse x -> ValidatePolicyResponse
forall x. ValidatePolicyResponse -> Rep ValidatePolicyResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ValidatePolicyResponse x -> ValidatePolicyResponse
$cfrom :: forall x. ValidatePolicyResponse -> Rep ValidatePolicyResponse x
Prelude.Generic)

-- |
-- Create a value of 'ValidatePolicyResponse' 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:
--
-- 'nextToken', 'validatePolicyResponse_nextToken' - A token used for pagination of results returned.
--
-- 'httpStatus', 'validatePolicyResponse_httpStatus' - The response's http status code.
--
-- 'findings', 'validatePolicyResponse_findings' - The list of findings in a policy returned by IAM Access Analyzer based
-- on its suite of policy checks.
newValidatePolicyResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ValidatePolicyResponse
newValidatePolicyResponse :: Int -> ValidatePolicyResponse
newValidatePolicyResponse Int
pHttpStatus_ =
  ValidatePolicyResponse'
    { $sel:nextToken:ValidatePolicyResponse' :: Maybe Text
nextToken =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ValidatePolicyResponse' :: Int
httpStatus = Int
pHttpStatus_,
      $sel:findings:ValidatePolicyResponse' :: [ValidatePolicyFinding]
findings = forall a. Monoid a => a
Prelude.mempty
    }

-- | A token used for pagination of results returned.
validatePolicyResponse_nextToken :: Lens.Lens' ValidatePolicyResponse (Prelude.Maybe Prelude.Text)
validatePolicyResponse_nextToken :: Lens' ValidatePolicyResponse (Maybe Text)
validatePolicyResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ValidatePolicyResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ValidatePolicyResponse' :: ValidatePolicyResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ValidatePolicyResponse
s@ValidatePolicyResponse' {} Maybe Text
a -> ValidatePolicyResponse
s {$sel:nextToken:ValidatePolicyResponse' :: Maybe Text
nextToken = Maybe Text
a} :: ValidatePolicyResponse)

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

-- | The list of findings in a policy returned by IAM Access Analyzer based
-- on its suite of policy checks.
validatePolicyResponse_findings :: Lens.Lens' ValidatePolicyResponse [ValidatePolicyFinding]
validatePolicyResponse_findings :: Lens' ValidatePolicyResponse [ValidatePolicyFinding]
validatePolicyResponse_findings = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ValidatePolicyResponse' {[ValidatePolicyFinding]
findings :: [ValidatePolicyFinding]
$sel:findings:ValidatePolicyResponse' :: ValidatePolicyResponse -> [ValidatePolicyFinding]
findings} -> [ValidatePolicyFinding]
findings) (\s :: ValidatePolicyResponse
s@ValidatePolicyResponse' {} [ValidatePolicyFinding]
a -> ValidatePolicyResponse
s {$sel:findings:ValidatePolicyResponse' :: [ValidatePolicyFinding]
findings = [ValidatePolicyFinding]
a} :: ValidatePolicyResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

instance Prelude.NFData ValidatePolicyResponse where
  rnf :: ValidatePolicyResponse -> ()
rnf ValidatePolicyResponse' {Int
[ValidatePolicyFinding]
Maybe Text
findings :: [ValidatePolicyFinding]
httpStatus :: Int
nextToken :: Maybe Text
$sel:findings:ValidatePolicyResponse' :: ValidatePolicyResponse -> [ValidatePolicyFinding]
$sel:httpStatus:ValidatePolicyResponse' :: ValidatePolicyResponse -> Int
$sel:nextToken:ValidatePolicyResponse' :: ValidatePolicyResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
nextToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` 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 [ValidatePolicyFinding]
findings