wip main cycle

diff --git a/NmcJson.hs b/NmcJson.hs
index b7449297d3796aca706f78a645b0e49fba28f987..978fb04b67cda0bf2a00776e608eed12c1b844b0 100644 (file)
--- a/NmcJson.hs
+++ b/NmcJson.hs
@@ -98,14 +98,3 @@ instance FromJSON NmcRes where
                 <*> o .: "address"
                 <*> o .: "expires_in"
         parseJSON _ = empty
                 <*> 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 7ed76e8a24bc046dcb42a96382d932f20c4210cb..d93214f98d33352cfc2702ea8ba9e4e1889c7bb8 100644 (file)
--- 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
 
 data RRType = RRTypeSRV   | RRTypeA   | RRTypeAAAA | RRTypeCNAME
             | RRTypeDNAME | RRTypeSOA | RRTypeRP   | RRTypeLOC


@@ -57,16 +63,5 @@ pdnsParse ver s =
                                             })
       _                         -> Left 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 f61d7baecf5ae61faa20d39adeb62a0e208e7699..a933c9ca70ade2f57d3c3a46b91b80923bf41d90 100644 (file)
--- 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
   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"