{-# 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.AttackProperty
-- 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.AttackProperty 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.AttackLayer
import Amazonka.Shield.Types.AttackPropertyIdentifier
import Amazonka.Shield.Types.Contributor
import Amazonka.Shield.Types.Unit

-- | Details of a Shield event. This is provided as part of an AttackDetail.
--
-- /See:/ 'newAttackProperty' smart constructor.
data AttackProperty = AttackProperty'
  { -- | The type of Shield event that was observed. @NETWORK@ indicates layer 3
    -- and layer 4 events and @APPLICATION@ indicates layer 7 events.
    --
    -- For infrastructure layer events (L3 and L4 events), you can view metrics
    -- for top contributors in Amazon CloudWatch metrics. For more information,
    -- see
    -- <https://docs.aws.amazon.com/waf/latest/developerguide/monitoring-cloudwatch.html#set-ddos-alarms Shield metrics and alarms>
    -- in the /WAF Developer Guide/.
    AttackProperty -> Maybe AttackLayer
attackLayer :: Prelude.Maybe AttackLayer,
    -- | Defines the Shield event property information that is provided. The
    -- @WORDPRESS_PINGBACK_REFLECTOR@ and @WORDPRESS_PINGBACK_SOURCE@ values
    -- are valid only for WordPress reflective pingback events.
    AttackProperty -> Maybe AttackPropertyIdentifier
attackPropertyIdentifier :: Prelude.Maybe AttackPropertyIdentifier,
    -- | Contributor objects for the top five contributors to a Shield event. A
    -- contributor is a source of traffic that Shield Advanced identifies as
    -- responsible for some or all of an event.
    AttackProperty -> Maybe [Contributor]
topContributors :: Prelude.Maybe [Contributor],
    -- | The total contributions made to this Shield event by all contributors.
    AttackProperty -> Maybe Integer
total :: Prelude.Maybe Prelude.Integer,
    -- | The unit used for the @Contributor@ @Value@ property.
    AttackProperty -> Maybe Unit
unit :: Prelude.Maybe Unit
  }
  deriving (AttackProperty -> AttackProperty -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AttackProperty -> AttackProperty -> Bool
$c/= :: AttackProperty -> AttackProperty -> Bool
== :: AttackProperty -> AttackProperty -> Bool
$c== :: AttackProperty -> AttackProperty -> Bool
Prelude.Eq, ReadPrec [AttackProperty]
ReadPrec AttackProperty
Int -> ReadS AttackProperty
ReadS [AttackProperty]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AttackProperty]
$creadListPrec :: ReadPrec [AttackProperty]
readPrec :: ReadPrec AttackProperty
$creadPrec :: ReadPrec AttackProperty
readList :: ReadS [AttackProperty]
$creadList :: ReadS [AttackProperty]
readsPrec :: Int -> ReadS AttackProperty
$creadsPrec :: Int -> ReadS AttackProperty
Prelude.Read, Int -> AttackProperty -> ShowS
[AttackProperty] -> ShowS
AttackProperty -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AttackProperty] -> ShowS
$cshowList :: [AttackProperty] -> ShowS
show :: AttackProperty -> String
$cshow :: AttackProperty -> String
showsPrec :: Int -> AttackProperty -> ShowS
$cshowsPrec :: Int -> AttackProperty -> ShowS
Prelude.Show, forall x. Rep AttackProperty x -> AttackProperty
forall x. AttackProperty -> Rep AttackProperty x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AttackProperty x -> AttackProperty
$cfrom :: forall x. AttackProperty -> Rep AttackProperty x
Prelude.Generic)

-- |
-- Create a value of 'AttackProperty' 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:
--
-- 'attackLayer', 'attackProperty_attackLayer' - The type of Shield event that was observed. @NETWORK@ indicates layer 3
-- and layer 4 events and @APPLICATION@ indicates layer 7 events.
--
-- For infrastructure layer events (L3 and L4 events), you can view metrics
-- for top contributors in Amazon CloudWatch metrics. For more information,
-- see
-- <https://docs.aws.amazon.com/waf/latest/developerguide/monitoring-cloudwatch.html#set-ddos-alarms Shield metrics and alarms>
-- in the /WAF Developer Guide/.
--
-- 'attackPropertyIdentifier', 'attackProperty_attackPropertyIdentifier' - Defines the Shield event property information that is provided. The
-- @WORDPRESS_PINGBACK_REFLECTOR@ and @WORDPRESS_PINGBACK_SOURCE@ values
-- are valid only for WordPress reflective pingback events.
--
-- 'topContributors', 'attackProperty_topContributors' - Contributor objects for the top five contributors to a Shield event. A
-- contributor is a source of traffic that Shield Advanced identifies as
-- responsible for some or all of an event.
--
-- 'total', 'attackProperty_total' - The total contributions made to this Shield event by all contributors.
--
-- 'unit', 'attackProperty_unit' - The unit used for the @Contributor@ @Value@ property.
newAttackProperty ::
  AttackProperty
