235 lines
8.0 KiB
Haskell
235 lines
8.0 KiB
Haskell
{-# LANGUAGE OverloadedStrings #-}
|
|
|
|
module Main where
|
|
|
|
import Control.Monad (void)
|
|
import Control.Monad.IO.Class (liftIO)
|
|
import qualified Data.ByteString as B
|
|
import Data.Configurator
|
|
import Data.Default (def)
|
|
import Data.Sort
|
|
import qualified Data.Text as T
|
|
import qualified Data.Text.IO as TIO
|
|
import Data.Time.Clock.POSIX
|
|
import System.Console.StructuredCLI
|
|
import System.Environment (getArgs)
|
|
import System.Exit
|
|
import System.IO
|
|
import Text.Read (readMaybe)
|
|
import ZcashHaskell.Types
|
|
import Zenith.CLI
|
|
import Zenith.Core (clearSync, testSync)
|
|
import Zenith.Types (Config(..), ZcashAddress(..), ZcashPool(..), ZcashTx(..))
|
|
import Zenith.Utils
|
|
import Zenith.Zcashd
|
|
|
|
prompt :: String -> IO String
|
|
prompt text = do
|
|
putStr text
|
|
hFlush stdout
|
|
getLine
|
|
|
|
root :: B.ByteString -> B.ByteString -> Commands ()
|
|
root user pwd = do
|
|
list user pwd
|
|
txs user pwd
|
|
sendZec user pwd
|
|
copyAdd user pwd
|
|
createUA user pwd
|
|
processUri user pwd
|
|
command "exit" "exit app" exitSuccess
|
|
|
|
copyAdd :: B.ByteString -> B.ByteString -> Commands ()
|
|
copyAdd user pwd =
|
|
command "copy" "copies an address to the clipboard" $ do
|
|
liftIO . putStrLn $ "Please select the source address:"
|
|
addList <- listAddresses user pwd
|
|
let idList = zip [1 ..] addList
|
|
liftIO $ mapM_ (displayZcashAddress user pwd) idList
|
|
s <- liftIO . prompt $ " > Enter ID (0 to cancel): "
|
|
let idx = read s
|
|
if idx == 0
|
|
then do
|
|
liftIO . putStrLn $ " Cancelled!"
|
|
return NoAction
|
|
else do
|
|
liftIO $ copyAddress (addList !! (idx - 1))
|
|
liftIO . putStrLn $ " Copied address to clipboard!"
|
|
return NoAction
|
|
|
|
list :: B.ByteString -> B.ByteString -> Commands ()
|
|
list user pwd =
|
|
command "list" "lists all addresses known to the node" $ do
|
|
liftIO . putStrLn $ "Addresses known to the node:"
|
|
liftIO . putStrLn $ "----------------------------"
|
|
addList <- listAddresses user pwd
|
|
let idList = zip [1 ..] addList
|
|
liftIO $ mapM_ (displayZcashAddress user pwd) idList
|
|
return NoAction
|
|
|
|
txs :: B.ByteString -> B.ByteString -> Commands ()
|
|
txs user pwd =
|
|
param
|
|
"txs"
|
|
"'txs <id>' shows transactions for address <id> from list command"
|
|
parseId $ \i -> do
|
|
addList <- listAddresses user pwd
|
|
liftIO . putStrLn $
|
|
"Txs for address " ++ T.unpack (addy (addList !! (i - 1))) ++ ":"
|
|
liftIO . putStrLn $ "----------------------------"
|
|
txList <- listTxs user pwd (addList !! (i - 1))
|
|
let txList' = sortOn zblocktime $ filter (not . zchange) txList
|
|
liftIO $ mapM_ displayTx txList'
|
|
return NoAction
|
|
|
|
sendZec :: B.ByteString -> B.ByteString -> Commands ()
|
|
sendZec user pwd =
|
|
command "send" "prompt for sending ZEC" $ do
|
|
liftIO . putStrLn $ "Please select the source address:"
|
|
addList <- listAddresses user pwd
|
|
let idList = zip [1 ..] addList
|
|
liftIO $ mapM_ (displayZcashAddress user pwd) idList
|
|
s <- liftIO . prompt $ " > Enter ID (0 to cancel): "
|
|
let idx = read s
|
|
if idx == 0
|
|
then do
|
|
liftIO . putStrLn $ " Cancelled!"
|
|
return NoAction
|
|
else do
|
|
liftIO . putStrLn $ " Sending from " ++ show (addList !! (idx - 1))
|
|
t <- liftIO . prompt $ " > Enter destination address: "
|
|
let addChk = validateAddress (T.pack t)
|
|
case addChk of
|
|
Nothing -> liftIO . putStrLn $ " Invalid address, cancelling."
|
|
Just Transparent -> do
|
|
liftIO . putStrLn $ " Address is valid!"
|
|
a <- liftIO . prompt $ " > Enter ZEC amount: "
|
|
case (readMaybe a :: Maybe Double) of
|
|
Just amt -> do
|
|
liftIO $
|
|
sendTx user pwd (addList !! (idx - 1)) (T.pack t) amt Nothing
|
|
Nothing -> liftIO . putStrLn $ " Invalid amount"
|
|
Just _ -> do
|
|
liftIO . putStrLn $ " Address is valid!"
|
|
a <- liftIO . prompt $ " > Enter ZEC amount: "
|
|
case (readMaybe a :: Maybe Double) of
|
|
Just amt -> do
|
|
m <- liftIO . prompt $ " > Enter memo: "
|
|
rt <- liftIO . prompt $ " > Include reply-to? (Y/N): "
|
|
let repTo =
|
|
case T.toLower (T.pack rt) of
|
|
"y" -> True
|
|
_ -> False
|
|
liftIO $
|
|
sendTx
|
|
user
|
|
pwd
|
|
(addList !! (idx - 1))
|
|
(T.pack t)
|
|
amt
|
|
(if repTo
|
|
then Just
|
|
(T.pack m <>
|
|
"\nReply-To:\n" <> addy (addList !! (idx - 1)))
|
|
else Just $ T.pack m)
|
|
Nothing -> liftIO . putStrLn $ " Invalid amount"
|
|
return NoAction
|
|
|
|
createUA :: B.ByteString -> B.ByteString -> Commands ()
|
|
createUA user pwd =
|
|
command "new" "create new Unified Address" $ do
|
|
accCheck <- liftIO $ checkAccounts user pwd
|
|
if accCheck
|
|
then do
|
|
liftIO . putStrLn $ " Account found."
|
|
else do
|
|
liftIO . putStrLn $ " No existing accounts, creating one..."
|
|
liftIO $ createAccount user pwd
|
|
t <- liftIO . prompt $ " > Include transparent receiver? (Y/N): "
|
|
let tRec =
|
|
case T.toLower (T.pack t) of
|
|
"y" -> True
|
|
_ -> False
|
|
s <- liftIO . prompt $ " > Include Sapling receiver? (Y/N): "
|
|
let sRec =
|
|
case T.toLower (T.pack s) of
|
|
"y" -> True
|
|
_ -> False
|
|
liftIO $ createUnifiedAddress user pwd tRec sRec
|
|
return NoAction
|
|
|
|
parseId :: Validator IO Int
|
|
parseId = return . readMaybe
|
|
|
|
displayTx :: ZcashTx -> IO ()
|
|
displayTx t = do
|
|
putStr "Tx ID: "
|
|
putStrLn $ (T.unpack . ztxid) t
|
|
putStr "Block Time: "
|
|
print $ posixSecondsToUTCTime (fromInteger (zblocktime t))
|
|
putStr "Amount: "
|
|
putStrLn $ displayZec $ zamountZat t
|
|
putStr "Memo: "
|
|
TIO.putStrLn $ zmemo t
|
|
putStrLn "-----"
|
|
|
|
processUri :: B.ByteString -> B.ByteString -> Commands ()
|
|
processUri user pwd =
|
|
command "uri" "send ZEC reading details from URI" $ do
|
|
liftIO . putStrLn $ "Please select the source address:"
|
|
addList <- listAddresses user pwd
|
|
let idList = zip [1 ..] addList
|
|
liftIO $ mapM_ (displayZcashAddress user pwd) idList
|
|
s <- liftIO . prompt $ " > Enter ID (0 to cancel): "
|
|
let idx = read s
|
|
if idx == 0
|
|
then do
|
|
liftIO . putStrLn $ " Cancelled!"
|
|
return NoAction
|
|
else do
|
|
liftIO . putStrLn $ " Sending from " ++ show (addList !! (idx - 1))
|
|
u <- liftIO . prompt $ " > Enter URI: "
|
|
rt <- liftIO . prompt $ " > Include reply-to? (Y/N): "
|
|
let repTo =
|
|
case T.toLower (T.pack rt) of
|
|
"y" -> True
|
|
_ -> False
|
|
_ <- liftIO $ sendWithUri user pwd (addList !! (idx - 1)) u repTo
|
|
return NoAction
|
|
|
|
main :: IO ()
|
|
main = do
|
|
config <- load ["zenith.cfg"]
|
|
args <- getArgs
|
|
dbFilePath <- require config "dbFilePath"
|
|
nodeUser <- require config "nodeUser"
|
|
nodePwd <- require config "nodePwd"
|
|
zebraPort <- require config "zebraPort"
|
|
zebraHost <- require config "zebraHost"
|
|
let myConfig = Config dbFilePath zebraHost zebraPort
|
|
if not (null args)
|
|
then do
|
|
case head args of
|
|
"legacy" -> do
|
|
checkServer nodeUser nodePwd
|
|
void $
|
|
runCLI
|
|
"Zenith"
|
|
def
|
|
{ getBanner =
|
|
" ______ _ _ _ \n |___ / (_) | | | \n / / ___ _ __ _| |_| |__ \n / / / _ \\ '_ \\| | __| '_ \\ \n / /_| __/ | | | | |_| | | |\n /_____\\___|_| |_|_|\\__|_| |_|\n Zcash Full Node CLI v0.4.0"
|
|
}
|
|
(root nodeUser nodePwd)
|
|
"cli" -> runZenithCLI myConfig
|
|
"rescan" -> clearSync myConfig
|
|
_ -> printUsage
|
|
else printUsage
|
|
|
|
printUsage :: IO ()
|
|
printUsage = do
|
|
putStrLn "zenith [command] [parameters]\n"
|
|
putStrLn "Available commands:"
|
|
putStrLn "legacy\tLegacy CLI for zcashd"
|
|
putStrLn "cli\tCLI for zebrad"
|
|
putStrLn "rescan\tRescan the existing wallet(s)"
|