zenith/app/Main.hs

245 lines
8.4 KiB
Haskell
Raw Permalink Normal View History

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-08-10 12:04:40 +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-09-13 12:09:31 +00:00
dbFileName <- require config "dbFileName"
2024-07-24 21:03:23 +00:00
nodeUser <- require config "nodeUser"
nodePwd <- require config "nodePwd"
zebraPort <- require config "zebraPort"
2024-02-14 18:02:53 +00:00
zebraHost <- require config "zebraHost"
2024-07-24 21:03:23 +00:00
nodePort <- require config "nodePort"
2024-09-13 12:09:31 +00:00
dbFP <- getZenithPath
let dbFilePath = T.pack $ dbFP ++ dbFileName
2024-07-24 21:03:23 +00:00
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
"tui" -> runZenithTUI myConfig
2024-08-10 12:04:40 +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"-}
putStrLn "tui\tTUI for zebrad"
2024-09-13 12:09:31 +00:00
putStrLn "gui\tGUI for zebrad"
2024-05-09 19:09:35 +00:00
putStrLn "rescan\tRescan the existing wallet(s)"