wip handling response

[pdns-pipe-nmc.git] / pdns-pipe-nmc.hs

diff --git a/pdns-pipe-nmc.hs b/pdns-pipe-nmc.hs
index 3d1e46d112705132f8d4ed2934ef20aa6ea69c4e..079e3b9cd9ab4014cb85016cc4d2892f78a94b3f 100644 (file)
--- a/pdns-pipe-nmc.hs
+++ b/pdns-pipe-nmc.hs
@@ -47,12 +47,14 @@ qReq cf q = applyBasicAuth (pack (rpcuser cf)) (pack (rpcpassword cf))
                 , method         = "PUT"
                 , requestHeaders = [ (hAccept,      "application/json")
                                    , (hContentType, "application/json")
                 , method         = "PUT"
                 , requestHeaders = [ (hAccept,      "application/json")
                                    , (hContentType, "application/json")

+                                   , (hConnection,  "Keep-Alive")

                                    ]
                 , requestBody    = RequestBodyLBS $ encode $
                                    JsonRpcRequest JsonRpcV1
                                                   "name_show"
                                                   [q]
                                                   (String "pdns-nmc")
                                    ]
                 , requestBody    = RequestBodyLBS $ encode $
                                    JsonRpcRequest JsonRpcV1
                                                   "name_show"
                                                   [q]
                                                   (String "pdns-nmc")

+                , checkStatus    = \_ _ _ -> Nothing

                 }
 
 -- NMC interface
                 }
 
 -- NMC interface


@@ -167,8 +169,17 @@ main = do
 
   mgr <- newManager def
 
 
   mgr <- newManager def
 

-  print $ qReq cfg "d/dot-bit"
-  rsp <- runResourceT $ httpLbs (qReq cfg "d/dot-bit") mgr
+  print $ qReq cfg "d/nosuchdomain"
+  rsp <- runResourceT $ httpLbs (qReq cfg "d/nosuchdomain") mgr
+  print $ (statusCode . responseStatus) rsp
+  putStrLn "===== complete response is:"

   print rsp
   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 $ getLine >>= (pdnsOut uri) . (pdnsParse ver)