{-# LANGUAGE BangPatterns, OverloadedStrings #-}
module Network.DNS.Decode.Parsers (
getResponse
, getDNSFlags
, getHeader
, getResourceRecord
, getResourceRecords
, getDomain
, getMailbox
) where
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as BS
import qualified Data.IP
import Data.IP (IP(..), toIPv4, toIPv6b, makeAddrRange)
import Network.DNS.Imports
import Network.DNS.StateBinary
import Network.DNS.Types.Internal
getResponse :: SGet DNSMessage
getResponse :: SGet DNSMessage
getResponse = do
DNSHeader
hm <- SGet DNSHeader
getHeader
Int
qdCount <- SGet Int
getInt16
Int
anCount <- SGet Int
getInt16
Int
nsCount <- SGet Int
getInt16
Int
arCount <- SGet Int
getInt16
[Question]
queries <- Int -> SGet [Question]
getQueries Int
qdCount
[ResourceRecord]
answers <- Int -> SGet [ResourceRecord]
getResourceRecords Int
anCount
[ResourceRecord]
authrrs <- Int -> SGet [ResourceRecord]
getResourceRecords Int
nsCount
[ResourceRecord]
addnrrs <- Int -> SGet [ResourceRecord]
getResourceRecords Int
arCount
let ([ResourceRecord]
opts, [ResourceRecord]
rest) = (ResourceRecord -> Bool)
-> [ResourceRecord] -> ([ResourceRecord], [ResourceRecord])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (TYPE -> TYPE -> Bool
forall a. Eq a => a -> a -> Bool
(==) TYPE
OPT(TYPE -> Bool)
-> (ResourceRecord -> TYPE) -> ResourceRecord -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ResourceRecord -> TYPE
rrtype) [ResourceRecord]
addnrrs
flgs :: DNSFlags
flgs = DNSHeader -> DNSFlags
flags DNSHeader
hm
rc :: Word16
rc = RCODE -> Word16
fromRCODE (RCODE -> Word16) -> RCODE -> Word16
forall a b. (a -> b) -> a -> b
$ DNSFlags -> RCODE
rcode DNSFlags
flgs
(EDNSheader
eh, RCODE
erc) = Word16 -> [ResourceRecord] -> (EDNSheader, RCODE)
getEDNS Word16
rc [ResourceRecord]
opts
hd :: DNSHeader
hd = DNSHeader
hm { flags :: DNSFlags
flags = DNSFlags
flgs { rcode :: RCODE
rcode = RCODE
erc } }
DNSMessage -> SGet DNSMessage
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DNSMessage -> SGet DNSMessage) -> DNSMessage -> SGet DNSMessage
forall a b. (a -> b) -> a -> b
$ DNSHeader
-> EDNSheader
-> [Question]
-> [ResourceRecord]
-> [ResourceRecord]
-> [ResourceRecord]
-> DNSMessage
DNSMessage DNSHeader
hd EDNSheader
eh [Question]
queries [ResourceRecord]
answers [ResourceRecord]
authrrs ([ResourceRecord] -> DNSMessage) -> [ResourceRecord] -> DNSMessage
forall a b. (a -> b) -> a -> b
$ EDNSheader
-> [ResourceRecord] -> [ResourceRecord] -> [ResourceRecord]
forall a. EDNSheader -> a -> a -> a
ifEDNS EDNSheader
eh [ResourceRecord]
rest [ResourceRecord]
addnrrs
where
getEDNS :: Word16 -> AdditionalRecords -> (EDNSheader, RCODE)
getEDNS :: Word16 -> [ResourceRecord] -> (EDNSheader, RCODE)
getEDNS Word16
rc [ResourceRecord]
rrs = case [ResourceRecord]
rrs of
[ResourceRecord
rr] | Just (EDNS
edns, Word16
erc) <- ResourceRecord -> Maybe (EDNS, Word16)
optEDNS ResourceRecord
rr
-> (EDNS -> EDNSheader
EDNSheader EDNS
edns, Word16 -> RCODE
toRCODE Word16
erc)
[] -> (EDNSheader
NoEDNS, Word16 -> RCODE
toRCODE Word16
rc)
[ResourceRecord]
_ -> (EDNSheader
InvalidEDNS, RCODE
BadRCODE)
where
optEDNS :: ResourceRecord -> Maybe (EDNS, Word16)
optEDNS :: ResourceRecord -> Maybe (EDNS, Word16)
optEDNS (ResourceRecord ByteString
"." TYPE
OPT Word16
udpsiz TTL
ttl' (RD_OPT [OData]
opts)) =
let hrc :: TTL
hrc = Word16 -> TTL
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
rc TTL -> TTL -> TTL
forall a. Bits a => a -> a -> a
.&. TTL
0x0f
erc :: TTL
erc = TTL -> Int -> TTL
forall a. Bits a => a -> Int -> a
shiftR (TTL
ttl' TTL -> TTL -> TTL
forall a. Bits a => a -> a -> a
.&. TTL
0xff000000) Int
20 TTL -> TTL -> TTL
forall a. Bits a => a -> a -> a
.|. TTL
hrc
secok :: Bool
secok = TTL
ttl' TTL -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
`testBit` Int
15
vers :: Word8
vers = TTL -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (TTL -> Word8) -> TTL -> Word8
forall a b. (a -> b) -> a -> b
$ TTL -> Int -> TTL
forall a. Bits a => a -> Int -> a
shiftR (TTL
ttl' TTL -> TTL -> TTL
forall a. Bits a => a -> a -> a
.&. TTL
0x00ff0000) Int
16
in (EDNS, Word16) -> Maybe (EDNS, Word16)
forall a. a -> Maybe a
Just (Word8 -> Word16 -> Bool -> [OData] -> EDNS
EDNS Word8
vers Word16
udpsiz Bool
secok [OData]
opts, TTL -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral TTL
erc)
optEDNS ResourceRecord
_ = Maybe (EDNS, Word16)
forall a. Maybe a
Nothing
getDNSFlags :: SGet DNSFlags
getDNSFlags :: SGet DNSFlags
getDNSFlags = do
Word16
flgs <- SGet Word16
get16
OPCODE
oc <- Word16 -> StateT PState (Parser ByteString) OPCODE
getOpcode Word16
flgs
DNSFlags -> SGet DNSFlags
forall (m :: * -> *) a. Monad m => a -> m a
return (DNSFlags -> SGet DNSFlags) -> DNSFlags -> SGet DNSFlags
forall a b. (a -> b) -> a -> b
$ QorR
-> OPCODE
-> Bool
-> Bool
-> Bool
-> Bool
-> RCODE
-> Bool
-> Bool
-> DNSFlags
DNSFlags (Word16 -> QorR
forall {a}. Bits a => a -> QorR
getQorR Word16
flgs)
OPCODE
oc
(Word16 -> Bool
forall {a}. Bits a => a -> Bool
getAuthAnswer Word16
flgs)
(Word16 -> Bool
forall {a}. Bits a => a -> Bool
getTrunCation Word16
flgs)
(Word16 -> Bool
forall {a}. Bits a => a -> Bool
getRecDesired Word16
flgs)
(Word16 -> Bool
forall {a}. Bits a => a -> Bool
getRecAvailable Word16
flgs)
(Word16 -> RCODE
getRcode Word16
flgs)
(Word16 -> Bool
forall {a}. Bits a => a -> Bool
getAuthenData Word16
flgs)
(Word16 -> Bool
forall {a}. Bits a => a -> Bool
getChkDisable Word16
flgs)
where
getQorR :: a -> QorR
getQorR a
w = if a -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit a
w Int
15 then QorR
QR_Response else QorR
QR_Query
getOpcode :: Word16 -> StateT PState (Parser ByteString) OPCODE
getOpcode Word16
w =
case Word16 -> Int -> Word16
forall a. Bits a => a -> Int -> a
shiftR Word16
w Int
11 Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.&. Word16
0x0f of
Word16
n | Just OPCODE
opc <- Word16 -> Maybe OPCODE
toOPCODE Word16
n
-> OPCODE -> StateT PState (Parser ByteString) OPCODE
forall (f :: * -> *) a. Applicative f => a -> f a
pure OPCODE
opc
| Bool
otherwise
-> [Char] -> StateT PState (Parser ByteString) OPCODE
forall a. [Char] -> SGet a
failSGet ([Char] -> StateT PState (Parser ByteString) OPCODE)
-> [Char] -> StateT PState (Parser ByteString) OPCODE
forall a b. (a -> b) -> a -> b
$ [Char]
"Unsupported header opcode: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Word16 -> [Char]
forall a. Show a => a -> [Char]
show Word16
n
getAuthAnswer :: a -> Bool
getAuthAnswer a
w = a -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit a
w Int
10
getTrunCation :: a -> Bool
getTrunCation a
w = a -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit a
w Int
9
getRecDesired :: a -> Bool
getRecDesired a
w = a -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit a
w Int
8
getRecAvailable :: a -> Bool
getRecAvailable a
w = a -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit a
w Int
7
getRcode :: Word16 -> RCODE
getRcode Word16
w = Word16 -> RCODE
toRCODE (Word16 -> RCODE) -> Word16 -> RCODE
forall a b. (a -> b) -> a -> b
$ Word16
w Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.&. Word16
0x0f
getAuthenData :: a -> Bool
getAuthenData a
w = a -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit a
w Int
5
getChkDisable :: a -> Bool
getChkDisable a
w = a -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit a
w Int
4
getHeader :: SGet DNSHeader
=
Word16 -> DNSFlags -> DNSHeader
DNSHeader (Word16 -> DNSFlags -> DNSHeader)
-> SGet Word16
-> StateT PState (Parser ByteString) (DNSFlags -> DNSHeader)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SGet Word16
decodeIdentifier StateT PState (Parser ByteString) (DNSFlags -> DNSHeader)
-> SGet DNSFlags -> SGet DNSHeader
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SGet DNSFlags
getDNSFlags
where
decodeIdentifier :: SGet Word16
decodeIdentifier = SGet Word16
get16
getQueries :: Int -> SGet [Question]
getQueries :: Int -> SGet [Question]
getQueries Int
n = Int
-> StateT PState (Parser ByteString) Question -> SGet [Question]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
n StateT PState (Parser ByteString) Question
getQuery
getTYPE :: SGet TYPE
getTYPE :: SGet TYPE
getTYPE = Word16 -> TYPE
toTYPE (Word16 -> TYPE) -> SGet Word16 -> SGet TYPE
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SGet Word16
get16
getQuery :: SGet Question
getQuery :: StateT PState (Parser ByteString) Question
getQuery = ByteString -> TYPE -> Question
Question (ByteString -> TYPE -> Question)
-> StateT PState (Parser ByteString) ByteString
-> StateT PState (Parser ByteString) (TYPE -> Question)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT PState (Parser ByteString) ByteString
getDomain
StateT PState (Parser ByteString) (TYPE -> Question)
-> SGet TYPE -> StateT PState (Parser ByteString) Question
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SGet TYPE
getTYPE
StateT PState (Parser ByteString) Question
-> SGet Word16 -> StateT PState (Parser ByteString) Question
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* SGet Word16
ignoreClass
where
ignoreClass :: SGet Word16
ignoreClass = SGet Word16
get16
getResourceRecords :: Int -> SGet [ResourceRecord]
getResourceRecords :: Int -> SGet [ResourceRecord]
getResourceRecords Int
n = Int
-> StateT PState (Parser ByteString) ResourceRecord
-> SGet [ResourceRecord]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
n StateT PState (Parser ByteString) ResourceRecord
getResourceRecord
getResourceRecord :: SGet ResourceRecord
getResourceRecord :: StateT PState (Parser ByteString) ResourceRecord
getResourceRecord = do
ByteString
dom <- StateT PState (Parser ByteString) ByteString
getDomain
TYPE
typ <- SGet TYPE
getTYPE
Word16
cls <- SGet Word16
get16
TTL
ttl <- SGet TTL
get32
Int
len <- SGet Int
getInt16
RData
dat <- Int -> SGet RData -> SGet RData
forall a. Int -> SGet a -> SGet a
fitSGet Int
len (SGet RData -> SGet RData) -> SGet RData -> SGet RData
forall a b. (a -> b) -> a -> b
$ TYPE -> Int -> SGet RData
getRData TYPE
typ Int
len
ResourceRecord -> StateT PState (Parser ByteString) ResourceRecord
forall (m :: * -> *) a. Monad m => a -> m a
return (ResourceRecord
-> StateT PState (Parser ByteString) ResourceRecord)
-> ResourceRecord
-> StateT PState (Parser ByteString) ResourceRecord
forall a b. (a -> b) -> a -> b
$ ByteString -> TYPE -> Word16 -> TTL -> RData -> ResourceRecord
ResourceRecord ByteString
dom TYPE
typ Word16
cls TTL
ttl RData
dat
rdataEnd :: Int
-> SGet Int
rdataEnd :: Int -> SGet Int
rdataEnd !Int
len = Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) Int
len (Int -> Int) -> SGet Int -> SGet Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SGet Int
getPosition
getRData :: TYPE -> Int -> SGet RData
getRData :: TYPE -> Int -> SGet RData
getRData TYPE
NS Int
_ = ByteString -> RData
RD_NS (ByteString -> RData)
-> StateT PState (Parser ByteString) ByteString -> SGet RData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT PState (Parser ByteString) ByteString
getDomain
getRData TYPE
MX Int
_ = Word16 -> ByteString -> RData
RD_MX (Word16 -> ByteString -> RData)
-> SGet Word16
-> StateT PState (Parser ByteString) (ByteString -> RData)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SGet Word16
get16 StateT PState (Parser ByteString) (ByteString -> RData)
-> StateT PState (Parser ByteString) ByteString -> SGet RData
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StateT PState (Parser ByteString) ByteString
getDomain
getRData TYPE
CNAME Int
_ = ByteString -> RData
RD_CNAME (ByteString -> RData)
-> StateT PState (Parser ByteString) ByteString -> SGet RData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT PState (Parser ByteString) ByteString
getDomain
getRData TYPE
DNAME Int
_ = ByteString -> RData
RD_DNAME (ByteString -> RData)
-> StateT PState (Parser ByteString) ByteString -> SGet RData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT PState (Parser ByteString) ByteString
getDomain
getRData TYPE
TXT Int
len = ByteString -> RData
RD_TXT (ByteString -> RData)
-> StateT PState (Parser ByteString) ByteString -> SGet RData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> StateT PState (Parser ByteString) ByteString
getTXT Int
len
getRData TYPE
A Int
_ = IPv4 -> RData
RD_A (IPv4 -> RData) -> ([Int] -> IPv4) -> [Int] -> RData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> IPv4
toIPv4 ([Int] -> RData)
-> StateT PState (Parser ByteString) [Int] -> SGet RData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> StateT PState (Parser ByteString) [Int]
getNBytes Int
4
getRData TYPE
AAAA Int
_ = IPv6 -> RData
RD_AAAA (IPv6 -> RData) -> ([Int] -> IPv6) -> [Int] -> RData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> IPv6
toIPv6b ([Int] -> RData)
-> StateT PState (Parser ByteString) [Int] -> SGet RData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> StateT PState (Parser ByteString) [Int]
getNBytes Int
16
getRData TYPE
SOA Int
_ = ByteString
-> ByteString -> TTL -> TTL -> TTL -> TTL -> TTL -> RData
RD_SOA (ByteString
-> ByteString -> TTL -> TTL -> TTL -> TTL -> TTL -> RData)
-> StateT PState (Parser ByteString) ByteString
-> StateT
PState
(Parser ByteString)
(ByteString -> TTL -> TTL -> TTL -> TTL -> TTL -> RData)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT PState (Parser ByteString) ByteString
getDomain
StateT
PState
(Parser ByteString)
(ByteString -> TTL -> TTL -> TTL -> TTL -> TTL -> RData)
-> StateT PState (Parser ByteString) ByteString
-> StateT
PState
(Parser ByteString)
(TTL -> TTL -> TTL -> TTL -> TTL -> RData)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StateT PState (Parser ByteString) ByteString
getMailbox
StateT
PState
(Parser ByteString)
(TTL -> TTL -> TTL -> TTL -> TTL -> RData)
-> SGet TTL
-> StateT
PState (Parser ByteString) (TTL -> TTL -> TTL -> TTL -> RData)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SGet TTL
decodeSerial
StateT
PState (Parser ByteString) (TTL -> TTL -> TTL -> TTL -> RData)
-> SGet TTL
-> StateT PState (Parser ByteString) (TTL -> TTL -> TTL -> RData)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SGet TTL
decodeRefesh
StateT PState (Parser ByteString) (TTL -> TTL -> TTL -> RData)
-> SGet TTL
-> StateT PState (Parser ByteString) (TTL -> TTL -> RData)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SGet TTL
decodeRetry
StateT PState (Parser ByteString) (TTL -> TTL -> RData)
-> SGet TTL -> StateT PState (Parser ByteString) (TTL -> RData)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SGet TTL
decodeExpire
StateT PState (Parser ByteString) (TTL -> RData)
-> SGet TTL -> SGet RData
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SGet TTL
decodeMinimum
where
decodeSerial :: SGet TTL
decodeSerial = SGet TTL
get32
decodeRefesh :: SGet TTL
decodeRefesh = SGet TTL
get32
decodeRetry :: SGet TTL
decodeRetry = SGet TTL
get32
decodeExpire :: SGet TTL
decodeExpire = SGet TTL
get32
decodeMinimum :: SGet TTL
decodeMinimum = SGet TTL
get32
getRData TYPE
PTR Int
_ = ByteString -> RData
RD_PTR (ByteString -> RData)
-> StateT PState (Parser ByteString) ByteString -> SGet RData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT PState (Parser ByteString) ByteString
getDomain
getRData TYPE
SRV Int
_ = Word16 -> Word16 -> Word16 -> ByteString -> RData
RD_SRV (Word16 -> Word16 -> Word16 -> ByteString -> RData)
-> SGet Word16
-> StateT
PState
(Parser ByteString)
(Word16 -> Word16 -> ByteString -> RData)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SGet Word16
decodePriority
StateT
PState
(Parser ByteString)
(Word16 -> Word16 -> ByteString -> RData)
-> SGet Word16
-> StateT
PState (Parser ByteString) (Word16 -> ByteString -> RData)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SGet Word16
decodeWeight
StateT PState (Parser ByteString) (Word16 -> ByteString -> RData)
-> SGet Word16
-> StateT PState (Parser ByteString) (ByteString -> RData)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SGet Word16
decodePort
StateT PState (Parser ByteString) (ByteString -> RData)
-> StateT PState (Parser ByteString) ByteString -> SGet RData
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StateT PState (Parser ByteString) ByteString
getDomain
where
decodePriority :: SGet Word16
decodePriority = SGet Word16
get16
decodeWeight :: SGet Word16
decodeWeight = SGet Word16
get16
decodePort :: SGet Word16
decodePort = SGet Word16
get16
getRData TYPE
OPT Int
len = [OData] -> RData
RD_OPT ([OData] -> RData)
-> StateT PState (Parser ByteString) [OData] -> SGet RData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> StateT PState (Parser ByteString) [OData]
getOpts Int
len
getRData TYPE
TLSA Int
len = Word8 -> Word8 -> Word8 -> ByteString -> RData
RD_TLSA (Word8 -> Word8 -> Word8 -> ByteString -> RData)
-> StateT PState (Parser ByteString) Word8
-> StateT
PState (Parser ByteString) (Word8 -> Word8 -> ByteString -> RData)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT PState (Parser ByteString) Word8
decodeUsage
StateT
PState (Parser ByteString) (Word8 -> Word8 -> ByteString -> RData)
-> StateT PState (Parser ByteString) Word8
-> StateT PState (Parser ByteString) (Word8 -> ByteString -> RData)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StateT PState (Parser ByteString) Word8
decodeSelector
StateT PState (Parser ByteString) (Word8 -> ByteString -> RData)
-> StateT PState (Parser ByteString) Word8
-> StateT PState (Parser ByteString) (ByteString -> RData)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StateT PState (Parser ByteString) Word8
decodeMType
StateT PState (Parser ByteString) (ByteString -> RData)
-> StateT PState (Parser ByteString) ByteString -> SGet RData
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StateT PState (Parser ByteString) ByteString
decodeADF
where
decodeUsage :: StateT PState (Parser ByteString) Word8
decodeUsage = StateT PState (Parser ByteString) Word8
get8
decodeSelector :: StateT PState (Parser ByteString) Word8
decodeSelector = StateT PState (Parser ByteString) Word8
get8
decodeMType :: StateT PState (Parser ByteString) Word8
decodeMType = StateT PState (Parser ByteString) Word8
get8
decodeADF :: StateT PState (Parser ByteString) ByteString
decodeADF = Int -> StateT PState (Parser ByteString) ByteString
getNByteString (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
3)
getRData TYPE
DS Int
len = Word16 -> Word8 -> Word8 -> ByteString -> RData
RD_DS (Word16 -> Word8 -> Word8 -> ByteString -> RData)
-> SGet Word16
-> StateT
PState (Parser ByteString) (Word8 -> Word8 -> ByteString -> RData)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SGet Word16
decodeTag
StateT
PState (Parser ByteString) (Word8 -> Word8 -> ByteString -> RData)
-> StateT PState (Parser ByteString) Word8
-> StateT PState (Parser ByteString) (Word8 -> ByteString -> RData)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StateT PState (Parser ByteString) Word8
decodeAlg
StateT PState (Parser ByteString) (Word8 -> ByteString -> RData)
-> StateT PState (Parser ByteString) Word8
-> StateT PState (Parser ByteString) (ByteString -> RData)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StateT PState (Parser ByteString) Word8
decodeDtyp
StateT PState (Parser ByteString) (ByteString -> RData)
-> StateT PState (Parser ByteString) ByteString -> SGet RData
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StateT PState (Parser ByteString) ByteString
decodeDval
where
decodeTag :: SGet Word16
decodeTag = SGet Word16
get16
decodeAlg :: StateT PState (Parser ByteString) Word8
decodeAlg = StateT PState (Parser ByteString) Word8
get8
decodeDtyp :: StateT PState (Parser ByteString) Word8
decodeDtyp = StateT PState (Parser ByteString) Word8
get8
decodeDval :: StateT PState (Parser ByteString) ByteString
decodeDval = Int -> StateT PState (Parser ByteString) ByteString
getNByteString (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
4)
getRData TYPE
CDS Int
len = Word16 -> Word8 -> Word8 -> ByteString -> RData
RD_CDS (Word16 -> Word8 -> Word8 -> ByteString -> RData)
-> SGet Word16
-> StateT
PState (Parser ByteString) (Word8 -> Word8 -> ByteString -> RData)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SGet Word16
decodeTag
StateT
PState (Parser ByteString) (Word8 -> Word8 -> ByteString -> RData)
-> StateT PState (Parser ByteString) Word8
-> StateT PState (Parser ByteString) (Word8 -> ByteString -> RData)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StateT PState (Parser ByteString) Word8
decodeAlg
StateT PState (Parser ByteString) (Word8 -> ByteString -> RData)
-> StateT PState (Parser ByteString) Word8
-> StateT PState (Parser ByteString) (ByteString -> RData)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StateT PState (Parser ByteString) Word8
decodeDtyp
StateT PState (Parser ByteString) (ByteString -> RData)
-> StateT PState (Parser ByteString) ByteString -> SGet RData
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StateT PState (Parser ByteString) ByteString
decodeDval
where
decodeTag :: SGet Word16
decodeTag = SGet Word16
get16
decodeAlg :: StateT PState (Parser ByteString) Word8
decodeAlg = StateT PState (Parser ByteString) Word8
get8
decodeDtyp :: StateT PState (Parser ByteString) Word8
decodeDtyp = StateT PState (Parser ByteString) Word8
get8
decodeDval :: StateT PState (Parser ByteString) ByteString
decodeDval = Int -> StateT PState (Parser ByteString) ByteString
getNByteString (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
4)
getRData TYPE
RRSIG Int
len = RD_RRSIG -> RData
RD_RRSIG (RD_RRSIG -> RData)
-> StateT PState (Parser ByteString) RD_RRSIG -> SGet RData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT PState (Parser ByteString) RD_RRSIG
decodeRRSIG
where
decodeRRSIG :: StateT PState (Parser ByteString) RD_RRSIG
decodeRRSIG = do
Int
end <- Int -> SGet Int
rdataEnd Int
len
TYPE
typ <- SGet TYPE
getTYPE
Word8
alg <- StateT PState (Parser ByteString) Word8
get8
Word8
cnt <- StateT PState (Parser ByteString) Word8
get8
TTL
ttl <- SGet TTL
get32
Int64
tex <- StateT PState (Parser ByteString) Int64
getDnsTime
Int64
tin <- StateT PState (Parser ByteString) Int64
getDnsTime
Word16
tag <- SGet Word16
get16
ByteString
dom <- StateT PState (Parser ByteString) ByteString
getDomain
Int
pos <- SGet Int
getPosition
ByteString
val <- Int -> StateT PState (Parser ByteString) ByteString
getNByteString (Int -> StateT PState (Parser ByteString) ByteString)
-> Int -> StateT PState (Parser ByteString) ByteString
forall a b. (a -> b) -> a -> b
$ Int
end Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
pos
RD_RRSIG -> StateT PState (Parser ByteString) RD_RRSIG
forall (m :: * -> *) a. Monad m => a -> m a
return (RD_RRSIG -> StateT PState (Parser ByteString) RD_RRSIG)
-> RD_RRSIG -> StateT PState (Parser ByteString) RD_RRSIG
forall a b. (a -> b) -> a -> b
$ TYPE
-> Word8
-> Word8
-> TTL
-> Int64
-> Int64
-> Word16
-> ByteString
-> ByteString
-> RD_RRSIG
RDREP_RRSIG TYPE
typ Word8
alg Word8
cnt TTL
ttl Int64
tex Int64
tin Word16
tag ByteString
dom ByteString
val
getDnsTime :: StateT PState (Parser ByteString) Int64
getDnsTime = do
Int64
tnow <- StateT PState (Parser ByteString) Int64
getAtTime
TTL
tdns <- SGet TTL
get32
Int64 -> StateT PState (Parser ByteString) Int64
forall (m :: * -> *) a. Monad m => a -> m a
return (Int64 -> StateT PState (Parser ByteString) Int64)
-> Int64 -> StateT PState (Parser ByteString) Int64
forall a b. (a -> b) -> a -> b
$! TTL -> Int64 -> Int64
dnsTime TTL
tdns Int64
tnow
getRData TYPE
NULL Int
len = ByteString -> RData
RD_NULL (ByteString -> RData)
-> StateT PState (Parser ByteString) ByteString -> SGet RData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> StateT PState (Parser ByteString) ByteString
getNByteString Int
len
getRData TYPE
NSEC Int
len = do
Int
end <- Int -> SGet Int
rdataEnd Int
len
ByteString
dom <- StateT PState (Parser ByteString) ByteString
getDomain
Int
pos <- SGet Int
getPosition
ByteString -> [TYPE] -> RData
RD_NSEC ByteString
dom ([TYPE] -> RData)
-> StateT PState (Parser ByteString) [TYPE] -> SGet RData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> StateT PState (Parser ByteString) [TYPE]
getNsecTypes (Int
end Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
pos)
getRData TYPE
DNSKEY Int
len = Word16 -> Word8 -> Word8 -> ByteString -> RData
RD_DNSKEY (Word16 -> Word8 -> Word8 -> ByteString -> RData)
-> SGet Word16
-> StateT
PState (Parser ByteString) (Word8 -> Word8 -> ByteString -> RData)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SGet Word16
decodeKeyFlags
StateT
PState (Parser ByteString) (Word8 -> Word8 -> ByteString -> RData)
-> StateT PState (Parser ByteString) Word8
-> StateT PState (Parser ByteString) (Word8 -> ByteString -> RData)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StateT PState (Parser ByteString) Word8
decodeKeyProto
StateT PState (Parser ByteString) (Word8 -> ByteString -> RData)
-> StateT PState (Parser ByteString) Word8
-> StateT PState (Parser ByteString) (ByteString -> RData)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StateT PState (Parser ByteString) Word8
decodeKeyAlg
StateT PState (Parser ByteString) (ByteString -> RData)
-> StateT PState (Parser ByteString) ByteString -> SGet RData
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StateT PState (Parser ByteString) ByteString
decodeKeyBytes
where
decodeKeyFlags :: SGet Word16
decodeKeyFlags = SGet Word16
get16
decodeKeyProto :: StateT PState (Parser ByteString) Word8
decodeKeyProto = StateT PState (Parser ByteString) Word8
get8
decodeKeyAlg :: StateT PState (Parser ByteString) Word8
decodeKeyAlg = StateT PState (Parser ByteString) Word8
get8
decodeKeyBytes :: StateT PState (Parser ByteString) ByteString
decodeKeyBytes = Int -> StateT PState (Parser ByteString) ByteString
getNByteString (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
4)
getRData TYPE
CDNSKEY Int
len = Word16 -> Word8 -> Word8 -> ByteString -> RData
RD_CDNSKEY (Word16 -> Word8 -> Word8 -> ByteString -> RData)
-> SGet Word16
-> StateT
PState (Parser ByteString) (Word8 -> Word8 -> ByteString -> RData)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SGet Word16
decodeKeyFlags
StateT
PState (Parser ByteString) (Word8 -> Word8 -> ByteString -> RData)
-> StateT PState (Parser ByteString) Word8
-> StateT PState (Parser ByteString) (Word8 -> ByteString -> RData)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StateT PState (Parser ByteString) Word8
decodeKeyProto
StateT PState (Parser ByteString) (Word8 -> ByteString -> RData)
-> StateT PState (Parser ByteString) Word8
-> StateT PState (Parser ByteString) (ByteString -> RData)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StateT PState (Parser ByteString) Word8
decodeKeyAlg
StateT PState (Parser ByteString) (ByteString -> RData)
-> StateT PState (Parser ByteString) ByteString -> SGet RData
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StateT PState (Parser ByteString) ByteString
decodeKeyBytes
where
decodeKeyFlags :: SGet Word16
decodeKeyFlags = SGet Word16
get16
decodeKeyProto :: StateT PState (Parser ByteString) Word8
decodeKeyProto = StateT PState (Parser ByteString) Word8
get8
decodeKeyAlg :: StateT PState (Parser ByteString) Word8
decodeKeyAlg = StateT PState (Parser ByteString) Word8
get8
decodeKeyBytes :: StateT PState (Parser ByteString) ByteString
decodeKeyBytes = Int -> StateT PState (Parser ByteString) ByteString
getNByteString (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
4)
getRData TYPE
NSEC3 Int
len = do
Int
dend <- Int -> SGet Int
rdataEnd Int
len
Word8
halg <- StateT PState (Parser ByteString) Word8
get8
Word8
flgs <- StateT PState (Parser ByteString) Word8
get8
Word16
iter <- SGet Word16
get16
ByteString
salt <- SGet Int
getInt8 SGet Int
-> (Int -> StateT PState (Parser ByteString) ByteString)
-> StateT PState (Parser ByteString) ByteString
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> StateT PState (Parser ByteString) ByteString
getNByteString
ByteString
hash <- SGet Int
getInt8 SGet Int
-> (Int -> StateT PState (Parser ByteString) ByteString)
-> StateT PState (Parser ByteString) ByteString
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> StateT PState (Parser ByteString) ByteString
getNByteString
Int
tpos <- SGet Int
getPosition
Word8
-> Word8 -> Word16 -> ByteString -> ByteString -> [TYPE] -> RData
RD_NSEC3 Word8
halg Word8
flgs Word16
iter ByteString
salt ByteString
hash ([TYPE] -> RData)
-> StateT PState (Parser ByteString) [TYPE] -> SGet RData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> StateT PState (Parser ByteString) [TYPE]
getNsecTypes (Int
dend Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
tpos)
getRData TYPE
NSEC3PARAM Int
_ = Word8 -> Word8 -> Word16 -> ByteString -> RData
RD_NSEC3PARAM (Word8 -> Word8 -> Word16 -> ByteString -> RData)
-> StateT PState (Parser ByteString) Word8
-> StateT
PState (Parser ByteString) (Word8 -> Word16 -> ByteString -> RData)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT PState (Parser ByteString) Word8
decodeHashAlg
StateT
PState (Parser ByteString) (Word8 -> Word16 -> ByteString -> RData)
-> StateT PState (Parser ByteString) Word8
-> StateT
PState (Parser ByteString) (Word16 -> ByteString -> RData)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StateT PState (Parser ByteString) Word8
decodeFlags
StateT PState (Parser ByteString) (Word16 -> ByteString -> RData)
-> SGet Word16
-> StateT PState (Parser ByteString) (ByteString -> RData)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SGet Word16
decodeIterations
StateT PState (Parser ByteString) (ByteString -> RData)
-> StateT PState (Parser ByteString) ByteString -> SGet RData
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StateT PState (Parser ByteString) ByteString
decodeSalt
where
decodeHashAlg :: StateT PState (Parser ByteString) Word8
decodeHashAlg = StateT PState (Parser ByteString) Word8
get8
decodeFlags :: StateT PState (Parser ByteString) Word8
decodeFlags = StateT PState (Parser ByteString) Word8
get8
decodeIterations :: SGet Word16
decodeIterations = SGet Word16
get16
decodeSalt :: StateT PState (Parser ByteString) ByteString
decodeSalt = SGet Int
getInt8 SGet Int
-> (Int -> StateT PState (Parser ByteString) ByteString)
-> StateT PState (Parser ByteString) ByteString
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> StateT PState (Parser ByteString) ByteString
getNByteString
getRData TYPE
_ Int
len = ByteString -> RData
UnknownRData (ByteString -> RData)
-> StateT PState (Parser ByteString) ByteString -> SGet RData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> StateT PState (Parser ByteString) ByteString
getNByteString Int
len
getTXT :: Int -> SGet ByteString
getTXT :: Int -> StateT PState (Parser ByteString) ByteString
getTXT !Int
len = [ByteString] -> ByteString
B.concat ([ByteString] -> ByteString)
-> StateT PState (Parser ByteString) [ByteString]
-> StateT PState (Parser ByteString) ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char]
-> Int
-> StateT PState (Parser ByteString) ByteString
-> StateT PState (Parser ByteString) [ByteString]
forall a. [Char] -> Int -> SGet a -> SGet [a]
sGetMany [Char]
"TXT RR string" Int
len StateT PState (Parser ByteString) ByteString
getstring
where
getstring :: StateT PState (Parser ByteString) ByteString
getstring = SGet Int
getInt8 SGet Int
-> (Int -> StateT PState (Parser ByteString) ByteString)
-> StateT PState (Parser ByteString) ByteString
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> StateT PState (Parser ByteString) ByteString
getNByteString
getOpts :: Int -> SGet [OData]
getOpts :: Int -> StateT PState (Parser ByteString) [OData]
getOpts !Int
len = [Char]
-> Int -> SGet OData -> StateT PState (Parser ByteString) [OData]
forall a. [Char] -> Int -> SGet a -> SGet [a]
sGetMany [Char]
"EDNS option" Int
len SGet OData
getoption
where
getoption :: SGet OData
getoption = do
OptCode
code <- Word16 -> OptCode
toOptCode (Word16 -> OptCode)
-> SGet Word16 -> StateT PState (Parser ByteString) OptCode
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SGet Word16
get16
Int
olen <- SGet Int
getInt16
OptCode -> Int -> SGet OData
getOData OptCode
code Int
olen
getNsecTypes :: Int -> SGet [TYPE]
getNsecTypes :: Int -> StateT PState (Parser ByteString) [TYPE]
getNsecTypes !Int
len = [[TYPE]] -> [TYPE]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[TYPE]] -> [TYPE])
-> StateT PState (Parser ByteString) [[TYPE]]
-> StateT PState (Parser ByteString) [TYPE]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char]
-> Int
-> StateT PState (Parser ByteString) [TYPE]
-> StateT PState (Parser ByteString) [[TYPE]]
forall a. [Char] -> Int -> SGet a -> SGet [a]
sGetMany [Char]
"NSEC type bitmap" Int
len StateT PState (Parser ByteString) [TYPE]
getbits
where
getbits :: StateT PState (Parser ByteString) [TYPE]
getbits = do
Int
window <- (Int -> Int -> Int) -> Int -> Int -> Int
forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> Int -> Int
forall a. Bits a => a -> Int -> a
shiftL Int
8 (Int -> Int) -> SGet Int -> SGet Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SGet Int
getInt8
Int
blocks <- SGet Int
getInt8
Bool
-> StateT PState (Parser ByteString) ()
-> StateT PState (Parser ByteString) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
blocks Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
32) (StateT PState (Parser ByteString) ()
-> StateT PState (Parser ByteString) ())
-> StateT PState (Parser ByteString) ()
-> StateT PState (Parser ByteString) ()
forall a b. (a -> b) -> a -> b
$
[Char] -> StateT PState (Parser ByteString) ()
forall a. [Char] -> SGet a
failSGet ([Char] -> StateT PState (Parser ByteString) ())
-> [Char] -> StateT PState (Parser ByteString) ()
forall a b. (a -> b) -> a -> b
$ [Char]
"NSEC bitmap block too long: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
blocks
((Int, Int) -> [TYPE]) -> [(Int, Int)] -> [TYPE]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Int, Int) -> [TYPE]
forall {a}. (Bits a, Num a) => (Int, a) -> [TYPE]
blkTypes([(Int, Int)] -> [TYPE])
-> ([Int] -> [(Int, Int)]) -> [Int] -> [TYPE]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> [Int] -> [(Int, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
window, Int
window Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
8..] ([Int] -> [TYPE])
-> StateT PState (Parser ByteString) [Int]
-> StateT PState (Parser ByteString) [TYPE]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> StateT PState (Parser ByteString) [Int]
getNBytes Int
blocks
where
blkTypes :: (Int, a) -> [TYPE]
blkTypes (Int
bitOffset, a
byte) =
[ Word16 -> TYPE
toTYPE (Word16 -> TYPE) -> Word16 -> TYPE
forall a b. (a -> b) -> a -> b
$ Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word16) -> Int -> Word16
forall a b. (a -> b) -> a -> b
$ Int
bitOffset Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i |
Int
i <- [Int
0..Int
7], a
byte a -> a -> a
forall a. Bits a => a -> a -> a
.&. Int -> a
forall a. Bits a => Int -> a
bit (Int
7Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
i) a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
0 ]
getOData :: OptCode -> Int -> SGet OData
getOData :: OptCode -> Int -> SGet OData
getOData OptCode
NSID Int
len = ByteString -> OData
OD_NSID (ByteString -> OData)
-> StateT PState (Parser ByteString) ByteString -> SGet OData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> StateT PState (Parser ByteString) ByteString
getNByteString Int
len
getOData OptCode
DAU Int
len = [Word8] -> OData
OD_DAU ([Word8] -> OData)
-> StateT PState (Parser ByteString) [Word8] -> SGet OData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> StateT PState (Parser ByteString) [Word8]
getNoctets Int
len
getOData OptCode
DHU Int
len = [Word8] -> OData
OD_DHU ([Word8] -> OData)
-> StateT PState (Parser ByteString) [Word8] -> SGet OData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> StateT PState (Parser ByteString) [Word8]
getNoctets Int
len
getOData OptCode
N3U Int
len = [Word8] -> OData
OD_N3U ([Word8] -> OData)
-> StateT PState (Parser ByteString) [Word8] -> SGet OData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> StateT PState (Parser ByteString) [Word8]
getNoctets Int
len
getOData OptCode
ClientSubnet Int
len = do
Word16
family <- SGet Word16
get16
Word8
srcBits <- StateT PState (Parser ByteString) Word8
get8
Word8
scpBits <- StateT PState (Parser ByteString) Word8
get8
ByteString
addrbs <- Int -> StateT PState (Parser ByteString) ByteString
getNByteString (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
4)
case ByteString -> Int
BS.length ByteString
addrbs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== (Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
srcBits Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
7) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
8 of
Bool
True | Just IP
ip <- Word16 -> ByteString -> Word8 -> Word8 -> Maybe IP
bstoip Word16
family ByteString
addrbs Word8
srcBits Word8
scpBits
-> OData -> SGet OData
forall (f :: * -> *) a. Applicative f => a -> f a
pure (OData -> SGet OData) -> OData -> SGet OData
forall a b. (a -> b) -> a -> b
$ Word8 -> Word8 -> IP -> OData
OD_ClientSubnet Word8
srcBits Word8
scpBits IP
ip
Bool
_ -> OData -> SGet OData
forall (f :: * -> *) a. Applicative f => a -> f a
pure (OData -> SGet OData) -> OData -> SGet OData
forall a b. (a -> b) -> a -> b
$ Word16 -> Word8 -> Word8 -> ByteString -> OData
OD_ECSgeneric Word16
family Word8
srcBits Word8
scpBits ByteString
addrbs
where
prefix :: a -> a -> a
prefix a
addr a
bits = AddrRange a -> a
forall a. AddrRange a -> a
Data.IP.addr (AddrRange a -> a) -> AddrRange a -> a
forall a b. (a -> b) -> a -> b
$ a -> Int -> AddrRange a
forall a. Addr a => a -> Int -> AddrRange a
makeAddrRange a
addr (Int -> AddrRange a) -> Int -> AddrRange a
forall a b. (a -> b) -> a -> b
$ a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
bits
zeropad :: ByteString -> [Int]
zeropad = ([Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ Int -> [Int]
forall a. a -> [a]
repeat Int
0)([Int] -> [Int]) -> (ByteString -> [Int]) -> ByteString -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8 -> Int) -> [Word8] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral([Word8] -> [Int])
-> (ByteString -> [Word8]) -> ByteString -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Word8]
B.unpack
checkBits :: (t a -> t) -> (t -> a) -> p -> a -> t a -> Maybe a
checkBits t a -> t
fromBytes t -> a
toIP p
srcBits a
scpBits t a
bytes =
let addr :: t
addr = t a -> t
fromBytes t a
bytes
maskedAddr :: t
maskedAddr = t -> p -> t
forall {a} {a}. (Addr a, Integral a) => a -> a -> a
prefix t
addr p
srcBits
maxBits :: a
maxBits = Int -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> a) -> Int -> a
forall a b. (a -> b) -> a -> b
$ Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
* t a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length t a
bytes
in if t
addr t -> t -> Bool
forall a. Eq a => a -> a -> Bool
== t
maskedAddr Bool -> Bool -> Bool
&& a
scpBits a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
maxBits
then a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$ t -> a
toIP t
addr
else Maybe a
forall a. Maybe a
Nothing
bstoip :: Word16 -> B.ByteString -> Word8 -> Word8 -> Maybe IP
bstoip :: Word16 -> ByteString -> Word8 -> Word8 -> Maybe IP
bstoip Word16
family ByteString
bs Word8
srcBits Word8
scpBits = case Word16
family of
Word16
1 -> ([Int] -> IPv4)
-> (IPv4 -> IP) -> Word8 -> Word8 -> [Int] -> Maybe IP
forall {a} {t} {t :: * -> *} {p} {a} {a}.
(Ord a, Num a, Foldable t, Addr t, Integral p) =>
(t a -> t) -> (t -> a) -> p -> a -> t a -> Maybe a
checkBits [Int] -> IPv4
toIPv4 IPv4 -> IP
IPv4 Word8
srcBits Word8
scpBits ([Int] -> Maybe IP) -> [Int] -> Maybe IP
forall a b. (a -> b) -> a -> b
$ Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
take Int
4 ([Int] -> [Int]) -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
$ ByteString -> [Int]
zeropad ByteString
bs
Word16
2 -> ([Int] -> IPv6)
-> (IPv6 -> IP) -> Word8 -> Word8 -> [Int] -> Maybe IP
forall {a} {t} {t :: * -> *} {p} {a} {a}.
(Ord a, Num a, Foldable t, Addr t, Integral p) =>
(t a -> t) -> (t -> a) -> p -> a -> t a -> Maybe a
checkBits [Int] -> IPv6
toIPv6b IPv6 -> IP
IPv6 Word8
srcBits Word8
scpBits ([Int] -> Maybe IP) -> [Int] -> Maybe IP
forall a b. (a -> b) -> a -> b
$ Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
take Int
16 ([Int] -> [Int]) -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
$ ByteString -> [Int]
zeropad ByteString
bs
Word16
_ -> Maybe IP
forall a. Maybe a
Nothing
getOData OptCode
opc Int
len = Word16 -> ByteString -> OData
UnknownOData (OptCode -> Word16
fromOptCode OptCode
opc) (ByteString -> OData)
-> StateT PState (Parser ByteString) ByteString -> SGet OData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> StateT PState (Parser ByteString) ByteString
getNByteString Int
len
getDomain :: SGet Domain
getDomain :: StateT PState (Parser ByteString) ByteString
getDomain = SGet Int
getPosition SGet Int
-> (Int -> StateT PState (Parser ByteString) ByteString)
-> StateT PState (Parser ByteString) ByteString
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Word8 -> Int -> StateT PState (Parser ByteString) ByteString
getDomain' Word8
dot
getMailbox :: SGet Mailbox
getMailbox :: StateT PState (Parser ByteString) ByteString
getMailbox = SGet Int
getPosition SGet Int
-> (Int -> StateT PState (Parser ByteString) ByteString)
-> StateT PState (Parser ByteString) ByteString
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Word8 -> Int -> StateT PState (Parser ByteString) ByteString
getDomain' Word8
atsign
dot, atsign :: Word8
dot :: Word8
dot = Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8) -> Int -> Word8
forall a b. (a -> b) -> a -> b
$ Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
'.'
atsign :: Word8
atsign = Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8) -> Int -> Word8
forall a b. (a -> b) -> a -> b
$ Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
'@'
getDomain' :: Word8 -> Int -> SGet ByteString
getDomain' :: Word8 -> Int -> StateT PState (Parser ByteString) ByteString
getDomain' Word8
sep1 Int
ptrLimit = do
Int
pos <- SGet Int
getPosition
Int
c <- SGet Int
getInt8
let n :: Int
n = Int -> Int
forall {a}. (Bits a, Num a) => a -> a
getValue Int
c
Int -> Int -> Int -> StateT PState (Parser ByteString) ByteString
forall {a}.
(Num a, Bits a) =>
Int -> a -> Int -> StateT PState (Parser ByteString) ByteString
getdomain Int
pos Int
c Int
n
where
getdomain :: Int -> a -> Int -> StateT PState (Parser ByteString) ByteString
getdomain Int
pos a
c Int
n
| a
c a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
0 = ByteString -> StateT PState (Parser ByteString) ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
"."
| a -> Bool
forall {a}. Bits a => a -> Bool
isPointer a
c = do
Int
d <- SGet Int
getInt8
let offset :: Int
offset = Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
256 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
d
Bool
-> StateT PState (Parser ByteString) ()
-> StateT PState (Parser ByteString) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
offset Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
ptrLimit) (StateT PState (Parser ByteString) ()
-> StateT PState (Parser ByteString) ())
-> StateT PState (Parser ByteString) ()
-> StateT PState (Parser ByteString) ()
forall a b. (a -> b) -> a -> b
$
[Char] -> StateT PState (Parser ByteString) ()
forall a. [Char] -> SGet a
failSGet [Char]
"invalid name compression pointer"
Maybe ByteString
mo <- Int -> SGet (Maybe ByteString)
pop Int
offset
case Maybe ByteString
mo of
Maybe ByteString
Nothing -> do
ByteString
msg <- StateT PState (Parser ByteString) ByteString
getInput
let parser :: StateT PState (Parser ByteString) ByteString
parser = Int -> StateT PState (Parser ByteString) ()
skipNBytes Int
offset StateT PState (Parser ByteString) ()
-> StateT PState (Parser ByteString) ByteString
-> StateT PState (Parser ByteString) ByteString
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word8 -> Int -> StateT PState (Parser ByteString) ByteString
getDomain' Word8
sep1 Int
offset
case StateT PState (Parser ByteString) ByteString
-> ByteString -> Either DNSError (ByteString, PState)
forall a. SGet a -> ByteString -> Either DNSError (a, PState)
runSGet StateT PState (Parser ByteString) ByteString
parser ByteString
msg of
Left (DecodeError [Char]
err) -> [Char] -> StateT PState (Parser ByteString) ByteString
forall a. [Char] -> SGet a
failSGet [Char]
err
Left DNSError
err -> [Char] -> StateT PState (Parser ByteString) ByteString
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> StateT PState (Parser ByteString) ByteString)
-> [Char] -> StateT PState (Parser ByteString) ByteString
forall a b. (a -> b) -> a -> b
$ DNSError -> [Char]
forall a. Show a => a -> [Char]
show DNSError
err
Right (ByteString, PState)
o -> Int -> ByteString -> StateT PState (Parser ByteString) ()
push Int
pos ((ByteString, PState) -> ByteString
forall a b. (a, b) -> a
fst (ByteString, PState)
o) StateT PState (Parser ByteString) ()
-> StateT PState (Parser ByteString) ByteString
-> StateT PState (Parser ByteString) ByteString
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ByteString -> StateT PState (Parser ByteString) ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ((ByteString, PState) -> ByteString
forall a b. (a, b) -> a
fst (ByteString, PState)
o)
Just ByteString
o -> Int -> ByteString -> StateT PState (Parser ByteString) ()
push Int
pos ByteString
o StateT PState (Parser ByteString) ()
-> StateT PState (Parser ByteString) ByteString
-> StateT PState (Parser ByteString) ByteString
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ByteString -> StateT PState (Parser ByteString) ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
o
| a -> Bool
forall {a}. Bits a => a -> Bool
isExtLabel a
c = ByteString -> StateT PState (Parser ByteString) ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
""
| Bool
otherwise = do
ByteString
hs <- Word8 -> ByteString -> ByteString
unparseLabel Word8
sep1 (ByteString -> ByteString)
-> StateT PState (Parser ByteString) ByteString
-> StateT PState (Parser ByteString) ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> StateT PState (Parser ByteString) ByteString
getNByteString Int
n
ByteString
ds <- Word8 -> Int -> StateT PState (Parser ByteString) ByteString
getDomain' Word8
dot Int
ptrLimit
let dom :: ByteString
dom = case ByteString
ds of
ByteString
"." -> ByteString
hs ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"."
ByteString
_ -> ByteString
hs ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Word8 -> ByteString
B.singleton Word8
sep1 ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
ds
Int -> ByteString -> StateT PState (Parser ByteString) ()
push Int
pos ByteString
dom
ByteString -> StateT PState (Parser ByteString) ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
dom
getValue :: a -> a
getValue a
c = a
c a -> a -> a
forall a. Bits a => a -> a -> a
.&. a
0x3f
isPointer :: a -> Bool
isPointer a
c = a -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit a
c Int
7 Bool -> Bool -> Bool
&& a -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit a
c Int
6
isExtLabel :: a -> Bool
isExtLabel a
c = Bool -> Bool
not (a -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit a
c Int
7) Bool -> Bool -> Bool
&& a -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit a
c Int
6