Add DNSUnitTest.hs

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

diff --git a/Network/DNS/Message.hs b/Network/DNS/Message.hs
index 3fc48a59f5470225648278fd5a8ad5aecaf21953..6144d13766e037d551838526f18804bf0b896451 100644 (file)
--- a/Network/DNS/Message.hs
+++ b/Network/DNS/Message.hs
@@ -18,9 +18,13 @@ module Network.DNS.Message
 
     , CNAME(..)
     , HINFO(..)
+
+    , mkQueryType
+    , mkDomainName
     )
     where
 
+import           Control.Exception
 import           Control.Monad
 import           Data.Binary
 import           Data.Binary.BitPut as BP
@@ -28,6 +32,7 @@ import           Data.Binary.Get as G
 import           Data.Binary.Put as P
 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.Typeable
 import qualified Data.IntMap as IM
@@ -52,6 +57,7 @@ data Message
       , msgAuthorities :: ![SomeRR]
       , msgAdditionals :: ![SomeRR]
       }
+    deriving (Show, Eq)
 
 data Header
     = Header {
@@ -70,6 +76,7 @@ data Header
       -- + NSCOUNT
       -- + ARCOUNT
       }
+    deriving (Show, Eq)
 
 type MessageID = Word16
 
@@ -96,11 +103,16 @@ data ResponseCode
 data Question
     = Question {
         qName  :: !DomainName
-      , qType  :: !SomeRT
+      , qType  :: !SomeQT
       , qClass :: !RecordClass
       }
     deriving (Show, Eq)
 
+type SomeQT = SomeRT
+
+mkQueryType :: RecordType rt dt => rt -> SomeQT
+mkQueryType = SomeRT
+
 putQ :: Question -> Put
 putQ q
     = do putDomainName $ qName q
@@ -128,6 +140,18 @@ nameToLabels (DN ls) = ls
 labelsToName :: [DomainLabel] -> DomainName
 labelsToName = DN
 
+mkDomainName :: String -> DomainName
+mkDomainName = labelsToName . 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