{-# 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.MediaConvert.Types.Mp4Settings
-- 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.MediaConvert.Types.Mp4Settings where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.MediaConvert.Types.CmfcAudioDuration
import Amazonka.MediaConvert.Types.Mp4CslgAtom
import Amazonka.MediaConvert.Types.Mp4FreeSpaceBox
import Amazonka.MediaConvert.Types.Mp4MoovPlacement
import qualified Amazonka.Prelude as Prelude

-- | These settings relate to your MP4 output container. You can create audio
-- only outputs with this container. For more information, see
-- https:\/\/docs.aws.amazon.com\/mediaconvert\/latest\/ug\/supported-codecs-containers-audio-only.html#output-codecs-and-containers-supported-for-audio-only.
--
-- /See:/ 'newMp4Settings' smart constructor.
data Mp4Settings = Mp4Settings'
  { -- | Specify this setting only when your output will be consumed by a
    -- downstream repackaging workflow that is sensitive to very small duration
    -- differences between video and audio. For this situation, choose Match
    -- video duration (MATCH_VIDEO_DURATION). In all other cases, keep the
    -- default value, Default codec duration (DEFAULT_CODEC_DURATION). When you
    -- choose Match video duration, MediaConvert pads the output audio streams
    -- with silence or trims them to ensure that the total duration of each
    -- audio stream is at least as long as the total duration of the video
    -- stream. After padding or trimming, the audio stream duration is no more
    -- than one frame longer than the video stream. MediaConvert applies audio
    -- padding or trimming only to the end of the last segment of the output.
    -- For unsegmented outputs, MediaConvert adds padding only to the end of
    -- the file. When you keep the default value, any minor discrepancies
    -- between audio and video duration will depend on your output audio codec.
    Mp4Settings -> Maybe CmfcAudioDuration
audioDuration :: Prelude.Maybe CmfcAudioDuration,
    -- | When enabled, file composition times will start at zero, composition
    -- times in the \'ctts\' (composition time to sample) box for B-frames will
    -- be negative, and a \'cslg\' (composition shift least greatest) box will
    -- be included per 14496-1 amendment 1. This improves compatibility with
    -- Apple players and tools.
    Mp4Settings -> Maybe Mp4CslgAtom
cslgAtom :: Prelude.Maybe Mp4CslgAtom,
    -- | Ignore this setting unless compliance to the CTTS box version
    -- specification matters in your workflow. Specify a value of 1 to set your
    -- CTTS box version to 1 and make your output compliant with the
    -- specification. When you specify a value of 1, you must also set CSLG
    -- atom (cslgAtom) to the value INCLUDE. Keep the default value 0 to set
    -- your CTTS box version to 0. This can provide backward compatibility for
    -- some players and packagers.
    Mp4Settings -> Maybe Natural
cttsVersion :: Prelude.Maybe Prelude.Natural,
    -- | Inserts a free-space box immediately after the moov box.
    Mp4Settings -> Maybe Mp4FreeSpaceBox
freeSpaceBox :: Prelude.Maybe Mp4FreeSpaceBox,
    -- | If set to PROGRESSIVE_DOWNLOAD, the MOOV atom is relocated to the
    -- beginning of the archive as required for progressive downloading.
    -- Otherwise it is placed normally at the end.
    Mp4Settings -> Maybe Mp4MoovPlacement
moovPlacement :: Prelude.Maybe Mp4MoovPlacement,
    -- | Overrides the \"Major Brand\" field in the output file. Usually not
    -- necessary to specify.
    Mp4Settings -> Maybe Text
mp4MajorBrand :: Prelude.Maybe Prelude.Text
  }
  deriving (Mp4Settings -> Mp4Settings -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Mp4Settings -> Mp4Settings -> Bool
$c/= :: Mp4Settings -> Mp4Settings -> Bool
== :: Mp4Settings -> Mp4Settings -> Bool
$c== :: Mp4Settings -> Mp4Settings -> Bool
Prelude.Eq, ReadPrec [Mp4Settings]
ReadPrec Mp4Settings
Int -> ReadS Mp4Settings
ReadS [Mp4Settings]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Mp4Settings]
$creadListPrec :: ReadPrec [Mp4Settings]
readPrec :: ReadPrec Mp4Settings
$creadPrec :: ReadPrec Mp4Settings
readList :: ReadS [Mp4Settings]
$creadList :: ReadS [Mp4Settings]
readsPrec :: Int -> ReadS Mp4Settings
$creadsPrec :: Int -> ReadS Mp4Settings
Prelude.Read, Int -> Mp4Settings -> ShowS
[Mp4Settings] -> ShowS
Mp4Settings -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Mp4Settings] -> ShowS
$cshowList :: [Mp4Settings] -> ShowS
show :: Mp4Settings -> String
$cshow :: Mp4Settings -> String
showsPrec :: Int -> Mp4Settings -> ShowS
$cshowsPrec :: Int -> Mp4Settings -> ShowS
Prelude.Show, forall x. Rep Mp4Settings x -> Mp4Settings
forall x. Mp4Settings -> Rep Mp4Settings x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Mp4Settings x -> Mp4Settings
$cfrom :: forall x. Mp4Settings -> Rep Mp4Settings x
Prelude.Generic)

-- |
-- Create a value of 'Mp4Settings' 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:
--
-- 'audioDuration', 'mp4Settings_audioDuration' - Specify this setting only when your output will be consumed by a
-- downstream repackaging workflow that is sensitive to very small duration
-- differences between video and audio. For this situation, choose Match
-- video duration (MATCH_VIDEO_DURATION). In all other cases, keep the
-- default value, Default codec duration (DEFAULT_CODEC_DURATION). When you
-- choose Match video duration, MediaConvert pads the output audio streams
-- with silence or trims them to ensure that the total duration of each
-- audio stream is at least as long as the total duration of the video
-- stream. After padding or trimming, the audio stream duration is no more
-- than one frame longer than the video stream. MediaConvert applies audio
-- padding or trimming only to the end of the last segment of the output.
-- For unsegmented outputs, MediaConvert adds padding only to the end of
-- the file. When you keep the default value, any minor discrepancies
-- between audio and video duration will depend on your output audio codec.
--
-- 'cslgAtom', 'mp4Settings_cslgAtom' - When enabled, file composition times will start at zero, composition
-- times in the \'ctts\' (composition time to sample) box for B-frames will
-- be negative, and a \'cslg\' (composition shift least greatest) box will
-- be included per 14496-1 amendment 1. This improves compatibility with
-- Apple players and tools.
--
-- 'cttsVersion', 'mp4Settings_cttsVersion' - Ignore this setting unless compliance to the CTTS box version
-- specification matters in your workflow. Specify a value of 1 to set your
-- CTTS box version to 1 and make your output compliant with the
-- specification. When you specify a value of 1, you must also set CSLG
-- atom (cslgAtom) to the value INCLUDE. Keep the default value 0 to set
-- your CTTS box version to 0. This can provide backward compatibility for
-- some players and packagers.
--
-- 'freeSpaceBox', 'mp4Settings_freeSpaceBox' - Inserts a free-space box immediately after the moov box.
--
-- 'moovPlacement', 'mp4Settings_moovPlacement' - If set to PROGRESSIVE_DOWNLOAD, the MOOV atom is relocated to the
-- beginning of the archive as required for progressive downloading.
-- Otherwise it is placed normally at the end.
--
-- 'mp4MajorBrand', 'mp4Settings_mp4MajorBrand' - Overrides the \"Major Brand\" field in the output file. Usually not
-- necessary to specify.
newMp4Settings ::
  Mp4Settings
newMp4Settings :: Mp4Settings
newMp4Settings =
  Mp4Settings'
    { $sel:audioDuration:Mp4Settings' :: Maybe CmfcAudioDuration
audioDuration = forall a. Maybe a
Prelude.Nothing,
      $sel:cslgAtom:Mp4Settings' :: Maybe Mp4CslgAtom
cslgAtom = forall a. Maybe a
Prelude.Nothing,
      $sel:cttsVersion:Mp4Settings' :: Maybe Natural
cttsVersion = forall a. Maybe a
Prelude.Nothing,
      $sel:freeSpaceBox:Mp4Settings' :: Maybe Mp4FreeSpaceBox
freeSpaceBox = forall a. Maybe a
Prelude.Nothing,
      $sel:moovPlacement:Mp4Settings' :: Maybe Mp4MoovPlacement
moovPlacement = forall a. Maybe a
Prelude.Nothing,
      $sel:mp4MajorBrand:Mp4Settings' :: Maybe Text
mp4MajorBrand = forall a. Maybe a
Prelude.Nothing
    }

-- | Specify this setting only when your output will be consumed by a
-- downstream repackaging workflow that is sensitive to very small duration
-- differences between video and audio. For this situation, choose Match
-- video duration (MATCH_VIDEO_DURATION). In all other cases, keep the
-- default value, Default codec duration (DEFAULT_CODEC_DURATION). When you
-- choose Match video duration, MediaConvert pads the output audio streams
-- with silence or trims them to ensure that the total duration of each
-- audio stream is at least as long as the total duration of the video
-- stream. After padding or trimming, the audio stream duration is no more
-- than one frame longer than the video stream. MediaConvert applies audio
-- padding or trimming only to the end of the last segment of the output.
-- For unsegmented outputs, MediaConvert adds padding only to the end of
-- the file. When you keep the default value, any minor discrepancies
-- between audio and video duration will depend on your output audio codec.
mp4Settings_audioDuration :: Lens.Lens' Mp4Settings (Prelude.Maybe CmfcAudioDuration)
mp4Settings_audioDuration :: Lens' Mp4Settings (Maybe CmfcAudioDuration)
mp4Settings_audioDuration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Mp4Settings' {Maybe CmfcAudioDuration
audioDuration :: Maybe CmfcAudioDuration
$sel:audioDuration:Mp4Settings' :: Mp4Settings -> Maybe CmfcAudioDuration
audioDuration} -> Maybe CmfcAudioDuration
audioDuration) (\s :: Mp4Settings
s@Mp4Settings' {} Maybe CmfcAudioDuration
a -> Mp4Settings
s {$sel:audioDuration:Mp4Settings' :: Maybe CmfcAudioDuration
audioDuration = Maybe CmfcAudioDuration
a} :: Mp4Settings)

-- | When enabled, file composition times will start at zero, composition
-- times in the \'ctts\' (composition time to sample) box for B-frames will
-- be negative, and a \'cslg\' (composition shift least greatest) box will
-- be included per 14496-1 amendment 1. This improves compatibility with
-- Apple players and tools.
mp4Settings_cslgAtom :: Lens.Lens' Mp4Settings (Prelude.Maybe Mp4CslgAtom)
mp4Settings_cslgAtom :: Lens' Mp4Settings (Maybe Mp4CslgAtom)
mp4Settings_cslgAtom = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Mp4Settings' {Maybe Mp4CslgAtom
cslgAtom :: Maybe Mp4CslgAtom
$sel:cslgAtom:Mp4Settings' :: Mp4Settings -> Maybe Mp4CslgAtom
cslgAtom} -> Maybe Mp4CslgAtom
cslgAtom) (\s :: Mp4Settings
s@Mp4Settings' {} Maybe Mp4CslgAtom
a -> Mp4Settings
s {$sel:cslgAtom:Mp4Settings' :: Maybe Mp4CslgAtom
cslgAtom = Maybe Mp4CslgAtom
a} :: Mp4Settings)

-- | Ignore this setting unless compliance to the CTTS box version
-- specification matters in your workflow. Specify a value of 1 to set your
-- CTTS box version to 1 and make your output compliant with the
-- specification. When you specify a value of 1, you must also set CSLG
-- atom (cslgAtom) to the value INCLUDE. Keep the default value 0 to set
-- your CTTS box version to 0. This can provide backward compatibility for
-- some players and packagers.
mp4Settings_cttsVersion :: Lens.Lens' Mp4Settings (Prelude.Maybe Prelude.Natural)
mp4Settings_cttsVersion :: Lens' Mp4Settings (Maybe Natural)
mp4Settings_cttsVersion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Mp4Settings' {Maybe Natural
cttsVersion :: Maybe Natural
$sel:cttsVersion:Mp4Settings' :: Mp4Settings -> Maybe Natural
cttsVersion} -> Maybe Natural
cttsVersion) (\s :: Mp4Settings
s@Mp4Settings' {} Maybe Natural
a -> Mp4Settings
s {$sel:cttsVersion:Mp4Settings' :: Maybe Natural
cttsVersion = Maybe Natural
a} :: Mp4Settings)

-- | Inserts a free-space box immediately after the moov box.
mp4Settings_freeSpaceBox :: Lens.Lens' Mp4Settings (Prelude.Maybe Mp4FreeSpaceBox)
mp4Settings_freeSpaceBox :: Lens' Mp4Settings (Maybe Mp4FreeSpaceBox)
mp4Settings_freeSpaceBox = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Mp4Settings' {Maybe Mp4FreeSpaceBox
freeSpaceBox :: Maybe Mp4FreeSpaceBox
$sel:freeSpaceBox:Mp4Settings' :: Mp4Settings -> Maybe Mp4FreeSpaceBox
freeSpaceBox} -> Maybe Mp4FreeSpaceBox
freeSpaceBox) (\s :: Mp4Settings
s@Mp4Settings' {} Maybe Mp4FreeSpaceBox
a -> Mp4Settings
s {$sel:freeSpaceBox:Mp4Settings' :: Maybe Mp4FreeSpaceBox
freeSpaceBox = Maybe Mp4FreeSpaceBox
a} :: Mp4Settings)

-- | If set to PROGRESSIVE_DOWNLOAD, the MOOV atom is relocated to the
-- beginning of the archive as required for progressive downloading.
-- Otherwise it is placed normally at the end.
mp4Settings_moovPlacement :: Lens.Lens' Mp4Settings (Prelude.Maybe Mp4MoovPlacement)
mp4Settings_moovPlacement :: Lens' Mp4Settings (Maybe Mp4MoovPlacement)
mp4Settings_moovPlacement = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Mp4Settings' {Maybe Mp4MoovPlacement
moovPlacement :: Maybe Mp4MoovPlacement
$sel:moovPlacement:Mp4Settings' :: Mp4Settings -> Maybe Mp4MoovPlacement
moovPlacement} -> Maybe Mp4MoovPlacement
moovPlacement) (\s :: Mp4Settings
s@Mp4Settings' {} Maybe Mp4MoovPlacement
a -> Mp4Settings
s {$sel:moovPlacement:Mp4Settings' :: Maybe Mp4MoovPlacement
moovPlacement = Maybe Mp4MoovPlacement
a} :: Mp4Settings)

-- | Overrides the \"Major Brand\" field in the output file. Usually not
-- necessary to specify.
mp4Settings_mp4MajorBrand :: Lens.Lens' Mp4Settings (Prelude.Maybe Prelude.Text)
mp4Settings_mp4MajorBrand :: Lens' Mp4Settings (Maybe Text)
mp4Settings_mp4MajorBrand = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Mp4Settings' {Maybe Text
mp4MajorBrand :: Maybe Text
$sel:mp4MajorBrand:Mp4Settings' :: Mp4Settings -> Maybe Text
mp4MajorBrand} -> Maybe Text
mp4MajorBrand) (\s :: Mp4Settings
s@Mp4Settings' {} Maybe Text
a -> Mp4Settings
s {$sel:mp4MajorBrand:Mp4Settings' :: Maybe Text
mp4MajorBrand = Maybe Text
a} :: Mp4Settings)

instance Data.FromJSON Mp4Settings where
  parseJSON :: Value -> Parser Mp4Settings
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"Mp4Settings"
      ( \Object
x ->
          Maybe CmfcAudioDuration
-> Maybe Mp4CslgAtom
-> Maybe Natural
-> Maybe Mp4FreeSpaceBox
-> Maybe Mp4MoovPlacement
-> Maybe Text
-> Mp4Settings
Mp4Settings'
            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
"audioDuration")
            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
"cslgAtom")
            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
"cttsVersion")
            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
"freeSpaceBox")
            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
"moovPlacement")
            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
"mp4MajorBrand")
      )

instance Prelude.Hashable Mp4Settings where
  hashWithSalt :: Int -> Mp4Settings -> Int
hashWithSalt Int
_salt Mp4Settings' {Maybe Natural
Maybe Text
Maybe CmfcAudioDuration
Maybe Mp4CslgAtom
Maybe Mp4FreeSpaceBox
Maybe Mp4MoovPlacement
mp4MajorBrand :: Maybe Text
moovPlacement :: Maybe Mp4MoovPlacement
freeSpaceBox :: Maybe Mp4FreeSpaceBox
cttsVersion :: Maybe Natural
cslgAtom :: Maybe Mp4CslgAtom
audioDuration :: Maybe CmfcAudioDuration
$sel:mp4MajorBrand:Mp4Settings' :: Mp4Settings -> Maybe Text
$sel:moovPlacement:Mp4Settings' :: Mp4Settings -> Maybe Mp4MoovPlacement
$sel:freeSpaceBox:Mp4Settings' :: Mp4Settings -> Maybe Mp4FreeSpaceBox
$sel:cttsVersion:Mp4Settings' :: Mp4Settings -> Maybe Natural
$sel:cslgAtom:Mp4Settings' :: Mp4Settings -> Maybe Mp4CslgAtom
$sel:audioDuration:Mp4Settings' :: Mp4Settings -> Maybe CmfcAudioDuration
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe CmfcAudioDuration
audioDuration
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Mp4CslgAtom
cslgAtom
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
cttsVersion
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Mp4FreeSpaceBox
freeSpaceBox
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Mp4MoovPlacement
moovPlacement
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
mp4MajorBrand

instance Prelude.NFData Mp4Settings where
  rnf :: Mp4Settings -> ()
rnf Mp4Settings' {Maybe Natural
Maybe Text
Maybe CmfcAudioDuration
Maybe Mp4CslgAtom
Maybe Mp4FreeSpaceBox
Maybe Mp4MoovPlacement
mp4MajorBrand :: Maybe Text
moovPlacement :: Maybe Mp4MoovPlacement
freeSpaceBox :: Maybe Mp4FreeSpaceBox
cttsVersion :: Maybe Natural
cslgAtom :: Maybe Mp4CslgAtom
audioDuration :: Maybe CmfcAudioDuration
$sel:mp4MajorBrand:Mp4Settings' :: Mp4Settings -> Maybe Text
$sel:moovPlacement:Mp4Settings' :: Mp4Settings -> Maybe Mp4MoovPlacement
$sel:freeSpaceBox:Mp4Settings' :: Mp4Settings -> Maybe Mp4FreeSpaceBox
$sel:cttsVersion:Mp4Settings' :: Mp4Settings -> Maybe Natural
$sel:cslgAtom:Mp4Settings' :: Mp4Settings -> Maybe Mp4CslgAtom
$sel:audioDuration:Mp4Settings' :: Mp4Settings -> Maybe CmfcAudioDuration
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe CmfcAudioDuration
audioDuration
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Mp4CslgAtom
cslgAtom
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
cttsVersion
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Mp4FreeSpaceBox
freeSpaceBox
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Mp4MoovPlacement
moovPlacement
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
mp4MajorBrand

instance Data.ToJSON Mp4Settings where
  toJSON :: Mp4Settings -> Value
toJSON Mp4Settings' {Maybe Natural
Maybe Text
Maybe CmfcAudioDuration
Maybe Mp4CslgAtom
Maybe Mp4FreeSpaceBox
Maybe Mp4MoovPlacement
mp4MajorBrand :: Maybe Text
moovPlacement :: Maybe Mp4MoovPlacement
freeSpaceBox :: Maybe Mp4FreeSpaceBox
cttsVersion :: Maybe Natural
cslgAtom :: Maybe Mp4CslgAtom
audioDuration :: Maybe CmfcAudioDuration
$sel:mp4MajorBrand:Mp4Settings' :: Mp4Settings -> Maybe Text
$sel:moovPlacement:Mp4Settings' :: Mp4Settings -> Maybe Mp4MoovPlacement
$sel:freeSpaceBox:Mp4Settings' :: Mp4Settings -> Maybe Mp4FreeSpaceBox
$sel:cttsVersion:Mp4Settings' :: Mp4Settings -> Maybe Natural
$sel:cslgAtom:Mp4Settings' :: Mp4Settings -> Maybe Mp4CslgAtom
$sel:audioDuration:Mp4Settings' :: Mp4Settings -> Maybe CmfcAudioDuration
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"audioDuration" 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 CmfcAudioDuration
audioDuration,
            (Key
"cslgAtom" 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 Mp4CslgAtom
cslgAtom,
            (Key
"cttsVersion" 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 Natural
cttsVersion,
            (Key
"freeSpaceBox" 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 Mp4FreeSpaceBox
freeSpaceBox,
            (Key
"moovPlacement" 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 Mp4MoovPlacement
moovPlacement,
            (Key
"mp4MajorBrand" 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
mp4MajorBrand
          ]
      )