{-# 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.CreateWebACL
-- 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.
--
-- Creates a @WebACL@, which contains the @Rules@ that identify the
-- CloudFront web requests that you want to allow, block, or count. AWS WAF
-- evaluates @Rules@ in order based on the value of @Priority@ for each
-- @Rule@.
--
-- You also specify a default action, either @ALLOW@ or @BLOCK@. If a web
-- request doesn\'t match any of the @Rules@ in a @WebACL@, AWS WAF
-- responds to the request with the default action.
--
-- To create and configure a @WebACL@, perform the following steps:
--
-- 1.  Create and update the @ByteMatchSet@ objects and other 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.  Use GetChangeToken to get the change token that you provide in the
--     @ChangeToken@ parameter of a @CreateWebACL@ request.
--
-- 4.  Submit a @CreateWebACL@ request.
--
-- 5.  Use @GetChangeToken@ to get the change token that you provide in the
--     @ChangeToken@ parameter of an UpdateWebACL request.
--
-- 6.  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.
--
-- For more information about how to use the AWS WAF API, see the
-- <https://docs.aws.amazon.com/waf/latest/developerguide/ AWS WAF Developer Guide>.
module Amazonka.WAFRegional.CreateWebACL
  ( -- * Creating a Request
    CreateWebACL (..),
    newCreateWebACL,

    -- * Request Lenses
    createWebACL_tags,
    createWebACL_name,
    createWebACL_metricName,
    createWebACL_defaultAction,
    createWebACL_changeToken,

    -- * Destructuring the Response
    CreateWebACLResponse (..),
    newCreateWebACLResponse,

    -- * Response Lenses
    createWebACLResponse_changeToken,
    createWebACLResponse_webACL,
    createWebACLResponse_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:/ 'newCreateWebACL' smart constructor.
data CreateWebACL = CreateWebACL'
  { CreateWebACL -> Maybe (NonEmpty Tag)
tags :: Prelude.Maybe (Prelude.NonEmpty Tag),
    -- | A friendly name or description of the WebACL. You can\'t change @Name@
    -- after you create the @WebACL@.
    CreateWebACL -> Text
name :: Prelude.Text,
    -- | A friendly name or description for the metrics for this @WebACL@.The
    -- name can contain only alphanumeric characters (A-Z, a-z, 0-9), with
    -- maximum length 128 and minimum length one. It can\'t contain whitespace
    -- or metric names reserved for AWS WAF, including \"All\" and
    -- \"Default_Action.\" You can\'t change @MetricName@ after you create the
    -- @WebACL@.
    CreateWebACL -> Text
metricName :: Prelude.Text,
    -- | The action that you want AWS WAF to take when a request doesn\'t match
    -- the criteria specified in any of the @Rule@ objects that are associated
    -- with the @WebACL@.
    CreateWebACL -> WafAction
defaultAction :: WafAction,
    -- | The value returned by the most recent call to GetChangeToken.
    CreateWebACL -> Text
changeToken :: Prelude.Text
  }
  deriving (CreateWebACL -> CreateWebACL -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateWebACL -> CreateWebACL -> Bool
$c/= :: CreateWebACL -> CreateWebACL -> Bool
== :: CreateWebACL -> CreateWebACL -> Bool
$c== :: CreateWebACL -> CreateWebACL -> Bool
Prelude.Eq, ReadPrec [CreateWebACL]
ReadPrec CreateWebACL
Int -> ReadS CreateWebACL
ReadS [CreateWebACL]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateWebACL]
$creadListPrec :: ReadPrec [CreateWebACL]
readPrec :: ReadPrec CreateWebACL
$creadPrec :: ReadPrec CreateWebACL
readList :: ReadS [CreateWebACL]
$creadList :: ReadS [CreateWebACL]
readsPrec :: Int -> ReadS CreateWebACL
$creadsPrec :: Int -> ReadS CreateWebACL
Prelude.Read, Int -> CreateWebACL -> ShowS
[CreateWebACL] -> ShowS
CreateWebACL -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateWebACL] -> ShowS
$cshowList :: [CreateWebACL] -> ShowS
show :: CreateWebACL -> String
$cshow :: CreateWebACL -> String
showsPrec :: Int -> CreateWebACL -> ShowS
$cshowsPrec :: Int -> CreateWebACL -> ShowS
Prelude.Show, forall x. Rep CreateWebACL x -> CreateWebACL
forall x. CreateWebACL -> Rep CreateWebACL x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateWebACL x -> CreateWebACL
$cfrom :: forall x. CreateWebACL -> Rep CreateWebACL x
Prelude.Generic)

