zenith/app/Main.hs

195 lines
6.5 KiB
Haskell
Raw 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
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
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)
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: "
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
then m ++
"\nReply-To:\n" ++
T.unpack (addy (addList !! (idx - 1)))
else m)
2022-06-20 21:46:13 +00:00
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: "
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: "
_ <- liftIO $ sendWithUri user pwd (addList !! (idx - 1)) u
return NoAction
2022-06-20 21:46:13 +00:00
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)