{-# 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.GetDomainDetail
-- 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 returns detailed information about a specified domain
-- that is associated with the current Amazon Web Services account. Contact
-- information for the domain is also returned as part of the output.
module Amazonka.Route53Domains.GetDomainDetail
  ( -- * Creating a Request
    GetDomainDetail (..),
    newGetDomainDetail,

    -- * Request Lenses
    getDomainDetail_domainName,

    -- * Destructuring the Response
    GetDomainDetailResponse (..),
    newGetDomainDetailResponse,

    -- * Response Lenses
    getDomainDetailResponse_abuseContactEmail,
    getDomainDetailResponse_abuseContactPhone,
    getDomainDetailResponse_adminContact,
    getDomainDetailResponse_adminPrivacy,
    getDomainDetailResponse_autoRenew,
    getDomainDetailResponse_creationDate,
    getDomainDetailResponse_dnsSec,
    getDomainDetailResponse_dnssecKeys,
    getDomainDetailResponse_domainName,
    getDomainDetailResponse_expirationDate,
    getDomainDetailResponse_nameservers,
    getDomainDetailResponse_registrantContact,
    getDomainDetailResponse_registrantPrivacy,
    getDomainDetailResponse_registrarName,
    getDomainDetailResponse_registrarUrl,
    getDomainDetailResponse_registryDomainId,
    getDomainDetailResponse_reseller,
    getDomainDetailResponse_statusList,
    getDomainDetailResponse_techContact,
    getDomainDetailResponse_techPrivacy,
    getDomainDetailResponse_updatedDate,
    getDomainDetailResponse_whoIsServer,
    getDomainDetailResponse_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 GetDomainDetail request includes the following element.
--
-- /See:/ 'newGetDomainDetail' smart constructor.
data GetDomainDetail = GetDomainDetail'
  { -- | The name of the domain that you want to get detailed information about.
    GetDomainDetail -> Text
domainName :: Prelude.Text
  }
  deriving (GetDomainDetail -> GetDomainDetail -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetDomainDetail -> GetDomainDetail -> Bool
$c/= :: GetDomainDetail -> GetDomainDetail -> Bool
== :: GetDomainDetail -> GetDomainDetail -> Bool
$c== :: GetDomainDetail -> GetDomainDetail -> Bool
Prelude.Eq, ReadPrec [GetDomainDetail]
ReadPrec GetDomainDetail
Int -> ReadS GetDomainDetail
ReadS [GetDomainDetail]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetDomainDetail]
$creadListPrec :: ReadPrec [GetDomainDetail]
readPrec :: ReadPrec GetDomainDetail
$creadPrec :: ReadPrec GetDomainDetail
readList :: ReadS [GetDomainDetail]
$creadList :: ReadS [GetDomainDetail]
readsPrec :: Int -> ReadS GetDomainDetail
$creadsPrec :: Int -> ReadS GetDomainDetail
Prelude.Read, Int -> GetDomainDetail -> ShowS
[GetDomainDetail] -> ShowS
GetDomainDetail -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetDomainDetail] -> ShowS
$cshowList :: [GetDomainDetail] -> ShowS
show :: GetDomainDetail -> String
$cshow :: GetDomainDetail -> String
showsPrec :: Int -> GetDomainDetail -> ShowS
$cshowsPrec :: Int -> GetDomainDetail -> ShowS
Prelude.Show, forall x. Rep GetDomainDetail x -> GetDomainDetail
forall x. GetDomainDetail -> Rep GetDomainDetail x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetDomainDetail x -> GetDomainDetail
$cfrom :: forall x. GetDomainDetail -> Rep GetDomainDetail x
Prelude.Generic)

-- |
-- Create a value of 'GetDomainDetail' 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:
--
-- 'domainName', 'getDomainDetail_domainName' - The name of the domain that you want to get detailed information about.
newGetDomainDetail ::
  -- | 'domainName'
  Prelude.Text ->
  GetDomainDetail
newGetDomainDetail :: Text -> GetDomainDetail
newGetDomainDetail Text
pDomainName_ =
  GetDomainDetail' {$sel:domainName:GetDomainDetail' :: Text
domainName = Text
pDomainName_}

-- | The name of the domain that you want to get detailed information about.
getDomainDetail_domainName :: Lens.Lens' GetDomainDetail Prelude.Text
getDomainDetail_domainName :: Lens' GetDomainDetail Text
getDomainDetail_domainName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetDomainDetail' {Text
domainName :: Text
$sel:domainName:GetDomainDetail' :: GetDomainDetail -> Text
domainName} -> Text
domainName) (\s :: GetDomainDetail
s@GetDomainDetail' {} Text
a -> GetDomainDetail
s {$sel:domainName:GetDomainDetail' :: Text
domainName = Text
a} :: GetDomainDetail)

instance Core.AWSRequest GetDomainDetail where
  type
    AWSResponse GetDomainDetail =
      GetDomainDetailResponse
  request :: (Service -> Service) -> GetDomainDetail -> Request GetDomainDetail
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 GetDomainDetail
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse GetDomainDetail)))
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
-> Maybe Text
-> Maybe (Sensitive ContactDetail)
-> Maybe Bool
-> Maybe Bool
-> Maybe POSIX
-> Maybe Text
-> Maybe [DnssecKey]
-> Maybe Text
-> Maybe POSIX
-> Maybe [Nameserver]
-> Maybe (Sensitive ContactDetail)
-> Maybe Bool
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe [Text]
-> Maybe (Sensitive ContactDetail)
-> Maybe Bool
-> Maybe POSIX
-> Maybe Text
-> Int
-> GetDomainDetailResponse
GetDomainDetailResponse'
            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
"AbuseContactEmail")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"AbuseContactPhone")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"AdminContact")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"AdminPrivacy")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"AutoRenew")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"CreationDate")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"DnsSec")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"DnssecKeys" forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty)
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"DomainName")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"ExpirationDate")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"Nameservers" forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty)
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"RegistrantContact")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"RegistrantPrivacy")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"RegistrarName")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"RegistrarUrl")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"RegistryDomainId")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"Reseller")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"StatusList" forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty)
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"TechContact")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"TechPrivacy")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"UpdatedDate")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"WhoIsServer")
            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 GetDomainDetail where
  hashWithSalt :: Int -> GetDomainDetail -> Int
