Change default connection method

This commit is contained in:
Rnhmjoj 2014-11-25 00:20:24 +01:00
parent 8d1cb7b3ef
commit 28ec0bc1e5

67
Main.hs
View File

@ -4,7 +4,6 @@ import Network.Wreq (get, responseBody)
import Data.Aeson (decode, toJSON) import Data.Aeson (decode, toJSON)
import Data.Maybe (fromJust) import Data.Maybe (fromJust)
import Data.HashMap.Strict (delete) import Data.HashMap.Strict (delete)
import Control.Monad (when)
import Control.Lens import Control.Lens
import Control.Applicative import Control.Applicative
@ -15,21 +14,21 @@ import System.Process
import Json import Json
data ProgArgs = ProgArgs data ProgArgs = ProgArgs
{ name :: String { name :: String
, url :: String , url :: String
, local :: Bool , dnschain :: Bool
, block :: Bool , block :: Bool
, raw :: Bool , raw :: Bool
} deriving (Show) } deriving (Show)
parser :: ParserSpec ProgArgs parser :: ParserSpec ProgArgs
parser = ProgArgs parser = ProgArgs
`parsedBy` reqPos "name" `Descr` "Namecoin name id" `parsedBy` reqPos "name" `Descr` "Namecoin name id"
`andBy` optFlag "http://dns.dnschain.net/" "url" `andBy` optFlag "http://dns.dnschain.net/" "url"
`Descr` "Use custom dnschain API url" `Descr` "Use custom api url"
`andBy` boolFlag "local" `Descr` "Use local namecoind db" `andBy` boolFlag "dnschain" `Descr` "Use dnschain api"
`andBy` boolFlag "block" `Descr` "Show blockchain data (require local connecton)" `andBy` boolFlag "block" `Descr` "Show blockchain data (require local connecton)"
`andBy` boolFlag "raw" `Descr` "Print raw JSON data" `andBy` boolFlag "raw" `Descr` "Print raw JSON data"
interface :: IO (CmdLnInterface ProgArgs) interface :: IO (CmdLnInterface ProgArgs)
interface = interface =
@ -37,28 +36,34 @@ interface =
(`setAppEpilog` "Stat rosa pristina nomine, nomina nuda tenemus.") <$> (`setAppEpilog` "Stat rosa pristina nomine, nomina nuda tenemus.") <$>
mkApp parser mkApp parser
handleLocal :: String -> Bool -> IO ()
handleLocal name block = do
out <- readProcess "namecoind" ["name_show", name] ""
case decode (C.pack out) of
Just res -> do
jprint $ reparse (res |: "value")
if block then jprint extra else return ()
where
reparse = fromJust . decode . C.pack
extra = toJSON $ delete "value" res
Nothing -> putStrLn "Error parsing data"
handleDnschain :: String -> String -> Bool -> IO ()
handleDnschain url name raw = do
req <- get (url ++ name)
let body = req ^. responseBody
if raw
then print body
else putStrLn $
case decode body of
Just res -> repr res
Nothing -> "Error parsing data"
exec :: ProgArgs -> IO () exec :: ProgArgs -> IO ()
exec args@ProgArgs{..} = exec args@ProgArgs{..} =
if local if dnschain
then do then handleDnschain url name raw
out <- readProcess "namecoind" ["name_show", name] "" else handleLocal name block
case decode (C.pack out) of
Just res -> do
putStrLn (repr value)
when block $ putStrLn (repr extra)
where
value = fromJust . decode . C.pack $ res |: "value"
extra = toJSON $ delete "value" res
Nothing -> putStrLn "Error parsing data"
else do
req <- get (url ++ name)
let body = req ^. responseBody
if raw
then print body
else putStrLn $
case decode body of
Just res -> repr res
Nothing -> "Error parsing data"
main :: IO () main :: IO ()
main = interface >>= flip runApp exec main = interface >>= flip runApp exec