]> gitweb @ CieloNegro.org - haskell-dns.git/blobdiff - Network/DNS/Message.hs
More record types...
[haskell-dns.git] / Network / DNS / Message.hs
index 3fc48a59f5470225648278fd5a8ad5aecaf21953..ab1a15426430bb9b7d559561562a1e5fc4b35af8 100644 (file)
@@ -13,35 +13,53 @@ module Network.DNS.Message
     , RecordType
     , RecordClass(..)
 
-    , SomeRR(..)
-    , SomeRT(..)
+    , 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
@@ -52,6 +70,7 @@ data Message
       , msgAuthorities :: ![SomeRR]
       , msgAdditionals :: ![SomeRR]
       }
+    deriving (Show, Eq)
 
 data Header
     = Header {
@@ -70,6 +89,7 @@ data Header
       -- + NSCOUNT
       -- + ARCOUNT
       }
+    deriving (Show, Eq)
 
 type MessageID = Word16
 
@@ -96,38 +116,59 @@ data ResponseCode
 data Question
     = Question {
         qName  :: !DomainName
-      , qType  :: !SomeRT
+      , qType  :: !SomeQT
       , qClass :: !RecordClass
       }
     deriving (Show, Eq)
 
-putQ :: Question -> Put
+type SomeQT = SomeRT
+
+putQ :: Question -> Packer CompTable ()
 putQ q
     = do putDomainName $ qName q
          putSomeRT $ qType q
-         put $ qClass q
-
-getQ :: DecompTable -> Get (Question, DecompTable)
-getQ dt
-    = do (nm, dt') <- getDomainName dt
-         ty        <- getSomeRT
-         cl        <- get
-         let q = Question {
-                   qName  = nm
-                 , qType  = ty
-                 , qClass = cl
-                 }
-         return (q, dt')
-
-newtype DomainName  = DN [DomainLabel] deriving (Eq, Show, Typeable)
+         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
 
-nameToLabels :: DomainName -> [DomainLabel]
-nameToLabels (DN ls) = ls
+rootName :: DomainName
+rootName = DN [BS.empty]
 
-labelsToName :: [DomainLabel] -> DomainName
-labelsToName = DN
+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
@@ -149,37 +190,6 @@ data RecordType rt dt => ResourceRecord rt dt
     deriving (Show, Eq, Typeable)
 
 
-putRR :: forall rt dt. RecordType rt dt => ResourceRecord rt dt -> Put
-putRR rr = do putDomainName $ rrName rr
-              putRecordType $ rrType  rr
-              put $ rrClass rr
-              putWord32be $ rrTTL rr
-
-              let dat = runPut $
-                        putRecordData (undefined :: rt) (rrData rr)
-              putWord16be $ fromIntegral $ LBS.length dat
-              putLazyByteString dat
-
-
-getRR :: forall rt dt. RecordType rt dt => DecompTable -> rt -> Get (ResourceRecord rt dt, DecompTable)
-getRR dt rt
-    = do (nm, dt1)  <- getDomainName dt
-         G.skip 2   -- record type
-         cl         <- get
-         ttl        <- G.getWord32be
-         G.skip 2   -- data length
-         (dat, dt2) <- getRecordData (undefined :: rt) dt1
-
-         let rr = ResourceRecord {
-                    rrName  = nm
-                  , rrType  = rt
-                  , rrClass = cl
-                  , rrTTL   = ttl
-                  , rrData  = dat
-                  }
-         return (rr, dt2)
-
-
 data SomeRR = forall rt dt. RecordType rt dt => SomeRR (ResourceRecord rt dt)
 
 instance Show SomeRR where
@@ -189,79 +199,165 @@ instance Eq SomeRR where
     (SomeRR a) == (SomeRR b) = Just a == cast b
 
 
-putSomeRR :: SomeRR -> Put
-putSomeRR (SomeRR rr) = putRR rr
-
-getSomeRR :: DecompTable -> Get (SomeRR, DecompTable)
-getSomeRR dt
-    = do srt <- lookAhead $
-                do getDomainName dt -- skip
-                   getSomeRT
-         case srt of
-           SomeRT rt -> getRR dt rt >>= \ (rr, dt') -> return (SomeRR rr, dt')
+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 DecompTable = IntMap BS.ByteString
-type TTL = Word32
+type CompTable   = Map DomainName Int
+type DecompTable = IntMap DomainName
+type TTL         = Word32
 
-getDomainName :: DecompTable -> Get (DomainName, DecompTable)
-getDomainName = flip worker []
+getDomainName :: Unpacker DecompTable DomainName
+getDomainName = 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
+      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 . nameToLabels
+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
 
-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
+    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
+                        }
 
 data SomeRT = forall rt dt. RecordType rt dt => SomeRT rt
 
@@ -271,31 +367,164 @@ instance Show SomeRT where
 instance Eq SomeRT where
     (SomeRT a) == (SomeRT b) = Just a == cast b
 
-putSomeRT :: SomeRT -> Put
+putSomeRT :: SomeRT -> Packer s ()
 putSomeRT (SomeRT rt) = putRecordType rt
 
-getSomeRT :: Get SomeRT
-getSomeRT = do n <- liftM fromIntegral G.getWord16be
+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 _ dt        = do cpu <- getCharString
-                                   os  <- getCharString
-                                   return ((cpu, os), dt)
+    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
@@ -325,25 +554,27 @@ data RecordType
 -}
 
 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
+    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 = 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 getSomeRR dt1
-             (aths, dt3) <- replicateM' nAth getSomeRR dt2
-             (adds, _  ) <- replicateM' nAdd getSomeRR dt3
+    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
@@ -353,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
@@ -367,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
@@ -426,48 +657,26 @@ instance Enum ResponseCode where
 
 {-
 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
@@ -486,13 +695,26 @@ instance Enum RecordClass where
 
 instance Binary RecordClass where
     get = liftM (toEnum . fromIntegral) G.getWord16be
-    put = putWord16be . fromIntegral . fromEnum
+    put = P'.putWord16be . fromIntegral . fromEnum
 
 
 defaultRTTable :: IntMap SomeRT
 defaultRTTable = IM.fromList $ map toPair $
-                 [ SomeRT CNAME
+                 [ 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