{-# 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.ListHostedZonesByName
-- 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 your hosted zones in lexicographic order. The
-- response includes a @HostedZones@ child element for each hosted zone
-- created by the current Amazon Web Services account.
--
-- @ListHostedZonesByName@ sorts hosted zones by name with the labels
-- reversed. For example:
--
-- @com.example.www.@
--
-- Note the trailing dot, which can change the sort order in some
-- circumstances.
--
-- If the domain name includes escape characters or Punycode,
-- @ListHostedZonesByName@ alphabetizes the domain name using the escaped
-- or Punycoded value, which is the format that Amazon Route 53 saves in
-- its database. For example, to create a hosted zone for exämple.com, you
-- specify ex\\344mple.com for the domain name. @ListHostedZonesByName@
-- alphabetizes it as:
--
-- @com.ex\\344mple.@
--
-- The labels are reversed and alphabetized using the escaped value. For
-- more information about valid domain name formats, including
-- internationalized domain names, see
-- <https://docs.aws.amazon.com/Route53/latest/DeveloperGuide/DomainNameFormat.html DNS Domain Name Format>
-- in the /Amazon Route 53 Developer Guide/.
--
-- Route 53 returns up to 100 items in each response. If you have a lot of
-- hosted zones, use the @MaxItems@ parameter to list them in groups of up
-- to 100. The response includes values that help navigate from one group
-- of @MaxItems@ hosted zones to the next:
--
-- -   The @DNSName@ and @HostedZoneId@ elements in the response contain
--     the values, if any, specified for the @dnsname@ and @hostedzoneid@
--     parameters in the request that produced the current response.
--
-- -   The @MaxItems@ element in the response contains the value, if any,
--     that you specified for the @maxitems@ parameter in the request that
--     produced the current response.
--
-- -   If the value of @IsTruncated@ in the response is true, there are
--     more hosted zones associated with the current Amazon Web Services
--     account.
--
--     If @IsTruncated@ is false, this response includes the last hosted
--     zone that is associated with the current account. The @NextDNSName@
--     element and @NextHostedZoneId@ elements are omitted from the
--     response.
--
-- -   The @NextDNSName@ and @NextHostedZoneId@ elements in the response
--     contain the domain name and the hosted zone ID of the next hosted
--     zone that is associated with the current Amazon Web Services
--     account. If you want to list more hosted zones, make another call to
--     @ListHostedZonesByName@, and specify the value of @NextDNSName@ and
--     @NextHostedZoneId@ in the @dnsname@ and @hostedzoneid@ parameters,
--     respectively.
module Amazonka.Route53.ListHostedZonesByName
  ( -- * Creating a Request
    ListHostedZonesByName (..),
    newListHostedZonesByName,

    -- * Request Lenses
    listHostedZonesByName_dNSName,
    listHostedZonesByName_hostedZoneId,
    listHostedZonesByName_maxItems,

    -- * Destructuring the Response
    ListHostedZonesByNameResponse (..),
    newListHostedZonesByNameResponse,

    -- * Response Lenses
    listHostedZonesByNameResponse_dNSName,
    listHostedZonesByNameResponse_hostedZoneId,
    listHostedZonesByNameResponse_nextDNSName,
    listHostedZonesByNameResponse_nextHostedZoneId,
    listHostedZonesByNameResponse_httpStatus,
    listHostedZonesByNameResponse_hostedZones,
    listHostedZonesByNameResponse_isTruncated,
    listHostedZonesByNameResponse_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

-- | Retrieves a list of the public and private hosted zones that are
-- associated with the current Amazon Web Services account in ASCII order
-- by domain name.
--
-- /See:/ 'newListHostedZonesByName' smart constructor.
data ListHostedZonesByName = ListHostedZonesByName'
  { -- | (Optional) For your first request to @ListHostedZonesByName@, include
    -- the @dnsname@ parameter only if you want to specify the name of the
    -- first hosted zone in the response. If you don\'t include the @dnsname@
    -- parameter, Amazon Route 53 returns all of the hosted zones that were
    -- created by the current Amazon Web Services account, in ASCII order. For
    -- subsequent requests, include both @dnsname@ and @hostedzoneid@
    -- parameters. For @dnsname@, specify the value of @NextDNSName@ from the
    -- previous response.
    ListHostedZonesByName -> Maybe Text
dNSName :: Prelude.Maybe Prelude.Text,
    -- | (Optional) For your first request to @ListHostedZonesByName@, do not
    -- include the @hostedzoneid@ parameter.
    --
    -- If you have more hosted zones than the value of @maxitems@,
    -- @ListHostedZonesByName@ returns only the first @maxitems@ hosted zones.
    -- To get the next group of @maxitems@ hosted zones, submit another request
    -- to @ListHostedZonesByName@ and include both @dnsname@ and @hostedzoneid@
    -- parameters. For the value of @hostedzoneid@, specify the value of the
    -- @NextHostedZoneId@ element from the previous response.
    ListHostedZonesByName -> Maybe ResourceId
hostedZoneId :: Prelude.Maybe ResourceId,
    -- | The maximum number of hosted zones to be included in the response body
    -- for this request. If you have more than @maxitems@ hosted zones, then
    -- the value of the @IsTruncated@ element in the response is true, and the
    -- values of @NextDNSName@ and @NextHostedZoneId@ specify the first hosted
    -- zone in the next group of @maxitems@ hosted zones.
    ListHostedZonesByName -> Maybe Text
maxItems :: Prelude.Maybe Prelude.Text
  }
  deriving (ListHostedZonesByName -> ListHostedZonesByName -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListHostedZonesByName -> ListHostedZonesByName -> Bool
$c/= :: ListHostedZonesByName -> ListHostedZonesByName -> Bool
== :: ListHostedZonesByName -> ListHostedZonesByName -> Bool
$c== :: ListHostedZonesByName -> ListHostedZonesByName -> Bool
Prelude.Eq, ReadPrec [ListHostedZonesByName]
ReadPrec ListHostedZonesByName
Int -> ReadS ListHostedZonesByName
ReadS [ListHostedZonesByName]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListHostedZonesByName]
$creadListPrec :: ReadPrec [ListHostedZonesByName]
readPrec :: ReadPrec ListHostedZonesByName
$creadPrec :: ReadPrec ListHostedZonesByName
readList :: ReadS [ListHostedZonesByName]
$creadList :: ReadS [ListHostedZonesByName]
readsPrec :: Int -> ReadS ListHostedZonesByName
$creadsPrec :: Int -> ReadS ListHostedZonesByName
Prelude.Read, Int -> ListHostedZonesByName -> ShowS
[ListHostedZonesByName] -> ShowS
ListHostedZonesByName -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListHostedZonesByName] -> ShowS
$cshowList :: [ListHostedZonesByName] -> ShowS
show :: ListHostedZonesByName -> String
$cshow :: ListHostedZonesByName -> String
showsPrec :: Int -> ListHostedZonesByName -> ShowS
$cshowsPrec :: Int -> ListHostedZonesByName -> ShowS
Prelude.Show, forall x. Rep ListHostedZonesByName x -> ListHostedZonesByName
forall x. ListHostedZonesByName -> Rep ListHostedZonesByName x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListHostedZonesByName x -> ListHostedZonesByName
$cfrom :: forall x. ListHostedZonesByName -> Rep ListHostedZonesByName x
Prelude.Generic)

