{-# 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.GetAccountLimit
-- 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 the current account, for example, the
-- maximum number of health checks that you can create using the account.
--
-- 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>.
--
-- You can also view account limits in Amazon Web Services Trusted Advisor.
-- Sign in to the Amazon Web Services Management Console and open the
-- Trusted Advisor console at
-- <https://console.aws.amazon.com/trustedadvisor https:\/\/console.aws.amazon.com\/trustedadvisor\/>.
-- Then choose __Service limits__ in the navigation pane.
module Amazonka.Route53.GetAccountLimit
  ( -- * Creating a Request
    GetAccountLimit (..),
    newGetAccountLimit,

    -- * Request Lenses
    getAccountLimit_type,

    -- * Destructuring the Response
    GetAccountLimitResponse (..),
    newGetAccountLimitResponse,

    -- * Response Lenses
    getAccountLimitResponse_httpStatus,
    getAccountLimitResponse_limit,
    getAccountLimitResponse_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:/ 'newGetAccountLimit' smart constructor.
data GetAccountLimit = GetAccountLimit'
  { -- | The limit that you want to get. Valid values include the following:
    --
    -- -   __MAX_HEALTH_CHECKS_BY_OWNER__: The maximum number of health checks
    --     that you can create using the current account.
    --
    -- -   __MAX_HOSTED_ZONES_BY_OWNER__: The maximum number of hosted zones
    --     that you can create using the current account.
    --
    -- -   __MAX_REUSABLE_DELEGATION_SETS_BY_OWNER__: The maximum number of
    --     reusable delegation sets that you can create using the current
    --     account.
    --
    -- -   __MAX_TRAFFIC_POLICIES_BY_OWNER__: The maximum number of traffic
    --     policies that you can create using the current account.
    --
    -- -   __MAX_TRAFFIC_POLICY_INSTANCES_BY_OWNER__: The maximum number of
    --     traffic policy instances that you can create using the current
    --     account. (Traffic policy instances are referred to as traffic flow
    --     policy records in the Amazon Route 53 console.)
    GetAccountLimit -> AccountLimitType
type' :: AccountLimitType
  }
  deriving (GetAccountLimit -> GetAccountLimit -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetAccountLimit -> GetAccountLimit -> Bool
$c/= :: GetAccountLimit -> GetAccountLimit -> Bool
== :: GetAccountLimit -> GetAccountLimit -> Bool
$c== :: GetAccountLimit -> GetAccountLimit -> Bool
Prelude.Eq, ReadPrec [GetAccountLimit]
ReadPrec GetAccountLimit
Int -> ReadS GetAccountLimit
ReadS [GetAccountLimit]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetAccountLimit]
$creadListPrec :: ReadPrec [GetAccountLimit]
readPrec :: ReadPrec GetAccountLimit
$creadPrec :: ReadPrec GetAccountLimit
readList :: ReadS [GetAccountLimit]
$creadList :: ReadS [GetAccountLimit]
readsPrec :: Int -> ReadS GetAccountLimit
$creadsPrec :: Int -> ReadS GetAccountLimit
Prelude.Read, Int -> GetAccountLimit -> ShowS
[GetAccountLimit] -> ShowS
GetAccountLimit -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetAccountLimit] -> ShowS
$cshowList :: [GetAccountLimit] -> ShowS
show :: GetAccountLimit -> String
$cshow :: GetAccountLimit -> String
showsPrec :: Int -> GetAccountLimit -> ShowS
$cshowsPrec :: Int -> GetAccountLimit -> ShowS
Prelude.Show, forall x. Rep GetAccountLimit x -> GetAccountLimit
forall x. GetAccountLimit -> Rep GetAccountLimit x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetAccountLimit x -> GetAccountLimit
$cfrom :: forall x. GetAccountLimit -> Rep GetAccountLimit x
Prelude.Generic)

-- |
-- Create a value of 'GetAccountLimit' 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'', 'getAccountLimit_type' - The limit that you want to get. Valid values include the following:
--
-- -   __MAX_HEALTH_CHECKS_BY_OWNER__: The maximum number of health checks
--     that you can create using the current account.
--
-- -   __MAX_HOSTED_ZONES_BY_OWNER__: The maximum number of hosted zones
--     that you can create using the current account.
--
-- -   __MAX_REUSABLE_DELEGATION_SETS_BY_OWNER__: The maximum number of
--     reusable delegation sets that you can create using the current
--     account.
--
-- -   __MAX_TRAFFIC_POLICIES_BY_OWNER__: The maximum number of traffic
--     policies that you can create using the current account.
--
-- -   __MAX_TRAFFIC_POLICY_INSTANCES_BY_OWNER__: The maximum number of
--     traffic policy instances that you can create using the current
--     account. (Traffic policy instances are referred to as traffic flow
--     policy records in the Amazon Route 53 console.)
newGetAccountLimit ::
  -- | 'type''
  AccountLimitType ->
  GetAccountLimit
