AAAA support

[haskell-dns.git] / Network / DNS / Message.hs

diff --git a/Network/DNS/Message.hs b/Network/DNS/Message.hs
index 9713dd2a707ed66d8776458733401346d7eb2e72..db5016096df79dc83788770b21de2aa014d60f1e 100644 (file)
--- a/Network/DNS/Message.hs
+++ b/Network/DNS/Message.hs
@@ -23,6 +23,7 @@ module Network.DNS.Message
     , SomeRR(..)
 
     , A(..)
     , SomeRR(..)
 
     , A(..)

+    , AAAA(..)

     , NS(..)
     , MD(..)
     , MF(..)
     , NS(..)
     , MD(..)
     , MF(..)


@@ -50,7 +51,6 @@ module Network.DNS.Message
     , HS(..)
 
     , mkDomainName
     , HS(..)
 
     , mkDomainName

-    , mkDN

     , rootName
     , isRootName
     , consLabel
     , rootName
     , isRootName
     , consLabel


@@ -73,6 +73,7 @@ import           Data.Binary.Strict.BitGet as BG
 import qualified Data.ByteString as BS
 import qualified Data.ByteString.Char8 as C8 hiding (ByteString)
 import qualified Data.ByteString.Lazy as LBS
 import qualified Data.ByteString as BS
 import qualified Data.ByteString.Char8 as C8 hiding (ByteString)
 import qualified Data.ByteString.Lazy as LBS

+import           Data.String

 import           Data.Typeable
 import qualified Data.IntMap as IM
 import           Data.IntMap (IntMap)
 import           Data.Typeable
 import qualified Data.IntMap as IM
 import           Data.IntMap (IntMap)


@@ -219,6 +220,9 @@ getSomeQC = do n <- liftM fromIntegral U.getWord16be
 newtype DomainName  = DN [DomainLabel] deriving (Eq, Show, Ord, Typeable)
 type DomainLabel    = BS.ByteString
 
 newtype DomainName  = DN [DomainLabel] deriving (Eq, Show, Ord, Typeable)
 type DomainLabel    = BS.ByteString
 

+instance IsString DomainName where
+    fromString = mkDomainName
+

 rootName :: DomainName
 rootName = DN [BS.empty]
 
 rootName :: DomainName
 rootName = DN [BS.empty]
 


@@ -252,9 +256,6 @@ mkDomainName = DN . mkLabels [] . notEmpty
                                 -> mkLabels (C8.pack l : soFar) rest
                             _   -> error ("Illegal domain name: " ++ xs)
 
                                 -> mkLabels (C8.pack l : soFar) rest
                             _   -> error ("Illegal domain name: " ++ xs)
 

-mkDN :: String -> DomainName
-mkDN = mkDomainName
-

 
 class (Show rc, Eq rc, Typeable rc) => RecordClass rc where
     rcToInt :: rc -> Int
 
 class (Show rc, Eq rc, Typeable rc) => RecordClass rc where
     rcToInt :: rc -> Int


@@ -529,6 +530,20 @@ instance RecordType A HostAddress where
     putRecordData _ = P.putWord32be
     getRecordData _ = U.getWord32be
 
     putRecordData _ = P.putWord32be
     getRecordData _ = U.getWord32be
 

+data AAAA = AAAA deriving (Show, Eq, Typeable)
+instance RecordType AAAA HostAddress6 where
+    rtToInt       _ = 28
+    putRecordData _ = \ (a, b, c, d) ->
+                      do P.putWord32be a
+                         P.putWord32be b
+                         P.putWord32be c
+                         P.putWord32be d
+    getRecordData _ = do a <- U.getWord32be
+                         b <- U.getWord32be
+                         c <- U.getWord32be
+                         d <- U.getWord32be
+                         return (a, b, c, d)
+

 data NS = NS deriving (Show, Eq, Typeable)
 instance RecordType NS DomainName where
     rtToInt       _ = 2
 data NS = NS deriving (Show, Eq, Typeable)
 instance RecordType NS DomainName where
     rtToInt       _ = 2


@@ -847,6 +862,7 @@ instance Enum ResponseCode where
 defaultRTTable :: IntMap SomeRT
 defaultRTTable = IM.fromList $ map toPair $
                  [ SomeRT A
 defaultRTTable :: IntMap SomeRT
 defaultRTTable = IM.fromList $ map toPair $
                  [ SomeRT A

+                 , SomeRT AAAA

                  , SomeRT NS
                  , SomeRT MD
                  , SomeRT MF
                  , SomeRT NS
                  , SomeRT MD
                  , SomeRT MF