mirror of
https://github.com/kazu-yamamoto/dns.git
synced 2024-10-05 18:17:09 +03:00
adding resourceDataType method
This commit is contained in:
Kazu Yamamoto
parent
339ebb4931
commit
95f80e2777
@ -71,6 +71,7 @@ module Network.DNS.Types (
|
||||
, RData(..)
|
||||
, toRData
|
||||
, fromRData
|
||||
, rdataType
|
||||
, SGet
|
||||
, SPut
|
||||
-- * DNS Message
|
||||
|
||||
@ -146,4 +146,4 @@ switch NSEC3PARAM l = toRData <$> decodeResourceData (Proxy :: Proxy RD_NSEC3PAR
|
||||
switch TLSA l = toRData <$> decodeResourceData (Proxy :: Proxy RD_TLSA) l
|
||||
switch CDS l = toRData <$> decodeResourceData (Proxy :: Proxy RD_CDS) l
|
||||
switch CDNSKEY l = toRData <$> decodeResourceData (Proxy :: Proxy RD_CDNSKEY) l
|
||||
switch _ _ = undefined
|
||||
switch typ l = toRData <$> RD_Unknown typ <$> getNByteString l
|
||||
|
||||
@ -21,6 +21,7 @@ import Network.DNS.Types.EDNS
|
||||
---------------------------------------------------------------
|
||||
|
||||
class (Typeable a, Eq a, Show a) => ResourceData a where
|
||||
resourceDataType :: a -> TYPE
|
||||
encodeResourceData :: a -> SPut
|
||||
decodeResourceData :: proxy a -> Int -> SGet a
|
||||
copyResourceData :: a -> a
|
||||
@ -41,12 +42,16 @@ instance Show RData where
|
||||
instance Eq RData where
|
||||
x@(RData xi) == y@(RData yi) = typeOf x == typeOf y && Just xi == cast yi
|
||||
|
||||
rdataType :: RData -> TYPE
|
||||
rdataType (RData x) = resourceDataType x
|
||||
|
||||
---------------------------------------------------------------
|
||||
|
||||
-- | IPv4 Address (RFC1035)
|
||||
newtype RD_A = RD_A IPv4 deriving Eq
|
||||
|
||||
instance ResourceData RD_A where
|
||||
resourceDataType = \_ -> A
|
||||
encodeResourceData = \(RD_A ipv4) -> mconcat $ map putInt8 (fromIPv4 ipv4)
|
||||
decodeResourceData = \_ _ -> RD_A . toIPv4 <$> getNBytes 4
|
||||
copyResourceData x = x
|
||||
@ -60,6 +65,7 @@ instance Show RD_A where
|
||||
newtype RD_NS = RD_NS Domain deriving (Eq)
|
||||
|
||||
instance ResourceData RD_NS where
|
||||
resourceDataType = \_ -> NS
|
||||
encodeResourceData = \(RD_NS d) -> putDomain d
|
||||
decodeResourceData = \_ _ -> RD_NS <$> getDomain
|
||||
copyResourceData (RD_NS dom) = RD_NS $ B.copy dom
|
||||
@ -73,6 +79,7 @@ instance Show RD_NS where
|
||||
newtype RD_CNAME = RD_CNAME Domain deriving (Eq)
|
||||
|
||||
instance ResourceData RD_CNAME where
|
||||
resourceDataType = \_ -> CNAME
|
||||
encodeResourceData = \(RD_CNAME d) -> putDomain d
|
||||
decodeResourceData = \_ _ -> RD_CNAME <$> getDomain
|
||||
copyResourceData (RD_CNAME dom) = RD_CNAME $ B.copy dom
|
||||
@ -94,6 +101,7 @@ data RD_SOA = RD_SOA {
|
||||
} deriving (Eq)
|
||||
|
||||
instance ResourceData RD_SOA where
|
||||
resourceDataType = \_ -> SOA
|
||||
encodeResourceData = \RD_SOA{..} ->
|
||||
mconcat [ putDomain soaMname
|
||||
, putMailbox soaRname
|
||||
@ -130,6 +138,7 @@ instance Show RD_SOA where
|
||||
newtype RD_NULL = RD_NULL ByteString deriving (Eq)
|
||||
|
||||
instance ResourceData RD_NULL where
|
||||
resourceDataType = \_ -> NULL
|
||||
encodeResourceData = \(RD_NULL bytes) -> putByteString bytes
|
||||
decodeResourceData = \_ len -> RD_NULL <$> getNByteString len
|
||||
copyResourceData (RD_NULL bytes) = RD_NULL $ B.copy bytes
|
||||
@ -143,6 +152,7 @@ instance Show RD_NULL where
|
||||
newtype RD_PTR = RD_PTR Domain deriving (Eq)
|
||||
|
||||
instance ResourceData RD_PTR where
|
||||
resourceDataType = \_ -> PTR
|
||||
encodeResourceData = \(RD_PTR d) -> putDomain d
|
||||
decodeResourceData = \_ _ -> RD_PTR <$> getDomain
|
||||
copyResourceData (RD_PTR dom) = RD_PTR $ B.copy dom
|
||||
@ -159,6 +169,7 @@ data RD_MX = RD_MX {
|
||||
} deriving (Eq)
|
||||
|
||||
instance ResourceData RD_MX where
|
||||
resourceDataType = \_ -> MX
|
||||
encodeResourceData = \RD_MX{..} ->
|
||||
mconcat [ put16 mxPreference
|
||||
, putDomain mxExchange
|
||||
@ -175,6 +186,7 @@ instance Show RD_MX where
|
||||
newtype RD_TXT = RD_TXT ByteString deriving (Eq)
|
||||
|
||||
instance ResourceData RD_TXT where
|
||||
resourceDataType = \_ -> TXT
|
||||
encodeResourceData = \(RD_TXT txt0) -> putTXT txt0
|
||||
where
|
||||
putTXT txt = let (!h, !t) = BS.splitAt 255 txt
|
||||
@ -210,6 +222,7 @@ instance Show RD_TXT where
|
||||
data RD_RP = RD_RP Mailbox Domain deriving (Eq)
|
||||
|
||||
instance ResourceData RD_RP where
|
||||
resourceDataType = \_ -> RP
|
||||
encodeResourceData = \(RD_RP mbox d) -> putMailbox mbox <> putDomain d
|
||||
decodeResourceData = \_ _ -> RD_RP <$> getMailbox <*> getDomain
|
||||
copyResourceData (RD_RP mbox dname) = RD_RP (B.copy mbox) (B.copy dname)
|
||||
@ -224,6 +237,7 @@ instance Show RD_RP where
|
||||
newtype RD_AAAA = RD_AAAA IPv6 deriving (Eq)
|
||||
|
||||
instance ResourceData RD_AAAA where
|
||||
resourceDataType = \_ -> AAAA
|
||||
encodeResourceData = \(RD_AAAA ipv6) -> mconcat $ map putInt8 (fromIPv6b ipv6)
|
||||
decodeResourceData = \_ _ -> RD_AAAA . toIPv6b <$> getNBytes 16
|
||||
copyResourceData x = x
|
||||
@ -242,6 +256,7 @@ data RD_SRV = RD_SRV {
|
||||
} deriving (Eq)
|
||||
|
||||
instance ResourceData RD_SRV where
|
||||
resourceDataType = \_ -> SRV
|
||||
encodeResourceData = \RD_SRV{..} ->
|
||||
mconcat [ put16 srvPriority
|
||||
, put16 srvWeight
|
||||
@ -266,6 +281,7 @@ instance Show RD_SRV where
|
||||
newtype RD_DNAME = RD_DNAME Domain deriving (Eq)
|
||||
|
||||
instance ResourceData RD_DNAME where
|
||||
resourceDataType = \_ -> DNAME
|
||||
encodeResourceData = \(RD_DNAME d) -> putDomain d
|
||||
decodeResourceData = \_ _ -> RD_DNAME <$> getDomain
|
||||
copyResourceData (RD_DNAME dom) = RD_DNAME $ B.copy dom
|
||||
@ -279,6 +295,7 @@ instance Show RD_DNAME where
|
||||
newtype RD_OPT = RD_OPT [OData] deriving (Eq)
|
||||
|
||||
instance ResourceData RD_OPT where
|
||||
resourceDataType = \_ -> OPT
|
||||
encodeResourceData = \(RD_OPT options) -> mconcat $ fmap putOData options
|
||||
decodeResourceData = \_ len ->
|
||||
RD_OPT <$> sGetMany "EDNS option" len getoption
|
||||
@ -303,6 +320,7 @@ data RD_TLSA = RD_TLSA {
|
||||
} deriving (Eq)
|
||||
|
||||
instance ResourceData RD_TLSA where
|
||||
resourceDataType = \_ -> TLSA
|
||||
encodeResourceData = \RD_TLSA{..} ->
|
||||
mconcat [ put8 tlsaUsage
|
||||
, put8 tlsaSelector
|
||||
@ -326,12 +344,13 @@ instance Show RD_TLSA where
|
||||
----------------------------------------------------------------
|
||||
|
||||
-- | Unknown resource data
|
||||
newtype RD_Unknown = RD_Unknown ByteString deriving (Eq, Show)
|
||||
data RD_Unknown = RD_Unknown TYPE ByteString deriving (Eq, Show)
|
||||
|
||||
instance ResourceData RD_Unknown where
|
||||
encodeResourceData = \(RD_Unknown bytes) -> putByteString bytes
|
||||
decodeResourceData = \_ len -> RD_Unknown <$> getNByteString len
|
||||
copyResourceData (RD_Unknown x) = RD_Unknown $ B.copy x
|
||||
resourceDataType = \(RD_Unknown typ _) -> typ
|
||||
encodeResourceData = \(RD_Unknown _ bytes) -> putByteString bytes
|
||||
decodeResourceData = undefined -- never used
|
||||
copyResourceData (RD_Unknown t x) = RD_Unknown t $ B.copy x
|
||||
|
||||
----------------------------------------------------------------
|
||||
|
||||
|
||||
@ -61,6 +61,7 @@ data RD_RRSIG = RD_RRSIG {
|
||||
} deriving (Eq, Ord)
|
||||
|
||||
instance ResourceData RD_RRSIG where
|
||||
resourceDataType = \_ -> RRSIG
|
||||
encodeResourceData = \RD_RRSIG{..} ->
|
||||
mconcat [ put16 $ fromTYPE rrsigType
|
||||
, put8 rrsigKeyAlg
|
||||
@ -130,6 +131,7 @@ data RD_DS = RD_DS {
|
||||
} deriving (Eq)
|
||||
|
||||
instance ResourceData RD_DS where
|
||||
resourceDataType = \_ -> DS
|
||||
encodeResourceData = \RD_DS{..} ->
|
||||
mconcat [ put16 dsKeyTag
|
||||
, put8 dsAlgorithm
|
||||
@ -158,6 +160,7 @@ data RD_NSEC = RD_NSEC {
|
||||
} deriving (Eq)
|
||||
|
||||
instance ResourceData RD_NSEC where
|
||||
resourceDataType = \_ -> NSEC
|
||||
encodeResourceData = \RD_NSEC{..} ->
|
||||
putDomain nsecNextDomain <> putNsecTypes nsecTypes
|
||||
decodeResourceData = \_ len -> do
|
||||
@ -183,6 +186,7 @@ data RD_DNSKEY = RD_DNSKEY {
|
||||
} deriving (Eq)
|
||||
|
||||
instance ResourceData RD_DNSKEY where
|
||||
resourceDataType = \_ -> DNSKEY
|
||||
encodeResourceData = \RD_DNSKEY{..} ->
|
||||
mconcat [ put16 dnskeyFlags
|
||||
, put8 dnskeyProtocol
|
||||
@ -217,6 +221,7 @@ data RD_NSEC3 = RD_NSEC3 {
|
||||
} deriving (Eq)
|
||||
|
||||
instance ResourceData RD_NSEC3 where
|
||||
resourceDataType = \_ -> NSEC3
|
||||
encodeResourceData = \RD_NSEC3{..} ->
|
||||
mconcat [ put8 nsec3HashAlgorithm
|
||||
, put8 nsec3Flags
|
||||
@ -258,6 +263,7 @@ data RD_NSEC3PARAM = RD_NSEC3PARAM {
|
||||
} deriving (Eq)
|
||||
|
||||
instance ResourceData RD_NSEC3PARAM where
|
||||
resourceDataType = \_ -> NSEC3PARAM
|
||||
encodeResourceData = \RD_NSEC3PARAM{..} ->
|
||||
mconcat [ put8 nsec3paramHashAlgorithm
|
||||
, put8 nsec3paramFlags
|
||||
@ -284,6 +290,7 @@ instance Show RD_NSEC3PARAM where
|
||||
newtype RD_CDS = RD_CDS RD_DS deriving (Eq)
|
||||
|
||||
instance ResourceData RD_CDS where
|
||||
resourceDataType = \_ -> CDS
|
||||
encodeResourceData = \(RD_CDS ds) -> encodeResourceData ds
|
||||
decodeResourceData = \_ len -> RD_CDS <$> decodeResourceData (Proxy :: Proxy RD_DS) len
|
||||
copyResourceData = \(RD_CDS ds) -> RD_CDS $ copyResourceData ds
|
||||
@ -297,6 +304,7 @@ instance Show RD_CDS where
|
||||
newtype RD_CDNSKEY = RD_CDNSKEY RD_DNSKEY deriving (Eq)
|
||||
|
||||
instance ResourceData RD_CDNSKEY where
|
||||
resourceDataType = \_ -> CDNSKEY
|
||||
encodeResourceData = \(RD_CDNSKEY dnskey) -> encodeResourceData dnskey
|
||||
decodeResourceData = \_ len -> RD_CDNSKEY <$> decodeResourceData (Proxy :: Proxy RD_DNSKEY) len
|
||||
copyResourceData = \(RD_CDNSKEY dnskey) -> RD_CDNSKEY $ copyResourceData dnskey
|
||||
|
||||
Loading…
Reference in New Issue
Block a user