{-# 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.WAFV2.Types.Headers
-- 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.WAFV2.Types.Headers 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.WAFV2.Types.HeaderMatchPattern
import Amazonka.WAFV2.Types.MapMatchScope
import Amazonka.WAFV2.Types.OversizeHandling

-- | Inspect all headers in the web request. You can specify the parts of the
-- headers to inspect and you can narrow the set of headers to inspect by
-- including or excluding specific keys.
--
-- This is used to indicate the web request component to inspect, in the
-- FieldToMatch specification.
--
-- If you want to inspect just the value of a single header, use the
-- @SingleHeader@ @FieldToMatch@ setting instead.
--
-- Example JSON:
-- @\"Headers\": { \"MatchPattern\": { \"All\": {} }, \"MatchScope\": \"KEY\", \"OversizeHandling\": \"MATCH\" }@
--
-- /See:/ 'newHeaders' smart constructor.
data Headers = Headers'
  { -- | The filter to use to identify the subset of headers to inspect in a web
    -- request.
    --
    -- You must specify exactly one setting: either @All@, @IncludedHeaders@,
    -- or @ExcludedHeaders@.
    --
    -- Example JSON:
    -- @\"MatchPattern\": { \"ExcludedHeaders\": {\"KeyToExclude1\", \"KeyToExclude2\"} }@
    Headers -> HeaderMatchPattern
matchPattern :: HeaderMatchPattern,
    -- | The parts of the headers to match with the rule inspection criteria. If
    -- you specify @All@, WAF inspects both keys and values.
    Headers -> MapMatchScope
matchScope :: MapMatchScope,
    -- | What WAF should do if the headers of the request are larger than WAF can
    -- inspect. WAF does not support inspecting the entire contents of request
    -- headers when they exceed 8 KB (8192 bytes) or 200 total headers. The
    -- underlying host service forwards a maximum of 200 headers and at most 8
    -- KB of header contents to WAF.
    --
    -- The options for oversize handling are the following:
    --
    -- -   @CONTINUE@ - Inspect the headers normally, according to the rule
    --     inspection criteria.
    --
    -- -   @MATCH@ - Treat the web request as matching the rule statement. WAF
    --     applies the rule action to the request.
    --
    -- -   @NO_MATCH@ - Treat the web request as not matching the rule
    --     statement.
    Headers -> OversizeHandling
oversizeHandling :: OversizeHandling
  }
  deriving (Headers -> Headers -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Headers -> Headers -> Bool
$c/= :: Headers -> Headers -> Bool
== :: Headers -> Headers -> Bool
$c== :: Headers -> Headers -> Bool
Prelude.Eq, ReadPrec [Headers]
ReadPrec Headers
Int -> ReadS Headers
ReadS [Headers]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Headers]
$creadListPrec :: ReadPrec [Headers]
readPrec :: ReadPrec Headers
$creadPrec :: ReadPrec Headers
readList :: ReadS [Headers]
$creadList :: ReadS [Headers]
readsPrec :: Int -> ReadS Headers
$creadsPrec :: Int -> ReadS Headers
Prelude.Read, Int -> Headers -> ShowS
[Headers] -> ShowS
Headers -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Headers] -> ShowS
$cshowList :: [Headers] -> ShowS
show :: Headers -> String
$cshow :: Headers -> String
showsPrec :: Int -> Headers -> ShowS
$cshowsPrec :: Int -> Headers -> ShowS
Prelude.Show, forall x. Rep Headers x -> Headers
forall x. Headers -> Rep Headers x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Headers x -> Headers
$cfrom :: forall x. Headers -> Rep Headers x
Prelude.Generic)

-- |
-- Create a value of 'Headers' 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:
--
-- 'matchPattern', 'headers_matchPattern' - The filter to use to identify the subset of headers to inspect in a web
-- request.
--
-- You must specify exactly one setting: either @All@, @IncludedHeaders@,
-- or @ExcludedHeaders@.
--
-- Example JSON:
-- @\"MatchPattern\": { \"ExcludedHeaders\": {\"KeyToExclude1\", \"KeyToExclude2\"} }@
--
-- 'matchScope', 'headers_matchScope' - The parts of the headers to match with the rule inspection criteria. If
-- you specify @All@, WAF inspects both keys and values.
--
-- 'oversizeHandling', 'headers_oversizeHandling' - What WAF should do if the headers of the request are larger than WAF can
-- inspect. WAF does not support inspecting the entire contents of request
-- headers when they exceed 8 KB (8192 bytes) or 200 total headers. The
-- underlying host service forwards a maximum of 200 headers and at most 8
-- KB of header contents to WAF.
--
-- The options for oversize handling are the following:
--
-- -   @CONTINUE@ - Inspect the headers normally, according to the rule
--     inspection criteria.
--
-- -   @MATCH@ - Treat the web request as matching the rule statement. WAF
--     applies the rule action to the request.
--
-- -   @NO_MATCH@ - Treat the web request as not matching the rule
--     statement.
newHeaders ::
  -- | 'matchPattern'
  HeaderMatchPattern ->
  -- | 'matchScope'
  MapMatchScope ->
  -- | 'oversizeHandling'
  OversizeHandling ->
  Headers
newHeaders :: HeaderMatchPattern -> MapMatchScope -> OversizeHandling -> Headers
newHeaders
  HeaderMatchPattern
pMatchPattern_
  MapMatchScope
pMatchScope_
  OversizeHandling
pOversizeHandling_ =
    Headers'
      { $sel:matchPattern:Headers' :: HeaderMatchPattern
matchPattern = HeaderMatchPattern
pMatchPattern_,
        $sel:matchScope:Headers' :: MapMatchScope
matchScope = MapMatchScope
pMatchScope_,
        $sel:oversizeHandling:Headers' :: OversizeHandling
oversizeHandling = OversizeHandling
pOversizeHandling_
      }

-- | The filter to use to identify the subset of headers to inspect in a web
-- request.
--
-- You must specify exactly one setting: either @All@, @IncludedHeaders@,
-- or @ExcludedHeaders@.
--
-- Example JSON:
-- @\"MatchPattern\": { \"ExcludedHeaders\": {\"KeyToExclude1\", \"KeyToExclude2\"} }@
headers_matchPattern :: Lens.Lens' Headers HeaderMatchPattern
headers_matchPattern :: Lens' Headers HeaderMatchPattern
headers_matchPattern = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Headers' {HeaderMatchPattern
matchPattern :: HeaderMatchPattern
$sel:matchPattern:Headers' :: Headers -> HeaderMatchPattern
matchPattern} -> HeaderMatchPattern
matchPattern) (\s :: Headers
s@Headers' {} HeaderMatchPattern
a -> Headers
s {$sel:matchPattern:Headers' :: HeaderMatchPattern
matchPattern = HeaderMatchPattern
a} :: Headers)

-- | The parts of the headers to match with the rule inspection criteria. If
-- you specify @All@, WAF inspects both keys and values.
headers_matchScope :: Lens.Lens' Headers MapMatchScope
headers_matchScope :: Lens' Headers MapMatchScope
headers_matchScope = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Headers' {MapMatchScope
matchScope :: MapMatchScope
$sel:matchScope:Headers' :: Headers -> MapMatchScope
matchScope} -> MapMatchScope
matchScope) (\s :: Headers
s@Headers' {} MapMatchScope
a -> Headers
s {$sel:matchScope:Headers' :: MapMatchScope
matchScope = MapMatchScope
a} :: Headers)

-- | What WAF should do if the headers of the request are larger than WAF can
-- inspect. WAF does not support inspecting the entire contents of request
-- headers when they exceed 8 KB (8192 bytes) or 200 total headers. The
-- underlying host service forwards a maximum of 200 headers and at most 8
-- KB of header contents to WAF.
--
-- The options for oversize handling are the following:
--
-- -   @CONTINUE@ - Inspect the headers normally, according to the rule
--     inspection criteria.
--
-- -   @MATCH@ - Treat the web request as matching the rule statement. WAF
--     applies the rule action to the request.
--
-- -   @NO_MATCH@ - Treat the web request as not matching the rule
--     statement.
headers_oversizeHandling :: Lens.Lens' Headers OversizeHandling
headers_oversizeHandling :: Lens' Headers OversizeHandling
headers_oversizeHandling = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Headers' {OversizeHandling
oversizeHandling :: OversizeHandling
$sel:oversizeHandling:Headers' :: Headers -> OversizeHandling
oversizeHandling} -> OversizeHandling
oversizeHandling) (\s :: Headers
s@Headers' {} OversizeHandling
a -> Headers
s {$sel:oversizeHandling:Headers' :: OversizeHandling
oversizeHandling = OversizeHandling
a} :: Headers)

instance Data.FromJSON Headers where
  parseJSON :: Value -> Parser Headers
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"Headers"
      ( \Object
x ->
          HeaderMatchPattern -> MapMatchScope -> OversizeHandling -> Headers
Headers'
            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
"MatchPattern")
            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
"MatchScope")
            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
"OversizeHandling")
      )

instance Prelude.Hashable Headers where
  hashWithSalt :: Int -> Headers -> Int
hashWithSalt Int
_salt Headers' {HeaderMatchPattern
MapMatchScope
OversizeHandling
oversizeHandling :: OversizeHandling
matchScope :: MapMatchScope
matchPattern :: HeaderMatchPattern
$sel:oversizeHandling:Headers' :: Headers -> OversizeHandling
$sel:matchScope:Headers' :: Headers -> MapMatchScope
$sel:matchPattern:Headers' :: Headers -> HeaderMatchPattern
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` HeaderMatchPattern
matchPattern
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` MapMatchScope
matchScope
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` OversizeHandling
oversizeHandling

instance Prelude.NFData Headers where
  rnf :: Headers -> ()
rnf Headers' {HeaderMatchPattern
MapMatchScope
OversizeHandling
oversizeHandling :: OversizeHandling
matchScope :: MapMatchScope
matchPattern :: HeaderMatchPattern
$sel:oversizeHandling:Headers' :: Headers -> OversizeHandling
$sel:matchScope:Headers' :: Headers -> MapMatchScope
$sel:matchPattern:Headers' :: Headers -> HeaderMatchPattern
..} =
    forall a. NFData a => a -> ()
Prelude.rnf HeaderMatchPattern
matchPattern
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf MapMatchScope
matchScope
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf OversizeHandling
oversizeHandling

instance Data.ToJSON Headers where
  toJSON :: Headers -> Value
toJSON Headers' {HeaderMatchPattern
MapMatchScope
OversizeHandling
oversizeHandling :: OversizeHandling
matchScope :: MapMatchScope
matchPattern :: HeaderMatchPattern
$sel:oversizeHandling:Headers' :: Headers -> OversizeHandling
$sel:matchScope:Headers' :: Headers -> MapMatchScope
$sel:matchPattern:Headers' :: Headers -> HeaderMatchPattern
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just (Key
"MatchPattern" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= HeaderMatchPattern
matchPattern),
            forall a. a -> Maybe a
Prelude.Just (Key
"MatchScope" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= MapMatchScope
matchScope),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"OversizeHandling" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= OversizeHandling
oversizeHandling)
          ]
      )