From f3ad40fd6916408dde9b9e6237b41828d90c1e34 Mon Sep 17 00:00:00 2001
From: PHO <pho@cielonegro.org>
Date: Thu, 28 May 2009 15:19:32 +0900
Subject: [PATCH] ZoneFinder comes back

---
 ExampleDNSServer.hs       | 46 +++++++++++++++++++--------------------
 Network/DNS/Named.hs      |  6 ++---
 Network/DNS/Named/Zone.hs | 28 +++++++++++++++++++++++-
 3 files changed, 52 insertions(+), 28 deletions(-)

diff --git a/ExampleDNSServer.hs b/ExampleDNSServer.hs
index 75b261a..1aae098 100644
--- a/ExampleDNSServer.hs
+++ b/ExampleDNSServer.hs
@@ -1,3 +1,4 @@
+import           Network.DNS.DomainMap (DomainMap)
 import           Network.DNS.Message
 import           Network.DNS.Named
 import           Network.DNS.Named.Config
@@ -5,7 +6,7 @@ import           Network.DNS.Named.Zone
 import           Network.Socket.IsString ()
 
 main :: IO ()
-main = runNamed cnf (return . findZone)
+main = runNamed cnf zones
     where
       cnf :: Config
       cnf = Config {
@@ -13,29 +14,26 @@ main = runNamed cnf (return . findZone)
             , cnfAllowTransfer = True
             }
 
-      findZone :: DomainName -> Maybe Zone
-      findZone name
-          | name `isInZone` zone = Just zone
-          | otherwise            = Nothing
-
-      zone :: Zone
-      zone = Zone {
-               zoneName = "cielonegro.org."
-             , zoneSOA  = Just SOAFields {
-                            soaMasterNameServer   = "ns.cielonegro.org."
-                          , soaResponsibleMailbox = "root.ns.cielonegro.org."
-                          , soaSerialNumber       = 2008022148
-                          , soaRefreshInterval    = 3600
-                          , soaRetryInterval      = 900
-                          , soaExpirationLimit    = 3600000
-                          , soaMinimumTTL         = 3600
-                          }
-             , zoneRecordNames = return [ "ns.cielonegro.org."
-                                        , "www.cielonegro.org."
-                                        , "git.cielonegro.org."
-                                        ]
-             , zoneResponder   = return . responder
-             }
+      zones :: DomainMap Zone
+      zones = fromZones
+              [ Zone {
+                  zoneName = "cielonegro.org."
+                , zoneSOA  = Just SOAFields {
+                               soaMasterNameServer   = "ns.cielonegro.org."
+                             , soaResponsibleMailbox = "root.ns.cielonegro.org."
+                             , soaSerialNumber       = 2008022148
+                             , soaRefreshInterval    = 3600
+                             , soaRetryInterval      = 900
+                             , soaExpirationLimit    = 3600000
+                             , soaMinimumTTL         = 3600
+                             }
+                , zoneRecordNames = return [ "ns.cielonegro.org."
+                                           , "www.cielonegro.org."
+                                           , "git.cielonegro.org."
+                                           ]
+                , zoneResponder   = return . responder
+                }
+              ]
 
       responder :: DomainName -> [SomeRR]
       responder name
diff --git a/Network/DNS/Named.hs b/Network/DNS/Named.hs
index 57570cf..7abdcd0 100644
--- a/Network/DNS/Named.hs
+++ b/Network/DNS/Named.hs
@@ -23,8 +23,8 @@ import           System.Posix.Signals
 import           System.IO
 
 
-runNamed :: Config -> (DomainName -> IO (Maybe Zone)) -> IO ()
-runNamed cnf findZone
+runNamed :: ZoneFinder zf => Config -> zf -> IO ()
+runNamed cnf zf
     = withSocketsDo $
       do installHandler sigPIPE Ignore Nothing
 
@@ -118,7 +118,7 @@ runNamed cnf findZone
 
       handleQuestion :: SomeQ -> IO (Builder ())
       handleQuestion (SomeQ q)
-          = do zoneM <- findZone (qName q)
+          = do zoneM <- findZone zf (qName q)
                case zoneM of
                  Nothing
                      -> return $ do unauthorise
diff --git a/Network/DNS/Named/Zone.hs b/Network/DNS/Named/Zone.hs
index c02ff4b..f313beb 100644
--- a/Network/DNS/Named/Zone.hs
+++ b/Network/DNS/Named/Zone.hs
@@ -1,5 +1,8 @@
 module Network.DNS.Named.Zone
-    ( Zone(..)
+    ( ZoneFinder(..)
+    , fromZones
+
+    , Zone(..)
     , isInZone
 
     , zoneSOARecord
@@ -9,6 +12,29 @@ module Network.DNS.Named.Zone
 
 import Data.Maybe
 import Network.DNS.Message
+import Network.DNS.DomainMap
+
+
+class ZoneFinder a where
+    findZone :: a -> DomainName -> IO (Maybe Zone)
+
+instance ZoneFinder (DomainMap Zone) where
+    findZone = (return .) . flip nearest
+
+instance ZoneFinder (IO (DomainMap Zone)) where
+    findZone = flip (fmap . nearest)
+
+instance ZoneFinder (DomainName -> Maybe Zone) where
+    findZone = (return .)
+
+instance ZoneFinder (DomainName -> IO (Maybe Zone)) where
+    findZone = id
+
+
+fromZones :: [Zone] -> DomainMap Zone
+fromZones = fromList . map toPair
+    where
+      toPair z = (zoneName z, z)
 
 
 data Zone
-- 
2.40.0