{-# 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.ApplicationLayerAutomaticResponseConfiguration
-- 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.ApplicationLayerAutomaticResponseConfiguration 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.ApplicationLayerAutomaticResponseStatus
import Amazonka.Shield.Types.ResponseAction

-- | The automatic application layer DDoS mitigation settings for a
-- Protection. This configuration determines whether Shield Advanced
-- automatically manages rules in the web ACL in order to respond to
-- application layer events that Shield Advanced determines to be DDoS
-- attacks.
--
-- /See:/ 'newApplicationLayerAutomaticResponseConfiguration' smart constructor.
data ApplicationLayerAutomaticResponseConfiguration = ApplicationLayerAutomaticResponseConfiguration'
  { -- | Indicates whether automatic application layer DDoS mitigation is enabled
    -- for the protection.
    ApplicationLayerAutomaticResponseConfiguration
-> ApplicationLayerAutomaticResponseStatus
status :: ApplicationLayerAutomaticResponseStatus,
    -- | Specifies the action setting that Shield Advanced should use in the WAF
    -- rules that it creates on behalf of the protected resource in response to
    -- DDoS attacks. You specify this as part of the configuration for the
    -- automatic application layer DDoS mitigation feature, when you enable or
    -- update automatic mitigation. Shield Advanced creates the WAF rules in a
    -- Shield Advanced-managed rule group, inside the web ACL that you have
    -- associated with the resource.
    ApplicationLayerAutomaticResponseConfiguration -> ResponseAction
action :: ResponseAction
  }
  deriving (ApplicationLayerAutomaticResponseConfiguration
-> ApplicationLayerAutomaticResponseConfiguration -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ApplicationLayerAutomaticResponseConfiguration
-> ApplicationLayerAutomaticResponseConfiguration -> Bool
$c/= :: ApplicationLayerAutomaticResponseConfiguration
-> ApplicationLayerAutomaticResponseConfiguration -> Bool
== :: ApplicationLayerAutomaticResponseConfiguration
-> ApplicationLayerAutomaticResponseConfiguration -> Bool
$c== :: ApplicationLayerAutomaticResponseConfiguration
-> ApplicationLayerAutomaticResponseConfiguration -> Bool
Prelude.Eq, ReadPrec [ApplicationLayerAutomaticResponseConfiguration]
ReadPrec ApplicationLayerAutomaticResponseConfiguration
Int -> ReadS ApplicationLayerAutomaticResponseConfiguration
ReadS [ApplicationLayerAutomaticResponseConfiguration]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ApplicationLayerAutomaticResponseConfiguration]
$creadListPrec :: ReadPrec [ApplicationLayerAutomaticResponseConfiguration]
readPrec :: ReadPrec ApplicationLayerAutomaticResponseConfiguration
$creadPrec :: ReadPrec ApplicationLayerAutomaticResponseConfiguration
readList :: ReadS [ApplicationLayerAutomaticResponseConfiguration]
$creadList :: ReadS [ApplicationLayerAutomaticResponseConfiguration]
readsPrec :: Int -> ReadS ApplicationLayerAutomaticResponseConfiguration
$creadsPrec :: Int -> ReadS ApplicationLayerAutomaticResponseConfiguration
Prelude.Read, Int -> ApplicationLayerAutomaticResponseConfiguration -> ShowS
[ApplicationLayerAutomaticResponseConfiguration] -> ShowS
ApplicationLayerAutomaticResponseConfiguration -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ApplicationLayerAutomaticResponseConfiguration] -> ShowS
$cshowList :: [ApplicationLayerAutomaticResponseConfiguration] -> ShowS
show :: ApplicationLayerAutomaticResponseConfiguration -> String
$cshow :: ApplicationLayerAutomaticResponseConfiguration -> String
showsPrec :: Int -> ApplicationLayerAutomaticResponseConfiguration -> ShowS
$cshowsPrec :: Int -> ApplicationLayerAutomaticResponseConfiguration -> ShowS
Prelude.Show, forall x.
Rep ApplicationLayerAutomaticResponseConfiguration x
-> ApplicationLayerAutomaticResponseConfiguration
forall x.
ApplicationLayerAutomaticResponseConfiguration
-> Rep ApplicationLayerAutomaticResponseConfiguration x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ApplicationLayerAutomaticResponseConfiguration x
-> ApplicationLayerAutomaticResponseConfiguration
$cfrom :: forall x.
ApplicationLayerAutomaticResponseConfiguration
-> Rep ApplicationLayerAutomaticResponseConfiguration x
Prelude.Generic)

-- |
-- Create a value of 'ApplicationLayerAutomaticResponseConfiguration' 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:
--
-- 'status', 'applicationLayerAutomaticResponseConfiguration_status' - Indicates whether automatic application layer DDoS mitigation is enabled
-- for the protection.
--
-- 'action', 'applicationLayerAutomaticResponseConfiguration_action' - Specifies the action setting that Shield Advanced should use in the WAF
-- rules that it creates on behalf of the protected resource in response to
-- DDoS attacks. You specify this as part of the configuration for the
-- automatic application layer DDoS mitigation feature, when you enable or
-- update automatic mitigation. Shield Advanced creates the WAF rules in a
-- Shield Advanced-managed rule group, inside the web ACL that you have
-- associated with the resource.
newApplicationLayerAutomaticResponseConfiguration ::
  -- | 'status'
  ApplicationLayerAutomaticResponseStatus ->
  -- | 'action'
  ResponseAction ->
  ApplicationLayerAutomaticResponseConfiguration
newApplicationLayerAutomaticResponseConfiguration :: ApplicationLayerAutomaticResponseStatus
-> ResponseAction -> ApplicationLayerAutomaticResponseConfiguration
newApplicationLayerAutomaticResponseConfiguration
  ApplicationLayerAutomaticResponseStatus
