{-# 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.GetChannelSchedule
-- 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 information about your channel\'s schedule.
--
-- This operation returns paginated results.
module Amazonka.MediaTailor.GetChannelSchedule
  ( -- * Creating a Request
    GetChannelSchedule (..),
    newGetChannelSchedule,

    -- * Request Lenses
    getChannelSchedule_durationMinutes,
    getChannelSchedule_maxResults,
    getChannelSchedule_nextToken,
    getChannelSchedule_channelName,

    -- * Destructuring the Response
    GetChannelScheduleResponse (..),
    newGetChannelScheduleResponse,

    -- * Response Lenses
    getChannelScheduleResponse_items,
    getChannelScheduleResponse_nextToken,
    getChannelScheduleResponse_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:/ 'newGetChannelSchedule' smart constructor.
data GetChannelSchedule = GetChannelSchedule'
  { -- | The duration in minutes of the channel schedule.
    GetChannelSchedule -> Maybe Text
durationMinutes :: Prelude.Maybe Prelude.Text,
    -- | The maximum number of channel schedules that you want MediaTailor to
    -- return in response to the current request. If there are more than
    -- @MaxResults@ channel schedules, use the value of @NextToken@ in the
    -- response to get the next page of results.
    GetChannelSchedule -> Maybe Natural
maxResults :: Prelude.Maybe Prelude.Natural,
    -- | (Optional) If the playback configuration has more than @MaxResults@
    -- channel schedules, use @NextToken@ to get the second and subsequent
    -- pages of results.
    --
    -- For the first @GetChannelScheduleRequest@ request, omit this value.
    --
    -- For the second and subsequent requests, get the value of @NextToken@
    -- from the previous response and specify that value for @NextToken@ in the
    -- request.
    --
    -- If the previous response didn\'t include a @NextToken@ element, there
    -- are no more channel schedules to get.
    GetChannelSchedule -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The name of the channel associated with this Channel Schedule.
    GetChannelSchedule -> Text
channelName :: Prelude.Text
  }
  deriving (GetChannelSchedule -> GetChannelSchedule -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetChannelSchedule -> GetChannelSchedule -> Bool
$c/= :: GetChannelSchedule -> GetChannelSchedule -> Bool
== :: GetChannelSchedule -> GetChannelSchedule -> Bool
$c== :: GetChannelSchedule -> GetChannelSchedule -> Bool
Prelude.Eq, ReadPrec [GetChannelSchedule]
ReadPrec GetChannelSchedule
Int -> ReadS GetChannelSchedule
ReadS [GetChannelSchedule]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetChannelSchedule]
$creadListPrec :: ReadPrec [GetChannelSchedule]
readPrec :: ReadPrec GetChannelSchedule
$creadPrec :: ReadPrec GetChannelSchedule
readList :: ReadS [GetChannelSchedule]
$creadList :: ReadS [GetChannelSchedule]
readsPrec :: Int -> ReadS GetChannelSchedule
$creadsPrec :: Int -> ReadS GetChannelSchedule
Prelude.Read, Int -> GetChannelSchedule -> ShowS
[GetChannelSchedule] -> ShowS
GetChannelSchedule -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetChannelSchedule] -> ShowS
$cshowList :: [GetChannelSchedule] -> ShowS
show :: GetChannelSchedule -> String
$cshow :: GetChannelSchedule -> String
showsPrec :: Int -> GetChannelSchedule -> ShowS
$cshowsPrec :: Int -> GetChannelSchedule -> ShowS
Prelude.Show, forall x. Rep GetChannelSchedule x -> GetChannelSchedule
forall x. GetChannelSchedule -> Rep GetChannelSchedule x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetChannelSchedule x -> GetChannelSchedule
$cfrom :: forall x. GetChannelSchedule -> Rep GetChannelSchedule x
Prelude.Generic)

-- |
-- Create a value of 'GetChannelSchedule' 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:
--
-- 'durationMinutes', 'getChannelSchedule_durationMinutes' - The duration in minutes of the channel schedule.
--
-- 'maxResults', 'getChannelSchedule_maxResults' - The maximum number of channel schedules that you want MediaTailor to
-- return in response to the current request. If there are more than
-- @MaxResults@ channel schedules, use the value of @NextToken@ in the
-- response to get the next page of results.
--
-- 'nextToken', 'getChannelSchedule_nextToken' - (Optional) If the playback configuration has more than @MaxResults@
-- channel schedules, use @NextToken@ to get the second and subsequent
-- pages of results.
--
-- For the first @GetChannelScheduleRequest@ request, omit this value.
--
-- For the second and subsequent requests, get the value of @NextToken@
-- from the previous response and specify that value for @NextToken@ in the
-- request.
--
-- If the previous response didn\'t include a @NextToken@ element, there
-- are no more channel schedules to get.
--
-- 'channelName', 'getChannelSchedule_channelName' - The name of the channel associated with this Channel Schedule.
newGetChannelSchedule ::
  -- | 'channelName'
  Prelude.Text ->
  GetChannelSchedule
newGetChannelSchedule :: Text -> GetChannelSchedule
newGetChannelSchedule Text
pChannelName_ =
  GetChannelSchedule'
    { $sel:durationMinutes:GetChannelSchedule' :: Maybe Text
durationMinutes =
        forall a. Maybe a
Prelude.Nothing,
      $sel:maxResults:GetChannelSchedule' :: Maybe Natural
maxResults = forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:GetChannelSchedule' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:channelName:GetChannelSchedule' :: Text
channelName = Text
pChannelName_
    }

-- | The duration in minutes of the channel schedule.
getChannelSchedule_durationMinutes :: Lens.Lens' GetChannelSchedule (Prelude.Maybe Prelude.Text)
getChannelSchedule_durationMinutes :: Lens' GetChannelSchedule (Maybe Text)
getChannelSchedule_durationMinutes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetChannelSchedule' {Maybe Text
durationMinutes :: Maybe Text
$sel:durationMinutes:GetChannelSchedule' :: GetChannelSchedule -> Maybe Text
durationMinutes} -> Maybe Text
durationMinutes) (\s :: GetChannelSchedule
s@GetChannelSchedule' {} Maybe Text
a -> GetChannelSchedule
s {$sel:durationMinutes:GetChannelSchedule' :: Maybe Text
durationMinutes = Maybe Text
a} :: GetChannelSchedule)

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

-- | (Optional) If the playback configuration has more than @MaxResults@
-- channel schedules, use @NextToken@ to get the second and subsequent
-- pages of results.
--
-- For the first @GetChannelScheduleRequest@ request, omit this value.
--
-- For the second and subsequent requests, get the value of @NextToken@
-- from the previous response and specify that value for @NextToken@ in the
-- request.
--
-- If the previous response didn\'t include a @NextToken@ element, there
-- are no more channel schedules to get.
getChannelSchedule_nextToken :: Lens.Lens' GetChannelSchedule (Prelude.Maybe Prelude.Text)
getChannelSchedule_nextToken :: Lens' GetChannelSchedule (Maybe Text)
getChannelSchedule_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetChannelSchedule' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:GetChannelSchedule' :: GetChannelSchedule -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: GetChannelSchedule
s@GetChannelSchedule' {} Maybe Text
a -> GetChannelSchedule
s {$sel:nextToken:GetChannelSchedule' :: Maybe Text
nextToken = Maybe Text
a} :: GetChannelSchedule)

