{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -fno-warn-unused-binds #-}
{-# 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.UpdateApplicationLayerAutomaticResponse
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Updates an existing Shield Advanced automatic application layer DDoS
-- mitigation configuration for the specified resource.
module Amazonka.Shield.UpdateApplicationLayerAutomaticResponse
  ( -- * Creating a Request
    UpdateApplicationLayerAutomaticResponse (..),
    newUpdateApplicationLayerAutomaticResponse,

    -- * Request Lenses
    updateApplicationLayerAutomaticResponse_resourceArn,
    updateApplicationLayerAutomaticResponse_action,

    -- * Destructuring the Response
    UpdateApplicationLayerAutomaticResponseResponse (..),
    newUpdateApplicationLayerAutomaticResponseResponse,

    -- * Response Lenses
    updateApplicationLayerAutomaticResponseResponse_httpStatus,
  )
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 qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response
import Amazonka.Shield.Types

-- | /See:/ 'newUpdateApplicationLayerAutomaticResponse' smart constructor.
data UpdateApplicationLayerAutomaticResponse = UpdateApplicationLayerAutomaticResponse'
  { -- | The ARN (Amazon Resource Name) of the resource.
    UpdateApplicationLayerAutomaticResponse -> Text
resourceArn :: Prelude.Text,
    -- | 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.
    UpdateApplicationLayerAutomaticResponse -> ResponseAction
action :: ResponseAction
  }
  deriving (UpdateApplicationLayerAutomaticResponse
-> UpdateApplicationLayerAutomaticResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateApplicationLayerAutomaticResponse
-> UpdateApplicationLayerAutomaticResponse -> Bool
$c/= :: UpdateApplicationLayerAutomaticResponse
-> UpdateApplicationLayerAutomaticResponse -> Bool
== :: UpdateApplicationLayerAutomaticResponse
-> UpdateApplicationLayerAutomaticResponse -> Bool
$c== :: UpdateApplicationLayerAutomaticResponse
-> UpdateApplicationLayerAutomaticResponse -> Bool
Prelude.Eq, ReadPrec [UpdateApplicationLayerAutomaticResponse]
ReadPrec UpdateApplicationLayerAutomaticResponse
Int -> ReadS UpdateApplicationLayerAutomaticResponse
ReadS [UpdateApplicationLayerAutomaticResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateApplicationLayerAutomaticResponse]
$creadListPrec :: ReadPrec [UpdateApplicationLayerAutomaticResponse]
readPrec :: ReadPrec UpdateApplicationLayerAutomaticResponse
$creadPrec :: ReadPrec UpdateApplicationLayerAutomaticResponse
readList :: ReadS [UpdateApplicationLayerAutomaticResponse]
$creadList :: ReadS [UpdateApplicationLayerAutomaticResponse]
readsPrec :: Int -> ReadS UpdateApplicationLayerAutomaticResponse
$creadsPrec :: Int -> ReadS UpdateApplicationLayerAutomaticResponse
Prelude.Read, Int -> UpdateApplicationLayerAutomaticResponse -> ShowS
[UpdateApplicationLayerAutomaticResponse] -> ShowS
UpdateApplicationLayerAutomaticResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateApplicationLayerAutomaticResponse] -> ShowS
$cshowList :: [UpdateApplicationLayerAutomaticResponse] -> ShowS
show :: UpdateApplicationLayerAutomaticResponse -> String
$cshow :: UpdateApplicationLayerAutomaticResponse -> String
showsPrec :: Int -> UpdateApplicationLayerAutomaticResponse -> ShowS
$cshowsPrec :: Int -> UpdateApplicationLayerAutomaticResponse -> ShowS
Prelude.Show, forall x.
Rep UpdateApplicationLayerAutomaticResponse x
-> UpdateApplicationLayerAutomaticResponse
forall x.
UpdateApplicationLayerAutomaticResponse
-> Rep UpdateApplicationLayerAutomaticResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep UpdateApplicationLayerAutomaticResponse x
-> UpdateApplicationLayerAutomaticResponse
$cfrom :: forall x.
UpdateApplicationLayerAutomaticResponse
-> Rep UpdateApplicationLayerAutomaticResponse x
Prelude.Generic)

-- |
-- Create a value of 'UpdateApplicationLayerAutomaticResponse' 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:
--
-- 'resourceArn', 'updateApplicationLayerAutomaticResponse_resourceArn' - The ARN (Amazon Resource Name) of the resource.
--
-- 'action', 'updateApplicationLayerAutomaticResponse_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.
newUpdateApplicationLayerAutomaticResponse ::
  -- | 'resourceArn'
  Prelude.Text ->
  -- | 'action'
  ResponseAction ->
  UpdateApplicationLayerAutomaticResponse
newUpdateApplicationLayerAutomaticResponse :: Text -> ResponseAction -> UpdateApplicationLayerAutomaticResponse
newUpdateApplicationLayerAutomaticResponse
  Text
pResourceArn_
  ResponseAction
pAction_ =
    UpdateApplicationLayerAutomaticResponse'
      { $sel:resourceArn:UpdateApplicationLayerAutomaticResponse' :: Text
resourceArn =
          Text
pResourceArn_,
        $sel:action:UpdateApplicationLayerAutomaticResponse' :: ResponseAction
action = ResponseAction
pAction_
      }

-- | The ARN (Amazon Resource Name) of the resource.
updateApplicationLayerAutomaticResponse_resourceArn :: Lens.Lens' UpdateApplicationLayerAutomaticResponse Prelude.Text
updateApplicationLayerAutomaticResponse_resourceArn :: Lens' UpdateApplicationLayerAutomaticResponse Text
updateApplicationLayerAutomaticResponse_resourceArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateApplicationLayerAutomaticResponse' {Text
resourceArn :: Text
$sel:resourceArn:UpdateApplicationLayerAutomaticResponse' :: UpdateApplicationLayerAutomaticResponse -> Text
resourceArn} -> Text
resourceArn) (\s :: UpdateApplicationLayerAutomaticResponse
s@UpdateApplicationLayerAutomaticResponse' {} Text
a -> UpdateApplicationLayerAutomaticResponse
s {$sel:resourceArn:UpdateApplicationLayerAutomaticResponse' :: Text
resourceArn = Text
a} :: UpdateApplicationLayerAutomaticResponse)

