{-# 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.ListPrefetchSchedules
-- 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 prefetch schedules for a playback configuration.
--
-- This operation returns paginated results.
module Amazonka.MediaTailor.ListPrefetchSchedules
  ( -- * Creating a Request
    ListPrefetchSchedules (..),
    newListPrefetchSchedules,

    -- * Request Lenses
    listPrefetchSchedules_maxResults,
    listPrefetchSchedules_nextToken,
    listPrefetchSchedules_streamId,
    listPrefetchSchedules_playbackConfigurationName,

    -- * Destructuring the Response
    ListPrefetchSchedulesResponse (..),
    newListPrefetchSchedulesResponse,

    -- * Response Lenses
    listPrefetchSchedulesResponse_items,
    listPrefetchSchedulesResponse_nextToken,
    listPrefetchSchedulesResponse_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:/ 'newListPrefetchSchedules' smart constructor.
data ListPrefetchSchedules = ListPrefetchSchedules'
  { -- | The maximum number of prefetch schedules that you want MediaTailor to
    -- return in response to the current request. If there are more than
    -- @MaxResults@ prefetch schedules, use the value of @NextToken@ in the
    -- response to get the next page of results.
    ListPrefetchSchedules -> Maybe Natural
maxResults :: Prelude.Maybe Prelude.Natural,
    -- | (Optional) If the playback configuration has more than @MaxResults@
    -- prefetch schedules, use @NextToken@ to get the second and subsequent
    -- pages of results.
    --
    -- For the first @ListPrefetchSchedulesRequest@ 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 prefetch schedules to get.
    ListPrefetchSchedules -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | An optional filtering parameter whereby MediaTailor filters the prefetch
    -- schedules to include only specific streams.
    ListPrefetchSchedules -> Maybe Text
streamId :: Prelude.Maybe Prelude.Text,
    -- | Retrieves the prefetch schedule(s) for a specific playback
    -- configuration.
    ListPrefetchSchedules -> Text
playbackConfigurationName :: Prelude.Text
  }
  deriving (ListPrefetchSchedules -> ListPrefetchSchedules -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListPrefetchSchedules -> ListPrefetchSchedules -> Bool
$c/= :: ListPrefetchSchedules -> ListPrefetchSchedules -> Bool
== :: ListPrefetchSchedules -> ListPrefetchSchedules -> Bool
$c== :: ListPrefetchSchedules -> ListPrefetchSchedules -> Bool
Prelude.Eq, ReadPrec [ListPrefetchSchedules]
ReadPrec ListPrefetchSchedules
Int -> ReadS ListPrefetchSchedules
ReadS [ListPrefetchSchedules]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListPrefetchSchedules]
$creadListPrec :: ReadPrec [ListPrefetchSchedules]
readPrec :: ReadPrec ListPrefetchSchedules
$creadPrec :: ReadPrec ListPrefetchSchedules
readList :: ReadS [ListPrefetchSchedules]
$creadList :: ReadS [ListPrefetchSchedules]
readsPrec :: Int -> ReadS ListPrefetchSchedules
$creadsPrec :: Int -> ReadS ListPrefetchSchedules
Prelude.Read, Int -> ListPrefetchSchedules -> ShowS
[ListPrefetchSchedules] -> ShowS
ListPrefetchSchedules -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListPrefetchSchedules] -> ShowS
$cshowList :: [ListPrefetchSchedules] -> ShowS
show :: ListPrefetchSchedules -> String
$cshow :: ListPrefetchSchedules -> String
showsPrec :: Int -> ListPrefetchSchedules -> ShowS
$cshowsPrec :: Int -> ListPrefetchSchedules -> ShowS
Prelude.Show, forall x. Rep ListPrefetchSchedules x -> ListPrefetchSchedules
forall x. ListPrefetchSchedules -> Rep ListPrefetchSchedules x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListPrefetchSchedules x -> ListPrefetchSchedules
$cfrom :: forall x. ListPrefetchSchedules -> Rep ListPrefetchSchedules x
Prelude.Generic)

-- |
-- Create a value of 'ListPrefetchSchedules' 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', 'listPrefetchSchedules_maxResults' - The maximum number of prefetch schedules that you want MediaTailor to
-- return in response to the current request. If there are more than
-- @MaxResults@ prefetch schedules, use the value of @NextToken@ in the
-- response to get the next page of results.
--
-- 'nextToken', 'listPrefetchSchedules_nextToken' - (Optional) If the playback configuration has more than @MaxResults@
-- prefetch schedules, use @NextToken@ to get the second and subsequent
-- pages of results.
--
-- For the first @ListPrefetchSchedulesRequest@ 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 prefetch schedules to get.
--
-- 'streamId', 'listPrefetchSchedules_streamId' - An optional filtering parameter whereby MediaTailor filters the prefetch
-- schedules to include only specific streams.
--
-- 'playbackConfigurationName', 'listPrefetchSchedules_playbackConfigurationName' - Retrieves the prefetch schedule(s) for a specific playback
-- configuration.
newListPrefetchSchedules ::
  -- | 'playbackConfigurationName'
  Prelude.Text ->
  ListPrefetchSchedules
newListPrefetchSchedules :: Text -> ListPrefetchSchedules
newListPrefetchSchedules Text
pPlaybackConfigurationName_ =
  ListPrefetchSchedules'
    { $sel:maxResults:ListPrefetchSchedules' :: Maybe Natural
maxResults =
        forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListPrefetchSchedules' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:streamId:ListPrefetchSchedules' :: Maybe Text
streamId = forall a. Maybe a
Prelude.Nothing,
      $sel:playbackConfigurationName:ListPrefetchSchedules' :: Text
playbackConfigurationName =
        Text
pPlaybackConfigurationName_
    }

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

-- | (Optional) If the playback configuration has more than @MaxResults@
-- prefetch schedules, use @NextToken@ to get the second and subsequent
-- pages of results.
--
-- For the first @ListPrefetchSchedulesRequest@ 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 prefetch schedules to get.
listPrefetchSchedules_nextToken :: Lens.Lens' ListPrefetchSchedules (Prelude.Maybe Prelude.Text)
listPrefetchSchedules_nextToken :: Lens' ListPrefetchSchedules (Maybe Text)
listPrefetchSchedules_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListPrefetchSchedules' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListPrefetchSchedules' :: ListPrefetchSchedules -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListPrefetchSchedules
s@ListPrefetchSchedules' {} Maybe Text
a -> ListPrefetchSchedules
s {$sel:nextToken:ListPrefetchSchedules' :: Maybe Text
nextToken = Maybe Text
a} :: ListPrefetchSchedules)

-- | An optional filtering parameter whereby MediaTailor filters the prefetch
-- schedules to include only specific streams.
listPrefetchSchedules_streamId :: Lens.Lens' ListPrefetchSchedules (Prelude.Maybe Prelude.Text)
listPrefetchSchedules_streamId :: Lens' ListPrefetchSchedules (Maybe Text)
listPrefetchSchedules_streamId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListPrefetchSchedules' {Maybe Text
streamId :: Maybe Text
$sel:streamId:ListPrefetchSchedules' :: ListPrefetchSchedules -> Maybe Text
streamId} -> Maybe Text
streamId) (\s :: ListPrefetchSchedules
s@ListPrefetchSchedules' {} Maybe Text
a -> ListPrefetchSchedules
s {$sel:streamId:ListPrefetchSchedules' :: Maybe Text
streamId = Maybe Text
a} :: ListPrefetchSchedules)

-- | Retrieves the prefetch schedule(s) for a specific playback
-- configuration.
listPrefetchSchedules_playbackConfigurationName :: Lens.Lens' ListPrefetchSchedules Prelude.Text
listPrefetchSchedules_playbackConfigurationName :: Lens' ListPrefetchSchedules Text
listPrefetchSchedules_playbackConfigurationName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListPrefetchSchedules' {Text
playbackConfigurationName :: Text
$sel:playbackConfigurationName:ListPrefetchSchedules' :: ListPrefetchSchedules -> Text
playbackConfigurationName} -> Text
playbackConfigurationName) (\s :: ListPrefetchSchedules
s@ListPrefetchSchedules' {} Text
a -> ListPrefetchSchedules
s {$sel:playbackConfigurationName:ListPrefetchSchedules' :: Text
playbackConfigurationName = Text
a} :: ListPrefetchSchedules)

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

instance Prelude.NFData ListPrefetchSchedules where
  rnf :: ListPrefetchSchedules -> ()
rnf ListPrefetchSchedules' {Maybe Natural
Maybe Text
Text
playbackConfigurationName :: Text
streamId :: Maybe Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:playbackConfigurationName:ListPrefetchSchedules' :: ListPrefetchSchedules -> Text
$sel:streamId:ListPrefetchSchedules' :: ListPrefetchSchedules -> Maybe Text
$sel:nextToken:ListPrefetchSchedules' :: ListPrefetchSchedules -> Maybe Text
$sel:maxResults:ListPrefetchSchedules' :: ListPrefetchSchedules -> 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 Maybe Text
streamId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
playbackConfigurationName

instance Data.ToHeaders ListPrefetchSchedules where
  toHeaders :: ListPrefetchSchedules -> 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.ToJSON ListPrefetchSchedules where
  toJSON :: ListPrefetchSchedules -> Value
toJSON ListPrefetchSchedules' {Maybe Natural
Maybe Text
Text
playbackConfigurationName :: Text
streamId :: Maybe Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:playbackConfigurationName:ListPrefetchSchedules' :: ListPrefetchSchedules -> Text
$sel:streamId:ListPrefetchSchedules' :: ListPrefetchSchedules -> Maybe Text
$sel:nextToken:ListPrefetchSchedules' :: ListPrefetchSchedules -> Maybe Text
$sel:maxResults:ListPrefetchSchedules' :: ListPrefetchSchedules -> Maybe Natural
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (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
"StreamId" 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
streamId
          ]
      )

instance Data.ToPath ListPrefetchSchedules where
  toPath :: ListPrefetchSchedules -> ByteString
toPath ListPrefetchSchedules' {Maybe Natural
Maybe Text
Text
playbackConfigurationName :: Text
streamId :: Maybe Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:playbackConfigurationName:ListPrefetchSchedules' :: ListPrefetchSchedules -> Text
$sel:streamId:ListPrefetchSchedules' :: ListPrefetchSchedules -> Maybe Text
$sel:nextToken:ListPrefetchSchedules' :: ListPrefetchSchedules -> Maybe Text
$sel:maxResults:ListPrefetchSchedules' :: ListPrefetchSchedules -> Maybe Natural
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/prefetchSchedule/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
playbackConfigurationName
      ]

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

-- | /See:/ 'newListPrefetchSchedulesResponse' smart constructor.
data ListPrefetchSchedulesResponse = ListPrefetchSchedulesResponse'
  { -- | Lists the prefetch schedules. An empty @Items@ list doesn\'t mean there
    -- aren\'t more items to fetch, just that that page was empty.
    ListPrefetchSchedulesResponse -> Maybe [PrefetchSchedule]
items :: Prelude.Maybe [PrefetchSchedule],
    -- | Pagination token returned by the list request when results exceed the
    -- maximum allowed. Use the token to fetch the next page of results.
    ListPrefetchSchedulesResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    ListPrefetchSchedulesResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ListPrefetchSchedulesResponse
-> ListPrefetchSchedulesResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListPrefetchSchedulesResponse
-> ListPrefetchSchedulesResponse -> Bool
$c/= :: ListPrefetchSchedulesResponse
-> ListPrefetchSchedulesResponse -> Bool
== :: ListPrefetchSchedulesResponse
-> ListPrefetchSchedulesResponse -> Bool
$c== :: ListPrefetchSchedulesResponse
-> ListPrefetchSchedulesResponse -> Bool
Prelude.Eq, ReadPrec [ListPrefetchSchedulesResponse]
ReadPrec ListPrefetchSchedulesResponse
Int -> ReadS ListPrefetchSchedulesResponse
ReadS [ListPrefetchSchedulesResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListPrefetchSchedulesResponse]
$creadListPrec :: ReadPrec [ListPrefetchSchedulesResponse]
readPrec :: ReadPrec ListPrefetchSchedulesResponse
$creadPrec :: ReadPrec ListPrefetchSchedulesResponse
readList :: ReadS [ListPrefetchSchedulesResponse]
$creadList :: ReadS [ListPrefetchSchedulesResponse]
readsPrec :: Int -> ReadS ListPrefetchSchedulesResponse
$creadsPrec :: Int -> ReadS ListPrefetchSchedulesResponse
Prelude.Read, Int -> ListPrefetchSchedulesResponse -> ShowS
[ListPrefetchSchedulesResponse] -> ShowS
ListPrefetchSchedulesResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListPrefetchSchedulesResponse] -> ShowS
$cshowList :: [ListPrefetchSchedulesResponse] -> ShowS
show :: ListPrefetchSchedulesResponse -> String
$cshow :: ListPrefetchSchedulesResponse -> String
showsPrec :: Int -> ListPrefetchSchedulesResponse -> ShowS
$cshowsPrec :: Int -> ListPrefetchSchedulesResponse -> ShowS
Prelude.Show, forall x.
Rep ListPrefetchSchedulesResponse x
-> ListPrefetchSchedulesResponse
forall x.
ListPrefetchSchedulesResponse
-> Rep ListPrefetchSchedulesResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ListPrefetchSchedulesResponse x
-> ListPrefetchSchedulesResponse
$cfrom :: forall x.
ListPrefetchSchedulesResponse
-> Rep ListPrefetchSchedulesResponse x
Prelude.Generic)

-- |
-- Create a value of 'ListPrefetchSchedulesResponse' 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', 'listPrefetchSchedulesResponse_items' - Lists the prefetch schedules. An empty @Items@ list doesn\'t mean there
-- aren\'t more items to fetch, just that that page was empty.
--
-- 'nextToken', 'listPrefetchSchedulesResponse_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', 'listPrefetchSchedulesResponse_httpStatus' - The response's http status code.
newListPrefetchSchedulesResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ListPrefetchSchedulesResponse
newListPrefetchSchedulesResponse :: Int -> ListPrefetchSchedulesResponse
newListPrefetchSchedulesResponse Int
pHttpStatus_ =
  ListPrefetchSchedulesResponse'
    { $sel:items:ListPrefetchSchedulesResponse' :: Maybe [PrefetchSchedule]
items =
        forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListPrefetchSchedulesResponse' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ListPrefetchSchedulesResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Lists the prefetch schedules. An empty @Items@ list doesn\'t mean there
-- aren\'t more items to fetch, just that that page was empty.
listPrefetchSchedulesResponse_items :: Lens.Lens' ListPrefetchSchedulesResponse (Prelude.Maybe [PrefetchSchedule])
listPrefetchSchedulesResponse_items :: Lens' ListPrefetchSchedulesResponse (Maybe [PrefetchSchedule])
listPrefetchSchedulesResponse_items = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListPrefetchSchedulesResponse' {Maybe [PrefetchSchedule]
items :: Maybe [PrefetchSchedule]
$sel:items:ListPrefetchSchedulesResponse' :: ListPrefetchSchedulesResponse -> Maybe [PrefetchSchedule]
items} -> Maybe [PrefetchSchedule]
items) (\s :: ListPrefetchSchedulesResponse
s@ListPrefetchSchedulesResponse' {} Maybe [PrefetchSchedule]
a -> ListPrefetchSchedulesResponse
s {$sel:items:ListPrefetchSchedulesResponse' :: Maybe [PrefetchSchedule]
items = Maybe [PrefetchSchedule]
a} :: ListPrefetchSchedulesResponse) 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.
listPrefetchSchedulesResponse_nextToken :: Lens.Lens' ListPrefetchSchedulesResponse (Prelude.Maybe Prelude.Text)
listPrefetchSchedulesResponse_nextToken :: Lens' ListPrefetchSchedulesResponse (Maybe Text)
listPrefetchSchedulesResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListPrefetchSchedulesResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListPrefetchSchedulesResponse' :: ListPrefetchSchedulesResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListPrefetchSchedulesResponse
s@ListPrefetchSchedulesResponse' {} Maybe Text
a -> ListPrefetchSchedulesResponse
s {$sel:nextToken:ListPrefetchSchedulesResponse' :: Maybe Text
nextToken = Maybe Text
a} :: ListPrefetchSchedulesResponse)

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

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