{-# 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.Route53.ListHostedZones
-- 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 a list of the public and private hosted zones that are
-- associated with the current Amazon Web Services account. The response
-- includes a @HostedZones@ child element for each hosted zone.
--
-- Amazon Route 53 returns a maximum of 100 items in each response. If you
-- have a lot of hosted zones, you can use the @maxitems@ parameter to list
-- them in groups of up to 100.
--
-- This operation returns paginated results.
module Amazonka.Route53.ListHostedZones
  ( -- * Creating a Request
    ListHostedZones (..),
    newListHostedZones,

    -- * Request Lenses
    listHostedZones_delegationSetId,
    listHostedZones_marker,
    listHostedZones_maxItems,

    -- * Destructuring the Response
    ListHostedZonesResponse (..),
    newListHostedZonesResponse,

    -- * Response Lenses
    listHostedZonesResponse_marker,
    listHostedZonesResponse_nextMarker,
    listHostedZonesResponse_httpStatus,
    listHostedZonesResponse_hostedZones,
    listHostedZonesResponse_isTruncated,
    listHostedZonesResponse_maxItems,
  )
where

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
import Amazonka.Route53.Types

-- | A request to retrieve a list of the public and private hosted zones that
-- are associated with the current Amazon Web Services account.
--
-- /See:/ 'newListHostedZones' smart constructor.
data ListHostedZones = ListHostedZones'
  { -- | If you\'re using reusable delegation sets and you want to list all of
    -- the hosted zones that are associated with a reusable delegation set,
    -- specify the ID of that reusable delegation set.
    ListHostedZones -> Maybe ResourceId
delegationSetId :: Prelude.Maybe ResourceId,
    -- | If the value of @IsTruncated@ in the previous response was @true@, you
    -- have more hosted zones. To get more hosted zones, submit another
    -- @ListHostedZones@ request.
    --
    -- For the value of @marker@, specify the value of @NextMarker@ from the
    -- previous response, which is the ID of the first hosted zone that Amazon
    -- Route 53 will return if you submit another request.
    --
    -- If the value of @IsTruncated@ in the previous response was @false@,
    -- there are no more hosted zones to get.
    ListHostedZones -> Maybe Text
marker :: Prelude.Maybe Prelude.Text,
    -- | (Optional) The maximum number of hosted zones that you want Amazon Route
    -- 53 to return. If you have more than @maxitems@ hosted zones, the value
    -- of @IsTruncated@ in the response is @true@, and the value of
    -- @NextMarker@ is the hosted zone ID of the first hosted zone that Route
    -- 53 will return if you submit another request.
    ListHostedZones -> Maybe Text
maxItems :: Prelude.Maybe Prelude.Text
  }
  deriving (ListHostedZones -> ListHostedZones -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListHostedZones -> ListHostedZones -> Bool
$c/= :: ListHostedZones -> ListHostedZones -> Bool
== :: ListHostedZones -> ListHostedZones -> Bool
$c== :: ListHostedZones -> ListHostedZones -> Bool
Prelude.Eq, ReadPrec [ListHostedZones]
ReadPrec ListHostedZones
Int -> ReadS ListHostedZones
ReadS [ListHostedZones]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListHostedZones]
$creadListPrec :: ReadPrec [ListHostedZones]
readPrec :: ReadPrec ListHostedZones
$creadPrec :: ReadPrec ListHostedZones
readList :: ReadS [ListHostedZones]
$creadList :: ReadS [ListHostedZones]
readsPrec :: Int -> ReadS ListHostedZones
$creadsPrec :: Int -> ReadS ListHostedZones
Prelude.Read, Int -> ListHostedZones -> ShowS
[ListHostedZones] -> ShowS
ListHostedZones -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListHostedZones] -> ShowS
$cshowList :: [ListHostedZones] -> ShowS
show :: ListHostedZones -> String
$cshow :: ListHostedZones -> String
showsPrec :: Int -> ListHostedZones -> ShowS
$cshowsPrec :: Int -> ListHostedZones -> ShowS
Prelude.Show, forall x. Rep ListHostedZones x -> ListHostedZones
forall x. ListHostedZones -> Rep ListHostedZones x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListHostedZones x -> ListHostedZones
$cfrom :: forall x. ListHostedZones -> Rep ListHostedZones x
Prelude.Generic)

-- |
-- Create a value of 'ListHostedZones' 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:
--
-- 'delegationSetId', 'listHostedZones_delegationSetId' - If you\'re using reusable delegation sets and you want to list all of
-- the hosted zones that are associated with a reusable delegation set,
-- specify the ID of that reusable delegation set.
--
-- 'marker', 'listHostedZones_marker' - If the value of @IsTruncated@ in the previous response was @true@, you
-- have more hosted zones. To get more hosted zones, submit another
-- @ListHostedZones@ request.
--
-- For the value of @marker@, specify the value of @NextMarker@ from the
-- previous response, which is the ID of the first hosted zone that Amazon
-- Route 53 will return if you submit another request.
--
-- If the value of @IsTruncated@ in the previous response was @false@,
-- there are no more hosted zones to get.
--
-- 'maxItems', 'listHostedZones_maxItems' - (Optional) The maximum number of hosted zones that you want Amazon Route
-- 53 to return. If you have more than @maxitems@ hosted zones, the value
-- of @IsTruncated@ in the response is @true@, and the value of
-- @NextMarker@ is the hosted zone ID of the first hosted zone that Route
-- 53 will return if you submit another request.
newListHostedZones ::
  ListHostedZones
newListHostedZones :: ListHostedZones
newListHostedZones =
  ListHostedZones'
    { $sel:delegationSetId:ListHostedZones' :: Maybe ResourceId
delegationSetId = forall a. Maybe a
Prelude.Nothing,
      $sel:marker:ListHostedZones' :: Maybe Text
marker = forall a. Maybe a
Prelude.Nothing,
      $sel:maxItems:ListHostedZones' :: Maybe Text
maxItems = forall a. Maybe a
Prelude.Nothing
    }

-- | If you\'re using reusable delegation sets and you want to list all of
-- the hosted zones that are associated with a reusable delegation set,
-- specify the ID of that reusable delegation set.
listHostedZones_delegationSetId :: Lens.Lens' ListHostedZones (Prelude.Maybe ResourceId)
listHostedZones_delegationSetId :: Lens' ListHostedZones (Maybe ResourceId)
listHostedZones_delegationSetId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListHostedZones' {Maybe ResourceId
delegationSetId :: Maybe ResourceId
$sel:delegationSetId:ListHostedZones' :: ListHostedZones -> Maybe ResourceId
delegationSetId} -> Maybe ResourceId
delegationSetId) (\s :: ListHostedZones
s@ListHostedZones' {} Maybe ResourceId
a -> ListHostedZones
s {$sel:delegationSetId:ListHostedZones' :: Maybe ResourceId
delegationSetId = Maybe ResourceId
a} :: ListHostedZones)

-- | If the value of @IsTruncated@ in the previous response was @true@, you
-- have more hosted zones. To get more hosted zones, submit another
-- @ListHostedZones@ request.
--
-- For the value of @marker@, specify the value of @NextMarker@ from the
-- previous response, which is the ID of the first hosted zone that Amazon
-- Route 53 will return if you submit another request.
--
-- If the value of @IsTruncated@ in the previous response was @false@,
-- there are no more hosted zones to get.
listHostedZones_marker :: Lens.Lens' ListHostedZones (Prelude.Maybe Prelude.Text)
listHostedZones_marker :: Lens' ListHostedZones (Maybe Text)
listHostedZones_marker = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListHostedZones' {Maybe Text
marker :: Maybe Text
$sel:marker:ListHostedZones' :: ListHostedZones -> Maybe Text
marker} -> Maybe Text
marker) (\s :: ListHostedZones
s@ListHostedZones' {} Maybe Text
a -> ListHostedZones
s {$sel:marker:ListHostedZones' :: Maybe Text
marker = Maybe Text
a} :: ListHostedZones)

