{-# 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.ListCachePolicies
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Gets a list of cache policies.
--
-- You can optionally apply a filter to return only the managed policies
-- created by Amazon Web Services, or only the custom policies created in
-- your Amazon Web Services account.
--
-- You can optionally specify the maximum number of items to receive in the
-- response. If the total number of items in the list exceeds the maximum
-- that you specify, or the default maximum, the response is paginated. To
-- get the next page of items, send a subsequent request that specifies the
-- @NextMarker@ value from the current response as the @Marker@ value in
-- the subsequent request.
module Amazonka.CloudFront.ListCachePolicies
  ( -- * Creating a Request
    ListCachePolicies (..),
    newListCachePolicies,

    -- * Request Lenses
    listCachePolicies_marker,
    listCachePolicies_maxItems,
    listCachePolicies_type,

    -- * Destructuring the Response
    ListCachePoliciesResponse (..),
    newListCachePoliciesResponse,

    -- * Response Lenses
    listCachePoliciesResponse_cachePolicyList,
    listCachePoliciesResponse_httpStatus,
  )
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

-- | /See:/ 'newListCachePolicies' smart constructor.
data ListCachePolicies = ListCachePolicies'
  { -- | Use this field when paginating results to indicate where to begin in
    -- your list of cache policies. The response includes cache policies in the
    -- list that occur after the marker. To get the next page of the list, set
    -- this field\'s value to the value of @NextMarker@ from the current
    -- page\'s response.
    ListCachePolicies -> Maybe Text
marker :: Prelude.Maybe Prelude.Text,
    -- | The maximum number of cache policies that you want in the response.
    ListCachePolicies -> Maybe Text
maxItems :: Prelude.Maybe Prelude.Text,
    -- | A filter to return only the specified kinds of cache policies. Valid
    -- values are:
    --
    -- -   @managed@ – Returns only the managed policies created by Amazon Web
    --     Services.
    --
    -- -   @custom@ – Returns only the custom policies created in your Amazon
    --     Web Services account.
    ListCachePolicies -> Maybe CachePolicyType
type' :: Prelude.Maybe CachePolicyType
  }
  deriving (ListCachePolicies -> ListCachePolicies -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListCachePolicies -> ListCachePolicies -> Bool
$c/= :: ListCachePolicies -> ListCachePolicies -> Bool
== :: ListCachePolicies -> ListCachePolicies -> Bool
$c== :: ListCachePolicies -> ListCachePolicies -> Bool
Prelude.Eq, ReadPrec [ListCachePolicies]
ReadPrec ListCachePolicies
Int -> ReadS ListCachePolicies
ReadS [ListCachePolicies]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListCachePolicies]
$creadListPrec :: ReadPrec [ListCachePolicies]
readPrec :: ReadPrec ListCachePolicies
$creadPrec :: ReadPrec ListCachePolicies
readList :: ReadS [ListCachePolicies]
$creadList :: ReadS [ListCachePolicies]
readsPrec :: Int -> ReadS ListCachePolicies
$creadsPrec :: Int -> ReadS ListCachePolicies
Prelude.Read, Int -> ListCachePolicies -> ShowS
[ListCachePolicies] -> ShowS
ListCachePolicies -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListCachePolicies] -> ShowS
$cshowList :: [ListCachePolicies] -> ShowS
show :: ListCachePolicies -> String
$cshow :: ListCachePolicies -> String
showsPrec :: Int -> ListCachePolicies -> ShowS
$cshowsPrec :: Int -> ListCachePolicies -> ShowS
Prelude.Show, forall x. Rep ListCachePolicies x -> ListCachePolicies
forall x. ListCachePolicies -> Rep ListCachePolicies x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListCachePolicies x -> ListCachePolicies
$cfrom :: forall x. ListCachePolicies -> Rep ListCachePolicies x
Prelude.Generic)

-- |
-- Create a value of 'ListCachePolicies' 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', 'listCachePolicies_marker' - Use this field when paginating results to indicate where to begin in
-- your list of cache policies. The response includes cache policies in the
-- list that occur after the marker. To get the next page of the list, set
-- this field\'s value to the value of @NextMarker@ from the current
-- page\'s response.
--
-- 'maxItems', 'listCachePolicies_maxItems' - The maximum number of cache policies that you want in the response.
--
-- 'type'', 'listCachePolicies_type' - A filter to return only the specified kinds of cache policies. Valid
-- values are:
--
-- -   @managed@ – Returns only the managed policies created by Amazon Web
--     Services.
--
-- -   @custom@ – Returns only the custom policies created in your Amazon
--     Web Services account.
newListCachePolicies ::
  ListCachePolicies
newListCachePolicies :: ListCachePolicies
newListCachePolicies =
  ListCachePolicies'
    { $sel:marker:ListCachePolicies' :: Maybe Text
marker = forall a. Maybe a
Prelude.Nothing,
      $sel:maxItems:ListCachePolicies' :: Maybe Text
maxItems = forall a. Maybe a
Prelude.Nothing,
      $sel:type':ListCachePolicies' :: Maybe CachePolicyType
type' = forall a. Maybe a
Prelude.Nothing
    }

-- | Use this field when paginating results to indicate where to begin in
-- your list of cache policies. The response includes cache policies in the
-- list that occur after the marker. To get the next page of the list, set
-- this field\'s value to the value of @NextMarker@ from the current
-- page\'s response.
listCachePolicies_marker :: Lens.Lens' ListCachePolicies (Prelude.Maybe Prelude.Text)
listCachePolicies_marker :: Lens' ListCachePolicies (Maybe Text)
listCachePolicies_marker = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListCachePolicies' {Maybe Text
marker :: Maybe Text
$sel:marker:ListCachePolicies' :: ListCachePolicies -> Maybe Text
marker} -> Maybe Text
marker) (\s :: ListCachePolicies
s@ListCachePolicies' {} Maybe Text
a -> ListCachePolicies
s {$sel:marker:ListCachePolicies' :: Maybe Text
marker = Maybe Text
a} :: ListCachePolicies)

-- | The maximum number of cache policies that you want in the response.
listCachePolicies_maxItems :: Lens.Lens' ListCachePolicies (Prelude.Maybe Prelude.Text)
listCachePolicies_maxItems :: Lens' ListCachePolicies (Maybe Text)
listCachePolicies_maxItems = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListCachePolicies' {Maybe Text
maxItems :: Maybe Text
$sel:maxItems:ListCachePolicies' :: ListCachePolicies -> Maybe Text
maxItems} -> Maybe Text
maxItems) (\s :: ListCachePolicies
s@ListCachePolicies' {} Maybe Text
a -> ListCachePolicies
s {$sel:maxItems:ListCachePolicies' :: Maybe Text
maxItems = Maybe Text
a} :: ListCachePolicies)

-- | A filter to return only the specified kinds of cache policies. Valid
-- values are:
--
-- -   @managed@ – Returns only the managed policies created by Amazon Web
--     Services.
--
-- -   @custom@ – Returns only the custom policies created in your Amazon
--     Web Services account.
listCachePolicies_type :: Lens.Lens' ListCachePolicies (Prelude.Maybe CachePolicyType)
listCachePolicies_type :: Lens' ListCachePolicies (Maybe CachePolicyType)
listCachePolicies_type = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListCachePolicies' {Maybe CachePolicyType
type' :: Maybe CachePolicyType
$sel:type':ListCachePolicies' :: ListCachePolicies -> Maybe CachePolicyType
type'} -> Maybe CachePolicyType
type') (\s :: ListCachePolicies
s@ListCachePolicies' {} Maybe CachePolicyType
a -> ListCachePolicies
s {$sel:type':ListCachePolicies' :: Maybe CachePolicyType
type' = Maybe CachePolicyType
a} :: ListCachePolicies)

instance Core.AWSRequest ListCachePolicies where
  type
    AWSResponse ListCachePolicies =
      ListCachePoliciesResponse
  request :: (Service -> Service)
-> ListCachePolicies -> Request ListCachePolicies
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 ListCachePolicies
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse ListCachePolicies)))
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 ->
          Maybe CachePolicyList -> Int -> ListCachePoliciesResponse
ListCachePoliciesResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (forall a. FromXML a => [Node] -> Either String a
Data.parseXML [Node]
x)
            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 ListCachePolicies where
  hashWithSalt :: Int -> ListCachePolicies -> Int
hashWithSalt Int
_salt ListCachePolicies' {Maybe Text
Maybe CachePolicyType
type' :: Maybe CachePolicyType
maxItems :: Maybe Text
marker :: Maybe Text
$sel:type':ListCachePolicies' :: ListCachePolicies -> Maybe CachePolicyType
$sel:maxItems:ListCachePolicies' :: ListCachePolicies -> Maybe Text
$sel:marker:ListCachePolicies' :: ListCachePolicies -> 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
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe CachePolicyType
type'

instance Prelude.NFData ListCachePolicies where
  rnf :: ListCachePolicies -> ()
rnf ListCachePolicies' {Maybe Text
Maybe CachePolicyType
type' :: Maybe CachePolicyType
maxItems :: Maybe Text
marker :: Maybe Text
$sel:type':ListCachePolicies' :: ListCachePolicies -> Maybe CachePolicyType
$sel:maxItems:ListCachePolicies' :: ListCachePolicies -> Maybe Text
$sel:marker:ListCachePolicies' :: ListCachePolicies -> 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
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe CachePolicyType
type'

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

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

instance Data.ToQuery ListCachePolicies where
  toQuery :: ListCachePolicies -> QueryString
toQuery ListCachePolicies' {Maybe Text
Maybe CachePolicyType
type' :: Maybe CachePolicyType
maxItems :: Maybe Text
marker :: Maybe Text
$sel:type':ListCachePolicies' :: ListCachePolicies -> Maybe CachePolicyType
$sel:maxItems:ListCachePolicies' :: ListCachePolicies -> Maybe Text
$sel:marker:ListCachePolicies' :: ListCachePolicies -> 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,
        ByteString
"Type" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe CachePolicyType
type'
      ]

-- | /See:/ 'newListCachePoliciesResponse' smart constructor.
data ListCachePoliciesResponse = ListCachePoliciesResponse'
  { -- | A list of cache policies.
    ListCachePoliciesResponse -> Maybe CachePolicyList
cachePolicyList :: Prelude.Maybe CachePolicyList,
    -- | The response's http status code.
    ListCachePoliciesResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ListCachePoliciesResponse -> ListCachePoliciesResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListCachePoliciesResponse -> ListCachePoliciesResponse -> Bool
$c/= :: ListCachePoliciesResponse -> ListCachePoliciesResponse -> Bool
== :: ListCachePoliciesResponse -> ListCachePoliciesResponse -> Bool
$c== :: ListCachePoliciesResponse -> ListCachePoliciesResponse -> Bool
Prelude.Eq, ReadPrec [ListCachePoliciesResponse]
ReadPrec ListCachePoliciesResponse
Int -> ReadS ListCachePoliciesResponse
ReadS [ListCachePoliciesResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListCachePoliciesResponse]
$creadListPrec :: ReadPrec [ListCachePoliciesResponse]
readPrec :: ReadPrec ListCachePoliciesResponse
$creadPrec :: ReadPrec ListCachePoliciesResponse
readList :: ReadS [ListCachePoliciesResponse]
$creadList :: ReadS [ListCachePoliciesResponse]
readsPrec :: Int -> ReadS ListCachePoliciesResponse
$creadsPrec :: Int -> ReadS ListCachePoliciesResponse
Prelude.Read, Int -> ListCachePoliciesResponse -> ShowS
[ListCachePoliciesResponse] -> ShowS
ListCachePoliciesResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListCachePoliciesResponse] -> ShowS
$cshowList :: [ListCachePoliciesResponse] -> ShowS
show :: ListCachePoliciesResponse -> String
$cshow :: ListCachePoliciesResponse -> String
showsPrec :: Int -> ListCachePoliciesResponse -> ShowS
$cshowsPrec :: Int -> ListCachePoliciesResponse -> ShowS
Prelude.Show, forall x.
Rep ListCachePoliciesResponse x -> ListCachePoliciesResponse
forall x.
ListCachePoliciesResponse -> Rep ListCachePoliciesResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ListCachePoliciesResponse x -> ListCachePoliciesResponse
$cfrom :: forall x.
ListCachePoliciesResponse -> Rep ListCachePoliciesResponse x
Prelude.Generic)

-- |
-- Create a value of 'ListCachePoliciesResponse' 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:
--
-- 'cachePolicyList', 'listCachePoliciesResponse_cachePolicyList' - A list of cache policies.
--
-- 'httpStatus', 'listCachePoliciesResponse_httpStatus' - The response's http status code.
newListCachePoliciesResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ListCachePoliciesResponse
newListCachePoliciesResponse :: Int -> ListCachePoliciesResponse
newListCachePoliciesResponse Int
pHttpStatus_ =
  ListCachePoliciesResponse'
    { $sel:cachePolicyList:ListCachePoliciesResponse' :: Maybe CachePolicyList
cachePolicyList =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ListCachePoliciesResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | A list of cache policies.
listCachePoliciesResponse_cachePolicyList :: Lens.Lens' ListCachePoliciesResponse (Prelude.Maybe CachePolicyList)
listCachePoliciesResponse_cachePolicyList :: Lens' ListCachePoliciesResponse (Maybe CachePolicyList)
listCachePoliciesResponse_cachePolicyList = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListCachePoliciesResponse' {Maybe CachePolicyList
cachePolicyList :: Maybe CachePolicyList
$sel:cachePolicyList:ListCachePoliciesResponse' :: ListCachePoliciesResponse -> Maybe CachePolicyList
cachePolicyList} -> Maybe CachePolicyList
cachePolicyList) (\s :: ListCachePoliciesResponse
s@ListCachePoliciesResponse' {} Maybe CachePolicyList
a -> ListCachePoliciesResponse
s {$sel:cachePolicyList:ListCachePoliciesResponse' :: Maybe CachePolicyList
cachePolicyList = Maybe CachePolicyList
a} :: ListCachePoliciesResponse)

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

instance Prelude.NFData ListCachePoliciesResponse where
  rnf :: ListCachePoliciesResponse -> ()
rnf ListCachePoliciesResponse' {Int
Maybe CachePolicyList
httpStatus :: Int
cachePolicyList :: Maybe CachePolicyList
$sel:httpStatus:ListCachePoliciesResponse' :: ListCachePoliciesResponse -> Int
$sel:cachePolicyList:ListCachePoliciesResponse' :: ListCachePoliciesResponse -> Maybe CachePolicyList
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe CachePolicyList
cachePolicyList
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus