{-# 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.KinesisVideoMedia.GetMedia
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Use this API to retrieve media content from a Kinesis video stream. In
-- the request, you identify the stream name or stream Amazon Resource Name
-- (ARN), and the starting chunk. Kinesis Video Streams then returns a
-- stream of chunks in order by fragment number.
--
-- You must first call the @GetDataEndpoint@ API to get an endpoint. Then
-- send the @GetMedia@ requests to this endpoint using the
-- <https://docs.aws.amazon.com/cli/latest/reference/ --endpoint-url parameter>.
--
-- When you put media data (fragments) on a stream, Kinesis Video Streams
-- stores each incoming fragment and related metadata in what is called a
-- \"chunk.\" For more information, see
-- <https://docs.aws.amazon.com/kinesisvideostreams/latest/dg/API_dataplane_PutMedia.html PutMedia>.
-- The @GetMedia@ API returns a stream of these chunks starting from the
-- chunk that you specify in the request.
--
-- The following limits apply when using the @GetMedia@ API:
--
-- -   A client can call @GetMedia@ up to five times per second per stream.
--
-- -   Kinesis Video Streams sends media data at a rate of up to 25
--     megabytes per second (or 200 megabits per second) during a
--     @GetMedia@ session.
--
-- If an error is thrown after invoking a Kinesis Video Streams media API,
-- in addition to the HTTP status code and the response body, it includes
-- the following pieces of information:
--
-- -   @x-amz-ErrorType@ HTTP header – contains a more specific error type
--     in addition to what the HTTP status code provides.
--
-- -   @x-amz-RequestId@ HTTP header – if you want to report an issue to
--     AWS, the support team can better diagnose the problem if given the
--     Request Id.
--
-- Both the HTTP status code and the ErrorType header can be utilized to
-- make programmatic decisions about whether errors are retry-able and
-- under what conditions, as well as provide information on what actions
-- the client programmer might need to take in order to successfully try
-- again.
--
-- For more information, see the __Errors__ section at the bottom of this
-- topic, as well as
-- <https://docs.aws.amazon.com/kinesisvideostreams/latest/dg/CommonErrors.html Common Errors>.
module Amazonka.KinesisVideoMedia.GetMedia
  ( -- * Creating a Request
    GetMedia (..),
    newGetMedia,

    -- * Request Lenses
    getMedia_streamARN,
    getMedia_streamName,
    getMedia_startSelector,

    -- * Destructuring the Response
    GetMediaResponse (..),
    newGetMediaResponse,

    -- * Response Lenses
    getMediaResponse_contentType,
    getMediaResponse_httpStatus,
    getMediaResponse_payload,
  )
where

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

-- | /See:/ 'newGetMedia' smart constructor.
data GetMedia = GetMedia'
  { -- | The ARN of the stream from where you want to get the media content. If
    -- you don\'t specify the @streamARN@, you must specify the @streamName@.
    GetMedia -> Maybe Text
streamARN :: Prelude.Maybe Prelude.Text,
    -- | The Kinesis video stream name from where you want to get the media
    -- content. If you don\'t specify the @streamName@, you must specify the
    -- @streamARN@.
    GetMedia -> Maybe Text
streamName :: Prelude.Maybe Prelude.Text,
    -- | Identifies the starting chunk to get from the specified stream.
    GetMedia -> StartSelector
startSelector :: StartSelector
  }
  deriving (GetMedia -> GetMedia -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetMedia -> GetMedia -> Bool
$c/= :: GetMedia -> GetMedia -> Bool
== :: GetMedia -> GetMedia -> Bool
$c== :: GetMedia -> GetMedia -> Bool
Prelude.Eq, ReadPrec [GetMedia]
ReadPrec GetMedia
Int -> ReadS GetMedia
ReadS [GetMedia]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetMedia]
$creadListPrec :: ReadPrec [GetMedia]
readPrec :: ReadPrec GetMedia
$creadPrec :: ReadPrec GetMedia
readList :: ReadS [GetMedia]
$creadList :: ReadS [GetMedia]
readsPrec :: Int -> ReadS GetMedia
$creadsPrec :: Int -> ReadS GetMedia
Prelude.Read, Int -> GetMedia -> ShowS
[GetMedia] -> ShowS
GetMedia -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetMedia] -> ShowS
$cshowList :: [GetMedia] -> ShowS
show :: GetMedia -> String
$cshow :: GetMedia -> String
showsPrec :: Int -> GetMedia -> ShowS
$cshowsPrec :: Int -> GetMedia -> ShowS
Prelude.Show, forall x. Rep GetMedia x -> GetMedia
forall x. GetMedia -> Rep GetMedia x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetMedia x -> GetMedia
$cfrom :: forall x. GetMedia -> Rep GetMedia x
Prelude.Generic)

-- |
-- Create a value of 'GetMedia' 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:
--
-- 'streamARN', 'getMedia_streamARN' - The ARN of the stream from where you want to get the media content. If
-- you don\'t specify the @streamARN@, you must specify the @streamName@.
--
-- 'streamName', 'getMedia_streamName' - The Kinesis video stream name from where you want to get the media
-- content. If you don\'t specify the @streamName@, you must specify the
-- @streamARN@.
--
-- 'startSelector', 'getMedia_startSelector' - Identifies the starting chunk to get from the specified stream.
newGetMedia ::
  -- | 'startSelector'
  StartSelector ->
  GetMedia
newGetMedia :: StartSelector -> GetMedia
newGetMedia StartSelector
pStartSelector_ =
  GetMedia'
    { $sel:streamARN:GetMedia' :: Maybe Text
streamARN = forall a. Maybe a
Prelude.Nothing,
      $sel:streamName:GetMedia' :: Maybe Text
streamName = forall a. Maybe a
Prelude.Nothing,
      $sel:startSelector:GetMedia' :: StartSelector
startSelector = StartSelector
pStartSelector_
    }

-- | The ARN of the stream from where you want to get the media content. If
-- you don\'t specify the @streamARN@, you must specify the @streamName@.
getMedia_streamARN :: Lens.Lens' GetMedia (Prelude.Maybe Prelude.Text)
getMedia_streamARN :: Lens' GetMedia (Maybe Text)
getMedia_streamARN = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetMedia' {Maybe Text
streamARN :: Maybe Text
$sel:streamARN:GetMedia' :: GetMedia -> Maybe Text
streamARN} -> Maybe Text
streamARN) (\s :: GetMedia
s@GetMedia' {} Maybe Text
a -> GetMedia
s {$sel:streamARN:GetMedia' :: Maybe Text
streamARN = Maybe Text
a} :: GetMedia)

-- | The Kinesis video stream name from where you want to get the media
-- content. If you don\'t specify the @streamName@, you must specify the
-- @streamARN@.
getMedia_streamName :: Lens.Lens' GetMedia (Prelude.Maybe Prelude.Text)
getMedia_streamName :: Lens' GetMedia (Maybe Text)
getMedia_streamName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetMedia' {Maybe Text
streamName :: Maybe Text
$sel:streamName:GetMedia' :: GetMedia -> Maybe Text
streamName} -> Maybe Text
streamName) (\s :: GetMedia
s@GetMedia' {} Maybe Text
a -> GetMedia
s {$sel:streamName:GetMedia' :: Maybe Text
streamName = Maybe Text
a} :: GetMedia)

-- | Identifies the starting chunk to get from the specified stream.
getMedia_startSelector :: Lens.Lens' GetMedia StartSelector
getMedia_startSelector :: Lens' GetMedia StartSelector
getMedia_startSelector = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetMedia' {StartSelector
startSelector :: StartSelector
$sel:startSelector:GetMedia' :: GetMedia -> StartSelector
startSelector} -> StartSelector
startSelector) (\s :: GetMedia
s@GetMedia' {} StartSelector
a -> GetMedia
s {$sel:startSelector:GetMedia' :: StartSelector
startSelector = StartSelector
a} :: GetMedia)

instance Core.AWSRequest GetMedia where
  type AWSResponse GetMedia = GetMediaResponse
  request :: (Service -> Service) -> GetMedia -> Request GetMedia
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.postJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy GetMedia
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse GetMedia)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int
 -> ResponseHeaders
 -> ResponseBody
 -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveBody
      ( \Int
s ResponseHeaders
h ResponseBody
x ->
          Maybe Text -> Int -> ResponseBody -> GetMediaResponse
GetMediaResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (ResponseHeaders
h forall a.
FromText a =>
ResponseHeaders -> HeaderName -> Either String (Maybe a)
Data..#? HeaderName
"Content-Type")
            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))
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure ResponseBody
x)
      )

instance Prelude.Hashable GetMedia where
  hashWithSalt :: Int -> GetMedia -> Int
hashWithSalt Int
_salt GetMedia' {Maybe Text
StartSelector
startSelector :: StartSelector
streamName :: Maybe Text
streamARN :: Maybe Text
$sel:startSelector:GetMedia' :: GetMedia -> StartSelector
$sel:streamName:GetMedia' :: GetMedia -> Maybe Text
$sel:streamARN:GetMedia' :: GetMedia -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
streamARN
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
streamName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` StartSelector
startSelector

instance Prelude.NFData GetMedia where
  rnf :: GetMedia -> ()
rnf GetMedia' {Maybe Text
StartSelector
startSelector :: StartSelector
streamName :: Maybe Text
streamARN :: Maybe Text
$sel:startSelector:GetMedia' :: GetMedia -> StartSelector
$sel:streamName:GetMedia' :: GetMedia -> Maybe Text
$sel:streamARN:GetMedia' :: GetMedia -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
streamARN
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
streamName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf StartSelector
startSelector

instance Data.ToHeaders GetMedia where
  toHeaders :: GetMedia -> ResponseHeaders
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

instance Data.ToJSON GetMedia where
  toJSON :: GetMedia -> Value
toJSON GetMedia' {Maybe Text
StartSelector
startSelector :: StartSelector
streamName :: Maybe Text
streamARN :: Maybe Text
$sel:startSelector:GetMedia' :: GetMedia -> StartSelector
$sel:streamName:GetMedia' :: GetMedia -> Maybe Text
$sel:streamARN:GetMedia' :: GetMedia -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"StreamARN" 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
streamARN,
            (Key
"StreamName" 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
streamName,
            forall a. a -> Maybe a
Prelude.Just
              (Key
"StartSelector" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= StartSelector
startSelector)
          ]
      )

instance Data.ToPath GetMedia where
  toPath :: GetMedia -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/getMedia"

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

-- | /See:/ 'newGetMediaResponse' smart constructor.
data GetMediaResponse = GetMediaResponse'
  { -- | The content type of the requested media.
    GetMediaResponse -> Maybe Text
contentType :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    GetMediaResponse -> Int
httpStatus :: Prelude.Int,
    -- | The payload Kinesis Video Streams returns is a sequence of chunks from
    -- the specified stream. For information about the chunks, see . The chunks
    -- that Kinesis Video Streams returns in the @GetMedia@ call also include
    -- the following additional Matroska (MKV) tags:
    --
    -- -   AWS_KINESISVIDEO_CONTINUATION_TOKEN (UTF-8 string) - In the event
    --     your @GetMedia@ call terminates, you can use this continuation token
    --     in your next request to get the next chunk where the last request
    --     terminated.
    --
    -- -   AWS_KINESISVIDEO_MILLIS_BEHIND_NOW (UTF-8 string) - Client
    --     applications can use this tag value to determine how far behind the
    --     chunk returned in the response is from the latest chunk on the
    --     stream.
    --
    -- -   AWS_KINESISVIDEO_FRAGMENT_NUMBER - Fragment number returned in the
    --     chunk.
    --
    -- -   AWS_KINESISVIDEO_SERVER_TIMESTAMP - Server timestamp of the
    --     fragment.
    --
    -- -   AWS_KINESISVIDEO_PRODUCER_TIMESTAMP - Producer timestamp of the
    --     fragment.
    --
    -- The following tags will be present if an error occurs:
    --
    -- -   AWS_KINESISVIDEO_ERROR_CODE - String description of an error that
    --     caused GetMedia to stop.
    --
    -- -   AWS_KINESISVIDEO_ERROR_ID: Integer code of the error.
    --
    -- The error codes are as follows:
    --
    -- -   3002 - Error writing to the stream
    --
    -- -   4000 - Requested fragment is not found
    --
    -- -   4500 - Access denied for the stream\'s KMS key
    --
    -- -   4501 - Stream\'s KMS key is disabled
    --
    -- -   4502 - Validation error on the stream\'s KMS key
    --
    -- -   4503 - KMS key specified in the stream is unavailable
    --
    -- -   4504 - Invalid usage of the KMS key specified in the stream
    --
    -- -   4505 - Invalid state of the KMS key specified in the stream
    --
    -- -   4506 - Unable to find the KMS key specified in the stream
    --
    -- -   5000 - Internal error
    GetMediaResponse -> ResponseBody
payload :: Data.ResponseBody
  }
  deriving (Int -> GetMediaResponse -> ShowS
[GetMediaResponse] -> ShowS
GetMediaResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetMediaResponse] -> ShowS
$cshowList :: [GetMediaResponse] -> ShowS
show :: GetMediaResponse -> String
$cshow :: GetMediaResponse -> String
showsPrec :: Int -> GetMediaResponse -> ShowS
$cshowsPrec :: Int -> GetMediaResponse -> ShowS
Prelude.Show, forall x. Rep GetMediaResponse x -> GetMediaResponse
forall x. GetMediaResponse -> Rep GetMediaResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetMediaResponse x -> GetMediaResponse
$cfrom :: forall x. GetMediaResponse -> Rep GetMediaResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetMediaResponse' 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:
--
-- 'contentType', 'getMediaResponse_contentType' - The content type of the requested media.
--
-- 'httpStatus', 'getMediaResponse_httpStatus' - The response's http status code.
--
-- 'payload', 'getMediaResponse_payload' - The payload Kinesis Video Streams returns is a sequence of chunks from
-- the specified stream. For information about the chunks, see . The chunks
-- that Kinesis Video Streams returns in the @GetMedia@ call also include
-- the following additional Matroska (MKV) tags:
--
-- -   AWS_KINESISVIDEO_CONTINUATION_TOKEN (UTF-8 string) - In the event
--     your @GetMedia@ call terminates, you can use this continuation token
--     in your next request to get the next chunk where the last request
--     terminated.
--
-- -   AWS_KINESISVIDEO_MILLIS_BEHIND_NOW (UTF-8 string) - Client
--     applications can use this tag value to determine how far behind the
--     chunk returned in the response is from the latest chunk on the
--     stream.
--
-- -   AWS_KINESISVIDEO_FRAGMENT_NUMBER - Fragment number returned in the
--     chunk.
--
-- -   AWS_KINESISVIDEO_SERVER_TIMESTAMP - Server timestamp of the
--     fragment.
--
-- -   AWS_KINESISVIDEO_PRODUCER_TIMESTAMP - Producer timestamp of the
--     fragment.
--
-- The following tags will be present if an error occurs:
--
-- -   AWS_KINESISVIDEO_ERROR_CODE - String description of an error that
--     caused GetMedia to stop.
--
-- -   AWS_KINESISVIDEO_ERROR_ID: Integer code of the error.
--
-- The error codes are as follows:
--
-- -   3002 - Error writing to the stream
--
-- -   4000 - Requested fragment is not found
--
-- -   4500 - Access denied for the stream\'s KMS key
--
-- -   4501 - Stream\'s KMS key is disabled
--
-- -   4502 - Validation error on the stream\'s KMS key
--
-- -   4503 - KMS key specified in the stream is unavailable
--
-- -   4504 - Invalid usage of the KMS key specified in the stream
--
-- -   4505 - Invalid state of the KMS key specified in the stream
--
-- -   4506 - Unable to find the KMS key specified in the stream
--
-- -   5000 - Internal error
newGetMediaResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'payload'
  Data.ResponseBody ->
  GetMediaResponse
newGetMediaResponse :: Int -> ResponseBody -> GetMediaResponse
newGetMediaResponse Int
pHttpStatus_ ResponseBody
pPayload_ =
  GetMediaResponse'
    { $sel:contentType:GetMediaResponse' :: Maybe Text
contentType = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetMediaResponse' :: Int
httpStatus = Int
pHttpStatus_,
      $sel:payload:GetMediaResponse' :: ResponseBody
payload = ResponseBody
pPayload_
    }

-- | The content type of the requested media.
getMediaResponse_contentType :: Lens.Lens' GetMediaResponse (Prelude.Maybe Prelude.Text)
getMediaResponse_contentType :: Lens' GetMediaResponse (Maybe Text)
getMediaResponse_contentType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetMediaResponse' {Maybe Text
contentType :: Maybe Text
$sel:contentType:GetMediaResponse' :: GetMediaResponse -> Maybe Text
contentType} -> Maybe Text
contentType) (\s :: GetMediaResponse
s@GetMediaResponse' {} Maybe Text
a -> GetMediaResponse
s {$sel:contentType:GetMediaResponse' :: Maybe Text
contentType = Maybe Text
a} :: GetMediaResponse)

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

-- | The payload Kinesis Video Streams returns is a sequence of chunks from
-- the specified stream. For information about the chunks, see . The chunks
-- that Kinesis Video Streams returns in the @GetMedia@ call also include
-- the following additional Matroska (MKV) tags:
--
-- -   AWS_KINESISVIDEO_CONTINUATION_TOKEN (UTF-8 string) - In the event
--     your @GetMedia@ call terminates, you can use this continuation token
--     in your next request to get the next chunk where the last request
--     terminated.
--
-- -   AWS_KINESISVIDEO_MILLIS_BEHIND_NOW (UTF-8 string) - Client
--     applications can use this tag value to determine how far behind the
--     chunk returned in the response is from the latest chunk on the
--     stream.
--
-- -   AWS_KINESISVIDEO_FRAGMENT_NUMBER - Fragment number returned in the
--     chunk.
--
-- -   AWS_KINESISVIDEO_SERVER_TIMESTAMP - Server timestamp of the
--     fragment.
--
-- -   AWS_KINESISVIDEO_PRODUCER_TIMESTAMP - Producer timestamp of the
--     fragment.
--
-- The following tags will be present if an error occurs:
--
-- -   AWS_KINESISVIDEO_ERROR_CODE - String description of an error that
--     caused GetMedia to stop.
--
-- -   AWS_KINESISVIDEO_ERROR_ID: Integer code of the error.
--
-- The error codes are as follows:
--
-- -   3002 - Error writing to the stream
--
-- -   4000 - Requested fragment is not found
--
-- -   4500 - Access denied for the stream\'s KMS key
--
-- -   4501 - Stream\'s KMS key is disabled
--
-- -   4502 - Validation error on the stream\'s KMS key
--
-- -   4503 - KMS key specified in the stream is unavailable
--
-- -   4504 - Invalid usage of the KMS key specified in the stream
--
-- -   4505 - Invalid state of the KMS key specified in the stream
--
-- -   4506 - Unable to find the KMS key specified in the stream
--
-- -   5000 - Internal error
getMediaResponse_payload :: Lens.Lens' GetMediaResponse Data.ResponseBody
getMediaResponse_payload :: Lens' GetMediaResponse ResponseBody
getMediaResponse_payload = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetMediaResponse' {ResponseBody
payload :: ResponseBody
$sel:payload:GetMediaResponse' :: GetMediaResponse -> ResponseBody
payload} -> ResponseBody
payload) (\s :: GetMediaResponse
s@GetMediaResponse' {} ResponseBody
a -> GetMediaResponse
s {$sel:payload:GetMediaResponse' :: ResponseBody
payload = ResponseBody
a} :: GetMediaResponse)