{-# 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.MediaConnect.Types.MediaStream
-- 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.MediaConnect.Types.MediaStream where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.MediaConnect.Types.MediaStreamAttributes
import Amazonka.MediaConnect.Types.MediaStreamType
import qualified Amazonka.Prelude as Prelude

-- | A single track or stream of media that contains video, audio, or
-- ancillary data. After you add a media stream to a flow, you can
-- associate it with sources and outputs on that flow, as long as they use
-- the CDI protocol or the ST 2110 JPEG XS protocol. Each source or output
-- can consist of one or many media streams.
--
-- /See:/ 'newMediaStream' smart constructor.
data MediaStream = MediaStream'
  { -- | Attributes that are related to the media stream.
    MediaStream -> Maybe MediaStreamAttributes
attributes :: Prelude.Maybe MediaStreamAttributes,
    -- | The sample rate for the stream. This value is measured in Hz.
    MediaStream -> Maybe Int
clockRate :: Prelude.Maybe Prelude.Int,
    -- | A description that can help you quickly identify what your media stream
    -- is used for.
    MediaStream -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | The resolution of the video.
    MediaStream -> Maybe Text
videoFormat :: Prelude.Maybe Prelude.Text,
    -- | The type of media stream.
    MediaStream -> MediaStreamType
mediaStreamType :: MediaStreamType,
    -- | A unique identifier for the media stream.
    MediaStream -> Int
mediaStreamId :: Prelude.Int,
    -- | A name that helps you distinguish one media stream from another.
    MediaStream -> Text
mediaStreamName :: Prelude.Text,
    -- | The format type number (sometimes referred to as RTP payload type) of
    -- the media stream. MediaConnect assigns this value to the media stream.
    -- For ST 2110 JPEG XS outputs, you need to provide this value to the
    -- receiver.
    MediaStream -> Int
fmt :: Prelude.Int
  }
  deriving (MediaStream -> MediaStream -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MediaStream -> MediaStream -> Bool
$c/= :: MediaStream -> MediaStream -> Bool
== :: MediaStream -> MediaStream -> Bool
$c== :: MediaStream -> MediaStream -> Bool
Prelude.Eq, ReadPrec [MediaStream]
ReadPrec MediaStream
Int -> ReadS MediaStream
ReadS [MediaStream]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MediaStream]
$creadListPrec :: ReadPrec [MediaStream]
readPrec :: ReadPrec MediaStream
$creadPrec :: ReadPrec MediaStream
readList :: ReadS [MediaStream]
$creadList :: ReadS [MediaStream]
readsPrec :: Int -> ReadS MediaStream
$creadsPrec :: Int -> ReadS MediaStream
Prelude.Read, Int -> MediaStream -> ShowS
[MediaStream] -> ShowS
MediaStream -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MediaStream] -> ShowS
$cshowList :: [MediaStream] -> ShowS
show :: MediaStream -> String
$cshow :: MediaStream -> String
showsPrec :: Int -> MediaStream -> ShowS
$cshowsPrec :: Int -> MediaStream -> ShowS
Prelude.Show, forall x. Rep MediaStream x -> MediaStream
forall x. MediaStream -> Rep MediaStream x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MediaStream x -> MediaStream
$cfrom :: forall x. MediaStream -> Rep MediaStream x
Prelude.Generic)

-- |
-- Create a value of 'MediaStream' 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:
--
-- 'attributes', 'mediaStream_attributes' - Attributes that are related to the media stream.
--
-- 'clockRate', 'mediaStream_clockRate' - The sample rate for the stream. This value is measured in Hz.
--
-- 'description', 'mediaStream_description' - A description that can help you quickly identify what your media stream
-- is used for.
--
-- 'videoFormat', 'mediaStream_videoFormat' - The resolution of the video.
--
-- 'mediaStreamType', 'mediaStream_mediaStreamType' - The type of media stream.
--
-- 'mediaStreamId', 'mediaStream_mediaStreamId' - A unique identifier for the media stream.
--
-- 'mediaStreamName', 'mediaStream_mediaStreamName' - A name that helps you distinguish one media stream from another.
--
-- 'fmt', 'mediaStream_fmt' - The format type number (sometimes referred to as RTP payload type) of
-- the media stream. MediaConnect assigns this value to the media stream.
-- For ST 2110 JPEG XS outputs, you need to provide this value to the
-- receiver.
newMediaStream ::
  -- | 'mediaStreamType'
  MediaStreamType ->
  -- | 'mediaStreamId'
  Prelude.Int ->
  -- | 'mediaStreamName'
  Prelude.Text ->
  -- | 'fmt'
  Prelude.Int ->
  MediaStream
newMediaStream :: MediaStreamType -> Int -> Text -> Int -> MediaStream
newMediaStream
  MediaStreamType
pMediaStreamType_
  Int
pMediaStreamId_
  Text
pMediaStreamName_
  Int
pFmt_ =
    MediaStream'
      { $sel:attributes:MediaStream' :: Maybe MediaStreamAttributes
attributes = forall a. Maybe a
Prelude.Nothing,
        $sel:clockRate:MediaStream' :: Maybe Int
clockRate = forall a. Maybe a
Prelude.Nothing,
        $sel:description:MediaStream' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
        $sel:videoFormat:MediaStream' :: Maybe Text
videoFormat = forall a. Maybe a
Prelude.Nothing,
        $sel:mediaStreamType:MediaStream' :: MediaStreamType
mediaStreamType = MediaStreamType
pMediaStreamType_,
        $sel:mediaStreamId:MediaStream' :: Int
mediaStreamId = Int
pMediaStreamId_,
        $sel:mediaStreamName:MediaStream' :: Text
mediaStreamName = Text
pMediaStreamName_,
        $sel:fmt:MediaStream' :: Int
fmt = Int
pFmt_
      }

-- | Attributes that are related to the media stream.
mediaStream_attributes :: Lens.Lens' MediaStream (Prelude.Maybe MediaStreamAttributes)
mediaStream_attributes :: Lens' MediaStream (Maybe MediaStreamAttributes)
mediaStream_attributes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\MediaStream' {Maybe MediaStreamAttributes
attributes :: Maybe MediaStreamAttributes
$sel:attributes:MediaStream' :: MediaStream -> Maybe MediaStreamAttributes
attributes} -> Maybe MediaStreamAttributes
attributes) (\s :: MediaStream
s@MediaStream' {} Maybe MediaStreamAttributes
a -> MediaStream
s {$sel:attributes:MediaStream' :: Maybe MediaStreamAttributes
attributes = Maybe MediaStreamAttributes
a} :: MediaStream)

-- | The sample rate for the stream. This value is measured in Hz.
mediaStream_clockRate :: Lens.Lens' MediaStream (Prelude.Maybe Prelude.Int)
mediaStream_clockRate :: Lens' MediaStream (Maybe Int)
mediaStream_clockRate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\MediaStream' {Maybe Int
clockRate :: Maybe Int
$sel:clockRate:MediaStream' :: MediaStream -> Maybe Int
clockRate} -> Maybe Int
clockRate) (\s :: MediaStream
s@MediaStream' {} Maybe Int
a -> MediaStream
s {$sel:clockRate:MediaStream' :: Maybe Int
clockRate = Maybe Int
a} :: MediaStream)

-- | A description that can help you quickly identify what your media stream
-- is used for.
mediaStream_description :: Lens.Lens' MediaStream (Prelude.Maybe Prelude.Text)
mediaStream_description :: Lens' MediaStream (Maybe Text)
mediaStream_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\MediaStream' {Maybe Text
description :: Maybe Text
$sel:description:MediaStream' :: MediaStream -> Maybe Text
description} -> Maybe Text
description) (\s :: MediaStream
s@MediaStream' {} Maybe Text
a -> MediaStream
s {$sel:description:MediaStream' :: Maybe Text
description = Maybe Text
a} :: MediaStream)

-- | The resolution of the video.
mediaStream_videoFormat :: Lens.Lens' MediaStream (Prelude.Maybe Prelude.Text)
mediaStream_videoFormat :: Lens' MediaStream (Maybe Text)
mediaStream_videoFormat = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\MediaStream' {Maybe Text
videoFormat :: Maybe Text
$sel:videoFormat:MediaStream' :: MediaStream -> Maybe Text
videoFormat} -> Maybe Text
videoFormat) (\s :: MediaStream
s@MediaStream' {} Maybe Text
a -> MediaStream
s {$sel:videoFormat:MediaStream' :: Maybe Text
videoFormat = Maybe Text
a} :: MediaStream)

-- | The type of media stream.
mediaStream_mediaStreamType :: Lens.Lens' MediaStream MediaStreamType
mediaStream_mediaStreamType :: Lens' MediaStream MediaStreamType
mediaStream_mediaStreamType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\MediaStream' {MediaStreamType
mediaStreamType :: MediaStreamType
$sel:mediaStreamType:MediaStream' :: MediaStream -> MediaStreamType
mediaStreamType} -> MediaStreamType
mediaStreamType) (\s :: MediaStream
s@MediaStream' {} MediaStreamType
a -> MediaStream
s {$sel:mediaStreamType:MediaStream' :: MediaStreamType
mediaStreamType = MediaStreamType
a} :: MediaStream)

-- | A unique identifier for the media stream.
mediaStream_mediaStreamId :: Lens.Lens' MediaStream Prelude.Int
mediaStream_mediaStreamId :: Lens' MediaStream Int
mediaStream_mediaStreamId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\MediaStream' {Int
mediaStreamId :: Int
$sel:mediaStreamId:MediaStream' :: MediaStream -> Int
mediaStreamId} -> Int
mediaStreamId) (\s :: MediaStream
s@MediaStream' {} Int
a -> MediaStream
s {$sel:mediaStreamId:MediaStream' :: Int
mediaStreamId = Int
a} :: MediaStream)

-- | A name that helps you distinguish one media stream from another.
mediaStream_mediaStreamName :: Lens.Lens' MediaStream Prelude.Text
mediaStream_mediaStreamName :: Lens' MediaStream Text
mediaStream_mediaStreamName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\MediaStream' {Text
mediaStreamName :: Text
$sel:mediaStreamName:MediaStream' :: MediaStream -> Text
mediaStreamName} -> Text
mediaStreamName) (\s :: MediaStream
s@MediaStream' {} Text
a -> MediaStream
s {$sel:mediaStreamName:MediaStream' :: Text
mediaStreamName = Text
a} :: MediaStream)

-- | The format type number (sometimes referred to as RTP payload type) of
-- the media stream. MediaConnect assigns this value to the media stream.
-- For ST 2110 JPEG XS outputs, you need to provide this value to the
-- receiver.
mediaStream_fmt :: Lens.Lens' MediaStream Prelude.Int
mediaStream_fmt :: Lens' MediaStream Int
mediaStream_fmt = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\MediaStream' {Int
fmt :: Int
$sel:fmt:MediaStream' :: MediaStream -> Int
fmt} -> Int
fmt) (\s :: MediaStream
s@MediaStream' {} Int
a -> MediaStream
s {$sel:fmt:MediaStream' :: Int
fmt = Int
a} :: MediaStream)

instance Data.FromJSON MediaStream where
  parseJSON :: Value -> Parser MediaStream
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"MediaStream"
      ( \Object
x ->
          Maybe MediaStreamAttributes
-> Maybe Int
-> Maybe Text
-> Maybe Text
-> MediaStreamType
-> Int
-> Text
-> Int
-> MediaStream
MediaStream'
            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
"attributes")
            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
"clockRate")
            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
"description")
            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
"videoFormat")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser a
Data..: Key
"mediaStreamType")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser a
Data..: Key
"mediaStreamId")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser a
Data..: Key
"mediaStreamName")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser a
Data..: Key
"fmt")
      )

instance Prelude.Hashable MediaStream where
  hashWithSalt :: Int -> MediaStream -> Int
hashWithSalt Int
_salt MediaStream' {Int
Maybe Int
Maybe Text
Maybe MediaStreamAttributes
Text
MediaStreamType
fmt :: Int
mediaStreamName :: Text
mediaStreamId :: Int
mediaStreamType :: MediaStreamType
videoFormat :: Maybe Text
description :: Maybe Text
clockRate :: Maybe Int
attributes :: Maybe MediaStreamAttributes
$sel:fmt:MediaStream' :: MediaStream -> Int
$sel:mediaStreamName:MediaStream' :: MediaStream -> Text
$sel:mediaStreamId:MediaStream' :: MediaStream -> Int
$sel:mediaStreamType:MediaStream' :: MediaStream -> MediaStreamType
$sel:videoFormat:MediaStream' :: MediaStream -> Maybe Text
$sel:description:MediaStream' :: MediaStream -> Maybe Text
$sel:clockRate:MediaStream' :: MediaStream -> Maybe Int
$sel:attributes:MediaStream' :: MediaStream -> Maybe MediaStreamAttributes
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe MediaStreamAttributes
attributes
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
clockRate
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
videoFormat
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` MediaStreamType
mediaStreamType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Int
mediaStreamId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
mediaStreamName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Int
fmt

instance Prelude.NFData MediaStream where
  rnf :: MediaStream -> ()
rnf MediaStream' {Int
Maybe Int
Maybe Text
Maybe MediaStreamAttributes
Text
MediaStreamType
fmt :: Int
mediaStreamName :: Text
mediaStreamId :: Int
mediaStreamType :: MediaStreamType
videoFormat :: Maybe Text
description :: Maybe Text
clockRate :: Maybe Int
attributes :: Maybe MediaStreamAttributes
$sel:fmt:MediaStream' :: MediaStream -> Int
$sel:mediaStreamName:MediaStream' :: MediaStream -> Text
$sel:mediaStreamId:MediaStream' :: MediaStream -> Int
$sel:mediaStreamType:MediaStream' :: MediaStream -> MediaStreamType
$sel:videoFormat:MediaStream' :: MediaStream -> Maybe Text
$sel:description:MediaStream' :: MediaStream -> Maybe Text
$sel:clockRate:MediaStream' :: MediaStream -> Maybe Int
$sel:attributes:MediaStream' :: MediaStream -> Maybe MediaStreamAttributes
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe MediaStreamAttributes
attributes
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
clockRate
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
description
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
videoFormat
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf MediaStreamType
mediaStreamType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
mediaStreamId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
mediaStreamName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
fmt