hashWithSalt Int
_salt GetDomainDetail' {Text
domainName :: Text
$sel:domainName:GetDomainDetail' :: GetDomainDetail -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
domainName

instance Prelude.NFData GetDomainDetail where
  rnf :: GetDomainDetail -> ()
rnf GetDomainDetail' {Text
domainName :: Text
$sel:domainName:GetDomainDetail' :: GetDomainDetail -> Text
..} = forall a. NFData a => a -> ()
Prelude.rnf Text
domainName

instance Data.ToHeaders GetDomainDetail where
  toHeaders :: GetDomainDetail -> 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.GetDomainDetail" ::
                          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 GetDomainDetail where
  toJSON :: GetDomainDetail -> Value
toJSON GetDomainDetail' {Text
domainName :: Text
$sel:domainName:GetDomainDetail' :: GetDomainDetail -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [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 GetDomainDetail where
  toPath :: GetDomainDetail -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

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

-- | The GetDomainDetail response includes the following elements.
--
-- /See:/ 'newGetDomainDetailResponse' smart constructor.
data GetDomainDetailResponse = GetDomainDetailResponse'
  { -- | Email address to contact to report incorrect contact information for a
    -- domain, to report that the domain is being used to send spam, to report
    -- that someone is cybersquatting on a domain name, or report some other
    -- type of abuse.
    GetDomainDetailResponse -> Maybe Text
abuseContactEmail :: Prelude.Maybe Prelude.Text,
    -- | Phone number for reporting abuse.
    GetDomainDetailResponse -> Maybe Text
abuseContactPhone :: Prelude.Maybe Prelude.Text,
    -- | Provides details about the domain administrative contact.
    GetDomainDetailResponse -> Maybe (Sensitive ContactDetail)
adminContact :: Prelude.Maybe (Data.Sensitive ContactDetail),
    -- | Specifies whether contact information is concealed from WHOIS queries.
    -- If the value is @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
    -- the value is @false@, WHOIS queries return the information that you
    -- entered for the admin contact.
    GetDomainDetailResponse -> Maybe Bool
adminPrivacy :: Prelude.Maybe Prelude.Bool,
    -- | Specifies whether the domain registration is set to renew automatically.
    GetDomainDetailResponse -> Maybe Bool
autoRenew :: Prelude.Maybe Prelude.Bool,
    -- | The date when the domain was created as found in the response to a WHOIS
    -- query. The date and time is in Unix time format and Coordinated
    -- Universal time (UTC).
    GetDomainDetailResponse -> Maybe POSIX
creationDate :: Prelude.Maybe Data.POSIX,
    -- | Deprecated.
    GetDomainDetailResponse -> Maybe Text
dnsSec :: Prelude.Maybe Prelude.Text,
    -- | A complex type that contains information about the DNSSEC configuration.
    GetDomainDetailResponse -> Maybe [DnssecKey]
dnssecKeys :: Prelude.Maybe [DnssecKey],
    -- | The name of a domain.
    GetDomainDetailResponse -> Maybe Text
domainName :: Prelude.Maybe Prelude.Text,
    -- | The date when the registration for the domain is set to expire. The date
    -- and time is in Unix time format and Coordinated Universal time (UTC).
    GetDomainDetailResponse -> Maybe POSIX
expirationDate :: Prelude.Maybe Data.POSIX,
    -- | The name servers of the domain.
    GetDomainDetailResponse -> Maybe [Nameserver]
nameservers :: Prelude.Maybe [Nameserver],
    -- | Provides details about the domain registrant.
    GetDomainDetailResponse -> Maybe (Sensitive ContactDetail)
registrantContact :: Prelude.Maybe (Data.Sensitive ContactDetail),
    -- | Specifies whether contact information is concealed from WHOIS queries.
    -- If the value is @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
    -- the value is @false@, WHOIS queries return the information that you
    -- entered for the registrant contact (domain owner).
    GetDomainDetailResponse -> Maybe Bool
registrantPrivacy :: Prelude.Maybe Prelude.Bool,
    -- | Name of the registrar of the domain as identified in the registry.
    -- Domains with a .com, .net, or .org TLD are registered by Amazon
    -- Registrar. All other domains are registered by our registrar associate,
    -- Gandi. The value for domains that are registered by Gandi is
    -- @\"GANDI SAS\"@.
    GetDomainDetailResponse -> Maybe Text
registrarName :: Prelude.Maybe Prelude.Text,
    -- | Web address of the registrar.
    GetDomainDetailResponse -> Maybe Text
registrarUrl :: Prelude.Maybe Prelude.Text,
    -- | Reserved for future use.
    GetDomainDetailResponse -> Maybe Text
registryDomainId :: Prelude.Maybe Prelude.Text,
    -- | Reseller of the domain. Domains registered or transferred using Route 53
    -- domains will have @\"Amazon\"@ as the reseller.
    GetDomainDetailResponse -> Maybe Text
reseller :: Prelude.Maybe Prelude.Text,
    -- | An array of domain name status codes, also known as Extensible
    -- Provisioning Protocol (EPP) status codes.
    --
    -- ICANN, the organization that maintains a central database of domain
    -- names, has developed a set of domain name status codes that tell you the
    -- status of a variety of operations on a domain name, for example,
    -- registering a domain name, transferring a domain name to another
    -- registrar, renewing the registration for a domain name, and so on. All
    -- registrars use this same set of status codes.
    --
    -- For a current list of domain name status codes and an explanation of
    -- what each code means, go to the <https://www.icann.org/ ICANN website>
    -- and search for @epp status codes@. (Search on the ICANN website; web
    -- searches sometimes return an old version of the document.)
    GetDomainDetailResponse -> Maybe [Text]
statusList :: Prelude.Maybe [Prelude.Text],
    -- | Provides details about the domain technical contact.
    GetDomainDetailResponse -> Maybe (Sensitive ContactDetail)
techContact :: Prelude.Maybe (Data.Sensitive ContactDetail),
    -- | Specifies whether contact information is concealed from WHOIS queries.
    -- If the value is @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
    -- the value is @false@, WHOIS queries return the information that you
    -- entered for the technical contact.
    GetDomainDetailResponse -> Maybe Bool
techPrivacy :: Prelude.Maybe Prelude.Bool,
    -- | The last updated date of the domain as found in the response to a WHOIS
    -- query. The date and time is in Unix time format and Coordinated
    -- Universal time (UTC).
    GetDomainDetailResponse -> Maybe POSIX
updatedDate :: Prelude.Maybe Data.POSIX,
    -- | The fully qualified name of the WHOIS server that can answer the WHOIS
    -- query for the domain.
    GetDomainDetailResponse -> Maybe Text
whoIsServer :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    GetDomainDetailResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetDomainDetailResponse -> GetDomainDetailResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetDomainDetailResponse -> GetDomainDetailResponse -> Bool
$c/= :: GetDomainDetailResponse -> GetDomainDetailResponse -> Bool
== :: GetDomainDetailResponse -> GetDomainDetailResponse -> Bool
$c== :: GetDomainDetailResponse -> GetDomainDetailResponse -> Bool
Prelude.Eq, Int -> GetDomainDetailResponse -> ShowS
[GetDomainDetailResponse] -> ShowS
GetDomainDetailResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetDomainDetailResponse] -> ShowS
$cshowList :: [GetDomainDetailResponse] -> ShowS
show :: GetDomainDetailResponse -> String
$cshow :: GetDomainDetailResponse -> String
showsPrec :: Int -> GetDomainDetailResponse -> ShowS
$cshowsPrec :: Int -> GetDomainDetailResponse -> ShowS
Prelude.Show, forall x. Rep GetDomainDetailResponse x -> GetDomainDetailResponse
forall x. GetDomainDetailResponse -> Rep GetDomainDetailResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetDomainDetailResponse x -> GetDomainDetailResponse
$cfrom :: forall x. GetDomainDetailResponse -> Rep GetDomainDetailResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetDomainDetailResponse' 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:
--
-- 'abuseContactEmail', 'getDomainDetailResponse_abuseContactEmail' - Email address to contact to report incorrect contact information for a
-- domain, to report that the domain is being used to send spam, to report
-- that someone is cybersquatting on a domain name, or report some other
-- type of abuse.
--
-- 'abuseContactPhone', 'getDomainDetailResponse_abuseContactPhone' - Phone number for reporting abuse.
--
-- 'adminContact', 'getDomainDetailResponse_adminContact' - Provides details about the domain administrative contact.
--
-- 'adminPrivacy', 'getDomainDetailResponse_adminPrivacy' - Specifies whether contact information is concealed from WHOIS queries.
-- If the value is @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
-- the value is @false@, WHOIS queries return the information that you
-- entered for the admin contact.
--
-- 'autoRenew', 'getDomainDetailResponse_autoRenew' - Specifies whether the domain registration is set to renew automatically.
--
-- 'creationDate', 'getDomainDetailResponse_creationDate' - The date when the domain was created as found in the response to a WHOIS
-- query. The date and time is in Unix time format and Coordinated
-- Universal time (UTC).
--
-- 'dnsSec', 'getDomainDetailResponse_dnsSec' - Deprecated.
--
-- 'dnssecKeys', 'getDomainDetailResponse_dnssecKeys' - A complex type that contains information about the DNSSEC configuration.
--
-- 'domainName', 'getDomainDetailResponse_domainName' - The name of a domain.
--
-- 'expirationDate', 'getDomainDetailResponse_expirationDate' - The date when the registration for the domain is set to expire. The date
-- and time is in Unix time format and Coordinated Universal time (UTC).
--
-- 'nameservers', 'getDomainDetailResponse_nameservers' - The name servers of the domain.
--
-- 'registrantContact', 'getDomainDetailResponse_registrantContact' - Provides details about the domain registrant.
--
-- 'registrantPrivacy', 'getDomainDetailResponse_registrantPrivacy' - Specifies whether contact information is concealed from WHOIS queries.
-- If the value is @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
-- the value is @false@, WHOIS queries return the information that you
-- entered for the registrant contact (domain owner).
--
-- 'registrarName', 'getDomainDetailResponse_registrarName' - Name of the registrar of the domain as identified in the registry.
-- Domains with a .com, .net, or .org TLD are registered by Amazon
-- Registrar. All other domains are registered by our registrar associate,
-- Gandi. The value for domains that are registered by Gandi is
-- @\"GANDI SAS\"@.
--
-- 'registrarUrl', 'getDomainDetailResponse_registrarUrl' - Web address of the registrar.
--
-- 'registryDomainId', 'getDomainDetailResponse_registryDomainId' - Reserved for future use.
--
-- 'reseller', 'getDomainDetailResponse_reseller' - Reseller of the domain. Domains registered or transferred using Route 53
-- domains will have @\"Amazon\"@ as the reseller.
--
-- 'statusList', 'getDomainDetailResponse_statusList' - An array of domain name status codes, also known as Extensible
-- Provisioning Protocol (EPP) status codes.
--
-- ICANN, the organization that maintains a central database of domain
-- names, has developed a set of domain name status codes that tell you the
-- status of a variety of operations on a domain name, for example,
-- registering a domain name, transferring a domain name to another
-- registrar, renewing the registration for a domain name, and so on. All
-- registrars use this same set of status codes.
--
-- For a current list of domain name status codes and an explanation of
-- what each code means, go to the <https://www.icann.org/ ICANN website>
-- and search for @epp status codes@. (Search on the ICANN website; web
-- searches sometimes return an old version of the document.)
--
-- 'techContact', 'getDomainDetailResponse_techContact' - Provides details about the domain technical contact.
--
-- 'techPrivacy', 'getDomainDetailResponse_techPrivacy' - Specifies whether contact information is concealed from WHOIS queries.
-- If the value is @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
-- the value is @false@, WHOIS queries return the information that you
-- entered for the technical contact.
--
-- 'updatedDate', 'getDomainDetailResponse_updatedDate' - The last updated date of the domain as found in the response to a WHOIS
-- query. The date and time is in Unix time format and Coordinated
-- Universal time (UTC).
--
-- 'whoIsServer', 'getDomainDetailResponse_whoIsServer' - The fully qualified name of the WHOIS server that can answer the WHOIS
-- query for the domain.
--
-- 'httpStatus', 'getDomainDetailResponse_httpStatus' - The response's http status code.
newGetDomainDetailResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetDomainDetailResponse
newGetDomainDetailResponse :: Int -> GetDomainDetailResponse
newGetDomainDetailResponse Int
pHttpStatus_ =
  GetDomainDetailResponse'
    { $sel:abuseContactEmail:GetDomainDetailResponse' :: Maybe Text
abuseContactEmail =
        forall a. Maybe a
Prelude.Nothing,
      $sel:abuseContactPhone:GetDomainDetailResponse' :: Maybe Text
abuseContactPhone = forall a. Maybe a
Prelude.Nothing,
      $sel:adminContact:GetDomainDetailResponse' :: Maybe (Sensitive ContactDetail)
adminContact = forall a. Maybe a
Prelude.Nothing,
      $sel:adminPrivacy:GetDomainDetailResponse' :: Maybe Bool
adminPrivacy = forall a. Maybe a
Prelude.Nothing,
      $sel:autoRenew:GetDomainDetailResponse' :: Maybe Bool
autoRenew = forall a. Maybe a
Prelude.Nothing,
      $sel:creationDate:GetDomainDetailResponse' :: Maybe POSIX
creationDate = forall a. Maybe a
Prelude.Nothing,
      $sel:dnsSec:GetDomainDetailResponse' :: Maybe Text
dnsSec = forall a. Maybe a
Prelude.Nothing,
      $sel:dnssecKeys:GetDomainDetailResponse' :: Maybe [DnssecKey]
dnssecKeys = forall a. Maybe a
Prelude.Nothing,
      $sel:domainName:GetDomainDetailResponse' :: Maybe Text
domainName = forall a. Maybe a
Prelude.Nothing,
      $sel:expirationDate:GetDomainDetailResponse' :: Maybe POSIX
expirationDate = forall a. Maybe a
Prelude.Nothing,
      $sel:nameservers:GetDomainDetailResponse' :: Maybe [Nameserver]
nameservers = forall a. Maybe a
Prelude.Nothing,
      $sel:registrantContact:GetDomainDetailResponse' :: Maybe (Sensitive ContactDetail)
registrantContact = forall a. Maybe a
Prelude.Nothing,
      $sel:registrantPrivacy:GetDomainDetailResponse' :: Maybe Bool
registrantPrivacy = forall a. Maybe a
Prelude.Nothing,
      $sel:registrarName:GetDomainDetailResponse' :: Maybe Text
registrarName = forall a. Maybe a
Prelude.Nothing,
      $sel:registrarUrl:GetDomainDetailResponse' :: Maybe Text
registrarUrl = forall a. Maybe a
Prelude.Nothing,
      $sel:registryDomainId:GetDomainDetailResponse' :: Maybe Text
registryDomainId = forall a. Maybe a
Prelude.Nothing,
      $sel:reseller:GetDomainDetailResponse' :: Maybe Text
reseller = forall a. Maybe a
Prelude.Nothing,
      $sel:statusList:GetDomainDetailResponse' :: Maybe [Text]
statusList = forall a. Maybe a
Prelude.Nothing,
      $sel:techContact:GetDomainDetailResponse' :: Maybe (Sensitive ContactDetail)
techContact = forall a. Maybe a
Prelude.Nothing,
      $sel:techPrivacy:GetDomainDetailResponse' :: Maybe Bool
techPrivacy = forall a. Maybe a
Prelude.Nothing,
      $sel:updatedDate:GetDomainDetailResponse' :: Maybe POSIX
updatedDate = forall a. Maybe a
Prelude.Nothing,
      $sel:whoIsServer:GetDomainDetailResponse' :: Maybe Text
whoIsServer = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetDomainDetailResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Email address to contact to report incorrect contact information for a
-- domain, to report that the domain is being used to send spam, to report
-- that someone is cybersquatting on a domain name, or report some other
-- type of abuse.
getDomainDetailResponse_abuseContactEmail :: Lens.Lens' GetDomainDetailResponse (Prelude.Maybe Prelude.Text)
getDomainDetailResponse_abuseContactEmail :: Lens' GetDomainDetailResponse (Maybe Text)
getDomainDetailResponse_abuseContactEmail = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetDomainDetailResponse' {Maybe Text
abuseContactEmail :: Maybe Text
$sel:abuseContactEmail:GetDomainDetailResponse' :: GetDomainDetailResponse -> Maybe Text
abuseContactEmail} -> Maybe Text
abuseContactEmail) (\s :: GetDomainDetailResponse
s@GetDomainDetailResponse' {} Maybe Text
a -> GetDomainDetailResponse
s {$sel:abuseContactEmail:GetDomainDetailResponse' :: Maybe Text
abuseContactEmail = Maybe Text
a} :: GetDomainDetailResponse)

-- | Phone number for reporting abuse.
getDomainDetailResponse_abuseContactPhone :: Lens.Lens' GetDomainDetailResponse (Prelude.Maybe Prelude.Text)
getDomainDetailResponse_abuseContactPhone :: Lens' GetDomainDetailResponse (Maybe Text)
getDomainDetailResponse_abuseContactPhone = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetDomainDetailResponse' {Maybe Text
abuseContactPhone :: Maybe Text
$sel:abuseContactPhone:GetDomainDetailResponse' :: GetDomainDetailResponse -> Maybe Text
abuseContactPhone} -> Maybe Text
abuseContactPhone) (\s :: GetDomainDetailResponse
s@GetDomainDetailResponse' {} Maybe Text
a -> GetDomainDetailResponse
s {$sel:abuseContactPhone:GetDomainDetailResponse' :: Maybe Text
abuseContactPhone = Maybe Text
a} :: GetDomainDetailResponse)

-- | Provides details about the domain administrative contact.
getDomainDetailResponse_adminContact :: Lens.Lens' GetDomainDetailResponse (Prelude.Maybe ContactDetail)
getDomainDetailResponse_adminContact :: Lens' GetDomainDetailResponse (Maybe ContactDetail)
getDomainDetailResponse_adminContact = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetDomainDetailResponse' {Maybe (Sensitive ContactDetail)
adminContact :: Maybe (Sensitive ContactDetail)
$sel:adminContact:GetDomainDetailResponse' :: GetDomainDetailResponse -> Maybe (Sensitive ContactDetail)
adminContact} -> Maybe (Sensitive ContactDetail)
adminContact) (\s :: GetDomainDetailResponse
s@GetDomainDetailResponse' {} Maybe (Sensitive ContactDetail)
a -> GetDomainDetailResponse
s {$sel:adminContact:GetDomainDetailResponse' :: Maybe (Sensitive ContactDetail)
adminContact = Maybe (Sensitive ContactDetail)
a} :: GetDomainDetailResponse) 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

-- | Specifies whether contact information is concealed from WHOIS queries.
-- If the value is @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
-- the value is @false@, WHOIS queries return the information that you
-- entered for the admin contact.
getDomainDetailResponse_adminPrivacy :: Lens.Lens' GetDomainDetailResponse (Prelude.Maybe Prelude.Bool)
getDomainDetailResponse_adminPrivacy :: Lens' GetDomainDetailResponse (Maybe Bool)
getDomainDetailResponse_adminPrivacy = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetDomainDetailResponse' {Maybe Bool
adminPrivacy :: Maybe Bool
$sel:adminPrivacy:GetDomainDetailResponse' :: GetDomainDetailResponse -> Maybe Bool
adminPrivacy} -> Maybe Bool
adminPrivacy) (\s :: GetDomainDetailResponse
s@GetDomainDetailResponse' {} Maybe Bool
a -> GetDomainDetailResponse
s {$sel:adminPrivacy:GetDomainDetailResponse' :: Maybe Bool
adminPrivacy = Maybe Bool
a} :: GetDomainDetailResponse)

-- | Specifies whether the domain registration is set to renew automatically.
getDomainDetailResponse_autoRenew :: Lens.Lens' GetDomainDetailResponse (Prelude.Maybe Prelude.Bool)
getDomainDetailResponse_autoRenew :: Lens' GetDomainDetailResponse (Maybe Bool)
getDomainDetailResponse_autoRenew = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetDomainDetailResponse' {Maybe Bool
autoRenew :: Maybe Bool
$sel:autoRenew:GetDomainDetailResponse' :: GetDomainDetailResponse -> Maybe Bool
autoRenew} -> Maybe Bool
autoRenew) (\s :: GetDomainDetailResponse
s@GetDomainDetailResponse' {} Maybe Bool
a -> GetDomainDetailResponse
s {$sel:autoRenew:GetDomainDetailResponse' :: Maybe Bool
autoRenew = Maybe Bool
a} :: GetDomainDetailResponse)

-- | The date when the domain was created as found in the response to a WHOIS
-- query. The date and time is in Unix time format and Coordinated
-- Universal time (UTC).
getDomainDetailResponse_creationDate :: Lens.Lens' GetDomainDetailResponse (Prelude.Maybe Prelude.UTCTime)
getDomainDetailResponse_creationDate :: Lens' GetDomainDetailResponse (Maybe UTCTime)
getDomainDetailResponse_creationDate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetDomainDetailResponse' {Maybe POSIX
creationDate :: Maybe POSIX
$sel:creationDate:GetDomainDetailResponse' :: GetDomainDetailResponse -> Maybe POSIX
creationDate} -> Maybe POSIX
creationDate) (\s :: GetDomainDetailResponse
s@GetDomainDetailResponse' {} Maybe POSIX
a -> GetDomainDetailResponse
s {$sel:creationDate:GetDomainDetailResponse' :: Maybe POSIX
creationDate = Maybe POSIX
a} :: GetDomainDetailResponse) 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 :: Format). Iso' (Time a) UTCTime
Data._Time

-- | Deprecated.
getDomainDetailResponse_dnsSec :: Lens.Lens' GetDomainDetailResponse (Prelude.Maybe Prelude.Text)
getDomainDetailResponse_dnsSec :: Lens' GetDomainDetailResponse (Maybe Text)
getDomainDetailResponse_dnsSec = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetDomainDetailResponse' {Maybe Text
dnsSec :: Maybe Text
$sel:dnsSec:GetDomainDetailResponse' :: GetDomainDetailResponse -> Maybe Text
dnsSec} -> Maybe Text
dnsSec) (\s :: GetDomainDetailResponse
s@GetDomainDetailResponse' {} Maybe Text
a -> GetDomainDetailResponse
s {$sel:dnsSec:GetDomainDetailResponse' :: Maybe Text
dnsSec = Maybe Text
a} :: GetDomainDetailResponse)

-- | A complex type that contains information about the DNSSEC configuration.
getDomainDetailResponse_dnssecKeys :: Lens.Lens' GetDomainDetailResponse (Prelude.Maybe [DnssecKey])
getDomainDetailResponse_dnssecKeys :: Lens' GetDomainDetailResponse (Maybe [DnssecKey])
getDomainDetailResponse_dnssecKeys = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetDomainDetailResponse' {Maybe [DnssecKey]
dnssecKeys :: Maybe [DnssecKey]
$sel:dnssecKeys:GetDomainDetailResponse' :: GetDomainDetailResponse -> Maybe [DnssecKey]
dnssecKeys} -> Maybe [DnssecKey]
dnssecKeys) (\s :: GetDomainDetailResponse
s@GetDomainDetailResponse' {} Maybe [DnssecKey]
a -> GetDomainDetailResponse
s {$sel:dnssecKeys:GetDomainDetailResponse' :: Maybe [DnssecKey]
dnssecKeys = Maybe [DnssecKey]
a} :: GetDomainDetailResponse) 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

