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

-- | Inspect the cookies in the web request. You can specify the parts of the
-- cookies to inspect and you can narrow the set of cookies to inspect by
-- including or excluding specific keys.
--
-- This is used to indicate the web request component to inspect, in the
-- FieldToMatch specification.
--
-- Example JSON:
-- @\"Cookies\": { \"MatchPattern\": { \"All\": {} }, \"MatchScope\": \"KEY\", \"OversizeHandling\": \"MATCH\" }@
--
-- /See:/ 'newCookies' smart constructor.
data Cookies = Cookies'
  { -- | The filter to use to identify the subset of cookies to inspect in a web
    -- request.
    --
    -- You must specify exactly one setting: either @All@, @IncludedCookies@,
    -- or @ExcludedCookies@.
    --
    -- Example JSON:
    -- @\"MatchPattern\": { \"IncludedCookies\": {\"KeyToInclude1\", \"KeyToInclude2\", \"KeyToInclude3\"} }@
    Cookies -> CookieMatchPattern
matchPattern :: CookieMatchPattern,
    -- | The parts of the cookies to inspect with the rule inspection criteria.
    -- If you specify @All@, WAF inspects both keys and values.
    Cookies -> MapMatchScope
matchScope :: MapMatchScope,
    -- | What WAF should do if the cookies of the request are larger than WAF can
    -- inspect. WAF does not support inspecting the entire contents of request
    -- cookies when they exceed 8 KB (8192 bytes) or 200 total cookies. The
    -- underlying host service forwards a maximum of 200 cookies and at most 8
    -- KB of cookie contents to WAF.
    --
    -- The options for oversize handling are the following:
    --
    -- -   @CONTINUE@ - Inspect the cookies 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.
    Cookies -> OversizeHandling
oversizeHandling :: OversizeHandling
  }
  deriving (Cookies -> Cookies -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Cookies -> Cookies -> Bool
$c/= :: Cookies -> Cookies -> Bool
== :: Cookies -> Cookies -> Bool
$c== :: Cookies -> Cookies -> Bool
Prelude.Eq, ReadPrec [Cookies]
ReadPrec Cookies
Int -> ReadS Cookies
ReadS [Cookies]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Cookies]
$creadListPrec :: ReadPrec [Cookies]
readPrec :: ReadPrec Cookies
$creadPrec :: ReadPrec Cookies
readList :: ReadS [Cookies]
$creadList :: ReadS [Cookies]
readsPrec :: Int -> ReadS Cookies
$creadsPrec :: Int -> ReadS Cookies
Prelude.Read, Int -> Cookies -> ShowS
[Cookies] -> ShowS
Cookies -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Cookies] -> ShowS
$cshowList :: [Cookies] -> ShowS
show :: Cookies -> String
$cshow :: Cookies -> String
showsPrec :: Int -> Cookies -> ShowS
$cshowsPrec :: Int -> Cookies -> ShowS
Prelude.Show, forall x. Rep Cookies x -> Cookies
forall x. Cookies -> Rep Cookies x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Cookies x -> Cookies
$cfrom :: forall x. Cookies -> Rep Cookies x
Prelude.Generic)

-- |
-- Create a value of 'Cookies' 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', 'cookies_matchPattern' - The filter to use to identify the subset of cookies to inspect in a web
-- request.
--
-- You must specify exactly one setting: either @All@, @IncludedCookies@,
-- or @ExcludedCookies@.
--
-- Example JSON:
-- @\"MatchPattern\": { \"IncludedCookies\": {\"KeyToInclude1\", \"KeyToInclude2\", \"KeyToInclude3\"} }@
--
-- 'matchScope', 'cookies_matchScope' - The parts of the cookies to inspect with the rule inspection criteria.
-- If you specify @All@, WAF inspects both keys and values.
--
-- 'oversizeHandling', 'cookies_oversizeHandling' - What WAF should do if the cookies of the request are larger than WAF can
-- inspect. WAF does not support inspecting the entire contents of request
-- cookies when they exceed 8 KB (8192 bytes) or 200 total cookies. The
-- underlying host service forwards a maximum of 200 cookies and at most 8
-- KB of cookie contents to WAF.
--
-- The options for oversize handling are the following:
--
-- -   @CONTINUE@ - Inspect the cookies 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.
newCookies ::
  -- | 'matchPattern'
  CookieMatchPattern ->
  -- | 'matchScope'
  MapMatchScope ->
  -- | 'oversizeHandling'
  OversizeHandling ->
  Cookies
newCookies :: CookieMatchPattern -> MapMatchScope -> OversizeHandling -> Cookies
newCookies
  CookieMatchPattern
pMatchPattern_
  MapMatchScope
pMatchScope_
  OversizeHandling
pOversizeHandling_ =
    Cookies'
      { $sel:matchPattern:Cookies' :: CookieMatchPattern
matchPattern = CookieMatchPattern
pMatchPattern_,
        $sel:matchScope:Cookies' :: MapMatchScope
matchScope = MapMatchScope
pMatchScope_,
        $sel:oversizeHandling:Cookies' :: OversizeHandling
oversizeHandling = OversizeHandling
pOversizeHandling_
      }

-- | The filter to use to identify the subset of cookies to inspect in a web
-- request.
--
-- You must specify exactly one setting: either @All@, @IncludedCookies@,
-- or @ExcludedCookies@.
--
-- Example JSON:
-- @\"MatchPattern\": { \"IncludedCookies\": {\"KeyToInclude1\", \"KeyToInclude2\", \"KeyToInclude3\"} }@
cookies_matchPattern :: Lens.Lens' Cookies CookieMatchPattern
cookies_matchPattern :: Lens' Cookies CookieMatchPattern
cookies_matchPattern = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Cookies' {CookieMatchPattern
matchPattern :: CookieMatchPattern
$sel:matchPattern:Cookies' :: Cookies -> CookieMatchPattern
matchPattern} -> CookieMatchPattern
matchPattern) (\s :: Cookies
s@Cookies' {} CookieMatchPattern
a -> Cookies
s {$sel:matchPattern:Cookies' :: CookieMatchPattern
matchPattern = CookieMatchPattern
a} :: Cookies)

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

-- | What WAF should do if the cookies of the request are larger than WAF can
-- inspect. WAF does not support inspecting the entire contents of request
-- cookies when they exceed 8 KB (8192 bytes) or 200 total cookies. The
-- underlying host service forwards a maximum of 200 cookies and at most 8
-- KB of cookie contents to WAF.
--
-- The options for oversize handling are the following:
--
-- -   @CONTINUE@ - Inspect the cookies 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.
cookies_oversizeHandling :: Lens.Lens' Cookies OversizeHandling
cookies_oversizeHandling :: Lens' Cookies OversizeHandling
cookies_oversizeHandling = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Cookies' {OversizeHandling
oversizeHandling :: OversizeHandling
$sel:oversizeHandling:Cookies' :: Cookies -> OversizeHandling
oversizeHandling} -> OversizeHandling
oversizeHandling) (\s :: Cookies
s@Cookies' {} OversizeHandling
a -> Cookies
s {$sel:oversizeHandling:Cookies' :: OversizeHandling
oversizeHandling = OversizeHandling
a} :: Cookies)

instance Data.FromJSON Cookies where
  parseJSON :: Value -> Parser Cookies
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"Cookies"
      ( \Object
x ->
          CookieMatchPattern -> MapMatchScope -> OversizeHandling -> Cookies
Cookies'
            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 Cookies where
  hashWithSalt :: Int -> Cookies -> Int
hashWithSalt Int
_salt Cookies' {CookieMatchPattern
MapMatchScope
OversizeHandling
oversizeHandling :: OversizeHandling
matchScope :: MapMatchScope
matchPattern :: CookieMatchPattern
$sel:oversizeHandling:Cookies' :: Cookies -> OversizeHandling
$sel:matchScope:Cookies' :: Cookies -> MapMatchScope
$sel:matchPattern:Cookies' :: Cookies -> CookieMatchPattern
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` CookieMatchPattern
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 Cookies where
  rnf :: Cookies -> ()
rnf Cookies' {CookieMatchPattern
MapMatchScope
OversizeHandling
oversizeHandling :: OversizeHandling
matchScope :: MapMatchScope
matchPattern :: CookieMatchPattern
$sel:oversizeHandling:Cookies' :: Cookies -> OversizeHandling
$sel:matchScope:Cookies' :: Cookies -> MapMatchScope
$sel:matchPattern:Cookies' :: Cookies -> CookieMatchPattern
..} =
    forall a. NFData a => a -> ()
Prelude.rnf CookieMatchPattern
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 Cookies where
  toJSON :: Cookies -> Value
toJSON Cookies' {CookieMatchPattern
MapMatchScope
OversizeHandling
oversizeHandling :: OversizeHandling
matchScope :: MapMatchScope
matchPattern :: CookieMatchPattern
$sel:oversizeHandling:Cookies' :: Cookies -> OversizeHandling
$sel:matchScope:Cookies' :: Cookies -> MapMatchScope
$sel:matchPattern:Cookies' :: Cookies -> CookieMatchPattern
..} =
    [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..= CookieMatchPattern
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)
          ]
      )