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

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 Amazonka.WAFV2.Types.CustomResponseBody
import Amazonka.WAFV2.Types.LabelSummary
import Amazonka.WAFV2.Types.Rule
import Amazonka.WAFV2.Types.VisibilityConfig

-- | A rule group defines a collection of rules to inspect and control web
-- requests that you can use in a WebACL. When you create a rule group, you
-- define an immutable capacity limit. If you update a rule group, you must
-- stay within the capacity. This allows others to reuse the rule group
-- with confidence in its capacity requirements.
--
-- /See:/ 'newRuleGroup' smart constructor.
data RuleGroup = RuleGroup'
  { -- | The labels that one or more rules in this rule group add to matching web
    -- requests. These labels are defined in the @RuleLabels@ for a Rule.
    RuleGroup -> Maybe [LabelSummary]
availableLabels :: Prelude.Maybe [LabelSummary],
    -- | The labels that one or more rules in this rule group match against in
    -- label match statements. These labels are defined in a
    -- @LabelMatchStatement@ specification, in the Statement definition of a
    -- rule.
    RuleGroup -> Maybe [LabelSummary]
consumedLabels :: Prelude.Maybe [LabelSummary],
    -- | A map of custom response keys and content bodies. When you create a rule
    -- with a block action, you can send a custom response to the web request.
    -- You define these for the rule group, and then use them in the rules that
    -- you define in the rule group.
    --
    -- For information about customizing web requests and responses, see
    -- <https://docs.aws.amazon.com/waf/latest/developerguide/waf-custom-request-response.html Customizing web requests and responses in WAF>
    -- in the
    -- <https://docs.aws.amazon.com/waf/latest/developerguide/waf-chapter.html WAF Developer Guide>.
    --
    -- For information about the limits on count and size for custom request
    -- and response settings, see
    -- <https://docs.aws.amazon.com/waf/latest/developerguide/limits.html WAF quotas>
    -- in the
    -- <https://docs.aws.amazon.com/waf/latest/developerguide/waf-chapter.html WAF Developer Guide>.
    RuleGroup -> Maybe (HashMap Text CustomResponseBody)
customResponseBodies :: Prelude.Maybe (Prelude.HashMap Prelude.Text CustomResponseBody),
    -- | A description of the rule group that helps with identification.
    RuleGroup -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | The label namespace prefix for this rule group. All labels added by
    -- rules in this rule group have this prefix.
    --
    -- -   The syntax for the label namespace prefix for your rule groups is
    --     the following:
    --
    --     @awswaf:\<account ID>:rulegroup:\<rule group name>:@
    --
    -- -   When a rule with a label matches a web request, WAF adds the fully
    --     qualified label to the request. A fully qualified label is made up
    --     of the label namespace from the rule group or web ACL where the rule
    --     is defined and the label from the rule, separated by a colon:
    --
    --     @\<label namespace>:\<label from rule>@
    RuleGroup -> Maybe Text
labelNamespace :: Prelude.Maybe Prelude.Text,
    -- | The Rule statements used to identify the web requests that you want to
    -- allow, block, or count. Each rule includes one top-level statement that
    -- WAF uses to identify matching web requests, and parameters that govern
    -- how WAF handles them.
    RuleGroup -> Maybe [Rule]
rules :: Prelude.Maybe [Rule],
    -- | The name of the rule group. You cannot change the name of a rule group
    -- after you create it.
    RuleGroup -> Text
name :: Prelude.Text,
    -- | A unique identifier for the rule group. This ID is returned in the
    -- responses to create and list commands. You provide it to operations like
    -- update and delete.
    RuleGroup -> Text
id :: Prelude.Text,
    -- | The web ACL capacity units (WCUs) required for this rule group.
    --
    -- When you create your own rule group, you define this, and you cannot
    -- change it after creation. When you add or modify the rules in a rule
    -- group, WAF enforces this limit. You can check the capacity for a set of
    -- rules using CheckCapacity.
    --
    -- WAF uses WCUs to calculate and control the operating resources that are
    -- used to run your rules, rule groups, and web ACLs. WAF calculates
    -- capacity differently for each rule type, to reflect the relative cost of
    -- each rule. Simple rules that cost little to run use fewer WCUs than more
    -- complex rules that use more processing power. Rule group capacity is
    -- fixed at creation, which helps users plan their web ACL WCU usage when
    -- they use a rule group. The WCU limit for web ACLs is 1,500.
    RuleGroup -> Natural
capacity :: Prelude.Natural,
    -- | The Amazon Resource Name (ARN) of the entity.
    RuleGroup -> Text
arn :: Prelude.Text,
    -- | Defines and enables Amazon CloudWatch metrics and web request sample
    -- collection.
    RuleGroup -> VisibilityConfig
visibilityConfig :: VisibilityConfig
  }
  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:
