{-# 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.Config.PutOrganizationConfigRule
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Adds or updates an Config rule for your entire organization to evaluate
-- if your Amazon Web Services resources comply with your desired
-- configurations. For information on how many organization Config rules
-- you can have per account, see
-- <https://docs.aws.amazon.com/config/latest/developerguide/configlimits.html Service Limits>
-- in the /Config Developer Guide/.
--
-- Only a management account and a delegated administrator can create or
-- update an organization Config rule. When calling this API with a
-- delegated administrator, you must ensure Organizations
-- @ListDelegatedAdministrator@ permissions are added. An organization can
-- have up to 3 delegated administrators.
--
-- This API enables organization service access through the
-- @EnableAWSServiceAccess@ action and creates a service-linked role
-- @AWSServiceRoleForConfigMultiAccountSetup@ in the management or
-- delegated administrator account of your organization. The service-linked
-- role is created only when the role does not exist in the caller account.
-- Config verifies the existence of role with @GetRole@ action.
--
-- To use this API with delegated administrator, register a delegated
-- administrator by calling Amazon Web Services Organization
-- @register-delegated-administrator@ for
-- @config-multiaccountsetup.amazonaws.com@.
--
-- There are two types of rules: Config Custom Rules and Config Managed
-- Rules. You can use @PutOrganizationConfigRule@ to create both Config
-- custom rules and Config managed rules.
--
-- Custom rules are rules that you can create using either Guard or Lambda
-- functions. Guard
-- (<https://github.com/aws-cloudformation/cloudformation-guard Guard GitHub Repository>)
-- is a policy-as-code language that allows you to write policies that are
-- enforced by Config Custom Policy rules. Lambda uses custom code that you
-- upload to evaluate a custom rule. If you are adding a new Custom Lambda
-- rule, you first need to create an Lambda function in the management
-- account or a delegated administrator that the rule invokes to evaluate
-- your resources. You also need to create an IAM role in the managed
-- account that can be assumed by the Lambda function. When you use
-- @PutOrganizationConfigRule@ to add a Custom Lambda rule to Config, you
-- must specify the Amazon Resource Name (ARN) that Lambda assigns to the
-- function.
--
-- Managed rules are predefined, customizable rules created by Config. For
-- a list of managed rules, see
-- <https://docs.aws.amazon.com/config/latest/developerguide/managed-rules-by-aws-config.html List of Config Managed Rules>.
-- If you are adding an Config managed rule, you must specify the rule\'s
-- identifier for the @RuleIdentifier@ key.
--
-- Prerequisite: Ensure you call @EnableAllFeatures@ API to enable all
-- features in an organization.
--
-- Make sure to specify one of either
-- @OrganizationCustomPolicyRuleMetadata@ for Custom Policy rules,
-- @OrganizationCustomRuleMetadata@ for Custom Lambda rules, or
-- @OrganizationManagedRuleMetadata@ for managed rules.
module Amazonka.Config.PutOrganizationConfigRule
  ( -- * Creating a Request
    PutOrganizationConfigRule (..),
    newPutOrganizationConfigRule,

    -- * Request Lenses
    putOrganizationConfigRule_excludedAccounts,
    putOrganizationConfigRule_organizationCustomPolicyRuleMetadata,
    putOrganizationConfigRule_organizationCustomRuleMetadata,
    putOrganizationConfigRule_organizationManagedRuleMetadata,
    putOrganizationConfigRule_organizationConfigRuleName,

    -- * Destructuring the Response
    PutOrganizationConfigRuleResponse (..),
    newPutOrganizationConfigRuleResponse,

    -- * Response Lenses
    putOrganizationConfigRuleResponse_organizationConfigRuleArn,
    putOrganizationConfigRuleResponse_httpStatus,
  )
where

import Amazonka.Config.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:/ 'newPutOrganizationConfigRule' smart constructor.
data PutOrganizationConfigRule = PutOrganizationConfigRule'
  { -- | A comma-separated list of accounts that you want to exclude from an
    -- organization Config rule.
    PutOrganizationConfigRule -> Maybe [Text]
excludedAccounts :: Prelude.Maybe [Prelude.Text],
    -- | An @OrganizationCustomPolicyRuleMetadata@ object. This object specifies
    -- metadata for your organization\'s Config Custom Policy rule. The
    -- metadata includes the runtime system in use, which accounts have debug
    -- logging enabled, and other custom rule metadata, such as resource type,
    -- resource ID of Amazon Web Services resource, and organization trigger
    -- types that initiate Config to evaluate Amazon Web Services resources
    -- against a rule.
    PutOrganizationConfigRule
-> Maybe OrganizationCustomPolicyRuleMetadata
organizationCustomPolicyRuleMetadata :: Prelude.Maybe OrganizationCustomPolicyRuleMetadata,
    -- | An @OrganizationCustomRuleMetadata@ object. This object specifies
    -- organization custom rule metadata such as resource type, resource ID of
    -- Amazon Web Services resource, Lambda function ARN, and organization
    -- trigger types that trigger Config to evaluate your Amazon Web Services
    -- resources against a rule. It also provides the frequency with which you
    -- want Config to run evaluations for the rule if the trigger type is
    -- periodic.
    PutOrganizationConfigRule -> Maybe OrganizationCustomRuleMetadata
organizationCustomRuleMetadata :: Prelude.Maybe OrganizationCustomRuleMetadata,
    -- | An @OrganizationManagedRuleMetadata@ object. This object specifies
    -- organization managed rule metadata such as resource type and ID of
    -- Amazon Web Services resource along with the rule identifier. It also
    -- provides the frequency with which you want Config to run evaluations for
    -- the rule if the trigger type is periodic.
    PutOrganizationConfigRule -> Maybe OrganizationManagedRuleMetadata
organizationManagedRuleMetadata :: Prelude.Maybe OrganizationManagedRuleMetadata,
    -- | The name that you assign to an organization Config rule.
    PutOrganizationConfigRule -> Text
organizationConfigRuleName :: Prelude.Text
  }
  deriving (PutOrganizationConfigRule -> PutOrganizationConfigRule -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PutOrganizationConfigRule -> PutOrganizationConfigRule -> Bool
$c/= :: PutOrganizationConfigRule -> PutOrganizationConfigRule -> Bool
== :: PutOrganizationConfigRule -> PutOrganizationConfigRule -> Bool
$c== :: PutOrganizationConfigRule -> PutOrganizationConfigRule -> Bool
Prelude.Eq, ReadPrec [PutOrganizationConfigRule]
ReadPrec PutOrganizationConfigRule
Int -> ReadS PutOrganizationConfigRule
ReadS [PutOrganizationConfigRule]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PutOrganizationConfigRule]
$creadListPrec :: ReadPrec [PutOrganizationConfigRule]
readPrec :: ReadPrec PutOrganizationConfigRule
$creadPrec :: ReadPrec PutOrganizationConfigRule
readList :: ReadS [PutOrganizationConfigRule]
$creadList :: ReadS [PutOrganizationConfigRule]
readsPrec :: Int -> ReadS PutOrganizationConfigRule
$creadsPrec :: Int -> ReadS PutOrganizationConfigRule
Prelude.Read, Int -> PutOrganizationConfigRule -> ShowS
[PutOrganizationConfigRule] -> ShowS
PutOrganizationConfigRule -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PutOrganizationConfigRule] -> ShowS
$cshowList :: [PutOrganizationConfigRule] -> ShowS
show :: PutOrganizationConfigRule -> String
$cshow :: PutOrganizationConfigRule -> String
showsPrec :: Int -> PutOrganizationConfigRule -> ShowS
$cshowsPrec :: Int -> PutOrganizationConfigRule -> ShowS
Prelude.Show, forall x.
Rep PutOrganizationConfigRule x -> PutOrganizationConfigRule
forall x.
PutOrganizationConfigRule -> Rep PutOrganizationConfigRule x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep PutOrganizationConfigRule x -> PutOrganizationConfigRule
$cfrom :: forall x.
PutOrganizationConfigRule -> Rep PutOrganizationConfigRule x
Prelude.Generic)