-- | (Optional) The maximum number of hosted zones that you want Amazon Route
-- 53 to return. If you have more than @maxitems@ hosted zones, the value
-- of @IsTruncated@ in the response is @true@, and the value of
-- @NextMarker@ is the hosted zone ID of the first hosted zone that Route
-- 53 will return if you submit another request.
listHostedZones_maxItems :: Lens.Lens' ListHostedZones (Prelude.Maybe Prelude.Text)
listHostedZones_maxItems :: Lens' ListHostedZones (Maybe Text)
listHostedZones_maxItems = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListHostedZones' {Maybe Text
maxItems :: Maybe Text
$sel:maxItems:ListHostedZones' :: ListHostedZones -> Maybe Text
maxItems} -> Maybe Text
maxItems) (\s :: ListHostedZones
s@ListHostedZones' {} Maybe Text
a -> ListHostedZones
s {$sel:maxItems:ListHostedZones' :: Maybe Text
maxItems = Maybe Text
a} :: ListHostedZones)

instance Core.AWSPager ListHostedZones where
  page :: ListHostedZones
-> AWSResponse ListHostedZones -> Maybe ListHostedZones
page ListHostedZones
rq AWSResponse ListHostedZones
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        (AWSResponse ListHostedZones
rs forall s a. s -> Getting a s a -> a
Lens.^. Lens' ListHostedZonesResponse Bool
listHostedZonesResponse_isTruncated) =
        forall a. Maybe a
Prelude.Nothing
    | forall a. Maybe a -> Bool
Prelude.isNothing
        ( AWSResponse ListHostedZones
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListHostedZonesResponse (Maybe Text)
listHostedZonesResponse_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.$ ListHostedZones
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' ListHostedZones (Maybe Text)
listHostedZones_marker
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse ListHostedZones
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListHostedZonesResponse (Maybe Text)
listHostedZonesResponse_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 ListHostedZones where
  type
    AWSResponse ListHostedZones =
      ListHostedZonesResponse
  request :: (Service -> Service) -> ListHostedZones -> Request ListHostedZones
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 ListHostedZones
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse ListHostedZones)))
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 Text
-> Maybe Text
-> Int
-> [HostedZone]
-> Bool
-> Text
-> ListHostedZonesResponse
ListHostedZonesResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"Marker")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"NextMarker")
            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))
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ( [Node]
x
                            forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"HostedZones"
                            forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty
                            forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
Prelude.>>= forall a. FromXML a => Text -> [Node] -> Either String [a]
Data.parseXMLList Text
"HostedZone"
                        )
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String a
Data..@ Text
"IsTruncated")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String a
Data..@ Text
"MaxItems")
      )

instance Prelude.Hashable ListHostedZones where
  hashWithSalt :: Int -> ListHostedZones -> Int
hashWithSalt Int
_salt ListHostedZones' {Maybe Text
Maybe ResourceId
maxItems :: Maybe Text
marker :: Maybe Text
delegationSetId :: Maybe ResourceId
$sel:maxItems:ListHostedZones' :: ListHostedZones -> Maybe Text
$sel:marker:ListHostedZones' :: ListHostedZones -> Maybe Text
$sel:delegationSetId:ListHostedZones' :: ListHostedZones -> Maybe ResourceId
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ResourceId
delegationSetId
      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 ListHostedZones where
  rnf :: ListHostedZones -> ()
rnf ListHostedZones' {Maybe Text
Maybe ResourceId
maxItems :: Maybe Text
marker :: Maybe Text
delegationSetId :: Maybe ResourceId
$sel:maxItems:ListHostedZones' :: ListHostedZones -> Maybe Text
$sel:marker:ListHostedZones' :: ListHostedZones -> Maybe Text
$sel:delegationSetId:ListHostedZones' :: ListHostedZones -> Maybe ResourceId
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe ResourceId
delegationSetId
      seq :: forall a b. a -> b -> b
`Prelude.seq` 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 ListHostedZones where
  toHeaders :: ListHostedZones -> ResponseHeaders
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

instance Data.ToPath ListHostedZones where
  toPath :: ListHostedZones -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/2013-04-01/hostedzone"

instance Data.ToQuery ListHostedZones where
  toQuery :: ListHostedZones -> QueryString
toQuery ListHostedZones' {Maybe Text
Maybe ResourceId
maxItems :: Maybe Text
marker :: Maybe Text
delegationSetId :: Maybe ResourceId
$sel:maxItems:ListHostedZones' :: ListHostedZones -> Maybe Text
$sel:marker:ListHostedZones' :: ListHostedZones -> Maybe Text
$sel:delegationSetId:ListHostedZones' :: ListHostedZones -> Maybe ResourceId
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"delegationsetid" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe ResourceId
delegationSetId,
        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
      ]

-- | /See:/ 'newListHostedZonesResponse' smart constructor.
data ListHostedZonesResponse = ListHostedZonesResponse'
  { -- | For the second and subsequent calls to @ListHostedZones@, @Marker@ is
    -- the value that you specified for the @marker@ parameter in the request
    -- that produced the current response.
    ListHostedZonesResponse -> Maybe Text
marker :: Prelude.Maybe Prelude.Text,
    -- | If @IsTruncated@ is @true@, the value of @NextMarker@ identifies the
    -- first hosted zone in the next group of hosted zones. Submit another
    -- @ListHostedZones@ request, and specify the value of @NextMarker@ from
    -- the response in the @marker@ parameter.
    --
    -- This element is present only if @IsTruncated@ is @true@.
    ListHostedZonesResponse -> Maybe Text
nextMarker :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    ListHostedZonesResponse -> Int
httpStatus :: Prelude.Int,
    -- | A complex type that contains general information about the hosted zone.
    ListHostedZonesResponse -> [HostedZone]
hostedZones :: [HostedZone],
    -- | A flag indicating whether there are more hosted zones to be listed. If
    -- the response was truncated, you can get more hosted zones by submitting
    -- another @ListHostedZones@ request and specifying the value of
    -- @NextMarker@ in the @marker@ parameter.
    ListHostedZonesResponse -> Bool
isTruncated :: Prelude.Bool,
    -- | The value that you specified for the @maxitems@ parameter in the call to
    -- @ListHostedZones@ that produced the current response.
    ListHostedZonesResponse -> Text
maxItems :: Prelude.Text
  }
  deriving (ListHostedZonesResponse -> ListHostedZonesResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListHostedZonesResponse -> ListHostedZonesResponse -> Bool
$c/= :: ListHostedZonesResponse -> ListHostedZonesResponse -> Bool
== :: ListHostedZonesResponse -> ListHostedZonesResponse -> Bool
$c== :: ListHostedZonesResponse -> ListHostedZonesResponse -> Bool
Prelude.Eq, ReadPrec [ListHostedZonesResponse]
ReadPrec ListHostedZonesResponse
Int -> ReadS ListHostedZonesResponse
ReadS [ListHostedZonesResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListHostedZonesResponse]
$creadListPrec :: ReadPrec [ListHostedZonesResponse]
readPrec :: ReadPrec ListHostedZonesResponse
$creadPrec :: ReadPrec ListHostedZonesResponse
readList :: ReadS [ListHostedZonesResponse]
$creadList :: ReadS [ListHostedZonesResponse]
readsPrec :: Int -> ReadS ListHostedZonesResponse
$creadsPrec :: Int -> ReadS ListHostedZonesResponse
Prelude.Read, Int -> ListHostedZonesResponse -> ShowS
[ListHostedZonesResponse] -> ShowS
ListHostedZonesResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListHostedZonesResponse] -> ShowS
$cshowList :: [ListHostedZonesResponse] -> ShowS
show :: ListHostedZonesResponse -> String
$cshow :: ListHostedZonesResponse -> String
showsPrec :: Int -> ListHostedZonesResponse -> ShowS
$cshowsPrec :: Int -> ListHostedZonesResponse -> ShowS
Prelude.Show, forall x. Rep ListHostedZonesResponse x -> ListHostedZonesResponse
forall x. ListHostedZonesResponse -> Rep ListHostedZonesResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListHostedZonesResponse x -> ListHostedZonesResponse
$cfrom :: forall x. ListHostedZonesResponse -> Rep ListHostedZonesResponse x
Prelude.Generic)

-- |
-- Create a value of 'ListHostedZonesResponse' 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', 'listHostedZonesResponse_marker' - For the second and subsequent calls to @ListHostedZones@, @Marker@ is
-- the value that you specified for the @marker@ parameter in the request
-- that produced the current response.
--
-- 'nextMarker', 'listHostedZonesResponse_nextMarker' - If @IsTruncated@ is @true@, the value of @NextMarker@ identifies the
-- first hosted zone in the next group of hosted zones. Submit another
-- @ListHostedZones@ request, and specify the value of @NextMarker@ from
-- the response in the @marker@ parameter.
--
-- This element is present only if @IsTruncated@ is @true@.
--
-- 'httpStatus', 'listHostedZonesResponse_httpStatus' - The response's http status code.
--
-- 'hostedZones', 'listHostedZonesResponse_hostedZones' - A complex type that contains general information about the hosted zone.
--
-- 'isTruncated', 'listHostedZonesResponse_isTruncated' - A flag indicating whether there are more hosted zones to be listed. If
-- the response was truncated, you can get more hosted zones by submitting
-- another @ListHostedZones@ request and specifying the value of
-- @NextMarker@ in the @marker@ parameter.
--
-- 'maxItems', 'listHostedZonesResponse_maxItems' - The value that you specified for the @maxitems@ parameter in the call to
-- @ListHostedZones@ that produced the current response.
newListHostedZonesResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'isTruncated'
  Prelude.Bool ->
  -- | 'maxItems'
  Prelude.Text ->
  ListHostedZonesResponse
newListHostedZonesResponse :: Int -> Bool -> Text -> ListHostedZonesResponse
newListHostedZonesResponse
  Int
pHttpStatus_
  Bool
pIsTruncated_
  Text
pMaxItems_ =
    ListHostedZonesResponse'
      { $sel:marker:ListHostedZonesResponse' :: Maybe Text
marker = forall a. Maybe a
Prelude.Nothing,
        $sel:nextMarker:ListHostedZonesResponse' :: Maybe Text
nextMarker = forall a. Maybe a
Prelude.Nothing,
        $sel:httpStatus:ListHostedZonesResponse' :: Int
httpStatus = Int
pHttpStatus_,
        $sel:hostedZones:ListHostedZonesResponse' :: [HostedZone]
hostedZones = forall a. Monoid a => a
Prelude.mempty,
        $sel:isTruncated:ListHostedZonesResponse' :: Bool
isTruncated = Bool
pIsTruncated_,
        $sel:maxItems:ListHostedZonesResponse' :: Text
maxItems = Text
pMaxItems_
      }

-- | For the second and subsequent calls to @ListHostedZones@, @Marker@ is
-- the value that you specified for the @marker@ parameter in the request
-- that produced the current response.
listHostedZonesResponse_marker :: Lens.Lens' ListHostedZonesResponse (Prelude.Maybe Prelude.Text)
listHostedZonesResponse_marker :: Lens' ListHostedZonesResponse (Maybe Text)
listHostedZonesResponse_marker = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListHostedZonesResponse' {Maybe Text
marker :: Maybe Text
$sel:marker:ListHostedZonesResponse' :: ListHostedZonesResponse -> Maybe Text
marker} -> Maybe Text
marker) (\s :: ListHostedZonesResponse
s@ListHostedZonesResponse' {} Maybe Text
a -> ListHostedZonesResponse
s {$sel:marker:ListHostedZonesResponse' :: Maybe Text
marker = Maybe Text
a} :: ListHostedZonesResponse)

-- | If @IsTruncated@ is @true@, the value of @NextMarker@ identifies the
-- first hosted zone in the next group of hosted zones. Submit another
-- @ListHostedZones@ request, and specify the value of @NextMarker@ from
-- the response in the @marker@ parameter.
--
-- This element is present only if @IsTruncated@ is @true@.
listHostedZonesResponse_nextMarker :: Lens.Lens' ListHostedZonesResponse (Prelude.Maybe Prelude.Text)
listHostedZonesResponse_nextMarker :: Lens' ListHostedZonesResponse (Maybe Text)
listHostedZonesResponse_nextMarker = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListHostedZonesResponse' {Maybe Text
nextMarker :: Maybe Text
$sel:nextMarker:ListHostedZonesResponse' :: ListHostedZonesResponse -> Maybe Text
nextMarker} -> Maybe Text
nextMarker) (\s :: ListHostedZonesResponse
s@ListHostedZonesResponse' {} Maybe Text
a -> ListHostedZonesResponse
s {$sel:nextMarker:ListHostedZonesResponse' :: Maybe Text
nextMarker = Maybe Text
a} :: ListHostedZonesResponse)

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

-- | A complex type that contains general information about the hosted zone.
listHostedZonesResponse_hostedZones :: Lens.Lens' ListHostedZonesResponse [HostedZone]
listHostedZonesResponse_hostedZones :: Lens' ListHostedZonesResponse [HostedZone]
listHostedZonesResponse_hostedZones = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListHostedZonesResponse' {[HostedZone]
hostedZones :: [HostedZone]
$sel:hostedZones:ListHostedZonesResponse' :: ListHostedZonesResponse -> [HostedZone]
hostedZones} -> [HostedZone]
hostedZones) (\s :: ListHostedZonesResponse
s@ListHostedZonesResponse' {} [HostedZone]
a -> ListHostedZonesResponse
s {$sel:hostedZones:ListHostedZonesResponse' :: [HostedZone]
hostedZones = [HostedZone]
a} :: ListHostedZonesResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | A flag indicating whether there are more hosted zones to be listed. If
-- the response was truncated, you can get more hosted zones by submitting
-- another @ListHostedZones@ request and specifying the value of
-- @NextMarker@ in the @marker@ parameter.
listHostedZonesResponse_isTruncated :: Lens.Lens' ListHostedZonesResponse Prelude.Bool
listHostedZonesResponse_isTruncated :: Lens' ListHostedZonesResponse Bool
listHostedZonesResponse_isTruncated = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListHostedZonesResponse' {Bool
isTruncated :: Bool
$sel:isTruncated:ListHostedZonesResponse' :: ListHostedZonesResponse -> Bool
isTruncated} -> Bool
isTruncated) (\s :: ListHostedZonesResponse
s@ListHostedZonesResponse' {} Bool
a -> ListHostedZonesResponse
s {$sel:isTruncated:ListHostedZonesResponse' :: Bool
isTruncated = Bool
a} :: ListHostedZonesResponse)

-- | The value that you specified for the @maxitems@ parameter in the call to
-- @ListHostedZones@ that produced the current response.
listHostedZonesResponse_maxItems :: Lens.Lens' ListHostedZonesResponse Prelude.Text
listHostedZonesResponse_maxItems :: Lens' ListHostedZonesResponse Text
listHostedZonesResponse_maxItems = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListHostedZonesResponse' {Text
maxItems :: Text
$sel:maxItems:ListHostedZonesResponse' :: ListHostedZonesResponse -> Text
maxItems} -> Text
maxItems) (\s :: ListHostedZonesResponse
s@ListHostedZonesResponse' {} Text
a -> ListHostedZonesResponse
s {$sel:maxItems:ListHostedZonesResponse' :: Text
maxItems = Text
a} :: ListHostedZonesResponse)

instance Prelude.NFData ListHostedZonesResponse where
  rnf :: ListHostedZonesResponse -> ()
rnf ListHostedZonesResponse' {Bool
Int
[HostedZone]
Maybe Text
Text
maxItems :: Text
isTruncated :: Bool
hostedZones :: [HostedZone]
httpStatus :: Int
nextMarker :: Maybe Text
marker :: Maybe Text
$sel:maxItems:ListHostedZonesResponse' :: ListHostedZonesResponse -> Text
$sel:isTruncated:ListHostedZonesResponse' :: ListHostedZonesResponse -> Bool
$sel:hostedZones:ListHostedZonesResponse' :: ListHostedZonesResponse -> [HostedZone]
$sel:httpStatus:ListHostedZonesResponse' :: ListHostedZonesResponse -> Int
$sel:nextMarker:ListHostedZonesResponse' :: ListHostedZonesResponse -> Maybe Text
$sel:marker:ListHostedZonesResponse' :: ListHostedZonesResponse -> 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
nextMarker
      seq :: forall a b. a -> b -> b
`Prelude.seq` 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 [HostedZone]
hostedZones
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Bool
isTruncated
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
maxItems