rosa-0.4.0.0: src/Main.hs

{-# LANGUAGE RecordWildCards, OverloadedStrings #-}
-- | Main module
module Main where

import Json

import Control.Lens                (view)
import Control.Monad               (when)
import Namecoin                    (Error, rpcRequest, uri)
import Network.Wreq                (get, responseBody)
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 qualified Data.Text.IO as T

-- * 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 api url" )
  <*> switch
      ( long "dnschain"
     <> short 'd'
     <> help "Use dnschain api" )
  <*> switch
      ( long "block"
     <> short 'b'
     <> help "Show blockchain data (require local connection)" )
  <*> 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
      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 -> 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
        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 <- view responseBody <$> get (url++"/v1/namecoin/key/"++name)
  if raw
    then print body
    else putStrLn $
      case decode body of
        Just res -> repr res
        Nothing  -> "Error parsing data"