More data types

diff --git a/Network/DNS/Message.hs b/Network/DNS/Message.hs
index a3c04821f0f90b60a838ad7fe7fa8e10093dd20c..71fec55814cda85735cb528f6f5b262f50383616 100644 (file)
--- a/Network/DNS/Message.hs
+++ b/Network/DNS/Message.hs
@@ -1,7 +1,13 @@
 module Network.DNS.Message
-    ( Header(..)
+    ( Message(..)
+    , MessageType(..)
+    , Header(..)
     , Opcode(..)
     , ResponseCode(..)
+    , Question(..)
+    , ResourceRecord(..)
+    , RecordType(..)
+    , RecordClass(..)
     )
     where
 
@@ -12,27 +18,43 @@ import           Data.Bits
 import           Data.Word
 
 
-data Header
-    = QueryHeader {
-        hdMessageID             :: !Word16
-      , hdOpcode                :: !Opcode
-      , hdIsTruncated           :: !Bool
-      , hdIsRecursionDesired    :: !Bool
+data Message
+    = Message {
+        msgHeader      :: !Header
+      , msgQuestions   :: ![Question]
+      , msgAnswers     :: ![ResourceRecord]
+      , msgAuthorities :: ![ResourceRecord]
+      , msgAdditionals :: ![ResourceRecord]
       }
-    | ResponseHeader {
+
+data Header
+    = Header {
         hdMessageID             :: !Word16
+      , hdMessageType           :: !MessageType
       , hdOpcode                :: !Opcode
       , hdIsAuthoritativeAnswer :: !Bool
       , hdIsTruncated           :: !Bool
       , hdIsRecursionDesired    :: !Bool
       , hdIsRecursionAvailable  :: !Bool
       , hdResponseCode          :: !ResponseCode
+
+      -- These fields are supressed in this data structure:
+      -- * QDCOUNT
+      -- * ANCOUNT
+      -- * NSCOUNT
+      -- * ARCOUNT
       }
 
+data MessageType
+    = Query
+    | Response
+    deriving (Show, Eq)
+
 data Opcode
     = StandardQuery
     | InverseQuery
     | ServerStatusRequest
+    deriving (Show, Eq)
 
 data ResponseCode
     = NoError
@@ -43,28 +65,68 @@ data ResponseCode
     | Refused
     deriving (Show, Eq)
 
-hdIsResponse :: Header -> Bool
-hdIsResponse (QueryHeader    _ _ _ _      ) = False
-hdIsResponse (ResponseHeader _ _ _ _ _ _ _) = True
+data Question
+    = Question {
+        qName  :: !DomainName
+      , qType  :: !RecordType
+      , qClass :: !RecordClass
+      }
+    deriving (Show, Eq)
+
+type DomainName = [[Word8]]
+
+data RecordClass
+    = IN
+    | CS -- Obsolete
+    | CH
+    | HS
+    | AnyClass -- Only for queries
+    deriving (Show, Eq)
+
+data ResourceRecord
+    = ResourceRecord {
+        rrName  :: !DomainName
+      , rrType  :: !RecordType
+      , rrClass :: !RecordClass
+      , rrTTL   :: !Word32
+      , rrData  :: ![Word8]
+      }
+    deriving (Show, Eq)
+
+data RecordType
+    = A
+    | NS
+    | MD
+    | MF
+    | CNAME
+    | SOA
+    | MB
+    | MG
+    | MR
+    | NULL
+    | WKS
+    | PTR
+    | HINFO
+    | MINFO
+    | MX
+    | TXT
+
+    -- Only for queries:
+    | AXFR
+    | MAILB -- Obsolete
+    | MAILA -- Obsolete
+    | AnyType
+    deriving (Show, Eq)
 
 instance Binary Header where
     put h = do putWord16be $ hdMessageID h
-               let qr    = boolToNum $ hdIsResponse h
+               let qr    = fromIntegral $ fromEnum $ hdMessageType h
                    op    = fromIntegral $ fromEnum $ hdOpcode h
-                   aa    = if hdIsResponse h then
-                               boolToNum $ hdIsAuthoritativeAnswer h
-                           else
-                               0
+                   aa    = boolToNum $ hdIsAuthoritativeAnswer h
                    tc    = boolToNum $ hdIsTruncated h
                    rd    = boolToNum $ hdIsRecursionDesired h
-                   ra    = if hdIsResponse h then
-                               boolToNum $ hdIsRecursionAvailable h
-                           else
-                               0
-                   rc    = if hdIsResponse h then
-                               fromIntegral $ fromEnum $ hdResponseCode h
-                           else
-                               0
+                   ra    = boolToNum $ hdIsRecursionAvailable h
+                   rc    = fromIntegral $ fromEnum $ hdResponseCode h
                    flags = ((qr `shiftL` 15) .&. 0x01) .|.
                            ((op `shiftL` 11) .&. 0x0F) .|.
                            ((aa `shiftL` 10) .&. 0x01) .|.
@@ -80,32 +142,33 @@ instance Binary Header where
 
     get = do mID   <- getWord16be
              flags <- getWord16be
-             let qr = testBit flags 15
+             let qr = toEnum $ fromIntegral ((flags `shiftR` 15) .&. 0x01)
                  op = toEnum $ fromIntegral ((flags `shiftR` 11) .&. 0x0F)
                  aa = testBit flags 10
                  tc = testBit flags 9
                  rd = testBit flags 8
                  ra = testBit flags 7
                  rc = toEnum $ fromIntegral (flags .&. 0x0F)
-                 hd = if qr then
-                          ResponseHeader {
-                            hdMessageID             = mID
-                          , hdOpcode                = op
-                          , hdIsAuthoritativeAnswer = aa
-                          , hdIsTruncated           = tc
-                          , hdIsRecursionDesired    = rd
-                          , hdIsRecursionAvailable  = ra
-                          , hdResponseCode          = rc
-                          }
-                      else
-                          QueryHeader {
-                            hdMessageID          = mID
-                          , hdOpcode             = op
-                          , hdIsTruncated        = tc
-                          , hdIsRecursionDesired = rd
-                          }
+                 hd = Header {
+                         hdMessageID             = mID
+                       , hdMessageType           = qr
+                       , hdOpcode                = op
+                       , hdIsAuthoritativeAnswer = aa
+                       , hdIsTruncated           = tc
+                       , hdIsRecursionDesired    = rd
+                       , hdIsRecursionAvailable  = ra
+                       , hdResponseCode          = rc
+                       }
              return hd
 
+instance Enum MessageType where
+    fromEnum Query    = 0
+    fromEnum Response = 1
+
+    toEnum 0 = Query
+    toEnum 1 = Response
+    toEnum _ = undefined
+
 instance Enum Opcode where
     fromEnum StandardQuery       = 0
     fromEnum InverseQuery        = 1
@@ -116,10 +179,6 @@ instance Enum Opcode where
     toEnum 2 = ServerStatusRequest
     toEnum _ = undefined
 
-instance Bounded Opcode where
-    minBound = StandardQuery
-    maxBound = ServerStatusRequest
-
 instance Enum ResponseCode where
     fromEnum NoError        = 0
     fromEnum FormatError    = 1
@@ -136,6 +195,60 @@ instance Enum ResponseCode where
     toEnum 5 = Refused
     toEnum _ = undefined
 
-instance Bounded ResponseCode where
-    minBound = NoError
-    maxBound = Refused
+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 WKS     = 11
+    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
+    fromEnum IN       = 1
+    fromEnum CS       = 2
+    fromEnum CH       = 3
+    fromEnum HS       = 4
+    fromEnum AnyClass = 255
+
+    toEnum 1   = IN
+    toEnum 2   = CS
+    toEnum 3   = CH
+    toEnum 4   = HS
+    toEnum 255 = AnyClass
+    toEnum _   = undefined