{-# 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.GetImages
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Retrieves a list of Images corresponding to each timestamp for a given
-- time range, sampling interval, and image format configuration.
--
-- This operation returns paginated results.
module Amazonka.KinesisVideoArchivedMedia.GetImages
  ( -- * Creating a Request
    GetImages (..),
    newGetImages,

    -- * Request Lenses
    getImages_formatConfig,
    getImages_heightPixels,
    getImages_maxResults,
    getImages_nextToken,
    getImages_streamARN,
    getImages_streamName,
    getImages_widthPixels,
    getImages_imageSelectorType,
    getImages_startTimestamp,
    getImages_endTimestamp,
    getImages_samplingInterval,
    getImages_format,

    -- * Destructuring the Response
    GetImagesResponse (..),
    newGetImagesResponse,

    -- * Response Lenses
    getImagesResponse_images,
    getImagesResponse_nextToken,
    getImagesResponse_httpStatus,
  )
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:/ 'newGetImages' smart constructor.
data GetImages = GetImages'
  { -- | The list of a key-value pair structure that contains extra parameters
    -- that can be applied when the image is generated. The @FormatConfig@ key
    -- is the @JPEGQuality@, which indicates the JPEG quality key to be used to
    -- generate the image. The @FormatConfig@ value accepts ints from 1 to 100.
    -- If the value is 1, the image will be generated with less quality and the
    -- best compression. If the value is 100, the image will be generated with
    -- the best quality and less compression. If no value is provided, the
    -- default value of the @JPEGQuality@ key will be set to 80.
    GetImages -> Maybe (HashMap FormatConfigKey Text)
formatConfig :: Prelude.Maybe (Prelude.HashMap FormatConfigKey Prelude.Text),
    -- | The height of the output image that is used in conjunction with the
    -- @WidthPixels@ parameter. When both @HeightPixels@ and @WidthPixels@
    -- parameters are provided, the image will be stretched to fit the
    -- specified aspect ratio. If only the @HeightPixels@ parameter is
    -- provided, its original aspect ratio will be used to calculate the
    -- @WidthPixels@ ratio. If neither parameter is provided, the original
    -- image size will be returned.
    GetImages -> Maybe Natural
heightPixels :: Prelude.Maybe Prelude.Natural,
    -- | The maximum number of images to be returned by the API.
    --
    -- The default limit is 100 images per API response. The additional results
    -- will be paginated.
    GetImages -> Maybe Natural
maxResults :: Prelude.Maybe Prelude.Natural,
    -- | A token that specifies where to start paginating the next set of Images.
    -- This is the @GetImages:NextToken@ from a previously truncated response.
    GetImages -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The Amazon Resource Name (ARN) of the stream from which to retrieve the
    -- images. You must specify either the @StreamName@ or the @StreamARN@.
    GetImages -> Maybe Text
streamARN :: Prelude.Maybe Prelude.Text,
    -- | The name of the stream from which to retrieve the images. You must
    -- specify either the @StreamName@ or the @StreamARN@.
    GetImages -> Maybe Text
streamName :: Prelude.Maybe Prelude.Text,
    -- | The width of the output image that is used in conjunction with the
    -- @HeightPixels@ parameter. When both @WidthPixels@ and @HeightPixels@
    -- parameters are provided, the image will be stretched to fit the
    -- specified aspect ratio. If only the @WidthPixels@ parameter is provided
    -- or if only the @HeightPixels@ is provided, a @ValidationException@ will
    -- be thrown. If neither parameter is provided, the original image size
    -- from the stream will be returned.
    GetImages -> Maybe Natural
widthPixels :: Prelude.Maybe Prelude.Natural,
    -- | The origin of the Server or Producer timestamps to use to generate the
    -- images.
    GetImages -> ImageSelectorType
imageSelectorType :: ImageSelectorType,
    -- | The starting point from which the images should be generated. This
    -- @StartTimestamp@ must be within an inclusive range of timestamps for an
    -- image to be returned.
    GetImages -> POSIX
startTimestamp :: Data.POSIX,
    -- | The end timestamp for the range of images to be generated.
    GetImages -> POSIX
endTimestamp :: Data.POSIX,
    -- | The time interval in milliseconds (ms) at which the images need to be
    -- generated from the stream. The minimum value that can be provided is
    -- 3000 ms. If the timestamp range is less than the sampling interval, the
    -- Image from the @startTimestamp@ will be returned if available.
    --
    -- The minimum value of 3000 ms is a soft limit. If needed, a lower
    -- sampling frequency can be requested.
    GetImages -> Natural
samplingInterval :: Prelude.Natural,
    -- | The format that will be used to encode the image.
    GetImages -> Format
format :: Format
  }
  deriving (GetImages -> GetImages -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetImages -> GetImages -> Bool
$c/= :: GetImages -> GetImages -> Bool
== :: GetImages -> GetImages -> Bool
$c== :: GetImages -> GetImages -> Bool
Prelude.Eq, ReadPrec [GetImages]
ReadPrec GetImages
Int -> ReadS GetImages
ReadS [GetImages]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetImages]
$creadListPrec :: ReadPrec [GetImages]
readPrec :: ReadPrec GetImages
$creadPrec :: ReadPrec GetImages
readList :: ReadS [GetImages]
$creadList :: ReadS [GetImages]
readsPrec :: Int -> ReadS GetImages
$creadsPrec :: Int -> ReadS GetImages
Prelude.Read, Int -> GetImages -> ShowS
[GetImages] -> ShowS
GetImages -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetImages] -> ShowS
$cshowList :: [GetImages] -> ShowS
show :: GetImages -> String
$cshow :: GetImages -> String
showsPrec :: Int -> GetImages -> ShowS
$cshowsPrec :: Int -> GetImages -> ShowS
Prelude.Show, forall x. Rep GetImages x -> GetImages
forall x. GetImages -> Rep GetImages x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetImages x -> GetImages
$cfrom :: forall x. GetImages -> Rep GetImages x
Prelude.Generic)

-- |
-- Create a value of 'GetImages' 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:
--
-- 'formatConfig', 'getImages_formatConfig' - The list of a key-value pair structure that contains extra parameters
-- that can be applied when the image is generated. The @FormatConfig@ key
-- is the @JPEGQuality@, which indicates the JPEG quality key to be used to
-- generate the image. The @FormatConfig@ value accepts ints from 1 to 100.
-- If the value is 1, the image will be generated with less quality and the
-- best compression. If the value is 100, the image will be generated with
-- the best quality and less compression. If no value is provided, the
-- default value of the @JPEGQuality@ key will be set to 80.
--
-- 'heightPixels', 'getImages_heightPixels' - The height of the output image that is used in conjunction with the
-- @WidthPixels@ parameter. When both @HeightPixels@ and @WidthPixels@
-- parameters are provided, the image will be stretched to fit the
-- specified aspect ratio. If only the @HeightPixels@ parameter is
-- provided, its original aspect ratio will be used to calculate the
-- @WidthPixels@ ratio. If neither parameter is provided, the original
-- image size will be returned.
--
-- 'maxResults', 'getImages_maxResults' - The maximum number of images to be returned by the API.
--
-- The default limit is 100 images per API response. The additional results
-- will be paginated.
--
-- 'nextToken', 'getImages_nextToken' - A token that specifies where to start paginating the next set of Images.
-- This is the @GetImages:NextToken@ from a previously truncated response.
--
-- 'streamARN', 'getImages_streamARN' - The Amazon Resource Name (ARN) of the stream from which to retrieve the
-- images. You must specify either the @StreamName@ or the @StreamARN@.
--
-- 'streamName', 'getImages_streamName' - The name of the stream from which to retrieve the images. You must
-- specify either the @StreamName@ or the @StreamARN@.
--
-- 'widthPixels', 'getImages_widthPixels' - The width of the output image that is used in conjunction with the
-- @HeightPixels@ parameter. When both @WidthPixels@ and @HeightPixels@
-- parameters are provided, the image will be stretched to fit the
-- specified aspect ratio. If only the @WidthPixels@ parameter is provided
-- or if only the @HeightPixels@ is provided, a @ValidationException@ will
-- be thrown. If neither parameter is provided, the original image size
-- from the stream will be returned.
--
-- 'imageSelectorType', 'getImages_imageSelectorType' - The origin of the Server or Producer timestamps to use to generate the
-- images.
--
-- 'startTimestamp', 'getImages_startTimestamp' - The starting point from which the images should be generated. This
-- @StartTimestamp@ must be within an inclusive range of timestamps for an
-- image to be returned.
--
-- 'endTimestamp', 'getImages_endTimestamp' - The end timestamp for the range of images to be generated.
--
-- 'samplingInterval', 'getImages_samplingInterval' - The time interval in milliseconds (ms) at which the images need to be
-- generated from the stream. The minimum value that can be provided is
-- 3000 ms. If the timestamp range is less than the sampling interval, the
-- Image from the @startTimestamp@ will be returned if available.
--
-- The minimum value of 3000 ms is a soft limit. If needed, a lower
-- sampling frequency can be requested.
--
-- 'format', 'getImages_format' - The format that will be used to encode the image.
newGetImages ::
  -- | 'imageSelectorType'
  ImageSelectorType ->
  -- | 'startTimestamp'
  Prelude.UTCTime ->
  -- | 'endTimestamp'
  Prelude.UTCTime ->
  -- | 'samplingInterval'
  Prelude.Natural ->
  -- | 'format'
  Format ->
  GetImages
newGetImages :: ImageSelectorType
-> UTCTime -> UTCTime -> Natural -> Format -> GetImages
newGetImages
  ImageSelectorType
pImageSelectorType_
  UTCTime
pStartTimestamp_
  UTCTime
pEndTimestamp_
  Natural
pSamplingInterval_
  Format
pFormat_ =
    GetImages'
      { $sel:formatConfig:GetImages' :: Maybe (HashMap FormatConfigKey Text)
formatConfig = forall a. Maybe a
Prelude.Nothing,
        $sel:heightPixels:GetImages' :: Maybe Natural
heightPixels = forall a. Maybe a
Prelude.Nothing,
        $sel:maxResults:GetImages' :: Maybe Natural
maxResults = forall a. Maybe a
Prelude.Nothing,
        $sel:nextToken:GetImages' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
        $sel:streamARN:GetImages' :: Maybe Text
streamARN = forall a. Maybe a
Prelude.Nothing,
        $sel:streamName:GetImages' :: Maybe Text
streamName = forall a. Maybe a
Prelude.Nothing,
        $sel:widthPixels:GetImages' :: Maybe Natural
widthPixels = forall a. Maybe a
Prelude.Nothing,
        $sel:imageSelectorType:GetImages' :: ImageSelectorType
imageSelectorType = ImageSelectorType
pImageSelectorType_,
        $sel:startTimestamp:GetImages' :: POSIX
startTimestamp = forall (a :: Format). Iso' (Time a) UTCTime
Data._Time forall t b. AReview t b -> b -> t
Lens.# UTCTime
pStartTimestamp_,
        $sel:endTimestamp:GetImages' :: POSIX
endTimestamp = forall (a :: Format). Iso' (Time a) UTCTime
Data._Time forall t b. AReview t b -> b -> t
Lens.# UTCTime
pEndTimestamp_,
        $sel:samplingInterval:GetImages' :: Natural
samplingInterval = Natural
pSamplingInterval_,
        $sel:format:GetImages' :: Format
format = Format
pFormat_
      }