-- |
-- Create a value of 'ListHostedZonesByName' 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:
--
-- 'dNSName', 'listHostedZonesByName_dNSName' - (Optional) For your first request to @ListHostedZonesByName@, include
-- the @dnsname@ parameter only if you want to specify the name of the
-- first hosted zone in the response. If you don\'t include the @dnsname@
-- parameter, Amazon Route 53 returns all of the hosted zones that were
-- created by the current Amazon Web Services account, in ASCII order. For
-- subsequent requests, include both @dnsname@ and @hostedzoneid@
-- parameters. For @dnsname@, specify the value of @NextDNSName@ from the
-- previous response.
--
-- 'hostedZoneId', 'listHostedZonesByName_hostedZoneId' - (Optional) For your first request to @ListHostedZonesByName@, do not
-- include the @hostedzoneid@ parameter.
--
-- If you have more hosted zones than the value of @maxitems@,
-- @ListHostedZonesByName@ returns only the first @maxitems@ hosted zones.
-- To get the next group of @maxitems@ hosted zones, submit another request
-- to @ListHostedZonesByName@ and include both @dnsname@ and @hostedzoneid@
-- parameters. For the value of @hostedzoneid@, specify the value of the
-- @NextHostedZoneId@ element from the previous response.
--
-- 'maxItems', 'listHostedZonesByName_maxItems' - The maximum number of hosted zones to be included in the response body
-- for this request. If you have more than @maxitems@ hosted zones, then
-- the value of the @IsTruncated@ element in the response is true, and the
-- values of @NextDNSName@ and @NextHostedZoneId@ specify the first hosted
-- zone in the next group of @maxitems@ hosted zones.
newListHostedZonesByName ::
  ListHostedZonesByName
