{-# 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.GetHostedZoneLimit
-- 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 the specified limit for a specified hosted zone, for example, the
-- maximum number of records that you can create in the hosted zone.
--
-- For the default limit, see
-- <https://docs.aws.amazon.com/Route53/latest/DeveloperGuide/DNSLimitations.html Limits>
-- in the /Amazon Route 53 Developer Guide/. To request a higher limit,
-- <https://console.aws.amazon.com/support/home#/case/create?issueType=service-limit-increase&limitType=service-code-route53 open a case>.
module Amazonka.Route53.GetHostedZoneLimit
  ( -- * Creating a Request
    GetHostedZoneLimit (..),
    newGetHostedZoneLimit,

    -- * Request Lenses
    getHostedZoneLimit_type,
    getHostedZoneLimit_hostedZoneId,

    -- * Destructuring the Response
    GetHostedZoneLimitResponse (..),
    newGetHostedZoneLimitResponse,

    -- * Response Lenses
    getHostedZoneLimitResponse_httpStatus,
    getHostedZoneLimitResponse_limit,
    getHostedZoneLimitResponse_count,
  )
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 complex type that contains information about the request to create a
-- hosted zone.
--
-- /See:/ 'newGetHostedZoneLimit' smart constructor.
data GetHostedZoneLimit = GetHostedZoneLimit'
  { -- | The limit that you want to get. Valid values include the following:
    --
    -- -   __MAX_RRSETS_BY_ZONE__: The maximum number of records that you can
    --     create in the specified hosted zone.
    --
    -- -   __MAX_VPCS_ASSOCIATED_BY_ZONE__: The maximum number of Amazon VPCs
    --     that you can associate with the specified private hosted zone.
    GetHostedZoneLimit -> HostedZoneLimitType
type' :: HostedZoneLimitType,
    -- | The ID of the hosted zone that you want to get a limit for.
    GetHostedZoneLimit -> ResourceId
hostedZoneId :: ResourceId
  }
  deriving (GetHostedZoneLimit -> GetHostedZoneLimit -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetHostedZoneLimit -> GetHostedZoneLimit -> Bool
$c/= :: GetHostedZoneLimit -> GetHostedZoneLimit -> Bool
== :: GetHostedZoneLimit -> GetHostedZoneLimit -> Bool
$c== :: GetHostedZoneLimit -> GetHostedZoneLimit -> Bool
Prelude.Eq, ReadPrec [GetHostedZoneLimit]
ReadPrec GetHostedZoneLimit
Int -> ReadS GetHostedZoneLimit
ReadS [GetHostedZoneLimit]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetHostedZoneLimit]
$creadListPrec :: ReadPrec [GetHostedZoneLimit]
readPrec :: ReadPrec GetHostedZoneLimit
$creadPrec :: ReadPrec GetHostedZoneLimit
readList :: ReadS [GetHostedZoneLimit]
$creadList :: ReadS [GetHostedZoneLimit]
readsPrec :: Int -> ReadS GetHostedZoneLimit
$creadsPrec :: Int -> ReadS GetHostedZoneLimit
Prelude.Read, Int -> GetHostedZoneLimit -> ShowS
[GetHostedZoneLimit] -> ShowS
GetHostedZoneLimit -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetHostedZoneLimit] -> ShowS
$cshowList :: [GetHostedZoneLimit] -> ShowS
show :: GetHostedZoneLimit -> String
$cshow :: GetHostedZoneLimit -> String
showsPrec :: Int -> GetHostedZoneLimit -> ShowS
$cshowsPrec :: Int -> GetHostedZoneLimit -> ShowS
Prelude.Show, forall x. Rep GetHostedZoneLimit x -> GetHostedZoneLimit
forall x. GetHostedZoneLimit -> Rep GetHostedZoneLimit x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetHostedZoneLimit x -> GetHostedZoneLimit
$cfrom :: forall x. GetHostedZoneLimit -> Rep GetHostedZoneLimit x
Prelude.Generic)

-- |
-- Create a value of 'GetHostedZoneLimit' 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:
--
-- 'type'', 'getHostedZoneLimit_type' - The limit that you want to get. Valid values include the following:
--
-- -   __MAX_RRSETS_BY_ZONE__: The maximum number of records that you can
--     create in the specified hosted zone.
--
-- -   __MAX_VPCS_ASSOCIATED_BY_ZONE__: The maximum number of Amazon VPCs
--     that you can associate with the specified private hosted zone.
--
-- 'hostedZoneId', 'getHostedZoneLimit_hostedZoneId' - The ID of the hosted zone that you want to get a limit for.
newGetHostedZoneLimit ::
  -- | 'type''
  HostedZoneLimitType ->
  -- | 'hostedZoneId'
  ResourceId ->
  GetHostedZoneLimit
newGetHostedZoneLimit :: HostedZoneLimitType -> ResourceId -> GetHostedZoneLimit
newGetHostedZoneLimit HostedZoneLimitType
pType_ ResourceId
pHostedZoneId_ =
  GetHostedZoneLimit'
    { $sel:type':GetHostedZoneLimit' :: HostedZoneLimitType
type' = HostedZoneLimitType
pType_,
      $sel:hostedZoneId:GetHostedZoneLimit' :: ResourceId
hostedZoneId = ResourceId
pHostedZoneId_
    }

-- | The limit that you want to get. Valid values include the following:
--
-- -   __MAX_RRSETS_BY_ZONE__: The maximum number of records that you can
--     create in the specified hosted zone.
--
-- -   __MAX_VPCS_ASSOCIATED_BY_ZONE__: The maximum number of Amazon VPCs
--     that you can associate with the specified private hosted zone.
getHostedZoneLimit_type :: Lens.Lens' GetHostedZoneLimit HostedZoneLimitType
getHostedZoneLimit_type :: Lens' GetHostedZoneLimit HostedZoneLimitType
getHostedZoneLimit_type = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetHostedZoneLimit' {HostedZoneLimitType
type' :: HostedZoneLimitType
$sel:type':GetHostedZoneLimit' :: GetHostedZoneLimit -> HostedZoneLimitType
type'} -> HostedZoneLimitType
type') (\s :: GetHostedZoneLimit
s@GetHostedZoneLimit' {} HostedZoneLimitType
a -> GetHostedZoneLimit
s {$sel:type':GetHostedZoneLimit' :: HostedZoneLimitType
type' = HostedZoneLimitType
a} :: GetHostedZoneLimit)

-- | The ID of the hosted zone that you want to get a limit for.
getHostedZoneLimit_hostedZoneId :: Lens.Lens' GetHostedZoneLimit ResourceId
getHostedZoneLimit_hostedZoneId :: Lens' GetHostedZoneLimit ResourceId
getHostedZoneLimit_hostedZoneId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetHostedZoneLimit' {ResourceId
hostedZoneId :: ResourceId
$sel:hostedZoneId:GetHostedZoneLimit' :: GetHostedZoneLimit -> ResourceId
hostedZoneId} -> ResourceId
hostedZoneId) (\s :: GetHostedZoneLimit
s@GetHostedZoneLimit' {} ResourceId
a -> GetHostedZoneLimit
s {$sel:hostedZoneId:GetHostedZoneLimit' :: ResourceId
hostedZoneId = ResourceId
a} :: GetHostedZoneLimit)

instance Core.AWSRequest GetHostedZoneLimit where
  type
    AWSResponse GetHostedZoneLimit =
      GetHostedZoneLimitResponse
  request :: (Service -> Service)
-> GetHostedZoneLimit -> Request GetHostedZoneLimit
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 GetHostedZoneLimit
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse GetHostedZoneLimit)))
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 ->
          Int -> HostedZoneLimit -> Natural -> GetHostedZoneLimitResponse
GetHostedZoneLimitResponse'
            forall (f :: * -> *) a b. Functor 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
"Limit")
            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
"Count")
      )

instance Prelude.Hashable GetHostedZoneLimit where
  hashWithSalt :: Int -> GetHostedZoneLimit -> Int
hashWithSalt Int
_salt GetHostedZoneLimit' {ResourceId
HostedZoneLimitType
hostedZoneId :: ResourceId
type' :: HostedZoneLimitType
$sel:hostedZoneId:GetHostedZoneLimit' :: GetHostedZoneLimit -> ResourceId
$sel:type':GetHostedZoneLimit' :: GetHostedZoneLimit -> HostedZoneLimitType
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` HostedZoneLimitType
type'
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` ResourceId
hostedZoneId

instance Prelude.NFData GetHostedZoneLimit where
  rnf :: GetHostedZoneLimit -> ()
rnf GetHostedZoneLimit' {ResourceId
HostedZoneLimitType
hostedZoneId :: ResourceId
type' :: HostedZoneLimitType
$sel:hostedZoneId:GetHostedZoneLimit' :: GetHostedZoneLimit -> ResourceId
$sel:type':GetHostedZoneLimit' :: GetHostedZoneLimit -> HostedZoneLimitType
..} =
    forall a. NFData a => a -> ()
Prelude.rnf HostedZoneLimitType
type'
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf ResourceId
hostedZoneId

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

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

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

-- | A complex type that contains the requested limit.
--
-- /See:/ 'newGetHostedZoneLimitResponse' smart constructor.
data GetHostedZoneLimitResponse = GetHostedZoneLimitResponse'
  { -- | The response's http status code.
    GetHostedZoneLimitResponse -> Int
httpStatus :: Prelude.Int,
    -- | The current setting for the specified limit. For example, if you
    -- specified @MAX_RRSETS_BY_ZONE@ for the value of @Type@ in the request,
    -- the value of @Limit@ is the maximum number of records that you can
    -- create in the specified hosted zone.
    GetHostedZoneLimitResponse -> HostedZoneLimit
limit :: HostedZoneLimit,
    -- | The current number of entities that you have created of the specified
    -- type. For example, if you specified @MAX_RRSETS_BY_ZONE@ for the value
    -- of @Type@ in the request, the value of @Count@ is the current number of
    -- records that you have created in the specified hosted zone.
    GetHostedZoneLimitResponse -> Natural
count :: Prelude.Natural
  }
  deriving (GetHostedZoneLimitResponse -> GetHostedZoneLimitResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetHostedZoneLimitResponse -> GetHostedZoneLimitResponse -> Bool
$c/= :: GetHostedZoneLimitResponse -> GetHostedZoneLimitResponse -> Bool
== :: GetHostedZoneLimitResponse -> GetHostedZoneLimitResponse -> Bool
$c== :: GetHostedZoneLimitResponse -> GetHostedZoneLimitResponse -> Bool
Prelude.Eq, ReadPrec [GetHostedZoneLimitResponse]
ReadPrec GetHostedZoneLimitResponse
Int -> ReadS GetHostedZoneLimitResponse
ReadS [GetHostedZoneLimitResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetHostedZoneLimitResponse]
$creadListPrec :: ReadPrec [GetHostedZoneLimitResponse]
readPrec :: ReadPrec GetHostedZoneLimitResponse
$creadPrec :: ReadPrec GetHostedZoneLimitResponse
readList :: ReadS [GetHostedZoneLimitResponse]
$creadList :: ReadS [GetHostedZoneLimitResponse]
readsPrec :: Int -> ReadS GetHostedZoneLimitResponse
$creadsPrec :: Int -> ReadS GetHostedZoneLimitResponse
Prelude.Read, Int -> GetHostedZoneLimitResponse -> ShowS
[GetHostedZoneLimitResponse] -> ShowS
GetHostedZoneLimitResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetHostedZoneLimitResponse] -> ShowS
$cshowList :: [GetHostedZoneLimitResponse] -> ShowS
show :: GetHostedZoneLimitResponse -> String
$cshow :: GetHostedZoneLimitResponse -> String
showsPrec :: Int -> GetHostedZoneLimitResponse -> ShowS
$cshowsPrec :: Int -> GetHostedZoneLimitResponse -> ShowS
Prelude.Show, forall x.
Rep GetHostedZoneLimitResponse x -> GetHostedZoneLimitResponse
forall x.
GetHostedZoneLimitResponse -> Rep GetHostedZoneLimitResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetHostedZoneLimitResponse x -> GetHostedZoneLimitResponse
$cfrom :: forall x.
GetHostedZoneLimitResponse -> Rep GetHostedZoneLimitResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetHostedZoneLimitResponse' 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:
--
-- 'httpStatus', 'getHostedZoneLimitResponse_httpStatus' - The response's http status code.
--
-- 'limit', 'getHostedZoneLimitResponse_limit' - The current setting for the specified limit. For example, if you
-- specified @MAX_RRSETS_BY_ZONE@ for the value of @Type@ in the request,
-- the value of @Limit@ is the maximum number of records that you can
-- create in the specified hosted zone.
--
-- 'count', 'getHostedZoneLimitResponse_count' - The current number of entities that you have created of the specified
-- type. For example, if you specified @MAX_RRSETS_BY_ZONE@ for the value
-- of @Type@ in the request, the value of @Count@ is the current number of
-- records that you have created in the specified hosted zone.
newGetHostedZoneLimitResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'limit'
  HostedZoneLimit ->
  -- | 'count'
  Prelude.Natural ->
  GetHostedZoneLimitResponse
newGetHostedZoneLimitResponse :: Int -> HostedZoneLimit -> Natural -> GetHostedZoneLimitResponse
newGetHostedZoneLimitResponse
  Int
pHttpStatus_
  HostedZoneLimit
pLimit_
  Natural
pCount_ =
    GetHostedZoneLimitResponse'
      { $sel:httpStatus:GetHostedZoneLimitResponse' :: Int
httpStatus =
          Int
pHttpStatus_,
        $sel:limit:GetHostedZoneLimitResponse' :: HostedZoneLimit
limit = HostedZoneLimit
pLimit_,
        $sel:count:GetHostedZoneLimitResponse' :: Natural
count = Natural
pCount_
      }

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

-- | The current setting for the specified limit. For example, if you
-- specified @MAX_RRSETS_BY_ZONE@ for the value of @Type@ in the request,
-- the value of @Limit@ is the maximum number of records that you can
-- create in the specified hosted zone.
getHostedZoneLimitResponse_limit :: Lens.Lens' GetHostedZoneLimitResponse HostedZoneLimit
getHostedZoneLimitResponse_limit :: Lens' GetHostedZoneLimitResponse HostedZoneLimit
getHostedZoneLimitResponse_limit = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetHostedZoneLimitResponse' {HostedZoneLimit
limit :: HostedZoneLimit
$sel:limit:GetHostedZoneLimitResponse' :: GetHostedZoneLimitResponse -> HostedZoneLimit
limit} -> HostedZoneLimit
limit) (\s :: GetHostedZoneLimitResponse
s@GetHostedZoneLimitResponse' {} HostedZoneLimit
a -> GetHostedZoneLimitResponse
s {$sel:limit:GetHostedZoneLimitResponse' :: HostedZoneLimit
limit = HostedZoneLimit
a} :: GetHostedZoneLimitResponse)

-- | The current number of entities that you have created of the specified
-- type. For example, if you specified @MAX_RRSETS_BY_ZONE@ for the value
-- of @Type@ in the request, the value of @Count@ is the current number of
-- records that you have created in the specified hosted zone.
getHostedZoneLimitResponse_count :: Lens.Lens' GetHostedZoneLimitResponse Prelude.Natural
getHostedZoneLimitResponse_count :: Lens' GetHostedZoneLimitResponse Natural
getHostedZoneLimitResponse_count = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetHostedZoneLimitResponse' {Natural
count :: Natural
$sel:count:GetHostedZoneLimitResponse' :: GetHostedZoneLimitResponse -> Natural
count} -> Natural
count) (\s :: GetHostedZoneLimitResponse
s@GetHostedZoneLimitResponse' {} Natural
a -> GetHostedZoneLimitResponse
s {$sel:count:GetHostedZoneLimitResponse' :: Natural
count = Natural
a} :: GetHostedZoneLimitResponse)

instance Prelude.NFData GetHostedZoneLimitResponse where
  rnf :: GetHostedZoneLimitResponse -> ()
rnf GetHostedZoneLimitResponse' {Int
Natural
HostedZoneLimit
count :: Natural
limit :: HostedZoneLimit
httpStatus :: Int
$sel:count:GetHostedZoneLimitResponse' :: GetHostedZoneLimitResponse -> Natural
$sel:limit:GetHostedZoneLimitResponse' :: GetHostedZoneLimitResponse -> HostedZoneLimit
$sel:httpStatus:GetHostedZoneLimitResponse' :: GetHostedZoneLimitResponse -> Int
..} =
    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 HostedZoneLimit
limit
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Natural
count