{-# 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.MediaLive.ListMultiplexPrograms
-- 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 programs that currently exist for a specific multiplex.
--
-- This operation returns paginated results.
module Amazonka.MediaLive.ListMultiplexPrograms
  ( -- * Creating a Request
    ListMultiplexPrograms (..),
    newListMultiplexPrograms,

    -- * Request Lenses
    listMultiplexPrograms_maxResults,
    listMultiplexPrograms_nextToken,
    listMultiplexPrograms_multiplexId,

    -- * Destructuring the Response
    ListMultiplexProgramsResponse (..),
    newListMultiplexProgramsResponse,

    -- * Response Lenses
    listMultiplexProgramsResponse_multiplexPrograms,
    listMultiplexProgramsResponse_nextToken,
    listMultiplexProgramsResponse_httpStatus,
  )
where

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

-- | Placeholder documentation for ListMultiplexProgramsRequest
--
-- /See:/ 'newListMultiplexPrograms' smart constructor.
data ListMultiplexPrograms = ListMultiplexPrograms'
  { -- | The maximum number of items to return.
    ListMultiplexPrograms -> Maybe Natural
maxResults :: Prelude.Maybe Prelude.Natural,
    -- | The token to retrieve the next page of results.
    ListMultiplexPrograms -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The ID of the multiplex that the programs belong to.
    ListMultiplexPrograms -> Text
multiplexId :: Prelude.Text
  }
  deriving (ListMultiplexPrograms -> ListMultiplexPrograms -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListMultiplexPrograms -> ListMultiplexPrograms -> Bool
$c/= :: ListMultiplexPrograms -> ListMultiplexPrograms -> Bool
== :: ListMultiplexPrograms -> ListMultiplexPrograms -> Bool
$c== :: ListMultiplexPrograms -> ListMultiplexPrograms -> Bool
Prelude.Eq, ReadPrec [ListMultiplexPrograms]
ReadPrec ListMultiplexPrograms
Int -> ReadS ListMultiplexPrograms
ReadS [ListMultiplexPrograms]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListMultiplexPrograms]
$creadListPrec :: ReadPrec [ListMultiplexPrograms]
readPrec :: ReadPrec ListMultiplexPrograms
$creadPrec :: ReadPrec ListMultiplexPrograms
readList :: ReadS [ListMultiplexPrograms]
$creadList :: ReadS [ListMultiplexPrograms]
readsPrec :: Int -> ReadS ListMultiplexPrograms
$creadsPrec :: Int -> ReadS ListMultiplexPrograms
Prelude.Read, Int -> ListMultiplexPrograms -> ShowS
[ListMultiplexPrograms] -> ShowS
ListMultiplexPrograms -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListMultiplexPrograms] -> ShowS
$cshowList :: [ListMultiplexPrograms] -> ShowS
show :: ListMultiplexPrograms -> String
$cshow :: ListMultiplexPrograms -> String
showsPrec :: Int -> ListMultiplexPrograms -> ShowS
$cshowsPrec :: Int -> ListMultiplexPrograms -> ShowS
Prelude.Show, forall x. Rep ListMultiplexPrograms x -> ListMultiplexPrograms
forall x. ListMultiplexPrograms -> Rep ListMultiplexPrograms x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListMultiplexPrograms x -> ListMultiplexPrograms
$cfrom :: forall x. ListMultiplexPrograms -> Rep ListMultiplexPrograms x
Prelude.Generic)

-- |
-- Create a value of 'ListMultiplexPrograms' 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', 'listMultiplexPrograms_maxResults' - The maximum number of items to return.
--
-- 'nextToken', 'listMultiplexPrograms_nextToken' - The token to retrieve the next page of results.
--
-- 'multiplexId', 'listMultiplexPrograms_multiplexId' - The ID of the multiplex that the programs belong to.
newListMultiplexPrograms ::
  -- | 'multiplexId'
  Prelude.Text ->
  ListMultiplexPrograms
newListMultiplexPrograms :: Text -> ListMultiplexPrograms
newListMultiplexPrograms Text
pMultiplexId_ =
  ListMultiplexPrograms'
    { $sel:maxResults:ListMultiplexPrograms' :: Maybe Natural
maxResults =
        forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListMultiplexPrograms' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:multiplexId:ListMultiplexPrograms' :: Text
multiplexId = Text
pMultiplexId_
    }

-- | The maximum number of items to return.
listMultiplexPrograms_maxResults :: Lens.Lens' ListMultiplexPrograms (Prelude.Maybe Prelude.Natural)
listMultiplexPrograms_maxResults :: Lens' ListMultiplexPrograms (Maybe Natural)
listMultiplexPrograms_maxResults = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListMultiplexPrograms' {Maybe Natural
maxResults :: Maybe Natural
$sel:maxResults:ListMultiplexPrograms' :: ListMultiplexPrograms -> Maybe Natural
maxResults} -> Maybe Natural
maxResults) (\s :: ListMultiplexPrograms
s@ListMultiplexPrograms' {} Maybe Natural
a -> ListMultiplexPrograms
s {$sel:maxResults:ListMultiplexPrograms' :: Maybe Natural
maxResults = Maybe Natural
a} :: ListMultiplexPrograms)

-- | The token to retrieve the next page of results.
listMultiplexPrograms_nextToken :: Lens.Lens' ListMultiplexPrograms (Prelude.Maybe Prelude.Text)
listMultiplexPrograms_nextToken :: Lens' ListMultiplexPrograms (Maybe Text)
listMultiplexPrograms_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListMultiplexPrograms' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListMultiplexPrograms' :: ListMultiplexPrograms -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListMultiplexPrograms
s@ListMultiplexPrograms' {} Maybe Text
a -> ListMultiplexPrograms
s {$sel:nextToken:ListMultiplexPrograms' :: Maybe Text
nextToken = Maybe Text
a} :: ListMultiplexPrograms)

-- | The ID of the multiplex that the programs belong to.
listMultiplexPrograms_multiplexId :: Lens.Lens' ListMultiplexPrograms Prelude.Text
listMultiplexPrograms_multiplexId :: Lens' ListMultiplexPrograms Text
listMultiplexPrograms_multiplexId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListMultiplexPrograms' {Text
multiplexId :: Text
$sel:multiplexId:ListMultiplexPrograms' :: ListMultiplexPrograms -> Text
multiplexId} -> Text
multiplexId) (\s :: ListMultiplexPrograms
s@ListMultiplexPrograms' {} Text
a -> ListMultiplexPrograms
s {$sel:multiplexId:ListMultiplexPrograms' :: Text
multiplexId = Text
a} :: ListMultiplexPrograms)

instance Core.AWSPager ListMultiplexPrograms where
  page :: ListMultiplexPrograms
-> AWSResponse ListMultiplexPrograms -> Maybe ListMultiplexPrograms
page ListMultiplexPrograms
rq AWSResponse ListMultiplexPrograms
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse ListMultiplexPrograms
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListMultiplexProgramsResponse (Maybe Text)
listMultiplexProgramsResponse_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 ListMultiplexPrograms
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens'
  ListMultiplexProgramsResponse (Maybe [MultiplexProgramSummary])
listMultiplexProgramsResponse_multiplexPrograms
            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.$ ListMultiplexPrograms
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' ListMultiplexPrograms (Maybe Text)
listMultiplexPrograms_nextToken
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse ListMultiplexPrograms
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListMultiplexProgramsResponse (Maybe Text)
listMultiplexProgramsResponse_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 ListMultiplexPrograms where
  type
    AWSResponse ListMultiplexPrograms =
      ListMultiplexProgramsResponse
  request :: (Service -> Service)
-> ListMultiplexPrograms -> Request ListMultiplexPrograms
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 ListMultiplexPrograms
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse ListMultiplexPrograms)))
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 [MultiplexProgramSummary]
-> Maybe Text -> Int -> ListMultiplexProgramsResponse
ListMultiplexProgramsResponse'
            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
"multiplexPrograms"
                            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 ListMultiplexPrograms where
  hashWithSalt :: Int -> ListMultiplexPrograms -> Int
hashWithSalt Int
_salt ListMultiplexPrograms' {Maybe Natural
Maybe Text
Text
multiplexId :: Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:multiplexId:ListMultiplexPrograms' :: ListMultiplexPrograms -> Text
$sel:nextToken:ListMultiplexPrograms' :: ListMultiplexPrograms -> Maybe Text
$sel:maxResults:ListMultiplexPrograms' :: ListMultiplexPrograms -> 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
multiplexId

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

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

instance Data.ToQuery ListMultiplexPrograms where
  toQuery :: ListMultiplexPrograms -> QueryString
toQuery ListMultiplexPrograms' {Maybe Natural
Maybe Text
Text
multiplexId :: Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:multiplexId:ListMultiplexPrograms' :: ListMultiplexPrograms -> Text
$sel:nextToken:ListMultiplexPrograms' :: ListMultiplexPrograms -> Maybe Text
$sel:maxResults:ListMultiplexPrograms' :: ListMultiplexPrograms -> 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
      ]

-- | Placeholder documentation for ListMultiplexProgramsResponse
--
-- /See:/ 'newListMultiplexProgramsResponse' smart constructor.
data ListMultiplexProgramsResponse = ListMultiplexProgramsResponse'
  { -- | List of multiplex programs.
    ListMultiplexProgramsResponse -> Maybe [MultiplexProgramSummary]
multiplexPrograms :: Prelude.Maybe [MultiplexProgramSummary],
    -- | Token for the next ListMultiplexProgram request.
    ListMultiplexProgramsResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    ListMultiplexProgramsResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ListMultiplexProgramsResponse
-> ListMultiplexProgramsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListMultiplexProgramsResponse
-> ListMultiplexProgramsResponse -> Bool
$c/= :: ListMultiplexProgramsResponse
-> ListMultiplexProgramsResponse -> Bool
== :: ListMultiplexProgramsResponse
-> ListMultiplexProgramsResponse -> Bool
$c== :: ListMultiplexProgramsResponse
-> ListMultiplexProgramsResponse -> Bool
Prelude.Eq, ReadPrec [ListMultiplexProgramsResponse]
ReadPrec ListMultiplexProgramsResponse
Int -> ReadS ListMultiplexProgramsResponse
ReadS [ListMultiplexProgramsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListMultiplexProgramsResponse]
$creadListPrec :: ReadPrec [ListMultiplexProgramsResponse]
readPrec :: ReadPrec ListMultiplexProgramsResponse
$creadPrec :: ReadPrec ListMultiplexProgramsResponse
readList :: ReadS [ListMultiplexProgramsResponse]
$creadList :: ReadS [ListMultiplexProgramsResponse]
readsPrec :: Int -> ReadS ListMultiplexProgramsResponse
$creadsPrec :: Int -> ReadS ListMultiplexProgramsResponse
Prelude.Read, Int -> ListMultiplexProgramsResponse -> ShowS
[ListMultiplexProgramsResponse] -> ShowS
ListMultiplexProgramsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListMultiplexProgramsResponse] -> ShowS
$cshowList :: [ListMultiplexProgramsResponse] -> ShowS
show :: ListMultiplexProgramsResponse -> String
$cshow :: ListMultiplexProgramsResponse -> String
showsPrec :: Int -> ListMultiplexProgramsResponse -> ShowS
$cshowsPrec :: Int -> ListMultiplexProgramsResponse -> ShowS
Prelude.Show, forall x.
Rep ListMultiplexProgramsResponse x
-> ListMultiplexProgramsResponse
forall x.
ListMultiplexProgramsResponse
-> Rep ListMultiplexProgramsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ListMultiplexProgramsResponse x
-> ListMultiplexProgramsResponse
$cfrom :: forall x.
ListMultiplexProgramsResponse
-> Rep ListMultiplexProgramsResponse x
Prelude.Generic)

-- |
-- Create a value of 'ListMultiplexProgramsResponse' 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:
--
-- 'multiplexPrograms', 'listMultiplexProgramsResponse_multiplexPrograms' - List of multiplex programs.
--
-- 'nextToken', 'listMultiplexProgramsResponse_nextToken' - Token for the next ListMultiplexProgram request.
--
-- 'httpStatus', 'listMultiplexProgramsResponse_httpStatus' - The response's http status code.
newListMultiplexProgramsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ListMultiplexProgramsResponse
newListMultiplexProgramsResponse :: Int -> ListMultiplexProgramsResponse
newListMultiplexProgramsResponse Int
pHttpStatus_ =
  ListMultiplexProgramsResponse'
    { $sel:multiplexPrograms:ListMultiplexProgramsResponse' :: Maybe [MultiplexProgramSummary]
multiplexPrograms =
        forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListMultiplexProgramsResponse' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ListMultiplexProgramsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | List of multiplex programs.
listMultiplexProgramsResponse_multiplexPrograms :: Lens.Lens' ListMultiplexProgramsResponse (Prelude.Maybe [MultiplexProgramSummary])
listMultiplexProgramsResponse_multiplexPrograms :: Lens'
  ListMultiplexProgramsResponse (Maybe [MultiplexProgramSummary])
listMultiplexProgramsResponse_multiplexPrograms = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListMultiplexProgramsResponse' {Maybe [MultiplexProgramSummary]
multiplexPrograms :: Maybe [MultiplexProgramSummary]
$sel:multiplexPrograms:ListMultiplexProgramsResponse' :: ListMultiplexProgramsResponse -> Maybe [MultiplexProgramSummary]
multiplexPrograms} -> Maybe [MultiplexProgramSummary]
multiplexPrograms) (\s :: ListMultiplexProgramsResponse
s@ListMultiplexProgramsResponse' {} Maybe [MultiplexProgramSummary]
a -> ListMultiplexProgramsResponse
s {$sel:multiplexPrograms:ListMultiplexProgramsResponse' :: Maybe [MultiplexProgramSummary]
multiplexPrograms = Maybe [MultiplexProgramSummary]
a} :: ListMultiplexProgramsResponse) 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

-- | Token for the next ListMultiplexProgram request.
listMultiplexProgramsResponse_nextToken :: Lens.Lens' ListMultiplexProgramsResponse (Prelude.Maybe Prelude.Text)
listMultiplexProgramsResponse_nextToken :: Lens' ListMultiplexProgramsResponse (Maybe Text)
listMultiplexProgramsResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListMultiplexProgramsResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListMultiplexProgramsResponse' :: ListMultiplexProgramsResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListMultiplexProgramsResponse
s@ListMultiplexProgramsResponse' {} Maybe Text
a -> ListMultiplexProgramsResponse
s {$sel:nextToken:ListMultiplexProgramsResponse' :: Maybe Text
nextToken = Maybe Text
a} :: ListMultiplexProgramsResponse)

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

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