{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -fno-warn-unused-binds #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
{-# OPTIONS_GHC -fno-warn-unused-matches #-}

-- Derived from AWS service descriptions, licensed under Apache 2.0.

-- |
-- Module      : Amazonka.Route53.TestDNSAnswer
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Gets the value that Amazon Route 53 returns in response to a DNS request
-- for a specified record name and type. You can optionally specify the IP
-- address of a DNS resolver, an EDNS0 client subnet IP address, and a
-- subnet mask.
--
-- This call only supports querying public hosted zones.
module Amazonka.Route53.TestDNSAnswer
  ( -- * Creating a Request
    TestDNSAnswer (..),
    newTestDNSAnswer,

    -- * Request Lenses
    testDNSAnswer_eDNS0ClientSubnetIP,
    testDNSAnswer_eDNS0ClientSubnetMask,
    testDNSAnswer_resolverIP,
    testDNSAnswer_hostedZoneId,
    testDNSAnswer_recordName,
    testDNSAnswer_recordType,

    -- * Destructuring the Response
    TestDNSAnswerResponse (..),
    newTestDNSAnswerResponse,

    -- * Response Lenses
    testDNSAnswerResponse_httpStatus,
    testDNSAnswerResponse_nameserver,
    testDNSAnswerResponse_recordName,
    testDNSAnswerResponse_recordType,
    testDNSAnswerResponse_recordData,
    testDNSAnswerResponse_responseCode,
    testDNSAnswerResponse_protocol,
  )
where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response
import Amazonka.Route53.Types

-- | Gets the value that Amazon Route 53 returns in response to a DNS request
-- for a specified record name and type. You can optionally specify the IP
-- address of a DNS resolver, an EDNS0 client subnet IP address, and a
-- subnet mask.
--
-- /See:/ 'newTestDNSAnswer' smart constructor.
data TestDNSAnswer = TestDNSAnswer'
  { -- | If the resolver that you specified for resolverip supports EDNS0,
    -- specify the IPv4 or IPv6 address of a client in the applicable location,
    -- for example, @192.0.2.44@ or @2001:db8:85a3::8a2e:370:7334@.
    TestDNSAnswer -> Maybe Text
eDNS0ClientSubnetIP :: Prelude.Maybe Prelude.Text,
    -- | If you specify an IP address for @edns0clientsubnetip@, you can
    -- optionally specify the number of bits of the IP address that you want
    -- the checking tool to include in the DNS query. For example, if you
    -- specify @192.0.2.44@ for @edns0clientsubnetip@ and @24@ for
    -- @edns0clientsubnetmask@, the checking tool will simulate a request from
    -- 192.0.2.0\/24. The default value is 24 bits for IPv4 addresses and 64
    -- bits for IPv6 addresses.
    --
    -- The range of valid values depends on whether @edns0clientsubnetip@ is an
    -- IPv4 or an IPv6 address:
    --
    -- -   __IPv4__: Specify a value between 0 and 32
    --
    -- -   __IPv6__: Specify a value between 0 and 128
    TestDNSAnswer -> Maybe Text
eDNS0ClientSubnetMask :: Prelude.Maybe Prelude.Text,
    -- | If you want to simulate a request from a specific DNS resolver, specify
    -- the IP address for that resolver. If you omit this value,
    -- @TestDnsAnswer@ uses the IP address of a DNS resolver in the Amazon Web
    -- Services US East (N. Virginia) Region (@us-east-1@).
    TestDNSAnswer -> Maybe Text
resolverIP :: Prelude.Maybe Prelude.Text,
    -- | The ID of the hosted zone that you want Amazon Route 53 to simulate a
    -- query for.
    TestDNSAnswer -> ResourceId
hostedZoneId :: ResourceId,
    -- | The name of the resource record set that you want Amazon Route 53 to
    -- simulate a query for.
    TestDNSAnswer -> Text
recordName :: Prelude.Text,
    -- | The type of the resource record set.
    TestDNSAnswer -> RRType
recordType :: RRType
  }
  deriving (TestDNSAnswer -> TestDNSAnswer -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TestDNSAnswer -> TestDNSAnswer -> Bool
$c/= :: TestDNSAnswer -> TestDNSAnswer -> Bool
== :: TestDNSAnswer -> TestDNSAnswer -> Bool
$c== :: TestDNSAnswer -> TestDNSAnswer -> Bool
Prelude.Eq, ReadPrec [TestDNSAnswer]
ReadPrec TestDNSAnswer
Int -> ReadS TestDNSAnswer
ReadS [TestDNSAnswer]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [TestDNSAnswer]
$creadListPrec :: ReadPrec [TestDNSAnswer]
readPrec :: ReadPrec TestDNSAnswer
$creadPrec :: ReadPrec TestDNSAnswer
readList :: ReadS [TestDNSAnswer]
$creadList :: ReadS [TestDNSAnswer]
readsPrec :: Int -> ReadS TestDNSAnswer
$creadsPrec :: Int -> ReadS TestDNSAnswer
Prelude.Read, Int -> TestDNSAnswer -> ShowS
[TestDNSAnswer] -> ShowS
TestDNSAnswer -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TestDNSAnswer] -> ShowS
$cshowList :: [TestDNSAnswer] -> ShowS
show :: TestDNSAnswer -> String
$cshow :: TestDNSAnswer -> String
showsPrec :: Int -> TestDNSAnswer -> ShowS
$cshowsPrec :: Int -> TestDNSAnswer -> ShowS
Prelude.Show, forall x. Rep TestDNSAnswer x -> TestDNSAnswer
forall x. TestDNSAnswer -> Rep TestDNSAnswer x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TestDNSAnswer x -> TestDNSAnswer
$cfrom :: forall x. TestDNSAnswer -> Rep TestDNSAnswer x
Prelude.Generic)

-- |
-- Create a value of 'TestDNSAnswer' 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:
--
-- 'eDNS0ClientSubnetIP', 'testDNSAnswer_eDNS0ClientSubnetIP' - If the resolver that you specified for resolverip supports EDNS0,
-- specify the IPv4 or IPv6 address of a client in the applicable location,
-- for example, @192.0.2.44@ or @2001:db8:85a3::8a2e:370:7334@.
--
-- 'eDNS0ClientSubnetMask', 'testDNSAnswer_eDNS0ClientSubnetMask' - If you specify an IP address for @edns0clientsubnetip@, you can
-- optionally specify the number of bits of the IP address that you want
-- the checking tool to include in the DNS query. For example, if you
-- specify @192.0.2.44@ for @edns0clientsubnetip@ and @24@ for
-- @edns0clientsubnetmask@, the checking tool will simulate a request from
-- 192.0.2.0\/24. The default value is 24 bits for IPv4 addresses and 64
-- bits for IPv6 addresses.
--
-- The range of valid values depends on whether @edns0clientsubnetip@ is an
-- IPv4 or an IPv6 address:
--
-- -   __IPv4__: Specify a value between 0 and 32
--
-- -   __IPv6__: Specify a value between 0 and 128
--
-- 'resolverIP', 'testDNSAnswer_resolverIP' - If you want to simulate a request from a specific DNS resolver, specify
-- the IP address for that resolver. If you omit this value,
-- @TestDnsAnswer@ uses the IP address of a DNS resolver in the Amazon Web
-- Services US East (N. Virginia) Region (@us-east-1@).
--
-- 'hostedZoneId', 'testDNSAnswer_hostedZoneId' - The ID of the hosted zone that you want Amazon Route 53 to simulate a
-- query for.
--
-- 'recordName', 'testDNSAnswer_recordName' - The name of the resource record set that you want Amazon Route 53 to
-- simulate a query for.
--
-- 'recordType', 'testDNSAnswer_recordType' - The type of the resource record set.
newTestDNSAnswer ::
  -- | 'hostedZoneId'
  ResourceId ->
  -- | 'recordName'
  Prelude.Text ->
  -- | 'recordType'
  RRType ->
  TestDNSAnswer
newTestDNSAnswer :: ResourceId -> Text -> RRType -> TestDNSAnswer
newTestDNSAnswer
  ResourceId
pHostedZoneId_
  Text
pRecordName_
  RRType
pRecordType_ =
    TestDNSAnswer'
      { $sel:eDNS0ClientSubnetIP:TestDNSAnswer' :: Maybe Text
eDNS0ClientSubnetIP =
          forall a. Maybe a
Prelude.Nothing,
        $sel:eDNS0ClientSubnetMask:TestDNSAnswer' :: Maybe Text
eDNS0ClientSubnetMask = forall a. Maybe a
Prelude.Nothing,
        $sel:resolverIP:TestDNSAnswer' :: Maybe Text
resolverIP = forall a. Maybe a
Prelude.Nothing,
        $sel:hostedZoneId:TestDNSAnswer' :: ResourceId
hostedZoneId = ResourceId
pHostedZoneId_,
        $sel:recordName:TestDNSAnswer' :: Text
recordName = Text
pRecordName_,
        $sel:recordType:TestDNSAnswer' :: RRType
recordType = RRType
pRecordType_
      }

-- | If the resolver that you specified for resolverip supports EDNS0,
-- specify the IPv4 or IPv6 address of a client in the applicable location,
-- for example, @192.0.2.44@ or @2001:db8:85a3::8a2e:370:7334@.
testDNSAnswer_eDNS0ClientSubnetIP :: Lens.Lens' TestDNSAnswer (Prelude.Maybe Prelude.Text)
testDNSAnswer_eDNS0ClientSubnetIP :: Lens' TestDNSAnswer (Maybe Text)
testDNSAnswer_eDNS0ClientSubnetIP = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TestDNSAnswer' {Maybe Text
eDNS0ClientSubnetIP :: Maybe Text
$sel:eDNS0ClientSubnetIP:TestDNSAnswer' :: TestDNSAnswer -> Maybe Text
eDNS0ClientSubnetIP} -> Maybe Text
eDNS0ClientSubnetIP) (\s :: TestDNSAnswer
s@TestDNSAnswer' {} Maybe Text
a -> TestDNSAnswer
s {$sel:eDNS0ClientSubnetIP:TestDNSAnswer' :: Maybe Text
eDNS0ClientSubnetIP = Maybe Text
a} :: TestDNSAnswer)

-- | If you specify an IP address for @edns0clientsubnetip@, you can
-- optionally specify the number of bits of the IP address that you want
-- the checking tool to include in the DNS query. For example, if you
-- specify @192.0.2.44@ for @edns0clientsubnetip@ and @24@ for
-- @edns0clientsubnetmask@, the checking tool will simulate a request from
-- 192.0.2.0\/24. The default value is 24 bits for IPv4 addresses and 64
-- bits for IPv6 addresses.
--
-- The range of valid values depends on whether @edns0clientsubnetip@ is an
-- IPv4 or an IPv6 address:
--
-- -   __IPv4__: Specify a value between 0 and 32
--
-- -   __IPv6__: Specify a value between 0 and 128
testDNSAnswer_eDNS0ClientSubnetMask :: Lens.Lens' TestDNSAnswer (Prelude.Maybe Prelude.Text)
testDNSAnswer_eDNS0ClientSubnetMask :: Lens' TestDNSAnswer (Maybe Text)
testDNSAnswer_eDNS0ClientSubnetMask = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TestDNSAnswer' {Maybe Text
eDNS0ClientSubnetMask :: Maybe Text
$sel:eDNS0ClientSubnetMask:TestDNSAnswer' :: TestDNSAnswer -> Maybe Text
eDNS0ClientSubnetMask} -> Maybe Text
eDNS0ClientSubnetMask) (\s :: TestDNSAnswer
s@TestDNSAnswer' {} Maybe Text
a -> TestDNSAnswer
s {$sel:eDNS0ClientSubnetMask:TestDNSAnswer' :: Maybe Text
eDNS0ClientSubnetMask = Maybe Text
a} :: TestDNSAnswer)

