{-# 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.GetGeneratedPolicy
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Retrieves the policy that was generated using @StartPolicyGeneration@.
module Amazonka.AccessAnalyzer.GetGeneratedPolicy
  ( -- * Creating a Request
    GetGeneratedPolicy (..),
    newGetGeneratedPolicy,

    -- * Request Lenses
    getGeneratedPolicy_includeResourcePlaceholders,
    getGeneratedPolicy_includeServiceLevelTemplate,
    getGeneratedPolicy_jobId,

    -- * Destructuring the Response
    GetGeneratedPolicyResponse (..),
    newGetGeneratedPolicyResponse,

    -- * Response Lenses
    getGeneratedPolicyResponse_httpStatus,
    getGeneratedPolicyResponse_jobDetails,
    getGeneratedPolicyResponse_generatedPolicyResult,
  )
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:/ 'newGetGeneratedPolicy' smart constructor.
data GetGeneratedPolicy = GetGeneratedPolicy'
  { -- | The level of detail that you want to generate. You can specify whether
    -- to generate policies with placeholders for resource ARNs for actions
    -- that support resource level granularity in policies.
    --
    -- For example, in the resource section of a policy, you can receive a
    -- placeholder such as @\"Resource\":\"arn:aws:s3:::${BucketName}\"@
    -- instead of @\"*\"@.
    GetGeneratedPolicy -> Maybe Bool
includeResourcePlaceholders :: Prelude.Maybe Prelude.Bool,
    -- | The level of detail that you want to generate. You can specify whether
    -- to generate service-level policies.
    --
    -- IAM Access Analyzer uses @iam:servicelastaccessed@ to identify services
    -- that have been used recently to create this service-level template.
    GetGeneratedPolicy -> Maybe Bool
includeServiceLevelTemplate :: Prelude.Maybe Prelude.Bool,
    -- | The @JobId@ that is returned by the @StartPolicyGeneration@ operation.
    -- The @JobId@ can be used with @GetGeneratedPolicy@ to retrieve the
    -- generated policies or used with @CancelPolicyGeneration@ to cancel the
    -- policy generation request.
    GetGeneratedPolicy -> Text
jobId :: Prelude.Text
  }
  deriving (GetGeneratedPolicy -> GetGeneratedPolicy -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetGeneratedPolicy -> GetGeneratedPolicy -> Bool
$c/= :: GetGeneratedPolicy -> GetGeneratedPolicy -> Bool
== :: GetGeneratedPolicy -> GetGeneratedPolicy -> Bool
$c== :: GetGeneratedPolicy -> GetGeneratedPolicy -> Bool
Prelude.Eq, ReadPrec [GetGeneratedPolicy]
ReadPrec GetGeneratedPolicy
Int -> ReadS GetGeneratedPolicy
ReadS [GetGeneratedPolicy]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetGeneratedPolicy]
$creadListPrec :: ReadPrec [GetGeneratedPolicy]
readPrec :: ReadPrec GetGeneratedPolicy
$creadPrec :: ReadPrec GetGeneratedPolicy
readList :: ReadS [GetGeneratedPolicy]
$creadList :: ReadS [GetGeneratedPolicy]
readsPrec :: Int -> ReadS GetGeneratedPolicy
$creadsPrec :: Int -> ReadS GetGeneratedPolicy
Prelude.Read, Int -> GetGeneratedPolicy -> ShowS
[GetGeneratedPolicy] -> ShowS
GetGeneratedPolicy -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetGeneratedPolicy] -> ShowS
$cshowList :: [GetGeneratedPolicy] -> ShowS
show :: GetGeneratedPolicy -> String
$cshow :: GetGeneratedPolicy -> String
showsPrec :: Int -> GetGeneratedPolicy -> ShowS
$cshowsPrec :: Int -> GetGeneratedPolicy -> ShowS
Prelude.Show, forall x. Rep GetGeneratedPolicy x -> GetGeneratedPolicy
forall x. GetGeneratedPolicy -> Rep GetGeneratedPolicy x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetGeneratedPolicy x -> GetGeneratedPolicy
$cfrom :: forall x. GetGeneratedPolicy -> Rep GetGeneratedPolicy x
Prelude.Generic)

-- |
-- Create a value of 'GetGeneratedPolicy' 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:
--
-- 'includeResourcePlaceholders', 'getGeneratedPolicy_includeResourcePlaceholders' - The level of detail that you want to generate. You can specify whether
-- to generate policies with placeholders for resource ARNs for actions
-- that support resource level granularity in policies.
--
-- For example, in the resource section of a policy, you can receive a
-- placeholder such as @\"Resource\":\"arn:aws:s3:::${BucketName}\"@
-- instead of @\"*\"@.
--
-- 'includeServiceLevelTemplate', 'getGeneratedPolicy_includeServiceLevelTemplate' - The level of detail that you want to generate. You can specify whether
-- to generate service-level policies.
--
-- IAM Access Analyzer uses @iam:servicelastaccessed@ to identify services
-- that have been used recently to create this service-level template.
--
-- 'jobId', 'getGeneratedPolicy_jobId' - The @JobId@ that is returned by the @StartPolicyGeneration@ operation.
-- The @JobId@ can be used with @GetGeneratedPolicy@ to retrieve the
-- generated policies or used with @CancelPolicyGeneration@ to cancel the
-- policy generation request.
newGetGeneratedPolicy ::
  -- | 'jobId'
  Prelude.Text ->
  GetGeneratedPolicy
newGetGeneratedPolicy :: Text -> GetGeneratedPolicy
newGetGeneratedPolicy Text
pJobId_ =
  GetGeneratedPolicy'
    { $sel:includeResourcePlaceholders:GetGeneratedPolicy' :: Maybe Bool
includeResourcePlaceholders =
        forall a. Maybe a
Prelude.Nothing,
      $sel:includeServiceLevelTemplate:GetGeneratedPolicy' :: Maybe Bool
includeServiceLevelTemplate = forall a. Maybe a
Prelude.Nothing,
      $sel:jobId:GetGeneratedPolicy' :: Text
jobId = Text
pJobId_
    }

-- | The level of detail that you want to generate. You can specify whether
-- to generate policies with placeholders for resource ARNs for actions
-- that support resource level granularity in policies.
--
-- For example, in the resource section of a policy, you can receive a
-- placeholder such as @\"Resource\":\"arn:aws:s3:::${BucketName}\"@
-- instead of @\"*\"@.
getGeneratedPolicy_includeResourcePlaceholders :: Lens.Lens' GetGeneratedPolicy (Prelude.Maybe Prelude.Bool)
getGeneratedPolicy_includeResourcePlaceholders :: Lens' GetGeneratedPolicy (Maybe Bool)
getGeneratedPolicy_includeResourcePlaceholders = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetGeneratedPolicy' {Maybe Bool
includeResourcePlaceholders :: Maybe Bool
$sel:includeResourcePlaceholders:GetGeneratedPolicy' :: GetGeneratedPolicy -> Maybe Bool
includeResourcePlaceholders} -> Maybe Bool
includeResourcePlaceholders) (\s :: GetGeneratedPolicy
s@GetGeneratedPolicy' {} Maybe Bool
a -> GetGeneratedPolicy
s {$sel:includeResourcePlaceholders:GetGeneratedPolicy' :: Maybe Bool
includeResourcePlaceholders = Maybe Bool
a} :: GetGeneratedPolicy)

-- | The level of detail that you want to generate. You can specify whether
-- to generate service-level policies.
--
-- IAM Access Analyzer uses @iam:servicelastaccessed@ to identify services
-- that have been used recently to create this service-level template.
getGeneratedPolicy_includeServiceLevelTemplate :: Lens.Lens' GetGeneratedPolicy (Prelude.Maybe Prelude.Bool)
getGeneratedPolicy_includeServiceLevelTemplate :: Lens' GetGeneratedPolicy (Maybe Bool)
getGeneratedPolicy_includeServiceLevelTemplate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetGeneratedPolicy' {Maybe Bool
includeServiceLevelTemplate :: Maybe Bool
$sel:includeServiceLevelTemplate:GetGeneratedPolicy' :: GetGeneratedPolicy -> Maybe Bool
includeServiceLevelTemplate} -> Maybe Bool
includeServiceLevelTemplate) (\s :: GetGeneratedPolicy
s@GetGeneratedPolicy' {} Maybe Bool
a -> GetGeneratedPolicy
s {$sel:includeServiceLevelTemplate:GetGeneratedPolicy' :: Maybe Bool
includeServiceLevelTemplate = Maybe Bool
a} :: GetGeneratedPolicy)

-- | The @JobId@ that is returned by the @StartPolicyGeneration@ operation.
-- The @JobId@ can be used with @GetGeneratedPolicy@ to retrieve the
-- generated policies or used with @CancelPolicyGeneration@ to cancel the
-- policy generation request.
getGeneratedPolicy_jobId :: Lens.Lens' GetGeneratedPolicy Prelude.Text
getGeneratedPolicy_jobId :: Lens' GetGeneratedPolicy Text
getGeneratedPolicy_jobId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetGeneratedPolicy' {Text
jobId :: Text
$sel:jobId:GetGeneratedPolicy' :: GetGeneratedPolicy -> Text
jobId} -> Text
jobId) (\s :: GetGeneratedPolicy
s@GetGeneratedPolicy' {} Text
a -> GetGeneratedPolicy
s {$sel:jobId:GetGeneratedPolicy' :: Text
jobId = Text
a} :: GetGeneratedPolicy)

instance Core.AWSRequest GetGeneratedPolicy where
  type
    AWSResponse GetGeneratedPolicy =
      GetGeneratedPolicyResponse
  request :: (Service -> Service)
-> GetGeneratedPolicy -> Request GetGeneratedPolicy
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.get (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy GetGeneratedPolicy
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse GetGeneratedPolicy)))
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
-> JobDetails
-> GeneratedPolicyResult
-> GetGeneratedPolicyResponse
GetGeneratedPolicyResponse'
            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
"jobDetails")
            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
"generatedPolicyResult")
      )

instance Prelude.Hashable GetGeneratedPolicy where
  hashWithSalt :: Int -> GetGeneratedPolicy -> Int
hashWithSalt Int
_salt GetGeneratedPolicy' {Maybe Bool
Text
jobId :: Text
includeServiceLevelTemplate :: Maybe Bool
includeResourcePlaceholders :: Maybe Bool
$sel:jobId:GetGeneratedPolicy' :: GetGeneratedPolicy -> Text
$sel:includeServiceLevelTemplate:GetGeneratedPolicy' :: GetGeneratedPolicy -> Maybe Bool
$sel:includeResourcePlaceholders:GetGeneratedPolicy' :: GetGeneratedPolicy -> Maybe Bool
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
includeResourcePlaceholders
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
includeServiceLevelTemplate
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
jobId

instance Prelude.NFData GetGeneratedPolicy where
  rnf :: GetGeneratedPolicy -> ()
rnf GetGeneratedPolicy' {Maybe Bool
Text
jobId :: Text
includeServiceLevelTemplate :: Maybe Bool
includeResourcePlaceholders :: Maybe Bool
$sel:jobId:GetGeneratedPolicy' :: GetGeneratedPolicy -> Text
$sel:includeServiceLevelTemplate:GetGeneratedPolicy' :: GetGeneratedPolicy -> Maybe Bool
$sel:includeResourcePlaceholders:GetGeneratedPolicy' :: GetGeneratedPolicy -> Maybe Bool
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
includeResourcePlaceholders
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
includeServiceLevelTemplate
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
jobId

instance Data.ToHeaders GetGeneratedPolicy where
  toHeaders :: GetGeneratedPolicy -> 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.ToPath GetGeneratedPolicy where
  toPath :: GetGeneratedPolicy -> ByteString
toPath GetGeneratedPolicy' {Maybe Bool
Text
jobId :: Text
includeServiceLevelTemplate :: Maybe Bool
includeResourcePlaceholders :: Maybe Bool
$sel:jobId:GetGeneratedPolicy' :: GetGeneratedPolicy -> Text
$sel:includeServiceLevelTemplate:GetGeneratedPolicy' :: GetGeneratedPolicy -> Maybe Bool
$sel:includeResourcePlaceholders:GetGeneratedPolicy' :: GetGeneratedPolicy -> Maybe Bool
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ByteString
"/policy/generation/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
jobId]

instance Data.ToQuery GetGeneratedPolicy where
  toQuery :: GetGeneratedPolicy -> QueryString
toQuery GetGeneratedPolicy' {Maybe Bool
Text
jobId :: Text
includeServiceLevelTemplate :: Maybe Bool
includeResourcePlaceholders :: Maybe Bool
$sel:jobId:GetGeneratedPolicy' :: GetGeneratedPolicy -> Text
$sel:includeServiceLevelTemplate:GetGeneratedPolicy' :: GetGeneratedPolicy -> Maybe Bool
$sel:includeResourcePlaceholders:GetGeneratedPolicy' :: GetGeneratedPolicy -> Maybe Bool
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"includeResourcePlaceholders"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
includeResourcePlaceholders,
        ByteString
"includeServiceLevelTemplate"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
includeServiceLevelTemplate
      ]

-- | /See:/ 'newGetGeneratedPolicyResponse' smart constructor.
data GetGeneratedPolicyResponse = GetGeneratedPolicyResponse'
  { -- | The response's http status code.
    GetGeneratedPolicyResponse -> Int
httpStatus :: Prelude.Int,
    -- | A @GeneratedPolicyDetails@ object that contains details about the
    -- generated policy.
    GetGeneratedPolicyResponse -> JobDetails
jobDetails :: JobDetails,
    -- | A @GeneratedPolicyResult@ object that contains the generated policies
    -- and associated details.
    GetGeneratedPolicyResponse -> GeneratedPolicyResult
generatedPolicyResult :: GeneratedPolicyResult
  }
  deriving (GetGeneratedPolicyResponse -> GetGeneratedPolicyResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetGeneratedPolicyResponse -> GetGeneratedPolicyResponse -> Bool
$c/= :: GetGeneratedPolicyResponse -> GetGeneratedPolicyResponse -> Bool
== :: GetGeneratedPolicyResponse -> GetGeneratedPolicyResponse -> Bool
$c== :: GetGeneratedPolicyResponse -> GetGeneratedPolicyResponse -> Bool
Prelude.Eq, ReadPrec [GetGeneratedPolicyResponse]
ReadPrec GetGeneratedPolicyResponse
Int -> ReadS GetGeneratedPolicyResponse
ReadS [GetGeneratedPolicyResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetGeneratedPolicyResponse]
$creadListPrec :: ReadPrec [GetGeneratedPolicyResponse]
readPrec :: ReadPrec GetGeneratedPolicyResponse
$creadPrec :: ReadPrec GetGeneratedPolicyResponse
readList :: ReadS [GetGeneratedPolicyResponse]
$creadList :: ReadS [GetGeneratedPolicyResponse]
readsPrec :: Int -> ReadS GetGeneratedPolicyResponse
$creadsPrec :: Int -> ReadS GetGeneratedPolicyResponse
Prelude.Read, Int -> GetGeneratedPolicyResponse -> ShowS
[GetGeneratedPolicyResponse] -> ShowS
GetGeneratedPolicyResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetGeneratedPolicyResponse] -> ShowS
$cshowList :: [GetGeneratedPolicyResponse] -> ShowS
show :: GetGeneratedPolicyResponse -> String
$cshow :: GetGeneratedPolicyResponse -> String
showsPrec :: Int -> GetGeneratedPolicyResponse -> ShowS
$cshowsPrec :: Int -> GetGeneratedPolicyResponse -> ShowS
Prelude.Show, forall x.
Rep GetGeneratedPolicyResponse x -> GetGeneratedPolicyResponse
forall x.
GetGeneratedPolicyResponse -> Rep GetGeneratedPolicyResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetGeneratedPolicyResponse x -> GetGeneratedPolicyResponse
$cfrom :: forall x.
GetGeneratedPolicyResponse -> Rep GetGeneratedPolicyResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetGeneratedPolicyResponse' 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', 'getGeneratedPolicyResponse_httpStatus' - The response's http status code.
--
-- 'jobDetails', 'getGeneratedPolicyResponse_jobDetails' - A @GeneratedPolicyDetails@ object that contains details about the
-- generated policy.
--
-- 'generatedPolicyResult', 'getGeneratedPolicyResponse_generatedPolicyResult' - A @GeneratedPolicyResult@ object that contains the generated policies
-- and associated details.
newGetGeneratedPolicyResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'jobDetails'
  JobDetails ->
  -- | 'generatedPolicyResult'
  GeneratedPolicyResult ->
  GetGeneratedPolicyResponse
