wip merging imports

diff --git a/NmcDom.hs b/NmcDom.hs
index 25dd84fcc5d96e373e710cd06ef6ded854f9bb2a..9edb79879f0e5cb3f469a27d95ee29ae5563106e 100644 (file)
--- a/NmcDom.hs
+++ b/NmcDom.hs
@@ -3,12 +3,10 @@
 module NmcDom   ( NmcDom(..)
                 , emptyNmcDom
                 , descendNmcDom
 module NmcDom   ( NmcDom(..)
                 , emptyNmcDom
                 , descendNmcDom

-                , queryNmcDom

                 , mergeImport
                 ) where
 
 import Data.ByteString.Lazy (ByteString)
                 , mergeImport
                 ) where
 
 import Data.ByteString.Lazy (ByteString)

-import qualified Data.ByteString.Lazy.Char8 as L (pack)

 import qualified Data.Text as T (unpack)
 import Data.List.Split
 import Data.Char
 import qualified Data.Text as T (unpack)
 import Data.List.Split
 import Data.Char


@@ -164,9 +162,9 @@ mergeNmcDom sub dom = dom  { domService = choose domService
 
 -- | Perform query and return error string or parsed domain object
 queryNmcDom ::
 
 -- | Perform query and return error string or parsed domain object
 queryNmcDom ::

-  (ByteString -> IO (Either String ByteString)) -- ^ query operation action
-  -> ByteString                                 -- ^ key
-  -> IO (Either String NmcDom)                  -- ^ error string or domain
+  (String -> IO (Either String ByteString)) -- ^ query operation action
+  -> String                                 -- ^ key
+  -> IO (Either String NmcDom)              -- ^ error string or domain

 queryNmcDom queryOp key = do
   l <- queryOp key
   case l of
 queryNmcDom queryOp key = do
   l <- queryOp key
   case l of


@@ -176,20 +174,20 @@ queryNmcDom queryOp key = do
       Just dom -> return $ Right dom
 
 -- | Try to fetch "import" object and merge it into the base domain
       Just dom -> return $ Right dom
 
 -- | Try to fetch "import" object and merge it into the base domain

---   Any errors are ignored, and nothing is merged.
+--   In case of errors they are ignored, and nothing is merged.

 --   Original "import" element is removed, but new imports from the
 --   imported objects are processed recursively until there are none.
 mergeImport ::
 --   Original "import" element is removed, but new imports from the
 --   imported objects are processed recursively until there are none.
 mergeImport ::

-  (ByteString -> IO (Either String ByteString)) -- ^ query operation action
-  -> NmcDom                                     -- ^ base domain
-  -> IO NmcDom                                  -- ^ result with merged import
+  (String -> IO (Either String ByteString)) -- ^ query operation action
+  -> NmcDom                                 -- ^ base domain
+  -> IO NmcDom                              -- ^ result with merged import

 mergeImport queryOp base = do
   let base' = base {domImport = Nothing}
   -- print base'
   case domImport base of
     Nothing  -> return base'
     Just key -> do
 mergeImport queryOp base = do
   let base' = base {domImport = Nothing}
   -- print base'
   case domImport base of
     Nothing  -> return base'
     Just key -> do

-      sub <- queryNmcDom queryOp (L.pack key)
+      sub <- queryNmcDom queryOp key

       case sub of
         Left  e    -> return base'
         Right sub' -> mergeImport queryOp $ sub' `mergeNmcDom` base'
       case sub of
         Left  e    -> return base'
         Right sub' -> mergeImport queryOp $ sub' `mergeNmcDom` base'

diff --git a/d/extra1 b/d/extra1
index 273d05a14817ec89bfaf17c82865eaaa88f18ed7..420adfc1aab97033140b99765b4fc7dfe550fc0e 100644 (file)
--- a/d/extra1
+++ b/d/extra1
@@ -1 +1 @@
-{"service":[["imap", "tcp", "0", "0", "143", "mail.host.com."],["smtp", "tcp", "0", "0", "143", "mail.host.com."]]}
+{"service":[["imap", "tcp", "0", "0", "143", "mail.host.com."],["smtp", "tcp", "0", "0", "143", "mail.host.com."]],"import":"d/extra2","ip":["1.2.3.4"]}

diff --git a/d/root b/d/root
index 7f6874a720bce7aceafabe754c56c1fda3ec5989..915ee35ae74861d22770b89a3a7d0b1d319b22dc 100644 (file)
--- a/d/root
+++ b/d/root
@@ -1 +1 @@
-{"info":{"description":"Dot-BIT Project - Official Website","registrar":"http://register.dot-bit.org"},"fingerprint":["30:B0:60:94:32:08:EC:F5:BE:DF:F4:BB:EE:52:90:2C:5D:47:62:46"],"ns":["ns0.web-sweet-web.net","ns1.web-sweet-web.net"],"map":{"":{"ns":["ns0.web-sweet-web.net","ns1.web-sweet-web.net"]}},"email":"register@dot-bit.org","import":"d/extra1"}
+{"info":{"description":"Dot-BIT Project - Official Website","registrar":"http://register.dot-bit.org"},"fingerprint":["30:B0:60:94:32:08:EC:F5:BE:DF:F4:BB:EE:52:90:2C:5D:47:62:46"],"ns":["ns0.web-sweet-web.net","ns1.web-sweet-web.net"],"map":{"":{"ns":["ns2.web-sweet-web.net","ns3.web-sweet-web.net"]}},"email":"register@dot-bit.org","import":"d/extra1"}

diff --git a/pdns-pipe-nmc.hs b/pdns-pipe-nmc.hs
index ed5d47c4a929723e42dbd57716c2c1fe4e9db169..d9ced8f3318629029611f1f5aff08e998dfebb73 100644 (file)
--- a/pdns-pipe-nmc.hs
+++ b/pdns-pipe-nmc.hs
@@ -51,11 +51,11 @@ qRsp rsp =
 
 -- NMC interface
 
 
 -- NMC interface
 

-queryOp :: Manager -> Config -> String -> ByteString
+queryOp :: Manager -> Config -> String -> String

         -> IO (Either String ByteString)
 queryOp mgr cfg qid key = do
   rsp <- runResourceT $
         -> IO (Either String ByteString)
 queryOp mgr cfg qid key = do
   rsp <- runResourceT $

-    httpLbs (qReq cfg key (L.pack qid)) mgr
+    httpLbs (qReq cfg (L.pack key) (L.pack qid)) mgr

   return $ qRsp rsp
 
 queryNmc :: Manager -> Config -> String -> String
   return $ qRsp rsp
 
 queryNmc :: Manager -> Config -> String -> String


@@ -63,10 +63,9 @@ queryNmc :: Manager -> Config -> String -> String
 queryNmc mgr cfg fqdn qid = do
   case reverse (splitOn "." fqdn) of
     "bit":dn:xs -> do
 queryNmc mgr cfg fqdn qid = do
   case reverse (splitOn "." fqdn) of
     "bit":dn:xs -> do

-      dom <- queryDom (queryOp mgr cfg qid) (L.pack ("d/" ++ dn))
-      return $ case dom of
-        Left  err -> Left err
-        Right dom -> Right $ descendNmc xs dom
+      dom <- mergeImport (queryOp mgr cfg qid) $
+                emptyNmcDom { domImport = Just ("d/" ++ dn)}
+      return $ Right $ descendNmcDom xs dom

     _           ->
       return $ Left "Only \".bit\" domain is supported"
 
     _           ->
       return $ Left "Only \".bit\" domain is supported"
 

diff --git a/test.hs b/test.hs
index 966186f62ef379ee6e39c3a7be31420efbbde670..eb3bfb9c4b8208efa7fe3205d0772fa3aef02ea8 100644 (file)
--- a/test.hs
+++ b/test.hs
@@ -4,14 +4,14 @@ module Main where
 
 import Prelude hiding (readFile)
 import Data.ByteString.Lazy (ByteString)
 
 import Prelude hiding (readFile)
 import Data.ByteString.Lazy (ByteString)

-import Data.ByteString.Lazy.Char8 (unpack, readFile)
+import Data.ByteString.Lazy.Char8 (readFile)

 import System.IO.Error
 import Control.Exception
 
 import NmcDom
 
 import System.IO.Error
 import Control.Exception
 
 import NmcDom
 

-queryOp :: ByteString -> IO (Either String ByteString)
-queryOp key = catch (readFile (unpack key) >>= return . Right)
+queryOp :: String -> IO (Either String ByteString)
+queryOp key = catch (readFile key >>= return . Right)

                     (\e -> return (Left (show (e :: IOException))))
 
 main = do
                     (\e -> return (Left (show (e :: IOException))))
 
 main = do