{-# 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.TransferDomain
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Transfers a domain from another registrar to Amazon Route 53. When the
-- transfer is complete, the domain is registered either with Amazon
-- Registrar (for .com, .net, and .org domains) or with our registrar
-- associate, Gandi (for all other TLDs).
--
-- For more information about transferring domains, see the following
-- topics:
--
-- -   For transfer requirements, a detailed procedure, and information
--     about viewing the status of a domain that you\'re transferring to
--     Route 53, see
--     <https://docs.aws.amazon.com/Route53/latest/DeveloperGuide/domain-transfer-to-route-53.html Transferring Registration for a Domain to Amazon Route 53>
--     in the /Amazon Route 53 Developer Guide/.
--
-- -   For information about how to transfer a domain from one Amazon Web
--     Services account to another, see
--     <https://docs.aws.amazon.com/Route53/latest/APIReference/API_domains_TransferDomainToAnotherAwsAccount.html TransferDomainToAnotherAwsAccount>.
--
-- -   For information about how to transfer a domain to another domain
--     registrar, see
--     <https://docs.aws.amazon.com/Route53/latest/DeveloperGuide/domain-transfer-from-route-53.html Transferring a Domain from Amazon Route 53 to Another Registrar>
--     in the /Amazon Route 53 Developer Guide/.
--
-- If the registrar for your domain is also the DNS service provider for
-- the domain, we highly recommend that you transfer your DNS service to
-- Route 53 or to another DNS service provider before you transfer your
-- registration. Some registrars provide free DNS service when you purchase
-- a domain registration. When you transfer the registration, the previous
-- registrar will not renew your domain registration and could end your DNS
-- service at any time.
--
-- If the registrar for your domain is also the DNS service provider for
-- the domain and you don\'t transfer DNS service to another provider, your
-- website, email, and the web applications associated with the domain
-- might become unavailable.
--
-- If the transfer is successful, this method returns an operation ID that
-- you can use to track the progress and completion of the action. If the
-- transfer doesn\'t complete successfully, the domain registrant will be
-- notified by email.
module Amazonka.Route53Domains.TransferDomain
  ( -- * Creating a Request
    TransferDomain (..),
    newTransferDomain,

    -- * Request Lenses
    transferDomain_authCode,
    transferDomain_autoRenew,
    transferDomain_idnLangCode,
    transferDomain_nameservers,
    transferDomain_privacyProtectAdminContact,
    transferDomain_privacyProtectRegistrantContact,
    transferDomain_privacyProtectTechContact,
    transferDomain_domainName,
    transferDomain_durationInYears,
    transferDomain_adminContact,
    transferDomain_registrantContact,
    transferDomain_techContact,

    -- * Destructuring the Response
    TransferDomainResponse (..),
    newTransferDomainResponse,

    -- * Response Lenses
    transferDomainResponse_operationId,
    transferDomainResponse_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 TransferDomain request includes the following elements.
--
-- /See:/ 'newTransferDomain' smart constructor.
data TransferDomain = TransferDomain'
  { -- | The authorization code for the domain. You get this value from the
    -- current registrar.
    TransferDomain -> Maybe (Sensitive Text)
authCode :: Prelude.Maybe (Data.Sensitive Prelude.Text),
    -- | Indicates whether the domain will be automatically renewed (true) or not
    -- (false). Auto renewal only takes effect after the account is charged.
    --
    -- Default: true
    TransferDomain -> Maybe Bool
autoRenew :: Prelude.Maybe Prelude.Bool,
    -- | Reserved for future use.
    TransferDomain -> Maybe Text
idnLangCode :: Prelude.Maybe Prelude.Text,
    -- | Contains details for the host and glue IP addresses.
    TransferDomain -> Maybe [Nameserver]
nameservers :: Prelude.Maybe [Nameserver],
    -- | 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@
    TransferDomain -> 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 (domain owner).
    --
    -- You must specify the same privacy setting for the administrative,
    -- registrant, and technical contacts.
    --
    -- Default: @true@
    TransferDomain -> 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@
    TransferDomain -> Maybe Bool
privacyProtectTechContact :: Prelude.Maybe Prelude.Bool,
    -- | The name of the domain that you want to transfer to Route 53. 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@.
    TransferDomain -> 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.
    --
    -- Default: 1
    TransferDomain -> Natural
durationInYears :: Prelude.Natural,
    -- | Provides detailed contact information.
    TransferDomain -> Sensitive ContactDetail
adminContact :: Data.Sensitive ContactDetail,
    -- | Provides detailed contact information.
    TransferDomain -> Sensitive ContactDetail
registrantContact :: Data.Sensitive ContactDetail,
    -- | Provides detailed contact information.
    TransferDomain -> Sensitive ContactDetail
techContact :: Data.Sensitive ContactDetail
  }
  deriving (TransferDomain -> TransferDomain -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TransferDomain -> TransferDomain -> Bool
$c/= :: TransferDomain -> TransferDomain -> Bool
== :: TransferDomain -> TransferDomain -> Bool
$c== :: TransferDomain -> TransferDomain -> Bool
Prelude.Eq, Int -> TransferDomain -> ShowS
[TransferDomain] -> ShowS
TransferDomain -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TransferDomain] -> ShowS
$cshowList :: [TransferDomain] -> ShowS
show :: TransferDomain -> String
$cshow :: TransferDomain -> String
showsPrec :: Int -> TransferDomain -> ShowS
$cshowsPrec :: Int -> TransferDomain -> ShowS
Prelude.Show, forall x. Rep TransferDomain x -> TransferDomain
forall x. TransferDomain -> Rep TransferDomain x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TransferDomain x -> TransferDomain
$cfrom :: forall x. TransferDomain -> Rep TransferDomain x
Prelude.Generic)

-- |
-- Create a value of 'TransferDomain' 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:
--
-- 'authCode', 'transferDomain_authCode' - The authorization code for the domain. You get this value from the
-- current registrar.
--
-- 'autoRenew', 'transferDomain_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', 'transferDomain_idnLangCode' - Reserved for future use.
--
-- 'nameservers', 'transferDomain_nameservers' - Contains details for the host and glue IP addresses.
--
-- 'privacyProtectAdminContact', 'transferDomain_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', 'transferDomain_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 (domain owner).
--
-- You must specify the same privacy setting for the administrative,
-- registrant, and technical contacts.
--
-- Default: @true@
--
-- 'privacyProtectTechContact', 'transferDomain_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', 'transferDomain_domainName' - The name of the domain that you want to transfer to Route 53. 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@.
--
-- 'durationInYears', 'transferDomain_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.
--
-- Default: 1
--
-- 'adminContact', 'transferDomain_adminContact' - Provides detailed contact information.
--
-- 'registrantContact', 'transferDomain_registrantContact' - Provides detailed contact information.
--
-- 'techContact', 'transferDomain_techContact' - Provides detailed contact information.
newTransferDomain ::
  -- | 'domainName'
  Prelude.Text ->
  -- | 'durationInYears'
  Prelude.Natural ->
  -- | 'adminContact'
  ContactDetail ->
  -- | 'registrantContact'
  ContactDetail ->
  -- | 'techContact'
  ContactDetail ->
  TransferDomain
newTransferDomain :: Text
-> Natural
-> ContactDetail
-> ContactDetail
-> ContactDetail
-> TransferDomain
newTransferDomain
  Text
pDomainName_
  Natural
pDurationInYears_
  ContactDetail
pAdminContact_
  ContactDetail
pRegistrantContact_
  ContactDetail
pTechContact_ =
    TransferDomain'
      { $sel:authCode:TransferDomain' :: Maybe (Sensitive Text)
authCode = forall a. Maybe a
Prelude.Nothing,
        $sel:autoRenew:TransferDomain' :: Maybe Bool
autoRenew = forall a. Maybe a
Prelude.Nothing,
        $sel:idnLangCode:TransferDomain' :: Maybe Text
idnLangCode = forall a. Maybe a
Prelude.Nothing,
        $sel:nameservers:TransferDomain' :: Maybe [Nameserver]
nameservers = forall a. Maybe a
Prelude.Nothing,
        $sel:privacyProtectAdminContact:TransferDomain' :: Maybe Bool
privacyProtectAdminContact = forall a. Maybe a
Prelude.Nothing,
        $sel:privacyProtectRegistrantContact:TransferDomain' :: Maybe Bool
privacyProtectRegistrantContact = forall a. Maybe a
Prelude.Nothing,
        $sel:privacyProtectTechContact:TransferDomain' :: Maybe Bool
privacyProtectTechContact = forall a. Maybe a
Prelude.Nothing,
        $sel:domainName:TransferDomain' :: Text
domainName = Text
pDomainName_,
        $sel:durationInYears:TransferDomain' :: Natural
durationInYears = Natural
pDurationInYears_,
        $sel:adminContact:TransferDomain' :: Sensitive ContactDetail
adminContact = forall a. Iso' (Sensitive a) a
Data._Sensitive forall t b. AReview t b -> b -> t
Lens.# ContactDetail
pAdminContact_,
        $sel:registrantContact:TransferDomain' :: Sensitive ContactDetail
registrantContact =
          forall a. Iso' (Sensitive a) a
Data._Sensitive forall t b. AReview t b -> b -> t
Lens.# ContactDetail
pRegistrantContact_,
        $sel:techContact:TransferDomain' :: Sensitive ContactDetail
techContact = forall a. Iso' (Sensitive a) a
Data._Sensitive forall t b. AReview t b -> b -> t
Lens.# ContactDetail
pTechContact_
      }

-- | The authorization code for the domain. You get this value from the
-- current registrar.
transferDomain_authCode :: Lens.Lens' TransferDomain (Prelude.Maybe Prelude.Text)
transferDomain_authCode :: Lens' TransferDomain (Maybe Text)
transferDomain_authCode = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TransferDomain' {Maybe (Sensitive Text)
authCode :: Maybe (Sensitive Text)
$sel:authCode:TransferDomain' :: TransferDomain -> Maybe (Sensitive Text)
authCode} -> Maybe (Sensitive Text)
authCode) (\s :: TransferDomain
s@TransferDomain' {} Maybe (Sensitive Text)
a -> TransferDomain
s {$sel:authCode:TransferDomain' :: Maybe (Sensitive Text)
authCode = Maybe (Sensitive Text)
a} :: TransferDomain) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall a. Iso' (Sensitive a) a
Data._Sensitive

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

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

-- | Contains details for the host and glue IP addresses.
transferDomain_nameservers :: Lens.Lens' TransferDomain (Prelude.Maybe [Nameserver])
transferDomain_nameservers :: Lens' TransferDomain (Maybe [Nameserver])
transferDomain_nameservers = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TransferDomain' {Maybe [Nameserver]
nameservers :: Maybe [Nameserver]
$sel:nameservers:TransferDomain' :: TransferDomain -> Maybe [Nameserver]
nameservers} -> Maybe [Nameserver]
nameservers) (\s :: TransferDomain
s@TransferDomain' {} Maybe [Nameserver]
a -> TransferDomain
s {$sel:nameservers:TransferDomain' :: Maybe [Nameserver]
nameservers = Maybe [Nameserver]
a} :: TransferDomain) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | 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@
transferDomain_privacyProtectAdminContact :: Lens.Lens' TransferDomain (Prelude.Maybe Prelude.Bool)
transferDomain_privacyProtectAdminContact :: Lens' TransferDomain (Maybe Bool)
transferDomain_privacyProtectAdminContact = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TransferDomain' {Maybe Bool
privacyProtectAdminContact :: Maybe Bool
$sel:privacyProtectAdminContact:TransferDomain' :: TransferDomain -> Maybe Bool
privacyProtectAdminContact} -> Maybe Bool
privacyProtectAdminContact) (\s :: TransferDomain
s@TransferDomain' {} Maybe Bool
a -> TransferDomain
s {$sel:privacyProtectAdminContact:TransferDomain' :: Maybe Bool
privacyProtectAdminContact = Maybe Bool
a} :: TransferDomain)

-- | 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 (domain owner).
--
-- You must specify the same privacy setting for the administrative,
-- registrant, and technical contacts.
--
-- Default: @true@
transferDomain_privacyProtectRegistrantContact :: Lens.Lens' TransferDomain (Prelude.Maybe Prelude.Bool)
transferDomain_privacyProtectRegistrantContact :: Lens' TransferDomain (Maybe Bool)
transferDomain_privacyProtectRegistrantContact = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TransferDomain' {Maybe Bool
privacyProtectRegistrantContact :: Maybe Bool
$sel:privacyProtectRegistrantContact:TransferDomain' :: TransferDomain -> Maybe Bool
privacyProtectRegistrantContact} -> Maybe Bool
privacyProtectRegistrantContact) (\s :: TransferDomain
s@TransferDomain' {} Maybe Bool
a -> TransferDomain
s {$sel:privacyProtectRegistrantContact:TransferDomain' :: Maybe Bool
privacyProtectRegistrantContact = Maybe Bool
a} :: TransferDomain)

-- | 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@
transferDomain_privacyProtectTechContact :: Lens.Lens' TransferDomain (Prelude.Maybe Prelude.Bool)
transferDomain_privacyProtectTechContact :: Lens' TransferDomain (Maybe Bool)
transferDomain_privacyProtectTechContact = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TransferDomain' {Maybe Bool
privacyProtectTechContact :: Maybe Bool
$sel:privacyProtectTechContact:TransferDomain' :: TransferDomain -> Maybe Bool
privacyProtectTechContact} -> Maybe Bool
privacyProtectTechContact) (\s :: TransferDomain
s@TransferDomain' {} Maybe Bool
a -> TransferDomain
s {$sel:privacyProtectTechContact:TransferDomain' :: Maybe Bool
privacyProtectTechContact = Maybe Bool
a} :: TransferDomain)

-- | The name of the domain that you want to transfer to Route 53. 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@.
transferDomain_domainName :: Lens.Lens' TransferDomain Prelude.Text
transferDomain_domainName :: Lens' TransferDomain Text
transferDomain_domainName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TransferDomain' {Text
domainName :: Text
$sel:domainName:TransferDomain' :: TransferDomain -> Text
domainName} -> Text
domainName) (\s :: TransferDomain
s@TransferDomain' {} Text
a -> TransferDomain
s {$sel:domainName:TransferDomain' :: Text
domainName = Text
a} :: TransferDomain)

-- | 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.
--
-- Default: 1
transferDomain_durationInYears :: Lens.Lens' TransferDomain Prelude.Natural
transferDomain_durationInYears :: Lens' TransferDomain Natural
transferDomain_durationInYears = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TransferDomain' {Natural
durationInYears :: Natural
$sel:durationInYears:TransferDomain' :: TransferDomain -> Natural
durationInYears} -> Natural
durationInYears) (\s :: TransferDomain
s@TransferDomain' {} Natural
a -> TransferDomain
s {$sel:durationInYears:TransferDomain' :: Natural
durationInYears = Natural
a} :: TransferDomain)

-- | Provides detailed contact information.
transferDomain_adminContact :: Lens.Lens' TransferDomain ContactDetail
transferDomain_adminContact :: Lens' TransferDomain ContactDetail
transferDomain_adminContact = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TransferDomain' {Sensitive ContactDetail
adminContact :: Sensitive ContactDetail
$sel:adminContact:TransferDomain' :: TransferDomain -> Sensitive ContactDetail
adminContact} -> Sensitive ContactDetail
adminContact) (\s :: TransferDomain
s@TransferDomain' {} Sensitive ContactDetail
a -> TransferDomain
s {$sel:adminContact:TransferDomain' :: Sensitive ContactDetail
adminContact = Sensitive ContactDetail
a} :: TransferDomain) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a. Iso' (Sensitive a) a
Data._Sensitive

-- | Provides detailed contact information.
transferDomain_registrantContact :: Lens.Lens' TransferDomain ContactDetail
transferDomain_registrantContact :: Lens' TransferDomain ContactDetail
transferDomain_registrantContact = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TransferDomain' {Sensitive ContactDetail
registrantContact :: Sensitive ContactDetail
$sel:registrantContact:TransferDomain' :: TransferDomain -> Sensitive ContactDetail
registrantContact} -> Sensitive ContactDetail
registrantContact) (\s :: TransferDomain
s@TransferDomain' {} Sensitive ContactDetail
a -> TransferDomain
s {$sel:registrantContact:TransferDomain' :: Sensitive ContactDetail
registrantContact = Sensitive ContactDetail
a} :: TransferDomain) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a. Iso' (Sensitive a) a
Data._Sensitive

-- | Provides detailed contact information.
transferDomain_techContact :: Lens.Lens' TransferDomain ContactDetail
transferDomain_techContact :: Lens' TransferDomain ContactDetail
transferDomain_techContact = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TransferDomain' {Sensitive ContactDetail
techContact :: Sensitive ContactDetail
$sel:techContact:TransferDomain' :: TransferDomain -> Sensitive ContactDetail
techContact} -> Sensitive ContactDetail
techContact) (\s :: TransferDomain
s@TransferDomain' {} Sensitive ContactDetail
a -> TransferDomain
s {$sel:techContact:TransferDomain' :: Sensitive ContactDetail
techContact = Sensitive ContactDetail
a} :: TransferDomain) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a. Iso' (Sensitive a) a
Data._Sensitive

instance Core.AWSRequest TransferDomain where
  type
    AWSResponse TransferDomain =
      TransferDomainResponse
  request :: (Service -> Service) -> TransferDomain -> Request TransferDomain
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 TransferDomain
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse TransferDomain)))
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 -> TransferDomainResponse
TransferDomainResponse'
            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 TransferDomain where
  hashWithSalt :: Int -> TransferDomain -> Int
hashWithSalt Int
_salt TransferDomain' {Natural
Maybe Bool
Maybe [Nameserver]
Maybe Text
Maybe (Sensitive 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
nameservers :: Maybe [Nameserver]
idnLangCode :: Maybe Text
autoRenew :: Maybe Bool
authCode :: Maybe (Sensitive Text)
$sel:techContact:TransferDomain' :: TransferDomain -> Sensitive ContactDetail
$sel:registrantContact:TransferDomain' :: TransferDomain -> Sensitive ContactDetail
$sel:adminContact:TransferDomain' :: TransferDomain -> Sensitive ContactDetail
$sel:durationInYears:TransferDomain' :: TransferDomain -> Natural
$sel:domainName:TransferDomain' :: TransferDomain -> Text
$sel:privacyProtectTechContact:TransferDomain' :: TransferDomain -> Maybe Bool
$sel:privacyProtectRegistrantContact:TransferDomain' :: TransferDomain -> Maybe Bool
$sel:privacyProtectAdminContact:TransferDomain' :: TransferDomain -> Maybe Bool
$sel:nameservers:TransferDomain' :: TransferDomain -> Maybe [Nameserver]
$sel:idnLangCode:TransferDomain' :: TransferDomain -> Maybe Text
$sel:autoRenew:TransferDomain' :: TransferDomain -> Maybe Bool
$sel:authCode:TransferDomain' :: TransferDomain -> Maybe (Sensitive Text)
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (Sensitive Text)
authCode
      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 [Nameserver]
nameservers
      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 TransferDomain where
  rnf :: TransferDomain -> ()
rnf TransferDomain' {Natural
Maybe Bool
Maybe [Nameserver]
Maybe Text
Maybe (Sensitive 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
nameservers :: Maybe [Nameserver]
idnLangCode :: Maybe Text
autoRenew :: Maybe Bool
authCode :: Maybe (Sensitive Text)
$sel:techContact:TransferDomain' :: TransferDomain -> Sensitive ContactDetail
$sel:registrantContact:TransferDomain' :: TransferDomain -> Sensitive ContactDetail
$sel:adminContact:TransferDomain' :: TransferDomain -> Sensitive ContactDetail
$sel:durationInYears:TransferDomain' :: TransferDomain -> Natural
$sel:domainName:TransferDomain' :: TransferDomain -> Text
$sel:privacyProtectTechContact:TransferDomain' :: TransferDomain -> Maybe Bool
$sel:privacyProtectRegistrantContact:TransferDomain' :: TransferDomain -> Maybe Bool
$sel:privacyProtectAdminContact:TransferDomain' :: TransferDomain -> Maybe Bool
$sel:nameservers:TransferDomain' :: TransferDomain -> Maybe [Nameserver]
$sel:idnLangCode:TransferDomain' :: TransferDomain -> Maybe Text
$sel:autoRenew:TransferDomain' :: TransferDomain -> Maybe Bool
$sel:authCode:TransferDomain' :: TransferDomain -> Maybe (Sensitive Text)
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe (Sensitive Text)
authCode
      seq :: forall a b. a -> b -> b
`Prelude.seq` 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 [Nameserver]
nameservers
      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 TransferDomain where
  toHeaders :: TransferDomain -> 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.TransferDomain" ::
                          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 TransferDomain where
  toJSON :: TransferDomain -> Value
toJSON TransferDomain' {Natural
Maybe Bool
Maybe [Nameserver]
Maybe Text
Maybe (Sensitive 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
nameservers :: Maybe [Nameserver]
idnLangCode :: Maybe Text
autoRenew :: Maybe Bool
authCode :: Maybe (Sensitive Text)
$sel:techContact:TransferDomain' :: TransferDomain -> Sensitive ContactDetail
$sel:registrantContact:TransferDomain' :: TransferDomain -> Sensitive ContactDetail
$sel:adminContact:TransferDomain' :: TransferDomain -> Sensitive ContactDetail
$sel:durationInYears:TransferDomain' :: TransferDomain -> Natural
$sel:domainName:TransferDomain' :: TransferDomain -> Text
$sel:privacyProtectTechContact:TransferDomain' :: TransferDomain -> Maybe Bool
$sel:privacyProtectRegistrantContact:TransferDomain' :: TransferDomain -> Maybe Bool
$sel:privacyProtectAdminContact:TransferDomain' :: TransferDomain -> Maybe Bool
$sel:nameservers:TransferDomain' :: TransferDomain -> Maybe [Nameserver]
$sel:idnLangCode:TransferDomain' :: TransferDomain -> Maybe Text
$sel:autoRenew:TransferDomain' :: TransferDomain -> Maybe Bool
$sel:authCode:TransferDomain' :: TransferDomain -> Maybe (Sensitive Text)
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"AuthCode" 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 (Sensitive Text)
authCode,
            (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
"Nameservers" 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 [Nameserver]
nameservers,
            (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 TransferDomain where
  toPath :: TransferDomain -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

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

-- | The TransferDomain response includes the following element.
--
-- /See:/ 'newTransferDomainResponse' smart constructor.
data TransferDomainResponse = TransferDomainResponse'
  { -- | 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>.
    TransferDomainResponse -> Maybe Text
operationId :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    TransferDomainResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (TransferDomainResponse -> TransferDomainResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TransferDomainResponse -> TransferDomainResponse -> Bool
$c/= :: TransferDomainResponse -> TransferDomainResponse -> Bool
== :: TransferDomainResponse -> TransferDomainResponse -> Bool
$c== :: TransferDomainResponse -> TransferDomainResponse -> Bool
Prelude.Eq, ReadPrec [TransferDomainResponse]
ReadPrec TransferDomainResponse
Int -> ReadS TransferDomainResponse
ReadS [TransferDomainResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [TransferDomainResponse]
$creadListPrec :: ReadPrec [TransferDomainResponse]
readPrec :: ReadPrec TransferDomainResponse
$creadPrec :: ReadPrec TransferDomainResponse
readList :: ReadS [TransferDomainResponse]
$creadList :: ReadS [TransferDomainResponse]
readsPrec :: Int -> ReadS TransferDomainResponse
$creadsPrec :: Int -> ReadS TransferDomainResponse
Prelude.Read, Int -> TransferDomainResponse -> ShowS
[TransferDomainResponse] -> ShowS
TransferDomainResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TransferDomainResponse] -> ShowS
$cshowList :: [TransferDomainResponse] -> ShowS
show :: TransferDomainResponse -> String
$cshow :: TransferDomainResponse -> String
showsPrec :: Int -> TransferDomainResponse -> ShowS
$cshowsPrec :: Int -> TransferDomainResponse -> ShowS
Prelude.Show, forall x. Rep TransferDomainResponse x -> TransferDomainResponse
forall x. TransferDomainResponse -> Rep TransferDomainResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TransferDomainResponse x -> TransferDomainResponse
$cfrom :: forall x. TransferDomainResponse -> Rep TransferDomainResponse x
Prelude.Generic)

-- |
-- Create a value of 'TransferDomainResponse' 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', 'transferDomainResponse_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', 'transferDomainResponse_httpStatus' - The response's http status code.
newTransferDomainResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  TransferDomainResponse
newTransferDomainResponse :: Int -> TransferDomainResponse
newTransferDomainResponse Int
pHttpStatus_ =
  TransferDomainResponse'
    { $sel:operationId:TransferDomainResponse' :: Maybe Text
operationId =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:TransferDomainResponse' :: 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>.
transferDomainResponse_operationId :: Lens.Lens' TransferDomainResponse (Prelude.Maybe Prelude.Text)
transferDomainResponse_operationId :: Lens' TransferDomainResponse (Maybe Text)
transferDomainResponse_operationId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TransferDomainResponse' {Maybe Text
operationId :: Maybe Text
$sel:operationId:TransferDomainResponse' :: TransferDomainResponse -> Maybe Text
operationId} -> Maybe Text
operationId) (\s :: TransferDomainResponse
s@TransferDomainResponse' {} Maybe Text
a -> TransferDomainResponse
s {$sel:operationId:TransferDomainResponse' :: Maybe Text
operationId = Maybe Text
a} :: TransferDomainResponse)

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

instance Prelude.NFData TransferDomainResponse where
  rnf :: TransferDomainResponse -> ()
rnf TransferDomainResponse' {Int
Maybe Text
httpStatus :: Int
operationId :: Maybe Text
$sel:httpStatus:TransferDomainResponse' :: TransferDomainResponse -> Int
$sel:operationId:TransferDomainResponse' :: TransferDomainResponse -> 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