{-# LANGUAGE BangPatterns               #-}
{-# LANGUAGE CApiFFI                    #-}
{-# LANGUAGE DeriveFoldable             #-}
{-# LANGUAGE DeriveFunctor              #-}
{-# LANGUAGE DeriveTraversable          #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE RecordWildCards            #-}

-- |
-- Copyright: © 2017 Herbert Valerio Riedel
-- SPDX-License-Identifier: GPL-2.0-or-later
--
-- Internal module
module Network.DNS.Message where

import qualified Data.ByteString.Base16 as B16

import qualified Data.ByteString        as BS
import qualified Data.ByteString.Lazy   as BSL
import           Data.Function
import           Data.List              (groupBy)
import           Data.String
import           Numeric                (showHex)
import           Prelude

import           Data.Binary
import           Data.Binary.Get
import           Data.Binary.Put
import           Data.Bits
import           Data.Map               (Map)
import qualified Data.Map               as Map
import           Data.Set               (Set)
import qualified Data.Set               as Set

import           Compat

-- | An IPv6 address
--
-- The IP address is represented in network order,
-- i.e. @2606:2800:220:1:248:1893:25c8:1946@ is
-- represented as @(IPv6 0x2606280002200001 0x248189325c81946)@.
data IPv6 = IPv6 !Word64 !Word64
          deriving (IPv6 -> IPv6 -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IPv6 -> IPv6 -> Bool
$c/= :: IPv6 -> IPv6 -> Bool
== :: IPv6 -> IPv6 -> Bool
$c== :: IPv6 -> IPv6 -> Bool
Eq,Eq IPv6
IPv6 -> IPv6 -> Bool
IPv6 -> IPv6 -> Ordering
IPv6 -> IPv6 -> IPv6
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 :: IPv6 -> IPv6 -> IPv6
$cmin :: IPv6 -> IPv6 -> IPv6
max :: IPv6 -> IPv6 -> IPv6
$cmax :: IPv6 -> IPv6 -> IPv6
>= :: IPv6 -> IPv6 -> Bool
$c>= :: IPv6 -> IPv6 -> Bool
> :: IPv6 -> IPv6 -> Bool
$c> :: IPv6 -> IPv6 -> Bool
<= :: IPv6 -> IPv6 -> Bool
$c<= :: IPv6 -> IPv6 -> Bool
< :: IPv6 -> IPv6 -> Bool
$c< :: IPv6 -> IPv6 -> Bool
compare :: IPv6 -> IPv6 -> Ordering
$ccompare :: IPv6 -> IPv6 -> Ordering
Ord,ReadPrec [IPv6]
ReadPrec IPv6
Int -> ReadS IPv6
ReadS [IPv6]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [IPv6]
$creadListPrec :: ReadPrec [IPv6]
readPrec :: ReadPrec IPv6
$creadPrec :: ReadPrec IPv6
readList :: ReadS [IPv6]
$creadList :: ReadS [IPv6]
readsPrec :: Int -> ReadS IPv6
$creadsPrec :: Int -> ReadS IPv6
Read)

instance Show IPv6 where
    showsPrec :: Int -> IPv6 -> ShowS
showsPrec Int
p (IPv6 Word64
hi Word64
lo) = Bool -> ShowS -> ShowS
showParen (Int
p forall a. Ord a => a -> a -> Bool
>= Int
11) (String -> ShowS
showString String
"IPv6 0x" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (Integral a, Show a) => a -> ShowS
showHex Word64
hi forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" 0x" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (Integral a, Show a) => a -> ShowS
showHex Word64
lo)

instance Binary IPv6 where
    put :: IPv6 -> Put
put (IPv6 Word64
hi Word64
lo) = Word64 -> Put
putWord64be Word64
hi forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word64 -> Put
putWord64be Word64
lo
    get :: Get IPv6
get              = Word64 -> Word64 -> IPv6
IPv6 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word64
getWord64be forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Word64
getWord64be

-- | An IPv4 address
--
-- The IP address is represented in network order, i.e. @127.0.0.1@ is
-- represented as @(IPv4 0x7f000001)@.
data IPv4 = IPv4 !Word32
          deriving (IPv4 -> IPv4 -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IPv4 -> IPv4 -> Bool
$c/= :: IPv4 -> IPv4 -> Bool
== :: IPv4 -> IPv4 -> Bool
$c== :: IPv4 -> IPv4 -> Bool
Eq,Eq IPv4
IPv4 -> IPv4 -> Bool
IPv4 -> IPv4 -> Ordering
IPv4 -> IPv4 -> IPv4
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 :: IPv4 -> IPv4 -> IPv4
$cmin :: IPv4 -> IPv4 -> IPv4
max :: IPv4 -> IPv4 -> IPv4
$cmax :: IPv4 -> IPv4 -> IPv4
>= :: IPv4 -> IPv4 -> Bool
$c>= :: IPv4 -> IPv4 -> Bool
> :: IPv4 -> IPv4 -> Bool
$c> :: IPv4 -> IPv4 -> Bool
<= :: IPv4 -> IPv4 -> Bool
$c<= :: IPv4 -> IPv4 -> Bool
< :: IPv4 -> IPv4 -> Bool
$c< :: IPv4 -> IPv4 -> Bool
compare :: IPv4 -> IPv4 -> Ordering
$ccompare :: IPv4 -> IPv4 -> Ordering
Ord,ReadPrec [IPv4]
ReadPrec IPv4
Int -> ReadS IPv4
ReadS [IPv4]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [IPv4]
$creadListPrec :: ReadPrec [IPv4]
readPrec :: ReadPrec IPv4
$creadPrec :: ReadPrec IPv4
readList :: ReadS [IPv4]
$creadList :: ReadS [IPv4]
readsPrec :: Int -> ReadS IPv4
$creadsPrec :: Int -> ReadS IPv4
Read)

instance Show IPv4 where
    showsPrec :: Int -> IPv4 -> ShowS
showsPrec Int
p (IPv4 Word32
n) = Bool -> ShowS -> ShowS
showParen (Int
p forall a. Ord a => a -> a -> Bool
>= Int
11) (String -> ShowS
showString String
"IPv4 0x" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (Integral a, Show a) => a -> ShowS
showHex Word32
n)

instance Binary IPv4 where
    put :: IPv4 -> Put
put (IPv4 Word32
w) = Word32 -> Put
putWord32be Word32
w
    get :: Get IPv4
get = Word32 -> IPv4
IPv4 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32
getWord32be

-- | @\<domain-name\>@ as per [RFC 1035, section 3.3](https://tools.ietf.org/html/rfc1035#section-3.3).
--
-- A domain-name represented as a series of labels separated by dots.
--
-- See also 'Labels' for list-based representation.
--
-- __NOTE__: The 'Labels' type is able to properly represent domain
-- names whose components contain dots which the 'Name' representation
-- cannot.
newtype Name = Name BS.ByteString
             deriving (ReadPrec [Name]
ReadPrec Name
Int -> ReadS Name
ReadS [Name]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Name]
$creadListPrec :: ReadPrec [Name]
readPrec :: ReadPrec Name
$creadPrec :: ReadPrec Name
readList :: ReadS [Name]
$creadList :: ReadS [Name]
readsPrec :: Int -> ReadS Name
$creadsPrec :: Int -> ReadS Name
Read,Int -> Name -> ShowS
[Name] -> ShowS
Name -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Name] -> ShowS
$cshowList :: [Name] -> ShowS
show :: Name -> String
$cshow :: Name -> String
showsPrec :: Int -> Name -> ShowS
$cshowsPrec :: Int -> Name -> ShowS
Show,Name -> Name -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Name -> Name -> Bool
$c/= :: Name -> Name -> Bool
== :: Name -> Name -> Bool
$c== :: Name -> Name -> Bool
Eq,Eq Name
Name -> Name -> Bool
Name -> Name -> Ordering
Name -> Name -> Name
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 :: Name -> Name -> Name
$cmin :: Name -> Name -> Name
max :: Name -> Name -> Name
$cmax :: Name -> Name -> Name
>= :: Name -> Name -> Bool
$c>= :: Name -> Name -> Bool
> :: Name -> Name -> Bool
$c> :: Name -> Name -> Bool
<= :: Name -> Name -> Bool
$c<= :: Name -> Name -> Bool
< :: Name -> Name -> Bool
$c< :: Name -> Name -> Bool
compare :: Name -> Name -> Ordering
$ccompare :: Name -> Name -> Ordering
Ord)

-- | @\<character-string\>@ as per [RFC 1035, section 3.3](https://tools.ietf.org/html/rfc1035#section-3.3).
--
-- A sequence of up to 255 octets
--
-- The limit of 255 octets is caused by the encoding which uses by a
-- prefixed octet denoting the length.
newtype CharStr = CharStr BS.ByteString
                deriving (CharStr -> CharStr -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CharStr -> CharStr -> Bool
$c/= :: CharStr -> CharStr -> Bool
== :: CharStr -> CharStr -> Bool
$c== :: CharStr -> CharStr -> Bool
Eq,Eq CharStr
CharStr -> CharStr -> Bool
CharStr -> CharStr -> Ordering
CharStr -> CharStr -> CharStr
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 :: CharStr -> CharStr -> CharStr
$cmin :: CharStr -> CharStr -> CharStr
max :: CharStr -> CharStr -> CharStr
$cmax :: CharStr -> CharStr -> CharStr
>= :: CharStr -> CharStr -> Bool
$c>= :: CharStr -> CharStr -> Bool
> :: CharStr -> CharStr -> Bool
$c> :: CharStr -> CharStr -> Bool
<= :: CharStr -> CharStr -> Bool
$c<= :: CharStr -> CharStr -> Bool
< :: CharStr -> CharStr -> Bool
$c< :: CharStr -> CharStr -> Bool
compare :: CharStr -> CharStr -> Ordering
$ccompare :: CharStr -> CharStr -> Ordering
Ord,String -> CharStr
forall a. (String -> a) -> IsString a
fromString :: String -> CharStr
$cfromString :: String -> CharStr
IsString)

instance Show CharStr where
    showsPrec :: Int -> CharStr -> ShowS
showsPrec Int
p (CharStr Label
bs) = forall a. Show a => Int -> a -> ShowS
showsPrec Int
p Label
bs

instance Read CharStr where
    readsPrec :: Int -> ReadS CharStr
readsPrec Int
p = forall a b. (a -> b) -> [a] -> [b]
map (\(Label
x,String
y) -> (Label -> CharStr
CharStr Label
x,String
y)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Read a => Int -> ReadS a
readsPrec Int
p

instance Binary CharStr where
    put :: CharStr -> Put
put (CharStr Label
bs)
      | Label -> Int
BS.length Label
bs forall a. Ord a => a -> a -> Bool
> Int
0xff = forall a. HasCallStack => String -> a
error String
"putString: string too long"
      | Bool
otherwise = do
            Word8 -> Put
putWord8 (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Label -> Int
BS.length Label
bs)
            Label -> Put
putByteString Label
bs
    get :: Get CharStr
get = do
        Word8
len' <- Get Word8
getWord8
        Label -> CharStr
CharStr forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Get Label
getByteString (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
len')

{- Resource records

 -- https://en.wikipedia.org/wiki/List_of_DNS_record_types

 RFC 1035

 A        1     a host address
 NS       2     an authoritative name server
 CNAME    5     the canonical name for an alias
 SOA      6     marks the start of a zone of authority
 PTR      12    a domain name pointer
 MX       15    mail exchange
 TXT      16    text strings

 RFC 3596

 AAAA     28    IPv6

 RFC 2782

 SRV      33    Location of services

 ----

 RFC3597            Handling of Unknown DNS Resource Record (RR) Types

-}

-- | Represents a DNS message as per [RFC 1035](https://tools.ietf.org/html/rfc1035)
data Msg l
    = Msg
      { forall l. Msg l -> MsgHeader
msgHeader           :: !MsgHeader
      , forall l. Msg l -> [MsgQuestion l]
msgQD               :: [MsgQuestion l]
      , forall l. Msg l -> [MsgRR l]
msgAN, forall l. Msg l -> [MsgRR l]
msgNS, forall l. Msg l -> [MsgRR l]
msgAR :: [MsgRR l]
      } deriving (ReadPrec [Msg l]
ReadPrec (Msg l)
ReadS [Msg l]
forall l. Read l => ReadPrec [Msg l]
forall l. Read l => ReadPrec (Msg l)
forall l. Read l => Int -> ReadS (Msg l)
forall l. Read l => ReadS [Msg l]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Msg l]
$creadListPrec :: forall l. Read l => ReadPrec [Msg l]
readPrec :: ReadPrec (Msg l)
$creadPrec :: forall l. Read l => ReadPrec (Msg l)
readList :: ReadS [Msg l]
$creadList :: forall l. Read l => ReadS [Msg l]
readsPrec :: Int -> ReadS (Msg l)
$creadsPrec :: forall l. Read l => Int -> ReadS (Msg l)
Read,Int -> Msg l -> ShowS
forall l. Show l => Int -> Msg l -> ShowS
forall l. Show l => [Msg l] -> ShowS
forall l. Show l => Msg l -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Msg l] -> ShowS
$cshowList :: forall l. Show l => [Msg l] -> ShowS
show :: Msg l -> String
$cshow :: forall l. Show l => Msg l -> String
showsPrec :: Int -> Msg l -> ShowS
$cshowsPrec :: forall l. Show l => Int -> Msg l -> ShowS
Show,forall a b. a -> Msg b -> Msg a
forall a b. (a -> b) -> Msg a -> Msg b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Msg b -> Msg a
$c<$ :: forall a b. a -> Msg b -> Msg a
fmap :: forall a b. (a -> b) -> Msg a -> Msg b
$cfmap :: forall a b. (a -> b) -> Msg a -> Msg b
Functor,forall a. Eq a => a -> Msg a -> Bool
forall a. Num a => Msg a -> a
forall a. Ord a => Msg a -> a
forall m. Monoid m => Msg m -> m
forall a. Msg a -> Bool
forall a. Msg a -> Int
forall a. Msg a -> [a]
forall a. (a -> a -> a) -> Msg a -> a
forall m a. Monoid m => (a -> m) -> Msg a -> m
forall b a. (b -> a -> b) -> b -> Msg a -> b
forall a b. (a -> b -> b) -> b -> Msg a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: forall a. Num a => Msg a -> a
$cproduct :: forall a. Num a => Msg a -> a
sum :: forall a. Num a => Msg a -> a
$csum :: forall a. Num a => Msg a -> a
minimum :: forall a. Ord a => Msg a -> a
$cminimum :: forall a. Ord a => Msg a -> a
maximum :: forall a. Ord a => Msg a -> a
$cmaximum :: forall a. Ord a => Msg a -> a
elem :: forall a. Eq a => a -> Msg a -> Bool
$celem :: forall a. Eq a => a -> Msg a -> Bool
length :: forall a. Msg a -> Int
$clength :: forall a. Msg a -> Int
null :: forall a. Msg a -> Bool
$cnull :: forall a. Msg a -> Bool
toList :: forall a. Msg a -> [a]
$ctoList :: forall a. Msg a -> [a]
foldl1 :: forall a. (a -> a -> a) -> Msg a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Msg a -> a
foldr1 :: forall a. (a -> a -> a) -> Msg a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> Msg a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> Msg a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Msg a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Msg a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Msg a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Msg a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Msg a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Msg a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> Msg a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> Msg a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Msg a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Msg a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Msg a -> m
fold :: forall m. Monoid m => Msg m -> m
$cfold :: forall m. Monoid m => Msg m -> m
Foldable,Functor Msg
Foldable Msg
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => Msg (m a) -> m (Msg a)
forall (f :: * -> *) a. Applicative f => Msg (f a) -> f (Msg a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Msg a -> m (Msg b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Msg a -> f (Msg b)
sequence :: forall (m :: * -> *) a. Monad m => Msg (m a) -> m (Msg a)
$csequence :: forall (m :: * -> *) a. Monad m => Msg (m a) -> m (Msg a)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Msg a -> m (Msg b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Msg a -> m (Msg b)
sequenceA :: forall (f :: * -> *) a. Applicative f => Msg (f a) -> f (Msg a)
$csequenceA :: forall (f :: * -> *) a. Applicative f => Msg (f a) -> f (Msg a)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Msg a -> f (Msg b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Msg a -> f (Msg b)
Traversable)

-- | DNS message header section as per [RFC 1035, section 4.1.1](https://tools.ietf.org/html/rfc1035#section-4.1.1)
data MsgHeader
    = MsgHeader
      { MsgHeader -> Word16
mhId      :: !Word16

      , MsgHeader -> MsgHeaderFlags
mhFlags   :: !MsgHeaderFlags

      , MsgHeader -> Word16
mhQDCount :: !Word16
      , MsgHeader -> Word16
mhANCount :: !Word16
      , MsgHeader -> Word16
mhNSCount :: !Word16
      , MsgHeader -> Word16
mhARCount :: !Word16
      } deriving (ReadPrec [MsgHeader]
ReadPrec MsgHeader
Int -> ReadS MsgHeader
ReadS [MsgHeader]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MsgHeader]
$creadListPrec :: ReadPrec [MsgHeader]
readPrec :: ReadPrec MsgHeader
$creadPrec :: ReadPrec MsgHeader
readList :: ReadS [MsgHeader]
$creadList :: ReadS [MsgHeader]
readsPrec :: Int -> ReadS MsgHeader
$creadsPrec :: Int -> ReadS MsgHeader
Read,Int -> MsgHeader -> ShowS
[MsgHeader] -> ShowS
MsgHeader -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MsgHeader] -> ShowS
$cshowList :: [MsgHeader] -> ShowS
show :: MsgHeader -> String
$cshow :: MsgHeader -> String
showsPrec :: Int -> MsgHeader -> ShowS
$cshowsPrec :: Int -> MsgHeader -> ShowS
Show)

-- | DNS message header section as per [RFC 1035, section 4.1.2](https://tools.ietf.org/html/rfc1035#section-4.1.2)
data MsgQuestion l
    = MsgQuestion !l !Type !Class
    deriving (MsgQuestion l -> MsgQuestion l -> Bool
forall l. Eq l => MsgQuestion l -> MsgQuestion l -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MsgQuestion l -> MsgQuestion l -> Bool
$c/= :: forall l. Eq l => MsgQuestion l -> MsgQuestion l -> Bool
== :: MsgQuestion l -> MsgQuestion l -> Bool
$c== :: forall l. Eq l => MsgQuestion l -> MsgQuestion l -> Bool
Eq,ReadPrec [MsgQuestion l]
ReadPrec (MsgQuestion l)
ReadS [MsgQuestion l]
forall l. Read l => ReadPrec [MsgQuestion l]
forall l. Read l => ReadPrec (MsgQuestion l)
forall l. Read l => Int -> ReadS (MsgQuestion l)
forall l. Read l => ReadS [MsgQuestion l]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MsgQuestion l]
$creadListPrec :: forall l. Read l => ReadPrec [MsgQuestion l]
readPrec :: ReadPrec (MsgQuestion l)
$creadPrec :: forall l. Read l => ReadPrec (MsgQuestion l)
readList :: ReadS [MsgQuestion l]
$creadList :: forall l. Read l => ReadS [MsgQuestion l]
readsPrec :: Int -> ReadS (MsgQuestion l)
$creadsPrec :: forall l. Read l => Int -> ReadS (MsgQuestion l)
Read,Int -> MsgQuestion l -> ShowS
forall l. Show l => Int -> MsgQuestion l -> ShowS
forall l. Show l => [MsgQuestion l] -> ShowS
forall l. Show l => MsgQuestion l -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MsgQuestion l] -> ShowS
$cshowList :: forall l. Show l => [MsgQuestion l] -> ShowS
show :: MsgQuestion l -> String
$cshow :: forall l. Show l => MsgQuestion l -> String
showsPrec :: Int -> MsgQuestion l -> ShowS
$cshowsPrec :: forall l. Show l => Int -> MsgQuestion l -> ShowS
Show,forall a b. a -> MsgQuestion b -> MsgQuestion a
forall a b. (a -> b) -> MsgQuestion a -> MsgQuestion b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> MsgQuestion b -> MsgQuestion a
$c<$ :: forall a b. a -> MsgQuestion b -> MsgQuestion a
fmap :: forall a b. (a -> b) -> MsgQuestion a -> MsgQuestion b
$cfmap :: forall a b. (a -> b) -> MsgQuestion a -> MsgQuestion b
Functor,forall a. Eq a => a -> MsgQuestion a -> Bool
forall a. Num a => MsgQuestion a -> a
forall a. Ord a => MsgQuestion a -> a
forall m. Monoid m => MsgQuestion m -> m
forall a. MsgQuestion a -> Bool
forall a. MsgQuestion a -> Int
forall a. MsgQuestion a -> [a]
forall a. (a -> a -> a) -> MsgQuestion a -> a
forall m a. Monoid m => (a -> m) -> MsgQuestion a -> m
forall b a. (b -> a -> b) -> b -> MsgQuestion a -> b
forall a b. (a -> b -> b) -> b -> MsgQuestion a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: forall a. Num a => MsgQuestion a -> a
$cproduct :: forall a. Num a => MsgQuestion a -> a
sum :: forall a. Num a => MsgQuestion a -> a
$csum :: forall a. Num a => MsgQuestion a -> a
minimum :: forall a. Ord a => MsgQuestion a -> a
$cminimum :: forall a. Ord a => MsgQuestion a -> a
maximum :: forall a. Ord a => MsgQuestion a -> a
$cmaximum :: forall a. Ord a => MsgQuestion a -> a
elem :: forall a. Eq a => a -> MsgQuestion a -> Bool
$celem :: forall a. Eq a => a -> MsgQuestion a -> Bool
length :: forall a. MsgQuestion a -> Int
$clength :: forall a. MsgQuestion a -> Int
null :: forall a. MsgQuestion a -> Bool
$cnull :: forall a. MsgQuestion a -> Bool
toList :: forall a. MsgQuestion a -> [a]
$ctoList :: forall a. MsgQuestion a -> [a]
foldl1 :: forall a. (a -> a -> a) -> MsgQuestion a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> MsgQuestion a -> a
foldr1 :: forall a. (a -> a -> a) -> MsgQuestion a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> MsgQuestion a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> MsgQuestion a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> MsgQuestion a -> b
foldl :: forall b a. (b -> a -> b) -> b -> MsgQuestion a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> MsgQuestion a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> MsgQuestion a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> MsgQuestion a -> b
foldr :: forall a b. (a -> b -> b) -> b -> MsgQuestion a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> MsgQuestion a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> MsgQuestion a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> MsgQuestion a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> MsgQuestion a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> MsgQuestion a -> m
fold :: forall m. Monoid m => MsgQuestion m -> m
$cfold :: forall m. Monoid m => MsgQuestion m -> m
Foldable,Functor MsgQuestion
Foldable MsgQuestion
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
MsgQuestion (m a) -> m (MsgQuestion a)
forall (f :: * -> *) a.
Applicative f =>
MsgQuestion (f a) -> f (MsgQuestion a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> MsgQuestion a -> m (MsgQuestion b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> MsgQuestion a -> f (MsgQuestion b)
sequence :: forall (m :: * -> *) a.
Monad m =>
MsgQuestion (m a) -> m (MsgQuestion a)
$csequence :: forall (m :: * -> *) a.
Monad m =>
MsgQuestion (m a) -> m (MsgQuestion a)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> MsgQuestion a -> m (MsgQuestion b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> MsgQuestion a -> m (MsgQuestion b)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
MsgQuestion (f a) -> f (MsgQuestion a)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
MsgQuestion (f a) -> f (MsgQuestion a)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> MsgQuestion a -> f (MsgQuestion b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> MsgQuestion a -> f (MsgQuestion b)
Traversable)

-- | DNS message header flags as per [RFC 1035, section 4.1.1](https://tools.ietf.org/html/rfc1035#section-4.1.1)
data MsgHeaderFlags
    = MsgHeaderFlags
      { MsgHeaderFlags -> QR
mhQR     :: !QR
      , MsgHeaderFlags -> Word8
mhOpcode :: !Word8 -- actually Word4
      , MsgHeaderFlags -> Bool
mhAA     :: !Bool
      , MsgHeaderFlags -> Bool
mhTC     :: !Bool
      , MsgHeaderFlags -> Bool
mhRD     :: !Bool
      , MsgHeaderFlags -> Bool
mhRA     :: !Bool
      , MsgHeaderFlags -> Bool
mhZ      :: !Bool -- reserved/unused bit
      , MsgHeaderFlags -> Bool
mhAD     :: !Bool -- RFC4035
      , MsgHeaderFlags -> Bool
mhCD     :: !Bool -- RFC4035
      , MsgHeaderFlags -> Word8
mhRCode  :: !Word8 -- Word4
      } deriving (ReadPrec [MsgHeaderFlags]
ReadPrec MsgHeaderFlags
Int -> ReadS MsgHeaderFlags
ReadS [MsgHeaderFlags]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MsgHeaderFlags]
$creadListPrec :: ReadPrec [MsgHeaderFlags]
readPrec :: ReadPrec MsgHeaderFlags
$creadPrec :: ReadPrec MsgHeaderFlags
readList :: ReadS [MsgHeaderFlags]
$creadList :: ReadS [MsgHeaderFlags]
readsPrec :: Int -> ReadS MsgHeaderFlags
$creadsPrec :: Int -> ReadS MsgHeaderFlags
Read,Int -> MsgHeaderFlags -> ShowS
[MsgHeaderFlags] -> ShowS
MsgHeaderFlags -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MsgHeaderFlags] -> ShowS
$cshowList :: [MsgHeaderFlags] -> ShowS
show :: MsgHeaderFlags -> String
$cshow :: MsgHeaderFlags -> String
showsPrec :: Int -> MsgHeaderFlags -> ShowS
$cshowsPrec :: Int -> MsgHeaderFlags -> ShowS
Show)

-- | DNS resource record section as per [RFC 1035, section 4.1.3](https://tools.ietf.org/html/rfc1035#section-4.1.3)
data MsgRR l
    = MsgRR
      { forall l. MsgRR l -> l
rrName  :: !l
      , forall l. MsgRR l -> Class
rrClass :: !Class
      , forall l. MsgRR l -> TTL
rrTTL   :: !TTL
      , forall l. MsgRR l -> RData l
rrData  :: !(RData l)
      } deriving (MsgRR l -> MsgRR l -> Bool
forall l. Eq l => MsgRR l -> MsgRR l -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MsgRR l -> MsgRR l -> Bool
$c/= :: forall l. Eq l => MsgRR l -> MsgRR l -> Bool
== :: MsgRR l -> MsgRR l -> Bool
$c== :: forall l. Eq l => MsgRR l -> MsgRR l -> Bool
Eq,ReadPrec [MsgRR l]
ReadPrec (MsgRR l)
ReadS [MsgRR l]
forall l. Read l => ReadPrec [MsgRR l]
forall l. Read l => ReadPrec (MsgRR l)
forall l. Read l => Int -> ReadS (MsgRR l)
forall l. Read l => ReadS [MsgRR l]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MsgRR l]
$creadListPrec :: forall l. Read l => ReadPrec [MsgRR l]
readPrec :: ReadPrec (MsgRR l)
$creadPrec :: forall l. Read l => ReadPrec (MsgRR l)
readList :: ReadS [MsgRR l]
$creadList :: forall l. Read l => ReadS [MsgRR l]
readsPrec :: Int -> ReadS (MsgRR l)
$creadsPrec :: forall l. Read l => Int -> ReadS (MsgRR l)
Read,Int -> MsgRR l -> ShowS
forall l. Show l => Int -> MsgRR l -> ShowS
forall l. Show l => [MsgRR l] -> ShowS
forall l. Show l => MsgRR l -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MsgRR l] -> ShowS
$cshowList :: forall l. Show l => [MsgRR l] -> ShowS
show :: MsgRR l -> String
$cshow :: forall l. Show l => MsgRR l -> String
showsPrec :: Int -> MsgRR l -> ShowS
$cshowsPrec :: forall l. Show l => Int -> MsgRR l -> ShowS
Show,forall a b. a -> MsgRR b -> MsgRR a
forall a b. (a -> b) -> MsgRR a -> MsgRR b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> MsgRR b -> MsgRR a
$c<$ :: forall a b. a -> MsgRR b -> MsgRR a
fmap :: forall a b. (a -> b) -> MsgRR a -> MsgRR b
$cfmap :: forall a b. (a -> b) -> MsgRR a -> MsgRR b
Functor,forall a. Eq a => a -> MsgRR a -> Bool
forall a. Num a => MsgRR a -> a
forall a. Ord a => MsgRR a -> a
forall m. Monoid m => MsgRR m -> m
forall a. MsgRR a -> Bool
forall a. MsgRR a -> Int
forall a. MsgRR a -> [a]
forall a. (a -> a -> a) -> MsgRR a -> a
forall m a. Monoid m => (a -> m) -> MsgRR a -> m
forall b a. (b -> a -> b) -> b -> MsgRR a -> b
forall a b. (a -> b -> b) -> b -> MsgRR a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: forall a. Num a => MsgRR a -> a
$cproduct :: forall a. Num a => MsgRR a -> a
sum :: forall a. Num a => MsgRR a -> a
$csum :: forall a. Num a => MsgRR a -> a
minimum :: forall a. Ord a => MsgRR a -> a
$cminimum :: forall a. Ord a => MsgRR a -> a
maximum :: forall a. Ord a => MsgRR a -> a
$cmaximum :: forall a. Ord a => MsgRR a -> a
elem :: forall a. Eq a => a -> MsgRR a -> Bool
$celem :: forall a. Eq a => a -> MsgRR a -> Bool
length :: forall a. MsgRR a -> Int
$clength :: forall a. MsgRR a -> Int
null :: forall a. MsgRR a -> Bool
$cnull :: forall a. MsgRR a -> Bool
toList :: forall a. MsgRR a -> [a]
$ctoList :: forall a. MsgRR a -> [a]
foldl1 :: forall a. (a -> a -> a) -> MsgRR a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> MsgRR a -> a
foldr1 :: forall a. (a -> a -> a) -> MsgRR a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> MsgRR a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> MsgRR a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> MsgRR a -> b
foldl :: forall b a. (b -> a -> b) -> b -> MsgRR a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> MsgRR a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> MsgRR a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> MsgRR a -> b
foldr :: forall a b. (a -> b -> b) -> b -> MsgRR a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> MsgRR a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> MsgRR a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> MsgRR a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> MsgRR a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> MsgRR a -> m
fold :: forall m. Monoid m => MsgRR m -> m
$cfold :: forall m. Monoid m => MsgRR m -> m
Foldable,Functor MsgRR
Foldable MsgRR
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => MsgRR (m a) -> m (MsgRR a)
forall (f :: * -> *) a. Applicative f => MsgRR (f a) -> f (MsgRR a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> MsgRR a -> m (MsgRR b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> MsgRR a -> f (MsgRR b)
sequence :: forall (m :: * -> *) a. Monad m => MsgRR (m a) -> m (MsgRR a)
$csequence :: forall (m :: * -> *) a. Monad m => MsgRR (m a) -> m (MsgRR a)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> MsgRR a -> m (MsgRR b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> MsgRR a -> m (MsgRR b)
sequenceA :: forall (f :: * -> *) a. Applicative f => MsgRR (f a) -> f (MsgRR a)
$csequenceA :: forall (f :: * -> *) a. Applicative f => MsgRR (f a) -> f (MsgRR a)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> MsgRR a -> f (MsgRR b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> MsgRR a -> f (MsgRR b)
Traversable)

-- | DNS resource record data (see also 'MsgRR' and 'TypeSym')
data RData l
    = RDataA      !IPv4
    | RDataAAAA   !IPv6
    | RDataCNAME  !l
    | RDataPTR    !l
    | RDataHINFO  !CharStr !CharStr
    | RDataNS     !l
    | RDataMX     !Word16 !l
    | RDataTXT    ![CharStr]
    | RDataSPF    ![CharStr]
    | RDataSOA    !l !l !Word32 !Word32 !Word32 !Word32 !Word32
    | RDataSRV    !(SRV l)

    -- RFC 1183
    | RDataAFSDB  !Word16 !l

    -- RFC 2915
    | RDataNAPTR  !Word16 !Word16 !CharStr !CharStr !CharStr !l

    -- RFC 7553
    | RDataURI    !Word16 !Word16 !BS.ByteString

    -- RFC 4034
    | RDataRRSIG  !Word16 !Word8 !Word8 !Word32 !Word32 !Word32 !Word16 !l !BS.ByteString
    | RDataDNSKEY !Word16 !Word8 !Word8 !BS.ByteString
    | RDataDS     !Word16 !Word8 !Word8 !BS.ByteString
    | RDataNSEC   !l !(Set Type)

    -- RFC 4255
    | RDataSSHFP  !Word8 !Word8 !BS.ByteString

    -- RFC 5155
    | RDataNSEC3PARAM !Word8 !Word8 !Word16 !CharStr
    | RDataNSEC3      !Word8 !Word8 !Word16 !CharStr  !CharStr !(Set Type)

    -- RFC 6844
    | RDataCAA !Word8 !CharStr !BS.ByteString

    -- pseudo-record
    | RDataOPT !BS.ByteString -- FIXME

    -- unknown/unsupported
    | RData    !Type !BS.ByteString -- ^ Unknown/undecoded resource record type
    deriving (RData l -> RData l -> Bool
forall l. Eq l => RData l -> RData l -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RData l -> RData l -> Bool
$c/= :: forall l. Eq l => RData l -> RData l -> Bool
== :: RData l -> RData l -> Bool
$c== :: forall l. Eq l => RData l -> RData l -> Bool
Eq,ReadPrec [RData l]
ReadPrec (RData l)
ReadS [RData l]
forall l. Read l => ReadPrec [RData l]
forall l. Read l => ReadPrec (RData l)
forall l. Read l => Int -> ReadS (RData l)
forall l. Read l => ReadS [RData l]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RData l]
$creadListPrec :: forall l. Read l => ReadPrec [RData l]
readPrec :: ReadPrec (RData l)
$creadPrec :: forall l. Read l => ReadPrec (RData l)
readList :: ReadS [RData l]
$creadList :: forall l. Read l => ReadS [RData l]
readsPrec :: Int -> ReadS (RData l)
$creadsPrec :: forall l. Read l => Int -> ReadS (RData l)
Read,Int -> RData l -> ShowS
forall l. Show l => Int -> RData l -> ShowS
forall l. Show l => [RData l] -> ShowS
forall l. Show l => RData l -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RData l] -> ShowS
$cshowList :: forall l. Show l => [RData l] -> ShowS
show :: RData l -> String
$cshow :: forall l. Show l => RData l -> String
showsPrec :: Int -> RData l -> ShowS
$cshowsPrec :: forall l. Show l => Int -> RData l -> ShowS
Show,forall a b. a -> RData b -> RData a
forall a b. (a -> b) -> RData a -> RData b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> RData b -> RData a
$c<$ :: forall a b. a -> RData b -> RData a
fmap :: forall a b. (a -> b) -> RData a -> RData b
$cfmap :: forall a b. (a -> b) -> RData a -> RData b
Functor,forall a. Eq a => a -> RData a -> Bool
forall a. Num a => RData a -> a
forall a. Ord a => RData a -> a
forall m. Monoid m => RData m -> m
forall a. RData a -> Bool
forall a. RData a -> Int
forall a. RData a -> [a]
forall a. (a -> a -> a) -> RData a -> a
forall m a. Monoid m => (a -> m) -> RData a -> m
forall b a. (b -> a -> b) -> b -> RData a -> b
forall a b. (a -> b -> b) -> b -> RData a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: forall a. Num a => RData a -> a
$cproduct :: forall a. Num a => RData a -> a
sum :: forall a. Num a => RData a -> a
$csum :: forall a. Num a => RData a -> a
minimum :: forall a. Ord a => RData a -> a
$cminimum :: forall a. Ord a => RData a -> a
maximum :: forall a. Ord a => RData a -> a
$cmaximum :: forall a. Ord a => RData a -> a
elem :: forall a. Eq a => a -> RData a -> Bool
$celem :: forall a. Eq a => a -> RData a -> Bool
length :: forall a. RData a -> Int
$clength :: forall a. RData a -> Int
null :: forall a. RData a -> Bool
$cnull :: forall a. RData a -> Bool
toList :: forall a. RData a -> [a]
$ctoList :: forall a. RData a -> [a]
foldl1 :: forall a. (a -> a -> a) -> RData a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> RData a -> a
foldr1 :: forall a. (a -> a -> a) -> RData a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> RData a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> RData a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> RData a -> b
foldl :: forall b a. (b -> a -> b) -> b -> RData a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> RData a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> RData a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> RData a -> b
foldr :: forall a b. (a -> b -> b) -> b -> RData a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> RData a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> RData a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> RData a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> RData a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> RData a -> m
fold :: forall m. Monoid m => RData m -> m
$cfold :: forall m. Monoid m => RData m -> m
Foldable,Functor RData
Foldable RData
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => RData (m a) -> m (RData a)
forall (f :: * -> *) a. Applicative f => RData (f a) -> f (RData a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> RData a -> m (RData b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> RData a -> f (RData b)
sequence :: forall (m :: * -> *) a. Monad m => RData (m a) -> m (RData a)
$csequence :: forall (m :: * -> *) a. Monad m => RData (m a) -> m (RData a)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> RData a -> m (RData b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> RData a -> m (RData b)
sequenceA :: forall (f :: * -> *) a. Applicative f => RData (f a) -> f (RData a)
$csequenceA :: forall (f :: * -> *) a. Applicative f => RData (f a) -> f (RData a)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> RData a -> f (RData b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> RData a -> f (RData b)
Traversable)


-- | @SRV@ Record data as per [RFC 2782](https://tools.ietf.org/html/rfc2782)
data SRV l = SRV { forall l. SRV l -> Word16
srvPriority :: !Word16
                 , forall l. SRV l -> Word16
srvWeight   :: !Word16
                 , forall l. SRV l -> Word16
srvPort     :: !Word16
                 , forall l. SRV l -> l
srvTarget   :: !l
                 } deriving (SRV l -> SRV l -> Bool
forall l. Eq l => SRV l -> SRV l -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SRV l -> SRV l -> Bool
$c/= :: forall l. Eq l => SRV l -> SRV l -> Bool
== :: SRV l -> SRV l -> Bool
$c== :: forall l. Eq l => SRV l -> SRV l -> Bool
Eq,ReadPrec [SRV l]
ReadPrec (SRV l)
ReadS [SRV l]
forall l. Read l => ReadPrec [SRV l]
forall l. Read l => ReadPrec (SRV l)
forall l. Read l => Int -> ReadS (SRV l)
forall l. Read l => ReadS [SRV l]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SRV l]
$creadListPrec :: forall l. Read l => ReadPrec [SRV l]
readPrec :: ReadPrec (SRV l)
$creadPrec :: forall l. Read l => ReadPrec (SRV l)
readList :: ReadS [SRV l]
$creadList :: forall l. Read l => ReadS [SRV l]
readsPrec :: Int -> ReadS (SRV l)
$creadsPrec :: forall l. Read l => Int -> ReadS (SRV l)
Read,Int -> SRV l -> ShowS
forall l. Show l => Int -> SRV l -> ShowS
forall l. Show l => [SRV l] -> ShowS
forall l. Show l => SRV l -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SRV l] -> ShowS
$cshowList :: forall l. Show l => [SRV l] -> ShowS
show :: SRV l -> String
$cshow :: forall l. Show l => SRV l -> String
showsPrec :: Int -> SRV l -> ShowS
$cshowsPrec :: forall l. Show l => Int -> SRV l -> ShowS
Show,forall a b. a -> SRV b -> SRV a
forall a b. (a -> b) -> SRV a -> SRV b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> SRV b -> SRV a
$c<$ :: forall a b. a -> SRV b -> SRV a
fmap :: forall a b. (a -> b) -> SRV a -> SRV b
$cfmap :: forall a b. (a -> b) -> SRV a -> SRV b
Functor,forall a. Eq a => a -> SRV a -> Bool
forall a. Num a => SRV a -> a
forall a. Ord a => SRV a -> a
forall m. Monoid m => SRV m -> m
forall a. SRV a -> Bool
forall a. SRV a -> Int
forall a. SRV a -> [a]
forall a. (a -> a -> a) -> SRV a -> a
forall m a. Monoid m => (a -> m) -> SRV a -> m
forall b a. (b -> a -> b) -> b -> SRV a -> b
forall a b. (a -> b -> b) -> b -> SRV a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: forall a. Num a => SRV a -> a
$cproduct :: forall a. Num a => SRV a -> a
sum :: forall a. Num a => SRV a -> a
$csum :: forall a. Num a => SRV a -> a
minimum :: forall a. Ord a => SRV a -> a
$cminimum :: forall a. Ord a => SRV a -> a
maximum :: forall a. Ord a => SRV a -> a
$cmaximum :: forall a. Ord a => SRV a -> a
elem :: forall a. Eq a => a -> SRV a -> Bool
$celem :: forall a. Eq a => a -> SRV a -> Bool
length :: forall a. SRV a -> Int
$clength :: forall a. SRV a -> Int
null :: forall a. SRV a -> Bool
$cnull :: forall a. SRV a -> Bool
toList :: forall a. SRV a -> [a]
$ctoList :: forall a. SRV a -> [a]
foldl1 :: forall a. (a -> a -> a) -> SRV a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> SRV a -> a
foldr1 :: forall a. (a -> a -> a) -> SRV a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> SRV a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> SRV a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> SRV a -> b
foldl :: forall b a. (b -> a -> b) -> b -> SRV a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> SRV a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> SRV a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> SRV a -> b
foldr :: forall a b. (a -> b -> b) -> b -> SRV a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> SRV a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> SRV a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> SRV a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> SRV a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> SRV a -> m
fold :: forall m. Monoid m => SRV m -> m
$cfold :: forall m. Monoid m => SRV m -> m
Foldable,Functor SRV
Foldable SRV
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => SRV (m a) -> m (SRV a)
forall (f :: * -> *) a. Applicative f => SRV (f a) -> f (SRV a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> SRV a -> m (SRV b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> SRV a -> f (SRV b)
sequence :: forall (m :: * -> *) a. Monad m => SRV (m a) -> m (SRV a)
$csequence :: forall (m :: * -> *) a. Monad m => SRV (m a) -> m (SRV a)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> SRV a -> m (SRV b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> SRV a -> m (SRV b)
sequenceA :: forall (f :: * -> *) a. Applicative f => SRV (f a) -> f (SRV a)
$csequenceA :: forall (f :: * -> *) a. Applicative f => SRV (f a) -> f (SRV a)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> SRV a -> f (SRV b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> SRV a -> f (SRV b)
Traversable)

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

decodeMessage' :: BS.ByteString -> Maybe (Msg Labels)
decodeMessage' :: Label -> Maybe (Msg Labels)
decodeMessage' Label
bs = do
    (ByteString
rest, ByteOffset
_, Msg LabelsPtr
v) <- forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall {a} {b} {a}. (Show a, Show b) => (ByteString, b, a) -> a
handleParseFail forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$
                    forall a.
Binary a =>
ByteString
-> Either
     (ByteString, ByteOffset, String) (ByteString, ByteOffset, a)
decodeOrFail (Label -> ByteString
fromStrict Label
bs)

    -- don't allow trailing garbage
    forall (f :: * -> *). Alternative f => Bool -> f ()
guard (ByteString -> Bool
BSL.null ByteString
rest)

    let ofss :: Set Word16
ofss = forall a. Ord a => [a] -> Set a
Set.fromList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe LabelsPtr -> Maybe Word16
labelsPtr (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Msg LabelsPtr
v)
    Map Word16 LabelsPtr
ofsmap <- Label -> Set Word16 -> Maybe (Map Word16 LabelsPtr)
retrieveLabelPtrs Label
bs Set Word16
ofss

    forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Map Word16 LabelsPtr -> LabelsPtr -> Maybe Labels
resolveLabelPtr Map Word16 LabelsPtr
ofsmap) Msg LabelsPtr
v
  where
    -- handleParseFail _ = Nothing
    handleParseFail :: (ByteString, b, a) -> a
handleParseFail (ByteString
rest, b
n, a
e) = forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show (a
e, b
n, ByteString -> ByteOffset
BSL.length ByteString
rest, Label -> Int
BS.length Label
bs) forall a. [a] -> [a] -> [a]
++ String
"\n" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (Label -> Label
B16.encode forall a b. (a -> b) -> a -> b
$ ByteString -> Label
toStrict ByteString
rest)

-- | Decode a raw DNS message (query or response)
--
-- Returns 'Nothing' on decoding failures.
decodeMessage :: IsLabels n => BS.ByteString -> Maybe (Msg n)
decodeMessage :: forall n. IsLabels n => Label -> Maybe (Msg n)
decodeMessage = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall s. IsLabels s => Labels -> s
fromLabels) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Label -> Maybe (Msg Labels)
decodeMessage'

encodeMessage' :: Msg Labels -> BS.ByteString
encodeMessage' :: Msg Labels -> Label
encodeMessage' Msg Labels
m = ByteString -> Label
toStrict forall a b. (a -> b) -> a -> b
$ forall a. Binary a => a -> ByteString
encode (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Labels -> LabelsPtr
labels2labelsPtr Msg Labels
m)

-- | Construct a raw DNS message (query or response)
--
-- May return 'Nothing' in input parameters are detected to be invalid.
encodeMessage :: IsLabels n => Msg n -> Maybe BS.ByteString
encodeMessage :: forall n. IsLabels n => Msg n -> Maybe Label
encodeMessage Msg n
m = Msg Labels -> Label
encodeMessage' forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall s. IsLabels s => s -> Maybe Labels
toLabels Msg n
m


instance Binary l => Binary (Msg l) where
    get :: Get (Msg l)
get = do
        hdr :: MsgHeader
hdr@MsgHeader{Word16
MsgHeaderFlags
mhARCount :: Word16
mhNSCount :: Word16
mhANCount :: Word16
mhQDCount :: Word16
mhFlags :: MsgHeaderFlags
mhId :: Word16
mhARCount :: MsgHeader -> Word16
mhNSCount :: MsgHeader -> Word16
mhANCount :: MsgHeader -> Word16
mhQDCount :: MsgHeader -> Word16
mhFlags :: MsgHeader -> MsgHeaderFlags
mhId :: MsgHeader -> Word16
..} <- forall t. Binary t => Get t
get

        forall l.
MsgHeader
-> [MsgQuestion l] -> [MsgRR l] -> [MsgRR l] -> [MsgRR l] -> Msg l
Msg MsgHeader
hdr forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
mhQDCount) forall t. Binary t => Get t
get
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
mhANCount) forall t. Binary t => Get t
get
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
mhNSCount) forall t. Binary t => Get t
get
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
mhARCount) forall t. Binary t => Get t
get

    put :: Msg l -> Put
put (Msg MsgHeader
hdr [MsgQuestion l]
qds [MsgRR l]
ans [MsgRR l]
nss [MsgRR l]
ars) = do
        forall t. Binary t => t -> Put
put MsgHeader
hdr
        forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall t. Binary t => t -> Put
put [MsgQuestion l]
qds
        forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall t. Binary t => t -> Put
put [MsgRR l]
ans
        forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall t. Binary t => t -> Put
put [MsgRR l]
nss
        forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall t. Binary t => t -> Put
put [MsgRR l]
ars

instance Binary MsgHeader where
    get :: Get MsgHeader
get = Word16
-> MsgHeaderFlags
-> Word16
-> Word16
-> Word16
-> Word16
-> MsgHeader
MsgHeader forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
getWord16be
                    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall t. Binary t => Get t
get
                    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Word16
getWord16be
                    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Word16
getWord16be
                    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Word16
getWord16be
                    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Word16
getWord16be

    put :: MsgHeader -> Put
put (MsgHeader{Word16
MsgHeaderFlags
mhARCount :: Word16
mhNSCount :: Word16
mhANCount :: Word16
mhQDCount :: Word16
mhFlags :: MsgHeaderFlags
mhId :: Word16
mhARCount :: MsgHeader -> Word16
mhNSCount :: MsgHeader -> Word16
mhANCount :: MsgHeader -> Word16
mhQDCount :: MsgHeader -> Word16
mhFlags :: MsgHeader -> MsgHeaderFlags
mhId :: MsgHeader -> Word16
..}) = do
        Word16 -> Put
putWord16be Word16
mhId
        forall t. Binary t => t -> Put
put MsgHeaderFlags
mhFlags
        Word16 -> Put
putWord16be Word16
mhQDCount
        Word16 -> Put
putWord16be Word16
mhANCount
        Word16 -> Put
putWord16be Word16
mhNSCount
        Word16 -> Put
putWord16be Word16
mhARCount

instance Binary MsgHeaderFlags where
    put :: MsgHeaderFlags -> Put
put = Word16 -> Put
putWord16be forall b c a. (b -> c) -> (a -> b) -> a -> c
. MsgHeaderFlags -> Word16
encodeFlags
    get :: Get MsgHeaderFlags
get = Word16 -> MsgHeaderFlags
decodeFlags forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
getWord16be

-- | Decode message header flag field
--
-- >  +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+
-- >  |QR|   Opcode  |AA|TC|RD|RA|??|AD|CD|   RCODE   |
-- >  +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+
--
decodeFlags :: Word16 -> MsgHeaderFlags
decodeFlags :: Word16 -> MsgHeaderFlags
decodeFlags Word16
w = MsgHeaderFlags{Bool
Word8
QR
mhRCode :: Word8
mhCD :: Bool
mhAD :: Bool
mhZ :: Bool
mhRA :: Bool
mhRD :: Bool
mhTC :: Bool
mhAA :: Bool
mhOpcode :: Word8
mhQR :: QR
mhRCode :: Word8
mhCD :: Bool
mhAD :: Bool
mhZ :: Bool
mhRA :: Bool
mhRD :: Bool
mhTC :: Bool
mhAA :: Bool
mhOpcode :: Word8
mhQR :: QR
..}
  where
    mhQR :: QR
mhQR      = if forall a. Bits a => a -> Int -> Bool
testBit Word16
w Int
15 then QR
IsResponse else QR
IsQuery
    mhOpcode :: Word8
mhOpcode  = Int -> Word8
shiftR'   Int
11 forall a. Bits a => a -> a -> a
.&. Word8
0xf
    mhAA :: Bool
mhAA      = forall a. Bits a => a -> Int -> Bool
testBit Word16
w Int
10
    mhTC :: Bool
mhTC      = forall a. Bits a => a -> Int -> Bool
testBit Word16
w  Int
9
    mhRD :: Bool
mhRD      = forall a. Bits a => a -> Int -> Bool
testBit Word16
w  Int
8
    mhRA :: Bool
mhRA      = forall a. Bits a => a -> Int -> Bool
testBit Word16
w  Int
7
    mhZ :: Bool
mhZ       = forall a. Bits a => a -> Int -> Bool
testBit Word16
w  Int
6
    mhAD :: Bool
mhAD      = forall a. Bits a => a -> Int -> Bool
testBit Word16
w  Int
5
    mhCD :: Bool
mhCD      = forall a. Bits a => a -> Int -> Bool
testBit Word16
w  Int
4
    mhRCode :: Word8
mhRCode   = forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
w forall a. Bits a => a -> a -> a
.&. Word8
0xf

    shiftR' :: Int -> Word8
shiftR' = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Bits a => a -> Int -> a
shiftR Word16
w

encodeFlags :: MsgHeaderFlags -> Word16
encodeFlags :: MsgHeaderFlags -> Word16
encodeFlags MsgHeaderFlags{Bool
Word8
QR
mhRCode :: Word8
mhCD :: Bool
mhAD :: Bool
mhZ :: Bool
mhRA :: Bool
mhRD :: Bool
mhTC :: Bool
mhAA :: Bool
mhOpcode :: Word8
mhQR :: QR
mhRCode :: MsgHeaderFlags -> Word8
mhCD :: MsgHeaderFlags -> Bool
mhAD :: MsgHeaderFlags -> Bool
mhZ :: MsgHeaderFlags -> Bool
mhRA :: MsgHeaderFlags -> Bool
mhRD :: MsgHeaderFlags -> Bool
mhTC :: MsgHeaderFlags -> Bool
mhAA :: MsgHeaderFlags -> Bool
mhOpcode :: MsgHeaderFlags -> Word8
mhQR :: MsgHeaderFlags -> QR
..} =
    (case QR
mhQR of
        QR
IsResponse -> forall a. Bits a => Int -> a
bit Int
15
        QR
IsQuery    -> Word16
0) forall a. Bits a => a -> a -> a
.|.
    (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
mhOpcode forall a. Bits a => a -> Int -> a
`shiftL` Int
11) forall a. Bits a => a -> a -> a
.|.
    (if Bool
mhAA then forall a. Bits a => Int -> a
bit Int
10 else Word16
0) forall a. Bits a => a -> a -> a
.|.
    (if Bool
mhTC then forall a. Bits a => Int -> a
bit  Int
9 else Word16
0) forall a. Bits a => a -> a -> a
.|.
    (if Bool
mhRD then forall a. Bits a => Int -> a
bit  Int
8 else Word16
0) forall a. Bits a => a -> a -> a
.|.
    (if Bool
mhRA then forall a. Bits a => Int -> a
bit  Int
7 else Word16
0) forall a. Bits a => a -> a -> a
.|.
    (if Bool
mhZ  then forall a. Bits a => Int -> a
bit  Int
6 else Word16
0) forall a. Bits a => a -> a -> a
.|.
    (if Bool
mhAD then forall a. Bits a => Int -> a
bit  Int
5 else Word16
0) forall a. Bits a => a -> a -> a
.|.
    (if Bool
mhCD then forall a. Bits a => Int -> a
bit  Int
4 else Word16
0) forall a. Bits a => a -> a -> a
.|.
    (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
mhRCode)

-- | Encodes whether message is a query or a response
--
-- @since 0.1.1.0
data QR = IsQuery | IsResponse
        deriving (QR -> QR -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: QR -> QR -> Bool
$c/= :: QR -> QR -> Bool
== :: QR -> QR -> Bool
$c== :: QR -> QR -> Bool
Eq,ReadPrec [QR]
ReadPrec QR
Int -> ReadS QR
ReadS [QR]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [QR]
$creadListPrec :: ReadPrec [QR]
readPrec :: ReadPrec QR
$creadPrec :: ReadPrec QR
readList :: ReadS [QR]
$creadList :: ReadS [QR]
readsPrec :: Int -> ReadS QR
$creadsPrec :: Int -> ReadS QR
Read,Int -> QR -> ShowS
[QR] -> ShowS
QR -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [QR] -> ShowS
$cshowList :: [QR] -> ShowS
show :: QR -> String
$cshow :: QR -> String
showsPrec :: Int -> QR -> ShowS
$cshowsPrec :: Int -> QR -> ShowS
Show)

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

infixr 5 :.:

-- | A DNS Label
--
-- Must be non-empty and at most 63 octets.
type Label = BS.ByteString

-- | A @<domain-name>@ as per [RFC 1035, section 3.3](https://tools.ietf.org/html/rfc1035#section-3.3) expressed as list of 'Label's.
--
-- See also 'Name'
data Labels = !Label :.: !Labels | Root
            deriving (ReadPrec [Labels]
ReadPrec Labels
Int -> ReadS Labels
ReadS [Labels]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Labels]
$creadListPrec :: ReadPrec [Labels]
readPrec :: ReadPrec Labels
$creadPrec :: ReadPrec Labels
readList :: ReadS [Labels]
$creadList :: ReadS [Labels]
readsPrec :: Int -> ReadS Labels
$creadsPrec :: Int -> ReadS Labels
Read,Int -> Labels -> ShowS
[Labels] -> ShowS
Labels -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Labels] -> ShowS
$cshowList :: [Labels] -> ShowS
show :: Labels -> String
$cshow :: Labels -> String
showsPrec :: Int -> Labels -> ShowS
$cshowsPrec :: Int -> Labels -> ShowS
Show,Labels -> Labels -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Labels -> Labels -> Bool
$c/= :: Labels -> Labels -> Bool
== :: Labels -> Labels -> Bool
$c== :: Labels -> Labels -> Bool
Eq,Eq Labels
Labels -> Labels -> Bool
Labels -> Labels -> Ordering
Labels -> Labels -> Labels
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 :: Labels -> Labels -> Labels
$cmin :: Labels -> Labels -> Labels
max :: Labels -> Labels -> Labels
$cmax :: Labels -> Labels -> Labels
>= :: Labels -> Labels -> Bool
$c>= :: Labels -> Labels -> Bool
> :: Labels -> Labels -> Bool
$c> :: Labels -> Labels -> Bool
<= :: Labels -> Labels -> Bool
$c<= :: Labels -> Labels -> Bool
< :: Labels -> Labels -> Bool
$c< :: Labels -> Labels -> Bool
compare :: Labels -> Labels -> Ordering
$ccompare :: Labels -> Labels -> Ordering
Ord)

labelsToList :: Labels -> [Label]
labelsToList :: Labels -> [Label]
labelsToList (Label
x :.: Labels
xs) = Label
x forall a. a -> [a] -> [a]
: Labels -> [Label]
labelsToList Labels
xs
labelsToList Labels
Root       = [Label
""]

-- | Types that represent @<domain-name>@ as per [RFC 1035, section 3.3](https://tools.ietf.org/html/rfc1035#section-3.3) and can be converted to and from 'Labels'.
class IsLabels s where
  toLabels   :: s -> Maybe Labels
  fromLabels :: Labels -> s

instance IsLabels Labels where
  fromLabels :: Labels -> Labels
fromLabels = forall a. a -> a
id

  toLabels :: Labels -> Maybe Labels
toLabels Labels
ls
    | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Label -> Bool
isLabelValid (forall a. [a] -> [a]
init (Labels -> [Label]
labelsToList Labels
ls)) = forall a. a -> Maybe a
Just Labels
ls
    | Bool
otherwise = forall a. Maybe a
Nothing
    where
      isLabelValid :: Label -> Bool
isLabelValid Label
l = Bool -> Bool
not (Label -> Bool
BS.null Label
l) Bool -> Bool -> Bool
&& Label -> Int
BS.length Label
l forall a. Ord a => a -> a -> Bool
< Int
0x40

instance IsLabels Name where
  fromLabels :: Labels -> Name
fromLabels = Labels -> Name
labels2name
  toLabels :: Name -> Maybe Labels
toLabels   = Name -> Maybe Labels
name2labels

toName :: IsLabels n => n -> Maybe Name
toName :: forall n. IsLabels n => n -> Maybe Name
toName = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall s. IsLabels s => Labels -> s
fromLabels forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s. IsLabels s => s -> Maybe Labels
toLabels

name2labels :: Name -> Maybe Labels
name2labels :: Name -> Maybe Labels
name2labels (Name Label
n)
  | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\Label
l -> Bool -> Bool
not (Label -> Bool
BS.null Label
l) Bool -> Bool -> Bool
&& Label -> Int
BS.length Label
l forall a. Ord a => a -> a -> Bool
< Int
0x40) [Label]
n' = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$! forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Label -> Labels -> Labels
(:.:) Labels
Root [Label]
n'
  | Bool
otherwise = forall a. Maybe a
Nothing
  where
    n' :: [Label]
n' | Label -> Label -> Bool
BS.isSuffixOf Label
"." Label
n = Word8 -> Label -> [Label]
BS.split Word8
0x2e (HasCallStack => Label -> Label
BS.init Label
n)
       | Bool
otherwise           = Word8 -> Label -> [Label]
BS.split Word8
0x2e Label
n

labels2name :: Labels -> Name
labels2name :: Labels -> Name
labels2name Labels
Root = Label -> Name
Name Label
"."
labels2name Labels
ls   = Label -> Name
Name (Label -> [Label] -> Label
BS.intercalate Label
"." forall a b. (a -> b) -> a -> b
$ Labels -> [Label]
labelsToList Labels
ls)

-- | IOW, a domain-name
--
-- May contain pointers
--
-- Can be resolved into a 'Labels' without label ptrs.
data LabelsPtr = Label !Label !LabelsPtr -- ^ See RC2181: a label must be between 1-63 octets; can be arbitrary binary data
               | LPtr  !Word16
               | LNul
               deriving (LabelsPtr -> LabelsPtr -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LabelsPtr -> LabelsPtr -> Bool
$c/= :: LabelsPtr -> LabelsPtr -> Bool
== :: LabelsPtr -> LabelsPtr -> Bool
$c== :: LabelsPtr -> LabelsPtr -> Bool
Eq,ReadPrec [LabelsPtr]
ReadPrec LabelsPtr
Int -> ReadS LabelsPtr
ReadS [LabelsPtr]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [LabelsPtr]
$creadListPrec :: ReadPrec [LabelsPtr]
readPrec :: ReadPrec LabelsPtr
$creadPrec :: ReadPrec LabelsPtr
readList :: ReadS [LabelsPtr]
$creadList :: ReadS [LabelsPtr]
readsPrec :: Int -> ReadS LabelsPtr
$creadsPrec :: Int -> ReadS LabelsPtr
Read,Int -> LabelsPtr -> ShowS
[LabelsPtr] -> ShowS
LabelsPtr -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LabelsPtr] -> ShowS
$cshowList :: [LabelsPtr] -> ShowS
show :: LabelsPtr -> String
$cshow :: LabelsPtr -> String
showsPrec :: Int -> LabelsPtr -> ShowS
$cshowsPrec :: Int -> LabelsPtr -> ShowS
Show)

labels2labelsPtr :: Labels -> LabelsPtr
labels2labelsPtr :: Labels -> LabelsPtr
labels2labelsPtr Labels
Root         = LabelsPtr
LNul
labels2labelsPtr (Label
l :.: Labels
rest) = Label -> LabelsPtr -> LabelsPtr
Label Label
l (Labels -> LabelsPtr
labels2labelsPtr Labels
rest)

instance Binary LabelsPtr where
    get :: Get LabelsPtr
get = [Label] -> Get LabelsPtr
go []
      where
        go :: [Label] -> Get LabelsPtr
go [Label]
acc = do
            Either Word16 Label
l0 <- Get (Either Word16 Label)
getLabel
            case Either Word16 Label
l0 of
              Right Label
bs | Label -> Bool
BS.null Label
bs -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Label -> LabelsPtr -> LabelsPtr
Label LabelsPtr
LNul forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
reverse [Label]
acc)
                       | Bool
otherwise  -> [Label] -> Get LabelsPtr
go (Label
bsforall a. a -> [a] -> [a]
:[Label]
acc)
              Left Word16
ofs              -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Label -> LabelsPtr -> LabelsPtr
Label (Word16 -> LabelsPtr
LPtr Word16
ofs) forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
reverse [Label]
acc)

        getLabel :: Get (Either Word16 BS.ByteString)
        getLabel :: Get (Either Word16 Label)
getLabel = do
            Word8
len <- Get Word8
getWord8

            if Word8
len forall a. Ord a => a -> a -> Bool
>= Word8
0x40
             then do
                forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word8
len forall a. Bits a => a -> a -> a
.&. Word8
0xc0 forall a. Eq a => a -> a -> Bool
/= Word8
0xc0) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"invalid length octet " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Word8
len)
                Word16
ofs <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
getWord8
                forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ (forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8
len forall a. Bits a => a -> a -> a
.&. Word8
0x3f) forall a. Bits a => a -> Int -> a
`shiftL` Int
8) forall a. Bits a => a -> a -> a
.|. Word16
ofs
             else forall a b. b -> Either a b
Right forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Get Label
getByteString (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
len)

    put :: LabelsPtr -> Put
put LabelsPtr
LNul = Word8 -> Put
putWord8 Word8
0
    put (Label Label
l LabelsPtr
next)
      | Label -> Int
BS.length Label
l forall a. Ord a => a -> a -> Bool
< Int
1 Bool -> Bool -> Bool
|| Label -> Int
BS.length Label
l forall a. Ord a => a -> a -> Bool
>= Int
0x40 = forall a. HasCallStack => String -> a
error String
"put (Label {}): invalid label size"
      | Bool
otherwise = do
            Word8 -> Put
putWord8 (forall a b. (Integral a, Num b) => a -> b
fromIntegral (Label -> Int
BS.length Label
l))
            Label -> Put
putByteString Label
l
            forall t. Binary t => t -> Put
put LabelsPtr
next
    put (LPtr Word16
ofs)
      | Word16
ofs forall a. Ord a => a -> a -> Bool
< Word16
0x4000 = Word16 -> Put
putWord16be (Word16
0xc000 forall a. Bits a => a -> a -> a
.|. Word16
ofs)
      | Bool
otherwise  = forall a. HasCallStack => String -> a
error String
"put (LPtr {}): invalid offset"

-- | Compute serialised size of 'LabelsPtr'
labelsSize :: LabelsPtr -> Word16
labelsSize :: LabelsPtr -> Word16
labelsSize = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> LabelsPtr -> Int
go Int
0
  where
    go :: Int -> LabelsPtr -> Int
go Int
n (LPtr Word16
_)        = Int
nforall a. Num a => a -> a -> a
+Int
2
    go Int
n  LabelsPtr
LNul           = Int
nforall a. Num a => a -> a -> a
+Int
1
    go Int
n (Label Label
bs LabelsPtr
rest) = Int -> LabelsPtr -> Int
go (Int
n forall a. Num a => a -> a -> a
+ Int
1 forall a. Num a => a -> a -> a
+ Label -> Int
BS.length Label
bs) LabelsPtr
rest

-- | Extract pointer-offset from 'LabelsPtr' (if it exists)
labelsPtr :: LabelsPtr -> Maybe Word16
labelsPtr :: LabelsPtr -> Maybe Word16
labelsPtr (Label Label
_ LabelsPtr
ls) = LabelsPtr -> Maybe Word16
labelsPtr LabelsPtr
ls
labelsPtr LabelsPtr
LNul         = forall a. Maybe a
Nothing
labelsPtr (LPtr Word16
ofs)   = forall a. a -> Maybe a
Just Word16
ofs

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

instance Binary l => Binary (MsgQuestion l) where
    get :: Get (MsgQuestion l)
get = forall l. l -> Type -> Class -> MsgQuestion l
MsgQuestion forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t. Binary t => Get t
get forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall t. Binary t => Get t
get forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall t. Binary t => Get t
get
    put :: MsgQuestion l -> Put
put (MsgQuestion l
l Type
qt Class
cls) = forall t. Binary t => t -> Put
put l
l forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall t. Binary t => t -> Put
put Type
qt forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall t. Binary t => t -> Put
put Class
cls


instance Binary l => Binary (MsgRR l) where
    get :: Get (MsgRR l)
get = do
        l
rrName  <- forall t. Binary t => Get t
get
        Type
rrType  <- forall t. Binary t => Get t
get
        Class
rrClass <- forall t. Binary t => Get t
get
        TTL
rrTTL   <- forall t. Binary t => Get t
get
        RData l
rrData  <- forall l. Binary l => Type -> Get (RData l)
getRData Type
rrType
        forall (f :: * -> *) a. Applicative f => a -> f a
pure (MsgRR {l
TTL
Class
RData l
rrData :: RData l
rrTTL :: TTL
rrClass :: Class
rrName :: l
rrData :: RData l
rrTTL :: TTL
rrClass :: Class
rrName :: l
..})

    put :: MsgRR l -> Put
put (MsgRR{l
TTL
Class
RData l
rrData :: RData l
rrTTL :: TTL
rrClass :: Class
rrName :: l
rrData :: forall l. MsgRR l -> RData l
rrTTL :: forall l. MsgRR l -> TTL
rrClass :: forall l. MsgRR l -> Class
rrName :: forall l. MsgRR l -> l
..}) = do
        forall t. Binary t => t -> Put
put         l
rrName
        forall t. Binary t => t -> Put
put         (forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a. a -> a
id TypeSym -> Type
typeFromSym forall a b. (a -> b) -> a -> b
$ forall l. RData l -> Either Type TypeSym
rdType RData l
rrData)
        forall t. Binary t => t -> Put
put         Class
rrClass
        forall t. Binary t => t -> Put
put         TTL
rrTTL
        forall l. Binary l => RData l -> Put
putRData    RData l
rrData

getRData :: Binary l => Type -> Get (RData l)
getRData :: forall l. Binary l => Type -> Get (RData l)
getRData Type
qt = do
    Int
len     <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
getWord16be

    let unknownRdata :: Get (RData l)
unknownRdata = forall l. Type -> Label -> RData l
RData Type
qt forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Get Label
getByteString Int
len

        getByteStringRest :: Get Label
getByteStringRest = forall {b}. (Int -> Get b) -> Get b
consumeRestWith Int -> Get Label
getByteString

        consumeRestWith :: (Int -> Get b) -> Get b
consumeRestWith Int -> Get b
act = do
            Int
curofs <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ByteOffset
bytesRead
            Int -> Get b
act (Int
len forall a. Num a => a -> a -> a
- Int
curofs)

    forall a. Int -> Get a -> Get a
isolate Int
len forall a b. (a -> b) -> a -> b
$
      case Type -> Maybe TypeSym
typeToSym Type
qt of
        Maybe TypeSym
Nothing -> forall {l}. Get (RData l)
unknownRdata
        Just TypeSym
ts -> case TypeSym
ts of
          TypeSym
TypeA      -> forall l. IPv4 -> RData l
RDataA      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t. Binary t => Get t
get

          TypeSym
TypeAFSDB  -> forall l. Word16 -> l -> RData l
RDataAFSDB  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
getWord16be
                                    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall t. Binary t => Get t
get

          TypeSym
TypeNS     -> forall l. l -> RData l
RDataNS     forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t. Binary t => Get t
get

          TypeSym
TypeCNAME  -> forall l. l -> RData l
RDataCNAME  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t. Binary t => Get t
get

          TypeSym
TypeSOA    -> forall l.
l -> l -> Word32 -> Word32 -> Word32 -> Word32 -> Word32 -> RData l
RDataSOA    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t. Binary t => Get t
get
                                    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall t. Binary t => Get t
get
                                    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Word32
getWord32be
                                    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Word32
getWord32be
                                    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Word32
getWord32be
                                    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Word32
getWord32be
                                    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Word32
getWord32be

          TypeSym
TypePTR    -> forall l. l -> RData l
RDataPTR    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t. Binary t => Get t
get

          TypeSym
TypeHINFO  -> forall l. CharStr -> CharStr -> RData l
RDataHINFO  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t. Binary t => Get t
get
                                    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall t. Binary t => Get t
get

          TypeSym
TypeMX     -> forall l. Word16 -> l -> RData l
RDataMX     forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
getWord16be
                                    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall t. Binary t => Get t
get

          TypeSym
TypeTXT    -> forall l. [CharStr] -> RData l
RDataTXT    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Binary a => Get [a]
getUntilEmpty
          TypeSym
TypeSPF    -> forall l. [CharStr] -> RData l
RDataSPF    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Binary a => Get [a]
getUntilEmpty

          TypeSym
TypeAAAA   -> forall l. IPv6 -> RData l
RDataAAAA   forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t. Binary t => Get t
get

          TypeSym
TypeSRV    -> forall l. SRV l -> RData l
RDataSRV    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t. Binary t => Get t
get

          TypeSym
TypeNAPTR  -> forall l.
Word16 -> Word16 -> CharStr -> CharStr -> CharStr -> l -> RData l
RDataNAPTR  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
getWord16be -- order
                                    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Word16
getWord16be --preference
                                    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall t. Binary t => Get t
get -- flags
                                    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall t. Binary t => Get t
get -- services
                                    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall t. Binary t => Get t
get -- regexp
                                    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall t. Binary t => Get t
get -- replacement

          TypeSym
TypeRRSIG  -> forall l.
Word16
-> Word8
-> Word8
-> Word32
-> Word32
-> Word32
-> Word16
-> l
-> Label
-> RData l
RDataRRSIG  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
getWord16be
                                    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Word8
getWord8
                                    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Word8
getWord8
                                    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Word32
getWord32be
                                    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Word32
getWord32be
                                    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Word32
getWord32be
                                    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Word16
getWord16be
                                    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall t. Binary t => Get t
get -- uncompressed
                                    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Label
getByteStringRest

          TypeSym
TypeDNSKEY -> forall l. Word16 -> Word8 -> Word8 -> Label -> RData l
RDataDNSKEY forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
getWord16be
                                    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Word8
getWord8
                                    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Word8
getWord8
                                    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> Get Label
getByteString (Int
len forall a. Num a => a -> a -> a
- Int
4)

          TypeSym
TypeDS     -> forall l. Word16 -> Word8 -> Word8 -> Label -> RData l
RDataDS     forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
getWord16be
                                    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Word8
getWord8
                                    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Word8
getWord8
                                    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> Get Label
getByteString (Int
len forall a. Num a => a -> a -> a
- Int
4)

          TypeSym
TypeNSEC   -> forall l. l -> Set Type -> RData l
RDataNSEC   forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t. Binary t => Get t
get
                                    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get (Set Type)
decodeNsecTypeMap

          TypeSym
TypeURI    -> forall l. Word16 -> Word16 -> Label -> RData l
RDataURI    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
getWord16be -- prio
                                    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Word16
getWord16be -- weight
                                    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> Get Label
getByteString (Int
len forall a. Num a => a -> a -> a
- Int
4)

          TypeSym
TypeSSHFP  -> forall l. Word8 -> Word8 -> Label -> RData l
RDataSSHFP  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
getWord8
                                    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Word8
getWord8
                                    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> Get Label
getByteString (Int
len forall a. Num a => a -> a -> a
- Int
2)

          TypeSym
TypeNSEC3PARAM -> forall l. Word8 -> Word8 -> Word16 -> CharStr -> RData l
RDataNSEC3PARAM forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
getWord8
                                            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Word8
getWord8
                                            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Word16
getWord16be
                                            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall t. Binary t => Get t
get -- salt

          TypeSym
TypeNSEC3      -> forall l.
Word8
-> Word8 -> Word16 -> CharStr -> CharStr -> Set Type -> RData l
RDataNSEC3      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
getWord8
                                            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Word8
getWord8
                                            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Word16
getWord16be
                                            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall t. Binary t => Get t
get -- salt
                                            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall t. Binary t => Get t
get -- next hashed owner name
                                            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get (Set Type)
decodeNsecTypeMap

          TypeSym
TypeCAA        -> forall l. Word8 -> CharStr -> Label -> RData l
RDataCAA        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
getWord8 -- flags
                                            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall t. Binary t => Get t
get -- tag -- TODO: must be non-empty
                                            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Label
getByteStringRest

          TypeSym
TypeOPT -> forall l. Label -> RData l
RDataOPT forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Get Label
getByteString Int
len -- FIXME

          TypeSym
TypeANY    -> forall {l}. Get (RData l)
unknownRdata -- shouldn't happen

putRData :: Binary l => RData l -> Put
putRData :: forall l. Binary l => RData l -> Put
putRData RData l
rd = do
    let rdata :: ByteString
rdata = Put -> ByteString
runPut (forall l. Binary l => RData l -> Put
putRData' RData l
rd)
        rdataLen :: ByteOffset
rdataLen = ByteString -> ByteOffset
BSL.length ByteString
rdata

    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ByteOffset
rdataLen forall a. Ord a => a -> a -> Bool
< ByteOffset
0x10000) forall a b. (a -> b) -> a -> b
$
        forall a. HasCallStack => String -> a
error String
"rdata too large"

    Word16 -> Put
putWord16be (forall a b. (Integral a, Num b) => a -> b
fromIntegral ByteOffset
rdataLen)
    ByteString -> Put
putLazyByteString ByteString
rdata

putRData' :: Binary l => RData l -> Put
putRData' :: forall l. Binary l => RData l -> Put
putRData' RData l
rd = case RData l
rd of
  RDataA IPv4
ip4 -> forall t. Binary t => t -> Put
put IPv4
ip4
  RDataAAAA IPv6
ip6 -> forall t. Binary t => t -> Put
put IPv6
ip6
  RDataCNAME l
cname -> forall t. Binary t => t -> Put
put l
cname
  RDataOPT Label
d -> Label -> Put
putByteString Label
d
  RDataMX Word16
prio l
l -> Word16 -> Put
putWord16be Word16
prio forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall t. Binary t => t -> Put
put l
l
  RDataSOA l
l1 l
l2 Word32
w1 Word32
w2 Word32
w3 Word32
w4 Word32
w5 -> do
      forall t. Binary t => t -> Put
put l
l1
      forall t. Binary t => t -> Put
put l
l2
      Word32 -> Put
putWord32be Word32
w1
      Word32 -> Put
putWord32be Word32
w2
      Word32 -> Put
putWord32be Word32
w3
      Word32 -> Put
putWord32be Word32
w4
      Word32 -> Put
putWord32be Word32
w5

  RDataPTR l
l -> forall t. Binary t => t -> Put
put l
l
  RDataNS  l
l -> forall t. Binary t => t -> Put
put l
l
  RDataTXT [CharStr]
ss -> forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall t. Binary t => t -> Put
put [CharStr]
ss
  RDataSPF [CharStr]
ss -> forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall t. Binary t => t -> Put
put [CharStr]
ss
  RDataSRV SRV l
srv -> forall t. Binary t => t -> Put
put SRV l
srv

  RDataAFSDB Word16
w l
l -> Word16 -> Put
putWord16be Word16
w forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall t. Binary t => t -> Put
put l
l

  RDataHINFO CharStr
s1 CharStr
s2 -> forall t. Binary t => t -> Put
put CharStr
s1 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall t. Binary t => t -> Put
put CharStr
s2

  RDataRRSIG Word16
w1 Word8
w2 Word8
w3 Word32
w4 Word32
w5 Word32
w6 Word16
w7 l
l Label
s -> do
      Word16 -> Put
putWord16be Word16
w1
      Word8 -> Put
putWord8    Word8
w2
      Word8 -> Put
putWord8    Word8
w3
      Word32 -> Put
putWord32be Word32
w4
      Word32 -> Put
putWord32be Word32
w5
      Word32 -> Put
putWord32be Word32
w6
      Word16 -> Put
putWord16be Word16
w7
      forall t. Binary t => t -> Put
put l
l
      Label -> Put
putByteString Label
s

  RDataDNSKEY Word16
w1 Word8
w2 Word8
w3 Label
s -> do
      Word16 -> Put
putWord16be Word16
w1
      Word8 -> Put
putWord8    Word8
w2
      Word8 -> Put
putWord8    Word8
w3
      Label -> Put
putByteString Label
s

  RDataNSEC3PARAM Word8
w1 Word8
w2 Word16
w3 CharStr
s -> do
      Word8 -> Put
putWord8 Word8
w1
      Word8 -> Put
putWord8 Word8
w2
      Word16 -> Put
putWord16be Word16
w3
      forall t. Binary t => t -> Put
put CharStr
s

  RDataNSEC3 Word8
w1 Word8
w2 Word16
w3 CharStr
s1 CharStr
s2 Set Type
tm -> do
      Word8 -> Put
putWord8 Word8
w1
      Word8 -> Put
putWord8 Word8
w2
      Word16 -> Put
putWord16be Word16
w3
      forall t. Binary t => t -> Put
put CharStr
s1
      forall t. Binary t => t -> Put
put CharStr
s2
      Set Type -> Put
encodeNsecTypeMap Set Type
tm

  RDataCAA Word8
fl CharStr
s1 Label
s2 -> do
      Word8 -> Put
putWord8 Word8
fl
      forall t. Binary t => t -> Put
put CharStr
s1
      Label -> Put
putByteString Label
s2

  RDataURI Word16
w1 Word16
w2 Label
s -> do
      Word16 -> Put
putWord16be Word16
w1
      Word16 -> Put
putWord16be Word16
w2
      Label -> Put
putByteString Label
s

  RDataDS Word16
w1 Word8
w2 Word8
w3 Label
s -> do
      Word16 -> Put
putWord16be Word16
w1
      Word8 -> Put
putWord8 Word8
w2
      Word8 -> Put
putWord8 Word8
w3
      Label -> Put
putByteString Label
s

  RDataNSEC l
l Set Type
tm -> do
      forall t. Binary t => t -> Put
put l
l
      Set Type -> Put
encodeNsecTypeMap Set Type
tm

  RDataNAPTR Word16
w1 Word16
w2 CharStr
s1 CharStr
s2 CharStr
s3 l
l -> do
      Word16 -> Put
putWord16be Word16
w1
      Word16 -> Put
putWord16be Word16
w2
      forall t. Binary t => t -> Put
put CharStr
s1
      forall t. Binary t => t -> Put
put CharStr
s2
      forall t. Binary t => t -> Put
put CharStr
s3
      forall t. Binary t => t -> Put
put l
l

  RDataSSHFP Word8
w1 Word8
w2 Label
s -> do
      Word8 -> Put
putWord8 Word8
w1
      Word8 -> Put
putWord8 Word8
w2
      Label -> Put
putByteString Label
s

  RData Type
_ Label
raw -> Label -> Put
putByteString Label
raw

  -- _ -> error ("putRData: " ++ show rd)


instance Binary l => Binary (SRV l) where
    get :: Get (SRV l)
get = forall l. Word16 -> Word16 -> Word16 -> l -> SRV l
SRV forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
getWord16be
              forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Word16
getWord16be
              forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Word16
getWord16be
              forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall t. Binary t => Get t
get

    put :: SRV l -> Put
put (SRV Word16
w1 Word16
w2 Word16
w3 l
l) = do
      Word16 -> Put
putWord16be Word16
w1
      Word16 -> Put
putWord16be Word16
w2
      Word16 -> Put
putWord16be Word16
w3
      forall t. Binary t => t -> Put
put l
l

{- NSEC type-bitmap example:

 A NS SOA TXT AAAA RRSIG NSEC DNSKEY

'00 07 62 00 80 08 00 03 80'
'00000000 00000111 01100010 00000000 10000000 00001000 00000000 00000011 10000000'
 Win=#0    len=7         ^{SOA}      ^{TXT}       ^{AAAA}                ^{DNSKEY}
                    ^^{A,NS}                                          ^^{RRSIG,NSEC}
-}

decodeNsecTypeMap :: Get (Set Type)
decodeNsecTypeMap :: Get (Set Type)
decodeNsecTypeMap = do
    [Type]
r <- forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Get a -> Get [a]
untilEmptyWith Get [Type]
decode1
    -- TODO: enforce uniqueness
    forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. Ord a => [a] -> Set a
Set.fromList [Type]
r)
  where
    -- decode single window
    decode1 :: Get [Type]
decode1 = do
        Word8
wi <- Get Word8
getWord8
        Word8
l  <- Get Word8
getWord8
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Word8
0 forall a. Ord a => a -> a -> Bool
< Word8
l Bool -> Bool -> Bool
&& Word8
l forall a. Ord a => a -> a -> Bool
<= Word8
32) forall a b. (a -> b) -> a -> b
$
            forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"invalid bitmap length"

        Label
bmap <- Int -> Get Label
getByteString (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
l)

        let winofs :: Int
winofs = (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
wi)forall a. Num a => a -> a -> a
*Int
0x100 :: Int
            lst :: [Type]
lst = [ Word16 -> Type
Type (forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
winofsforall a. Num a => a -> a -> a
+Int
jforall a. Num a => a -> a -> a
*Int
8forall a. Num a => a -> a -> a
+Int
7forall a. Num a => a -> a -> a
-Int
i))
                  | (Int
j,Word8
x) <- forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] (Label -> [Word8]
BS.unpack Label
bmap)
                  , Int
i <- [Int
7,Int
6..Int
0]
                  , forall a. Bits a => a -> Int -> Bool
testBit Word8
x Int
i ]

        forall (f :: * -> *) a. Applicative f => a -> f a
pure [Type]
lst

encodeNsecTypeMap :: Set Type -> Put
encodeNsecTypeMap :: Set Type -> Put
encodeNsecTypeMap Set Type
bmap = do
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall a. Set a -> Bool
Set.null Set Type
bmap) forall a b. (a -> b) -> a -> b
$ forall a. HasCallStack => String -> a
error String
"invalid empty type-map"
    -- when (Set.member 0 bmap) $ fail "invalid TYPE0 set in type-map"
    -- TODO: verify that Meta-TYPES and QTYPEs aren't contained in bmap

    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (forall k a. Map k a -> [(k, a)]
Map.toList Map Word8 [Word8]
bmap') forall a b. (a -> b) -> a -> b
$ \(Word8
wi, [Word8]
tm) -> do
        Word8 -> Put
putWord8 Word8
wi
        forall t. Binary t => t -> Put
put (Label -> CharStr
CharStr forall a b. (a -> b) -> a -> b
$ [Word8] -> Label
BS.pack [Word8]
tm)
  where
    bmap' :: Map Word8 [Word8]
bmap' = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Set Word8 -> [Word8]
set2bitmap forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set Word16 -> Map Word8 (Set Word8)
splitToBlocks forall a b. (a -> b) -> a -> b
$ forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map (\(Type Word16
w)->Word16
w) Set Type
bmap

set2bitmap :: Set Word8 -> [Word8]
set2bitmap :: Set Word8 -> [Word8]
set2bitmap = forall {a} {t}. (Num t, Bits t, Integral a) => a -> t -> [a] -> [t]
go Word8
0 Word8
0 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Set a -> [a]
Set.toList
  where
    go :: a -> t -> [a] -> [t]
go a
_ t
acc [] = if t
acc forall a. Eq a => a -> a -> Bool
== t
0 then [] else [t
acc]
    go a
j t
acc (a
i:[a]
is)
      | a
j'  forall a. Ord a => a -> a -> Bool
> a
j  = t
acc forall a. a -> [a] -> [a]
: a -> t -> [a] -> [t]
go (a
jforall a. Num a => a -> a -> a
+a
1) t
0 (a
iforall a. a -> [a] -> [a]
:[a]
is)
      | a
j' forall a. Eq a => a -> a -> Bool
== a
j  = a -> t -> [a] -> [t]
go a
j' (t
acc forall a. Bits a => a -> a -> a
.|. forall a. Bits a => Int -> a
bit (Int
7 forall a. Num a => a -> a -> a
- forall a b. (Integral a, Num b) => a -> b
fromIntegral a
i')) [a]
is
      | Bool
otherwise = forall a. HasCallStack => String -> a
error String
"set2bitmap: the impossible happened"
      where
        (a
j',a
i') = a
i forall a. Integral a => a -> a -> (a, a)
`quotRem` a
8

splitToBlocks :: Set Word16 -> Map Word8 (Set Word8)
splitToBlocks :: Set Word16 -> Map Word8 (Set Word8)
splitToBlocks Set Word16
js = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\[(Word8, Word8)]
xs -> (forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
head [(Word8, Word8)]
xs, forall a. Ord a => [a] -> Set a
Set.fromList (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd [(Word8, Word8)]
xs))) [[(Word8, Word8)]]
js'
  where
    hi16 :: Word16 -> Word8
    hi16 :: Word16 -> Word8
hi16 = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Bits a => a -> Int -> a
shiftR Int
8

    lo16 :: Word16 -> Word8
    lo16 :: Word16 -> Word8
lo16 = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Bits a => a -> a -> a
.&. Word16
0xff)

    js' :: [[(Word8,Word8)]]
    js' :: [[(Word8, Word8)]]
js' = forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (forall a. Eq a => a -> a -> Bool
(==) forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall a b. (a, b) -> a
fst) (forall a b. (a -> b) -> [a] -> [b]
map ((,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Word16 -> Word8
hi16 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Word16 -> Word8
lo16) (forall a. Set a -> [a]
Set.toList Set Word16
js))


-- | Resolves/parses label pointer used for label compressing
--
-- Returns 'Nothing' on failure
retrieveLabelPtr :: BS.ByteString -> Word16 -> Maybe LabelsPtr
retrieveLabelPtr :: Label -> Word16 -> Maybe LabelsPtr
retrieveLabelPtr Label
msg Word16
ofs
    = case forall a.
Binary a =>
ByteString
-> Either
     (ByteString, ByteOffset, String) (ByteString, ByteOffset, a)
decodeOrFail (Label -> ByteString
fromStrict forall a b. (a -> b) -> a -> b
$ Int -> Label -> Label
BS.drop (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
ofs) Label
msg) of
        Left (ByteString, ByteOffset, String)
_          -> forall a. Maybe a
Nothing
        Right (ByteString
_, ByteOffset
_, LabelsPtr
v) -> forall a. a -> Maybe a
Just LabelsPtr
v

-- | Resolve set of label pointer offsets
--
-- Invariants (/iff/ result is not 'Nothing')
--
--  * all requested offsets will be contained in the result map
--
--  * any offsets contained in the resolved 'Labels' will be part of
--    the result map as well
--
-- NB: No cycle detection is performed, nor are 'Labels' flattened
retrieveLabelPtrs :: BS.ByteString -> Set Word16 -> Maybe (Map Word16 LabelsPtr)
retrieveLabelPtrs :: Label -> Set Word16 -> Maybe (Map Word16 LabelsPtr)
retrieveLabelPtrs Label
msg Set Word16
ofss0 = Map Word16 LabelsPtr -> Maybe (Map Word16 LabelsPtr)
go forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Set Word16 -> Maybe (Map Word16 LabelsPtr)
lupPtrs1 Set Word16
ofss0
  where
    go :: Map Word16 LabelsPtr -> Maybe (Map Word16 LabelsPtr)
    go :: Map Word16 LabelsPtr -> Maybe (Map Word16 LabelsPtr)
go Map Word16 LabelsPtr
m0 = do
        let missingOfss :: Set Word16
missingOfss = forall a. Ord a => [a] -> Set a
Set.fromList (forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe LabelsPtr -> Maybe Word16
labelsPtr (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Map Word16 LabelsPtr
m0)) forall a. Ord a => Set a -> Set a -> Set a
Set.\\ forall k a. Map k a -> Set k
Map.keysSet Map Word16 LabelsPtr
m0

        if forall a. Set a -> Bool
Set.null Set Word16
missingOfss
         then forall (f :: * -> *) a. Applicative f => a -> f a
pure Map Word16 LabelsPtr
m0 -- fix-point reached
         else do
            Map Word16 LabelsPtr
m1 <- Set Word16 -> Maybe (Map Word16 LabelsPtr)
lupPtrs1 Set Word16
missingOfss
            Map Word16 LabelsPtr -> Maybe (Map Word16 LabelsPtr)
go (forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union Map Word16 LabelsPtr
m0 Map Word16 LabelsPtr
m1)

    -- single lookup step
    lupPtrs1 :: Set Word16 -> Maybe (Map Word16 LabelsPtr)
    lupPtrs1 :: Set Word16 -> Maybe (Map Word16 LabelsPtr)
lupPtrs1 Set Word16
ofss1 = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. [a] -> [b] -> [(a, b)]
zip (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Set Word16
ofss1) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Label -> Word16 -> Maybe LabelsPtr
retrieveLabelPtr Label
msg) (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Set Word16
ofss1)

-- | Checks for maximum name length (255) and (therefore indirectly) cycle-checking
resolveLabelPtr :: Map Word16 LabelsPtr -> LabelsPtr -> Maybe Labels
resolveLabelPtr :: Map Word16 LabelsPtr -> LabelsPtr -> Maybe Labels
resolveLabelPtr Map Word16 LabelsPtr
ofsmap = Int -> [Label] -> LabelsPtr -> Maybe Labels
go Int
0 []
  where
    go :: Int -> [BS.ByteString] -> LabelsPtr -> Maybe Labels
    go :: Int -> [Label] -> LabelsPtr -> Maybe Labels
go !Int
n [Label]
acc (Label Label
x LabelsPtr
ls) = Int -> [Label] -> LabelsPtr -> Maybe Labels
go (Int
nforall a. Num a => a -> a -> a
+Int
1forall a. Num a => a -> a -> a
+Label -> Int
BS.length Label
x) (Label
xforall a. a -> [a] -> [a]
:[Label]
acc) LabelsPtr
ls
    go Int
n [Label]
acc LabelsPtr
LNul
        | Int
n forall a. Ord a => a -> a -> Bool
< Int
255    = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$! forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Label -> Labels -> Labels
(:.:) Labels
Root (forall a. [a] -> [a]
reverse [Label]
acc)
        | Bool
otherwise  = forall a. Maybe a
Nothing -- length violation
    go Int
n [Label]
acc (LPtr Word16
ofs)
        | Int
n forall a. Ord a => a -> a -> Bool
< Int
255    = Int -> [Label] -> LabelsPtr -> Maybe Labels
go Int
n [Label]
acc forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Word16 -> Maybe LabelsPtr
lup Word16
ofs
        | Bool
otherwise  = forall a. Maybe a
Nothing

    lup :: Word16 -> Maybe LabelsPtr
    lup :: Word16 -> Maybe LabelsPtr
lup Word16
ofs = forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Word16
ofs Map Word16 LabelsPtr
ofsmap


{- Resource records

 -- https://en.wikipedia.org/wiki/List_of_DNS_record_types

 RFC 1035

 A        1     a host address
 NS       2     an authoritative name server
 CNAME    5     the canonical name for an alias
 SOA      6     marks the start of a zone of authority
 PTR      12    a domain name pointer
 MX       15    mail exchange
 TXT      16    text strings

 RFC 3596

 AAAA     28    IPv6

 RFC 2782

 SRV      33    Location of services

 ----

 RFC3597            Handling of Unknown DNS Resource Record (RR) Types

-}

-- | Raw DNS record type code
--
-- See also 'TypeSym'
newtype Type = Type 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,ReadPrec [Type]
ReadPrec Type
Int -> ReadS Type
ReadS [Type]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Type]
$creadListPrec :: ReadPrec [Type]
readPrec :: ReadPrec Type
$creadPrec :: ReadPrec Type
readList :: ReadS [Type]
$creadList :: ReadS [Type]
readsPrec :: Int -> ReadS Type
$creadsPrec :: Int -> ReadS Type
Read,Int -> Type -> ShowS
[Type] -> ShowS
Type -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Type] -> ShowS
$cshowList :: [Type] -> ShowS
show :: Type -> String
$cshow :: Type -> String
showsPrec :: Int -> Type -> ShowS
$cshowsPrec :: Int -> Type -> ShowS
Show)

instance Binary Type where
    put :: Type -> Put
put (Type Word16
w) = Word16 -> Put
putWord16be Word16
w
    get :: Get Type
get = Word16 -> Type
Type forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
getWord16be

-- | DNS @CLASS@ code as per [RFC 1035, section 3.2.4](https://tools.ietf.org/html/rfc1035#section-3.2.4)
--
-- The most commonly used value is 'classIN'.
newtype Class = Class Word16
              deriving (Class -> Class -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Class -> Class -> Bool
$c/= :: Class -> Class -> Bool
== :: Class -> Class -> Bool
$c== :: Class -> Class -> Bool
Eq,Eq Class
Class -> Class -> Bool
Class -> Class -> Ordering
Class -> Class -> Class
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 :: Class -> Class -> Class
$cmin :: Class -> Class -> Class
max :: Class -> Class -> Class
$cmax :: Class -> Class -> Class
>= :: Class -> Class -> Bool
$c>= :: Class -> Class -> Bool
> :: Class -> Class -> Bool
$c> :: Class -> Class -> Bool
<= :: Class -> Class -> Bool
$c<= :: Class -> Class -> Bool
< :: Class -> Class -> Bool
$c< :: Class -> Class -> Bool
compare :: Class -> Class -> Ordering
$ccompare :: Class -> Class -> Ordering
Ord,ReadPrec [Class]
ReadPrec Class
Int -> ReadS Class
ReadS [Class]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Class]
$creadListPrec :: ReadPrec [Class]
readPrec :: ReadPrec Class
$creadPrec :: ReadPrec Class
readList :: ReadS [Class]
$creadList :: ReadS [Class]
readsPrec :: Int -> ReadS Class
$creadsPrec :: Int -> ReadS Class
Read,Int -> Class -> ShowS
[Class] -> ShowS
Class -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Class] -> ShowS
$cshowList :: [Class] -> ShowS
show :: Class -> String
$cshow :: Class -> String
showsPrec :: Int -> Class -> ShowS
$cshowsPrec :: Int -> Class -> ShowS
Show)

-- | The 'Class' constant for @IN@ (Internet)
classIN :: Class
classIN :: Class
classIN = Word16 -> Class
Class Word16
1

instance Binary Class where
    put :: Class -> Put
put (Class Word16
w) = Word16 -> Put
putWord16be Word16
w
    get :: Get Class
get = Word16 -> Class
Class forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
getWord16be

-- | Cache time-to-live expressed in seconds
newtype TTL = TTL Int32
            deriving (TTL -> TTL -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TTL -> TTL -> Bool
$c/= :: TTL -> TTL -> Bool
== :: TTL -> TTL -> Bool
$c== :: TTL -> TTL -> Bool
Eq,Eq TTL
TTL -> TTL -> Bool
TTL -> TTL -> Ordering
TTL -> TTL -> TTL
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 :: TTL -> TTL -> TTL
$cmin :: TTL -> TTL -> TTL
max :: TTL -> TTL -> TTL
$cmax :: TTL -> TTL -> TTL
>= :: TTL -> TTL -> Bool
$c>= :: TTL -> TTL -> Bool
> :: TTL -> TTL -> Bool
$c> :: TTL -> TTL -> Bool
<= :: TTL -> TTL -> Bool
$c<= :: TTL -> TTL -> Bool
< :: TTL -> TTL -> Bool
$c< :: TTL -> TTL -> Bool
compare :: TTL -> TTL -> Ordering
$ccompare :: TTL -> TTL -> Ordering
Ord,ReadPrec [TTL]
ReadPrec TTL
Int -> ReadS TTL
ReadS [TTL]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [TTL]
$creadListPrec :: ReadPrec [TTL]
readPrec :: ReadPrec TTL
$creadPrec :: ReadPrec TTL
readList :: ReadS [TTL]
$creadList :: ReadS [TTL]
readsPrec :: Int -> ReadS TTL
$creadsPrec :: Int -> ReadS TTL
Read,Int -> TTL -> ShowS
[TTL] -> ShowS
TTL -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TTL] -> ShowS
$cshowList :: [TTL] -> ShowS
show :: TTL -> String
$cshow :: TTL -> String
showsPrec :: Int -> TTL -> ShowS
$cshowsPrec :: Int -> TTL -> ShowS
Show)

instance Binary TTL where
    put :: TTL -> Put
put (TTL Int32
i) = Int32 -> Put
putInt32be Int32
i
    get :: Get TTL
get = Int32 -> TTL
TTL forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int32
getInt32be

-- http://www.bind9.net/dns-parameters

-- | Symbolic DNS record type
data TypeSym
    = TypeA          -- ^ [RFC 1035](https://tools.ietf.org/html/rfc1035)
    | TypeAAAA       -- ^ [RFC 3596](https://tools.ietf.org/html/rfc3596)
    | TypeAFSDB      -- ^ [RFC 1183](https://tools.ietf.org/html/rfc1183)
    | TypeANY        -- ^ [RFC 1035](https://tools.ietf.org/html/rfc1035) (query)
    | TypeCAA        -- ^ [RFC 6844](https://tools.ietf.org/html/rfc6844)
    | TypeCNAME      -- ^ [RFC 1035](https://tools.ietf.org/html/rfc1035)
    | TypeDNSKEY     -- ^ [RFC 4034](https://tools.ietf.org/html/rfc4034)
    | TypeDS         -- ^ [RFC 4034](https://tools.ietf.org/html/rfc4034)
    | TypeHINFO      -- ^ [RFC 1035](https://tools.ietf.org/html/rfc1035)
    | TypeMX         -- ^ [RFC 1035](https://tools.ietf.org/html/rfc1035)
    | TypeNAPTR      -- ^ [RFC 2915](https://tools.ietf.org/html/rfc2915)
    | TypeNS         -- ^ [RFC 1035](https://tools.ietf.org/html/rfc1035)
    | TypeNSEC       -- ^ [RFC 4034](https://tools.ietf.org/html/rfc4034)
    | TypeNSEC3      -- ^ [RFC 5155](https://tools.ietf.org/html/rfc5155)
    | TypeNSEC3PARAM -- ^ [RFC 5155](https://tools.ietf.org/html/rfc5155)
    | TypeOPT        -- ^ [RFC 6891](https://tools.ietf.org/html/rfc6891) (meta)
    | TypePTR        -- ^ [RFC 1035](https://tools.ietf.org/html/rfc1035)
    | TypeRRSIG      -- ^ [RFC 4034](https://tools.ietf.org/html/rfc4034)
    | TypeSOA        -- ^ [RFC 1035](https://tools.ietf.org/html/rfc1035)
    | TypeSPF        -- ^ [RFC 4408](https://tools.ietf.org/html/rfc4408)
    | TypeSRV        -- ^ [RFC 2782](https://tools.ietf.org/html/rfc2782)
    | TypeSSHFP      -- ^ [RFC 4255](https://tools.ietf.org/html/rfc4255)
    | TypeTXT        -- ^ [RFC 1035](https://tools.ietf.org/html/rfc1035)
    | TypeURI        -- ^ [RFC 7553](https://tools.ietf.org/html/rfc7553)
    deriving (TypeSym -> TypeSym -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TypeSym -> TypeSym -> Bool
$c/= :: TypeSym -> TypeSym -> Bool
== :: TypeSym -> TypeSym -> Bool
$c== :: TypeSym -> TypeSym -> Bool
Eq,Eq TypeSym
TypeSym -> TypeSym -> Bool
TypeSym -> TypeSym -> Ordering
TypeSym -> TypeSym -> TypeSym
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 :: TypeSym -> TypeSym -> TypeSym
$cmin :: TypeSym -> TypeSym -> TypeSym
max :: TypeSym -> TypeSym -> TypeSym
$cmax :: TypeSym -> TypeSym -> TypeSym
>= :: TypeSym -> TypeSym -> Bool
$c>= :: TypeSym -> TypeSym -> Bool
> :: TypeSym -> TypeSym -> Bool
$c> :: TypeSym -> TypeSym -> Bool
<= :: TypeSym -> TypeSym -> Bool
$c<= :: TypeSym -> TypeSym -> Bool
< :: TypeSym -> TypeSym -> Bool
$c< :: TypeSym -> TypeSym -> Bool
compare :: TypeSym -> TypeSym -> Ordering
$ccompare :: TypeSym -> TypeSym -> Ordering
Ord,Int -> TypeSym
TypeSym -> Int
TypeSym -> [TypeSym]
TypeSym -> TypeSym
TypeSym -> TypeSym -> [TypeSym]
TypeSym -> TypeSym -> TypeSym -> [TypeSym]
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 :: TypeSym -> TypeSym -> TypeSym -> [TypeSym]
$cenumFromThenTo :: TypeSym -> TypeSym -> TypeSym -> [TypeSym]
enumFromTo :: TypeSym -> TypeSym -> [TypeSym]
$cenumFromTo :: TypeSym -> TypeSym -> [TypeSym]
enumFromThen :: TypeSym -> TypeSym -> [TypeSym]
$cenumFromThen :: TypeSym -> TypeSym -> [TypeSym]
enumFrom :: TypeSym -> [TypeSym]
$cenumFrom :: TypeSym -> [TypeSym]
fromEnum :: TypeSym -> Int
$cfromEnum :: TypeSym -> Int
toEnum :: Int -> TypeSym
$ctoEnum :: Int -> TypeSym
pred :: TypeSym -> TypeSym
$cpred :: TypeSym -> TypeSym
succ :: TypeSym -> TypeSym
$csucc :: TypeSym -> TypeSym
Enum,TypeSym
forall a. a -> a -> Bounded a
maxBound :: TypeSym
$cmaxBound :: TypeSym
minBound :: TypeSym
$cminBound :: TypeSym
Bounded,ReadPrec [TypeSym]
ReadPrec TypeSym
Int -> ReadS TypeSym
ReadS [TypeSym]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [TypeSym]
$creadListPrec :: ReadPrec [TypeSym]
readPrec :: ReadPrec TypeSym
$creadPrec :: ReadPrec TypeSym
readList :: ReadS [TypeSym]
$creadList :: ReadS [TypeSym]
readsPrec :: Int -> ReadS TypeSym
$creadsPrec :: Int -> ReadS TypeSym
Read,Int -> TypeSym -> ShowS
[TypeSym] -> ShowS
TypeSym -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TypeSym] -> ShowS
$cshowList :: [TypeSym] -> ShowS
show :: TypeSym -> String
$cshow :: TypeSym -> String
showsPrec :: Int -> TypeSym -> ShowS
$cshowsPrec :: Int -> TypeSym -> ShowS
Show)

-- | Convert  symbolic 'TypeSym' to numeric 'Type' code
typeFromSym :: TypeSym -> Type
typeFromSym :: TypeSym -> Type
typeFromSym TypeSym
ts = Word16 -> Type
Type forall a b. (a -> b) -> a -> b
$ case TypeSym
ts of
                  TypeSym
TypeA          -> Word16
1
                  TypeSym
TypeNS         -> Word16
2
                  TypeSym
TypeCNAME      -> Word16
5
                  TypeSym
TypeSOA        -> Word16
6
                  TypeSym
TypePTR        -> Word16
12
                  TypeSym
TypeHINFO      -> Word16
13
                  TypeSym
TypeMX         -> Word16
15
                  TypeSym
TypeTXT        -> Word16
16
                  TypeSym
TypeAFSDB      -> Word16
18
                  TypeSym
TypeAAAA       -> Word16
28
                  TypeSym
TypeSRV        -> Word16
33
                  TypeSym
TypeNAPTR      -> Word16
35
                  TypeSym
TypeOPT        -> Word16
41
                  TypeSym
TypeDS         -> Word16
43
                  TypeSym
TypeSSHFP      -> Word16
44
                  TypeSym
TypeRRSIG      -> Word16
46
                  TypeSym
TypeNSEC       -> Word16
47
                  TypeSym
TypeDNSKEY     -> Word16
48
                  TypeSym
TypeNSEC3      -> Word16
50
                  TypeSym
TypeNSEC3PARAM -> Word16
51
                  TypeSym
TypeSPF        -> Word16
99
                  TypeSym
TypeANY        -> Word16
255
                  TypeSym
TypeURI        -> Word16
256
                  TypeSym
TypeCAA        -> Word16
257

-- | Convert 'Type' code to symbolic 'TypeSym'
typeToSym :: Type -> Maybe TypeSym
typeToSym :: Type -> Maybe TypeSym
typeToSym (Type Word16
w) = case Word16
w of
                  Word16
1   -> forall a. a -> Maybe a
Just TypeSym
TypeA
                  Word16
2   -> forall a. a -> Maybe a
Just TypeSym
TypeNS
                  Word16
5   -> forall a. a -> Maybe a
Just TypeSym
TypeCNAME
                  Word16
6   -> forall a. a -> Maybe a
Just TypeSym
TypeSOA
                  Word16
12  -> forall a. a -> Maybe a
Just TypeSym
TypePTR
                  Word16
13  -> forall a. a -> Maybe a
Just TypeSym
TypeHINFO
                  Word16
15  -> forall a. a -> Maybe a
Just TypeSym
TypeMX
                  Word16
16  -> forall a. a -> Maybe a
Just TypeSym
TypeTXT
                  Word16
18  -> forall a. a -> Maybe a
Just TypeSym
TypeAFSDB
                  Word16
28  -> forall a. a -> Maybe a
Just TypeSym
TypeAAAA
                  Word16
33  -> forall a. a -> Maybe a
Just TypeSym
TypeSRV
                  Word16
35  -> forall a. a -> Maybe a
Just TypeSym
TypeNAPTR
                  Word16
41  -> forall a. a -> Maybe a
Just TypeSym
TypeOPT
                  Word16
43  -> forall a. a -> Maybe a
Just TypeSym
TypeDS
                  Word16
44  -> forall a. a -> Maybe a
Just TypeSym
TypeSSHFP
                  Word16
46  -> forall a. a -> Maybe a
Just TypeSym
TypeRRSIG
                  Word16
47  -> forall a. a -> Maybe a
Just TypeSym
TypeNSEC
                  Word16
48  -> forall a. a -> Maybe a
Just TypeSym
TypeDNSKEY
                  Word16
50  -> forall a. a -> Maybe a
Just TypeSym
TypeNSEC3
                  Word16
51  -> forall a. a -> Maybe a
Just TypeSym
TypeNSEC3PARAM
                  Word16
99  -> forall a. a -> Maybe a
Just TypeSym
TypeSPF
                  Word16
255 -> forall a. a -> Maybe a
Just TypeSym
TypeANY
                  Word16
256 -> forall a. a -> Maybe a
Just TypeSym
TypeURI
                  Word16
257 -> forall a. a -> Maybe a
Just TypeSym
TypeCAA
                  Word16
_   -> forall a. Maybe a
Nothing

-- | Extract the resource record type of a 'RData' object
rdType :: RData l -> Either Type TypeSym
rdType :: forall l. RData l -> Either Type TypeSym
rdType RData l
rd = case RData l
rd of
              RDataA          {} -> forall a b. b -> Either a b
Right TypeSym
TypeA
              RDataAAAA       {} -> forall a b. b -> Either a b
Right TypeSym
TypeAAAA
              RDataAFSDB      {} -> forall a b. b -> Either a b
Right TypeSym
TypeAFSDB
              RDataCAA        {} -> forall a b. b -> Either a b
Right TypeSym
TypeCAA
              RDataCNAME      {} -> forall a b. b -> Either a b
Right TypeSym
TypeCNAME
              RDataDNSKEY     {} -> forall a b. b -> Either a b
Right TypeSym
TypeDNSKEY
              RDataDS         {} -> forall a b. b -> Either a b
Right TypeSym
TypeDS
              RDataHINFO      {} -> forall a b. b -> Either a b
Right TypeSym
TypeHINFO
              RDataMX         {} -> forall a b. b -> Either a b
Right TypeSym
TypeMX
              RDataNAPTR      {} -> forall a b. b -> Either a b
Right TypeSym
TypeNAPTR
              RDataNS         {} -> forall a b. b -> Either a b
Right TypeSym
TypeNS
              RDataNSEC       {} -> forall a b. b -> Either a b
Right TypeSym
TypeNSEC
              RDataNSEC3      {} -> forall a b. b -> Either a b
Right TypeSym
TypeNSEC3
              RDataNSEC3PARAM {} -> forall a b. b -> Either a b
Right TypeSym
TypeNSEC3PARAM
              RDataOPT        {} -> forall a b. b -> Either a b
Right TypeSym
TypeOPT
              RDataPTR        {} -> forall a b. b -> Either a b
Right TypeSym
TypePTR
              RDataRRSIG      {} -> forall a b. b -> Either a b
Right TypeSym
TypeRRSIG
              RDataSOA        {} -> forall a b. b -> Either a b
Right TypeSym
TypeSOA
              RDataSRV        {} -> forall a b. b -> Either a b
Right TypeSym
TypeSRV
              RDataTXT        {} -> forall a b. b -> Either a b
Right TypeSym
TypeTXT
              RDataSPF        {} -> forall a b. b -> Either a b
Right TypeSym
TypeSPF
              RDataURI        {} -> forall a b. b -> Either a b
Right TypeSym
TypeURI
              RDataSSHFP      {} -> forall a b. b -> Either a b
Right TypeSym
TypeSSHFP
              --
              RData        Type
ty Label
_  -> forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a b. a -> Either a b
Left Type
ty) forall a b. b -> Either a b
Right (Type -> Maybe TypeSym
typeToSym Type
ty)


{- TODO:


type-bitmap:

 A NS SOA TXT AAAA RRSIG NSEC DNSKEY

'00 07 62 00 80 08 00 03 80'
'00000000 00000111 01100010 00000000 10000000 00001000 00000000 00000011 10000000'
 Win=#0    len=7         ^{SOA}      ^{TXT}       ^{AAAA}                ^{DNSKEY}
                    ^^{A,NS}                                          ^^{RRSIG,NSEC}

" ".join(map("{:08b}".format,[0,7,98,0,128,8,0,3,128]))


"\NUL\a\"\NUL\NUL\NUL\NUL\ETX\128"   NS SOA RRSIG NSEC DNSKEY

[ (winofs+j*8+7-i)   | (j,x) <- zip [0..] xs, i <- [7,6..0], testBit x i ]

-}



-- helpers

getUntilEmpty :: Binary a => Get [a]
getUntilEmpty :: forall a. Binary a => Get [a]
getUntilEmpty = forall a. Get a -> Get [a]
untilEmptyWith forall t. Binary t => Get t
get

untilEmptyWith :: Get a -> Get [a]
untilEmptyWith :: forall a. Get a -> Get [a]
untilEmptyWith Get a
g = [a] -> Get [a]
go []
  where
    go :: [a] -> Get [a]
go [a]
acc = do
        Bool
e <- Get Bool
isEmpty
        if Bool
e
         then forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. [a] -> [a]
reverse [a]
acc)
         else do
            a
v <- Get a
g
            [a] -> Get [a]
go (a
v forall a. a -> [a] -> [a]
: [a]
acc)



{- TODO:


   MsgRR{rrName = Name "stanford.edu.", rrClass = 1, rrTTL = 1799,
         rrData =
           RData 29
             "\NUL\DC2\SYN\DC3\136\a\244\212e\200\252\194\NUL\152\150\128"},


https://en.wikipedia.org/wiki/LOC_record


LOC record statdns.net.   IN LOC   52 22 23.000 N 4 53 32.000 E -2.00m 0.00m 10000m 10m


SW1A2AA.find.me.uk.	86399	IN	LOC	51 30 12.748 N 0 7 39.611 W 0.00m 0.00m 0.00m 0.00m


https://tools.ietf.org/html/rfc1876

-}