{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# 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.Types.HostedZone
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
module Amazonka.Route53.Types.HostedZone 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 Amazonka.Route53.Internal
import Amazonka.Route53.Types.HostedZoneConfig
import Amazonka.Route53.Types.LinkedService

-- | A complex type that contains general information about the hosted zone.
--
-- /See:/ 'newHostedZone' smart constructor.
data HostedZone = HostedZone'
  { -- | A complex type that includes the @Comment@ and @PrivateZone@ elements.
    -- If you omitted the @HostedZoneConfig@ and @Comment@ elements from the
    -- request, the @Config@ and @Comment@ elements don\'t appear in the
    -- response.
    HostedZone -> Maybe HostedZoneConfig
config :: Prelude.Maybe HostedZoneConfig,
    -- | If the hosted zone was created by another service, the service that
    -- created the hosted zone. When a hosted zone is created by another
    -- service, you can\'t edit or delete it using Route 53.
    HostedZone -> Maybe LinkedService
linkedService :: Prelude.Maybe LinkedService,
    -- | The number of resource record sets in the hosted zone.
    HostedZone -> Maybe Integer
resourceRecordSetCount :: Prelude.Maybe Prelude.Integer,
    -- | The ID that Amazon Route 53 assigned to the hosted zone when you created
    -- it.
    HostedZone -> ResourceId
id :: ResourceId,
    -- | The name of the domain. For public hosted zones, this is the name that
    -- you have registered with your DNS registrar.
    --
    -- For information about how to specify characters other than @a-z@, @0-9@,
    -- and @-@ (hyphen) and how to specify internationalized domain names, see
    -- <https://docs.aws.amazon.com/Route53/latest/APIReference/API_CreateHostedZone.html CreateHostedZone>.
    HostedZone -> Text
name :: Prelude.Text,
    -- | The value that you specified for @CallerReference@ when you created the
    -- hosted zone.
    HostedZone -> Text
callerReference :: Prelude.Text
  }
  deriving (HostedZone -> HostedZone -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HostedZone -> HostedZone -> Bool
$c/= :: HostedZone -> HostedZone -> Bool
== :: HostedZone -> HostedZone -> Bool
$c== :: HostedZone -> HostedZone -> Bool
Prelude.Eq, ReadPrec [HostedZone]
ReadPrec HostedZone
Int -> ReadS HostedZone
ReadS [HostedZone]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [HostedZone]
$creadListPrec :: ReadPrec [HostedZone]
readPrec :: ReadPrec HostedZone
$creadPrec :: ReadPrec HostedZone
readList :: ReadS [HostedZone]
$creadList :: ReadS [HostedZone]
readsPrec :: Int -> ReadS HostedZone
$creadsPrec :: Int -> ReadS HostedZone
Prelude.Read, Int -> HostedZone -> ShowS
[HostedZone] -> ShowS
HostedZone -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HostedZone] -> ShowS
$cshowList :: [HostedZone] -> ShowS
show :: HostedZone -> String
$cshow :: HostedZone -> String
showsPrec :: Int -> HostedZone -> ShowS
$cshowsPrec :: Int -> HostedZone -> ShowS
Prelude.Show, forall x. Rep HostedZone x -> HostedZone
forall x. HostedZone -> Rep HostedZone x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep HostedZone x -> HostedZone
$cfrom :: forall x. HostedZone -> Rep HostedZone x
Prelude.Generic)