-- | The name of the channel associated with this Channel Schedule.
getChannelSchedule_channelName :: Lens.Lens' GetChannelSchedule Prelude.Text
getChannelSchedule_channelName :: Lens' GetChannelSchedule Text
getChannelSchedule_channelName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetChannelSchedule' {Text
channelName :: Text
$sel:channelName:GetChannelSchedule' :: GetChannelSchedule -> Text
channelName} -> Text
channelName) (\s :: GetChannelSchedule
s@GetChannelSchedule' {} Text
a -> GetChannelSchedule
s {$sel:channelName:GetChannelSchedule' :: Text
channelName = Text
a} :: GetChannelSchedule)

instance Core.AWSPager GetChannelSchedule where
  page :: GetChannelSchedule
-> AWSResponse GetChannelSchedule -> Maybe GetChannelSchedule
page GetChannelSchedule
rq AWSResponse GetChannelSchedule
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse GetChannelSchedule
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' GetChannelScheduleResponse (Maybe Text)
getChannelScheduleResponse_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 GetChannelSchedule
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' GetChannelScheduleResponse (Maybe [ScheduleEntry])
getChannelScheduleResponse_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.$ GetChannelSchedule
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' GetChannelSchedule (Maybe Text)
getChannelSchedule_nextToken
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse GetChannelSchedule
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' GetChannelScheduleResponse (Maybe Text)
getChannelScheduleResponse_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 GetChannelSchedule where
  type
    AWSResponse GetChannelSchedule =
      GetChannelScheduleResponse
  request :: (Service -> Service)
-> GetChannelSchedule -> Request GetChannelSchedule
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 GetChannelSchedule
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse GetChannelSchedule)))
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 [ScheduleEntry]
-> Maybe Text -> Int -> GetChannelScheduleResponse
GetChannelScheduleResponse'
            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 GetChannelSchedule where
  hashWithSalt :: Int -> GetChannelSchedule -> Int
hashWithSalt Int
_salt GetChannelSchedule' {Maybe Natural
Maybe Text
Text
channelName :: Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
durationMinutes :: Maybe Text
$sel:channelName:GetChannelSchedule' :: GetChannelSchedule -> Text
$sel:nextToken:GetChannelSchedule' :: GetChannelSchedule -> Maybe Text
$sel:maxResults:GetChannelSchedule' :: GetChannelSchedule -> Maybe Natural
$sel:durationMinutes:GetChannelSchedule' :: GetChannelSchedule -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
durationMinutes
      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
channelName

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

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

instance Data.ToQuery GetChannelSchedule where
  toQuery :: GetChannelSchedule -> QueryString
toQuery GetChannelSchedule' {Maybe Natural
Maybe Text
Text
channelName :: Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
durationMinutes :: Maybe Text
$sel:channelName:GetChannelSchedule' :: GetChannelSchedule -> Text
$sel:nextToken:GetChannelSchedule' :: GetChannelSchedule -> Maybe Text
$sel:maxResults:GetChannelSchedule' :: GetChannelSchedule -> Maybe Natural
$sel:durationMinutes:GetChannelSchedule' :: GetChannelSchedule -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"durationMinutes" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
durationMinutes,
        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:/ 'newGetChannelScheduleResponse' smart constructor.
data GetChannelScheduleResponse = GetChannelScheduleResponse'
  { -- | A list of schedule entries for the channel.
    GetChannelScheduleResponse -> Maybe [ScheduleEntry]
items :: Prelude.Maybe [ScheduleEntry],
    -- | Pagination token returned by the list request when results exceed the
    -- maximum allowed. Use the token to fetch the next page of results.
    GetChannelScheduleResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    GetChannelScheduleResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetChannelScheduleResponse -> GetChannelScheduleResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetChannelScheduleResponse -> GetChannelScheduleResponse -> Bool
$c/= :: GetChannelScheduleResponse -> GetChannelScheduleResponse -> Bool
== :: GetChannelScheduleResponse -> GetChannelScheduleResponse -> Bool
$c== :: GetChannelScheduleResponse -> GetChannelScheduleResponse -> Bool
Prelude.Eq, ReadPrec [GetChannelScheduleResponse]
ReadPrec GetChannelScheduleResponse
Int -> ReadS GetChannelScheduleResponse
ReadS [GetChannelScheduleResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetChannelScheduleResponse]
$creadListPrec :: ReadPrec [GetChannelScheduleResponse]
readPrec :: ReadPrec GetChannelScheduleResponse
$creadPrec :: ReadPrec GetChannelScheduleResponse
readList :: ReadS [GetChannelScheduleResponse]
$creadList :: ReadS [GetChannelScheduleResponse]
readsPrec :: Int -> ReadS GetChannelScheduleResponse
$creadsPrec :: Int -> ReadS GetChannelScheduleResponse
Prelude.Read, Int -> GetChannelScheduleResponse -> ShowS
[GetChannelScheduleResponse] -> ShowS
GetChannelScheduleResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetChannelScheduleResponse] -> ShowS
$cshowList :: [GetChannelScheduleResponse] -> ShowS
show :: GetChannelScheduleResponse -> String
$cshow :: GetChannelScheduleResponse -> String
showsPrec :: Int -> GetChannelScheduleResponse -> ShowS
$cshowsPrec :: Int -> GetChannelScheduleResponse -> ShowS
Prelude.Show, forall x.
Rep GetChannelScheduleResponse x -> GetChannelScheduleResponse
forall x.
GetChannelScheduleResponse -> Rep GetChannelScheduleResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetChannelScheduleResponse x -> GetChannelScheduleResponse
$cfrom :: forall x.
GetChannelScheduleResponse -> Rep GetChannelScheduleResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetChannelScheduleResponse' 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', 'getChannelScheduleResponse_items' - A list of schedule entries for the channel.
--
-- 'nextToken', 'getChannelScheduleResponse_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', 'getChannelScheduleResponse_httpStatus' - The response's http status code.
newGetChannelScheduleResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetChannelScheduleResponse
newGetChannelScheduleResponse :: Int -> GetChannelScheduleResponse
newGetChannelScheduleResponse Int
pHttpStatus_ =
  GetChannelScheduleResponse'
    { $sel:items:GetChannelScheduleResponse' :: Maybe [ScheduleEntry]
items =
        forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:GetChannelScheduleResponse' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetChannelScheduleResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | A list of schedule entries for the channel.
getChannelScheduleResponse_items :: Lens.Lens' GetChannelScheduleResponse (Prelude.Maybe [ScheduleEntry])
getChannelScheduleResponse_items :: Lens' GetChannelScheduleResponse (Maybe [ScheduleEntry])
getChannelScheduleResponse_items = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetChannelScheduleResponse' {Maybe [ScheduleEntry]
items :: Maybe [ScheduleEntry]
$sel:items:GetChannelScheduleResponse' :: GetChannelScheduleResponse -> Maybe [ScheduleEntry]
items} -> Maybe [ScheduleEntry]
items) (\s :: GetChannelScheduleResponse
s@GetChannelScheduleResponse' {} Maybe [ScheduleEntry]
a -> GetChannelScheduleResponse
s {$sel:items:GetChannelScheduleResponse' :: Maybe [ScheduleEntry]
items = Maybe [ScheduleEntry]
a} :: GetChannelScheduleResponse) 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.
getChannelScheduleResponse_nextToken :: Lens.Lens' GetChannelScheduleResponse (Prelude.Maybe Prelude.Text)
getChannelScheduleResponse_nextToken :: Lens' GetChannelScheduleResponse (Maybe Text)
getChannelScheduleResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetChannelScheduleResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:GetChannelScheduleResponse' :: GetChannelScheduleResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: GetChannelScheduleResponse
s@GetChannelScheduleResponse' {} Maybe Text
a -> GetChannelScheduleResponse
s {$sel:nextToken:GetChannelScheduleResponse' :: Maybe Text
nextToken = Maybe Text
a} :: GetChannelScheduleResponse)

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

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