{-# 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.RegisterDomain
-- 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 registers a domain. Domains are registered either by
-- Amazon Registrar (for .com, .net, and .org domains) or by our registrar
-- associate, Gandi (for all other domains). For some top-level domains
-- (TLDs), this operation requires extra parameters.
--
-- When you register a domain, Amazon Route 53 does the following:
--
-- -   Creates a Route 53 hosted zone that has the same name as the domain.
--     Route 53 assigns four name servers to your hosted zone and
--     automatically updates your domain registration with the names of
--     these name servers.
--
-- -   Enables auto renew, so your domain registration will renew
--     automatically each year. We\'ll notify you in advance of the renewal
--     date so you can choose whether to renew the registration.
--
-- -   Optionally enables privacy protection, so WHOIS queries return
--     contact information either for Amazon Registrar (for .com, .net, and
--     .org domains) or for our registrar associate, Gandi (for all other
--     TLDs). If you don\'t enable privacy protection, WHOIS queries return
--     the information that you entered for the administrative, registrant,
--     and technical contacts.
--
--     You must specify the same privacy setting for the administrative,
--     registrant, and technical contacts.
--
-- -   If registration is successful, returns an operation ID that you can
--     use to track the progress and completion of the action. If the
--     request is not completed successfully, the domain registrant is
--     notified by email.
--
-- -   Charges your Amazon Web Services account an amount based on the
--     top-level domain. For more information, see
--     <http://aws.amazon.com/route53/pricing/ Amazon Route 53 Pricing>.
module Amazonka.Route53Domains.RegisterDomain
  ( -- * Creating a Request
    RegisterDomain (..),
    newRegisterDomain,

    -- * Request Lenses
    registerDomain_autoRenew,
    registerDomain_idnLangCode,
    registerDomain_privacyProtectAdminContact,
    registerDomain_privacyProtectRegistrantContact,
    registerDomain_privacyProtectTechContact,
    registerDomain_domainName,
    registerDomain_durationInYears,
    registerDomain_adminContact,
    registerDomain_registrantContact,
    registerDomain_techContact,

    -- * Destructuring the Response
    RegisterDomainResponse (..),
    newRegisterDomainResponse,

    -- * Response Lenses
    registerDomainResponse_operationId,
    registerDomainResponse_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 RegisterDomain request includes the following elements.
--
-- /See:/ 'newRegisterDomain' smart constructor.
data RegisterDomain = RegisterDomain'
  { -- | Indicates whether the domain will be automatically renewed (@true@) or
    -- not (@false@). Auto renewal only takes effect after the account is
    -- charged.
    --
    -- Default: @true@
    RegisterDomain -> Maybe Bool
autoRenew :: Prelude.Maybe Prelude.Bool,
    -- | Reserved for future use.
    RegisterDomain -> Maybe Text
idnLangCode :: Prelude.Maybe Prelude.Text,
    -- | Whether you want to conceal contact information from WHOIS queries. If
    -- you specify @true@, WHOIS (\"who is\") queries return contact
    -- information either for Amazon Registrar (for .com, .net, and .org
    -- domains) or for our registrar associate, Gandi (for all other TLDs). If
    -- you specify @false@, WHOIS queries return the information that you
    -- entered for the admin contact.
    --
    -- You must specify the same privacy setting for the administrative,
    -- registrant, and technical contacts.
    --
    -- Default: @true@
    RegisterDomain -> Maybe Bool
privacyProtectAdminContact :: Prelude.Maybe Prelude.Bool,
    -- | Whether you want to conceal contact information from WHOIS queries. If
    -- you specify @true@, WHOIS (\"who is\") queries return contact
    -- information either for Amazon Registrar (for .com, .net, and .org
    -- domains) or for our registrar associate, Gandi (for all other TLDs). If
    -- you specify @false@, WHOIS queries return the information that you
    -- entered for the registrant contact (the domain owner).
    --
    -- You must specify the same privacy setting for the administrative,
    -- registrant, and technical contacts.
    --
    -- Default: @true@
    RegisterDomain -> Maybe Bool
privacyProtectRegistrantContact :: Prelude.Maybe Prelude.Bool,
    -- | Whether you want to conceal contact information from WHOIS queries. If
    -- you specify @true@, WHOIS (\"who is\") queries return contact
    -- information either for Amazon Registrar (for .com, .net, and .org
    -- domains) or for our registrar associate, Gandi (for all other TLDs). If
    -- you specify @false@, WHOIS queries return the information that you
    -- entered for the technical contact.
    --
    -- You must specify the same privacy setting for the administrative,
    -- registrant, and technical contacts.
    --
    -- Default: @true@
    RegisterDomain -> Maybe Bool
privacyProtectTechContact :: Prelude.Maybe Prelude.Bool,
    -- | The domain name that you want to register. 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>.
    RegisterDomain -> Text
domainName :: Prelude.Text,
    -- | The number of years that you want to register the domain for. Domains
    -- are registered for a minimum of one year. The maximum period depends on
    -- the top-level domain. For the range of valid values for your domain, 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/.
    --
    -- Default: 1
    RegisterDomain -> Natural
durationInYears :: Prelude.Natural,
    -- | Provides detailed contact information. For information about the values
    -- that you specify for each element, see
    -- <https://docs.aws.amazon.com/Route53/latest/APIReference/API_domains_ContactDetail.html ContactDetail>.
    RegisterDomain -> Sensitive ContactDetail
adminContact :: Data.Sensitive ContactDetail,
    -- | Provides detailed contact information. For information about the values
    -- that you specify for each element, see
    -- <https://docs.aws.amazon.com/Route53/latest/APIReference/API_domains_ContactDetail.html ContactDetail>.
    RegisterDomain -> Sensitive ContactDetail
registrantContact :: Data.Sensitive ContactDetail,
    -- | Provides detailed contact information. For information about the values
    -- that you specify for each element, see
    -- <https://docs.aws.amazon.com/Route53/latest/APIReference/API_domains_ContactDetail.html ContactDetail>.
    RegisterDomain -> Sensitive ContactDetail
techContact :: Data.Sensitive ContactDetail
  }
  deriving (RegisterDomain -> RegisterDomain -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RegisterDomain -> RegisterDomain -> Bool
$c/= :: RegisterDomain -> RegisterDomain -> Bool
== :: RegisterDomain -> RegisterDomain -> Bool
$c== :: RegisterDomain -> RegisterDomain -> Bool
Prelude.Eq, Int -> RegisterDomain -> ShowS
[RegisterDomain] -> ShowS
RegisterDomain -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RegisterDomain] -> ShowS
$cshowList :: [RegisterDomain] -> ShowS
show :: RegisterDomain -> String
$cshow :: RegisterDomain -> String
showsPrec :: Int -> RegisterDomain -> ShowS
$cshowsPrec :: Int -> RegisterDomain -> ShowS
Prelude.Show, forall x. Rep RegisterDomain x -> RegisterDomain
forall x. RegisterDomain -> Rep RegisterDomain x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RegisterDomain x -> RegisterDomain
$cfrom :: forall x. RegisterDomain -> Rep RegisterDomain x
Prelude.Generic)

-- |
-- Create a value of 'RegisterDomain' 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:
--
-- 'autoRenew', 'registerDomain_autoRenew' - Indicates whether the domain will be automatically renewed (@true@) or
-- not (@false@). Auto renewal only takes effect after the account is
-- charged.
--
-- Default: @true@
--
-- 'idnLangCode', 'registerDomain_idnLangCode' - Reserved for future use.
--
-- 'privacyProtectAdminContact', 'registerDomain_privacyProtectAdminContact' - Whether you want to conceal contact information from WHOIS queries. If
-- you specify @true@, WHOIS (\"who is\") queries return contact
-- information either for Amazon Registrar (for .com, .net, and .org
-- domains) or for our registrar associate, Gandi (for all other TLDs). If
-- you specify @false@, WHOIS queries return the information that you
-- entered for the admin contact.
--
-- You must specify the same privacy setting for the administrative,
-- registrant, and technical contacts.
--
-- Default: @true@
--
-- 'privacyProtectRegistrantContact', 'registerDomain_privacyProtectRegistrantContact' - Whether you want to conceal contact information from WHOIS queries. If
-- you specify @true@, WHOIS (\"who is\") queries return contact
-- information either for Amazon Registrar (for .com, .net, and .org
-- domains) or for our registrar associate, Gandi (for all other TLDs). If
-- you specify @false@, WHOIS queries return the information that you
-- entered for the registrant contact (the domain owner).
--
-- You must specify the same privacy setting for the administrative,
-- registrant, and technical contacts.
--
-- Default: @true@
--
-- 'privacyProtectTechContact', 'registerDomain_privacyProtectTechContact' - Whether you want to conceal contact information from WHOIS queries. If
-- you specify @true@, WHOIS (\"who is\") queries return contact
-- information either for Amazon Registrar (for .com, .net, and .org
-- domains) or for our registrar associate, Gandi (for all other TLDs). If
-- you specify @false@, WHOIS queries return the information that you
-- entered for the technical contact.
--
-- You must specify the same privacy setting for the administrative,
-- registrant, and technical contacts.
--
-- Default: @true@
--
-- 'domainName', 'registerDomain_domainName' - The domain name that you want to register. 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>.
--
-- 'durationInYears', 'registerDomain_durationInYears' - The number of years that you want to register the domain for. Domains
-- are registered for a minimum of one year. The maximum period depends on
-- the top-level domain. For the range of valid values for your domain, 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/.
--
-- Default: 1
--
-- 'adminContact', 'registerDomain_adminContact' - Provides detailed contact information. For information about the values
-- that you specify for each element, see
-- <https://docs.aws.amazon.com/Route53/latest/APIReference/API_domains_ContactDetail.html ContactDetail>.
--
-- 'registrantContact', 'registerDomain_registrantContact' - Provides detailed contact information. For information about the values
-- that you specify for each element, see
-- <https://docs.aws.amazon.com/Route53/latest/APIReference/API_domains_ContactDetail.html ContactDetail>.
--
-- 'techContact', 'registerDomain_techContact' - Provides detailed contact information. For information about the values
-- that you specify for each element, see
-- <https://docs.aws.amazon.com/Route53/latest/APIReference/API_domains_ContactDetail.html ContactDetail>.
newRegisterDomain ::
  -- | 'domainName'
  Prelude.Text ->
  -- | 'durationInYears'
  Prelude.Natural ->
  -- | 'adminContact'
  ContactDetail ->
  -- | 'registrantContact'
  ContactDetail ->
  -- | 'techContact'
  ContactDetail ->
  RegisterDomain
newRegisterDomain :: Text
-> Natural
-> ContactDetail
-> ContactDetail
-> ContactDetail
-> RegisterDomain
newRegisterDomain
  Text
pDomainName_
  Natural
pDurationInYears_
  ContactDetail
pAdminContact_
  ContactDetail
pRegistrantContact_
  ContactDetail
pTechContact_ =
    RegisterDomain'
      { $sel:autoRenew:RegisterDomain' :: Maybe Bool
autoRenew = forall a. Maybe a
Prelude.Nothing,
        $sel:idnLangCode:RegisterDomain' :: Maybe Text
idnLangCode = forall a. Maybe a
Prelude.Nothing,
        $sel:privacyProtectAdminContact:RegisterDomain' :: Maybe Bool
privacyProtectAdminContact = forall a. Maybe a
Prelude.Nothing,
        $sel:privacyProtectRegistrantContact:RegisterDomain' :: Maybe Bool
privacyProtectRegistrantContact = forall a. Maybe a
Prelude.Nothing,
        $sel:privacyProtectTechContact:RegisterDomain' :: Maybe Bool
privacyProtectTechContact = forall a. Maybe a
Prelude.Nothing,
        $sel:domainName:RegisterDomain' :: Text
domainName = Text
pDomainName_,
        $sel:durationInYears:RegisterDomain' :: Natural
durationInYears = Natural
pDurationInYears_,
        $sel:adminContact:RegisterDomain' :: Sensitive ContactDetail
adminContact = forall a. Iso' (Sensitive a) a
Data._Sensitive forall t b. AReview t b -> b -> t
Lens.# ContactDetail
pAdminContact_,
        $sel:registrantContact:RegisterDomain' :: Sensitive ContactDetail
registrantContact =
          forall a. Iso' (Sensitive a) a
Data._Sensitive forall t b. AReview t b -> b -> t
Lens.# ContactDetail
pRegistrantContact_,
        $sel:techContact:RegisterDomain' :: Sensitive ContactDetail
techContact = forall a. Iso' (Sensitive a) a
Data._Sensitive forall t b. AReview t b -> b -> t
Lens.# ContactDetail
pTechContact_
      }

-- | Indicates whether the domain will be automatically renewed (@true@) or
-- not (@false@). Auto renewal only takes effect after the account is
-- charged.
--
-- Default: @true@
registerDomain_autoRenew :: Lens.Lens' RegisterDomain (Prelude.Maybe Prelude.Bool)
registerDomain_autoRenew :: Lens' RegisterDomain (Maybe Bool)
registerDomain_autoRenew = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RegisterDomain' {Maybe Bool
autoRenew :: Maybe Bool
$sel:autoRenew:RegisterDomain' :: RegisterDomain -> Maybe Bool
autoRenew} -> Maybe Bool
autoRenew) (\s :: RegisterDomain
s@RegisterDomain' {} Maybe Bool
a -> RegisterDomain
s {$sel:autoRenew:RegisterDomain' :: Maybe Bool
autoRenew = Maybe Bool
a} :: RegisterDomain)

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

-- | Whether you want to conceal contact information from WHOIS queries. If
-- you specify @true@, WHOIS (\"who is\") queries return contact
-- information either for Amazon Registrar (for .com, .net, and .org
-- domains) or for our registrar associate, Gandi (for all other TLDs). If
-- you specify @false@, WHOIS queries return the information that you
-- entered for the admin contact.
--
-- You must specify the same privacy setting for the administrative,
-- registrant, and technical contacts.
--
-- Default: @true@
registerDomain_privacyProtectAdminContact :: Lens.Lens' RegisterDomain (Prelude.Maybe Prelude.Bool)
registerDomain_privacyProtectAdminContact :: Lens' RegisterDomain (Maybe Bool)
registerDomain_privacyProtectAdminContact = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RegisterDomain' {Maybe Bool
privacyProtectAdminContact :: Maybe Bool
$sel:privacyProtectAdminContact:RegisterDomain' :: RegisterDomain -> Maybe Bool
privacyProtectAdminContact} -> Maybe Bool
privacyProtectAdminContact) (\s :: RegisterDomain
s@RegisterDomain' {} Maybe Bool
a -> RegisterDomain
s {$sel:privacyProtectAdminContact:RegisterDomain' :: Maybe Bool
privacyProtectAdminContact = Maybe Bool
a} :: RegisterDomain)

-- | Whether you want to conceal contact information from WHOIS queries. If
-- you specify @true@, WHOIS (\"who is\") queries return contact
-- information either for Amazon Registrar (for .com, .net, and .org
-- domains) or for our registrar associate, Gandi (for all other TLDs). If
-- you specify @false@, WHOIS queries return the information that you
-- entered for the registrant contact (the domain owner).
--
-- You must specify the same privacy setting for the administrative,
-- registrant, and technical contacts.
--
-- Default: @true@
registerDomain_privacyProtectRegistrantContact :: Lens.Lens' RegisterDomain (Prelude.Maybe Prelude.Bool)
registerDomain_privacyProtectRegistrantContact :: Lens' RegisterDomain (Maybe Bool)
registerDomain_privacyProtectRegistrantContact = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RegisterDomain' {Maybe Bool
privacyProtectRegistrantContact :: Maybe Bool
$sel:privacyProtectRegistrantContact:RegisterDomain' :: RegisterDomain -> Maybe Bool
privacyProtectRegistrantContact} -> Maybe Bool
privacyProtectRegistrantContact) (\s :: RegisterDomain
s@RegisterDomain' {} Maybe Bool
a -> RegisterDomain
s {$sel:privacyProtectRegistrantContact:RegisterDomain' :: Maybe Bool
privacyProtectRegistrantContact = Maybe Bool
a} :: RegisterDomain)

-- | Whether you want to conceal contact information from WHOIS queries. If
-- you specify @true@, WHOIS (\"who is\") queries return contact
-- information either for Amazon Registrar (for .com, .net, and .org
-- domains) or for our registrar associate, Gandi (for all other TLDs). If
-- you specify @false@, WHOIS queries return the information that you
-- entered for the technical contact.
--
-- You must specify the same privacy setting for the administrative,
-- registrant, and technical contacts.
--
-- Default: @true@
registerDomain_privacyProtectTechContact :: Lens.Lens' RegisterDomain (Prelude.Maybe Prelude.Bool)
registerDomain_privacyProtectTechContact :: Lens' RegisterDomain (Maybe Bool)
registerDomain_privacyProtectTechContact = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RegisterDomain' {Maybe Bool
privacyProtectTechContact :: Maybe Bool
$sel:privacyProtectTechContact:RegisterDomain' :: RegisterDomain -> Maybe Bool
privacyProtectTechContact} -> Maybe Bool
privacyProtectTechContact) (\s :: RegisterDomain
s@RegisterDomain' {} Maybe Bool
a -> RegisterDomain
s {$sel:privacyProtectTechContact:RegisterDomain' :: Maybe Bool
privacyProtectTechContact = Maybe Bool
a} :: RegisterDomain)

-- | The domain name that you want to register. 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>.
registerDomain_domainName :: Lens.Lens' RegisterDomain Prelude.Text
registerDomain_domainName :: Lens' RegisterDomain Text
registerDomain_domainName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RegisterDomain' {Text
domainName :: Text
$sel:domainName:RegisterDomain' :: RegisterDomain -> Text
domainName} -> Text
domainName) (\s :: RegisterDomain
s@RegisterDomain' {} Text
a -> RegisterDomain
s {$sel:domainName:RegisterDomain' :: Text
domainName = Text
a} :: RegisterDomain)

-- | The number of years that you want to register the domain for. Domains
-- are registered for a minimum of one year. The maximum period depends on
-- the top-level domain. For the range of valid values for your domain, 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/.
--
-- Default: 1
registerDomain_durationInYears :: Lens.Lens' RegisterDomain Prelude.Natural
registerDomain_durationInYears :: Lens' RegisterDomain Natural
registerDomain_durationInYears = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RegisterDomain' {Natural
durationInYears :: Natural
$sel:durationInYears:RegisterDomain' :: RegisterDomain -> Natural
durationInYears} -> Natural
durationInYears) (\s :: RegisterDomain
s@RegisterDomain' {} Natural
a -> RegisterDomain
s {$sel:durationInYears:RegisterDomain' :: Natural
durationInYears = Natural
a} :: RegisterDomain)

-- | Provides detailed contact information. For information about the values
-- that you specify for each element, see
-- <https://docs.aws.amazon.com/Route53/latest/APIReference/API_domains_ContactDetail.html ContactDetail>.
registerDomain_adminContact :: Lens.Lens' RegisterDomain ContactDetail
registerDomain_adminContact :: Lens' RegisterDomain ContactDetail
registerDomain_adminContact = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RegisterDomain' {Sensitive ContactDetail
adminContact :: Sensitive ContactDetail
$sel:adminContact:RegisterDomain' :: RegisterDomain -> Sensitive ContactDetail
adminContact} -> Sensitive ContactDetail
adminContact) (\s :: RegisterDomain
s@RegisterDomain' {} Sensitive ContactDetail
a -> RegisterDomain
s {$sel:adminContact:RegisterDomain' :: Sensitive ContactDetail
adminContact = Sensitive ContactDetail
a} :: RegisterDomain) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a. Iso' (Sensitive a) a
Data._Sensitive

-- | Provides detailed contact information. For information about the values
-- that you specify for each element, see
-- <https://docs.aws.amazon.com/Route53/latest/APIReference/API_domains_ContactDetail.html ContactDetail>.
registerDomain_registrantContact :: Lens.Lens' RegisterDomain ContactDetail
registerDomain_registrantContact :: Lens' RegisterDomain ContactDetail
registerDomain_registrantContact = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RegisterDomain' {Sensitive ContactDetail
registrantContact :: Sensitive ContactDetail
$sel:registrantContact:RegisterDomain' :: RegisterDomain -> Sensitive ContactDetail
registrantContact} -> Sensitive ContactDetail
registrantContact) (\s :: RegisterDomain
s@RegisterDomain' {} Sensitive ContactDetail
a -> RegisterDomain
s {$sel:registrantContact:RegisterDomain' :: Sensitive ContactDetail
registrantContact = Sensitive ContactDetail
a} :: RegisterDomain) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a. Iso' (Sensitive a) a
Data._Sensitive

-- | Provides detailed contact information. For information about the values
-- that you specify for each element, see
-- <https://docs.aws.amazon.com/Route53/latest/APIReference/API_domains_ContactDetail.html ContactDetail>.
registerDomain_techContact :: Lens.Lens' RegisterDomain ContactDetail
registerDomain_techContact :: Lens' RegisterDomain ContactDetail
registerDomain_techContact = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RegisterDomain' {Sensitive ContactDetail
techContact :: Sensitive ContactDetail
$sel:techContact:RegisterDomain' :: RegisterDomain -> Sensitive ContactDetail
techContact} -> Sensitive ContactDetail
techContact) (\s :: RegisterDomain
s@RegisterDomain' {} Sensitive ContactDetail
a -> RegisterDomain
s {$sel:techContact:RegisterDomain' :: Sensitive ContactDetail
techContact = Sensitive ContactDetail
a} :: RegisterDomain) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a. Iso' (Sensitive a) a
Data._Sensitive

instance Core.AWSRequest RegisterDomain where
  type
    AWSResponse RegisterDomain =
      RegisterDomainResponse
  request :: (Service -> Service) -> RegisterDomain -> Request RegisterDomain
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 RegisterDomain
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse RegisterDomain)))
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 Text -> Int -> RegisterDomainResponse
RegisterDomainResponse'
            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
"OperationId")
            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 RegisterDomain where
  hashWithSalt :: Int -> RegisterDomain -> Int
hashWithSalt Int
_salt RegisterDomain' {Natural
Maybe Bool
Maybe Text
Text
Sensitive ContactDetail
techContact :: Sensitive ContactDetail
registrantContact :: Sensitive ContactDetail
adminContact :: Sensitive ContactDetail
durationInYears :: Natural
domainName :: Text
privacyProtectTechContact :: Maybe Bool
privacyProtectRegistrantContact :: Maybe Bool
privacyProtectAdminContact :: Maybe Bool
idnLangCode :: Maybe Text
autoRenew :: Maybe Bool
$sel:techContact:RegisterDomain' :: RegisterDomain -> Sensitive ContactDetail
$sel:registrantContact:RegisterDomain' :: RegisterDomain -> Sensitive ContactDetail
$sel:adminContact:RegisterDomain' :: RegisterDomain -> Sensitive ContactDetail
$sel:durationInYears:RegisterDomain' :: RegisterDomain -> Natural
$sel:domainName:RegisterDomain' :: RegisterDomain -> Text
$sel:privacyProtectTechContact:RegisterDomain' :: RegisterDomain -> Maybe Bool
$sel:privacyProtectRegistrantContact:RegisterDomain' :: RegisterDomain -> Maybe Bool
$sel:privacyProtectAdminContact:RegisterDomain' :: RegisterDomain -> Maybe Bool
$sel:idnLangCode:RegisterDomain' :: RegisterDomain -> Maybe Text
$sel:autoRenew:RegisterDomain' :: RegisterDomain -> Maybe Bool
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
autoRenew
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
idnLangCode
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
privacyProtectAdminContact
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
privacyProtectRegistrantContact
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
privacyProtectTechContact
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
domainName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Natural
durationInYears
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Sensitive ContactDetail
adminContact
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Sensitive ContactDetail
registrantContact
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Sensitive ContactDetail
techContact

instance Prelude.NFData RegisterDomain where
  rnf :: RegisterDomain -> ()
rnf RegisterDomain' {Natural
Maybe Bool
Maybe Text
Text
Sensitive ContactDetail
techContact :: Sensitive ContactDetail
registrantContact :: Sensitive ContactDetail
adminContact :: Sensitive ContactDetail
durationInYears :: Natural
domainName :: Text
privacyProtectTechContact :: Maybe Bool
privacyProtectRegistrantContact :: Maybe Bool
privacyProtectAdminContact :: Maybe Bool
idnLangCode :: Maybe Text
autoRenew :: Maybe Bool
$sel:techContact:RegisterDomain' :: RegisterDomain -> Sensitive ContactDetail
$sel:registrantContact:RegisterDomain' :: RegisterDomain -> Sensitive ContactDetail
$sel:adminContact:RegisterDomain' :: RegisterDomain -> Sensitive ContactDetail
$sel:durationInYears:RegisterDomain' :: RegisterDomain -> Natural
$sel:domainName:RegisterDomain' :: RegisterDomain -> Text
$sel:privacyProtectTechContact:RegisterDomain' :: RegisterDomain -> Maybe Bool
$sel:privacyProtectRegistrantContact:RegisterDomain' :: RegisterDomain -> Maybe Bool
$sel:privacyProtectAdminContact:RegisterDomain' :: RegisterDomain -> Maybe Bool
$sel:idnLangCode:RegisterDomain' :: RegisterDomain -> Maybe Text
$sel:autoRenew:RegisterDomain' :: RegisterDomain -> Maybe Bool
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
autoRenew
      seq :: forall a b. a -> b -> b