-- |
-- Create a value of 'CreateWebACL' 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:
--
-- 'tags', 'createWebACL_tags' -
--
-- 'name', 'createWebACL_name' - A friendly name or description of the WebACL. You can\'t change @Name@
-- after you create the @WebACL@.
--
-- 'metricName', 'createWebACL_metricName' - A friendly name or description for the metrics for this @WebACL@.The
-- name can contain only alphanumeric characters (A-Z, a-z, 0-9), with
-- maximum length 128 and minimum length one. It can\'t contain whitespace
-- or metric names reserved for AWS WAF, including \"All\" and
-- \"Default_Action.\" You can\'t change @MetricName@ after you create the
-- @WebACL@.
--
-- 'defaultAction', 'createWebACL_defaultAction' - The action that you want AWS WAF to take when a request doesn\'t match
-- the criteria specified in any of the @Rule@ objects that are associated
-- with the @WebACL@.
--
-- 'changeToken', 'createWebACL_changeToken' - The value returned by the most recent call to GetChangeToken.
newCreateWebACL ::
  -- | 'name'
  Prelude.Text ->
  -- | 'metricName'
  Prelude.Text ->
  -- | 'defaultAction'
  WafAction ->
  -- | 'changeToken'
  Prelude.Text ->
  CreateWebACL
newCreateWebACL :: Text -> Text -> WafAction -> Text -> CreateWebACL
newCreateWebACL
  Text
pName_
  Text
pMetricName_
  WafAction
pDefaultAction_
  Text
pChangeToken_ =
    CreateWebACL'
      { $sel:tags:CreateWebACL' :: Maybe (NonEmpty Tag)
tags = forall a. Maybe a
Prelude.Nothing,
        $sel:name:CreateWebACL' :: Text
name = Text
pName_,
        $sel:metricName:CreateWebACL' :: Text
metricName = Text
pMetricName_,
        $sel:defaultAction:CreateWebACL' :: WafAction
defaultAction = WafAction
pDefaultAction_,
        $sel:changeToken:CreateWebACL' :: Text
changeToken = Text
pChangeToken_
      }

createWebACL_tags :: Lens.Lens' CreateWebACL (Prelude.Maybe (Prelude.NonEmpty Tag))
createWebACL_tags :: Lens' CreateWebACL (Maybe (NonEmpty Tag))
createWebACL_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateWebACL' {Maybe (NonEmpty Tag)
tags :: Maybe (NonEmpty Tag)
$sel:tags:CreateWebACL' :: CreateWebACL -> Maybe (NonEmpty Tag)
tags} -> Maybe (NonEmpty Tag)
tags) (\s :: CreateWebACL
s@CreateWebACL' {} Maybe (NonEmpty Tag)
a -> CreateWebACL
s {$sel:tags:CreateWebACL' :: Maybe (NonEmpty Tag)
tags = Maybe (NonEmpty Tag)
a} :: CreateWebACL) 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

-- | A friendly name or description of the WebACL. You can\'t change @Name@
-- after you create the @WebACL@.
createWebACL_name :: Lens.Lens' CreateWebACL Prelude.Text
createWebACL_name :: Lens' CreateWebACL Text
createWebACL_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateWebACL' {Text
name :: Text
$sel:name:CreateWebACL' :: CreateWebACL -> Text
name} -> Text
name) (\s :: CreateWebACL
s@CreateWebACL' {} Text
a -> CreateWebACL
s {$sel:name:CreateWebACL' :: Text
name = Text
a} :: CreateWebACL)