-- |
-- Create a value of 'PutOrganizationConfigRule' 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:
--
-- 'excludedAccounts', 'putOrganizationConfigRule_excludedAccounts' - A comma-separated list of accounts that you want to exclude from an
-- organization Config rule.
--
-- 'organizationCustomPolicyRuleMetadata', 'putOrganizationConfigRule_organizationCustomPolicyRuleMetadata' - An @OrganizationCustomPolicyRuleMetadata@ object. This object specifies
-- metadata for your organization\'s Config Custom Policy rule. The
-- metadata includes the runtime system in use, which accounts have debug
-- logging enabled, and other custom rule metadata, such as resource type,
-- resource ID of Amazon Web Services resource, and organization trigger
-- types that initiate Config to evaluate Amazon Web Services resources
-- against a rule.
--
-- 'organizationCustomRuleMetadata', 'putOrganizationConfigRule_organizationCustomRuleMetadata' - An @OrganizationCustomRuleMetadata@ object. This object specifies
-- organization custom rule metadata such as resource type, resource ID of
-- Amazon Web Services resource, Lambda function ARN, and organization
-- trigger types that trigger Config to evaluate your Amazon Web Services
-- resources against a rule. It also provides the frequency with which you
-- want Config to run evaluations for the rule if the trigger type is
-- periodic.
--
-- 'organizationManagedRuleMetadata', 'putOrganizationConfigRule_organizationManagedRuleMetadata' - An @OrganizationManagedRuleMetadata@ object. This object specifies
-- organization managed rule metadata such as resource type and ID of
-- Amazon Web Services resource along with the rule identifier. It also
-- provides the frequency with which you want Config to run evaluations for
-- the rule if the trigger type is periodic.
--
-- 'organizationConfigRuleName', 'putOrganizationConfigRule_organizationConfigRuleName' - The name that you assign to an organization Config rule.
newPutOrganizationConfigRule ::
  -- | 'organizationConfigRuleName'
  Prelude.Text ->
  PutOrganizationConfigRule
newPutOrganizationConfigRule :: Text -> PutOrganizationConfigRule
newPutOrganizationConfigRule
  Text
pOrganizationConfigRuleName_ =
    PutOrganizationConfigRule'
      { $sel:excludedAccounts:PutOrganizationConfigRule' :: Maybe [Text]
excludedAccounts =
          forall a. Maybe a
Prelude.Nothing,
        $sel:organizationCustomPolicyRuleMetadata:PutOrganizationConfigRule' :: Maybe OrganizationCustomPolicyRuleMetadata
organizationCustomPolicyRuleMetadata =
          forall a. Maybe a
Prelude.Nothing,
        $sel:organizationCustomRuleMetadata:PutOrganizationConfigRule' :: Maybe OrganizationCustomRuleMetadata
organizationCustomRuleMetadata = forall a. Maybe a
Prelude.Nothing,
        $sel:organizationManagedRuleMetadata:PutOrganizationConfigRule' :: Maybe OrganizationManagedRuleMetadata
organizationManagedRuleMetadata =
          forall a. Maybe a
Prelude.Nothing,
        $sel:organizationConfigRuleName:PutOrganizationConfigRule' :: Text
organizationConfigRuleName =
          Text
pOrganizationConfigRuleName_
      }

-- | A comma-separated list of accounts that you want to exclude from an
-- organization Config rule.
putOrganizationConfigRule_excludedAccounts :: Lens.Lens' PutOrganizationConfigRule (Prelude.Maybe [Prelude.Text])
putOrganizationConfigRule_excludedAccounts :: Lens' PutOrganizationConfigRule (Maybe [Text])
putOrganizationConfigRule_excludedAccounts = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutOrganizationConfigRule' {Maybe [Text]
excludedAccounts :: Maybe [Text]
$sel:excludedAccounts:PutOrganizationConfigRule' :: PutOrganizationConfigRule -> Maybe [Text]
excludedAccounts} -> Maybe [Text]
excludedAccounts) (\s :: PutOrganizationConfigRule
s@PutOrganizationConfigRule' {} Maybe [Text]
a -> PutOrganizationConfigRule
s {$sel:excludedAccounts:PutOrganizationConfigRule' :: Maybe [Text]
excludedAccounts = Maybe [Text]
a} :: PutOrganizationConfigRule) 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

-- | An @OrganizationCustomPolicyRuleMetadata@ object. This object specifies
-- metadata for your organization\'s Config Custom Policy rule. The
-- metadata includes the runtime system in use, which accounts have debug
-- logging enabled, and other custom rule metadata, such as resource type,
-- resource ID of Amazon Web Services resource, and organization trigger
-- types that initiate Config to evaluate Amazon Web Services resources
-- against a rule.
putOrganizationConfigRule_organizationCustomPolicyRuleMetadata :: Lens.Lens' PutOrganizationConfigRule (Prelude.Maybe OrganizationCustomPolicyRuleMetadata)
putOrganizationConfigRule_organizationCustomPolicyRuleMetadata :: Lens'
  PutOrganizationConfigRule
  (Maybe OrganizationCustomPolicyRuleMetadata)
putOrganizationConfigRule_organizationCustomPolicyRuleMetadata = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutOrganizationConfigRule' {Maybe OrganizationCustomPolicyRuleMetadata
organizationCustomPolicyRuleMetadata :: Maybe OrganizationCustomPolicyRuleMetadata
$sel:organizationCustomPolicyRuleMetadata:PutOrganizationConfigRule' :: PutOrganizationConfigRule
-> Maybe OrganizationCustomPolicyRuleMetadata
organizationCustomPolicyRuleMetadata} -> Maybe OrganizationCustomPolicyRuleMetadata
organizationCustomPolicyRuleMetadata) (\s :: PutOrganizationConfigRule
s@PutOrganizationConfigRule' {} Maybe OrganizationCustomPolicyRuleMetadata
a -> PutOrganizationConfigRule
s {$sel:organizationCustomPolicyRuleMetadata:PutOrganizationConfigRule' :: Maybe OrganizationCustomPolicyRuleMetadata
organizationCustomPolicyRuleMetadata = Maybe OrganizationCustomPolicyRuleMetadata
a} :: PutOrganizationConfigRule)

-- | An @OrganizationCustomRuleMetadata@ object. This object specifies
-- organization custom rule metadata such as resource type, resource ID of
-- Amazon Web Services resource, Lambda function ARN, and organization
-- trigger types that trigger Config to evaluate your Amazon Web Services
-- resources against a rule. It also provides the frequency with which you
-- want Config to run evaluations for the rule if the trigger type is
-- periodic.
putOrganizationConfigRule_organizationCustomRuleMetadata :: Lens.Lens' PutOrganizationConfigRule (Prelude.Maybe OrganizationCustomRuleMetadata)
putOrganizationConfigRule_organizationCustomRuleMetadata :: Lens'
  PutOrganizationConfigRule (Maybe OrganizationCustomRuleMetadata)
putOrganizationConfigRule_organizationCustomRuleMetadata = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutOrganizationConfigRule' {Maybe OrganizationCustomRuleMetadata
organizationCustomRuleMetadata :: Maybe OrganizationCustomRuleMetadata
$sel:organizationCustomRuleMetadata:PutOrganizationConfigRule' :: PutOrganizationConfigRule -> Maybe OrganizationCustomRuleMetadata
organizationCustomRuleMetadata} -> Maybe OrganizationCustomRuleMetadata
organizationCustomRuleMetadata) (\s :: PutOrganizationConfigRule
s@PutOrganizationConfigRule' {} Maybe OrganizationCustomRuleMetadata
a -> PutOrganizationConfigRule
s {$sel:organizationCustomRuleMetadata:PutOrganizationConfigRule' :: Maybe OrganizationCustomRuleMetadata
organizationCustomRuleMetadata = Maybe OrganizationCustomRuleMetadata
a} :: PutOrganizationConfigRule)

-- | An @OrganizationManagedRuleMetadata@ object. This object specifies
-- organization managed rule metadata such as resource type and ID of
-- Amazon Web Services resource along with the rule identifier. It also
-- provides the frequency with which you want Config to run evaluations for
-- the rule if the trigger type is periodic.
putOrganizationConfigRule_organizationManagedRuleMetadata :: Lens.Lens' PutOrganizationConfigRule (Prelude.Maybe OrganizationManagedRuleMetadata)
putOrganizationConfigRule_organizationManagedRuleMetadata :: Lens'
  PutOrganizationConfigRule (Maybe OrganizationManagedRuleMetadata)
putOrganizationConfigRule_organizationManagedRuleMetadata = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutOrganizationConfigRule' {Maybe OrganizationManagedRuleMetadata
organizationManagedRuleMetadata :: Maybe OrganizationManagedRuleMetadata
$sel:organizationManagedRuleMetadata:PutOrganizationConfigRule' :: PutOrganizationConfigRule -> Maybe OrganizationManagedRuleMetadata
organizationManagedRuleMetadata} -> Maybe OrganizationManagedRuleMetadata
organizationManagedRuleMetadata) (\s :: PutOrganizationConfigRule
s@PutOrganizationConfigRule' {} Maybe OrganizationManagedRuleMetadata
a -> PutOrganizationConfigRule
s {$sel:organizationManagedRuleMetadata:PutOrganizationConfigRule' :: Maybe OrganizationManagedRuleMetadata
organizationManagedRuleMetadata = Maybe OrganizationManagedRuleMetadata
a} :: PutOrganizationConfigRule)

-- | The name that you assign to an organization Config rule.
putOrganizationConfigRule_organizationConfigRuleName :: Lens.Lens' PutOrganizationConfigRule Prelude.Text
putOrganizationConfigRule_organizationConfigRuleName :: Lens' PutOrganizationConfigRule Text
putOrganizationConfigRule_organizationConfigRuleName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutOrganizationConfigRule' {Text
organizationConfigRuleName :: Text
$sel:organizationConfigRuleName:PutOrganizationConfigRule' :: PutOrganizationConfigRule -> Text
organizationConfigRuleName} -> Text
organizationConfigRuleName) (\s :: PutOrganizationConfigRule
s@PutOrganizationConfigRule' {} Text
a -> PutOrganizationConfigRule
s {$sel:organizationConfigRuleName:PutOrganizationConfigRule' :: Text
organizationConfigRuleName = Text
a} :: PutOrganizationConfigRule)

instance Core.AWSRequest PutOrganizationConfigRule where
  type
    AWSResponse PutOrganizationConfigRule =
      PutOrganizationConfigRuleResponse
  request :: (Service -> Service)
-> PutOrganizationConfigRule -> Request PutOrganizationConfigRule
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 PutOrganizationConfigRule
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse PutOrganizationConfigRule)))
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 -> PutOrganizationConfigRuleResponse
PutOrganizationConfigRuleResponse'
            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
"OrganizationConfigRuleArn")
            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 PutOrganizationConfigRule where
  hashWithSalt :: Int -> PutOrganizationConfigRule -> Int
hashWithSalt Int
_salt PutOrganizationConfigRule' {Maybe [Text]
Maybe OrganizationCustomPolicyRuleMetadata
Maybe OrganizationCustomRuleMetadata
Maybe OrganizationManagedRuleMetadata
Text
organizationConfigRuleName :: Text
organizationManagedRuleMetadata :: Maybe OrganizationManagedRuleMetadata
organizationCustomRuleMetadata :: Maybe OrganizationCustomRuleMetadata
organizationCustomPolicyRuleMetadata :: Maybe OrganizationCustomPolicyRuleMetadata
excludedAccounts :: Maybe [Text]
$sel:organizationConfigRuleName:PutOrganizationConfigRule' :: PutOrganizationConfigRule -> Text
$sel:organizationManagedRuleMetadata:PutOrganizationConfigRule' :: PutOrganizationConfigRule -> Maybe OrganizationManagedRuleMetadata
$sel:organizationCustomRuleMetadata:PutOrganizationConfigRule' :: PutOrganizationConfigRule -> Maybe OrganizationCustomRuleMetadata
$sel:organizationCustomPolicyRuleMetadata:PutOrganizationConfigRule' :: PutOrganizationConfigRule
-> Maybe OrganizationCustomPolicyRuleMetadata
$sel:excludedAccounts:PutOrganizationConfigRule' :: PutOrganizationConfigRule -> Maybe [Text]
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
excludedAccounts
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe OrganizationCustomPolicyRuleMetadata
organizationCustomPolicyRuleMetadata
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe OrganizationCustomRuleMetadata
organizationCustomRuleMetadata
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe OrganizationManagedRuleMetadata
organizationManagedRuleMetadata
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
organizationConfigRuleName

instance Prelude.NFData PutOrganizationConfigRule where
  rnf :: PutOrganizationConfigRule -> ()
