{-# 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.MediaLive.Types.AudioOnlyHlsSettings
-- 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.MediaLive.Types.AudioOnlyHlsSettings where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.MediaLive.Types.AudioOnlyHlsSegmentType
import Amazonka.MediaLive.Types.AudioOnlyHlsTrackType
import Amazonka.MediaLive.Types.InputLocation
import qualified Amazonka.Prelude as Prelude

-- | Audio Only Hls Settings
--
-- /See:/ 'newAudioOnlyHlsSettings' smart constructor.
data AudioOnlyHlsSettings = AudioOnlyHlsSettings'
  { -- | Specifies the group to which the audio Rendition belongs.
    AudioOnlyHlsSettings -> Maybe Text
audioGroupId :: Prelude.Maybe Prelude.Text,
    -- | Optional. Specifies the .jpg or .png image to use as the cover art for
    -- an audio-only output. We recommend a low bit-size file because the image
    -- increases the output audio bandwidth. The image is attached to the audio
    -- as an ID3 tag, frame type APIC, picture type 0x10, as per the \"ID3 tag
    -- version 2.4.0 - Native Frames\" standard.
    AudioOnlyHlsSettings -> Maybe InputLocation
audioOnlyImage :: Prelude.Maybe InputLocation,
    -- | Four types of audio-only tracks are supported: Audio-Only Variant Stream
    -- The client can play back this audio-only stream instead of video in
    -- low-bandwidth scenarios. Represented as an EXT-X-STREAM-INF in the HLS
    -- manifest. Alternate Audio, Auto Select, Default Alternate rendition that
    -- the client should try to play back by default. Represented as an
    -- EXT-X-MEDIA in the HLS manifest with DEFAULT=YES, AUTOSELECT=YES
    -- Alternate Audio, Auto Select, Not Default Alternate rendition that the
    -- client may try to play back by default. Represented as an EXT-X-MEDIA in
    -- the HLS manifest with DEFAULT=NO, AUTOSELECT=YES Alternate Audio, not
    -- Auto Select Alternate rendition that the client will not try to play
    -- back by default. Represented as an EXT-X-MEDIA in the HLS manifest with
    -- DEFAULT=NO, AUTOSELECT=NO
    AudioOnlyHlsSettings -> Maybe AudioOnlyHlsTrackType
audioTrackType :: Prelude.Maybe AudioOnlyHlsTrackType,
    -- | Specifies the segment type.
    AudioOnlyHlsSettings -> Maybe AudioOnlyHlsSegmentType
segmentType :: Prelude.Maybe AudioOnlyHlsSegmentType
  }
  deriving (AudioOnlyHlsSettings -> AudioOnlyHlsSettings -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AudioOnlyHlsSettings -> AudioOnlyHlsSettings -> Bool
$c/= :: AudioOnlyHlsSettings -> AudioOnlyHlsSettings -> Bool
== :: AudioOnlyHlsSettings -> AudioOnlyHlsSettings -> Bool
$c== :: AudioOnlyHlsSettings -> AudioOnlyHlsSettings -> Bool
Prelude.Eq, ReadPrec [AudioOnlyHlsSettings]
ReadPrec AudioOnlyHlsSettings
Int -> ReadS AudioOnlyHlsSettings
ReadS [AudioOnlyHlsSettings]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AudioOnlyHlsSettings]
$creadListPrec :: ReadPrec [AudioOnlyHlsSettings]
readPrec :: ReadPrec AudioOnlyHlsSettings
$creadPrec :: ReadPrec AudioOnlyHlsSettings
readList :: ReadS [AudioOnlyHlsSettings]
$creadList :: ReadS [AudioOnlyHlsSettings]
readsPrec :: Int -> ReadS AudioOnlyHlsSettings
$creadsPrec :: Int -> ReadS AudioOnlyHlsSettings
Prelude.Read, Int -> AudioOnlyHlsSettings -> ShowS
[AudioOnlyHlsSettings] -> ShowS
AudioOnlyHlsSettings -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AudioOnlyHlsSettings] -> ShowS
$cshowList :: [AudioOnlyHlsSettings] -> ShowS
show :: AudioOnlyHlsSettings -> String
$cshow :: AudioOnlyHlsSettings -> String
showsPrec :: Int -> AudioOnlyHlsSettings -> ShowS
$cshowsPrec :: Int -> AudioOnlyHlsSettings -> ShowS
Prelude.Show, forall x. Rep AudioOnlyHlsSettings x -> AudioOnlyHlsSettings
forall x. AudioOnlyHlsSettings -> Rep AudioOnlyHlsSettings x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AudioOnlyHlsSettings x -> AudioOnlyHlsSettings
$cfrom :: forall x. AudioOnlyHlsSettings -> Rep AudioOnlyHlsSettings x
Prelude.Generic)

-- |
-- Create a value of 'AudioOnlyHlsSettings' 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:
--
-- 'audioGroupId', 'audioOnlyHlsSettings_audioGroupId' - Specifies the group to which the audio Rendition belongs.
--
-- 'audioOnlyImage', 'audioOnlyHlsSettings_audioOnlyImage' - Optional. Specifies the .jpg or .png image to use as the cover art for
-- an audio-only output. We recommend a low bit-size file because the image
-- increases the output audio bandwidth. The image is attached to the audio
-- as an ID3 tag, frame type APIC, picture type 0x10, as per the \"ID3 tag
-- version 2.4.0 - Native Frames\" standard.
--
-- 'audioTrackType', 'audioOnlyHlsSettings_audioTrackType' - Four types of audio-only tracks are supported: Audio-Only Variant Stream
-- The client can play back this audio-only stream instead of video in
-- low-bandwidth scenarios. Represented as an EXT-X-STREAM-INF in the HLS
-- manifest. Alternate Audio, Auto Select, Default Alternate rendition that
-- the client should try to play back by default. Represented as an
-- EXT-X-MEDIA in the HLS manifest with DEFAULT=YES, AUTOSELECT=YES
-- Alternate Audio, Auto Select, Not Default Alternate rendition that the
-- client may try to play back by default. Represented as an EXT-X-MEDIA in
-- the HLS manifest with DEFAULT=NO, AUTOSELECT=YES Alternate Audio, not
-- Auto Select Alternate rendition that the client will not try to play
-- back by default. Represented as an EXT-X-MEDIA in the HLS manifest with
-- DEFAULT=NO, AUTOSELECT=NO
--
-- 'segmentType', 'audioOnlyHlsSettings_segmentType' - Specifies the segment type.
newAudioOnlyHlsSettings ::
  AudioOnlyHlsSettings
newAudioOnlyHlsSettings :: AudioOnlyHlsSettings
newAudioOnlyHlsSettings =
  AudioOnlyHlsSettings'
    { $sel:audioGroupId:AudioOnlyHlsSettings' :: Maybe Text
audioGroupId =
        forall a. Maybe a
Prelude.Nothing,
      $sel:audioOnlyImage:AudioOnlyHlsSettings' :: Maybe InputLocation
audioOnlyImage = forall a. Maybe a
Prelude.Nothing,
      $sel:audioTrackType:AudioOnlyHlsSettings' :: Maybe AudioOnlyHlsTrackType
audioTrackType = forall a. Maybe a
Prelude.Nothing,
      $sel:segmentType:AudioOnlyHlsSettings' :: Maybe AudioOnlyHlsSegmentType
segmentType = forall a. Maybe a
Prelude.Nothing
    }

-- | Specifies the group to which the audio Rendition belongs.
audioOnlyHlsSettings_audioGroupId :: Lens.Lens' AudioOnlyHlsSettings (Prelude.Maybe Prelude.Text)
audioOnlyHlsSettings_audioGroupId :: Lens' AudioOnlyHlsSettings (Maybe Text)
audioOnlyHlsSettings_audioGroupId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AudioOnlyHlsSettings' {Maybe Text
audioGroupId :: Maybe Text
$sel:audioGroupId:AudioOnlyHlsSettings' :: AudioOnlyHlsSettings -> Maybe Text
audioGroupId} -> Maybe Text
audioGroupId) (\s :: AudioOnlyHlsSettings
s@AudioOnlyHlsSettings' {} Maybe Text
a -> AudioOnlyHlsSettings
s {$sel:audioGroupId:AudioOnlyHlsSettings' :: Maybe Text
audioGroupId = Maybe Text
a} :: AudioOnlyHlsSettings)

-- | Optional. Specifies the .jpg or .png image to use as the cover art for
-- an audio-only output. We recommend a low bit-size file because the image
-- increases the output audio bandwidth. The image is attached to the audio
-- as an ID3 tag, frame type APIC, picture type 0x10, as per the \"ID3 tag
-- version 2.4.0 - Native Frames\" standard.
audioOnlyHlsSettings_audioOnlyImage :: Lens.Lens' AudioOnlyHlsSettings (Prelude.Maybe InputLocation)
audioOnlyHlsSettings_audioOnlyImage :: Lens' AudioOnlyHlsSettings (Maybe InputLocation)
audioOnlyHlsSettings_audioOnlyImage = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AudioOnlyHlsSettings' {Maybe InputLocation
audioOnlyImage :: Maybe InputLocation
$sel:audioOnlyImage:AudioOnlyHlsSettings' :: AudioOnlyHlsSettings -> Maybe InputLocation
audioOnlyImage} -> Maybe InputLocation
audioOnlyImage) (\s :: AudioOnlyHlsSettings
s@AudioOnlyHlsSettings' {} Maybe InputLocation
a -> AudioOnlyHlsSettings
s {$sel:audioOnlyImage:AudioOnlyHlsSettings' :: Maybe InputLocation
audioOnlyImage = Maybe InputLocation
a} :: AudioOnlyHlsSettings)

-- | Four types of audio-only tracks are supported: Audio-Only Variant Stream
-- The client can play back this audio-only stream instead of video in
-- low-bandwidth scenarios. Represented as an EXT-X-STREAM-INF in the HLS
-- manifest. Alternate Audio, Auto Select, Default Alternate rendition that
-- the client should try to play back by default. Represented as an
-- EXT-X-MEDIA in the HLS manifest with DEFAULT=YES, AUTOSELECT=YES
-- Alternate Audio, Auto Select, Not Default Alternate rendition that the
-- client may try to play back by default. Represented as an EXT-X-MEDIA in
-- the HLS manifest with DEFAULT=NO, AUTOSELECT=YES Alternate Audio, not
-- Auto Select Alternate rendition that the client will not try to play
-- back by default. Represented as an EXT-X-MEDIA in the HLS manifest with
-- DEFAULT=NO, AUTOSELECT=NO
audioOnlyHlsSettings_audioTrackType :: Lens.Lens' AudioOnlyHlsSettings (Prelude.Maybe AudioOnlyHlsTrackType)
audioOnlyHlsSettings_audioTrackType :: Lens' AudioOnlyHlsSettings (Maybe AudioOnlyHlsTrackType)
audioOnlyHlsSettings_audioTrackType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AudioOnlyHlsSettings' {Maybe AudioOnlyHlsTrackType
audioTrackType :: Maybe AudioOnlyHlsTrackType
$sel:audioTrackType:AudioOnlyHlsSettings' :: AudioOnlyHlsSettings -> Maybe AudioOnlyHlsTrackType
audioTrackType} -> Maybe AudioOnlyHlsTrackType
audioTrackType) (\s :: AudioOnlyHlsSettings
s@AudioOnlyHlsSettings' {} Maybe AudioOnlyHlsTrackType
a -> AudioOnlyHlsSettings
s {$sel:audioTrackType:AudioOnlyHlsSettings' :: Maybe AudioOnlyHlsTrackType
audioTrackType = Maybe AudioOnlyHlsTrackType
a} :: AudioOnlyHlsSettings)

-- | Specifies the segment type.
audioOnlyHlsSettings_segmentType :: Lens.Lens' AudioOnlyHlsSettings (Prelude.Maybe AudioOnlyHlsSegmentType)
audioOnlyHlsSettings_segmentType :: Lens' AudioOnlyHlsSettings (Maybe AudioOnlyHlsSegmentType)
audioOnlyHlsSettings_segmentType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AudioOnlyHlsSettings' {Maybe AudioOnlyHlsSegmentType
segmentType :: Maybe AudioOnlyHlsSegmentType
$sel:segmentType:AudioOnlyHlsSettings' :: AudioOnlyHlsSettings -> Maybe AudioOnlyHlsSegmentType
segmentType} -> Maybe AudioOnlyHlsSegmentType
segmentType) (\s :: AudioOnlyHlsSettings
s@AudioOnlyHlsSettings' {} Maybe AudioOnlyHlsSegmentType
a -> AudioOnlyHlsSettings
s {$sel:segmentType:AudioOnlyHlsSettings' :: Maybe AudioOnlyHlsSegmentType
segmentType = Maybe AudioOnlyHlsSegmentType
a} :: AudioOnlyHlsSettings)

instance Data.FromJSON AudioOnlyHlsSettings where
  parseJSON :: Value -> Parser AudioOnlyHlsSettings
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"AudioOnlyHlsSettings"
      ( \Object
x ->
          Maybe Text
-> Maybe InputLocation
-> Maybe AudioOnlyHlsTrackType
-> Maybe AudioOnlyHlsSegmentType
-> AudioOnlyHlsSettings
AudioOnlyHlsSettings'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"audioGroupId")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"audioOnlyImage")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"audioTrackType")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"segmentType")
      )

instance Prelude.Hashable AudioOnlyHlsSettings where
  hashWithSalt :: Int -> AudioOnlyHlsSettings -> Int
hashWithSalt Int
_salt AudioOnlyHlsSettings' {Maybe Text
Maybe AudioOnlyHlsSegmentType
Maybe AudioOnlyHlsTrackType
Maybe InputLocation
segmentType :: Maybe AudioOnlyHlsSegmentType
audioTrackType :: Maybe AudioOnlyHlsTrackType
audioOnlyImage :: Maybe InputLocation
audioGroupId :: Maybe Text
$sel:segmentType:AudioOnlyHlsSettings' :: AudioOnlyHlsSettings -> Maybe AudioOnlyHlsSegmentType
$sel:audioTrackType:AudioOnlyHlsSettings' :: AudioOnlyHlsSettings -> Maybe AudioOnlyHlsTrackType
$sel:audioOnlyImage:AudioOnlyHlsSettings' :: AudioOnlyHlsSettings -> Maybe InputLocation
$sel:audioGroupId:AudioOnlyHlsSettings' :: AudioOnlyHlsSettings -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
audioGroupId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe InputLocation
audioOnlyImage
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe AudioOnlyHlsTrackType
audioTrackType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe AudioOnlyHlsSegmentType
segmentType

instance Prelude.NFData AudioOnlyHlsSettings where
  rnf :: AudioOnlyHlsSettings -> ()
rnf AudioOnlyHlsSettings' {Maybe Text
Maybe AudioOnlyHlsSegmentType
Maybe AudioOnlyHlsTrackType
Maybe InputLocation
segmentType :: Maybe AudioOnlyHlsSegmentType
audioTrackType :: Maybe AudioOnlyHlsTrackType
audioOnlyImage :: Maybe InputLocation
audioGroupId :: Maybe Text
$sel:segmentType:AudioOnlyHlsSettings' :: AudioOnlyHlsSettings -> Maybe AudioOnlyHlsSegmentType
$sel:audioTrackType:AudioOnlyHlsSettings' :: AudioOnlyHlsSettings -> Maybe AudioOnlyHlsTrackType
$sel:audioOnlyImage:AudioOnlyHlsSettings' :: AudioOnlyHlsSettings -> Maybe InputLocation
$sel:audioGroupId:AudioOnlyHlsSettings' :: AudioOnlyHlsSettings -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
audioGroupId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe InputLocation
audioOnlyImage
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe AudioOnlyHlsTrackType
audioTrackType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe AudioOnlyHlsSegmentType
segmentType

instance Data.ToJSON AudioOnlyHlsSettings where
  toJSON :: AudioOnlyHlsSettings -> Value
toJSON AudioOnlyHlsSettings' {Maybe Text
Maybe AudioOnlyHlsSegmentType
Maybe AudioOnlyHlsTrackType
Maybe InputLocation
segmentType :: Maybe AudioOnlyHlsSegmentType
audioTrackType :: Maybe AudioOnlyHlsTrackType
audioOnlyImage :: Maybe InputLocation
audioGroupId :: Maybe Text
$sel:segmentType:AudioOnlyHlsSettings' :: AudioOnlyHlsSettings -> Maybe AudioOnlyHlsSegmentType
$sel:audioTrackType:AudioOnlyHlsSettings' :: AudioOnlyHlsSettings -> Maybe AudioOnlyHlsTrackType
$sel:audioOnlyImage:AudioOnlyHlsSettings' :: AudioOnlyHlsSettings -> Maybe InputLocation
$sel:audioGroupId:AudioOnlyHlsSettings' :: AudioOnlyHlsSettings -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"audioGroupId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
audioGroupId,
            (Key
"audioOnlyImage" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe InputLocation
audioOnlyImage,
            (Key
"audioTrackType" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe AudioOnlyHlsTrackType
audioTrackType,
            (Key
"segmentType" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe AudioOnlyHlsSegmentType
segmentType
          ]
      )