use RPC to talk to namecoind
This commit is contained in:
parent
16c7de690d
commit
bfe521cce8
@ -30,6 +30,6 @@ executable rosa
|
||||
other-extensions: RecordWildCards, OverloadedStrings
|
||||
build-depends: base >=4.8 && <5.0 , aeson, text,
|
||||
vector, unordered-containers,
|
||||
wreq, lens >=4.4, bytestring,
|
||||
optparse-applicative, process
|
||||
wreq, lens, bytestring, directory,
|
||||
optparse-applicative, namecoin-update
|
||||
ghc-options: -O2
|
||||
|
@ -16,7 +16,7 @@ obj |. key = case parse (.: key) obj of
|
||||
Error err -> toJSON err
|
||||
|
||||
|
||||
-- | Get the String value of a key
|
||||
-- | Get the 'String' value of a key
|
||||
(|:) :: Object -> Text -> String
|
||||
obj |: key = repr (obj |. key)
|
||||
|
||||
|
55
src/Main.hs
55
src/Main.hs
@ -4,17 +4,19 @@ module Main where
|
||||
|
||||
import Json
|
||||
|
||||
import Control.Lens
|
||||
import Control.Lens (view)
|
||||
import Control.Monad (when)
|
||||
import Namecoin (Error, rpcRequest, uri)
|
||||
import Network.Wreq (get, responseBody)
|
||||
import Data.Monoid
|
||||
import Data.Aeson (decode, toJSON)
|
||||
import Data.Maybe (fromJust)
|
||||
import System.Directory (XdgDirectory(..), getXdgDirectory)
|
||||
import Data.Aeson (Value(..), decode, toJSON)
|
||||
import Data.Maybe (fromJust, fromMaybe)
|
||||
import Data.HashMap.Strict (delete)
|
||||
import Data.ByteString.Lazy.Char8 (pack)
|
||||
import Data.Monoid
|
||||
import Options.Applicative
|
||||
import System.Process
|
||||
|
||||
import qualified Data.Text.IO as T
|
||||
|
||||
-- * CLI interface
|
||||
|
||||
@ -22,6 +24,7 @@ import System.Process
|
||||
data Options = Options
|
||||
{ name :: String
|
||||
, url :: String
|
||||
, conf :: Maybe FilePath
|
||||
, dnschain :: Bool
|
||||
, block :: Bool
|
||||
, raw :: Bool
|
||||
@ -36,9 +39,14 @@ options = Options
|
||||
<*> strOption
|
||||
( long "url"
|
||||
<> short 'u'
|
||||
<> value "http://dns.dnschain.net/"
|
||||
<> value "http://namecoin.dns"
|
||||
<> metavar "URL"
|
||||
<> help "Use custom api url" )
|
||||
<*> (optional $ strOption $
|
||||
long "conf"
|
||||
<> short 'c'
|
||||
<> metavar "FILE"
|
||||
<> help "Use custom api url" )
|
||||
<*> switch
|
||||
( long "dnschain"
|
||||
<> short 'd'
|
||||
@ -70,27 +78,38 @@ main = execParser description >>= exec where
|
||||
exec Options{..} =
|
||||
if dnschain
|
||||
then doDnschain url name raw
|
||||
else doLocal name block
|
||||
else doLocal name block conf
|
||||
|
||||
|
||||
-- | Load namecoin configuration
|
||||
apiURI :: Maybe FilePath -> IO String
|
||||
apiURI path = do
|
||||
path <- flip fromMaybe path <$> getXdgDirectory XdgConfig "namecoin"
|
||||
res <- uri <$> T.readFile path
|
||||
case res of
|
||||
Left err -> fail ("Couldn't load the configuration: " ++ err)
|
||||
Right uri -> return uri
|
||||
|
||||
|
||||
-- | Connect to local namecoin node
|
||||
doLocal :: String -> Bool -> IO ()
|
||||
doLocal name block = do
|
||||
out <- readProcess "namecoin-cli" ["name_show", name] ""
|
||||
case decode (pack out) of
|
||||
Nothing -> putStrLn "Error parsing data"
|
||||
Just res -> do
|
||||
pprint $ reparse (res |: "value")
|
||||
when block (pprint extra)
|
||||
doLocal :: String -> Bool -> Maybe FilePath -> IO ()
|
||||
doLocal name block conf = do
|
||||
uri <- apiURI conf
|
||||
req <- rpcRequest uri "name_show" [name]
|
||||
case req of
|
||||
Left err -> putStrLn ("The lookup failed: " ++ err)
|
||||
Right (Object res) -> do
|
||||
pprint $ tryParse (res |: "value")
|
||||
when block (pprint blockInfo)
|
||||
where
|
||||
reparse = fromJust . decode . pack
|
||||
extra = toJSON (delete "value" res)
|
||||
tryParse = fromMaybe (res |. "value") . decode . pack
|
||||
blockInfo = toJSON (delete "value" res)
|
||||
|
||||
|
||||
-- | Connect to dnschain api endpoint
|
||||
doDnschain :: String -> String -> Bool -> IO ()
|
||||
doDnschain url name raw = do
|
||||
body <- (^. responseBody) <$> get (url ++ name)
|
||||
body <- view responseBody <$> get (url++"/v1/namecoin/key/"++name)
|
||||
if raw
|
||||
then print body
|
||||
else putStrLn $
|
||||
|
Loading…
Reference in New Issue
Block a user