{-# 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.KinesisVideoArchivedMedia.GetClip
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Downloads an MP4 file (clip) containing the archived, on-demand media
-- from the specified video stream over the specified time range.
--
-- Both the StreamName and the StreamARN parameters are optional, but you
-- must specify either the StreamName or the StreamARN when invoking this
-- API operation.
--
-- As a prerequisite to using GetCLip API, you must obtain an endpoint
-- using @GetDataEndpoint@, specifying GET_CLIP for the @APIName@
-- parameter.
--
-- An Amazon Kinesis video stream has the following requirements for
-- providing data through MP4:
--
-- -   The media must contain h.264 or h.265 encoded video and, optionally,
--     AAC or G.711 encoded audio. Specifically, the codec ID of track 1
--     should be @V_MPEG\/ISO\/AVC@ (for h.264) or V_MPEGH\/ISO\/HEVC (for
--     H.265). Optionally, the codec ID of track 2 should be @A_AAC@ (for
--     AAC) or A_MS\/ACM (for G.711).
--
-- -   Data retention must be greater than 0.
--
-- -   The video track of each fragment must contain codec private data in
--     the Advanced Video Coding (AVC) for H.264 format and HEVC for H.265
--     format. For more information, see
--     <https://www.iso.org/standard/55980.html MPEG-4 specification ISO\/IEC 14496-15>.
--     For information about adapting stream data to a given format, see
--     <http://docs.aws.amazon.com/kinesisvideostreams/latest/dg/producer-reference-nal.html NAL Adaptation Flags>.
--
-- -   The audio track (if present) of each fragment must contain codec
--     private data in the AAC format
--     (<https://www.iso.org/standard/43345.html AAC specification ISO\/IEC 13818-7>)
--     or the
--     <http://www-mmsp.ece.mcgill.ca/Documents/AudioFormats/WAVE/WAVE.html MS Wave format>.
--
-- You can monitor the amount of outgoing data by monitoring the
-- @GetClip.OutgoingBytes@ Amazon CloudWatch metric. For information about
-- using CloudWatch to monitor Kinesis Video Streams, see
-- <http://docs.aws.amazon.com/kinesisvideostreams/latest/dg/monitoring.html Monitoring Kinesis Video Streams>.
-- For pricing information, see
-- <https://aws.amazon.com/kinesis/video-streams/pricing/ Amazon Kinesis Video Streams Pricing>
-- and <https://aws.amazon.com/pricing/ AWS Pricing>. Charges for outgoing
-- AWS data apply.
module Amazonka.KinesisVideoArchivedMedia.GetClip
  ( -- * Creating a Request
    GetClip (..),
    newGetClip,

    -- * Request Lenses
    getClip_streamARN,
    getClip_streamName,
    getClip_clipFragmentSelector,

    -- * Destructuring the Response
    GetClipResponse (..),
    newGetClipResponse,

    -- * Response Lenses
    getClipResponse_contentType,
    getClipResponse_httpStatus,
    getClipResponse_payload,
  )
where

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

-- | /See:/ 'newGetClip' smart constructor.
data GetClip = GetClip'
  { -- | The Amazon Resource Name (ARN) of the stream for which to retrieve the
    -- media clip.
    --
    -- You must specify either the StreamName or the StreamARN.
    GetClip -> Maybe Text
streamARN :: Prelude.Maybe Prelude.Text,
    -- | The name of the stream for which to retrieve the media clip.
    --
    -- You must specify either the StreamName or the StreamARN.
    GetClip -> Maybe Text
streamName :: Prelude.Maybe Prelude.Text,
    -- | The time range of the requested clip and the source of the timestamps.
    GetClip -> ClipFragmentSelector
clipFragmentSelector :: ClipFragmentSelector
  }
  deriving (GetClip -> GetClip -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetClip -> GetClip -> Bool
$c/= :: GetClip -> GetClip -> Bool
== :: GetClip -> GetClip -> Bool
$c== :: GetClip -> GetClip -> Bool
Prelude.Eq, ReadPrec [GetClip]
ReadPrec GetClip
Int -> ReadS GetClip
ReadS [GetClip]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetClip]
$creadListPrec :: ReadPrec [GetClip]
readPrec :: ReadPrec GetClip
$creadPrec :: ReadPrec GetClip
readList :: ReadS [GetClip]
$creadList :: ReadS [GetClip]
readsPrec :: Int -> ReadS GetClip
$creadsPrec :: Int -> ReadS GetClip
Prelude.Read, Int -> GetClip -> ShowS
[GetClip] -> ShowS
GetClip -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetClip] -> ShowS
$cshowList :: [GetClip] -> ShowS
show :: GetClip -> String
$cshow :: GetClip -> String
showsPrec :: Int -> GetClip -> ShowS
$cshowsPrec :: Int -> GetClip -> ShowS
Prelude.Show, forall x. Rep GetClip x -> GetClip
forall x. GetClip -> Rep GetClip x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetClip x -> GetClip
$cfrom :: forall x. GetClip -> Rep GetClip x
Prelude.Generic)

-- |
-- Create a value of 'GetClip' 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', 'getClip_streamARN' - The Amazon Resource Name (ARN) of the stream for which to retrieve the
-- media clip.
--
-- You must specify either the StreamName or the StreamARN.
--
-- 'streamName', 'getClip_streamName' - The name of the stream for which to retrieve the media clip.
--
-- You must specify either the StreamName or the StreamARN.
--
-- 'clipFragmentSelector', 'getClip_clipFragmentSelector' - The time range of the requested clip and the source of the timestamps.
newGetClip ::
  -- | 'clipFragmentSelector'
  ClipFragmentSelector ->
  GetClip
newGetClip :: ClipFragmentSelector -> GetClip
newGetClip ClipFragmentSelector
pClipFragmentSelector_ =
  GetClip'
    { $sel:streamARN:GetClip' :: Maybe Text
streamARN = forall a. Maybe a
Prelude.Nothing,
      $sel:streamName:GetClip' :: Maybe Text
streamName = forall a. Maybe a
Prelude.Nothing,
      $sel:clipFragmentSelector:GetClip' :: ClipFragmentSelector
clipFragmentSelector = ClipFragmentSelector
pClipFragmentSelector_
    }

-- | The Amazon Resource Name (ARN) of the stream for which to retrieve the
-- media clip.
--
-- You must specify either the StreamName or the StreamARN.
getClip_streamARN :: Lens.Lens' GetClip (Prelude.Maybe Prelude.Text)
getClip_streamARN :: Lens' GetClip (Maybe Text)
getClip_streamARN = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetClip' {Maybe Text
streamARN :: Maybe Text
$sel:streamARN:GetClip' :: GetClip -> Maybe Text
streamARN} -> Maybe Text
streamARN) (\s :: GetClip
s@GetClip' {} Maybe Text
a -> GetClip
s {$sel:streamARN:GetClip' :: Maybe Text
streamARN = Maybe Text
a} :: GetClip)

-- | The name of the stream for which to retrieve the media clip.
--
-- You must specify either the StreamName or the StreamARN.
getClip_streamName :: Lens.Lens' GetClip (Prelude.Maybe Prelude.Text)
getClip_streamName :: Lens' GetClip (Maybe Text)
getClip_streamName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetClip' {Maybe Text
streamName :: Maybe Text
$sel:streamName:GetClip' :: GetClip -> Maybe Text
streamName} -> Maybe Text
streamName) (\s :: GetClip
s@GetClip' {} Maybe Text
a -> GetClip
s {$sel:streamName:GetClip' :: Maybe Text
streamName = Maybe Text
a} :: GetClip)

-- | The time range of the requested clip and the source of the timestamps.
getClip_clipFragmentSelector :: Lens.Lens' GetClip ClipFragmentSelector
getClip_clipFragmentSelector :: Lens' GetClip ClipFragmentSelector
getClip_clipFragmentSelector = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetClip' {ClipFragmentSelector
clipFragmentSelector :: ClipFragmentSelector
$sel:clipFragmentSelector:GetClip' :: GetClip -> ClipFragmentSelector
clipFragmentSelector} -> ClipFragmentSelector
clipFragmentSelector) (\s :: GetClip
s@GetClip' {} ClipFragmentSelector
a -> GetClip
s {$sel:clipFragmentSelector:GetClip' :: ClipFragmentSelector
clipFragmentSelector = ClipFragmentSelector
a} :: GetClip)

instance Core.AWSRequest GetClip where
  type AWSResponse GetClip = GetClipResponse
  request :: (Service -> Service) -> GetClip -> Request GetClip
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 GetClip
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse GetClip)))
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 -> GetClipResponse
GetClipResponse'
            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 GetClip where
  hashWithSalt :: Int -> GetClip -> Int
hashWithSalt Int
_salt GetClip' {Maybe Text
ClipFragmentSelector
clipFragmentSelector :: ClipFragmentSelector
streamName :: Maybe Text
streamARN :: Maybe Text
$sel:clipFragmentSelector:GetClip' :: GetClip -> ClipFragmentSelector
$sel:streamName:GetClip' :: GetClip -> Maybe Text
$sel:streamARN:GetClip' :: GetClip -> 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` ClipFragmentSelector
clipFragmentSelector

instance Prelude.NFData GetClip where
  rnf :: GetClip -> ()
rnf GetClip' {Maybe Text
ClipFragmentSelector
clipFragmentSelector :: ClipFragmentSelector
streamName :: Maybe Text
streamARN :: Maybe Text
$sel:clipFragmentSelector:GetClip' :: GetClip -> ClipFragmentSelector
$sel:streamName:GetClip' :: GetClip -> Maybe Text
$sel:streamARN:GetClip' :: GetClip -> 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 ClipFragmentSelector
clipFragmentSelector

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

instance Data.ToJSON GetClip where
  toJSON :: GetClip -> Value
toJSON GetClip' {Maybe Text
ClipFragmentSelector
clipFragmentSelector :: ClipFragmentSelector
streamName :: Maybe Text
streamARN :: Maybe Text
$sel:clipFragmentSelector:GetClip' :: GetClip -> ClipFragmentSelector
$sel:streamName:GetClip' :: GetClip -> Maybe Text
$sel:streamARN:GetClip' :: GetClip -> 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
"ClipFragmentSelector"
                  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= ClipFragmentSelector
clipFragmentSelector
              )
          ]
      )

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

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

-- | /See:/ 'newGetClipResponse' smart constructor.
data GetClipResponse = GetClipResponse'
  { -- | The content type of the media in the requested clip.
    GetClipResponse -> Maybe Text
contentType :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    GetClipResponse -> Int
httpStatus :: Prelude.Int,
    -- | Traditional MP4 file that contains the media clip from the specified
    -- video stream. The output will contain the first 100 MB or the first 200
    -- fragments from the specified start timestamp. For more information, see
    -- <https://docs.aws.amazon.com/kinesisvideostreams/latest/dg/limits.html Kinesis Video Streams Limits>.
    GetClipResponse -> ResponseBody
payload :: Data.ResponseBody
  }
  deriving (Int -> GetClipResponse -> ShowS
[GetClipResponse] -> ShowS
GetClipResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetClipResponse] -> ShowS
$cshowList :: [GetClipResponse] -> ShowS
show :: GetClipResponse -> String
$cshow :: GetClipResponse -> String
showsPrec :: Int -> GetClipResponse -> ShowS
$cshowsPrec :: Int -> GetClipResponse -> ShowS
Prelude.Show, forall x. Rep GetClipResponse x -> GetClipResponse
forall x. GetClipResponse -> Rep GetClipResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetClipResponse x -> GetClipResponse
$cfrom :: forall x. GetClipResponse -> Rep GetClipResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetClipResponse' 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', 'getClipResponse_contentType' - The content type of the media in the requested clip.
--
-- 'httpStatus', 'getClipResponse_httpStatus' - The response's http status code.
--
-- 'payload', 'getClipResponse_payload' - Traditional MP4 file that contains the media clip from the specified
-- video stream. The output will contain the first 100 MB or the first 200
-- fragments from the specified start timestamp. For more information, see
-- <https://docs.aws.amazon.com/kinesisvideostreams/latest/dg/limits.html Kinesis Video Streams Limits>.
newGetClipResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'payload'
  Data.ResponseBody ->
  GetClipResponse
newGetClipResponse :: Int -> ResponseBody -> GetClipResponse
newGetClipResponse Int
pHttpStatus_ ResponseBody
pPayload_ =
  GetClipResponse'
    { $sel:contentType:GetClipResponse' :: Maybe Text
contentType = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetClipResponse' :: Int
httpStatus = Int
pHttpStatus_,
      $sel:payload:GetClipResponse' :: ResponseBody
payload = ResponseBody
pPayload_
    }

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

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

-- | Traditional MP4 file that contains the media clip from the specified
-- video stream. The output will contain the first 100 MB or the first 200
-- fragments from the specified start timestamp. For more information, see
-- <https://docs.aws.amazon.com/kinesisvideostreams/latest/dg/limits.html Kinesis Video Streams Limits>.
getClipResponse_payload :: Lens.Lens' GetClipResponse Data.ResponseBody
getClipResponse_payload :: Lens' GetClipResponse ResponseBody
getClipResponse_payload = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetClipResponse' {ResponseBody
payload :: ResponseBody
$sel:payload:GetClipResponse' :: GetClipResponse -> ResponseBody
payload} -> ResponseBody
payload) (\s :: GetClipResponse
s@GetClipResponse' {} ResponseBody
a -> GetClipResponse
s {$sel:payload:GetClipResponse' :: ResponseBody
payload = ResponseBody
a} :: GetClipResponse)