import Data.Map.Lazy (Map, empty, lookup, insert, delete, size)
import Data.Aeson (encode, decode, Value(..))
import Network.HTTP.Types
-import Data.Conduit
-import Network.HTTP.Conduit
+import Network.HTTP.Client
+import Data.Default (def)
import JsonRpcClient
import Config
-- HTTP/JsonRpc interface
-qReq :: Config -> String -> Int -> Request m
+qReq :: Config -> String -> Int -> Request
qReq cf q id = applyBasicAuth (C.pack (rpcuser cf)) (C.pack (rpcpassword cf))
$ def { host = (C.pack (rpchost cf))
, port = (rpcport cf)
case parseJsonRpc (responseBody rsp) :: Either JsonRpcError NmcRes of
Left jerr ->
case (jrpcErrCode jerr) of
- -4 -> Right "{}" -- this is how non-existent entry is returned
- _ -> Left $ "JsonRpc error response: " ++ (show jerr)
+ (-4) -> Right "{}" -- this is how non-existent entry is returned
+ _ -> Left $ "JsonRpc error response: " ++ (show jerr)
Right jrsp -> Right $ resValue jrsp
-- NMC interface
queryOpNmc cfg mgr qid key =
- runResourceT (httpLbs (qReq cfg key qid) mgr) >>= return . qRsp
+ httpLbs (qReq cfg key qid) mgr >>= return . qRsp
queryOpFile key = catch (readFile key >>= return . Right)
(\e -> return (Left (show (e :: IOException))))
putStrLn $ "OK\tDnsNmc ready to serve, protocol v." ++ (show ver)
- mgr <- newManager def
+ mgr <- newManager defaultManagerSettings
let
fetch = lookup
case preq of
PdnsRequestQ qname qtype id _ _ _ -> do
io $ queryDom (queryOpNmc cfg mgr id) qname
- >>= putStr . (pdnsOut ver count qname qtype)
+ >>= putStr . (pdnsOutQ ver count qname qtype)
-- debug
io $ putStrLn $ "LOG\tRequest number " ++ (show count)
++ " id: " ++ (show id)
runStateT mainloop (0, empty) >> return ()
+-- helper for command-line tools
+
+pdnsOut key qt dom =
+ case qt of
+ "AXFR" -> pdnsOutXfr 1 (-1) key dom
+ _ -> pdnsOutQ 1 (-1) key (rrType qt) dom
+
-- query by key from Namecoin
mainOne key qt = do
cfg <- readConfig confFile
- mgr <- newManager def
+ mgr <- newManager defaultManagerSettings
dom <- queryDom (queryOpNmc cfg mgr (-1)) key
putStrLn $ ppShow dom
- putStr $ pdnsOut 1 (-1) key qt dom
+ putStr $ pdnsOut key qt dom
-- using file backend for testing json domain data
mainFile key qt = do
dom <- queryDom queryOpFile key
putStrLn $ ppShow dom
- putStr $ pdnsOut 1 (-1) key qt dom
+ putStr $ pdnsOut key qt dom
-- Entry point
args <- getArgs
case args of
[] -> mainPdnsNmc
- [key, qtype] -> mainOne key (rrType qtype)
- ["-f" ,key, qtype] -> mainFile key (rrType qtype)
- _ -> error $ "usage: empty args, or \"[-f] <fqdn> <QTYPE>\" (type in caps)"
+ [key, qtype] -> mainOne key qtype
+ ["-f" ,key, qtype] -> mainFile key qtype
+ _ -> error $ "usage: empty args, or \"[-f] <fqdn> {<TYPE>|ANY|AXFR}\" (type in caps)"