`Prelude.seq` 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 Maybe Bool
privacyProtectAdminContact
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
privacyProtectRegistrantContact
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
privacyProtectTechContact
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
domainName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Natural
durationInYears
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Sensitive ContactDetail
adminContact
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Sensitive ContactDetail
registrantContact
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Sensitive ContactDetail
techContact

instance Data.ToHeaders RegisterDomain where
  toHeaders :: RegisterDomain -> 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.RegisterDomain" ::
                          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 RegisterDomain where
  toJSON :: RegisterDomain -> Value
toJSON RegisterDomain' {Natural
Maybe Bool
Maybe Text
Text
Sensitive ContactDetail
techContact :: Sensitive ContactDetail
registrantContact :: Sensitive ContactDetail
adminContact :: Sensitive ContactDetail
durationInYears :: Natural
domainName :: Text
privacyProtectTechContact :: Maybe Bool
privacyProtectRegistrantContact :: Maybe Bool
privacyProtectAdminContact :: Maybe Bool
idnLangCode :: Maybe Text
autoRenew :: Maybe Bool
$sel:techContact:RegisterDomain' :: RegisterDomain -> Sensitive ContactDetail
$sel:registrantContact:RegisterDomain' :: RegisterDomain -> Sensitive ContactDetail
$sel:adminContact:RegisterDomain' :: RegisterDomain -> Sensitive ContactDetail
$sel:durationInYears:RegisterDomain' :: RegisterDomain -> Natural
$sel:domainName:RegisterDomain' :: RegisterDomain -> Text
$sel:privacyProtectTechContact:RegisterDomain' :: RegisterDomain -> Maybe Bool
$sel:privacyProtectRegistrantContact:RegisterDomain' :: RegisterDomain -> Maybe Bool
$sel:privacyProtectAdminContact:RegisterDomain' :: RegisterDomain -> Maybe Bool
$sel:idnLangCode:RegisterDomain' :: RegisterDomain -> Maybe Text
$sel:autoRenew:RegisterDomain' :: RegisterDomain -> Maybe Bool
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"AutoRenew" 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 Bool
autoRenew,
            (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,
            (Key
"PrivacyProtectAdminContact" 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 Bool
privacyProtectAdminContact,
            (Key
"PrivacyProtectRegistrantContact" 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 Bool
privacyProtectRegistrantContact,
            (Key
"PrivacyProtectTechContact" 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 Bool
privacyProtectTechContact,
            forall a. a -> Maybe a
Prelude.Just (Key
"DomainName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
domainName),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"DurationInYears" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Natural
durationInYears),
            forall a. a -> Maybe a
Prelude.Just (Key
"AdminContact" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Sensitive ContactDetail
adminContact),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"RegistrantContact" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Sensitive ContactDetail
registrantContact),
            forall a. a -> Maybe a
Prelude.Just (Key
"TechContact" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Sensitive ContactDetail
techContact)
          ]
      )

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

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

-- | The RegisterDomain response includes the following element.
--
-- /See:/ 'newRegisterDomainResponse' smart constructor.
data RegisterDomainResponse = RegisterDomainResponse'
  { -- | Identifier for tracking the progress of the request. To query the
    -- operation status, use
    -- <https://docs.aws.amazon.com/Route53/latest/APIReference/API_domains_GetOperationDetail.html GetOperationDetail>.
    RegisterDomainResponse -> Maybe Text
operationId :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    RegisterDomainResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (RegisterDomainResponse -> RegisterDomainResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RegisterDomainResponse -> RegisterDomainResponse -> Bool
$c/= :: RegisterDomainResponse -> RegisterDomainResponse -> Bool
== :: RegisterDomainResponse -> RegisterDomainResponse -> Bool
$c== :: RegisterDomainResponse -> RegisterDomainResponse -> Bool
Prelude.Eq, ReadPrec [RegisterDomainResponse]
ReadPrec RegisterDomainResponse
Int -> ReadS RegisterDomainResponse
ReadS [RegisterDomainResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RegisterDomainResponse]
$creadListPrec :: ReadPrec [RegisterDomainResponse]
readPrec :: ReadPrec RegisterDomainResponse
$creadPrec :: ReadPrec RegisterDomainResponse
readList :: ReadS [RegisterDomainResponse]
$creadList :: ReadS [RegisterDomainResponse]
readsPrec :: Int -> ReadS RegisterDomainResponse
$creadsPrec :: Int -> ReadS RegisterDomainResponse
Prelude.Read, Int -> RegisterDomainResponse -> ShowS
[RegisterDomainResponse] -> ShowS
RegisterDomainResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RegisterDomainResponse] -> ShowS
$cshowList :: [RegisterDomainResponse] -> ShowS
show :: RegisterDomainResponse -> String
$cshow :: RegisterDomainResponse -> String
showsPrec :: Int -> RegisterDomainResponse -> ShowS
$cshowsPrec :: Int -> RegisterDomainResponse -> ShowS
Prelude.Show, forall x. Rep RegisterDomainResponse x -> RegisterDomainResponse
forall x. RegisterDomainResponse -> Rep RegisterDomainResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RegisterDomainResponse x -> RegisterDomainResponse
$cfrom :: forall x. RegisterDomainResponse -> Rep RegisterDomainResponse x
Prelude.Generic)

