From: Eugene Crosser <crosser@average.org>
Date: Thu, 27 Mar 2014 22:45:18 +0000 (+0400)
Subject: wip main cycle
X-Git-Tag: 0.9.0.0~115
X-Git-Url: http://www.average.org/gitweb/?p=pdns-pipe-nmc.git;a=commitdiff_plain;h=26b23d266b588ea4b5bc4d53cbf479f9b40d26a0

wip main cycle
---

diff --git a/NmcJson.hs b/NmcJson.hs
index b744929..978fb04 100644
--- a/NmcJson.hs
+++ b/NmcJson.hs
@@ -98,14 +98,3 @@ instance FromJSON NmcRes where
                 <*> o .: "address"
                 <*> o .: "expires_in"
         parseJSON _ = empty
-
-main = do
-  let l = "{\"name\":\"d/dot-bit\",\"value\":\"{\\\"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\\\"}\",\"txid\":\"7412603f2e6c3459be56accc6e1f3646b603f3d4a4188119a4072f125c1340d5\",\"address\":\"Mw3KCQcqC44nm75w7r79ZifZbEqT8RetWn\",\"expires_in\":18915}"
-  let r = decode l :: Maybe NmcRes
-  case r of
-    Just resp -> do
-      let value = (resValue resp)
-      let dom = decode value :: Maybe NmcDom
-      print dom
-    Nothing   ->
-      print "Unparseable NMC response"
diff --git a/PowerDns.hs b/PowerDns.hs
index 7ed76e8..d93214f 100644
--- a/PowerDns.hs
+++ b/PowerDns.hs
@@ -1,4 +1,10 @@
-module PowerDns where
+module PowerDns ( RRType
+                , PdnsRequest(..)
+                , pdnsParse
+                , pdnsOut
+                ) where
+
+import NmcJson
 
 data RRType = RRTypeSRV   | RRTypeA   | RRTypeAAAA | RRTypeCNAME
             | RRTypeDNAME | RRTypeSOA | RRTypeRP   | RRTypeLOC
@@ -57,16 +63,5 @@ pdnsParse ver s =
                                             })
       _                         -> Left s
 
-{-
-pdnsOut :: String -> Either String PdnsRequest -> IO ()
-pdnsOut _   (Left e)   = putStrLn ("ERROR\tUnparseable request: " ++ e)
-pdnsOut uri (Right rq) = case rq of
-    PdnsRequestQ qn qt id lip rip eip -> do
-      dom <- queryNmc uri qn qt id
-      case dom of
-        Left  e      -> putStrLn ("ERROR\tNmc query error: " ++ e)
-        Right result -> print result
-    PdnsRequestAXFR xfrreq ->
-      putStrLn ("ERROR\t No support for AXFR " ++ xfrreq)
-    PdnsRequestPing -> putStrLn "OK"
--}
+pdnsOut :: NmcDom -> String
+pdnsOut d = show d
diff --git a/pdns-pipe-nmc.hs b/pdns-pipe-nmc.hs
index f61d7ba..a933c9c 100644
--- a/pdns-pipe-nmc.hs
+++ b/pdns-pipe-nmc.hs
@@ -83,18 +83,17 @@ main = do
   putStrLn $ "OK\tDnsNmc ready to serve, protocol v." ++ (show ver)
 
   mgr <- newManager def
-
-  print $ qReq cfg "d/nosuchdomain" "query-nmc"
-  rsp <- runResourceT $ httpLbs (qReq cfg "d/nosuchdomain" "query-nmc") mgr
-  print $ (statusCode . responseStatus) rsp
-  putStrLn "===== complete response is:"
-  print rsp
-  let rbody = responseBody rsp
-  putStrLn "===== response body is:"
-  print rbody
-  let result = parseJsonRpc rbody :: Either JsonRpcError NmcRes
-  putStrLn "===== parsed response is:"
-  print result
---  print $ parseJsonRpc (responseBody rsp)
-
-  --forever $ getLine >>= (pdnsOut uri) . (pdnsParse ver)
+  forever $ do
+    l <- getLine
+    case pdnsParse ver l of
+      Left e -> putStrLn $ "ERROR\t" ++ e
+      Right preq -> do
+        case preq of
+          PdnsRequestQ qn qt id lip rip eip -> do
+            ncres <- queryNmc mgr cfg (qName preq) (qType preq) (iD preq)
+            case ncres of
+              Left  e   -> putStrLn $ "ERROR\t" ++ e
+              Right dom -> putStrLn $ pdnsOut dom
+          PdnsRequestAXFR xfrreq ->
+            putStrLn ("ERROR\t No support for AXFR " ++ xfrreq)
+          PdnsRequestPing -> putStrLn "OK"