newAttackProperty :: AttackProperty
newAttackProperty =
  AttackProperty'
    { $sel:attackLayer:AttackProperty' :: Maybe AttackLayer
attackLayer = forall a. Maybe a
Prelude.Nothing,
      $sel:attackPropertyIdentifier:AttackProperty' :: Maybe AttackPropertyIdentifier
attackPropertyIdentifier = forall a. Maybe a
Prelude.Nothing,
      $sel:topContributors:AttackProperty' :: Maybe [Contributor]
topContributors = forall a. Maybe a
Prelude.Nothing,
      $sel:total:AttackProperty' :: Maybe Integer
total = forall a. Maybe a
Prelude.Nothing,
      $sel:unit:AttackProperty' :: Maybe Unit
unit = forall a. Maybe a
Prelude.Nothing
    }

-- | The type of Shield event that was observed. @NETWORK@ indicates layer 3
-- and layer 4 events and @APPLICATION@ indicates layer 7 events.
--
-- For infrastructure layer events (L3 and L4 events), you can view metrics
-- for top contributors in Amazon CloudWatch metrics. For more information,
-- see
-- <https://docs.aws.amazon.com/waf/latest/developerguide/monitoring-cloudwatch.html#set-ddos-alarms Shield metrics and alarms>
-- in the /WAF Developer Guide/.
attackProperty_attackLayer :: Lens.Lens' AttackProperty (Prelude.Maybe AttackLayer)
attackProperty_attackLayer :: Lens' AttackProperty (Maybe AttackLayer)
attackProperty_attackLayer = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AttackProperty' {Maybe AttackLayer
attackLayer :: Maybe AttackLayer
$sel:attackLayer:AttackProperty' :: AttackProperty -> Maybe AttackLayer
attackLayer} -> Maybe AttackLayer
attackLayer) (\s :: AttackProperty
s@AttackProperty' {} Maybe AttackLayer
a -> AttackProperty
s {$sel:attackLayer:AttackProperty' :: Maybe AttackLayer
attackLayer = Maybe AttackLayer
a} :: AttackProperty)

-- | Defines the Shield event property information that is provided. The
-- @WORDPRESS_PINGBACK_REFLECTOR@ and @WORDPRESS_PINGBACK_SOURCE@ values
-- are valid only for WordPress reflective pingback events.
attackProperty_attackPropertyIdentifier :: Lens.Lens' AttackProperty (Prelude.Maybe AttackPropertyIdentifier)
attackProperty_attackPropertyIdentifier :: Lens' AttackProperty (Maybe AttackPropertyIdentifier)
attackProperty_attackPropertyIdentifier = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AttackProperty' {Maybe AttackPropertyIdentifier
attackPropertyIdentifier :: Maybe AttackPropertyIdentifier
$sel:attackPropertyIdentifier:AttackProperty' :: AttackProperty -> Maybe AttackPropertyIdentifier
attackPropertyIdentifier} -> Maybe AttackPropertyIdentifier
attackPropertyIdentifier) (\s :: AttackProperty
s@AttackProperty' {} Maybe AttackPropertyIdentifier
a -> AttackProperty
s {$sel:attackPropertyIdentifier:AttackProperty' :: Maybe AttackPropertyIdentifier
attackPropertyIdentifier = Maybe AttackPropertyIdentifier
a} :: AttackProperty)

