{-# 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.WAFV2.CheckCapacity
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Returns the web ACL capacity unit (WCU) requirements for a specified
-- scope and set of rules. You can use this to check the capacity
-- requirements for the rules you want to use in a RuleGroup or WebACL.
--
-- WAF uses WCUs to calculate and control the operating resources that are
-- used to run your rules, rule groups, and web ACLs. WAF calculates
-- capacity differently for each rule type, to reflect the relative cost of
-- each rule. Simple rules that cost little to run use fewer WCUs than more
-- complex rules that use more processing power. Rule group capacity is
-- fixed at creation, which helps users plan their web ACL WCU usage when
-- they use a rule group. The WCU limit for web ACLs is 1,500.
module Amazonka.WAFV2.CheckCapacity
  ( -- * Creating a Request
    CheckCapacity (..),
    newCheckCapacity,

    -- * Request Lenses
    checkCapacity_scope,
    checkCapacity_rules,

    -- * Destructuring the Response
    CheckCapacityResponse (..),
    newCheckCapacityResponse,

    -- * Response Lenses
    checkCapacityResponse_capacity,
    checkCapacityResponse_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.WAFV2.Types

-- | /See:/ 'newCheckCapacity' smart constructor.
data CheckCapacity = CheckCapacity'
  { -- | Specifies whether this is for an Amazon CloudFront distribution or for a
    -- regional application. A regional application can be an Application Load
    -- Balancer (ALB), an Amazon API Gateway REST API, an AppSync GraphQL API,
    -- or an Amazon Cognito user pool.
    --
    -- To work with CloudFront, you must also specify the Region US East (N.
    -- Virginia) as follows:
    --
    -- -   CLI - Specify the Region when you use the CloudFront scope:
    --     @--scope=CLOUDFRONT --region=us-east-1@.
    --
    -- -   API and SDKs - For all calls, use the Region endpoint us-east-1.
    CheckCapacity -> Scope
scope :: Scope,
    -- | An array of Rule that you\'re configuring to use in a rule group or web
    -- ACL.
    CheckCapacity -> [Rule]
rules :: [Rule]
  }
  deriving (CheckCapacity -> CheckCapacity -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CheckCapacity -> CheckCapacity -> Bool
$c/= :: CheckCapacity -> CheckCapacity -> Bool
== :: CheckCapacity -> CheckCapacity -> Bool
$c== :: CheckCapacity -> CheckCapacity -> Bool
Prelude.Eq, ReadPrec [CheckCapacity]
ReadPrec CheckCapacity
Int -> ReadS CheckCapacity
ReadS [CheckCapacity]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CheckCapacity]
$creadListPrec :: ReadPrec [CheckCapacity]
readPrec :: ReadPrec CheckCapacity
$creadPrec :: ReadPrec CheckCapacity
readList :: ReadS [CheckCapacity]
$creadList :: ReadS [CheckCapacity]
readsPrec :: Int -> ReadS CheckCapacity
$creadsPrec :: Int -> ReadS CheckCapacity
Prelude.Read, Int -> CheckCapacity -> ShowS
[CheckCapacity] -> ShowS
CheckCapacity -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CheckCapacity] -> ShowS
$cshowList :: [CheckCapacity] -> ShowS
show :: CheckCapacity -> String
$cshow :: CheckCapacity -> String
showsPrec :: Int -> CheckCapacity -> ShowS
$cshowsPrec :: Int -> CheckCapacity -> ShowS
Prelude.Show, forall x. Rep CheckCapacity x -> CheckCapacity
forall x. CheckCapacity -> Rep CheckCapacity x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CheckCapacity x -> CheckCapacity
$cfrom :: forall x. CheckCapacity -> Rep CheckCapacity x
Prelude.Generic)

-- |
-- Create a value of 'CheckCapacity' 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:
--
-- 'scope', 'checkCapacity_scope' - Specifies whether this is for an Amazon CloudFront distribution or for a
-- regional application. A regional application can be an Application Load
-- Balancer (ALB), an Amazon API Gateway REST API, an AppSync GraphQL API,
-- or an Amazon Cognito user pool.
--
-- To work with CloudFront, you must also specify the Region US East (N.
-- Virginia) as follows:
--
-- -   CLI - Specify the Region when you use the CloudFront scope:
--     @--scope=CLOUDFRONT --region=us-east-1@.
--
-- -   API and SDKs - For all calls, use the Region endpoint us-east-1.
--
-- 'rules', 'checkCapacity_rules' - An array of Rule that you\'re configuring to use in a rule group or web
-- ACL.
newCheckCapacity ::
  -- | 'scope'
  Scope ->
  CheckCapacity
newCheckCapacity :: Scope -> CheckCapacity
newCheckCapacity Scope
pScope_ =
  CheckCapacity'
    { $sel:scope:CheckCapacity' :: Scope
scope = Scope
pScope_,
      $sel:rules:CheckCapacity' :: [Rule]
rules = forall a. Monoid a => a
Prelude.mempty
    }

-- | Specifies whether this is for an Amazon CloudFront distribution or for a
-- regional application. A regional application can be an Application Load
-- Balancer (ALB), an Amazon API Gateway REST API, an AppSync GraphQL API,
-- or an Amazon Cognito user pool.
--
-- To work with CloudFront, you must also specify the Region US East (N.
-- Virginia) as follows:
--
-- -   CLI - Specify the Region when you use the CloudFront scope:
--     @--scope=CLOUDFRONT --region=us-east-1@.
--
-- -   API and SDKs - For all calls, use the Region endpoint us-east-1.
checkCapacity_scope :: Lens.Lens' CheckCapacity Scope
checkCapacity_scope :: Lens' CheckCapacity Scope
checkCapacity_scope = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CheckCapacity' {Scope
scope :: Scope
$sel:scope:CheckCapacity' :: CheckCapacity -> Scope
scope} -> Scope
scope) (\s :: CheckCapacity
s@CheckCapacity' {} Scope
a -> CheckCapacity
s {$sel:scope:CheckCapacity' :: Scope
scope = Scope
a} :: CheckCapacity)

-- | An array of Rule that you\'re configuring to use in a rule group or web
-- ACL.
checkCapacity_rules :: Lens.Lens' CheckCapacity [Rule]
checkCapacity_rules :: Lens' CheckCapacity [Rule]
checkCapacity_rules = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CheckCapacity' {[Rule]
rules :: [Rule]
$sel:rules:CheckCapacity' :: CheckCapacity -> [Rule]
rules} -> [Rule]
rules) (\s :: CheckCapacity
s@CheckCapacity' {} [Rule]
a -> CheckCapacity
s {$sel:rules:CheckCapacity' :: [Rule]
rules = [Rule]
a} :: CheckCapacity) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

instance Core.AWSRequest CheckCapacity where
  type
    AWSResponse CheckCapacity =
      CheckCapacityResponse
  request :: (Service -> Service) -> CheckCapacity -> Request CheckCapacity
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 CheckCapacity
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CheckCapacity)))
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 Natural -> Int -> CheckCapacityResponse
CheckCapacityResponse'
            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
"Capacity")
            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 CheckCapacity where
  hashWithSalt :: Int -> CheckCapacity -> Int
hashWithSalt Int
_salt CheckCapacity' {[Rule]
Scope
rules :: [Rule]
scope :: Scope
$sel:rules:CheckCapacity' :: CheckCapacity -> [Rule]
$sel:scope:CheckCapacity' :: CheckCapacity -> Scope
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Scope
scope
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` [Rule]
rules

instance Prelude.NFData CheckCapacity where
  rnf :: CheckCapacity -> ()
rnf CheckCapacity' {[Rule]
Scope
rules :: [Rule]
scope :: Scope
$sel:rules:CheckCapacity' :: CheckCapacity -> [Rule]
$sel:scope:CheckCapacity' :: CheckCapacity -> Scope
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Scope
scope seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf [Rule]
rules

instance Data.ToHeaders CheckCapacity where
  toHeaders :: CheckCapacity -> 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_20190729.CheckCapacity" ::
                          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 CheckCapacity where
  toJSON :: CheckCapacity -> Value
toJSON CheckCapacity' {[Rule]
Scope
rules :: [Rule]
scope :: Scope
$sel:rules:CheckCapacity' :: CheckCapacity -> [Rule]
$sel:scope:CheckCapacity' :: CheckCapacity -> Scope
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just (Key
"Scope" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Scope
scope),
            forall a. a -> Maybe a
Prelude.Just (Key
"Rules" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= [Rule]
rules)
          ]
      )

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

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

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

-- |
-- Create a value of 'CheckCapacityResponse' 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:
--
-- 'capacity', 'checkCapacityResponse_capacity' - The capacity required by the rules and scope.
--
-- 'httpStatus', 'checkCapacityResponse_httpStatus' - The response's http status code.
newCheckCapacityResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CheckCapacityResponse
newCheckCapacityResponse :: Int -> CheckCapacityResponse
newCheckCapacityResponse Int
pHttpStatus_ =
  CheckCapacityResponse'
    { $sel:capacity:CheckCapacityResponse' :: Maybe Natural
capacity = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CheckCapacityResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The capacity required by the rules and scope.
checkCapacityResponse_capacity :: Lens.Lens' CheckCapacityResponse (Prelude.Maybe Prelude.Natural)
checkCapacityResponse_capacity :: Lens' CheckCapacityResponse (Maybe Natural)
checkCapacityResponse_capacity = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CheckCapacityResponse' {Maybe Natural
capacity :: Maybe Natural
$sel:capacity:CheckCapacityResponse' :: CheckCapacityResponse -> Maybe Natural
capacity} -> Maybe Natural
capacity) (\s :: CheckCapacityResponse
s@CheckCapacityResponse' {} Maybe Natural
a -> CheckCapacityResponse
s {$sel:capacity:CheckCapacityResponse' :: Maybe Natural
capacity = Maybe Natural
a} :: CheckCapacityResponse)

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

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