--
-- 'availableLabels', 'ruleGroup_availableLabels' - The labels that one or more rules in this rule group add to matching web
-- requests. These labels are defined in the @RuleLabels@ for a Rule.
--
-- 'consumedLabels', 'ruleGroup_consumedLabels' - The labels that one or more rules in this rule group match against in
-- label match statements. These labels are defined in a
-- @LabelMatchStatement@ specification, in the Statement definition of a
-- rule.
--
-- 'customResponseBodies', 'ruleGroup_customResponseBodies' - A map of custom response keys and content bodies. When you create a rule
-- with a block action, you can send a custom response to the web request.
-- You define these for the rule group, and then use them in the rules that
-- you define in the rule group.
--
-- For information about customizing web requests and responses, see
-- <https://docs.aws.amazon.com/waf/latest/developerguide/waf-custom-request-response.html Customizing web requests and responses in WAF>
-- in the
-- <https://docs.aws.amazon.com/waf/latest/developerguide/waf-chapter.html WAF Developer Guide>.
--
-- For information about the limits on count and size for custom request
-- and response settings, see
-- <https://docs.aws.amazon.com/waf/latest/developerguide/limits.html WAF quotas>
-- in the
-- <https://docs.aws.amazon.com/waf/latest/developerguide/waf-chapter.html WAF Developer Guide>.
--
-- 'description', 'ruleGroup_description' - A description of the rule group that helps with identification.
--
-- 'labelNamespace', 'ruleGroup_labelNamespace' - The label namespace prefix for this rule group. All labels added by
-- rules in this rule group have this prefix.
--
-- -   The syntax for the label namespace prefix for your rule groups is
--     the following:
--
--     @awswaf:\<account ID>:rulegroup:\<rule group name>:@
--
-- -   When a rule with a label matches a web request, WAF adds the fully
--     qualified label to the request. A fully qualified label is made up
--     of the label namespace from the rule group or web ACL where the rule
--     is defined and the label from the rule, separated by a colon:
--
--     @\<label namespace>:\<label from rule>@
--
-- 'rules', 'ruleGroup_rules' - The Rule statements used to identify the web requests that you want to
-- allow, block, or count. Each rule includes one top-level statement that
-- WAF uses to identify matching web requests, and parameters that govern
-- how WAF handles them.
--
-- 'name', 'ruleGroup_name' - The name of the rule group. You cannot change the name of a rule group
-- after you create it.
--
-- 'id', 'ruleGroup_id' - A unique identifier for the rule group. This ID is returned in the
-- responses to create and list commands. You provide it to operations like
-- update and delete.
--
-- 'capacity', 'ruleGroup_capacity' - The web ACL capacity units (WCUs) required for this rule group.
--
-- When you create your own rule group, you define this, and you cannot
-- change it after creation. When you add or modify the rules in a rule
-- group, WAF enforces this limit. You can check the capacity for a set of
-- rules using CheckCapacity.
--
-- WAF uses WCUs to calculate and control the operating resources that are
-- used to run your rules, rule groups, and web ACLs. WAF calculates
-- capacity differently for each rule type, to reflect the relative cost of
-- each rule. Simple rules that cost little to run use fewer WCUs than more
-- complex rules that use more processing power. Rule group capacity is
-- fixed at creation, which helps users plan their web ACL WCU usage when
-- they use a rule group. The WCU limit for web ACLs is 1,500.
--
-- 'arn', 'ruleGroup_arn' - The Amazon Resource Name (ARN) of the entity.
--
-- 'visibilityConfig', 'ruleGroup_visibilityConfig' - Defines and enables Amazon CloudWatch metrics and web request sample
-- collection.
newRuleGroup ::
  -- | 'name'
  Prelude.Text ->
  -- | 'id'
  Prelude.Text ->
  -- | 'capacity'
  Prelude.Natural ->
  -- | 'arn'
  Prelude.Text ->
  -- | 'visibilityConfig'
  VisibilityConfig ->
  RuleGroup
newRuleGroup :: Text -> Text -> Natural -> Text -> VisibilityConfig -> RuleGroup
newRuleGroup
  Text
pName_
  Text
pId_
  Natural
pCapacity_
  Text
pARN_
  VisibilityConfig
pVisibilityConfig_ =
    RuleGroup'
      { $sel:availableLabels:RuleGroup' :: Maybe [LabelSummary]
availableLabels = forall a. Maybe a
Prelude.Nothing,
        $sel:consumedLabels:RuleGroup' :: Maybe [LabelSummary]
consumedLabels = forall a. Maybe a
Prelude.Nothing,
        $sel:customResponseBodies:RuleGroup' :: Maybe (HashMap Text CustomResponseBody)
customResponseBodies = forall a. Maybe a
Prelude.Nothing,
        $sel:description:RuleGroup' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
        $sel:labelNamespace:RuleGroup' :: Maybe Text
labelNamespace = forall a. Maybe a
Prelude.Nothing,
        $sel:rules:RuleGroup' :: Maybe [Rule]
rules = forall a. Maybe a
Prelude.Nothing,
        $sel:name:RuleGroup' :: Text
name = Text
pName_,
        $sel:id:RuleGroup' :: Text
id = Text
pId_,
        $sel:capacity:RuleGroup' :: Natural
capacity = Natural
pCapacity_,
        $sel:arn:RuleGroup' :: Text
arn = Text
pARN_,
        $sel:visibilityConfig:RuleGroup' :: VisibilityConfig
visibilityConfig = VisibilityConfig
pVisibilityConfig_
      }

-- | The labels that one or more rules in this rule group add to matching web
-- requests. These labels are defined in the @RuleLabels@ for a Rule.
ruleGroup_availableLabels :: Lens.Lens' RuleGroup (Prelude.Maybe [LabelSummary])
ruleGroup_availableLabels :: Lens' RuleGroup (Maybe [LabelSummary])
ruleGroup_availableLabels = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RuleGroup' {Maybe [LabelSummary]
availableLabels :: Maybe [LabelSummary]
$sel:availableLabels:RuleGroup' :: RuleGroup -> Maybe [LabelSummary]
availableLabels} -> Maybe [LabelSummary]
availableLabels) (\s :: RuleGroup
s@RuleGroup' {} Maybe [LabelSummary]
a -> RuleGroup
s {$sel:availableLabels:RuleGroup' :: Maybe [LabelSummary]
availableLabels = Maybe [LabelSummary]
a} :: RuleGroup) 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

-- | The labels that one or more rules in this rule group match against in
-- label match statements. These labels are defined in a
-- @LabelMatchStatement@ specification, in the Statement definition of a
-- rule.
ruleGroup_consumedLabels :: Lens.Lens' RuleGroup (Prelude.Maybe [LabelSummary])
ruleGroup_consumedLabels :: Lens' RuleGroup (Maybe [LabelSummary])
ruleGroup_consumedLabels = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RuleGroup' {Maybe [LabelSummary]
consumedLabels :: Maybe [LabelSummary]
$sel:consumedLabels:RuleGroup' :: RuleGroup -> Maybe [LabelSummary]
consumedLabels} -> Maybe [LabelSummary]
consumedLabels) (\s :: RuleGroup
s@RuleGroup' {} Maybe [LabelSummary]
a -> RuleGroup
s {$sel:consumedLabels:RuleGroup' :: Maybe [LabelSummary]
consumedLabels = Maybe [LabelSummary]
a} :: RuleGroup) 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

-- | A map of custom response keys and content bodies. When you create a rule
-- with a block action, you can send a custom response to the web request.
-- You define these for the rule group, and then use them in the rules that
-- you define in the rule group.
--
-- For information about customizing web requests and responses, see
-- <https://docs.aws.amazon.com/waf/latest/developerguide/waf-custom-request-response.html Customizing web requests and responses in WAF>
-- in the
-- <https://docs.aws.amazon.com/waf/latest/developerguide/waf-chapter.html WAF Developer Guide>.
--
-- For information about the limits on count and size for custom request
-- and response settings, see
-- <https://docs.aws.amazon.com/waf/latest/developerguide/limits.html WAF quotas>
-- in the
-- <https://docs.aws.amazon.com/waf/latest/developerguide/waf-chapter.html WAF Developer Guide>.
ruleGroup_customResponseBodies :: Lens.Lens' RuleGroup (Prelude.Maybe (Prelude.HashMap Prelude.Text CustomResponseBody))
ruleGroup_customResponseBodies :: Lens' RuleGroup (Maybe (HashMap Text CustomResponseBody))
ruleGroup_customResponseBodies = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RuleGroup' {Maybe (HashMap Text CustomResponseBody)
customResponseBodies :: Maybe (HashMap Text CustomResponseBody)
$sel:customResponseBodies:RuleGroup' :: RuleGroup -> Maybe (HashMap Text CustomResponseBody)
customResponseBodies} -> Maybe (HashMap Text CustomResponseBody)
customResponseBodies) (\s :: RuleGroup
s@RuleGroup' {} Maybe (HashMap Text CustomResponseBody)
a -> RuleGroup
s {$sel:customResponseBodies:RuleGroup' :: Maybe (HashMap Text CustomResponseBody)
customResponseBodies = Maybe (HashMap Text CustomResponseBody)
a} :: RuleGroup) 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

-- | A description of the rule group that helps with identification.
ruleGroup_description :: Lens.Lens' RuleGroup (Prelude.Maybe Prelude.Text)
ruleGroup_description :: Lens' RuleGroup (Maybe Text)
ruleGroup_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RuleGroup' {Maybe Text
description :: Maybe Text
$sel:description:RuleGroup' :: RuleGroup -> Maybe Text
description} -> Maybe Text
description) (\s :: RuleGroup
s@RuleGroup' {} Maybe Text
a -> RuleGroup
s {$sel:description:RuleGroup' :: Maybe Text
description = Maybe Text
a} :: RuleGroup)

-- | The label namespace prefix for this rule group. All labels added by
-- rules in this rule group have this prefix.
--
-- -   The syntax for the label namespace prefix for your rule groups is
--     the following:
--
--     @awswaf:\<account ID>:rulegroup:\<rule group name>:@
--
-- -   When a rule with a label matches a web request, WAF adds the fully
--     qualified label to the request. A fully qualified label is made up
--     of the label namespace from the rule group or web ACL where the rule
--     is defined and the label from the rule, separated by a colon:
--
--     @\<label namespace>:\<label from rule>@
ruleGroup_labelNamespace :: Lens.Lens' RuleGroup (Prelude.Maybe Prelude.Text)
ruleGroup_labelNamespace :: Lens' RuleGroup (Maybe Text)
ruleGroup_labelNamespace = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RuleGroup' {Maybe Text
labelNamespace :: Maybe Text
$sel:labelNamespace:RuleGroup' :: RuleGroup -> Maybe Text
labelNamespace} -> Maybe Text
labelNamespace) (\s :: RuleGroup
s@RuleGroup' {} Maybe Text
a -> RuleGroup
s {$sel:labelNamespace:RuleGroup' :: Maybe Text
labelNamespace = Maybe Text
a} :: RuleGroup)

-- | The Rule statements used to identify the web requests that you want to
-- allow, block, or count. Each rule includes one top-level statement that
-- WAF uses to identify matching web requests, and parameters that govern
-- how WAF handles them.
ruleGroup_rules :: Lens.Lens' RuleGroup (Prelude.Maybe [Rule])
ruleGroup_rules :: Lens' RuleGroup (Maybe [Rule])
ruleGroup_rules = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RuleGroup' {Maybe [Rule]
rules :: Maybe [Rule]
$sel:rules:RuleGroup' :: RuleGroup -> Maybe [Rule]
rules} -> Maybe [Rule]
rules) (\s :: RuleGroup
s@RuleGroup' {} Maybe [Rule]
a -> RuleGroup
s {$sel:rules:RuleGroup' :: Maybe [Rule]
rules = Maybe [Rule]
a} :: RuleGroup) 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

