{-# 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.StatefulRule
-- 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.StatefulRule 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.Header
import Amazonka.NetworkFirewall.Types.RuleOption
import Amazonka.NetworkFirewall.Types.StatefulAction
import qualified Amazonka.Prelude as Prelude

-- | A single Suricata rules specification, for use in a stateful rule group.
-- Use this option to specify a simple Suricata rule with protocol, source
-- and destination, ports, direction, and rule options. For information
-- about the Suricata @Rules@ format, see
-- <https://suricata.readthedocs.io/rules/intro.html# Rules Format>.
--
-- /See:/ 'newStatefulRule' smart constructor.
data StatefulRule = StatefulRule'
  { -- | Defines what Network Firewall should do with the packets in a traffic
    -- flow when the flow matches the stateful rule criteria. For all actions,
    -- Network Firewall performs the specified action and discontinues stateful
    -- inspection of the traffic flow.
    --
    -- The actions for a stateful rule are defined as follows:
    --
    -- -   __PASS__ - Permits the packets to go to the intended destination.
    --
    -- -   __DROP__ - Blocks the packets from going to the intended destination
    --     and sends an alert log message, if alert logging is configured in
    --     the Firewall LoggingConfiguration.
    --
    -- -   __ALERT__ - Permits the packets to go to the intended destination
    --     and sends an alert log message, if alert logging is configured in
    --     the Firewall LoggingConfiguration.
    --
    --     You can use this action to test a rule that you intend to use to
    --     drop traffic. You can enable the rule with @ALERT@ action, verify in
    --     the logs that the rule is filtering as you want, then change the
    --     action to @DROP@.
    StatefulRule -> StatefulAction
action :: StatefulAction,
    -- | The stateful inspection criteria for this rule, used to inspect traffic
    -- flows.
    StatefulRule -> Header
header :: Header,
    -- | Additional options for the rule. These are the Suricata @RuleOptions@
    -- settings.
    StatefulRule -> [RuleOption]
ruleOptions :: [RuleOption]
  }
  deriving (StatefulRule -> StatefulRule -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StatefulRule -> StatefulRule -> Bool
$c/= :: StatefulRule -> StatefulRule -> Bool
== :: StatefulRule -> StatefulRule -> Bool
$c== :: StatefulRule -> StatefulRule -> Bool
Prelude.Eq, ReadPrec [StatefulRule]
ReadPrec StatefulRule
Int -> ReadS StatefulRule
ReadS [StatefulRule]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StatefulRule]
$creadListPrec :: ReadPrec [StatefulRule]
readPrec :: ReadPrec StatefulRule
$creadPrec :: ReadPrec StatefulRule
readList :: ReadS [StatefulRule]
$creadList :: ReadS [StatefulRule]
readsPrec :: Int -> ReadS StatefulRule
$creadsPrec :: Int -> ReadS StatefulRule
Prelude.Read, Int -> StatefulRule -> ShowS
[StatefulRule] -> ShowS
StatefulRule -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StatefulRule] -> ShowS
$cshowList :: [StatefulRule] -> ShowS
show :: StatefulRule -> String
$cshow :: StatefulRule -> String
showsPrec :: Int -> StatefulRule -> ShowS
$cshowsPrec :: Int -> StatefulRule -> ShowS
Prelude.Show, forall x. Rep StatefulRule x -> StatefulRule
forall x. StatefulRule -> Rep StatefulRule x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StatefulRule x -> StatefulRule
$cfrom :: forall x. StatefulRule -> Rep StatefulRule x
Prelude.Generic)

-- |
-- Create a value of 'StatefulRule' 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:
--
-- 'action', 'statefulRule_action' - Defines what Network Firewall should do with the packets in a traffic
-- flow when the flow matches the stateful rule criteria. For all actions,
-- Network Firewall performs the specified action and discontinues stateful
-- inspection of the traffic flow.
--
-- The actions for a stateful rule are defined as follows:
--
-- -   __PASS__ - Permits the packets to go to the intended destination.
--
-- -   __DROP__ - Blocks the packets from going to the intended destination
--     and sends an alert log message, if alert logging is configured in
--     the Firewall LoggingConfiguration.
--
-- -   __ALERT__ - Permits the packets to go to the intended destination
--     and sends an alert log message, if alert logging is configured in
--     the Firewall LoggingConfiguration.
--
--     You can use this action to test a rule that you intend to use to
--     drop traffic. You can enable the rule with @ALERT@ action, verify in
--     the logs that the rule is filtering as you want, then change the
--     action to @DROP@.
--
-- 'header', 'statefulRule_header' - The stateful inspection criteria for this rule, used to inspect traffic
-- flows.
--
-- 'ruleOptions', 'statefulRule_ruleOptions' - Additional options for the rule. These are the Suricata @RuleOptions@
-- settings.
newStatefulRule ::
  -- | 'action'
  StatefulAction ->
  -- | 'header'
  Header ->
  StatefulRule
newStatefulRule :: StatefulAction -> Header -> StatefulRule
newStatefulRule StatefulAction
pAction_ Header
pHeader_ =
  StatefulRule'
    { $sel:action:StatefulRule' :: StatefulAction
action = StatefulAction
pAction_,
      $sel:header:StatefulRule' :: Header
header = Header
pHeader_,
      $sel:ruleOptions:StatefulRule' :: [RuleOption]
ruleOptions = forall a. Monoid a => a
Prelude.mempty
    }

-- | Defines what Network Firewall should do with the packets in a traffic
-- flow when the flow matches the stateful rule criteria. For all actions,
-- Network Firewall performs the specified action and discontinues stateful
-- inspection of the traffic flow.
--
-- The actions for a stateful rule are defined as follows:
--
-- -   __PASS__ - Permits the packets to go to the intended destination.
--
-- -   __DROP__ - Blocks the packets from going to the intended destination
--     and sends an alert log message, if alert logging is configured in
--     the Firewall LoggingConfiguration.
--
-- -   __ALERT__ - Permits the packets to go to the intended destination
--     and sends an alert log message, if alert logging is configured in
--     the Firewall LoggingConfiguration.
--
--     You can use this action to test a rule that you intend to use to
--     drop traffic. You can enable the rule with @ALERT@ action, verify in
--     the logs that the rule is filtering as you want, then change the
--     action to @DROP@.
statefulRule_action :: Lens.Lens' StatefulRule StatefulAction
statefulRule_action :: Lens' StatefulRule StatefulAction
statefulRule_action = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StatefulRule' {StatefulAction
action :: StatefulAction
$sel:action:StatefulRule' :: StatefulRule -> StatefulAction
action} -> StatefulAction
action) (\s :: StatefulRule
s@StatefulRule' {} StatefulAction
a -> StatefulRule
s {$sel:action:StatefulRule' :: StatefulAction
action = StatefulAction
a} :: StatefulRule)

-- | The stateful inspection criteria for this rule, used to inspect traffic
-- flows.
statefulRule_header :: Lens.Lens' StatefulRule Header
statefulRule_header :: Lens' StatefulRule Header
statefulRule_header = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StatefulRule' {Header
header :: Header
$sel:header:StatefulRule' :: StatefulRule -> Header
header} -> Header
header) (\s :: StatefulRule
s@StatefulRule' {} Header
a -> StatefulRule
s {$sel:header:StatefulRule' :: Header
header = Header
a} :: StatefulRule)

-- | Additional options for the rule. These are the Suricata @RuleOptions@
-- settings.
statefulRule_ruleOptions :: Lens.Lens' StatefulRule [RuleOption]
statefulRule_ruleOptions :: Lens' StatefulRule [RuleOption]
statefulRule_ruleOptions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StatefulRule' {[RuleOption]
ruleOptions :: [RuleOption]
$sel:ruleOptions:StatefulRule' :: StatefulRule -> [RuleOption]
ruleOptions} -> [RuleOption]
ruleOptions) (\s :: StatefulRule
s@StatefulRule' {} [RuleOption]
a -> StatefulRule
s {$sel:ruleOptions:StatefulRule' :: [RuleOption]
ruleOptions = [RuleOption]
a} :: StatefulRule) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

instance Data.FromJSON StatefulRule where
  parseJSON :: Value -> Parser StatefulRule
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"StatefulRule"
      ( \Object
x ->
          StatefulAction -> Header -> [RuleOption] -> StatefulRule
StatefulRule'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Parser a
Data..: Key
"Action")
            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
"Header")
            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
"RuleOptions" forall a. Parser (Maybe a) -> a -> Parser a
Data..!= forall a. Monoid a => a
Prelude.mempty)
      )

instance Prelude.Hashable StatefulRule where
  hashWithSalt :: Int -> StatefulRule -> Int
hashWithSalt Int
_salt StatefulRule' {[RuleOption]
StatefulAction
Header
ruleOptions :: [RuleOption]
header :: Header
action :: StatefulAction
$sel:ruleOptions:StatefulRule' :: StatefulRule -> [RuleOption]
$sel:header:StatefulRule' :: StatefulRule -> Header
$sel:action:StatefulRule' :: StatefulRule -> StatefulAction
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` StatefulAction
action
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Header
header
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` [RuleOption]
ruleOptions

instance Prelude.NFData StatefulRule where
  rnf :: StatefulRule -> ()
rnf StatefulRule' {[RuleOption]
StatefulAction
Header
ruleOptions :: [RuleOption]
header :: Header
action :: StatefulAction
$sel:ruleOptions:StatefulRule' :: StatefulRule -> [RuleOption]
$sel:header:StatefulRule' :: StatefulRule -> Header
$sel:action:StatefulRule' :: StatefulRule -> StatefulAction
..} =
    forall a. NFData a => a -> ()
Prelude.rnf StatefulAction
action
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Header
header
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf [RuleOption]
ruleOptions

instance Data.ToJSON StatefulRule where
  toJSON :: StatefulRule -> Value
toJSON StatefulRule' {[RuleOption]
StatefulAction
Header
ruleOptions :: [RuleOption]
header :: Header
action :: StatefulAction
$sel:ruleOptions:StatefulRule' :: StatefulRule -> [RuleOption]
$sel:header:StatefulRule' :: StatefulRule -> Header
$sel:action:StatefulRule' :: StatefulRule -> StatefulAction
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just (Key
"Action" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= StatefulAction
action),
            forall a. a -> Maybe a
Prelude.Just (Key
"Header" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Header
header),
            forall a. a -> Maybe a
Prelude.Just (Key
"RuleOptions" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= [RuleOption]
ruleOptions)
          ]
      )