Safe Haskell | Safe-Inferred |
---|---|
Language | Haskell2010 |
Data types for DNS Query and Response. For more information, see http://www.ietf.org/rfc/rfc1035.
Synopsis
- data ResourceRecord = ResourceRecord {}
- type Answers = [ResourceRecord]
- type AuthorityRecords = [ResourceRecord]
- type AdditionalRecords = [ResourceRecord]
- type Domain = ByteString
- type CLASS = Word16
- classIN :: CLASS
- type TTL = Word32
- data TYPE where
- pattern A :: TYPE
- pattern NS :: TYPE
- pattern CNAME :: TYPE
- pattern SOA :: TYPE
- pattern NULL :: TYPE
- pattern PTR :: TYPE
- pattern MX :: TYPE
- pattern TXT :: TYPE
- pattern AAAA :: TYPE
- pattern SRV :: TYPE
- pattern DNAME :: TYPE
- pattern OPT :: TYPE
- pattern DS :: TYPE
- pattern RRSIG :: TYPE
- pattern NSEC :: TYPE
- pattern DNSKEY :: TYPE
- pattern NSEC3 :: TYPE
- pattern NSEC3PARAM :: TYPE
- pattern TLSA :: TYPE
- pattern CDS :: TYPE
- pattern CDNSKEY :: TYPE
- pattern CSYNC :: TYPE
- pattern AXFR :: TYPE
- pattern ANY :: TYPE
- pattern CAA :: TYPE
- fromTYPE :: TYPE -> Word16
- toTYPE :: Word16 -> TYPE
- data RData
- = RD_A IPv4
- | RD_NS Domain
- | RD_CNAME Domain
- | RD_SOA Domain Mailbox Word32 Word32 Word32 Word32 Word32
- | RD_NULL ByteString
- | RD_PTR Domain
- | RD_MX Word16 Domain
- | RD_TXT ByteString
- | RD_RP Mailbox Domain
- | RD_AAAA IPv6
- | RD_SRV Word16 Word16 Word16 Domain
- | RD_DNAME Domain
- | RD_OPT [OData]
- | RD_DS Word16 Word8 Word8 ByteString
- | RD_RRSIG RD_RRSIG
- | RD_NSEC Domain [TYPE]
- | RD_DNSKEY Word16 Word8 Word8 ByteString
- | RD_NSEC3 Word8 Word8 Word16 ByteString ByteString [TYPE]
- | RD_NSEC3PARAM Word8 Word8 Word16 ByteString
- | RD_TLSA Word8 Word8 Word8 ByteString
- | RD_CDS Word16 Word8 Word8 ByteString
- | RD_CDNSKEY Word16 Word8 Word8 ByteString
- | RD_CAA Word8 (CI ByteString) ByteString
- | UnknownRData ByteString
- data RD_RRSIG = RDREP_RRSIG {
- rrsigType :: !TYPE
- rrsigKeyAlg :: !Word8
- rrsigNumLabels :: !Word8
- rrsigTTL :: !Word32
- rrsigExpiration :: !Int64
- rrsigInception :: !Int64
- rrsigKeyTag :: !Word16
- rrsigZone :: !Domain
- rrsigValue :: !ByteString
- dnsTime :: Word32 -> Int64 -> Int64
- data DNSMessage = DNSMessage {}
- makeQuery :: Identifier -> Question -> QueryControls -> DNSMessage
- makeEmptyQuery :: QueryControls -> DNSMessage
- defaultQuery :: DNSMessage
- data QueryControls
- rdFlag :: FlagOp -> QueryControls
- adFlag :: FlagOp -> QueryControls
- cdFlag :: FlagOp -> QueryControls
- doFlag :: FlagOp -> QueryControls
- ednsEnabled :: FlagOp -> QueryControls
- ednsSetVersion :: Maybe Word8 -> QueryControls
- ednsSetUdpSize :: Maybe Word16 -> QueryControls
- ednsSetOptions :: ODataOp -> QueryControls
- data FlagOp
- data ODataOp
- defaultResponse :: DNSMessage
- makeResponse :: Identifier -> Question -> Answers -> DNSMessage
- data DNSHeader = DNSHeader {
- identifier :: !Identifier
- flags :: !DNSFlags
- type Identifier = Word16
- data DNSFlags = DNSFlags {
- qOrR :: !QorR
- opcode :: !OPCODE
- authAnswer :: !Bool
- trunCation :: !Bool
- recDesired :: !Bool
- recAvailable :: !Bool
- rcode :: !RCODE
- authenData :: !Bool
- chkDisable :: !Bool
- data QorR
- defaultDNSFlags :: DNSFlags
- data OPCODE
- fromOPCODE :: OPCODE -> Word16
- toOPCODE :: Word16 -> Maybe OPCODE
- data RCODE where
- pattern NoErr :: RCODE
- pattern FormatErr :: RCODE
- pattern ServFail :: RCODE
- pattern NameErr :: RCODE
- pattern NotImpl :: RCODE
- pattern Refused :: RCODE
- pattern YXDomain :: RCODE
- pattern YXRRSet :: RCODE
- pattern NXRRSet :: RCODE
- pattern NotAuth :: RCODE
- pattern NotZone :: RCODE
- pattern BadVers :: RCODE
- pattern BadKey :: RCODE
- pattern BadTime :: RCODE
- pattern BadMode :: RCODE
- pattern BadName :: RCODE
- pattern BadAlg :: RCODE
- pattern BadTrunc :: RCODE
- pattern BadCookie :: RCODE
- pattern BadRCODE :: RCODE
- fromRCODE :: RCODE -> Word16
- toRCODE :: Word16 -> RCODE
- data EDNSheader
- ifEDNS :: EDNSheader -> a -> a -> a
- mapEDNS :: EDNSheader -> (EDNS -> a) -> a -> a
- data EDNS = EDNS {
- ednsVersion :: !Word8
- ednsUdpSize :: !Word16
- ednsDnssecOk :: !Bool
- ednsOptions :: ![OData]
- defaultEDNS :: EDNS
- maxUdpSize :: Word16
- minUdpSize :: Word16
- data OData
- data OptCode where
- fromOptCode :: OptCode -> Word16
- toOptCode :: Word16 -> OptCode
- data Question = Question {}
- data DNSError
- type Mailbox = ByteString
Resource Records
data ResourceRecord #
Raw data format for resource records.
Instances
Show ResourceRecord | |
Defined in Network.DNS.Types.Internal showsPrec :: Int -> ResourceRecord -> ShowS # show :: ResourceRecord -> String # showList :: [ResourceRecord] -> ShowS # | |
Eq ResourceRecord | |
Defined in Network.DNS.Types.Internal (==) :: ResourceRecord -> ResourceRecord -> Bool # (/=) :: ResourceRecord -> ResourceRecord -> Bool # |
type Answers = [ResourceRecord] #
Type alias for resource records in the answer section.
type AuthorityRecords = [ResourceRecord] #
Type alias for resource records in the answer section.
type AdditionalRecords = [ResourceRecord] #
Type for resource records in the additional section.
Types
type Domain = ByteString #
This type holds the presentation form of fully-qualified DNS domain
names encoded as ASCII A-labels, with '.' separators between labels.
Non-printing characters are escaped as \DDD
(a backslash, followed by
three decimal digits). The special characters: ", $, (, ), ;, @,
and
\
are escaped by prepending a backslash. The trailing '.' is optional
on input, but is recommended, and is always added when decoding from
wire form.
The encoding of domain names to wire form, e.g. for transmission in a
query, requires the input encodings to be valid, otherwise a DecodeError
may be thrown. Domain names received in wire form in DNS messages are
escaped to this presentation form as part of decoding the DNSMessage
.
This form is ASCII-only. Any conversion between A-label ByteString
s,
and U-label Text
happens at whatever layer maps user input to DNS
names, or presents friendly DNS names to the user. Not all users
can read all scripts, and applications that default to U-label form
should ideally give the user a choice to see the A-label form.
Examples:
www.example.org. -- Ordinary DNS name. _25._tcp.mx1.example.net. -- TLSA RR initial labels have _ prefixes. \001.exotic.example. -- First label is Ctrl-A! just\.one\.label.example. -- First label is "just.one.label"
Resource Record Types
Types for resource records.
pattern A :: TYPE | IPv4 address |
pattern NS :: TYPE | An authoritative name serve |
pattern CNAME :: TYPE | The canonical name for an alias |
pattern SOA :: TYPE | Marks the start of a zone of authority |
pattern NULL :: TYPE | A null RR (EXPERIMENTAL) |
pattern PTR :: TYPE | A domain name pointer |
pattern MX :: TYPE | Mail exchange |
pattern TXT :: TYPE | Text strings |
pattern AAAA :: TYPE | IPv6 Address |
pattern SRV :: TYPE | Server Selection (RFC2782) |
pattern DNAME :: TYPE | DNAME (RFC6672) |
pattern OPT :: TYPE | OPT (RFC6891) |
pattern DS :: TYPE | Delegation Signer (RFC4034) |
pattern RRSIG :: TYPE | RRSIG (RFC4034) |
pattern NSEC :: TYPE | NSEC (RFC4034) |
pattern DNSKEY :: TYPE | DNSKEY (RFC4034) |
pattern NSEC3 :: TYPE | NSEC3 (RFC5155) |
pattern NSEC3PARAM :: TYPE | NSEC3PARAM (RFC5155) |
pattern TLSA :: TYPE | TLSA (RFC6698) |
pattern CDS :: TYPE | Child DS (RFC7344) |
pattern CDNSKEY :: TYPE | DNSKEY(s) the Child wants reflected in DS (RFC7344) |
pattern CSYNC :: TYPE | Child-To-Parent Synchronization (RFC7477) |
pattern AXFR :: TYPE | Zone transfer (RFC5936) |
pattern ANY :: TYPE | A request for all records the server/cache has available |
pattern CAA :: TYPE | Certification Authority Authorization (RFC6844) |
Resource Data
Raw data format for each type.
RD_A IPv4 | IPv4 address |
RD_NS Domain | An authoritative name serve |
RD_CNAME Domain | The canonical name for an alias |
RD_SOA Domain Mailbox Word32 Word32 Word32 Word32 Word32 | Marks the start of a zone of authority |
RD_NULL ByteString | NULL RR (EXPERIMENTAL, RFC1035). |
RD_PTR Domain | A domain name pointer |
RD_MX Word16 Domain | Mail exchange |
RD_TXT ByteString | Text strings |
RD_RP Mailbox Domain | Responsible Person (RFC1183) |
RD_AAAA IPv6 | IPv6 Address |
RD_SRV Word16 Word16 Word16 Domain | Server Selection (RFC2782) |
RD_DNAME Domain | DNAME (RFC6672) |
RD_OPT [OData] | OPT (RFC6891) |
RD_DS Word16 Word8 Word8 ByteString | Delegation Signer (RFC4034) |
RD_RRSIG RD_RRSIG | DNSSEC signature |
RD_NSEC Domain [TYPE] | DNSSEC denial of existence NSEC record |
RD_DNSKEY Word16 Word8 Word8 ByteString | DNSKEY (RFC4034) |
RD_NSEC3 Word8 Word8 Word16 ByteString ByteString [TYPE] | DNSSEC hashed denial of existence (RFC5155) |
RD_NSEC3PARAM Word8 Word8 Word16 ByteString | NSEC3 zone parameters (RFC5155) |
RD_TLSA Word8 Word8 Word8 ByteString | TLSA (RFC6698) |
RD_CDS Word16 Word8 Word8 ByteString | Child DS (RFC7344) |
RD_CDNSKEY Word16 Word8 Word8 ByteString | Child DNSKEY (RFC7344) |
RD_CAA Word8 (CI ByteString) ByteString | CAA (RFC 6844) RD_CSYNC |
UnknownRData ByteString | Unknown resource data |
RRSIG representation.
As noted in
Section 3.1.5 of RFC 4034
the RRsig inception and expiration times use serial number arithmetic. As a
result these timestamps are not pure values, their meaning is
time-dependent! They depend on the present time and are both at most
approximately +/-68 years from the present. This ambiguity is not a
problem because cached RRSIG records should only persist a few days,
signature lifetimes should be *much* shorter than 68 years, and key rotation
should result any misconstrued 136-year-old signatures fail to validate.
This also means that the interpretation of a time that is exactly half-way
around the clock at now +/-0x80000000
is not important, the signature
should never be valid.
The upshot for us is that we need to convert these *impure* relative values to pure absolute values at the moment they are received from from the network (or read from files, ... in some impure I/O context), and convert them back to 32-bit values when encoding. Therefore, the constructor takes absolute 64-bit representations of the inception and expiration times.
The dnsTime
function performs the requisite conversion.
RDREP_RRSIG | |
|
Given a 32-bit circle-arithmetic DNS time, and the current absolute epoch time, return the epoch time corresponding to the DNS timestamp.
DNS Message
data DNSMessage #
DNS message format for queries and replies.
DNSMessage | |
|
Instances
Show DNSMessage | |
Defined in Network.DNS.Types.Internal showsPrec :: Int -> DNSMessage -> ShowS # show :: DNSMessage -> String # showList :: [DNSMessage] -> ShowS # | |
Eq DNSMessage | |
Defined in Network.DNS.Types.Internal (==) :: DNSMessage -> DNSMessage -> Bool # (/=) :: DNSMessage -> DNSMessage -> Bool # |
Query
:: Identifier | Crypto random request id |
-> Question | Question name and type |
-> QueryControls | Custom RD/AD/CD flags and EDNS settings |
-> DNSMessage |
Construct a complete query DNSMessage
, by combining the defaultQuery
template with the specified Identifier
, and Question
. The
QueryControls
can be mempty
to leave all header and EDNS settings at
their default values, or some combination of overrides. A default set of
overrides can be enabled via the resolvQueryControls
field of ResolvConf
. Per-query overrides are
possible by using loookupRawCtl
.
:: QueryControls | Flag and EDNS overrides |
-> DNSMessage |
A query template with QueryControls
overrides applied,
with just the Question
and query Identifier
remaining
to be filled in.
A DNSMessage
template for queries with default settings for
the message DNSHeader
and EDNSheader
. This is the initial
query message state, before customization via QueryControls
.
Query Controls
data QueryControls #
Query controls form a Monoid
, as with function composition, the
left-most value has the last say. The Monoid
is generated by two sets of
combinators, one that controls query-related DNS header flags, and another
that controls EDNS features.
The header flag controls are: rdFlag
, adFlag
and cdFlag
.
The EDNS feature controls are: doFlag
, ednsEnabled
, ednsSetVersion
,
ednsSetUdpSize
and ednsSetOptions
. When EDNS is disabled, all the other
EDNS-related controls have no effect.
Example: Disable DNSSEC checking on the server, and request signatures and NSEC records, perhaps for your own independent validation. The UDP buffer size is set large, for use with a local loopback nameserver on the same host.
>>>
:{
mconcat [ adFlag FlagClear , cdFlag FlagSet , doFlag FlagSet , ednsSetUdpSize (Just 8192) -- IPv4 loopback server? ] :} ad:0,cd:1,edns.udpsize:8192,edns.dobit:1
Example: Use EDNS version 1 (yet to be specified), request nameserver ids from the server, and indicate a client subnet of "192.0.2.1/24".
>>>
:set -XOverloadedStrings
>>>
let emptyNSID = ""
>>>
let mask = 24
>>>
let ipaddr = read "192.0.2.1"
>>>
:{
mconcat [ ednsSetVersion (Just 1) , ednsSetOptions (ODataAdd [OD_NSID emptyNSID]) , ednsSetOptions (ODataAdd [OD_ClientSubnet mask 0 ipaddr]) ] :} edns.version:1,edns.options:[NSID,ClientSubnet]
Instances
Monoid QueryControls | |
Defined in Network.DNS.Types.Internal mempty :: QueryControls # mappend :: QueryControls -> QueryControls -> QueryControls # mconcat :: [QueryControls] -> QueryControls # | |
Semigroup QueryControls | |
Defined in Network.DNS.Types.Internal (<>) :: QueryControls -> QueryControls -> QueryControls # sconcat :: NonEmpty QueryControls -> QueryControls # stimes :: Integral b => b -> QueryControls -> QueryControls # | |
Show QueryControls | |
Defined in Network.DNS.Types.Internal showsPrec :: Int -> QueryControls -> ShowS # show :: QueryControls -> String # showList :: [QueryControls] -> ShowS # | |
Eq QueryControls | |
Defined in Network.DNS.Types.Internal (==) :: QueryControls -> QueryControls -> Bool # (/=) :: QueryControls -> QueryControls -> Bool # |
rdFlag :: FlagOp -> QueryControls #
Generator of QueryControls
that adjusts the RD bit.
>>>
rdFlag FlagClear
rd:0
adFlag :: FlagOp -> QueryControls #
Generator of QueryControls
that adjusts the AD bit.
>>>
adFlag FlagSet
ad:1
cdFlag :: FlagOp -> QueryControls #
Generator of QueryControls
that adjusts the CD bit.
>>>
cdFlag FlagSet
cd:1
doFlag :: FlagOp -> QueryControls #
Generator of QueryControls
that adjusts the EDNS
DnssecOk (DO) bit.
>>>
doFlag FlagSet
edns.dobit:1
ednsEnabled :: FlagOp -> QueryControls #
Generator of QueryControls
that enables or disables EDNS support.
When EDNS is disabled, the rest of the EDNS
controls are ignored.
>>>
ednsHeader $ makeEmptyQuery $ ednsEnabled FlagClear <> doFlag FlagSet
NoEDNS
ednsSetVersion :: Maybe Word8 -> QueryControls #
Generator of QueryControls
that adjusts the EDNS
version.
A value of Nothing
makes no changes, while Just
v
sets
the EDNS version to v
.
>>>
ednsSetVersion (Just 1)
edns.version:1
ednsSetUdpSize :: Maybe Word16 -> QueryControls #
Generator of QueryControls
that adjusts the EDNS
UDP buffer size.
A value of Nothing
makes no changes, while Just
n
sets the EDNS UDP
buffer size to n
.
>>>
ednsSetUdpSize (Just 2048)
edns.udpsize:2048
ednsSetOptions :: ODataOp -> QueryControls #
Generator of QueryControls
that adjusts the list of EDNS
options.
>>>
:set -XOverloadedStrings
>>>
ednsSetOptions (ODataAdd [OD_NSID ""])
edns.options:[NSID]
Flag and OData control operations
Boolean flag operations. These form a Monoid
. When combined via
mappend
, as with function composition, the left-most value has
the last say.
>>>
mempty :: FlagOp
FlagKeep>>>
FlagSet <> mempty
FlagSet>>>
FlagClear <> FlagSet <> mempty
FlagClear>>>
FlagReset <> FlagClear <> FlagSet <> mempty
FlagReset
FlagSet | Set the flag to 1 |
FlagClear | Clear the flag to 0 |
FlagReset | Reset the flag to its default value |
FlagKeep | Leave the flag unchanged |
The default EDNS Option list is empty. We define two operations, one to prepend a list of options, and another to set a specific list of options.
ODataAdd [OData] | Add the specified options to the list. |
ODataSet [OData] | Set the option list as specified. |
Response
defaultResponse :: DNSMessage #
Default response. When responding to EDNS queries, the response must
either be an EDNS response, or else FormatErr must be returned. The default
response message has EDNS disabled (ednsHeader
set to NoEDNS
), it should
be updated as appropriate.
Do not explicitly add OPT RRs to the additional section, instead let the encoder compute and add the OPT record based on the EDNS pseudo-header.
The RCODE
in the DNSHeader
should be set to the appropriate 12-bit
extended value, which will be split between the primary header and EDNS OPT
record during message encoding (low 4 bits in DNS header, high 8 bits in
EDNS OPT record). See EDNSheader
for more details.
makeResponse :: Identifier -> Question -> Answers -> DNSMessage #
Construct a query response DNSMessage
.
DNS Header
Raw data format for the header of DNS Query and Response.
DNSHeader | |
|
type Identifier = Word16 #
An identifier assigned by the program that generates any kind of query.
DNS flags
Raw data format for the flags of DNS Query and Response.
DNSFlags | |
|
Query or response.
QR_Query | Query. |
QR_Response | Response. |
Default DNSFlags
record suitable for making recursive queries. By default
the RD bit is set, and the AD and CD bits are cleared.
OPCODE and RCODE
Kind of query.
OP_STD | A standard query. |
OP_INV | An inverse query (inverse queries are deprecated). |
OP_SSR | A server status request. |
OP_NOTIFY | A zone change notification (RFC1996) |
OP_UPDATE | An update request (RFC2136) |
fromOPCODE :: OPCODE -> Word16 #
Convert the internal representation of a DNS OPCODE to its 16-bit numeric value.
toOPCODE :: Word16 -> Maybe OPCODE #
Convert a 16-bit DNS OPCODE number to its internal representation
EDNS extended 12-bit response code. Non-EDNS messages use only the low 4
bits. With EDNS this stores the combined error code from the DNS header and
and the EDNS psuedo-header. See EDNSheader
for more detail.
pattern NoErr :: RCODE | No error condition. |
pattern FormatErr :: RCODE | Format error - The name server was unable to interpret the query. |
pattern ServFail :: RCODE | Server failure - The name server was unable to process this query due to a problem with the name server. |
pattern NameErr :: RCODE | Name Error - Meaningful only for responses from an authoritative name server, this code signifies that the domain name referenced in the query does not exist. |
pattern NotImpl :: RCODE | Not Implemented - The name server does not support the requested kind of query. |
pattern Refused :: RCODE | Refused - The name server refuses to perform the specified operation for policy reasons. For example, a name server may not wish to provide the information to the particular requester, or a name server may not wish to perform a particular operation (e.g., zone transfer) for particular data. |
pattern YXDomain :: RCODE | YXDomain - Dynamic update response, a pre-requisite domain that should not exist, does exist. |
pattern YXRRSet :: RCODE | YXRRSet - Dynamic update response, a pre-requisite RRSet that should not exist, does exist. |
pattern NXRRSet :: RCODE | NXRRSet - Dynamic update response, a pre-requisite RRSet that should exist, does not exist. |
pattern NotAuth :: RCODE | NotAuth - Dynamic update response, the server is not authoritative for the zone named in the Zone Section. |
pattern NotZone :: RCODE | NotZone - Dynamic update response, a name used in the Prerequisite or Update Section is not within the zone denoted by the Zone Section. |
pattern BadVers :: RCODE | Bad OPT Version (BADVERS, RFC 6891). |
pattern BadKey :: RCODE | Key not recognized [RFC2845] |
pattern BadTime :: RCODE | Signature out of time window [RFC2845] |
pattern BadMode :: RCODE | Bad TKEY Mode [RFC2930] |
pattern BadName :: RCODE | Duplicate key name [RFC2930] |
pattern BadAlg :: RCODE | Algorithm not supported [RFC2930] |
pattern BadTrunc :: RCODE | Bad Truncation [RFC4635] |
pattern BadCookie :: RCODE | Bad/missing Server Cookie [RFC7873] |
pattern BadRCODE :: RCODE | Malformed (peer) EDNS message, no RCODE available. This is not an RCODE
that can be sent by a peer. It lies outside the 12-bit range expressible
via EDNS. The low 12-bits are chosen to coincide with |
Instances
Enum RCODE | Provide an Enum instance for backwards compatibility |
Defined in Network.DNS.Types.Internal | |
Show RCODE | Use https://tools.ietf.org/html/rfc2929#section-2.3 names for DNS RCODEs |
Eq RCODE | |
Convert a numeric value to a corresponding RCODE
. The behaviour is
undefined for values outside the range [0 .. 0xFFF]
since the EDNS
extended RCODE is a 12-bit value. Values in the range [0xF01 .. 0xFFF]
are reserved for private use.
EDNS Pseudo-Header
data EDNSheader #
Data type representing the optional EDNS pseudo-header of a DNSMessage
When a single well-formed OPT
ResourceRecord
was present in the
message's additional section, it is decoded to an EDNS
record and and
stored in the message ednsHeader
field. The corresponding OPT RR
is
then removed from the additional section.
When the constructor is NoEDNS
, no EDNS OPT
record was present in the
message additional section. When InvalidEDNS
, the message holds either a
malformed OPT record or more than one OPT record, which can still be found
in (have not been removed from) the message additional section.
The EDNS OPT record augments the message error status with an 8-bit field
that forms 12-bit extended RCODE when combined with the 4-bit RCODE from the
unextended DNS header. In EDNS messages it is essential to not use just the
bare 4-bit RCODE
from the original DNS header. Therefore, in order to
avoid potential misinterpretation of the response RCODE
, when the OPT
record is decoded, the upper eight bits of the error status are
automatically combined with the rcode
of the message header, so that there
is only one place in which to find the full 12-bit result. Therefore, the
decoded EDNS
pseudo-header, does not hold any error status bits.
The reverse process occurs when encoding messages. The low four bits of the
message header rcode
are encoded into the wire-form DNS header, while the
upper eight bits are encoded as part of the OPT record. In DNS responses with
an rcode
larger than 15, EDNS extensions SHOULD be enabled by providing a
value for ednsHeader
with a constructor of EDNSheader
. If EDNS is not
enabled in such a message, in order to avoid truncation of RCODE
values
that don't fit in the non-extended DNS header, the encoded wire-form RCODE
is set to FormatErr
.
When encoding messages for transmission, the ednsHeader
is used to
generate the additional OPT record. Do not add explicit OPT
records
to the aditional section, configure EDNS via the EDNSheader
instead.
>>>
let getopts eh = mapEDNS eh ednsOptions []
>>>
let optsin = [OD_ClientSubnet 24 0 $ read "192.0.2.1"]
>>>
let masked = [OD_ClientSubnet 24 0 $ read "192.0.2.0"]
>>>
let message = makeEmptyQuery $ ednsSetOptions $ ODataSet optsin
>>>
let optsout = getopts. ednsHeader <$> (decode $ encode message)
>>>
optsout == Right masked
True
EDNSheader EDNS | A valid EDNS message |
NoEDNS | A valid non-EDNS message |
InvalidEDNS | Multiple or bad additional |
Instances
Show EDNSheader | |
Defined in Network.DNS.Types.Internal showsPrec :: Int -> EDNSheader -> ShowS # show :: EDNSheader -> String # showList :: [EDNSheader] -> ShowS # | |
Eq EDNSheader | |
Defined in Network.DNS.Types.Internal (==) :: EDNSheader -> EDNSheader -> Bool # (/=) :: EDNSheader -> EDNSheader -> Bool # |
:: EDNSheader | EDNS pseudo-header |
-> a | Value to return for EDNS messages |
-> a | Value to return for non-EDNS messages |
-> a |
Return the second argument for EDNS messages, otherwise the third.
:: EDNSheader | EDNS pseudo-header |
-> (EDNS -> a) | Function to apply to |
-> a | Default result for non-EDNS messages |
-> a |
Return the output of a function applied to the EDNS pseudo-header if EDNS is enabled, otherwise return a default value.
EDNS record
EDNS information defined in RFC 6891.
EDNS | |
|
defaultEDNS :: EDNS #
The default EDNS pseudo-header for queries. The UDP buffer size is set to 1216 bytes, which should result in replies that fit into the 1280 byte IPv6 minimum MTU. Since IPv6 only supports fragmentation at the source, and even then not all gateways forward IPv6 pre-fragmented IPv6 packets, it is best to keep DNS packet sizes below this limit when using IPv6 nameservers. A larger value may be practical when using IPv4 exclusively.
defaultEDNS = EDNS { ednsVersion = 0 -- The default EDNS version is 0 , ednsUdpSize = 1232 -- IPv6-safe UDP MTU (RIPE recommendation) , ednsDnssecOk = False -- We don't do DNSSEC validation , ednsOptions = [] -- No EDNS options by default }
maxUdpSize :: Word16 #
Maximum UDP size that can be advertised. If the ednsUdpSize
of EDNS
is larger, then this value is sent instead. This value is likely to work
only for local nameservers on the loopback network. Servers may enforce
a smaller limit.
>>>
maxUdpSize
16384
minUdpSize :: Word16 #
Minimum UDP size to advertise. If ednsUdpSize
of EDNS
is smaller,
then this value is sent instead.
>>>
minUdpSize
512
EDNS options
RData formats for a few EDNS options, and an opaque catchall
OD_NSID ByteString | Name Server Identifier (RFC5001). Bidirectional, empty from client. (opaque octet-string). May contain binary data, which MUST be empty in queries. |
OD_DAU [Word8] | DNSSEC Algorithm Understood (RFC6975). Client to server. (array of 8-bit numbers). Lists supported DNSKEY algorithms. |
OD_DHU [Word8] | DS Hash Understood (RFC6975). Client to server. (array of 8-bit numbers). Lists supported DS hash algorithms. |
OD_N3U [Word8] | NSEC3 Hash Understood (RFC6975). Client to server. (array of 8-bit numbers). Lists supported NSEC3 hash algorithms. |
OD_ClientSubnet Word8 Word8 IP | Client subnet (RFC7871). Bidirectional.
(source bits, scope bits, address).
The address is masked and truncated when encoding queries. The
address is zero-padded when decoding. Invalid input encodings
result in an |
OD_ECSgeneric Word16 Word8 Word8 ByteString | Unsupported or malformed IP client subnet option. Bidirectional. (address family, source bits, scope bits, opaque address). |
UnknownOData Word16 ByteString | Generic EDNS option.
(numeric |
EDNS Option Code (RFC 6891).
pattern ClientSubnet :: OptCode | Client subnet (RFC7871) |
pattern DAU :: OptCode | DNSSEC algorithm support (RFC6974, section 3) |
pattern DHU :: OptCode | |
pattern N3U :: OptCode | |
pattern NSID :: OptCode | NSID (RFC5001, section 2.3) |
fromOptCode :: OptCode -> Word16 #
From option code to number.
DNS Body
Raw data format for DNS questions.
DNS Error
An enumeration of all possible DNS errors that can occur.
SequenceNumberMismatch | The sequence number of the answer doesn't match our query. This could indicate foul play. |
QuestionMismatch | The question section of the response doesn't match our query. This could indicate foul play. |
InvalidAXFRLookup | A zone tranfer, i.e., a request of type AXFR, was attempted with the "lookup" interface. Zone transfer is different enough from "normal" requests that it requires a different interface. |
RetryLimitExceeded | The number of retries for the request was exceeded. |
TimeoutExpired | TCP fallback request timed out. |
UnexpectedRDATA | The answer has the correct sequence number, but returned an unexpected RDATA format. |
IllegalDomain | The domain for query is illegal. |
FormatError | The name server was unable to interpret the query. |
ServerFailure | The name server was unable to process this query due to a problem with the name server. |
NameError | This code signifies that the domain name referenced in the query does not exist. |
NotImplemented | The name server does not support the requested kind of query. |
OperationRefused | The name server refuses to perform the specified operation for policy reasons. For example, a name server may not wish to provide the information to the particular requester, or a name server may not wish to perform a particular operation (e.g., zone transfer) for particular data. |
BadOptRecord | The server does not support the OPT RR version or content |
BadConfiguration | Configuration is wrong. |
NetworkFailure IOException | Network failure. |
DecodeError String | Error is unknown |
UnknownDNSError |
Instances
Exception DNSError | |
Defined in Network.DNS.Types.Internal toException :: DNSError -> SomeException # fromException :: SomeException -> Maybe DNSError # displayException :: DNSError -> String # | |
Show DNSError | |
Eq DNSError | |
Other types
type Mailbox = ByteString #
Type for a mailbox encoded on the wire as a DNS name, but the first label
is conceptually the local part of an email address, and may contain internal
periods that are not label separators. Therefore, in mailboxes @ is used as
the separator between the first and second labels, and any '.' characters
in the first label are not escaped. The encoding is otherwise the same as
Domain
above. This is most commonly seen in the rname of SOA
records,
and is also employed in the mbox-dname
field of RP
records.
On input, if there is no unescaped @ character in the Mailbox
, it is
reparsed with '.' as the first label separator. Thus the traditional
format with all labels separated by dots is also accepted, but decoding from
wire form always uses @ between the first label and the domain-part of the
address. Examples:
hostmaster@example.org. -- First label is simplyhostmaster
john.smith@examle.com. -- First label isjohn.smith