{-# 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.WAFRegional.UpdateWebACL
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- This is __AWS WAF Classic__ documentation. For more information, see
-- <https://docs.aws.amazon.com/waf/latest/developerguide/classic-waf-chapter.html AWS WAF Classic>
-- in the developer guide.
--
-- __For the latest version of AWS WAF__, use the AWS WAFV2 API and see the
-- <https://docs.aws.amazon.com/waf/latest/developerguide/waf-chapter.html AWS WAF Developer Guide>.
-- With the latest version, AWS WAF has a single set of endpoints for
-- regional and global use.
--
-- Inserts or deletes ActivatedRule objects in a @WebACL@. Each @Rule@
-- identifies web requests that you want to allow, block, or count. When
-- you update a @WebACL@, you specify the following values:
--
-- -   A default action for the @WebACL@, either @ALLOW@ or @BLOCK@. AWS
--     WAF performs the default action if a request doesn\'t match the
--     criteria in any of the @Rules@ in a @WebACL@.
--
-- -   The @Rules@ that you want to add or delete. If you want to replace
--     one @Rule@ with another, you delete the existing @Rule@ and add the
--     new one.
--
-- -   For each @Rule@, whether you want AWS WAF to allow requests, block
--     requests, or count requests that match the conditions in the @Rule@.
--
-- -   The order in which you want AWS WAF to evaluate the @Rules@ in a
--     @WebACL@. If you add more than one @Rule@ to a @WebACL@, AWS WAF
--     evaluates each request against the @Rules@ in order based on the
--     value of @Priority@. (The @Rule@ that has the lowest value for
--     @Priority@ is evaluated first.) When a web request matches all the
--     predicates (such as @ByteMatchSets@ and @IPSets@) in a @Rule@, AWS
--     WAF immediately takes the corresponding action, allow or block, and
--     doesn\'t evaluate the request against the remaining @Rules@ in the
--     @WebACL@, if any.
--
-- To create and configure a @WebACL@, perform the following steps:
--
-- 1.  Create and update the predicates that you want to include in
--     @Rules@. For more information, see CreateByteMatchSet,
--     UpdateByteMatchSet, CreateIPSet, UpdateIPSet,
--     CreateSqlInjectionMatchSet, and UpdateSqlInjectionMatchSet.
--
-- 2.  Create and update the @Rules@ that you want to include in the
--     @WebACL@. For more information, see CreateRule and UpdateRule.
--
-- 3.  Create a @WebACL@. See CreateWebACL.
--
-- 4.  Use @GetChangeToken@ to get the change token that you provide in the
--     @ChangeToken@ parameter of an UpdateWebACL request.
--
-- 5.  Submit an @UpdateWebACL@ request to specify the @Rules@ that you
--     want to include in the @WebACL@, to specify the default action, and
--     to associate the @WebACL@ with a CloudFront distribution.
--
--     The @ActivatedRule@ can be a rule group. If you specify a rule group
--     as your @ActivatedRule@ , you can exclude specific rules from that
--     rule group.
--
--     If you already have a rule group associated with a web ACL and want
--     to submit an @UpdateWebACL@ request to exclude certain rules from
--     that rule group, you must first remove the rule group from the web
--     ACL, the re-insert it again, specifying the excluded rules. For
--     details, see ActivatedRule$ExcludedRules .
--
-- Be aware that if you try to add a RATE_BASED rule to a web ACL without
-- setting the rule type when first creating the rule, the UpdateWebACL
-- request will fail because the request tries to add a REGULAR rule (the
-- default rule type) with the specified ID, which does not exist.
--
-- For more information about how to use the AWS WAF API to allow or block
-- HTTP requests, see the
-- <https://docs.aws.amazon.com/waf/latest/developerguide/ AWS WAF Developer Guide>.
module Amazonka.WAFRegional.UpdateWebACL
  ( -- * Creating a Request
    UpdateWebACL (..),
    newUpdateWebACL,

    -- * Request Lenses
    updateWebACL_defaultAction,
    updateWebACL_updates,
    updateWebACL_webACLId,
    updateWebACL_changeToken,

    -- * Destructuring the Response
    UpdateWebACLResponse (..),
    newUpdateWebACLResponse,

    -- * Response Lenses
    updateWebACLResponse_changeToken,
    updateWebACLResponse_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.WAFRegional.Types

-- | /See:/ 'newUpdateWebACL' smart constructor.
data UpdateWebACL = UpdateWebACL'
  { -- | A default action for the web ACL, either ALLOW or BLOCK. AWS WAF
    -- performs the default action if a request doesn\'t match the criteria in
    -- any of the rules in a web ACL.
    UpdateWebACL -> Maybe WafAction
defaultAction :: Prelude.Maybe WafAction,
    -- | An array of updates to make to the WebACL.
    --
    -- An array of @WebACLUpdate@ objects that you want to insert into or
    -- delete from a WebACL. For more information, see the applicable data
    -- types:
    --
    -- -   WebACLUpdate: Contains @Action@ and @ActivatedRule@
    --
    -- -   ActivatedRule: Contains @Action@, @OverrideAction@, @Priority@,
    --     @RuleId@, and @Type@. @ActivatedRule|OverrideAction@ applies only
    --     when updating or adding a @RuleGroup@ to a @WebACL@. In this case,
    --     you do not use @ActivatedRule|Action@. For all other update
    --     requests, @ActivatedRule|Action@ is used instead of
    --     @ActivatedRule|OverrideAction@.
    --
    -- -   WafAction: Contains @Type@
    UpdateWebACL -> Maybe [WebACLUpdate]
updates :: Prelude.Maybe [WebACLUpdate],
    -- | The @WebACLId@ of the WebACL that you want to update. @WebACLId@ is
    -- returned by CreateWebACL and by ListWebACLs.
    UpdateWebACL -> Text
webACLId :: Prelude.Text,
    -- | The value returned by the most recent call to GetChangeToken.
    UpdateWebACL -> Text
changeToken :: Prelude.Text
  }
  deriving (UpdateWebACL -> UpdateWebACL -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateWebACL -> UpdateWebACL -> Bool
$c/= :: UpdateWebACL -> UpdateWebACL -> Bool
== :: UpdateWebACL -> UpdateWebACL -> Bool
$c== :: UpdateWebACL -> UpdateWebACL -> Bool
Prelude.Eq, ReadPrec [UpdateWebACL]
ReadPrec UpdateWebACL
Int -> ReadS UpdateWebACL
ReadS [UpdateWebACL]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateWebACL]
$creadListPrec :: ReadPrec [UpdateWebACL]
readPrec :: ReadPrec UpdateWebACL
$creadPrec :: ReadPrec UpdateWebACL
readList :: ReadS [UpdateWebACL]
$creadList :: ReadS [UpdateWebACL]
readsPrec :: Int -> ReadS UpdateWebACL
$creadsPrec :: Int -> ReadS UpdateWebACL
Prelude.Read, Int -> UpdateWebACL -> ShowS
[UpdateWebACL] -> ShowS
UpdateWebACL -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateWebACL] -> ShowS
$cshowList :: [UpdateWebACL] -> ShowS
show :: UpdateWebACL -> String
$cshow :: UpdateWebACL -> String
showsPrec :: Int -> UpdateWebACL -> ShowS
$cshowsPrec :: Int -> UpdateWebACL -> ShowS
Prelude.Show, forall x. Rep UpdateWebACL x -> UpdateWebACL
forall x. UpdateWebACL -> Rep UpdateWebACL x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateWebACL x -> UpdateWebACL
$cfrom :: forall x. UpdateWebACL -> Rep UpdateWebACL x
Prelude.Generic)

-- |
-- Create a value of 'UpdateWebACL' 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:
--
-- 'defaultAction', 'updateWebACL_defaultAction' - A default action for the web ACL, either ALLOW or BLOCK. AWS WAF
-- performs the default action if a request doesn\'t match the criteria in
-- any of the rules in a web ACL.
--
-- 'updates', 'updateWebACL_updates' - An array of updates to make to the WebACL.
--
-- An array of @WebACLUpdate@ objects that you want to insert into or
-- delete from a WebACL. For more information, see the applicable data
-- types:
--
-- -   WebACLUpdate: Contains @Action@ and @ActivatedRule@
--
-- -   ActivatedRule: Contains @Action@, @OverrideAction@, @Priority@,
--     @RuleId@, and @Type@. @ActivatedRule|OverrideAction@ applies only
--     when updating or adding a @RuleGroup@ to a @WebACL@. In this case,
--     you do not use @ActivatedRule|Action@. For all other update
--     requests, @ActivatedRule|Action@ is used instead of
--     @ActivatedRule|OverrideAction@.
--
-- -   WafAction: Contains @Type@
--
-- 'webACLId', 'updateWebACL_webACLId' - The @WebACLId@ of the WebACL that you want to update. @WebACLId@ is
-- returned by CreateWebACL and by ListWebACLs.
--
-- 'changeToken', 'updateWebACL_changeToken' - The value returned by the most recent call to GetChangeToken.
newUpdateWebACL ::
  -- | 'webACLId'
  Prelude.Text ->
  -- | 'changeToken'
  Prelude.Text ->
  UpdateWebACL
