{-# 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.MediaTailor.ListLiveSources
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Lists the live sources contained in a source location. A source
-- represents a piece of content.
--
-- This operation returns paginated results.
module Amazonka.MediaTailor.ListLiveSources
  ( -- * Creating a Request
    ListLiveSources (..),
    newListLiveSources,

    -- * Request Lenses
    listLiveSources_maxResults,
    listLiveSources_nextToken,
    listLiveSources_sourceLocationName,

    -- * Destructuring the Response
    ListLiveSourcesResponse (..),
    newListLiveSourcesResponse,

    -- * Response Lenses
    listLiveSourcesResponse_items,
    listLiveSourcesResponse_nextToken,
    listLiveSourcesResponse_httpStatus,
  )
where

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

-- | /See:/ 'newListLiveSources' smart constructor.
data ListLiveSources = ListLiveSources'
  { -- | The maximum number of live sources that you want MediaTailor to return
    -- in response to the current request. If there are more than @MaxResults@
    -- live sources, use the value of @NextToken@ in the response to get the
    -- next page of results.
    ListLiveSources -> Maybe Natural
maxResults :: Prelude.Maybe Prelude.Natural,
    -- | Pagination token returned by the list request when results exceed the
    -- maximum allowed. Use the token to fetch the next page of results.
    ListLiveSources -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The name of the source location associated with this Live Sources list.
    ListLiveSources -> Text
sourceLocationName :: Prelude.Text
  }
  deriving (ListLiveSources -> ListLiveSources -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListLiveSources -> ListLiveSources -> Bool
$c/= :: ListLiveSources -> ListLiveSources -> Bool
== :: ListLiveSources -> ListLiveSources -> Bool
$c== :: ListLiveSources -> ListLiveSources -> Bool
Prelude.Eq, ReadPrec [ListLiveSources]
ReadPrec ListLiveSources
Int -> ReadS ListLiveSources
ReadS [ListLiveSources]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListLiveSources]
$creadListPrec :: ReadPrec [ListLiveSources]
readPrec :: ReadPrec ListLiveSources
$creadPrec :: ReadPrec ListLiveSources
readList :: ReadS [ListLiveSources]
$creadList :: ReadS [ListLiveSources]
readsPrec :: Int -> ReadS ListLiveSources
$creadsPrec :: Int -> ReadS ListLiveSources
Prelude.Read, Int -> ListLiveSources -> ShowS
[ListLiveSources] -> ShowS
ListLiveSources -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListLiveSources] -> ShowS
$cshowList :: [ListLiveSources] -> ShowS
show :: ListLiveSources -> String
$cshow :: ListLiveSources -> String
showsPrec :: Int -> ListLiveSources -> ShowS
$cshowsPrec :: Int -> ListLiveSources -> ShowS
Prelude.Show, forall x. Rep ListLiveSources x -> ListLiveSources
forall x. ListLiveSources -> Rep ListLiveSources x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListLiveSources x -> ListLiveSources
$cfrom :: forall x. ListLiveSources -> Rep ListLiveSources x
Prelude.Generic)

-- |
-- Create a value of 'ListLiveSources' 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:
--
-- 'maxResults', 'listLiveSources_maxResults' - The maximum number of live sources that you want MediaTailor to return
-- in response to the current request. If there are more than @MaxResults@
-- live sources, use the value of @NextToken@ in the response to get the
-- next page of results.
--
-- 'nextToken', 'listLiveSources_nextToken' - Pagination token returned by the list request when results exceed the
-- maximum allowed. Use the token to fetch the next page of results.
--
-- 'sourceLocationName', 'listLiveSources_sourceLocationName' - The name of the source location associated with this Live Sources list.
newListLiveSources ::
  -- | 'sourceLocationName'
  Prelude.Text ->
  ListLiveSources
newListLiveSources :: Text -> ListLiveSources
newListLiveSources Text
pSourceLocationName_ =
  ListLiveSources'
    { $sel:maxResults:ListLiveSources' :: Maybe Natural
maxResults = forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListLiveSources' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:sourceLocationName:ListLiveSources' :: Text
sourceLocationName = Text
pSourceLocationName_
    }

-- | The maximum number of live sources that you want MediaTailor to return
-- in response to the current request. If there are more than @MaxResults@
-- live sources, use the value of @NextToken@ in the response to get the
-- next page of results.
listLiveSources_maxResults :: Lens.Lens' ListLiveSources (Prelude.Maybe Prelude.Natural)
listLiveSources_maxResults :: Lens' ListLiveSources (Maybe Natural)
listLiveSources_maxResults = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListLiveSources' {Maybe Natural
maxResults :: Maybe Natural
$sel:maxResults:ListLiveSources' :: ListLiveSources -> Maybe Natural
maxResults} -> Maybe Natural
maxResults) (\s :: ListLiveSources
s@ListLiveSources' {} Maybe Natural
a -> ListLiveSources
s {$sel:maxResults:ListLiveSources' :: Maybe Natural
maxResults = Maybe Natural
a} :: ListLiveSources)

-- | Pagination token returned by the list request when results exceed the
-- maximum allowed. Use the token to fetch the next page of results.
listLiveSources_nextToken :: Lens.Lens' ListLiveSources (Prelude.Maybe Prelude.Text)
listLiveSources_nextToken :: Lens' ListLiveSources (Maybe Text)
listLiveSources_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListLiveSources' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListLiveSources' :: ListLiveSources -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListLiveSources
s@ListLiveSources' {} Maybe Text
a -> ListLiveSources
s {$sel:nextToken:ListLiveSources' :: Maybe Text
nextToken = Maybe Text
a} :: ListLiveSources)

-- | The name of the source location associated with this Live Sources list.
listLiveSources_sourceLocationName :: Lens.Lens' ListLiveSources Prelude.Text
listLiveSources_sourceLocationName :: Lens' ListLiveSources Text
listLiveSources_sourceLocationName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListLiveSources' {Text
sourceLocationName :: Text
$sel:sourceLocationName:ListLiveSources' :: ListLiveSources -> Text
sourceLocationName} -> Text
sourceLocationName) (\s :: ListLiveSources
s@ListLiveSources' {} Text
a -> ListLiveSources
s {$sel:sourceLocationName:ListLiveSources' :: Text
sourceLocationName = Text
a} :: ListLiveSources)

instance Core.AWSPager ListLiveSources where
  page :: ListLiveSources
-> AWSResponse ListLiveSources -> Maybe ListLiveSources
page ListLiveSources
rq AWSResponse ListLiveSources
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse ListLiveSources
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListLiveSourcesResponse (Maybe Text)
listLiveSourcesResponse_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 ListLiveSources
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListLiveSourcesResponse (Maybe [LiveSource])
listLiveSourcesResponse_items
            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.$ ListLiveSources
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' ListLiveSources (Maybe Text)
listLiveSources_nextToken
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse ListLiveSources
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListLiveSourcesResponse (Maybe Text)
listLiveSourcesResponse_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 ListLiveSources where
  type
    AWSResponse ListLiveSources =
      ListLiveSourcesResponse
  request :: (Service -> Service) -> ListLiveSources -> Request ListLiveSources
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 ListLiveSources
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse ListLiveSources)))
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 [LiveSource] -> Maybe Text -> Int -> ListLiveSourcesResponse
ListLiveSourcesResponse'
            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
"Items" 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 ListLiveSources where
  hashWithSalt :: Int -> ListLiveSources -> Int
hashWithSalt Int
_salt ListLiveSources' {Maybe Natural
Maybe Text
Text
sourceLocationName :: Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:sourceLocationName:ListLiveSources' :: ListLiveSources -> Text
$sel:nextToken:ListLiveSources' :: ListLiveSources -> Maybe Text
$sel:maxResults:ListLiveSources' :: ListLiveSources -> Maybe Natural
..} =
    Int
_salt
      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` Text
sourceLocationName

instance Prelude.NFData ListLiveSources where
  rnf :: ListLiveSources -> ()
rnf ListLiveSources' {Maybe Natural
Maybe Text
Text
sourceLocationName :: Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:sourceLocationName:ListLiveSources' :: ListLiveSources -> Text
$sel:nextToken:ListLiveSources' :: ListLiveSources -> Maybe Text
$sel:maxResults:ListLiveSources' :: ListLiveSources -> Maybe Natural
..} =
    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 Text
sourceLocationName

instance Data.ToHeaders ListLiveSources where
  toHeaders :: ListLiveSources -> 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 ListLiveSources where
  toPath :: ListLiveSources -> ByteString
toPath ListLiveSources' {Maybe Natural
Maybe Text
Text
sourceLocationName :: Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:sourceLocationName:ListLiveSources' :: ListLiveSources -> Text
$sel:nextToken:ListLiveSources' :: ListLiveSources -> Maybe Text
$sel:maxResults:ListLiveSources' :: ListLiveSources -> Maybe Natural
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/sourceLocation/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
sourceLocationName,
        ByteString
"/liveSources"
      ]

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

-- | /See:/ 'newListLiveSourcesResponse' smart constructor.
data ListLiveSourcesResponse = ListLiveSourcesResponse'
  { -- | Lists the live sources.
    ListLiveSourcesResponse -> Maybe [LiveSource]
items :: Prelude.Maybe [LiveSource],
    -- | Pagination token returned by the list request when results exceed the
    -- maximum allowed. Use the token to fetch the next page of results.
    ListLiveSourcesResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    ListLiveSourcesResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ListLiveSourcesResponse -> ListLiveSourcesResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListLiveSourcesResponse -> ListLiveSourcesResponse -> Bool
$c/= :: ListLiveSourcesResponse -> ListLiveSourcesResponse -> Bool
== :: ListLiveSourcesResponse -> ListLiveSourcesResponse -> Bool
$c== :: ListLiveSourcesResponse -> ListLiveSourcesResponse -> Bool
Prelude.Eq, ReadPrec [ListLiveSourcesResponse]
ReadPrec ListLiveSourcesResponse
Int -> ReadS ListLiveSourcesResponse
ReadS [ListLiveSourcesResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListLiveSourcesResponse]
$creadListPrec :: ReadPrec [ListLiveSourcesResponse]
readPrec :: ReadPrec ListLiveSourcesResponse
$creadPrec :: ReadPrec ListLiveSourcesResponse
readList :: ReadS [ListLiveSourcesResponse]
$creadList :: ReadS [ListLiveSourcesResponse]
readsPrec :: Int -> ReadS ListLiveSourcesResponse
$creadsPrec :: Int -> ReadS ListLiveSourcesResponse
Prelude.Read, Int -> ListLiveSourcesResponse -> ShowS
[ListLiveSourcesResponse] -> ShowS
ListLiveSourcesResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListLiveSourcesResponse] -> ShowS
$cshowList :: [ListLiveSourcesResponse] -> ShowS
show :: ListLiveSourcesResponse -> String
$cshow :: ListLiveSourcesResponse -> String
showsPrec :: Int -> ListLiveSourcesResponse -> ShowS
$cshowsPrec :: Int -> ListLiveSourcesResponse -> ShowS
Prelude.Show, forall x. Rep ListLiveSourcesResponse x -> ListLiveSourcesResponse
forall x. ListLiveSourcesResponse -> Rep ListLiveSourcesResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListLiveSourcesResponse x -> ListLiveSourcesResponse
$cfrom :: forall x. ListLiveSourcesResponse -> Rep ListLiveSourcesResponse x
Prelude.Generic)

-- |
-- Create a value of 'ListLiveSourcesResponse' 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:
--
-- 'items', 'listLiveSourcesResponse_items' - Lists the live sources.
--
-- 'nextToken', 'listLiveSourcesResponse_nextToken' - Pagination token returned by the list request when results exceed the
-- maximum allowed. Use the token to fetch the next page of results.
--
-- 'httpStatus', 'listLiveSourcesResponse_httpStatus' - The response's http status code.
newListLiveSourcesResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ListLiveSourcesResponse
newListLiveSourcesResponse :: Int -> ListLiveSourcesResponse
newListLiveSourcesResponse Int
pHttpStatus_ =
  ListLiveSourcesResponse'
    { $sel:items:ListLiveSourcesResponse' :: Maybe [LiveSource]
items = forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListLiveSourcesResponse' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ListLiveSourcesResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Lists the live sources.
listLiveSourcesResponse_items :: Lens.Lens' ListLiveSourcesResponse (Prelude.Maybe [LiveSource])
listLiveSourcesResponse_items :: Lens' ListLiveSourcesResponse (Maybe [LiveSource])
listLiveSourcesResponse_items = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListLiveSourcesResponse' {Maybe [LiveSource]
items :: Maybe [LiveSource]
$sel:items:ListLiveSourcesResponse' :: ListLiveSourcesResponse -> Maybe [LiveSource]
items} -> Maybe [LiveSource]
items) (\s :: ListLiveSourcesResponse
s@ListLiveSourcesResponse' {} Maybe [LiveSource]
a -> ListLiveSourcesResponse
s {$sel:items:ListLiveSourcesResponse' :: Maybe [LiveSource]
items = Maybe [LiveSource]
a} :: ListLiveSourcesResponse) 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

-- | Pagination token returned by the list request when results exceed the
-- maximum allowed. Use the token to fetch the next page of results.
listLiveSourcesResponse_nextToken :: Lens.Lens' ListLiveSourcesResponse (Prelude.Maybe Prelude.Text)
listLiveSourcesResponse_nextToken :: Lens' ListLiveSourcesResponse (Maybe Text)
listLiveSourcesResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListLiveSourcesResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListLiveSourcesResponse' :: ListLiveSourcesResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListLiveSourcesResponse
s@ListLiveSourcesResponse' {} Maybe Text
a -> ListLiveSourcesResponse
s {$sel:nextToken:ListLiveSourcesResponse' :: Maybe Text
nextToken = Maybe Text
a} :: ListLiveSourcesResponse)

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

instance Prelude.NFData ListLiveSourcesResponse where
  rnf :: ListLiveSourcesResponse -> ()
rnf ListLiveSourcesResponse' {Int
Maybe [LiveSource]
Maybe Text
httpStatus :: Int
nextToken :: Maybe Text
items :: Maybe [LiveSource]
$sel:httpStatus:ListLiveSourcesResponse' :: ListLiveSourcesResponse -> Int
$sel:nextToken:ListLiveSourcesResponse' :: ListLiveSourcesResponse -> Maybe Text
$sel:items:ListLiveSourcesResponse' :: ListLiveSourcesResponse -> Maybe [LiveSource]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [LiveSource]
items
      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