{-# 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.GetHostedZone
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Gets information about a specified hosted zone including the four name
-- servers assigned to the hosted zone.
module Amazonka.Route53.GetHostedZone
  ( -- * Creating a Request
    GetHostedZone (..),
    newGetHostedZone,

    -- * Request Lenses
    getHostedZone_id,

    -- * Destructuring the Response
    GetHostedZoneResponse (..),
    newGetHostedZoneResponse,

    -- * Response Lenses
    getHostedZoneResponse_delegationSet,
    getHostedZoneResponse_vPCs,
    getHostedZoneResponse_httpStatus,
    getHostedZoneResponse_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 qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response
import Amazonka.Route53.Types

-- | A request to get information about a specified hosted zone.
--
-- /See:/ 'newGetHostedZone' smart constructor.
data GetHostedZone = GetHostedZone'
  { -- | The ID of the hosted zone that you want to get information about.
    GetHostedZone -> ResourceId
id :: ResourceId
  }
  deriving (GetHostedZone -> GetHostedZone -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetHostedZone -> GetHostedZone -> Bool
$c/= :: GetHostedZone -> GetHostedZone -> Bool
== :: GetHostedZone -> GetHostedZone -> Bool
$c== :: GetHostedZone -> GetHostedZone -> Bool
Prelude.Eq, ReadPrec [GetHostedZone]
ReadPrec GetHostedZone
Int -> ReadS GetHostedZone
ReadS [GetHostedZone]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetHostedZone]
$creadListPrec :: ReadPrec [GetHostedZone]
readPrec :: ReadPrec GetHostedZone
$creadPrec :: ReadPrec GetHostedZone
readList :: ReadS [GetHostedZone]
$creadList :: ReadS [GetHostedZone]
readsPrec :: Int -> ReadS GetHostedZone
$creadsPrec :: Int -> ReadS GetHostedZone
Prelude.Read, Int -> GetHostedZone -> ShowS
[GetHostedZone] -> ShowS
GetHostedZone -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetHostedZone] -> ShowS
$cshowList :: [GetHostedZone] -> ShowS
show :: GetHostedZone -> String
$cshow :: GetHostedZone -> String
showsPrec :: Int -> GetHostedZone -> ShowS
$cshowsPrec :: Int -> GetHostedZone -> ShowS
Prelude.Show, forall x. Rep GetHostedZone x -> GetHostedZone
forall x. GetHostedZone -> Rep GetHostedZone x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetHostedZone x -> GetHostedZone
$cfrom :: forall x. GetHostedZone -> Rep GetHostedZone x
Prelude.Generic)

-- |
-- Create a value of 'GetHostedZone' 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:
--
-- 'id', 'getHostedZone_id' - The ID of the hosted zone that you want to get information about.
newGetHostedZone ::
  -- | 'id'
  ResourceId ->
  GetHostedZone
newGetHostedZone :: ResourceId -> GetHostedZone
newGetHostedZone ResourceId
pId_ = GetHostedZone' {$sel:id:GetHostedZone' :: ResourceId
id = ResourceId
pId_}

-- | The ID of the hosted zone that you want to get information about.
getHostedZone_id :: Lens.Lens' GetHostedZone ResourceId
getHostedZone_id :: Lens' GetHostedZone ResourceId
getHostedZone_id = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetHostedZone' {ResourceId
id :: ResourceId
$sel:id:GetHostedZone' :: GetHostedZone -> ResourceId
id} -> ResourceId
id) (\s :: GetHostedZone
s@GetHostedZone' {} ResourceId
a -> GetHostedZone
s {$sel:id:GetHostedZone' :: ResourceId
id = ResourceId
a} :: GetHostedZone)

instance Core.AWSRequest GetHostedZone where
  type
    AWSResponse GetHostedZone =
      GetHostedZoneResponse
  request :: (Service -> Service) -> GetHostedZone -> Request GetHostedZone
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 GetHostedZone
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse GetHostedZone)))
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 DelegationSet
-> Maybe (NonEmpty VPC)
-> Int
-> HostedZone
-> GetHostedZoneResponse
GetHostedZoneResponse'
            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
"DelegationSet")
            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
"VPCs"
                            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 (f :: * -> *) a b.
Applicative f =>
([a] -> f b) -> [a] -> f (Maybe b)
Core.may (forall a. FromXML a => Text -> [Node] -> Either String (NonEmpty a)
Data.parseXMLList1 Text
"VPC")
                        )
            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 a
Data..@ Text
"HostedZone")
      )

instance Prelude.Hashable GetHostedZone where
  hashWithSalt :: Int -> GetHostedZone -> Int
hashWithSalt Int
_salt GetHostedZone' {ResourceId
id :: ResourceId
$sel:id:GetHostedZone' :: GetHostedZone -> ResourceId
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` ResourceId
id

instance Prelude.NFData GetHostedZone where
  rnf :: GetHostedZone -> ()
rnf GetHostedZone' {ResourceId
id :: ResourceId
$sel:id:GetHostedZone' :: GetHostedZone -> ResourceId
..} = forall a. NFData a => a -> ()
Prelude.rnf ResourceId
id

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

instance Data.ToPath GetHostedZone where
  toPath :: GetHostedZone -> ByteString
toPath GetHostedZone' {ResourceId
id :: ResourceId
$sel:id:GetHostedZone' :: GetHostedZone -> ResourceId
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ByteString
"/2013-04-01/hostedzone/", forall a. ToByteString a => a -> ByteString
Data.toBS ResourceId
id]

instance Data.ToQuery GetHostedZone where
  toQuery :: GetHostedZone -> QueryString
toQuery = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

-- | A complex type that contain the response to a @GetHostedZone@ request.
--
-- /See:/ 'newGetHostedZoneResponse' smart constructor.
data GetHostedZoneResponse = GetHostedZoneResponse'
  { -- | A complex type that lists the Amazon Route 53 name servers for the
    -- specified hosted zone.
    GetHostedZoneResponse -> Maybe DelegationSet
delegationSet :: Prelude.Maybe DelegationSet,
    -- | A complex type that contains information about the VPCs that are
    -- associated with the specified hosted zone.
    GetHostedZoneResponse -> Maybe (NonEmpty VPC)
vPCs :: Prelude.Maybe (Prelude.NonEmpty VPC),
    -- | The response's http status code.
    GetHostedZoneResponse -> Int
httpStatus :: Prelude.Int,
    -- | A complex type that contains general information about the specified
    -- hosted zone.
    GetHostedZoneResponse -> HostedZone
hostedZone :: HostedZone
  }
  deriving (GetHostedZoneResponse -> GetHostedZoneResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetHostedZoneResponse -> GetHostedZoneResponse -> Bool
$c/= :: GetHostedZoneResponse -> GetHostedZoneResponse -> Bool
== :: GetHostedZoneResponse -> GetHostedZoneResponse -> Bool
$c== :: GetHostedZoneResponse -> GetHostedZoneResponse -> Bool
Prelude.Eq, ReadPrec [GetHostedZoneResponse]
ReadPrec GetHostedZoneResponse
Int -> ReadS GetHostedZoneResponse
ReadS [GetHostedZoneResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetHostedZoneResponse]
$creadListPrec :: ReadPrec [GetHostedZoneResponse]
readPrec :: ReadPrec GetHostedZoneResponse
$creadPrec :: ReadPrec GetHostedZoneResponse
readList :: ReadS [GetHostedZoneResponse]
$creadList :: ReadS [GetHostedZoneResponse]
readsPrec :: Int -> ReadS GetHostedZoneResponse
$creadsPrec :: Int -> ReadS GetHostedZoneResponse
Prelude.Read, Int -> GetHostedZoneResponse -> ShowS
[GetHostedZoneResponse] -> ShowS
GetHostedZoneResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetHostedZoneResponse] -> ShowS
$cshowList :: [GetHostedZoneResponse] -> ShowS
show :: GetHostedZoneResponse -> String
$cshow :: GetHostedZoneResponse -> String
showsPrec :: Int -> GetHostedZoneResponse -> ShowS
$cshowsPrec :: Int -> GetHostedZoneResponse -> ShowS
Prelude.Show, forall x. Rep GetHostedZoneResponse x -> GetHostedZoneResponse
forall x. GetHostedZoneResponse -> Rep GetHostedZoneResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetHostedZoneResponse x -> GetHostedZoneResponse
$cfrom :: forall x. GetHostedZoneResponse -> Rep GetHostedZoneResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetHostedZoneResponse' 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:
--
-- 'delegationSet', 'getHostedZoneResponse_delegationSet' - A complex type that lists the Amazon Route 53 name servers for the
-- specified hosted zone.
--
-- 'vPCs', 'getHostedZoneResponse_vPCs' - A complex type that contains information about the VPCs that are
-- associated with the specified hosted zone.
--
-- 'httpStatus', 'getHostedZoneResponse_httpStatus' - The response's http status code.
--
-- 'hostedZone', 'getHostedZoneResponse_hostedZone' - A complex type that contains general information about the specified
-- hosted zone.
newGetHostedZoneResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'hostedZone'
  HostedZone ->
  GetHostedZoneResponse
newGetHostedZoneResponse :: Int -> HostedZone -> GetHostedZoneResponse
newGetHostedZoneResponse Int
pHttpStatus_ HostedZone
pHostedZone_ =
  GetHostedZoneResponse'
    { $sel:delegationSet:GetHostedZoneResponse' :: Maybe DelegationSet
delegationSet =
        forall a. Maybe a
Prelude.Nothing,
      $sel:vPCs:GetHostedZoneResponse' :: Maybe (NonEmpty VPC)
vPCs = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetHostedZoneResponse' :: Int
httpStatus = Int
pHttpStatus_,
      $sel:hostedZone:GetHostedZoneResponse' :: HostedZone
hostedZone = HostedZone
pHostedZone_
    }

-- | A complex type that lists the Amazon Route 53 name servers for the
-- specified hosted zone.
getHostedZoneResponse_delegationSet :: Lens.Lens' GetHostedZoneResponse (Prelude.Maybe DelegationSet)
getHostedZoneResponse_delegationSet :: Lens' GetHostedZoneResponse (Maybe DelegationSet)
getHostedZoneResponse_delegationSet = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetHostedZoneResponse' {Maybe DelegationSet
delegationSet :: Maybe DelegationSet
$sel:delegationSet:GetHostedZoneResponse' :: GetHostedZoneResponse -> Maybe DelegationSet
delegationSet} -> Maybe DelegationSet
delegationSet) (\s :: GetHostedZoneResponse
s@GetHostedZoneResponse' {} Maybe DelegationSet
a -> GetHostedZoneResponse
s {$sel:delegationSet:GetHostedZoneResponse' :: Maybe DelegationSet
delegationSet = Maybe DelegationSet
a} :: GetHostedZoneResponse)

-- | A complex type that contains information about the VPCs that are
-- associated with the specified hosted zone.
getHostedZoneResponse_vPCs :: Lens.Lens' GetHostedZoneResponse (Prelude.Maybe (Prelude.NonEmpty VPC))
getHostedZoneResponse_vPCs :: Lens' GetHostedZoneResponse (Maybe (NonEmpty VPC))
getHostedZoneResponse_vPCs = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetHostedZoneResponse' {Maybe (NonEmpty VPC)
vPCs :: Maybe (NonEmpty VPC)
$sel:vPCs:GetHostedZoneResponse' :: GetHostedZoneResponse -> Maybe (NonEmpty VPC)
vPCs} -> Maybe (NonEmpty VPC)
vPCs) (\s :: GetHostedZoneResponse
s@GetHostedZoneResponse' {} Maybe (NonEmpty VPC)
a -> GetHostedZoneResponse
s {$sel:vPCs:GetHostedZoneResponse' :: Maybe (NonEmpty VPC)
vPCs = Maybe (NonEmpty VPC)
a} :: GetHostedZoneResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

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

-- | A complex type that contains general information about the specified
-- hosted zone.
getHostedZoneResponse_hostedZone :: Lens.Lens' GetHostedZoneResponse HostedZone
getHostedZoneResponse_hostedZone :: Lens' GetHostedZoneResponse HostedZone
getHostedZoneResponse_hostedZone = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetHostedZoneResponse' {HostedZone
hostedZone :: HostedZone
$sel:hostedZone:GetHostedZoneResponse' :: GetHostedZoneResponse -> HostedZone
hostedZone} -> HostedZone
hostedZone) (\s :: GetHostedZoneResponse
s@GetHostedZoneResponse' {} HostedZone
a -> GetHostedZoneResponse
s {$sel:hostedZone:GetHostedZoneResponse' :: HostedZone
hostedZone = HostedZone
a} :: GetHostedZoneResponse)

instance Prelude.NFData GetHostedZoneResponse where
  rnf :: GetHostedZoneResponse -> ()
rnf GetHostedZoneResponse' {Int
Maybe (NonEmpty VPC)
Maybe DelegationSet
HostedZone
hostedZone :: HostedZone
httpStatus :: Int
vPCs :: Maybe (NonEmpty VPC)
delegationSet :: Maybe DelegationSet
$sel:hostedZone:GetHostedZoneResponse' :: GetHostedZoneResponse -> HostedZone
$sel:httpStatus:GetHostedZoneResponse' :: GetHostedZoneResponse -> Int
$sel:vPCs:GetHostedZoneResponse' :: GetHostedZoneResponse -> Maybe (NonEmpty VPC)
$sel:delegationSet:GetHostedZoneResponse' :: GetHostedZoneResponse -> Maybe DelegationSet
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe DelegationSet
delegationSet
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (NonEmpty VPC)
vPCs
      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
hostedZone