newUpdateWebACL :: Text -> Text -> UpdateWebACL
newUpdateWebACL Text
pWebACLId_ Text
pChangeToken_ =
  UpdateWebACL'
    { $sel:defaultAction:UpdateWebACL' :: Maybe WafAction
defaultAction = forall a. Maybe a
Prelude.Nothing,
      $sel:updates:UpdateWebACL' :: Maybe [WebACLUpdate]
updates = forall a. Maybe a
Prelude.Nothing,
      $sel:webACLId:UpdateWebACL' :: Text
webACLId = Text
pWebACLId_,
      $sel:changeToken:UpdateWebACL' :: Text
changeToken = Text
pChangeToken_
    }

-- | A default action for the web ACL, either ALLOW or BLOCK. AWS WAF
-- performs the default action if a request doesn\'t match the criteria in
-- any of the rules in a web ACL.
updateWebACL_defaultAction :: Lens.Lens' UpdateWebACL (Prelude.Maybe WafAction)
updateWebACL_defaultAction :: Lens' UpdateWebACL (Maybe WafAction)
updateWebACL_defaultAction = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateWebACL' {Maybe WafAction
defaultAction :: Maybe WafAction
$sel:defaultAction:UpdateWebACL' :: UpdateWebACL -> Maybe WafAction
defaultAction} -> Maybe WafAction
defaultAction) (\s :: UpdateWebACL
s@UpdateWebACL' {} Maybe WafAction
a -> UpdateWebACL
s {$sel:defaultAction:UpdateWebACL' :: Maybe WafAction
defaultAction = Maybe WafAction
a} :: UpdateWebACL)

-- | An array of updates to make to the WebACL.
--
-- An array of @WebACLUpdate@ objects that you want to insert into or
-- delete from a WebACL. For more information, see the applicable data
-- types:
--
-- -   WebACLUpdate: Contains @Action@ and @ActivatedRule@
--
-- -   ActivatedRule: Contains @Action@, @OverrideAction@, @Priority@,
--     @RuleId@, and @Type@. @ActivatedRule|OverrideAction@ applies only
--     when updating or adding a @RuleGroup@ to a @WebACL@. In this case,
--     you do not use @ActivatedRule|Action@. For all other update
--     requests, @ActivatedRule|Action@ is used instead of
--     @ActivatedRule|OverrideAction@.
--
-- -   WafAction: Contains @Type@
updateWebACL_updates :: Lens.Lens' UpdateWebACL (Prelude.Maybe [WebACLUpdate])
updateWebACL_updates :: Lens' UpdateWebACL (Maybe [WebACLUpdate])
updateWebACL_updates = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateWebACL' {Maybe [WebACLUpdate]
updates :: Maybe [WebACLUpdate]
$sel:updates:UpdateWebACL' :: UpdateWebACL -> Maybe [WebACLUpdate]
updates} -> Maybe [WebACLUpdate]
updates) (\s :: UpdateWebACL
s@UpdateWebACL' {} Maybe [WebACLUpdate]
a -> UpdateWebACL
s {$sel:updates:UpdateWebACL' :: Maybe [WebACLUpdate]
updates = Maybe [WebACLUpdate]
a} :: UpdateWebACL) 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 @WebACLId@ of the WebACL that you want to update. @WebACLId@ is
-- returned by CreateWebACL and by ListWebACLs.
updateWebACL_webACLId :: Lens.Lens' UpdateWebACL Prelude.Text
updateWebACL_webACLId :: Lens' UpdateWebACL Text
updateWebACL_webACLId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateWebACL' {Text
webACLId :: Text
$sel:webACLId:UpdateWebACL' :: UpdateWebACL -> Text
webACLId} -> Text
webACLId) (\s :: UpdateWebACL
s@UpdateWebACL' {} Text
a -> UpdateWebACL
s {$sel:webACLId:UpdateWebACL' :: Text
webACLId = Text
a} :: UpdateWebACL)

-- | The value returned by the most recent call to GetChangeToken.
updateWebACL_changeToken :: Lens.Lens' UpdateWebACL Prelude.Text
updateWebACL_changeToken :: Lens' UpdateWebACL Text
updateWebACL_changeToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateWebACL' {Text
changeToken :: Text
$sel:changeToken:UpdateWebACL' :: UpdateWebACL -> Text
changeToken} -> Text
changeToken) (\s :: UpdateWebACL
s@UpdateWebACL' {} Text
a -> UpdateWebACL
s {$sel:changeToken:UpdateWebACL' :: Text
changeToken = Text
a} :: UpdateWebACL)

instance Core.AWSRequest UpdateWebACL where
  type AWSResponse UpdateWebACL = UpdateWebACLResponse
  request :: (Service -> Service) -> UpdateWebACL -> Request UpdateWebACL
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 UpdateWebACL
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse UpdateWebACL)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> Object -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveJSON
      ( \Int
s ResponseHeaders
h Object
x ->
          Maybe Text -> Int -> UpdateWebACLResponse
UpdateWebACLResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"ChangeToken")
            forall (f :: * -> *) a b. Applicative f => 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 UpdateWebACL where
  hashWithSalt :: Int -> UpdateWebACL -> Int
hashWithSalt Int
_salt UpdateWebACL' {Maybe [WebACLUpdate]
Maybe WafAction
Text
changeToken :: Text
webACLId :: Text
updates :: Maybe [WebACLUpdate]
defaultAction :: Maybe WafAction
$sel:changeToken:UpdateWebACL' :: UpdateWebACL -> Text
$sel:webACLId:UpdateWebACL' :: UpdateWebACL -> Text
$sel:updates:UpdateWebACL' :: UpdateWebACL -> Maybe [WebACLUpdate]
$sel:defaultAction:UpdateWebACL' :: UpdateWebACL -> Maybe WafAction
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe WafAction
defaultAction
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [WebACLUpdate]
updates
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
webACLId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
changeToken

instance Prelude.NFData UpdateWebACL where
  rnf :: UpdateWebACL -> ()
rnf UpdateWebACL' {Maybe [WebACLUpdate]
Maybe WafAction
Text
changeToken :: Text
webACLId :: Text
updates :: Maybe [WebACLUpdate]
defaultAction :: Maybe WafAction
$sel:changeToken:UpdateWebACL' :: UpdateWebACL -> Text
$sel:webACLId:UpdateWebACL' :: UpdateWebACL -> Text
$sel:updates:UpdateWebACL' :: UpdateWebACL -> Maybe [WebACLUpdate]
$sel:defaultAction:UpdateWebACL' :: UpdateWebACL -> Maybe WafAction
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe WafAction
defaultAction
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [WebACLUpdate]
updates
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
webACLId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
changeToken

instance Data.ToHeaders UpdateWebACL where
  toHeaders :: UpdateWebACL -> 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
"AWSWAF_Regional_20161128.UpdateWebACL" ::
                          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 UpdateWebACL where
  toJSON :: UpdateWebACL -> Value
toJSON UpdateWebACL' {Maybe [WebACLUpdate]
Maybe WafAction
Text
changeToken :: Text
webACLId :: Text
updates :: Maybe [WebACLUpdate]
defaultAction :: Maybe WafAction
$sel:changeToken:UpdateWebACL' :: UpdateWebACL -> Text
$sel:webACLId:UpdateWebACL' :: UpdateWebACL -> Text
$sel:updates:UpdateWebACL' :: UpdateWebACL -> Maybe [WebACLUpdate]
$sel:defaultAction:UpdateWebACL' :: UpdateWebACL -> Maybe WafAction
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"DefaultAction" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe WafAction
defaultAction,
            (Key
"Updates" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [WebACLUpdate]
updates,
            forall a. a -> Maybe a
Prelude.Just (Key
"WebACLId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
webACLId),
            forall a. a -> Maybe a
Prelude.Just (Key
"ChangeToken" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
changeToken)
          ]
      )

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

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

-- | /See:/ 'newUpdateWebACLResponse' smart constructor.
data UpdateWebACLResponse = UpdateWebACLResponse'
  { -- | The @ChangeToken@ that you used to submit the @UpdateWebACL@ request.
    -- You can also use this value to query the status of the request. For more
    -- information, see GetChangeTokenStatus.
    UpdateWebACLResponse -> Maybe Text
changeToken :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    UpdateWebACLResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (UpdateWebACLResponse -> UpdateWebACLResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateWebACLResponse -> UpdateWebACLResponse -> Bool
$c/= :: UpdateWebACLResponse -> UpdateWebACLResponse -> Bool
== :: UpdateWebACLResponse -> UpdateWebACLResponse -> Bool
$c== :: UpdateWebACLResponse -> UpdateWebACLResponse -> Bool
Prelude.Eq, ReadPrec [UpdateWebACLResponse]
ReadPrec UpdateWebACLResponse
Int -> ReadS UpdateWebACLResponse
ReadS [UpdateWebACLResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateWebACLResponse]
$creadListPrec :: ReadPrec [UpdateWebACLResponse]
readPrec :: ReadPrec UpdateWebACLResponse
$creadPrec :: ReadPrec UpdateWebACLResponse
readList :: ReadS [UpdateWebACLResponse]
$creadList :: ReadS [UpdateWebACLResponse]
readsPrec :: Int -> ReadS UpdateWebACLResponse
$creadsPrec :: Int -> ReadS UpdateWebACLResponse
Prelude.Read, Int -> UpdateWebACLResponse -> ShowS
[UpdateWebACLResponse] -> ShowS
UpdateWebACLResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateWebACLResponse] -> ShowS
$cshowList :: [UpdateWebACLResponse] -> ShowS
show :: UpdateWebACLResponse -> String
$cshow :: UpdateWebACLResponse -> String
showsPrec :: Int -> UpdateWebACLResponse -> ShowS
$cshowsPrec :: Int -> UpdateWebACLResponse -> ShowS
Prelude.Show, forall x. Rep UpdateWebACLResponse x -> UpdateWebACLResponse
forall x. UpdateWebACLResponse -> Rep UpdateWebACLResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateWebACLResponse x -> UpdateWebACLResponse
$cfrom :: forall x. UpdateWebACLResponse -> Rep UpdateWebACLResponse x
Prelude.Generic)

-- |
-- Create a value of 'UpdateWebACLResponse' 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:
--
-- 'changeToken', 'updateWebACLResponse_changeToken' - The @ChangeToken@ that you used to submit the @UpdateWebACL@ request.
-- You can also use this value to query the status of the request. For more
-- information, see GetChangeTokenStatus.
--
-- 'httpStatus', 'updateWebACLResponse_httpStatus' - The response's http status code.
newUpdateWebACLResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UpdateWebACLResponse
newUpdateWebACLResponse :: Int -> UpdateWebACLResponse
newUpdateWebACLResponse Int
pHttpStatus_ =
  UpdateWebACLResponse'
    { $sel:changeToken:UpdateWebACLResponse' :: Maybe Text
changeToken =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:UpdateWebACLResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The @ChangeToken@ that you used to submit the @UpdateWebACL@ request.
-- You can also use this value to query the status of the request. For more
-- information, see GetChangeTokenStatus.
updateWebACLResponse_changeToken :: Lens.Lens' UpdateWebACLResponse (Prelude.Maybe Prelude.Text)
updateWebACLResponse_changeToken :: Lens' UpdateWebACLResponse (Maybe Text)
updateWebACLResponse_changeToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateWebACLResponse' {Maybe Text
changeToken :: Maybe Text
$sel:changeToken:UpdateWebACLResponse' :: UpdateWebACLResponse -> Maybe Text
changeToken} -> Maybe Text
changeToken) (\s :: UpdateWebACLResponse
s@UpdateWebACLResponse' {} Maybe Text
a -> UpdateWebACLResponse
s {$sel:changeToken:UpdateWebACLResponse' :: Maybe Text
changeToken = Maybe Text
a} :: UpdateWebACLResponse)

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

instance Prelude.NFData UpdateWebACLResponse where
  rnf :: UpdateWebACLResponse -> ()
rnf UpdateWebACLResponse' {Int
Maybe Text
httpStatus :: Int
changeToken :: Maybe Text
$sel:httpStatus:UpdateWebACLResponse' :: UpdateWebACLResponse -> Int
$sel:changeToken:UpdateWebACLResponse' :: UpdateWebACLResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
changeToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus