X-Git-Url: http://git.cielonegro.org/gitweb.cgi?p=haskell-dns.git;a=blobdiff_plain;f=Network%2FDNS%2FMessage.hs;h=db5016096df79dc83788770b21de2aa014d60f1e;hp=9713dd2a707ed66d8776458733401346d7eb2e72;hb=845dca95afa7e073e62520ef3c4840b3b078bdad;hpb=826401d22c87d6c5d77ad4f427d28d6b97a9d12f diff --git a/Network/DNS/Message.hs b/Network/DNS/Message.hs index 9713dd2..db50160 100644 --- a/Network/DNS/Message.hs +++ b/Network/DNS/Message.hs @@ -23,6 +23,7 @@ module Network.DNS.Message , SomeRR(..) , A(..) + , AAAA(..) , NS(..) , MD(..) , MF(..) @@ -50,7 +51,6 @@ module Network.DNS.Message , HS(..) , mkDomainName - , mkDN , 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 Data.String 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 +instance IsString DomainName where + fromString = mkDomainName + 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) -mkDN :: String -> DomainName -mkDN = mkDomainName - 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 +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 @@ -847,6 +862,7 @@ instance Enum ResponseCode where defaultRTTable :: IntMap SomeRT defaultRTTable = IM.fromList $ map toPair $ [ SomeRT A + , SomeRT AAAA , SomeRT NS , SomeRT MD , SomeRT MF