{-# 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.GetReusableDelegationSetLimit
-- 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 maximum number of hosted zones that you can associate with the
-- specified reusable delegation set.
--
-- 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.GetReusableDelegationSetLimit
  ( -- * Creating a Request
    GetReusableDelegationSetLimit (..),
    newGetReusableDelegationSetLimit,

    -- * Request Lenses
    getReusableDelegationSetLimit_type,
    getReusableDelegationSetLimit_delegationSetId,

    -- * Destructuring the Response
    GetReusableDelegationSetLimitResponse (..),
    newGetReusableDelegationSetLimitResponse,

    -- * Response Lenses
    getReusableDelegationSetLimitResponse_httpStatus,
    getReusableDelegationSetLimitResponse_limit,
    getReusableDelegationSetLimitResponse_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:/ 'newGetReusableDelegationSetLimit' smart constructor.
data GetReusableDelegationSetLimit = GetReusableDelegationSetLimit'
  { -- | Specify @MAX_ZONES_BY_REUSABLE_DELEGATION_SET@ to get the maximum number
    -- of hosted zones that you can associate with the specified reusable
    -- delegation set.
    GetReusableDelegationSetLimit -> ReusableDelegationSetLimitType
type' :: ReusableDelegationSetLimitType,
    -- | The ID of the delegation set that you want to get the limit for.
    GetReusableDelegationSetLimit -> ResourceId
delegationSetId :: ResourceId
  }
  deriving (GetReusableDelegationSetLimit
-> GetReusableDelegationSetLimit -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetReusableDelegationSetLimit
-> GetReusableDelegationSetLimit -> Bool
$c/= :: GetReusableDelegationSetLimit
-> GetReusableDelegationSetLimit -> Bool
== :: GetReusableDelegationSetLimit
-> GetReusableDelegationSetLimit -> Bool
$c== :: GetReusableDelegationSetLimit
-> GetReusableDelegationSetLimit -> Bool
Prelude.Eq, ReadPrec [GetReusableDelegationSetLimit]
ReadPrec GetReusableDelegationSetLimit
Int -> ReadS GetReusableDelegationSetLimit
ReadS [GetReusableDelegationSetLimit]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetReusableDelegationSetLimit]
$creadListPrec :: ReadPrec [GetReusableDelegationSetLimit]
readPrec :: ReadPrec GetReusableDelegationSetLimit
$creadPrec :: ReadPrec GetReusableDelegationSetLimit
readList :: ReadS [GetReusableDelegationSetLimit]
$creadList :: ReadS [GetReusableDelegationSetLimit]
readsPrec :: Int -> ReadS GetReusableDelegationSetLimit
$creadsPrec :: Int -> ReadS GetReusableDelegationSetLimit
Prelude.Read, Int -> GetReusableDelegationSetLimit -> ShowS
[GetReusableDelegationSetLimit] -> ShowS
GetReusableDelegationSetLimit -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetReusableDelegationSetLimit] -> ShowS
$cshowList :: [GetReusableDelegationSetLimit] -> ShowS
show :: GetReusableDelegationSetLimit -> String
$cshow :: GetReusableDelegationSetLimit -> String
showsPrec :: Int -> GetReusableDelegationSetLimit -> ShowS
$cshowsPrec :: Int -> GetReusableDelegationSetLimit -> ShowS
Prelude.Show, forall x.
Rep GetReusableDelegationSetLimit x
-> GetReusableDelegationSetLimit
forall x.
GetReusableDelegationSetLimit
-> Rep GetReusableDelegationSetLimit x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetReusableDelegationSetLimit x
-> GetReusableDelegationSetLimit
$cfrom :: forall x.
GetReusableDelegationSetLimit
-> Rep GetReusableDelegationSetLimit x
Prelude.Generic)

-- |
-- Create a value of 'GetReusableDelegationSetLimit' 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'', 'getReusableDelegationSetLimit_type' - Specify @MAX_ZONES_BY_REUSABLE_DELEGATION_SET@ to get the maximum number
-- of hosted zones that you can associate with the specified reusable
-- delegation set.
--
-- 'delegationSetId', 'getReusableDelegationSetLimit_delegationSetId' - The ID of the delegation set that you want to get the limit for.
newGetReusableDelegationSetLimit ::
  -- | 'type''
  ReusableDelegationSetLimitType ->
  -- | 'delegationSetId'
  ResourceId ->
  GetReusableDelegationSetLimit
newGetReusableDelegationSetLimit :: ReusableDelegationSetLimitType
-> ResourceId -> GetReusableDelegationSetLimit
newGetReusableDelegationSetLimit
  ReusableDelegationSetLimitType
pType_
  ResourceId
pDelegationSetId_ =
    GetReusableDelegationSetLimit'
      { $sel:type':GetReusableDelegationSetLimit' :: ReusableDelegationSetLimitType
type' = ReusableDelegationSetLimitType
pType_,
        $sel:delegationSetId:GetReusableDelegationSetLimit' :: ResourceId
delegationSetId = ResourceId
pDelegationSetId_
      }

-- | Specify @MAX_ZONES_BY_REUSABLE_DELEGATION_SET@ to get the maximum number
-- of hosted zones that you can associate with the specified reusable
-- delegation set.
getReusableDelegationSetLimit_type :: Lens.Lens' GetReusableDelegationSetLimit ReusableDelegationSetLimitType
getReusableDelegationSetLimit_type :: Lens' GetReusableDelegationSetLimit ReusableDelegationSetLimitType
getReusableDelegationSetLimit_type = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetReusableDelegationSetLimit' {ReusableDelegationSetLimitType
type' :: ReusableDelegationSetLimitType
$sel:type':GetReusableDelegationSetLimit' :: GetReusableDelegationSetLimit -> ReusableDelegationSetLimitType
type'} -> ReusableDelegationSetLimitType
type') (\s :: GetReusableDelegationSetLimit
s@GetReusableDelegationSetLimit' {} ReusableDelegationSetLimitType
a -> GetReusableDelegationSetLimit
s {$sel:type':GetReusableDelegationSetLimit' :: ReusableDelegationSetLimitType
type' = ReusableDelegationSetLimitType
a} :: GetReusableDelegationSetLimit)

-- | The ID of the delegation set that you want to get the limit for.
getReusableDelegationSetLimit_delegationSetId :: Lens.Lens' GetReusableDelegationSetLimit ResourceId
getReusableDelegationSetLimit_delegationSetId :: Lens' GetReusableDelegationSetLimit ResourceId
getReusableDelegationSetLimit_delegationSetId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetReusableDelegationSetLimit' {ResourceId
delegationSetId :: ResourceId
$sel:delegationSetId:GetReusableDelegationSetLimit' :: GetReusableDelegationSetLimit -> ResourceId
delegationSetId} -> ResourceId
delegationSetId) (\s :: GetReusableDelegationSetLimit
s@GetReusableDelegationSetLimit' {} ResourceId
a -> GetReusableDelegationSetLimit
s {$sel:delegationSetId:GetReusableDelegationSetLimit' :: ResourceId
delegationSetId = ResourceId
a} :: GetReusableDelegationSetLimit)

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

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

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

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

instance Data.ToQuery GetReusableDelegationSetLimit where
  toQuery :: GetReusableDelegationSetLimit -> 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:/ 'newGetReusableDelegationSetLimitResponse' smart constructor.
data GetReusableDelegationSetLimitResponse = GetReusableDelegationSetLimitResponse'
  { -- | The response's http status code.
    GetReusableDelegationSetLimitResponse -> Int
httpStatus :: Prelude.Int,
    -- | The current setting for the limit on hosted zones that you can associate
    -- with the specified reusable delegation set.
    GetReusableDelegationSetLimitResponse -> ReusableDelegationSetLimit
limit :: ReusableDelegationSetLimit,
    -- | The current number of hosted zones that you can associate with the
    -- specified reusable delegation set.
    GetReusableDelegationSetLimitResponse -> Natural
count :: Prelude.Natural
  }
  deriving (GetReusableDelegationSetLimitResponse
-> GetReusableDelegationSetLimitResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetReusableDelegationSetLimitResponse
-> GetReusableDelegationSetLimitResponse -> Bool
$c/= :: GetReusableDelegationSetLimitResponse
-> GetReusableDelegationSetLimitResponse -> Bool
== :: GetReusableDelegationSetLimitResponse
-> GetReusableDelegationSetLimitResponse -> Bool
$c== :: GetReusableDelegationSetLimitResponse
-> GetReusableDelegationSetLimitResponse -> Bool
Prelude.Eq, ReadPrec [GetReusableDelegationSetLimitResponse]
ReadPrec GetReusableDelegationSetLimitResponse
Int -> ReadS GetReusableDelegationSetLimitResponse
ReadS [GetReusableDelegationSetLimitResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetReusableDelegationSetLimitResponse]
$creadListPrec :: ReadPrec [GetReusableDelegationSetLimitResponse]
readPrec :: ReadPrec GetReusableDelegationSetLimitResponse
$creadPrec :: ReadPrec GetReusableDelegationSetLimitResponse
readList :: ReadS [GetReusableDelegationSetLimitResponse]
$creadList :: ReadS [GetReusableDelegationSetLimitResponse]
readsPrec :: Int -> ReadS GetReusableDelegationSetLimitResponse
$creadsPrec :: Int -> ReadS GetReusableDelegationSetLimitResponse
Prelude.Read, Int -> GetReusableDelegationSetLimitResponse -> ShowS
[GetReusableDelegationSetLimitResponse] -> ShowS
GetReusableDelegationSetLimitResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetReusableDelegationSetLimitResponse] -> ShowS
$cshowList :: [GetReusableDelegationSetLimitResponse] -> ShowS
show :: GetReusableDelegationSetLimitResponse -> String
$cshow :: GetReusableDelegationSetLimitResponse -> String
showsPrec :: Int -> GetReusableDelegationSetLimitResponse -> ShowS
$cshowsPrec :: Int -> GetReusableDelegationSetLimitResponse -> ShowS
Prelude.Show, forall x.
Rep GetReusableDelegationSetLimitResponse x
-> GetReusableDelegationSetLimitResponse
forall x.
GetReusableDelegationSetLimitResponse
-> Rep GetReusableDelegationSetLimitResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetReusableDelegationSetLimitResponse x
-> GetReusableDelegationSetLimitResponse
$cfrom :: forall x.
GetReusableDelegationSetLimitResponse
-> Rep GetReusableDelegationSetLimitResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetReusableDelegationSetLimitResponse' 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', 'getReusableDelegationSetLimitResponse_httpStatus' - The response's http status code.
--
-- 'limit', 'getReusableDelegationSetLimitResponse_limit' - The current setting for the limit on hosted zones that you can associate
-- with the specified reusable delegation set.
--
-- 'count', 'getReusableDelegationSetLimitResponse_count' - The current number of hosted zones that you can associate with the
-- specified reusable delegation set.
newGetReusableDelegationSetLimitResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'limit'
  ReusableDelegationSetLimit ->
  -- | 'count'
  Prelude.Natural ->
  GetReusableDelegationSetLimitResponse
newGetReusableDelegationSetLimitResponse :: Int
-> ReusableDelegationSetLimit
-> Natural
-> GetReusableDelegationSetLimitResponse
newGetReusableDelegationSetLimitResponse
  Int
pHttpStatus_
  ReusableDelegationSetLimit
pLimit_
  Natural
pCount_ =
    GetReusableDelegationSetLimitResponse'
      { $sel:httpStatus:GetReusableDelegationSetLimitResponse' :: Int
httpStatus =
          Int
pHttpStatus_,
        $sel:limit:GetReusableDelegationSetLimitResponse' :: ReusableDelegationSetLimit
limit = ReusableDelegationSetLimit
pLimit_,
        $sel:count:GetReusableDelegationSetLimitResponse' :: Natural
count = Natural
pCount_
      }

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

-- | The current setting for the limit on hosted zones that you can associate
-- with the specified reusable delegation set.
getReusableDelegationSetLimitResponse_limit :: Lens.Lens' GetReusableDelegationSetLimitResponse ReusableDelegationSetLimit
getReusableDelegationSetLimitResponse_limit :: Lens'
  GetReusableDelegationSetLimitResponse ReusableDelegationSetLimit
getReusableDelegationSetLimitResponse_limit = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetReusableDelegationSetLimitResponse' {ReusableDelegationSetLimit
limit :: ReusableDelegationSetLimit
$sel:limit:GetReusableDelegationSetLimitResponse' :: GetReusableDelegationSetLimitResponse -> ReusableDelegationSetLimit
limit} -> ReusableDelegationSetLimit
limit) (\s :: GetReusableDelegationSetLimitResponse
s@GetReusableDelegationSetLimitResponse' {} ReusableDelegationSetLimit
a -> GetReusableDelegationSetLimitResponse
s {$sel:limit:GetReusableDelegationSetLimitResponse' :: ReusableDelegationSetLimit
limit = ReusableDelegationSetLimit
a} :: GetReusableDelegationSetLimitResponse)

-- | The current number of hosted zones that you can associate with the
-- specified reusable delegation set.
getReusableDelegationSetLimitResponse_count :: Lens.Lens' GetReusableDelegationSetLimitResponse Prelude.Natural
getReusableDelegationSetLimitResponse_count :: Lens' GetReusableDelegationSetLimitResponse Natural
getReusableDelegationSetLimitResponse_count = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetReusableDelegationSetLimitResponse' {Natural
count :: Natural
$sel:count:GetReusableDelegationSetLimitResponse' :: GetReusableDelegationSetLimitResponse -> Natural
count} -> Natural
count) (\s :: GetReusableDelegationSetLimitResponse
s@GetReusableDelegationSetLimitResponse' {} Natural
a -> GetReusableDelegationSetLimitResponse
s {$sel:count:GetReusableDelegationSetLimitResponse' :: Natural
count = Natural
a} :: GetReusableDelegationSetLimitResponse)

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