-- | If you want to simulate a request from a specific DNS resolver, specify
-- the IP address for that resolver. If you omit this value,
-- @TestDnsAnswer@ uses the IP address of a DNS resolver in the Amazon Web
-- Services US East (N. Virginia) Region (@us-east-1@).
testDNSAnswer_resolverIP :: Lens.Lens' TestDNSAnswer (Prelude.Maybe Prelude.Text)
testDNSAnswer_resolverIP :: Lens' TestDNSAnswer (Maybe Text)
testDNSAnswer_resolverIP = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TestDNSAnswer' {Maybe Text
resolverIP :: Maybe Text
$sel:resolverIP:TestDNSAnswer' :: TestDNSAnswer -> Maybe Text
resolverIP} -> Maybe Text
resolverIP) (\s :: TestDNSAnswer
s@TestDNSAnswer' {} Maybe Text
a -> TestDNSAnswer
s {$sel:resolverIP:TestDNSAnswer' :: Maybe Text
resolverIP = Maybe Text
a} :: TestDNSAnswer)

-- | The ID of the hosted zone that you want Amazon Route 53 to simulate a
-- query for.
testDNSAnswer_hostedZoneId :: Lens.Lens' TestDNSAnswer ResourceId
testDNSAnswer_hostedZoneId :: Lens' TestDNSAnswer ResourceId
testDNSAnswer_hostedZoneId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TestDNSAnswer' {ResourceId
hostedZoneId :: ResourceId
$sel:hostedZoneId:TestDNSAnswer' :: TestDNSAnswer -> ResourceId
hostedZoneId} -> ResourceId
hostedZoneId) (\s :: TestDNSAnswer
s@TestDNSAnswer' {} ResourceId
a -> TestDNSAnswer
s {$sel:hostedZoneId:TestDNSAnswer' :: ResourceId
hostedZoneId = ResourceId
a} :: TestDNSAnswer)

-- | The name of the resource record set that you want Amazon Route 53 to
-- simulate a query for.
testDNSAnswer_recordName :: Lens.Lens' TestDNSAnswer Prelude.Text
testDNSAnswer_recordName :: Lens' TestDNSAnswer Text
testDNSAnswer_recordName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TestDNSAnswer' {Text
recordName :: Text
$sel:recordName:TestDNSAnswer' :: TestDNSAnswer -> Text
recordName} -> Text
recordName) (\s :: TestDNSAnswer
s@TestDNSAnswer' {} Text
a -> TestDNSAnswer
s {$sel:recordName:TestDNSAnswer' :: Text
recordName = Text
a} :: TestDNSAnswer)

-- | The type of the resource record set.
testDNSAnswer_recordType :: Lens.Lens' TestDNSAnswer RRType
testDNSAnswer_recordType :: Lens' TestDNSAnswer RRType
testDNSAnswer_recordType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TestDNSAnswer' {RRType
recordType :: RRType
$sel:recordType:TestDNSAnswer' :: TestDNSAnswer -> RRType
recordType} -> RRType
recordType) (\s :: TestDNSAnswer
s@TestDNSAnswer' {} RRType
a -> TestDNSAnswer
s {$sel:recordType:TestDNSAnswer' :: RRType
recordType = RRType
a} :: TestDNSAnswer)

instance Core.AWSRequest TestDNSAnswer where
  type
    AWSResponse TestDNSAnswer =
      TestDNSAnswerResponse
  request :: (Service -> Service) -> TestDNSAnswer -> Request TestDNSAnswer
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.get (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy TestDNSAnswer
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse TestDNSAnswer)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> [Node] -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveXML
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Int
-> Text
-> Text
-> RRType
-> [Text]
-> Text
-> Text
-> TestDNSAnswerResponse
TestDNSAnswerResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String a
Data..@ Text
"Nameserver")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String a
Data..@ Text
"RecordName")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String a
Data..@ Text
"RecordType")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ( [Node]
x
                            forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"RecordData"
                            forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty
                            forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
Prelude.>>= forall a. FromXML a => Text -> [Node] -> Either String [a]
Data.parseXMLList Text
"RecordDataEntry"
                        )
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String a
Data..@ Text
"ResponseCode")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String a
Data..@ Text
"Protocol")
      )

instance Prelude.Hashable TestDNSAnswer where
  hashWithSalt :: Int -> TestDNSAnswer -> Int
hashWithSalt Int
_salt TestDNSAnswer' {Maybe Text
Text
ResourceId
RRType
recordType :: RRType
recordName :: Text
hostedZoneId :: ResourceId
resolverIP :: Maybe Text
eDNS0ClientSubnetMask :: Maybe Text
eDNS0ClientSubnetIP :: Maybe Text
$sel:recordType:TestDNSAnswer' :: TestDNSAnswer -> RRType
$sel:recordName:TestDNSAnswer' :: TestDNSAnswer -> Text
$sel:hostedZoneId:TestDNSAnswer' :: TestDNSAnswer -> ResourceId
$sel:resolverIP:TestDNSAnswer' :: TestDNSAnswer -> Maybe Text
$sel:eDNS0ClientSubnetMask:TestDNSAnswer' :: TestDNSAnswer -> Maybe Text
$sel:eDNS0ClientSubnetIP:TestDNSAnswer' :: TestDNSAnswer -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
eDNS0ClientSubnetIP
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
eDNS0ClientSubnetMask
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
resolverIP
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` ResourceId
hostedZoneId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
recordName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` RRType
recordType

instance Prelude.NFData TestDNSAnswer where
  rnf :: TestDNSAnswer -> ()
rnf TestDNSAnswer' {Maybe Text
Text
ResourceId
RRType
recordType :: RRType
recordName :: Text
hostedZoneId :: ResourceId
resolverIP :: Maybe Text
eDNS0ClientSubnetMask :: Maybe Text
eDNS0ClientSubnetIP :: Maybe Text
$sel:recordType:TestDNSAnswer' :: TestDNSAnswer -> RRType
$sel:recordName:TestDNSAnswer' :: TestDNSAnswer -> Text
$sel:hostedZoneId:TestDNSAnswer' :: TestDNSAnswer -> ResourceId
$sel:resolverIP:TestDNSAnswer' :: TestDNSAnswer -> Maybe Text
$sel:eDNS0ClientSubnetMask:TestDNSAnswer' :: TestDNSAnswer -> Maybe Text
$sel:eDNS0ClientSubnetIP:TestDNSAnswer' :: TestDNSAnswer -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
eDNS0ClientSubnetIP
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
eDNS0ClientSubnetMask
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
resolverIP
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf ResourceId
hostedZoneId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
recordName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf RRType
recordType

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

instance Data.ToPath TestDNSAnswer where
  toPath :: TestDNSAnswer -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/2013-04-01/testdnsanswer"

instance Data.ToQuery TestDNSAnswer where
  toQuery :: TestDNSAnswer -> QueryString
toQuery TestDNSAnswer' {Maybe Text
Text
ResourceId
RRType
recordType :: RRType
recordName :: Text
hostedZoneId :: ResourceId
resolverIP :: Maybe Text
eDNS0ClientSubnetMask :: Maybe Text
eDNS0ClientSubnetIP :: Maybe Text
$sel:recordType:TestDNSAnswer' :: TestDNSAnswer -> RRType
$sel:recordName:TestDNSAnswer' :: TestDNSAnswer -> Text
$sel:hostedZoneId:TestDNSAnswer' :: TestDNSAnswer -> ResourceId
$sel:resolverIP:TestDNSAnswer' :: TestDNSAnswer -> Maybe Text
$sel:eDNS0ClientSubnetMask:TestDNSAnswer' :: TestDNSAnswer -> Maybe Text
$sel:eDNS0ClientSubnetIP:TestDNSAnswer' :: TestDNSAnswer -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"edns0clientsubnetip" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
eDNS0ClientSubnetIP,
        ByteString
"edns0clientsubnetmask"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
eDNS0ClientSubnetMask,
        ByteString
"resolverip" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
resolverIP,
        ByteString
"hostedzoneid" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: ResourceId
hostedZoneId,
        ByteString
"recordname" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
recordName,
        ByteString
"recordtype" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: RRType
recordType
      ]

-- | A complex type that contains the response to a @TestDNSAnswer@ request.
--
-- /See:/ 'newTestDNSAnswerResponse' smart constructor.
data TestDNSAnswerResponse = TestDNSAnswerResponse'
  { -- | The response's http status code.
    TestDNSAnswerResponse -> Int
httpStatus :: Prelude.Int,
    -- | The Amazon Route 53 name server used to respond to the request.
    TestDNSAnswerResponse -> Text
nameserver :: Prelude.Text,
    -- | The name of the resource record set that you submitted a request for.
    TestDNSAnswerResponse -> Text
recordName :: Prelude.Text,
    -- | The type of the resource record set that you submitted a request for.
    TestDNSAnswerResponse -> RRType
recordType :: RRType,
    -- | A list that contains values that Amazon Route 53 returned for this
    -- resource record set.
    TestDNSAnswerResponse -> [Text]
recordData :: [Prelude.Text],
    -- | A code that indicates whether the request is valid or not. The most
    -- common response code is @NOERROR@, meaning that the request is valid. If
    -- the response is not valid, Amazon Route 53 returns a response code that
    -- describes the error. For a list of possible response codes, see
    -- <http://www.iana.org/assignments/dns-parameters/dns-parameters.xhtml#dns-parameters-6 DNS RCODES>
    -- on the IANA website.
    TestDNSAnswerResponse -> Text
responseCode :: Prelude.Text,
    -- | The protocol that Amazon Route 53 used to respond to the request, either
    -- @UDP@ or @TCP@.
    TestDNSAnswerResponse -> Text
protocol :: Prelude.Text
  }
  deriving (TestDNSAnswerResponse -> TestDNSAnswerResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TestDNSAnswerResponse -> TestDNSAnswerResponse -> Bool
$c/= :: TestDNSAnswerResponse -> TestDNSAnswerResponse -> Bool
== :: TestDNSAnswerResponse -> TestDNSAnswerResponse -> Bool
$c== :: TestDNSAnswerResponse -> TestDNSAnswerResponse -> Bool
Prelude.Eq, ReadPrec [TestDNSAnswerResponse]
ReadPrec TestDNSAnswerResponse
Int -> ReadS TestDNSAnswerResponse
ReadS [TestDNSAnswerResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [TestDNSAnswerResponse]
$creadListPrec :: ReadPrec [TestDNSAnswerResponse]
readPrec :: ReadPrec TestDNSAnswerResponse
$creadPrec :: ReadPrec TestDNSAnswerResponse
readList :: ReadS [TestDNSAnswerResponse]
$creadList :: ReadS [TestDNSAnswerResponse]
readsPrec :: Int -> ReadS TestDNSAnswerResponse
$creadsPrec :: Int -> ReadS TestDNSAnswerResponse
Prelude.Read, Int -> TestDNSAnswerResponse -> ShowS
[TestDNSAnswerResponse] -> ShowS
TestDNSAnswerResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TestDNSAnswerResponse] -> ShowS
$cshowList :: [TestDNSAnswerResponse] -> ShowS
show :: TestDNSAnswerResponse -> String
$cshow :: TestDNSAnswerResponse -> String
showsPrec :: Int -> TestDNSAnswerResponse -> ShowS
$cshowsPrec :: Int -> TestDNSAnswerResponse -> ShowS
Prelude.Show, forall x. Rep TestDNSAnswerResponse x -> TestDNSAnswerResponse
forall x. TestDNSAnswerResponse -> Rep TestDNSAnswerResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TestDNSAnswerResponse x -> TestDNSAnswerResponse
$cfrom :: forall x. TestDNSAnswerResponse -> Rep TestDNSAnswerResponse x
Prelude.Generic)

-- |
-- Create a value of 'TestDNSAnswerResponse' with all optional fields omitted.
--
-- Use <https://hackage.haskell.org/package/generic-lens generic-lens> or <https://hackage.haskell.org/package/optics optics> to modify other optional fields.
--
-- The following record fields are available, with the corresponding lenses provided
-- for backwards compatibility:
--
-- 'httpStatus', 'testDNSAnswerResponse_httpStatus' - The response's http status code.
--
-- 'nameserver', 'testDNSAnswerResponse_nameserver' - The Amazon Route 53 name server used to respond to the request.
--
-- 'recordName', 'testDNSAnswerResponse_recordName' - The name of the resource record set that you submitted a request for.
--
-- 'recordType', 'testDNSAnswerResponse_recordType' - The type of the resource record set that you submitted a request for.
--
-- 'recordData', 'testDNSAnswerResponse_recordData' - A list that contains values that Amazon Route 53 returned for this
-- resource record set.
--
-- 'responseCode', 'testDNSAnswerResponse_responseCode' - A code that indicates whether the request is valid or not. The most
-- common response code is @NOERROR@, meaning that the request is valid. If
-- the response is not valid, Amazon Route 53 returns a response code that
-- describes the error. For a list of possible response codes, see
-- <http://www.iana.org/assignments/dns-parameters/dns-parameters.xhtml#dns-parameters-6 DNS RCODES>
-- on the IANA website.
--
-- 'protocol', 'testDNSAnswerResponse_protocol' - The protocol that Amazon Route 53 used to respond to the request, either
-- @UDP@ or @TCP@.
newTestDNSAnswerResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'nameserver'
  Prelude.Text ->
  -- | 'recordName'
  Prelude.Text ->
  -- | 'recordType'
  RRType ->
  -- | 'responseCode'
  Prelude.Text ->
  -- | 'protocol'
  Prelude.Text ->
  TestDNSAnswerResponse
newTestDNSAnswerResponse :: Int
-> Text -> Text -> RRType -> Text -> Text -> TestDNSAnswerResponse
newTestDNSAnswerResponse
  Int
pHttpStatus_
  Text
pNameserver_
  Text
pRecordName_
  RRType
pRecordType_
  Text
pResponseCode_
  Text
pProtocol_ =
    TestDNSAnswerResponse'
      { $sel:httpStatus:TestDNSAnswerResponse' :: Int
httpStatus = Int
pHttpStatus_,
        $sel:nameserver:TestDNSAnswerResponse' :: Text
nameserver = Text
pNameserver_,
        $sel:recordName:TestDNSAnswerResponse' :: Text
recordName = Text
pRecordName_,
        $sel:recordType:TestDNSAnswerResponse' :: RRType
recordType = RRType
pRecordType_,
        $sel:recordData:TestDNSAnswerResponse' :: [Text]
recordData = forall a. Monoid a => a
Prelude.mempty,
        $sel:responseCode:TestDNSAnswerResponse' :: Text
responseCode = Text
pResponseCode_,
        $sel:protocol:TestDNSAnswerResponse' :: Text
protocol = Text
pProtocol_
      }

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

-- | The Amazon Route 53 name server used to respond to the request.
testDNSAnswerResponse_nameserver :: Lens.Lens' TestDNSAnswerResponse Prelude.Text
testDNSAnswerResponse_nameserver :: Lens' TestDNSAnswerResponse Text
testDNSAnswerResponse_nameserver = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TestDNSAnswerResponse' {Text
nameserver :: Text
$sel:nameserver:TestDNSAnswerResponse' :: TestDNSAnswerResponse -> Text
nameserver} -> Text
nameserver) (\s :: TestDNSAnswerResponse
s@TestDNSAnswerResponse' {} Text
a -> TestDNSAnswerResponse
s {$sel:nameserver:TestDNSAnswerResponse' :: Text
nameserver = Text
a} :: TestDNSAnswerResponse)

-- | The name of the resource record set that you submitted a request for.
testDNSAnswerResponse_recordName :: Lens.Lens' TestDNSAnswerResponse Prelude.Text
testDNSAnswerResponse_recordName :: Lens' TestDNSAnswerResponse Text
testDNSAnswerResponse_recordName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TestDNSAnswerResponse' {Text
recordName :: Text
$sel:recordName:TestDNSAnswerResponse' :: TestDNSAnswerResponse -> Text
recordName} -> Text
recordName) (\s :: TestDNSAnswerResponse
s@TestDNSAnswerResponse' {} Text
a -> TestDNSAnswerResponse
s {$sel:recordName:TestDNSAnswerResponse' :: Text
recordName = Text
a} :: TestDNSAnswerResponse)

-- | The type of the resource record set that you submitted a request for.
testDNSAnswerResponse_recordType :: Lens.Lens' TestDNSAnswerResponse RRType
testDNSAnswerResponse_recordType :: Lens' TestDNSAnswerResponse RRType
testDNSAnswerResponse_recordType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TestDNSAnswerResponse' {RRType
recordType :: RRType
$sel:recordType:TestDNSAnswerResponse' :: TestDNSAnswerResponse -> RRType
recordType} -> RRType
recordType) (\s :: TestDNSAnswerResponse
s@TestDNSAnswerResponse' {} RRType
a -> TestDNSAnswerResponse
s {$sel:recordType:TestDNSAnswerResponse' :: RRType
recordType = RRType
a} :: TestDNSAnswerResponse)

-- | A list that contains values that Amazon Route 53 returned for this
-- resource record set.
testDNSAnswerResponse_recordData :: Lens.Lens' TestDNSAnswerResponse [Prelude.Text]
testDNSAnswerResponse_recordData :: Lens' TestDNSAnswerResponse [Text]
testDNSAnswerResponse_recordData = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TestDNSAnswerResponse' {[Text]
recordData :: [Text]
$sel:recordData:TestDNSAnswerResponse' :: TestDNSAnswerResponse -> [Text]
recordData} -> [Text]
recordData) (\s :: TestDNSAnswerResponse
s@TestDNSAnswerResponse' {} [Text]
a -> TestDNSAnswerResponse
s {$sel:recordData:TestDNSAnswerResponse' :: [Text]
recordData = [Text]
a} :: TestDNSAnswerResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | A code that indicates whether the request is valid or not. The most
-- common response code is @NOERROR@, meaning that the request is valid. If
-- the response is not valid, Amazon Route 53 returns a response code that
-- describes the error. For a list of possible response codes, see
-- <http://www.iana.org/assignments/dns-parameters/dns-parameters.xhtml#dns-parameters-6 DNS RCODES>
-- on the IANA website.
testDNSAnswerResponse_responseCode :: Lens.Lens' TestDNSAnswerResponse Prelude.Text
testDNSAnswerResponse_responseCode :: Lens' TestDNSAnswerResponse Text
testDNSAnswerResponse_responseCode = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TestDNSAnswerResponse' {Text
responseCode :: Text
$sel:responseCode:TestDNSAnswerResponse' :: TestDNSAnswerResponse -> Text
responseCode} -> Text
responseCode) (\s :: TestDNSAnswerResponse
s@TestDNSAnswerResponse' {} Text
a -> TestDNSAnswerResponse
s {$sel:responseCode:TestDNSAnswerResponse' :: Text
responseCode = Text
a} :: TestDNSAnswerResponse)

-- | The protocol that Amazon Route 53 used to respond to the request, either
-- @UDP@ or @TCP@.
testDNSAnswerResponse_protocol :: Lens.Lens' TestDNSAnswerResponse Prelude.Text
testDNSAnswerResponse_protocol :: Lens' TestDNSAnswerResponse Text
testDNSAnswerResponse_protocol = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TestDNSAnswerResponse' {Text
protocol :: Text
$sel:protocol:TestDNSAnswerResponse' :: TestDNSAnswerResponse -> Text
protocol} -> Text
protocol) (\s :: TestDNSAnswerResponse
s@TestDNSAnswerResponse' {} Text
a -> TestDNSAnswerResponse
s {$sel:protocol:TestDNSAnswerResponse' :: Text
protocol = Text
a} :: TestDNSAnswerResponse)

instance Prelude.NFData TestDNSAnswerResponse where
  rnf :: TestDNSAnswerResponse -> ()
rnf TestDNSAnswerResponse' {Int
[Text]
Text
RRType
protocol :: Text
responseCode :: Text
recordData :: [Text]
recordType :: RRType
recordName :: Text
nameserver :: Text
httpStatus :: Int
$sel:protocol:TestDNSAnswerResponse' :: TestDNSAnswerResponse -> Text
$sel:responseCode:TestDNSAnswerResponse' :: TestDNSAnswerResponse -> Text
$sel:recordData:TestDNSAnswerResponse' :: TestDNSAnswerResponse -> [Text]
$sel:recordType:TestDNSAnswerResponse' :: TestDNSAnswerResponse -> RRType
$sel:recordName:TestDNSAnswerResponse' :: TestDNSAnswerResponse -> Text
$sel:nameserver:TestDNSAnswerResponse' :: TestDNSAnswerResponse -> Text
$sel:httpStatus:TestDNSAnswerResponse' :: TestDNSAnswerResponse -> Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
nameserver
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
recordName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf RRType
recordType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf [Text]
recordData
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
responseCode
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
protocol