newGetGeneratedPolicyResponse :: Int
-> JobDetails
-> GeneratedPolicyResult
-> GetGeneratedPolicyResponse
newGetGeneratedPolicyResponse
  Int
pHttpStatus_
  JobDetails
pJobDetails_
  GeneratedPolicyResult
pGeneratedPolicyResult_ =
    GetGeneratedPolicyResponse'
      { $sel:httpStatus:GetGeneratedPolicyResponse' :: Int
httpStatus =
          Int
pHttpStatus_,
        $sel:jobDetails:GetGeneratedPolicyResponse' :: JobDetails
jobDetails = JobDetails
pJobDetails_,
        $sel:generatedPolicyResult:GetGeneratedPolicyResponse' :: GeneratedPolicyResult
generatedPolicyResult = GeneratedPolicyResult
pGeneratedPolicyResult_
      }

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

-- | A @GeneratedPolicyDetails@ object that contains details about the
-- generated policy.
getGeneratedPolicyResponse_jobDetails :: Lens.Lens' GetGeneratedPolicyResponse JobDetails
getGeneratedPolicyResponse_jobDetails :: Lens' GetGeneratedPolicyResponse JobDetails
getGeneratedPolicyResponse_jobDetails = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetGeneratedPolicyResponse' {JobDetails
jobDetails :: JobDetails
$sel:jobDetails:GetGeneratedPolicyResponse' :: GetGeneratedPolicyResponse -> JobDetails
jobDetails} -> JobDetails
jobDetails) (\s :: GetGeneratedPolicyResponse
s@GetGeneratedPolicyResponse' {} JobDetails
a -> GetGeneratedPolicyResponse
s {$sel:jobDetails:GetGeneratedPolicyResponse' :: JobDetails
jobDetails = JobDetails
a} :: GetGeneratedPolicyResponse)

-- | A @GeneratedPolicyResult@ object that contains the generated policies
-- and associated details.
getGeneratedPolicyResponse_generatedPolicyResult :: Lens.Lens' GetGeneratedPolicyResponse GeneratedPolicyResult
getGeneratedPolicyResponse_generatedPolicyResult :: Lens' GetGeneratedPolicyResponse GeneratedPolicyResult
getGeneratedPolicyResponse_generatedPolicyResult = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetGeneratedPolicyResponse' {GeneratedPolicyResult
generatedPolicyResult :: GeneratedPolicyResult
$sel:generatedPolicyResult:GetGeneratedPolicyResponse' :: GetGeneratedPolicyResponse -> GeneratedPolicyResult
generatedPolicyResult} -> GeneratedPolicyResult
generatedPolicyResult) (\s :: GetGeneratedPolicyResponse
s@GetGeneratedPolicyResponse' {} GeneratedPolicyResult
a -> GetGeneratedPolicyResponse
s {$sel:generatedPolicyResult:GetGeneratedPolicyResponse' :: GeneratedPolicyResult
generatedPolicyResult = GeneratedPolicyResult
a} :: GetGeneratedPolicyResponse)

instance Prelude.NFData GetGeneratedPolicyResponse where
  rnf :: GetGeneratedPolicyResponse -> ()
rnf GetGeneratedPolicyResponse' {Int
JobDetails
GeneratedPolicyResult
generatedPolicyResult :: GeneratedPolicyResult
jobDetails :: JobDetails
httpStatus :: Int
$sel:generatedPolicyResult:GetGeneratedPolicyResponse' :: GetGeneratedPolicyResponse -> GeneratedPolicyResult
$sel:jobDetails:GetGeneratedPolicyResponse' :: GetGeneratedPolicyResponse -> JobDetails
$sel:httpStatus:GetGeneratedPolicyResponse' :: GetGeneratedPolicyResponse -> 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 JobDetails
jobDetails
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf GeneratedPolicyResult
generatedPolicyResult