rnf PutOrganizationConfigRule' {Maybe [Text]
Maybe OrganizationCustomPolicyRuleMetadata
Maybe OrganizationCustomRuleMetadata
Maybe OrganizationManagedRuleMetadata
Text
organizationConfigRuleName :: Text
organizationManagedRuleMetadata :: Maybe OrganizationManagedRuleMetadata
organizationCustomRuleMetadata :: Maybe OrganizationCustomRuleMetadata
organizationCustomPolicyRuleMetadata :: Maybe OrganizationCustomPolicyRuleMetadata
excludedAccounts :: Maybe [Text]
$sel:organizationConfigRuleName:PutOrganizationConfigRule' :: PutOrganizationConfigRule -> Text
$sel:organizationManagedRuleMetadata:PutOrganizationConfigRule' :: PutOrganizationConfigRule -> Maybe OrganizationManagedRuleMetadata
$sel:organizationCustomRuleMetadata:PutOrganizationConfigRule' :: PutOrganizationConfigRule -> Maybe OrganizationCustomRuleMetadata
$sel:organizationCustomPolicyRuleMetadata:PutOrganizationConfigRule' :: PutOrganizationConfigRule
-> Maybe OrganizationCustomPolicyRuleMetadata
$sel:excludedAccounts:PutOrganizationConfigRule' :: PutOrganizationConfigRule -> Maybe [Text]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
excludedAccounts
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe OrganizationCustomPolicyRuleMetadata
organizationCustomPolicyRuleMetadata
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe OrganizationCustomRuleMetadata
organizationCustomRuleMetadata
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe OrganizationManagedRuleMetadata
organizationManagedRuleMetadata
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
organizationConfigRuleName

instance Data.ToHeaders PutOrganizationConfigRule where
  toHeaders :: PutOrganizationConfigRule -> 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
"StarlingDoveService.PutOrganizationConfigRule" ::
                          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 PutOrganizationConfigRule where
  toJSON :: PutOrganizationConfigRule -> Value
toJSON PutOrganizationConfigRule' {Maybe [Text]
Maybe OrganizationCustomPolicyRuleMetadata
Maybe OrganizationCustomRuleMetadata
Maybe OrganizationManagedRuleMetadata
Text
organizationConfigRuleName :: Text
organizationManagedRuleMetadata :: Maybe OrganizationManagedRuleMetadata
organizationCustomRuleMetadata :: Maybe OrganizationCustomRuleMetadata
organizationCustomPolicyRuleMetadata :: Maybe OrganizationCustomPolicyRuleMetadata
excludedAccounts :: Maybe [Text]
$sel:organizationConfigRuleName:PutOrganizationConfigRule' :: PutOrganizationConfigRule -> Text
$sel:organizationManagedRuleMetadata:PutOrganizationConfigRule' :: PutOrganizationConfigRule -> Maybe OrganizationManagedRuleMetadata
$sel:organizationCustomRuleMetadata:PutOrganizationConfigRule' :: PutOrganizationConfigRule -> Maybe OrganizationCustomRuleMetadata
$sel:organizationCustomPolicyRuleMetadata:PutOrganizationConfigRule' :: PutOrganizationConfigRule
-> Maybe OrganizationCustomPolicyRuleMetadata
$sel:excludedAccounts:PutOrganizationConfigRule' :: PutOrganizationConfigRule -> Maybe [Text]
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"ExcludedAccounts" 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]
excludedAccounts,
            (Key
"OrganizationCustomPolicyRuleMetadata" 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 OrganizationCustomPolicyRuleMetadata
organizationCustomPolicyRuleMetadata,
            (Key
"OrganizationCustomRuleMetadata" 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 OrganizationCustomRuleMetadata
organizationCustomRuleMetadata,
            (Key
"OrganizationManagedRuleMetadata" 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 OrganizationManagedRuleMetadata
organizationManagedRuleMetadata,
            forall a. a -> Maybe a
Prelude.Just
              ( Key
"OrganizationConfigRuleName"
                  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
organizationConfigRuleName
              )
          ]
      )

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

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

-- | /See:/ 'newPutOrganizationConfigRuleResponse' smart constructor.
data PutOrganizationConfigRuleResponse = PutOrganizationConfigRuleResponse'
  { -- | The Amazon Resource Name (ARN) of an organization Config rule.
    PutOrganizationConfigRuleResponse -> Maybe Text
organizationConfigRuleArn :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    PutOrganizationConfigRuleResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (PutOrganizationConfigRuleResponse
-> PutOrganizationConfigRuleResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PutOrganizationConfigRuleResponse
-> PutOrganizationConfigRuleResponse -> Bool
$c/= :: PutOrganizationConfigRuleResponse
-> PutOrganizationConfigRuleResponse -> Bool
== :: PutOrganizationConfigRuleResponse
-> PutOrganizationConfigRuleResponse -> Bool
$c== :: PutOrganizationConfigRuleResponse
-> PutOrganizationConfigRuleResponse -> Bool
Prelude.Eq, ReadPrec [PutOrganizationConfigRuleResponse]
ReadPrec PutOrganizationConfigRuleResponse
Int -> ReadS PutOrganizationConfigRuleResponse
ReadS [PutOrganizationConfigRuleResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PutOrganizationConfigRuleResponse]
$creadListPrec :: ReadPrec [PutOrganizationConfigRuleResponse]
readPrec :: ReadPrec PutOrganizationConfigRuleResponse
$creadPrec :: ReadPrec PutOrganizationConfigRuleResponse
readList :: ReadS [PutOrganizationConfigRuleResponse]
$creadList :: ReadS [PutOrganizationConfigRuleResponse]
readsPrec :: Int -> ReadS PutOrganizationConfigRuleResponse
$creadsPrec :: Int -> ReadS PutOrganizationConfigRuleResponse
Prelude.Read, Int -> PutOrganizationConfigRuleResponse -> ShowS
[PutOrganizationConfigRuleResponse] -> ShowS
PutOrganizationConfigRuleResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PutOrganizationConfigRuleResponse] -> ShowS
$cshowList :: [PutOrganizationConfigRuleResponse] -> ShowS
show :: PutOrganizationConfigRuleResponse -> String
$cshow :: PutOrganizationConfigRuleResponse -> String
showsPrec :: Int -> PutOrganizationConfigRuleResponse -> ShowS
$cshowsPrec :: Int -> PutOrganizationConfigRuleResponse -> ShowS
Prelude.Show, forall x.
Rep PutOrganizationConfigRuleResponse x
-> PutOrganizationConfigRuleResponse
forall x.
PutOrganizationConfigRuleResponse
-> Rep PutOrganizationConfigRuleResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep PutOrganizationConfigRuleResponse x
-> PutOrganizationConfigRuleResponse
$cfrom :: forall x.
PutOrganizationConfigRuleResponse
-> Rep PutOrganizationConfigRuleResponse x
Prelude.Generic)

-- |
-- Create a value of 'PutOrganizationConfigRuleResponse' 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:
--
-- 'organizationConfigRuleArn', 'putOrganizationConfigRuleResponse_organizationConfigRuleArn' - The Amazon Resource Name (ARN) of an organization Config rule.
--
-- 'httpStatus', 'putOrganizationConfigRuleResponse_httpStatus' - The response's http status code.
newPutOrganizationConfigRuleResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  PutOrganizationConfigRuleResponse
newPutOrganizationConfigRuleResponse :: Int -> PutOrganizationConfigRuleResponse
newPutOrganizationConfigRuleResponse Int
pHttpStatus_ =
  PutOrganizationConfigRuleResponse'
    { $sel:organizationConfigRuleArn:PutOrganizationConfigRuleResponse' :: Maybe Text
organizationConfigRuleArn =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:PutOrganizationConfigRuleResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The Amazon Resource Name (ARN) of an organization Config rule.
putOrganizationConfigRuleResponse_organizationConfigRuleArn :: Lens.Lens' PutOrganizationConfigRuleResponse (Prelude.Maybe Prelude.Text)
putOrganizationConfigRuleResponse_organizationConfigRuleArn :: Lens' PutOrganizationConfigRuleResponse (Maybe Text)
putOrganizationConfigRuleResponse_organizationConfigRuleArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutOrganizationConfigRuleResponse' {Maybe Text
organizationConfigRuleArn :: Maybe Text
$sel:organizationConfigRuleArn:PutOrganizationConfigRuleResponse' :: PutOrganizationConfigRuleResponse -> Maybe Text
organizationConfigRuleArn} -> Maybe Text
organizationConfigRuleArn) (\s :: PutOrganizationConfigRuleResponse
s@PutOrganizationConfigRuleResponse' {} Maybe Text
a -> PutOrganizationConfigRuleResponse
s {$sel:organizationConfigRuleArn:PutOrganizationConfigRuleResponse' :: Maybe Text
organizationConfigRuleArn = Maybe Text
a} :: PutOrganizationConfigRuleResponse)

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

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