newGetAccountLimit :: AccountLimitType -> GetAccountLimit
newGetAccountLimit AccountLimitType
pType_ =
  GetAccountLimit' {$sel:type':GetAccountLimit' :: AccountLimitType
type' = AccountLimitType
pType_}

-- | The limit that you want to get. Valid values include the following:
--
-- -   __MAX_HEALTH_CHECKS_BY_OWNER__: The maximum number of health checks
--     that you can create using the current account.
--
-- -   __MAX_HOSTED_ZONES_BY_OWNER__: The maximum number of hosted zones
--     that you can create using the current account.
--
-- -   __MAX_REUSABLE_DELEGATION_SETS_BY_OWNER__: The maximum number of
--     reusable delegation sets that you can create using the current
--     account.
--
-- -   __MAX_TRAFFIC_POLICIES_BY_OWNER__: The maximum number of traffic
--     policies that you can create using the current account.
--
-- -   __MAX_TRAFFIC_POLICY_INSTANCES_BY_OWNER__: The maximum number of
--     traffic policy instances that you can create using the current
--     account. (Traffic policy instances are referred to as traffic flow
--     policy records in the Amazon Route 53 console.)
getAccountLimit_type :: Lens.Lens' GetAccountLimit AccountLimitType
getAccountLimit_type :: Lens' GetAccountLimit AccountLimitType
getAccountLimit_type = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetAccountLimit' {AccountLimitType
type' :: AccountLimitType
$sel:type':GetAccountLimit' :: GetAccountLimit -> AccountLimitType
type'} -> AccountLimitType
type') (\s :: GetAccountLimit
s@GetAccountLimit' {} AccountLimitType
a -> GetAccountLimit
s {$sel:type':GetAccountLimit' :: AccountLimitType
type' = AccountLimitType
a} :: GetAccountLimit)

instance Core.AWSRequest GetAccountLimit where
  type
    AWSResponse GetAccountLimit =
      GetAccountLimitResponse
  request :: (Service -> Service) -> GetAccountLimit -> Request GetAccountLimit
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 GetAccountLimit
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse GetAccountLimit)))
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 -> AccountLimit -> Natural -> GetAccountLimitResponse
GetAccountLimitResponse'
            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 GetAccountLimit where
  hashWithSalt :: Int -> GetAccountLimit -> Int
hashWithSalt Int
_salt GetAccountLimit' {AccountLimitType
type' :: AccountLimitType
$sel:type':GetAccountLimit' :: GetAccountLimit -> AccountLimitType
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` AccountLimitType
type'

instance Prelude.NFData GetAccountLimit where
  rnf :: GetAccountLimit -> ()
rnf GetAccountLimit' {AccountLimitType
type' :: AccountLimitType
$sel:type':GetAccountLimit' :: GetAccountLimit -> AccountLimitType
..} = forall a. NFData a => a -> ()
Prelude.rnf AccountLimitType
type'

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

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

instance Data.ToQuery GetAccountLimit where
  toQuery :: GetAccountLimit -> 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:/ 'newGetAccountLimitResponse' smart constructor.
data GetAccountLimitResponse = GetAccountLimitResponse'
  { -- | The response's http status code.
    GetAccountLimitResponse -> Int
httpStatus :: Prelude.Int,
    -- | The current setting for the specified limit. For example, if you
    -- specified @MAX_HEALTH_CHECKS_BY_OWNER@ for the value of @Type@ in the
    -- request, the value of @Limit@ is the maximum number of health checks
    -- that you can create using the current account.
    GetAccountLimitResponse -> AccountLimit
limit :: AccountLimit,
    -- | The current number of entities that you have created of the specified
    -- type. For example, if you specified @MAX_HEALTH_CHECKS_BY_OWNER@ for the
    -- value of @Type@ in the request, the value of @Count@ is the current
    -- number of health checks that you have created using the current account.
    GetAccountLimitResponse -> Natural
count :: Prelude.Natural
  }
  deriving (GetAccountLimitResponse -> GetAccountLimitResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetAccountLimitResponse -> GetAccountLimitResponse -> Bool
$c/= :: GetAccountLimitResponse -> GetAccountLimitResponse -> Bool
== :: GetAccountLimitResponse -> GetAccountLimitResponse -> Bool
$c== :: GetAccountLimitResponse -> GetAccountLimitResponse -> Bool
Prelude.Eq, ReadPrec [GetAccountLimitResponse]
ReadPrec GetAccountLimitResponse
Int -> ReadS GetAccountLimitResponse
ReadS [GetAccountLimitResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetAccountLimitResponse]
$creadListPrec :: ReadPrec [GetAccountLimitResponse]
readPrec :: ReadPrec GetAccountLimitResponse
$creadPrec :: ReadPrec GetAccountLimitResponse
readList :: ReadS [GetAccountLimitResponse]
$creadList :: ReadS [GetAccountLimitResponse]
readsPrec :: Int -> ReadS GetAccountLimitResponse
$creadsPrec :: Int -> ReadS GetAccountLimitResponse
Prelude.Read, Int -> GetAccountLimitResponse -> ShowS
[GetAccountLimitResponse] -> ShowS
GetAccountLimitResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetAccountLimitResponse] -> ShowS
$cshowList :: [GetAccountLimitResponse] -> ShowS
show :: GetAccountLimitResponse -> String
$cshow :: GetAccountLimitResponse -> String
showsPrec :: Int -> GetAccountLimitResponse -> ShowS
$cshowsPrec :: Int -> GetAccountLimitResponse -> ShowS
Prelude.Show, forall x. Rep GetAccountLimitResponse x -> GetAccountLimitResponse
forall x. GetAccountLimitResponse -> Rep GetAccountLimitResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetAccountLimitResponse x -> GetAccountLimitResponse
$cfrom :: forall x. GetAccountLimitResponse -> Rep GetAccountLimitResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetAccountLimitResponse' 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', 'getAccountLimitResponse_httpStatus' - The response's http status code.
--
-- 'limit', 'getAccountLimitResponse_limit' - The current setting for the specified limit. For example, if you
-- specified @MAX_HEALTH_CHECKS_BY_OWNER@ for the value of @Type@ in the
-- request, the value of @Limit@ is the maximum number of health checks
-- that you can create using the current account.
--
-- 'count', 'getAccountLimitResponse_count' - The current number of entities that you have created of the specified
-- type. For example, if you specified @MAX_HEALTH_CHECKS_BY_OWNER@ for the
-- value of @Type@ in the request, the value of @Count@ is the current
-- number of health checks that you have created using the current account.
newGetAccountLimitResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'limit'
  AccountLimit ->
  -- | 'count'
  Prelude.Natural ->
  GetAccountLimitResponse
newGetAccountLimitResponse :: Int -> AccountLimit -> Natural -> GetAccountLimitResponse
newGetAccountLimitResponse
  Int
pHttpStatus_
  AccountLimit
pLimit_
  Natural
pCount_ =
    GetAccountLimitResponse'
      { $sel:httpStatus:GetAccountLimitResponse' :: Int
httpStatus = Int
pHttpStatus_,
        $sel:limit:GetAccountLimitResponse' :: AccountLimit
limit = AccountLimit
pLimit_,
        $sel:count:GetAccountLimitResponse' :: Natural
count = Natural
pCount_
      }

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

-- | The current setting for the specified limit. For example, if you
-- specified @MAX_HEALTH_CHECKS_BY_OWNER@ for the value of @Type@ in the
-- request, the value of @Limit@ is the maximum number of health checks
-- that you can create using the current account.
getAccountLimitResponse_limit :: Lens.Lens' GetAccountLimitResponse AccountLimit
getAccountLimitResponse_limit :: Lens' GetAccountLimitResponse AccountLimit
getAccountLimitResponse_limit = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetAccountLimitResponse' {AccountLimit
limit :: AccountLimit
$sel:limit:GetAccountLimitResponse' :: GetAccountLimitResponse -> AccountLimit
limit} -> AccountLimit
limit) (\s :: GetAccountLimitResponse
s@GetAccountLimitResponse' {} AccountLimit
a -> GetAccountLimitResponse
s {$sel:limit:GetAccountLimitResponse' :: AccountLimit
limit = AccountLimit
a} :: GetAccountLimitResponse)

-- | The current number of entities that you have created of the specified
-- type. For example, if you specified @MAX_HEALTH_CHECKS_BY_OWNER@ for the
-- value of @Type@ in the request, the value of @Count@ is the current
-- number of health checks that you have created using the current account.
getAccountLimitResponse_count :: Lens.Lens' GetAccountLimitResponse Prelude.Natural
getAccountLimitResponse_count :: Lens' GetAccountLimitResponse Natural
getAccountLimitResponse_count = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetAccountLimitResponse' {Natural
count :: Natural
$sel:count:GetAccountLimitResponse' :: GetAccountLimitResponse -> Natural
count} -> Natural
count) (\s :: GetAccountLimitResponse
s@GetAccountLimitResponse' {} Natural
a -> GetAccountLimitResponse
s {$sel:count:GetAccountLimitResponse' :: Natural
count = Natural
a} :: GetAccountLimitResponse)

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