-- |
-- Create a value of 'RegisterDomainResponse' 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:
--
-- 'operationId', 'registerDomainResponse_operationId' - Identifier for tracking the progress of the request. To query the
-- operation status, use
-- <https://docs.aws.amazon.com/Route53/latest/APIReference/API_domains_GetOperationDetail.html GetOperationDetail>.
--
-- 'httpStatus', 'registerDomainResponse_httpStatus' - The response's http status code.
newRegisterDomainResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  RegisterDomainResponse
newRegisterDomainResponse :: Int -> RegisterDomainResponse
newRegisterDomainResponse Int
pHttpStatus_ =
  RegisterDomainResponse'
    { $sel:operationId:RegisterDomainResponse' :: Maybe Text
operationId =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:RegisterDomainResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Identifier for tracking the progress of the request. To query the
-- operation status, use
-- <https://docs.aws.amazon.com/Route53/latest/APIReference/API_domains_GetOperationDetail.html GetOperationDetail>.
registerDomainResponse_operationId :: Lens.Lens' RegisterDomainResponse (Prelude.Maybe Prelude.Text)
registerDomainResponse_operationId :: Lens' RegisterDomainResponse (Maybe Text)
registerDomainResponse_operationId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RegisterDomainResponse' {Maybe Text
operationId :: Maybe Text
$sel:operationId:RegisterDomainResponse' :: RegisterDomainResponse -> Maybe Text
operationId} -> Maybe Text
operationId) (\s :: RegisterDomainResponse
s@RegisterDomainResponse' {} Maybe Text
a -> RegisterDomainResponse
s {$sel:operationId:RegisterDomainResponse' :: Maybe Text
operationId = Maybe Text
a} :: RegisterDomainResponse)

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

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