-- | A friendly name or description for the metrics for this @WebACL@.The
-- name can contain only alphanumeric characters (A-Z, a-z, 0-9), with
-- maximum length 128 and minimum length one. It can\'t contain whitespace
-- or metric names reserved for AWS WAF, including \"All\" and
-- \"Default_Action.\" You can\'t change @MetricName@ after you create the
-- @WebACL@.
createWebACL_metricName :: Lens.Lens' CreateWebACL Prelude.Text
createWebACL_metricName :: Lens' CreateWebACL Text
createWebACL_metricName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateWebACL' {Text
metricName :: Text
$sel:metricName:CreateWebACL' :: CreateWebACL -> Text
metricName} -> Text
metricName) (\s :: CreateWebACL
s@CreateWebACL' {} Text
a -> CreateWebACL
s {$sel:metricName:CreateWebACL' :: Text
metricName = Text
a} :: CreateWebACL)

-- | The action that you want AWS WAF to take when a request doesn\'t match
-- the criteria specified in any of the @Rule@ objects that are associated
-- with the @WebACL@.
createWebACL_defaultAction :: Lens.Lens' CreateWebACL WafAction
createWebACL_defaultAction :: Lens' CreateWebACL WafAction
createWebACL_defaultAction = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateWebACL' {WafAction
defaultAction :: WafAction
$sel:defaultAction:CreateWebACL' :: CreateWebACL -> WafAction
defaultAction} -> WafAction
defaultAction) (\s :: CreateWebACL
s@CreateWebACL' {} WafAction
a -> CreateWebACL
s {$sel:defaultAction:CreateWebACL' :: WafAction
defaultAction = WafAction
a} :: CreateWebACL)

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

instance Core.AWSRequest CreateWebACL where
  type AWSResponse CreateWebACL = CreateWebACLResponse
  request :: (Service -> Service) -> CreateWebACL -> Request CreateWebACL
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 CreateWebACL
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CreateWebACL)))
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 -> Maybe WebACL -> Int -> CreateWebACLResponse
CreateWebACLResponse'
            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.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"WebACL")
            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 CreateWebACL where
  hashWithSalt :: Int -> CreateWebACL -> Int
hashWithSalt Int
_salt CreateWebACL' {Maybe (NonEmpty Tag)
Text
WafAction
changeToken :: Text
defaultAction :: WafAction
metricName :: Text
name :: Text
tags :: Maybe (NonEmpty Tag)
$sel:changeToken:CreateWebACL' :: CreateWebACL -> Text
$sel:defaultAction:CreateWebACL' :: CreateWebACL -> WafAction
$sel:metricName:CreateWebACL' :: CreateWebACL -> Text
$sel:name:CreateWebACL' :: CreateWebACL -> Text
$sel:tags:CreateWebACL' :: CreateWebACL -> Maybe (NonEmpty Tag)
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (NonEmpty Tag)
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
name
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
metricName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` WafAction
defaultAction
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
changeToken

instance Prelude.NFData CreateWebACL where
  rnf :: CreateWebACL -> ()
rnf CreateWebACL' {Maybe (NonEmpty Tag)
Text
WafAction
changeToken :: Text
defaultAction :: WafAction
metricName :: Text
name :: Text
tags :: Maybe (NonEmpty Tag)
$sel:changeToken:CreateWebACL' :: CreateWebACL -> Text
$sel:defaultAction:CreateWebACL' :: CreateWebACL -> WafAction
$sel:metricName:CreateWebACL' :: CreateWebACL -> Text
$sel:name:CreateWebACL' :: CreateWebACL -> Text
$sel:tags:CreateWebACL' :: CreateWebACL -> Maybe (NonEmpty Tag)
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe (NonEmpty Tag)
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
name
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
metricName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf WafAction
defaultAction
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
changeToken

instance Data.ToHeaders CreateWebACL where
  toHeaders :: CreateWebACL -> 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.CreateWebACL" ::
                          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 CreateWebACL where
  toJSON :: CreateWebACL -> Value
toJSON CreateWebACL' {Maybe (NonEmpty Tag)
Text
WafAction
changeToken :: Text
defaultAction :: WafAction
metricName :: Text
name :: Text
tags :: Maybe (NonEmpty Tag)
$sel:changeToken:CreateWebACL' :: CreateWebACL -> Text
$sel:defaultAction:CreateWebACL' :: CreateWebACL -> WafAction
$sel:metricName:CreateWebACL' :: CreateWebACL -> Text
$sel:name:CreateWebACL' :: CreateWebACL -> Text
$sel:tags:CreateWebACL' :: CreateWebACL -> Maybe (NonEmpty Tag)
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"Tags" 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 (NonEmpty Tag)
tags,
            forall a. a -> Maybe a
Prelude.Just (Key
"Name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
name),
            forall a. a -> Maybe a
Prelude.Just (Key
"MetricName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
metricName),
            forall a. a -> Maybe a
Prelude.Just (Key
"DefaultAction" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= WafAction
defaultAction),
            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 CreateWebACL where
  toPath :: CreateWebACL -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

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

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

-- |
-- Create a value of 'CreateWebACLResponse' 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', 'createWebACLResponse_changeToken' - The @ChangeToken@ that you used to submit the @CreateWebACL@ request.
-- You can also use this value to query the status of the request. For more
-- information, see GetChangeTokenStatus.
--
-- 'webACL', 'createWebACLResponse_webACL' - The WebACL returned in the @CreateWebACL@ response.
--
-- 'httpStatus', 'createWebACLResponse_httpStatus' - The response's http status code.
newCreateWebACLResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateWebACLResponse
newCreateWebACLResponse :: Int -> CreateWebACLResponse
newCreateWebACLResponse Int
pHttpStatus_ =
  CreateWebACLResponse'
    { $sel:changeToken:CreateWebACLResponse' :: Maybe Text
changeToken =
        forall a. Maybe a
Prelude.Nothing,
      $sel:webACL:CreateWebACLResponse' :: Maybe WebACL
webACL = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateWebACLResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

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

-- | The WebACL returned in the @CreateWebACL@ response.
createWebACLResponse_webACL :: Lens.Lens' CreateWebACLResponse (Prelude.Maybe WebACL)
createWebACLResponse_webACL :: Lens' CreateWebACLResponse (Maybe WebACL)
createWebACLResponse_webACL = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateWebACLResponse' {Maybe WebACL
webACL :: Maybe WebACL
$sel:webACL:CreateWebACLResponse' :: CreateWebACLResponse -> Maybe WebACL
webACL} -> Maybe WebACL
webACL) (\s :: CreateWebACLResponse
s@CreateWebACLResponse' {} Maybe WebACL
a -> CreateWebACLResponse
s {$sel:webACL:CreateWebACLResponse' :: Maybe WebACL
webACL = Maybe WebACL
a} :: CreateWebACLResponse)

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

instance Prelude.NFData CreateWebACLResponse where
  rnf :: CreateWebACLResponse -> ()
rnf CreateWebACLResponse' {Int
Maybe Text
Maybe WebACL
httpStatus :: Int
webACL :: Maybe WebACL
changeToken :: Maybe Text
$sel:httpStatus:CreateWebACLResponse' :: CreateWebACLResponse -> Int
$sel:webACL:CreateWebACLResponse' :: CreateWebACLResponse -> Maybe WebACL
$sel:changeToken:CreateWebACLResponse' :: CreateWebACLResponse -> 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 Maybe WebACL
webACL
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus