{-# 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.CloudFront.Types.ForwardedValues
-- 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.CloudFront.Types.ForwardedValues where

import Amazonka.CloudFront.Types.CookiePreference
import Amazonka.CloudFront.Types.Headers
import Amazonka.CloudFront.Types.QueryStringCacheKeys
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

-- | This field is deprecated. We recommend that you use a cache policy or an
-- origin request policy instead of this field.
--
-- If you want to include values in the cache key, use a cache policy. For
-- more information, see
-- <https://docs.aws.amazon.com/AmazonCloudFront/latest/DeveloperGuide/controlling-the-cache-key.html#cache-key-create-cache-policy Creating cache policies>
-- in the /Amazon CloudFront Developer Guide/.
--
-- If you want to send values to the origin but not include them in the
-- cache key, use an origin request policy. For more information, see
-- <https://docs.aws.amazon.com/AmazonCloudFront/latest/DeveloperGuide/controlling-origin-requests.html#origin-request-create-origin-request-policy Creating origin request policies>
-- in the /Amazon CloudFront Developer Guide/.
--
-- A complex type that specifies how CloudFront handles query strings,
-- cookies, and HTTP headers.
--
-- /See:/ 'newForwardedValues' smart constructor.
data ForwardedValues = ForwardedValues'
  { -- | This field is deprecated. We recommend that you use a cache policy or an
    -- origin request policy instead of this field.
    --
    -- If you want to include headers in the cache key, use a cache policy. For
    -- more information, see
    -- <https://docs.aws.amazon.com/AmazonCloudFront/latest/DeveloperGuide/controlling-the-cache-key.html#cache-key-create-cache-policy Creating cache policies>
    -- in the /Amazon CloudFront Developer Guide/.
    --
    -- If you want to send headers to the origin but not include them in the
    -- cache key, use an origin request policy. For more information, see
    -- <https://docs.aws.amazon.com/AmazonCloudFront/latest/DeveloperGuide/controlling-origin-requests.html#origin-request-create-origin-request-policy Creating origin request policies>
    -- in the /Amazon CloudFront Developer Guide/.
    --
    -- A complex type that specifies the @Headers@, if any, that you want
    -- CloudFront to forward to the origin for this cache behavior (whitelisted
    -- headers). For the headers that you specify, CloudFront also caches
    -- separate versions of a specified object that is based on the header
    -- values in viewer requests.
    --
    -- For more information, see
    -- <https://docs.aws.amazon.com/AmazonCloudFront/latest/DeveloperGuide/header-caching.html Caching Content Based on Request Headers>
    -- in the /Amazon CloudFront Developer Guide/.
    ForwardedValues -> Maybe Headers
headers :: Prelude.Maybe Headers,
    -- | This field is deprecated. We recommend that you use a cache policy or an
    -- origin request policy instead of this field.
    --
    -- If you want to include query strings in the cache key, use a cache
    -- policy. For more information, see
    -- <https://docs.aws.amazon.com/AmazonCloudFront/latest/DeveloperGuide/controlling-the-cache-key.html#cache-key-create-cache-policy Creating cache policies>
    -- in the /Amazon CloudFront Developer Guide/.
    --
    -- If you want to send query strings to the origin but not include them in
    -- the cache key, use an origin request policy. For more information, see
    -- <https://docs.aws.amazon.com/AmazonCloudFront/latest/DeveloperGuide/controlling-origin-requests.html#origin-request-create-origin-request-policy Creating origin request policies>
    -- in the /Amazon CloudFront Developer Guide/.
    --
    -- A complex type that contains information about the query string
    -- parameters that you want CloudFront to use for caching for this cache
    -- behavior.
    ForwardedValues -> Maybe QueryStringCacheKeys
queryStringCacheKeys :: Prelude.Maybe QueryStringCacheKeys,
    -- | This field is deprecated. We recommend that you use a cache policy or an
    -- origin request policy instead of this field.
    --
    -- If you want to include query strings in the cache key, use a cache
    -- policy. For more information, see
    -- <https://docs.aws.amazon.com/AmazonCloudFront/latest/DeveloperGuide/controlling-the-cache-key.html#cache-key-create-cache-policy Creating cache policies>
    -- in the /Amazon CloudFront Developer Guide/.
    --
    -- If you want to send query strings to the origin but not include them in
    -- the cache key, use an origin request policy. For more information, see
    -- <https://docs.aws.amazon.com/AmazonCloudFront/latest/DeveloperGuide/controlling-origin-requests.html#origin-request-create-origin-request-policy Creating origin request policies>
    -- in the /Amazon CloudFront Developer Guide/.
    --
    -- Indicates whether you want CloudFront to forward query strings to the
    -- origin that is associated with this cache behavior and cache based on
    -- the query string parameters. CloudFront behavior depends on the value of
    -- @QueryString@ and on the values that you specify for
    -- @QueryStringCacheKeys@, if any:
    --
    -- If you specify true for @QueryString@ and you don\'t specify any values
    -- for @QueryStringCacheKeys@, CloudFront forwards all query string
    -- parameters to the origin and caches based on all query string
    -- parameters. Depending on how many query string parameters and values you
    -- have, this can adversely affect performance because CloudFront must
    -- forward more requests to the origin.
    --
    -- If you specify true for @QueryString@ and you specify one or more values
    -- for @QueryStringCacheKeys@, CloudFront forwards all query string
    -- parameters to the origin, but it only caches based on the query string
    -- parameters that you specify.
    --
    -- If you specify false for @QueryString@, CloudFront doesn\'t forward any
    -- query string parameters to the origin, and doesn\'t cache based on query
    -- string parameters.
    --
    -- For more information, see
    -- <https://docs.aws.amazon.com/AmazonCloudFront/latest/DeveloperGuide/QueryStringParameters.html Configuring CloudFront to Cache Based on Query String Parameters>
    -- in the /Amazon CloudFront Developer Guide/.
    ForwardedValues -> Bool
queryString :: Prelude.Bool,
    -- | This field is deprecated. We recommend that you use a cache policy or an
    -- origin request policy instead of this field.
    --
    -- If you want to include cookies in the cache key, use a cache policy. For
    -- more information, see
    -- <https://docs.aws.amazon.com/AmazonCloudFront/latest/DeveloperGuide/controlling-the-cache-key.html#cache-key-create-cache-policy Creating cache policies>
    -- in the /Amazon CloudFront Developer Guide/.
    --
    -- If you want to send cookies to the origin but not include them in the
    -- cache key, use an origin request policy. For more information, see
    -- <https://docs.aws.amazon.com/AmazonCloudFront/latest/DeveloperGuide/controlling-origin-requests.html#origin-request-create-origin-request-policy Creating origin request policies>
    -- in the /Amazon CloudFront Developer Guide/.
    --
    -- A complex type that specifies whether you want CloudFront to forward
    -- cookies to the origin and, if so, which ones. For more information about
    -- forwarding cookies to the origin, see
    -- <https://docs.aws.amazon.com/AmazonCloudFront/latest/DeveloperGuide/Cookies.html How CloudFront Forwards, Caches, and Logs Cookies>
    -- in the /Amazon CloudFront Developer Guide/.
    ForwardedValues -> CookiePreference
cookies :: CookiePreference
  }
  deriving (ForwardedValues -> ForwardedValues -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ForwardedValues -> ForwardedValues -> Bool
$c/= :: ForwardedValues -> ForwardedValues -> Bool
== :: ForwardedValues -> ForwardedValues -> Bool
$c== :: ForwardedValues -> ForwardedValues -> Bool
Prelude.Eq, ReadPrec [ForwardedValues]
ReadPrec ForwardedValues
Int -> ReadS ForwardedValues
ReadS [ForwardedValues]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ForwardedValues]
$creadListPrec :: ReadPrec [ForwardedValues]
readPrec :: ReadPrec ForwardedValues
$creadPrec :: ReadPrec ForwardedValues
readList :: ReadS [ForwardedValues]
$creadList :: ReadS [ForwardedValues]
readsPrec :: Int -> ReadS ForwardedValues
$creadsPrec :: Int -> ReadS ForwardedValues
Prelude.Read, Int -> ForwardedValues -> ShowS
[ForwardedValues] -> ShowS
ForwardedValues -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ForwardedValues] -> ShowS
$cshowList :: [ForwardedValues] -> ShowS
show :: ForwardedValues -> String
$cshow :: ForwardedValues -> String
showsPrec :: Int -> ForwardedValues -> ShowS
$cshowsPrec :: Int -> ForwardedValues -> ShowS
Prelude.Show, forall x. Rep ForwardedValues x -> ForwardedValues
forall x. ForwardedValues -> Rep ForwardedValues x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ForwardedValues x -> ForwardedValues
$cfrom :: forall x. ForwardedValues -> Rep ForwardedValues x
Prelude.Generic)

-- |
-- Create a value of 'ForwardedValues' 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:
--
-- 'headers', 'forwardedValues_headers' - This field is deprecated. We recommend that you use a cache policy or an
-- origin request policy instead of this field.
--
-- If you want to include headers in the cache key, use a cache policy. For
-- more information, see
-- <https://docs.aws.amazon.com/AmazonCloudFront/latest/DeveloperGuide/controlling-the-cache-key.html#cache-key-create-cache-policy Creating cache policies>
-- in the /Amazon CloudFront Developer Guide/.
--
-- If you want to send headers to the origin but not include them in the
-- cache key, use an origin request policy. For more information, see
-- <https://docs.aws.amazon.com/AmazonCloudFront/latest/DeveloperGuide/controlling-origin-requests.html#origin-request-create-origin-request-policy Creating origin request policies>
-- in the /Amazon CloudFront Developer Guide/.
--
-- A complex type that specifies the @Headers@, if any, that you want
-- CloudFront to forward to the origin for this cache behavior (whitelisted
-- headers). For the headers that you specify, CloudFront also caches
-- separate versions of a specified object that is based on the header
-- values in viewer requests.
--
-- For more information, see
-- <https://docs.aws.amazon.com/AmazonCloudFront/latest/DeveloperGuide/header-caching.html Caching Content Based on Request Headers>
-- in the /Amazon CloudFront Developer Guide/.
--
-- 'queryStringCacheKeys', 'forwardedValues_queryStringCacheKeys' - This field is deprecated. We recommend that you use a cache policy or an
-- origin request policy instead of this field.
--
-- If you want to include query strings in the cache key, use a cache
-- policy. For more information, see
-- <https://docs.aws.amazon.com/AmazonCloudFront/latest/DeveloperGuide/controlling-the-cache-key.html#cache-key-create-cache-policy Creating cache policies>
-- in the /Amazon CloudFront Developer Guide/.
--
-- If you want to send query strings to the origin but not include them in
-- the cache key, use an origin request policy. For more information, see
-- <https://docs.aws.amazon.com/AmazonCloudFront/latest/DeveloperGuide/controlling-origin-requests.html#origin-request-create-origin-request-policy Creating origin request policies>
-- in the /Amazon CloudFront Developer Guide/.
--
-- A complex type that contains information about the query string
-- parameters that you want CloudFront to use for caching for this cache
-- behavior.
--
-- 'queryString', 'forwardedValues_queryString' - This field is deprecated. We recommend that you use a cache policy or an
-- origin request policy instead of this field.
--
-- If you want to include query strings in the cache key, use a cache
-- policy. For more information, see
-- <https://docs.aws.amazon.com/AmazonCloudFront/latest/DeveloperGuide/controlling-the-cache-key.html#cache-key-create-cache-policy Creating cache policies>
-- in the /Amazon CloudFront Developer Guide/.
--
-- If you want to send query strings to the origin but not include them in
-- the cache key, use an origin request policy. For more information, see
-- <https://docs.aws.amazon.com/AmazonCloudFront/latest/DeveloperGuide/controlling-origin-requests.html#origin-request-create-origin-request-policy Creating origin request policies>
-- in the /Amazon CloudFront Developer Guide/.
--
-- Indicates whether you want CloudFront to forward query strings to the
-- origin that is associated with this cache behavior and cache based on
-- the query string parameters. CloudFront behavior depends on the value of
-- @QueryString@ and on the values that you specify for
-- @QueryStringCacheKeys@, if any:
--
-- If you specify true for @QueryString@ and you don\'t specify any values
-- for @QueryStringCacheKeys@, CloudFront forwards all query string
-- parameters to the origin and caches based on all query string
-- parameters. Depending on how many query string parameters and values you
-- have, this can adversely affect performance because CloudFront must
-- forward more requests to the origin.
--
-- If you specify true for @QueryString@ and you specify one or more values
-- for @QueryStringCacheKeys@, CloudFront forwards all query string
-- parameters to the origin, but it only caches based on the query string
-- parameters that you specify.
--
-- If you specify false for @QueryString@, CloudFront doesn\'t forward any
-- query string parameters to the origin, and doesn\'t cache based on query
-- string parameters.
--
-- For more information, see
-- <https://docs.aws.amazon.com/AmazonCloudFront/latest/DeveloperGuide/QueryStringParameters.html Configuring CloudFront to Cache Based on Query String Parameters>
-- in the /Amazon CloudFront Developer Guide/.
--
-- 'cookies', 'forwardedValues_cookies' - This field is deprecated. We recommend that you use a cache policy or an
-- origin request policy instead of this field.
--
-- If you want to include cookies in the cache key, use a cache policy. For
-- more information, see
-- <https://docs.aws.amazon.com/AmazonCloudFront/latest/DeveloperGuide/controlling-the-cache-key.html#cache-key-create-cache-policy Creating cache policies>
-- in the /Amazon CloudFront Developer Guide/.
--
-- If you want to send cookies to the origin but not include them in the
-- cache key, use an origin request policy. For more information, see
-- <https://docs.aws.amazon.com/AmazonCloudFront/latest/DeveloperGuide/controlling-origin-requests.html#origin-request-create-origin-request-policy Creating origin request policies>
-- in the /Amazon CloudFront Developer Guide/.
--
-- A complex type that specifies whether you want CloudFront to forward
-- cookies to the origin and, if so, which ones. For more information about
-- forwarding cookies to the origin, see
-- <https://docs.aws.amazon.com/AmazonCloudFront/latest/DeveloperGuide/Cookies.html How CloudFront Forwards, Caches, and Logs Cookies>
-- in the /Amazon CloudFront Developer Guide/.
newForwardedValues ::
  -- | 'queryString'
  Prelude.Bool ->
  -- | 'cookies'
  CookiePreference ->
  ForwardedValues
newForwardedValues :: Bool -> CookiePreference -> ForwardedValues
newForwardedValues Bool
pQueryString_ CookiePreference
pCookies_ =
  ForwardedValues'
    { $sel:headers:ForwardedValues' :: Maybe Headers
headers = forall a. Maybe a
Prelude.Nothing,
      $sel:queryStringCacheKeys:ForwardedValues' :: Maybe QueryStringCacheKeys
queryStringCacheKeys = forall a. Maybe a
Prelude.Nothing,
      $sel:queryString:ForwardedValues' :: Bool
queryString = Bool
pQueryString_,
      $sel:cookies:ForwardedValues' :: CookiePreference
cookies = CookiePreference
pCookies_
    }

-- | This field is deprecated. We recommend that you use a cache policy or an
-- origin request policy instead of this field.
--
-- If you want to include headers in the cache key, use a cache policy. For
-- more information, see
-- <https://docs.aws.amazon.com/AmazonCloudFront/latest/DeveloperGuide/controlling-the-cache-key.html#cache-key-create-cache-policy Creating cache policies>
-- in the /Amazon CloudFront Developer Guide/.
--
-- If you want to send headers to the origin but not include them in the
-- cache key, use an origin request policy. For more information, see
-- <https://docs.aws.amazon.com/AmazonCloudFront/latest/DeveloperGuide/controlling-origin-requests.html#origin-request-create-origin-request-policy Creating origin request policies>
-- in the /Amazon CloudFront Developer Guide/.
--
-- A complex type that specifies the @Headers@, if any, that you want
-- CloudFront to forward to the origin for this cache behavior (whitelisted
-- headers). For the headers that you specify, CloudFront also caches
-- separate versions of a specified object that is based on the header
-- values in viewer requests.
--
-- For more information, see
-- <https://docs.aws.amazon.com/AmazonCloudFront/latest/DeveloperGuide/header-caching.html Caching Content Based on Request Headers>
-- in the /Amazon CloudFront Developer Guide/.
forwardedValues_headers :: Lens.Lens' ForwardedValues (Prelude.Maybe Headers)
forwardedValues_headers :: Lens' ForwardedValues (Maybe Headers)
forwardedValues_headers = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ForwardedValues' {Maybe Headers
headers :: Maybe Headers
$sel:headers:ForwardedValues' :: ForwardedValues -> Maybe Headers
headers} -> Maybe Headers
headers) (\s :: ForwardedValues
s@ForwardedValues' {} Maybe Headers
a -> ForwardedValues
s {$sel:headers:ForwardedValues' :: Maybe Headers
headers = Maybe Headers
a} :: ForwardedValues)

-- | This field is deprecated. We recommend that you use a cache policy or an
-- origin request policy instead of this field.
--
-- If you want to include query strings in the cache key, use a cache
-- policy. For more information, see
-- <https://docs.aws.amazon.com/AmazonCloudFront/latest/DeveloperGuide/controlling-the-cache-key.html#cache-key-create-cache-policy Creating cache policies>
-- in the /Amazon CloudFront Developer Guide/.
--
-- If you want to send query strings to the origin but not include them in
-- the cache key, use an origin request policy. For more information, see
-- <https://docs.aws.amazon.com/AmazonCloudFront/latest/DeveloperGuide/controlling-origin-requests.html#origin-request-create-origin-request-policy Creating origin request policies>
-- in the /Amazon CloudFront Developer Guide/.
--
-- A complex type that contains information about the query string
-- parameters that you want CloudFront to use for caching for this cache
-- behavior.
forwardedValues_queryStringCacheKeys :: Lens.Lens' ForwardedValues (Prelude.Maybe QueryStringCacheKeys)
forwardedValues_queryStringCacheKeys :: Lens' ForwardedValues (Maybe QueryStringCacheKeys)
forwardedValues_queryStringCacheKeys = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ForwardedValues' {Maybe QueryStringCacheKeys
queryStringCacheKeys :: Maybe QueryStringCacheKeys
$sel:queryStringCacheKeys:ForwardedValues' :: ForwardedValues -> Maybe QueryStringCacheKeys
queryStringCacheKeys} -> Maybe QueryStringCacheKeys
queryStringCacheKeys) (\s :: ForwardedValues
s@ForwardedValues' {} Maybe QueryStringCacheKeys
a -> ForwardedValues
s {$sel:queryStringCacheKeys:ForwardedValues' :: Maybe QueryStringCacheKeys
queryStringCacheKeys = Maybe QueryStringCacheKeys
a} :: ForwardedValues)

-- | This field is deprecated. We recommend that you use a cache policy or an
-- origin request policy instead of this field.
--
-- If you want to include query strings in the cache key, use a cache
-- policy. For more information, see
-- <https://docs.aws.amazon.com/AmazonCloudFront/latest/DeveloperGuide/controlling-the-cache-key.html#cache-key-create-cache-policy Creating cache policies>
-- in the /Amazon CloudFront Developer Guide/.
--
-- If you want to send query strings to the origin but not include them in
-- the cache key, use an origin request policy. For more information, see
-- <https://docs.aws.amazon.com/AmazonCloudFront/latest/DeveloperGuide/controlling-origin-requests.html#origin-request-create-origin-request-policy Creating origin request policies>
-- in the /Amazon CloudFront Developer Guide/.
--
-- Indicates whether you want CloudFront to forward query strings to the
-- origin that is associated with this cache behavior and cache based on
-- the query string parameters. CloudFront behavior depends on the value of
-- @QueryString@ and on the values that you specify for
-- @QueryStringCacheKeys@, if any:
--
-- If you specify true for @QueryString@ and you don\'t specify any values
-- for @QueryStringCacheKeys@, CloudFront forwards all query string
-- parameters to the origin and caches based on all query string
-- parameters. Depending on how many query string parameters and values you
-- have, this can adversely affect performance because CloudFront must
-- forward more requests to the origin.
--
-- If you specify true for @QueryString@ and you specify one or more values
-- for @QueryStringCacheKeys@, CloudFront forwards all query string
-- parameters to the origin, but it only caches based on the query string
-- parameters that you specify.
--
-- If you specify false for @QueryString@, CloudFront doesn\'t forward any
-- query string parameters to the origin, and doesn\'t cache based on query
-- string parameters.
--
-- For more information, see
-- <https://docs.aws.amazon.com/AmazonCloudFront/latest/DeveloperGuide/QueryStringParameters.html Configuring CloudFront to Cache Based on Query String Parameters>
-- in the /Amazon CloudFront Developer Guide/.
forwardedValues_queryString :: Lens.Lens' ForwardedValues Prelude.Bool
forwardedValues_queryString :: Lens' ForwardedValues Bool
forwardedValues_queryString = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ForwardedValues' {Bool
queryString :: Bool
$sel:queryString:ForwardedValues' :: ForwardedValues -> Bool
queryString} -> Bool
queryString) (\s :: ForwardedValues
s@ForwardedValues' {} Bool
a -> ForwardedValues
s {$sel:queryString:ForwardedValues' :: Bool
queryString = Bool
a} :: ForwardedValues)

-- | This field is deprecated. We recommend that you use a cache policy or an
-- origin request policy instead of this field.
--
-- If you want to include cookies in the cache key, use a cache policy. For
-- more information, see
-- <https://docs.aws.amazon.com/AmazonCloudFront/latest/DeveloperGuide/controlling-the-cache-key.html#cache-key-create-cache-policy Creating cache policies>
-- in the /Amazon CloudFront Developer Guide/.
--
-- If you want to send cookies to the origin but not include them in the
-- cache key, use an origin request policy. For more information, see
-- <https://docs.aws.amazon.com/AmazonCloudFront/latest/DeveloperGuide/controlling-origin-requests.html#origin-request-create-origin-request-policy Creating origin request policies>
-- in the /Amazon CloudFront Developer Guide/.
--
-- A complex type that specifies whether you want CloudFront to forward
-- cookies to the origin and, if so, which ones. For more information about
-- forwarding cookies to the origin, see
-- <https://docs.aws.amazon.com/AmazonCloudFront/latest/DeveloperGuide/Cookies.html How CloudFront Forwards, Caches, and Logs Cookies>
-- in the /Amazon CloudFront Developer Guide/.
forwardedValues_cookies :: Lens.Lens' ForwardedValues CookiePreference
forwardedValues_cookies :: Lens' ForwardedValues CookiePreference
forwardedValues_cookies = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ForwardedValues' {CookiePreference
cookies :: CookiePreference
$sel:cookies:ForwardedValues' :: ForwardedValues -> CookiePreference
cookies} -> CookiePreference
cookies) (\s :: ForwardedValues
s@ForwardedValues' {} CookiePreference
a -> ForwardedValues
s {$sel:cookies:ForwardedValues' :: CookiePreference
cookies = CookiePreference
a} :: ForwardedValues)

instance Data.FromXML ForwardedValues where
  parseXML :: [Node] -> Either String ForwardedValues
parseXML [Node]
x =
    Maybe Headers
-> Maybe QueryStringCacheKeys
-> Bool
-> CookiePreference
-> ForwardedValues
ForwardedValues'
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"Headers")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"QueryStringCacheKeys")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String a
Data..@ Text
"QueryString")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String a
Data..@ Text
"Cookies")

instance Prelude.Hashable ForwardedValues where
  hashWithSalt :: Int -> ForwardedValues -> Int
hashWithSalt Int
_salt ForwardedValues' {Bool
Maybe Headers
Maybe QueryStringCacheKeys
CookiePreference
cookies :: CookiePreference
queryString :: Bool
queryStringCacheKeys :: Maybe QueryStringCacheKeys
headers :: Maybe Headers
$sel:cookies:ForwardedValues' :: ForwardedValues -> CookiePreference
$sel:queryString:ForwardedValues' :: ForwardedValues -> Bool
$sel:queryStringCacheKeys:ForwardedValues' :: ForwardedValues -> Maybe QueryStringCacheKeys
$sel:headers:ForwardedValues' :: ForwardedValues -> Maybe Headers
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Headers
headers
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe QueryStringCacheKeys
queryStringCacheKeys
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Bool
queryString
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` CookiePreference
cookies

instance Prelude.NFData ForwardedValues where
  rnf :: ForwardedValues -> ()
rnf ForwardedValues' {Bool
Maybe Headers
Maybe QueryStringCacheKeys
CookiePreference
cookies :: CookiePreference
queryString :: Bool
queryStringCacheKeys :: Maybe QueryStringCacheKeys
headers :: Maybe Headers
$sel:cookies:ForwardedValues' :: ForwardedValues -> CookiePreference
$sel:queryString:ForwardedValues' :: ForwardedValues -> Bool
$sel:queryStringCacheKeys:ForwardedValues' :: ForwardedValues -> Maybe QueryStringCacheKeys
$sel:headers:ForwardedValues' :: ForwardedValues -> Maybe Headers
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Headers
headers
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe QueryStringCacheKeys
queryStringCacheKeys
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Bool
queryString
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf CookiePreference
cookies

instance Data.ToXML ForwardedValues where
  toXML :: ForwardedValues -> XML
toXML ForwardedValues' {Bool
Maybe Headers
Maybe QueryStringCacheKeys
CookiePreference
cookies :: CookiePreference
queryString :: Bool
queryStringCacheKeys :: Maybe QueryStringCacheKeys
headers :: Maybe Headers
$sel:cookies:ForwardedValues' :: ForwardedValues -> CookiePreference
$sel:queryString:ForwardedValues' :: ForwardedValues -> Bool
$sel:queryStringCacheKeys:ForwardedValues' :: ForwardedValues -> Maybe QueryStringCacheKeys
$sel:headers:ForwardedValues' :: ForwardedValues -> Maybe Headers
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ Name
"Headers" forall a. ToXML a => Name -> a -> XML
Data.@= Maybe Headers
headers,
        Name
"QueryStringCacheKeys" forall a. ToXML a => Name -> a -> XML
Data.@= Maybe QueryStringCacheKeys
queryStringCacheKeys,
        Name
"QueryString" forall a. ToXML a => Name -> a -> XML
Data.@= Bool
queryString,
        Name
"Cookies" forall a. ToXML a => Name -> a -> XML
Data.@= CookiePreference
cookies
      ]