+
+type DecompTable = IntMap BS.ByteString
+type TTL = Word32
+
+getDomainName :: DecompTable -> Get (DomainName, DecompTable)
+getDomainName = flip worker []
+ where
+ worker :: DecompTable -> [DomainLabel] -> Get (DomainName, DecompTable)
+ worker dt soFar
+ = do (l, dt') <- getDomainLabel dt
+ case BS.null l of
+ True -> return (labelsToName (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
+
+data LabelHeader
+ = Offset !Int
+ | Length !Int
+
+putDomainName :: DomainName -> Put
+putDomainName = mapM_ putDomainLabel . nameToLabels
+
+putDomainLabel :: DomainLabel -> Put
+putDomainLabel l
+ = do putWord8 $ fromIntegral $ BS.length l
+ P.putByteString l
+
+class (Show rt, Show dt, Eq rt, Eq dt, Typeable rt, Typeable dt) => RecordType rt dt | rt -> dt where
+ rtToInt :: rt -> Int
+ putRecordType :: rt -> Put
+ putRecordData :: rt -> dt -> Put
+ getRecordData :: rt -> DecompTable -> Get (dt, DecompTable)
+
+ putRecordType = putWord16be . fromIntegral . rtToInt
+
+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 -> Put
+putSomeRT (SomeRT rt) = putRecordType rt
+
+getSomeRT :: Get SomeRT
+getSomeRT = do n <- liftM fromIntegral G.getWord16be
+ case IM.lookup n defaultRTTable of
+ Nothing
+ -> fail ("Unknown resource record type: " ++ show n)
+ Just srt
+ -> return srt
+
+data CNAME = CNAME deriving (Show, Eq, Typeable)
+instance RecordType CNAME DomainName where
+ rtToInt _ = 5
+ 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 _ dt = do cpu <- getCharString
+ os <- getCharString
+ return ((cpu, os), dt)
+
+{-