newListHostedZonesByName :: ListHostedZonesByName
newListHostedZonesByName =
  ListHostedZonesByName'
    { $sel:dNSName:ListHostedZonesByName' :: Maybe Text
dNSName = forall a. Maybe a
Prelude.Nothing,
      $sel:hostedZoneId:ListHostedZonesByName' :: Maybe ResourceId
hostedZoneId = forall a. Maybe a
Prelude.Nothing,
      $sel:maxItems:ListHostedZonesByName' :: Maybe Text
maxItems = forall a. Maybe a
Prelude.Nothing
    }

-- | (Optional) For your first request to @ListHostedZonesByName@, include
-- the @dnsname@ parameter only if you want to specify the name of the
-- first hosted zone in the response. If you don\'t include the @dnsname@
-- parameter, Amazon Route 53 returns all of the hosted zones that were
-- created by the current Amazon Web Services account, in ASCII order. For
-- subsequent requests, include both @dnsname@ and @hostedzoneid@
-- parameters. For @dnsname@, specify the value of @NextDNSName@ from the
-- previous response.
listHostedZonesByName_dNSName :: Lens.Lens' ListHostedZonesByName (Prelude.Maybe Prelude.Text)
listHostedZonesByName_dNSName :: Lens' ListHostedZonesByName (Maybe Text)
listHostedZonesByName_dNSName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListHostedZonesByName' {Maybe Text
dNSName :: Maybe Text
$sel:dNSName:ListHostedZonesByName' :: ListHostedZonesByName -> Maybe Text
dNSName} -> Maybe Text
dNSName) (\s :: ListHostedZonesByName
s@ListHostedZonesByName' {} Maybe Text
a -> ListHostedZonesByName
s {$sel:dNSName:ListHostedZonesByName' :: Maybe Text
dNSName = Maybe Text
a} :: ListHostedZonesByName)

-- | (Optional) For your first request to @ListHostedZonesByName@, do not
-- include the @hostedzoneid@ parameter.
--
-- If you have more hosted zones than the value of @maxitems@,
-- @ListHostedZonesByName@ returns only the first @maxitems@ hosted zones.
-- To get the next group of @maxitems@ hosted zones, submit another request
-- to @ListHostedZonesByName@ and include both @dnsname@ and @hostedzoneid@
-- parameters. For the value of @hostedzoneid@, specify the value of the
-- @NextHostedZoneId@ element from the previous response.
listHostedZonesByName_hostedZoneId :: Lens.Lens' ListHostedZonesByName (Prelude.Maybe ResourceId)
listHostedZonesByName_hostedZoneId :: Lens' ListHostedZonesByName (Maybe ResourceId)
listHostedZonesByName_hostedZoneId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListHostedZonesByName' {Maybe ResourceId
hostedZoneId :: Maybe ResourceId
$sel:hostedZoneId:ListHostedZonesByName' :: ListHostedZonesByName -> Maybe ResourceId
hostedZoneId} -> Maybe ResourceId
hostedZoneId) (\s :: ListHostedZonesByName
s@ListHostedZonesByName' {} Maybe ResourceId
a -> ListHostedZonesByName
s {$sel:hostedZoneId:ListHostedZonesByName' :: Maybe ResourceId
hostedZoneId = Maybe ResourceId
a} :: ListHostedZonesByName)

-- | The maximum number of hosted zones to be included in the response body
-- for this request. If you have more than @maxitems@ hosted zones, then
-- the value of the @IsTruncated@ element in the response is true, and the
-- values of @NextDNSName@ and @NextHostedZoneId@ specify the first hosted
-- zone in the next group of @maxitems@ hosted zones.
listHostedZonesByName_maxItems :: Lens.Lens' ListHostedZonesByName (Prelude.Maybe Prelude.Text)
listHostedZonesByName_maxItems :: Lens' ListHostedZonesByName (Maybe Text)
listHostedZonesByName_maxItems = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListHostedZonesByName' {Maybe Text
maxItems :: Maybe Text
$sel:maxItems:ListHostedZonesByName' :: ListHostedZonesByName -> Maybe Text
maxItems} -> Maybe Text
maxItems) (\s :: ListHostedZonesByName
s@ListHostedZonesByName' {} Maybe Text
a -> ListHostedZonesByName
s {$sel:maxItems:ListHostedZonesByName' :: Maybe Text
maxItems = Maybe Text
a} :: ListHostedZonesByName)

instance Core.AWSRequest ListHostedZonesByName where
  type
    AWSResponse ListHostedZonesByName =
      ListHostedZonesByNameResponse
  request :: (Service -> Service)
-> ListHostedZonesByName -> Request ListHostedZonesByName
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 ListHostedZonesByName
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse ListHostedZonesByName)))
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 ResourceId
-> Maybe Text
-> Maybe ResourceId
-> Int
-> [HostedZone]
-> Bool
-> Text
-> ListHostedZonesByNameResponse
ListHostedZonesByNameResponse'
            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
"DNSName")
            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
"HostedZoneId")
            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
"NextDNSName")
            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
"NextHostedZoneId")
            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 ListHostedZonesByName where
  hashWithSalt :: Int -> ListHostedZonesByName -> Int
hashWithSalt Int
_salt ListHostedZonesByName' {Maybe Text
Maybe ResourceId
maxItems :: Maybe Text
hostedZoneId :: Maybe ResourceId
dNSName :: Maybe Text
$sel:maxItems:ListHostedZonesByName' :: ListHostedZonesByName -> Maybe Text
$sel:hostedZoneId:ListHostedZonesByName' :: ListHostedZonesByName -> Maybe ResourceId
$sel:dNSName:ListHostedZonesByName' :: ListHostedZonesByName -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
dNSName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ResourceId
hostedZoneId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
maxItems

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

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

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

instance Data.ToQuery ListHostedZonesByName where
  toQuery :: ListHostedZonesByName -> QueryString
toQuery ListHostedZonesByName' {Maybe Text
Maybe ResourceId
maxItems :: Maybe Text
hostedZoneId :: Maybe ResourceId
dNSName :: Maybe Text
$sel:maxItems:ListHostedZonesByName' :: ListHostedZonesByName -> Maybe Text
$sel:hostedZoneId:ListHostedZonesByName' :: ListHostedZonesByName -> Maybe ResourceId
$sel:dNSName:ListHostedZonesByName' :: ListHostedZonesByName -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"dnsname" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
dNSName,
        ByteString
"hostedzoneid" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe ResourceId
hostedZoneId,
        ByteString
"maxitems" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
maxItems
      ]

-- | A complex type that contains the response information for the request.
--
-- /See:/ 'newListHostedZonesByNameResponse' smart constructor.
data ListHostedZonesByNameResponse = ListHostedZonesByNameResponse'
  { -- | For the second and subsequent calls to @ListHostedZonesByName@,
    -- @DNSName@ is the value that you specified for the @dnsname@ parameter in
    -- the request that produced the current response.
    ListHostedZonesByNameResponse -> Maybe Text
dNSName :: Prelude.Maybe Prelude.Text,
    -- | The ID that Amazon Route 53 assigned to the hosted zone when you created
    -- it.
    ListHostedZonesByNameResponse -> Maybe ResourceId
hostedZoneId :: Prelude.Maybe ResourceId,
    -- | If @IsTruncated@ is true, the value of @NextDNSName@ is the name of the
    -- first hosted zone in the next group of @maxitems@ hosted zones. Call
    -- @ListHostedZonesByName@ again and specify the value of @NextDNSName@ and
    -- @NextHostedZoneId@ in the @dnsname@ and @hostedzoneid@ parameters,
    -- respectively.
    --
    -- This element is present only if @IsTruncated@ is @true@.
    ListHostedZonesByNameResponse -> Maybe Text
nextDNSName :: Prelude.Maybe Prelude.Text,
    -- | If @IsTruncated@ is @true@, the value of @NextHostedZoneId@ identifies
    -- the first hosted zone in the next group of @maxitems@ hosted zones. Call
    -- @ListHostedZonesByName@ again and specify the value of @NextDNSName@ and
    -- @NextHostedZoneId@ in the @dnsname@ and @hostedzoneid@ parameters,
    -- respectively.
    --
    -- This element is present only if @IsTruncated@ is @true@.
    ListHostedZonesByNameResponse -> Maybe ResourceId
nextHostedZoneId :: Prelude.Maybe ResourceId,
    -- | The response's http status code.
    ListHostedZonesByNameResponse -> Int
httpStatus :: Prelude.Int,
    -- | A complex type that contains general information about the hosted zone.
    ListHostedZonesByNameResponse -> [HostedZone]
hostedZones :: [HostedZone],
    -- | A flag that indicates whether there are more hosted zones to be listed.
    -- If the response was truncated, you can get the next group of @maxitems@
    -- hosted zones by calling @ListHostedZonesByName@ again and specifying the
    -- values of @NextDNSName@ and @NextHostedZoneId@ elements in the @dnsname@
    -- and @hostedzoneid@ parameters.
    ListHostedZonesByNameResponse -> Bool
isTruncated :: Prelude.Bool,
    -- | The value that you specified for the @maxitems@ parameter in the call to
    -- @ListHostedZonesByName@ that produced the current response.
    ListHostedZonesByNameResponse -> Text
maxItems :: Prelude.Text
  }
  deriving (ListHostedZonesByNameResponse
-> ListHostedZonesByNameResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListHostedZonesByNameResponse
-> ListHostedZonesByNameResponse -> Bool
$c/= :: ListHostedZonesByNameResponse
-> ListHostedZonesByNameResponse -> Bool
== :: ListHostedZonesByNameResponse
-> ListHostedZonesByNameResponse -> Bool
$c== :: ListHostedZonesByNameResponse
-> ListHostedZonesByNameResponse -> Bool
Prelude.Eq, ReadPrec [ListHostedZonesByNameResponse]
ReadPrec ListHostedZonesByNameResponse
Int -> ReadS ListHostedZonesByNameResponse
ReadS [ListHostedZonesByNameResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListHostedZonesByNameResponse]
$creadListPrec :: ReadPrec [ListHostedZonesByNameResponse]
readPrec :: ReadPrec ListHostedZonesByNameResponse
$creadPrec :: ReadPrec ListHostedZonesByNameResponse
readList :: ReadS [ListHostedZonesByNameResponse]
$creadList :: ReadS [ListHostedZonesByNameResponse]
readsPrec :: Int -> ReadS ListHostedZonesByNameResponse
$creadsPrec :: Int -> ReadS ListHostedZonesByNameResponse
Prelude.Read, Int -> ListHostedZonesByNameResponse -> ShowS
[ListHostedZonesByNameResponse] -> ShowS
ListHostedZonesByNameResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListHostedZonesByNameResponse] -> ShowS
$cshowList :: [ListHostedZonesByNameResponse] -> ShowS
show :: ListHostedZonesByNameResponse -> String
$cshow :: ListHostedZonesByNameResponse -> String
showsPrec :: Int -> ListHostedZonesByNameResponse -> ShowS
$cshowsPrec :: Int -> ListHostedZonesByNameResponse -> ShowS
Prelude.Show, forall x.
Rep ListHostedZonesByNameResponse x
-> ListHostedZonesByNameResponse
forall x.
ListHostedZonesByNameResponse
-> Rep ListHostedZonesByNameResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ListHostedZonesByNameResponse x
-> ListHostedZonesByNameResponse
$cfrom :: forall x.
ListHostedZonesByNameResponse
-> Rep ListHostedZonesByNameResponse x
Prelude.Generic)

-- |
-- Create a value of 'ListHostedZonesByNameResponse' 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:
--
-- 'dNSName', 'listHostedZonesByNameResponse_dNSName' - For the second and subsequent calls to @ListHostedZonesByName@,
-- @DNSName@ is the value that you specified for the @dnsname@ parameter in
-- the request that produced the current response.
--
-- 'hostedZoneId', 'listHostedZonesByNameResponse_hostedZoneId' - The ID that Amazon Route 53 assigned to the hosted zone when you created
-- it.
--
-- 'nextDNSName', 'listHostedZonesByNameResponse_nextDNSName' - If @IsTruncated@ is true, the value of @NextDNSName@ is the name of the
-- first hosted zone in the next group of @maxitems@ hosted zones. Call
-- @ListHostedZonesByName@ again and specify the value of @NextDNSName@ and
-- @NextHostedZoneId@ in the @dnsname@ and @hostedzoneid@ parameters,
-- respectively.
--
-- This element is present only if @IsTruncated@ is @true@.
--
-- 'nextHostedZoneId', 'listHostedZonesByNameResponse_nextHostedZoneId' - If @IsTruncated@ is @true@, the value of @NextHostedZoneId@ identifies
-- the first hosted zone in the next group of @maxitems@ hosted zones. Call
-- @ListHostedZonesByName@ again and specify the value of @NextDNSName@ and
-- @NextHostedZoneId@ in the @dnsname@ and @hostedzoneid@ parameters,
-- respectively.
--
-- This element is present only if @IsTruncated@ is @true@.
--
-- 'httpStatus', 'listHostedZonesByNameResponse_httpStatus' - The response's http status code.
--
-- 'hostedZones', 'listHostedZonesByNameResponse_hostedZones' - A complex type that contains general information about the hosted zone.
--
-- 'isTruncated', 'listHostedZonesByNameResponse_isTruncated' - A flag that indicates whether there are more hosted zones to be listed.
-- If the response was truncated, you can get the next group of @maxitems@
-- hosted zones by calling @ListHostedZonesByName@ again and specifying the
-- values of @NextDNSName@ and @NextHostedZoneId@ elements in the @dnsname@
-- and @hostedzoneid@ parameters.
--
-- 'maxItems', 'listHostedZonesByNameResponse_maxItems' - The value that you specified for the @maxitems@ parameter in the call to
-- @ListHostedZonesByName@ that produced the current response.
newListHostedZonesByNameResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'isTruncated'
  Prelude.Bool ->
  -- | 'maxItems'
  Prelude.Text ->
  ListHostedZonesByNameResponse
newListHostedZonesByNameResponse :: Int -> Bool -> Text -> ListHostedZonesByNameResponse
newListHostedZonesByNameResponse
  Int
pHttpStatus_
  Bool
pIsTruncated_
  Text
pMaxItems_ =
    ListHostedZonesByNameResponse'
      { $sel:dNSName:ListHostedZonesByNameResponse' :: Maybe Text
dNSName =
          forall a. Maybe a
Prelude.Nothing,
        $sel:hostedZoneId:ListHostedZonesByNameResponse' :: Maybe ResourceId
hostedZoneId = forall a. Maybe a
Prelude.Nothing,
        $sel:nextDNSName:ListHostedZonesByNameResponse' :: Maybe Text
nextDNSName = forall a. Maybe a
Prelude.Nothing,
        $sel:nextHostedZoneId:ListHostedZonesByNameResponse' :: Maybe ResourceId
nextHostedZoneId = forall a. Maybe a
Prelude.Nothing,
        $sel:httpStatus:ListHostedZonesByNameResponse' :: Int
httpStatus = Int
pHttpStatus_,
        $sel:hostedZones:ListHostedZonesByNameResponse' :: [HostedZone]
hostedZones = forall a. Monoid a => a
Prelude.mempty,
        $sel:isTruncated:ListHostedZonesByNameResponse' :: Bool
isTruncated = Bool
pIsTruncated_,
        $sel:maxItems:ListHostedZonesByNameResponse' :: Text
maxItems = Text
pMaxItems_
      }

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

-- | The ID that Amazon Route 53 assigned to the hosted zone when you created
-- it.
listHostedZonesByNameResponse_hostedZoneId :: Lens.Lens' ListHostedZonesByNameResponse (Prelude.Maybe ResourceId)
listHostedZonesByNameResponse_hostedZoneId :: Lens' ListHostedZonesByNameResponse (Maybe ResourceId)
listHostedZonesByNameResponse_hostedZoneId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListHostedZonesByNameResponse' {Maybe ResourceId
hostedZoneId :: Maybe ResourceId
$sel:hostedZoneId:ListHostedZonesByNameResponse' :: ListHostedZonesByNameResponse -> Maybe ResourceId
hostedZoneId} -> Maybe ResourceId
hostedZoneId) (\s :: ListHostedZonesByNameResponse
s@ListHostedZonesByNameResponse' {} Maybe ResourceId
a -> ListHostedZonesByNameResponse
s {$sel:hostedZoneId:ListHostedZonesByNameResponse' :: Maybe ResourceId
hostedZoneId = Maybe ResourceId
a} :: ListHostedZonesByNameResponse)

-- | If @IsTruncated@ is true, the value of @NextDNSName@ is the name of the
-- first hosted zone in the next group of @maxitems@ hosted zones. Call
-- @ListHostedZonesByName@ again and specify the value of @NextDNSName@ and
-- @NextHostedZoneId@ in the @dnsname@ and @hostedzoneid@ parameters,
-- respectively.
--
-- This element is present only if @IsTruncated@ is @true@.
listHostedZonesByNameResponse_nextDNSName :: Lens.Lens' ListHostedZonesByNameResponse (Prelude.Maybe Prelude.Text)
listHostedZonesByNameResponse_nextDNSName :: Lens' ListHostedZonesByNameResponse (Maybe Text)
listHostedZonesByNameResponse_nextDNSName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListHostedZonesByNameResponse' {Maybe Text
nextDNSName :: Maybe Text
$sel:nextDNSName:ListHostedZonesByNameResponse' :: ListHostedZonesByNameResponse -> Maybe Text
nextDNSName} -> Maybe Text
nextDNSName) (\s :: ListHostedZonesByNameResponse
s@ListHostedZonesByNameResponse' {} Maybe Text
a -> ListHostedZonesByNameResponse
s {$sel:nextDNSName:ListHostedZonesByNameResponse' :: Maybe Text
nextDNSName = Maybe Text
a} :: ListHostedZonesByNameResponse)

-- | If @IsTruncated@ is @true@, the value of @NextHostedZoneId@ identifies
-- the first hosted zone in the next group of @maxitems@ hosted zones. Call
-- @ListHostedZonesByName@ again and specify the value of @NextDNSName@ and
-- @NextHostedZoneId@ in the @dnsname@ and @hostedzoneid@ parameters,
-- respectively.
--
-- This element is present only if @IsTruncated@ is @true@.
listHostedZonesByNameResponse_nextHostedZoneId :: Lens.Lens' ListHostedZonesByNameResponse (Prelude.Maybe ResourceId)
listHostedZonesByNameResponse_nextHostedZoneId :: Lens' ListHostedZonesByNameResponse (Maybe ResourceId)
listHostedZonesByNameResponse_nextHostedZoneId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListHostedZonesByNameResponse' {Maybe ResourceId
nextHostedZoneId :: Maybe ResourceId
$sel:nextHostedZoneId:ListHostedZonesByNameResponse' :: ListHostedZonesByNameResponse -> Maybe ResourceId
nextHostedZoneId} -> Maybe ResourceId
nextHostedZoneId) (\s :: ListHostedZonesByNameResponse
s@ListHostedZonesByNameResponse' {} Maybe ResourceId
a -> ListHostedZonesByNameResponse
s {$sel:nextHostedZoneId:ListHostedZonesByNameResponse' :: Maybe ResourceId
nextHostedZoneId = Maybe ResourceId
a} :: ListHostedZonesByNameResponse)

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

-- | A complex type that contains general information about the hosted zone.
listHostedZonesByNameResponse_hostedZones :: Lens.Lens' ListHostedZonesByNameResponse [HostedZone]
listHostedZonesByNameResponse_hostedZones :: Lens' ListHostedZonesByNameResponse [HostedZone]
listHostedZonesByNameResponse_hostedZones = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListHostedZonesByNameResponse' {[HostedZone]
hostedZones :: [HostedZone]
$sel:hostedZones:ListHostedZonesByNameResponse' :: ListHostedZonesByNameResponse -> [HostedZone]
hostedZones} -> [HostedZone]
hostedZones) (\s :: ListHostedZonesByNameResponse
s@ListHostedZonesByNameResponse' {} [HostedZone]
a -> ListHostedZonesByNameResponse
s {$sel:hostedZones:ListHostedZonesByNameResponse' :: [HostedZone]
hostedZones = [HostedZone]
a} :: ListHostedZonesByNameResponse) 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 that indicates whether there are more hosted zones to be listed.
-- If the response was truncated, you can get the next group of @maxitems@
-- hosted zones by calling @ListHostedZonesByName@ again and specifying the
-- values of @NextDNSName@ and @NextHostedZoneId@ elements in the @dnsname@
-- and @hostedzoneid@ parameters.
listHostedZonesByNameResponse_isTruncated :: Lens.Lens' ListHostedZonesByNameResponse Prelude.Bool
listHostedZonesByNameResponse_isTruncated :: Lens' ListHostedZonesByNameResponse Bool
listHostedZonesByNameResponse_isTruncated = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListHostedZonesByNameResponse' {Bool
isTruncated :: Bool
$sel:isTruncated:ListHostedZonesByNameResponse' :: ListHostedZonesByNameResponse -> Bool
isTruncated} -> Bool
isTruncated) (\s :: ListHostedZonesByNameResponse
s@ListHostedZonesByNameResponse' {} Bool
a -> ListHostedZonesByNameResponse
s {$sel:isTruncated:ListHostedZonesByNameResponse' :: Bool
isTruncated = Bool
a} :: ListHostedZonesByNameResponse)

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

instance Prelude.NFData ListHostedZonesByNameResponse where
  rnf :: ListHostedZonesByNameResponse -> ()
rnf ListHostedZonesByNameResponse' {Bool
Int
[HostedZone]
Maybe Text
Maybe ResourceId
Text
maxItems :: Text
isTruncated :: Bool
hostedZones :: [HostedZone]
httpStatus :: Int
nextHostedZoneId :: Maybe ResourceId
nextDNSName :: Maybe Text
hostedZoneId :: Maybe ResourceId
dNSName :: Maybe Text
$sel:maxItems:ListHostedZonesByNameResponse' :: ListHostedZonesByNameResponse -> Text
$sel:isTruncated:ListHostedZonesByNameResponse' :: ListHostedZonesByNameResponse -> Bool
$sel:hostedZones:ListHostedZonesByNameResponse' :: ListHostedZonesByNameResponse -> [HostedZone]
$sel:httpStatus:ListHostedZonesByNameResponse' :: ListHostedZonesByNameResponse -> Int
$sel:nextHostedZoneId:ListHostedZonesByNameResponse' :: ListHostedZonesByNameResponse -> Maybe ResourceId
$sel:nextDNSName:ListHostedZonesByNameResponse' :: ListHostedZonesByNameResponse -> Maybe Text
$sel:hostedZoneId:ListHostedZonesByNameResponse' :: ListHostedZonesByNameResponse -> Maybe ResourceId
$sel:dNSName:ListHostedZonesByNameResponse' :: ListHostedZonesByNameResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
dNSName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ResourceId
hostedZoneId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
nextDNSName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ResourceId
nextHostedZoneId
      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