diff --git a/rosa.cabal b/rosa.cabal index 4c488c6..d13cd13 100644 --- a/rosa.cabal +++ b/rosa.cabal @@ -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 diff --git a/src/Json.hs b/src/Json.hs index 8ca033f..d35ef1c 100644 --- a/src/Json.hs +++ b/src/Json.hs @@ -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) diff --git a/src/Main.hs b/src/Main.hs index 19aae0a..7784197 100644 --- a/src/Main.hs +++ b/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 $