{-# 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.ViewerCertificate
-- 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.ViewerCertificate where

import Amazonka.CloudFront.Types.CertificateSource
import Amazonka.CloudFront.Types.MinimumProtocolVersion
import Amazonka.CloudFront.Types.SSLSupportMethod
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 complex type that determines the distribution\'s SSL\/TLS
-- configuration for communicating with viewers.
--
-- If the distribution doesn\'t use @Aliases@ (also known as alternate
-- domain names or CNAMEs)—that is, if the distribution uses the CloudFront
-- domain name such as @d111111abcdef8.cloudfront.net@—set
-- @CloudFrontDefaultCertificate@ to @true@ and leave all other fields
-- empty.
--
-- If the distribution uses @Aliases@ (alternate domain names or CNAMEs),
-- use the fields in this type to specify the following settings:
--
-- -   Which viewers the distribution accepts HTTPS connections from: only
--     viewers that support
--     <https://en.wikipedia.org/wiki/Server_Name_Indication server name indication (SNI)>
--     (recommended), or all viewers including those that don\'t support
--     SNI.
--
--     -   To accept HTTPS connections from only viewers that support SNI,
--         set @SSLSupportMethod@ to @sni-only@. This is recommended. Most
--         browsers and clients support SNI.
--
--     -   To accept HTTPS connections from all viewers, including those
--         that don\'t support SNI, set @SSLSupportMethod@ to @vip@. This
--         is not recommended, and results in additional monthly charges
--         from CloudFront.
--
-- -   The minimum SSL\/TLS protocol version that the distribution can use
--     to communicate with viewers. To specify a minimum version, choose a
--     value for @MinimumProtocolVersion@. For more information, see
--     <https://docs.aws.amazon.com/AmazonCloudFront/latest/DeveloperGuide/distribution-web-values-specify.html#DownloadDistValues-security-policy Security Policy>
--     in the /Amazon CloudFront Developer Guide/.
--
-- -   The location of the SSL\/TLS certificate,
--     <https://docs.aws.amazon.com/acm/latest/userguide/acm-overview.html Certificate Manager (ACM)>
--     (recommended) or
--     <https://docs.aws.amazon.com/IAM/latest/UserGuide/id_credentials_server-certs.html Identity and Access Management (IAM)>.
--     You specify the location by setting a value in one of the following
--     fields (not both):
--
--     -   @ACMCertificateArn@
--
--     -   @IAMCertificateId@
--
-- All distributions support HTTPS connections from viewers. To require
-- viewers to use HTTPS only, or to redirect them from HTTP to HTTPS, use
-- @ViewerProtocolPolicy@ in the @CacheBehavior@ or @DefaultCacheBehavior@.
-- To specify how CloudFront should use SSL\/TLS to communicate with your
-- custom origin, use @CustomOriginConfig@.
--
-- For more information, see
-- <https://docs.aws.amazon.com/AmazonCloudFront/latest/DeveloperGuide/using-https.html Using HTTPS with CloudFront>
-- and
-- <https://docs.aws.amazon.com/AmazonCloudFront/latest/DeveloperGuide/using-https-alternate-domain-names.html Using Alternate Domain Names and HTTPS>
-- in the /Amazon CloudFront Developer Guide/.
--
-- /See:/ 'newViewerCertificate' smart constructor.
data ViewerCertificate = ViewerCertificate'
  { -- | If the distribution uses @Aliases@ (alternate domain names or CNAMEs)
    -- and the SSL\/TLS certificate is stored in
    -- <https://docs.aws.amazon.com/acm/latest/userguide/acm-overview.html Certificate Manager (ACM)>,
    -- provide the Amazon Resource Name (ARN) of the ACM certificate.
    -- CloudFront only supports ACM certificates in the US East (N. Virginia)
    -- Region (@us-east-1@).
    --
    -- If you specify an ACM certificate ARN, you must also specify values for
    -- @MinimumProtocolVersion@ and @SSLSupportMethod@.
    ViewerCertificate -> Maybe Text
aCMCertificateArn :: Prelude.Maybe Prelude.Text,
    -- | This field is deprecated. Use one of the following fields instead:
    --
    -- -   @ACMCertificateArn@
    --
    -- -   @IAMCertificateId@
    --
    -- -   @CloudFrontDefaultCertificate@
    ViewerCertificate -> Maybe Text
certificate :: Prelude.Maybe Prelude.Text,
    -- | This field is deprecated. Use one of the following fields instead:
    --
    -- -   @ACMCertificateArn@
    --
    -- -   @IAMCertificateId@
    --
    -- -   @CloudFrontDefaultCertificate@
    ViewerCertificate -> Maybe CertificateSource
certificateSource :: Prelude.Maybe CertificateSource,
    -- | If the distribution uses the CloudFront domain name such as
    -- @d111111abcdef8.cloudfront.net@, set this field to @true@.
    --
    -- If the distribution uses @Aliases@ (alternate domain names or CNAMEs),
    -- set this field to @false@ and specify values for the following fields:
    --
    -- -   @ACMCertificateArn@ or @IAMCertificateId@ (specify a value for one,
    --     not both)
    --
    -- -   @MinimumProtocolVersion@
    --
    -- -   @SSLSupportMethod@
    ViewerCertificate -> Maybe Bool
cloudFrontDefaultCertificate :: Prelude.Maybe Prelude.Bool,
    -- | If the distribution uses @Aliases@ (alternate domain names or CNAMEs)
    -- and the SSL\/TLS certificate is stored in
    -- <https://docs.aws.amazon.com/IAM/latest/UserGuide/id_credentials_server-certs.html Identity and Access Management (IAM)>,
    -- provide the ID of the IAM certificate.
    --
    -- If you specify an IAM certificate ID, you must also specify values for
    -- @MinimumProtocolVersion@ and @SSLSupportMethod@.
    ViewerCertificate -> Maybe Text
iAMCertificateId :: Prelude.Maybe Prelude.Text,
    -- | If the distribution uses @Aliases@ (alternate domain names or CNAMEs),
    -- specify the security policy that you want CloudFront to use for HTTPS
    -- connections with viewers. The security policy determines two settings:
    --
    -- -   The minimum SSL\/TLS protocol that CloudFront can use to communicate
    --     with viewers.
    --
    -- -   The ciphers that CloudFront can use to encrypt the content that it
    --     returns to viewers.
    --
    -- For more information, see
    -- <https://docs.aws.amazon.com/AmazonCloudFront/latest/DeveloperGuide/distribution-web-values-specify.html#DownloadDistValues-security-policy Security Policy>
    -- and
    -- <https://docs.aws.amazon.com/AmazonCloudFront/latest/DeveloperGuide/secure-connections-supported-viewer-protocols-ciphers.html#secure-connections-supported-ciphers Supported Protocols and Ciphers Between Viewers and CloudFront>
    -- in the /Amazon CloudFront Developer Guide/.
    --
    -- On the CloudFront console, this setting is called __Security Policy__.
    --
    -- When you\'re using SNI only (you set @SSLSupportMethod@ to @sni-only@),
    -- you must specify @TLSv1@ or higher.
    --
    -- If the distribution uses the CloudFront domain name such as
    -- @d111111abcdef8.cloudfront.net@ (you set @CloudFrontDefaultCertificate@
    -- to @true@), CloudFront automatically sets the security policy to @TLSv1@
    -- regardless of the value that you set here.
    ViewerCertificate -> Maybe MinimumProtocolVersion
minimumProtocolVersion :: Prelude.Maybe MinimumProtocolVersion,
    -- | If the distribution uses @Aliases@ (alternate domain names or CNAMEs),
    -- specify which viewers the distribution accepts HTTPS connections from.
    --
    -- -   @sni-only@ – The distribution accepts HTTPS connections from only
    --     viewers that support
    --     <https://en.wikipedia.org/wiki/Server_Name_Indication server name indication (SNI)>.
    --     This is recommended. Most browsers and clients support SNI.
    --
    -- -   @vip@ – The distribution accepts HTTPS connections from all viewers
    --     including those that don\'t support SNI. This is not recommended,
    --     and results in additional monthly charges from CloudFront.
    --
    -- -   @static-ip@ - Do not specify this value unless your distribution has
    --     been enabled for this feature by the CloudFront team. If you have a
    --     use case that requires static IP addresses for a distribution,
    --     contact CloudFront through the
    --     <https://console.aws.amazon.com/support/home Amazon Web Services Support Center>.
    --
    -- If the distribution uses the CloudFront domain name such as
    -- @d111111abcdef8.cloudfront.net@, don\'t set a value for this field.
    ViewerCertificate -> Maybe SSLSupportMethod
sSLSupportMethod :: Prelude.Maybe SSLSupportMethod
  }
  deriving (ViewerCertificate -> ViewerCertificate -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ViewerCertificate -> ViewerCertificate -> Bool
$c/= :: ViewerCertificate -> ViewerCertificate -> Bool
== :: ViewerCertificate -> ViewerCertificate -> Bool
$c== :: ViewerCertificate -> ViewerCertificate -> Bool
Prelude.Eq, ReadPrec [ViewerCertificate]
ReadPrec ViewerCertificate
Int -> ReadS ViewerCertificate
ReadS [ViewerCertificate]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ViewerCertificate]
$creadListPrec :: ReadPrec [ViewerCertificate]
readPrec :: ReadPrec ViewerCertificate
$creadPrec :: ReadPrec ViewerCertificate
readList :: ReadS [ViewerCertificate]
$creadList :: ReadS [ViewerCertificate]
readsPrec :: Int -> ReadS ViewerCertificate
$creadsPrec :: Int -> ReadS ViewerCertificate
Prelude.Read, Int -> ViewerCertificate -> ShowS
[ViewerCertificate] -> ShowS
ViewerCertificate -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ViewerCertificate] -> ShowS
$cshowList :: [ViewerCertificate] -> ShowS
show :: ViewerCertificate -> String
$cshow :: ViewerCertificate -> String
showsPrec :: Int -> ViewerCertificate -> ShowS
$cshowsPrec :: Int -> ViewerCertificate -> ShowS
Prelude.Show, forall x. Rep ViewerCertificate x -> ViewerCertificate
forall x. ViewerCertificate -> Rep ViewerCertificate x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ViewerCertificate x -> ViewerCertificate
$cfrom :: forall x. ViewerCertificate -> Rep ViewerCertificate x
Prelude.Generic)

-- |
-- Create a value of 'ViewerCertificate' 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:
--
-- 'aCMCertificateArn', 'viewerCertificate_aCMCertificateArn' - If the distribution uses @Aliases@ (alternate domain names or CNAMEs)
-- and the SSL\/TLS certificate is stored in
-- <https://docs.aws.amazon.com/acm/latest/userguide/acm-overview.html Certificate Manager (ACM)>,
-- provide the Amazon Resource Name (ARN) of the ACM certificate.
-- CloudFront only supports ACM certificates in the US East (N. Virginia)
-- Region (@us-east-1@).
--
-- If you specify an ACM certificate ARN, you must also specify values for
-- @MinimumProtocolVersion@ and @SSLSupportMethod@.
--
-- 'certificate', 'viewerCertificate_certificate' - This field is deprecated. Use one of the following fields instead:
--
-- -   @ACMCertificateArn@
--
-- -   @IAMCertificateId@
--
-- -   @CloudFrontDefaultCertificate@
--
-- 'certificateSource', 'viewerCertificate_certificateSource' - This field is deprecated. Use one of the following fields instead:
--
-- -   @ACMCertificateArn@
--
-- -   @IAMCertificateId@
--
-- -   @CloudFrontDefaultCertificate@
--
-- 'cloudFrontDefaultCertificate', 'viewerCertificate_cloudFrontDefaultCertificate' - If the distribution uses the CloudFront domain name such as
-- @d111111abcdef8.cloudfront.net@, set this field to @true@.
--
-- If the distribution uses @Aliases@ (alternate domain names or CNAMEs),
-- set this field to @false@ and specify values for the following fields:
--
-- -   @ACMCertificateArn@ or @IAMCertificateId@ (specify a value for one,
--     not both)
--
-- -   @MinimumProtocolVersion@
--
-- -   @SSLSupportMethod@
--
-- 'iAMCertificateId', 'viewerCertificate_iAMCertificateId' - If the distribution uses @Aliases@ (alternate domain names or CNAMEs)
-- and the SSL\/TLS certificate is stored in
-- <https://docs.aws.amazon.com/IAM/latest/UserGuide/id_credentials_server-certs.html Identity and Access Management (IAM)>,
-- provide the ID of the IAM certificate.
--
-- If you specify an IAM certificate ID, you must also specify values for
-- @MinimumProtocolVersion@ and @SSLSupportMethod@.
--
-- 'minimumProtocolVersion', 'viewerCertificate_minimumProtocolVersion' - If the distribution uses @Aliases@ (alternate domain names or CNAMEs),
-- specify the security policy that you want CloudFront to use for HTTPS
-- connections with viewers. The security policy determines two settings:
--
-- -   The minimum SSL\/TLS protocol that CloudFront can use to communicate
--     with viewers.
--
-- -   The ciphers that CloudFront can use to encrypt the content that it
--     returns to viewers.
--
-- For more information, see
-- <https://docs.aws.amazon.com/AmazonCloudFront/latest/DeveloperGuide/distribution-web-values-specify.html#DownloadDistValues-security-policy Security Policy>
-- and
-- <https://docs.aws.amazon.com/AmazonCloudFront/latest/DeveloperGuide/secure-connections-supported-viewer-protocols-ciphers.html#secure-connections-supported-ciphers Supported Protocols and Ciphers Between Viewers and CloudFront>
-- in the /Amazon CloudFront Developer Guide/.
--
-- On the CloudFront console, this setting is called __Security Policy__.
--
-- When you\'re using SNI only (you set @SSLSupportMethod@ to @sni-only@),
-- you must specify @TLSv1@ or higher.
--
-- If the distribution uses the CloudFront domain name such as
-- @d111111abcdef8.cloudfront.net@ (you set @CloudFrontDefaultCertificate@
-- to @true@), CloudFront automatically sets the security policy to @TLSv1@
-- regardless of the value that you set here.
--
-- 'sSLSupportMethod', 'viewerCertificate_sSLSupportMethod' - If the distribution uses @Aliases@ (alternate domain names or CNAMEs),
-- specify which viewers the distribution accepts HTTPS connections from.
--
-- -   @sni-only@ – The distribution accepts HTTPS connections from only
--     viewers that support
--     <https://en.wikipedia.org/wiki/Server_Name_Indication server name indication (SNI)>.
--     This is recommended. Most browsers and clients support SNI.
--
-- -   @vip@ – The distribution accepts HTTPS connections from all viewers
--     including those that don\'t support SNI. This is not recommended,
--     and results in additional monthly charges from CloudFront.
--
-- -   @static-ip@ - Do not specify this value unless your distribution has
--     been enabled for this feature by the CloudFront team. If you have a
--     use case that requires static IP addresses for a distribution,
--     contact CloudFront through the
--     <https://console.aws.amazon.com/support/home Amazon Web Services Support Center>.
--
-- If the distribution uses the CloudFront domain name such as
-- @d111111abcdef8.cloudfront.net@, don\'t set a value for this field.
newViewerCertificate ::
  ViewerCertificate
newViewerCertificate :: ViewerCertificate
newViewerCertificate =
  ViewerCertificate'
    { $sel:aCMCertificateArn:ViewerCertificate' :: Maybe Text
aCMCertificateArn =
        forall a. Maybe a
Prelude.Nothing,
      $sel:certificate:ViewerCertificate' :: Maybe Text
certificate = forall a. Maybe a
Prelude.Nothing,
      $sel:certificateSource:ViewerCertificate' :: Maybe CertificateSource
certificateSource = forall a. Maybe a
Prelude.Nothing,
      $sel:cloudFrontDefaultCertificate:ViewerCertificate' :: Maybe Bool
cloudFrontDefaultCertificate = forall a. Maybe a
Prelude.Nothing,
      $sel:iAMCertificateId:ViewerCertificate' :: Maybe Text
iAMCertificateId = forall a. Maybe a
Prelude.Nothing,
      $sel:minimumProtocolVersion:ViewerCertificate' :: Maybe MinimumProtocolVersion
minimumProtocolVersion = forall a. Maybe a
Prelude.Nothing,
      $sel:sSLSupportMethod:ViewerCertificate' :: Maybe SSLSupportMethod
sSLSupportMethod = forall a. Maybe a
Prelude.Nothing
    }

-- | If the distribution uses @Aliases@ (alternate domain names or CNAMEs)
-- and the SSL\/TLS certificate is stored in
-- <https://docs.aws.amazon.com/acm/latest/userguide/acm-overview.html Certificate Manager (ACM)>,
-- provide the Amazon Resource Name (ARN) of the ACM certificate.
-- CloudFront only supports ACM certificates in the US East (N. Virginia)
-- Region (@us-east-1@).
--
-- If you specify an ACM certificate ARN, you must also specify values for
-- @MinimumProtocolVersion@ and @SSLSupportMethod@.
viewerCertificate_aCMCertificateArn :: Lens.Lens' ViewerCertificate (Prelude.Maybe Prelude.Text)
viewerCertificate_aCMCertificateArn :: Lens' ViewerCertificate (Maybe Text)
viewerCertificate_aCMCertificateArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ViewerCertificate' {Maybe Text
aCMCertificateArn :: Maybe Text
$sel:aCMCertificateArn:ViewerCertificate' :: ViewerCertificate -> Maybe Text
aCMCertificateArn} -> Maybe Text
aCMCertificateArn) (\s :: ViewerCertificate
s@ViewerCertificate' {} Maybe Text
a -> ViewerCertificate
s {$sel:aCMCertificateArn:ViewerCertificate' :: Maybe Text
aCMCertificateArn = Maybe Text
a} :: ViewerCertificate)

-- | This field is deprecated. Use one of the following fields instead:
--
-- -   @ACMCertificateArn@
--
-- -   @IAMCertificateId@
--
-- -   @CloudFrontDefaultCertificate@
viewerCertificate_certificate :: Lens.Lens' ViewerCertificate (Prelude.Maybe Prelude.Text)
viewerCertificate_certificate :: Lens' ViewerCertificate (Maybe Text)
viewerCertificate_certificate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ViewerCertificate' {Maybe Text
certificate :: Maybe Text
$sel:certificate:ViewerCertificate' :: ViewerCertificate -> Maybe Text
certificate} -> Maybe Text
certificate) (\s :: ViewerCertificate
s@ViewerCertificate' {} Maybe Text
a -> ViewerCertificate
s {$sel:certificate:ViewerCertificate' :: Maybe Text
certificate = Maybe Text
a} :: ViewerCertificate)

-- | This field is deprecated. Use one of the following fields instead:
--
-- -   @ACMCertificateArn@
--
-- -   @IAMCertificateId@
--
-- -   @CloudFrontDefaultCertificate@
viewerCertificate_certificateSource :: Lens.Lens' ViewerCertificate (Prelude.Maybe CertificateSource)
viewerCertificate_certificateSource :: Lens' ViewerCertificate (Maybe CertificateSource)
viewerCertificate_certificateSource = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ViewerCertificate' {Maybe CertificateSource
certificateSource :: Maybe CertificateSource
$sel:certificateSource:ViewerCertificate' :: ViewerCertificate -> Maybe CertificateSource
certificateSource} -> Maybe CertificateSource
certificateSource) (\s :: ViewerCertificate
s@ViewerCertificate' {} Maybe CertificateSource
a -> ViewerCertificate
s {$sel:certificateSource:ViewerCertificate' :: Maybe CertificateSource
certificateSource = Maybe CertificateSource
a} :: ViewerCertificate)

-- | If the distribution uses the CloudFront domain name such as
-- @d111111abcdef8.cloudfront.net@, set this field to @true@.
--
-- If the distribution uses @Aliases@ (alternate domain names or CNAMEs),
-- set this field to @false@ and specify values for the following fields:
--
-- -   @ACMCertificateArn@ or @IAMCertificateId@ (specify a value for one,
--     not both)
--
-- -   @MinimumProtocolVersion@
--
-- -   @SSLSupportMethod@
viewerCertificate_cloudFrontDefaultCertificate :: Lens.Lens' ViewerCertificate (Prelude.Maybe Prelude.Bool)
viewerCertificate_cloudFrontDefaultCertificate :: Lens' ViewerCertificate (Maybe Bool)
viewerCertificate_cloudFrontDefaultCertificate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ViewerCertificate' {Maybe Bool
cloudFrontDefaultCertificate :: Maybe Bool
$sel:cloudFrontDefaultCertificate:ViewerCertificate' :: ViewerCertificate -> Maybe Bool
cloudFrontDefaultCertificate} -> Maybe Bool
cloudFrontDefaultCertificate) (\s :: ViewerCertificate
s@ViewerCertificate' {} Maybe Bool
a -> ViewerCertificate
s {$sel:cloudFrontDefaultCertificate:ViewerCertificate' :: Maybe Bool
cloudFrontDefaultCertificate = Maybe Bool
a} :: ViewerCertificate)

-- | If the distribution uses @Aliases@ (alternate domain names or CNAMEs)
-- and the SSL\/TLS certificate is stored in
-- <https://docs.aws.amazon.com/IAM/latest/UserGuide/id_credentials_server-certs.html Identity and Access Management (IAM)>,
-- provide the ID of the IAM certificate.
--
-- If you specify an IAM certificate ID, you must also specify values for
-- @MinimumProtocolVersion@ and @SSLSupportMethod@.
viewerCertificate_iAMCertificateId :: Lens.Lens' ViewerCertificate (Prelude.Maybe Prelude.Text)
viewerCertificate_iAMCertificateId :: Lens' ViewerCertificate (Maybe Text)
viewerCertificate_iAMCertificateId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ViewerCertificate' {Maybe Text
iAMCertificateId :: Maybe Text
$sel:iAMCertificateId:ViewerCertificate' :: ViewerCertificate -> Maybe Text
iAMCertificateId} -> Maybe Text
iAMCertificateId) (\s :: ViewerCertificate
s@ViewerCertificate' {} Maybe Text
a -> ViewerCertificate
s {$sel:iAMCertificateId:ViewerCertificate' :: Maybe Text
iAMCertificateId = Maybe Text
a} :: ViewerCertificate)

-- | If the distribution uses @Aliases@ (alternate domain names or CNAMEs),
-- specify the security policy that you want CloudFront to use for HTTPS
-- connections with viewers. The security policy determines two settings:
--
-- -   The minimum SSL\/TLS protocol that CloudFront can use to communicate
--     with viewers.
--
-- -   The ciphers that CloudFront can use to encrypt the content that it
--     returns to viewers.
--
-- For more information, see
-- <https://docs.aws.amazon.com/AmazonCloudFront/latest/DeveloperGuide/distribution-web-values-specify.html#DownloadDistValues-security-policy Security Policy>
-- and
-- <https://docs.aws.amazon.com/AmazonCloudFront/latest/DeveloperGuide/secure-connections-supported-viewer-protocols-ciphers.html#secure-connections-supported-ciphers Supported Protocols and Ciphers Between Viewers and CloudFront>
-- in the /Amazon CloudFront Developer Guide/.
--
-- On the CloudFront console, this setting is called __Security Policy__.
--
-- When you\'re using SNI only (you set @SSLSupportMethod@ to @sni-only@),
-- you must specify @TLSv1@ or higher.
--
-- If the distribution uses the CloudFront domain name such as
-- @d111111abcdef8.cloudfront.net@ (you set @CloudFrontDefaultCertificate@
-- to @true@), CloudFront automatically sets the security policy to @TLSv1@
-- regardless of the value that you set here.
viewerCertificate_minimumProtocolVersion :: Lens.Lens' ViewerCertificate (Prelude.Maybe MinimumProtocolVersion)
viewerCertificate_minimumProtocolVersion :: Lens' ViewerCertificate (Maybe MinimumProtocolVersion)
viewerCertificate_minimumProtocolVersion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ViewerCertificate' {Maybe MinimumProtocolVersion
minimumProtocolVersion :: Maybe MinimumProtocolVersion
$sel:minimumProtocolVersion:ViewerCertificate' :: ViewerCertificate -> Maybe MinimumProtocolVersion
minimumProtocolVersion} -> Maybe MinimumProtocolVersion
minimumProtocolVersion) (\s :: ViewerCertificate
s@ViewerCertificate' {} Maybe MinimumProtocolVersion
a -> ViewerCertificate
s {$sel:minimumProtocolVersion:ViewerCertificate' :: Maybe MinimumProtocolVersion
minimumProtocolVersion = Maybe MinimumProtocolVersion
a} :: ViewerCertificate)

-- | If the distribution uses @Aliases@ (alternate domain names or CNAMEs),
-- specify which viewers the distribution accepts HTTPS connections from.
--
-- -   @sni-only@ – The distribution accepts HTTPS connections from only
--     viewers that support
--     <https://en.wikipedia.org/wiki/Server_Name_Indication server name indication (SNI)>.
--     This is recommended. Most browsers and clients support SNI.
--
-- -   @vip@ – The distribution accepts HTTPS connections from all viewers
--     including those that don\'t support SNI. This is not recommended,
--     and results in additional monthly charges from CloudFront.
--
-- -   @static-ip@ - Do not specify this value unless your distribution has
--     been enabled for this feature by the CloudFront team. If you have a
--     use case that requires static IP addresses for a distribution,
--     contact CloudFront through the
--     <https://console.aws.amazon.com/support/home Amazon Web Services Support Center>.
--
-- If the distribution uses the CloudFront domain name such as
-- @d111111abcdef8.cloudfront.net@, don\'t set a value for this field.
viewerCertificate_sSLSupportMethod :: Lens.Lens' ViewerCertificate (Prelude.Maybe SSLSupportMethod)
viewerCertificate_sSLSupportMethod :: Lens' ViewerCertificate (Maybe SSLSupportMethod)
viewerCertificate_sSLSupportMethod = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ViewerCertificate' {Maybe SSLSupportMethod
sSLSupportMethod :: Maybe SSLSupportMethod
$sel:sSLSupportMethod:ViewerCertificate' :: ViewerCertificate -> Maybe SSLSupportMethod
sSLSupportMethod} -> Maybe SSLSupportMethod
sSLSupportMethod) (\s :: ViewerCertificate
s@ViewerCertificate' {} Maybe SSLSupportMethod
a -> ViewerCertificate
s {$sel:sSLSupportMethod:ViewerCertificate' :: Maybe SSLSupportMethod
sSLSupportMethod = Maybe SSLSupportMethod
a} :: ViewerCertificate)

instance Data.FromXML ViewerCertificate where
  parseXML :: [Node] -> Either String ViewerCertificate
parseXML [Node]
x =
    Maybe Text
-> Maybe Text
-> Maybe CertificateSource
-> Maybe Bool
-> Maybe Text
-> Maybe MinimumProtocolVersion
-> Maybe SSLSupportMethod
-> ViewerCertificate
ViewerCertificate'
      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
"ACMCertificateArn")
      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
"Certificate")
      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
"CertificateSource")
      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
"CloudFrontDefaultCertificate")
      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
"IAMCertificateId")
      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
"MinimumProtocolVersion")
      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
"SSLSupportMethod")

instance Prelude.Hashable ViewerCertificate where
  hashWithSalt :: Int -> ViewerCertificate -> Int
hashWithSalt Int
_salt ViewerCertificate' {Maybe Bool
Maybe Text
Maybe CertificateSource
Maybe MinimumProtocolVersion
Maybe SSLSupportMethod
sSLSupportMethod :: Maybe SSLSupportMethod
minimumProtocolVersion :: Maybe MinimumProtocolVersion
iAMCertificateId :: Maybe Text
cloudFrontDefaultCertificate :: Maybe Bool
certificateSource :: Maybe CertificateSource
certificate :: Maybe Text
aCMCertificateArn :: Maybe Text
$sel:sSLSupportMethod:ViewerCertificate' :: ViewerCertificate -> Maybe SSLSupportMethod
$sel:minimumProtocolVersion:ViewerCertificate' :: ViewerCertificate -> Maybe MinimumProtocolVersion
$sel:iAMCertificateId:ViewerCertificate' :: ViewerCertificate -> Maybe Text
$sel:cloudFrontDefaultCertificate:ViewerCertificate' :: ViewerCertificate -> Maybe Bool
$sel:certificateSource:ViewerCertificate' :: ViewerCertificate -> Maybe CertificateSource
$sel:certificate:ViewerCertificate' :: ViewerCertificate -> Maybe Text
$sel:aCMCertificateArn:ViewerCertificate' :: ViewerCertificate -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
aCMCertificateArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
certificate
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe CertificateSource
certificateSource
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
cloudFrontDefaultCertificate
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
iAMCertificateId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe MinimumProtocolVersion
minimumProtocolVersion
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe SSLSupportMethod
sSLSupportMethod

instance Prelude.NFData ViewerCertificate where
  rnf :: ViewerCertificate -> ()
rnf ViewerCertificate' {Maybe Bool
Maybe Text
Maybe CertificateSource
Maybe MinimumProtocolVersion
Maybe SSLSupportMethod
sSLSupportMethod :: Maybe SSLSupportMethod
minimumProtocolVersion :: Maybe MinimumProtocolVersion
iAMCertificateId :: Maybe Text
cloudFrontDefaultCertificate :: Maybe Bool
certificateSource :: Maybe CertificateSource
certificate :: Maybe Text
aCMCertificateArn :: Maybe Text
$sel:sSLSupportMethod:ViewerCertificate' :: ViewerCertificate -> Maybe SSLSupportMethod
$sel:minimumProtocolVersion:ViewerCertificate' :: ViewerCertificate -> Maybe MinimumProtocolVersion
$sel:iAMCertificateId:ViewerCertificate' :: ViewerCertificate -> Maybe Text
$sel:cloudFrontDefaultCertificate:ViewerCertificate' :: ViewerCertificate -> Maybe Bool
$sel:certificateSource:ViewerCertificate' :: ViewerCertificate -> Maybe CertificateSource
$sel:certificate:ViewerCertificate' :: ViewerCertificate -> Maybe Text
$sel:aCMCertificateArn:ViewerCertificate' :: ViewerCertificate -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
aCMCertificateArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
certificate
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe CertificateSource
certificateSource
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
cloudFrontDefaultCertificate
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
iAMCertificateId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe MinimumProtocolVersion
minimumProtocolVersion
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe SSLSupportMethod
sSLSupportMethod

instance Data.ToXML ViewerCertificate where
  toXML :: ViewerCertificate -> XML
toXML ViewerCertificate' {Maybe Bool
Maybe Text
Maybe CertificateSource
Maybe MinimumProtocolVersion
Maybe SSLSupportMethod
sSLSupportMethod :: Maybe SSLSupportMethod
minimumProtocolVersion :: Maybe MinimumProtocolVersion
iAMCertificateId :: Maybe Text
cloudFrontDefaultCertificate :: Maybe Bool
certificateSource :: Maybe CertificateSource
certificate :: Maybe Text
aCMCertificateArn :: Maybe Text
$sel:sSLSupportMethod:ViewerCertificate' :: ViewerCertificate -> Maybe SSLSupportMethod
$sel:minimumProtocolVersion:ViewerCertificate' :: ViewerCertificate -> Maybe MinimumProtocolVersion
$sel:iAMCertificateId:ViewerCertificate' :: ViewerCertificate -> Maybe Text
$sel:cloudFrontDefaultCertificate:ViewerCertificate' :: ViewerCertificate -> Maybe Bool
$sel:certificateSource:ViewerCertificate' :: ViewerCertificate -> Maybe CertificateSource
$sel:certificate:ViewerCertificate' :: ViewerCertificate -> Maybe Text
$sel:aCMCertificateArn:ViewerCertificate' :: ViewerCertificate -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ Name
"ACMCertificateArn" forall a. ToXML a => Name -> a -> XML
Data.@= Maybe Text
aCMCertificateArn,
        Name
"Certificate" forall a. ToXML a => Name -> a -> XML
Data.@= Maybe Text
certificate,
        Name
"CertificateSource" forall a. ToXML a => Name -> a -> XML
Data.@= Maybe CertificateSource
certificateSource,
        Name
"CloudFrontDefaultCertificate"
          forall a. ToXML a => Name -> a -> XML
Data.@= Maybe Bool
cloudFrontDefaultCertificate,
        Name
"IAMCertificateId" forall a. ToXML a => Name -> a -> XML
Data.@= Maybe Text
iAMCertificateId,
        Name
"MinimumProtocolVersion"
          forall a. ToXML a => Name -> a -> XML
Data.@= Maybe MinimumProtocolVersion
minimumProtocolVersion,
        Name
"SSLSupportMethod" forall a. ToXML a => Name -> a -> XML
Data.@= Maybe SSLSupportMethod
sSLSupportMethod
      ]