2022-06-20 21:46:13 +00:00
|
|
|
{-# 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
|
2022-06-27 14:25:36 +00:00
|
|
|
import qualified Data.Text.IO as TIO
|
2022-06-20 21:46:13 +00:00
|
|
|
import Data.Time.Clock.POSIX
|
2024-07-11 13:38:20 +00:00
|
|
|
|
|
|
|
{-import System.Console.StructuredCLI-}
|
2024-02-08 19:26:54 +00:00
|
|
|
import System.Environment (getArgs)
|
2022-06-20 21:46:13 +00:00
|
|
|
import System.Exit
|
|
|
|
import System.IO
|
|
|
|
import Text.Read (readMaybe)
|
2024-04-18 01:28:47 +00:00
|
|
|
import ZcashHaskell.Types
|
2024-02-08 19:26:54 +00:00
|
|
|
import Zenith.CLI
|
2024-05-23 21:20:43 +00:00
|
|
|
import Zenith.GUI (runZenithGUI)
|
2024-11-21 15:39:18 +00:00
|
|
|
import Zenith.Scanner (clearSync, rescanZebra)
|
2024-04-18 01:28:47 +00:00
|
|
|
import Zenith.Types (Config(..), ZcashAddress(..), ZcashPool(..), ZcashTx(..))
|
2024-01-17 18:15:21 +00:00
|
|
|
import Zenith.Utils
|
|
|
|
import Zenith.Zcashd
|
2024-07-11 13:38:20 +00:00
|
|
|
{-
|
2022-06-20 21:46:13 +00:00
|
|
|
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
|
2022-06-23 15:29:33 +00:00
|
|
|
processUri user pwd
|
2022-06-20 21:46:13 +00:00
|
|
|
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)
|
2022-07-08 12:45:41 +00:00
|
|
|
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
|
2022-06-20 21:46:13 +00:00
|
|
|
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: "
|
2022-06-23 15:29:33 +00:00
|
|
|
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
|
2022-07-08 12:45:41 +00:00
|
|
|
then Just
|
|
|
|
(T.pack m <>
|
|
|
|
"\nReply-To:\n" <> addy (addList !! (idx - 1)))
|
|
|
|
else Just $ T.pack m)
|
2022-06-20 21:46:13 +00:00
|
|
|
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: "
|
2023-02-08 20:32:13 +00:00
|
|
|
putStrLn $ (T.unpack . ztxid) t
|
2022-06-20 21:46:13 +00:00
|
|
|
putStr "Block Time: "
|
|
|
|
print $ posixSecondsToUTCTime (fromInteger (zblocktime t))
|
2023-02-08 20:32:13 +00:00
|
|
|
putStr "Amount: "
|
|
|
|
putStrLn $ displayZec $ zamountZat t
|
2022-06-20 21:46:13 +00:00
|
|
|
putStr "Memo: "
|
2022-06-27 14:25:36 +00:00
|
|
|
TIO.putStrLn $ zmemo t
|
2022-06-20 21:46:13 +00:00
|
|
|
putStrLn "-----"
|
|
|
|
|
2022-06-23 15:29:33 +00:00
|
|
|
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: "
|
2022-06-28 19:42:35 +00:00
|
|
|
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
|
2022-06-23 15:29:33 +00:00
|
|
|
return NoAction
|
2024-07-11 13:38:20 +00:00
|
|
|
-}
|
2022-06-23 15:29:33 +00:00
|
|
|
|
2022-06-20 21:46:13 +00:00
|
|
|
main :: IO ()
|
|
|
|
main = do
|
2024-07-12 16:30:12 +00:00
|
|
|
config <- load ["$(HOME)/Zenith/zenith.cfg"]
|
2024-02-08 19:26:54 +00:00
|
|
|
args <- getArgs
|
2024-11-21 15:39:18 +00:00
|
|
|
dbFileName <- require config "dbFileName"
|
|
|
|
nodeUser <- require config "nodeUser"
|
|
|
|
nodePwd <- require config "nodePwd"
|
2024-02-12 21:09:12 +00:00
|
|
|
zebraPort <- require config "zebraPort"
|
2024-02-14 18:02:53 +00:00
|
|
|
zebraHost <- require config "zebraHost"
|
2024-11-21 15:39:18 +00:00
|
|
|
nodePort <- require config "nodePort"
|
|
|
|
dbFP <- getZenithPath
|
|
|
|
let dbFilePath = T.pack $ dbFP ++ dbFileName
|
|
|
|
let myConfig = Config dbFilePath zebraHost zebraPort nodeUser nodePwd nodePort
|
2024-02-08 19:26:54 +00:00
|
|
|
if not (null args)
|
|
|
|
then do
|
2024-07-11 13:38:20 +00:00
|
|
|
case head args
|
|
|
|
{-"legacy" -> do
|
2024-02-08 19:26:54 +00:00
|
|
|
checkServer nodeUser nodePwd
|
|
|
|
void $
|
|
|
|
runCLI
|
|
|
|
"Zenith"
|
|
|
|
def
|
|
|
|
{ getBanner =
|
|
|
|
" ______ _ _ _ \n |___ / (_) | | | \n / / ___ _ __ _| |_| |__ \n / / / _ \\ '_ \\| | __| '_ \\ \n / /_| __/ | | | | |_| | | |\n /_____\\___|_| |_|_|\\__|_| |_|\n Zcash Full Node CLI v0.4.0"
|
|
|
|
}
|
2024-07-11 13:38:20 +00:00
|
|
|
(root nodeUser nodePwd) -}
|
|
|
|
of
|
2024-05-23 21:20:43 +00:00
|
|
|
"gui" -> runZenithGUI myConfig
|
2024-06-11 23:34:40 +00:00
|
|
|
"tui" -> runZenithTUI myConfig
|
2024-11-21 15:39:18 +00:00
|
|
|
"rescan" -> rescanZebra zebraHost zebraPort dbFilePath
|
|
|
|
"resync" -> clearSync myConfig
|
2024-02-08 19:26:54 +00:00
|
|
|
_ -> printUsage
|
|
|
|
else printUsage
|
|
|
|
|
|
|
|
printUsage :: IO ()
|
|
|
|
printUsage = do
|
|
|
|
putStrLn "zenith [command] [parameters]\n"
|
|
|
|
putStrLn "Available commands:"
|
2024-07-11 13:38:20 +00:00
|
|
|
{-putStrLn "legacy\tLegacy CLI for zcashd"-}
|
2024-06-11 23:34:40 +00:00
|
|
|
putStrLn "tui\tTUI for zebrad"
|
2024-11-21 15:39:18 +00:00
|
|
|
putStrLn "gui\tGUI for zebrad"
|
2024-05-09 19:09:35 +00:00
|
|
|
putStrLn "rescan\tRescan the existing wallet(s)"
|