1 {-# LANGUAGE OverloadedStrings #-}
7 import Data.ByteString.Lazy hiding (reverse, putStr, putStrLn)
8 import qualified Data.ByteString.Char8 as C (pack)
9 import qualified Data.ByteString.Lazy.Char8 as L (pack)
10 import qualified Data.Text as T (pack)
11 import Data.List.Split
12 import Data.Aeson (encode, decode, Value(..))
13 import Network.HTTP.Types
15 import Network.HTTP.Conduit
24 confFile = "/etc/namecoin.conf"
26 -- HTTP/JsonRpc interface
28 qReq :: Config -> String -> String -> Request m
29 qReq cf q id = applyBasicAuth (C.pack (rpcuser cf)) (C.pack (rpcpassword cf))
30 $ def { host = (C.pack (rpchost cf))
33 , requestHeaders = [ (hAccept, "application/json")
34 , (hContentType, "application/json")
35 , (hConnection, "Keep-Alive")
37 , requestBody = RequestBodyLBS $ encode $
38 JsonRpcRequest JsonRpcV1
42 , checkStatus = \_ _ _ -> Nothing
45 qRsp :: Response ByteString -> Either String ByteString
47 case parseJsonRpc (responseBody rsp) :: Either JsonRpcError NmcRes of
49 case (jrpcErrCode jerr) of
50 -4 -> Right "{}" -- this is how non-existent entry is returned
51 _ -> Left $ "JsonRpc error response: " ++ (show jerr)
52 Right jrsp -> Right $ resValue jrsp
56 queryNmc :: Manager -> Config -> String -> String
57 -> IO (Either String NmcDom)
58 queryNmc mgr cfg qid fqdn =
59 case reverse (splitOn "." fqdn) of
60 "bit":dn:xs -> descendNmcDom queryOp xs $ seedNmcDom dn
61 _ -> return $ Left "Only \".bit\" domain is supported"
64 rsp <- runResourceT $ httpLbs (qReq cfg key qid) mgr
72 cfg <- readConfig confFile
74 hSetBuffering stdin LineBuffering
75 hSetBuffering stdout LineBuffering
78 loopErr e = forever $ do
79 putStrLn $ "FAIL\t" ++ e
84 ["HELO", "1"] -> return 1
85 ["HELO", "2"] -> return 2
86 ["HELO", "3"] -> return 3
87 ["HELO", x ] -> loopErr $ "unsupported ABI version " ++ (show x)
88 _ -> loopErr $ "bad HELO " ++ (show s)
90 putStrLn $ "OK\tDnsNmc ready to serve, protocol v." ++ (show ver)
95 case pdnsParse ver l of
96 Left e -> putStr $ pdnsReport e
99 PdnsRequestQ qname qtype id _ _ _ ->
100 queryNmc mgr cfg id qname >>= putStr . (pdnsOut ver id qname qtype)
101 PdnsRequestAXFR xfrreq ->
102 putStr $ pdnsReport ("No support for AXFR " ++ xfrreq)
103 PdnsRequestPing -> putStrLn "END"
108 cfg <- readConfig confFile
109 mgr <- newManager def
110 queryNmc mgr cfg "askid" str >>= putStr . (pdnsOut 1 "askid" str RRTypeANY)