-- | Contributor objects for the top five contributors to a Shield event. A
-- contributor is a source of traffic that Shield Advanced identifies as
-- responsible for some or all of an event.
attackProperty_topContributors :: Lens.Lens' AttackProperty (Prelude.Maybe [Contributor])
attackProperty_topContributors :: Lens' AttackProperty (Maybe [Contributor])
attackProperty_topContributors = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AttackProperty' {Maybe [Contributor]
topContributors :: Maybe [Contributor]
$sel:topContributors:AttackProperty' :: AttackProperty -> Maybe [Contributor]
topContributors} -> Maybe [Contributor]
topContributors) (\s :: AttackProperty
s@AttackProperty' {} Maybe [Contributor]
a -> AttackProperty
s {$sel:topContributors:AttackProperty' :: Maybe [Contributor]
topContributors = Maybe [Contributor]
a} :: AttackProperty) 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 total contributions made to this Shield event by all contributors.
attackProperty_total :: Lens.Lens' AttackProperty (Prelude.Maybe Prelude.Integer)
attackProperty_total :: Lens' AttackProperty (Maybe Integer)
attackProperty_total = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AttackProperty' {Maybe Integer
total :: Maybe Integer
$sel:total:AttackProperty' :: AttackProperty -> Maybe Integer
total} -> Maybe Integer
total) (\s :: AttackProperty
s@AttackProperty' {} Maybe Integer
a -> AttackProperty
s {$sel:total:AttackProperty' :: Maybe Integer
total = Maybe Integer
a} :: AttackProperty)

-- | The unit used for the @Contributor@ @Value@ property.
attackProperty_unit :: Lens.Lens' AttackProperty (Prelude.Maybe Unit)
attackProperty_unit :: Lens' AttackProperty (Maybe Unit)
attackProperty_unit = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AttackProperty' {Maybe Unit
unit :: Maybe Unit
$sel:unit:AttackProperty' :: AttackProperty -> Maybe Unit
unit} -> Maybe Unit
unit) (\s :: AttackProperty
s@AttackProperty' {} Maybe Unit
a -> AttackProperty
s {$sel:unit:AttackProperty' :: Maybe Unit
unit = Maybe Unit
a} :: AttackProperty)

instance Data.FromJSON AttackProperty where
  parseJSON :: Value -> Parser AttackProperty
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"AttackProperty"
      ( \Object
x ->
          Maybe AttackLayer
-> Maybe AttackPropertyIdentifier
-> Maybe [Contributor]
-> Maybe Integer
-> Maybe Unit
-> AttackProperty
AttackProperty'
            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
"AttackLayer")
            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
"AttackPropertyIdentifier")
            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
"TopContributors"
                            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
"Total")
            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
"Unit")
      )

instance Prelude.Hashable AttackProperty where
  hashWithSalt :: Int -> AttackProperty -> Int
hashWithSalt Int
_salt AttackProperty' {Maybe Integer
Maybe [Contributor]
Maybe AttackLayer
Maybe AttackPropertyIdentifier
Maybe Unit
unit :: Maybe Unit
total :: Maybe Integer
topContributors :: Maybe [Contributor]
attackPropertyIdentifier :: Maybe AttackPropertyIdentifier
attackLayer :: Maybe AttackLayer
$sel:unit:AttackProperty' :: AttackProperty -> Maybe Unit
$sel:total:AttackProperty' :: AttackProperty -> Maybe Integer
$sel:topContributors:AttackProperty' :: AttackProperty -> Maybe [Contributor]
$sel:attackPropertyIdentifier:AttackProperty' :: AttackProperty -> Maybe AttackPropertyIdentifier
$sel:attackLayer:AttackProperty' :: AttackProperty -> Maybe AttackLayer
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe AttackLayer
attackLayer
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe AttackPropertyIdentifier
attackPropertyIdentifier
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Contributor]
topContributors
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Integer
total
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Unit
unit

instance Prelude.NFData AttackProperty where
  rnf :: AttackProperty -> ()
rnf AttackProperty' {Maybe Integer
Maybe [Contributor]
Maybe AttackLayer
Maybe AttackPropertyIdentifier
Maybe Unit
unit :: Maybe Unit
total :: Maybe Integer
topContributors :: Maybe [Contributor]
attackPropertyIdentifier :: Maybe AttackPropertyIdentifier
attackLayer :: Maybe AttackLayer
$sel:unit:AttackProperty' :: AttackProperty -> Maybe Unit
$sel:total:AttackProperty' :: AttackProperty -> Maybe Integer
$sel:topContributors:AttackProperty' :: AttackProperty -> Maybe [Contributor]
$sel:attackPropertyIdentifier:AttackProperty' :: AttackProperty -> Maybe AttackPropertyIdentifier
$sel:attackLayer:AttackProperty' :: AttackProperty -> Maybe AttackLayer
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe AttackLayer
attackLayer
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe AttackPropertyIdentifier
attackPropertyIdentifier
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Contributor]
topContributors
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Integer
total
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Unit
unit