{-# LANGUAGE UnicodeSyntax #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE DoAndIfThenElse #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE TypeFamilies #-}

-- | This module provides Domain Name System data structures and
--   (de)serialization routines.
module Network.DNS
  ( HostName
  , aHostName
  , hostName
  , hostNameLabels
  , arpaHostName
  , HostAddr(..)
  , Host4Addr
  , Host6Addr
  , aHostAddr
  , aHostAddrOf
  , aHost4Addr
  , aHost6Addr
  , aHostAddrIP
  , DnsId
  , DnsType(..)
  , dnsTypeCode
  , DnsData(..)
  , DnsRecord(..)
  , DnsQType(..)
  , dnsQTypeCode
  , DnsQuestion(..)
  , DnsReq(..)
  , DnsError(..)
  , DnsResp(..)
  ) where

import Data.Typeable (Typeable)
#if !MIN_VERSION_base(4,7,0)
import Data.Typeable (Typeable1)
#endif
import Data.Proxy (Proxy(..))
import Data.Foldable (forM_)
import Data.Hashable
import Data.Word
import Data.Bits
import Data.Char (chr, ord)
import Data.Map (Map)
import qualified Data.Map as Map
import Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8
import qualified Data.ByteString.Lazy as BSL
import qualified Data.ByteString.Builder as BB
import Data.Serializer (Serializer, Serializable, SizedSerializable)
import qualified Data.Serializer as S
import Data.Deserializer (Deserializer, Deserializable)
import qualified Data.Deserializer as D
import Text.Parser.Combinators as P
import Text.Parser.Char as P
import Text.Printer ((<>))
import qualified Text.Printer as T
import Data.Textual (Printable, toAscii, toUtf8, Textual)
import qualified Data.Textual as T
import qualified Text.Ascii as A
import Text.Printf
import qualified Text.Read as TR
import Network.IP.Addr
import Control.Applicative ((<$>), Applicative(..), (<|>))
import Control.Monad (void, unless, ap, foldM)

-- | Host name.
newtype HostName = HN { -- | Host name as a 'ByteString'.
                        HostName -> ByteString
hostName ∷ ByteString
                      }
                   deriving (Typeable, HostName -> HostName -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HostName -> HostName -> Bool
$c/= :: HostName -> HostName -> Bool
== :: HostName -> HostName -> Bool
$c== :: HostName -> HostName -> Bool
Eq, Eq HostName
HostName -> HostName -> Bool
HostName -> HostName -> Ordering
HostName -> HostName -> HostName
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 :: HostName -> HostName -> HostName
$cmin :: HostName -> HostName -> HostName
max :: HostName -> HostName -> HostName
$cmax :: HostName -> HostName -> HostName
>= :: HostName -> HostName -> Bool
$c>= :: HostName -> HostName -> Bool
> :: HostName -> HostName -> Bool
$c> :: HostName -> HostName -> Bool
<= :: HostName -> HostName -> Bool
$c<= :: HostName -> HostName -> Bool
< :: HostName -> HostName -> Bool
$c< :: HostName -> HostName -> Bool
compare :: HostName -> HostName -> Ordering
$ccompare :: HostName -> HostName -> Ordering
Ord, Eq HostName
Int -> HostName -> Int
HostName -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: HostName -> Int
$chash :: HostName -> Int
hashWithSalt :: Int -> HostName -> Int
$chashWithSalt :: Int -> HostName -> Int
Hashable)

-- | 'HostName' proxy value.
aHostName ∷ Proxy HostName
aHostName :: Proxy HostName
aHostName = forall {k} (t :: k). Proxy t
Proxy

instance Show HostName where
  showsPrec :: Int -> HostName -> ShowS
showsPrec Int
p (HN ByteString
bs) = Bool -> ShowS -> ShowS
showParen (Int
p forall a. Ord a => a -> a -> Bool
> Int
10)
                      forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"fromJust "
                      forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> ShowS -> ShowS
showParen Bool
True forall a b. (a -> b) -> a -> b
$
                           String -> ShowS
showString String
"fromString "
                           forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => Int -> a -> ShowS
showsPrec Int
10 (ByteString -> String
BS8.unpack ByteString
bs))

instance Read HostName where
  readPrec :: ReadPrec HostName
readPrec = forall a. ReadPrec a -> ReadPrec a
TR.parens forall a b. (a -> b) -> a -> b
$ forall a. Int -> ReadPrec a -> ReadPrec a
TR.prec Int
10 forall a b. (a -> b) -> a -> b
$ do
    TR.Ident String
"fromJust" ← ReadPrec Lexeme
TR.lexP
    forall a. ReadPrec a -> ReadPrec a
TR.step forall a b. (a -> b) -> a -> b
$ forall a. ReadPrec a -> ReadPrec a
TR.parens forall a b. (a -> b) -> a -> b
$ forall a. Int -> ReadPrec a -> ReadPrec a
TR.prec Int
10 forall a b. (a -> b) -> a -> b
$ do
      TR.Ident String
"fromString" ← ReadPrec Lexeme
TR.lexP
      TR.String String
s ← ReadPrec Lexeme
TR.lexP
      Just HostName
n ← forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall α. Textual α => String -> Maybe α
T.fromString String
s
      forall (m :: * -> *) a. Monad m => a -> m a
return HostName
n

instance Printable HostName where
  print :: forall p. Printer p => HostName -> p
print (HN ByteString
bs) = forall p. Printer p => ByteString -> p
T.ascii ByteString
bs

{-# RULES "toAscii/HostName" toAscii = hostName #-}
{-# RULES "toUtf8/HostName"  toUtf8  = hostName #-}

instance Textual HostName where
  textual :: forall (μ :: * -> *). (Monad μ, CharParsing μ) => μ HostName
textual = forall {m :: * -> *} {t} {a}.
(Monad m, CharParsing m, Eq t, Eq a, Num t, Num a) =>
[[Word8]] -> a -> Bool -> [Word8] -> t -> m HostName
go [] (Int
0 ∷ Int) Bool
False [] (Int
0 ∷ Int) forall (m :: * -> *) a. Parsing m => m a -> String -> m a
<?> String
"host name"
    where alphaNumOrDashOrDot :: Char -> Bool
alphaNumOrDashOrDot Char
c = Char -> Bool
A.isAlphaNum Char
c Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'-' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'.'
          go :: [[Word8]] -> a -> Bool -> [Word8] -> t -> m HostName
go ![[Word8]]
ls !a
ncs Bool
_ [Word8]
_ t
0 =
            forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (forall (m :: * -> *). CharParsing m => (Char -> Bool) -> m Char
satisfy Char -> Bool
A.isAlpha) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
              Just Char
c  → if a
ncs forall a. Eq a => a -> a -> Bool
== a
255
                        then forall (m :: * -> *) a. Parsing m => String -> m a
unexpected String
"Host name is too long"
                        else [[Word8]] -> a -> Bool -> [Word8] -> t -> m HostName
go [[Word8]]
ls (a
ncs forall a. Num a => a -> a -> a
+ a
1) Bool
False [Char -> Word8
A.ascii Char
c] t
1
              Maybe Char
Nothing → forall (m :: * -> *) a. Parsing m => String -> m a
unexpected String
"A letter expected"
          go ![[Word8]]
ls !a
ncs !Bool
dash ![Word8]
lcs !t
nlcs =
            forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (forall (m :: * -> *). CharParsing m => (Char -> Bool) -> m Char
satisfy Char -> Bool
alphaNumOrDashOrDot) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
              Just Char
'.' → if Bool
dash
                         then forall (m :: * -> *) a. Parsing m => String -> m a
unexpected String
"Label ends with a dash"
                         else if a
ncs forall a. Eq a => a -> a -> Bool
== a
255
                              then forall (m :: * -> *) a. Parsing m => String -> m a
unexpected String
"Host name is too long"
                              else [[Word8]] -> a -> Bool -> [Word8] -> t -> m HostName
go (forall a. [a] -> [a]
reverse (Char -> Word8
A.ascii Char
'.' forall a. a -> [a] -> [a]
: [Word8]
lcs) forall a. a -> [a] -> [a]
: [[Word8]]
ls)
                                      (a
ncs forall a. Num a => a -> a -> a
+ a
1) Bool
False [] t
0
              Just Char
c   → if t
nlcs forall a. Eq a => a -> a -> Bool
== t
63
                         then forall (m :: * -> *) a. Parsing m => String -> m a
unexpected String
"Label is too long"
                         else if a
ncs forall a. Eq a => a -> a -> Bool
== a
255
                              then forall (m :: * -> *) a. Parsing m => String -> m a
unexpected String
"Host name is too long"
                              else [[Word8]] -> a -> Bool -> [Word8] -> t -> m HostName
go [[Word8]]
ls (a
ncs forall a. Num a => a -> a -> a
+ a
1) (Char
c forall a. Eq a => a -> a -> Bool
== Char
'-')
                                         (Char -> Word8
A.ascii Char
c forall a. a -> [a] -> [a]
: [Word8]
lcs) (t
nlcs forall a. Num a => a -> a -> a
+ t
1)
              Maybe Char
Nothing  → forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ByteString -> HostName
HN forall a b. (a -> b) -> a -> b
$ [Word8] -> ByteString
BS.pack forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
                                forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
reverse [Word8]
lcs forall a. a -> [a] -> [a]
: [[Word8]]
ls

instance Printable (InetAddr HostName) where
  print :: forall p. Printer p => InetAddr HostName -> p
print (InetAddr HostName
n InetPort
p) = forall α p. (Printable α, Printer p) => α -> p
T.print HostName
n forall a. Semigroup a => a -> a -> a
<> forall p. Printer p => Char -> p
T.char7 Char
':' forall a. Semigroup a => a -> a -> a
<> forall α p. (Printable α, Printer p) => α -> p
T.print InetPort
p

instance Textual (InetAddr HostName) where
  textual :: forall (μ :: * -> *).
(Monad μ, CharParsing μ) =>
μ (InetAddr HostName)
textual = forall a. a -> InetPort -> InetAddr a
InetAddr forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall α (μ :: * -> *). (Textual α, Monad μ, CharParsing μ) => μ α
T.textual forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall (m :: * -> *). CharParsing m => Char -> m Char
P.char Char
':' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall α (μ :: * -> *). (Textual α, Monad μ, CharParsing μ) => μ α
T.textual)

-- | List the 'HostName' labels:
--
-- @
--   'hostNameLabels' ('Data.Maybe.fromJust' ('Data.Textual.fromString' /"www.google.com"/)) = [/"www"/, /"google"/, /"com"/]
-- @
hostNameLabels ∷ HostName → [ByteString]
hostNameLabels :: HostName -> [ByteString]
hostNameLabels = Word8 -> ByteString -> [ByteString]
BS.split (Char -> Word8
A.ascii Char
'.') forall b c a. (b -> c) -> (a -> b) -> a -> c
. HostName -> ByteString
hostName

-- | Host name for reverse DNS lookups.
--
-- @
--   'Text.Printer.toString' ('arpaHostName' ('IPv4' ('ip4FromOctets' /1/ /2/ /3/ /4/))) = /"4.3.2.1.in-addr.arpa"/
--   'Text.Printer.toString' ('arpaHostName' ('IPv6' ('ip6FromWords' /1/ /2/ /3/ /4/ /5/ /6/ /7/ /8/))) = /"8.0.0.0.7.0.0.0.6.0.0.0.5.0.0.0.4.0.0.0.3.0.0.0.2.0.0.0.1.0.0.0.ip6.arpa"/
-- @
arpaHostName ∷ IP → HostName
arpaHostName :: IP -> HostName
arpaHostName (IPv4 IP4
a) =
    ByteString -> HostName
HN forall a b. (a -> b) -> a -> b
$ String -> ByteString
BS8.pack forall a b. (a -> b) -> a -> b
$ forall r. PrintfType r => String -> r
printf String
"%i.%i.%i.%i.in-addr.arpa" Word8
o4 Word8
o3 Word8
o2 Word8
o1
  where (Word8
o1, Word8
o2, Word8
o3, Word8
o4) = IP4 -> (Word8, Word8, Word8, Word8)
ip4ToOctets IP4
a
arpaHostName (IPv6 IP6
a) =
    ByteString -> HostName
HN forall a b. (a -> b) -> a -> b
$ String -> ByteString
BS8.pack forall a b. (a -> b) -> a -> b
$ forall {a}. (Integral a, Bits a) => [a] -> String
digits (forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ IP6 -> [Word16]
ip6ToWordList IP6
a) forall a. [a] -> [a] -> [a]
++ String
"ip6.arpa"
  where digits :: [a] -> String
digits (a
w : [a]
ws) = [Char
d4, Char
'.', Char
d3, Char
'.', Char
d2, Char
'.', Char
d1, Char
'.'] forall a. [a] -> [a] -> [a]
++ [a] -> String
digits [a]
ws
          where d1 :: Char
d1 = forall {a}. Integral a => a -> Char
toDigit forall a b. (a -> b) -> a -> b
$ a
w forall a. Bits a => a -> Int -> a
`shiftR` Int
12
                d2 :: Char
d2 = forall {a}. Integral a => a -> Char
toDigit forall a b. (a -> b) -> a -> b
$ a
w forall a. Bits a => a -> Int -> a
`shiftR` Int
8 forall a. Bits a => a -> a -> a
.&. a
0xF
                d3 :: Char
d3 = forall {a}. Integral a => a -> Char
toDigit forall a b. (a -> b) -> a -> b
$ a
w forall a. Bits a => a -> Int -> a
`shiftR` Int
4 forall a. Bits a => a -> a -> a
.&. a
0xF
                d4 :: Char
d4 = forall {a}. Integral a => a -> Char
toDigit forall a b. (a -> b) -> a -> b
$ a
w forall a. Bits a => a -> a -> a
.&. a
0xF
                toDigit :: a -> Char
toDigit a
n | a
n forall a. Ord a => a -> a -> Bool
< a
10    = Int -> Char
chr forall a b. (a -> b) -> a -> b
$ Char -> Int
ord Char
'0' forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral a
n
                          | Bool
otherwise = Int -> Char
chr forall a b. (a -> b) -> a -> b
$ Char -> Int
ord Char
'a' forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral a
n forall a. Num a => a -> a -> a
- Int
10
        digits [] = []

newtype Writer s α = Writer { forall s α. Writer s α -> (s -> s) -> (s -> s, α)
runWriter ∷ (s → s) → (s → s, α) }

instance Functor (Writer s) where
  fmap :: forall a b. (a -> b) -> Writer s a -> Writer s b
fmap a -> b
f Writer s a
m = forall s α. ((s -> s) -> (s -> s, α)) -> Writer s α
Writer forall a b. (a -> b) -> a -> b
$ \s -> s
append →
               let (s -> s
append', a
x) = forall s α. Writer s α -> (s -> s) -> (s -> s, α)
runWriter Writer s a
m s -> s
append
               in (s -> s
append', a -> b
f a
x)

instance Applicative (Writer s) where
  pure :: forall a. a -> Writer s a
pure = forall (m :: * -> *) a. Monad m => a -> m a
return
  {-# INLINE pure #-}
  <*> :: forall a b. Writer s (a -> b) -> Writer s a -> Writer s b
(<*>) = forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap
  {-# INLINE (<*>) #-}

instance Monad (Writer s) where
  return :: forall a. a -> Writer s a
return a
x = forall s α. ((s -> s) -> (s -> s, α)) -> Writer s α
Writer forall a b. (a -> b) -> a -> b
$ \s -> s
append → (s -> s
append, a
x)
  Writer s a
m >>= :: forall a b. Writer s a -> (a -> Writer s b) -> Writer s b
>>= a -> Writer s b
f = forall s α. ((s -> s) -> (s -> s, α)) -> Writer s α
Writer forall a b. (a -> b) -> a -> b
$ \s -> s
append →
              let (s -> s
append', a
x) = forall s α. Writer s α -> (s -> s) -> (s -> s, α)
runWriter Writer s a
m s -> s
append
              in forall s α. Writer s α -> (s -> s) -> (s -> s, α)
runWriter (a -> Writer s b
f a
x) s -> s
append'

newtype StateT k v μ α =
  StateT { forall k v (μ :: * -> *) α.
StateT k v μ α
-> Map k v -> Maybe Word16 -> μ (Map k v, Maybe Word16, α)
runStateT ∷ Map k v → Maybe Word16 → μ (Map k v, Maybe Word16, α) }

type CompT s α   = StateT [ByteString] Word16 (Writer s) α
type DecompT μ α = StateT Word16 HostName μ α

compress ∷ Serializer s ⇒ Word16 → CompT s () → s
compress :: forall s. Serializer s => Word16 -> CompT s () -> s
compress Word16
i CompT s ()
m = s -> s
append forall a. Monoid a => a
mempty
  where (s -> s
append, (Map [ByteString] Word16, Maybe Word16, ())
_) = forall s α. Writer s α -> (s -> s) -> (s -> s, α)
runWriter (forall k v (μ :: * -> *) α.
StateT k v μ α
-> Map k v -> Maybe Word16 -> μ (Map k v, Maybe Word16, α)
runStateT CompT s ()
m forall k a. Map k a
Map.empty forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just Word16
i) forall a. a -> a
id
{-# INLINE compress #-}

decompress ∷ Monad μ ⇒ Word16 → DecompT μ α → μ α
decompress :: forall (μ :: * -> *) α. Monad μ => Word16 -> DecompT μ α -> μ α
decompress Word16
i DecompT μ α
m = do
  (Map Word16 HostName
_, Maybe Word16
_, α
x) ← forall k v (μ :: * -> *) α.
StateT k v μ α
-> Map k v -> Maybe Word16 -> μ (Map k v, Maybe Word16, α)
runStateT DecompT μ α
m forall k a. Map k a
Map.empty forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just Word16
i
  forall (m :: * -> *) a. Monad m => a -> m a
return α
x
{-# INLINE decompress #-}

instance Monad μ ⇒ Functor (StateT k v μ) where
  fmap :: forall a b. (a -> b) -> StateT k v μ a -> StateT k v μ b
fmap a -> b
f StateT k v μ a
m = forall k v (μ :: * -> *) α.
(Map k v -> Maybe Word16 -> μ (Map k v, Maybe Word16, α))
-> StateT k v μ α
StateT forall a b. (a -> b) -> a -> b
$ \Map k v
ptrs Maybe Word16
offset → do
               (Map k v
ptrs', Maybe Word16
offset', a
x) ← forall k v (μ :: * -> *) α.
StateT k v μ α
-> Map k v -> Maybe Word16 -> μ (Map k v, Maybe Word16, α)
runStateT StateT k v μ a
m Map k v
ptrs Maybe Word16
offset
               forall (m :: * -> *) a. Monad m => a -> m a
return (Map k v
ptrs', Maybe Word16
offset', a -> b
f a
x)
  {-# INLINE fmap #-}

instance Monad μ ⇒ Applicative (StateT k v μ) where
  pure :: forall a. a -> StateT k v μ a
pure = forall (m :: * -> *) a. Monad m => a -> m a
return
  {-# INLINE pure #-}
  <*> :: forall a b.
StateT k v μ (a -> b) -> StateT k v μ a -> StateT k v μ b
(<*>) = forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap
  {-# INLINE (<*>) #-}

instance Monad μ ⇒ Monad (StateT k v μ) where
  return :: forall a. a -> StateT k v μ a
return = forall (μ :: * -> *) α k v. Monad μ => μ α -> StateT k v μ α
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => a -> m a
return
  {-# INLINE return #-}
  StateT k v μ a
m >>= :: forall a b.
StateT k v μ a -> (a -> StateT k v μ b) -> StateT k v μ b
>>= a -> StateT k v μ b
f = forall k v (μ :: * -> *) α.
(Map k v -> Maybe Word16 -> μ (Map k v, Maybe Word16, α))
-> StateT k v μ α
StateT forall a b. (a -> b) -> a -> b
$ \Map k v
ptrs Maybe Word16
offset → do
              (Map k v
ptrs', Maybe Word16
offset', a
x) ← forall k v (μ :: * -> *) α.
StateT k v μ α
-> Map k v -> Maybe Word16 -> μ (Map k v, Maybe Word16, α)
runStateT StateT k v μ a
m Map k v
ptrs Maybe Word16
offset
              forall k v (μ :: * -> *) α.
StateT k v μ α
-> Map k v -> Maybe Word16 -> μ (Map k v, Maybe Word16, α)
runStateT (a -> StateT k v μ b
f a
x) Map k v
ptrs' Maybe Word16
offset'
  {-# INLINE (>>=) #-}
#if !MIN_VERSION_base(4,13,0)
  fail msg = lift $ fail msg
  {-# INLINE fail #-}
#endif

lift ∷ Monad μ ⇒ μ α → StateT k v μ α
lift :: forall (μ :: * -> *) α k v. Monad μ => μ α -> StateT k v μ α
lift μ α
m = forall k v (μ :: * -> *) α.
(Map k v -> Maybe Word16 -> μ (Map k v, Maybe Word16, α))
-> StateT k v μ α
StateT forall a b. (a -> b) -> a -> b
$ \Map k v
ptrs Maybe Word16
offset → do
           α
x ← μ α
m
           forall (m :: * -> *) a. Monad m => a -> m a
return (Map k v
ptrs, Maybe Word16
offset, α
x)
{-# INLINE lift #-}

write ∷ Serializer s ⇒ s → CompT s ()
write :: forall s. Serializer s => s -> CompT s ()
write s
s = forall (μ :: * -> *) α k v. Monad μ => μ α -> StateT k v μ α
lift forall a b. (a -> b) -> a -> b
$ forall s α. ((s -> s) -> (s -> s, α)) -> Writer s α
Writer forall a b. (a -> b) -> a -> b
$ \s -> s
append → ((s -> s
append s
s forall a. Semigroup a => a -> a -> a
<>), ())
{-# INLINE write #-}

getOffset ∷ Monad μ ⇒ StateT k v μ (Maybe Word16)
getOffset :: forall (μ :: * -> *) k v. Monad μ => StateT k v μ (Maybe Word16)
getOffset = forall k v (μ :: * -> *) α.
(Map k v -> Maybe Word16 -> μ (Map k v, Maybe Word16, α))
-> StateT k v μ α
StateT forall a b. (a -> b) -> a -> b
$ \Map k v
ptrs Maybe Word16
offset → forall (m :: * -> *) a. Monad m => a -> m a
return (Map k v
ptrs, Maybe Word16
offset, Maybe Word16
offset)
{-# INLINE getOffset #-}

addToOffset ∷ Word16 → Maybe Word16 → Maybe Word16
addToOffset :: Word16 -> Maybe Word16 -> Maybe Word16
addToOffset Word16
n (Just Word16
i) | Word16
i' ← Word16
i forall a. Num a => a -> a -> a
+ Word16
n, Word16
i' forall a. Ord a => a -> a -> Bool
>= Word16
i Bool -> Bool -> Bool
&& Word16
i' forall a. Ord a => a -> a -> Bool
<= Word16
0x3FFF = forall a. a -> Maybe a
Just Word16
i'
addToOffset Word16
_ Maybe Word16
_ = forall a. Maybe a
Nothing
{-# INLINE addToOffset #-}

incOffset ∷ Monad μ ⇒ Word16 → StateT k v μ ()
incOffset :: forall (μ :: * -> *) k v. Monad μ => Word16 -> StateT k v μ ()
incOffset Word16
n = forall k v (μ :: * -> *) α.
(Map k v -> Maybe Word16 -> μ (Map k v, Maybe Word16, α))
-> StateT k v μ α
StateT forall a b. (a -> b) -> a -> b
$ \Map k v
ptrs Maybe Word16
offset →
  forall (m :: * -> *) a. Monad m => a -> m a
return (Map k v
ptrs, Word16 -> Maybe Word16 -> Maybe Word16
addToOffset Word16
n Maybe Word16
offset, ())
{-# INLINE incOffset #-}

getEntries ∷ Monad μ ⇒ StateT k v μ (Map k v)
getEntries :: forall (μ :: * -> *) k v. Monad μ => StateT k v μ (Map k v)
getEntries = forall k v (μ :: * -> *) α.
(Map k v -> Maybe Word16 -> μ (Map k v, Maybe Word16, α))
-> StateT k v μ α
StateT forall a b. (a -> b) -> a -> b
$ \Map k v
ptrs Maybe Word16
offset → forall (m :: * -> *) a. Monad m => a -> m a
return (Map k v
ptrs, Maybe Word16
offset, Map k v
ptrs)
{-# INLINE getEntries #-}

getEntry ∷ (Ord k, Monad μ) ⇒ k → StateT k v μ (Maybe v)
getEntry :: forall k (μ :: * -> *) v.
(Ord k, Monad μ) =>
k -> StateT k v μ (Maybe v)
getEntry k
key = forall k v (μ :: * -> *) α.
(Map k v -> Maybe Word16 -> μ (Map k v, Maybe Word16, α))
-> StateT k v μ α
StateT forall a b. (a -> b) -> a -> b
$ \Map k v
ptrs Maybe Word16
offset → do
  forall (m :: * -> *) a. Monad m => a -> m a
return (Map k v
ptrs, Maybe Word16
offset, forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup k
key Map k v
ptrs)
{-# INLINE getEntry #-}

putEntry ∷ (Ord k, Monad μ) ⇒ k → v → StateT k v μ ()
putEntry :: forall k (μ :: * -> *) v.
(Ord k, Monad μ) =>
k -> v -> StateT k v μ ()
putEntry k
key v
value = forall k v (μ :: * -> *) α.
(Map k v -> Maybe Word16 -> μ (Map k v, Maybe Word16, α))
-> StateT k v μ α
StateT forall a b. (a -> b) -> a -> b
$ \Map k v
ptrs Maybe Word16
offset → do
  forall (m :: * -> *) a. Monad m => a -> m a
return (forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert k
key v
value Map k v
ptrs, Maybe Word16
offset, ())
{-# INLINE putEntry #-}

evalComp ∷ Serializer s ⇒ CompT BB.Builder () → CompT s BSL.ByteString
evalComp :: forall s. Serializer s => CompT Builder () -> CompT s ByteString
evalComp CompT Builder ()
m = forall k v (μ :: * -> *) α.
(Map k v -> Maybe Word16 -> μ (Map k v, Maybe Word16, α))
-> StateT k v μ α
StateT forall a b. (a -> b) -> a -> b
$ \Map [ByteString] Word16
ptrs Maybe Word16
offset → do
  let (Builder -> Builder
append, (Map [ByteString] Word16
ptrs', Maybe Word16
offset', ()
_)) = forall s α. Writer s α -> (s -> s) -> (s -> s, α)
runWriter (forall k v (μ :: * -> *) α.
StateT k v μ α
-> Map k v -> Maybe Word16 -> μ (Map k v, Maybe Word16, α)
runStateT CompT Builder ()
m Map [ByteString] Word16
ptrs Maybe Word16
offset) forall a. a -> a
id
  forall (m :: * -> *) a. Monad m => a -> m a
return (Map [ByteString] Word16
ptrs', Maybe Word16
offset', Builder -> ByteString
BB.toLazyByteString (Builder -> Builder
append forall a. Monoid a => a
mempty))
{-# INLINE evalComp #-}

evalDecomp ∷ Deserializer μ
           ⇒ Word16
           → DecompT μ α
           → DecompT μ α
evalDecomp :: forall (μ :: * -> *) α.
Deserializer μ =>
Word16 -> DecompT μ α -> DecompT μ α
evalDecomp Word16
len DecompT μ α
m = forall k v (μ :: * -> *) α.
(Map k v -> Maybe Word16 -> μ (Map k v, Maybe Word16, α))
-> StateT k v μ α
StateT forall a b. (a -> b) -> a -> b
$ \Map Word16 HostName
ptrs Maybe Word16
offset → do
    forall (μ :: * -> *) α. Deserializer μ => Int -> μ α -> μ α
D.isolate (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
len) forall a b. (a -> b) -> a -> b
$ forall k v (μ :: * -> *) α.
StateT k v μ α
-> Map k v -> Maybe Word16 -> μ (Map k v, Maybe Word16, α)
runStateT (DecompT μ α
m forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall {μ :: * -> *} {t} {k} {v}.
Deserializer μ =>
t -> StateT k v μ t
drain) Map Word16 HostName
ptrs Maybe Word16
offset
  where drain :: t -> StateT k v μ t
drain t
r = forall (μ :: * -> *) α k v. Monad μ => μ α -> StateT k v μ α
lift forall (μ :: * -> *). Deserializer μ => μ ByteString
D.chunk forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
          ByteString
bs | ByteString -> Bool
BS.null ByteString
bs → forall (m :: * -> *) a. Monad m => a -> m a
return t
r
          ByteString
bs → forall (μ :: * -> *) k v. Monad μ => Word16 -> StateT k v μ ()
incOffset (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ ByteString -> Int
BS.length ByteString
bs) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> t -> StateT k v μ t
drain t
r

serializeHostName ∷ Serializer s ⇒ HostName → CompT s ()
serializeHostName :: forall s. Serializer s => HostName -> CompT s ()
serializeHostName = forall {s}.
Serializer s =>
[ByteString] -> StateT [ByteString] Word16 (Writer s) ()
go forall b c a. (b -> c) -> (a -> b) -> a -> c
. HostName -> [ByteString]
hostNameLabels
  where
    go :: [ByteString] -> StateT [ByteString] Word16 (Writer s) ()
go [] = do
      forall s. Serializer s => s -> CompT s ()
write forall a b. (a -> b) -> a -> b
$ forall s. Serializer s => Word8 -> s
S.word8 Word8
0
      forall (μ :: * -> *) k v. Monad μ => Word16 -> StateT k v μ ()
incOffset Word16
1
    go labels :: [ByteString]
labels@(ByteString
label : [ByteString]
labels') = do
      Maybe Word16
entry ← forall k (μ :: * -> *) v.
(Ord k, Monad μ) =>
k -> StateT k v μ (Maybe v)
getEntry [ByteString]
labels
      case Maybe Word16
entry of
        Maybe Word16
Nothing → do
          let ll :: Int
ll = ByteString -> Int
BS.length ByteString
label
          Maybe Word16
offset ← forall (μ :: * -> *) k v. Monad μ => StateT k v μ (Maybe Word16)
getOffset
          forall s. Serializer s => s -> CompT s ()
write forall a b. (a -> b) -> a -> b
$  forall s. Serializer s => Word8 -> s
S.word8 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
ll)
                forall a. Semigroup a => a -> a -> a
<> forall s. Serializer s => ByteString -> s
S.byteString ByteString
label
          forall (μ :: * -> *) k v. Monad μ => Word16 -> StateT k v μ ()
incOffset forall a b. (a -> b) -> a -> b
$ Word16
1 forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
ll
          forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe Word16
offset forall a b. (a -> b) -> a -> b
$ forall k (μ :: * -> *) v.
(Ord k, Monad μ) =>
k -> v -> StateT k v μ ()
putEntry [ByteString]
labels
          [ByteString] -> StateT [ByteString] Word16 (Writer s) ()
go [ByteString]
labels'
        Just Word16
ptr → do
          forall s. Serializer s => s -> CompT s ()
write forall a b. (a -> b) -> a -> b
$ forall s. Serializer s => Word16 -> s
S.word16B forall a b. (a -> b) -> a -> b
$ Word16
0xC000 forall a. Bits a => a -> a -> a
.|. Word16
ptr
          forall (μ :: * -> *) k v. Monad μ => Word16 -> StateT k v μ ()
incOffset Word16
2

guard ∷ Deserializer μ ⇒ String → Bool → μ ()
guard :: forall (μ :: * -> *). Deserializer μ => String -> Bool -> μ ()
guard String
msg Bool
test = forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
test forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Parsing m => String -> m a
unexpected String
msg
{-# INLINE guard #-}

deserializeHostName ∷ Deserializer μ ⇒ DecompT μ HostName
deserializeHostName :: forall (μ :: * -> *). Deserializer μ => DecompT μ HostName
deserializeHostName = forall {μ :: * -> *}.
Deserializer μ =>
[(ByteString, Maybe Word16)] -> StateT Word16 HostName μ HostName
go []
  where
    folder :: ByteString -> (ByteString, t k) -> StateT k HostName μ ByteString
folder ByteString
suffix (ByteString
label, t k
offset) = do
        forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ t k
offset forall a b. (a -> b) -> a -> b
$ \k
i → forall k (μ :: * -> *) v.
(Ord k, Monad μ) =>
k -> v -> StateT k v μ ()
putEntry k
i (ByteString -> HostName
HN ByteString
suffix')
        forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
suffix'
      where suffix' :: ByteString
suffix' = ByteString -> ByteString -> ByteString
BS.append ByteString
label forall a b. (a -> b) -> a -> b
$ Word8 -> ByteString -> ByteString
BS.cons (Char -> Word8
A.ascii Char
'.') ByteString
suffix
    go :: [(ByteString, Maybe Word16)] -> StateT Word16 HostName μ HostName
go [(ByteString, Maybe Word16)]
labels = do
      Maybe Word16
offset ← forall (μ :: * -> *) k v. Monad μ => StateT k v μ (Maybe Word16)
getOffset
      Word8
w ← forall (μ :: * -> *) α k v. Monad μ => μ α -> StateT k v μ α
lift forall (μ :: * -> *). Deserializer μ => μ Word8
D.word8
      forall (μ :: * -> *) k v. Monad μ => Word16 -> StateT k v μ ()
incOffset Word16
1
      if Word8
w forall a. Bits a => a -> a -> a
.&. Word8
0xC0 forall a. Eq a => a -> a -> Bool
== Word8
0xC0
      then do
        Word8
w' ← forall (μ :: * -> *) α k v. Monad μ => μ α -> StateT k v μ α
lift forall (μ :: * -> *). Deserializer μ => μ Word8
D.word8
        forall (μ :: * -> *) k v. Monad μ => Word16 -> StateT k v μ ()
incOffset Word16
1
        let ptr :: Word16
ptr = forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8
w 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
.|. forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
w'
        Maybe HostName
entry ← forall k (μ :: * -> *) v.
(Ord k, Monad μ) =>
k -> StateT k v μ (Maybe v)
getEntry Word16
ptr
        case Maybe HostName
entry of
          Maybe HostName
Nothing → do
            Map Word16 HostName
entries ← forall (μ :: * -> *) k v. Monad μ => StateT k v μ (Map k v)
getEntries
            forall (μ :: * -> *) α k v. Monad μ => μ α -> StateT k v μ α
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Parsing m => String -> m a
unexpected forall a b. (a -> b) -> a -> b
$  String
"Invalid pointer " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Word16
ptr
                              forall a. [a] -> [a] -> [a]
++ String
": pointer map is "
                              forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall k a. Map k a -> [a]
Map.elems Map Word16 HostName
entries)
          Just (HN ByteString
suffix1) → ByteString -> HostName
HN forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM forall {μ :: * -> *} {t :: * -> *} {k}.
(Monad μ, Foldable t, Ord k) =>
ByteString -> (ByteString, t k) -> StateT k HostName μ ByteString
folder ByteString
suffix1 [(ByteString, Maybe Word16)]
labels
      else
        if Word8
w forall a. Eq a => a -> a -> Bool
== Word8
0
        then do
          forall (μ :: * -> *) α k v. Monad μ => μ α -> StateT k v μ α
lift forall a b. (a -> b) -> a -> b
$ forall (μ :: * -> *). Deserializer μ => String -> Bool -> μ ()
guard String
"Hostname with zero labels" forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(ByteString, Maybe Word16)]
labels
          let (ByteString
lastLabel, Maybe Word16
lastOffset) : [(ByteString, Maybe Word16)]
labels' = [(ByteString, Maybe Word16)]
labels
          forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe Word16
lastOffset forall a b. (a -> b) -> a -> b
$ \Word16
i → forall k (μ :: * -> *) v.
(Ord k, Monad μ) =>
k -> v -> StateT k v μ ()
putEntry Word16
i (ByteString -> HostName
HN ByteString
lastLabel)
          ByteString -> HostName
HN forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM forall {μ :: * -> *} {t :: * -> *} {k}.
(Monad μ, Foldable t, Ord k) =>
ByteString -> (ByteString, t k) -> StateT k HostName μ ByteString
folder ByteString
lastLabel [(ByteString, Maybe Word16)]
labels'
        else do
          forall (μ :: * -> *) α k v. Monad μ => μ α -> StateT k v μ α
lift forall a b. (a -> b) -> a -> b
$ forall (μ :: * -> *). Deserializer μ => String -> Bool -> μ ()
guard String
"Label is too long" forall a b. (a -> b) -> a -> b
$ Word8
w forall a. Ord a => a -> a -> Bool
<= Word8
63
          ByteString
label ← forall (μ :: * -> *) α k v. Monad μ => μ α -> StateT k v μ α
lift forall a b. (a -> b) -> a -> b
$ forall (μ :: * -> *). Deserializer μ => Int -> μ ByteString
D.take forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
w
          forall (μ :: * -> *) k v. Monad μ => Word16 -> StateT k v μ ()
incOffset forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
w
          [(ByteString, Maybe Word16)] -> StateT Word16 HostName μ HostName
go (((Word8 -> Word8) -> ByteString -> ByteString
BS.map Word8 -> Word8
A.toLower8 ByteString
label, Maybe Word16
offset) forall a. a -> [a] -> [a]
: [(ByteString, Maybe Word16)]
labels)

-- | Host address. Either a host name or an IP address.
data HostAddr a = HostName {-# UNPACK #-} !HostName
                | HostAddr !a
                deriving (Typeable, Int -> HostAddr a -> ShowS
forall a. Show a => Int -> HostAddr a -> ShowS
forall a. Show a => [HostAddr a] -> ShowS
forall a. Show a => HostAddr a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HostAddr a] -> ShowS
$cshowList :: forall a. Show a => [HostAddr a] -> ShowS
show :: HostAddr a -> String
$cshow :: forall a. Show a => HostAddr a -> String
showsPrec :: Int -> HostAddr a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> HostAddr a -> ShowS
Show, ReadPrec [HostAddr a]
ReadPrec (HostAddr a)
ReadS [HostAddr a]
forall a. Read a => ReadPrec [HostAddr a]
forall a. Read a => ReadPrec (HostAddr a)
forall a. Read a => Int -> ReadS (HostAddr a)
forall a. Read a => ReadS [HostAddr a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [HostAddr a]
$creadListPrec :: forall a. Read a => ReadPrec [HostAddr a]
readPrec :: ReadPrec (HostAddr a)
$creadPrec :: forall a. Read a => ReadPrec (HostAddr a)
readList :: ReadS [HostAddr a]
$creadList :: forall a. Read a => ReadS [HostAddr a]
readsPrec :: Int -> ReadS (HostAddr a)
$creadsPrec :: forall a. Read a => Int -> ReadS (HostAddr a)
Read, HostAddr a -> HostAddr a -> Bool
forall a. Eq a => HostAddr a -> HostAddr a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HostAddr a -> HostAddr a -> Bool
$c/= :: forall a. Eq a => HostAddr a -> HostAddr a -> Bool
== :: HostAddr a -> HostAddr a -> Bool
$c== :: forall a. Eq a => HostAddr a -> HostAddr a -> Bool
Eq, HostAddr a -> HostAddr a -> Bool
HostAddr a -> HostAddr a -> Ordering
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
forall {a}. Ord a => Eq (HostAddr a)
forall a. Ord a => HostAddr a -> HostAddr a -> Bool
forall a. Ord a => HostAddr a -> HostAddr a -> Ordering
forall a. Ord a => HostAddr a -> HostAddr a -> HostAddr a
min :: HostAddr a -> HostAddr a -> HostAddr a
$cmin :: forall a. Ord a => HostAddr a -> HostAddr a -> HostAddr a
max :: HostAddr a -> HostAddr a -> HostAddr a
$cmax :: forall a. Ord a => HostAddr a -> HostAddr a -> HostAddr a
>= :: HostAddr a -> HostAddr a -> Bool
$c>= :: forall a. Ord a => HostAddr a -> HostAddr a -> Bool
> :: HostAddr a -> HostAddr a -> Bool
$c> :: forall a. Ord a => HostAddr a -> HostAddr a -> Bool
<= :: HostAddr a -> HostAddr a -> Bool
$c<= :: forall a. Ord a => HostAddr a -> HostAddr a -> Bool
< :: HostAddr a -> HostAddr a -> Bool
$c< :: forall a. Ord a => HostAddr a -> HostAddr a -> Bool
compare :: HostAddr a -> HostAddr a -> Ordering
$ccompare :: forall a. Ord a => HostAddr a -> HostAddr a -> Ordering
Ord)

type Host4Addr = HostAddr IP4
type Host6Addr = HostAddr IP6

-- | 'HostAddr' proxy value.
aHostAddr ∷ Proxy HostAddr
aHostAddr :: Proxy HostAddr
aHostAddr = forall {k} (t :: k). Proxy t
Proxy

-- | 'HostAddr' /a/ proxy value.
aHostAddrOf ∷ Proxy a → Proxy (HostAddr a)
aHostAddrOf :: forall a. Proxy a -> Proxy (HostAddr a)
aHostAddrOf Proxy a
_ = forall {k} (t :: k). Proxy t
Proxy

-- | 'Host4Addr' proxy value.
aHost4Addr ∷ Proxy Host4Addr
aHost4Addr :: Proxy Host4Addr
aHost4Addr = forall {k} (t :: k). Proxy t
Proxy

-- | 'Host6Addr' proxy value.
aHost6Addr ∷ Proxy Host6Addr
aHost6Addr :: Proxy Host6Addr
aHost6Addr = forall {k} (t :: k). Proxy t
Proxy

-- | 'HostAddr' 'IP' proxy value.
aHostAddrIP ∷ Proxy (HostAddr IP)
aHostAddrIP :: Proxy (HostAddr IP)
aHostAddrIP = forall {k} (t :: k). Proxy t
Proxy

instance Printable a ⇒ Printable (HostAddr a) where
  print :: forall p. Printer p => HostAddr a -> p
print (HostName HostName
name) = forall α p. (Printable α, Printer p) => α -> p
T.print HostName
name
  print (HostAddr a
addr) = forall α p. (Printable α, Printer p) => α -> p
T.print a
addr

instance Textual a ⇒ Textual (HostAddr a) where
  textual :: forall (μ :: * -> *). (Monad μ, CharParsing μ) => μ (HostAddr a)
textual  =  forall (m :: * -> *) a. Parsing m => m a -> m a
P.try (forall a. HostName -> HostAddr a
HostName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall α (μ :: * -> *). (Textual α, Monad μ, CharParsing μ) => μ α
T.textual)
          forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (forall a. a -> HostAddr a
HostAddr forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall α (μ :: * -> *). (Textual α, Monad μ, CharParsing μ) => μ α
T.textual)

instance Printable (InetAddr a) ⇒ Printable (InetAddr (HostAddr a)) where
  print :: forall p. Printer p => InetAddr (HostAddr a) -> p
print (InetAddr (HostName HostName
n) InetPort
p) = forall α p. (Printable α, Printer p) => α -> p
T.print forall a b. (a -> b) -> a -> b
$ forall a. a -> InetPort -> InetAddr a
InetAddr HostName
n InetPort
p
  print (InetAddr (HostAddr a
a) InetPort
p) = forall α p. (Printable α, Printer p) => α -> p
T.print forall a b. (a -> b) -> a -> b
$ forall a. a -> InetPort -> InetAddr a
InetAddr a
a InetPort
p

instance Textual (InetAddr a) ⇒ Textual (InetAddr (HostAddr a)) where
  textual :: forall (μ :: * -> *).
(Monad μ, CharParsing μ) =>
μ (InetAddr (HostAddr a))
textual  =  forall (m :: * -> *) a. Parsing m => m a -> m a
P.try (forall a. a -> InetPort -> InetAddr a
InetAddr forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. HostName -> HostAddr a
HostName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall α (μ :: * -> *). (Textual α, Monad μ, CharParsing μ) => μ α
T.textual)
                              forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall (m :: * -> *). CharParsing m => Char -> m Char
P.char Char
':' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall α (μ :: * -> *). (Textual α, Monad μ, CharParsing μ) => μ α
T.textual))
          forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall α (μ :: * -> *). (Textual α, Monad μ, CharParsing μ) => μ α
T.textual

-- | Message identifier.
type DnsId = Word16

-- | Resource Record type.
data DnsType α where
  -- IPv4 address record (/A/)
  AddrDnsType  ∷ DnsType IP4
  -- IPv6 address record (/AAAA/)
  Addr6DnsType ∷ DnsType IP6
  -- Name server record (/NS/)
  NsDnsType    ∷ DnsType HostName
  -- Canonical name record (/CNAME/)
  CNameDnsType ∷ DnsType HostName
  -- Pointer record (/PTR/)
  PtrDnsType   ∷ DnsType HostName
  -- Mail exchange record (/MX/)
  MxDnsType    ∷ DnsType (Word16, HostName)

#if MIN_VERSION_base(4,7,0)
deriving instance Typeable DnsType
#else
deriving instance Typeable1 DnsType
#endif
deriving instance Eq (DnsType α)

instance Show (DnsType α) where
  showsPrec :: Int -> DnsType α -> ShowS
showsPrec Int
_ DnsType α
AddrDnsType  = String -> ShowS
showString String
"AddrDnsType"
  showsPrec Int
_ DnsType α
Addr6DnsType = String -> ShowS
showString String
"Addr6DnsType"
  showsPrec Int
_ DnsType α
NsDnsType    = String -> ShowS
showString String
"NsDnsType"
  showsPrec Int
_ DnsType α
CNameDnsType = String -> ShowS
showString String
"CNameDnsType"
  showsPrec Int
_ DnsType α
PtrDnsType   = String -> ShowS
showString String
"PtrDnsType"
  showsPrec Int
_ DnsType α
MxDnsType    = String -> ShowS
showString String
"MxDnsType"

-- | Numeric representation of a Resource Record type.
dnsTypeCode ∷ DnsType α → Word16
dnsTypeCode :: forall α. DnsType α -> Word16
dnsTypeCode DnsType α
AddrDnsType  = Word16
1
dnsTypeCode DnsType α
Addr6DnsType = Word16
28
dnsTypeCode DnsType α
NsDnsType    = Word16
2
dnsTypeCode DnsType α
CNameDnsType = Word16
5
dnsTypeCode DnsType α
PtrDnsType   = Word16
12
dnsTypeCode DnsType α
MxDnsType    = Word16
15

-- | Resource Record data.
data DnsData = ∀ α . DnsData { ()
dnsType ∷ !(DnsType α) -- ^ The type
                             , ()
dnsData ∷ α            -- ^ The data
                             }
               deriving Typeable

instance Show DnsData where
  showsPrec :: Int -> DnsData -> ShowS
showsPrec Int
p (DnsData {α
DnsType α
dnsData :: α
dnsType :: DnsType α
dnsData :: ()
dnsType :: ()
..}) = Bool -> ShowS -> ShowS
showParen (Int
p forall a. Ord a => a -> a -> Bool
> Int
10)
      forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"DnsData {dnsType = "
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => Int -> a -> ShowS
showsPrec (Int
p forall a. Num a => a -> a -> a
+ Int
1) DnsType α
dnsType
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
", dnsData = "
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. case DnsType α
dnsType of
          DnsType α
AddrDnsType  → forall a. Show a => Int -> a -> ShowS
showsPrec Int
p' α
dnsData
          DnsType α
Addr6DnsType → forall a. Show a => Int -> a -> ShowS
showsPrec Int
p' α
dnsData
          DnsType α
NsDnsType    → forall a. Show a => Int -> a -> ShowS
showsPrec Int
p' α
dnsData
          DnsType α
CNameDnsType → forall a. Show a => Int -> a -> ShowS
showsPrec Int
p' α
dnsData
          DnsType α
PtrDnsType   → forall a. Show a => Int -> a -> ShowS
showsPrec Int
p' α
dnsData
          DnsType α
MxDnsType    → forall a. Show a => Int -> a -> ShowS
showsPrec Int
p' α
dnsData
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"}"
    where p' :: Int
p' = Int
10 ∷ Int

-- | Resource Record.
data DnsRecord = DnsRecord { -- | Record owner
                             DnsRecord -> HostName
dnsRecOwner ∷ {-# UNPACK #-} !HostName
                           , -- | Maximum caching time in secords
                             DnsRecord -> Word32
dnsRecTtl   ∷ {-# UNPACK #-} !Word32
                           , -- | Record data
                             DnsRecord -> DnsData
dnsRecData  ∷ !DnsData
                           }
                 deriving (Typeable, Int -> DnsRecord -> ShowS
[DnsRecord] -> ShowS
DnsRecord -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DnsRecord] -> ShowS
$cshowList :: [DnsRecord] -> ShowS
show :: DnsRecord -> String
$cshow :: DnsRecord -> String
showsPrec :: Int -> DnsRecord -> ShowS
$cshowsPrec :: Int -> DnsRecord -> ShowS
Show)

serializeDnsRecord ∷ Serializer s ⇒ DnsRecord → CompT s ()
serializeDnsRecord :: forall s. Serializer s => DnsRecord -> CompT s ()
serializeDnsRecord (DnsRecord {Word32
DnsData
HostName
dnsRecData :: DnsData
dnsRecTtl :: Word32
dnsRecOwner :: HostName
dnsRecData :: DnsRecord -> DnsData
dnsRecTtl :: DnsRecord -> Word32
dnsRecOwner :: DnsRecord -> HostName
..}) | DnsData DnsType α
tp α
dt ← DnsData
dnsRecData = do
  forall s. Serializer s => HostName -> CompT s ()
serializeHostName HostName
dnsRecOwner
  forall s. Serializer s => s -> CompT s ()
write forall a b. (a -> b) -> a -> b
$  forall s. Serializer s => Word16 -> s
S.word16B (forall α. DnsType α -> Word16
dnsTypeCode DnsType α
tp)
        forall a. Semigroup a => a -> a -> a
<> forall s. Serializer s => Word16 -> s
S.word16B Word16
1
        forall a. Semigroup a => a -> a -> a
<> forall s. Serializer s => Word32 -> s
S.word32B Word32
dnsRecTtl
  forall (μ :: * -> *) k v. Monad μ => Word16 -> StateT k v μ ()
incOffset Word16
10
  ByteString
d ← forall s. Serializer s => CompT Builder () -> CompT s ByteString
evalComp forall a b. (a -> b) -> a -> b
$ case DnsType α
tp of
    DnsType α
AddrDnsType  → forall s. Serializer s => s -> CompT s ()
write (forall α s. (Serializable α, Serializer s) => α -> s
S.put α
dt) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (μ :: * -> *) k v. Monad μ => Word16 -> StateT k v μ ()
incOffset Word16
4
    DnsType α
Addr6DnsType → forall s. Serializer s => s -> CompT s ()
write (forall α s. (Serializable α, Serializer s) => α -> s
S.put α
dt) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (μ :: * -> *) k v. Monad μ => Word16 -> StateT k v μ ()
incOffset Word16
16
    DnsType α
NsDnsType    → forall s. Serializer s => HostName -> CompT s ()
serializeHostName α
dt
    DnsType α
CNameDnsType → forall s. Serializer s => HostName -> CompT s ()
serializeHostName α
dt
    DnsType α
PtrDnsType   → forall s. Serializer s => HostName -> CompT s ()
serializeHostName α
dt
    DnsType α
MxDnsType    → do
      forall s. Serializer s => s -> CompT s ()
write forall a b. (a -> b) -> a -> b
$ forall s. Serializer s => Word16 -> s
S.word16B forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> a
fst α
dt
      forall (μ :: * -> *) k v. Monad μ => Word16 -> StateT k v μ ()
incOffset Word16
2
      forall s. Serializer s => HostName -> CompT s ()
serializeHostName forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> b
snd α
dt
  let len :: Word16
len = forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int64
BSL.length ByteString
d)
  forall s. Serializer s => s -> CompT s ()
write forall a b. (a -> b) -> a -> b
$  forall s. Serializer s => Word16 -> s
S.word16B Word16
len
        forall a. Semigroup a => a -> a -> a
<> forall s. Serializer s => ByteString -> s
S.lazyByteString (Int64 -> ByteString -> ByteString
BSL.take (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
len) ByteString
d)

deserializeDnsRecord ∷ Deserializer μ ⇒ DecompT μ DnsRecord
deserializeDnsRecord :: forall (μ :: * -> *). Deserializer μ => DecompT μ DnsRecord
deserializeDnsRecord = do
  HostName
owner ← forall (μ :: * -> *). Deserializer μ => DecompT μ HostName
deserializeHostName
  Word16
code  ← forall (μ :: * -> *) α k v. Monad μ => μ α -> StateT k v μ α
lift forall (μ :: * -> *). Deserializer μ => μ Word16
D.word16B
  forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall (μ :: * -> *) α k v. Monad μ => μ α -> StateT k v μ α
lift forall (μ :: * -> *). Deserializer μ => μ Word16
D.word16B
  Word32
ttl   ← forall (μ :: * -> *) α k v. Monad μ => μ α -> StateT k v μ α
lift forall (μ :: * -> *). Deserializer μ => μ Word32
D.word32B
  Word16
len   ← forall (μ :: * -> *) α k v. Monad μ => μ α -> StateT k v μ α
lift forall (μ :: * -> *). Deserializer μ => μ Word16
D.word16B
  forall (μ :: * -> *) k v. Monad μ => Word16 -> StateT k v μ ()
incOffset Word16
10
  DnsData
dd ← forall (μ :: * -> *) α.
Deserializer μ =>
Word16 -> DecompT μ α -> DecompT μ α
evalDecomp Word16
len forall a b. (a -> b) -> a -> b
$ case Word16
code of
    Word16
1  → forall α. DnsType α -> α -> DnsData
DnsData DnsType IP4
AddrDnsType  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (μ :: * -> *) k v. Monad μ => Word16 -> StateT k v μ ()
incOffset Word16
4 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (μ :: * -> *) α k v. Monad μ => μ α -> StateT k v μ α
lift forall α (μ :: * -> *). (Deserializable α, Deserializer μ) => μ α
D.get)
    Word16
2  → forall α. DnsType α -> α -> DnsData
DnsData DnsType HostName
NsDnsType    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (μ :: * -> *). Deserializer μ => DecompT μ HostName
deserializeHostName
    Word16
5  → forall α. DnsType α -> α -> DnsData
DnsData DnsType HostName
CNameDnsType forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (μ :: * -> *). Deserializer μ => DecompT μ HostName
deserializeHostName
    Word16
12 → forall α. DnsType α -> α -> DnsData
DnsData DnsType HostName
PtrDnsType   forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (μ :: * -> *). Deserializer μ => DecompT μ HostName
deserializeHostName
    Word16
28 → forall α. DnsType α -> α -> DnsData
DnsData DnsType IP6
Addr6DnsType forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (μ :: * -> *) k v. Monad μ => Word16 -> StateT k v μ ()
incOffset Word16
16 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (μ :: * -> *) α k v. Monad μ => μ α -> StateT k v μ α
lift forall α (μ :: * -> *). (Deserializable α, Deserializer μ) => μ α
D.get)
    Word16
_  → forall (μ :: * -> *) α k v. Monad μ => μ α -> StateT k v μ α
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Parsing m => String -> m a
unexpected forall a b. (a -> b) -> a -> b
$ String
"Unsupported type " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Word16
code
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ HostName -> Word32 -> DnsData -> DnsRecord
DnsRecord HostName
owner Word32
ttl DnsData
dd

-- | DNS query type.
data DnsQType = ∀ α . StdDnsType (DnsType α) -- ^ Record type
              | AllDnsType -- ^ All record types
              deriving Typeable

instance Show DnsQType where
  showsPrec :: Int -> DnsQType -> ShowS
showsPrec Int
p (StdDnsType DnsType α
t) = Bool -> ShowS -> ShowS
showParen (Int
p forall a. Ord a => a -> a -> Bool
> Int
10)
                             forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"StdDnsType "
                             forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => Int -> a -> ShowS
showsPrec (Int
p forall a. Num a => a -> a -> a
+ Int
1) DnsType α
t
  showsPrec Int
_ DnsQType
AllDnsType = String -> ShowS
showString String
"AllDnsType"

-- | Numeric representation of a DNS query type.
dnsQTypeCode ∷ DnsQType → Word16
dnsQTypeCode :: DnsQType -> Word16
dnsQTypeCode (StdDnsType DnsType α
t) = forall α. DnsType α -> Word16
dnsTypeCode DnsType α
t
dnsQTypeCode DnsQType
AllDnsType     = Word16
255

instance Eq DnsQType where
  DnsQType
t1 == :: DnsQType -> DnsQType -> Bool
== DnsQType
t2 = DnsQType -> Word16
dnsQTypeCode DnsQType
t1 forall a. Eq a => a -> a -> Bool
== DnsQType -> Word16
dnsQTypeCode DnsQType
t2

instance Ord DnsQType where
  DnsQType
t1 compare :: DnsQType -> DnsQType -> Ordering
`compare` DnsQType
t2 = DnsQType -> Word16
dnsQTypeCode DnsQType
t1 forall a. Ord a => a -> a -> Ordering
`compare` DnsQType -> Word16
dnsQTypeCode DnsQType
t2

instance Serializable DnsQType where
  put :: forall s. Serializer s => DnsQType -> s
put = forall s. Serializer s => Word16 -> s
S.word16B forall b c a. (b -> c) -> (a -> b) -> a -> c
. DnsQType -> Word16
dnsQTypeCode
  {-# INLINE put #-}

instance SizedSerializable DnsQType where
  size :: Proxy DnsQType -> Int
size Proxy DnsQType
_ = Int
2
  {-# INLINE size #-}

instance Deserializable DnsQType where
  get :: forall (μ :: * -> *). Deserializer μ => μ DnsQType
get = forall (μ :: * -> *). Deserializer μ => μ Word16
D.word16B forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Word16
1   → forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall α. DnsType α -> DnsQType
StdDnsType DnsType IP4
AddrDnsType
    Word16
2   → forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall α. DnsType α -> DnsQType
StdDnsType DnsType HostName
NsDnsType
    Word16
5   → forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall α. DnsType α -> DnsQType
StdDnsType DnsType HostName
CNameDnsType
    Word16
12  → forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall α. DnsType α -> DnsQType
StdDnsType DnsType HostName
PtrDnsType
    Word16
28  → forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall α. DnsType α -> DnsQType
StdDnsType DnsType IP6
Addr6DnsType
    Word16
255 → forall (m :: * -> *) a. Monad m => a -> m a
return DnsQType
AllDnsType
    Word16
t   → forall (m :: * -> *) a. Parsing m => String -> m a
unexpected forall a b. (a -> b) -> a -> b
$ String
"Unsupported query type" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Word16
t

-- | DNS question.
data DnsQuestion = DnsQuestion { -- | Ask about the specified host name
                                 DnsQuestion -> HostName
dnsQName ∷ {-# UNPACK #-} !HostName
                               , -- | Query type
                                 DnsQuestion -> DnsQType
dnsQType ∷ !DnsQType
                               }
                   deriving (Typeable, Int -> DnsQuestion -> ShowS
[DnsQuestion] -> ShowS
DnsQuestion -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DnsQuestion] -> ShowS
$cshowList :: [DnsQuestion] -> ShowS
show :: DnsQuestion -> String
$cshow :: DnsQuestion -> String
showsPrec :: Int -> DnsQuestion -> ShowS
$cshowsPrec :: Int -> DnsQuestion -> ShowS
Show, DnsQuestion -> DnsQuestion -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DnsQuestion -> DnsQuestion -> Bool
$c/= :: DnsQuestion -> DnsQuestion -> Bool
== :: DnsQuestion -> DnsQuestion -> Bool
$c== :: DnsQuestion -> DnsQuestion -> Bool
Eq, Eq DnsQuestion
DnsQuestion -> DnsQuestion -> Bool
DnsQuestion -> DnsQuestion -> Ordering
DnsQuestion -> DnsQuestion -> DnsQuestion
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 :: DnsQuestion -> DnsQuestion -> DnsQuestion
$cmin :: DnsQuestion -> DnsQuestion -> DnsQuestion
max :: DnsQuestion -> DnsQuestion -> DnsQuestion
$cmax :: DnsQuestion -> DnsQuestion -> DnsQuestion
>= :: DnsQuestion -> DnsQuestion -> Bool
$c>= :: DnsQuestion -> DnsQuestion -> Bool
> :: DnsQuestion -> DnsQuestion -> Bool
$c> :: DnsQuestion -> DnsQuestion -> Bool
<= :: DnsQuestion -> DnsQuestion -> Bool
$c<= :: DnsQuestion -> DnsQuestion -> Bool
< :: DnsQuestion -> DnsQuestion -> Bool
$c< :: DnsQuestion -> DnsQuestion -> Bool
compare :: DnsQuestion -> DnsQuestion -> Ordering
$ccompare :: DnsQuestion -> DnsQuestion -> Ordering
Ord)

serializeDnsQuestion ∷ Serializer s ⇒ DnsQuestion → CompT s ()
serializeDnsQuestion :: forall s. Serializer s => DnsQuestion -> CompT s ()
serializeDnsQuestion (DnsQuestion {DnsQType
HostName
dnsQType :: DnsQType
dnsQName :: HostName
dnsQType :: DnsQuestion -> DnsQType
dnsQName :: DnsQuestion -> HostName
..}) = do
  forall s. Serializer s => HostName -> CompT s ()
serializeHostName HostName
dnsQName
  forall s. Serializer s => s -> CompT s ()
write forall a b. (a -> b) -> a -> b
$  forall α s. (Serializable α, Serializer s) => α -> s
S.put DnsQType
dnsQType
        forall a. Semigroup a => a -> a -> a
<> forall s. Serializer s => Word16 -> s
S.word16B Word16
1
  forall (μ :: * -> *) k v. Monad μ => Word16 -> StateT k v μ ()
incOffset Word16
4

deserializeDnsQuestion ∷ Deserializer μ ⇒ DecompT μ DnsQuestion
deserializeDnsQuestion :: forall (μ :: * -> *). Deserializer μ => DecompT μ DnsQuestion
deserializeDnsQuestion = do
  DnsQuestion
q ← HostName -> DnsQType -> DnsQuestion
DnsQuestion forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (μ :: * -> *). Deserializer μ => DecompT μ HostName
deserializeHostName forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (μ :: * -> *) α k v. Monad μ => μ α -> StateT k v μ α
lift forall α (μ :: * -> *). (Deserializable α, Deserializer μ) => μ α
D.get
  forall (μ :: * -> *) α k v. Monad μ => μ α -> StateT k v μ α
lift forall a b. (a -> b) -> a -> b
$ forall (μ :: * -> *). Deserializer μ => μ Word16
D.word16B forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (μ :: * -> *). Deserializer μ => String -> Bool -> μ ()
guard String
"Unsupported class in a question" forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Eq a => a -> a -> Bool
== Word16
1)
  forall (μ :: * -> *) k v. Monad μ => Word16 -> StateT k v μ ()
incOffset Word16
4
  forall (m :: * -> *) a. Monad m => a -> m a
return DnsQuestion
q

-- | Request message.
data DnsReq -- | Standard query
            = DnsReq { -- | Message identifier
                       DnsReq -> Word16
dnsReqId       ∷ {-# UNPACK #-} !DnsId
                     , -- | Truncation flag
                       DnsReq -> Bool
dnsReqTruncd   ∷ !Bool
                     , -- | Recursion flag
                       DnsReq -> Bool
dnsReqRec      ∷ !Bool
                     , -- | Question
                       DnsReq -> DnsQuestion
dnsReqQuestion ∷ {-# UNPACK #-} !DnsQuestion
                     }
            -- | Inverse query
            | DnsInvReq { dnsReqId  ∷ {-# UNPACK #-} !DnsId
                        , -- | IP address
                          DnsReq -> IP
dnsReqInv ∷ !IP
                        }
            deriving (Typeable, Int -> DnsReq -> ShowS
[DnsReq] -> ShowS
DnsReq -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DnsReq] -> ShowS
$cshowList :: [DnsReq] -> ShowS
show :: DnsReq -> String
$cshow :: DnsReq -> String
showsPrec :: Int -> DnsReq -> ShowS
$cshowsPrec :: Int -> DnsReq -> ShowS
Show)

anyHostName ∷ HostName
anyHostName :: HostName
anyHostName = ByteString -> HostName
HN ByteString
"any"

instance Serializable DnsReq where
  put :: forall s. Serializer s => DnsReq -> s
put (DnsReq {Bool
Word16
DnsQuestion
dnsReqQuestion :: DnsQuestion
dnsReqRec :: Bool
dnsReqTruncd :: Bool
dnsReqId :: Word16
dnsReqQuestion :: DnsReq -> DnsQuestion
dnsReqRec :: DnsReq -> Bool
dnsReqTruncd :: DnsReq -> Bool
dnsReqId :: DnsReq -> Word16
..})
    =  forall s. Serializer s => Word16 -> s
S.word16B Word16
dnsReqId
    forall a. Semigroup a => a -> a -> a
<> forall s. Serializer s => Word8 -> s
S.word8 (if Bool
dnsReqRec then Word8
1 else Word8
0
                forall a. Bits a => a -> a -> a
.|. if Bool
dnsReqTruncd then Word8
2 else Word8
0)
    forall a. Semigroup a => a -> a -> a
<> forall s. Serializer s => Word8 -> s
S.word8 Word8
0
    forall a. Semigroup a => a -> a -> a
<> forall s. Serializer s => Word16 -> s
S.word16B Word16
1
    forall a. Semigroup a => a -> a -> a
<> forall s. Serializer s => Word16 -> s
S.word16B Word16
0
    forall a. Semigroup a => a -> a -> a
<> forall s. Serializer s => Word16 -> s
S.word16B Word16
0
    forall a. Semigroup a => a -> a -> a
<> forall s. Serializer s => Word16 -> s
S.word16B Word16
0
    forall a. Semigroup a => a -> a -> a
<> forall s. Serializer s => Word16 -> CompT s () -> s
compress Word16
12 (forall s. Serializer s => DnsQuestion -> CompT s ()
serializeDnsQuestion DnsQuestion
dnsReqQuestion)
  put (DnsInvReq {Word16
IP
dnsReqInv :: IP
dnsReqId :: Word16
dnsReqInv :: DnsReq -> IP
dnsReqId :: DnsReq -> Word16
..})
      =  forall s. Serializer s => Word16 -> s
S.word16B Word16
dnsReqId
      forall a. Semigroup a => a -> a -> a
<> forall s. Serializer s => Word8 -> s
S.word8 Word8
8
      forall a. Semigroup a => a -> a -> a
<> forall s. Serializer s => Word8 -> s
S.word8 Word8
0
      forall a. Semigroup a => a -> a -> a
<> forall s. Serializer s => Word16 -> s
S.word16B Word16
0
      forall a. Semigroup a => a -> a -> a
<> forall s. Serializer s => Word16 -> s
S.word16B Word16
1
      forall a. Semigroup a => a -> a -> a
<> forall s. Serializer s => Word16 -> s
S.word16B Word16
0
      forall a. Semigroup a => a -> a -> a
<> forall s. Serializer s => Word16 -> s
S.word16B Word16
0
      forall a. Semigroup a => a -> a -> a
<> forall s. Serializer s => Word16 -> CompT s () -> s
compress Word16
12 (forall s. Serializer s => DnsRecord -> CompT s ()
serializeDnsRecord DnsRecord
record)
    where
      record :: DnsRecord
record = DnsRecord { dnsRecOwner :: HostName
dnsRecOwner = HostName
anyHostName
                         , dnsRecTtl :: Word32
dnsRecTtl   = Word32
0
                         , dnsRecData :: DnsData
dnsRecData  = case IP
dnsReqInv of
                             IPv4 IP4
a → forall α. DnsType α -> α -> DnsData
DnsData DnsType IP4
AddrDnsType IP4
a
                             IPv6 IP6
a → forall α. DnsType α -> α -> DnsData
DnsData DnsType IP6
Addr6DnsType IP6
a }

instance Deserializable DnsReq where
  get :: forall (μ :: * -> *). Deserializer μ => μ DnsReq
get = do
    Word16
i ← forall (μ :: * -> *). Deserializer μ => μ Word16
D.word16B
    Word8
w ← forall (μ :: * -> *). Deserializer μ => μ Word8
D.word8
    forall (f :: * -> *) a. Functor f => f a -> f ()
void forall (μ :: * -> *). Deserializer μ => μ Word8
D.word8
    forall (μ :: * -> *). Deserializer μ => String -> Bool -> μ ()
guard String
"Not a request" forall a b. (a -> b) -> a -> b
$ Word8
w forall a. Bits a => a -> a -> a
.&. Word8
128 forall a. Eq a => a -> a -> Bool
== Word8
0
    let rec :: Bool
rec    = Word8
w forall a. Bits a => a -> a -> a
.&. Word8
1 forall a. Eq a => a -> a -> Bool
/= Word8
0
        truncd :: Bool
truncd = Word8
w forall a. Bits a => a -> a -> a
.&. Word8
2 forall a. Eq a => a -> a -> Bool
/= Word8
0
        opcode :: Word8
opcode = Word8
w forall a. Bits a => a -> Int -> a
`shiftR` Int
3 forall a. Bits a => a -> a -> a
.&. Word8
0xF
    case Word8
opcode of
      Word8
0 → do
        forall (μ :: * -> *). Deserializer μ => μ Word16
D.word16B forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (μ :: * -> *). Deserializer μ => String -> Bool -> μ ()
guard String
"No questions in query" forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Eq a => a -> a -> Bool
== Word16
1)
        forall (μ :: * -> *). Deserializer μ => μ Word16
D.word16B forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (μ :: * -> *). Deserializer μ => String -> Bool -> μ ()
guard String
"Answers in query" forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Eq a => a -> a -> Bool
== Word16
0)
        forall (μ :: * -> *). Deserializer μ => μ Word16
D.word16B forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (μ :: * -> *). Deserializer μ => String -> Bool -> μ ()
guard String
"Authorities in query" forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Eq a => a -> a -> Bool
== Word16
0)
        forall (μ :: * -> *). Deserializer μ => μ Word16
D.word16B forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (μ :: * -> *). Deserializer μ => String -> Bool -> μ ()
guard String
"Extras in query" forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Eq a => a -> a -> Bool
== Word16
0)
        forall (μ :: * -> *) α. Monad μ => Word16 -> DecompT μ α -> μ α
decompress Word16
12 forall a b. (a -> b) -> a -> b
$ do
          DnsQuestion
q ← forall (μ :: * -> *). Deserializer μ => DecompT μ DnsQuestion
deserializeDnsQuestion
          forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ DnsReq { dnsReqId :: Word16
dnsReqId       = Word16
i
                          , dnsReqTruncd :: Bool
dnsReqTruncd   = Bool
truncd
                          , dnsReqRec :: Bool
dnsReqRec      = Bool
rec
                          , dnsReqQuestion :: DnsQuestion
dnsReqQuestion = DnsQuestion
q }
      Word8
1 → do
        forall (μ :: * -> *). Deserializer μ => μ Word16
D.word16B forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (μ :: * -> *). Deserializer μ => String -> Bool -> μ ()
guard String
"Questions in inverse query" forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Eq a => a -> a -> Bool
== Word16
0)
        forall (μ :: * -> *). Deserializer μ => μ Word16
D.word16B forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (μ :: * -> *). Deserializer μ => String -> Bool -> μ ()
guard String
"No answers in inverse query" forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Eq a => a -> a -> Bool
== Word16
1)
        forall (μ :: * -> *). Deserializer μ => μ Word16
D.word16B forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (μ :: * -> *). Deserializer μ => String -> Bool -> μ ()
guard String
"Authorities in inverse query" forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Eq a => a -> a -> Bool
== Word16
0)
        forall (μ :: * -> *). Deserializer μ => μ Word16
D.word16B forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (μ :: * -> *). Deserializer μ => String -> Bool -> μ ()
guard String
"Extras in inverse query" forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Eq a => a -> a -> Bool
== Word16
0)
        DnsRecord {DnsData
dnsRecData :: DnsData
dnsRecData :: DnsRecord -> DnsData
dnsRecData} ← forall (μ :: * -> *) α. Monad μ => Word16 -> DecompT μ α -> μ α
decompress Word16
12 forall (μ :: * -> *). Deserializer μ => DecompT μ DnsRecord
deserializeDnsRecord
        case DnsData
dnsRecData of
          DnsData DnsType α
AddrDnsType α
a →
            forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ DnsInvReq { dnsReqId :: Word16
dnsReqId  = Word16
i, dnsReqInv :: IP
dnsReqInv = forall t₄ t₆. t₄ -> IP46 t₄ t₆
IPv4 α
a }
          DnsData DnsType α
Addr6DnsType α
a →
            forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ DnsInvReq { dnsReqId :: Word16
dnsReqId  = Word16
i, dnsReqInv :: IP
dnsReqInv = forall t₄ t₆. t₆ -> IP46 t₄ t₆
IPv6 α
a }
          DnsData
_ → forall (m :: * -> *) a. Parsing m => String -> m a
unexpected String
"Invalid answer RR in inverse query"
      Word8
_ → forall (m :: * -> *) a. Parsing m => String -> m a
unexpected forall a b. (a -> b) -> a -> b
$ String
"Invalid opcode " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Word8
opcode forall a. [a] -> [a] -> [a]
++ String
" in request"

-- | Errors returned in responses.
data DnsError = FormatDnsError
              | FailureDnsError
              | NoNameDnsError
              | NotImplDnsError
              | RefusedDnsError
              | NameExistsDnsError
              | RsExistsDnsError
              | NoRsDnsError
              | NotAuthDnsError
              | NotInZoneDnsError
              deriving (Typeable, Int -> DnsError -> ShowS
[DnsError] -> ShowS
DnsError -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DnsError] -> ShowS
$cshowList :: [DnsError] -> ShowS
show :: DnsError -> String
$cshow :: DnsError -> String
showsPrec :: Int -> DnsError -> ShowS
$cshowsPrec :: Int -> DnsError -> ShowS
Show, ReadPrec [DnsError]
ReadPrec DnsError
Int -> ReadS DnsError
ReadS [DnsError]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DnsError]
$creadListPrec :: ReadPrec [DnsError]
readPrec :: ReadPrec DnsError
$creadPrec :: ReadPrec DnsError
readList :: ReadS [DnsError]
$creadList :: ReadS [DnsError]
readsPrec :: Int -> ReadS DnsError
$creadsPrec :: Int -> ReadS DnsError
Read, DnsError -> DnsError -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DnsError -> DnsError -> Bool
$c/= :: DnsError -> DnsError -> Bool
== :: DnsError -> DnsError -> Bool
$c== :: DnsError -> DnsError -> Bool
Eq, Eq DnsError
DnsError -> DnsError -> Bool
DnsError -> DnsError -> Ordering
DnsError -> DnsError -> DnsError
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 :: DnsError -> DnsError -> DnsError
$cmin :: DnsError -> DnsError -> DnsError
max :: DnsError -> DnsError -> DnsError
$cmax :: DnsError -> DnsError -> DnsError
>= :: DnsError -> DnsError -> Bool
$c>= :: DnsError -> DnsError -> Bool
> :: DnsError -> DnsError -> Bool
$c> :: DnsError -> DnsError -> Bool
<= :: DnsError -> DnsError -> Bool
$c<= :: DnsError -> DnsError -> Bool
< :: DnsError -> DnsError -> Bool
$c< :: DnsError -> DnsError -> Bool
compare :: DnsError -> DnsError -> Ordering
$ccompare :: DnsError -> DnsError -> Ordering
Ord, Int -> DnsError
DnsError -> Int
DnsError -> [DnsError]
DnsError -> DnsError
DnsError -> DnsError -> [DnsError]
DnsError -> DnsError -> DnsError -> [DnsError]
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 :: DnsError -> DnsError -> DnsError -> [DnsError]
$cenumFromThenTo :: DnsError -> DnsError -> DnsError -> [DnsError]
enumFromTo :: DnsError -> DnsError -> [DnsError]
$cenumFromTo :: DnsError -> DnsError -> [DnsError]
enumFromThen :: DnsError -> DnsError -> [DnsError]
$cenumFromThen :: DnsError -> DnsError -> [DnsError]
enumFrom :: DnsError -> [DnsError]
$cenumFrom :: DnsError -> [DnsError]
fromEnum :: DnsError -> Int
$cfromEnum :: DnsError -> Int
toEnum :: Int -> DnsError
$ctoEnum :: Int -> DnsError
pred :: DnsError -> DnsError
$cpred :: DnsError -> DnsError
succ :: DnsError -> DnsError
$csucc :: DnsError -> DnsError
Enum)

-- | Numerical representation of the error.
dnsErrorCode ∷ DnsError → Word8
dnsErrorCode :: DnsError -> Word8
dnsErrorCode DnsError
FormatDnsError     = Word8
1
dnsErrorCode DnsError
FailureDnsError    = Word8
2
dnsErrorCode DnsError
NoNameDnsError     = Word8
3
dnsErrorCode DnsError
NotImplDnsError    = Word8
4
dnsErrorCode DnsError
RefusedDnsError    = Word8
5
dnsErrorCode DnsError
NameExistsDnsError = Word8
6
dnsErrorCode DnsError
RsExistsDnsError   = Word8
7
dnsErrorCode DnsError
NoRsDnsError       = Word8
8
dnsErrorCode DnsError
NotAuthDnsError    = Word8
9
dnsErrorCode DnsError
NotInZoneDnsError  = Word8
10

-- | Response message.
data DnsResp -- | Normal response.
             = DnsResp { -- | Request identifer
                         DnsResp -> Word16
dnsRespId       ∷ {-# UNPACK #-} !DnsId
                       , -- | Truncation flag
                         DnsResp -> Bool
dnsRespTruncd   ∷ !Bool
                       , -- | Authoritative answer flag
                         DnsResp -> Bool
dnsRespAuthd    ∷ !Bool
                       , -- | Recursive query support flag
                         DnsResp -> Bool
dnsRespRec      ∷ !Bool
                       , -- | Request question
                         DnsResp -> DnsQuestion
dnsRespQuestion ∷ {-# UNPACK #-} !DnsQuestion
                       , -- | Answer records
                         DnsResp -> [DnsRecord]
dnsRespAnswers  ∷ [DnsRecord]
                       , -- | Authority records
                         DnsResp -> [DnsRecord]
dnsRespAuths    ∷ [DnsRecord]
                       , -- | Additional records
                         DnsResp -> [DnsRecord]
dnsRespExtras   ∷ [DnsRecord]
                       }
             -- | Error response.
             | DnsErrResp { dnsRespId    ∷ {-# UNPACK #-} !DnsId
                          , -- | Error
                            DnsResp -> DnsError
dnsRespError ∷ !DnsError
                          }
             deriving (Typeable, Int -> DnsResp -> ShowS
[DnsResp] -> ShowS
DnsResp -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DnsResp] -> ShowS
$cshowList :: [DnsResp] -> ShowS
show :: DnsResp -> String
$cshow :: DnsResp -> String
showsPrec :: Int -> DnsResp -> ShowS
$cshowsPrec :: Int -> DnsResp -> ShowS
Show)

instance Serializable DnsResp where
  put :: forall s. Serializer s => DnsResp -> s
put (DnsResp {Bool
[DnsRecord]
Word16
DnsQuestion
dnsRespExtras :: [DnsRecord]
dnsRespAuths :: [DnsRecord]
dnsRespAnswers :: [DnsRecord]
dnsRespQuestion :: DnsQuestion
dnsRespRec :: Bool
dnsRespAuthd :: Bool
dnsRespTruncd :: Bool
dnsRespId :: Word16
dnsRespExtras :: DnsResp -> [DnsRecord]
dnsRespAuths :: DnsResp -> [DnsRecord]
dnsRespAnswers :: DnsResp -> [DnsRecord]
dnsRespQuestion :: DnsResp -> DnsQuestion
dnsRespRec :: DnsResp -> Bool
dnsRespAuthd :: DnsResp -> Bool
dnsRespTruncd :: DnsResp -> Bool
dnsRespId :: DnsResp -> Word16
..})
      =  forall s. Serializer s => Word16 -> s
S.word16B Word16
dnsRespId
      forall a. Semigroup a => a -> a -> a
<> forall s. Serializer s => Word8 -> s
S.word8 (Word8
128
                  forall a. Bits a => a -> a -> a
.|. if Bool
dnsRespTruncd then Word8
2 else Word8
0
                  forall a. Bits a => a -> a -> a
.|. if Bool
dnsRespAuthd then Word8
4 else Word8
0)
      forall a. Semigroup a => a -> a -> a
<> forall s. Serializer s => Word8 -> s
S.word8 (if Bool
dnsRespRec then Word8
128 else Word8
0)
      forall a. Semigroup a => a -> a -> a
<> forall s. Serializer s => Word16 -> s
S.word16B Word16
1
      forall a. Semigroup a => a -> a -> a
<> forall s. Serializer s => Word16 -> s
S.word16B (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length [DnsRecord]
dnsRespAnswers)
      forall a. Semigroup a => a -> a -> a
<> forall s. Serializer s => Word16 -> s
S.word16B (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length [DnsRecord]
dnsRespAuths)
      forall a. Semigroup a => a -> a -> a
<> forall s. Serializer s => Word16 -> s
S.word16B (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length [DnsRecord]
dnsRespExtras)
      forall a. Semigroup a => a -> a -> a
<> forall s. Serializer s => Word16 -> CompT s () -> s
compress Word16
12 StateT [ByteString] Word16 (Writer s) ()
records
    where records :: StateT [ByteString] Word16 (Writer s) ()
records = do
            forall s. Serializer s => DnsQuestion -> CompT s ()
serializeDnsQuestion DnsQuestion
dnsRespQuestion
            forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [DnsRecord]
dnsRespAnswers forall s. Serializer s => DnsRecord -> CompT s ()
serializeDnsRecord
            forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [DnsRecord]
dnsRespAuths   forall s. Serializer s => DnsRecord -> CompT s ()
serializeDnsRecord
            forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [DnsRecord]
dnsRespExtras  forall s. Serializer s => DnsRecord -> CompT s ()
serializeDnsRecord
  put (DnsErrResp {Word16
DnsError
dnsRespError :: DnsError
dnsRespId :: Word16
dnsRespError :: DnsResp -> DnsError
dnsRespId :: DnsResp -> Word16
..})
    =  forall s. Serializer s => Word16 -> s
S.word16B Word16
dnsRespId
    forall a. Semigroup a => a -> a -> a
<> forall s. Serializer s => Word8 -> s
S.word8 Word8
8
    forall a. Semigroup a => a -> a -> a
<> forall s. Serializer s => Word8 -> s
S.word8 (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ DnsError -> Word8
dnsErrorCode DnsError
dnsRespError)
    forall a. Semigroup a => a -> a -> a
<> forall s. Serializer s => Word16 -> s
S.word16B Word16
0
    forall a. Semigroup a => a -> a -> a
<> forall s. Serializer s => Word16 -> s
S.word16B Word16
0
    forall a. Semigroup a => a -> a -> a
<> forall s. Serializer s => Word16 -> s
S.word16B Word16
0
    forall a. Semigroup a => a -> a -> a
<> forall s. Serializer s => Word16 -> s
S.word16B Word16
0

instance Deserializable DnsResp where
  get :: forall (μ :: * -> *). Deserializer μ => μ DnsResp
get = do
    Word16
i ← forall (μ :: * -> *). Deserializer μ => μ Word16
D.word16B
    Word8
w ← forall (μ :: * -> *). Deserializer μ => μ Word8
D.word8
    forall (μ :: * -> *). Deserializer μ => String -> Bool -> μ ()
guard String
"Not a response" forall a b. (a -> b) -> a -> b
$ Word8
w forall a. Bits a => a -> a -> a
.&. Word8
128 forall a. Eq a => a -> a -> Bool
/= Word8
0
    Word8
w' ← forall (μ :: * -> *). Deserializer μ => μ Word8
D.word8
    let truncd :: Bool
truncd = Word8
w forall a. Bits a => a -> a -> a
.&. Word8
2 forall a. Eq a => a -> a -> Bool
/= Word8
0
        authd :: Bool
authd  = Word8
w forall a. Bits a => a -> a -> a
.&. Word8
4 forall a. Eq a => a -> a -> Bool
/= Word8
0
        rec :: Bool
rec    = Word8
w' forall a. Bits a => a -> a -> a
.&. Word8
128 forall a. Eq a => a -> a -> Bool
/= Word8
0
        ec :: Word8
ec     = Word8
w' forall a. Bits a => a -> a -> a
.&. Word8
0xF
    case Word8
ec of
      Word8
0 → do
        forall (μ :: * -> *). Deserializer μ => μ Word16
D.word16B forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (μ :: * -> *). Deserializer μ => String -> Bool -> μ ()
guard String
"No question in a response" forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Eq a => a -> a -> Bool
== Word16
1)
        Word16
anc ← forall (μ :: * -> *). Deserializer μ => μ Word16
D.word16B
        Word16
nsc ← forall (μ :: * -> *). Deserializer μ => μ Word16
D.word16B
        Word16
arc ← forall (μ :: * -> *). Deserializer μ => μ Word16
D.word16B
        forall (μ :: * -> *) α. Monad μ => Word16 -> DecompT μ α -> μ α
decompress Word16
12 forall a b. (a -> b) -> a -> b
$ do
          DnsQuestion
q   ← forall (μ :: * -> *). Deserializer μ => DecompT μ DnsQuestion
deserializeDnsQuestion
          [DnsRecord]
ans ← forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall a b. a -> b -> a
const forall (μ :: * -> *). Deserializer μ => DecompT μ DnsRecord
deserializeDnsRecord) [Word16
1 .. Word16
anc]
          [DnsRecord]
nss ← forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall a b. a -> b -> a
const forall (μ :: * -> *). Deserializer μ => DecompT μ DnsRecord
deserializeDnsRecord) [Word16
1 .. Word16
nsc]
          [DnsRecord]
ars ← forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall a b. a -> b -> a
const forall (μ :: * -> *). Deserializer μ => DecompT μ DnsRecord
deserializeDnsRecord) [Word16
1 .. Word16
arc]
          forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ DnsResp { dnsRespId :: Word16
dnsRespId       = Word16
i
                           , dnsRespTruncd :: Bool
dnsRespTruncd   = Bool
truncd
                           , dnsRespAuthd :: Bool
dnsRespAuthd    = Bool
authd
                           , dnsRespRec :: Bool
dnsRespRec      = Bool
rec
                           , dnsRespQuestion :: DnsQuestion
dnsRespQuestion = DnsQuestion
q
                           , dnsRespAnswers :: [DnsRecord]
dnsRespAnswers  = [DnsRecord]
ans
                           , dnsRespAuths :: [DnsRecord]
dnsRespAuths    = [DnsRecord]
nss
                           , dnsRespExtras :: [DnsRecord]
dnsRespExtras   = [DnsRecord]
ars }
      Word8
_ → do
        forall (f :: * -> *) a. Functor f => f a -> f ()
void forall (μ :: * -> *). Deserializer μ => μ Word16
D.word16B
        forall (f :: * -> *) a. Functor f => f a -> f ()
void forall (μ :: * -> *). Deserializer μ => μ Word16
D.word16B
        forall (f :: * -> *) a. Functor f => f a -> f ()
void forall (μ :: * -> *). Deserializer μ => μ Word16
D.word16B
        forall (f :: * -> *) a. Functor f => f a -> f ()
void forall (μ :: * -> *). Deserializer μ => μ Word16
D.word16B
        Word16 -> DnsError -> DnsResp
DnsErrResp Word16
i forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case Word8
ec of
          Word8
1  → forall (m :: * -> *) a. Monad m => a -> m a
return DnsError
FormatDnsError
          Word8
2  → forall (m :: * -> *) a. Monad m => a -> m a
return DnsError
FailureDnsError
          Word8
3  → forall (m :: * -> *) a. Monad m => a -> m a
return DnsError
NoNameDnsError
          Word8
4  → forall (m :: * -> *) a. Monad m => a -> m a
return DnsError
NotImplDnsError
          Word8
5  → forall (m :: * -> *) a. Monad m => a -> m a
return DnsError
RefusedDnsError
          Word8
6  → forall (m :: * -> *) a. Monad m => a -> m a
return DnsError
NameExistsDnsError
          Word8
7  → forall (m :: * -> *) a. Monad m => a -> m a
return DnsError
RsExistsDnsError
          Word8
8  → forall (m :: * -> *) a. Monad m => a -> m a
return DnsError
NoRsDnsError
          Word8
9  → forall (m :: * -> *) a. Monad m => a -> m a
return DnsError
NotAuthDnsError
          Word8
10 → forall (m :: * -> *) a. Monad m => a -> m a
return DnsError
NotInZoneDnsError
          Word8
_  → forall (m :: * -> *) a. Parsing m => String -> m a
unexpected forall a b. (a -> b) -> a -> b
$ String
"Unknown error code " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Word8
ec