rosa-0.5.0.0: src/Main.hs

{-# 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