{-# OPTIONS_HADDOCK hide #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE CPP #-}

module Network.DNS.Types.Internal where

import Control.Exception (Exception, IOException)
import qualified Data.ByteString as B
import qualified Data.ByteString.Base16 as B16
import qualified Data.ByteString.Base64 as B64
import qualified Data.ByteString.Char8 as BS
import Data.CaseInsensitive (CI)
import qualified Data.CaseInsensitive as CI
import Data.Char (intToDigit)
import qualified Data.Hourglass as H
import Data.IP (IP(..), IPv4, IPv6)
import qualified Data.Semigroup as Sem

import qualified Network.DNS.Base32Hex as B32
import Network.DNS.Imports

-- $setup
-- >>> import Network.DNS

----------------------------------------------------------------

-- | 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\"
-- @
--
type Domain = 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 simply @hostmaster@
-- john.smith\@examle.com.   -- First label is @john.smith@
-- @
--
type Mailbox = ByteString

----------------------------------------------------------------

-- | Types for resource records.
newtype TYPE = TYPE {
    -- | From type to number.
    TYPE -> Word16
fromTYPE :: Word16
  } deriving (TYPE -> TYPE -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TYPE -> TYPE -> Bool
$c/= :: TYPE -> TYPE -> Bool
== :: TYPE -> TYPE -> Bool
$c== :: TYPE -> TYPE -> Bool
Eq, Eq TYPE
TYPE -> TYPE -> Bool
TYPE -> TYPE -> Ordering
TYPE -> TYPE -> TYPE
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: TYPE -> TYPE -> TYPE
$cmin :: TYPE -> TYPE -> TYPE
max :: TYPE -> TYPE -> TYPE
$cmax :: TYPE -> TYPE -> TYPE
>= :: TYPE -> TYPE -> Bool
$c>= :: TYPE -> TYPE -> Bool
> :: TYPE -> TYPE -> Bool
$c> :: TYPE -> TYPE -> Bool
<= :: TYPE -> TYPE -> Bool
$c<= :: TYPE -> TYPE -> Bool
< :: TYPE -> TYPE -> Bool
$c< :: TYPE -> TYPE -> Bool
compare :: TYPE -> TYPE -> Ordering
$ccompare :: TYPE -> TYPE -> Ordering
Ord)

-- https://www.iana.org/assignments/dns-parameters/dns-parameters.xhtml#dns-parameters-4

-- | IPv4 address
pattern A :: TYPE
pattern $bA :: TYPE
$mA :: forall {r}. TYPE -> ((# #) -> r) -> ((# #) -> r) -> r
A          = TYPE   1
-- | An authoritative name serve
pattern NS :: TYPE
pattern $bNS :: TYPE
$mNS :: forall {r}. TYPE -> ((# #) -> r) -> ((# #) -> r) -> r
NS         = TYPE   2
-- | The canonical name for an alias
pattern CNAME :: TYPE
pattern $bCNAME :: TYPE
$mCNAME :: forall {r}. TYPE -> ((# #) -> r) -> ((# #) -> r) -> r
CNAME      = TYPE   5
-- | Marks the start of a zone of authority
pattern SOA :: TYPE
pattern $bSOA :: TYPE
$mSOA :: forall {r}. TYPE -> ((# #) -> r) -> ((# #) -> r) -> r
SOA        = TYPE   6
-- | A null RR (EXPERIMENTAL)
pattern NULL :: TYPE
pattern $bNULL :: TYPE
$mNULL :: forall {r}. TYPE -> ((# #) -> r) -> ((# #) -> r) -> r
NULL       = TYPE  10
-- | A domain name pointer
pattern PTR :: TYPE
pattern $bPTR :: TYPE
$mPTR :: forall {r}. TYPE -> ((# #) -> r) -> ((# #) -> r) -> r
PTR        = TYPE  12
-- | Mail exchange
pattern MX :: TYPE
pattern $bMX :: TYPE
$mMX :: forall {r}. TYPE -> ((# #) -> r) -> ((# #) -> r) -> r
MX         = TYPE  15
-- | Text strings
pattern TXT :: TYPE
pattern $bTXT :: TYPE
$mTXT :: forall {r}. TYPE -> ((# #) -> r) -> ((# #) -> r) -> r
TXT        = TYPE  16
-- | Responsible Person
pattern RP :: TYPE
pattern $bRP :: TYPE
$mRP :: forall {r}. TYPE -> ((# #) -> r) -> ((# #) -> r) -> r
RP         = TYPE  17
-- | IPv6 Address
pattern AAAA :: TYPE
pattern $bAAAA :: TYPE
$mAAAA :: forall {r}. TYPE -> ((# #) -> r) -> ((# #) -> r) -> r
AAAA       = TYPE  28
-- | Server Selection (RFC2782)
pattern SRV :: TYPE
pattern $bSRV :: TYPE
$mSRV :: forall {r}. TYPE -> ((# #) -> r) -> ((# #) -> r) -> r
SRV        = TYPE  33
-- | DNAME (RFC6672)
pattern DNAME :: TYPE
pattern $bDNAME :: TYPE
$mDNAME :: forall {r}. TYPE -> ((# #) -> r) -> ((# #) -> r) -> r
DNAME      = TYPE  39 -- RFC 6672
-- | OPT (RFC6891)
pattern OPT :: TYPE
pattern $bOPT :: TYPE
$mOPT :: forall {r}. TYPE -> ((# #) -> r) -> ((# #) -> r) -> r
OPT        = TYPE  41 -- RFC 6891
-- | Delegation Signer (RFC4034)
pattern DS :: TYPE
pattern $bDS :: TYPE
$mDS :: forall {r}. TYPE -> ((# #) -> r) -> ((# #) -> r) -> r
DS         = TYPE  43 -- RFC 4034
-- | RRSIG (RFC4034)
pattern RRSIG :: TYPE
pattern $bRRSIG :: TYPE
$mRRSIG :: forall {r}. TYPE -> ((# #) -> r) -> ((# #) -> r) -> r
RRSIG      = TYPE  46 -- RFC 4034
-- | NSEC (RFC4034)
pattern NSEC :: TYPE
pattern $bNSEC :: TYPE
$mNSEC :: forall {r}. TYPE -> ((# #) -> r) -> ((# #) -> r) -> r
NSEC       = TYPE  47 -- RFC 4034
-- | DNSKEY (RFC4034)
pattern DNSKEY :: TYPE
pattern $bDNSKEY :: TYPE
$mDNSKEY :: forall {r}. TYPE -> ((# #) -> r) -> ((# #) -> r) -> r
DNSKEY     = TYPE  48 -- RFC 4034
-- | NSEC3 (RFC5155)
pattern NSEC3 :: TYPE
pattern $bNSEC3 :: TYPE
$mNSEC3 :: forall {r}. TYPE -> ((# #) -> r) -> ((# #) -> r) -> r
NSEC3      = TYPE  50 -- RFC 5155
-- | NSEC3PARAM (RFC5155)
pattern NSEC3PARAM :: TYPE
pattern $bNSEC3PARAM :: TYPE
$mNSEC3PARAM :: forall {r}. TYPE -> ((# #) -> r) -> ((# #) -> r) -> r
NSEC3PARAM = TYPE  51 -- RFC 5155
-- | TLSA (RFC6698)
pattern TLSA :: TYPE
pattern $bTLSA :: TYPE
$mTLSA :: forall {r}. TYPE -> ((# #) -> r) -> ((# #) -> r) -> r
TLSA       = TYPE  52 -- RFC 6698
-- | Child DS (RFC7344)
pattern CDS :: TYPE
pattern $bCDS :: TYPE
$mCDS :: forall {r}. TYPE -> ((# #) -> r) -> ((# #) -> r) -> r
CDS        = TYPE  59 -- RFC 7344
-- | DNSKEY(s) the Child wants reflected in DS (RFC7344)
pattern CDNSKEY :: TYPE
pattern $bCDNSKEY :: TYPE
$mCDNSKEY :: forall {r}. TYPE -> ((# #) -> r) -> ((# #) -> r) -> r
CDNSKEY    = TYPE  60 -- RFC 7344
-- | Child-To-Parent Synchronization (RFC7477)
pattern CSYNC :: TYPE
pattern $bCSYNC :: TYPE
$mCSYNC :: forall {r}. TYPE -> ((# #) -> r) -> ((# #) -> r) -> r
CSYNC      = TYPE  62 -- RFC 7477
-- | Zone transfer (RFC5936)
pattern AXFR :: TYPE
pattern $bAXFR :: TYPE
$mAXFR :: forall {r}. TYPE -> ((# #) -> r) -> ((# #) -> r) -> r
AXFR       = TYPE 252 -- RFC 5936
-- | A request for all records the server/cache has available
pattern ANY :: TYPE
pattern $bANY :: TYPE
$mANY :: forall {r}. TYPE -> ((# #) -> r) -> ((# #) -> r) -> r
ANY        = TYPE 255
-- | Certification Authority Authorization (RFC6844)
pattern CAA :: TYPE
pattern $bCAA :: TYPE
$mCAA :: forall {r}. TYPE -> ((# #) -> r) -> ((# #) -> r) -> r
CAA        = TYPE 257 -- RFC 6844

-- | From number to type.
toTYPE :: Word16 -> TYPE
toTYPE :: Word16 -> TYPE
toTYPE = Word16 -> TYPE
TYPE

instance Show TYPE where
    show :: TYPE -> [Char]
show TYPE
A          = [Char]
"A"
    show TYPE
NS         = [Char]
"NS"
    show TYPE
CNAME      = [Char]
"CNAME"
    show TYPE
SOA        = [Char]
"SOA"
    show TYPE
NULL       = [Char]
"NULL"
    show TYPE
PTR        = [Char]
"PTR"
    show TYPE
MX         = [Char]
"MX"
    show TYPE
TXT        = [Char]
"TXT"
    show TYPE
RP         = [Char]
"RP"
    show TYPE
AAAA       = [Char]
"AAAA"
    show TYPE
SRV        = [Char]
"SRV"
    show TYPE
DNAME      = [Char]
"DNAME"
    show TYPE
OPT        = [Char]
"OPT"
    show TYPE
DS         = [Char]
"DS"
    show TYPE
RRSIG      = [Char]
"RRSIG"
    show TYPE
NSEC       = [Char]
"NSEC"
    show TYPE
DNSKEY     = [Char]
"DNSKEY"
    show TYPE
NSEC3      = [Char]
"NSEC3"
    show TYPE
NSEC3PARAM = [Char]
"NSEC3PARAM"
    show TYPE
TLSA       = [Char]
"TLSA"
    show TYPE
CDS        = [Char]
"CDS"
    show TYPE
CDNSKEY    = [Char]
"CDNSKEY"
    show TYPE
CSYNC      = [Char]
"CSYNC"
    show TYPE
AXFR       = [Char]
"AXFR"
    show TYPE
ANY        = [Char]
"ANY"
    show TYPE
CAA        = [Char]
"CAA"
    show TYPE
x          = [Char]
"TYPE" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show (TYPE -> Word16
fromTYPE TYPE
x)

----------------------------------------------------------------

-- | An enumeration of all possible DNS errors that can occur.
data DNSError =
    -- | The sequence number of the answer doesn't match our query. This
    --   could indicate foul play.
    SequenceNumberMismatch
    -- | The question section of the response doesn't match our query. This
    --   could indicate foul play.
  | QuestionMismatch
    -- | 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.
  | InvalidAXFRLookup
    -- | The number of retries for the request was exceeded.
  | RetryLimitExceeded
    -- | TCP fallback request timed out.
  | TimeoutExpired
    -- | The answer has the correct sequence number, but returned an
    --   unexpected RDATA format.
  | UnexpectedRDATA
    -- | The domain for query is illegal.
  | IllegalDomain
    -- | The name server was unable to interpret the query.
  | FormatError
    -- | The name server was unable to process this query due to a
    --   problem with the name server.
  | ServerFailure
    -- | This code signifies that the domain name referenced in the
    --   query does not exist.
  | NameError
    -- | The name server does not support the requested kind of query.
  | NotImplemented
    -- | 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.
  | OperationRefused
    -- | The server does not support the OPT RR version or content
  | BadOptRecord
    -- | Configuration is wrong.
  | BadConfiguration
    -- | Network failure.
  | NetworkFailure IOException
    -- | Error is unknown
  | DecodeError String
  | UnknownDNSError
  deriving (DNSError -> DNSError -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DNSError -> DNSError -> Bool
$c/= :: DNSError -> DNSError -> Bool
== :: DNSError -> DNSError -> Bool
$c== :: DNSError -> DNSError -> Bool
Eq, Int -> DNSError -> ShowS
[DNSError] -> ShowS
DNSError -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [DNSError] -> ShowS
$cshowList :: [DNSError] -> ShowS
show :: DNSError -> [Char]
$cshow :: DNSError -> [Char]
showsPrec :: Int -> DNSError -> ShowS
$cshowsPrec :: Int -> DNSError -> ShowS
Show, Typeable)

instance Exception DNSError


-- | 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
--
data EDNSheader = EDNSheader EDNS -- ^ A valid EDNS message
                | NoEDNS          -- ^ A valid non-EDNS message
                | InvalidEDNS     -- ^ Multiple or bad additional @OPT@ RRs
    deriving (EDNSheader -> EDNSheader -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EDNSheader -> EDNSheader -> Bool
$c/= :: EDNSheader -> EDNSheader -> Bool
== :: EDNSheader -> EDNSheader -> Bool
$c== :: EDNSheader -> EDNSheader -> Bool
Eq, Int -> EDNSheader -> ShowS
[EDNSheader] -> ShowS
EDNSheader -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [EDNSheader] -> ShowS
$cshowList :: [EDNSheader] -> ShowS
show :: EDNSheader -> [Char]
$cshow :: EDNSheader -> [Char]
showsPrec :: Int -> EDNSheader -> ShowS
$cshowsPrec :: Int -> EDNSheader -> ShowS
Show)


-- | Return the second argument for EDNS messages, otherwise the third.
ifEDNS :: EDNSheader -- ^ EDNS pseudo-header
       -> a          -- ^ Value to return for EDNS messages
       -> a          -- ^ Value to return for non-EDNS messages
       -> a
ifEDNS :: forall a. EDNSheader -> a -> a -> a
ifEDNS (EDNSheader EDNS
_) a
a a
_ = a
a
ifEDNS             EDNSheader
_  a
_ a
b = a
b
{-# INLINE ifEDNS #-}


-- | Return the output of a function applied to the EDNS pseudo-header if EDNS
--   is enabled, otherwise return a default value.
mapEDNS :: EDNSheader  -- ^ EDNS pseudo-header
        -> (EDNS -> a) -- ^ Function to apply to 'EDNS' value
        -> a           -- ^ Default result for non-EDNS messages
        -> a
mapEDNS :: forall a. EDNSheader -> (EDNS -> a) -> a -> a
mapEDNS (EDNSheader EDNS
eh) EDNS -> a
f a
_ = EDNS -> a
f EDNS
eh
mapEDNS               EDNSheader
_ EDNS -> a
_ a
a = a
a
{-# INLINE mapEDNS #-}


-- | DNS message format for queries and replies.
--
data DNSMessage = DNSMessage {
    DNSMessage -> DNSHeader
header     :: !DNSHeader        -- ^ Header with extended 'RCODE'
  , DNSMessage -> EDNSheader
ednsHeader :: EDNSheader        -- ^ EDNS pseudo-header
  , DNSMessage -> [Question]
question   :: [Question]        -- ^ The question for the name server
  , DNSMessage -> Answers
answer     :: Answers           -- ^ RRs answering the question
  , DNSMessage -> Answers
authority  :: AuthorityRecords  -- ^ RRs pointing toward an authority
  , DNSMessage -> Answers
additional :: AdditionalRecords -- ^ RRs holding additional information
  } deriving (DNSMessage -> DNSMessage -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DNSMessage -> DNSMessage -> Bool
$c/= :: DNSMessage -> DNSMessage -> Bool
== :: DNSMessage -> DNSMessage -> Bool
$c== :: DNSMessage -> DNSMessage -> Bool
Eq, Int -> DNSMessage -> ShowS
[DNSMessage] -> ShowS
DNSMessage -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [DNSMessage] -> ShowS
$cshowList :: [DNSMessage] -> ShowS
show :: DNSMessage -> [Char]
$cshow :: DNSMessage -> [Char]
showsPrec :: Int -> DNSMessage -> ShowS
$cshowsPrec :: Int -> DNSMessage -> ShowS
Show)

-- | An identifier assigned by the program that
--   generates any kind of query.
type Identifier = Word16

-- | Raw data format for the header of DNS Query and Response.
data DNSHeader = DNSHeader {
    DNSHeader -> Word16
identifier :: !Identifier -- ^ Query or reply identifier.
  , DNSHeader -> DNSFlags
flags      :: !DNSFlags   -- ^ Flags, OPCODE, and RCODE
  } deriving (DNSHeader -> DNSHeader -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DNSHeader -> DNSHeader -> Bool
$c/= :: DNSHeader -> DNSHeader -> Bool
== :: DNSHeader -> DNSHeader -> Bool
$c== :: DNSHeader -> DNSHeader -> Bool
Eq, Int -> DNSHeader -> ShowS
[DNSHeader] -> ShowS
DNSHeader -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [DNSHeader] -> ShowS
$cshowList :: [DNSHeader] -> ShowS
show :: DNSHeader -> [Char]
$cshow :: DNSHeader -> [Char]
showsPrec :: Int -> DNSHeader -> ShowS
$cshowsPrec :: Int -> DNSHeader -> ShowS
Show)

-- | Raw data format for the flags of DNS Query and Response.
data DNSFlags = DNSFlags {
    DNSFlags -> QorR
qOrR         :: !QorR  -- ^ Query or response.
  , DNSFlags -> OPCODE
opcode       :: !OPCODE -- ^ Kind of query.
  , DNSFlags -> Bool
authAnswer   :: !Bool  -- ^ AA (Authoritative Answer) bit - this bit is valid in responses,
                           -- and specifies that the responding name server is an
                           -- authority for the domain name in question section.
  , DNSFlags -> Bool
trunCation   :: !Bool  -- ^ TC (Truncated Response) bit - specifies that this message was truncated
                           -- due to length greater than that permitted on the
                           -- transmission channel.
  , DNSFlags -> Bool
recDesired   :: !Bool  -- ^ RD (Recursion Desired) bit - this bit may be set in a query and
                           -- is copied into the response.  If RD is set, it directs
                           -- the name server to pursue the query recursively.
                           -- Recursive query support is optional.
  , DNSFlags -> Bool
recAvailable :: !Bool  -- ^ RA (Recursion Available) bit - this be is set or cleared in a
                           -- response, and denotes whether recursive query support is
                           -- available in the name server.

  , DNSFlags -> RCODE
rcode        :: !RCODE -- ^ The full 12-bit extended RCODE when EDNS is in use.
                           -- Should always be zero in well-formed requests.
                           -- When decoding replies, the high eight bits from
                           -- any EDNS response are combined with the 4-bit
                           -- RCODE from the DNS header.  When encoding
                           -- replies, if no EDNS OPT record is provided, RCODE
                           -- values > 15 are mapped to 'FormatErr'.
  , DNSFlags -> Bool
authenData   :: !Bool  -- ^ AD (Authenticated Data) bit - (RFC4035, Section 3.2.3).
  , DNSFlags -> Bool
chkDisable   :: !Bool  -- ^ CD (Checking Disabled) bit - (RFC4035, Section 3.2.2).
  } deriving (DNSFlags -> DNSFlags -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DNSFlags -> DNSFlags -> Bool
$c/= :: DNSFlags -> DNSFlags -> Bool
== :: DNSFlags -> DNSFlags -> Bool
$c== :: DNSFlags -> DNSFlags -> Bool
Eq, Int -> DNSFlags -> ShowS
[DNSFlags] -> ShowS
DNSFlags -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [DNSFlags] -> ShowS
$cshowList :: [DNSFlags] -> ShowS
show :: DNSFlags -> [Char]
$cshow :: DNSFlags -> [Char]
showsPrec :: Int -> DNSFlags -> ShowS
$cshowsPrec :: Int -> DNSFlags -> ShowS
Show)


-- | Default 'DNSFlags' record suitable for making recursive queries.  By default
-- the RD bit is set, and the AD and CD bits are cleared.
--
defaultDNSFlags :: DNSFlags
defaultDNSFlags :: DNSFlags
defaultDNSFlags = DNSFlags
         { qOrR :: QorR
qOrR         = QorR
QR_Query
         , opcode :: OPCODE
opcode       = OPCODE
OP_STD
         , authAnswer :: Bool
authAnswer   = Bool
False
         , trunCation :: Bool
trunCation   = Bool
False
         , recDesired :: Bool
recDesired   = Bool
True
         , recAvailable :: Bool
recAvailable = Bool
False
         , authenData :: Bool
authenData   = Bool
False
         , chkDisable :: Bool
chkDisable   = Bool
False
         , rcode :: RCODE
rcode        = RCODE
NoErr
         }

----------------------------------------------------------------

-- | 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
data FlagOp = 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
            deriving (FlagOp -> FlagOp -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FlagOp -> FlagOp -> Bool
$c/= :: FlagOp -> FlagOp -> Bool
== :: FlagOp -> FlagOp -> Bool
$c== :: FlagOp -> FlagOp -> Bool
Eq, Int -> FlagOp -> ShowS
[FlagOp] -> ShowS
FlagOp -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [FlagOp] -> ShowS
$cshowList :: [FlagOp] -> ShowS
show :: FlagOp -> [Char]
$cshow :: FlagOp -> [Char]
showsPrec :: Int -> FlagOp -> ShowS
$cshowsPrec :: Int -> FlagOp -> ShowS
Show)

-- $
-- Test associativity of the semigroup operation:
--
-- >>> let ops = [FlagSet, FlagClear, FlagReset, FlagKeep]
-- >>> foldl (&&) True [(a<>b)<>c == a<>(b<>c) | a <- ops, b <- ops, c <- ops]
-- True
--
instance Sem.Semigroup FlagOp where
    FlagOp
FlagKeep <> :: FlagOp -> FlagOp -> FlagOp
<> FlagOp
op = FlagOp
op
    FlagOp
op       <> FlagOp
_  = FlagOp
op

instance Monoid FlagOp where
    mempty :: FlagOp
mempty = FlagOp
FlagKeep
#if !(MIN_VERSION_base(4,11,0))
    -- this is redundant starting with base-4.11 / GHC 8.4
    -- if you want to avoid CPP, you can define `mappend = (<>)` unconditionally
    mappend = (Sem.<>)
#endif

-- | We don't show options left at their default value.
--
_skipDefault :: String
_skipDefault :: [Char]
_skipDefault = [Char]
""

-- | Show non-default flag values
--
_showFlag :: String -> FlagOp -> String
_showFlag :: [Char] -> FlagOp -> [Char]
_showFlag [Char]
nm FlagOp
FlagSet   = [Char]
nm forall a. [a] -> [a] -> [a]
++ [Char]
":1"
_showFlag [Char]
nm FlagOp
FlagClear = [Char]
nm forall a. [a] -> [a] -> [a]
++ [Char]
":0"
_showFlag [Char]
_  FlagOp
FlagReset = [Char]
_skipDefault
_showFlag [Char]
_  FlagOp
FlagKeep  = [Char]
_skipDefault

-- | Combine a list of options for display, skipping default values
--
_showOpts :: [String] -> String
_showOpts :: [[Char]] -> [Char]
_showOpts [[Char]]
os = forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"," forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
/= [Char]
_skipDefault) [[Char]]
os

----------------------------------------------------------------

-- | Control over query-related DNS header flags. As with function composition,
-- the left-most value has the last say.
--
data HeaderControls = HeaderControls
    { HeaderControls -> FlagOp
rdBit :: !FlagOp
    , HeaderControls -> FlagOp
adBit :: !FlagOp
    , HeaderControls -> FlagOp
cdBit :: !FlagOp
    }
    deriving (HeaderControls -> HeaderControls -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HeaderControls -> HeaderControls -> Bool
$c/= :: HeaderControls -> HeaderControls -> Bool
== :: HeaderControls -> HeaderControls -> Bool
$c== :: HeaderControls -> HeaderControls -> Bool
Eq)

instance Sem.Semigroup HeaderControls where
    (HeaderControls FlagOp
rd1 FlagOp
ad1 FlagOp
cd1) <> :: HeaderControls -> HeaderControls -> HeaderControls
<> (HeaderControls FlagOp
rd2 FlagOp
ad2 FlagOp
cd2) =
        FlagOp -> FlagOp -> FlagOp -> HeaderControls
HeaderControls (FlagOp
rd1 forall a. Semigroup a => a -> a -> a
<> FlagOp
rd2) (FlagOp
ad1 forall a. Semigroup a => a -> a -> a
<> FlagOp
ad2) (FlagOp
cd1 forall a. Semigroup a => a -> a -> a
<> FlagOp
cd2)

instance Monoid HeaderControls where
    mempty :: HeaderControls
mempty = FlagOp -> FlagOp -> FlagOp -> HeaderControls
HeaderControls FlagOp
FlagKeep FlagOp
FlagKeep FlagOp
FlagKeep
#if !(MIN_VERSION_base(4,11,0))
    -- this is redundant starting with base-4.11 / GHC 8.4
    -- if you want to avoid CPP, you can define `mappend = (<>)` unconditionally
    mappend = (Sem.<>)
#endif

instance Show HeaderControls where
    show :: HeaderControls -> [Char]
show (HeaderControls FlagOp
rd FlagOp
ad FlagOp
cd) =
        [[Char]] -> [Char]
_showOpts
             [ [Char] -> FlagOp -> [Char]
_showFlag [Char]
"rd" FlagOp
rd
             , [Char] -> FlagOp -> [Char]
_showFlag [Char]
"ad" FlagOp
ad
             , [Char] -> FlagOp -> [Char]
_showFlag [Char]
"cd" FlagOp
cd ]

----------------------------------------------------------------

-- | 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.
--
data ODataOp = ODataAdd [OData] -- ^ Add the specified options to the list.
             | ODataSet [OData] -- ^ Set the option list as specified.
             deriving (ODataOp -> ODataOp -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ODataOp -> ODataOp -> Bool
$c/= :: ODataOp -> ODataOp -> Bool
== :: ODataOp -> ODataOp -> Bool
$c== :: ODataOp -> ODataOp -> Bool
Eq)

-- | Since any given option code can appear at most once in the list, we
-- de-duplicate by the OPTION CODE when combining lists.
--
_odataDedup :: ODataOp -> [OData]
_odataDedup :: ODataOp -> [OData]
_odataDedup ODataOp
op =
    forall a. (a -> a -> Bool) -> [a] -> [a]
nubBy (forall a. Eq a => a -> a -> Bool
(==) forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` OData -> OptCode
_odataToOptCode) forall a b. (a -> b) -> a -> b
$
        case ODataOp
op of
            ODataAdd [OData]
os -> [OData]
os
            ODataSet [OData]
os -> [OData]
os

-- $
-- Test associativity of the OData semigroup operation:
--
-- >>> let ip1 = IPv4 $ read "127.0.0.0"
-- >>> let ip2 = IPv4 $ read "192.0.2.0"
-- >>> let cs1 = OD_ClientSubnet 8 0 ip1
-- >>> let cs2 = OD_ClientSubnet 24 0 ip2
-- >>> let cs3 = OD_ECSgeneric 0 24 0 "foo"
-- >>> let dau1 = OD_DAU [3,5,7,8]
-- >>> let dau2 = OD_DAU [13,14]
-- >>> let dhu1 = OD_DHU [1,2]
-- >>> let dhu2 = OD_DHU [3,4]
-- >>> let nsid = OD_NSID ""
-- >>> let ops1 = [ODataAdd [dau1, dau2, cs1], ODataAdd [dau2, cs2, dhu1]]
-- >>> let ops2 = [ODataSet [], ODataSet [dhu2, cs3], ODataSet [nsid]]
-- >>> let ops = ops1 ++ ops2
-- >>> foldl (&&) True [(a<>b)<>c == a<>(b<>c) | a <- ops, b <- ops, c <- ops]
-- True

instance Sem.Semigroup ODataOp where
    ODataAdd [OData]
as <> :: ODataOp -> ODataOp -> ODataOp
<> ODataAdd [OData]
bs = [OData] -> ODataOp
ODataAdd forall a b. (a -> b) -> a -> b
$ [OData]
as forall a. [a] -> [a] -> [a]
++ [OData]
bs
    ODataAdd [OData]
as <> ODataSet [OData]
bs = [OData] -> ODataOp
ODataSet forall a b. (a -> b) -> a -> b
$ [OData]
as forall a. [a] -> [a] -> [a]
++ [OData]
bs
    ODataSet [OData]
as <> ODataOp
_ = [OData] -> ODataOp
ODataSet [OData]
as

instance Monoid ODataOp where
    mempty :: ODataOp
mempty = [OData] -> ODataOp
ODataAdd []
#if !(MIN_VERSION_base(4,11,0))
    -- this is redundant starting with base-4.11 / GHC 8.4
    -- if you want to avoid CPP, you can define `mappend = (<>)` unconditionally
    mappend = (Sem.<>)
#endif

----------------------------------------------------------------

-- | EDNS query controls.  When EDNS is disabled via @ednsEnabled FlagClear@,
-- all the other EDNS-related overrides have no effect.
--
-- >>> ednsHeader $ makeEmptyQuery $ ednsEnabled FlagClear <> doFlag FlagSet
-- NoEDNS
data EdnsControls = EdnsControls
    { EdnsControls -> FlagOp
extEn :: !FlagOp         -- ^ Enabled
    , EdnsControls -> Maybe Word8
extVn :: !(Maybe Word8)  -- ^ Version
    , EdnsControls -> Maybe Word16
extSz :: !(Maybe Word16) -- ^ UDP Size
    , EdnsControls -> FlagOp
extDO :: !FlagOp         -- ^ DNSSEC OK (DO) bit
    , EdnsControls -> ODataOp
extOd :: !ODataOp        -- ^ EDNS option list tweaks
    }
    deriving (EdnsControls -> EdnsControls -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EdnsControls -> EdnsControls -> Bool
$c/= :: EdnsControls -> EdnsControls -> Bool
== :: EdnsControls -> EdnsControls -> Bool
$c== :: EdnsControls -> EdnsControls -> Bool
Eq)

-- | Apply all the query flag overrides to 'defaultDNSFlags', returning the

instance Sem.Semigroup EdnsControls where
    (EdnsControls FlagOp
en1 Maybe Word8
vn1 Maybe Word16
sz1 FlagOp
do1 ODataOp
od1) <> :: EdnsControls -> EdnsControls -> EdnsControls
<> (EdnsControls FlagOp
en2 Maybe Word8
vn2 Maybe Word16
sz2 FlagOp
do2 ODataOp
od2) =
        FlagOp
-> Maybe Word8 -> Maybe Word16 -> FlagOp -> ODataOp -> EdnsControls
EdnsControls (FlagOp
en1 forall a. Semigroup a => a -> a -> a
<> FlagOp
en2) (Maybe Word8
vn1 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Word8
vn2) (Maybe Word16
sz1 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Word16
sz2)
                    (FlagOp
do1 forall a. Semigroup a => a -> a -> a
<> FlagOp
do2) (ODataOp
od1 forall a. Semigroup a => a -> a -> a
<> ODataOp
od2)

instance Monoid EdnsControls where
    mempty :: EdnsControls
mempty = FlagOp
-> Maybe Word8 -> Maybe Word16 -> FlagOp -> ODataOp -> EdnsControls
EdnsControls FlagOp
FlagKeep forall a. Maybe a
Nothing forall a. Maybe a
Nothing FlagOp
FlagKeep forall a. Monoid a => a
mempty
#if !(MIN_VERSION_base(4,11,0))
    -- this is redundant starting with base-4.11 / GHC 8.4
    -- if you want to avoid CPP, you can define `mappend = (<>)` unconditionally
    mappend = (Sem.<>)
#endif

instance Show EdnsControls where
    show :: EdnsControls -> [Char]
show (EdnsControls FlagOp
en Maybe Word8
vn Maybe Word16
sz FlagOp
d0 ODataOp
od) =
        [[Char]] -> [Char]
_showOpts
            [ [Char] -> FlagOp -> [Char]
_showFlag [Char]
"edns.enabled" FlagOp
en
            , forall a. Show a => [Char] -> Maybe a -> [Char]
_showWord [Char]
"edns.version" Maybe Word8
vn
            , forall a. Show a => [Char] -> Maybe a -> [Char]
_showWord [Char]
"edns.udpsize" Maybe Word16
sz
            , [Char] -> FlagOp -> [Char]
_showFlag [Char]
"edns.dobit"   FlagOp
d0
            , [Char] -> [[Char]] -> [Char]
_showOdOp [Char]
"edns.options" forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall a. Show a => a -> [Char]
showforall b c a. (b -> c) -> (a -> b) -> a -> c
. OData -> OptCode
_odataToOptCode)
                                       forall a b. (a -> b) -> a -> b
$ ODataOp -> [OData]
_odataDedup ODataOp
od ]
      where
        _showWord :: Show a => String -> Maybe a -> String
        _showWord :: forall a. Show a => [Char] -> Maybe a -> [Char]
_showWord [Char]
nm Maybe a
w = forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Char]
_skipDefault (\a
s -> [Char]
nm forall a. [a] -> [a] -> [a]
++ [Char]
":" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show a
s) Maybe a
w

        _showOdOp :: String -> [String] -> String
        _showOdOp :: [Char] -> [[Char]] -> [Char]
_showOdOp [Char]
nm [[Char]]
os = case [[Char]]
os of
            [] -> [Char]
""
            [[Char]]
_  -> [Char]
nm forall a. [a] -> [a] -> [a]
++ [Char]
":[" forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"," [[Char]]
os forall a. [a] -> [a] -> [a]
++ [Char]
"]"

----------------------------------------------------------------

-- | 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]

data QueryControls = QueryControls
    { QueryControls -> HeaderControls
qctlHeader :: !HeaderControls
    , QueryControls -> EdnsControls
qctlEdns   :: !EdnsControls
    }
    deriving (QueryControls -> QueryControls -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: QueryControls -> QueryControls -> Bool
$c/= :: QueryControls -> QueryControls -> Bool
== :: QueryControls -> QueryControls -> Bool
$c== :: QueryControls -> QueryControls -> Bool
Eq)

instance Sem.Semigroup QueryControls where
    (QueryControls HeaderControls
fl1 EdnsControls
ex1) <> :: QueryControls -> QueryControls -> QueryControls
<> (QueryControls HeaderControls
fl2 EdnsControls
ex2) =
        HeaderControls -> EdnsControls -> QueryControls
QueryControls (HeaderControls
fl1 forall a. Semigroup a => a -> a -> a
<> HeaderControls
fl2) (EdnsControls
ex1 forall a. Semigroup a => a -> a -> a
<> EdnsControls
ex2)

instance Monoid QueryControls where
    mempty :: QueryControls
mempty = HeaderControls -> EdnsControls -> QueryControls
QueryControls forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty
#if !(MIN_VERSION_base(4,11,0))
    -- this is redundant starting with base-4.11 / GHC 8.4
    -- if you want to avoid CPP, you can define `mappend = (<>)` unconditionally
    mappend = (Sem.<>)
#endif

instance Show QueryControls where
    show :: QueryControls -> [Char]
show (QueryControls HeaderControls
fl EdnsControls
ex) = [[Char]] -> [Char]
_showOpts [ forall a. Show a => a -> [Char]
show HeaderControls
fl, forall a. Show a => a -> [Char]
show EdnsControls
ex ]

----------------------------------------------------------------

-- | Generator of 'QueryControls' that adjusts the RD bit.
--
-- >>> rdFlag FlagClear
-- rd:0
rdFlag :: FlagOp -> QueryControls
rdFlag :: FlagOp -> QueryControls
rdFlag FlagOp
rd = forall a. Monoid a => a
mempty { qctlHeader :: HeaderControls
qctlHeader = forall a. Monoid a => a
mempty { rdBit :: FlagOp
rdBit = FlagOp
rd } }

-- | Generator of 'QueryControls' that adjusts the AD bit.
--
-- >>> adFlag FlagSet
-- ad:1
adFlag :: FlagOp -> QueryControls
adFlag :: FlagOp -> QueryControls
adFlag FlagOp
ad = forall a. Monoid a => a
mempty { qctlHeader :: HeaderControls
qctlHeader = forall a. Monoid a => a
mempty { adBit :: FlagOp
adBit = FlagOp
ad } }

-- | Generator of 'QueryControls' that adjusts the CD bit.
--
-- >>> cdFlag FlagSet
-- cd:1
cdFlag :: FlagOp -> QueryControls
cdFlag :: FlagOp -> QueryControls
cdFlag FlagOp
cd = forall a. Monoid a => a
mempty { qctlHeader :: HeaderControls
qctlHeader = forall a. Monoid a => a
mempty { cdBit :: FlagOp
cdBit = FlagOp
cd } }

-- | 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
ednsEnabled :: FlagOp -> QueryControls
ednsEnabled :: FlagOp -> QueryControls
ednsEnabled FlagOp
en = forall a. Monoid a => a
mempty { qctlEdns :: EdnsControls
qctlEdns = forall a. Monoid a => a
mempty { extEn :: FlagOp
extEn = FlagOp
en } }

-- | 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
ednsSetVersion :: Maybe Word8 -> QueryControls
ednsSetVersion :: Maybe Word8 -> QueryControls
ednsSetVersion Maybe Word8
vn = forall a. Monoid a => a
mempty { qctlEdns :: EdnsControls
qctlEdns = forall a. Monoid a => a
mempty { extVn :: Maybe Word8
extVn = Maybe Word8
vn } }

-- | 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
ednsSetUdpSize :: Maybe Word16 -> QueryControls
ednsSetUdpSize :: Maybe Word16 -> QueryControls
ednsSetUdpSize Maybe Word16
sz = forall a. Monoid a => a
mempty { qctlEdns :: EdnsControls
qctlEdns = forall a. Monoid a => a
mempty { extSz :: Maybe Word16
extSz = Maybe Word16
sz } }

-- | Generator of 'QueryControls' that adjusts the 'EDNS' DnssecOk (DO) bit.
--
-- >>> doFlag FlagSet
-- edns.dobit:1
doFlag :: FlagOp -> QueryControls
doFlag :: FlagOp -> QueryControls
doFlag FlagOp
d0 = forall a. Monoid a => a
mempty { qctlEdns :: EdnsControls
qctlEdns = forall a. Monoid a => a
mempty { extDO :: FlagOp
extDO = FlagOp
d0 } }

-- | Generator of 'QueryControls' that adjusts the list of 'EDNS' options.
--
-- >>> :set -XOverloadedStrings
-- >>> ednsSetOptions (ODataAdd [OD_NSID ""])
-- edns.options:[NSID]
ednsSetOptions :: ODataOp -> QueryControls
ednsSetOptions :: ODataOp -> QueryControls
ednsSetOptions ODataOp
od = forall a. Monoid a => a
mempty { qctlEdns :: EdnsControls
qctlEdns = forall a. Monoid a => a
mempty { extOd :: ODataOp
extOd = ODataOp
od } }

----------------------------------------------------------------

-- | Query or response.
data QorR = QR_Query    -- ^ Query.
          | QR_Response -- ^ Response.
          deriving (QorR -> QorR -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: QorR -> QorR -> Bool
$c/= :: QorR -> QorR -> Bool
== :: QorR -> QorR -> Bool
$c== :: QorR -> QorR -> Bool
Eq, Int -> QorR -> ShowS
[QorR] -> ShowS
QorR -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [QorR] -> ShowS
$cshowList :: [QorR] -> ShowS
show :: QorR -> [Char]
$cshow :: QorR -> [Char]
showsPrec :: Int -> QorR -> ShowS
$cshowsPrec :: Int -> QorR -> ShowS
Show, Int -> QorR
QorR -> Int
QorR -> [QorR]
QorR -> QorR
QorR -> QorR -> [QorR]
QorR -> QorR -> QorR -> [QorR]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: QorR -> QorR -> QorR -> [QorR]
$cenumFromThenTo :: QorR -> QorR -> QorR -> [QorR]
enumFromTo :: QorR -> QorR -> [QorR]
$cenumFromTo :: QorR -> QorR -> [QorR]
enumFromThen :: QorR -> QorR -> [QorR]
$cenumFromThen :: QorR -> QorR -> [QorR]
enumFrom :: QorR -> [QorR]
$cenumFrom :: QorR -> [QorR]
fromEnum :: QorR -> Int
$cfromEnum :: QorR -> Int
toEnum :: Int -> QorR
$ctoEnum :: Int -> QorR
pred :: QorR -> QorR
$cpred :: QorR -> QorR
succ :: QorR -> QorR
$csucc :: QorR -> QorR
Enum, QorR
forall a. a -> a -> Bounded a
maxBound :: QorR
$cmaxBound :: QorR
minBound :: QorR
$cminBound :: QorR
Bounded)

-- | Kind of query.
data OPCODE
  = 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)
  deriving (OPCODE -> OPCODE -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OPCODE -> OPCODE -> Bool
$c/= :: OPCODE -> OPCODE -> Bool
== :: OPCODE -> OPCODE -> Bool
$c== :: OPCODE -> OPCODE -> Bool
Eq, Int -> OPCODE -> ShowS
[OPCODE] -> ShowS
OPCODE -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [OPCODE] -> ShowS
$cshowList :: [OPCODE] -> ShowS
show :: OPCODE -> [Char]
$cshow :: OPCODE -> [Char]
showsPrec :: Int -> OPCODE -> ShowS
$cshowsPrec :: Int -> OPCODE -> ShowS
Show, Int -> OPCODE
OPCODE -> Int
OPCODE -> [OPCODE]
OPCODE -> OPCODE
OPCODE -> OPCODE -> [OPCODE]
OPCODE -> OPCODE -> OPCODE -> [OPCODE]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: OPCODE -> OPCODE -> OPCODE -> [OPCODE]
$cenumFromThenTo :: OPCODE -> OPCODE -> OPCODE -> [OPCODE]
enumFromTo :: OPCODE -> OPCODE -> [OPCODE]
$cenumFromTo :: OPCODE -> OPCODE -> [OPCODE]
enumFromThen :: OPCODE -> OPCODE -> [OPCODE]
$cenumFromThen :: OPCODE -> OPCODE -> [OPCODE]
enumFrom :: OPCODE -> [OPCODE]
$cenumFrom :: OPCODE -> [OPCODE]
fromEnum :: OPCODE -> Int
$cfromEnum :: OPCODE -> Int
toEnum :: Int -> OPCODE
$ctoEnum :: Int -> OPCODE
pred :: OPCODE -> OPCODE
$cpred :: OPCODE -> OPCODE
succ :: OPCODE -> OPCODE
$csucc :: OPCODE -> OPCODE
Enum, OPCODE
forall a. a -> a -> Bounded a
maxBound :: OPCODE
$cmaxBound :: OPCODE
minBound :: OPCODE
$cminBound :: OPCODE
Bounded)

-- | Convert a 16-bit DNS OPCODE number to its internal representation
--
toOPCODE :: Word16 -> Maybe OPCODE
toOPCODE :: Word16 -> Maybe OPCODE
toOPCODE Word16
i = case Word16
i of
  Word16
0 -> forall a. a -> Maybe a
Just OPCODE
OP_STD
  Word16
1 -> forall a. a -> Maybe a
Just OPCODE
OP_INV
  Word16
2 -> forall a. a -> Maybe a
Just OPCODE
OP_SSR
  -- OPCODE 3 is unassigned
  Word16
4 -> forall a. a -> Maybe a
Just OPCODE
OP_NOTIFY
  Word16
5 -> forall a. a -> Maybe a
Just OPCODE
OP_UPDATE
  Word16
_ -> forall a. Maybe a
Nothing

-- | Convert the internal representation of a DNS OPCODE to its 16-bit numeric
-- value.
--
fromOPCODE :: OPCODE -> Word16
fromOPCODE :: OPCODE -> Word16
fromOPCODE OPCODE
OP_STD    = Word16
0
fromOPCODE OPCODE
OP_INV    = Word16
1
fromOPCODE OPCODE
OP_SSR    = Word16
2
fromOPCODE OPCODE
OP_NOTIFY = Word16
4
fromOPCODE OPCODE
OP_UPDATE = Word16
5

----------------------------------------------------------------

-- | 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.
newtype RCODE = RCODE {
    -- | Convert an 'RCODE' to its numeric value.
    RCODE -> Word16
fromRCODE :: Word16
  } deriving (RCODE -> RCODE -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RCODE -> RCODE -> Bool
$c/= :: RCODE -> RCODE -> Bool
== :: RCODE -> RCODE -> Bool
$c== :: RCODE -> RCODE -> Bool
Eq)

-- | Provide an Enum instance for backwards compatibility
instance Enum RCODE where
    fromEnum :: RCODE -> Int
fromEnum = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. RCODE -> Word16
fromRCODE
    toEnum :: Int -> RCODE
toEnum = Word16 -> RCODE
RCODE forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- | No error condition.
pattern NoErr     :: RCODE
pattern $bNoErr :: RCODE
$mNoErr :: forall {r}. RCODE -> ((# #) -> r) -> ((# #) -> r) -> r
NoErr      = RCODE  0
-- | Format error - The name server was
--   unable to interpret the query.
pattern FormatErr :: RCODE
pattern $bFormatErr :: RCODE
$mFormatErr :: forall {r}. RCODE -> ((# #) -> r) -> ((# #) -> r) -> r
FormatErr  = RCODE  1
-- | Server failure - The name server was
--   unable to process this query due to a
--   problem with the name server.
pattern ServFail  :: RCODE
pattern $bServFail :: RCODE
$mServFail :: forall {r}. RCODE -> ((# #) -> r) -> ((# #) -> r) -> r
ServFail   = RCODE  2
-- | 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 NameErr   :: RCODE
pattern $bNameErr :: RCODE
$mNameErr :: forall {r}. RCODE -> ((# #) -> r) -> ((# #) -> r) -> r
NameErr    = RCODE  3
-- | Not Implemented - The name server does
--   not support the requested kind of query.
pattern NotImpl   :: RCODE
pattern $bNotImpl :: RCODE
$mNotImpl :: forall {r}. RCODE -> ((# #) -> r) -> ((# #) -> r) -> r
NotImpl    = RCODE  4
-- | 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 Refused   :: RCODE
pattern $bRefused :: RCODE
$mRefused :: forall {r}. RCODE -> ((# #) -> r) -> ((# #) -> r) -> r
Refused    = RCODE  5
-- | YXDomain - Dynamic update response, a pre-requisite domain that should not
-- exist, does exist.
pattern YXDomain :: RCODE
pattern $bYXDomain :: RCODE
$mYXDomain :: forall {r}. RCODE -> ((# #) -> r) -> ((# #) -> r) -> r
YXDomain  = RCODE 6
-- | YXRRSet - Dynamic update response, a pre-requisite RRSet that should not
-- exist, does exist.
pattern YXRRSet  :: RCODE
pattern $bYXRRSet :: RCODE
$mYXRRSet :: forall {r}. RCODE -> ((# #) -> r) -> ((# #) -> r) -> r
YXRRSet   = RCODE 7
-- | NXRRSet - Dynamic update response, a pre-requisite RRSet that should
-- exist, does not exist.
pattern NXRRSet  :: RCODE
pattern $bNXRRSet :: RCODE
$mNXRRSet :: forall {r}. RCODE -> ((# #) -> r) -> ((# #) -> r) -> r
NXRRSet   = RCODE 8
-- | NotAuth - Dynamic update response, the server is not authoritative for the
-- zone named in the Zone Section.
pattern NotAuth  :: RCODE
pattern $bNotAuth :: RCODE
$mNotAuth :: forall {r}. RCODE -> ((# #) -> r) -> ((# #) -> r) -> r
NotAuth   = RCODE 9
-- | NotZone - Dynamic update response, a name used in the Prerequisite or
-- Update Section is not within the zone denoted by the Zone Section.
pattern NotZone  :: RCODE
pattern $bNotZone :: RCODE
$mNotZone :: forall {r}. RCODE -> ((# #) -> r) -> ((# #) -> r) -> r
NotZone   = RCODE 10
-- | Bad OPT Version (BADVERS, RFC 6891).
pattern BadVers   :: RCODE
pattern $bBadVers :: RCODE
$mBadVers :: forall {r}. RCODE -> ((# #) -> r) -> ((# #) -> r) -> r
BadVers    = RCODE 16
-- | Key not recognized [RFC2845]
pattern BadKey    :: RCODE
pattern $bBadKey :: RCODE
$mBadKey :: forall {r}. RCODE -> ((# #) -> r) -> ((# #) -> r) -> r
BadKey     = RCODE 17
-- | Signature out of time window [RFC2845]
pattern BadTime   :: RCODE
pattern $bBadTime :: RCODE
$mBadTime :: forall {r}. RCODE -> ((# #) -> r) -> ((# #) -> r) -> r
BadTime    = RCODE 18
-- | Bad TKEY Mode [RFC2930]
pattern BadMode   :: RCODE
pattern $bBadMode :: RCODE
$mBadMode :: forall {r}. RCODE -> ((# #) -> r) -> ((# #) -> r) -> r
BadMode    = RCODE 19
-- | Duplicate key name [RFC2930]
pattern BadName   :: RCODE
pattern $bBadName :: RCODE
$mBadName :: forall {r}. RCODE -> ((# #) -> r) -> ((# #) -> r) -> r
BadName    = RCODE 20
-- | Algorithm not supported [RFC2930]
pattern BadAlg    :: RCODE
pattern $bBadAlg :: RCODE
$mBadAlg :: forall {r}. RCODE -> ((# #) -> r) -> ((# #) -> r) -> r
BadAlg     = RCODE 21
-- | Bad Truncation [RFC4635]
pattern BadTrunc  :: RCODE
pattern $bBadTrunc :: RCODE
$mBadTrunc :: forall {r}. RCODE -> ((# #) -> r) -> ((# #) -> r) -> r
BadTrunc   = RCODE 22
-- | Bad/missing Server Cookie [RFC7873]
pattern BadCookie :: RCODE
pattern $bBadCookie :: RCODE
$mBadCookie :: forall {r}. RCODE -> ((# #) -> r) -> ((# #) -> r) -> r
BadCookie  = RCODE 23
-- | 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 'FormatErr'.  When
-- an EDNS message is malformed, and we're unable to extract the extended RCODE,
-- the header 'rcode' is set to 'BadRCODE'.
pattern BadRCODE  :: RCODE
pattern $bBadRCODE :: RCODE
$mBadRCODE :: forall {r}. RCODE -> ((# #) -> r) -> ((# #) -> r) -> r
BadRCODE   = RCODE 0x1001

-- | Use https://tools.ietf.org/html/rfc2929#section-2.3 names for DNS RCODEs
instance Show RCODE where
    show :: RCODE -> [Char]
show RCODE
NoErr     = [Char]
"NoError"
    show RCODE
FormatErr = [Char]
"FormErr"
    show RCODE
ServFail  = [Char]
"ServFail"
    show RCODE
NameErr   = [Char]
"NXDomain"
    show RCODE
NotImpl   = [Char]
"NotImp"
    show RCODE
Refused   = [Char]
"Refused"
    show RCODE
YXDomain  = [Char]
"YXDomain"
    show RCODE
YXRRSet   = [Char]
"YXRRSet"
    show RCODE
NotAuth   = [Char]
"NotAuth"
    show RCODE
NotZone   = [Char]
"NotZone"
    show RCODE
BadVers   = [Char]
"BadVers"
    show RCODE
BadKey    = [Char]
"BadKey"
    show RCODE
BadTime   = [Char]
"BadTime"
    show RCODE
BadMode   = [Char]
"BadMode"
    show RCODE
BadName   = [Char]
"BadName"
    show RCODE
BadAlg    = [Char]
"BadAlg"
    show RCODE
BadTrunc  = [Char]
"BadTrunc"
    show RCODE
BadCookie = [Char]
"BadCookie"
    show RCODE
x         = [Char]
"RCODE " forall a. [a] -> [a] -> [a]
++ (forall a. Show a => a -> [Char]
show forall a b. (a -> b) -> a -> b
$ RCODE -> Word16
fromRCODE RCODE
x)

-- | 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.
toRCODE :: Word16 -> RCODE
toRCODE :: Word16 -> RCODE
toRCODE = Word16 -> RCODE
RCODE

----------------------------------------------------------------

-- XXX: The Question really should also include the CLASS
--
-- | Raw data format for DNS questions.
data Question = Question {
    Question -> Domain
qname  :: Domain -- ^ A domain name
  , Question -> TYPE
qtype  :: TYPE   -- ^ The type of the query
  } deriving (Question -> Question -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Question -> Question -> Bool
$c/= :: Question -> Question -> Bool
== :: Question -> Question -> Bool
$c== :: Question -> Question -> Bool
Eq, Int -> Question -> ShowS
[Question] -> ShowS
Question -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Question] -> ShowS
$cshowList :: [Question] -> ShowS
show :: Question -> [Char]
$cshow :: Question -> [Char]
showsPrec :: Int -> Question -> ShowS
$cshowsPrec :: Int -> Question -> ShowS
Show)

----------------------------------------------------------------

-- | Resource record class.
type CLASS = Word16

-- | Resource record class for the Internet.
classIN :: CLASS
classIN :: Word16
classIN = Word16
1

-- | Time to live in second.
type TTL = Word32

-- | Raw data format for resource records.
data ResourceRecord = ResourceRecord {
    ResourceRecord -> Domain
rrname  :: !Domain -- ^ Name
  , ResourceRecord -> TYPE
rrtype  :: !TYPE   -- ^ Resource record type
  , ResourceRecord -> Word16
rrclass :: !CLASS  -- ^ Resource record class
  , ResourceRecord -> Word32
rrttl   :: !TTL    -- ^ Time to live
  , ResourceRecord -> RData
rdata   :: !RData  -- ^ Resource data
  } deriving (ResourceRecord -> ResourceRecord -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ResourceRecord -> ResourceRecord -> Bool
$c/= :: ResourceRecord -> ResourceRecord -> Bool
== :: ResourceRecord -> ResourceRecord -> Bool
$c== :: ResourceRecord -> ResourceRecord -> Bool
Eq,Int -> ResourceRecord -> ShowS
Answers -> ShowS
ResourceRecord -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: Answers -> ShowS
$cshowList :: Answers -> ShowS
show :: ResourceRecord -> [Char]
$cshow :: ResourceRecord -> [Char]
showsPrec :: Int -> ResourceRecord -> ShowS
$cshowsPrec :: Int -> ResourceRecord -> ShowS
Show)

----------------------------------------------------------------

-- | Given a 32-bit circle-arithmetic DNS time, and the current absolute epoch
-- time, return the epoch time corresponding to the DNS timestamp.
--
dnsTime :: Word32 -- ^ DNS circle-arithmetic timestamp
        -> Int64  -- ^ current epoch time
        -> Int64  -- ^ absolute DNS timestamp
dnsTime :: Word32 -> Int64 -> Int64
dnsTime Word32
tdns Int64
tnow =
    let delta :: Word32
delta = Word32
tdns forall a. Num a => a -> a -> a
- forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
tnow
     in if Word32
delta forall a. Ord a => a -> a -> Bool
> Word32
0x7FFFFFFF -- tdns is in the past?
           then Int64
tnow forall a. Num a => a -> a -> a
- (Int64
0x100000000 forall a. Num a => a -> a -> a
- forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
delta)
           else Int64
tnow forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
delta

-- | RRSIG representation.
--
-- As noted in
-- <https://tools.ietf.org/html/rfc4034#section-3.1.5 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.
--
data RD_RRSIG = RDREP_RRSIG
    { RD_RRSIG -> TYPE
rrsigType       :: !TYPE       -- ^ RRtype of RRset signed
    , RD_RRSIG -> Word8
rrsigKeyAlg     :: !Word8      -- ^ DNSKEY algorithm
    , RD_RRSIG -> Word8
rrsigNumLabels  :: !Word8      -- ^ Number of labels signed
    , RD_RRSIG -> Word32
rrsigTTL        :: !Word32     -- ^ Maximum origin TTL
    , RD_RRSIG -> Int64
rrsigExpiration :: !Int64      -- ^ Time last valid
    , RD_RRSIG -> Int64
rrsigInception  :: !Int64      -- ^ Time first valid
    , RD_RRSIG -> Word16
rrsigKeyTag     :: !Word16     -- ^ Signing key tag
    , RD_RRSIG -> Domain
rrsigZone       :: !Domain     -- ^ Signing domain
    , RD_RRSIG -> Domain
rrsigValue      :: !ByteString -- ^ Opaque signature
    }
    deriving (RD_RRSIG -> RD_RRSIG -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RD_RRSIG -> RD_RRSIG -> Bool
$c/= :: RD_RRSIG -> RD_RRSIG -> Bool
== :: RD_RRSIG -> RD_RRSIG -> Bool
$c== :: RD_RRSIG -> RD_RRSIG -> Bool
Eq, Eq RD_RRSIG
RD_RRSIG -> RD_RRSIG -> Bool
RD_RRSIG -> RD_RRSIG -> Ordering
RD_RRSIG -> RD_RRSIG -> RD_RRSIG
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: RD_RRSIG -> RD_RRSIG -> RD_RRSIG
$cmin :: RD_RRSIG -> RD_RRSIG -> RD_RRSIG
max :: RD_RRSIG -> RD_RRSIG -> RD_RRSIG
$cmax :: RD_RRSIG -> RD_RRSIG -> RD_RRSIG
>= :: RD_RRSIG -> RD_RRSIG -> Bool
$c>= :: RD_RRSIG -> RD_RRSIG -> Bool
> :: RD_RRSIG -> RD_RRSIG -> Bool
$c> :: RD_RRSIG -> RD_RRSIG -> Bool
<= :: RD_RRSIG -> RD_RRSIG -> Bool
$c<= :: RD_RRSIG -> RD_RRSIG -> Bool
< :: RD_RRSIG -> RD_RRSIG -> Bool
$c< :: RD_RRSIG -> RD_RRSIG -> Bool
compare :: RD_RRSIG -> RD_RRSIG -> Ordering
$ccompare :: RD_RRSIG -> RD_RRSIG -> Ordering
Ord)

instance Show RD_RRSIG where
    show :: RD_RRSIG -> [Char]
show RDREP_RRSIG{Int64
Word8
Word16
Word32
Domain
TYPE
rrsigValue :: Domain
rrsigZone :: Domain
rrsigKeyTag :: Word16
rrsigInception :: Int64
rrsigExpiration :: Int64
rrsigTTL :: Word32
rrsigNumLabels :: Word8
rrsigKeyAlg :: Word8
rrsigType :: TYPE
rrsigValue :: RD_RRSIG -> Domain
rrsigZone :: RD_RRSIG -> Domain
rrsigKeyTag :: RD_RRSIG -> Word16
rrsigInception :: RD_RRSIG -> Int64
rrsigExpiration :: RD_RRSIG -> Int64
rrsigTTL :: RD_RRSIG -> Word32
rrsigNumLabels :: RD_RRSIG -> Word8
rrsigKeyAlg :: RD_RRSIG -> Word8
rrsigType :: RD_RRSIG -> TYPE
..} = [[Char]] -> [Char]
unwords
        [ forall a. Show a => a -> [Char]
show TYPE
rrsigType
        , forall a. Show a => a -> [Char]
show Word8
rrsigKeyAlg
        , forall a. Show a => a -> [Char]
show Word8
rrsigNumLabels
        , forall a. Show a => a -> [Char]
show Word32
rrsigTTL
        , Int64 -> [Char]
showTime Int64
rrsigExpiration
        , Int64 -> [Char]
showTime Int64
rrsigInception
        , forall a. Show a => a -> [Char]
show Word16
rrsigKeyTag
        , Domain -> [Char]
BS.unpack Domain
rrsigZone
        , Domain -> [Char]
_b64encode Domain
rrsigValue
        ]
      where
        showTime :: Int64 -> String
        showTime :: Int64 -> [Char]
showTime Int64
t = forall format t.
(TimeFormat format, Timeable t) =>
format -> t -> [Char]
H.timePrint [TimeFormatElem]
fmt forall a b. (a -> b) -> a -> b
$ Seconds -> Elapsed
H.Elapsed forall a b. (a -> b) -> a -> b
$ Int64 -> Seconds
H.Seconds Int64
t
          where
            fmt :: [TimeFormatElem]
fmt = [ TimeFormatElem
H.Format_Year4, TimeFormatElem
H.Format_Month2, TimeFormatElem
H.Format_Day2
                  , TimeFormatElem
H.Format_Hour,  TimeFormatElem
H.Format_Minute, TimeFormatElem
H.Format_Second ]

-- | Raw data format for each type.
data RData = 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
    deriving (RData -> RData -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RData -> RData -> Bool
$c/= :: RData -> RData -> Bool
== :: RData -> RData -> Bool
$c== :: RData -> RData -> Bool
Eq, Eq RData
RData -> RData -> Bool
RData -> RData -> Ordering
RData -> RData -> RData
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: RData -> RData -> RData
$cmin :: RData -> RData -> RData
max :: RData -> RData -> RData
$cmax :: RData -> RData -> RData
>= :: RData -> RData -> Bool
$c>= :: RData -> RData -> Bool
> :: RData -> RData -> Bool
$c> :: RData -> RData -> Bool
<= :: RData -> RData -> Bool
$c<= :: RData -> RData -> Bool
< :: RData -> RData -> Bool
$c< :: RData -> RData -> Bool
compare :: RData -> RData -> Ordering
$ccompare :: RData -> RData -> Ordering
Ord)

instance Show RData where
  show :: RData -> [Char]
show RData
rd = case RData
rd of
      RD_A                  IPv4
address -> forall a. Show a => a -> [Char]
show IPv4
address
      RD_NS                 Domain
nsdname -> Domain -> [Char]
showDomain Domain
nsdname
      RD_CNAME                Domain
cname -> Domain -> [Char]
showDomain Domain
cname
      RD_SOA          Domain
a Domain
b Word32
c Word32
d Word32
e Word32
f Word32
g -> forall {a} {a} {a} {a} {a}.
(Show a, Show a, Show a, Show a, Show a) =>
Domain -> Domain -> a -> a -> a -> a -> a -> [Char]
showSOA Domain
a Domain
b Word32
c Word32
d Word32
e Word32
f Word32
g
      RD_NULL                 Domain
bytes -> Domain -> [Char]
showOpaque Domain
bytes
      RD_PTR               Domain
ptrdname -> Domain -> [Char]
showDomain Domain
ptrdname
      RD_MX               Word16
pref Domain
exch -> forall {a}. Show a => a -> Domain -> [Char]
showMX Word16
pref Domain
exch
      RD_TXT             Domain
textstring -> Domain -> [Char]
showTXT Domain
textstring
      RD_RP              Domain
mbox Domain
dname -> Domain -> Domain -> [Char]
showRP Domain
mbox Domain
dname
      RD_AAAA               IPv6
address -> forall a. Show a => a -> [Char]
show IPv6
address
      RD_SRV        Word16
pri Word16
wei Word16
prt Domain
tgt -> forall {a} {a} {a}.
(Show a, Show a, Show a) =>
a -> a -> a -> Domain -> [Char]
showSRV Word16
pri Word16
wei Word16
prt Domain
tgt
      RD_DNAME               Domain
target -> Domain -> [Char]
showDomain Domain
target
      RD_OPT                [OData]
options -> forall a. Show a => a -> [Char]
show [OData]
options
      RD_DS          Word16
tag Word8
alg Word8
dalg Domain
d -> forall {a} {a} {a}.
(Show a, Show a, Show a) =>
a -> a -> a -> Domain -> [Char]
showDS Word16
tag Word8
alg Word8
dalg Domain
d
      RD_RRSIG                RD_RRSIG
rrsig -> forall a. Show a => a -> [Char]
show RD_RRSIG
rrsig
      RD_NSEC            Domain
next [TYPE]
types -> forall {a}. Show a => Domain -> [a] -> [Char]
showNSEC Domain
next [TYPE]
types
      RD_DNSKEY             Word16
f Word8
p Word8
a Domain
k -> forall {a} {a} {a}.
(Show a, Show a, Show a) =>
a -> a -> a -> Domain -> [Char]
showDNSKEY Word16
f Word8
p Word8
a Domain
k
      RD_NSEC3      Word8
a Word8
f Word16
i Domain
s Domain
h [TYPE]
types -> forall {a} {a} {a} {a}.
(Show a, Show a, Show a, Show a) =>
a -> a -> a -> Domain -> Domain -> [a] -> [Char]
showNSEC3 Word8
a Word8
f Word16
i Domain
s Domain
h [TYPE]
types
      RD_NSEC3PARAM         Word8
a Word8
f Word16
i Domain
s -> forall {a} {a} {a}.
(Show a, Show a, Show a) =>
a -> a -> a -> Domain -> [Char]
showNSEC3PARAM Word8
a Word8
f Word16
i Domain
s
      RD_TLSA               Word8
u Word8
s Word8
m Domain
d -> forall {a} {a} {a}.
(Show a, Show a, Show a) =>
a -> a -> a -> Domain -> [Char]
showTLSA Word8
u Word8
s Word8
m Domain
d
      RD_CDS         Word16
tag Word8
alg Word8
dalg Domain
d -> forall {a} {a} {a}.
(Show a, Show a, Show a) =>
a -> a -> a -> Domain -> [Char]
showDS Word16
tag Word8
alg Word8
dalg Domain
d
      RD_CDNSKEY            Word16
f Word8
p Word8
a Domain
k -> forall {a} {a} {a}.
(Show a, Show a, Show a) =>
a -> a -> a -> Domain -> [Char]
showDNSKEY Word16
f Word8
p Word8
a Domain
k
      RD_CAA                  Word8
f CI Domain
t Domain
v -> forall {a} {a}. (Show a, Show a) => a -> CI Domain -> a -> [Char]
showCAA Word8
f CI Domain
t Domain
v
      UnknownRData            Domain
bytes -> Domain -> [Char]
showOpaque Domain
bytes
    where
      showSalt :: Domain -> [Char]
showSalt Domain
""    = [Char]
"-"
      showSalt Domain
salt  = Domain -> [Char]
_b16encode Domain
salt
      showDomain :: Domain -> [Char]
showDomain = Domain -> [Char]
BS.unpack
      showSOA :: Domain -> Domain -> a -> a -> a -> a -> a -> [Char]
showSOA Domain
mname Domain
rname a
serial a
refresh a
retry a
expire a
minttl =
          Domain -> [Char]
showDomain Domain
mname forall a. [a] -> [a] -> [a]
++ [Char]
" " forall a. [a] -> [a] -> [a]
++ Domain -> [Char]
showDomain Domain
rname forall a. [a] -> [a] -> [a]
++ [Char]
" " forall a. [a] -> [a] -> [a]
++
          forall a. Show a => a -> [Char]
show a
serial forall a. [a] -> [a] -> [a]
++ [Char]
" " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show a
refresh forall a. [a] -> [a] -> [a]
++ [Char]
" " forall a. [a] -> [a] -> [a]
++
          forall a. Show a => a -> [Char]
show a
retry forall a. [a] -> [a] -> [a]
++ [Char]
" " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show a
expire forall a. [a] -> [a] -> [a]
++ [Char]
" " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show a
minttl
      showMX :: a -> Domain -> [Char]
showMX a
preference Domain
exchange =
          forall a. Show a => a -> [Char]
show a
preference forall a. [a] -> [a] -> [a]
++ [Char]
" " forall a. [a] -> [a] -> [a]
++ Domain -> [Char]
showDomain Domain
exchange
      showTXT :: Domain -> [Char]
showTXT Domain
bs = Char
'"' forall a. a -> [a] -> [a]
: forall a. (Word8 -> a -> a) -> a -> Domain -> a
B.foldr Word8 -> ShowS
dnsesc [Char
'"'] Domain
bs
        where
          c2w :: Char -> Word8
c2w = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Enum a => a -> Int
fromEnum
          w2c :: Word8 -> Char
w2c = forall a. Enum a => Int -> a
toEnum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral
          doubleQuote :: Word8
doubleQuote = Char -> Word8
c2w Char
'"'
          backSlash :: Word8
backSlash   = Char -> Word8
c2w Char
'\\'
          dnsesc :: Word8 -> ShowS
dnsesc Word8
c [Char]
s
              | Word8
c forall a. Eq a => a -> a -> Bool
== Word8
doubleQuote   = Char
'\\' forall a. a -> [a] -> [a]
: Word8 -> Char
w2c Word8
c forall a. a -> [a] -> [a]
: [Char]
s
              | Word8
c forall a. Eq a => a -> a -> Bool
== Word8
backSlash     = Char
'\\' forall a. a -> [a] -> [a]
: Word8 -> Char
w2c Word8
c forall a. a -> [a] -> [a]
: [Char]
s
              | Word8
c forall a. Ord a => a -> a -> Bool
>= Word8
32 Bool -> Bool -> Bool
&& Word8
c forall a. Ord a => a -> a -> Bool
< Word8
127 =        Word8 -> Char
w2c Word8
c forall a. a -> [a] -> [a]
: [Char]
s
              | Bool
otherwise          = Char
'\\' forall a. a -> [a] -> [a]
: forall {p}. Integral p => p -> ShowS
ddd Word8
c   [Char]
s
          ddd :: p -> ShowS
ddd p
c [Char]
s =
              let (Int
q100, Int
r100) = forall a. Integral a => a -> a -> (a, a)
divMod (forall a b. (Integral a, Num b) => a -> b
fromIntegral p
c) Int
100
                  (Int
q10, Int
r10) = forall a. Integral a => a -> a -> (a, a)
divMod Int
r100 Int
10
               in Int -> Char
intToDigit Int
q100 forall a. a -> [a] -> [a]
: Int -> Char
intToDigit Int
q10 forall a. a -> [a] -> [a]
: Int -> Char
intToDigit Int
r10 forall a. a -> [a] -> [a]
: [Char]
s
      showRP :: Domain -> Domain -> [Char]
showRP Domain
mbox Domain
dname = Domain -> [Char]
showDomain Domain
mbox forall a. [a] -> [a] -> [a]
++ [Char]
" " forall a. [a] -> [a] -> [a]
++ Domain -> [Char]
showDomain Domain
dname
      showSRV :: a -> a -> a -> Domain -> [Char]
showSRV a
priority a
weight a
port Domain
target =
          forall a. Show a => a -> [Char]
show a
priority forall a. [a] -> [a] -> [a]
++ [Char]
" " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show a
weight forall a. [a] -> [a] -> [a]
++ [Char]
" " forall a. [a] -> [a] -> [a]
++
          forall a. Show a => a -> [Char]
show a
port forall a. [a] -> [a] -> [a]
++ [Char]
" " forall a. [a] -> [a] -> [a]
++ Domain -> [Char]
BS.unpack Domain
target
      showDS :: a -> a -> a -> Domain -> [Char]
showDS a
keytag a
alg a
digestType Domain
digest =
          forall a. Show a => a -> [Char]
show a
keytag forall a. [a] -> [a] -> [a]
++ [Char]
" " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show a
alg forall a. [a] -> [a] -> [a]
++ [Char]
" " forall a. [a] -> [a] -> [a]
++
          forall a. Show a => a -> [Char]
show a
digestType forall a. [a] -> [a] -> [a]
++ [Char]
" " forall a. [a] -> [a] -> [a]
++ Domain -> [Char]
_b16encode Domain
digest
      showNSEC :: Domain -> [a] -> [Char]
showNSEC Domain
next [a]
types =
          [[Char]] -> [Char]
unwords forall a b. (a -> b) -> a -> b
$ Domain -> [Char]
showDomain Domain
next forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map forall a. Show a => a -> [Char]
show [a]
types
      showDNSKEY :: a -> a -> a -> Domain -> [Char]
showDNSKEY a
flags a
protocol a
alg Domain
key =
          forall a. Show a => a -> [Char]
show a
flags forall a. [a] -> [a] -> [a]
++ [Char]
" " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show a
protocol forall a. [a] -> [a] -> [a]
++ [Char]
" " forall a. [a] -> [a] -> [a]
++
          forall a. Show a => a -> [Char]
show a
alg forall a. [a] -> [a] -> [a]
++ [Char]
" " forall a. [a] -> [a] -> [a]
++ Domain -> [Char]
_b64encode Domain
key
      -- | <https://tools.ietf.org/html/rfc5155#section-3.2>
      showNSEC3 :: a -> a -> a -> Domain -> Domain -> [a] -> [Char]
showNSEC3 a
hashalg a
flags a
iterations Domain
salt Domain
nexthash [a]
types =
          [[Char]] -> [Char]
unwords forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> [Char]
show a
hashalg forall a. a -> [a] -> [a]
: forall a. Show a => a -> [Char]
show a
flags forall a. a -> [a] -> [a]
: forall a. Show a => a -> [Char]
show a
iterations forall a. a -> [a] -> [a]
:
                    Domain -> [Char]
showSalt Domain
salt forall a. a -> [a] -> [a]
: Domain -> [Char]
_b32encode Domain
nexthash forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map forall a. Show a => a -> [Char]
show [a]
types
      showNSEC3PARAM :: a -> a -> a -> Domain -> [Char]
showNSEC3PARAM a
hashAlg a
flags a
iterations Domain
salt =
          forall a. Show a => a -> [Char]
show a
hashAlg forall a. [a] -> [a] -> [a]
++ [Char]
" " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show a
flags forall a. [a] -> [a] -> [a]
++ [Char]
" " forall a. [a] -> [a] -> [a]
++
          forall a. Show a => a -> [Char]
show a
iterations forall a. [a] -> [a] -> [a]
++ [Char]
" " forall a. [a] -> [a] -> [a]
++ Domain -> [Char]
showSalt Domain
salt
      showTLSA :: a -> a -> a -> Domain -> [Char]
showTLSA a
usage a
selector a
mtype Domain
digest =
          forall a. Show a => a -> [Char]
show a
usage forall a. [a] -> [a] -> [a]
++ [Char]
" " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show a
selector forall a. [a] -> [a] -> [a]
++ [Char]
" " forall a. [a] -> [a] -> [a]
++
          forall a. Show a => a -> [Char]
show a
mtype forall a. [a] -> [a] -> [a]
++ [Char]
" " forall a. [a] -> [a] -> [a]
++ Domain -> [Char]
_b16encode Domain
digest
      showCAA :: a -> CI Domain -> a -> [Char]
showCAA a
flags CI Domain
tag a
value =
          forall a. Show a => a -> [Char]
show a
flags forall a. [a] -> [a] -> [a]
++ [Char]
" " forall a. [a] -> [a] -> [a]
++ Domain -> [Char]
BS.unpack (forall s. CI s -> s
CI.original CI Domain
tag) forall a. [a] -> [a] -> [a]
++ [Char]
" " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show a
value
      -- | Opaque RData: <https://tools.ietf.org/html/rfc3597#section-5>
      showOpaque :: Domain -> [Char]
showOpaque Domain
bs = [[Char]] -> [Char]
unwords [[Char]
"\\#", forall a. Show a => a -> [Char]
show (Domain -> Int
BS.length Domain
bs), Domain -> [Char]
_b16encode Domain
bs]

_b16encode, _b32encode, _b64encode :: ByteString -> String
_b16encode :: Domain -> [Char]
_b16encode = Domain -> [Char]
BS.unpackforall b c a. (b -> c) -> (a -> b) -> a -> c
. Domain -> Domain
B16.encode
_b32encode :: Domain -> [Char]
_b32encode = Domain -> [Char]
BS.unpackforall b c a. (b -> c) -> (a -> b) -> a -> c
. Domain -> Domain
B32.encode
_b64encode :: Domain -> [Char]
_b64encode = Domain -> [Char]
BS.unpackforall b c a. (b -> c) -> (a -> b) -> a -> c
. Domain -> Domain
B64.encode

-- | Type alias for resource records in the answer section.
type Answers = [ResourceRecord]

-- | Type alias for resource records in the answer section.
type AuthorityRecords = [ResourceRecord]

-- | Type for resource records in the additional section.
type AdditionalRecords = [ResourceRecord]

----------------------------------------------------------------

-- | 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'.
--
defaultQuery :: DNSMessage
defaultQuery :: DNSMessage
defaultQuery = DNSMessage {
    header :: DNSHeader
header = DNSHeader {
       identifier :: Word16
identifier = Word16
0
     , flags :: DNSFlags
flags = DNSFlags
defaultDNSFlags
     }
  , ednsHeader :: EDNSheader
ednsHeader = EDNS -> EDNSheader
EDNSheader EDNS
defaultEDNS
  , question :: [Question]
question   = []
  , answer :: Answers
answer     = []
  , authority :: Answers
authority  = []
  , additional :: Answers
additional = []
  }

-- | 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.
--
defaultResponse :: DNSMessage
defaultResponse :: DNSMessage
defaultResponse = DNSMessage {
    header :: DNSHeader
header = DNSHeader {
       identifier :: Word16
identifier = Word16
0
     , flags :: DNSFlags
flags = DNSFlags
defaultDNSFlags {
              qOrR :: QorR
qOrR = QorR
QR_Response
            , authAnswer :: Bool
authAnswer = Bool
True
            , recAvailable :: Bool
recAvailable = Bool
True
            , authenData :: Bool
authenData = Bool
False
       }
     }
  , ednsHeader :: EDNSheader
ednsHeader = EDNSheader
NoEDNS
  , question :: [Question]
question   = []
  , answer :: Answers
answer     = []
  , authority :: Answers
authority  = []
  , additional :: Answers
additional = []
  }

-- | A query template with 'QueryControls' overrides applied,
-- with just the 'Question' and query 'Identifier' remaining
-- to be filled in.
--
makeEmptyQuery :: QueryControls -- ^ Flag and EDNS overrides
               -> DNSMessage
makeEmptyQuery :: QueryControls -> DNSMessage
makeEmptyQuery QueryControls
ctls = DNSMessage
defaultQuery {
      header :: DNSHeader
header = DNSHeader
header'
    , ednsHeader :: EDNSheader
ednsHeader = EdnsControls -> EDNSheader
queryEdns EdnsControls
ehctls
    }
  where
    hctls :: HeaderControls
hctls = QueryControls -> HeaderControls
qctlHeader QueryControls
ctls
    ehctls :: EdnsControls
ehctls = QueryControls -> EdnsControls
qctlEdns QueryControls
ctls
    header' :: DNSHeader
header' = (DNSMessage -> DNSHeader
header DNSMessage
defaultQuery) { flags :: DNSFlags
flags = HeaderControls -> DNSFlags
queryDNSFlags HeaderControls
hctls }

    -- | Apply the given 'FlagOp' to a default boolean value to produce the final
    -- setting.
    --
    applyFlag :: FlagOp -> Bool -> Bool
    applyFlag :: FlagOp -> Bool -> Bool
applyFlag FlagOp
FlagSet   Bool
_ = Bool
True
    applyFlag FlagOp
FlagClear Bool
_ = Bool
False
    applyFlag FlagOp
_         Bool
v = Bool
v

    -- | Construct a list of 0 or 1 EDNS OPT RRs based on EdnsControls setting.
    --
    queryEdns :: EdnsControls -> EDNSheader
    queryEdns :: EdnsControls -> EDNSheader
queryEdns (EdnsControls FlagOp
en Maybe Word8
vn Maybe Word16
sz FlagOp
d0 ODataOp
od) =
        let d :: EDNS
d  = EDNS
defaultEDNS
         in if FlagOp
en forall a. Eq a => a -> a -> Bool
== FlagOp
FlagClear
            then EDNSheader
NoEDNS
            else EDNS -> EDNSheader
EDNSheader forall a b. (a -> b) -> a -> b
$ EDNS
d { ednsVersion :: Word8
ednsVersion = forall a. a -> Maybe a -> a
fromMaybe (EDNS -> Word8
ednsVersion EDNS
d) Maybe Word8
vn
                                , ednsUdpSize :: Word16
ednsUdpSize = forall a. a -> Maybe a -> a
fromMaybe (EDNS -> Word16
ednsUdpSize EDNS
d) Maybe Word16
sz
                                , ednsDnssecOk :: Bool
ednsDnssecOk = FlagOp -> Bool -> Bool
applyFlag FlagOp
d0 (EDNS -> Bool
ednsDnssecOk EDNS
d)
                                , ednsOptions :: [OData]
ednsOptions  = ODataOp -> [OData]
_odataDedup ODataOp
od
                                }

    -- | Apply all the query flag overrides to 'defaultDNSFlags', returning the
    -- resulting 'DNSFlags' suitable for making queries with the requested flag
    -- settings.  This is only needed if you're creating your own 'DNSMessage',
    -- the 'Network.DNS.LookupRaw.lookupRawCtl' function takes a 'QueryControls'
    -- argument and handles this conversion internally.
    --
    -- Default overrides can be specified in the resolver configuration by setting
    -- the 'Network.DNS.resolvQueryControls' field of the
    -- 'Network.DNS.Resolver.ResolvConf' argument to
    -- 'Network.DNS.Resolver.makeResolvSeed'.  These then apply to lookups via
    -- resolvers based on the resulting configuration, with the exception of
    -- 'Network.DNS.LookupRaw.lookupRawCtl' which takes an additional
    -- 'QueryControls' argument to augment the default overrides.
    --
    queryDNSFlags :: HeaderControls -> DNSFlags
    queryDNSFlags :: HeaderControls -> DNSFlags
queryDNSFlags (HeaderControls FlagOp
rd FlagOp
ad FlagOp
cd) = DNSFlags
d {
          recDesired :: Bool
recDesired = FlagOp -> Bool -> Bool
applyFlag FlagOp
rd forall a b. (a -> b) -> a -> b
$ DNSFlags -> Bool
recDesired DNSFlags
d
        , authenData :: Bool
authenData = FlagOp -> Bool -> Bool
applyFlag FlagOp
ad forall a b. (a -> b) -> a -> b
$ DNSFlags -> Bool
authenData DNSFlags
d
        , chkDisable :: Bool
chkDisable = FlagOp -> Bool -> Bool
applyFlag FlagOp
cd forall a b. (a -> b) -> a -> b
$ DNSFlags -> Bool
chkDisable DNSFlags
d
        }
      where
        d :: DNSFlags
d = DNSFlags
defaultDNSFlags

-- | 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 'Network.DNS.Resolver.resolvQueryControls'
-- field of 'Network.DNS.Resolver.ResolvConf'.  Per-query overrides are
-- possible by using 'Network.DNS.LookupRaw.loookupRawCtl'.
--
makeQuery :: Identifier        -- ^ Crypto random request id
          -> Question          -- ^ Question name and type
          -> QueryControls     -- ^ Custom RD\/AD\/CD flags and EDNS settings
          -> DNSMessage
makeQuery :: Word16 -> Question -> QueryControls -> DNSMessage
makeQuery Word16
idt Question
q QueryControls
ctls = DNSMessage
empqry {
      header :: DNSHeader
header = (DNSMessage -> DNSHeader
header DNSMessage
empqry) { identifier :: Word16
identifier = Word16
idt }
    , question :: [Question]
question = [Question
q]
    }
  where
    empqry :: DNSMessage
empqry = QueryControls -> DNSMessage
makeEmptyQuery QueryControls
ctls

-- | Construct a query response 'DNSMessage'.
makeResponse :: Identifier
             -> Question
             -> Answers
             -> DNSMessage
makeResponse :: Word16 -> Question -> Answers -> DNSMessage
makeResponse Word16
idt Question
q Answers
as = DNSMessage
defaultResponse {
      header :: DNSHeader
header = DNSHeader
header' { identifier :: Word16
identifier = Word16
idt }
    , question :: [Question]
question = [Question
q]
    , answer :: Answers
answer   = Answers
as
    }
  where
    header' :: DNSHeader
header' = DNSMessage -> DNSHeader
header DNSMessage
defaultResponse

----------------------------------------------------------------
-- EDNS (RFC 6891, EDNS(0))
----------------------------------------------------------------

-- | EDNS information defined in RFC 6891.
data EDNS = EDNS {
    -- | EDNS version, presently only version 0 is defined.
    EDNS -> Word8
ednsVersion :: !Word8
    -- | Supported UDP payload size.
  , EDNS -> Word16
ednsUdpSize  :: !Word16
    -- | Request DNSSEC replies (with RRSIG and NSEC records as as appropriate)
    -- from the server.  Generally, not needed (except for diagnostic purposes)
    -- unless the signatures will be validated.  Just setting the 'AD' bit in
    -- the query and checking it in the response is sufficient (but often
    -- subject to man-in-the-middle forgery) if all that's wanted is whether
    -- the server validated the response.
  , EDNS -> Bool
ednsDnssecOk :: !Bool
    -- | EDNS options (e.g. 'OD_NSID', 'OD_ClientSubnet', ...)
  , EDNS -> [OData]
ednsOptions  :: ![OData]
  } deriving (EDNS -> EDNS -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EDNS -> EDNS -> Bool
$c/= :: EDNS -> EDNS -> Bool
== :: EDNS -> EDNS -> Bool
$c== :: EDNS -> EDNS -> Bool
Eq, Int -> EDNS -> ShowS
[EDNS] -> ShowS
EDNS -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [EDNS] -> ShowS
$cshowList :: [EDNS] -> ShowS
show :: EDNS -> [Char]
$cshow :: EDNS -> [Char]
showsPrec :: Int -> EDNS -> ShowS
$cshowsPrec :: Int -> EDNS -> ShowS
Show)

-- | 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
--     }
-- @
--
defaultEDNS :: EDNS
defaultEDNS :: EDNS
defaultEDNS = EDNS
    { ednsVersion :: Word8
ednsVersion = Word8
0      -- The default EDNS version is 0
    , ednsUdpSize :: Word16
ednsUdpSize = Word16
1232   -- IPv6-safe UDP MTU
    , ednsDnssecOk :: Bool
ednsDnssecOk = Bool
False -- We don't do DNSSEC validation
    , ednsOptions :: [OData]
ednsOptions = []     -- No EDNS options by default
    }

-- | 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
maxUdpSize :: Word16
maxUdpSize :: Word16
maxUdpSize = Word16
16384

-- | Minimum UDP size to advertise. If 'ednsUdpSize' of 'EDNS' is smaller,
--   then this value is sent instead.
--
-- >>> minUdpSize
-- 512
minUdpSize :: Word16
minUdpSize :: Word16
minUdpSize = Word16
512

----------------------------------------------------------------

-- | EDNS Option Code (RFC 6891).
newtype OptCode = OptCode {
    -- | From option code to number.
    OptCode -> Word16
fromOptCode :: Word16
  } deriving (OptCode -> OptCode -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OptCode -> OptCode -> Bool
$c/= :: OptCode -> OptCode -> Bool
== :: OptCode -> OptCode -> Bool
$c== :: OptCode -> OptCode -> Bool
Eq,Eq OptCode
OptCode -> OptCode -> Bool
OptCode -> OptCode -> Ordering
OptCode -> OptCode -> OptCode
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: OptCode -> OptCode -> OptCode
$cmin :: OptCode -> OptCode -> OptCode
max :: OptCode -> OptCode -> OptCode
$cmax :: OptCode -> OptCode -> OptCode
>= :: OptCode -> OptCode -> Bool
$c>= :: OptCode -> OptCode -> Bool
> :: OptCode -> OptCode -> Bool
$c> :: OptCode -> OptCode -> Bool
<= :: OptCode -> OptCode -> Bool
$c<= :: OptCode -> OptCode -> Bool
< :: OptCode -> OptCode -> Bool
$c< :: OptCode -> OptCode -> Bool
compare :: OptCode -> OptCode -> Ordering
$ccompare :: OptCode -> OptCode -> Ordering
Ord)

-- | NSID (RFC5001, section 2.3)
pattern NSID :: OptCode
pattern $bNSID :: OptCode
$mNSID :: forall {r}. OptCode -> ((# #) -> r) -> ((# #) -> r) -> r
NSID = OptCode 3

-- | DNSSEC algorithm support (RFC6974, section 3)
pattern DAU :: OptCode
pattern $bDAU :: OptCode
$mDAU :: forall {r}. OptCode -> ((# #) -> r) -> ((# #) -> r) -> r
DAU = OptCode 5
pattern DHU :: OptCode
pattern $bDHU :: OptCode
$mDHU :: forall {r}. OptCode -> ((# #) -> r) -> ((# #) -> r) -> r
DHU = OptCode 6
pattern N3U :: OptCode
pattern $bN3U :: OptCode
$mN3U :: forall {r}. OptCode -> ((# #) -> r) -> ((# #) -> r) -> r
N3U = OptCode 7

-- | Client subnet (RFC7871)
pattern ClientSubnet :: OptCode
pattern $bClientSubnet :: OptCode
$mClientSubnet :: forall {r}. OptCode -> ((# #) -> r) -> ((# #) -> r) -> r
ClientSubnet = OptCode 8

instance Show OptCode where
    show :: OptCode -> [Char]
show OptCode
NSID         = [Char]
"NSID"
    show OptCode
DAU          = [Char]
"DAU"
    show OptCode
DHU          = [Char]
"DHU"
    show OptCode
N3U          = [Char]
"N3U"
    show OptCode
ClientSubnet = [Char]
"ClientSubnet"
    show OptCode
x            = [Char]
"OptCode" forall a. [a] -> [a] -> [a]
++ (forall a. Show a => a -> [Char]
show forall a b. (a -> b) -> a -> b
$ OptCode -> Word16
fromOptCode OptCode
x)

-- | From number to option code.
toOptCode :: Word16 -> OptCode
toOptCode :: Word16 -> OptCode
toOptCode = Word16 -> OptCode
OptCode

----------------------------------------------------------------

-- | RData formats for a few EDNS options, and an opaque catchall
data OData =
      -- | Name Server Identifier (RFC5001).  Bidirectional, empty from client.
      -- (opaque octet-string).  May contain binary data, which MUST be empty
      -- in queries.
      OD_NSID ByteString
      -- | DNSSEC Algorithm Understood (RFC6975).  Client to server.
      -- (array of 8-bit numbers). Lists supported DNSKEY algorithms.
    | OD_DAU [Word8]
      -- | DS Hash Understood (RFC6975).  Client to server.
      -- (array of 8-bit numbers). Lists supported DS hash algorithms.
    | OD_DHU [Word8]
      -- | NSEC3 Hash Understood (RFC6975).  Client to server.
      -- (array of 8-bit numbers). Lists supported NSEC3 hash algorithms.
    | OD_N3U [Word8]
      -- | 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' value instead.
      --
    | OD_ClientSubnet Word8 Word8 IP
      -- | Unsupported or malformed IP client subnet option.  Bidirectional.
      -- (address family, source bits, scope bits, opaque address).
    | OD_ECSgeneric Word16 Word8 Word8 ByteString
      -- | Generic EDNS option.
      -- (numeric 'OptCode', opaque content)
    | UnknownOData Word16 ByteString
    deriving (OData -> OData -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OData -> OData -> Bool
$c/= :: OData -> OData -> Bool
== :: OData -> OData -> Bool
$c== :: OData -> OData -> Bool
Eq,Eq OData
OData -> OData -> Bool
OData -> OData -> Ordering
OData -> OData -> OData
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: OData -> OData -> OData
$cmin :: OData -> OData -> OData
max :: OData -> OData -> OData
$cmax :: OData -> OData -> OData
>= :: OData -> OData -> Bool
$c>= :: OData -> OData -> Bool
> :: OData -> OData -> Bool
$c> :: OData -> OData -> Bool
<= :: OData -> OData -> Bool
$c<= :: OData -> OData -> Bool
< :: OData -> OData -> Bool
$c< :: OData -> OData -> Bool
compare :: OData -> OData -> Ordering
$ccompare :: OData -> OData -> Ordering
Ord)


-- | Recover the (often implicit) 'OptCode' from a value of the 'OData' sum
-- type.
_odataToOptCode :: OData -> OptCode
_odataToOptCode :: OData -> OptCode
_odataToOptCode OD_NSID {}            = OptCode
NSID
_odataToOptCode OD_DAU {}             = OptCode
DAU
_odataToOptCode OD_DHU {}             = OptCode
DHU
_odataToOptCode OD_N3U {}             = OptCode
N3U
_odataToOptCode OD_ClientSubnet {}    = OptCode
ClientSubnet
_odataToOptCode OD_ECSgeneric {}      = OptCode
ClientSubnet
_odataToOptCode (UnknownOData Word16
code Domain
_) = Word16 -> OptCode
toOptCode Word16
code

instance Show OData where
    show :: OData -> [Char]
show (OD_NSID Domain
nsid) = Domain -> [Char]
_showNSID Domain
nsid
    show (OD_DAU [Word8]
as)    = [Char] -> [Word8] -> [Char]
_showAlgList [Char]
"DAU" [Word8]
as
    show (OD_DHU [Word8]
hs)    = [Char] -> [Word8] -> [Char]
_showAlgList [Char]
"DHU" [Word8]
hs
    show (OD_N3U [Word8]
hs)    = [Char] -> [Word8] -> [Char]
_showAlgList [Char]
"N3U" [Word8]
hs
    show (OD_ClientSubnet Word8
b1 Word8
b2 ip :: IP
ip@(IPv4 IPv4
_)) = Word16 -> Word8 -> Word8 -> ShowS
_showECS Word16
1 Word8
b1 Word8
b2 forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> [Char]
show IP
ip
    show (OD_ClientSubnet Word8
b1 Word8
b2 ip :: IP
ip@(IPv6 IPv6
_)) = Word16 -> Word8 -> Word8 -> ShowS
_showECS Word16
2 Word8
b1 Word8
b2 forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> [Char]
show IP
ip
    show (OD_ECSgeneric Word16
fam Word8
b1 Word8
b2 Domain
a) = Word16 -> Word8 -> Word8 -> ShowS
_showECS Word16
fam Word8
b1 Word8
b2 forall a b. (a -> b) -> a -> b
$ Domain -> [Char]
_b16encode Domain
a
    show (UnknownOData Word16
code Domain
bs) =
        [Char]
"UnknownOData " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Word16
code forall a. [a] -> [a] -> [a]
++ [Char]
" " forall a. [a] -> [a] -> [a]
++ Domain -> [Char]
_b16encode Domain
bs

_showAlgList :: String -> [Word8] -> String
_showAlgList :: [Char] -> [Word8] -> [Char]
_showAlgList [Char]
nm [Word8]
ws = [Char]
nm forall a. [a] -> [a] -> [a]
++ [Char]
" " forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"," (forall a b. (a -> b) -> [a] -> [b]
map forall a. Show a => a -> [Char]
show [Word8]
ws)

_showNSID :: ByteString -> String
_showNSID :: Domain -> [Char]
_showNSID Domain
nsid = [Char]
"NSID" forall a. [a] -> [a] -> [a]
++ [Char]
" " forall a. [a] -> [a] -> [a]
++ Domain -> [Char]
_b16encode Domain
nsid forall a. [a] -> [a] -> [a]
++ [Char]
";" forall a. [a] -> [a] -> [a]
++ Domain -> [Char]
printable Domain
nsid
  where
    printable :: Domain -> [Char]
printable = Domain -> [Char]
BS.unpackforall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char) -> Domain -> Domain
BS.map (\Char
c -> if Char
c forall a. Ord a => a -> a -> Bool
< Char
' ' Bool -> Bool -> Bool
|| Char
c forall a. Ord a => a -> a -> Bool
> Char
'~' then Char
'?' else Char
c)

_showECS :: Word16 -> Word8 -> Word8 -> String -> String
_showECS :: Word16 -> Word8 -> Word8 -> ShowS
_showECS Word16
family Word8
srcBits Word8
scpBits [Char]
address =
    forall a. Show a => a -> [Char]
show Word16
family forall a. [a] -> [a] -> [a]
++ [Char]
" " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Word8
srcBits
                forall a. [a] -> [a] -> [a]
++ [Char]
" " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Word8
scpBits forall a. [a] -> [a] -> [a]
++ [Char]
" " forall a. [a] -> [a] -> [a]
++ [Char]
address