{-# 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.ResponseHeadersPolicyServerTimingHeadersConfig
-- 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.ResponseHeadersPolicyServerTimingHeadersConfig 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

-- | A configuration for enabling the @Server-Timing@ header in HTTP
-- responses sent from CloudFront. CloudFront adds this header to HTTP
-- responses that it sends in response to requests that match a cache
-- behavior that\'s associated with this response headers policy.
--
-- You can use the @Server-Timing@ header to view metrics that can help you
-- gain insights about the behavior and performance of CloudFront. For
-- example, you can see which cache layer served a cache hit, or the first
-- byte latency from the origin when there was a cache miss. You can use
-- the metrics in the @Server-Timing@ header to troubleshoot issues or test
-- the efficiency of your CloudFront configuration. For more information,
-- see
-- <https://docs.aws.amazon.com/AmazonCloudFront/latest/DeveloperGuide/understanding-response-headers-policies.html#server-timing-header Server-Timing header>
-- in the /Amazon CloudFront Developer Guide/.
--
-- /See:/ 'newResponseHeadersPolicyServerTimingHeadersConfig' smart constructor.
data ResponseHeadersPolicyServerTimingHeadersConfig = ResponseHeadersPolicyServerTimingHeadersConfig'
  { -- | A number 0–100 (inclusive) that specifies the percentage of responses
    -- that you want CloudFront to add the @Server-Timing@ header to. When you
    -- set the sampling rate to 100, CloudFront adds the @Server-Timing@ header
    -- to the HTTP response for every request that matches the cache behavior
    -- that this response headers policy is attached to. When you set it to 50,
    -- CloudFront adds the header to 50% of the responses for requests that
    -- match the cache behavior. You can set the sampling rate to any number
    -- 0–100 with up to four decimal places.
    ResponseHeadersPolicyServerTimingHeadersConfig -> Maybe Double
samplingRate :: Prelude.Maybe Prelude.Double,
    -- | A Boolean that determines whether CloudFront adds the @Server-Timing@
    -- header to HTTP responses that it sends in response to requests that
    -- match a cache behavior that\'s associated with this response headers
    -- policy.
    ResponseHeadersPolicyServerTimingHeadersConfig -> Bool
enabled :: Prelude.Bool
  }
  deriving (ResponseHeadersPolicyServerTimingHeadersConfig
-> ResponseHeadersPolicyServerTimingHeadersConfig -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ResponseHeadersPolicyServerTimingHeadersConfig
-> ResponseHeadersPolicyServerTimingHeadersConfig -> Bool
$c/= :: ResponseHeadersPolicyServerTimingHeadersConfig
-> ResponseHeadersPolicyServerTimingHeadersConfig -> Bool
== :: ResponseHeadersPolicyServerTimingHeadersConfig
-> ResponseHeadersPolicyServerTimingHeadersConfig -> Bool
$c== :: ResponseHeadersPolicyServerTimingHeadersConfig
-> ResponseHeadersPolicyServerTimingHeadersConfig -> Bool
Prelude.Eq, ReadPrec [ResponseHeadersPolicyServerTimingHeadersConfig]
ReadPrec ResponseHeadersPolicyServerTimingHeadersConfig
Int -> ReadS ResponseHeadersPolicyServerTimingHeadersConfig
ReadS [ResponseHeadersPolicyServerTimingHeadersConfig]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ResponseHeadersPolicyServerTimingHeadersConfig]
$creadListPrec :: ReadPrec [ResponseHeadersPolicyServerTimingHeadersConfig]
readPrec :: ReadPrec ResponseHeadersPolicyServerTimingHeadersConfig
$creadPrec :: ReadPrec ResponseHeadersPolicyServerTimingHeadersConfig
readList :: ReadS [ResponseHeadersPolicyServerTimingHeadersConfig]
$creadList :: ReadS [ResponseHeadersPolicyServerTimingHeadersConfig]
readsPrec :: Int -> ReadS ResponseHeadersPolicyServerTimingHeadersConfig
$creadsPrec :: Int -> ReadS ResponseHeadersPolicyServerTimingHeadersConfig
Prelude.Read, Int -> ResponseHeadersPolicyServerTimingHeadersConfig -> ShowS
[ResponseHeadersPolicyServerTimingHeadersConfig] -> ShowS
ResponseHeadersPolicyServerTimingHeadersConfig -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ResponseHeadersPolicyServerTimingHeadersConfig] -> ShowS
$cshowList :: [ResponseHeadersPolicyServerTimingHeadersConfig] -> ShowS
show :: ResponseHeadersPolicyServerTimingHeadersConfig -> String
$cshow :: ResponseHeadersPolicyServerTimingHeadersConfig -> String
showsPrec :: Int -> ResponseHeadersPolicyServerTimingHeadersConfig -> ShowS
$cshowsPrec :: Int -> ResponseHeadersPolicyServerTimingHeadersConfig -> ShowS
Prelude.Show, forall x.
Rep ResponseHeadersPolicyServerTimingHeadersConfig x
-> ResponseHeadersPolicyServerTimingHeadersConfig
forall x.
ResponseHeadersPolicyServerTimingHeadersConfig
-> Rep ResponseHeadersPolicyServerTimingHeadersConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ResponseHeadersPolicyServerTimingHeadersConfig x
-> ResponseHeadersPolicyServerTimingHeadersConfig
$cfrom :: forall x.
ResponseHeadersPolicyServerTimingHeadersConfig
-> Rep ResponseHeadersPolicyServerTimingHeadersConfig x
Prelude.Generic)

-- |
-- Create a value of 'ResponseHeadersPolicyServerTimingHeadersConfig' 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:
--
-- 'samplingRate', 'responseHeadersPolicyServerTimingHeadersConfig_samplingRate' - A number 0–100 (inclusive) that specifies the percentage of responses
-- that you want CloudFront to add the @Server-Timing@ header to. When you
-- set the sampling rate to 100, CloudFront adds the @Server-Timing@ header
-- to the HTTP response for every request that matches the cache behavior
-- that this response headers policy is attached to. When you set it to 50,
-- CloudFront adds the header to 50% of the responses for requests that
-- match the cache behavior. You can set the sampling rate to any number
-- 0–100 with up to four decimal places.
--
-- 'enabled', 'responseHeadersPolicyServerTimingHeadersConfig_enabled' - A Boolean that determines whether CloudFront adds the @Server-Timing@
-- header to HTTP responses that it sends in response to requests that
-- match a cache behavior that\'s associated with this response headers
-- policy.
newResponseHeadersPolicyServerTimingHeadersConfig ::
  -- | 'enabled'
  Prelude.Bool ->
  ResponseHeadersPolicyServerTimingHeadersConfig
newResponseHeadersPolicyServerTimingHeadersConfig :: Bool -> ResponseHeadersPolicyServerTimingHeadersConfig
newResponseHeadersPolicyServerTimingHeadersConfig
  Bool
pEnabled_ =
    ResponseHeadersPolicyServerTimingHeadersConfig'
      { $sel:samplingRate:ResponseHeadersPolicyServerTimingHeadersConfig' :: Maybe Double
samplingRate =
          forall a. Maybe a
Prelude.Nothing,
        $sel:enabled:ResponseHeadersPolicyServerTimingHeadersConfig' :: Bool
enabled = Bool
pEnabled_
      }

-- | A number 0–100 (inclusive) that specifies the percentage of responses
-- that you want CloudFront to add the @Server-Timing@ header to. When you
-- set the sampling rate to 100, CloudFront adds the @Server-Timing@ header
-- to the HTTP response for every request that matches the cache behavior
-- that this response headers policy is attached to. When you set it to 50,
-- CloudFront adds the header to 50% of the responses for requests that
-- match the cache behavior. You can set the sampling rate to any number
-- 0–100 with up to four decimal places.
responseHeadersPolicyServerTimingHeadersConfig_samplingRate :: Lens.Lens' ResponseHeadersPolicyServerTimingHeadersConfig (Prelude.Maybe Prelude.Double)
responseHeadersPolicyServerTimingHeadersConfig_samplingRate :: Lens' ResponseHeadersPolicyServerTimingHeadersConfig (Maybe Double)
responseHeadersPolicyServerTimingHeadersConfig_samplingRate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ResponseHeadersPolicyServerTimingHeadersConfig' {Maybe Double
samplingRate :: Maybe Double
$sel:samplingRate:ResponseHeadersPolicyServerTimingHeadersConfig' :: ResponseHeadersPolicyServerTimingHeadersConfig -> Maybe Double
samplingRate} -> Maybe Double
samplingRate) (\s :: ResponseHeadersPolicyServerTimingHeadersConfig
s@ResponseHeadersPolicyServerTimingHeadersConfig' {} Maybe Double
a -> ResponseHeadersPolicyServerTimingHeadersConfig
s {$sel:samplingRate:ResponseHeadersPolicyServerTimingHeadersConfig' :: Maybe Double
samplingRate = Maybe Double
a} :: ResponseHeadersPolicyServerTimingHeadersConfig)

-- | A Boolean that determines whether CloudFront adds the @Server-Timing@
-- header to HTTP responses that it sends in response to requests that
-- match a cache behavior that\'s associated with this response headers
-- policy.
responseHeadersPolicyServerTimingHeadersConfig_enabled :: Lens.Lens' ResponseHeadersPolicyServerTimingHeadersConfig Prelude.Bool
responseHeadersPolicyServerTimingHeadersConfig_enabled :: Lens' ResponseHeadersPolicyServerTimingHeadersConfig Bool
responseHeadersPolicyServerTimingHeadersConfig_enabled = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ResponseHeadersPolicyServerTimingHeadersConfig' {Bool
enabled :: Bool
$sel:enabled:ResponseHeadersPolicyServerTimingHeadersConfig' :: ResponseHeadersPolicyServerTimingHeadersConfig -> Bool
enabled} -> Bool
enabled) (\s :: ResponseHeadersPolicyServerTimingHeadersConfig
s@ResponseHeadersPolicyServerTimingHeadersConfig' {} Bool
a -> ResponseHeadersPolicyServerTimingHeadersConfig
s {$sel:enabled:ResponseHeadersPolicyServerTimingHeadersConfig' :: Bool
enabled = Bool
a} :: ResponseHeadersPolicyServerTimingHeadersConfig)

instance
  Data.FromXML
    ResponseHeadersPolicyServerTimingHeadersConfig
  where
  parseXML :: [Node]
-> Either String ResponseHeadersPolicyServerTimingHeadersConfig
parseXML [Node]
x =
    Maybe Double
-> Bool -> ResponseHeadersPolicyServerTimingHeadersConfig
ResponseHeadersPolicyServerTimingHeadersConfig'
      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
"SamplingRate")
      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
"Enabled")

instance
  Prelude.Hashable
    ResponseHeadersPolicyServerTimingHeadersConfig
  where
  hashWithSalt :: Int -> ResponseHeadersPolicyServerTimingHeadersConfig -> Int
hashWithSalt
    Int
_salt
    ResponseHeadersPolicyServerTimingHeadersConfig' {Bool
Maybe Double
enabled :: Bool
samplingRate :: Maybe Double
$sel:enabled:ResponseHeadersPolicyServerTimingHeadersConfig' :: ResponseHeadersPolicyServerTimingHeadersConfig -> Bool
$sel:samplingRate:ResponseHeadersPolicyServerTimingHeadersConfig' :: ResponseHeadersPolicyServerTimingHeadersConfig -> Maybe Double
..} =
      Int
_salt
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Double
samplingRate
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Bool
enabled

instance
  Prelude.NFData
    ResponseHeadersPolicyServerTimingHeadersConfig
  where
  rnf :: ResponseHeadersPolicyServerTimingHeadersConfig -> ()
rnf
    ResponseHeadersPolicyServerTimingHeadersConfig' {Bool
Maybe Double
enabled :: Bool
samplingRate :: Maybe Double
$sel:enabled:ResponseHeadersPolicyServerTimingHeadersConfig' :: ResponseHeadersPolicyServerTimingHeadersConfig -> Bool
$sel:samplingRate:ResponseHeadersPolicyServerTimingHeadersConfig' :: ResponseHeadersPolicyServerTimingHeadersConfig -> Maybe Double
..} =
      forall a. NFData a => a -> ()
Prelude.rnf Maybe Double
samplingRate
        seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Bool
enabled

instance
  Data.ToXML
    ResponseHeadersPolicyServerTimingHeadersConfig
  where
  toXML :: ResponseHeadersPolicyServerTimingHeadersConfig -> XML
toXML
    ResponseHeadersPolicyServerTimingHeadersConfig' {Bool
Maybe Double
enabled :: Bool
samplingRate :: Maybe Double
$sel:enabled:ResponseHeadersPolicyServerTimingHeadersConfig' :: ResponseHeadersPolicyServerTimingHeadersConfig -> Bool
$sel:samplingRate:ResponseHeadersPolicyServerTimingHeadersConfig' :: ResponseHeadersPolicyServerTimingHeadersConfig -> Maybe Double
..} =
      forall a. Monoid a => [a] -> a
Prelude.mconcat
        [ Name
"SamplingRate" forall a. ToXML a => Name -> a -> XML
Data.@= Maybe Double
samplingRate,
          Name
"Enabled" forall a. ToXML a => Name -> a -> XML
Data.@= Bool
enabled
        ]