-- | The name of a domain.
getDomainDetailResponse_domainName :: Lens.Lens' GetDomainDetailResponse (Prelude.Maybe Prelude.Text)
getDomainDetailResponse_domainName :: Lens' GetDomainDetailResponse (Maybe Text)
getDomainDetailResponse_domainName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetDomainDetailResponse' {Maybe Text
domainName :: Maybe Text
$sel:domainName:GetDomainDetailResponse' :: GetDomainDetailResponse -> Maybe Text
domainName} -> Maybe Text
domainName) (\s :: GetDomainDetailResponse
s@GetDomainDetailResponse' {} Maybe Text
a -> GetDomainDetailResponse
s {$sel:domainName:GetDomainDetailResponse' :: Maybe Text
domainName = Maybe Text
a} :: GetDomainDetailResponse)

-- | The date when the registration for the domain is set to expire. The date
-- and time is in Unix time format and Coordinated Universal time (UTC).
getDomainDetailResponse_expirationDate :: Lens.Lens' GetDomainDetailResponse (Prelude.Maybe Prelude.UTCTime)
getDomainDetailResponse_expirationDate :: Lens' GetDomainDetailResponse (Maybe UTCTime)
getDomainDetailResponse_expirationDate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetDomainDetailResponse' {Maybe POSIX
expirationDate :: Maybe POSIX
$sel:expirationDate:GetDomainDetailResponse' :: GetDomainDetailResponse -> Maybe POSIX
expirationDate} -> Maybe POSIX
expirationDate) (\s :: GetDomainDetailResponse
s@GetDomainDetailResponse' {} Maybe POSIX
a -> GetDomainDetailResponse
s {$sel:expirationDate:GetDomainDetailResponse' :: Maybe POSIX
expirationDate = Maybe POSIX
a} :: GetDomainDetailResponse) 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 :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The name servers of the domain.
getDomainDetailResponse_nameservers :: Lens.Lens' GetDomainDetailResponse (Prelude.Maybe [Nameserver])
getDomainDetailResponse_nameservers :: Lens' GetDomainDetailResponse (Maybe [Nameserver])
getDomainDetailResponse_nameservers = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetDomainDetailResponse' {Maybe [Nameserver]
nameservers :: Maybe [Nameserver]
$sel:nameservers:GetDomainDetailResponse' :: GetDomainDetailResponse -> Maybe [Nameserver]
nameservers} -> Maybe [Nameserver]
nameservers) (\s :: GetDomainDetailResponse
s@GetDomainDetailResponse' {} Maybe [Nameserver]
a -> GetDomainDetailResponse
s {$sel:nameservers:GetDomainDetailResponse' :: Maybe [Nameserver]
nameservers = Maybe [Nameserver]
a} :: GetDomainDetailResponse) 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

-- | Provides details about the domain registrant.
getDomainDetailResponse_registrantContact :: Lens.Lens' GetDomainDetailResponse (Prelude.Maybe ContactDetail)
getDomainDetailResponse_registrantContact :: Lens' GetDomainDetailResponse (Maybe ContactDetail)
getDomainDetailResponse_registrantContact = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetDomainDetailResponse' {Maybe (Sensitive ContactDetail)
registrantContact :: Maybe (Sensitive ContactDetail)
$sel:registrantContact:GetDomainDetailResponse' :: GetDomainDetailResponse -> Maybe (Sensitive ContactDetail)
registrantContact} -> Maybe (Sensitive ContactDetail)
registrantContact) (\s :: GetDomainDetailResponse
s@GetDomainDetailResponse' {} Maybe (Sensitive ContactDetail)
a -> GetDomainDetailResponse
s {$sel:registrantContact:GetDomainDetailResponse' :: Maybe (Sensitive ContactDetail)
registrantContact = Maybe (Sensitive ContactDetail)
a} :: GetDomainDetailResponse) 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

-- | Specifies whether contact information is concealed from WHOIS queries.
-- If the value is @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
-- the value is @false@, WHOIS queries return the information that you
-- entered for the registrant contact (domain owner).
getDomainDetailResponse_registrantPrivacy :: Lens.Lens' GetDomainDetailResponse (Prelude.Maybe Prelude.Bool)
getDomainDetailResponse_registrantPrivacy :: Lens' GetDomainDetailResponse (Maybe Bool)
getDomainDetailResponse_registrantPrivacy = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetDomainDetailResponse' {Maybe Bool
registrantPrivacy :: Maybe Bool
$sel:registrantPrivacy:GetDomainDetailResponse' :: GetDomainDetailResponse -> Maybe Bool
registrantPrivacy} -> Maybe Bool
registrantPrivacy) (\s :: GetDomainDetailResponse
s@GetDomainDetailResponse' {} Maybe Bool
a -> GetDomainDetailResponse
s {$sel:registrantPrivacy:GetDomainDetailResponse' :: Maybe Bool
registrantPrivacy = Maybe Bool
a} :: GetDomainDetailResponse)

-- | Name of the registrar of the domain as identified in the registry.
-- Domains with a .com, .net, or .org TLD are registered by Amazon
-- Registrar. All other domains are registered by our registrar associate,
-- Gandi. The value for domains that are registered by Gandi is
-- @\"GANDI SAS\"@.
getDomainDetailResponse_registrarName :: Lens.Lens' GetDomainDetailResponse (Prelude.Maybe Prelude.Text)
getDomainDetailResponse_registrarName :: Lens' GetDomainDetailResponse (Maybe Text)
getDomainDetailResponse_registrarName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetDomainDetailResponse' {Maybe Text
registrarName :: Maybe Text
$sel:registrarName:GetDomainDetailResponse' :: GetDomainDetailResponse -> Maybe Text
registrarName} -> Maybe Text
registrarName) (\s :: GetDomainDetailResponse
s@GetDomainDetailResponse' {} Maybe Text
a -> GetDomainDetailResponse
s {$sel:registrarName:GetDomainDetailResponse' :: Maybe Text
registrarName = Maybe Text
a} :: GetDomainDetailResponse)

-- | Web address of the registrar.
getDomainDetailResponse_registrarUrl :: Lens.Lens' GetDomainDetailResponse (Prelude.Maybe Prelude.Text)
getDomainDetailResponse_registrarUrl :: Lens' GetDomainDetailResponse (Maybe Text)
getDomainDetailResponse_registrarUrl = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetDomainDetailResponse' {Maybe Text
registrarUrl :: Maybe Text
$sel:registrarUrl:GetDomainDetailResponse' :: GetDomainDetailResponse -> Maybe Text
registrarUrl} -> Maybe Text
registrarUrl) (\s :: GetDomainDetailResponse
s@GetDomainDetailResponse' {} Maybe Text
a -> GetDomainDetailResponse
s {$sel:registrarUrl:GetDomainDetailResponse' :: Maybe Text
registrarUrl = Maybe Text
a} :: GetDomainDetailResponse)

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

-- | Reseller of the domain. Domains registered or transferred using Route 53
-- domains will have @\"Amazon\"@ as the reseller.
getDomainDetailResponse_reseller :: Lens.Lens' GetDomainDetailResponse (Prelude.Maybe Prelude.Text)
getDomainDetailResponse_reseller :: Lens' GetDomainDetailResponse (Maybe Text)
getDomainDetailResponse_reseller = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetDomainDetailResponse' {Maybe Text
reseller :: Maybe Text
$sel:reseller:GetDomainDetailResponse' :: GetDomainDetailResponse -> Maybe Text
reseller} -> Maybe Text
reseller) (\s :: GetDomainDetailResponse
s@GetDomainDetailResponse' {} Maybe Text
a -> GetDomainDetailResponse
s {$sel:reseller:GetDomainDetailResponse' :: Maybe Text
reseller = Maybe Text
a} :: GetDomainDetailResponse)

-- | An array of domain name status codes, also known as Extensible
-- Provisioning Protocol (EPP) status codes.
--
-- ICANN, the organization that maintains a central database of domain
-- names, has developed a set of domain name status codes that tell you the
-- status of a variety of operations on a domain name, for example,
-- registering a domain name, transferring a domain name to another
-- registrar, renewing the registration for a domain name, and so on. All
-- registrars use this same set of status codes.
--
-- For a current list of domain name status codes and an explanation of
-- what each code means, go to the <https://www.icann.org/ ICANN website>
-- and search for @epp status codes@. (Search on the ICANN website; web
-- searches sometimes return an old version of the document.)
getDomainDetailResponse_statusList :: Lens.Lens' GetDomainDetailResponse (Prelude.Maybe [Prelude.Text])
getDomainDetailResponse_statusList :: Lens' GetDomainDetailResponse (Maybe [Text])
getDomainDetailResponse_statusList = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetDomainDetailResponse' {Maybe [Text]
statusList :: Maybe [Text]
$sel:statusList:GetDomainDetailResponse' :: GetDomainDetailResponse -> Maybe [Text]
statusList} -> Maybe [Text]
statusList) (\s :: GetDomainDetailResponse
s@GetDomainDetailResponse' {} Maybe [Text]
a -> GetDomainDetailResponse
s {$sel:statusList:GetDomainDetailResponse' :: Maybe [Text]
statusList = Maybe [Text]
a} :: GetDomainDetailResponse) 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

-- | Provides details about the domain technical contact.
getDomainDetailResponse_techContact :: Lens.Lens' GetDomainDetailResponse (Prelude.Maybe ContactDetail)
getDomainDetailResponse_techContact :: Lens' GetDomainDetailResponse (Maybe ContactDetail)
getDomainDetailResponse_techContact = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetDomainDetailResponse' {Maybe (Sensitive ContactDetail)
techContact :: Maybe (Sensitive ContactDetail)
$sel:techContact:GetDomainDetailResponse' :: GetDomainDetailResponse -> Maybe (Sensitive ContactDetail)
techContact} -> Maybe (Sensitive ContactDetail)
techContact) (\s :: GetDomainDetailResponse
s@GetDomainDetailResponse' {} Maybe (Sensitive ContactDetail)
a -> GetDomainDetailResponse
s {$sel:techContact:GetDomainDetailResponse' :: Maybe (Sensitive ContactDetail)
techContact = Maybe (Sensitive ContactDetail)
a} :: GetDomainDetailResponse) 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

-- | Specifies whether contact information is concealed from WHOIS queries.
-- If the value is @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
-- the value is @false@, WHOIS queries return the information that you
-- entered for the technical contact.
getDomainDetailResponse_techPrivacy :: Lens.Lens' GetDomainDetailResponse (Prelude.Maybe Prelude.Bool)
getDomainDetailResponse_techPrivacy :: Lens' GetDomainDetailResponse (Maybe Bool)
getDomainDetailResponse_techPrivacy = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetDomainDetailResponse' {Maybe Bool
techPrivacy :: Maybe Bool
$sel:techPrivacy:GetDomainDetailResponse' :: GetDomainDetailResponse -> Maybe Bool
techPrivacy} -> Maybe Bool
techPrivacy) (\s :: GetDomainDetailResponse
s@GetDomainDetailResponse' {} Maybe Bool
a -> GetDomainDetailResponse
s {$sel:techPrivacy:GetDomainDetailResponse' :: Maybe Bool
techPrivacy = Maybe Bool
a} :: GetDomainDetailResponse)

-- | The last updated date of the domain as found in the response to a WHOIS
-- query. The date and time is in Unix time format and Coordinated
-- Universal time (UTC).
getDomainDetailResponse_updatedDate :: Lens.Lens' GetDomainDetailResponse (Prelude.Maybe Prelude.UTCTime)
getDomainDetailResponse_updatedDate :: Lens' GetDomainDetailResponse (Maybe UTCTime)
getDomainDetailResponse_updatedDate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetDomainDetailResponse' {Maybe POSIX
updatedDate :: Maybe POSIX
$sel:updatedDate:GetDomainDetailResponse' :: GetDomainDetailResponse -> Maybe POSIX
updatedDate} -> Maybe POSIX
updatedDate) (\s :: GetDomainDetailResponse
s@GetDomainDetailResponse' {} Maybe POSIX
a -> GetDomainDetailResponse
s {$sel:updatedDate:GetDomainDetailResponse' :: Maybe POSIX
updatedDate = Maybe POSIX
a} :: GetDomainDetailResponse) 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 :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The fully qualified name of the WHOIS server that can answer the WHOIS
-- query for the domain.
getDomainDetailResponse_whoIsServer :: Lens.Lens' GetDomainDetailResponse (Prelude.Maybe Prelude.Text)
getDomainDetailResponse_whoIsServer :: Lens' GetDomainDetailResponse (Maybe Text)
getDomainDetailResponse_whoIsServer = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetDomainDetailResponse' {Maybe Text
whoIsServer :: Maybe Text
$sel:whoIsServer:GetDomainDetailResponse' :: GetDomainDetailResponse -> Maybe Text
whoIsServer} -> Maybe Text
whoIsServer) (\s :: GetDomainDetailResponse
s@GetDomainDetailResponse' {} Maybe Text
a -> GetDomainDetailResponse
s {$sel:whoIsServer:GetDomainDetailResponse' :: Maybe Text
whoIsServer = Maybe Text
a} :: GetDomainDetailResponse)

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

instance Prelude.NFData GetDomainDetailResponse where
  rnf :: GetDomainDetailResponse -> ()
rnf GetDomainDetailResponse' {Int
Maybe Bool
Maybe [Text]
Maybe [DnssecKey]
Maybe [Nameserver]
Maybe Text
Maybe (Sensitive ContactDetail)
Maybe POSIX
httpStatus :: Int
whoIsServer :: Maybe Text
updatedDate :: Maybe POSIX
techPrivacy :: Maybe Bool
techContact :: Maybe (Sensitive ContactDetail)
statusList :: Maybe [Text]
reseller :: Maybe Text
registryDomainId :: Maybe Text
registrarUrl :: Maybe Text
registrarName :: Maybe Text
registrantPrivacy :: Maybe Bool
registrantContact :: Maybe (Sensitive ContactDetail)
nameservers :: Maybe [Nameserver]
expirationDate :: Maybe POSIX
domainName :: Maybe Text
dnssecKeys :: Maybe [DnssecKey]
dnsSec :: Maybe Text
creationDate :: Maybe POSIX
autoRenew :: Maybe Bool
adminPrivacy :: Maybe Bool
adminContact :: Maybe (Sensitive ContactDetail)
abuseContactPhone :: Maybe Text
abuseContactEmail :: Maybe Text
$sel:httpStatus:GetDomainDetailResponse' :: GetDomainDetailResponse -> Int
$sel:whoIsServer:GetDomainDetailResponse' :: GetDomainDetailResponse -> Maybe Text
$sel:updatedDate:GetDomainDetailResponse' :: GetDomainDetailResponse -> Maybe POSIX
$sel:techPrivacy:GetDomainDetailResponse' :: GetDomainDetailResponse -> Maybe Bool
$sel:techContact:GetDomainDetailResponse' :: GetDomainDetailResponse -> Maybe (Sensitive ContactDetail)
$sel:statusList:GetDomainDetailResponse' :: GetDomainDetailResponse -> Maybe [Text]
$sel:reseller:GetDomainDetailResponse' :: GetDomainDetailResponse -> Maybe Text
$sel:registryDomainId:GetDomainDetailResponse' :: GetDomainDetailResponse -> Maybe Text
$sel:registrarUrl:GetDomainDetailResponse' :: GetDomainDetailResponse -> Maybe Text
$sel:registrarName:GetDomainDetailResponse' :: GetDomainDetailResponse -> Maybe Text
$sel:registrantPrivacy:GetDomainDetailResponse' :: GetDomainDetailResponse -> Maybe Bool
$sel:registrantContact:GetDomainDetailResponse' :: GetDomainDetailResponse -> Maybe (Sensitive ContactDetail)
$sel:nameservers:GetDomainDetailResponse' :: GetDomainDetailResponse -> Maybe [Nameserver]
$sel:expirationDate:GetDomainDetailResponse' :: GetDomainDetailResponse -> Maybe POSIX
$sel:domainName:GetDomainDetailResponse' :: GetDomainDetailResponse -> Maybe Text
$sel:dnssecKeys:GetDomainDetailResponse' :: GetDomainDetailResponse -> Maybe [DnssecKey]
$sel:dnsSec:GetDomainDetailResponse' :: GetDomainDetailResponse -> Maybe Text
$sel:creationDate:GetDomainDetailResponse' :: GetDomainDetailResponse -> Maybe POSIX
$sel:autoRenew:GetDomainDetailResponse' :: GetDomainDetailResponse -> Maybe Bool
$sel:adminPrivacy:GetDomainDetailResponse' :: GetDomainDetailResponse -> Maybe Bool
$sel:adminContact:GetDomainDetailResponse' :: GetDomainDetailResponse -> Maybe (Sensitive ContactDetail)
$sel:abuseContactPhone:GetDomainDetailResponse' :: GetDomainDetailResponse -> Maybe Text
$sel:abuseContactEmail:GetDomainDetailResponse' :: GetDomainDetailResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
abuseContactEmail
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
abuseContactPhone
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (Sensitive ContactDetail)
adminContact
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
adminPrivacy
      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 POSIX
creationDate
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
dnsSec
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [DnssecKey]
dnssecKeys
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
domainName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
expirationDate
      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 (Sensitive ContactDetail)
registrantContact
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
registrantPrivacy
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
registrarName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
registrarUrl
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
registryDomainId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
reseller
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
statusList
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (Sensitive ContactDetail)
techContact
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
techPrivacy
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
updatedDate
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
whoIsServer
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus