From 8e28329b12d1cabd0038e5d86c8c8edd9dfe0e5e Mon Sep 17 00:00:00 2001
From: Kazu Yamamoto <kazu@iij.ad.jp>
Date: Mon, 5 Sep 2011 16:06:17 +0900
Subject: Supporting PTR.

---
 Network/DNS/Internal.hs |  6 ++++--
 Network/DNS/Lookup.hs   | 13 +++++++++++++
 Network/DNS/Response.hs |  1 +
 3 files changed, 18 insertions(+), 2 deletions(-)

(limited to 'Network')

diff --git a/Network/DNS/Internal.hs b/Network/DNS/Internal.hs
index 28063fc..f2dff00 100644
--- a/Network/DNS/Internal.hs
+++ b/Network/DNS/Internal.hs
@@ -18,7 +18,7 @@ type Domain = ByteString
 {-|
   Types for resource records.
 -}
-data TYPE = A | AAAA | NS | TXT | MX | CNAME | SOA
+data TYPE = A | AAAA | NS | TXT | MX | CNAME | SOA | PTR
           | UNKNOWN Int deriving (Eq, Show, Read)
 
 rrDB :: [(TYPE, Int)]
@@ -27,6 +27,7 @@ rrDB = [
   , (NS,     2)
   , (CNAME,  5)
   , (SOA,    6)
+  , (PTR,   12)
   , (MX,    15)
   , (TXT,   16)
   , (AAAA,  28)
@@ -125,7 +126,7 @@ data ResourceRecord = ResourceRecord {
 {-|
   Raw data format for each type.
 -}
-data RDATA = RD_NS Domain | RD_CNAME Domain | RD_MX Int Domain
+data RDATA = RD_NS Domain | RD_CNAME Domain | RD_MX Int Domain | RD_PTR Domain
            | RD_SOA Domain Domain Int Int Int Int Int
            | RD_A IPv4 | RD_AAAA IPv6 | RD_TXT ByteString
            | RD_OTH [Int] deriving (Eq)
@@ -138,6 +139,7 @@ instance Show RDATA where
   show (RD_AAAA aaaa) = show aaaa
   show (RD_TXT txt) = BS.unpack txt
   show (RD_SOA mn _ _ _ _ _ mi) = BS.unpack mn ++ " " ++ show mi
+  show (RD_PTR dom) = BS.unpack dom
   show (RD_OTH is) = show is
 
 ----------------------------------------------------------------
diff --git a/Network/DNS/Lookup.hs b/Network/DNS/Lookup.hs
index 79af339..728b0c6 100644
--- a/Network/DNS/Lookup.hs
+++ b/Network/DNS/Lookup.hs
@@ -6,6 +6,7 @@ module Network.DNS.Lookup (
     lookupA, lookupAAAA
   , lookupMX, lookupAviaMX, lookupAAAAviaMX
   , lookupTXT
+  , lookupPTR
   ) where
 
 import Control.Applicative
@@ -82,3 +83,15 @@ lookupTXT rlv dom = toTXT <$> DNS.lookup rlv dom TXT
     toTXT = maybe Nothing (Just . map unTag)
     unTag (RD_TXT x) = x
     unTag _ = error "lookupTXT"
+
+----------------------------------------------------------------
+
+{-|
+  Resolving 'Domain' and its preference by 'PTR'.
+-}
+lookupPTR :: Resolver -> Domain -> IO (Maybe [Domain])
+lookupPTR rlv dom = toPTR <$> DNS.lookup rlv dom PTR
+  where
+    toPTR = maybe Nothing (Just . map unTag)
+    unTag (RD_PTR dm) = dm
+    unTag _ = error "lookupPTR"
diff --git a/Network/DNS/Response.hs b/Network/DNS/Response.hs
index d746fc2..fdce3e3 100644
--- a/Network/DNS/Response.hs
+++ b/Network/DNS/Response.hs
@@ -126,6 +126,7 @@ decodeRData SOA _ = RD_SOA <$> decodeDomain
     decodeRetry   = getInt32
     decodeExpire  = getInt32
     decodeMinumun = getInt32
+decodeRData PTR _ = RD_PTR <$> decodeDomain
 
 decodeRData _  len = RD_OTH <$> getNBytes len
 
-- 
cgit v1.2.3