-- | The name of the rule group. You cannot change the name of a rule group
-- after you create it.
ruleGroup_name :: Lens.Lens' RuleGroup Prelude.Text
ruleGroup_name :: Lens' RuleGroup Text
ruleGroup_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RuleGroup' {Text
name :: Text
$sel:name:RuleGroup' :: RuleGroup -> Text
name} -> Text
name) (\s :: RuleGroup
s@RuleGroup' {} Text
a -> RuleGroup
s {$sel:name:RuleGroup' :: Text
name = Text
a} :: RuleGroup)

-- | A unique identifier for the rule group. This ID is returned in the
-- responses to create and list commands. You provide it to operations like
-- update and delete.
ruleGroup_id :: Lens.Lens' RuleGroup Prelude.Text
ruleGroup_id :: Lens' RuleGroup Text
ruleGroup_id = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RuleGroup' {Text
id :: Text
$sel:id:RuleGroup' :: RuleGroup -> Text
id} -> Text
id) (\s :: RuleGroup
s@RuleGroup' {} Text
a -> RuleGroup
s {$sel:id:RuleGroup' :: Text
id = Text
a} :: RuleGroup)

-- | The web ACL capacity units (WCUs) required for this rule group.
--
-- When you create your own rule group, you define this, and you cannot
-- change it after creation. When you add or modify the rules in a rule
-- group, WAF enforces this limit. You can check the capacity for a set of
-- rules using CheckCapacity.
--
-- WAF uses WCUs to calculate and control the operating resources that are
-- used to run your rules, rule groups, and web ACLs. WAF calculates
-- capacity differently for each rule type, to reflect the relative cost of
-- each rule. Simple rules that cost little to run use fewer WCUs than more
-- complex rules that use more processing power. Rule group capacity is
-- fixed at creation, which helps users plan their web ACL WCU usage when
-- they use a rule group. The WCU limit for web ACLs is 1,500.
ruleGroup_capacity :: Lens.Lens' RuleGroup Prelude.Natural
ruleGroup_capacity :: Lens' RuleGroup Natural
ruleGroup_capacity = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RuleGroup' {Natural
capacity :: Natural
$sel:capacity:RuleGroup' :: RuleGroup -> Natural
capacity} -> Natural
capacity) (\s :: RuleGroup
s@RuleGroup' {} Natural
a -> RuleGroup
s {$sel:capacity:RuleGroup' :: Natural
capacity = Natural
a} :: RuleGroup)

-- | The Amazon Resource Name (ARN) of the entity.
ruleGroup_arn :: Lens.Lens' RuleGroup Prelude.Text
ruleGroup_arn :: Lens' RuleGroup Text
ruleGroup_arn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RuleGroup' {Text
arn :: Text
$sel:arn:RuleGroup' :: RuleGroup -> Text
arn} -> Text
arn) (\s :: RuleGroup
s@RuleGroup' {} Text
a -> RuleGroup
s {$sel:arn:RuleGroup' :: Text
arn = Text
a} :: RuleGroup)

-- | Defines and enables Amazon CloudWatch metrics and web request sample
-- collection.
ruleGroup_visibilityConfig :: Lens.Lens' RuleGroup VisibilityConfig
ruleGroup_visibilityConfig :: Lens' RuleGroup VisibilityConfig
ruleGroup_visibilityConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RuleGroup' {VisibilityConfig
visibilityConfig :: VisibilityConfig
$sel:visibilityConfig:RuleGroup' :: RuleGroup -> VisibilityConfig
visibilityConfig} -> VisibilityConfig
visibilityConfig) (\s :: RuleGroup
s@RuleGroup' {} VisibilityConfig
a -> RuleGroup
s {$sel:visibilityConfig:RuleGroup' :: VisibilityConfig
visibilityConfig = VisibilityConfig
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 [LabelSummary]
-> Maybe [LabelSummary]
-> Maybe (HashMap Text CustomResponseBody)
-> Maybe Text
-> Maybe Text
-> Maybe [Rule]
-> Text
-> Text
-> Natural
-> Text
-> VisibilityConfig
-> 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
"AvailableLabels"
                            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
"ConsumedLabels" 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
"CustomResponseBodies"
                            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
"Description")
            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
"LabelNamespace")
            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
"Rules" 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 a
Data..: Key
"Name")
            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
"Id")
            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
"Capacity")
            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
"ARN")
            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
"VisibilityConfig")
      )

instance Prelude.Hashable RuleGroup where
  hashWithSalt :: Int -> RuleGroup -> Int
hashWithSalt Int
_salt RuleGroup' {Natural
Maybe [LabelSummary]
Maybe [Rule]
Maybe Text
Maybe (HashMap Text CustomResponseBody)
Text
VisibilityConfig
visibilityConfig :: VisibilityConfig
arn :: Text
capacity :: Natural
id :: Text
name :: Text
rules :: Maybe [Rule]
labelNamespace :: Maybe Text
description :: Maybe Text
customResponseBodies :: Maybe (HashMap Text CustomResponseBody)
consumedLabels :: Maybe [LabelSummary]
availableLabels :: Maybe [LabelSummary]
$sel:visibilityConfig:RuleGroup' :: RuleGroup -> VisibilityConfig
$sel:arn:RuleGroup' :: RuleGroup -> Text
$sel:capacity:RuleGroup' :: RuleGroup -> Natural
$sel:id:RuleGroup' :: RuleGroup -> Text
$sel:name:RuleGroup' :: RuleGroup -> Text
$sel:rules:RuleGroup' :: RuleGroup -> Maybe [Rule]
$sel:labelNamespace:RuleGroup' :: RuleGroup -> Maybe Text
$sel:description:RuleGroup' :: RuleGroup -> Maybe Text
$sel:customResponseBodies:RuleGroup' :: RuleGroup -> Maybe (HashMap Text CustomResponseBody)
$sel:consumedLabels:RuleGroup' :: RuleGroup -> Maybe [LabelSummary]
$sel:availableLabels:RuleGroup' :: RuleGroup -> Maybe [LabelSummary]
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [LabelSummary]
availableLabels
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [LabelSummary]
consumedLabels
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text CustomResponseBody)
customResponseBodies
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
labelNamespace
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Rule]
rules
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
name
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
id
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Natural
capacity
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
arn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` VisibilityConfig
visibilityConfig

instance Prelude.NFData RuleGroup where
  rnf :: RuleGroup -> ()
rnf RuleGroup' {Natural
Maybe [LabelSummary]
Maybe [Rule]
Maybe Text
Maybe (HashMap Text CustomResponseBody)
Text
VisibilityConfig
visibilityConfig :: VisibilityConfig
arn :: Text
capacity :: Natural
id :: Text
name :: Text
rules :: Maybe [Rule]
labelNamespace :: Maybe Text
description :: Maybe Text
customResponseBodies :: Maybe (HashMap Text CustomResponseBody)
consumedLabels :: Maybe [LabelSummary]
availableLabels :: Maybe [LabelSummary]
$sel:visibilityConfig:RuleGroup' :: RuleGroup -> VisibilityConfig
$sel:arn:RuleGroup' :: RuleGroup -> Text
$sel:capacity:RuleGroup' :: RuleGroup -> Natural
$sel:id:RuleGroup' :: RuleGroup -> Text
$sel:name:RuleGroup' :: RuleGroup -> Text
$sel:rules:RuleGroup' :: RuleGroup -> Maybe [Rule]
$sel:labelNamespace:RuleGroup' :: RuleGroup -> Maybe Text
$sel:description:RuleGroup' :: RuleGroup -> Maybe Text
$sel:customResponseBodies:RuleGroup' :: RuleGroup -> Maybe (HashMap Text CustomResponseBody)
$sel:consumedLabels:RuleGroup' :: RuleGroup -> Maybe [LabelSummary]
$sel:availableLabels:RuleGroup' :: RuleGroup -> Maybe [LabelSummary]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [LabelSummary]
availableLabels
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [LabelSummary]
consumedLabels
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text CustomResponseBody)
customResponseBodies
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
description
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
labelNamespace
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Rule]
rules
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
name
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
id
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Natural
capacity
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
arn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf VisibilityConfig
visibilityConfig