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