X-Git-Url: http://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;f=Network%2FDNS%2FMessage.hs;h=ab1a15426430bb9b7d559561562a1e5fc4b35af8;hb=2afb9d8072fdf52e9ed100027cf97aad8b9abd8d;hp=e6aaaa5e2af26fd3671fc812844148f562adb827;hpb=a828c881514494f1718a812301f1883f15a72870;p=haskell-dns.git diff --git a/Network/DNS/Message.hs b/Network/DNS/Message.hs index e6aaaa5..ab1a154 100644 --- a/Network/DNS/Message.hs +++ b/Network/DNS/Message.hs @@ -10,36 +10,56 @@ module Network.DNS.Message , DomainName , DomainLabel , TTL - , SomeRR(..) - , RecordType(..) + , RecordType , RecordClass(..) + , SOAFields(..) + + , SomeQT + , SomeRR + , SomeRT + + , A(..) + , NS(..) + , MD(..) + , MF(..) , CNAME(..) + , SOA(..) + , MB(..) + , MG(..) + , MR(..) + , NULL(..) + , PTR(..) , HINFO(..) + , MINFO(..) + , MX(..) + , TXT(..) + + , mkDomainName + , wrapQueryType + , wrapRecordType + , wrapRecord ) where +import Control.Exception import Control.Monad import Data.Binary import Data.Binary.BitPut as BP import Data.Binary.Get as G -import Data.Binary.Put as P +import Data.Binary.Put as P' import Data.Binary.Strict.BitGet as BG import qualified Data.ByteString as BS -import qualified Data.ByteString.Lazy as LBS +import qualified Data.ByteString.Char8 as C8 hiding (ByteString) import Data.Typeable import qualified Data.IntMap as IM import Data.IntMap (IntMap) +import qualified Data.Map as M +import Data.Map (Map) import Data.Word - - -replicateM' :: Monad m => Int -> (a -> m (b, a)) -> a -> m ([b], a) -replicateM' = worker [] - where - worker :: Monad m => [b] -> Int -> (a -> m (b, a)) -> a -> m ([b], a) - worker soFar 0 _ a = return (reverse soFar, a) - worker soFar n f a = do (b, a') <- f a - worker (b : soFar) (n - 1) f a' +import Network.DNS.Packer as P +import Network.DNS.Unpacker as U +import Network.Socket data Message @@ -50,6 +70,7 @@ data Message , msgAuthorities :: ![SomeRR] , msgAdditionals :: ![SomeRR] } + deriving (Show, Eq) data Header = Header { @@ -68,6 +89,7 @@ data Header -- + NSCOUNT -- + ARCOUNT } + deriving (Show, Eq) type MessageID = Word16 @@ -94,31 +116,59 @@ data ResponseCode data Question = Question { qName :: !DomainName - , qType :: !RecordType + , qType :: !SomeQT , qClass :: !RecordClass } deriving (Show, Eq) -putQ :: Question -> Put +type SomeQT = SomeRT + +putQ :: Question -> Packer CompTable () putQ q = do putDomainName $ qName q - put $ qType q - put $ qClass q - -getQ :: DecompTable -> Get (Question, DecompTable) -getQ dt - = do (nm, dt') <- getDomainName dt - ty <- get - cl <- get - let q = Question { - qName = nm - , qType = ty - , qClass = cl - } - return (q, dt') - -type DomainName = [DomainLabel] -type DomainLabel = BS.ByteString + putSomeRT $ qType q + putBinary $ qClass q + +getQ :: Unpacker DecompTable Question +getQ = do nm <- getDomainName + ty <- getSomeRT + cl <- getBinary + return Question { + qName = nm + , qType = ty + , qClass = cl + } + + +newtype DomainName = DN [DomainLabel] deriving (Eq, Show, Ord, Typeable) +type DomainLabel = BS.ByteString + +rootName :: DomainName +rootName = DN [BS.empty] + +isRootName :: DomainName -> Bool +isRootName (DN [_]) = True +isRootName _ = False + +consLabel :: DomainLabel -> DomainName -> DomainName +consLabel x (DN ys) = DN (x:ys) + +unconsLabel :: DomainName -> (DomainLabel, DomainName) +unconsLabel (DN (x:xs)) = (x, DN xs) +unconsLabel x = error ("Illegal use of unconsLabel: " ++ show x) + +mkDomainName :: String -> DomainName +mkDomainName = DN . mkLabels [] . notEmpty + where + notEmpty :: String -> String + notEmpty xs = assert (not $ null xs) xs + + mkLabels :: [DomainLabel] -> String -> [DomainLabel] + mkLabels soFar [] = reverse (C8.empty : soFar) + mkLabels soFar xs = case break (== '.') xs of + (l, ('.':rest)) + -> mkLabels (C8.pack l : soFar) rest + _ -> error ("Illegal domain name: " ++ xs) data RecordClass = IN @@ -128,142 +178,355 @@ data RecordClass | AnyClass -- Only for queries deriving (Show, Eq) -class (Typeable rr, Show rr, Eq rr) => ResourceRecord rr where - rrName :: rr -> DomainName - rrType :: rr -> RecordType - rrClass :: rr -> RecordClass - rrTTL :: rr -> TTL - rrPutData :: rr -> Put - rrGetData :: DecompTable -> DomainName -> RecordClass -> TTL -> Get (rr, DecompTable) - toRR :: rr -> SomeRR - fromRR :: SomeRR -> Maybe rr - - toRR rr = SomeRR rr - fromRR (SomeRR rr') = cast rr' - -putRR :: ResourceRecord rr => rr -> Put -putRR rr = do putDomainName $ rrName rr - put $ rrType rr - put $ rrClass rr - putWord32be $ rrTTL rr - - let dat = runPut $ rrPutData rr - putWord16be $ fromIntegral $ LBS.length dat - putLazyByteString dat - -getRR :: DecompTable -> Get (SomeRR, DecompTable) -getRR dt - = do (nm, dt') <- getDomainName dt - ty <- get - cl <- get - ttl <- G.getWord32be - case ty of - CNAME -> do (rr, dt'') <- rrGetData dt' nm cl ttl - return (toRR (rr :: CNAME), dt'') - HINFO -> do (rr, dt'') <- rrGetData dt' nm cl ttl - return (toRR (rr :: HINFO), dt'') - AXFR -> onlyForQuestions "AXFR" - MAILB -> onlyForQuestions "MAILB" - MAILA -> onlyForQuestions "MAILA" - AnyType -> onlyForQuestions "ANY" - where - onlyForQuestions name - = fail (name ++ " is only for questions, not an actual resource record.") - -data SomeRR = forall rr. ResourceRecord rr => SomeRR rr - deriving Typeable -instance ResourceRecord SomeRR where - rrName (SomeRR rr) = rrName rr - rrType (SomeRR rr) = rrType rr - rrClass (SomeRR rr) = rrClass rr - rrTTL (SomeRR rr) = rrTTL rr - rrPutData (SomeRR rr) = rrPutData rr - rrGetData _ _ _ _ = fail "SomeRR can't directly be constructed." - toRR = id - fromRR = Just -instance Eq SomeRR where - (SomeRR a) == (SomeRR b) = Just a == cast b + +data RecordType rt dt => ResourceRecord rt dt + = ResourceRecord { + rrName :: !DomainName + , rrType :: !rt + , rrClass :: !RecordClass + , rrTTL :: !TTL + , rrData :: !dt + } + deriving (Show, Eq, Typeable) + + +data SomeRR = forall rt dt. RecordType rt dt => SomeRR (ResourceRecord rt dt) + instance Show SomeRR where show (SomeRR rr) = show rr -type DecompTable = IntMap BS.ByteString -type TTL = Word32 - -data CNAME = CNAME' !DomainName !RecordClass !TTL !DomainName - deriving (Eq, Show, Typeable) -instance ResourceRecord CNAME where - rrName (CNAME' n _ _ _) = n - rrType _ = CNAME - rrClass (CNAME' _ c _ _) = c - rrTTL (CNAME' _ _ t _) = t - rrGetData dt n c t = do (d, dt') <- getDomainName dt - return (CNAME' n c t d, dt') - rrPutData (CNAME' _ _ _ d) = putDomainName d - -data HINFO = HINFO' !DomainName !RecordClass !TTL !BS.ByteString !BS.ByteString - deriving (Eq, Show, Typeable) -instance ResourceRecord HINFO where - rrName (HINFO' n _ _ _ _) = n - rrType _ = HINFO - rrClass (HINFO' _ c _ _ _) = c - rrTTL (HINFO' _ _ t _ _) = t - rrGetData dt n c t = do cpu <- getCharString - os <- getCharString - return (HINFO' n c t cpu os, dt) - rrPutData (HINFO' _ _ _ c o) = do putCharString c - putCharString o - -getDomainName :: DecompTable -> Get (DomainName, DecompTable) -getDomainName = flip worker [] +instance Eq SomeRR where + (SomeRR a) == (SomeRR b) = Just a == cast b + + +putSomeRR :: SomeRR -> Packer CompTable () +putSomeRR (SomeRR rr) = putResourceRecord rr + +getSomeRR :: Unpacker DecompTable SomeRR +getSomeRR = do srt <- U.lookAhead $ + do getDomainName -- skip + getSomeRT + case srt of + SomeRT rt + -> getResourceRecord rt >>= return . SomeRR + +type CompTable = Map DomainName Int +type DecompTable = IntMap DomainName +type TTL = Word32 + +getDomainName :: Unpacker DecompTable DomainName +getDomainName = worker where - worker :: DecompTable -> [DomainLabel] -> Get ([DomainLabel], DecompTable) - worker dt soFar - = do (l, dt') <- getDomainLabel dt - case BS.null l of - True -> return (reverse (l : soFar), dt') - False -> worker dt' (l : soFar) - -getDomainLabel :: DecompTable -> Get (DomainLabel, DecompTable) -getDomainLabel dt - = do header <- getByteString 1 - let Right h - = runBitGet header $ - do a <- getBit - b <- getBit - n <- liftM fromIntegral (getAsWord8 6) - case (a, b) of - ( True, True) -> return $ Offset n - (False, False) -> return $ Length n - _ -> fail "Illegal label header" - case h of - Offset n - -> do let Just l = IM.lookup n dt - return (l, dt) - Length n - -> do offset <- liftM fromIntegral bytesRead - label <- getByteString n - let dt' = IM.insert offset label dt - return (label, dt') - -getCharString :: Get BS.ByteString -getCharString = do len <- G.getWord8 - getByteString (fromIntegral len) - -putCharString :: BS.ByteString -> Put -putCharString = putDomainLabel + worker :: Unpacker DecompTable DomainName + worker + = do offset <- U.bytesRead + hdr <- getLabelHeader + case hdr of + Offset n + -> do dt <- U.getState + case IM.lookup n dt of + Just name + -> return name + Nothing + -> fail ("Illegal offset of label pointer: " ++ show (n, dt)) + Length 0 + -> return rootName + Length n + -> do label <- U.getByteString n + rest <- worker + let name = consLabel label rest + U.modifyState $ IM.insert offset name + return name + + getLabelHeader :: Unpacker s LabelHeader + getLabelHeader + = do header <- U.lookAhead $ U.getByteString 1 + let Right h + = runBitGet header $ + do a <- getBit + b <- getBit + n <- liftM fromIntegral (getAsWord8 6) + case (a, b) of + ( True, True) -> return $ Offset n + (False, False) -> return $ Length n + _ -> fail "Illegal label header" + case h of + Offset _ + -> do header' <- U.getByteString 2 -- Pointers have 2 octets. + let Right h' + = runBitGet header' $ + do BG.skip 2 + n <- liftM fromIntegral (getAsWord16 14) + return $ Offset n + return h' + len@(Length _) + -> do U.skip 1 + return len + + +getCharString :: Unpacker s BS.ByteString +getCharString = do len <- U.getWord8 + U.getByteString (fromIntegral len) + +putCharString :: BS.ByteString -> Packer s () +putCharString xs = do P.putWord8 $ fromIntegral $ BS.length xs + P.putByteString xs data LabelHeader = Offset !Int | Length !Int -putDomainName :: DomainName -> Put -putDomainName = mapM_ putDomainLabel +putDomainName :: DomainName -> Packer CompTable () +putDomainName name + = do ct <- P.getState + case M.lookup name ct of + Just n + -> do let ptr = runBitPut $ + do putBit True + putBit True + putNBits 14 n + P.putLazyByteString ptr + Nothing + -> do offset <- bytesWrote + P.modifyState $ M.insert name offset + + let (label, rest) = unconsLabel name + + putCharString label + + if isRootName rest then + P.putWord8 0 + else + putDomainName rest + + +class (Show rt, Show dt, Eq rt, Eq dt, Typeable rt, Typeable dt) => RecordType rt dt | rt -> dt where + rtToInt :: rt -> Int + putRecordData :: rt -> dt -> Packer CompTable () + getRecordData :: rt -> Unpacker DecompTable dt + + putRecordType :: rt -> Packer s () + putRecordType = P.putWord16be . fromIntegral . rtToInt + + putRecordDataWithLength :: rt -> dt -> Packer CompTable () + putRecordDataWithLength rt dt + = do -- First, write a dummy data length. + offset <- bytesWrote + P.putWord16be 0 + + -- Second, write data. + putRecordData rt dt + + -- Third, rewrite the dummy length to an actual value. + offset' <- bytesWrote + withOffset offset + $ P.putWord16be (fromIntegral (offset' - offset - 2)) + + putResourceRecord :: ResourceRecord rt dt -> Packer CompTable () + putResourceRecord rr + = do putDomainName $ rrName rr + putRecordType $ rrType rr + putBinary $ rrClass rr + P.putWord32be $ rrTTL rr + putRecordDataWithLength (rrType rr) (rrData rr) + + getRecordDataWithLength :: rt -> Unpacker DecompTable dt + getRecordDataWithLength rt + = do len <- U.getWord16be + offset <- U.bytesRead + dat <- getRecordData rt + offset' <- U.bytesRead + + let consumed = offset' - offset + when (consumed /= len) + $ fail ("getRecordData " ++ show rt ++ " consumed " ++ show consumed ++ + " bytes but it had to consume " ++ show len ++ " bytes") + + return dat + + getResourceRecord :: rt -> Unpacker DecompTable (ResourceRecord rt dt) + getResourceRecord rt + = do name <- getDomainName + U.skip 2 -- record type + cl <- getBinary + ttl <- U.getWord32be + dat <- getRecordDataWithLength rt + return $ ResourceRecord { + rrName = name + , rrType = rt + , rrClass = cl + , rrTTL = ttl + , rrData = dat + } -putDomainLabel :: DomainLabel -> Put -putDomainLabel l - = do putWord8 $ fromIntegral $ BS.length l - P.putByteString l +data SomeRT = forall rt dt. RecordType rt dt => SomeRT rt + +instance Show SomeRT where + show (SomeRT rt) = show rt + +instance Eq SomeRT where + (SomeRT a) == (SomeRT b) = Just a == cast b + +putSomeRT :: SomeRT -> Packer s () +putSomeRT (SomeRT rt) = putRecordType rt + +getSomeRT :: Unpacker s SomeRT +getSomeRT = do n <- liftM fromIntegral U.getWord16be + case IM.lookup n defaultRTTable of + Nothing + -> fail ("Unknown resource record type: " ++ show n) + Just srt + -> return srt + +data SOAFields + = SOAFields { + soaMasterNameServer :: !DomainName + , soaResponsibleMailbox :: !DomainName + , soaSerialNumber :: !Word32 + , soaRefreshInterval :: !Word32 + , soaRetryInterval :: !Word32 + , soaExpirationLimit :: !Word32 + , soaMinimumTTL :: !Word32 + } + deriving (Show, Eq, Typeable) + +data A = A deriving (Show, Eq, Typeable) +instance RecordType A HostAddress where + rtToInt _ = 1 + putRecordData _ = P.putWord32be + getRecordData _ = U.getWord32be + +data NS = NS deriving (Show, Eq, Typeable) +instance RecordType NS DomainName where + rtToInt _ = 2 + putRecordData _ = putDomainName + getRecordData _ = getDomainName + +data MD = MD deriving (Show, Eq, Typeable) +instance RecordType MD DomainName where + rtToInt _ = 3 + putRecordData _ = putDomainName + getRecordData _ = getDomainName + +data MF = MF deriving (Show, Eq, Typeable) +instance RecordType MF DomainName where + rtToInt _ = 4 + putRecordData _ = putDomainName + getRecordData _ = getDomainName + +data CNAME = CNAME deriving (Show, Eq, Typeable) +instance RecordType CNAME DomainName where + rtToInt _ = 5 + putRecordData _ = putDomainName + getRecordData _ = getDomainName + +data SOA = SOA deriving (Show, Eq, Typeable) +instance RecordType SOA SOAFields where + rtToInt _ = 6 + putRecordData _ = \ soa -> + do putDomainName $ soaMasterNameServer soa + putDomainName $ soaResponsibleMailbox soa + P.putWord32be $ soaSerialNumber soa + P.putWord32be $ soaRefreshInterval soa + P.putWord32be $ soaRetryInterval soa + P.putWord32be $ soaExpirationLimit soa + P.putWord32be $ soaMinimumTTL soa + getRecordData _ = do master <- getDomainName + mail <- getDomainName + serial <- U.getWord32be + refresh <- U.getWord32be + retry <- U.getWord32be + expire <- U.getWord32be + ttl <- U.getWord32be + return SOAFields { + soaMasterNameServer = master + , soaResponsibleMailbox = mail + , soaSerialNumber = serial + , soaRefreshInterval = refresh + , soaRetryInterval = retry + , soaExpirationLimit = expire + , soaMinimumTTL = ttl + } + +data MB = MB deriving (Show, Eq, Typeable) +instance RecordType MB DomainName where + rtToInt _ = 7 + putRecordData _ = putDomainName + getRecordData _ = getDomainName + +data MG = MG deriving (Show, Eq, Typeable) +instance RecordType MG DomainName where + rtToInt _ = 8 + putRecordData _ = putDomainName + getRecordData _ = getDomainName + +data MR = MR deriving (Show, Eq, Typeable) +instance RecordType MR DomainName where + rtToInt _ = 9 + putRecordData _ = putDomainName + getRecordData _ = getDomainName + +data NULL = NULL deriving (Show, Eq, Typeable) +instance RecordType NULL BS.ByteString where + rtToInt _ = 10 + putRecordData _ _ = fail "putRecordData NULL can't be defined" + getRecordData _ = fail "getRecordData NULL can't be defined" + putRecordDataWithLength _ = \ dat -> + do P.putWord16be $ fromIntegral $ BS.length dat + P.putByteString dat + getRecordDataWithLength _ = do len <- U.getWord16be + U.getByteString $ fromIntegral len + +data PTR = PTR deriving (Show, Eq, Typeable) +instance RecordType PTR DomainName where + rtToInt _ = 12 + putRecordData _ = putDomainName + getRecordData _ = getDomainName + +data HINFO = HINFO deriving (Show, Eq, Typeable) +instance RecordType HINFO (BS.ByteString, BS.ByteString) where + rtToInt _ = 13 + putRecordData _ = \ (cpu, os) -> + do putCharString cpu + putCharString os + getRecordData _ = do cpu <- getCharString + os <- getCharString + return (cpu, os) + +data MINFO = MINFO deriving (Show, Eq, Typeable) +instance RecordType MINFO (DomainName, DomainName) where + rtToInt _ = 14 + putRecordData _ = \ (r, e) -> + do putDomainName r + putDomainName e + getRecordData _ = do r <- getDomainName + e <- getDomainName + return (r, e) + +data MX = MX deriving (Show, Eq, Typeable) +instance RecordType MX (Word16, DomainName) where + rtToInt _ = 15 + putRecordData _ = \ (pref, exch) -> + do P.putWord16be pref + putDomainName exch + getRecordData _ = do pref <- U.getWord16be + exch <- getDomainName + return (pref, exch) + +data TXT = TXT deriving (Show, Eq, Typeable) +instance RecordType TXT [BS.ByteString] where + rtToInt _ = 16 + putRecordData _ = mapM_ putCharString + getRecordData _ = fail "getRecordData TXT can't be defined" + + getRecordDataWithLength _ = U.getWord16be >>= worker [] . fromIntegral + where + worker :: [BS.ByteString] -> Int -> Unpacker s [BS.ByteString] + worker soFar 0 = return (reverse soFar) + worker soFar n = do str <- getCharString + worker (str : soFar) (0 `max` n - 1 - BS.length str) +{- data RecordType = A | NS @@ -288,27 +551,30 @@ data RecordType | MAILA -- Obsolete | AnyType deriving (Show, Eq) +-} instance Binary Message where - put m = do put $ msgHeader m - putWord16be $ fromIntegral $ length $ msgQuestions m - putWord16be $ fromIntegral $ length $ msgAnswers m - putWord16be $ fromIntegral $ length $ msgAuthorities m - putWord16be $ fromIntegral $ length $ msgAdditionals m - mapM_ putQ $ msgQuestions m - mapM_ putRR $ msgAnswers m - mapM_ putRR $ msgAuthorities m - mapM_ putRR $ msgAdditionals m - - get = do hdr <- get - nQ <- liftM fromIntegral G.getWord16be - nAns <- liftM fromIntegral G.getWord16be - nAth <- liftM fromIntegral G.getWord16be - nAdd <- liftM fromIntegral G.getWord16be - (qs , dt1) <- replicateM' nQ getQ IM.empty - (anss, dt2) <- replicateM' nAns getRR dt1 - (aths, dt3) <- replicateM' nAth getRR dt2 - (adds, _ ) <- replicateM' nAdd getRR dt3 + put m = P.liftToBinary M.empty $ + do putBinary $ msgHeader m + P.putWord16be $ fromIntegral $ length $ msgQuestions m + P.putWord16be $ fromIntegral $ length $ msgAnswers m + P.putWord16be $ fromIntegral $ length $ msgAuthorities m + P.putWord16be $ fromIntegral $ length $ msgAdditionals m + mapM_ putQ $ msgQuestions m + mapM_ putSomeRR $ msgAnswers m + mapM_ putSomeRR $ msgAuthorities m + mapM_ putSomeRR $ msgAdditionals m + + get = U.liftToBinary IM.empty $ + do hdr <- getBinary + nQ <- liftM fromIntegral U.getWord16be + nAns <- liftM fromIntegral U.getWord16be + nAth <- liftM fromIntegral U.getWord16be + nAdd <- liftM fromIntegral U.getWord16be + qs <- replicateM nQ getQ + anss <- replicateM nAns getSomeRR + aths <- replicateM nAth getSomeRR + adds <- replicateM nAdd getSomeRR return Message { msgHeader = hdr , msgQuestions = qs @@ -318,8 +584,8 @@ instance Binary Message where } instance Binary Header where - put h = do putWord16be $ hdMessageID h - putLazyByteString flags + put h = do P'.putWord16be $ hdMessageID h + P'.putLazyByteString flags where flags = runBitPut $ do putNBits 1 $ fromEnum $ hdMessageType h @@ -332,7 +598,7 @@ instance Binary Header where putNBits 4 $ fromEnum $ hdResponseCode h get = do mID <- G.getWord16be - flags <- getByteString 2 + flags <- G.getByteString 2 let Right hd = runBitGet flags $ do qr <- liftM (toEnum . fromIntegral) $ getAsWord8 1 @@ -389,49 +655,29 @@ instance Enum ResponseCode where toEnum 5 = Refused toEnum _ = undefined +{- instance Enum RecordType where - fromEnum A = 1 - fromEnum NS = 2 - fromEnum MD = 3 - fromEnum MF = 4 - fromEnum CNAME = 5 - fromEnum SOA = 6 - fromEnum MB = 7 - fromEnum MG = 8 - fromEnum MR = 9 - fromEnum NULL = 10 + fromEnum A = 1 / + fromEnum NS = 2 / + fromEnum MD = 3 / + fromEnum MF = 4 / + fromEnum CNAME = 5 / + fromEnum SOA = 6 / + fromEnum MB = 7 / + fromEnum MG = 8 / + fromEnum MR = 9 / + fromEnum NULL = 10 / fromEnum WKS = 11 - fromEnum PTR = 12 - fromEnum HINFO = 13 - fromEnum MINFO = 14 - fromEnum MX = 15 - fromEnum TXT = 16 + fromEnum PTR = 12 / + fromEnum HINFO = 13 / + fromEnum MINFO = 14 / + fromEnum MX = 15 / + fromEnum TXT = 16 / fromEnum AXFR = 252 fromEnum MAILB = 253 fromEnum MAILA = 254 fromEnum AnyType = 255 - - toEnum 1 = A - toEnum 2 = NS - toEnum 3 = MD - toEnum 4 = MF - toEnum 5 = CNAME - toEnum 6 = SOA - toEnum 7 = MB - toEnum 8 = MG - toEnum 9 = MR - toEnum 10 = NULL - toEnum 11 = WKS - toEnum 12 = PTR - toEnum 13 = HINFO - toEnum 14 = MINFO - toEnum 15 = MX - toEnum 16 = TXT - toEnum 252 = AXFR - toEnum 253 = MAILB - toEnum 254 = MAILA - toEnum 255 = AnyType - toEnum _ = undefined +-} instance Enum RecordClass where fromEnum IN = 1 @@ -447,10 +693,28 @@ instance Enum RecordClass where toEnum 255 = AnyClass toEnum _ = undefined -instance Binary RecordType where - get = liftM (toEnum . fromIntegral) G.getWord16be - put = putWord16be . fromIntegral . fromEnum - instance Binary RecordClass where get = liftM (toEnum . fromIntegral) G.getWord16be - put = putWord16be . fromIntegral . fromEnum \ No newline at end of file + put = P'.putWord16be . fromIntegral . fromEnum + + +defaultRTTable :: IntMap SomeRT +defaultRTTable = IM.fromList $ map toPair $ + [ wrapRecordType A + , wrapRecordType NS + , wrapRecordType CNAME + , wrapRecordType HINFO + ] + where + toPair :: SomeRT -> (Int, SomeRT) + toPair srt@(SomeRT rt) = (rtToInt rt, srt) + + +wrapQueryType :: RecordType rt dt => rt -> SomeQT +wrapQueryType = SomeRT + +wrapRecordType :: RecordType rt dt => rt -> SomeRT +wrapRecordType = SomeRT + +wrapRecord :: RecordType rt dt => ResourceRecord rt dt -> SomeRR +wrapRecord = SomeRR \ No newline at end of file