{-# 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.Route53Domains.CheckDomainAvailability
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- This operation checks the availability of one domain name. Note that if
-- the availability status of a domain is pending, you must submit another
-- request to determine the availability of the domain name.
module Amazonka.Route53Domains.CheckDomainAvailability
  ( -- * Creating a Request
    CheckDomainAvailability (..),
    newCheckDomainAvailability,

    -- * Request Lenses
    checkDomainAvailability_idnLangCode,
    checkDomainAvailability_domainName,

    -- * Destructuring the Response
    CheckDomainAvailabilityResponse (..),
    newCheckDomainAvailabilityResponse,

    -- * Response Lenses
    checkDomainAvailabilityResponse_availability,
    checkDomainAvailabilityResponse_httpStatus,
  )
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.Route53Domains.Types

-- | The CheckDomainAvailability request contains the following elements.
--
-- /See:/ 'newCheckDomainAvailability' smart constructor.
data CheckDomainAvailability = CheckDomainAvailability'
  { -- | Reserved for future use.
    CheckDomainAvailability -> Maybe Text
idnLangCode :: Prelude.Maybe Prelude.Text,
    -- | The name of the domain that you want to get availability for. The
    -- top-level domain (TLD), such as .com, must be a TLD that Route 53
    -- supports. For a list of supported TLDs, see
    -- <https://docs.aws.amazon.com/Route53/latest/DeveloperGuide/registrar-tld-list.html Domains that You Can Register with Amazon Route 53>
    -- in the /Amazon Route 53 Developer Guide/.
    --
    -- The domain name can contain only the following characters:
    --
    -- -   Letters a through z. Domain names are not case sensitive.
    --
    -- -   Numbers 0 through 9.
    --
    -- -   Hyphen (-). You can\'t specify a hyphen at the beginning or end of a
    --     label.
    --
    -- -   Period (.) to separate the labels in the name, such as the @.@ in
    --     @example.com@.
    --
    -- Internationalized domain names are not supported for some top-level
    -- domains. To determine whether the TLD that you want to use supports
    -- internationalized domain names, see
    -- <https://docs.aws.amazon.com/Route53/latest/DeveloperGuide/registrar-tld-list.html Domains that You Can Register with Amazon Route 53>.
    -- For more information, see
    -- <https://docs.aws.amazon.com/Route53/latest/DeveloperGuide/DomainNameFormat.html#domain-name-format-idns Formatting Internationalized Domain Names>.
    CheckDomainAvailability -> Text
domainName :: Prelude.Text
  }
  deriving (CheckDomainAvailability -> CheckDomainAvailability -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CheckDomainAvailability -> CheckDomainAvailability -> Bool
$c/= :: CheckDomainAvailability -> CheckDomainAvailability -> Bool
== :: CheckDomainAvailability -> CheckDomainAvailability -> Bool
$c== :: CheckDomainAvailability -> CheckDomainAvailability -> Bool
Prelude.Eq, ReadPrec [CheckDomainAvailability]
ReadPrec CheckDomainAvailability
Int -> ReadS CheckDomainAvailability
ReadS [CheckDomainAvailability]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CheckDomainAvailability]
$creadListPrec :: ReadPrec [CheckDomainAvailability]
readPrec :: ReadPrec CheckDomainAvailability
$creadPrec :: ReadPrec CheckDomainAvailability
readList :: ReadS [CheckDomainAvailability]
$creadList :: ReadS [CheckDomainAvailability]
readsPrec :: Int -> ReadS CheckDomainAvailability
$creadsPrec :: Int -> ReadS CheckDomainAvailability
Prelude.Read, Int -> CheckDomainAvailability -> ShowS
[CheckDomainAvailability] -> ShowS
CheckDomainAvailability -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CheckDomainAvailability] -> ShowS
$cshowList :: [CheckDomainAvailability] -> ShowS
show :: CheckDomainAvailability -> String
$cshow :: CheckDomainAvailability -> String
showsPrec :: Int -> CheckDomainAvailability -> ShowS
$cshowsPrec :: Int -> CheckDomainAvailability -> ShowS
Prelude.Show, forall x. Rep CheckDomainAvailability x -> CheckDomainAvailability
forall x. CheckDomainAvailability -> Rep CheckDomainAvailability x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CheckDomainAvailability x -> CheckDomainAvailability
$cfrom :: forall x. CheckDomainAvailability -> Rep CheckDomainAvailability x
Prelude.Generic)

-- |
-- Create a value of 'CheckDomainAvailability' 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:
--
-- 'idnLangCode', 'checkDomainAvailability_idnLangCode' - Reserved for future use.
--
-- 'domainName', 'checkDomainAvailability_domainName' - The name of the domain that you want to get availability for. The
-- top-level domain (TLD), such as .com, must be a TLD that Route 53
-- supports. For a list of supported TLDs, see
-- <https://docs.aws.amazon.com/Route53/latest/DeveloperGuide/registrar-tld-list.html Domains that You Can Register with Amazon Route 53>
-- in the /Amazon Route 53 Developer Guide/.
--
-- The domain name can contain only the following characters:
--
-- -   Letters a through z. Domain names are not case sensitive.
--
-- -   Numbers 0 through 9.
--
-- -   Hyphen (-). You can\'t specify a hyphen at the beginning or end of a
--     label.
--
-- -   Period (.) to separate the labels in the name, such as the @.@ in
--     @example.com@.
--
-- Internationalized domain names are not supported for some top-level
-- domains. To determine whether the TLD that you want to use supports
-- internationalized domain names, see
-- <https://docs.aws.amazon.com/Route53/latest/DeveloperGuide/registrar-tld-list.html Domains that You Can Register with Amazon Route 53>.
-- For more information, see
-- <https://docs.aws.amazon.com/Route53/latest/DeveloperGuide/DomainNameFormat.html#domain-name-format-idns Formatting Internationalized Domain Names>.
newCheckDomainAvailability ::
  -- | 'domainName'
  Prelude.Text ->
  CheckDomainAvailability
newCheckDomainAvailability :: Text -> CheckDomainAvailability
newCheckDomainAvailability Text
pDomainName_ =
  CheckDomainAvailability'
    { $sel:idnLangCode:CheckDomainAvailability' :: Maybe Text
idnLangCode =
        forall a. Maybe a
Prelude.Nothing,
      $sel:domainName:CheckDomainAvailability' :: Text
domainName = Text
pDomainName_
    }

-- | Reserved for future use.
checkDomainAvailability_idnLangCode :: Lens.Lens' CheckDomainAvailability (Prelude.Maybe Prelude.Text)
checkDomainAvailability_idnLangCode :: Lens' CheckDomainAvailability (Maybe Text)
checkDomainAvailability_idnLangCode = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CheckDomainAvailability' {Maybe Text
idnLangCode :: Maybe Text
$sel:idnLangCode:CheckDomainAvailability' :: CheckDomainAvailability -> Maybe Text
idnLangCode} -> Maybe Text
idnLangCode) (\s :: CheckDomainAvailability
s@CheckDomainAvailability' {} Maybe Text
a -> CheckDomainAvailability
s {$sel:idnLangCode:CheckDomainAvailability' :: Maybe Text
idnLangCode = Maybe Text
a} :: CheckDomainAvailability)

-- | The name of the domain that you want to get availability for. The
-- top-level domain (TLD), such as .com, must be a TLD that Route 53
-- supports. For a list of supported TLDs, see
-- <https://docs.aws.amazon.com/Route53/latest/DeveloperGuide/registrar-tld-list.html Domains that You Can Register with Amazon Route 53>
-- in the /Amazon Route 53 Developer Guide/.
--
-- The domain name can contain only the following characters:
--
-- -   Letters a through z. Domain names are not case sensitive.
--
-- -   Numbers 0 through 9.
--
-- -   Hyphen (-). You can\'t specify a hyphen at the beginning or end of a
--     label.
--
-- -   Period (.) to separate the labels in the name, such as the @.@ in
--     @example.com@.
--
-- Internationalized domain names are not supported for some top-level
-- domains. To determine whether the TLD that you want to use supports
-- internationalized domain names, see
-- <https://docs.aws.amazon.com/Route53/latest/DeveloperGuide/registrar-tld-list.html Domains that You Can Register with Amazon Route 53>.
-- For more information, see
-- <https://docs.aws.amazon.com/Route53/latest/DeveloperGuide/DomainNameFormat.html#domain-name-format-idns Formatting Internationalized Domain Names>.
checkDomainAvailability_domainName :: Lens.Lens' CheckDomainAvailability Prelude.Text
checkDomainAvailability_domainName :: Lens' CheckDomainAvailability Text
checkDomainAvailability_domainName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CheckDomainAvailability' {Text
domainName :: Text
$sel:domainName:CheckDomainAvailability' :: CheckDomainAvailability -> Text
domainName} -> Text
domainName) (\s :: CheckDomainAvailability
s@CheckDomainAvailability' {} Text
a -> CheckDomainAvailability
s {$sel:domainName:CheckDomainAvailability' :: Text
domainName = Text
a} :: CheckDomainAvailability)

instance Core.AWSRequest CheckDomainAvailability where
  type
    AWSResponse CheckDomainAvailability =
      CheckDomainAvailabilityResponse
  request :: (Service -> Service)
-> CheckDomainAvailability -> Request CheckDomainAvailability
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.postJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy CheckDomainAvailability
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CheckDomainAvailability)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> Object -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveJSON
      ( \Int
s ResponseHeaders
h Object
x ->
          Maybe DomainAvailability -> Int -> CheckDomainAvailabilityResponse
CheckDomainAvailabilityResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"Availability")
            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))
      )

instance Prelude.Hashable CheckDomainAvailability where
  hashWithSalt :: Int -> CheckDomainAvailability -> Int
hashWithSalt Int
_salt CheckDomainAvailability' {Maybe Text
Text
domainName :: Text
idnLangCode :: Maybe Text
$sel:domainName:CheckDomainAvailability' :: CheckDomainAvailability -> Text
$sel:idnLangCode:CheckDomainAvailability' :: CheckDomainAvailability -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
idnLangCode
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
domainName

instance Prelude.NFData CheckDomainAvailability where
  rnf :: CheckDomainAvailability -> ()
rnf CheckDomainAvailability' {Maybe Text
Text
domainName :: Text
idnLangCode :: Maybe Text
$sel:domainName:CheckDomainAvailability' :: CheckDomainAvailability -> Text
$sel:idnLangCode:CheckDomainAvailability' :: CheckDomainAvailability -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
idnLangCode
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
domainName

instance Data.ToHeaders CheckDomainAvailability where
  toHeaders :: CheckDomainAvailability -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"X-Amz-Target"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"Route53Domains_v20140515.CheckDomainAvailability" ::
                          Prelude.ByteString
                      ),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON CheckDomainAvailability where
  toJSON :: CheckDomainAvailability -> Value
toJSON CheckDomainAvailability' {Maybe Text
Text
domainName :: Text
idnLangCode :: Maybe Text
$sel:domainName:CheckDomainAvailability' :: CheckDomainAvailability -> Text
$sel:idnLangCode:CheckDomainAvailability' :: CheckDomainAvailability -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"IdnLangCode" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
idnLangCode,
            forall a. a -> Maybe a
Prelude.Just (Key
"DomainName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
domainName)
          ]
      )

instance Data.ToPath CheckDomainAvailability where
  toPath :: CheckDomainAvailability -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

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

-- | The CheckDomainAvailability response includes the following elements.
--
-- /See:/ 'newCheckDomainAvailabilityResponse' smart constructor.
data CheckDomainAvailabilityResponse = CheckDomainAvailabilityResponse'
  { -- | Whether the domain name is available for registering.
    --
    -- You can register only domains designated as @AVAILABLE@.
    --
    -- Valid values:
    --
    -- [AVAILABLE]
    --     The domain name is available.
    --
    -- [AVAILABLE_RESERVED]
    --     The domain name is reserved under specific conditions.
    --
    -- [AVAILABLE_PREORDER]
    --     The domain name is available and can be preordered.
    --
    -- [DONT_KNOW]
    --     The TLD registry didn\'t reply with a definitive answer about
    --     whether the domain name is available. Route 53 can return this
    --     response for a variety of reasons, for example, the registry is
    --     performing maintenance. Try again later.
    --
    -- [PENDING]
    --     The TLD registry didn\'t return a response in the expected amount of
    --     time. When the response is delayed, it usually takes just a few
    --     extra seconds. You can resubmit the request immediately.
    --
    -- [RESERVED]
    --     The domain name has been reserved for another person or
    --     organization.
    --
    -- [UNAVAILABLE]
    --     The domain name is not available.
    --
    -- [UNAVAILABLE_PREMIUM]
    --     The domain name is not available.
    --
    -- [UNAVAILABLE_RESTRICTED]
    --     The domain name is forbidden.
    CheckDomainAvailabilityResponse -> Maybe DomainAvailability
availability :: Prelude.Maybe DomainAvailability,
    -- | The response's http status code.
    CheckDomainAvailabilityResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CheckDomainAvailabilityResponse
-> CheckDomainAvailabilityResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CheckDomainAvailabilityResponse
-> CheckDomainAvailabilityResponse -> Bool
$c/= :: CheckDomainAvailabilityResponse
-> CheckDomainAvailabilityResponse -> Bool
== :: CheckDomainAvailabilityResponse
-> CheckDomainAvailabilityResponse -> Bool
$c== :: CheckDomainAvailabilityResponse
-> CheckDomainAvailabilityResponse -> Bool
Prelude.Eq, ReadPrec [CheckDomainAvailabilityResponse]
ReadPrec CheckDomainAvailabilityResponse
Int -> ReadS CheckDomainAvailabilityResponse
ReadS [CheckDomainAvailabilityResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CheckDomainAvailabilityResponse]
$creadListPrec :: ReadPrec [CheckDomainAvailabilityResponse]
readPrec :: ReadPrec CheckDomainAvailabilityResponse
$creadPrec :: ReadPrec CheckDomainAvailabilityResponse
readList :: ReadS [CheckDomainAvailabilityResponse]
$creadList :: ReadS [CheckDomainAvailabilityResponse]
readsPrec :: Int -> ReadS CheckDomainAvailabilityResponse
$creadsPrec :: Int -> ReadS CheckDomainAvailabilityResponse
Prelude.Read, Int -> CheckDomainAvailabilityResponse -> ShowS
[CheckDomainAvailabilityResponse] -> ShowS
CheckDomainAvailabilityResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CheckDomainAvailabilityResponse] -> ShowS
$cshowList :: [CheckDomainAvailabilityResponse] -> ShowS
show :: CheckDomainAvailabilityResponse -> String
$cshow :: CheckDomainAvailabilityResponse -> String
showsPrec :: Int -> CheckDomainAvailabilityResponse -> ShowS
$cshowsPrec :: Int -> CheckDomainAvailabilityResponse -> ShowS
Prelude.Show, forall x.
Rep CheckDomainAvailabilityResponse x
-> CheckDomainAvailabilityResponse
forall x.
CheckDomainAvailabilityResponse
-> Rep CheckDomainAvailabilityResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CheckDomainAvailabilityResponse x
-> CheckDomainAvailabilityResponse
$cfrom :: forall x.
CheckDomainAvailabilityResponse
-> Rep CheckDomainAvailabilityResponse x
Prelude.Generic)

-- |
-- Create a value of 'CheckDomainAvailabilityResponse' 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:
--
-- 'availability', 'checkDomainAvailabilityResponse_availability' - Whether the domain name is available for registering.
--
-- You can register only domains designated as @AVAILABLE@.
--
-- Valid values:
--
-- [AVAILABLE]
--     The domain name is available.
--
-- [AVAILABLE_RESERVED]
--     The domain name is reserved under specific conditions.
--
-- [AVAILABLE_PREORDER]
--     The domain name is available and can be preordered.
--
-- [DONT_KNOW]
--     The TLD registry didn\'t reply with a definitive answer about
--     whether the domain name is available. Route 53 can return this
--     response for a variety of reasons, for example, the registry is
--     performing maintenance. Try again later.
--
-- [PENDING]
--     The TLD registry didn\'t return a response in the expected amount of
--     time. When the response is delayed, it usually takes just a few
--     extra seconds. You can resubmit the request immediately.
--
-- [RESERVED]
--     The domain name has been reserved for another person or
--     organization.
--
-- [UNAVAILABLE]
--     The domain name is not available.
--
-- [UNAVAILABLE_PREMIUM]
--     The domain name is not available.
--
-- [UNAVAILABLE_RESTRICTED]
--     The domain name is forbidden.
--
-- 'httpStatus', 'checkDomainAvailabilityResponse_httpStatus' - The response's http status code.
newCheckDomainAvailabilityResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CheckDomainAvailabilityResponse
newCheckDomainAvailabilityResponse :: Int -> CheckDomainAvailabilityResponse
newCheckDomainAvailabilityResponse Int
pHttpStatus_ =
  CheckDomainAvailabilityResponse'
    { $sel:availability:CheckDomainAvailabilityResponse' :: Maybe DomainAvailability
availability =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CheckDomainAvailabilityResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Whether the domain name is available for registering.
--
-- You can register only domains designated as @AVAILABLE@.
--
-- Valid values:
--
-- [AVAILABLE]
--     The domain name is available.
--
-- [AVAILABLE_RESERVED]
--     The domain name is reserved under specific conditions.
--
-- [AVAILABLE_PREORDER]
--     The domain name is available and can be preordered.
--
-- [DONT_KNOW]
--     The TLD registry didn\'t reply with a definitive answer about
--     whether the domain name is available. Route 53 can return this
--     response for a variety of reasons, for example, the registry is
--     performing maintenance. Try again later.
--
-- [PENDING]
--     The TLD registry didn\'t return a response in the expected amount of
--     time. When the response is delayed, it usually takes just a few
--     extra seconds. You can resubmit the request immediately.
--
-- [RESERVED]
--     The domain name has been reserved for another person or
--     organization.
--
-- [UNAVAILABLE]
--     The domain name is not available.
--
-- [UNAVAILABLE_PREMIUM]
--     The domain name is not available.
--
-- [UNAVAILABLE_RESTRICTED]
--     The domain name is forbidden.
checkDomainAvailabilityResponse_availability :: Lens.Lens' CheckDomainAvailabilityResponse (Prelude.Maybe DomainAvailability)
checkDomainAvailabilityResponse_availability :: Lens' CheckDomainAvailabilityResponse (Maybe DomainAvailability)
checkDomainAvailabilityResponse_availability = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CheckDomainAvailabilityResponse' {Maybe DomainAvailability
availability :: Maybe DomainAvailability
$sel:availability:CheckDomainAvailabilityResponse' :: CheckDomainAvailabilityResponse -> Maybe DomainAvailability
availability} -> Maybe DomainAvailability
availability) (\s :: CheckDomainAvailabilityResponse
s@CheckDomainAvailabilityResponse' {} Maybe DomainAvailability
a -> CheckDomainAvailabilityResponse
s {$sel:availability:CheckDomainAvailabilityResponse' :: Maybe DomainAvailability
availability = Maybe DomainAvailability
a} :: CheckDomainAvailabilityResponse)

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

instance
  Prelude.NFData
    CheckDomainAvailabilityResponse
  where
  rnf :: CheckDomainAvailabilityResponse -> ()
rnf CheckDomainAvailabilityResponse' {Int
Maybe DomainAvailability
httpStatus :: Int
availability :: Maybe DomainAvailability
$sel:httpStatus:CheckDomainAvailabilityResponse' :: CheckDomainAvailabilityResponse -> Int
$sel:availability:CheckDomainAvailabilityResponse' :: CheckDomainAvailabilityResponse -> Maybe DomainAvailability
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe DomainAvailability
availability
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus