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 qualified Data.Text.IO as TIO
import Data.Time.Clock.POSIX
import System.Console.StructuredCLI
import System.Environment (getArgs)
import System.Exit
import System.IO
import Text.Read (readMaybe)
import ZcashHaskell.Types
import Zenith.CLI
import Zenith.Core (clearSync, testSync)
import Zenith.Types (Config(..), ZcashAddress(..), ZcashPool(..), ZcashTx(..))
import Zenith.Utils
import Zenith.Zcashd

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
  processUri 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)
        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
            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: "
                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 Just
                              (T.pack m <>
                               "\nReply-To:\n" <> addy (addList !! (idx - 1)))
                       else Just $ T.pack m)
              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: "
  putStrLn $ (T.unpack . ztxid) t
  putStr "Block Time: "
  print $ posixSecondsToUTCTime (fromInteger (zblocktime t))
  putStr "Amount: "
  putStrLn $ displayZec $ zamountZat t
  putStr "Memo: "
  TIO.putStrLn $ zmemo t
  putStrLn "-----"

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: "
        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
        return NoAction

main :: IO ()
main = do
  config <- load ["zenith.cfg"]
  args <- getArgs
  dbFilePath <- require config "dbFilePath"
  nodeUser <- require config "nodeUser"
  nodePwd <- require config "nodePwd"
  zebraPort <- require config "zebraPort"
  zebraHost <- require config "zebraHost"
  let myConfig = Config dbFilePath zebraHost zebraPort
  if not (null args)
    then do
      case head args of
        "legacy" -> do
          checkServer nodeUser nodePwd
          void $
            runCLI
              "Zenith"
              def
                { getBanner =
                    "                         ______          _ _   _    \n                        |___  /         (_) | | |    \n                           / / ___ _ __  _| |_| |__  \n                          / / / _ \\ '_ \\| | __| '_ \\ \n                         / /_|  __/ | | | | |_| | | |\n                        /_____\\___|_| |_|_|\\__|_| |_|\n                         Zcash Full Node CLI v0.4.0"
                }
              (root nodeUser nodePwd)
        "tui" -> runZenithTUI myConfig
        "rescan" -> clearSync myConfig
        _ -> printUsage
    else printUsage

printUsage :: IO ()
printUsage = do
  putStrLn "zenith [command] [parameters]\n"
  putStrLn "Available commands:"
  putStrLn "legacy\tLegacy CLI for zcashd"
  putStrLn "tui\tTUI for zebrad"
  putStrLn "rescan\tRescan the existing wallet(s)"