, RecordType
, RecordClass(..)
+ , SOAFields(..)
+
, SomeQT
, SomeRR
, SomeRT
, A(..)
, NS(..)
+ , MD(..)
+ , MF(..)
, CNAME(..)
+ , SOA(..)
+ , MB(..)
+ , MG(..)
+ , MR(..)
+ , NULL(..)
+ , PTR(..)
, HINFO(..)
+ , MINFO(..)
+ , MX(..)
+ , TXT(..)
, mkDomainName
, wrapQueryType
putRecordType :: rt -> Packer s ()
putRecordType = P.putWord16be . fromIntegral . rtToInt
- putResourceRecord :: ResourceRecord rt dt -> Packer CompTable ()
- putResourceRecord rr
- = do putDomainName $ rrName rr
- putRecordType $ rrType rr
- putBinary $ rrClass rr
- P.putWord32be $ rrTTL rr
-
- -- First, write a dummy data length.
+ putRecordDataWithLength :: rt -> dt -> Packer CompTable ()
+ putRecordDataWithLength rt dt
+ = do -- First, write a dummy data length.
offset <- bytesWrote
P.putWord16be 0
-- Second, write data.
- putRecordData (rrType rr) (rrData rr)
+ putRecordData rt dt
-- Third, rewrite the dummy length to an actual value.
offset' <- bytesWrote
withOffset offset
$ P.putWord16be (fromIntegral (offset' - offset - 2))
+ putResourceRecord :: ResourceRecord rt dt -> Packer CompTable ()
+ putResourceRecord rr
+ = do putDomainName $ rrName rr
+ putRecordType $ rrType rr
+ putBinary $ rrClass rr
+ P.putWord32be $ rrTTL rr
+ putRecordDataWithLength (rrType rr) (rrData rr)
+
+ getRecordDataWithLength :: rt -> Unpacker DecompTable dt
+ getRecordDataWithLength rt
+ = do len <- U.getWord16be
+ offset <- U.bytesRead
+ dat <- getRecordData rt
+ offset' <- U.bytesRead
+
+ let consumed = offset' - offset
+ when (consumed /= len)
+ $ fail ("getRecordData " ++ show rt ++ " consumed " ++ show consumed ++
+ " bytes but it had to consume " ++ show len ++ " bytes")
+
+ return dat
+
getResourceRecord :: rt -> Unpacker DecompTable (ResourceRecord rt dt)
getResourceRecord rt
= do name <- getDomainName
U.skip 2 -- record type
cl <- getBinary
ttl <- U.getWord32be
- U.skip 2 -- data length
- dat <- getRecordData rt
+ dat <- getRecordDataWithLength rt
return $ ResourceRecord {
rrName = name
, rrType = rt
Just srt
-> return srt
+data SOAFields
+ = SOAFields {
+ soaMasterNameServer :: !DomainName
+ , soaResponsibleMailbox :: !DomainName
+ , soaSerialNumber :: !Word32
+ , soaRefreshInterval :: !Word32
+ , soaRetryInterval :: !Word32
+ , soaExpirationLimit :: !Word32
+ , soaMinimumTTL :: !Word32
+ }
+ deriving (Show, Eq, Typeable)
+
data A = A deriving (Show, Eq, Typeable)
instance RecordType A HostAddress where
rtToInt _ = 1
putRecordData _ = putDomainName
getRecordData _ = getDomainName
+data MD = MD deriving (Show, Eq, Typeable)
+instance RecordType MD DomainName where
+ rtToInt _ = 3
+ putRecordData _ = putDomainName
+ getRecordData _ = getDomainName
+
+data MF = MF deriving (Show, Eq, Typeable)
+instance RecordType MF DomainName where
+ rtToInt _ = 4
+ putRecordData _ = putDomainName
+ getRecordData _ = getDomainName
+
data CNAME = CNAME deriving (Show, Eq, Typeable)
instance RecordType CNAME DomainName where
rtToInt _ = 5
putRecordData _ = putDomainName
getRecordData _ = getDomainName
+data SOA = SOA deriving (Show, Eq, Typeable)
+instance RecordType SOA SOAFields where
+ rtToInt _ = 6
+ putRecordData _ = \ soa ->
+ do putDomainName $ soaMasterNameServer soa
+ putDomainName $ soaResponsibleMailbox soa
+ P.putWord32be $ soaSerialNumber soa
+ P.putWord32be $ soaRefreshInterval soa
+ P.putWord32be $ soaRetryInterval soa
+ P.putWord32be $ soaExpirationLimit soa
+ P.putWord32be $ soaMinimumTTL soa
+ getRecordData _ = do master <- getDomainName
+ mail <- getDomainName
+ serial <- U.getWord32be
+ refresh <- U.getWord32be
+ retry <- U.getWord32be
+ expire <- U.getWord32be
+ ttl <- U.getWord32be
+ return SOAFields {
+ soaMasterNameServer = master
+ , soaResponsibleMailbox = mail
+ , soaSerialNumber = serial
+ , soaRefreshInterval = refresh
+ , soaRetryInterval = retry
+ , soaExpirationLimit = expire
+ , soaMinimumTTL = ttl
+ }
+
+data MB = MB deriving (Show, Eq, Typeable)
+instance RecordType MB DomainName where
+ rtToInt _ = 7
+ putRecordData _ = putDomainName
+ getRecordData _ = getDomainName
+
+data MG = MG deriving (Show, Eq, Typeable)
+instance RecordType MG DomainName where
+ rtToInt _ = 8
+ putRecordData _ = putDomainName
+ getRecordData _ = getDomainName
+
+data MR = MR deriving (Show, Eq, Typeable)
+instance RecordType MR DomainName where
+ rtToInt _ = 9
+ putRecordData _ = putDomainName
+ getRecordData _ = getDomainName
+
+data NULL = NULL deriving (Show, Eq, Typeable)
+instance RecordType NULL BS.ByteString where
+ rtToInt _ = 10
+ putRecordData _ _ = fail "putRecordData NULL can't be defined"
+ getRecordData _ = fail "getRecordData NULL can't be defined"
+ putRecordDataWithLength _ = \ dat ->
+ do P.putWord16be $ fromIntegral $ BS.length dat
+ P.putByteString dat
+ getRecordDataWithLength _ = do len <- U.getWord16be
+ U.getByteString $ fromIntegral len
+
+data PTR = PTR deriving (Show, Eq, Typeable)
+instance RecordType PTR DomainName where
+ rtToInt _ = 12
+ putRecordData _ = putDomainName
+ getRecordData _ = getDomainName
+
data HINFO = HINFO deriving (Show, Eq, Typeable)
instance RecordType HINFO (BS.ByteString, BS.ByteString) where
- rtToInt _ = 13
- putRecordData _ (cpu, os) = do putCharString cpu
- putCharString os
- getRecordData _ = do cpu <- getCharString
- os <- getCharString
- return (cpu, os)
-
+ rtToInt _ = 13
+ putRecordData _ = \ (cpu, os) ->
+ do putCharString cpu
+ putCharString os
+ getRecordData _ = do cpu <- getCharString
+ os <- getCharString
+ return (cpu, os)
+
+data MINFO = MINFO deriving (Show, Eq, Typeable)
+instance RecordType MINFO (DomainName, DomainName) where
+ rtToInt _ = 14
+ putRecordData _ = \ (r, e) ->
+ do putDomainName r
+ putDomainName e
+ getRecordData _ = do r <- getDomainName
+ e <- getDomainName
+ return (r, e)
+
+data MX = MX deriving (Show, Eq, Typeable)
+instance RecordType MX (Word16, DomainName) where
+ rtToInt _ = 15
+ putRecordData _ = \ (pref, exch) ->
+ do P.putWord16be pref
+ putDomainName exch
+ getRecordData _ = do pref <- U.getWord16be
+ exch <- getDomainName
+ return (pref, exch)
+
+data TXT = TXT deriving (Show, Eq, Typeable)
+instance RecordType TXT [BS.ByteString] where
+ rtToInt _ = 16
+ putRecordData _ = mapM_ putCharString
+ getRecordData _ = fail "getRecordData TXT can't be defined"
+
+ getRecordDataWithLength _ = U.getWord16be >>= worker [] . fromIntegral
+ where
+ worker :: [BS.ByteString] -> Int -> Unpacker s [BS.ByteString]
+ worker soFar 0 = return (reverse soFar)
+ worker soFar n = do str <- getCharString
+ worker (str : soFar) (0 `max` n - 1 - BS.length str)
{-
data RecordType
{-
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 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 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 where
projects / haskell-dns.git / commitdiff