138 lines
3.5 KiB
Haskell
138 lines
3.5 KiB
Haskell
{-# LANGUAGE RecordWildCards #-}
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
|
|
-- | Main module
|
|
module Main where
|
|
|
|
-- Rosa modules
|
|
import Json
|
|
|
|
-- Networking
|
|
import Namecoin (rpcRequest, uri)
|
|
import Network.Wreq (get, responseBody)
|
|
import qualified Network.URI.Encode as U
|
|
|
|
-- IO
|
|
import Options.Applicative
|
|
import System.Directory (XdgDirectory(..), getXdgDirectory)
|
|
import qualified Data.Text.IO as T
|
|
|
|
-- Data manipulation
|
|
import Data.Text (Text)
|
|
import Data.Aeson (Value(..), encode, decode, toJSON)
|
|
import Data.HashMap.Strict (delete)
|
|
import Data.ByteString.Lazy.Char8 (pack, unpack)
|
|
|
|
-- Misc
|
|
import Data.Maybe (fromMaybe)
|
|
import Control.Lens (view)
|
|
import Control.Monad (when)
|
|
|
|
|
|
-- * CLI interface
|
|
|
|
-- | Program arguments record
|
|
data Options = Options
|
|
{ name :: String
|
|
, url :: String
|
|
, conf :: Maybe FilePath
|
|
, dnschain :: Bool
|
|
, block :: Bool
|
|
, raw :: Bool
|
|
}
|
|
|
|
-- | Program arguments parser
|
|
options :: Parser Options
|
|
options = Options
|
|
<$> strArgument
|
|
( metavar "NAME"
|
|
<> help "Namecoin name id" )
|
|
<*> strOption
|
|
( long "url"
|
|
<> short 'u'
|
|
<> value "http://namecoin.dns"
|
|
<> metavar "URL"
|
|
<> help "Use custom API URL" )
|
|
<*> (optional $ strOption $
|
|
long "conf"
|
|
<> short 'c'
|
|
<> metavar "FILE"
|
|
<> help "Use custom namecoin config file" )
|
|
<*> switch
|
|
( long "dnschain"
|
|
<> short 'd'
|
|
<> help "Use dnschain API " )
|
|
<*> switch
|
|
( long "block"
|
|
<> short 'b'
|
|
<> help "Show blockchain data" )
|
|
<*> switch
|
|
( long "raw"
|
|
<> short 'r'
|
|
<> help "Print raw JSON data" )
|
|
|
|
|
|
-- | Program description
|
|
description :: ParserInfo Options
|
|
description = info (helper <*> options)
|
|
( fullDesc
|
|
<> progDesc "Query the namecoin blockchain"
|
|
<> footer "Stat rosa pristina nomine, nomina nuda tenemus." )
|
|
|
|
|
|
|
|
-- * Program
|
|
|
|
-- | Main function
|
|
main :: IO ()
|
|
main = execParser description >>= exec where
|
|
exec Options{..} =
|
|
if dnschain
|
|
then doDnschain url name raw block
|
|
else doLocal name raw 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 -> Bool -> Maybe FilePath -> IO ()
|
|
doLocal name raw 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
|
|
if raw
|
|
then putStrLn (unpack $ encode res)
|
|
else do
|
|
pprint $ tryParse (res |: "value")
|
|
when block (pprint blockInfo)
|
|
where
|
|
tryParse = fromMaybe (res |. "value") . decode . pack
|
|
blockInfo = toJSON (delete "value" res)
|
|
|
|
|
|
-- | Connect to dnschain API endpoint
|
|
doDnschain :: String -> String -> Bool -> Bool -> IO ()
|
|
doDnschain url name raw block = do
|
|
body <- view responseBody <$> get (url++"/v1/namecoin/key/"++U.encode name)
|
|
if raw
|
|
then putStrLn (unpack body)
|
|
else do
|
|
case decode body of
|
|
Nothing -> putStrLn "Error parsing data"
|
|
Just res -> putStrLn $
|
|
if block
|
|
then repr res
|
|
else repr $ (res .| "data") .| "value"
|
|
|
|
where (Object x) .| y = x |. y
|