{-# LANGUAGE OverloadedStrings #-}

module Network.DNS.Decode.Internal (
    getResponse
  , getDNSFlags
  , getHeader
  , getResourceRecord
  , getResourceRecords
  , getDomain
  , getMailbox
  ) where

import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as BS
import Data.IP (IP(..), toIPv4, toIPv6b)
import qualified Safe

import Network.DNS.Imports
import Network.DNS.StateBinary
import Network.DNS.Types

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

getResponse :: SGet DNSMessage
getResponse :: SGet DNSMessage
getResponse = do
    DNSHeader
hd <- SGet DNSHeader
getHeader
    Int
qdCount <- SGet Int
getInt16
    Int
anCount <- SGet Int
getInt16
    Int
nsCount <- SGet Int
getInt16
    Int
arCount <- SGet Int
getInt16
    DNSHeader
-> [Question]
-> [ResourceRecord]
-> [ResourceRecord]
-> [ResourceRecord]
-> DNSMessage
DNSMessage DNSHeader
hd ([Question]
 -> [ResourceRecord]
 -> [ResourceRecord]
 -> [ResourceRecord]
 -> DNSMessage)
-> StateT PState (Parser ByteString) [Question]
-> StateT
     PState
     (Parser ByteString)
     ([ResourceRecord]
      -> [ResourceRecord] -> [ResourceRecord] -> DNSMessage)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> StateT PState (Parser ByteString) [Question]
getQueries Int
qdCount
                  StateT
  PState
  (Parser ByteString)
  ([ResourceRecord]
   -> [ResourceRecord] -> [ResourceRecord] -> DNSMessage)
-> StateT PState (Parser ByteString) [ResourceRecord]
-> StateT
     PState
     (Parser ByteString)
     ([ResourceRecord] -> [ResourceRecord] -> DNSMessage)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> StateT PState (Parser ByteString) [ResourceRecord]
getResourceRecords Int
anCount
                  StateT
  PState
  (Parser ByteString)
  ([ResourceRecord] -> [ResourceRecord] -> DNSMessage)
-> StateT PState (Parser ByteString) [ResourceRecord]
-> StateT
     PState (Parser ByteString) ([ResourceRecord] -> DNSMessage)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> StateT PState (Parser ByteString) [ResourceRecord]
getResourceRecords Int
nsCount
                  StateT PState (Parser ByteString) ([ResourceRecord] -> DNSMessage)
-> StateT PState (Parser ByteString) [ResourceRecord]
-> SGet DNSMessage
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> StateT PState (Parser ByteString) [ResourceRecord]
getResourceRecords Int
arCount

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

getDNSFlags :: SGet DNSFlags
getDNSFlags :: SGet DNSFlags
getDNSFlags = do
    Word16
word <- SGet Word16
get16
    SGet DNSFlags
-> (DNSFlags -> SGet DNSFlags) -> Maybe DNSFlags -> SGet DNSFlags
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> SGet DNSFlags
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> SGet DNSFlags) -> String -> SGet DNSFlags
forall a b. (a -> b) -> a -> b
$ String
"Unsupported flags: 0x" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word16 -> String -> String
forall a. (Integral a, Show a) => a -> String -> String
showHex Word16
word String
"") DNSFlags -> SGet DNSFlags
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word16 -> Maybe DNSFlags
toFlags Word16
word)
  where
    toFlags :: Word16 -> Maybe DNSFlags
    toFlags :: Word16 -> Maybe DNSFlags
toFlags Word16
flgs = do
      OPCODE
oc <- Word16 -> Maybe OPCODE
forall a a. (Bounded a, Integral a, Bits a, Enum a) => a -> Maybe a
getOpcode Word16
flgs
      let rc :: RCODE
rc = Word16 -> RCODE
forall a. Integral a => a -> RCODE
getRcode Word16
flgs
      DNSFlags -> Maybe DNSFlags
forall (m :: * -> *) a. Monad m => a -> m a
return (DNSFlags -> Maybe DNSFlags) -> DNSFlags -> Maybe DNSFlags
forall a b. (a -> b) -> a -> b
$ QorR
-> OPCODE
-> Bool
-> Bool
-> Bool
-> Bool
-> RCODE
-> 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)
                        RCODE
rc
                        (Word16 -> Bool
forall a. Bits a => a -> Bool
getAuthenData Word16
flgs)
    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 :: a -> Maybe a
getOpcode a
w = Int -> Maybe a
forall a. (Enum a, Bounded a) => Int -> Maybe a
Safe.toEnumMay (a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a -> Int -> a
forall a. Bits a => a -> Int -> a
shiftR a
w Int
11 a -> a -> a
forall a. Bits a => a -> a -> a
.&. a
0x0f))
    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 :: a -> RCODE
getRcode a
w = Word16 -> RCODE
toRCODEforHeader (Word16 -> RCODE) -> Word16 -> RCODE
forall a b. (a -> b) -> a -> b
$ a -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
w
    getAuthenData :: a -> Bool
getAuthenData a
w = a -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit a
w Int
5

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

getHeader :: SGet DNSHeader
getHeader :: SGet DNSHeader
getHeader =
    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 -> StateT PState (Parser ByteString) [Question]
getQueries Int
n = Int
-> StateT PState (Parser ByteString) Question
-> StateT PState (Parser ByteString) [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

getOptCode :: SGet OptCode
getOptCode :: SGet OptCode
getOptCode = Word16 -> OptCode
toOptCode (Word16 -> OptCode) -> SGet Word16 -> SGet OptCode
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SGet Word16
get16

-- XXX: Include the class when implemented, or otherwise perhaps check the
-- implicit assumption that the class is classIN.
--
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
-> StateT PState (Parser ByteString) ()
-> StateT PState (Parser ByteString) Question
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<*  StateT PState (Parser ByteString) ()
ignoreClass

getResourceRecords :: Int -> SGet [ResourceRecord]
getResourceRecords :: Int -> StateT PState (Parser ByteString) [ResourceRecord]
getResourceRecords Int
n = Int
-> StateT PState (Parser ByteString) ResourceRecord
-> StateT PState (Parser ByteString) [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
decodeCLASS
    Word32
ttl <- SGet Word32
decodeTTL
    Int
len <- SGet Int
decodeRLen
    RData
dat <- 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 -> Word32 -> RData -> ResourceRecord
ResourceRecord ByteString
dom TYPE
typ Word16
cls Word32
ttl RData
dat
  where
    decodeCLASS :: SGet Word16
decodeCLASS = SGet Word16
get16
    decodeTTL :: SGet Word32
decodeTTL   = SGet Word32
get32
    decodeRLen :: SGet Int
decodeRLen  = SGet Int
getInt16

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
decodePreference 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
    decodePreference :: SGet Word16
decodePreference = SGet Word16
get16
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)
-> (ByteString -> ByteString) -> ByteString -> RData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
ignoreLength) (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
  where
    ignoreLength :: ByteString -> ByteString
ignoreLength = Int -> ByteString -> ByteString
BS.drop Int
1
getRData TYPE
A Int
len
  | Int
len Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
4  = (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
len
  | Bool
otherwise = String -> SGet RData
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"IPv4 addresses must be 4 bytes long"
getRData TYPE
AAAA Int
len
  | Int
len Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
16 = (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
len
  | Bool
otherwise = String -> SGet RData
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"IPv6 addresses must be 16 bytes long"
getRData TYPE
SOA Int
_ = ByteString
-> ByteString
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> RData
RD_SOA    (ByteString
 -> ByteString
 -> Word32
 -> Word32
 -> Word32
 -> Word32
 -> Word32
 -> RData)
-> StateT PState (Parser ByteString) ByteString
-> StateT
     PState
     (Parser ByteString)
     (ByteString
      -> Word32 -> Word32 -> Word32 -> Word32 -> Word32 -> RData)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT PState (Parser ByteString) ByteString
getDomain
                           StateT
  PState
  (Parser ByteString)
  (ByteString
   -> Word32 -> Word32 -> Word32 -> Word32 -> Word32 -> RData)
-> StateT PState (Parser ByteString) ByteString
-> StateT
     PState
     (Parser ByteString)
     (Word32 -> Word32 -> Word32 -> Word32 -> Word32 -> RData)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StateT PState (Parser ByteString) ByteString
getMailbox
                           StateT
  PState
  (Parser ByteString)
  (Word32 -> Word32 -> Word32 -> Word32 -> Word32 -> RData)
-> SGet Word32
-> StateT
     PState
     (Parser ByteString)
     (Word32 -> Word32 -> Word32 -> Word32 -> RData)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SGet Word32
decodeSerial
                           StateT
  PState
  (Parser ByteString)
  (Word32 -> Word32 -> Word32 -> Word32 -> RData)
-> SGet Word32
-> StateT
     PState (Parser ByteString) (Word32 -> Word32 -> Word32 -> RData)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SGet Word32
decodeRefesh
                           StateT
  PState (Parser ByteString) (Word32 -> Word32 -> Word32 -> RData)
-> SGet Word32
-> StateT PState (Parser ByteString) (Word32 -> Word32 -> RData)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SGet Word32
decodeRetry
                           StateT PState (Parser ByteString) (Word32 -> Word32 -> RData)
-> SGet Word32
-> StateT PState (Parser ByteString) (Word32 -> RData)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SGet Word32
decodeExpire
                           StateT PState (Parser ByteString) (Word32 -> RData)
-> SGet Word32 -> SGet RData
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SGet Word32
decodeMinimum
  where
    decodeSerial :: SGet Word32
decodeSerial  = SGet Word32
get32
    decodeRefesh :: SGet Word32
decodeRefesh  = SGet Word32
get32
    decodeRetry :: SGet Word32
decodeRetry   = SGet Word32
get32
    decodeExpire :: SGet Word32
decodeExpire  = SGet Word32
get32
    decodeMinimum :: SGet Word32
decodeMinimum = SGet Word32
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
ol = [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]
decode' Int
ol
  where
    decode' :: Int -> SGet [OData]
    decode' :: Int -> StateT PState (Parser ByteString) [OData]
decode' Int
l
        | Int
l  Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = String -> StateT PState (Parser ByteString) [OData]
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> StateT PState (Parser ByteString) [OData])
-> String -> StateT PState (Parser ByteString) [OData]
forall a b. (a -> b) -> a -> b
$ String
"decodeOPTData: length inconsistency (" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
l String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
        | Int
l Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = [OData] -> StateT PState (Parser ByteString) [OData]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
        | Bool
otherwise = do
            OptCode
optCode <- SGet OptCode
getOptCode
            Int
optLen <- SGet Int
getInt16
            OData
dat <- OptCode -> Int -> SGet OData
getOData OptCode
optCode Int
optLen
            (OData
datOData -> [OData] -> [OData]
forall a. a -> [a] -> [a]
:) ([OData] -> [OData])
-> StateT PState (Parser ByteString) [OData]
-> StateT PState (Parser ByteString) [OData]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> StateT PState (Parser ByteString) [OData]
decode' (Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
optLen Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
4)
--
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
NULL Int
len = RData -> ByteString -> RData
forall a b. a -> b -> a
const 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
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
NSEC3PARAM Int
len = 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       = do
        let n :: Int
n = Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
5
        Word8
slen <- StateT PState (Parser ByteString) Word8
get8
        Bool -> StateT PState (Parser ByteString) ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> StateT PState (Parser ByteString) ())
-> Bool -> StateT PState (Parser ByteString) ()
forall a b. (a -> b) -> a -> b
$ Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
slen Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
n
        if (Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0)
        then ByteString -> StateT PState (Parser ByteString) ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
B.empty
        else Int -> StateT PState (Parser ByteString) ByteString
getNByteString Int
n
--
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

getOData :: OptCode -> Int -> SGet OData
getOData :: OptCode -> Int -> SGet OData
getOData OptCode
ClientSubnet Int
len = do
        Int
fam <- SGet Int
getInt16
        Word8
srcMask <- StateT PState (Parser ByteString) Word8
get8
        Word8
scpMask <- StateT PState (Parser ByteString) Word8
get8
        [Int]
rawip <- (Word8 -> Int) -> [Word8] -> [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap 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 (ByteString -> [Int])
-> StateT PState (Parser ByteString) ByteString
-> StateT PState (Parser ByteString) [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> StateT PState (Parser ByteString) ByteString
getNByteString (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
4) -- 4 = 2 + 1 + 1
        IP
ip <- case Int
fam of
                    Int
1 -> IP -> StateT PState (Parser ByteString) IP
forall (f :: * -> *) a. Applicative f => a -> f a
pure (IP -> StateT PState (Parser ByteString) IP)
-> ([Int] -> IP) -> [Int] -> StateT PState (Parser ByteString) IP
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IPv4 -> IP
IPv4 (IPv4 -> IP) -> ([Int] -> IPv4) -> [Int] -> IP
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> IPv4
toIPv4 ([Int] -> StateT PState (Parser ByteString) IP)
-> [Int] -> StateT PState (Parser ByteString) IP
forall a b. (a -> b) -> a -> b
$ Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
take Int
4 ([Int]
rawip [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ Int -> [Int]
forall a. a -> [a]
repeat Int
0)
                    Int
2 -> IP -> StateT PState (Parser ByteString) IP
forall (f :: * -> *) a. Applicative f => a -> f a
pure (IP -> StateT PState (Parser ByteString) IP)
-> ([Int] -> IP) -> [Int] -> StateT PState (Parser ByteString) IP
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IPv6 -> IP
IPv6 (IPv6 -> IP) -> ([Int] -> IPv6) -> [Int] -> IP
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> IPv6
toIPv6b ([Int] -> StateT PState (Parser ByteString) IP)
-> [Int] -> StateT PState (Parser ByteString) IP
forall a b. (a -> b) -> a -> b
$ Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
take Int
16 ([Int]
rawip [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ Int -> [Int]
forall a. a -> [a]
repeat Int
0)
                    Int
_ -> String -> StateT PState (Parser ByteString) IP
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Unsupported address family"
        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
srcMask Word8
scpMask IP
ip
getOData OptCode
opc Int
len = OptCode -> ByteString -> OData
UnknownOData 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 = do
    Int
lim <- ByteString -> Int
B.length (ByteString -> Int)
-> StateT PState (Parser ByteString) ByteString -> SGet Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT PState (Parser ByteString) ByteString
getInput
    Char -> Int -> Int -> StateT PState (Parser ByteString) ByteString
getDomain' Char
'.' Int
lim Int
0

getMailbox :: SGet Mailbox
getMailbox :: StateT PState (Parser ByteString) ByteString
getMailbox = do
    Int
lim <- ByteString -> Int
B.length (ByteString -> Int)
-> StateT PState (Parser ByteString) ByteString -> SGet Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT PState (Parser ByteString) ByteString
getInput
    Char -> Int -> Int -> StateT PState (Parser ByteString) ByteString
getDomain' Char
'@' Int
lim Int
0

-- | Get a domain name, using sep1 as the separate between the 1st and 2nd
-- label.  Subsequent labels (and always the trailing label) are terminated
-- with a ".".
getDomain' :: Char -> Int -> Int -> SGet ByteString
getDomain' :: Char -> Int -> Int -> StateT PState (Parser ByteString) ByteString
getDomain' Char
sep1 Int
lim Int
loopcnt
  -- 127 is the logical limitation of pointers.
  | Int
loopcnt Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
127 = String -> StateT PState (Parser ByteString) ByteString
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"pointer recursion limit exceeded"
  | Bool
otherwise      = 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
"." -- Perhaps the root domain?
      | 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
lim) (StateT PState (Parser ByteString) ()
 -> StateT PState (Parser ByteString) ())
-> StateT PState (Parser ByteString) ()
-> StateT PState (Parser ByteString) ()
forall a b. (a -> b) -> a -> b
$ String -> StateT PState (Parser ByteString) ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"pointer is too large"
          Maybe ByteString
mo <- Int -> SGet (Maybe ByteString)
pop Int
offset
          case Maybe ByteString
mo of
              Maybe ByteString
Nothing -> do
                  ByteString
target <- Int -> ByteString -> ByteString
B.drop Int
offset (ByteString -> ByteString)
-> StateT PState (Parser ByteString) ByteString
-> StateT PState (Parser ByteString) ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT PState (Parser ByteString) ByteString
getInput
                  case StateT PState (Parser ByteString) ByteString
-> ByteString -> Either DNSError (ByteString, PState)
forall a. SGet a -> ByteString -> Either DNSError (a, PState)
runSGet (Char -> Int -> Int -> StateT PState (Parser ByteString) ByteString
getDomain' Char
sep1 Int
lim (Int
loopcnt Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)) ByteString
target of
                        Left (DecodeError String
err) -> String -> StateT PState (Parser ByteString) ByteString
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
err
                        Left DNSError
err               -> String -> StateT PState (Parser ByteString) ByteString
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> StateT PState (Parser ByteString) ByteString)
-> String -> StateT PState (Parser ByteString) ByteString
forall a b. (a -> b) -> a -> b
$ DNSError -> String
forall a. Show a => a -> String
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
      -- As for now, extended labels have no use.
      -- This may change some time in the future.
      | 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 <- Int -> StateT PState (Parser ByteString) ByteString
getNByteString Int
n
          ByteString
ds <- Char -> Int -> Int -> StateT PState (Parser ByteString) ByteString
getDomain' Char
'.' Int
lim (Int
loopcnt Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
          let dom :: ByteString
dom = case ByteString
ds of -- avoid trailing ".."
                  ByteString
"." -> ByteString
hs ByteString -> ByteString -> ByteString
`BS.append` ByteString
"."
                  ByteString
_   -> ByteString
hs ByteString -> ByteString -> ByteString
`BS.append` Char -> ByteString
BS.singleton Char
sep1 ByteString -> ByteString -> ByteString
`BS.append` 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

ignoreClass :: SGet ()
ignoreClass :: StateT PState (Parser ByteString) ()
ignoreClass = () () -> SGet Word16 -> StateT PState (Parser ByteString) ()
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ SGet Word16
get16