{-# 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.ListSourceLocations
-- 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 source locations for a channel. A source location defines the
-- host server URL, and contains a list of sources.
--
-- This operation returns paginated results.
module Amazonka.MediaTailor.ListSourceLocations
  ( -- * Creating a Request
    ListSourceLocations (..),
    newListSourceLocations,

    -- * Request Lenses
    listSourceLocations_maxResults,
    listSourceLocations_nextToken,

    -- * Destructuring the Response
    ListSourceLocationsResponse (..),
    newListSourceLocationsResponse,

    -- * Response Lenses
    listSourceLocationsResponse_items,
    listSourceLocationsResponse_nextToken,
    listSourceLocationsResponse_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:/ 'newListSourceLocations' smart constructor.
data ListSourceLocations = ListSourceLocations'
  { -- | The maximum number of source locations that you want MediaTailor to
    -- return in response to the current request. If there are more than
    -- @MaxResults@ source locations, use the value of @NextToken@ in the
    -- response to get the next page of results.
    ListSourceLocations -> 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.
    ListSourceLocations -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text
  }
  deriving (ListSourceLocations -> ListSourceLocations -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListSourceLocations -> ListSourceLocations -> Bool
$c/= :: ListSourceLocations -> ListSourceLocations -> Bool
== :: ListSourceLocations -> ListSourceLocations -> Bool
$c== :: ListSourceLocations -> ListSourceLocations -> Bool
Prelude.Eq, ReadPrec [ListSourceLocations]
ReadPrec ListSourceLocations
Int -> ReadS ListSourceLocations
ReadS [ListSourceLocations]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListSourceLocations]
$creadListPrec :: ReadPrec [ListSourceLocations]
readPrec :: ReadPrec ListSourceLocations
$creadPrec :: ReadPrec ListSourceLocations
readList :: ReadS [ListSourceLocations]
$creadList :: ReadS [ListSourceLocations]
readsPrec :: Int -> ReadS ListSourceLocations
$creadsPrec :: Int -> ReadS ListSourceLocations
Prelude.Read, Int -> ListSourceLocations -> ShowS
[ListSourceLocations] -> ShowS
ListSourceLocations -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListSourceLocations] -> ShowS
$cshowList :: [ListSourceLocations] -> ShowS
show :: ListSourceLocations -> String
$cshow :: ListSourceLocations -> String
showsPrec :: Int -> ListSourceLocations -> ShowS
$cshowsPrec :: Int -> ListSourceLocations -> ShowS
Prelude.Show, forall x. Rep ListSourceLocations x -> ListSourceLocations
forall x. ListSourceLocations -> Rep ListSourceLocations x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListSourceLocations x -> ListSourceLocations
$cfrom :: forall x. ListSourceLocations -> Rep ListSourceLocations x
Prelude.Generic)

-- |
-- Create a value of 'ListSourceLocations' 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', 'listSourceLocations_maxResults' - The maximum number of source locations that you want MediaTailor to
-- return in response to the current request. If there are more than
-- @MaxResults@ source locations, use the value of @NextToken@ in the
-- response to get the next page of results.
--
-- 'nextToken', 'listSourceLocations_nextToken' - Pagination token returned by the list request when results exceed the
-- maximum allowed. Use the token to fetch the next page of results.
newListSourceLocations ::
  ListSourceLocations
newListSourceLocations :: ListSourceLocations
newListSourceLocations =
  ListSourceLocations'
    { $sel:maxResults:ListSourceLocations' :: Maybe Natural
maxResults = forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListSourceLocations' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing
    }

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

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

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

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

instance Data.ToHeaders ListSourceLocations where
  toHeaders :: ListSourceLocations -> 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 ListSourceLocations where
  toPath :: ListSourceLocations -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/sourceLocations"

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

-- |
-- Create a value of 'ListSourceLocationsResponse' 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', 'listSourceLocationsResponse_items' - A list of source locations.
--
-- 'nextToken', 'listSourceLocationsResponse_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', 'listSourceLocationsResponse_httpStatus' - The response's http status code.
newListSourceLocationsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ListSourceLocationsResponse
newListSourceLocationsResponse :: Int -> ListSourceLocationsResponse
newListSourceLocationsResponse Int
pHttpStatus_ =
  ListSourceLocationsResponse'
    { $sel:items:ListSourceLocationsResponse' :: Maybe [SourceLocation]
items =
        forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListSourceLocationsResponse' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ListSourceLocationsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | A list of source locations.
listSourceLocationsResponse_items :: Lens.Lens' ListSourceLocationsResponse (Prelude.Maybe [SourceLocation])
listSourceLocationsResponse_items :: Lens' ListSourceLocationsResponse (Maybe [SourceLocation])
listSourceLocationsResponse_items = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListSourceLocationsResponse' {Maybe [SourceLocation]
items :: Maybe [SourceLocation]
$sel:items:ListSourceLocationsResponse' :: ListSourceLocationsResponse -> Maybe [SourceLocation]
items} -> Maybe [SourceLocation]
items) (\s :: ListSourceLocationsResponse
s@ListSourceLocationsResponse' {} Maybe [SourceLocation]
a -> ListSourceLocationsResponse
s {$sel:items:ListSourceLocationsResponse' :: Maybe [SourceLocation]
items = Maybe [SourceLocation]
a} :: ListSourceLocationsResponse) 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.
listSourceLocationsResponse_nextToken :: Lens.Lens' ListSourceLocationsResponse (Prelude.Maybe Prelude.Text)
listSourceLocationsResponse_nextToken :: Lens' ListSourceLocationsResponse (Maybe Text)
listSourceLocationsResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListSourceLocationsResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListSourceLocationsResponse' :: ListSourceLocationsResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListSourceLocationsResponse
s@ListSourceLocationsResponse' {} Maybe Text
a -> ListSourceLocationsResponse
s {$sel:nextToken:ListSourceLocationsResponse' :: Maybe Text
nextToken = Maybe Text
a} :: ListSourceLocationsResponse)

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

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