-- |
-- Create a value of 'HostedZone' 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:
--
-- 'config', 'hostedZone_config' - A complex type that includes the @Comment@ and @PrivateZone@ elements.
-- If you omitted the @HostedZoneConfig@ and @Comment@ elements from the
-- request, the @Config@ and @Comment@ elements don\'t appear in the
-- response.
--
-- 'linkedService', 'hostedZone_linkedService' - If the hosted zone was created by another service, the service that
-- created the hosted zone. When a hosted zone is created by another
-- service, you can\'t edit or delete it using Route 53.
--
-- 'resourceRecordSetCount', 'hostedZone_resourceRecordSetCount' - The number of resource record sets in the hosted zone.
--
-- 'id', 'hostedZone_id' - The ID that Amazon Route 53 assigned to the hosted zone when you created
-- it.
--
-- 'name', 'hostedZone_name' - The name of the domain. For public hosted zones, this is the name that
-- you have registered with your DNS registrar.
--
-- For information about how to specify characters other than @a-z@, @0-9@,
-- and @-@ (hyphen) and how to specify internationalized domain names, see
-- <https://docs.aws.amazon.com/Route53/latest/APIReference/API_CreateHostedZone.html CreateHostedZone>.
--
-- 'callerReference', 'hostedZone_callerReference' - The value that you specified for @CallerReference@ when you created the
-- hosted zone.
newHostedZone ::
  -- | 'id'
  ResourceId ->
  -- | 'name'
  Prelude.Text ->
  -- | 'callerReference'
  Prelude.Text ->
  HostedZone
newHostedZone :: ResourceId -> Text -> Text -> HostedZone
newHostedZone ResourceId
pId_ Text
pName_ Text
pCallerReference_ =
  HostedZone'
    { $sel:config:HostedZone' :: Maybe HostedZoneConfig
config = forall a. Maybe a
Prelude.Nothing,
      $sel:linkedService:HostedZone' :: Maybe LinkedService
linkedService = forall a. Maybe a
Prelude.Nothing,
      $sel:resourceRecordSetCount:HostedZone' :: Maybe Integer
resourceRecordSetCount = forall a. Maybe a
Prelude.Nothing,
      $sel:id:HostedZone' :: ResourceId
id = ResourceId
pId_,
      $sel:name:HostedZone' :: Text
name = Text
pName_,
      $sel:callerReference:HostedZone' :: Text
callerReference = Text
pCallerReference_
    }

-- | A complex type that includes the @Comment@ and @PrivateZone@ elements.
-- If you omitted the @HostedZoneConfig@ and @Comment@ elements from the
-- request, the @Config@ and @Comment@ elements don\'t appear in the
-- response.
hostedZone_config :: Lens.Lens' HostedZone (Prelude.Maybe HostedZoneConfig)
hostedZone_config :: Lens' HostedZone (Maybe HostedZoneConfig)
hostedZone_config = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\HostedZone' {Maybe HostedZoneConfig
config :: Maybe HostedZoneConfig
$sel:config:HostedZone' :: HostedZone -> Maybe HostedZoneConfig
config} -> Maybe HostedZoneConfig
config) (\s :: HostedZone
s@HostedZone' {} Maybe HostedZoneConfig
a -> HostedZone
s {$sel:config:HostedZone' :: Maybe HostedZoneConfig
config = Maybe HostedZoneConfig
a} :: HostedZone)

-- | If the hosted zone was created by another service, the service that
-- created the hosted zone. When a hosted zone is created by another
-- service, you can\'t edit or delete it using Route 53.
hostedZone_linkedService :: Lens.Lens' HostedZone (Prelude.Maybe LinkedService)
hostedZone_linkedService :: Lens' HostedZone (Maybe LinkedService)
hostedZone_linkedService = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\HostedZone' {Maybe LinkedService
linkedService :: Maybe LinkedService
$sel:linkedService:HostedZone' :: HostedZone -> Maybe LinkedService
linkedService} -> Maybe LinkedService
linkedService) (\s :: HostedZone
s@HostedZone' {} Maybe LinkedService
a -> HostedZone
s {$sel:linkedService:HostedZone' :: Maybe LinkedService
linkedService = Maybe LinkedService
a} :: HostedZone)

-- | The number of resource record sets in the hosted zone.
hostedZone_resourceRecordSetCount :: Lens.Lens' HostedZone (Prelude.Maybe Prelude.Integer)
hostedZone_resourceRecordSetCount :: Lens' HostedZone (Maybe Integer)
hostedZone_resourceRecordSetCount = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\HostedZone' {Maybe Integer
resourceRecordSetCount :: Maybe Integer
$sel:resourceRecordSetCount:HostedZone' :: HostedZone -> Maybe Integer
resourceRecordSetCount} -> Maybe Integer
resourceRecordSetCount) (\s :: HostedZone
s@HostedZone' {} Maybe Integer
a -> HostedZone
s {$sel:resourceRecordSetCount:HostedZone' :: Maybe Integer
resourceRecordSetCount = Maybe Integer
a} :: HostedZone)

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

-- | The name of the domain. For public hosted zones, this is the name that
-- you have registered with your DNS registrar.
--
-- For information about how to specify characters other than @a-z@, @0-9@,
-- and @-@ (hyphen) and how to specify internationalized domain names, see
-- <https://docs.aws.amazon.com/Route53/latest/APIReference/API_CreateHostedZone.html CreateHostedZone>.
hostedZone_name :: Lens.Lens' HostedZone Prelude.Text
hostedZone_name :: Lens' HostedZone Text
hostedZone_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\HostedZone' {Text
name :: Text
$sel:name:HostedZone' :: HostedZone -> Text
name} -> Text
name) (\s :: HostedZone
s@HostedZone' {} Text
a -> HostedZone
s {$sel:name:HostedZone' :: Text
name = Text
a} :: HostedZone)

-- | The value that you specified for @CallerReference@ when you created the
-- hosted zone.
hostedZone_callerReference :: Lens.Lens' HostedZone Prelude.Text
hostedZone_callerReference :: Lens' HostedZone Text
hostedZone_callerReference = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\HostedZone' {Text
callerReference :: Text
$sel:callerReference:HostedZone' :: HostedZone -> Text
callerReference} -> Text
callerReference) (\s :: HostedZone
s@HostedZone' {} Text
a -> HostedZone
s {$sel:callerReference:HostedZone' :: Text
callerReference = Text
a} :: HostedZone)

instance Data.FromXML HostedZone where
  parseXML :: [Node] -> Either String HostedZone
parseXML [Node]
x =
    Maybe HostedZoneConfig
-> Maybe LinkedService
-> Maybe Integer
-> ResourceId
-> Text
-> Text
-> HostedZone
HostedZone'
      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
"Config")
      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
"LinkedService")
      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
"ResourceRecordSetCount")
      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
"Id")
      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
"Name")
      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
"CallerReference")

instance Prelude.Hashable HostedZone where
  hashWithSalt :: Int -> HostedZone -> Int
hashWithSalt Int
_salt HostedZone' {Maybe Integer
Maybe HostedZoneConfig
Maybe LinkedService
Text
ResourceId
callerReference :: Text
name :: Text
id :: ResourceId
resourceRecordSetCount :: Maybe Integer
linkedService :: Maybe LinkedService
config :: Maybe HostedZoneConfig
$sel:callerReference:HostedZone' :: HostedZone -> Text
$sel:name:HostedZone' :: HostedZone -> Text
$sel:id:HostedZone' :: HostedZone -> ResourceId
$sel:resourceRecordSetCount:HostedZone' :: HostedZone -> Maybe Integer
$sel:linkedService:HostedZone' :: HostedZone -> Maybe LinkedService
$sel:config:HostedZone' :: HostedZone -> Maybe HostedZoneConfig
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe HostedZoneConfig
config
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe LinkedService
linkedService
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Integer
resourceRecordSetCount
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` ResourceId
id
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
name
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
callerReference

instance Prelude.NFData HostedZone where
  rnf :: HostedZone -> ()
rnf HostedZone' {Maybe Integer
Maybe HostedZoneConfig
Maybe LinkedService
Text
ResourceId
callerReference :: Text
name :: Text
id :: ResourceId
resourceRecordSetCount :: Maybe Integer
linkedService :: Maybe LinkedService
config :: Maybe HostedZoneConfig
$sel:callerReference:HostedZone' :: HostedZone -> Text
$sel:name:HostedZone' :: HostedZone -> Text
$sel:id:HostedZone' :: HostedZone -> ResourceId
$sel:resourceRecordSetCount:HostedZone' :: HostedZone -> Maybe Integer
$sel:linkedService:HostedZone' :: HostedZone -> Maybe LinkedService
$sel:config:HostedZone' :: HostedZone -> Maybe HostedZoneConfig
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe HostedZoneConfig
config
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe LinkedService
linkedService
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Integer
resourceRecordSetCount
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf ResourceId
id
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
name
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
callerReference