{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# 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.Types.Source
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
module Amazonka.Config.Types.Source where

import Amazonka.Config.Types.CustomPolicyDetails
import Amazonka.Config.Types.Owner
import Amazonka.Config.Types.SourceDetail
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

-- | Provides the CustomPolicyDetails, the rule owner (@Amazon Web Services@
-- for managed rules, @CUSTOM_POLICY@ for Custom Policy rules, and
-- @CUSTOM_LAMBDA@ for Custom Lambda rules), the rule identifier, and the
-- events that cause the evaluation of your Amazon Web Services resources.
--
-- /See:/ 'newSource' smart constructor.
data Source = Source'
  { -- | Provides the runtime system, policy definition, and whether debug
    -- logging is enabled. Required when owner is set to @CUSTOM_POLICY@.
    Source -> Maybe CustomPolicyDetails
customPolicyDetails :: Prelude.Maybe CustomPolicyDetails,
    -- | Provides the source and the message types that cause 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.
    --
    -- If the owner is set to @CUSTOM_POLICY@, the only acceptable values for
    -- the Config rule trigger message type are
    -- @ConfigurationItemChangeNotification@ and
    -- @OversizedConfigurationItemChangeNotification@.
    Source -> Maybe [SourceDetail]
sourceDetails :: Prelude.Maybe [SourceDetail],
    -- | For Config Managed rules, a predefined identifier from a list. For
    -- example, @IAM_PASSWORD_POLICY@ is a managed rule. To reference a managed
    -- rule, see
    -- <https://docs.aws.amazon.com/config/latest/developerguide/managed-rules-by-aws-config.html List of Config Managed Rules>.
    --
    -- For Config Custom Lambda rules, the identifier is the Amazon Resource
    -- Name (ARN) of the rule\'s Lambda function, such as
    -- @arn:aws:lambda:us-east-2:123456789012:function:custom_rule_name@.
    --
    -- For Config Custom Policy rules, this field will be ignored.
    Source -> Maybe Text
sourceIdentifier :: Prelude.Maybe Prelude.Text,
    -- | Indicates whether Amazon Web Services or the customer owns and manages
    -- the Config rule.
    --
    -- Config Managed Rules are predefined rules owned by Amazon Web Services.
    -- For more information, see
    -- <https://docs.aws.amazon.com/config/latest/developerguide/evaluate-config_use-managed-rules.html Config Managed Rules>
    -- in the /Config developer guide/.
    --
    -- Config Custom Rules are rules that you can develop either with Guard
    -- (@CUSTOM_POLICY@) or Lambda (@CUSTOM_LAMBDA@). For more information, see
    -- <https://docs.aws.amazon.com/config/latest/developerguide/evaluate-config_develop-rules.html Config Custom Rules>
    -- in the /Config developer guide/.
    Source -> Owner
owner :: Owner
  }
  deriving (Source -> Source -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Source -> Source -> Bool
$c/= :: Source -> Source -> Bool
== :: Source -> Source -> Bool
$c== :: Source -> Source -> Bool
Prelude.Eq, ReadPrec [Source]
ReadPrec Source
Int -> ReadS Source
ReadS [Source]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Source]
$creadListPrec :: ReadPrec [Source]
readPrec :: ReadPrec Source
$creadPrec :: ReadPrec Source
readList :: ReadS [Source]
$creadList :: ReadS [Source]
readsPrec :: Int -> ReadS Source
$creadsPrec :: Int -> ReadS Source
Prelude.Read, Int -> Source -> ShowS
[Source] -> ShowS
Source -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Source] -> ShowS
$cshowList :: [Source] -> ShowS
show :: Source -> String
$cshow :: Source -> String
showsPrec :: Int -> Source -> ShowS
$cshowsPrec :: Int -> Source -> ShowS
Prelude.Show, forall x. Rep Source x -> Source
forall x. Source -> Rep Source x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Source x -> Source
$cfrom :: forall x. Source -> Rep Source x
Prelude.Generic)

-- |
-- Create a value of 'Source' 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:
--
-- 'customPolicyDetails', 'source_customPolicyDetails' - Provides the runtime system, policy definition, and whether debug
-- logging is enabled. Required when owner is set to @CUSTOM_POLICY@.
--
-- 'sourceDetails', 'source_sourceDetails' - Provides the source and the message types that cause 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.
--
-- If the owner is set to @CUSTOM_POLICY@, the only acceptable values for
-- the Config rule trigger message type are
-- @ConfigurationItemChangeNotification@ and
-- @OversizedConfigurationItemChangeNotification@.
--
-- 'sourceIdentifier', 'source_sourceIdentifier' - For Config Managed rules, a predefined identifier from a list. For
-- example, @IAM_PASSWORD_POLICY@ is a managed rule. To reference a managed
-- rule, see
-- <https://docs.aws.amazon.com/config/latest/developerguide/managed-rules-by-aws-config.html List of Config Managed Rules>.
--
-- For Config Custom Lambda rules, the identifier is the Amazon Resource
-- Name (ARN) of the rule\'s Lambda function, such as
-- @arn:aws:lambda:us-east-2:123456789012:function:custom_rule_name@.
--
-- For Config Custom Policy rules, this field will be ignored.
--
-- 'owner', 'source_owner' - Indicates whether Amazon Web Services or the customer owns and manages
-- the Config rule.
--
-- Config Managed Rules are predefined rules owned by Amazon Web Services.
-- For more information, see
-- <https://docs.aws.amazon.com/config/latest/developerguide/evaluate-config_use-managed-rules.html Config Managed Rules>
-- in the /Config developer guide/.
--
-- Config Custom Rules are rules that you can develop either with Guard
-- (@CUSTOM_POLICY@) or Lambda (@CUSTOM_LAMBDA@). For more information, see
-- <https://docs.aws.amazon.com/config/latest/developerguide/evaluate-config_develop-rules.html Config Custom Rules>
-- in the /Config developer guide/.
newSource ::
  -- | 'owner'
  Owner ->
  Source
newSource :: Owner -> Source
newSource Owner
pOwner_ =
  Source'
    { $sel:customPolicyDetails:Source' :: Maybe CustomPolicyDetails
customPolicyDetails = forall a. Maybe a
Prelude.Nothing,
      $sel:sourceDetails:Source' :: Maybe [SourceDetail]
sourceDetails = forall a. Maybe a
Prelude.Nothing,
      $sel:sourceIdentifier:Source' :: Maybe Text
sourceIdentifier = forall a. Maybe a
Prelude.Nothing,
      $sel:owner:Source' :: Owner
owner = Owner
pOwner_
    }

-- | Provides the runtime system, policy definition, and whether debug
-- logging is enabled. Required when owner is set to @CUSTOM_POLICY@.
source_customPolicyDetails :: Lens.Lens' Source (Prelude.Maybe CustomPolicyDetails)
source_customPolicyDetails :: Lens' Source (Maybe CustomPolicyDetails)
source_customPolicyDetails = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Source' {Maybe CustomPolicyDetails
customPolicyDetails :: Maybe CustomPolicyDetails
$sel:customPolicyDetails:Source' :: Source -> Maybe CustomPolicyDetails
customPolicyDetails} -> Maybe CustomPolicyDetails
customPolicyDetails) (\s :: Source
s@Source' {} Maybe CustomPolicyDetails
a -> Source
s {$sel:customPolicyDetails:Source' :: Maybe CustomPolicyDetails
customPolicyDetails = Maybe CustomPolicyDetails
a} :: Source)

-- | Provides the source and the message types that cause 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.
--
-- If the owner is set to @CUSTOM_POLICY@, the only acceptable values for
-- the Config rule trigger message type are
-- @ConfigurationItemChangeNotification@ and
-- @OversizedConfigurationItemChangeNotification@.
source_sourceDetails :: Lens.Lens' Source (Prelude.Maybe [SourceDetail])
source_sourceDetails :: Lens' Source (Maybe [SourceDetail])
source_sourceDetails = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Source' {Maybe [SourceDetail]
sourceDetails :: Maybe [SourceDetail]
$sel:sourceDetails:Source' :: Source -> Maybe [SourceDetail]
sourceDetails} -> Maybe [SourceDetail]
sourceDetails) (\s :: Source
s@Source' {} Maybe [SourceDetail]
a -> Source
s {$sel:sourceDetails:Source' :: Maybe [SourceDetail]
sourceDetails = Maybe [SourceDetail]
a} :: Source) 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

-- | For Config Managed rules, a predefined identifier from a list. For
-- example, @IAM_PASSWORD_POLICY@ is a managed rule. To reference a managed
-- rule, see
-- <https://docs.aws.amazon.com/config/latest/developerguide/managed-rules-by-aws-config.html List of Config Managed Rules>.
--
-- For Config Custom Lambda rules, the identifier is the Amazon Resource
-- Name (ARN) of the rule\'s Lambda function, such as
-- @arn:aws:lambda:us-east-2:123456789012:function:custom_rule_name@.
--
-- For Config Custom Policy rules, this field will be ignored.
source_sourceIdentifier :: Lens.Lens' Source (Prelude.Maybe Prelude.Text)
source_sourceIdentifier :: Lens' Source (Maybe Text)
source_sourceIdentifier = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Source' {Maybe Text
sourceIdentifier :: Maybe Text
$sel:sourceIdentifier:Source' :: Source -> Maybe Text
sourceIdentifier} -> Maybe Text
sourceIdentifier) (\s :: Source
s@Source' {} Maybe Text
a -> Source
s {$sel:sourceIdentifier:Source' :: Maybe Text
sourceIdentifier = Maybe Text
a} :: Source)

-- | Indicates whether Amazon Web Services or the customer owns and manages
-- the Config rule.
--
-- Config Managed Rules are predefined rules owned by Amazon Web Services.
-- For more information, see
-- <https://docs.aws.amazon.com/config/latest/developerguide/evaluate-config_use-managed-rules.html Config Managed Rules>
-- in the /Config developer guide/.
--
-- Config Custom Rules are rules that you can develop either with Guard
-- (@CUSTOM_POLICY@) or Lambda (@CUSTOM_LAMBDA@). For more information, see
-- <https://docs.aws.amazon.com/config/latest/developerguide/evaluate-config_develop-rules.html Config Custom Rules>
-- in the /Config developer guide/.
source_owner :: Lens.Lens' Source Owner
source_owner :: Lens' Source Owner
source_owner = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Source' {Owner
owner :: Owner
$sel:owner:Source' :: Source -> Owner
owner} -> Owner
owner) (\s :: Source
s@Source' {} Owner
a -> Source
s {$sel:owner:Source' :: Owner
owner = Owner
a} :: Source)

instance Data.FromJSON Source where
  parseJSON :: Value -> Parser Source
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"Source"
      ( \Object
x ->
          Maybe CustomPolicyDetails
-> Maybe [SourceDetail] -> Maybe Text -> Owner -> Source
Source'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"CustomPolicyDetails")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"SourceDetails" forall a. Parser (Maybe a) -> a -> Parser a
Data..!= forall a. Monoid a => a
Prelude.mempty)
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"SourceIdentifier")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser a
Data..: Key
"Owner")
      )

instance Prelude.Hashable Source where
  hashWithSalt :: Int -> Source -> Int
hashWithSalt Int
_salt Source' {Maybe [SourceDetail]
Maybe Text
Maybe CustomPolicyDetails
Owner
owner :: Owner
sourceIdentifier :: Maybe Text
sourceDetails :: Maybe [SourceDetail]
customPolicyDetails :: Maybe CustomPolicyDetails
$sel:owner:Source' :: Source -> Owner
$sel:sourceIdentifier:Source' :: Source -> Maybe Text
$sel:sourceDetails:Source' :: Source -> Maybe [SourceDetail]
$sel:customPolicyDetails:Source' :: Source -> Maybe CustomPolicyDetails
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe CustomPolicyDetails
customPolicyDetails
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [SourceDetail]
sourceDetails
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
sourceIdentifier
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Owner
owner

instance Prelude.NFData Source where
  rnf :: Source -> ()
rnf Source' {Maybe [SourceDetail]
Maybe Text
Maybe CustomPolicyDetails
Owner
owner :: Owner
sourceIdentifier :: Maybe Text
sourceDetails :: Maybe [SourceDetail]
customPolicyDetails :: Maybe CustomPolicyDetails
$sel:owner:Source' :: Source -> Owner
$sel:sourceIdentifier:Source' :: Source -> Maybe Text
$sel:sourceDetails:Source' :: Source -> Maybe [SourceDetail]
$sel:customPolicyDetails:Source' :: Source -> Maybe CustomPolicyDetails
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe CustomPolicyDetails
customPolicyDetails
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [SourceDetail]
sourceDetails
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
sourceIdentifier
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Owner
owner

instance Data.ToJSON Source where
  toJSON :: Source -> Value
toJSON Source' {Maybe [SourceDetail]
Maybe Text
Maybe CustomPolicyDetails
Owner
owner :: Owner
sourceIdentifier :: Maybe Text
sourceDetails :: Maybe [SourceDetail]
customPolicyDetails :: Maybe CustomPolicyDetails
$sel:owner:Source' :: Source -> Owner
$sel:sourceIdentifier:Source' :: Source -> Maybe Text
$sel:sourceDetails:Source' :: Source -> Maybe [SourceDetail]
$sel:customPolicyDetails:Source' :: Source -> Maybe CustomPolicyDetails
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"CustomPolicyDetails" 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 CustomPolicyDetails
customPolicyDetails,
            (Key
"SourceDetails" 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 [SourceDetail]
sourceDetails,
            (Key
"SourceIdentifier" 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
sourceIdentifier,
            forall a. a -> Maybe a
Prelude.Just (Key
"Owner" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Owner
owner)
          ]
      )