{-# 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.CloudFront.ListDistributions
-- 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 CloudFront distributions.
--
-- This operation returns paginated results.
module Amazonka.CloudFront.ListDistributions
  ( -- * Creating a Request
    ListDistributions (..),
    newListDistributions,

    -- * Request Lenses
    listDistributions_marker,
    listDistributions_maxItems,

    -- * Destructuring the Response
    ListDistributionsResponse (..),
    newListDistributionsResponse,

    -- * Response Lenses
    listDistributionsResponse_httpStatus,
    listDistributionsResponse_distributionList,
  )
where

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

-- | The request to list your distributions.
--
-- /See:/ 'newListDistributions' smart constructor.
data ListDistributions = ListDistributions'
  { -- | Use this when paginating results to indicate where to begin in your list
    -- of distributions. The results include distributions in the list that
    -- occur after the marker. To get the next page of results, set the
    -- @Marker@ to the value of the @NextMarker@ from the current page\'s
    -- response (which is also the ID of the last distribution on that page).
    ListDistributions -> Maybe Text
marker :: Prelude.Maybe Prelude.Text,
    -- | The maximum number of distributions you want in the response body.
    ListDistributions -> Maybe Text
maxItems :: Prelude.Maybe Prelude.Text
  }
  deriving (ListDistributions -> ListDistributions -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListDistributions -> ListDistributions -> Bool
$c/= :: ListDistributions -> ListDistributions -> Bool
== :: ListDistributions -> ListDistributions -> Bool
$c== :: ListDistributions -> ListDistributions -> Bool
Prelude.Eq, ReadPrec [ListDistributions]
ReadPrec ListDistributions
Int -> ReadS ListDistributions
ReadS [ListDistributions]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListDistributions]
$creadListPrec :: ReadPrec [ListDistributions]
readPrec :: ReadPrec ListDistributions
$creadPrec :: ReadPrec ListDistributions
readList :: ReadS [ListDistributions]
$creadList :: ReadS [ListDistributions]
readsPrec :: Int -> ReadS ListDistributions
$creadsPrec :: Int -> ReadS ListDistributions
Prelude.Read, Int -> ListDistributions -> ShowS
[ListDistributions] -> ShowS
ListDistributions -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListDistributions] -> ShowS
$cshowList :: [ListDistributions] -> ShowS
show :: ListDistributions -> String
$cshow :: ListDistributions -> String
showsPrec :: Int -> ListDistributions -> ShowS
$cshowsPrec :: Int -> ListDistributions -> ShowS
Prelude.Show, forall x. Rep ListDistributions x -> ListDistributions
forall x. ListDistributions -> Rep ListDistributions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListDistributions x -> ListDistributions
$cfrom :: forall x. ListDistributions -> Rep ListDistributions x
Prelude.Generic)

-- |
-- Create a value of 'ListDistributions' 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:
--
-- 'marker', 'listDistributions_marker' - Use this when paginating results to indicate where to begin in your list
-- of distributions. The results include distributions in the list that
-- occur after the marker. To get the next page of results, set the
-- @Marker@ to the value of the @NextMarker@ from the current page\'s
-- response (which is also the ID of the last distribution on that page).
--
-- 'maxItems', 'listDistributions_maxItems' - The maximum number of distributions you want in the response body.
newListDistributions ::
  ListDistributions
newListDistributions :: ListDistributions
newListDistributions =
  ListDistributions'
    { $sel:marker:ListDistributions' :: Maybe Text
marker = forall a. Maybe a
Prelude.Nothing,
      $sel:maxItems:ListDistributions' :: Maybe Text
maxItems = forall a. Maybe a
Prelude.Nothing
    }

-- | Use this when paginating results to indicate where to begin in your list
-- of distributions. The results include distributions in the list that
-- occur after the marker. To get the next page of results, set the
-- @Marker@ to the value of the @NextMarker@ from the current page\'s
-- response (which is also the ID of the last distribution on that page).
listDistributions_marker :: Lens.Lens' ListDistributions (Prelude.Maybe Prelude.Text)
listDistributions_marker :: Lens' ListDistributions (Maybe Text)
listDistributions_marker = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListDistributions' {Maybe Text
marker :: Maybe Text
$sel:marker:ListDistributions' :: ListDistributions -> Maybe Text
marker} -> Maybe Text
marker) (\s :: ListDistributions
s@ListDistributions' {} Maybe Text
a -> ListDistributions
s {$sel:marker:ListDistributions' :: Maybe Text
marker = Maybe Text
a} :: ListDistributions)

-- | The maximum number of distributions you want in the response body.
listDistributions_maxItems :: Lens.Lens' ListDistributions (Prelude.Maybe Prelude.Text)
listDistributions_maxItems :: Lens' ListDistributions (Maybe Text)
listDistributions_maxItems = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListDistributions' {Maybe Text
maxItems :: Maybe Text
$sel:maxItems:ListDistributions' :: ListDistributions -> Maybe Text
maxItems} -> Maybe Text
maxItems) (\s :: ListDistributions
s@ListDistributions' {} Maybe Text
a -> ListDistributions
s {$sel:maxItems:ListDistributions' :: Maybe Text
maxItems = Maybe Text
a} :: ListDistributions)

instance Core.AWSPager ListDistributions where
  page :: ListDistributions
-> AWSResponse ListDistributions -> Maybe ListDistributions
page ListDistributions
rq AWSResponse ListDistributions
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse ListDistributions
rs
            forall s a. s -> Getting a s a -> a
Lens.^. Lens' ListDistributionsResponse DistributionList
listDistributionsResponse_distributionList
            forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. Lens' DistributionList Bool
distributionList_isTruncated
        ) =
        forall a. Maybe a
Prelude.Nothing
    | forall a. Maybe a -> Bool
Prelude.isNothing
        ( AWSResponse ListDistributions
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListDistributionsResponse DistributionList
listDistributionsResponse_distributionList
            forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. Lens' DistributionList (Maybe Text)
distributionList_nextMarker
            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.$ ListDistributions
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' ListDistributions (Maybe Text)
listDistributions_marker
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse ListDistributions
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListDistributionsResponse DistributionList
listDistributionsResponse_distributionList
          forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. Lens' DistributionList (Maybe Text)
distributionList_nextMarker
          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 ListDistributions where
  type
    AWSResponse ListDistributions =
      ListDistributionsResponse
  request :: (Service -> Service)
-> ListDistributions -> Request ListDistributions
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 ListDistributions
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse ListDistributions)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> [Node] -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveXML
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Int -> DistributionList -> ListDistributionsResponse
ListDistributionsResponse'
            forall (f :: * -> *) a b. Functor 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))
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (forall a. FromXML a => [Node] -> Either String a
Data.parseXML [Node]
x)
      )

instance Prelude.Hashable ListDistributions where
  hashWithSalt :: Int -> ListDistributions -> Int
hashWithSalt Int
_salt ListDistributions' {Maybe Text
maxItems :: Maybe Text
marker :: Maybe Text
$sel:maxItems:ListDistributions' :: ListDistributions -> Maybe Text
$sel:marker:ListDistributions' :: ListDistributions -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
marker
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
maxItems

instance Prelude.NFData ListDistributions where
  rnf :: ListDistributions -> ()
rnf ListDistributions' {Maybe Text
maxItems :: Maybe Text
marker :: Maybe Text
$sel:maxItems:ListDistributions' :: ListDistributions -> Maybe Text
$sel:marker:ListDistributions' :: ListDistributions -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
marker
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
maxItems

instance Data.ToHeaders ListDistributions where
  toHeaders :: ListDistributions -> ResponseHeaders
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

instance Data.ToPath ListDistributions where
  toPath :: ListDistributions -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/2020-05-31/distribution"

instance Data.ToQuery ListDistributions where
  toQuery :: ListDistributions -> QueryString
toQuery ListDistributions' {Maybe Text
maxItems :: Maybe Text
marker :: Maybe Text
$sel:maxItems:ListDistributions' :: ListDistributions -> Maybe Text
$sel:marker:ListDistributions' :: ListDistributions -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Marker" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
marker,
        ByteString
"MaxItems" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
maxItems
      ]

-- | The returned result of the corresponding request.
--
-- /See:/ 'newListDistributionsResponse' smart constructor.
data ListDistributionsResponse = ListDistributionsResponse'
  { -- | The response's http status code.
    ListDistributionsResponse -> Int
httpStatus :: Prelude.Int,
    -- | The @DistributionList@ type.
    ListDistributionsResponse -> DistributionList
distributionList :: DistributionList
  }
  deriving (ListDistributionsResponse -> ListDistributionsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListDistributionsResponse -> ListDistributionsResponse -> Bool
$c/= :: ListDistributionsResponse -> ListDistributionsResponse -> Bool
== :: ListDistributionsResponse -> ListDistributionsResponse -> Bool
$c== :: ListDistributionsResponse -> ListDistributionsResponse -> Bool
Prelude.Eq, Int -> ListDistributionsResponse -> ShowS
[ListDistributionsResponse] -> ShowS
ListDistributionsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListDistributionsResponse] -> ShowS
$cshowList :: [ListDistributionsResponse] -> ShowS
show :: ListDistributionsResponse -> String
$cshow :: ListDistributionsResponse -> String
showsPrec :: Int -> ListDistributionsResponse -> ShowS
$cshowsPrec :: Int -> ListDistributionsResponse -> ShowS
Prelude.Show, forall x.
Rep ListDistributionsResponse x -> ListDistributionsResponse
forall x.
ListDistributionsResponse -> Rep ListDistributionsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ListDistributionsResponse x -> ListDistributionsResponse
$cfrom :: forall x.
ListDistributionsResponse -> Rep ListDistributionsResponse x
Prelude.Generic)

-- |
-- Create a value of 'ListDistributionsResponse' 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:
--
-- 'httpStatus', 'listDistributionsResponse_httpStatus' - The response's http status code.
--
-- 'distributionList', 'listDistributionsResponse_distributionList' - The @DistributionList@ type.
newListDistributionsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'distributionList'
  DistributionList ->
  ListDistributionsResponse
newListDistributionsResponse :: Int -> DistributionList -> ListDistributionsResponse
newListDistributionsResponse
  Int
pHttpStatus_
  DistributionList
pDistributionList_ =
    ListDistributionsResponse'
      { $sel:httpStatus:ListDistributionsResponse' :: Int
httpStatus =
          Int
pHttpStatus_,
        $sel:distributionList:ListDistributionsResponse' :: DistributionList
distributionList = DistributionList
pDistributionList_
      }

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

-- | The @DistributionList@ type.
listDistributionsResponse_distributionList :: Lens.Lens' ListDistributionsResponse DistributionList
listDistributionsResponse_distributionList :: Lens' ListDistributionsResponse DistributionList
listDistributionsResponse_distributionList = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListDistributionsResponse' {DistributionList
distributionList :: DistributionList
$sel:distributionList:ListDistributionsResponse' :: ListDistributionsResponse -> DistributionList
distributionList} -> DistributionList
distributionList) (\s :: ListDistributionsResponse
s@ListDistributionsResponse' {} DistributionList
a -> ListDistributionsResponse
s {$sel:distributionList:ListDistributionsResponse' :: DistributionList
distributionList = DistributionList
a} :: ListDistributionsResponse)

instance Prelude.NFData ListDistributionsResponse where
  rnf :: ListDistributionsResponse -> ()
rnf ListDistributionsResponse' {Int
DistributionList
distributionList :: DistributionList
httpStatus :: Int
$sel:distributionList:ListDistributionsResponse' :: ListDistributionsResponse -> DistributionList
$sel:httpStatus:ListDistributionsResponse' :: ListDistributionsResponse -> Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf DistributionList
distributionList