zenith/app/Main.hs

{-# 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)