{-# 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 #-}
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
data HostedZone = HostedZone'
{
HostedZone -> Maybe HostedZoneConfig
config :: Prelude.Maybe HostedZoneConfig,
HostedZone -> Maybe LinkedService
linkedService :: Prelude.Maybe LinkedService,
HostedZone -> Maybe Integer
resourceRecordSetCount :: Prelude.Maybe Prelude.Integer,
HostedZone -> ResourceId
id :: ResourceId,
HostedZone -> Text
name :: Prelude.Text,
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)
newHostedZone ::
ResourceId ->
Prelude.Text ->
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_
}
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)
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)
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)
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)
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)
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