{-# 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.Organizations.DescribeEffectivePolicy
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Returns the contents of the effective policy for specified policy type
-- and account. The effective policy is the aggregation of any policies of
-- the specified type that the account inherits, plus any policy of that
-- type that is directly attached to the account.
--
-- This operation applies only to policy types /other/ than service control
-- policies (SCPs).
--
-- For more information about policy inheritance, see
-- <https://docs.aws.amazon.com/organizations/latest/userguide/orgs_manage_policies-inheritance.html How Policy Inheritance Works>
-- in the /Organizations User Guide/.
--
-- This operation can be called only from the organization\'s management
-- account or by a member account that is a delegated administrator for an
-- Amazon Web Services service.
module Amazonka.Organizations.DescribeEffectivePolicy
  ( -- * Creating a Request
    DescribeEffectivePolicy (..),
    newDescribeEffectivePolicy,

    -- * Request Lenses
    describeEffectivePolicy_targetId,
    describeEffectivePolicy_policyType,

    -- * Destructuring the Response
    DescribeEffectivePolicyResponse (..),
    newDescribeEffectivePolicyResponse,

    -- * Response Lenses
    describeEffectivePolicyResponse_effectivePolicy,
    describeEffectivePolicyResponse_httpStatus,
  )
where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.Organizations.Types
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newDescribeEffectivePolicy' smart constructor.
data DescribeEffectivePolicy = DescribeEffectivePolicy'
  { -- | When you\'re signed in as the management account, specify the ID of the
    -- account that you want details about. Specifying an organization root or
    -- organizational unit (OU) as the target is not supported.
    DescribeEffectivePolicy -> Maybe Text
targetId :: Prelude.Maybe Prelude.Text,
    -- | The type of policy that you want information about. You can specify one
    -- of the following values:
    --
    -- -   <https://docs.aws.amazon.com/organizations/latest/userguide/orgs_manage_policies_ai-opt-out.html AISERVICES_OPT_OUT_POLICY>
    --
    -- -   <https://docs.aws.amazon.com/organizations/latest/userguide/orgs_manage_policies_backup.html BACKUP_POLICY>
    --
    -- -   <https://docs.aws.amazon.com/organizations/latest/userguide/orgs_manage_policies_tag-policies.html TAG_POLICY>
    DescribeEffectivePolicy -> EffectivePolicyType
policyType :: EffectivePolicyType
  }
  deriving (DescribeEffectivePolicy -> DescribeEffectivePolicy -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeEffectivePolicy -> DescribeEffectivePolicy -> Bool
$c/= :: DescribeEffectivePolicy -> DescribeEffectivePolicy -> Bool
== :: DescribeEffectivePolicy -> DescribeEffectivePolicy -> Bool
$c== :: DescribeEffectivePolicy -> DescribeEffectivePolicy -> Bool
Prelude.Eq, ReadPrec [DescribeEffectivePolicy]
ReadPrec DescribeEffectivePolicy
Int -> ReadS DescribeEffectivePolicy
ReadS [DescribeEffectivePolicy]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeEffectivePolicy]
$creadListPrec :: ReadPrec [DescribeEffectivePolicy]
readPrec :: ReadPrec DescribeEffectivePolicy
$creadPrec :: ReadPrec DescribeEffectivePolicy
readList :: ReadS [DescribeEffectivePolicy]
$creadList :: ReadS [DescribeEffectivePolicy]
readsPrec :: Int -> ReadS DescribeEffectivePolicy
$creadsPrec :: Int -> ReadS DescribeEffectivePolicy
Prelude.Read, Int -> DescribeEffectivePolicy -> ShowS
[DescribeEffectivePolicy] -> ShowS
DescribeEffectivePolicy -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeEffectivePolicy] -> ShowS
$cshowList :: [DescribeEffectivePolicy] -> ShowS
show :: DescribeEffectivePolicy -> String
$cshow :: DescribeEffectivePolicy -> String
showsPrec :: Int -> DescribeEffectivePolicy -> ShowS
$cshowsPrec :: Int -> DescribeEffectivePolicy -> ShowS
Prelude.Show, forall x. Rep DescribeEffectivePolicy x -> DescribeEffectivePolicy
forall x. DescribeEffectivePolicy -> Rep DescribeEffectivePolicy x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DescribeEffectivePolicy x -> DescribeEffectivePolicy
$cfrom :: forall x. DescribeEffectivePolicy -> Rep DescribeEffectivePolicy x
Prelude.Generic)

-- |
-- Create a value of 'DescribeEffectivePolicy' 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:
--
-- 'targetId', 'describeEffectivePolicy_targetId' - When you\'re signed in as the management account, specify the ID of the
-- account that you want details about. Specifying an organization root or
-- organizational unit (OU) as the target is not supported.
--
-- 'policyType', 'describeEffectivePolicy_policyType' - The type of policy that you want information about. You can specify one
-- of the following values:
--
-- -   <https://docs.aws.amazon.com/organizations/latest/userguide/orgs_manage_policies_ai-opt-out.html AISERVICES_OPT_OUT_POLICY>
--
-- -   <https://docs.aws.amazon.com/organizations/latest/userguide/orgs_manage_policies_backup.html BACKUP_POLICY>
--
-- -   <https://docs.aws.amazon.com/organizations/latest/userguide/orgs_manage_policies_tag-policies.html TAG_POLICY>
newDescribeEffectivePolicy ::
  -- | 'policyType'
  EffectivePolicyType ->
  DescribeEffectivePolicy
newDescribeEffectivePolicy :: EffectivePolicyType -> DescribeEffectivePolicy
newDescribeEffectivePolicy EffectivePolicyType
pPolicyType_ =
  DescribeEffectivePolicy'
    { $sel:targetId:DescribeEffectivePolicy' :: Maybe Text
targetId =
        forall a. Maybe a
Prelude.Nothing,
      $sel:policyType:DescribeEffectivePolicy' :: EffectivePolicyType
policyType = EffectivePolicyType
pPolicyType_
    }

-- | When you\'re signed in as the management account, specify the ID of the
-- account that you want details about. Specifying an organization root or
-- organizational unit (OU) as the target is not supported.
describeEffectivePolicy_targetId :: Lens.Lens' DescribeEffectivePolicy (Prelude.Maybe Prelude.Text)
describeEffectivePolicy_targetId :: Lens' DescribeEffectivePolicy (Maybe Text)
describeEffectivePolicy_targetId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeEffectivePolicy' {Maybe Text
targetId :: Maybe Text
$sel:targetId:DescribeEffectivePolicy' :: DescribeEffectivePolicy -> Maybe Text
targetId} -> Maybe Text
targetId) (\s :: DescribeEffectivePolicy
s@DescribeEffectivePolicy' {} Maybe Text
a -> DescribeEffectivePolicy
s {$sel:targetId:DescribeEffectivePolicy' :: Maybe Text
targetId = Maybe Text
a} :: DescribeEffectivePolicy)

-- | The type of policy that you want information about. You can specify one
-- of the following values:
--
-- -   <https://docs.aws.amazon.com/organizations/latest/userguide/orgs_manage_policies_ai-opt-out.html AISERVICES_OPT_OUT_POLICY>
--
-- -   <https://docs.aws.amazon.com/organizations/latest/userguide/orgs_manage_policies_backup.html BACKUP_POLICY>
--
-- -   <https://docs.aws.amazon.com/organizations/latest/userguide/orgs_manage_policies_tag-policies.html TAG_POLICY>
describeEffectivePolicy_policyType :: Lens.Lens' DescribeEffectivePolicy EffectivePolicyType
describeEffectivePolicy_policyType :: Lens' DescribeEffectivePolicy EffectivePolicyType
describeEffectivePolicy_policyType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeEffectivePolicy' {EffectivePolicyType
policyType :: EffectivePolicyType
$sel:policyType:DescribeEffectivePolicy' :: DescribeEffectivePolicy -> EffectivePolicyType
policyType} -> EffectivePolicyType
policyType) (\s :: DescribeEffectivePolicy
s@DescribeEffectivePolicy' {} EffectivePolicyType
a -> DescribeEffectivePolicy
s {$sel:policyType:DescribeEffectivePolicy' :: EffectivePolicyType
policyType = EffectivePolicyType
a} :: DescribeEffectivePolicy)

instance Core.AWSRequest DescribeEffectivePolicy where
  type
    AWSResponse DescribeEffectivePolicy =
      DescribeEffectivePolicyResponse
  request :: (Service -> Service)
-> DescribeEffectivePolicy -> Request DescribeEffectivePolicy
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 DescribeEffectivePolicy
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse DescribeEffectivePolicy)))
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 EffectivePolicy -> Int -> DescribeEffectivePolicyResponse
DescribeEffectivePolicyResponse'
            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
"EffectivePolicy")
            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 DescribeEffectivePolicy where
  hashWithSalt :: Int -> DescribeEffectivePolicy -> Int
hashWithSalt Int
_salt DescribeEffectivePolicy' {Maybe Text
EffectivePolicyType
policyType :: EffectivePolicyType
targetId :: Maybe Text
$sel:policyType:DescribeEffectivePolicy' :: DescribeEffectivePolicy -> EffectivePolicyType
$sel:targetId:DescribeEffectivePolicy' :: DescribeEffectivePolicy -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
targetId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` EffectivePolicyType
policyType

instance Prelude.NFData DescribeEffectivePolicy where
  rnf :: DescribeEffectivePolicy -> ()
rnf DescribeEffectivePolicy' {Maybe Text
EffectivePolicyType
policyType :: EffectivePolicyType
targetId :: Maybe Text
$sel:policyType:DescribeEffectivePolicy' :: DescribeEffectivePolicy -> EffectivePolicyType
$sel:targetId:DescribeEffectivePolicy' :: DescribeEffectivePolicy -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
targetId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf EffectivePolicyType
policyType

instance Data.ToHeaders DescribeEffectivePolicy where
  toHeaders :: DescribeEffectivePolicy -> 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
"AWSOrganizationsV20161128.DescribeEffectivePolicy" ::
                          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 DescribeEffectivePolicy where
  toJSON :: DescribeEffectivePolicy -> Value
toJSON DescribeEffectivePolicy' {Maybe Text
EffectivePolicyType
policyType :: EffectivePolicyType
targetId :: Maybe Text
$sel:policyType:DescribeEffectivePolicy' :: DescribeEffectivePolicy -> EffectivePolicyType
$sel:targetId:DescribeEffectivePolicy' :: DescribeEffectivePolicy -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"TargetId" 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
targetId,
            forall a. a -> Maybe a
Prelude.Just (Key
"PolicyType" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= EffectivePolicyType
policyType)
          ]
      )

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

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

-- | /See:/ 'newDescribeEffectivePolicyResponse' smart constructor.
data DescribeEffectivePolicyResponse = DescribeEffectivePolicyResponse'
  { -- | The contents of the effective policy.
    DescribeEffectivePolicyResponse -> Maybe EffectivePolicy
effectivePolicy :: Prelude.Maybe EffectivePolicy,
    -- | The response's http status code.
    DescribeEffectivePolicyResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (DescribeEffectivePolicyResponse
-> DescribeEffectivePolicyResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeEffectivePolicyResponse
-> DescribeEffectivePolicyResponse -> Bool
$c/= :: DescribeEffectivePolicyResponse
-> DescribeEffectivePolicyResponse -> Bool
== :: DescribeEffectivePolicyResponse
-> DescribeEffectivePolicyResponse -> Bool
$c== :: DescribeEffectivePolicyResponse
-> DescribeEffectivePolicyResponse -> Bool
Prelude.Eq, ReadPrec [DescribeEffectivePolicyResponse]
ReadPrec DescribeEffectivePolicyResponse
Int -> ReadS DescribeEffectivePolicyResponse
ReadS [DescribeEffectivePolicyResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeEffectivePolicyResponse]
$creadListPrec :: ReadPrec [DescribeEffectivePolicyResponse]
readPrec :: ReadPrec DescribeEffectivePolicyResponse
$creadPrec :: ReadPrec DescribeEffectivePolicyResponse
readList :: ReadS [DescribeEffectivePolicyResponse]
$creadList :: ReadS [DescribeEffectivePolicyResponse]
readsPrec :: Int -> ReadS DescribeEffectivePolicyResponse
$creadsPrec :: Int -> ReadS DescribeEffectivePolicyResponse
Prelude.Read, Int -> DescribeEffectivePolicyResponse -> ShowS
[DescribeEffectivePolicyResponse] -> ShowS
DescribeEffectivePolicyResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeEffectivePolicyResponse] -> ShowS
$cshowList :: [DescribeEffectivePolicyResponse] -> ShowS
show :: DescribeEffectivePolicyResponse -> String
$cshow :: DescribeEffectivePolicyResponse -> String
showsPrec :: Int -> DescribeEffectivePolicyResponse -> ShowS
$cshowsPrec :: Int -> DescribeEffectivePolicyResponse -> ShowS
Prelude.Show, forall x.
Rep DescribeEffectivePolicyResponse x
-> DescribeEffectivePolicyResponse
forall x.
DescribeEffectivePolicyResponse
-> Rep DescribeEffectivePolicyResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DescribeEffectivePolicyResponse x
-> DescribeEffectivePolicyResponse
$cfrom :: forall x.
DescribeEffectivePolicyResponse
-> Rep DescribeEffectivePolicyResponse x
Prelude.Generic)

-- |
-- Create a value of 'DescribeEffectivePolicyResponse' 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:
--
-- 'effectivePolicy', 'describeEffectivePolicyResponse_effectivePolicy' - The contents of the effective policy.
--
-- 'httpStatus', 'describeEffectivePolicyResponse_httpStatus' - The response's http status code.
newDescribeEffectivePolicyResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DescribeEffectivePolicyResponse
newDescribeEffectivePolicyResponse :: Int -> DescribeEffectivePolicyResponse
newDescribeEffectivePolicyResponse Int
pHttpStatus_ =
  DescribeEffectivePolicyResponse'
    { $sel:effectivePolicy:DescribeEffectivePolicyResponse' :: Maybe EffectivePolicy
effectivePolicy =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:DescribeEffectivePolicyResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The contents of the effective policy.
describeEffectivePolicyResponse_effectivePolicy :: Lens.Lens' DescribeEffectivePolicyResponse (Prelude.Maybe EffectivePolicy)
describeEffectivePolicyResponse_effectivePolicy :: Lens' DescribeEffectivePolicyResponse (Maybe EffectivePolicy)
describeEffectivePolicyResponse_effectivePolicy = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeEffectivePolicyResponse' {Maybe EffectivePolicy
effectivePolicy :: Maybe EffectivePolicy
$sel:effectivePolicy:DescribeEffectivePolicyResponse' :: DescribeEffectivePolicyResponse -> Maybe EffectivePolicy
effectivePolicy} -> Maybe EffectivePolicy
effectivePolicy) (\s :: DescribeEffectivePolicyResponse
s@DescribeEffectivePolicyResponse' {} Maybe EffectivePolicy
a -> DescribeEffectivePolicyResponse
s {$sel:effectivePolicy:DescribeEffectivePolicyResponse' :: Maybe EffectivePolicy
effectivePolicy = Maybe EffectivePolicy
a} :: DescribeEffectivePolicyResponse)

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

instance
  Prelude.NFData
    DescribeEffectivePolicyResponse
  where
  rnf :: DescribeEffectivePolicyResponse -> ()
rnf DescribeEffectivePolicyResponse' {Int
Maybe EffectivePolicy
httpStatus :: Int
effectivePolicy :: Maybe EffectivePolicy
$sel:httpStatus:DescribeEffectivePolicyResponse' :: DescribeEffectivePolicyResponse -> Int
$sel:effectivePolicy:DescribeEffectivePolicyResponse' :: DescribeEffectivePolicyResponse -> Maybe EffectivePolicy
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe EffectivePolicy
effectivePolicy
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus