use RPC to talk to namecoind

This commit is contained in:
rnhmjoj 2017-05-17 20:50:03 +02:00
parent 16c7de690d
commit bfe521cce8
No known key found for this signature in database
GPG Key ID: 362BB82B7E496B7C
3 changed files with 41 additions and 22 deletions

View File

@ -28,8 +28,8 @@ executable rosa
hs-source-dirs: src
default-language: Haskell2010
other-extensions: RecordWildCards, OverloadedStrings
build-depends: base >=4.8 && <5.0, aeson, text,
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

View File

@ -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)

View File

@ -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 $