-- |
-- Module      : Net.DNSBase.Internal.Message
-- Description : TBD
-- Copyright   : (c) Viktor Dukhovni, 2026
-- License     : BSD-3-Clause
-- Maintainer  : ietf-dane@dukhovni.org
-- Stability   : unstable
{-# LANGUAGE RecordWildCards #-}

module Net.DNSBase.Internal.Message
    ( DNSMessage(..)
    , QueryID
    , putMessage
    , putRequest
    )
    where

import Net.DNSBase.EDNS.Internal.Option
import Net.DNSBase.Encode.Internal.State
import Net.DNSBase.Internal.Domain
import Net.DNSBase.Internal.Flags
import Net.DNSBase.Internal.Opcode
import Net.DNSBase.Internal.RCODE
import Net.DNSBase.Internal.RData
import Net.DNSBase.Internal.RRTYPE
import Net.DNSBase.Internal.EDNS
import Net.DNSBase.Internal.RRCLASS
import Net.DNSBase.Internal.RR
import Net.DNSBase.Internal.Util

-- | DNS over UDP uses 16-bit query ids to better correlate questions and
-- answers and to (inadequately) reduce the risk of cache-poisoning through
-- forged response packets.  They are still used with TCP to keep the header
-- format the same.
type QueryID = Word16

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

-- | DNS query or response header, here consisting of just the query ID and
-- the flags, sans the record counts, which are implicit in the corresponding
-- lists, [RFC1035 4.1.1](https://tools.ietf.org/html/rfc1035#section-4.1.1),
-- updated by [RFC2535](https://tools.ietf.org/html/rfc2535#section-6.1).
--
-- The basic DNS header contains the following fields:
--
-- >                                 1  1  1  1  1  1
-- >   0  1  2  3  4  5  6  7  8  9  0  1  2  3  4  5
-- > +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+
-- > |                      ID                       |
-- > +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+
-- > |QR|   Opcode  |AA|TC|RD|RA| Z|AD|CD|   RCODE   |
-- > +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+
-- > |                    QDCOUNT                    |
-- > +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+
-- > |                    ANCOUNT                    |
-- > +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+
-- > |                    NSCOUNT                    |
-- > +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+
-- > |                    ARCOUNT                    |
-- > +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+
--
-- The basic 4-bit @RCODE@ is augmented with 8 bits from the EDNS header,
-- forming a single /extended/ 12-bit @RCODE@, with the basic @RCODE@ as its
-- least-significant 4 bits.  Similarly, the /extended/ 32-bit 'DNSFlags' are
-- a combination of the basic flags above with 16 more flag bits from the
-- EDNS header, with the basic flags in the low 16-bits (with the @Opcode@
-- and @RCODE@ bits always cleared).
--

-- | DNS message format for queries and replies,
-- [RFC1035 4.1](https://tools.ietf.org/html/rfc1035#section-4.1)
--
-- >  +---------------------+
-- >  |        Header       |
-- >  +---------------------+
-- >  |       Question      | the question for the name server
-- >  +---------------------+
-- >  |        Answer       | RRs answering the question
-- >  +---------------------+
-- >  |      Authority      | RRs pointing toward an authority
-- >  +---------------------+
-- >  |      Additional     | RRs holding additional information
-- >  +---------------------+
--
data DNSMessage = DNSMessage
    { DNSMessage -> QueryID
dnsMsgId :: QueryID       -- ^ Query or reply identifier.
    , DNSMessage -> Opcode
dnsMsgOp :: Opcode        -- ^ The requested operation
    , DNSMessage -> RCODE
dnsMsgRC :: RCODE         -- ^ The (extended) result code
    , DNSMessage -> DNSFlags
dnsMsgFl :: DNSFlags      -- ^ The (extended) flags
    , DNSMessage -> Maybe EDNS
dnsMsgEx :: Maybe EDNS    -- ^ EDNS pseudo-header
    , DNSMessage -> [DnsTriple]
dnsMsgQu :: [DnsTriple]   -- ^ The question name, type, class
    , DNSMessage -> [RR]
dnsMsgAn :: [RR]          -- ^ Answers
    , DNSMessage -> [RR]
dnsMsgNs :: [RR]          -- ^ Authority records
    , DNSMessage -> [RR]
dnsMsgAr :: [RR]          -- ^ Additional records
    } deriving (DNSMessage -> DNSMessage -> Bool
(DNSMessage -> DNSMessage -> Bool)
-> (DNSMessage -> DNSMessage -> Bool) -> Eq DNSMessage
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DNSMessage -> DNSMessage -> Bool
== :: DNSMessage -> DNSMessage -> Bool
$c/= :: DNSMessage -> DNSMessage -> Bool
/= :: DNSMessage -> DNSMessage -> Bool
Eq, Int -> DNSMessage -> ShowS
[DNSMessage] -> ShowS
DNSMessage -> String
(Int -> DNSMessage -> ShowS)
-> (DNSMessage -> String)
-> ([DNSMessage] -> ShowS)
-> Show DNSMessage
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DNSMessage -> ShowS
showsPrec :: Int -> DNSMessage -> ShowS
$cshow :: DNSMessage -> String
show :: DNSMessage -> String
$cshowList :: [DNSMessage] -> ShowS
showList :: [DNSMessage] -> ShowS
Show)

-- | Encode the DNS Question,
-- [RFC1035 4.1.2](https://tools.ietf.org/html/rfc1035#section-4.1.2)
--
-- >                                 1  1  1  1  1  1
-- >   0  1  2  3  4  5  6  7  8  9  0  1  2  3  4  5
-- > +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+
-- > |                                               |
-- > /                     QNAME                     /
-- > /                                               /
-- > +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+
-- > |                     QTYPE                     |
-- > +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+
-- > |                     QCLASS                    |
-- > +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+
--
putQuestion :: DnsTriple -> SPut s RData
putQuestion :: forall s. DnsTriple -> SPut s RData
putQuestion DnsTriple{RRTYPE
RRCLASS
Domain
dnsTripleName :: Domain
dnsTripleType :: RRTYPE
dnsTripleClass :: RRCLASS
dnsTripleClass :: DnsTriple -> RRCLASS
dnsTripleType :: DnsTriple -> RRTYPE
dnsTripleName :: DnsTriple -> Domain
..} = do
    Domain -> SPut s RData
forall r s. ErrorContext r => Domain -> SPut s r
putDomain Domain
dnsTripleName
    Word32 -> SPut s RData
forall r s. ErrorContext r => Word32 -> SPut s r
put32 (Word32 -> SPut s RData) -> Word32 -> SPut s RData
forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word16 (RRTYPE -> QueryID
forall a b. Coercible a b => a -> b
coerce RRTYPE
dnsTripleType) Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
16 Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|.
            forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word16 (RRCLASS -> QueryID
forall a b. Coercible a b => a -> b
coerce RRCLASS
dnsTripleClass)

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

-- | Stub-resolver fast path for building an outgoing query: emits
-- the DNS header (with the given query ID, request flags, and the
-- four section counts hard-coded for a single question), the
-- single question, and — unless EDNS is disabled — the OPT
-- pseudo-RR carrying the supplied 'EDNS' record.  Used by the
-- resolver in "Net.DNSBase.Internal.Transport".  Fails with
-- 'EDNSRequired' when extended flag bits are set but no 'EDNS'
-- record was supplied.
putRequest :: QueryID
           -> DNSFlags
           -> Maybe EDNS
           -> DnsTriple
           -> SPut s RData
putRequest :: forall s.
QueryID -> DNSFlags -> Maybe EDNS -> DnsTriple -> SPut s RData
putRequest QueryID
qid DNSFlags
flags (Just EDNS{[EdnsOption]
Word8
QueryID
ednsVersion :: Word8
ednsUdpSize :: QueryID
ednsOptions :: [EdnsOption]
ednsOptions :: EDNS -> [EdnsOption]
ednsUdpSize :: EDNS -> QueryID
ednsVersion :: EDNS -> Word8
..}) DnsTriple
question = do
    -- header
    Word64 -> SPut s RData
forall r s. ErrorContext r => Word64 -> SPut s r
put64 (Word64 -> SPut s RData) -> Word64 -> SPut s RData
forall a b. (a -> b) -> a -> b
$ QueryID -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral QueryID
qid Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
48 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|.
            QueryID -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Opcode -> RCODE -> DNSFlags -> QueryID
basicFlags Opcode
Query RCODE
NOERROR DNSFlags
flags) Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
32 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|.
            -- RR counts
            Word64
0x0001_0000
    Word32 -> SPut s RData
forall r s. ErrorContext r => Word32 -> SPut s r
put32 (Word32 -> SPut s RData) -> Word32 -> SPut s RData
forall a b. (a -> b) -> a -> b
$ Word32
0x0000_0001
    --
    DnsTriple -> SPut s RData
forall s. DnsTriple -> SPut s RData
putQuestion DnsTriple
question
    -- OPT pseudo-RR
    Word8 -> SPut s RData
forall r s. ErrorContext r => Word8 -> SPut s r
put8 Word8
0  -- Root Domain
    Word64 -> SPut s RData
forall r s. ErrorContext r => Word64 -> SPut s r
put64 (Word64 -> SPut s RData) -> Word64 -> SPut s RData
forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word16 (RRTYPE -> QueryID
forall a b. Coercible a b => a -> b
coerce RRTYPE
OPT) Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
48 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|.
            QueryID -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral QueryID
ednsUdpSize Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
32 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|.
            Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
ednsVersion Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
16 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|.
            QueryID -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (DNSFlags -> QueryID
extendedFlags DNSFlags
flags)
    if ([EdnsOption] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [EdnsOption]
ednsOptions)
    then QueryID -> SPut s RData
forall r s. ErrorContext r => QueryID -> SPut s r
put16 QueryID
0
    else SPut s RData -> SPut s RData
forall r s a. ErrorContext r => SPutM s r a -> SPutM s r a
passLen (SPut s RData -> SPut s RData) -> SPut s RData -> SPut s RData
forall a b. (a -> b) -> a -> b
$ (EdnsOption -> SPut s RData) -> [EdnsOption] -> SPut s RData
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ EdnsOption -> SPut s RData
forall s r. (Typeable r, Eq r, Show r) => EdnsOption -> SPut s r
putOption [EdnsOption]
ednsOptions
putRequest QueryID
qid DNSFlags
flags Maybe EDNS
_ DnsTriple
question = do
    let ef :: QueryID
ef = DNSFlags -> QueryID
extendedFlags DNSFlags
flags
    Bool -> SPut s RData -> SPut s RData
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (QueryID
ef QueryID -> QueryID -> Bool
forall a. Eq a => a -> a -> Bool
/= QueryID
0) (SPut s RData -> SPut s RData) -> SPut s RData -> SPut s RData
forall a b. (a -> b) -> a -> b
$ (forall a. ErrorContext a => a -> EncodeErr a) -> SPut s RData
forall r s.
ErrorContext r =>
(forall a. ErrorContext a => a -> EncodeErr a) -> SPut s r
failWith ((forall a. ErrorContext a => a -> EncodeErr a) -> SPut s RData)
-> (forall a. ErrorContext a => a -> EncodeErr a) -> SPut s RData
forall a b. (a -> b) -> a -> b
$ EncodeErr a -> a -> EncodeErr a
forall a b. a -> b -> a
const EncodeErr a
forall r. EncodeErr r
EDNSRequired
    -- header
    Word64 -> SPut s RData
forall r s. ErrorContext r => Word64 -> SPut s r
put64 (Word64 -> SPut s RData) -> Word64 -> SPut s RData
forall a b. (a -> b) -> a -> b
$ QueryID -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral QueryID
qid Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
48 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|.
            QueryID -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Opcode -> RCODE -> DNSFlags -> QueryID
basicFlags Opcode
Query RCODE
NOERROR DNSFlags
flags) Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
32 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|.
            -- RR counts
            Word64
0x0001_0000
    Word32 -> SPut s RData
forall r s. ErrorContext r => Word32 -> SPut s r
put32 (Word32 -> SPut s RData) -> Word32 -> SPut s RData
forall a b. (a -> b) -> a -> b
$ Word32
0x0000_0000
    --
    DnsTriple -> SPut s RData
forall s. DnsTriple -> SPut s RData
putQuestion DnsTriple
question

-- | General-purpose wire-form encoder for a 'DNSMessage'.  Emits
-- the 12-byte header followed by each section (question, answer,
-- authority, additional) in turn, appending the OPT pseudo-RR to
-- the additional section when 'dnsMsgEx' is present.  Use this
-- for responses or any message with non-trivial section contents;
-- for the stub-resolver request path 'putRequest' is more direct.
putMessage :: DNSMessage -> SPut s RData
putMessage :: forall s. DNSMessage -> SPut s RData
putMessage DNSMessage{[DnsTriple]
[RR]
Maybe EDNS
QueryID
RCODE
Opcode
DNSFlags
dnsMsgId :: DNSMessage -> QueryID
dnsMsgOp :: DNSMessage -> Opcode
dnsMsgRC :: DNSMessage -> RCODE
dnsMsgFl :: DNSMessage -> DNSFlags
dnsMsgEx :: DNSMessage -> Maybe EDNS
dnsMsgQu :: DNSMessage -> [DnsTriple]
dnsMsgAn :: DNSMessage -> [RR]
dnsMsgNs :: DNSMessage -> [RR]
dnsMsgAr :: DNSMessage -> [RR]
dnsMsgId :: QueryID
dnsMsgOp :: Opcode
dnsMsgRC :: RCODE
dnsMsgFl :: DNSFlags
dnsMsgEx :: Maybe EDNS
dnsMsgQu :: [DnsTriple]
dnsMsgAn :: [RR]
dnsMsgNs :: [RR]
dnsMsgAr :: [RR]
..}
    | Just EDNS{[EdnsOption]
Word8
QueryID
ednsOptions :: EDNS -> [EdnsOption]
ednsUdpSize :: EDNS -> QueryID
ednsVersion :: EDNS -> Word8
ednsVersion :: Word8
ednsUdpSize :: QueryID
ednsOptions :: [EdnsOption]
..} <- Maybe EDNS
dnsMsgEx
      = do
        -- header
        Word64 -> SPut s RData
forall r s. ErrorContext r => Word64 -> SPut s r
put64 (Word64 -> SPut s RData) -> Word64 -> SPut s RData
forall a b. (a -> b) -> a -> b
$ Word64
msgid Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
48 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|.
                Word64
flags Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
32 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|.
                -- RR counts
                Word64
qdcount Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
16 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|.
                Word64
ancount
        Word32 -> SPut s RData
forall r s. ErrorContext r => Word32 -> SPut s r
put32 (Word32 -> SPut s RData) -> Word32 -> SPut s RData
forall a b. (a -> b) -> a -> b
$ Word32
nscount Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
16 Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|.
                Word32
arcount
        --
        (DnsTriple -> SPut s RData) -> [DnsTriple] -> SPut s RData
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ DnsTriple -> SPut s RData
forall s. DnsTriple -> SPut s RData
putQuestion [DnsTriple]
dnsMsgQu
        (RR -> SPut s RData) -> [RR] -> SPut s RData
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ RR -> SPut s RData
forall s. RR -> SPut s RData
putRR [RR]
dnsMsgAn
        (RR -> SPut s RData) -> [RR] -> SPut s RData
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ RR -> SPut s RData
forall s. RR -> SPut s RData
putRR [RR]
dnsMsgNs
        -- OPT pseudo-RR
        Word8 -> SPut s RData
forall r s. ErrorContext r => Word8 -> SPut s r
put8 Word8
0  -- Root Domain
        Word32 -> SPut s RData
forall r s. ErrorContext r => Word32 -> SPut s r
put32 (Word32 -> SPut s RData) -> Word32 -> SPut s RData
forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word16 (RRTYPE -> QueryID
forall a b. Coercible a b => a -> b
coerce RRTYPE
OPT) Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
16 Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|.
                QueryID -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral QueryID
ednsUdpSize
        Word32 -> SPut s RData
forall r s. ErrorContext r => Word32 -> SPut s r
put32 (Word32 -> SPut s RData) -> Word32 -> SPut s RData
forall a b. (a -> b) -> a -> b
$ (QueryID -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral QueryID
rc Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
0xff0) Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
20 Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|.
                Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
ednsVersion Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
16 Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|.
                QueryID -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (DNSFlags -> QueryID
extendedFlags DNSFlags
dnsMsgFl)
        if ([EdnsOption] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [EdnsOption]
ednsOptions)
        then QueryID -> SPut s RData
forall r s. ErrorContext r => QueryID -> SPut s r
put16 QueryID
0
        else SPut s RData -> SPut s RData
forall r s a. ErrorContext r => SPutM s r a -> SPutM s r a
passLen (SPut s RData -> SPut s RData) -> SPut s RData -> SPut s RData
forall a b. (a -> b) -> a -> b
$ (EdnsOption -> SPut s RData) -> [EdnsOption] -> SPut s RData
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ EdnsOption -> SPut s RData
forall s r. (Typeable r, Eq r, Show r) => EdnsOption -> SPut s r
putOption [EdnsOption]
ednsOptions
        -- Remaining additional records
        (RR -> SPut s RData) -> [RR] -> SPut s RData
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ RR -> SPut s RData
forall s. RR -> SPut s RData
putRR [RR]
dnsMsgAr
    | Bool
otherwise
      = do
        let ef :: QueryID
ef = DNSFlags -> QueryID
extendedFlags DNSFlags
dnsMsgFl
        Bool -> SPut s RData -> SPut s RData
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (QueryID
rc QueryID -> QueryID -> Bool
forall a. Ord a => a -> a -> Bool
> QueryID
0xf Bool -> Bool -> Bool
|| QueryID
ef QueryID -> QueryID -> Bool
forall a. Eq a => a -> a -> Bool
/= QueryID
0) (SPut s RData -> SPut s RData) -> SPut s RData -> SPut s RData
forall a b. (a -> b) -> a -> b
$ (forall a. ErrorContext a => a -> EncodeErr a) -> SPut s RData
forall r s.
ErrorContext r =>
(forall a. ErrorContext a => a -> EncodeErr a) -> SPut s r
failWith ((forall a. ErrorContext a => a -> EncodeErr a) -> SPut s RData)
-> (forall a. ErrorContext a => a -> EncodeErr a) -> SPut s RData
forall a b. (a -> b) -> a -> b
$ EncodeErr a -> a -> EncodeErr a
forall a b. a -> b -> a
const EncodeErr a
forall r. EncodeErr r
EDNSRequired
        -- header
        Word64 -> SPut s RData
forall r s. ErrorContext r => Word64 -> SPut s r
put64 (Word64 -> SPut s RData) -> Word64 -> SPut s RData
forall a b. (a -> b) -> a -> b
$ Word64
msgid Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
48 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|.
                Word64
flags Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
32 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|.
                -- RR counts
                Word64
qdcount Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
16 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|.
                Word64
ancount
        Word32 -> SPut s RData
forall r s. ErrorContext r => Word32 -> SPut s r
put32 (Word32 -> SPut s RData) -> Word32 -> SPut s RData
forall a b. (a -> b) -> a -> b
$ Word32
nscount Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
16 Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|.
                Word32
arcount
        --
        (DnsTriple -> SPut s RData) -> [DnsTriple] -> SPut s RData
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ DnsTriple -> SPut s RData
forall s. DnsTriple -> SPut s RData
putQuestion [DnsTriple]
dnsMsgQu
        (RR -> SPut s RData) -> [RR] -> SPut s RData
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ RR -> SPut s RData
forall s. RR -> SPut s RData
putRR [RR]
dnsMsgAn
        (RR -> SPut s RData) -> [RR] -> SPut s RData
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ RR -> SPut s RData
forall s. RR -> SPut s RData
putRR [RR]
dnsMsgNs
        (RR -> SPut s RData) -> [RR] -> SPut s RData
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ RR -> SPut s RData
forall s. RR -> SPut s RData
putRR [RR]
dnsMsgAr
  where
    msgid :: Word64
msgid   = QueryID -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral QueryID
dnsMsgId
    qdcount :: Word64
qdcount = Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word64) -> Int -> Word64
forall a b. (a -> b) -> a -> b
$ [DnsTriple] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [DnsTriple]
dnsMsgQu
    ancount :: Word64
ancount = Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word64) -> Int -> Word64
forall a b. (a -> b) -> a -> b
$ [RR] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [RR]
dnsMsgAn
    nscount :: Word32
nscount = Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word32) -> Int -> Word32
forall a b. (a -> b) -> a -> b
$ [RR] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [RR]
dnsMsgNs
    arcount :: Word32
arcount = Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word32) -> Int -> Word32
forall a b. (a -> b) -> a -> b
$ [RR] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [RR]
dnsMsgAr Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
    flags :: Word64
flags   = QueryID -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (QueryID -> Word64) -> QueryID -> Word64
forall a b. (a -> b) -> a -> b
$ Opcode -> RCODE -> DNSFlags -> QueryID
basicFlags Opcode
dnsMsgOp RCODE
dnsMsgRC DNSFlags
dnsMsgFl
    (RCODE QueryID
rc) = RCODE
dnsMsgRC