Network/DNS/Message.hs

   1 module Network.DNS.Message
   2     ( Message(..)
   3     , MessageID
   4     , MessageType(..)
   5     , Header(..)
   6     , Opcode(..)
   7     , ResponseCode(..)
   8     , Question(..)
   9     , ResourceRecord(..)
  10     , DomainName
  11     , DomainLabel
  12     , TTL
  13     , RecordType
  14     , RecordClass(..)
  15
  16     , SOAFields(..)
  17
  18     , SomeQT
  19     , SomeRR
  20     , SomeRT
  21
  22     , A(..)
  23     , NS(..)
  24     , MD(..)
  25     , MF(..)
  26     , CNAME(..)
  27     , SOA(..)
  28     , MB(..)
  29     , MG(..)
  30     , MR(..)
  31     , NULL(..)
  32     , PTR(..)
  33     , HINFO(..)
  34     , MINFO(..)
  35     , MX(..)
  36     , TXT(..)
  37
  38     , mkDomainName
  39     , wrapQueryType
  40     , wrapRecordType
  41     , wrapRecord
  42     )
  43     where
  44
  45 import           Control.Exception
  46 import           Control.Monad
  47 import           Data.Binary
  48 import           Data.Binary.BitPut as BP
  49 import           Data.Binary.Get as G
  50 import           Data.Binary.Put as P'
  51 import           Data.Binary.Strict.BitGet as BG
  52 import qualified Data.ByteString as BS
  53 import qualified Data.ByteString.Char8 as C8 hiding (ByteString)
  54 import           Data.Typeable
  55 import qualified Data.IntMap as IM
  56 import           Data.IntMap (IntMap)
  57 import qualified Data.Map as M
  58 import           Data.Map (Map)
  59 import           Data.Word
  60 import           Network.DNS.Packer as P
  61 import           Network.DNS.Unpacker as U
  62 import           Network.Socket
  63
  64
  65 data Message
  66     = Message {
  67         msgHeader      :: !Header
  68       , msgQuestions   :: ![Question]
  69       , msgAnswers     :: ![SomeRR]
  70       , msgAuthorities :: ![SomeRR]
  71       , msgAdditionals :: ![SomeRR]
  72       }
  73     deriving (Show, Eq)
  74
  75 data Header
  76     = Header {
  77         hdMessageID             :: !MessageID
  78       , hdMessageType           :: !MessageType
  79       , hdOpcode                :: !Opcode
  80       , hdIsAuthoritativeAnswer :: !Bool
  81       , hdIsTruncated           :: !Bool
  82       , hdIsRecursionDesired    :: !Bool
  83       , hdIsRecursionAvailable  :: !Bool
  84       , hdResponseCode          :: !ResponseCode
  85
  86       -- These fields are supressed in this data structure:
  87       -- + QDCOUNT
  88       -- + ANCOUNT
  89       -- + NSCOUNT
  90       -- + ARCOUNT
  91       }
  92     deriving (Show, Eq)
  93
  94 type MessageID = Word16
  95
  96 data MessageType
  97     = Query
  98     | Response
  99     deriving (Show, Eq)
 100
 101 data Opcode
 102     = StandardQuery
 103     | InverseQuery
 104     | ServerStatusRequest
 105     deriving (Show, Eq)
 106
 107 data ResponseCode
 108     = NoError
 109     | FormatError
 110     | ServerFailure
 111     | NameError
 112     | NotImplemented
 113     | Refused
 114     deriving (Show, Eq)
 115
 116 data Question
 117     = Question {
 118         qName  :: !DomainName
 119       , qType  :: !SomeQT
 120       , qClass :: !RecordClass
 121       }
 122     deriving (Show, Eq)
 123
 124 type SomeQT = SomeRT
 125
 126 putQ :: Question -> Packer CompTable ()
 127 putQ q
 128     = do putDomainName $ qName q
 129          putSomeRT $ qType q
 130          putBinary $ qClass q
 131
 132 getQ :: Unpacker DecompTable Question
 133 getQ = do nm <- getDomainName
 134           ty <- getSomeRT
 135           cl <- getBinary
 136           return Question {
 137                        qName  = nm
 138                      , qType  = ty
 139                      , qClass = cl
 140                      }
 141
 142
 143 newtype DomainName  = DN [DomainLabel] deriving (Eq, Show, Ord, Typeable)
 144 type DomainLabel    = BS.ByteString
 145
 146 rootName :: DomainName
 147 rootName = DN [BS.empty]
 148
 149 isRootName :: DomainName -> Bool
 150 isRootName (DN [_]) = True
 151 isRootName _        = False
 152
 153 consLabel :: DomainLabel -> DomainName -> DomainName
 154 consLabel x (DN ys) = DN (x:ys)
 155
 156 unconsLabel :: DomainName -> (DomainLabel, DomainName)
 157 unconsLabel (DN (x:xs)) = (x, DN xs)
 158 unconsLabel x           = error ("Illegal use of unconsLabel: " ++ show x)
 159
 160 mkDomainName :: String -> DomainName
 161 mkDomainName = DN . mkLabels [] . notEmpty
 162     where
 163       notEmpty :: String -> String
 164       notEmpty xs = assert (not $ null xs) xs
 165
 166       mkLabels :: [DomainLabel] -> String -> [DomainLabel]
 167       mkLabels soFar [] = reverse (C8.empty : soFar)
 168       mkLabels soFar xs = case break (== '.') xs of
 169                             (l, ('.':rest))
 170                                 -> mkLabels (C8.pack l : soFar) rest
 171                             _   -> error ("Illegal domain name: " ++ xs)
 172
 173 data RecordClass
 174     = IN
 175     | CS -- Obsolete
 176     | CH
 177     | HS
 178     | AnyClass -- Only for queries
 179     deriving (Show, Eq)
 180
 181
 182 data RecordType rt dt => ResourceRecord rt dt
 183     = ResourceRecord {
 184         rrName  :: !DomainName
 185       , rrType  :: !rt
 186       , rrClass :: !RecordClass
 187       , rrTTL   :: !TTL
 188       , rrData  :: !dt
 189       }
 190     deriving (Show, Eq, Typeable)
 191
 192
 193 data SomeRR = forall rt dt. RecordType rt dt => SomeRR (ResourceRecord rt dt)
 194
 195 instance Show SomeRR where
 196     show (SomeRR rr) = show rr
 197
 198 instance Eq SomeRR where
 199     (SomeRR a) == (SomeRR b) = Just a == cast b
 200
 201
 202 putSomeRR :: SomeRR -> Packer CompTable ()
 203 putSomeRR (SomeRR rr) = putResourceRecord rr
 204
 205 getSomeRR :: Unpacker DecompTable SomeRR
 206 getSomeRR = do srt <- U.lookAhead $
 207                       do getDomainName -- skip
 208                          getSomeRT
 209                case srt of
 210                  SomeRT rt
 211                      -> getResourceRecord rt >>= return . SomeRR
 212
 213 type CompTable   = Map DomainName Int
 214 type DecompTable = IntMap DomainName
 215 type TTL         = Word32
 216
 217 getDomainName :: Unpacker DecompTable DomainName
 218 getDomainName = worker
 219     where
 220       worker :: Unpacker DecompTable DomainName
 221       worker
 222           = do offset <- U.bytesRead
 223                hdr    <- getLabelHeader
 224                case hdr of
 225                  Offset n
 226                      -> do dt <- U.getState
 227                            case IM.lookup n dt of
 228                              Just name
 229                                  -> return name
 230                              Nothing
 231                                  -> fail ("Illegal offset of label pointer: " ++ show (n, dt))
 232                  Length 0
 233                      -> return rootName
 234                  Length n
 235                      -> do label <- U.getByteString n
 236                            rest  <- worker
 237                            let name = consLabel label rest
 238                            U.modifyState $ IM.insert offset name
 239                            return name
 240
 241       getLabelHeader :: Unpacker s LabelHeader
 242       getLabelHeader
 243           = do header <- U.lookAhead $ U.getByteString 1
 244                let Right h
 245                        = runBitGet header $
 246                          do a <- getBit
 247                             b <- getBit
 248                             n <- liftM fromIntegral (getAsWord8 6)
 249                             case (a, b) of
 250                               ( True,  True) -> return $ Offset n
 251                               (False, False) -> return $ Length n
 252                               _              -> fail "Illegal label header"
 253                case h of
 254                  Offset _
 255                      -> do header' <- U.getByteString 2 -- Pointers have 2 octets.
 256                            let Right h'
 257                                    = runBitGet header' $
 258                                      do BG.skip 2
 259                                         n <- liftM fromIntegral (getAsWord16 14)
 260                                         return $ Offset n
 261                            return h'
 262                  len@(Length _)
 263                      -> do U.skip 1
 264                            return len
 265
 266
 267 getCharString :: Unpacker s BS.ByteString
 268 getCharString = do len <- U.getWord8
 269                    U.getByteString (fromIntegral len)
 270
 271 putCharString :: BS.ByteString -> Packer s ()
 272 putCharString xs = do P.putWord8 $ fromIntegral $ BS.length xs
 273                       P.putByteString xs
 274
 275 data LabelHeader
 276     = Offset !Int
 277     | Length !Int
 278
 279 putDomainName :: DomainName -> Packer CompTable ()
 280 putDomainName name
 281     = do ct <- P.getState
 282          case M.lookup name ct of
 283            Just n
 284                -> do let ptr = runBitPut $
 285                                do putBit True
 286                                   putBit True
 287                                   putNBits 14 n
 288                      P.putLazyByteString ptr
 289            Nothing
 290                -> do offset <- bytesWrote
 291                      P.modifyState $ M.insert name offset
 292
 293                      let (label, rest) = unconsLabel name
 294
 295                      putCharString label
 296
 297                      if isRootName rest then
 298                          P.putWord8 0
 299                        else
 300                          putDomainName rest
 301
 302
 303 class (Show rt, Show dt, Eq rt, Eq dt, Typeable rt, Typeable dt) => RecordType rt dt | rt -> dt where
 304     rtToInt       :: rt -> Int
 305     putRecordData :: rt -> dt -> Packer CompTable ()
 306     getRecordData :: rt -> Unpacker DecompTable dt
 307
 308     putRecordType :: rt -> Packer s ()
 309     putRecordType = P.putWord16be . fromIntegral . rtToInt
 310
 311     putRecordDataWithLength :: rt -> dt -> Packer CompTable ()
 312     putRecordDataWithLength rt dt
 313         = do -- First, write a dummy data length.
 314              offset <- bytesWrote
 315              P.putWord16be 0
 316
 317              -- Second, write data.
 318              putRecordData rt dt
 319
 320              -- Third, rewrite the dummy length to an actual value.
 321              offset' <- bytesWrote
 322              withOffset offset
 323                  $ P.putWord16be (fromIntegral (offset' - offset - 2))
 324
 325     putResourceRecord :: ResourceRecord rt dt -> Packer CompTable ()
 326     putResourceRecord rr
 327         = do putDomainName $ rrName  rr
 328              putRecordType $ rrType  rr
 329              putBinary     $ rrClass rr
 330              P.putWord32be $ rrTTL   rr
 331              putRecordDataWithLength (rrType rr) (rrData rr)
 332
 333     getRecordDataWithLength :: rt -> Unpacker DecompTable dt
 334     getRecordDataWithLength rt
 335         = do len     <- U.getWord16be
 336              offset  <- U.bytesRead
 337              dat     <- getRecordData rt
 338              offset' <- U.bytesRead
 339
 340              let consumed = offset' - offset
 341              when (consumed /= len)
 342                       $ fail ("getRecordData " ++ show rt ++ " consumed " ++ show consumed ++
 343                               " bytes but it had to consume " ++ show len ++ " bytes")
 344
 345              return dat
 346
 347     getResourceRecord :: rt -> Unpacker DecompTable (ResourceRecord rt dt)
 348     getResourceRecord rt
 349         = do name     <- getDomainName
 350              U.skip 2 -- record type
 351              cl       <- getBinary
 352              ttl      <- U.getWord32be
 353              dat      <- getRecordDataWithLength rt
 354              return $ ResourceRecord {
 355                           rrName  = name
 356                         , rrType  = rt
 357                         , rrClass = cl
 358                         , rrTTL   = ttl
 359                         , rrData  = dat
 360                         }
 361
 362 data SomeRT = forall rt dt. RecordType rt dt => SomeRT rt
 363
 364 instance Show SomeRT where
 365     show (SomeRT rt) = show rt
 366
 367 instance Eq SomeRT where
 368     (SomeRT a) == (SomeRT b) = Just a == cast b
 369
 370 putSomeRT :: SomeRT -> Packer s ()
 371 putSomeRT (SomeRT rt) = putRecordType rt
 372
 373 getSomeRT :: Unpacker s SomeRT
 374 getSomeRT = do n <- liftM fromIntegral U.getWord16be
 375                case IM.lookup n defaultRTTable of
 376                  Nothing
 377                      -> fail ("Unknown resource record type: " ++ show n)
 378                  Just srt
 379                      -> return srt
 380
 381 data SOAFields
 382     = SOAFields {
 383         soaMasterNameServer   :: !DomainName
 384       , soaResponsibleMailbox :: !DomainName
 385       , soaSerialNumber       :: !Word32
 386       , soaRefreshInterval    :: !Word32
 387       , soaRetryInterval      :: !Word32
 388       , soaExpirationLimit    :: !Word32
 389       , soaMinimumTTL         :: !Word32
 390       }
 391     deriving (Show, Eq, Typeable)
 392
 393 data A = A deriving (Show, Eq, Typeable)
 394 instance RecordType A HostAddress where
 395     rtToInt       _ = 1
 396     putRecordData _ = P.putWord32be
 397     getRecordData _ = U.getWord32be
 398
 399 data NS = NS deriving (Show, Eq, Typeable)
 400 instance RecordType NS DomainName where
 401     rtToInt       _ = 2
 402     putRecordData _ = putDomainName
 403     getRecordData _ = getDomainName
 404
 405 data MD = MD deriving (Show, Eq, Typeable)
 406 instance RecordType MD DomainName where
 407     rtToInt       _ = 3
 408     putRecordData _ = putDomainName
 409     getRecordData _ = getDomainName
 410
 411 data MF = MF deriving (Show, Eq, Typeable)
 412 instance RecordType MF DomainName where
 413     rtToInt       _ = 4
 414     putRecordData _ = putDomainName
 415     getRecordData _ = getDomainName
 416
 417 data CNAME = CNAME deriving (Show, Eq, Typeable)
 418 instance RecordType CNAME DomainName where
 419     rtToInt       _ = 5
 420     putRecordData _ = putDomainName
 421     getRecordData _ = getDomainName
 422
 423 data SOA = SOA deriving (Show, Eq, Typeable)
 424 instance RecordType SOA SOAFields where
 425     rtToInt       _ = 6
 426     putRecordData _ = \ soa ->
 427                       do putDomainName $ soaMasterNameServer soa
 428                          putDomainName $ soaResponsibleMailbox soa
 429                          P.putWord32be $ soaSerialNumber soa
 430                          P.putWord32be $ soaRefreshInterval soa
 431                          P.putWord32be $ soaRetryInterval soa
 432                          P.putWord32be $ soaExpirationLimit soa
 433                          P.putWord32be $ soaMinimumTTL soa
 434     getRecordData _ = do master  <- getDomainName
 435                          mail    <- getDomainName
 436                          serial  <- U.getWord32be
 437                          refresh <- U.getWord32be
 438                          retry   <- U.getWord32be
 439                          expire  <- U.getWord32be
 440                          ttl     <- U.getWord32be
 441                          return SOAFields {
 442                                       soaMasterNameServer   = master
 443                                     , soaResponsibleMailbox = mail
 444                                     , soaSerialNumber       = serial
 445                                     , soaRefreshInterval    = refresh
 446                                     , soaRetryInterval      = retry
 447                                     , soaExpirationLimit    = expire
 448                                     , soaMinimumTTL         = ttl
 449                                     }
 450
 451 data MB = MB deriving (Show, Eq, Typeable)
 452 instance RecordType MB DomainName where
 453     rtToInt       _ = 7
 454     putRecordData _ = putDomainName
 455     getRecordData _ = getDomainName
 456
 457 data MG = MG deriving (Show, Eq, Typeable)
 458 instance RecordType MG DomainName where
 459     rtToInt       _ = 8
 460     putRecordData _ = putDomainName
 461     getRecordData _ = getDomainName
 462
 463 data MR = MR deriving (Show, Eq, Typeable)
 464 instance RecordType MR DomainName where
 465     rtToInt       _ = 9
 466     putRecordData _ = putDomainName
 467     getRecordData _ = getDomainName
 468
 469 data NULL = NULL deriving (Show, Eq, Typeable)
 470 instance RecordType NULL BS.ByteString where
 471     rtToInt                 _ = 10
 472     putRecordData         _ _ = fail "putRecordData NULL can't be defined"
 473     getRecordData           _ = fail "getRecordData NULL can't be defined"
 474     putRecordDataWithLength _ = \ dat ->
 475                                 do P.putWord16be $ fromIntegral $ BS.length dat
 476                                    P.putByteString dat
 477     getRecordDataWithLength _ = do len <- U.getWord16be
 478                                    U.getByteString $ fromIntegral len
 479
 480 data PTR = PTR deriving (Show, Eq, Typeable)
 481 instance RecordType PTR DomainName where
 482     rtToInt       _ = 12
 483     putRecordData _ = putDomainName
 484     getRecordData _ = getDomainName
 485
 486 data HINFO = HINFO deriving (Show, Eq, Typeable)
 487 instance RecordType HINFO (BS.ByteString, BS.ByteString) where
 488     rtToInt       _ = 13
 489     putRecordData _ = \ (cpu, os) ->
 490                       do putCharString cpu
 491                          putCharString os
 492     getRecordData _ = do cpu <- getCharString
 493                          os  <- getCharString
 494                          return (cpu, os)
 495
 496 data MINFO = MINFO deriving (Show, Eq, Typeable)
 497 instance RecordType MINFO (DomainName, DomainName) where
 498     rtToInt       _ = 14
 499     putRecordData _ = \ (r, e) ->
 500                       do putDomainName r
 501                          putDomainName e
 502     getRecordData _ = do r <- getDomainName
 503                          e <- getDomainName
 504                          return (r, e)
 505
 506 data MX = MX deriving (Show, Eq, Typeable)
 507 instance RecordType MX (Word16, DomainName) where
 508     rtToInt       _ = 15
 509     putRecordData _ = \ (pref, exch) ->
 510                       do P.putWord16be pref
 511                          putDomainName exch
 512     getRecordData _ = do pref <- U.getWord16be
 513                          exch <- getDomainName
 514                          return (pref, exch)
 515
 516 data TXT = TXT deriving (Show, Eq, Typeable)
 517 instance RecordType TXT [BS.ByteString] where
 518     rtToInt       _ = 16
 519     putRecordData _ = mapM_ putCharString
 520     getRecordData _ = fail "getRecordData TXT can't be defined"
 521
 522     getRecordDataWithLength _ = U.getWord16be >>= worker [] . fromIntegral
 523         where
 524           worker :: [BS.ByteString] -> Int -> Unpacker s [BS.ByteString]
 525           worker soFar 0 = return (reverse soFar)
 526           worker soFar n = do str <- getCharString
 527                               worker (str : soFar) (0 `max` n - 1 - BS.length str)
 528
 529 {-
 530 data RecordType
 531     = A
 532     | NS
 533     | MD
 534     | MF
 535     | CNAME
 536     | SOA
 537     | MB
 538     | MG
 539     | MR
 540     | NULL
 541     | WKS
 542     | PTR
 543     | HINFO
 544     | MINFO
 545     | MX
 546     | TXT
 547
 548     -- Only for queries:
 549     | AXFR
 550     | MAILB -- Obsolete
 551     | MAILA -- Obsolete
 552     | AnyType
 553     deriving (Show, Eq)
 554 -}
 555
 556 instance Binary Message where
 557     put m = P.liftToBinary M.empty $
 558             do putBinary $ msgHeader m
 559                P.putWord16be $ fromIntegral $ length $ msgQuestions m
 560                P.putWord16be $ fromIntegral $ length $ msgAnswers m
 561                P.putWord16be $ fromIntegral $ length $ msgAuthorities m
 562                P.putWord16be $ fromIntegral $ length $ msgAdditionals m
 563                mapM_ putQ      $ msgQuestions m
 564                mapM_ putSomeRR $ msgAnswers m
 565                mapM_ putSomeRR $ msgAuthorities m
 566                mapM_ putSomeRR $ msgAdditionals m
 567
 568     get = U.liftToBinary IM.empty $
 569           do hdr  <- getBinary
 570              nQ   <- liftM fromIntegral U.getWord16be
 571              nAns <- liftM fromIntegral U.getWord16be
 572              nAth <- liftM fromIntegral U.getWord16be
 573              nAdd <- liftM fromIntegral U.getWord16be
 574              qs   <- replicateM nQ   getQ
 575              anss <- replicateM nAns getSomeRR
 576              aths <- replicateM nAth getSomeRR
 577              adds <- replicateM nAdd getSomeRR
 578              return Message {
 579                           msgHeader      = hdr
 580                         , msgQuestions   = qs
 581                         , msgAnswers     = anss
 582                         , msgAuthorities = aths
 583                         , msgAdditionals = adds
 584                         }
 585
 586 instance Binary Header where
 587     put h = do P'.putWord16be $ hdMessageID h
 588                P'.putLazyByteString flags
 589         where
 590           flags = runBitPut $
 591                   do putNBits 1 $ fromEnum $ hdMessageType h
 592                      putNBits 4 $ fromEnum $ hdOpcode h
 593                      putBit $ hdIsAuthoritativeAnswer h
 594                      putBit $ hdIsTruncated h
 595                      putBit $ hdIsRecursionDesired h
 596                      putBit $ hdIsRecursionAvailable h
 597                      putNBits 3 (0 :: Int)
 598                      putNBits 4 $ fromEnum $ hdResponseCode h
 599
 600     get = do mID   <- G.getWord16be
 601              flags <- G.getByteString 2
 602              let Right hd
 603                      = runBitGet flags $
 604                        do qr <- liftM (toEnum . fromIntegral) $ getAsWord8 1
 605                           op <- liftM (toEnum . fromIntegral) $ getAsWord8 4
 606                           aa <- getBit
 607                           tc <- getBit
 608                           rd <- getBit
 609                           ra <- getBit
 610                           BG.skip 3
 611                           rc <- liftM (toEnum . fromIntegral) $ getAsWord8 4
 612                           return Header {
 613                                        hdMessageID             = mID
 614                                      , hdMessageType           = qr
 615                                      , hdOpcode                = op
 616                                      , hdIsAuthoritativeAnswer = aa
 617                                      , hdIsTruncated           = tc
 618                                      , hdIsRecursionDesired    = rd
 619                                      , hdIsRecursionAvailable  = ra
 620                                      , hdResponseCode          = rc
 621                                      }
 622              return hd
 623
 624 instance Enum MessageType where
 625     fromEnum Query    = 0
 626     fromEnum Response = 1
 627
 628     toEnum 0 = Query
 629     toEnum 1 = Response
 630     toEnum _ = undefined
 631
 632 instance Enum Opcode where
 633     fromEnum StandardQuery       = 0
 634     fromEnum InverseQuery        = 1
 635     fromEnum ServerStatusRequest = 2
 636
 637     toEnum 0 = StandardQuery
 638     toEnum 1 = InverseQuery
 639     toEnum 2 = ServerStatusRequest
 640     toEnum _ = undefined
 641
 642 instance Enum ResponseCode where
 643     fromEnum NoError        = 0
 644     fromEnum FormatError    = 1
 645     fromEnum ServerFailure  = 2
 646     fromEnum NameError      = 3
 647     fromEnum NotImplemented = 4
 648     fromEnum Refused        = 5
 649
 650     toEnum 0 = NoError
 651     toEnum 1 = FormatError
 652     toEnum 2 = ServerFailure
 653     toEnum 3 = NameError
 654     toEnum 4 = NotImplemented
 655     toEnum 5 = Refused
 656     toEnum _ = undefined
 657
 658 {-
 659 instance Enum RecordType where
 660     fromEnum A       = 1 /
 661     fromEnum NS      = 2 /
 662     fromEnum MD      = 3 /
 663     fromEnum MF      = 4 /
 664     fromEnum CNAME   = 5 /
 665     fromEnum SOA     = 6 /
 666     fromEnum MB      = 7 /
 667     fromEnum MG      = 8 /
 668     fromEnum MR      = 9 /
 669     fromEnum NULL    = 10 /
 670     fromEnum WKS     = 11
 671     fromEnum PTR     = 12 /
 672     fromEnum HINFO   = 13 /
 673     fromEnum MINFO   = 14 /
 674     fromEnum MX      = 15 /
 675     fromEnum TXT     = 16 /
 676     fromEnum AXFR    = 252
 677     fromEnum MAILB   = 253
 678     fromEnum MAILA   = 254
 679     fromEnum AnyType = 255
 680 -}
 681
 682 instance Enum RecordClass where
 683     fromEnum IN       = 1
 684     fromEnum CS       = 2
 685     fromEnum CH       = 3
 686     fromEnum HS       = 4
 687     fromEnum AnyClass = 255
 688
 689     toEnum 1   = IN
 690     toEnum 2   = CS
 691     toEnum 3   = CH
 692     toEnum 4   = HS
 693     toEnum 255 = AnyClass
 694     toEnum _   = undefined
 695
 696 instance Binary RecordClass where
 697     get = liftM (toEnum . fromIntegral) G.getWord16be
 698     put = P'.putWord16be . fromIntegral . fromEnum
 699
 700
 701 defaultRTTable :: IntMap SomeRT
 702 defaultRTTable = IM.fromList $ map toPair $
 703                  [ wrapRecordType A
 704                  , wrapRecordType NS
 705                  , wrapRecordType CNAME
 706                  , wrapRecordType HINFO
 707                  ]
 708     where
 709       toPair :: SomeRT -> (Int, SomeRT)
 710       toPair srt@(SomeRT rt) = (rtToInt rt, srt)
 711
 712
 713 wrapQueryType :: RecordType rt dt => rt -> SomeQT
 714 wrapQueryType = SomeRT
 715
 716 wrapRecordType :: RecordType rt dt => rt -> SomeRT
 717 wrapRecordType = SomeRT
 718
 719 wrapRecord :: RecordType rt dt => ResourceRecord rt dt -> SomeRR
 720 wrapRecord = SomeRR