]> gitweb @ CieloNegro.org - haskell-dns.git/blobdiff - Network/DNS/Named/Zone.hs
ZoneFinder comes back
[haskell-dns.git] / Network / DNS / Named / Zone.hs
index 8311376661bf5b506d951f802234448aab79e677..f313beb3d1aab7c78f3b1fd1d0fdf4b920390719 100644 (file)
@@ -1,41 +1,73 @@
 module Network.DNS.Named.Zone
-    ( Zone(..)
-    , ZoneFinder(..)
+    ( ZoneFinder(..)
+    , fromZones
 
-    , defaultRootZone
+    , Zone(..)
+    , isInZone
+
+    , zoneSOARecord
+    , zoneNSRecord
     )
     where
 
 import Data.Maybe
 import Network.DNS.Message
-import Network.DNS.Named.Responder
-
+import Network.DNS.DomainMap
 
-data Zone
-    = Zone {
-        zoneName       :: !DomainName
-      , zoneResponders :: ![SomeResponder]
-      }
 
 class ZoneFinder a where
-    findZone :: a -> DomainName -> IO Zone
+    findZone :: a -> DomainName -> IO (Maybe Zone)
 
-instance ZoneFinder (DomainName -> Zone) where
-    findZone = (return .)
+instance ZoneFinder (DomainMap Zone) where
+    findZone = (return .) . flip nearest
 
-instance ZoneFinder (DomainName -> IO Zone) where
-    findZone = id
+instance ZoneFinder (IO (DomainMap Zone)) where
+    findZone = flip (fmap . nearest)
 
 instance ZoneFinder (DomainName -> Maybe Zone) where
-    findZone = ((return . fromMaybe defaultRootZone) .)
+    findZone = (return .)
 
 instance ZoneFinder (DomainName -> IO (Maybe Zone)) where
-    findZone = (fmap (fromMaybe defaultRootZone) .)
+    findZone = id
+
+
+fromZones :: [Zone] -> DomainMap Zone
+fromZones = fromList . map toPair
+    where
+      toPair z = (zoneName z, z)
 
 
-defaultRootZone :: Zone
-defaultRootZone
+data Zone
     = Zone {
-        zoneName       = mkDomainName "."
-      , zoneResponders = [] -- FIXME
+        zoneName        :: !DomainName
+      , zoneSOA         :: !(Maybe SOAFields)
+      , zoneRecordNames :: !(IO [DomainName])
+      , zoneResponder   :: !(DomainName -> IO [SomeRR])
       }
+
+isInZone :: DomainName -> Zone -> Bool
+isInZone name zone = zoneName zone `isZoneOf` name
+
+zoneSOARecord :: Zone -> Maybe SomeRR
+zoneSOARecord zone
+    = do soa <- zoneSOA zone
+         return $ wrapRecord
+                $ ResourceRecord {
+                        rrName  = zoneName zone
+                      , rrType  = SOA
+                      , rrClass = IN
+                      , rrTTL   = soaMinimumTTL soa
+                      , rrData  = soa
+                      }
+
+zoneNSRecord :: Zone -> Maybe SomeRR
+zoneNSRecord zone
+    = do soa <- zoneSOA zone
+         return $ wrapRecord
+                $ ResourceRecord {
+                        rrName  = zoneName zone
+                      , rrType  = NS
+                      , rrClass = IN
+                      , rrTTL   = soaMinimumTTL soa
+                      , rrData  = soaMasterNameServer soa
+                      }