From: Eugene Crosser <crosser@average.org>
Date: Sun, 13 Apr 2014 07:44:39 +0000 (+0400)
Subject: wip merging imports
X-Git-Tag: 0.9.0.0~85
X-Git-Url: http://average.org/gitweb/?a=commitdiff_plain;h=f0b5926d1268770bbcbcb8af7036238ae066d400;p=pdns-pipe-nmc.git

wip merging imports
---

diff --git a/NmcDom.hs b/NmcDom.hs
index 25dd84f..9edb798 100644
--- a/NmcDom.hs
+++ b/NmcDom.hs
@@ -3,12 +3,10 @@
 module NmcDom   ( NmcDom(..)
                 , emptyNmcDom
                 , descendNmcDom
-                , queryNmcDom
                 , 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
@@ -164,9 +162,9 @@ mergeNmcDom sub dom = dom  { domService = choose domService
 
 -- | 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
@@ -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
---   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 ::
-  (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
-      sub <- queryNmcDom queryOp (L.pack key)
+      sub <- queryNmcDom queryOp key
       case sub of
         Left  e    -> return base'
         Right sub' -> mergeImport queryOp $ sub' `mergeNmcDom` base'
diff --git a/d/extra1 b/d/extra1
index 273d05a..420adfc 100644
--- 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 7f6874a..915ee35 100644
--- 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 ed5d47c..d9ced8f 100644
--- a/pdns-pipe-nmc.hs
+++ b/pdns-pipe-nmc.hs
@@ -51,11 +51,11 @@ qRsp rsp =
 
 -- NMC interface
 
-queryOp :: Manager -> Config -> String -> ByteString
+queryOp :: Manager -> Config -> String -> String
         -> 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
@@ -63,10 +63,9 @@ queryNmc :: Manager -> Config -> String -> String
 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"
 
diff --git a/test.hs b/test.hs
index 966186f..eb3bfb9 100644
--- a/test.hs
+++ b/test.hs
@@ -4,14 +4,14 @@ module Main where
 
 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
 
-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