-- | The list of a key-value pair structure that contains extra parameters
-- that can be applied when the image is generated. The @FormatConfig@ key
-- is the @JPEGQuality@, which indicates the JPEG quality key to be used to
-- generate the image. The @FormatConfig@ value accepts ints from 1 to 100.
-- If the value is 1, the image will be generated with less quality and the
-- best compression. If the value is 100, the image will be generated with
-- the best quality and less compression. If no value is provided, the
-- default value of the @JPEGQuality@ key will be set to 80.
getImages_formatConfig :: Lens.Lens' GetImages (Prelude.Maybe (Prelude.HashMap FormatConfigKey Prelude.Text))
getImages_formatConfig :: Lens' GetImages (Maybe (HashMap FormatConfigKey Text))
getImages_formatConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetImages' {Maybe (HashMap FormatConfigKey Text)
formatConfig :: Maybe (HashMap FormatConfigKey Text)
$sel:formatConfig:GetImages' :: GetImages -> Maybe (HashMap FormatConfigKey Text)
formatConfig} -> Maybe (HashMap FormatConfigKey Text)
formatConfig) (\s :: GetImages
s@GetImages' {} Maybe (HashMap FormatConfigKey Text)
a -> GetImages
s {$sel:formatConfig:GetImages' :: Maybe (HashMap FormatConfigKey Text)
formatConfig = Maybe (HashMap FormatConfigKey Text)
a} :: GetImages) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | The height of the output image that is used in conjunction with the
-- @WidthPixels@ parameter. When both @HeightPixels@ and @WidthPixels@
-- parameters are provided, the image will be stretched to fit the
-- specified aspect ratio. If only the @HeightPixels@ parameter is
-- provided, its original aspect ratio will be used to calculate the
-- @WidthPixels@ ratio. If neither parameter is provided, the original
-- image size will be returned.
getImages_heightPixels :: Lens.Lens' GetImages (Prelude.Maybe Prelude.Natural)
getImages_heightPixels :: Lens' GetImages (Maybe Natural)
getImages_heightPixels = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetImages' {Maybe Natural
heightPixels :: Maybe Natural
$sel:heightPixels:GetImages' :: GetImages -> Maybe Natural
heightPixels} -> Maybe Natural
heightPixels) (\s :: GetImages
s@GetImages' {} Maybe Natural
a -> GetImages
s {$sel:heightPixels:GetImages' :: Maybe Natural
heightPixels = Maybe Natural
a} :: GetImages)

-- | The maximum number of images to be returned by the API.
--
-- The default limit is 100 images per API response. The additional results
-- will be paginated.
getImages_maxResults :: Lens.Lens' GetImages (Prelude.Maybe Prelude.Natural)
getImages_maxResults :: Lens' GetImages (Maybe Natural)
getImages_maxResults = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetImages' {Maybe Natural
maxResults :: Maybe Natural
$sel:maxResults:GetImages' :: GetImages -> Maybe Natural
maxResults} -> Maybe Natural
maxResults) (\s :: GetImages
s@GetImages' {} Maybe Natural
a -> GetImages
s {$sel:maxResults:GetImages' :: Maybe Natural
maxResults = Maybe Natural
a} :: GetImages)

-- | A token that specifies where to start paginating the next set of Images.
-- This is the @GetImages:NextToken@ from a previously truncated response.
getImages_nextToken :: Lens.Lens' GetImages (Prelude.Maybe Prelude.Text)
getImages_nextToken :: Lens' GetImages (Maybe Text)
getImages_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetImages' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:GetImages' :: GetImages -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: GetImages
s@GetImages' {} Maybe Text
a -> GetImages
s {$sel:nextToken:GetImages' :: Maybe Text
nextToken = Maybe Text
a} :: GetImages)

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

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

-- | The width of the output image that is used in conjunction with the
-- @HeightPixels@ parameter. When both @WidthPixels@ and @HeightPixels@
-- parameters are provided, the image will be stretched to fit the
-- specified aspect ratio. If only the @WidthPixels@ parameter is provided
-- or if only the @HeightPixels@ is provided, a @ValidationException@ will
-- be thrown. If neither parameter is provided, the original image size
-- from the stream will be returned.
getImages_widthPixels :: Lens.Lens' GetImages (Prelude.Maybe Prelude.Natural)
getImages_widthPixels :: Lens' GetImages (Maybe Natural)
getImages_widthPixels = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetImages' {Maybe Natural
widthPixels :: Maybe Natural
$sel:widthPixels:GetImages' :: GetImages -> Maybe Natural
widthPixels} -> Maybe Natural
widthPixels) (\s :: GetImages
s@GetImages' {} Maybe Natural
a -> GetImages
s {$sel:widthPixels:GetImages' :: Maybe Natural
widthPixels = Maybe Natural
a} :: GetImages)

-- | The origin of the Server or Producer timestamps to use to generate the
-- images.
getImages_imageSelectorType :: Lens.Lens' GetImages ImageSelectorType
getImages_imageSelectorType :: Lens' GetImages ImageSelectorType
getImages_imageSelectorType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetImages' {ImageSelectorType
imageSelectorType :: ImageSelectorType
$sel:imageSelectorType:GetImages' :: GetImages -> ImageSelectorType
imageSelectorType} -> ImageSelectorType
imageSelectorType) (\s :: GetImages
s@GetImages' {} ImageSelectorType
a -> GetImages
s {$sel:imageSelectorType:GetImages' :: ImageSelectorType
imageSelectorType = ImageSelectorType
a} :: GetImages)

-- | The starting point from which the images should be generated. This
-- @StartTimestamp@ must be within an inclusive range of timestamps for an
-- image to be returned.
getImages_startTimestamp :: Lens.Lens' GetImages Prelude.UTCTime
getImages_startTimestamp :: Lens' GetImages UTCTime
getImages_startTimestamp = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetImages' {POSIX
startTimestamp :: POSIX
$sel:startTimestamp:GetImages' :: GetImages -> POSIX
startTimestamp} -> POSIX
startTimestamp) (\s :: GetImages
s@GetImages' {} POSIX
a -> GetImages
s {$sel:startTimestamp:GetImages' :: POSIX
startTimestamp = POSIX
a} :: GetImages) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The end timestamp for the range of images to be generated.
getImages_endTimestamp :: Lens.Lens' GetImages Prelude.UTCTime
getImages_endTimestamp :: Lens' GetImages UTCTime
getImages_endTimestamp = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetImages' {POSIX
endTimestamp :: POSIX
$sel:endTimestamp:GetImages' :: GetImages -> POSIX
endTimestamp} -> POSIX
endTimestamp) (\s :: GetImages
s@GetImages' {} POSIX
a -> GetImages
s {$sel:endTimestamp:GetImages' :: POSIX
endTimestamp = POSIX
a} :: GetImages) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The time interval in milliseconds (ms) at which the images need to be
-- generated from the stream. The minimum value that can be provided is
-- 3000 ms. If the timestamp range is less than the sampling interval, the
-- Image from the @startTimestamp@ will be returned if available.
--
-- The minimum value of 3000 ms is a soft limit. If needed, a lower
-- sampling frequency can be requested.
getImages_samplingInterval :: Lens.Lens' GetImages Prelude.Natural
getImages_samplingInterval :: Lens' GetImages Natural
getImages_samplingInterval = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetImages' {Natural
samplingInterval :: Natural
$sel:samplingInterval:GetImages' :: GetImages -> Natural
samplingInterval} -> Natural
samplingInterval) (\s :: GetImages
s@GetImages' {} Natural
a -> GetImages
s {$sel:samplingInterval:GetImages' :: Natural
samplingInterval = Natural
a} :: GetImages)

-- | The format that will be used to encode the image.
getImages_format :: Lens.Lens' GetImages Format
getImages_format :: Lens' GetImages Format
getImages_format = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetImages' {Format
format :: Format
$sel:format:GetImages' :: GetImages -> Format
format} -> Format
format) (\s :: GetImages
s@GetImages' {} Format
a -> GetImages
s {$sel:format:GetImages' :: Format
format = Format
a} :: GetImages)

instance Core.AWSPager GetImages where
  page :: GetImages -> AWSResponse GetImages -> Maybe GetImages
page GetImages
rq AWSResponse GetImages
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse GetImages
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' GetImagesResponse (Maybe Text)
getImagesResponse_nextToken
            forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
        ) =
        forall a. Maybe a
Prelude.Nothing
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse GetImages
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' GetImagesResponse (Maybe [Image])
getImagesResponse_images
            forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
        ) =
        forall a. Maybe a
Prelude.Nothing
    | Bool
Prelude.otherwise =
        forall a. a -> Maybe a
Prelude.Just
          forall a b. (a -> b) -> a -> b
Prelude.$ GetImages
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' GetImages (Maybe Text)
getImages_nextToken
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse GetImages
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' GetImagesResponse (Maybe Text)
getImagesResponse_nextToken
          forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just

instance Core.AWSRequest GetImages where
  type AWSResponse GetImages = GetImagesResponse
  request :: (Service -> Service) -> GetImages -> Request GetImages
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 GetImages
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse GetImages)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> Object -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveJSON
      ( \Int
s ResponseHeaders
h Object
x ->
          Maybe [Image] -> Maybe Text -> Int -> GetImagesResponse
GetImagesResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"Images" forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty)
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"NextToken")
            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))
      )

instance Prelude.Hashable GetImages where
  hashWithSalt :: Int -> GetImages -> Int
hashWithSalt Int
_salt GetImages' {Natural
Maybe Natural
Maybe Text
Maybe (HashMap FormatConfigKey Text)
POSIX
Format
ImageSelectorType
format :: Format
samplingInterval :: Natural
endTimestamp :: POSIX
startTimestamp :: POSIX
imageSelectorType :: ImageSelectorType
widthPixels :: Maybe Natural
streamName :: Maybe Text
streamARN :: Maybe Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
heightPixels :: Maybe Natural
formatConfig :: Maybe (HashMap FormatConfigKey Text)
$sel:format:GetImages' :: GetImages -> Format
$sel:samplingInterval:GetImages' :: GetImages -> Natural
$sel:endTimestamp:GetImages' :: GetImages -> POSIX
$sel:startTimestamp:GetImages' :: GetImages -> POSIX
$sel:imageSelectorType:GetImages' :: GetImages -> ImageSelectorType
$sel:widthPixels:GetImages' :: GetImages -> Maybe Natural
$sel:streamName:GetImages' :: GetImages -> Maybe Text
$sel:streamARN:GetImages' :: GetImages -> Maybe Text
$sel:nextToken:GetImages' :: GetImages -> Maybe Text
$sel:maxResults:GetImages' :: GetImages -> Maybe Natural
$sel:heightPixels:GetImages' :: GetImages -> Maybe Natural
$sel:formatConfig:GetImages' :: GetImages -> Maybe (HashMap FormatConfigKey Text)
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap FormatConfigKey Text)
formatConfig
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
heightPixels
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
maxResults
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
nextToken
      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` Maybe Natural
widthPixels
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` ImageSelectorType
imageSelectorType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` POSIX
startTimestamp
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` POSIX
endTimestamp
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Natural
samplingInterval
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Format
format

instance Prelude.NFData GetImages where
  rnf :: GetImages -> ()
rnf GetImages' {Natural
Maybe Natural
Maybe Text
Maybe (HashMap FormatConfigKey Text)
POSIX
Format
ImageSelectorType
format :: Format
samplingInterval :: Natural
endTimestamp :: POSIX
startTimestamp :: POSIX
imageSelectorType :: ImageSelectorType
widthPixels :: Maybe Natural
streamName :: Maybe Text
streamARN :: Maybe Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
heightPixels :: Maybe Natural
formatConfig :: Maybe (HashMap FormatConfigKey Text)
$sel:format:GetImages' :: GetImages -> Format
$sel:samplingInterval:GetImages' :: GetImages -> Natural
$sel:endTimestamp:GetImages' :: GetImages -> POSIX
$sel:startTimestamp:GetImages' :: GetImages -> POSIX
$sel:imageSelectorType:GetImages' :: GetImages -> ImageSelectorType
$sel:widthPixels:GetImages' :: GetImages -> Maybe Natural
$sel:streamName:GetImages' :: GetImages -> Maybe Text
$sel:streamARN:GetImages' :: GetImages -> Maybe Text
$sel:nextToken:GetImages' :: GetImages -> Maybe Text
$sel:maxResults:GetImages' :: GetImages -> Maybe Natural
$sel:heightPixels:GetImages' :: GetImages -> Maybe Natural
$sel:formatConfig:GetImages' :: GetImages -> Maybe (HashMap FormatConfigKey Text)
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap FormatConfigKey Text)
formatConfig
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
heightPixels
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
maxResults
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
nextToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` 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 Maybe Natural
widthPixels
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf ImageSelectorType
imageSelectorType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf POSIX
startTimestamp
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf POSIX
endTimestamp
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Natural
samplingInterval
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Format
format

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

instance Data.ToJSON GetImages where
  toJSON :: GetImages -> Value
toJSON GetImages' {Natural
Maybe Natural
Maybe Text
Maybe (HashMap FormatConfigKey Text)
POSIX
Format
ImageSelectorType
format :: Format
samplingInterval :: Natural
endTimestamp :: POSIX
startTimestamp :: POSIX
imageSelectorType :: ImageSelectorType
widthPixels :: Maybe Natural
streamName :: Maybe Text
streamARN :: Maybe Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
heightPixels :: Maybe Natural
formatConfig :: Maybe (HashMap FormatConfigKey Text)
$sel:format:GetImages' :: GetImages -> Format
$sel:samplingInterval:GetImages' :: GetImages -> Natural
$sel:endTimestamp:GetImages' :: GetImages -> POSIX
$sel:startTimestamp:GetImages' :: GetImages -> POSIX
$sel:imageSelectorType:GetImages' :: GetImages -> ImageSelectorType
$sel:widthPixels:GetImages' :: GetImages -> Maybe Natural
$sel:streamName:GetImages' :: GetImages -> Maybe Text
$sel:streamARN:GetImages' :: GetImages -> Maybe Text
$sel:nextToken:GetImages' :: GetImages -> Maybe Text
$sel:maxResults:GetImages' :: GetImages -> Maybe Natural
$sel:heightPixels:GetImages' :: GetImages -> Maybe Natural
$sel:formatConfig:GetImages' :: GetImages -> Maybe (HashMap FormatConfigKey Text)
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"FormatConfig" 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 (HashMap FormatConfigKey Text)
formatConfig,
            (Key
"HeightPixels" 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
heightPixels,
            (Key
"MaxResults" 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
maxResults,
            (Key
"NextToken" 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
nextToken,
            (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,
            (Key
"WidthPixels" 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
widthPixels,
            forall a. a -> Maybe a
Prelude.Just
              (Key
"ImageSelectorType" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= ImageSelectorType
imageSelectorType),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"StartTimestamp" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= POSIX
startTimestamp),
            forall a. a -> Maybe a
Prelude.Just (Key
"EndTimestamp" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= POSIX
endTimestamp),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"SamplingInterval" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Natural
samplingInterval),
            forall a. a -> Maybe a
Prelude.Just (Key
"Format" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Format
format)
          ]
      )

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

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

-- | /See:/ 'newGetImagesResponse' smart constructor.
data GetImagesResponse = GetImagesResponse'
  { -- | The list of images generated from the video stream. If there is no media
    -- available for the given timestamp, the @NO_MEDIA@ error will be listed
    -- in the output. If an error occurs while the image is being generated,
    -- the @MEDIA_ERROR@ will be listed in the output as the cause of the
    -- missing image.
    GetImagesResponse -> Maybe [Image]
images :: Prelude.Maybe [Image],
    -- | The encrypted token that was used in the request to get more images.
    GetImagesResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    GetImagesResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetImagesResponse -> GetImagesResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetImagesResponse -> GetImagesResponse -> Bool
$c/= :: GetImagesResponse -> GetImagesResponse -> Bool
== :: GetImagesResponse -> GetImagesResponse -> Bool
$c== :: GetImagesResponse -> GetImagesResponse -> Bool
Prelude.Eq, ReadPrec [GetImagesResponse]
ReadPrec GetImagesResponse
Int -> ReadS GetImagesResponse
ReadS [GetImagesResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetImagesResponse]
$creadListPrec :: ReadPrec [GetImagesResponse]
readPrec :: ReadPrec GetImagesResponse
$creadPrec :: ReadPrec GetImagesResponse
readList :: ReadS [GetImagesResponse]
$creadList :: ReadS [GetImagesResponse]
readsPrec :: Int -> ReadS GetImagesResponse
$creadsPrec :: Int -> ReadS GetImagesResponse
Prelude.Read, Int -> GetImagesResponse -> ShowS
[GetImagesResponse] -> ShowS
GetImagesResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetImagesResponse] -> ShowS
$cshowList :: [GetImagesResponse] -> ShowS
show :: GetImagesResponse -> String
$cshow :: GetImagesResponse -> String
showsPrec :: Int -> GetImagesResponse -> ShowS
$cshowsPrec :: Int -> GetImagesResponse -> ShowS
Prelude.Show, forall x. Rep GetImagesResponse x -> GetImagesResponse
forall x. GetImagesResponse -> Rep GetImagesResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetImagesResponse x -> GetImagesResponse
$cfrom :: forall x. GetImagesResponse -> Rep GetImagesResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetImagesResponse' 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:
--
-- 'images', 'getImagesResponse_images' - The list of images generated from the video stream. If there is no media
-- available for the given timestamp, the @NO_MEDIA@ error will be listed
-- in the output. If an error occurs while the image is being generated,
-- the @MEDIA_ERROR@ will be listed in the output as the cause of the
-- missing image.
--
-- 'nextToken', 'getImagesResponse_nextToken' - The encrypted token that was used in the request to get more images.
--
-- 'httpStatus', 'getImagesResponse_httpStatus' - The response's http status code.
newGetImagesResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetImagesResponse
newGetImagesResponse :: Int -> GetImagesResponse
newGetImagesResponse Int
pHttpStatus_ =
  GetImagesResponse'
    { $sel:images:GetImagesResponse' :: Maybe [Image]
images = forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:GetImagesResponse' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetImagesResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The list of images generated from the video stream. If there is no media
-- available for the given timestamp, the @NO_MEDIA@ error will be listed
-- in the output. If an error occurs while the image is being generated,
-- the @MEDIA_ERROR@ will be listed in the output as the cause of the
-- missing image.
getImagesResponse_images :: Lens.Lens' GetImagesResponse (Prelude.Maybe [Image])
getImagesResponse_images :: Lens' GetImagesResponse (Maybe [Image])
getImagesResponse_images = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetImagesResponse' {Maybe [Image]
images :: Maybe [Image]
$sel:images:GetImagesResponse' :: GetImagesResponse -> Maybe [Image]
images} -> Maybe [Image]
images) (\s :: GetImagesResponse
s@GetImagesResponse' {} Maybe [Image]
a -> GetImagesResponse
s {$sel:images:GetImagesResponse' :: Maybe [Image]
images = Maybe [Image]
a} :: GetImagesResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | The encrypted token that was used in the request to get more images.
getImagesResponse_nextToken :: Lens.Lens' GetImagesResponse (Prelude.Maybe Prelude.Text)
getImagesResponse_nextToken :: Lens' GetImagesResponse (Maybe Text)
getImagesResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetImagesResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:GetImagesResponse' :: GetImagesResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: GetImagesResponse
s@GetImagesResponse' {} Maybe Text
a -> GetImagesResponse
s {$sel:nextToken:GetImagesResponse' :: Maybe Text
nextToken = Maybe Text
a} :: GetImagesResponse)

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

instance Prelude.NFData GetImagesResponse where
  rnf :: GetImagesResponse -> ()
rnf GetImagesResponse' {Int
Maybe [Image]
Maybe Text
httpStatus :: Int
nextToken :: Maybe Text
images :: Maybe [Image]
$sel:httpStatus:GetImagesResponse' :: GetImagesResponse -> Int
$sel:nextToken:GetImagesResponse' :: GetImagesResponse -> Maybe Text
$sel:images:GetImagesResponse' :: GetImagesResponse -> Maybe [Image]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [Image]
images
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
nextToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus