{-# 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.Shield.Types.ProtectionGroup
-- 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.Shield.Types.ProtectionGroup 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.Shield.Types.ProtectedResourceType
import Amazonka.Shield.Types.ProtectionGroupAggregation
import Amazonka.Shield.Types.ProtectionGroupPattern

-- | A grouping of protected resources that you and Shield Advanced can
-- monitor as a collective. This resource grouping improves the accuracy of
-- detection and reduces false positives.
--
-- /See:/ 'newProtectionGroup' smart constructor.
data ProtectionGroup = ProtectionGroup'
  { -- | The ARN (Amazon Resource Name) of the protection group.
    ProtectionGroup -> Maybe Text
protectionGroupArn :: Prelude.Maybe Prelude.Text,
    -- | The resource type to include in the protection group. All protected
    -- resources of this type are included in the protection group. You must
    -- set this when you set @Pattern@ to @BY_RESOURCE_TYPE@ and you must not
    -- set it for any other @Pattern@ setting.
    ProtectionGroup -> Maybe ProtectedResourceType
resourceType :: Prelude.Maybe ProtectedResourceType,
    -- | The name of the protection group. You use this to identify the
    -- protection group in lists and to manage the protection group, for
    -- example to update, delete, or describe it.
    ProtectionGroup -> Text
protectionGroupId :: Prelude.Text,
    -- | Defines how Shield combines resource data for the group in order to
    -- detect, mitigate, and report events.
    --
    -- -   Sum - Use the total traffic across the group. This is a good choice
    --     for most cases. Examples include Elastic IP addresses for EC2
    --     instances that scale manually or automatically.
    --
    -- -   Mean - Use the average of the traffic across the group. This is a
    --     good choice for resources that share traffic uniformly. Examples
    --     include accelerators and load balancers.
    --
    -- -   Max - Use the highest traffic from each resource. This is useful for
    --     resources that don\'t share traffic and for resources that share
    --     that traffic in a non-uniform way. Examples include Amazon
    --     CloudFront distributions and origin resources for CloudFront
    --     distributions.
    ProtectionGroup -> ProtectionGroupAggregation
aggregation :: ProtectionGroupAggregation,
    -- | The criteria to use to choose the protected resources for inclusion in
    -- the group. You can include all resources that have protections, provide
    -- a list of resource ARNs (Amazon Resource Names), or include all
    -- resources of a specified resource type.
    ProtectionGroup -> ProtectionGroupPattern
pattern' :: ProtectionGroupPattern,
    -- | The ARNs (Amazon Resource Names) of the resources to include in the
    -- protection group. You must set this when you set @Pattern@ to
    -- @ARBITRARY@ and you must not set it for any other @Pattern@ setting.
    ProtectionGroup -> [Text]
members :: [Prelude.Text]
  }
  deriving (ProtectionGroup -> ProtectionGroup -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ProtectionGroup -> ProtectionGroup -> Bool
$c/= :: ProtectionGroup -> ProtectionGroup -> Bool
== :: ProtectionGroup -> ProtectionGroup -> Bool
$c== :: ProtectionGroup -> ProtectionGroup -> Bool
Prelude.Eq, ReadPrec [ProtectionGroup]
ReadPrec ProtectionGroup
Int -> ReadS ProtectionGroup
ReadS [ProtectionGroup]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ProtectionGroup]
$creadListPrec :: ReadPrec [ProtectionGroup]
readPrec :: ReadPrec ProtectionGroup
$creadPrec :: ReadPrec ProtectionGroup
readList :: ReadS [ProtectionGroup]
$creadList :: ReadS [ProtectionGroup]
readsPrec :: Int -> ReadS ProtectionGroup
$creadsPrec :: Int -> ReadS ProtectionGroup
Prelude.Read, Int -> ProtectionGroup -> ShowS
[ProtectionGroup] -> ShowS
ProtectionGroup -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ProtectionGroup] -> ShowS
$cshowList :: [ProtectionGroup] -> ShowS
show :: ProtectionGroup -> String
$cshow :: ProtectionGroup -> String
showsPrec :: Int -> ProtectionGroup -> ShowS
$cshowsPrec :: Int -> ProtectionGroup -> ShowS
Prelude.Show, forall x. Rep ProtectionGroup x -> ProtectionGroup
forall x. ProtectionGroup -> Rep ProtectionGroup x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ProtectionGroup x -> ProtectionGroup
$cfrom :: forall x. ProtectionGroup -> Rep ProtectionGroup x
Prelude.Generic)