pStatus_
  ResponseAction
pAction_ =
    ApplicationLayerAutomaticResponseConfiguration'
      { $sel:status:ApplicationLayerAutomaticResponseConfiguration' :: ApplicationLayerAutomaticResponseStatus
status =
          ApplicationLayerAutomaticResponseStatus
pStatus_,
        $sel:action:ApplicationLayerAutomaticResponseConfiguration' :: ResponseAction
action = ResponseAction
pAction_
      }

-- | Indicates whether automatic application layer DDoS mitigation is enabled
-- for the protection.
applicationLayerAutomaticResponseConfiguration_status :: Lens.Lens' ApplicationLayerAutomaticResponseConfiguration ApplicationLayerAutomaticResponseStatus
applicationLayerAutomaticResponseConfiguration_status :: Lens'
  ApplicationLayerAutomaticResponseConfiguration
  ApplicationLayerAutomaticResponseStatus
applicationLayerAutomaticResponseConfiguration_status = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ApplicationLayerAutomaticResponseConfiguration' {ApplicationLayerAutomaticResponseStatus
status :: ApplicationLayerAutomaticResponseStatus
$sel:status:ApplicationLayerAutomaticResponseConfiguration' :: ApplicationLayerAutomaticResponseConfiguration
-> ApplicationLayerAutomaticResponseStatus
status} -> ApplicationLayerAutomaticResponseStatus
status) (\s :: ApplicationLayerAutomaticResponseConfiguration
s@ApplicationLayerAutomaticResponseConfiguration' {} ApplicationLayerAutomaticResponseStatus
a -> ApplicationLayerAutomaticResponseConfiguration
s {$sel:status:ApplicationLayerAutomaticResponseConfiguration' :: ApplicationLayerAutomaticResponseStatus
status = ApplicationLayerAutomaticResponseStatus
a} :: ApplicationLayerAutomaticResponseConfiguration)

-- | Specifies the action setting that Shield Advanced should use in the WAF
-- rules that it creates on behalf of the protected resource in response to
-- DDoS attacks. You specify this as part of the configuration for the
-- automatic application layer DDoS mitigation feature, when you enable or
-- update automatic mitigation. Shield Advanced creates the WAF rules in a
-- Shield Advanced-managed rule group, inside the web ACL that you have
-- associated with the resource.
applicationLayerAutomaticResponseConfiguration_action :: Lens.Lens' ApplicationLayerAutomaticResponseConfiguration ResponseAction
applicationLayerAutomaticResponseConfiguration_action :: Lens' ApplicationLayerAutomaticResponseConfiguration ResponseAction
applicationLayerAutomaticResponseConfiguration_action = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ApplicationLayerAutomaticResponseConfiguration' {ResponseAction
action :: ResponseAction
$sel:action:ApplicationLayerAutomaticResponseConfiguration' :: ApplicationLayerAutomaticResponseConfiguration -> ResponseAction
action} -> ResponseAction
action) (\s :: ApplicationLayerAutomaticResponseConfiguration
s@ApplicationLayerAutomaticResponseConfiguration' {} ResponseAction
a -> ApplicationLayerAutomaticResponseConfiguration
s {$sel:action:ApplicationLayerAutomaticResponseConfiguration' :: ResponseAction
action = ResponseAction
a} :: ApplicationLayerAutomaticResponseConfiguration)

instance
  Data.FromJSON
    ApplicationLayerAutomaticResponseConfiguration
  where
  parseJSON :: Value -> Parser ApplicationLayerAutomaticResponseConfiguration
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"ApplicationLayerAutomaticResponseConfiguration"
      ( \Object
x ->
          ApplicationLayerAutomaticResponseStatus
-> ResponseAction -> ApplicationLayerAutomaticResponseConfiguration
ApplicationLayerAutomaticResponseConfiguration'
            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
"Status")
            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
"Action")
      )

instance
  Prelude.Hashable
    ApplicationLayerAutomaticResponseConfiguration
  where
  hashWithSalt :: Int -> ApplicationLayerAutomaticResponseConfiguration -> Int
hashWithSalt
    Int
_salt
    ApplicationLayerAutomaticResponseConfiguration' {ApplicationLayerAutomaticResponseStatus
ResponseAction
action :: ResponseAction
status :: ApplicationLayerAutomaticResponseStatus
$sel:action:ApplicationLayerAutomaticResponseConfiguration' :: ApplicationLayerAutomaticResponseConfiguration -> ResponseAction
$sel:status:ApplicationLayerAutomaticResponseConfiguration' :: ApplicationLayerAutomaticResponseConfiguration
-> ApplicationLayerAutomaticResponseStatus
..} =
      Int
_salt
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` ApplicationLayerAutomaticResponseStatus
status
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` ResponseAction
action

instance
  Prelude.NFData
    ApplicationLayerAutomaticResponseConfiguration
  where
  rnf :: ApplicationLayerAutomaticResponseConfiguration -> ()
rnf
    ApplicationLayerAutomaticResponseConfiguration' {ApplicationLayerAutomaticResponseStatus
ResponseAction
action :: ResponseAction
status :: ApplicationLayerAutomaticResponseStatus
$sel:action:ApplicationLayerAutomaticResponseConfiguration' :: ApplicationLayerAutomaticResponseConfiguration -> ResponseAction
$sel:status:ApplicationLayerAutomaticResponseConfiguration' :: ApplicationLayerAutomaticResponseConfiguration
-> ApplicationLayerAutomaticResponseStatus
..} =
      forall a. NFData a => a -> ()
Prelude.rnf ApplicationLayerAutomaticResponseStatus
status seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf ResponseAction
action