{-# 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.NetworkFirewall.Types.RuleGroup
-- 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.NetworkFirewall.Types.RuleGroup where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.NetworkFirewall.Types.ReferenceSets
import Amazonka.NetworkFirewall.Types.RuleVariables
import Amazonka.NetworkFirewall.Types.RulesSource
import Amazonka.NetworkFirewall.Types.StatefulRuleOptions
import qualified Amazonka.Prelude as Prelude

-- | The object that defines the rules in a rule group. This, along with
-- RuleGroupResponse, define the rule group. You can retrieve all objects
-- for a rule group by calling DescribeRuleGroup.
--
-- Network Firewall uses a rule group to inspect and control network
-- traffic. You define stateless rule groups to inspect individual packets
-- and you define stateful rule groups to inspect packets in the context of
-- their traffic flow.
--
-- To use a rule group, you include it by reference in an Network Firewall
-- firewall policy, then you use the policy in a firewall. You can
-- reference a rule group from more than one firewall policy, and you can
-- use a firewall policy in more than one firewall.
--
-- /See:/ 'newRuleGroup' smart constructor.
data RuleGroup = RuleGroup'
  { -- | The list of a rule group\'s reference sets.
    RuleGroup -> Maybe ReferenceSets
referenceSets :: Prelude.Maybe ReferenceSets,
    -- | Settings that are available for use in the rules in the rule group. You
    -- can only use these for stateful rule groups.
    RuleGroup -> Maybe RuleVariables
ruleVariables :: Prelude.Maybe RuleVariables,
    -- | Additional options governing how Network Firewall handles stateful
    -- rules. The policies where you use your stateful rule group must have
    -- stateful rule options settings that are compatible with these settings.
    RuleGroup -> Maybe StatefulRuleOptions
statefulRuleOptions :: Prelude.Maybe StatefulRuleOptions,
    -- | The stateful rules or stateless rules for the rule group.
    RuleGroup -> RulesSource
rulesSource :: RulesSource
  }
  deriving (RuleGroup -> RuleGroup -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RuleGroup -> RuleGroup -> Bool
$c/= :: RuleGroup -> RuleGroup -> Bool
== :: RuleGroup -> RuleGroup -> Bool
$c== :: RuleGroup -> RuleGroup -> Bool
Prelude.Eq, ReadPrec [RuleGroup]
ReadPrec RuleGroup
Int -> ReadS RuleGroup
ReadS [RuleGroup]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RuleGroup]
$creadListPrec :: ReadPrec [RuleGroup]
readPrec :: ReadPrec RuleGroup
$creadPrec :: ReadPrec RuleGroup
readList :: ReadS [RuleGroup]
$creadList :: ReadS [RuleGroup]
readsPrec :: Int -> ReadS RuleGroup
$creadsPrec :: Int -> ReadS RuleGroup
Prelude.Read, Int -> RuleGroup -> ShowS
[RuleGroup] -> ShowS
RuleGroup -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RuleGroup] -> ShowS
$cshowList :: [RuleGroup] -> ShowS
show :: RuleGroup -> String
$cshow :: RuleGroup -> String
showsPrec :: Int -> RuleGroup -> ShowS
$cshowsPrec :: Int -> RuleGroup -> ShowS
Prelude.Show, forall x. Rep RuleGroup x -> RuleGroup
forall x. RuleGroup -> Rep RuleGroup x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RuleGroup x -> RuleGroup
$cfrom :: forall x. RuleGroup -> Rep RuleGroup x
Prelude.Generic)

-- |
-- Create a value of 'RuleGroup' 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:
--
-- 'referenceSets', 'ruleGroup_referenceSets' - The list of a rule group\'s reference sets.
--
-- 'ruleVariables', 'ruleGroup_ruleVariables' - Settings that are available for use in the rules in the rule group. You
-- can only use these for stateful rule groups.
--
-- 'statefulRuleOptions', 'ruleGroup_statefulRuleOptions' - Additional options governing how Network Firewall handles stateful
-- rules. The policies where you use your stateful rule group must have
-- stateful rule options settings that are compatible with these settings.
--
-- 'rulesSource', 'ruleGroup_rulesSource' - The stateful rules or stateless rules for the rule group.
newRuleGroup ::
  -- | 'rulesSource'
  RulesSource ->
  RuleGroup
newRuleGroup :: RulesSource -> RuleGroup
newRuleGroup RulesSource
pRulesSource_ =
  RuleGroup'
    { $sel:referenceSets:RuleGroup' :: Maybe ReferenceSets
referenceSets = forall a. Maybe a
Prelude.Nothing,
      $sel:ruleVariables:RuleGroup' :: Maybe RuleVariables
ruleVariables = forall a. Maybe a
Prelude.Nothing,
      $sel:statefulRuleOptions:RuleGroup' :: Maybe StatefulRuleOptions
statefulRuleOptions = forall a. Maybe a
Prelude.Nothing,
      $sel:rulesSource:RuleGroup' :: RulesSource
rulesSource = RulesSource
pRulesSource_
    }

-- | The list of a rule group\'s reference sets.
ruleGroup_referenceSets :: Lens.Lens' RuleGroup (Prelude.Maybe ReferenceSets)
ruleGroup_referenceSets :: Lens' RuleGroup (Maybe ReferenceSets)
ruleGroup_referenceSets = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RuleGroup' {Maybe ReferenceSets
referenceSets :: Maybe ReferenceSets
$sel:referenceSets:RuleGroup' :: RuleGroup -> Maybe ReferenceSets
referenceSets} -> Maybe ReferenceSets
referenceSets) (\s :: RuleGroup
s@RuleGroup' {} Maybe ReferenceSets
a -> RuleGroup
s {$sel:referenceSets:RuleGroup' :: Maybe ReferenceSets
referenceSets = Maybe ReferenceSets
a} :: RuleGroup)

-- | Settings that are available for use in the rules in the rule group. You
-- can only use these for stateful rule groups.
ruleGroup_ruleVariables :: Lens.Lens' RuleGroup (Prelude.Maybe RuleVariables)
ruleGroup_ruleVariables :: Lens' RuleGroup (Maybe RuleVariables)
ruleGroup_ruleVariables = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RuleGroup' {Maybe RuleVariables
ruleVariables :: Maybe RuleVariables
$sel:ruleVariables:RuleGroup' :: RuleGroup -> Maybe RuleVariables
ruleVariables} -> Maybe RuleVariables
ruleVariables) (\s :: RuleGroup
s@RuleGroup' {} Maybe RuleVariables
a -> RuleGroup
s {$sel:ruleVariables:RuleGroup' :: Maybe RuleVariables
ruleVariables = Maybe RuleVariables
a} :: RuleGroup)

-- | Additional options governing how Network Firewall handles stateful
-- rules. The policies where you use your stateful rule group must have
-- stateful rule options settings that are compatible with these settings.
ruleGroup_statefulRuleOptions :: Lens.Lens' RuleGroup (Prelude.Maybe StatefulRuleOptions)
ruleGroup_statefulRuleOptions :: Lens' RuleGroup (Maybe StatefulRuleOptions)
ruleGroup_statefulRuleOptions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RuleGroup' {Maybe StatefulRuleOptions
statefulRuleOptions :: Maybe StatefulRuleOptions
$sel:statefulRuleOptions:RuleGroup' :: RuleGroup -> Maybe StatefulRuleOptions
statefulRuleOptions} -> Maybe StatefulRuleOptions
statefulRuleOptions) (\s :: RuleGroup
s@RuleGroup' {} Maybe StatefulRuleOptions
a -> RuleGroup
s {$sel:statefulRuleOptions:RuleGroup' :: Maybe StatefulRuleOptions
statefulRuleOptions = Maybe StatefulRuleOptions
a} :: RuleGroup)

-- | The stateful rules or stateless rules for the rule group.
ruleGroup_rulesSource :: Lens.Lens' RuleGroup RulesSource
ruleGroup_rulesSource :: Lens' RuleGroup RulesSource
ruleGroup_rulesSource = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RuleGroup' {RulesSource
rulesSource :: RulesSource
$sel:rulesSource:RuleGroup' :: RuleGroup -> RulesSource
rulesSource} -> RulesSource
rulesSource) (\s :: RuleGroup
s@RuleGroup' {} RulesSource
a -> RuleGroup
s {$sel:rulesSource:RuleGroup' :: RulesSource
rulesSource = RulesSource
a} :: RuleGroup)

instance Data.FromJSON RuleGroup where
  parseJSON :: Value -> Parser RuleGroup
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"RuleGroup"
      ( \Object
x ->
          Maybe ReferenceSets
-> Maybe RuleVariables
-> Maybe StatefulRuleOptions
-> RulesSource
-> RuleGroup
RuleGroup'
            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
"ReferenceSets")
            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
"RuleVariables")
            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
"StatefulRuleOptions")
            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
"RulesSource")
      )

instance Prelude.Hashable RuleGroup where
  hashWithSalt :: Int -> RuleGroup -> Int
hashWithSalt Int
_salt RuleGroup' {Maybe ReferenceSets
Maybe RuleVariables
Maybe StatefulRuleOptions
RulesSource
rulesSource :: RulesSource
statefulRuleOptions :: Maybe StatefulRuleOptions
ruleVariables :: Maybe RuleVariables
referenceSets :: Maybe ReferenceSets
$sel:rulesSource:RuleGroup' :: RuleGroup -> RulesSource
$sel:statefulRuleOptions:RuleGroup' :: RuleGroup -> Maybe StatefulRuleOptions
$sel:ruleVariables:RuleGroup' :: RuleGroup -> Maybe RuleVariables
$sel:referenceSets:RuleGroup' :: RuleGroup -> Maybe ReferenceSets
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ReferenceSets
referenceSets
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe RuleVariables
ruleVariables
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe StatefulRuleOptions
statefulRuleOptions
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` RulesSource
rulesSource

instance Prelude.NFData RuleGroup where
  rnf :: RuleGroup -> ()
rnf RuleGroup' {Maybe ReferenceSets
Maybe RuleVariables
Maybe StatefulRuleOptions
RulesSource
rulesSource :: RulesSource
statefulRuleOptions :: Maybe StatefulRuleOptions
ruleVariables :: Maybe RuleVariables
referenceSets :: Maybe ReferenceSets
$sel:rulesSource:RuleGroup' :: RuleGroup -> RulesSource
$sel:statefulRuleOptions:RuleGroup' :: RuleGroup -> Maybe StatefulRuleOptions
$sel:ruleVariables:RuleGroup' :: RuleGroup -> Maybe RuleVariables
$sel:referenceSets:RuleGroup' :: RuleGroup -> Maybe ReferenceSets
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe ReferenceSets
referenceSets
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe RuleVariables
ruleVariables
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe StatefulRuleOptions
statefulRuleOptions
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf RulesSource
rulesSource

instance Data.ToJSON RuleGroup where
  toJSON :: RuleGroup -> Value
toJSON RuleGroup' {Maybe ReferenceSets
Maybe RuleVariables
Maybe StatefulRuleOptions
RulesSource
rulesSource :: RulesSource
statefulRuleOptions :: Maybe StatefulRuleOptions
ruleVariables :: Maybe RuleVariables
referenceSets :: Maybe ReferenceSets
$sel:rulesSource:RuleGroup' :: RuleGroup -> RulesSource
$sel:statefulRuleOptions:RuleGroup' :: RuleGroup -> Maybe StatefulRuleOptions
$sel:ruleVariables:RuleGroup' :: RuleGroup -> Maybe RuleVariables
$sel:referenceSets:RuleGroup' :: RuleGroup -> Maybe ReferenceSets
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"ReferenceSets" 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 ReferenceSets
referenceSets,
            (Key
"RuleVariables" 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 RuleVariables
ruleVariables,
            (Key
"StatefulRuleOptions" 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 StatefulRuleOptions
statefulRuleOptions,
            forall a. a -> Maybe a
Prelude.Just (Key
"RulesSource" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= RulesSource
rulesSource)
          ]
      )