-- |
-- Create a value of 'ProtectionGroup' 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:
--
-- 'protectionGroupArn', 'protectionGroup_protectionGroupArn' - The ARN (Amazon Resource Name) of the protection group.
--
-- 'resourceType', 'protectionGroup_resourceType' - The resource type to include in the protection group. All protected
-- resources of this type are included in the protection group. You must
-- set this when you set @Pattern@ to @BY_RESOURCE_TYPE@ and you must not
-- set it for any other @Pattern@ setting.
--
-- 'protectionGroupId', 'protectionGroup_protectionGroupId' - The name of the protection group. You use this to identify the
-- protection group in lists and to manage the protection group, for
-- example to update, delete, or describe it.
--
-- 'aggregation', 'protectionGroup_aggregation' - Defines how Shield combines resource data for the group in order to
-- detect, mitigate, and report events.
--
-- -   Sum - Use the total traffic across the group. This is a good choice
--     for most cases. Examples include Elastic IP addresses for EC2
--     instances that scale manually or automatically.
--
-- -   Mean - Use the average of the traffic across the group. This is a
--     good choice for resources that share traffic uniformly. Examples
--     include accelerators and load balancers.
--
-- -   Max - Use the highest traffic from each resource. This is useful for
--     resources that don\'t share traffic and for resources that share
--     that traffic in a non-uniform way. Examples include Amazon
--     CloudFront distributions and origin resources for CloudFront
--     distributions.
--
-- 'pattern'', 'protectionGroup_pattern' - The criteria to use to choose the protected resources for inclusion in
-- the group. You can include all resources that have protections, provide
-- a list of resource ARNs (Amazon Resource Names), or include all
-- resources of a specified resource type.
--
-- 'members', 'protectionGroup_members' - The ARNs (Amazon Resource Names) of the resources to include in the
-- protection group. You must set this when you set @Pattern@ to
-- @ARBITRARY@ and you must not set it for any other @Pattern@ setting.
newProtectionGroup ::
  -- | 'protectionGroupId'
  Prelude.Text ->
  -- | 'aggregation'
  ProtectionGroupAggregation ->
  -- | 'pattern''
  ProtectionGroupPattern ->
  ProtectionGroup
newProtectionGroup :: Text
-> ProtectionGroupAggregation
-> ProtectionGroupPattern
-> ProtectionGroup
newProtectionGroup
  Text
pProtectionGroupId_
  ProtectionGroupAggregation
pAggregation_
  ProtectionGroupPattern
pPattern_ =
    ProtectionGroup'
      { $sel:protectionGroupArn:ProtectionGroup' :: Maybe Text
protectionGroupArn =
          forall a. Maybe a
Prelude.Nothing,
        $sel:resourceType:ProtectionGroup' :: Maybe ProtectedResourceType
resourceType = forall a. Maybe a
Prelude.Nothing,
        $sel:protectionGroupId:ProtectionGroup' :: Text
protectionGroupId = Text
pProtectionGroupId_,
        $sel:aggregation:ProtectionGroup' :: ProtectionGroupAggregation
aggregation = ProtectionGroupAggregation
pAggregation_,
        $sel:pattern':ProtectionGroup' :: ProtectionGroupPattern
pattern' = ProtectionGroupPattern
pPattern_,
        $sel:members:ProtectionGroup' :: [Text]
members = forall a. Monoid a => a
Prelude.mempty
      }

-- | The ARN (Amazon Resource Name) of the protection group.
protectionGroup_protectionGroupArn :: Lens.Lens' ProtectionGroup (Prelude.Maybe Prelude.Text)
protectionGroup_protectionGroupArn :: Lens' ProtectionGroup (Maybe Text)
protectionGroup_protectionGroupArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ProtectionGroup' {Maybe Text
protectionGroupArn :: Maybe Text
$sel:protectionGroupArn:ProtectionGroup' :: ProtectionGroup -> Maybe Text
protectionGroupArn} -> Maybe Text
protectionGroupArn) (\s :: ProtectionGroup
s@ProtectionGroup' {} Maybe Text
a -> ProtectionGroup
s {$sel:protectionGroupArn:ProtectionGroup' :: Maybe Text
protectionGroupArn = Maybe Text
a} :: ProtectionGroup)

-- | The resource type to include in the protection group. All protected
-- resources of this type are included in the protection group. You must
-- set this when you set @Pattern@ to @BY_RESOURCE_TYPE@ and you must not
-- set it for any other @Pattern@ setting.
protectionGroup_resourceType :: Lens.Lens' ProtectionGroup (Prelude.Maybe ProtectedResourceType)
protectionGroup_resourceType :: Lens' ProtectionGroup (Maybe ProtectedResourceType)
protectionGroup_resourceType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ProtectionGroup' {Maybe ProtectedResourceType
resourceType :: Maybe ProtectedResourceType
$sel:resourceType:ProtectionGroup' :: ProtectionGroup -> Maybe ProtectedResourceType
resourceType} -> Maybe ProtectedResourceType
resourceType) (\s :: ProtectionGroup
s@ProtectionGroup' {} Maybe ProtectedResourceType
a -> ProtectionGroup
s {$sel:resourceType:ProtectionGroup' :: Maybe ProtectedResourceType
resourceType = Maybe ProtectedResourceType
a} :: ProtectionGroup)

-- | The name of the protection group. You use this to identify the
-- protection group in lists and to manage the protection group, for
-- example to update, delete, or describe it.
protectionGroup_protectionGroupId :: Lens.Lens' ProtectionGroup Prelude.Text
protectionGroup_protectionGroupId :: Lens' ProtectionGroup Text
protectionGroup_protectionGroupId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ProtectionGroup' {Text
protectionGroupId :: Text
$sel:protectionGroupId:ProtectionGroup' :: ProtectionGroup -> Text
protectionGroupId} -> Text
protectionGroupId) (\s :: ProtectionGroup
s@ProtectionGroup' {} Text
a -> ProtectionGroup
s {$sel:protectionGroupId:ProtectionGroup' :: Text
protectionGroupId = Text
a} :: ProtectionGroup)

-- | Defines how Shield combines resource data for the group in order to
-- detect, mitigate, and report events.
--
-- -   Sum - Use the total traffic across the group. This is a good choice
--     for most cases. Examples include Elastic IP addresses for EC2
--     instances that scale manually or automatically.
--
-- -   Mean - Use the average of the traffic across the group. This is a
--     good choice for resources that share traffic uniformly. Examples
--     include accelerators and load balancers.
--
-- -   Max - Use the highest traffic from each resource. This is useful for
--     resources that don\'t share traffic and for resources that share
--     that traffic in a non-uniform way. Examples include Amazon
--     CloudFront distributions and origin resources for CloudFront
--     distributions.
protectionGroup_aggregation :: Lens.Lens' ProtectionGroup ProtectionGroupAggregation
protectionGroup_aggregation :: Lens' ProtectionGroup ProtectionGroupAggregation
protectionGroup_aggregation = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ProtectionGroup' {ProtectionGroupAggregation
aggregation :: ProtectionGroupAggregation
$sel:aggregation:ProtectionGroup' :: ProtectionGroup -> ProtectionGroupAggregation
aggregation} -> ProtectionGroupAggregation
aggregation) (\s :: ProtectionGroup
s@ProtectionGroup' {} ProtectionGroupAggregation
a -> ProtectionGroup
s {$sel:aggregation:ProtectionGroup' :: ProtectionGroupAggregation
aggregation = ProtectionGroupAggregation
a} :: ProtectionGroup)

-- | The criteria to use to choose the protected resources for inclusion in
-- the group. You can include all resources that have protections, provide
-- a list of resource ARNs (Amazon Resource Names), or include all
-- resources of a specified resource type.
protectionGroup_pattern :: Lens.Lens' ProtectionGroup ProtectionGroupPattern
protectionGroup_pattern :: Lens' ProtectionGroup ProtectionGroupPattern
protectionGroup_pattern = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ProtectionGroup' {ProtectionGroupPattern
pattern' :: ProtectionGroupPattern
$sel:pattern':ProtectionGroup' :: ProtectionGroup -> ProtectionGroupPattern
pattern'} -> ProtectionGroupPattern
pattern') (\s :: ProtectionGroup
s@ProtectionGroup' {} ProtectionGroupPattern
a -> ProtectionGroup
s {$sel:pattern':ProtectionGroup' :: ProtectionGroupPattern
pattern' = ProtectionGroupPattern
a} :: ProtectionGroup)

-- | The ARNs (Amazon Resource Names) of the resources to include in the
-- protection group. You must set this when you set @Pattern@ to
-- @ARBITRARY@ and you must not set it for any other @Pattern@ setting.
protectionGroup_members :: Lens.Lens' ProtectionGroup [Prelude.Text]
protectionGroup_members :: Lens' ProtectionGroup [Text]
protectionGroup_members = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ProtectionGroup' {[Text]
members :: [Text]
$sel:members:ProtectionGroup' :: ProtectionGroup -> [Text]
members} -> [Text]
members) (\s :: ProtectionGroup
s@ProtectionGroup' {} [Text]
a -> ProtectionGroup
s {$sel:members:ProtectionGroup' :: [Text]
members = [Text]
a} :: ProtectionGroup) 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 ProtectionGroup where
  parseJSON :: Value -> Parser ProtectionGroup
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"ProtectionGroup"
      ( \Object
x ->
          Maybe Text
-> Maybe ProtectedResourceType
-> Text
-> ProtectionGroupAggregation
-> ProtectionGroupPattern
-> [Text]
-> ProtectionGroup
ProtectionGroup'
            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
"ProtectionGroupArn")
            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
"ResourceType")
            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
"ProtectionGroupId")
            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
"Aggregation")
            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
"Pattern")
            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
"Members" forall a. Parser (Maybe a) -> a -> Parser a
Data..!= forall a. Monoid a => a
Prelude.mempty)
      )

instance Prelude.Hashable ProtectionGroup where
  hashWithSalt :: Int -> ProtectionGroup -> Int
hashWithSalt Int
_salt ProtectionGroup' {[Text]
Maybe Text
Maybe ProtectedResourceType
Text
ProtectionGroupAggregation
ProtectionGroupPattern
members :: [Text]
pattern' :: ProtectionGroupPattern
aggregation :: ProtectionGroupAggregation
protectionGroupId :: Text
resourceType :: Maybe ProtectedResourceType
protectionGroupArn :: Maybe Text
$sel:members:ProtectionGroup' :: ProtectionGroup -> [Text]
$sel:pattern':ProtectionGroup' :: ProtectionGroup -> ProtectionGroupPattern
$sel:aggregation:ProtectionGroup' :: ProtectionGroup -> ProtectionGroupAggregation
$sel:protectionGroupId:ProtectionGroup' :: ProtectionGroup -> Text
$sel:resourceType:ProtectionGroup' :: ProtectionGroup -> Maybe ProtectedResourceType
$sel:protectionGroupArn:ProtectionGroup' :: ProtectionGroup -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
protectionGroupArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ProtectedResourceType
resourceType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
protectionGroupId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` ProtectionGroupAggregation
aggregation
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` ProtectionGroupPattern
pattern'
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` [Text]
members

instance Prelude.NFData ProtectionGroup where
  rnf :: ProtectionGroup -> ()
rnf ProtectionGroup' {[Text]
Maybe Text
Maybe ProtectedResourceType
Text
ProtectionGroupAggregation
ProtectionGroupPattern
members :: [Text]
pattern' :: ProtectionGroupPattern
aggregation :: ProtectionGroupAggregation
protectionGroupId :: Text
resourceType :: Maybe ProtectedResourceType
protectionGroupArn :: Maybe Text
$sel:members:ProtectionGroup' :: ProtectionGroup -> [Text]
$sel:pattern':ProtectionGroup' :: ProtectionGroup -> ProtectionGroupPattern
$sel:aggregation:ProtectionGroup' :: ProtectionGroup -> ProtectionGroupAggregation
$sel:protectionGroupId:ProtectionGroup' :: ProtectionGroup -> Text
$sel:resourceType:ProtectionGroup' :: ProtectionGroup -> Maybe ProtectedResourceType
$sel:protectionGroupArn:ProtectionGroup' :: ProtectionGroup -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
protectionGroupArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ProtectedResourceType
resourceType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
protectionGroupId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf ProtectionGroupAggregation
aggregation
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf ProtectionGroupPattern
pattern'
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf [Text]
members