-- | 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.
updateApplicationLayerAutomaticResponse_action :: Lens.Lens' UpdateApplicationLayerAutomaticResponse ResponseAction
updateApplicationLayerAutomaticResponse_action :: Lens' UpdateApplicationLayerAutomaticResponse ResponseAction
updateApplicationLayerAutomaticResponse_action = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateApplicationLayerAutomaticResponse' {ResponseAction
action :: ResponseAction
$sel:action:UpdateApplicationLayerAutomaticResponse' :: UpdateApplicationLayerAutomaticResponse -> ResponseAction
action} -> ResponseAction
action) (\s :: UpdateApplicationLayerAutomaticResponse
s@UpdateApplicationLayerAutomaticResponse' {} ResponseAction
a -> UpdateApplicationLayerAutomaticResponse
s {$sel:action:UpdateApplicationLayerAutomaticResponse' :: ResponseAction
action = ResponseAction
a} :: UpdateApplicationLayerAutomaticResponse)

instance
  Core.AWSRequest
    UpdateApplicationLayerAutomaticResponse
  where
  type
    AWSResponse
      UpdateApplicationLayerAutomaticResponse =
      UpdateApplicationLayerAutomaticResponseResponse
  request :: (Service -> Service)
-> UpdateApplicationLayerAutomaticResponse
-> Request UpdateApplicationLayerAutomaticResponse
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.postJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy UpdateApplicationLayerAutomaticResponse
-> ClientResponse ClientBody
-> m (Either
        Error
        (ClientResponse
           (AWSResponse UpdateApplicationLayerAutomaticResponse)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> () -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveEmpty
      ( \Int
s ResponseHeaders
h ()
x ->
          Int -> UpdateApplicationLayerAutomaticResponseResponse
UpdateApplicationLayerAutomaticResponseResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
      )

instance
  Prelude.Hashable
    UpdateApplicationLayerAutomaticResponse
  where
  hashWithSalt :: Int -> UpdateApplicationLayerAutomaticResponse -> Int
hashWithSalt
    Int
_salt
    UpdateApplicationLayerAutomaticResponse' {Text
ResponseAction
action :: ResponseAction
resourceArn :: Text
$sel:action:UpdateApplicationLayerAutomaticResponse' :: UpdateApplicationLayerAutomaticResponse -> ResponseAction
$sel:resourceArn:UpdateApplicationLayerAutomaticResponse' :: UpdateApplicationLayerAutomaticResponse -> Text
..} =
      Int
_salt
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
resourceArn
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` ResponseAction
action

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

instance
  Data.ToHeaders
    UpdateApplicationLayerAutomaticResponse
  where
  toHeaders :: UpdateApplicationLayerAutomaticResponse -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"X-Amz-Target"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"AWSShield_20160616.UpdateApplicationLayerAutomaticResponse" ::
                          Prelude.ByteString
                      ),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance
  Data.ToJSON
    UpdateApplicationLayerAutomaticResponse
  where
  toJSON :: UpdateApplicationLayerAutomaticResponse -> Value
toJSON UpdateApplicationLayerAutomaticResponse' {Text
ResponseAction
action :: ResponseAction
resourceArn :: Text
$sel:action:UpdateApplicationLayerAutomaticResponse' :: UpdateApplicationLayerAutomaticResponse -> ResponseAction
$sel:resourceArn:UpdateApplicationLayerAutomaticResponse' :: UpdateApplicationLayerAutomaticResponse -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just (Key
"ResourceArn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
resourceArn),
            forall a. a -> Maybe a
Prelude.Just (Key
"Action" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= ResponseAction
action)
          ]
      )

instance
  Data.ToPath
    UpdateApplicationLayerAutomaticResponse
  where
  toPath :: UpdateApplicationLayerAutomaticResponse -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

instance
  Data.ToQuery
    UpdateApplicationLayerAutomaticResponse
  where
  toQuery :: UpdateApplicationLayerAutomaticResponse -> QueryString
toQuery = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

-- | /See:/ 'newUpdateApplicationLayerAutomaticResponseResponse' smart constructor.
data UpdateApplicationLayerAutomaticResponseResponse = UpdateApplicationLayerAutomaticResponseResponse'
  { -- | The response's http status code.
    UpdateApplicationLayerAutomaticResponseResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (UpdateApplicationLayerAutomaticResponseResponse
-> UpdateApplicationLayerAutomaticResponseResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateApplicationLayerAutomaticResponseResponse
-> UpdateApplicationLayerAutomaticResponseResponse -> Bool
$c/= :: UpdateApplicationLayerAutomaticResponseResponse
-> UpdateApplicationLayerAutomaticResponseResponse -> Bool
== :: UpdateApplicationLayerAutomaticResponseResponse
-> UpdateApplicationLayerAutomaticResponseResponse -> Bool
$c== :: UpdateApplicationLayerAutomaticResponseResponse
-> UpdateApplicationLayerAutomaticResponseResponse -> Bool
Prelude.Eq, ReadPrec [UpdateApplicationLayerAutomaticResponseResponse]
ReadPrec UpdateApplicationLayerAutomaticResponseResponse
Int -> ReadS UpdateApplicationLayerAutomaticResponseResponse
ReadS [UpdateApplicationLayerAutomaticResponseResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateApplicationLayerAutomaticResponseResponse]
$creadListPrec :: ReadPrec [UpdateApplicationLayerAutomaticResponseResponse]
readPrec :: ReadPrec UpdateApplicationLayerAutomaticResponseResponse
$creadPrec :: ReadPrec UpdateApplicationLayerAutomaticResponseResponse
readList :: ReadS [UpdateApplicationLayerAutomaticResponseResponse]
$creadList :: ReadS [UpdateApplicationLayerAutomaticResponseResponse]
readsPrec :: Int -> ReadS UpdateApplicationLayerAutomaticResponseResponse
$creadsPrec :: Int -> ReadS UpdateApplicationLayerAutomaticResponseResponse
Prelude.Read, Int -> UpdateApplicationLayerAutomaticResponseResponse -> ShowS
[UpdateApplicationLayerAutomaticResponseResponse] -> ShowS
UpdateApplicationLayerAutomaticResponseResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateApplicationLayerAutomaticResponseResponse] -> ShowS
$cshowList :: [UpdateApplicationLayerAutomaticResponseResponse] -> ShowS
show :: UpdateApplicationLayerAutomaticResponseResponse -> String
$cshow :: UpdateApplicationLayerAutomaticResponseResponse -> String
showsPrec :: Int -> UpdateApplicationLayerAutomaticResponseResponse -> ShowS
$cshowsPrec :: Int -> UpdateApplicationLayerAutomaticResponseResponse -> ShowS
Prelude.Show, forall x.
Rep UpdateApplicationLayerAutomaticResponseResponse x
-> UpdateApplicationLayerAutomaticResponseResponse
forall x.
UpdateApplicationLayerAutomaticResponseResponse
-> Rep UpdateApplicationLayerAutomaticResponseResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep UpdateApplicationLayerAutomaticResponseResponse x
-> UpdateApplicationLayerAutomaticResponseResponse
$cfrom :: forall x.
UpdateApplicationLayerAutomaticResponseResponse
-> Rep UpdateApplicationLayerAutomaticResponseResponse x
Prelude.Generic)

-- |
-- Create a value of 'UpdateApplicationLayerAutomaticResponseResponse' 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:
--
-- 'httpStatus', 'updateApplicationLayerAutomaticResponseResponse_httpStatus' - The response's http status code.
newUpdateApplicationLayerAutomaticResponseResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UpdateApplicationLayerAutomaticResponseResponse
newUpdateApplicationLayerAutomaticResponseResponse :: Int -> UpdateApplicationLayerAutomaticResponseResponse
newUpdateApplicationLayerAutomaticResponseResponse
  Int
pHttpStatus_ =
    UpdateApplicationLayerAutomaticResponseResponse'
      { $sel:httpStatus:UpdateApplicationLayerAutomaticResponseResponse' :: Int
httpStatus =
          Int
pHttpStatus_
      }

-- | The response's http status code.
updateApplicationLayerAutomaticResponseResponse_httpStatus :: Lens.Lens' UpdateApplicationLayerAutomaticResponseResponse Prelude.Int
updateApplicationLayerAutomaticResponseResponse_httpStatus :: Lens' UpdateApplicationLayerAutomaticResponseResponse Int
updateApplicationLayerAutomaticResponseResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateApplicationLayerAutomaticResponseResponse' {Int
httpStatus :: Int
$sel:httpStatus:UpdateApplicationLayerAutomaticResponseResponse' :: UpdateApplicationLayerAutomaticResponseResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: UpdateApplicationLayerAutomaticResponseResponse
s@UpdateApplicationLayerAutomaticResponseResponse' {} Int
a -> UpdateApplicationLayerAutomaticResponseResponse
s {$sel:httpStatus:UpdateApplicationLayerAutomaticResponseResponse' :: Int
httpStatus = Int
a} :: UpdateApplicationLayerAutomaticResponseResponse)

instance
  Prelude.NFData
    UpdateApplicationLayerAutomaticResponseResponse
  where
  rnf :: UpdateApplicationLayerAutomaticResponseResponse -> ()
rnf
    UpdateApplicationLayerAutomaticResponseResponse' {Int
httpStatus :: Int
$sel:httpStatus:UpdateApplicationLayerAutomaticResponseResponse' :: UpdateApplicationLayerAutomaticResponseResponse -> Int
..} =
      forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus