{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -fno-warn-unused-binds #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
{-# OPTIONS_GHC -fno-warn-unused-matches #-}

-- Derived from AWS service descriptions, licensed under Apache 2.0.

-- |
-- Module      : Amazonka.MediaTailor.GetPlaybackConfiguration
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Retrieves a playback configuration. For information about MediaTailor
-- configurations, see
-- <https://docs.aws.amazon.com/mediatailor/latest/ug/configurations.html Working with configurations in AWS Elemental MediaTailor>.
module Amazonka.MediaTailor.GetPlaybackConfiguration
  ( -- * Creating a Request
    GetPlaybackConfiguration (..),
    newGetPlaybackConfiguration,

    -- * Request Lenses
    getPlaybackConfiguration_name,

    -- * Destructuring the Response
    GetPlaybackConfigurationResponse (..),
    newGetPlaybackConfigurationResponse,

    -- * Response Lenses
    getPlaybackConfigurationResponse_adDecisionServerUrl,
    getPlaybackConfigurationResponse_availSuppression,
    getPlaybackConfigurationResponse_bumper,
    getPlaybackConfigurationResponse_cdnConfiguration,
    getPlaybackConfigurationResponse_configurationAliases,
    getPlaybackConfigurationResponse_dashConfiguration,
    getPlaybackConfigurationResponse_hlsConfiguration,
    getPlaybackConfigurationResponse_livePreRollConfiguration,
    getPlaybackConfigurationResponse_logConfiguration,
    getPlaybackConfigurationResponse_manifestProcessingRules,
    getPlaybackConfigurationResponse_name,
    getPlaybackConfigurationResponse_personalizationThresholdSeconds,
    getPlaybackConfigurationResponse_playbackConfigurationArn,
    getPlaybackConfigurationResponse_playbackEndpointPrefix,
    getPlaybackConfigurationResponse_sessionInitializationEndpointPrefix,
    getPlaybackConfigurationResponse_slateAdUrl,
    getPlaybackConfigurationResponse_tags,
    getPlaybackConfigurationResponse_transcodeProfileName,
    getPlaybackConfigurationResponse_videoContentSourceUrl,
    getPlaybackConfigurationResponse_httpStatus,
  )
where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.MediaTailor.Types
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newGetPlaybackConfiguration' smart constructor.
data GetPlaybackConfiguration = GetPlaybackConfiguration'
  { -- | The identifier for the playback configuration.
    GetPlaybackConfiguration -> Text
name :: Prelude.Text
  }
  deriving (GetPlaybackConfiguration -> GetPlaybackConfiguration -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetPlaybackConfiguration -> GetPlaybackConfiguration -> Bool
$c/= :: GetPlaybackConfiguration -> GetPlaybackConfiguration -> Bool
== :: GetPlaybackConfiguration -> GetPlaybackConfiguration -> Bool
$c== :: GetPlaybackConfiguration -> GetPlaybackConfiguration -> Bool
Prelude.Eq, ReadPrec [GetPlaybackConfiguration]
ReadPrec GetPlaybackConfiguration
Int -> ReadS GetPlaybackConfiguration
ReadS [GetPlaybackConfiguration]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetPlaybackConfiguration]
$creadListPrec :: ReadPrec [GetPlaybackConfiguration]
readPrec :: ReadPrec GetPlaybackConfiguration
$creadPrec :: ReadPrec GetPlaybackConfiguration
readList :: ReadS [GetPlaybackConfiguration]
$creadList :: ReadS [GetPlaybackConfiguration]
readsPrec :: Int -> ReadS GetPlaybackConfiguration
$creadsPrec :: Int -> ReadS GetPlaybackConfiguration
Prelude.Read, Int -> GetPlaybackConfiguration -> ShowS
[GetPlaybackConfiguration] -> ShowS
GetPlaybackConfiguration -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetPlaybackConfiguration] -> ShowS
$cshowList :: [GetPlaybackConfiguration] -> ShowS
show :: GetPlaybackConfiguration -> String
$cshow :: GetPlaybackConfiguration -> String
showsPrec :: Int -> GetPlaybackConfiguration -> ShowS
$cshowsPrec :: Int -> GetPlaybackConfiguration -> ShowS
Prelude.Show, forall x.
Rep GetPlaybackConfiguration x -> GetPlaybackConfiguration
forall x.
GetPlaybackConfiguration -> Rep GetPlaybackConfiguration x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetPlaybackConfiguration x -> GetPlaybackConfiguration
$cfrom :: forall x.
GetPlaybackConfiguration -> Rep GetPlaybackConfiguration x
Prelude.Generic)

-- |
-- Create a value of 'GetPlaybackConfiguration' 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:
--
-- 'name', 'getPlaybackConfiguration_name' - The identifier for the playback configuration.
newGetPlaybackConfiguration ::
  -- | 'name'
  Prelude.Text ->
  GetPlaybackConfiguration
newGetPlaybackConfiguration :: Text -> GetPlaybackConfiguration
newGetPlaybackConfiguration Text
pName_ =
  GetPlaybackConfiguration' {$sel:name:GetPlaybackConfiguration' :: Text
name = Text
pName_}

-- | The identifier for the playback configuration.
getPlaybackConfiguration_name :: Lens.Lens' GetPlaybackConfiguration Prelude.Text
getPlaybackConfiguration_name :: Lens' GetPlaybackConfiguration Text
getPlaybackConfiguration_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetPlaybackConfiguration' {Text
name :: Text
$sel:name:GetPlaybackConfiguration' :: GetPlaybackConfiguration -> Text
name} -> Text
name) (\s :: GetPlaybackConfiguration
s@GetPlaybackConfiguration' {} Text
a -> GetPlaybackConfiguration
s {$sel:name:GetPlaybackConfiguration' :: Text
name = Text
a} :: GetPlaybackConfiguration)

instance Core.AWSRequest GetPlaybackConfiguration where
  type
    AWSResponse GetPlaybackConfiguration =
      GetPlaybackConfigurationResponse
  request :: (Service -> Service)
-> GetPlaybackConfiguration -> Request GetPlaybackConfiguration
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.get (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy GetPlaybackConfiguration
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse GetPlaybackConfiguration)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> Object -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveJSON
      ( \Int
s ResponseHeaders
h Object
x ->
          Maybe Text
-> Maybe AvailSuppression
-> Maybe Bumper
-> Maybe CdnConfiguration
-> Maybe (HashMap Text (HashMap Text Text))
-> Maybe DashConfiguration
-> Maybe HlsConfiguration
-> Maybe LivePreRollConfiguration
-> Maybe LogConfiguration
-> Maybe ManifestProcessingRules
-> Maybe Text
-> Maybe Natural
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe (HashMap Text Text)
-> Maybe Text
-> Maybe Text
-> Int
-> GetPlaybackConfigurationResponse
GetPlaybackConfigurationResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"AdDecisionServerUrl")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"AvailSuppression")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"Bumper")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"CdnConfiguration")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ( Object
x
                            forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"ConfigurationAliases"
                            forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty
                        )
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"DashConfiguration")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"HlsConfiguration")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"LivePreRollConfiguration")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"LogConfiguration")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"ManifestProcessingRules")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"Name")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"PersonalizationThresholdSeconds")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"PlaybackConfigurationArn")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"PlaybackEndpointPrefix")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"SessionInitializationEndpointPrefix")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"SlateAdUrl")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"tags" forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty)
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"TranscodeProfileName")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"VideoContentSourceUrl")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
      )

instance Prelude.Hashable GetPlaybackConfiguration where
  hashWithSalt :: Int -> GetPlaybackConfiguration -> Int
hashWithSalt Int
_salt GetPlaybackConfiguration' {Text
name :: Text
$sel:name:GetPlaybackConfiguration' :: GetPlaybackConfiguration -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
name

instance Prelude.NFData GetPlaybackConfiguration where
  rnf :: GetPlaybackConfiguration -> ()
rnf GetPlaybackConfiguration' {Text
name :: Text
$sel:name:GetPlaybackConfiguration' :: GetPlaybackConfiguration -> Text
..} = forall a. NFData a => a -> ()
Prelude.rnf Text
name

instance Data.ToHeaders GetPlaybackConfiguration where
  toHeaders :: GetPlaybackConfiguration -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToPath GetPlaybackConfiguration where
  toPath :: GetPlaybackConfiguration -> ByteString
toPath GetPlaybackConfiguration' {Text
name :: Text
$sel:name:GetPlaybackConfiguration' :: GetPlaybackConfiguration -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ByteString
"/playbackConfiguration/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
name]

instance Data.ToQuery GetPlaybackConfiguration where
  toQuery :: GetPlaybackConfiguration -> QueryString
toQuery = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

-- | /See:/ 'newGetPlaybackConfigurationResponse' smart constructor.
data GetPlaybackConfigurationResponse = GetPlaybackConfigurationResponse'
  { -- | The URL for the ad decision server (ADS). This includes the
    -- specification of static parameters and placeholders for dynamic
    -- parameters. AWS Elemental MediaTailor substitutes player-specific and
    -- session-specific parameters as needed when calling the ADS. Alternately,
    -- for testing, you can provide a static VAST URL. The maximum length is
    -- 25,000 characters.
    GetPlaybackConfigurationResponse -> Maybe Text
adDecisionServerUrl :: Prelude.Maybe Prelude.Text,
    -- | The configuration for avail suppression, also known as ad suppression.
    -- For more information about ad suppression, see
    -- <https://docs.aws.amazon.com/mediatailor/latest/ug/ad-behavior.html Ad Suppression>.
    GetPlaybackConfigurationResponse -> Maybe AvailSuppression
availSuppression :: Prelude.Maybe AvailSuppression,
    -- | The configuration for bumpers. Bumpers are short audio or video clips
    -- that play at the start or before the end of an ad break. To learn more
    -- about bumpers, see
    -- <https://docs.aws.amazon.com/mediatailor/latest/ug/bumpers.html Bumpers>.
    GetPlaybackConfigurationResponse -> Maybe Bumper
bumper :: Prelude.Maybe Bumper,
    -- | The configuration for using a content delivery network (CDN), like
    -- Amazon CloudFront, for content and ad segment management.
    GetPlaybackConfigurationResponse -> Maybe CdnConfiguration
cdnConfiguration :: Prelude.Maybe CdnConfiguration,
    -- | The player parameters and aliases used as dynamic variables during
    -- session initialization. For more information, see
    -- <https://docs.aws.amazon.com/mediatailor/latest/ug/variables-domain.html Domain Variables>.
    GetPlaybackConfigurationResponse
-> Maybe (HashMap Text (HashMap Text Text))
configurationAliases :: Prelude.Maybe (Prelude.HashMap Prelude.Text (Prelude.HashMap Prelude.Text Prelude.Text)),
    -- | The configuration for DASH content.
    GetPlaybackConfigurationResponse -> Maybe DashConfiguration
dashConfiguration :: Prelude.Maybe DashConfiguration,
    -- | The configuration for HLS content.
    GetPlaybackConfigurationResponse -> Maybe HlsConfiguration
hlsConfiguration :: Prelude.Maybe HlsConfiguration,
    -- | The configuration for pre-roll ad insertion.
    GetPlaybackConfigurationResponse -> Maybe LivePreRollConfiguration
livePreRollConfiguration :: Prelude.Maybe LivePreRollConfiguration,
    -- | The Amazon CloudWatch log settings for a playback configuration.
    GetPlaybackConfigurationResponse -> Maybe LogConfiguration
logConfiguration :: Prelude.Maybe LogConfiguration,
    -- | The configuration for manifest processing rules. Manifest processing
    -- rules enable customization of the personalized manifests created by
    -- MediaTailor.
    GetPlaybackConfigurationResponse -> Maybe ManifestProcessingRules
manifestProcessingRules :: Prelude.Maybe ManifestProcessingRules,
    -- | The identifier for the playback configuration.
    GetPlaybackConfigurationResponse -> Maybe Text
name :: Prelude.Maybe Prelude.Text,
    -- | Defines the maximum duration of underfilled ad time (in seconds) allowed
    -- in an ad break. If the duration of underfilled ad time exceeds the
    -- personalization threshold, then the personalization of the ad break is
    -- abandoned and the underlying content is shown. This feature applies to
    -- /ad replacement/ in live and VOD streams, rather than ad insertion,
    -- because it relies on an underlying content stream. For more information
    -- about ad break behavior, including ad replacement and insertion, see
    -- <https://docs.aws.amazon.com/mediatailor/latest/ug/ad-behavior.html Ad Behavior in AWS Elemental MediaTailor>.
    GetPlaybackConfigurationResponse -> Maybe Natural
personalizationThresholdSeconds :: Prelude.Maybe Prelude.Natural,
    -- | The Amazon Resource Name (ARN) for the playback configuration.
    GetPlaybackConfigurationResponse -> Maybe Text
playbackConfigurationArn :: Prelude.Maybe Prelude.Text,
    -- | The URL that the player accesses to get a manifest from AWS Elemental
    -- MediaTailor. This session will use server-side reporting.
    GetPlaybackConfigurationResponse -> Maybe Text
playbackEndpointPrefix :: Prelude.Maybe Prelude.Text,
    -- | The URL that the player uses to initialize a session that uses
    -- client-side reporting.
    GetPlaybackConfigurationResponse -> Maybe Text
sessionInitializationEndpointPrefix :: Prelude.Maybe Prelude.Text,
    -- | The URL for a high-quality video asset to transcode and use to fill in
    -- time that\'s not used by ads. AWS Elemental MediaTailor shows the slate
    -- to fill in gaps in media content. Configuring the slate is optional for
    -- non-VPAID playback configurations. For VPAID, the slate is required
    -- because MediaTailor provides it in the slots designated for dynamic ad
    -- content. The slate must be a high-quality asset that contains both audio
    -- and video.
    GetPlaybackConfigurationResponse -> Maybe Text
slateAdUrl :: Prelude.Maybe Prelude.Text,
    -- | The tags assigned to the playback configuration. Tags are key-value
    -- pairs that you can associate with Amazon resources to help with
    -- organization, access control, and cost tracking. For more information,
    -- see
    -- <https://docs.aws.amazon.com/mediatailor/latest/ug/tagging.html Tagging AWS Elemental MediaTailor Resources>.
    GetPlaybackConfigurationResponse -> Maybe (HashMap Text Text)
tags :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | The name that is used to associate this playback configuration with a
    -- custom transcode profile. This overrides the dynamic transcoding
    -- defaults of MediaTailor. Use this only if you have already set up custom
    -- profiles with the help of AWS Support.
    GetPlaybackConfigurationResponse -> Maybe Text
transcodeProfileName :: Prelude.Maybe Prelude.Text,
    -- | The URL prefix for the parent manifest for the stream, minus the asset
    -- ID. The maximum length is 512 characters.
    GetPlaybackConfigurationResponse -> Maybe Text
videoContentSourceUrl :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    GetPlaybackConfigurationResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetPlaybackConfigurationResponse
-> GetPlaybackConfigurationResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetPlaybackConfigurationResponse
-> GetPlaybackConfigurationResponse -> Bool
$c/= :: GetPlaybackConfigurationResponse
-> GetPlaybackConfigurationResponse -> Bool
== :: GetPlaybackConfigurationResponse
-> GetPlaybackConfigurationResponse -> Bool
$c== :: GetPlaybackConfigurationResponse
-> GetPlaybackConfigurationResponse -> Bool
Prelude.Eq, ReadPrec [GetPlaybackConfigurationResponse]
ReadPrec GetPlaybackConfigurationResponse
Int -> ReadS GetPlaybackConfigurationResponse
ReadS [GetPlaybackConfigurationResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetPlaybackConfigurationResponse]
$creadListPrec :: ReadPrec [GetPlaybackConfigurationResponse]
readPrec :: ReadPrec GetPlaybackConfigurationResponse
$creadPrec :: ReadPrec GetPlaybackConfigurationResponse
readList :: ReadS [GetPlaybackConfigurationResponse]
$creadList :: ReadS [GetPlaybackConfigurationResponse]
readsPrec :: Int -> ReadS GetPlaybackConfigurationResponse
$creadsPrec :: Int -> ReadS GetPlaybackConfigurationResponse
Prelude.Read, Int -> GetPlaybackConfigurationResponse -> ShowS
[GetPlaybackConfigurationResponse] -> ShowS
GetPlaybackConfigurationResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetPlaybackConfigurationResponse] -> ShowS
$cshowList :: [GetPlaybackConfigurationResponse] -> ShowS
show :: GetPlaybackConfigurationResponse -> String
$cshow :: GetPlaybackConfigurationResponse -> String
showsPrec :: Int -> GetPlaybackConfigurationResponse -> ShowS
$cshowsPrec :: Int -> GetPlaybackConfigurationResponse -> ShowS
Prelude.Show, forall x.
Rep GetPlaybackConfigurationResponse x
-> GetPlaybackConfigurationResponse
forall x.
GetPlaybackConfigurationResponse
-> Rep GetPlaybackConfigurationResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetPlaybackConfigurationResponse x
-> GetPlaybackConfigurationResponse
$cfrom :: forall x.
GetPlaybackConfigurationResponse
-> Rep GetPlaybackConfigurationResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetPlaybackConfigurationResponse' 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:
--
-- 'adDecisionServerUrl', 'getPlaybackConfigurationResponse_adDecisionServerUrl' - The URL for the ad decision server (ADS). This includes the
-- specification of static parameters and placeholders for dynamic
-- parameters. AWS Elemental MediaTailor substitutes player-specific and
-- session-specific parameters as needed when calling the ADS. Alternately,
-- for testing, you can provide a static VAST URL. The maximum length is
-- 25,000 characters.
--
-- 'availSuppression', 'getPlaybackConfigurationResponse_availSuppression' - The configuration for avail suppression, also known as ad suppression.
-- For more information about ad suppression, see
-- <https://docs.aws.amazon.com/mediatailor/latest/ug/ad-behavior.html Ad Suppression>.
--
-- 'bumper', 'getPlaybackConfigurationResponse_bumper' - The configuration for bumpers. Bumpers are short audio or video clips
-- that play at the start or before the end of an ad break. To learn more
-- about bumpers, see
-- <https://docs.aws.amazon.com/mediatailor/latest/ug/bumpers.html Bumpers>.
--
-- 'cdnConfiguration', 'getPlaybackConfigurationResponse_cdnConfiguration' - The configuration for using a content delivery network (CDN), like
-- Amazon CloudFront, for content and ad segment management.
--
-- 'configurationAliases', 'getPlaybackConfigurationResponse_configurationAliases' - The player parameters and aliases used as dynamic variables during
-- session initialization. For more information, see
-- <https://docs.aws.amazon.com/mediatailor/latest/ug/variables-domain.html Domain Variables>.
--
-- 'dashConfiguration', 'getPlaybackConfigurationResponse_dashConfiguration' - The configuration for DASH content.
--
-- 'hlsConfiguration', 'getPlaybackConfigurationResponse_hlsConfiguration' - The configuration for HLS content.
--
-- 'livePreRollConfiguration', 'getPlaybackConfigurationResponse_livePreRollConfiguration' - The configuration for pre-roll ad insertion.
--
-- 'logConfiguration', 'getPlaybackConfigurationResponse_logConfiguration' - The Amazon CloudWatch log settings for a playback configuration.
--
-- 'manifestProcessingRules', 'getPlaybackConfigurationResponse_manifestProcessingRules' - The configuration for manifest processing rules. Manifest processing
-- rules enable customization of the personalized manifests created by
-- MediaTailor.
--
-- 'name', 'getPlaybackConfigurationResponse_name' - The identifier for the playback configuration.
--
-- 'personalizationThresholdSeconds', 'getPlaybackConfigurationResponse_personalizationThresholdSeconds' - Defines the maximum duration of underfilled ad time (in seconds) allowed
-- in an ad break. If the duration of underfilled ad time exceeds the
-- personalization threshold, then the personalization of the ad break is
-- abandoned and the underlying content is shown. This feature applies to
-- /ad replacement/ in live and VOD streams, rather than ad insertion,
-- because it relies on an underlying content stream. For more information
-- about ad break behavior, including ad replacement and insertion, see
-- <https://docs.aws.amazon.com/mediatailor/latest/ug/ad-behavior.html Ad Behavior in AWS Elemental MediaTailor>.
--
-- 'playbackConfigurationArn', 'getPlaybackConfigurationResponse_playbackConfigurationArn' - The Amazon Resource Name (ARN) for the playback configuration.
--
-- 'playbackEndpointPrefix', 'getPlaybackConfigurationResponse_playbackEndpointPrefix' - The URL that the player accesses to get a manifest from AWS Elemental
-- MediaTailor. This session will use server-side reporting.
--
-- 'sessionInitializationEndpointPrefix', 'getPlaybackConfigurationResponse_sessionInitializationEndpointPrefix' - The URL that the player uses to initialize a session that uses
-- client-side reporting.
--
-- 'slateAdUrl', 'getPlaybackConfigurationResponse_slateAdUrl' - The URL for a high-quality video asset to transcode and use to fill in
-- time that\'s not used by ads. AWS Elemental MediaTailor shows the slate
-- to fill in gaps in media content. Configuring the slate is optional for
-- non-VPAID playback configurations. For VPAID, the slate is required
-- because MediaTailor provides it in the slots designated for dynamic ad
-- content. The slate must be a high-quality asset that contains both audio
-- and video.
--
-- 'tags', 'getPlaybackConfigurationResponse_tags' - The tags assigned to the playback configuration. Tags are key-value
-- pairs that you can associate with Amazon resources to help with
-- organization, access control, and cost tracking. For more information,
-- see
-- <https://docs.aws.amazon.com/mediatailor/latest/ug/tagging.html Tagging AWS Elemental MediaTailor Resources>.
--
-- 'transcodeProfileName', 'getPlaybackConfigurationResponse_transcodeProfileName' - The name that is used to associate this playback configuration with a
-- custom transcode profile. This overrides the dynamic transcoding
-- defaults of MediaTailor. Use this only if you have already set up custom
-- profiles with the help of AWS Support.
--
-- 'videoContentSourceUrl', 'getPlaybackConfigurationResponse_videoContentSourceUrl' - The URL prefix for the parent manifest for the stream, minus the asset
-- ID. The maximum length is 512 characters.
--
-- 'httpStatus', 'getPlaybackConfigurationResponse_httpStatus' - The response's http status code.
newGetPlaybackConfigurationResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetPlaybackConfigurationResponse
newGetPlaybackConfigurationResponse :: Int -> GetPlaybackConfigurationResponse
newGetPlaybackConfigurationResponse Int
pHttpStatus_ =
  GetPlaybackConfigurationResponse'
    { $sel:adDecisionServerUrl:GetPlaybackConfigurationResponse' :: Maybe Text
adDecisionServerUrl =
        forall a. Maybe a
Prelude.Nothing,
      $sel:availSuppression:GetPlaybackConfigurationResponse' :: Maybe AvailSuppression
availSuppression = forall a. Maybe a
Prelude.Nothing,
      $sel:bumper:GetPlaybackConfigurationResponse' :: Maybe Bumper
bumper = forall a. Maybe a
Prelude.Nothing,
      $sel:cdnConfiguration:GetPlaybackConfigurationResponse' :: Maybe CdnConfiguration
cdnConfiguration = forall a. Maybe a
Prelude.Nothing,
      $sel:configurationAliases:GetPlaybackConfigurationResponse' :: Maybe (HashMap Text (HashMap Text Text))
configurationAliases = forall a. Maybe a
Prelude.Nothing,
      $sel:dashConfiguration:GetPlaybackConfigurationResponse' :: Maybe DashConfiguration
dashConfiguration = forall a. Maybe a
Prelude.Nothing,
      $sel:hlsConfiguration:GetPlaybackConfigurationResponse' :: Maybe HlsConfiguration
hlsConfiguration = forall a. Maybe a
Prelude.Nothing,
      $sel:livePreRollConfiguration:GetPlaybackConfigurationResponse' :: Maybe LivePreRollConfiguration
livePreRollConfiguration =
        forall a. Maybe a
Prelude.Nothing,
      $sel:logConfiguration:GetPlaybackConfigurationResponse' :: Maybe LogConfiguration
logConfiguration = forall a. Maybe a
Prelude.Nothing,
      $sel:manifestProcessingRules:GetPlaybackConfigurationResponse' :: Maybe ManifestProcessingRules
manifestProcessingRules = forall a. Maybe a
Prelude.Nothing,
      $sel:name:GetPlaybackConfigurationResponse' :: Maybe Text
name = forall a. Maybe a
Prelude.Nothing,
      $sel:personalizationThresholdSeconds:GetPlaybackConfigurationResponse' :: Maybe Natural
personalizationThresholdSeconds =
        forall a. Maybe a
Prelude.Nothing,
      $sel:playbackConfigurationArn:GetPlaybackConfigurationResponse' :: Maybe Text
playbackConfigurationArn =
        forall a. Maybe a
Prelude.Nothing,
      $sel:playbackEndpointPrefix:GetPlaybackConfigurationResponse' :: Maybe Text
playbackEndpointPrefix = forall a. Maybe a
Prelude.Nothing,
      $sel:sessionInitializationEndpointPrefix:GetPlaybackConfigurationResponse' :: Maybe Text
sessionInitializationEndpointPrefix =
        forall a. Maybe a
Prelude.Nothing,
      $sel:slateAdUrl:GetPlaybackConfigurationResponse' :: Maybe Text
slateAdUrl = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:GetPlaybackConfigurationResponse' :: Maybe (HashMap Text Text)
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:transcodeProfileName:GetPlaybackConfigurationResponse' :: Maybe Text
transcodeProfileName = forall a. Maybe a
Prelude.Nothing,
      $sel:videoContentSourceUrl:GetPlaybackConfigurationResponse' :: Maybe Text
videoContentSourceUrl = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetPlaybackConfigurationResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The URL for the ad decision server (ADS). This includes the
-- specification of static parameters and placeholders for dynamic
-- parameters. AWS Elemental MediaTailor substitutes player-specific and
-- session-specific parameters as needed when calling the ADS. Alternately,
-- for testing, you can provide a static VAST URL. The maximum length is
-- 25,000 characters.
getPlaybackConfigurationResponse_adDecisionServerUrl :: Lens.Lens' GetPlaybackConfigurationResponse (Prelude.Maybe Prelude.Text)
getPlaybackConfigurationResponse_adDecisionServerUrl :: Lens' GetPlaybackConfigurationResponse (Maybe Text)
getPlaybackConfigurationResponse_adDecisionServerUrl = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetPlaybackConfigurationResponse' {Maybe Text
adDecisionServerUrl :: Maybe Text
$sel:adDecisionServerUrl:GetPlaybackConfigurationResponse' :: GetPlaybackConfigurationResponse -> Maybe Text
adDecisionServerUrl} -> Maybe Text
adDecisionServerUrl) (\s :: GetPlaybackConfigurationResponse
s@GetPlaybackConfigurationResponse' {} Maybe Text
a -> GetPlaybackConfigurationResponse
s {$sel:adDecisionServerUrl:GetPlaybackConfigurationResponse' :: Maybe Text
adDecisionServerUrl = Maybe Text
a} :: GetPlaybackConfigurationResponse)

-- | The configuration for avail suppression, also known as ad suppression.
-- For more information about ad suppression, see
-- <https://docs.aws.amazon.com/mediatailor/latest/ug/ad-behavior.html Ad Suppression>.
getPlaybackConfigurationResponse_availSuppression :: Lens.Lens' GetPlaybackConfigurationResponse (Prelude.Maybe AvailSuppression)
getPlaybackConfigurationResponse_availSuppression :: Lens' GetPlaybackConfigurationResponse (Maybe AvailSuppression)
getPlaybackConfigurationResponse_availSuppression = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetPlaybackConfigurationResponse' {Maybe AvailSuppression
availSuppression :: Maybe AvailSuppression
$sel:availSuppression:GetPlaybackConfigurationResponse' :: GetPlaybackConfigurationResponse -> Maybe AvailSuppression
availSuppression} -> Maybe AvailSuppression
availSuppression) (\s :: GetPlaybackConfigurationResponse
s@GetPlaybackConfigurationResponse' {} Maybe AvailSuppression
a -> GetPlaybackConfigurationResponse
s {$sel:availSuppression:GetPlaybackConfigurationResponse' :: Maybe AvailSuppression
availSuppression = Maybe AvailSuppression
a} :: GetPlaybackConfigurationResponse)

-- | The configuration for bumpers. Bumpers are short audio or video clips
-- that play at the start or before the end of an ad break. To learn more
-- about bumpers, see
-- <https://docs.aws.amazon.com/mediatailor/latest/ug/bumpers.html Bumpers>.
getPlaybackConfigurationResponse_bumper :: Lens.Lens' GetPlaybackConfigurationResponse (Prelude.Maybe Bumper)
getPlaybackConfigurationResponse_bumper :: Lens' GetPlaybackConfigurationResponse (Maybe Bumper)
getPlaybackConfigurationResponse_bumper = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetPlaybackConfigurationResponse' {Maybe Bumper
bumper :: Maybe Bumper
$sel:bumper:GetPlaybackConfigurationResponse' :: GetPlaybackConfigurationResponse -> Maybe Bumper
bumper} -> Maybe Bumper
bumper) (\s :: GetPlaybackConfigurationResponse
s@GetPlaybackConfigurationResponse' {} Maybe Bumper
a -> GetPlaybackConfigurationResponse
s {$sel:bumper:GetPlaybackConfigurationResponse' :: Maybe Bumper
bumper = Maybe Bumper
a} :: GetPlaybackConfigurationResponse)

-- | The configuration for using a content delivery network (CDN), like
-- Amazon CloudFront, for content and ad segment management.
getPlaybackConfigurationResponse_cdnConfiguration :: Lens.Lens' GetPlaybackConfigurationResponse (Prelude.Maybe CdnConfiguration)
getPlaybackConfigurationResponse_cdnConfiguration :: Lens' GetPlaybackConfigurationResponse (Maybe CdnConfiguration)
getPlaybackConfigurationResponse_cdnConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetPlaybackConfigurationResponse' {Maybe CdnConfiguration
cdnConfiguration :: Maybe CdnConfiguration
$sel:cdnConfiguration:GetPlaybackConfigurationResponse' :: GetPlaybackConfigurationResponse -> Maybe CdnConfiguration
cdnConfiguration} -> Maybe CdnConfiguration
cdnConfiguration) (\s :: GetPlaybackConfigurationResponse
s@GetPlaybackConfigurationResponse' {} Maybe CdnConfiguration
a -> GetPlaybackConfigurationResponse
s {$sel:cdnConfiguration:GetPlaybackConfigurationResponse' :: Maybe CdnConfiguration
cdnConfiguration = Maybe CdnConfiguration
a} :: GetPlaybackConfigurationResponse)

-- | The player parameters and aliases used as dynamic variables during
-- session initialization. For more information, see
-- <https://docs.aws.amazon.com/mediatailor/latest/ug/variables-domain.html Domain Variables>.
getPlaybackConfigurationResponse_configurationAliases :: Lens.Lens' GetPlaybackConfigurationResponse (Prelude.Maybe (Prelude.HashMap Prelude.Text (Prelude.HashMap Prelude.Text Prelude.Text)))
getPlaybackConfigurationResponse_configurationAliases :: Lens'
  GetPlaybackConfigurationResponse
  (Maybe (HashMap Text (HashMap Text Text)))
getPlaybackConfigurationResponse_configurationAliases = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetPlaybackConfigurationResponse' {Maybe (HashMap Text (HashMap Text Text))
configurationAliases :: Maybe (HashMap Text (HashMap Text Text))
$sel:configurationAliases:GetPlaybackConfigurationResponse' :: GetPlaybackConfigurationResponse
-> Maybe (HashMap Text (HashMap Text Text))
configurationAliases} -> Maybe (HashMap Text (HashMap Text Text))
configurationAliases) (\s :: GetPlaybackConfigurationResponse
s@GetPlaybackConfigurationResponse' {} Maybe (HashMap Text (HashMap Text Text))
a -> GetPlaybackConfigurationResponse
s {$sel:configurationAliases:GetPlaybackConfigurationResponse' :: Maybe (HashMap Text (HashMap Text Text))
configurationAliases = Maybe (HashMap Text (HashMap Text Text))
a} :: GetPlaybackConfigurationResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | The configuration for DASH content.
getPlaybackConfigurationResponse_dashConfiguration :: Lens.Lens' GetPlaybackConfigurationResponse (Prelude.Maybe DashConfiguration)
getPlaybackConfigurationResponse_dashConfiguration :: Lens' GetPlaybackConfigurationResponse (Maybe DashConfiguration)
getPlaybackConfigurationResponse_dashConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetPlaybackConfigurationResponse' {Maybe DashConfiguration
dashConfiguration :: Maybe DashConfiguration
$sel:dashConfiguration:GetPlaybackConfigurationResponse' :: GetPlaybackConfigurationResponse -> Maybe DashConfiguration
dashConfiguration} -> Maybe DashConfiguration
dashConfiguration) (\s :: GetPlaybackConfigurationResponse
s@GetPlaybackConfigurationResponse' {} Maybe DashConfiguration
a -> GetPlaybackConfigurationResponse
s {$sel:dashConfiguration:GetPlaybackConfigurationResponse' :: Maybe DashConfiguration
dashConfiguration = Maybe DashConfiguration
a} :: GetPlaybackConfigurationResponse)

-- | The configuration for HLS content.
getPlaybackConfigurationResponse_hlsConfiguration :: Lens.Lens' GetPlaybackConfigurationResponse (Prelude.Maybe HlsConfiguration)
getPlaybackConfigurationResponse_hlsConfiguration :: Lens' GetPlaybackConfigurationResponse (Maybe HlsConfiguration)
getPlaybackConfigurationResponse_hlsConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetPlaybackConfigurationResponse' {Maybe HlsConfiguration
hlsConfiguration :: Maybe HlsConfiguration
$sel:hlsConfiguration:GetPlaybackConfigurationResponse' :: GetPlaybackConfigurationResponse -> Maybe HlsConfiguration
hlsConfiguration} -> Maybe HlsConfiguration
hlsConfiguration) (\s :: GetPlaybackConfigurationResponse
s@GetPlaybackConfigurationResponse' {} Maybe HlsConfiguration
a -> GetPlaybackConfigurationResponse
s {$sel:hlsConfiguration:GetPlaybackConfigurationResponse' :: Maybe HlsConfiguration
hlsConfiguration = Maybe HlsConfiguration
a} :: GetPlaybackConfigurationResponse)

-- | The configuration for pre-roll ad insertion.
getPlaybackConfigurationResponse_livePreRollConfiguration :: Lens.Lens' GetPlaybackConfigurationResponse (Prelude.Maybe LivePreRollConfiguration)
getPlaybackConfigurationResponse_livePreRollConfiguration :: Lens'
  GetPlaybackConfigurationResponse (Maybe LivePreRollConfiguration)
getPlaybackConfigurationResponse_livePreRollConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetPlaybackConfigurationResponse' {Maybe LivePreRollConfiguration
livePreRollConfiguration :: Maybe LivePreRollConfiguration
$sel:livePreRollConfiguration:GetPlaybackConfigurationResponse' :: GetPlaybackConfigurationResponse -> Maybe LivePreRollConfiguration
livePreRollConfiguration} -> Maybe LivePreRollConfiguration
livePreRollConfiguration) (\s :: GetPlaybackConfigurationResponse
s@GetPlaybackConfigurationResponse' {} Maybe LivePreRollConfiguration
a -> GetPlaybackConfigurationResponse
s {$sel:livePreRollConfiguration:GetPlaybackConfigurationResponse' :: Maybe LivePreRollConfiguration
livePreRollConfiguration = Maybe LivePreRollConfiguration
a} :: GetPlaybackConfigurationResponse)

-- | The Amazon CloudWatch log settings for a playback configuration.
getPlaybackConfigurationResponse_logConfiguration :: Lens.Lens' GetPlaybackConfigurationResponse (Prelude.Maybe LogConfiguration)
getPlaybackConfigurationResponse_logConfiguration :: Lens' GetPlaybackConfigurationResponse (Maybe LogConfiguration)
getPlaybackConfigurationResponse_logConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetPlaybackConfigurationResponse' {Maybe LogConfiguration
logConfiguration :: Maybe LogConfiguration
$sel:logConfiguration:GetPlaybackConfigurationResponse' :: GetPlaybackConfigurationResponse -> Maybe LogConfiguration
logConfiguration} -> Maybe LogConfiguration
logConfiguration) (\s :: GetPlaybackConfigurationResponse
s@GetPlaybackConfigurationResponse' {} Maybe LogConfiguration
a -> GetPlaybackConfigurationResponse
s {$sel:logConfiguration:GetPlaybackConfigurationResponse' :: Maybe LogConfiguration
logConfiguration = Maybe LogConfiguration
a} :: GetPlaybackConfigurationResponse)

-- | The configuration for manifest processing rules. Manifest processing
-- rules enable customization of the personalized manifests created by
-- MediaTailor.
getPlaybackConfigurationResponse_manifestProcessingRules :: Lens.Lens' GetPlaybackConfigurationResponse (Prelude.Maybe ManifestProcessingRules)
getPlaybackConfigurationResponse_manifestProcessingRules :: Lens'
  GetPlaybackConfigurationResponse (Maybe ManifestProcessingRules)
getPlaybackConfigurationResponse_manifestProcessingRules = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetPlaybackConfigurationResponse' {Maybe ManifestProcessingRules
manifestProcessingRules :: Maybe ManifestProcessingRules
$sel:manifestProcessingRules:GetPlaybackConfigurationResponse' :: GetPlaybackConfigurationResponse -> Maybe ManifestProcessingRules
manifestProcessingRules} -> Maybe ManifestProcessingRules
manifestProcessingRules) (\s :: GetPlaybackConfigurationResponse
s@GetPlaybackConfigurationResponse' {} Maybe ManifestProcessingRules
a -> GetPlaybackConfigurationResponse
s {$sel:manifestProcessingRules:GetPlaybackConfigurationResponse' :: Maybe ManifestProcessingRules
manifestProcessingRules = Maybe ManifestProcessingRules
a} :: GetPlaybackConfigurationResponse)

-- | The identifier for the playback configuration.
getPlaybackConfigurationResponse_name :: Lens.Lens' GetPlaybackConfigurationResponse (Prelude.Maybe Prelude.Text)
getPlaybackConfigurationResponse_name :: Lens' GetPlaybackConfigurationResponse (Maybe Text)
getPlaybackConfigurationResponse_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetPlaybackConfigurationResponse' {Maybe Text
name :: Maybe Text
$sel:name:GetPlaybackConfigurationResponse' :: GetPlaybackConfigurationResponse -> Maybe Text
name} -> Maybe Text
name) (\s :: GetPlaybackConfigurationResponse
s@GetPlaybackConfigurationResponse' {} Maybe Text
a -> GetPlaybackConfigurationResponse
s {$sel:name:GetPlaybackConfigurationResponse' :: Maybe Text
name = Maybe Text
a} :: GetPlaybackConfigurationResponse)

-- | Defines the maximum duration of underfilled ad time (in seconds) allowed
-- in an ad break. If the duration of underfilled ad time exceeds the
-- personalization threshold, then the personalization of the ad break is
-- abandoned and the underlying content is shown. This feature applies to
-- /ad replacement/ in live and VOD streams, rather than ad insertion,
-- because it relies on an underlying content stream. For more information
-- about ad break behavior, including ad replacement and insertion, see
-- <https://docs.aws.amazon.com/mediatailor/latest/ug/ad-behavior.html Ad Behavior in AWS Elemental MediaTailor>.
getPlaybackConfigurationResponse_personalizationThresholdSeconds :: Lens.Lens' GetPlaybackConfigurationResponse (Prelude.Maybe Prelude.Natural)
getPlaybackConfigurationResponse_personalizationThresholdSeconds :: Lens' GetPlaybackConfigurationResponse (Maybe Natural)
getPlaybackConfigurationResponse_personalizationThresholdSeconds = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetPlaybackConfigurationResponse' {Maybe Natural
personalizationThresholdSeconds :: Maybe Natural
$sel:personalizationThresholdSeconds:GetPlaybackConfigurationResponse' :: GetPlaybackConfigurationResponse -> Maybe Natural
personalizationThresholdSeconds} -> Maybe Natural
personalizationThresholdSeconds) (\s :: GetPlaybackConfigurationResponse
s@GetPlaybackConfigurationResponse' {} Maybe Natural
a -> GetPlaybackConfigurationResponse
s {$sel:personalizationThresholdSeconds:GetPlaybackConfigurationResponse' :: Maybe Natural
personalizationThresholdSeconds = Maybe Natural
a} :: GetPlaybackConfigurationResponse)

-- | The Amazon Resource Name (ARN) for the playback configuration.
getPlaybackConfigurationResponse_playbackConfigurationArn :: Lens.Lens' GetPlaybackConfigurationResponse (Prelude.Maybe Prelude.Text)
getPlaybackConfigurationResponse_playbackConfigurationArn :: Lens' GetPlaybackConfigurationResponse (Maybe Text)
getPlaybackConfigurationResponse_playbackConfigurationArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetPlaybackConfigurationResponse' {Maybe Text
playbackConfigurationArn :: Maybe Text
$sel:playbackConfigurationArn:GetPlaybackConfigurationResponse' :: GetPlaybackConfigurationResponse -> Maybe Text
playbackConfigurationArn} -> Maybe Text
playbackConfigurationArn) (\s :: GetPlaybackConfigurationResponse
s@GetPlaybackConfigurationResponse' {} Maybe Text
a -> GetPlaybackConfigurationResponse
s {$sel:playbackConfigurationArn:GetPlaybackConfigurationResponse' :: Maybe Text
playbackConfigurationArn = Maybe Text
a} :: GetPlaybackConfigurationResponse)

-- | The URL that the player accesses to get a manifest from AWS Elemental
-- MediaTailor. This session will use server-side reporting.
getPlaybackConfigurationResponse_playbackEndpointPrefix :: Lens.Lens' GetPlaybackConfigurationResponse (Prelude.Maybe Prelude.Text)
getPlaybackConfigurationResponse_playbackEndpointPrefix :: Lens' GetPlaybackConfigurationResponse (Maybe Text)
getPlaybackConfigurationResponse_playbackEndpointPrefix = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetPlaybackConfigurationResponse' {Maybe Text
playbackEndpointPrefix :: Maybe Text
$sel:playbackEndpointPrefix:GetPlaybackConfigurationResponse' :: GetPlaybackConfigurationResponse -> Maybe Text
playbackEndpointPrefix} -> Maybe Text
playbackEndpointPrefix) (\s :: GetPlaybackConfigurationResponse
s@GetPlaybackConfigurationResponse' {} Maybe Text
a -> GetPlaybackConfigurationResponse
s {$sel:playbackEndpointPrefix:GetPlaybackConfigurationResponse' :: Maybe Text
playbackEndpointPrefix = Maybe Text
a} :: GetPlaybackConfigurationResponse)

-- | The URL that the player uses to initialize a session that uses
-- client-side reporting.
getPlaybackConfigurationResponse_sessionInitializationEndpointPrefix :: Lens.Lens' GetPlaybackConfigurationResponse (Prelude.Maybe Prelude.Text)
getPlaybackConfigurationResponse_sessionInitializationEndpointPrefix :: Lens' GetPlaybackConfigurationResponse (Maybe Text)
getPlaybackConfigurationResponse_sessionInitializationEndpointPrefix = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetPlaybackConfigurationResponse' {Maybe Text
sessionInitializationEndpointPrefix :: Maybe Text
$sel:sessionInitializationEndpointPrefix:GetPlaybackConfigurationResponse' :: GetPlaybackConfigurationResponse -> Maybe Text
sessionInitializationEndpointPrefix} -> Maybe Text
sessionInitializationEndpointPrefix) (\s :: GetPlaybackConfigurationResponse
s@GetPlaybackConfigurationResponse' {} Maybe Text
a -> GetPlaybackConfigurationResponse
s {$sel:sessionInitializationEndpointPrefix:GetPlaybackConfigurationResponse' :: Maybe Text
sessionInitializationEndpointPrefix = Maybe Text
a} :: GetPlaybackConfigurationResponse)

-- | The URL for a high-quality video asset to transcode and use to fill in
-- time that\'s not used by ads. AWS Elemental MediaTailor shows the slate
-- to fill in gaps in media content. Configuring the slate is optional for
-- non-VPAID playback configurations. For VPAID, the slate is required
-- because MediaTailor provides it in the slots designated for dynamic ad
-- content. The slate must be a high-quality asset that contains both audio
-- and video.
getPlaybackConfigurationResponse_slateAdUrl :: Lens.Lens' GetPlaybackConfigurationResponse (Prelude.Maybe Prelude.Text)
getPlaybackConfigurationResponse_slateAdUrl :: Lens' GetPlaybackConfigurationResponse (Maybe Text)
getPlaybackConfigurationResponse_slateAdUrl = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetPlaybackConfigurationResponse' {Maybe Text
slateAdUrl :: Maybe Text
$sel:slateAdUrl:GetPlaybackConfigurationResponse' :: GetPlaybackConfigurationResponse -> Maybe Text
slateAdUrl} -> Maybe Text
slateAdUrl) (\s :: GetPlaybackConfigurationResponse
s@GetPlaybackConfigurationResponse' {} Maybe Text
a -> GetPlaybackConfigurationResponse
s {$sel:slateAdUrl:GetPlaybackConfigurationResponse' :: Maybe Text
slateAdUrl = Maybe Text
a} :: GetPlaybackConfigurationResponse)

-- | The tags assigned to the playback configuration. Tags are key-value
-- pairs that you can associate with Amazon resources to help with
-- organization, access control, and cost tracking. For more information,
-- see
-- <https://docs.aws.amazon.com/mediatailor/latest/ug/tagging.html Tagging AWS Elemental MediaTailor Resources>.
getPlaybackConfigurationResponse_tags :: Lens.Lens' GetPlaybackConfigurationResponse (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
getPlaybackConfigurationResponse_tags :: Lens' GetPlaybackConfigurationResponse (Maybe (HashMap Text Text))
getPlaybackConfigurationResponse_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetPlaybackConfigurationResponse' {Maybe (HashMap Text Text)
tags :: Maybe (HashMap Text Text)
$sel:tags:GetPlaybackConfigurationResponse' :: GetPlaybackConfigurationResponse -> Maybe (HashMap Text Text)
tags} -> Maybe (HashMap Text Text)
tags) (\s :: GetPlaybackConfigurationResponse
s@GetPlaybackConfigurationResponse' {} Maybe (HashMap Text Text)
a -> GetPlaybackConfigurationResponse
s {$sel:tags:GetPlaybackConfigurationResponse' :: Maybe (HashMap Text Text)
tags = Maybe (HashMap Text Text)
a} :: GetPlaybackConfigurationResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | The name that is used to associate this playback configuration with a
-- custom transcode profile. This overrides the dynamic transcoding
-- defaults of MediaTailor. Use this only if you have already set up custom
-- profiles with the help of AWS Support.
getPlaybackConfigurationResponse_transcodeProfileName :: Lens.Lens' GetPlaybackConfigurationResponse (Prelude.Maybe Prelude.Text)
getPlaybackConfigurationResponse_transcodeProfileName :: Lens' GetPlaybackConfigurationResponse (Maybe Text)
getPlaybackConfigurationResponse_transcodeProfileName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetPlaybackConfigurationResponse' {Maybe Text
transcodeProfileName :: Maybe Text
$sel:transcodeProfileName:GetPlaybackConfigurationResponse' :: GetPlaybackConfigurationResponse -> Maybe Text
transcodeProfileName} -> Maybe Text
transcodeProfileName) (\s :: GetPlaybackConfigurationResponse
s@GetPlaybackConfigurationResponse' {} Maybe Text
a -> GetPlaybackConfigurationResponse
s {$sel:transcodeProfileName:GetPlaybackConfigurationResponse' :: Maybe Text
transcodeProfileName = Maybe Text
a} :: GetPlaybackConfigurationResponse)

-- | The URL prefix for the parent manifest for the stream, minus the asset
-- ID. The maximum length is 512 characters.
getPlaybackConfigurationResponse_videoContentSourceUrl :: Lens.Lens' GetPlaybackConfigurationResponse (Prelude.Maybe Prelude.Text)
getPlaybackConfigurationResponse_videoContentSourceUrl :: Lens' GetPlaybackConfigurationResponse (Maybe Text)
getPlaybackConfigurationResponse_videoContentSourceUrl = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetPlaybackConfigurationResponse' {Maybe Text
videoContentSourceUrl :: Maybe Text
$sel:videoContentSourceUrl:GetPlaybackConfigurationResponse' :: GetPlaybackConfigurationResponse -> Maybe Text
videoContentSourceUrl} -> Maybe Text
videoContentSourceUrl) (\s :: GetPlaybackConfigurationResponse
s@GetPlaybackConfigurationResponse' {} Maybe Text
a -> GetPlaybackConfigurationResponse
s {$sel:videoContentSourceUrl:GetPlaybackConfigurationResponse' :: Maybe Text
videoContentSourceUrl = Maybe Text
a} :: GetPlaybackConfigurationResponse)

-- | The response's http status code.
getPlaybackConfigurationResponse_httpStatus :: Lens.Lens' GetPlaybackConfigurationResponse Prelude.Int
getPlaybackConfigurationResponse_httpStatus :: Lens' GetPlaybackConfigurationResponse Int
getPlaybackConfigurationResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetPlaybackConfigurationResponse' {Int
httpStatus :: Int
$sel:httpStatus:GetPlaybackConfigurationResponse' :: GetPlaybackConfigurationResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: GetPlaybackConfigurationResponse
s@GetPlaybackConfigurationResponse' {} Int
a -> GetPlaybackConfigurationResponse
s {$sel:httpStatus:GetPlaybackConfigurationResponse' :: Int
httpStatus = Int
a} :: GetPlaybackConfigurationResponse)

instance
  Prelude.NFData
    GetPlaybackConfigurationResponse
  where
  rnf :: GetPlaybackConfigurationResponse -> ()
rnf GetPlaybackConfigurationResponse' {Int
Maybe Natural
Maybe Text
Maybe (HashMap Text Text)
Maybe (HashMap Text (HashMap Text Text))
Maybe Bumper
Maybe CdnConfiguration
Maybe HlsConfiguration
Maybe LivePreRollConfiguration
Maybe LogConfiguration
Maybe ManifestProcessingRules
Maybe AvailSuppression
Maybe DashConfiguration
httpStatus :: Int
videoContentSourceUrl :: Maybe Text
transcodeProfileName :: Maybe Text
tags :: Maybe (HashMap Text Text)
slateAdUrl :: Maybe Text
sessionInitializationEndpointPrefix :: Maybe Text
playbackEndpointPrefix :: Maybe Text
playbackConfigurationArn :: Maybe Text
personalizationThresholdSeconds :: Maybe Natural
name :: Maybe Text
manifestProcessingRules :: Maybe ManifestProcessingRules
logConfiguration :: Maybe LogConfiguration
livePreRollConfiguration :: Maybe LivePreRollConfiguration
hlsConfiguration :: Maybe HlsConfiguration
dashConfiguration :: Maybe DashConfiguration
configurationAliases :: Maybe (HashMap Text (HashMap Text Text))
cdnConfiguration :: Maybe CdnConfiguration
bumper :: Maybe Bumper
availSuppression :: Maybe AvailSuppression
adDecisionServerUrl :: Maybe Text
$sel:httpStatus:GetPlaybackConfigurationResponse' :: GetPlaybackConfigurationResponse -> Int
$sel:videoContentSourceUrl:GetPlaybackConfigurationResponse' :: GetPlaybackConfigurationResponse -> Maybe Text
$sel:transcodeProfileName:GetPlaybackConfigurationResponse' :: GetPlaybackConfigurationResponse -> Maybe Text
$sel:tags:GetPlaybackConfigurationResponse' :: GetPlaybackConfigurationResponse -> Maybe (HashMap Text Text)
$sel:slateAdUrl:GetPlaybackConfigurationResponse' :: GetPlaybackConfigurationResponse -> Maybe Text
$sel:sessionInitializationEndpointPrefix:GetPlaybackConfigurationResponse' :: GetPlaybackConfigurationResponse -> Maybe Text
$sel:playbackEndpointPrefix:GetPlaybackConfigurationResponse' :: GetPlaybackConfigurationResponse -> Maybe Text
$sel:playbackConfigurationArn:GetPlaybackConfigurationResponse' :: GetPlaybackConfigurationResponse -> Maybe Text
$sel:personalizationThresholdSeconds:GetPlaybackConfigurationResponse' :: GetPlaybackConfigurationResponse -> Maybe Natural
$sel:name:GetPlaybackConfigurationResponse' :: GetPlaybackConfigurationResponse -> Maybe Text
$sel:manifestProcessingRules:GetPlaybackConfigurationResponse' :: GetPlaybackConfigurationResponse -> Maybe ManifestProcessingRules
$sel:logConfiguration:GetPlaybackConfigurationResponse' :: GetPlaybackConfigurationResponse -> Maybe LogConfiguration
$sel:livePreRollConfiguration:GetPlaybackConfigurationResponse' :: GetPlaybackConfigurationResponse -> Maybe LivePreRollConfiguration
$sel:hlsConfiguration:GetPlaybackConfigurationResponse' :: GetPlaybackConfigurationResponse -> Maybe HlsConfiguration
$sel:dashConfiguration:GetPlaybackConfigurationResponse' :: GetPlaybackConfigurationResponse -> Maybe DashConfiguration
$sel:configurationAliases:GetPlaybackConfigurationResponse' :: GetPlaybackConfigurationResponse
-> Maybe (HashMap Text (HashMap Text Text))
$sel:cdnConfiguration:GetPlaybackConfigurationResponse' :: GetPlaybackConfigurationResponse -> Maybe CdnConfiguration
$sel:bumper:GetPlaybackConfigurationResponse' :: GetPlaybackConfigurationResponse -> Maybe Bumper
$sel:availSuppression:GetPlaybackConfigurationResponse' :: GetPlaybackConfigurationResponse -> Maybe AvailSuppression
$sel:adDecisionServerUrl:GetPlaybackConfigurationResponse' :: GetPlaybackConfigurationResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
adDecisionServerUrl
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe AvailSuppression
availSuppression
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bumper
bumper
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe CdnConfiguration
cdnConfiguration
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text (HashMap Text Text))
configurationAliases
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe DashConfiguration
dashConfiguration
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe HlsConfiguration
hlsConfiguration
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe LivePreRollConfiguration
livePreRollConfiguration
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe LogConfiguration
logConfiguration
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ManifestProcessingRules
manifestProcessingRules
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
name
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
personalizationThresholdSeconds
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
playbackConfigurationArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
playbackEndpointPrefix
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        Maybe Text
sessionInitializationEndpointPrefix
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
slateAdUrl
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text Text)
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
transcodeProfileName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        Maybe Text
videoContentSourceUrl
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus