Network/DNS/Message.hs

   1 module Network.DNS.Message
   2     ( Message(..)
   3     , MessageType(..)
   4     , Header(..)
   5     , Opcode(..)
   6     , ResponseCode(..)
   7     , Question(..)
   8     , ResourceRecord(..)
   9     , RecordType(..)
  10     , RecordClass(..)
  11     )
  12     where
  13
  14 import           Control.Monad
  15 import           Data.Binary
  16 import           Data.Binary.BitPut
  17 import           Data.Binary.Get as G
  18 import           Data.Binary.Put
  19 import           Data.Binary.Strict.BitGet as BG
  20 import           Data.Word
  21
  22
  23 data Message
  24     = Message {
  25         msgHeader      :: !Header
  26       , msgQuestions   :: ![Question]
  27       , msgAnswers     :: ![ResourceRecord]
  28       , msgAuthorities :: ![ResourceRecord]
  29       , msgAdditionals :: ![ResourceRecord]
  30       }
  31
  32 data Header
  33     = Header {
  34         hdMessageID             :: !Word16
  35       , hdMessageType           :: !MessageType
  36       , hdOpcode                :: !Opcode
  37       , hdIsAuthoritativeAnswer :: !Bool
  38       , hdIsTruncated           :: !Bool
  39       , hdIsRecursionDesired    :: !Bool
  40       , hdIsRecursionAvailable  :: !Bool
  41       , hdResponseCode          :: !ResponseCode
  42
  43       -- These fields are supressed in this data structure:
  44       -- + QDCOUNT
  45       -- + ANCOUNT
  46       -- + NSCOUNT
  47       -- + ARCOUNT
  48       }
  49
  50 data MessageType
  51     = Query
  52     | Response
  53     deriving (Show, Eq)
  54
  55 data Opcode
  56     = StandardQuery
  57     | InverseQuery
  58     | ServerStatusRequest
  59     deriving (Show, Eq)
  60
  61 data ResponseCode
  62     = NoError
  63     | FormatError
  64     | ServerFailure
  65     | NameError
  66     | NotImplemented
  67     | Refused
  68     deriving (Show, Eq)
  69
  70 data Question
  71     = Question {
  72         qName  :: !DomainName
  73       , qType  :: !RecordType
  74       , qClass :: !RecordClass
  75       }
  76     deriving (Show, Eq)
  77
  78 type DomainName = [[Word8]]
  79
  80 data RecordClass
  81     = IN
  82     | CS -- Obsolete
  83     | CH
  84     | HS
  85     | AnyClass -- Only for queries
  86     deriving (Show, Eq)
  87
  88 data ResourceRecord
  89     = ResourceRecord {
  90         rrName  :: !DomainName
  91       , rrType  :: !RecordType
  92       , rrClass :: !RecordClass
  93       , rrTTL   :: !Word32
  94       , rrData  :: ![Word8]
  95       }
  96     deriving (Show, Eq)
  97
  98 data RecordType
  99     = A
 100     | NS
 101     | MD
 102     | MF
 103     | CNAME
 104     | SOA
 105     | MB
 106     | MG
 107     | MR
 108     | NULL
 109     | WKS
 110     | PTR
 111     | HINFO
 112     | MINFO
 113     | MX
 114     | TXT
 115
 116     -- Only for queries:
 117     | AXFR
 118     | MAILB -- Obsolete
 119     | MAILA -- Obsolete
 120     | AnyType
 121     deriving (Show, Eq)
 122
 123 instance Binary Header where
 124     put h = do putWord16be $ hdMessageID h
 125                putLazyByteString flags
 126         where
 127           flags = runBitPut $
 128                   do putNBits 1 $ fromEnum $ hdMessageType h
 129                      putNBits 4 $ fromEnum $ hdOpcode h
 130                      putBit $ hdIsAuthoritativeAnswer h
 131                      putBit $ hdIsTruncated h
 132                      putBit $ hdIsRecursionDesired h
 133                      putBit $ hdIsRecursionAvailable h
 134                      putNBits 3 (0 :: Int)
 135                      putNBits 4 $ fromEnum $ hdResponseCode h
 136
 137     get = do mID   <- G.getWord16be
 138              flags <- getByteString 2
 139              let Right hd
 140                      = runBitGet flags $
 141                        do qr <- liftM (toEnum . fromIntegral) $ getAsWord8 1
 142                           op <- liftM (toEnum . fromIntegral) $ getAsWord8 4
 143                           aa <- getBit
 144                           tc <- getBit
 145                           rd <- getBit
 146                           ra <- getBit
 147                           BG.skip 3
 148                           rc <- liftM (toEnum . fromIntegral) $ getAsWord8 4
 149                           return Header {
 150                                        hdMessageID             = mID
 151                                      , hdMessageType           = qr
 152                                      , hdOpcode                = op
 153                                      , hdIsAuthoritativeAnswer = aa
 154                                      , hdIsTruncated           = tc
 155                                      , hdIsRecursionDesired    = rd
 156                                      , hdIsRecursionAvailable  = ra
 157                                      , hdResponseCode          = rc
 158                                      }
 159              return hd
 160
 161 instance Enum MessageType where
 162     fromEnum Query    = 0
 163     fromEnum Response = 1
 164
 165     toEnum 0 = Query
 166     toEnum 1 = Response
 167     toEnum _ = undefined
 168
 169 instance Enum Opcode where
 170     fromEnum StandardQuery       = 0
 171     fromEnum InverseQuery        = 1
 172     fromEnum ServerStatusRequest = 2
 173
 174     toEnum 0 = StandardQuery
 175     toEnum 1 = InverseQuery
 176     toEnum 2 = ServerStatusRequest
 177     toEnum _ = undefined
 178
 179 instance Enum ResponseCode where
 180     fromEnum NoError        = 0
 181     fromEnum FormatError    = 1
 182     fromEnum ServerFailure  = 2
 183     fromEnum NameError      = 3
 184     fromEnum NotImplemented = 4
 185     fromEnum Refused        = 5
 186
 187     toEnum 0 = NoError
 188     toEnum 1 = FormatError
 189     toEnum 2 = ServerFailure
 190     toEnum 3 = NameError
 191     toEnum 4 = NotImplemented
 192     toEnum 5 = Refused
 193     toEnum _ = undefined
 194
 195 instance Enum RecordType where
 196     fromEnum A       = 1
 197     fromEnum NS      = 2
 198     fromEnum MD      = 3
 199     fromEnum MF      = 4
 200     fromEnum CNAME   = 5
 201     fromEnum SOA     = 6
 202     fromEnum MB      = 7
 203     fromEnum MG      = 8
 204     fromEnum MR      = 9
 205     fromEnum NULL    = 10
 206     fromEnum WKS     = 11
 207     fromEnum PTR     = 12
 208     fromEnum HINFO   = 13
 209     fromEnum MINFO   = 14
 210     fromEnum MX      = 15
 211     fromEnum TXT     = 16
 212     fromEnum AXFR    = 252
 213     fromEnum MAILB   = 253
 214     fromEnum MAILA   = 254
 215     fromEnum AnyType = 255
 216
 217     toEnum 1  = A
 218     toEnum 2  = NS
 219     toEnum 3  = MD
 220     toEnum 4  = MF
 221     toEnum 5  = CNAME
 222     toEnum 6  = SOA
 223     toEnum 7  = MB
 224     toEnum 8  = MG
 225     toEnum 9  = MR
 226     toEnum 10 = NULL
 227     toEnum 11 = WKS
 228     toEnum 12 = PTR
 229     toEnum 13 = HINFO
 230     toEnum 14 = MINFO
 231     toEnum 15 = MX
 232     toEnum 16 = TXT
 233     toEnum 252 = AXFR
 234     toEnum 253 = MAILB
 235     toEnum 254 = MAILA
 236     toEnum 255 = AnyType
 237     toEnum _  = undefined
 238
 239 instance Enum RecordClass where
 240     fromEnum IN       = 1
 241     fromEnum CS       = 2
 242     fromEnum CH       = 3
 243     fromEnum HS       = 4
 244     fromEnum AnyClass = 255
 245
 246     toEnum 1   = IN
 247     toEnum 2   = CS
 248     toEnum 3   = CH
 249     toEnum 4   = HS
 250     toEnum 255 = AnyClass
 251     toEnum _   = undefined