{-# 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.Nimble.ListStreamingImages
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- List the streaming image resources available to this studio.
--
-- This list will contain both images provided by Amazon Web Services, as
-- well as streaming images that you have created in your studio.
--
-- This operation returns paginated results.
module Amazonka.Nimble.ListStreamingImages
  ( -- * Creating a Request
    ListStreamingImages (..),
    newListStreamingImages,

    -- * Request Lenses
    listStreamingImages_nextToken,
    listStreamingImages_owner,
    listStreamingImages_studioId,

    -- * Destructuring the Response
    ListStreamingImagesResponse (..),
    newListStreamingImagesResponse,

    -- * Response Lenses
    listStreamingImagesResponse_nextToken,
    listStreamingImagesResponse_streamingImages,
    listStreamingImagesResponse_httpStatus,
  )
where

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

-- | /See:/ 'newListStreamingImages' smart constructor.
data ListStreamingImages = ListStreamingImages'
  { -- | The token for the next set of results, or null if there are no more
    -- results.
    ListStreamingImages -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | Filter this request to streaming images with the given owner
    ListStreamingImages -> Maybe Text
owner :: Prelude.Maybe Prelude.Text,
    -- | The studio ID.
    ListStreamingImages -> Text
studioId :: Prelude.Text
  }
  deriving (ListStreamingImages -> ListStreamingImages -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListStreamingImages -> ListStreamingImages -> Bool
$c/= :: ListStreamingImages -> ListStreamingImages -> Bool
== :: ListStreamingImages -> ListStreamingImages -> Bool
$c== :: ListStreamingImages -> ListStreamingImages -> Bool
Prelude.Eq, ReadPrec [ListStreamingImages]
ReadPrec ListStreamingImages
Int -> ReadS ListStreamingImages
ReadS [ListStreamingImages]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListStreamingImages]
$creadListPrec :: ReadPrec [ListStreamingImages]
readPrec :: ReadPrec ListStreamingImages
$creadPrec :: ReadPrec ListStreamingImages
readList :: ReadS [ListStreamingImages]
$creadList :: ReadS [ListStreamingImages]
readsPrec :: Int -> ReadS ListStreamingImages
$creadsPrec :: Int -> ReadS ListStreamingImages
Prelude.Read, Int -> ListStreamingImages -> ShowS
[ListStreamingImages] -> ShowS
ListStreamingImages -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListStreamingImages] -> ShowS
$cshowList :: [ListStreamingImages] -> ShowS
show :: ListStreamingImages -> String
$cshow :: ListStreamingImages -> String
showsPrec :: Int -> ListStreamingImages -> ShowS
$cshowsPrec :: Int -> ListStreamingImages -> ShowS
Prelude.Show, forall x. Rep ListStreamingImages x -> ListStreamingImages
forall x. ListStreamingImages -> Rep ListStreamingImages x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListStreamingImages x -> ListStreamingImages
$cfrom :: forall x. ListStreamingImages -> Rep ListStreamingImages x
Prelude.Generic)

-- |
-- Create a value of 'ListStreamingImages' 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:
--
-- 'nextToken', 'listStreamingImages_nextToken' - The token for the next set of results, or null if there are no more
-- results.
--
-- 'owner', 'listStreamingImages_owner' - Filter this request to streaming images with the given owner
--
-- 'studioId', 'listStreamingImages_studioId' - The studio ID.
newListStreamingImages ::
  -- | 'studioId'
  Prelude.Text ->
  ListStreamingImages
newListStreamingImages :: Text -> ListStreamingImages
newListStreamingImages Text
pStudioId_ =
  ListStreamingImages'
    { $sel:nextToken:ListStreamingImages' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:owner:ListStreamingImages' :: Maybe Text
owner = forall a. Maybe a
Prelude.Nothing,
      $sel:studioId:ListStreamingImages' :: Text
studioId = Text
pStudioId_
    }

-- | The token for the next set of results, or null if there are no more
-- results.
listStreamingImages_nextToken :: Lens.Lens' ListStreamingImages (Prelude.Maybe Prelude.Text)
listStreamingImages_nextToken :: Lens' ListStreamingImages (Maybe Text)
listStreamingImages_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListStreamingImages' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListStreamingImages' :: ListStreamingImages -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListStreamingImages
s@ListStreamingImages' {} Maybe Text
a -> ListStreamingImages
s {$sel:nextToken:ListStreamingImages' :: Maybe Text
nextToken = Maybe Text
a} :: ListStreamingImages)

-- | Filter this request to streaming images with the given owner
listStreamingImages_owner :: Lens.Lens' ListStreamingImages (Prelude.Maybe Prelude.Text)
listStreamingImages_owner :: Lens' ListStreamingImages (Maybe Text)
listStreamingImages_owner = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListStreamingImages' {Maybe Text
owner :: Maybe Text
$sel:owner:ListStreamingImages' :: ListStreamingImages -> Maybe Text
owner} -> Maybe Text
owner) (\s :: ListStreamingImages
s@ListStreamingImages' {} Maybe Text
a -> ListStreamingImages
s {$sel:owner:ListStreamingImages' :: Maybe Text
owner = Maybe Text
a} :: ListStreamingImages)

-- | The studio ID.
listStreamingImages_studioId :: Lens.Lens' ListStreamingImages Prelude.Text
listStreamingImages_studioId :: Lens' ListStreamingImages Text
listStreamingImages_studioId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListStreamingImages' {Text
studioId :: Text
$sel:studioId:ListStreamingImages' :: ListStreamingImages -> Text
studioId} -> Text
studioId) (\s :: ListStreamingImages
s@ListStreamingImages' {} Text
a -> ListStreamingImages
s {$sel:studioId:ListStreamingImages' :: Text
studioId = Text
a} :: ListStreamingImages)

instance Core.AWSPager ListStreamingImages where
  page :: ListStreamingImages
-> AWSResponse ListStreamingImages -> Maybe ListStreamingImages
page ListStreamingImages
rq AWSResponse ListStreamingImages
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse ListStreamingImages
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListStreamingImagesResponse (Maybe Text)
listStreamingImagesResponse_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 ListStreamingImages
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListStreamingImagesResponse (Maybe [StreamingImage])
listStreamingImagesResponse_streamingImages
            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.$ ListStreamingImages
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' ListStreamingImages (Maybe Text)
listStreamingImages_nextToken
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse ListStreamingImages
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListStreamingImagesResponse (Maybe Text)
listStreamingImagesResponse_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 ListStreamingImages where
  type
    AWSResponse ListStreamingImages =
      ListStreamingImagesResponse
  request :: (Service -> Service)
-> ListStreamingImages -> Request ListStreamingImages
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.get (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy ListStreamingImages
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse ListStreamingImages)))
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 Text
-> Maybe [StreamingImage] -> Int -> ListStreamingImagesResponse
ListStreamingImagesResponse'
            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
"nextToken")
            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
"streamingImages"
                            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.<*> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
      )

instance Prelude.Hashable ListStreamingImages where
  hashWithSalt :: Int -> ListStreamingImages -> Int
hashWithSalt Int
_salt ListStreamingImages' {Maybe Text
Text
studioId :: Text
owner :: Maybe Text
nextToken :: Maybe Text
$sel:studioId:ListStreamingImages' :: ListStreamingImages -> Text
$sel:owner:ListStreamingImages' :: ListStreamingImages -> Maybe Text
$sel:nextToken:ListStreamingImages' :: ListStreamingImages -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
nextToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
owner
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
studioId

instance Prelude.NFData ListStreamingImages where
  rnf :: ListStreamingImages -> ()
rnf ListStreamingImages' {Maybe Text
Text
studioId :: Text
owner :: Maybe Text
nextToken :: Maybe Text
$sel:studioId:ListStreamingImages' :: ListStreamingImages -> Text
$sel:owner:ListStreamingImages' :: ListStreamingImages -> Maybe Text
$sel:nextToken:ListStreamingImages' :: ListStreamingImages -> Maybe Text
..} =
    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
owner
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
studioId

instance Data.ToHeaders ListStreamingImages where
  toHeaders :: ListStreamingImages -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToPath ListStreamingImages where
  toPath :: ListStreamingImages -> ByteString
toPath ListStreamingImages' {Maybe Text
Text
studioId :: Text
owner :: Maybe Text
nextToken :: Maybe Text
$sel:studioId:ListStreamingImages' :: ListStreamingImages -> Text
$sel:owner:ListStreamingImages' :: ListStreamingImages -> Maybe Text
$sel:nextToken:ListStreamingImages' :: ListStreamingImages -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/2020-08-01/studios/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
studioId,
        ByteString
"/streaming-images"
      ]

instance Data.ToQuery ListStreamingImages where
  toQuery :: ListStreamingImages -> QueryString
toQuery ListStreamingImages' {Maybe Text
Text
studioId :: Text
owner :: Maybe Text
nextToken :: Maybe Text
$sel:studioId:ListStreamingImages' :: ListStreamingImages -> Text
$sel:owner:ListStreamingImages' :: ListStreamingImages -> Maybe Text
$sel:nextToken:ListStreamingImages' :: ListStreamingImages -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"nextToken" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
nextToken,
        ByteString
"owner" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
owner
      ]

-- | /See:/ 'newListStreamingImagesResponse' smart constructor.
data ListStreamingImagesResponse = ListStreamingImagesResponse'
  { -- | The token for the next set of results, or null if there are no more
    -- results.
    ListStreamingImagesResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | A collection of streaming images.
    ListStreamingImagesResponse -> Maybe [StreamingImage]
streamingImages :: Prelude.Maybe [StreamingImage],
    -- | The response's http status code.
    ListStreamingImagesResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ListStreamingImagesResponse -> ListStreamingImagesResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListStreamingImagesResponse -> ListStreamingImagesResponse -> Bool
$c/= :: ListStreamingImagesResponse -> ListStreamingImagesResponse -> Bool
== :: ListStreamingImagesResponse -> ListStreamingImagesResponse -> Bool
$c== :: ListStreamingImagesResponse -> ListStreamingImagesResponse -> Bool
Prelude.Eq, Int -> ListStreamingImagesResponse -> ShowS
[ListStreamingImagesResponse] -> ShowS
ListStreamingImagesResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListStreamingImagesResponse] -> ShowS
$cshowList :: [ListStreamingImagesResponse] -> ShowS
show :: ListStreamingImagesResponse -> String
$cshow :: ListStreamingImagesResponse -> String
showsPrec :: Int -> ListStreamingImagesResponse -> ShowS
$cshowsPrec :: Int -> ListStreamingImagesResponse -> ShowS
Prelude.Show, forall x.
Rep ListStreamingImagesResponse x -> ListStreamingImagesResponse
forall x.
ListStreamingImagesResponse -> Rep ListStreamingImagesResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ListStreamingImagesResponse x -> ListStreamingImagesResponse
$cfrom :: forall x.
ListStreamingImagesResponse -> Rep ListStreamingImagesResponse x
Prelude.Generic)

-- |
-- Create a value of 'ListStreamingImagesResponse' 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:
--
-- 'nextToken', 'listStreamingImagesResponse_nextToken' - The token for the next set of results, or null if there are no more
-- results.
--
-- 'streamingImages', 'listStreamingImagesResponse_streamingImages' - A collection of streaming images.
--
-- 'httpStatus', 'listStreamingImagesResponse_httpStatus' - The response's http status code.
newListStreamingImagesResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ListStreamingImagesResponse
newListStreamingImagesResponse :: Int -> ListStreamingImagesResponse
newListStreamingImagesResponse Int
pHttpStatus_ =
  ListStreamingImagesResponse'
    { $sel:nextToken:ListStreamingImagesResponse' :: Maybe Text
nextToken =
        forall a. Maybe a
Prelude.Nothing,
      $sel:streamingImages:ListStreamingImagesResponse' :: Maybe [StreamingImage]
streamingImages = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ListStreamingImagesResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The token for the next set of results, or null if there are no more
-- results.
listStreamingImagesResponse_nextToken :: Lens.Lens' ListStreamingImagesResponse (Prelude.Maybe Prelude.Text)
listStreamingImagesResponse_nextToken :: Lens' ListStreamingImagesResponse (Maybe Text)
listStreamingImagesResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListStreamingImagesResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListStreamingImagesResponse' :: ListStreamingImagesResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListStreamingImagesResponse
s@ListStreamingImagesResponse' {} Maybe Text
a -> ListStreamingImagesResponse
s {$sel:nextToken:ListStreamingImagesResponse' :: Maybe Text
nextToken = Maybe Text
a} :: ListStreamingImagesResponse)

-- | A collection of streaming images.
listStreamingImagesResponse_streamingImages :: Lens.Lens' ListStreamingImagesResponse (Prelude.Maybe [StreamingImage])
listStreamingImagesResponse_streamingImages :: Lens' ListStreamingImagesResponse (Maybe [StreamingImage])
listStreamingImagesResponse_streamingImages = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListStreamingImagesResponse' {Maybe [StreamingImage]
streamingImages :: Maybe [StreamingImage]
$sel:streamingImages:ListStreamingImagesResponse' :: ListStreamingImagesResponse -> Maybe [StreamingImage]
streamingImages} -> Maybe [StreamingImage]
streamingImages) (\s :: ListStreamingImagesResponse
s@ListStreamingImagesResponse' {} Maybe [StreamingImage]
a -> ListStreamingImagesResponse
s {$sel:streamingImages:ListStreamingImagesResponse' :: Maybe [StreamingImage]
streamingImages = Maybe [StreamingImage]
a} :: ListStreamingImagesResponse) 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 response's http status code.
listStreamingImagesResponse_httpStatus :: Lens.Lens' ListStreamingImagesResponse Prelude.Int
listStreamingImagesResponse_httpStatus :: Lens' ListStreamingImagesResponse Int
listStreamingImagesResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListStreamingImagesResponse' {Int
httpStatus :: Int
$sel:httpStatus:ListStreamingImagesResponse' :: ListStreamingImagesResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: ListStreamingImagesResponse
s@ListStreamingImagesResponse' {} Int
a -> ListStreamingImagesResponse
s {$sel:httpStatus:ListStreamingImagesResponse' :: Int
httpStatus = Int
a} :: ListStreamingImagesResponse)

instance Prelude.NFData ListStreamingImagesResponse where
  rnf :: ListStreamingImagesResponse -> ()
rnf ListStreamingImagesResponse' {Int
Maybe [StreamingImage]
Maybe Text
httpStatus :: Int
streamingImages :: Maybe [StreamingImage]
nextToken :: Maybe Text
$sel:httpStatus:ListStreamingImagesResponse' :: ListStreamingImagesResponse -> Int
$sel:streamingImages:ListStreamingImagesResponse' :: ListStreamingImagesResponse -> Maybe [StreamingImage]
$sel:nextToken:ListStreamingImagesResponse' :: ListStreamingImagesResponse -> Maybe Text
..} =
    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 [StreamingImage]
streamingImages
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus