158 lines
5.2 KiB
Haskell
158 lines
5.2 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 Data.Time.Clock.POSIX
|
||
|
import System.Console.StructuredCLI
|
||
|
import System.Exit
|
||
|
import System.IO
|
||
|
import Text.Read (readMaybe)
|
||
|
import Zenith
|
||
|
|
||
|
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
|
||
|
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)
|
||
|
if addChk
|
||
|
then 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: "
|
||
|
liftIO $ sendTx user pwd (addList !! (idx - 1)) (T.pack t) amt m
|
||
|
Nothing -> liftIO . putStrLn $ " Invalid amount"
|
||
|
else liftIO . putStrLn $ " Invalid address, cancelling."
|
||
|
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: "
|
||
|
print $ ztxid t
|
||
|
putStr "Block Time: "
|
||
|
print $ posixSecondsToUTCTime (fromInteger (zblocktime t))
|
||
|
putStr "Zats: "
|
||
|
print $ zamountZat t
|
||
|
putStr "Memo: "
|
||
|
print $ zmemo t
|
||
|
putStrLn "-----"
|
||
|
|
||
|
main :: IO ()
|
||
|
main = do
|
||
|
config <- load ["zenith.cfg"]
|
||
|
nodeUser <- require config "nodeUser"
|
||
|
nodePwd <- require config "nodePwd"
|
||
|
checkServer nodeUser nodePwd
|
||
|
void $
|
||
|
runCLI
|
||
|
"Zenith"
|
||
|
def
|
||
|
{ getBanner =
|
||
|
" ______ _ _ _ \n |___ / (_) | | | \n / / ___ _ __ _| |_| |__ \n / / / _ \\ '_ \\| | __| '_ \\ \n / /_| __/ | | | | |_| | | |\n /_____\\___|_| |_|_|\\__|_| |_|\n Zcash Full Node CLI"
|
||
|
}
|
||
|
(root nodeUser nodePwd)
|