{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE BlockArguments #-} module Zenith.CLI where import qualified Brick.AttrMap as A import qualified Brick.BChan as BC import qualified Brick.Focus as F import Brick.Forms ( Form(..) , (@@=) , allFieldsValid , editShowableFieldWithValidate , editTextField , focusedFormInputAttr , handleFormEvent , invalidFormInputAttr , newForm , renderForm , setFieldValid , updateFormState , FormFieldState , editShowableField ) import qualified Brick.Main as M import qualified Brick.Types as BT import Brick.Types (Widget) import Brick.Util (bg, clamp, fg, on, style) import qualified Brick.Widgets.Border as B import Brick.Widgets.Border.Style (unicode, unicodeBold) import qualified Brick.Widgets.Center as C import Brick.Widgets.Core ( Padding(..) , (<+>) , (<=>) , emptyWidget , fill , hBox , hLimit , joinBorders , padAll , padBottom , padTop , padLeft , setAvailableSize , str , strWrap , strWrapWith , txt , txtWrap , txtWrapWith , updateAttrMap , vBox , viewport , vLimit , withAttr , withBorderStyle ) import qualified Brick.Widgets.Dialog as D import qualified Brick.Widgets.Edit as E import qualified Brick.Widgets.List as L import qualified Brick.Widgets.ProgressBar as P import Control.Concurrent (forkIO, threadDelay) import Control.Exception (catch, throw, throwIO, try) import Control.Monad (forever, void) import Control.Monad.IO.Class (liftIO) import Control.Monad.Logger (LoggingT, runFileLoggingT, runNoLoggingT) import Data.Aeson import Data.HexString (toText) import Data.Maybe import qualified Data.Text as T import qualified Data.Text.Encoding as E import Data.Time.Clock.POSIX (posixSecondsToUTCTime) import qualified Data.Vector as Vec import Database.Persist import Database.Persist.Sqlite import qualified Graphics.Vty as V import qualified Graphics.Vty.CrossPlatform as VC import Lens.Micro ((&), (.~), (^.), set) import Lens.Micro.Mtl import Lens.Micro.TH import System.Hclip import Text.Wrap (FillScope(..), FillStrategy(..), WrapSettings(..), wrapText) import ZcashHaskell.Keys (generateWalletSeedPhrase, getWalletSeed) import ZcashHaskell.Orchard (getSaplingFromUA, isValidUnifiedAddress) import ZcashHaskell.Sapling (decodeSaplingAddress, isValidShieldedAddress) import ZcashHaskell.Transparent ( decodeExchangeAddress , decodeTransparentAddress , encodeTransparentReceiver ) import ZcashHaskell.Types import ZcashHaskell.Utils (getBlockTime, makeZebraCall) import Zenith.Core import Zenith.DB import Zenith.Scanner (processTx) import Zenith.Types ( Config(..) , PhraseDB(..) , UnifiedAddressDB(..) , ZcashNetDB(..) ) import Zenith.Utils (displayTaz, displayZec, jsonNumber, showAddress) data Name = WList | AList | AcList | TList | HelpDialog | DialogInputField | RecField | AmtField | MemoField | ABViewport | ABList | DescripField | AddressField deriving (Eq, Show, Ord) data DialogInput = DialogInput { _dialogInput :: !T.Text } deriving (Show) makeLenses ''DialogInput data SendInput = SendInput { _sendTo :: !T.Text , _sendAmt :: !Float , _sendMemo :: !T.Text } deriving (Show) makeLenses ''SendInput data AdrBookEntry = AdrBookEntry { _descrip :: !T.Text , _address :: !T.Text } deriving (Show) makeLenses ''AdrBookEntry data DialogType = WName | AName | AdName | WSelect | ASelect | SendTx | Blank | AdrBook | AdrBookForm | AdrBookUpdForm data DisplayType = AddrDisplay | MsgDisplay | PhraseDisplay | TxDisplay | SyncDisplay | SendDisplay | BlankDisplay data Tick = TickVal !Float | TickMsg !String data State = State { _network :: !ZcashNet , _wallets :: !(L.List Name (Entity ZcashWallet)) , _accounts :: !(L.List Name (Entity ZcashAccount)) , _addresses :: !(L.List Name (Entity WalletAddress)) , _transactions :: !(L.List Name (Entity UserTx)) , _msg :: !String , _helpBox :: !Bool , _dialogBox :: !DialogType , _splashBox :: !Bool , _inputForm :: !(Form DialogInput () Name) , _focusRing :: !(F.FocusRing Name) , _startBlock :: !Int , _dbPath :: !T.Text , _zebraHost :: !T.Text , _zebraPort :: !Int , _displayBox :: !DisplayType , _syncBlock :: !Int , _balance :: !Integer , _barValue :: !Float , _eventDispatch :: !(BC.BChan Tick) , _timer :: !Int , _txForm :: !(Form SendInput () Name) , _abaddresses :: !(L.List Name (Entity AddressBook)) , _abForm :: !(Form AdrBookEntry () Name) , _abCurAdrs :: !T.Text } makeLenses ''State drawUI :: State -> [Widget Name] drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s] where ui :: State -> Widget Name ui st = joinBorders $ withBorderStyle unicode $ B.borderWithLabel (str ("Zenith - " <> show (st ^. network) <> " - " <> T.unpack (maybe "(None)" (\(_, w) -> zcashWalletName $ entityVal w) (L.listSelectedElement (st ^. wallets))))) (C.hCenter (str ("Account: " ++ T.unpack (maybe "(None)" (\(_, a) -> zcashAccountName $ entityVal a) (L.listSelectedElement (st ^. accounts))))) <=> C.hCenter (str ("Balance: " ++ if st ^. network == MainNet then displayZec (st ^. balance) else displayTaz (st ^. balance))) <=> listAddressBox "Addresses" (st ^. addresses) <+> B.vBorder <+> (C.hCenter (str ("Last block seen: " ++ show (st ^. syncBlock))) <=> listTxBox "Transactions" (st ^. network) (st ^. transactions))) <=> C.hCenter (hBox [ capCommand "W" "allets" , capCommand "A" "ccounts" , capCommand "V" "iew address" , capCommand "S" "end Tx" , capCommand2 "Address " "B" "ook" , capCommand "Q" "uit" , capCommand "?" " Help" , str $ show (st ^. timer) ]) listBox :: Show e => String -> L.List Name e -> Widget Name listBox titleLabel l = C.vCenter $ vBox [ C.hCenter (B.borderWithLabel (str titleLabel) $ hLimit 25 $ vLimit 15 $ L.renderList listDrawElement True l) , str " " , C.hCenter $ str "Select " ] selectListBox :: Show e => String -> L.List Name e -> (Bool -> e -> Widget Name) -> Widget Name selectListBox titleLabel l drawF = vBox [ C.hCenter (B.borderWithLabel (str titleLabel) $ hLimit 25 $ vLimit 15 $ L.renderList drawF True l) , str " " ] listAddressBox :: String -> L.List Name (Entity WalletAddress) -> Widget Name listAddressBox titleLabel a = C.vCenter $ vBox [ C.hCenter (B.borderWithLabel (str titleLabel) $ hLimit 40 $ vLimit 15 $ L.renderList listDrawAddress True a) , str " " , C.hCenter (hBox [ capCommand "↑↓ " "move" , capCommand "↲ " "select" , capCommand "Tab " "->" ]) ] listTxBox :: String -> ZcashNet -> L.List Name (Entity UserTx) -> Widget Name listTxBox titleLabel znet tx = C.vCenter $ vBox [ C.hCenter (B.borderWithLabel (str titleLabel) $ hLimit 50 $ vLimit 15 $ L.renderList (listDrawTx znet) True tx) , str " " , C.hCenter (hBox [ capCommand "↑↓ " "move" , capCommand "T" "x Display" , capCommand "Tab " "<-" ]) ] helpDialog :: State -> Widget Name helpDialog st = if st ^. helpBox then D.renderDialog (D.dialog (Just (str "Commands")) Nothing 55) (vBox ([C.hCenter $ str "Key", B.hBorder] <> keyList) <+> vBox ([str "Actions", B.hBorder] <> actionList)) else emptyWidget where keyList = map (C.hCenter . str) ["?", "Esc", "w", "a", "v", "s", "b", "q"] actionList = map (hLimit 40 . str) [ "Open help" , "Close dialog" , "Switch wallets" , "Switch accounts" , "View address" , "Send Tx" , "Address Book" , "Quit" ] inputDialog :: State -> Widget Name inputDialog st = case st ^. dialogBox of WName -> D.renderDialog (D.dialog (Just (str "Create Wallet")) Nothing 50) (renderForm $ st ^. inputForm) AName -> D.renderDialog (D.dialog (Just (str "Create Account")) Nothing 50) (renderForm $ st ^. inputForm) AdName -> D.renderDialog (D.dialog (Just (str "Create Address")) Nothing 50) (renderForm $ st ^. inputForm) WSelect -> D.renderDialog (D.dialog (Just (str "Select Wallet")) Nothing 50) (selectListBox "Wallets" (st ^. wallets) listDrawWallet <=> C.hCenter (hBox [ capCommand "↑↓ " "move" , capCommand "↲ " "select" , capCommand "N" "ew" , capCommand "S" "how phrase" , xCommand ])) ASelect -> D.renderDialog (D.dialog (Just (str "Select Account")) Nothing 50) (selectListBox "Accounts" (st ^. accounts) listDrawAccount <=> C.hCenter (hBox [ capCommand "↑↓ " "move" , capCommand "↲ " "select" , capCommand "N" "ew" , xCommand ])) SendTx -> D.renderDialog (D.dialog (Just (str "Send Transaction")) Nothing 50) (renderForm (st ^. txForm) <=> C.hCenter (hBox [capCommand "↲ " "Send", capCommand " " "Cancel"])) Blank -> emptyWidget -- Address Book List AdrBook -> D.renderDialog (D.dialog (Just $ str " Address Book ") Nothing 60) (withAttr abDefAttr $ setAvailableSize (50,20) $ viewport ABViewport BT.Vertical $ vLimit 20 $ hLimit 50 $ vBox [vLimit 16 $ hLimit 50 $ vBox $ [ L.renderList listDrawAB True (s ^. abaddresses) ], padTop Max $ vLimit 4 $ hLimit 50 $ withAttr abMBarAttr $ vBox $ [C.hCenter $ (capCommand "N" "ew Address" <+> capCommand "E" "dit Address" <+> capCommand3 "" "C" "opy Address"), C.hCenter $ (capCommand "D" "elete Address" <+> capCommand "S" "end Zcash" <+> capCommand3 "E" "x" "it")]]) -- Address Book new entry form AdrBookForm -> D.renderDialog (D.dialog (Just $ str " New Address Book Entry ") Nothing 50) (renderForm (st ^. abForm) <=> C.hCenter (hBox [capCommand "↲" " Save", capCommand3 "" "" " Cancel"])) -- Address Book edit/update entry form AdrBookUpdForm -> D.renderDialog (D.dialog (Just $ str " Edit Address Book Entry ") Nothing 50) (renderForm (st ^. abForm) <=> C.hCenter (hBox [capCommand "↲" " Save", capCommand3 "" "" " Cancel"])) splashDialog :: State -> Widget Name splashDialog st = if st ^. splashBox then withBorderStyle unicodeBold $ D.renderDialog (D.dialog Nothing Nothing 30) (withAttr titleAttr (str " _____ _ _ _ \n|__ /___ _ __ (_) |_| |__\n / // _ \\ '_ \\| | __| '_ \\\n / /| __/ | | | | |_| | | |\n/____\\___|_| |_|_|\\__|_| |_|") <=> C.hCenter (withAttr titleAttr (str "Zcash Wallet v0.5.2.0-beta")) <=> C.hCenter (withAttr blinkAttr $ str "Press any key...")) else emptyWidget capCommand3 :: String -> String -> String -> Widget Name capCommand3 l h e = hBox [str l, withAttr titleAttr (str h), str e] capCommand2 :: String -> String -> String -> Widget Name capCommand2 l h e = hBox [str l, withAttr titleAttr (str h), str e, str " | "] capCommand :: String -> String -> Widget Name capCommand k comm = hBox [withAttr titleAttr (str k), str comm, str " | "] xCommand :: Widget Name xCommand = hBox [str "E", withAttr titleAttr (str "x"), str "it"] displayDialog :: State -> Widget Name displayDialog st = case st ^. displayBox of AddrDisplay -> case L.listSelectedElement $ st ^. addresses of Just (_, a) -> withBorderStyle unicodeBold $ D.renderDialog (D.dialog (Just $ txt ("Address: " <> walletAddressName (entityVal a))) Nothing 60) (padAll 1 $ B.borderWithLabel (str "Unified") (txtWrapWith (WrapSettings False True NoFill FillAfterFirst) $ getUA $ walletAddressUAddress $ entityVal a) <=> B.borderWithLabel (str "Legacy Shielded") (txtWrapWith (WrapSettings False True NoFill FillAfterFirst) $ fromMaybe "None" $ (getSaplingFromUA . E.encodeUtf8 . getUA . walletAddressUAddress) (entityVal a)) <=> B.borderWithLabel (str "Transparent") (txtWrapWith (WrapSettings False True NoFill FillAfterFirst) $ maybe "None" (encodeTransparentReceiver (st ^. network)) $ t_rec =<< (isValidUnifiedAddress . E.encodeUtf8 . getUA . walletAddressUAddress) (entityVal a)) <=> C.hCenter (hBox [ str "Copy: " , capCommand "U" "nified" , capCommand "S" "apling" , capCommand "T" "ransparent" ]) <=> C.hCenter xCommand) Nothing -> emptyWidget PhraseDisplay -> case L.listSelectedElement $ st ^. wallets of Just (_, w) -> withBorderStyle unicodeBold $ D.renderDialog (D.dialog (Just $ txt "Seed Phrase") Nothing 50) (padAll 1 $ txtWrap $ E.decodeUtf8Lenient $ getBytes $ getPhrase $ zcashWalletSeedPhrase $ entityVal w) Nothing -> emptyWidget MsgDisplay -> withBorderStyle unicodeBold $ D.renderDialog (D.dialog (Just $ txt "Message") Nothing 50) (padAll 1 $ strWrap $ st ^. msg) TxDisplay -> case L.listSelectedElement $ st ^. transactions of Nothing -> emptyWidget Just (_, tx) -> withBorderStyle unicodeBold $ D.renderDialog (D.dialog (Just $ txt "Transaction") Nothing 50) (padAll 1 (str ("Date: " ++ show (posixSecondsToUTCTime (fromIntegral (userTxTime $ entityVal tx)))) <=> (str "Tx ID: " <+> strWrapWith (WrapSettings False True NoFill FillAfterFirst) (show (userTxHex $ entityVal tx))) <=> str ("Amount: " ++ if st ^. network == MainNet then displayZec (fromIntegral $ userTxAmount $ entityVal tx) else displayTaz (fromIntegral $ userTxAmount $ entityVal tx)) <=> (txt "Memo: " <+> txtWrapWith (WrapSettings False True NoFill FillAfterFirst) (userTxMemo (entityVal tx))))) SyncDisplay -> withBorderStyle unicodeBold $ D.renderDialog (D.dialog (Just $ txt "Sync") Nothing 50) (padAll 1 (updateAttrMap (A.mapAttrNames [ (barDoneAttr, P.progressCompleteAttr) , (barToDoAttr, P.progressIncompleteAttr) ]) (P.progressBar (Just $ show (st ^. barValue * 100)) (_barValue st)))) SendDisplay -> withBorderStyle unicodeBold $ D.renderDialog (D.dialog (Just $ txt "Sending Transaction") Nothing 50) (padAll 1 (strWrapWith (WrapSettings False True NoFill FillAfterFirst) (st ^. msg))) BlankDisplay -> emptyWidget mkInputForm :: DialogInput -> Form DialogInput e Name mkInputForm = newForm [label "Name: " @@= editTextField dialogInput DialogInputField (Just 1)] where label s w = padBottom (Pad 1) $ vLimit 1 (hLimit 15 $ str s <+> fill ' ') <+> w mkSendForm :: Integer -> SendInput -> Form SendInput e Name mkSendForm bal = newForm [ label "To: " @@= editTextField sendTo RecField (Just 1) , label "Amount: " @@= editShowableFieldWithValidate sendAmt AmtField (isAmountValid bal) , label "Memo: " @@= editTextField sendMemo MemoField (Just 1) ] where isAmountValid :: Integer -> Float -> Bool isAmountValid b i = (fromIntegral b * 100000000.0) >= i && i > 0 label s w = padBottom (Pad 1) $ vLimit 1 (hLimit 15 $ str s <+> fill ' ') <+> w mkNewABForm :: AdrBookEntry -> Form AdrBookEntry e Name mkNewABForm = newForm [ label "Descrip: " @@= editTextField descrip DescripField (Just 1) , label "Address: " @@= editTextField address AddressField (Just 1) ] where label s w = padBottom (Pad 1) $ vLimit 1 (hLimit 10 $ str s <+> fill ' ') <+> w isRecipientValid :: T.Text -> Bool isRecipientValid a = case isValidUnifiedAddress (E.encodeUtf8 a) of Just _a1 -> True Nothing -> isValidShieldedAddress (E.encodeUtf8 a) || (case decodeTransparentAddress (E.encodeUtf8 a) of Just _a3 -> True Nothing -> case decodeExchangeAddress a of Just _a4 -> True Nothing -> False) listDrawElement :: (Show a) => Bool -> a -> Widget Name listDrawElement sel a = let selStr s = if sel then withAttr customAttr (str $ "<" <> s <> ">") else str s in C.hCenter $ selStr $ show a listDrawWallet :: Bool -> Entity ZcashWallet -> Widget Name listDrawWallet sel w = let selStr s = if sel then withAttr customAttr (txt $ "<" <> s <> ">") else txt s in C.hCenter $ selStr $ zcashWalletName (entityVal w) listDrawAccount :: Bool -> Entity ZcashAccount -> Widget Name listDrawAccount sel w = let selStr s = if sel then withAttr customAttr (txt $ "<" <> s <> ">") else txt s in C.hCenter $ selStr $ zcashAccountName (entityVal w) listDrawAddress :: Bool -> Entity WalletAddress -> Widget Name listDrawAddress sel w = let selStr s = if sel then withAttr customAttr (txt $ "<" <> s <> ">") else txt s in C.hCenter $ selStr $ walletAddressName (entityVal w) <> ": " <> showAddress (walletAddressUAddress (entityVal w)) listDrawTx :: ZcashNet -> Bool -> Entity UserTx -> Widget Name listDrawTx znet sel tx = selStr $ T.pack (show $ posixSecondsToUTCTime (fromIntegral (userTxTime $ entityVal tx))) <> " " <> T.pack fmtAmt where amt = fromIntegral $ userTxAmount $ entityVal tx dispAmount = if znet == MainNet then displayZec amt else displayTaz amt fmtAmt = if amt > 0 then "↘" <> dispAmount <> " " else " " <> dispAmount <> "↗" selStr s = if sel then withAttr customAttr (txt $ "> " <> s) else txt $ " " <> s listDrawAB :: Bool -> Entity AddressBook -> Widget Name listDrawAB sel ab = let selStr s = if sel then withAttr abSelAttr (txt $ " " <> s ) else txt $ " " <> s in selStr $ addressBookDescrip (entityVal ab) customAttr :: A.AttrName customAttr = L.listSelectedAttr <> A.attrName "custom" titleAttr :: A.AttrName titleAttr = A.attrName "title" blinkAttr :: A.AttrName blinkAttr = A.attrName "blink" baseAttr :: A.AttrName baseAttr = A.attrName "base" barDoneAttr :: A.AttrName barDoneAttr = A.attrName "done" barToDoAttr :: A.AttrName barToDoAttr = A.attrName "remaining" abDefAttr :: A.AttrName abDefAttr = A.attrName "abdefault" abSelAttr :: A.AttrName abSelAttr = A.attrName "abselected" abMBarAttr :: A.AttrName abMBarAttr = A.attrName "menubar" validBarValue :: Float -> Float validBarValue = clamp 0 1 scanZebra :: T.Text -> T.Text -> Int -> Int -> BC.BChan Tick -> IO () scanZebra dbP zHost zPort b eChan = do _ <- liftIO $ initDb dbP bStatus <- liftIO $ checkBlockChain zHost zPort pool <- runNoLoggingT $ initPool dbP dbBlock <- runNoLoggingT $ getMaxBlock pool let sb = max dbBlock b if sb > zgb_blocks bStatus || sb < 1 then liftIO $ BC.writeBChan eChan $ TickMsg "Invalid starting block for scan" else do let bList = [(sb + 1) .. (zgb_blocks bStatus)] let step = (1.0 :: Float) / fromIntegral (zgb_blocks bStatus - (sb + 1)) mapM_ (processBlock pool step) bList where processBlock :: ConnectionPool -> Float -> Int -> IO () processBlock pool step bl = do r <- liftIO $ makeZebraCall zHost zPort "getblock" [Data.Aeson.String $ T.pack $ show bl, jsonNumber 1] case r of Left e1 -> liftIO $ BC.writeBChan eChan $ TickMsg e1 Right blk -> do r2 <- liftIO $ makeZebraCall zHost zPort "getblock" [Data.Aeson.String $ T.pack $ show bl, jsonNumber 0] case r2 of Left e2 -> liftIO $ BC.writeBChan eChan $ TickMsg e2 Right hb -> do let blockTime = getBlockTime hb mapM_ (runNoLoggingT . processTx zHost zPort blockTime pool) $ bl_txs $ addTime blk blockTime liftIO $ BC.writeBChan eChan $ TickVal step addTime :: BlockResponse -> Int -> BlockResponse addTime bl t = BlockResponse (bl_confirmations bl) (bl_height bl) (fromIntegral t) (bl_txs bl) appEvent :: BT.BrickEvent Name Tick -> BT.EventM Name State () appEvent (BT.AppEvent t) = do s <- BT.get pool <- liftIO $ runNoLoggingT $ initPool $ s ^. dbPath case t of TickMsg m -> do case s ^. displayBox of AddrDisplay -> return () MsgDisplay -> return () PhraseDisplay -> return () TxDisplay -> return () SyncDisplay -> return () SendDisplay -> BT.modify $ set msg m BlankDisplay -> return () TickVal v -> do case s ^. displayBox of AddrDisplay -> return () MsgDisplay -> return () PhraseDisplay -> return () TxDisplay -> return () SendDisplay -> return () SyncDisplay -> do if s ^. barValue == 1.0 then do selWallet <- do case L.listSelectedElement $ s ^. wallets of Nothing -> do let fWall = L.listSelectedElement $ L.listMoveToBeginning $ s ^. wallets case fWall of Nothing -> throw $ userError "Failed to select wallet" Just (_j, w1) -> return w1 Just (_k, w) -> return w _ <- liftIO $ syncWallet (Config (s ^. dbPath) (s ^. zebraHost) (s ^. zebraPort)) selWallet BT.modify $ set displayBox BlankDisplay BT.modify $ set barValue 0.0 updatedState <- BT.get ns <- liftIO $ refreshWallet updatedState BT.put ns else BT.modify $ set barValue $ validBarValue (v + s ^. barValue) BlankDisplay -> do case s ^. dialogBox of AName -> return () AdName -> return () WName -> return () WSelect -> return () ASelect -> return () SendTx -> return () AdrBook -> return () AdrBookForm -> return () AdrBookUpdForm -> return () Blank -> do if s ^. timer == 90 then do BT.modify $ set barValue 0.0 BT.modify $ set displayBox SyncDisplay sBlock <- liftIO $ getMinBirthdayHeight pool _ <- liftIO $ forkIO $ scanZebra (s ^. dbPath) (s ^. zebraHost) (s ^. zebraPort) sBlock (s ^. eventDispatch) BT.modify $ set timer 0 return () else BT.modify $ set timer $ 1 + s ^. timer appEvent (BT.VtyEvent e) = do r <- F.focusGetCurrent <$> use focusRing s <- BT.get if s ^. splashBox then BT.modify $ set splashBox False else if s ^. helpBox then do case e of V.EvKey V.KEsc [] -> BT.modify $ set helpBox False _ev -> return () else do case s ^. displayBox of AddrDisplay -> do case e of V.EvKey (V.KChar 'x') [] -> BT.modify $ set displayBox BlankDisplay V.EvKey (V.KChar 'u') [] -> do case L.listSelectedElement $ s ^. addresses of Just (_, a) -> do liftIO $ setClipboard $ T.unpack $ getUA $ walletAddressUAddress $ entityVal a BT.modify $ set msg $ "Copied Unified Address <" ++ T.unpack (walletAddressName (entityVal a)) ++ ">!" BT.modify $ set displayBox MsgDisplay Nothing -> return () V.EvKey (V.KChar 's') [] -> do case L.listSelectedElement $ s ^. addresses of Just (_, a) -> do liftIO $ setClipboard $ maybe "None" T.unpack $ getSaplingFromUA $ E.encodeUtf8 $ getUA $ walletAddressUAddress $ entityVal a BT.modify $ set msg $ "Copied Sapling Address <" ++ T.unpack (walletAddressName (entityVal a)) ++ ">!" BT.modify $ set displayBox MsgDisplay Nothing -> return () V.EvKey (V.KChar 't') [] -> do case L.listSelectedElement $ s ^. addresses of Just (_, a) -> do liftIO $ setClipboard $ T.unpack $ maybe "None" (encodeTransparentReceiver (s ^. network)) $ t_rec =<< (isValidUnifiedAddress . E.encodeUtf8 . getUA . walletAddressUAddress) (entityVal a) BT.modify $ set msg $ "Copied Transparent Address <" ++ T.unpack (walletAddressName (entityVal a)) ++ ">!" BT.modify $ set displayBox MsgDisplay Nothing -> return () _ev -> return () MsgDisplay -> BT.modify $ set displayBox BlankDisplay PhraseDisplay -> BT.modify $ set displayBox BlankDisplay TxDisplay -> BT.modify $ set displayBox BlankDisplay SendDisplay -> BT.modify $ set displayBox BlankDisplay SyncDisplay -> BT.modify $ set displayBox BlankDisplay BlankDisplay -> do case s ^. dialogBox of WName -> do case e of V.EvKey V.KEsc [] -> BT.modify $ set dialogBox Blank V.EvKey V.KEnter [] -> do fs <- BT.zoom inputForm $ BT.gets formState nw <- liftIO $ addNewWallet (fs ^. dialogInput) s ns <- liftIO $ refreshWallet nw BT.put ns aL <- use accounts BT.modify $ set displayBox MsgDisplay BT.modify $ set dialogBox $ if not (null $ L.listElements aL) then Blank else AName ev -> BT.zoom inputForm $ handleFormEvent (BT.VtyEvent ev) AName -> do case e of V.EvKey V.KEsc [] -> BT.modify $ set dialogBox Blank V.EvKey V.KEnter [] -> do fs <- BT.zoom inputForm $ BT.gets formState ns <- liftIO $ refreshAccount =<< addNewAddress "Change" Internal =<< addNewAccount (fs ^. dialogInput) s BT.put ns addrL <- use addresses BT.modify $ set displayBox MsgDisplay BT.modify $ set dialogBox $ if not (null $ L.listElements addrL) then Blank else AdName ev -> BT.zoom inputForm $ handleFormEvent (BT.VtyEvent ev) AdName -> do case e of V.EvKey V.KEsc [] -> BT.modify $ set dialogBox Blank V.EvKey V.KEnter [] -> do fs <- BT.zoom inputForm $ BT.gets formState nAddr <- liftIO $ addNewAddress (fs ^. dialogInput) External s BT.put nAddr BT.modify $ set displayBox MsgDisplay BT.modify $ set dialogBox Blank ev -> BT.zoom inputForm $ handleFormEvent (BT.VtyEvent ev) WSelect -> do case e of V.EvKey (V.KChar 'x') [] -> BT.modify $ set dialogBox Blank V.EvKey V.KEnter [] -> do ns <- liftIO $ refreshWallet s BT.put ns BT.modify $ set dialogBox Blank V.EvKey (V.KChar 'n') [] -> do BT.modify $ set inputForm $ updateFormState (DialogInput "New Wallet") $ s ^. inputForm BT.modify $ set dialogBox WName V.EvKey (V.KChar 's') [] -> BT.modify $ set displayBox PhraseDisplay ev -> BT.zoom wallets $ L.handleListEvent ev ASelect -> do case e of V.EvKey (V.KChar 'x') [] -> BT.modify $ set dialogBox Blank V.EvKey V.KEnter [] -> do ns <- liftIO $ refreshAccount s BT.put ns BT.modify $ set dialogBox Blank V.EvKey (V.KChar 'n') [] -> do BT.modify $ set inputForm $ updateFormState (DialogInput "New Account") $ s ^. inputForm BT.modify $ set dialogBox AName ev -> BT.zoom accounts $ L.handleListEvent ev SendTx -> do case e of V.EvKey V.KEsc [] -> BT.modify $ set dialogBox Blank V.EvKey V.KEnter [] -> do if allFieldsValid (s ^. txForm) then do pool <- liftIO $ runNoLoggingT $ initPool $ s ^. dbPath selWal <- do case L.listSelectedElement $ s ^. wallets of Nothing -> do let fWall = L.listSelectedElement $ L.listMoveToBeginning $ s ^. wallets case fWall of Nothing -> throw $ userError "Failed to select wallet" Just (_j, w1) -> return w1 Just (_k, w) -> return w selAcc <- do case L.listSelectedElement $ s ^. accounts of Nothing -> do let fAcc = L.listSelectedElement $ L.listMoveToBeginning $ s ^. accounts case fAcc of Nothing -> throw $ userError "Failed to select wallet" Just (_j, w1) -> return w1 Just (_k, w) -> return w fs1 <- BT.zoom txForm $ BT.gets formState bl <- liftIO $ getLastSyncBlock pool $ entityKey selWal _ <- liftIO $ forkIO $ sendTransaction pool (s ^. eventDispatch) (s ^. zebraHost) (s ^. zebraPort) (s ^. network) (entityKey selAcc) bl (fs1 ^. sendAmt) (fs1 ^. sendTo) (fs1 ^. sendMemo) BT.modify $ set msg "Preparing transaction..." BT.modify $ set displayBox SendDisplay BT.modify $ set dialogBox Blank else do BT.modify $ set msg "Invalid inputs" BT.modify $ set displayBox MsgDisplay BT.modify $ set dialogBox Blank ev -> BT.zoom txForm $ do handleFormEvent (BT.VtyEvent ev) fs <- BT.gets formState BT.modify $ setFieldValid (isRecipientValid (fs ^. sendTo)) RecField AdrBook -> do case e of V.EvKey (V.KChar 'x') [] -> BT.modify $ set dialogBox Blank V.EvKey (V.KChar 'c') [] -> do -- Copy Address to Clipboard case L.listSelectedElement $ s ^. abaddresses of Just (_, a) -> do liftIO $ setClipboard $ T.unpack $ addressBookAddress (entityVal a) BT.modify $ set msg $ "Address copied to Clipboard from >>\n" ++ T.unpack (addressBookDescrip (entityVal a)) ++ "->\n" ++ T.unpack (addressBookAddress (entityVal a)) ++ "!" BT.modify $ set displayBox MsgDisplay _ -> do BT.modify $ set msg "Error while copying the address!!" BT.modify $ set displayBox MsgDisplay -- Send Zcash transaction V.EvKey (V.KChar 's') [] -> do case L.listSelectedElement $ s ^. abaddresses of Just (_, a) -> do BT.modify $ set txForm $ mkSendForm (s ^. balance) (SendInput (addressBookAddress (entityVal a)) 0.0 "") BT.modify $ set dialogBox SendTx _ -> do BT.modify $ set msg "No receiver address available!!" BT.modify $ set displayBox MsgDisplay -- Edit an entry in Address Book V.EvKey (V.KChar 'e') [] -> do case L.listSelectedElement $ s ^. abaddresses of Just (_, a) -> do BT.modify $ set abCurAdrs (addressBookAddress (entityVal a)) BT.modify $ set abForm $ mkNewABForm (AdrBookEntry (addressBookDescrip (entityVal a)) (addressBookAddress (entityVal a))) BT.modify $ set dialogBox AdrBookUpdForm _ -> do BT.modify $ set dialogBox Blank -- Create a new entry in Address Book V.EvKey (V.KChar 'n') [] -> do BT.modify $ set abForm $ mkNewABForm (AdrBookEntry "" "") BT.modify $ set dialogBox AdrBookForm -- Process any other event ev -> BT.zoom abaddresses $ L.handleListEvent ev -- Process new address book entry AdrBookForm -> do case e of V.EvKey V.KEsc [] -> BT.modify $ set dialogBox AdrBook V.EvKey V.KEnter [] -> do pool <- liftIO $ runNoLoggingT $ initPool $ s ^. dbPath fs <- BT.zoom abForm $ BT.gets formState let idescr = T.unpack $ T.strip (fs ^. descrip) let iabadr = fs ^. address if not (null idescr) && isRecipientValid iabadr then do res <- liftIO $ saveAdrsInAdrBook pool $ AddressBook (ZcashNetDB (s ^. network)) (fs ^. descrip) (fs ^.address) case res of Nothing -> do BT.modify $ set msg ("AddressBook Entry already exists: " ++ T.unpack (fs ^.address)) BT.modify $ set displayBox MsgDisplay Just _ -> do BT.modify $ set msg ("New AddressBook entry created!!\n" ++ T.unpack (fs ^.address)) BT.modify $ set displayBox MsgDisplay -- case end ab <- liftIO $ refreshAddressBook s BT.put ab BT.modify $ set dialogBox AdrBook else do BT.modify $ set msg "Invalid or missing data!!: " BT.modify $ set displayBox MsgDisplay BT.modify $ set dialogBox AdrBookForm ev -> BT.zoom abForm $ do handleFormEvent (BT.VtyEvent ev) fs <- BT.gets formState BT.modify $ setFieldValid (isRecipientValid (fs ^. address)) AddressField AdrBookUpdForm -> do case e of V.EvKey V.KEsc [] -> BT.modify $ set dialogBox AdrBook V.EvKey V.KEnter [] -> do pool <- liftIO $ runNoLoggingT $ initPool $ s ^. dbPath fs <- BT.zoom abForm $ BT.gets formState let idescr = T.unpack $ T.strip (fs ^. descrip) let iabadr = fs ^. address if not (null idescr) && isRecipientValid iabadr then do res <- liftIO $ updateAdrsInAdrBook pool (fs ^. descrip) (fs ^.address) (s ^. abCurAdrs) BT.modify $ set msg ("AddressBook entry modified!!\n" ++ T.unpack (fs ^.address)) BT.modify $ set displayBox MsgDisplay -- case end abookList <- liftIO $ getAdrBook pool (s ^. network) let abL = L.listReplace (Vec.fromList abookList) (Just 0) (s ^. abaddresses) BT.modify $ set dialogBox AdrBook else do BT.modify $ set msg "Invalid or missing data!!: " BT.modify $ set displayBox MsgDisplay BT.modify $ set dialogBox AdrBookForm ev -> BT.zoom abForm $ do handleFormEvent (BT.VtyEvent ev) fs <- BT.gets formState BT.modify $ setFieldValid (isRecipientValid (fs ^. address)) AddressField Blank -> do case e of V.EvKey (V.KChar '\t') [] -> focusRing %= F.focusNext V.EvKey V.KEnter [] -> do ns <- liftIO $ refreshTxs s BT.put ns V.EvKey (V.KChar 'q') [] -> M.halt V.EvKey (V.KChar '?') [] -> BT.modify $ set helpBox True V.EvKey (V.KChar 'n') [] -> BT.modify $ set dialogBox AdName V.EvKey (V.KChar 'v') [] -> BT.modify $ set displayBox AddrDisplay V.EvKey (V.KChar 'w') [] -> BT.modify $ set dialogBox WSelect V.EvKey (V.KChar 't') [] -> BT.modify $ set displayBox TxDisplay V.EvKey (V.KChar 'a') [] -> BT.modify $ set dialogBox ASelect V.EvKey (V.KChar 's') [] -> do BT.modify $ set txForm $ mkSendForm (s ^. balance) (SendInput "" 0.0 "") BT.modify $ set dialogBox SendTx V.EvKey (V.KChar 'b') [] -> BT.modify $ set dialogBox AdrBook ev -> case r of Just AList -> BT.zoom addresses $ L.handleListEvent ev Just TList -> BT.zoom transactions $ L.handleListEvent ev Just ABList -> BT.zoom abaddresses $ L.handleListEvent ev _anyName -> return () where printMsg :: String -> BT.EventM Name State () printMsg s = BT.modify $ updateMsg s updateMsg :: String -> State -> State updateMsg = set msg appEvent _ = return () theMap :: A.AttrMap theMap = A.attrMap V.defAttr [ (L.listAttr, V.white `on` V.blue) , (L.listSelectedAttr, V.blue `on` V.white) , (customAttr, fg V.black) , (titleAttr, V.withStyle (fg V.brightGreen) V.bold) , (blinkAttr, style V.blink) , (focusedFormInputAttr, V.white `on` V.blue) , (invalidFormInputAttr, V.red `on` V.black) , (E.editAttr, V.white `on` V.black) , (E.editFocusedAttr, V.black `on` V.white) , (baseAttr, bg V.brightBlack) , (barDoneAttr, V.white `on` V.blue) , (barToDoAttr, V.white `on` V.black) , (abDefAttr, V.white `on` V.blue) , (abSelAttr, V.black `on` V.white) , (abMBarAttr, V.white `on` V.black) ] theApp :: M.App State Tick Name theApp = M.App { M.appDraw = drawUI , M.appChooseCursor = M.showFirstCursor , M.appHandleEvent = appEvent , M.appStartEvent = return () , M.appAttrMap = const theMap } runZenithCLI :: Config -> IO () runZenithCLI config = do let host = c_zebraHost config let port = c_zebraPort config let dbFilePath = c_dbPath config pool <- runNoLoggingT $ initPool dbFilePath w <- try $ checkZebra host port :: IO (Either IOError ZebraGetInfo) case w of Right zebra -> do bc <- try $ checkBlockChain host port :: IO (Either IOError ZebraGetBlockChainInfo) case bc of Left e1 -> throwIO e1 Right chainInfo -> do initDb dbFilePath walList <- getWallets pool $ zgb_net chainInfo accList <- if not (null walList) then runNoLoggingT $ getAccounts pool $ entityKey $ head walList else return [] addrList <- if not (null accList) then runNoLoggingT $ getAddresses pool $ entityKey $ head accList else return [] txList <- if not (null addrList) then getUserTx pool $ entityKey $ head addrList else return [] let block = if not (null walList) then zcashWalletLastSync $ entityVal $ head walList else 0 abookList <- getAdrBook pool $ zgb_net chainInfo bal <- if not (null accList) then getBalance pool $ entityKey $ head accList else return 0 eventChan <- BC.newBChan 10 _ <- forkIO $ forever $ do BC.writeBChan eventChan (TickVal 0.0) threadDelay 1000000 let buildVty = VC.mkVty V.defaultConfig initialVty <- buildVty void $ M.customMain initialVty buildVty (Just eventChan) theApp $ State (zgb_net chainInfo) (L.list WList (Vec.fromList walList) 1) (L.list AcList (Vec.fromList accList) 0) (L.list AList (Vec.fromList addrList) 1) (L.list TList (Vec.fromList txList) 1) ("Start up Ok! Connected to Zebra " ++ (T.unpack . zgi_build) zebra ++ " on port " ++ show port ++ ".") False (if null walList then WName else Blank) True (mkInputForm $ DialogInput "Main") (F.focusRing [AList, TList,ABList]) (zgb_blocks chainInfo) dbFilePath host port MsgDisplay block bal 1.0 eventChan 0 (mkSendForm 0 $ SendInput "" 0.0 "") (L.list ABList (Vec.fromList abookList) 1) (mkNewABForm (AdrBookEntry "" "")) " " Left e -> print $ "No Zebra node available on port " <> show port <> ". Check your configuration." refreshWallet :: State -> IO State refreshWallet s = do pool <- runNoLoggingT $ initPool $ s ^. dbPath walList <- getWallets pool $ s ^. network (ix, selWallet) <- do case L.listSelectedElement $ s ^. wallets of Nothing -> do let fWall = L.listSelectedElement $ L.listMoveToBeginning $ s ^. wallets case fWall of Nothing -> throw $ userError "Failed to select wallet" Just (j, w1) -> return (j, w1) Just (k, w) -> return (k, w) aL <- runNoLoggingT $ getAccounts pool $ entityKey selWallet let bl = zcashWalletLastSync $ entityVal selWallet addrL <- if not (null aL) then runNoLoggingT $ getAddresses pool $ entityKey $ head aL else return [] bal <- if not (null aL) then getBalance pool $ entityKey $ head aL else return 0 txL <- if not (null addrL) then getUserTx pool $ entityKey $ head addrL else return [] let wL = L.listReplace (Vec.fromList walList) (Just ix) (s ^. wallets) let aL' = L.listReplace (Vec.fromList aL) (Just 0) (s ^. accounts) let addrL' = L.listReplace (Vec.fromList addrL) (Just 0) (s ^. addresses) let txL' = L.listReplace (Vec.fromList txL) (Just 0) (s ^. transactions) return $ s & wallets .~ wL & accounts .~ aL' & syncBlock .~ bl & balance .~ bal & addresses .~ addrL' & transactions .~ txL' & msg .~ "Switched to wallet: " ++ T.unpack (zcashWalletName $ entityVal selWallet) addNewWallet :: T.Text -> State -> IO State addNewWallet n s = do sP <- generateWalletSeedPhrase pool <- runNoLoggingT $ initPool $ s ^. dbPath let bH = s ^. startBlock let netName = s ^. network r <- saveWallet pool $ ZcashWallet n (ZcashNetDB netName) (PhraseDB sP) bH 0 case r of Nothing -> return $ s & msg .~ ("Wallet already exists: " ++ T.unpack n) Just _ -> do wL <- getWallets pool netName let aL = L.listFindBy (\x -> zcashWalletName (entityVal x) == n) $ L.listReplace (Vec.fromList wL) (Just 0) (s ^. wallets) return $ s & wallets .~ aL & msg .~ "Created new wallet: " ++ T.unpack n addNewAccount :: T.Text -> State -> IO State addNewAccount n s = do pool <- runNoLoggingT $ initPool $ s ^. dbPath selWallet <- do case L.listSelectedElement $ s ^. wallets of Nothing -> do let fWall = L.listSelectedElement $ L.listMoveToBeginning $ s ^. wallets case fWall of Nothing -> throw $ userError "Failed to select wallet" Just (_j, w1) -> return w1 Just (_k, w) -> return w aL' <- getMaxAccount pool (entityKey selWallet) zA <- try $ createZcashAccount n (aL' + 1) selWallet :: IO (Either IOError ZcashAccount) case zA of Left e -> return $ s & msg .~ "Error: " ++ show e Right zA' -> do r <- saveAccount pool zA' case r of Nothing -> return $ s & msg .~ "Account already exists: " ++ T.unpack n Just x -> do aL <- runNoLoggingT $ getAccounts pool (entityKey selWallet) let nL = L.listMoveToElement x $ L.listReplace (Vec.fromList aL) (Just 0) (s ^. accounts) return $ s & accounts .~ nL & msg .~ "Created new account: " ++ T.unpack n refreshAccount :: State -> IO State refreshAccount s = do pool <- runNoLoggingT $ initPool $ s ^. dbPath selAccount <- do case L.listSelectedElement $ s ^. accounts of Nothing -> do let fAcc = L.listSelectedElement $ L.listMoveToBeginning $ s ^. accounts case fAcc of Nothing -> throw $ userError "Failed to select account" Just (_j, w1) -> return w1 Just (_k, w) -> return w aL <- runNoLoggingT $ getAddresses pool $ entityKey selAccount bal <- getBalance pool $ entityKey selAccount let aL' = L.listReplace (Vec.fromList aL) (Just 0) (s ^. addresses) selAddress <- do case L.listSelectedElement aL' of Nothing -> do let fAdd = L.listSelectedElement $ L.listMoveToBeginning aL' return fAdd Just a2 -> return $ Just a2 case selAddress of Nothing -> return $ s & balance .~ bal & addresses .~ aL' & msg .~ "Switched to account: " ++ T.unpack (zcashAccountName $ entityVal selAccount) Just (_i, a) -> do tList <- getUserTx pool $ entityKey a let tL' = L.listReplace (Vec.fromList tList) (Just 0) (s ^. transactions) return $ s & balance .~ bal & addresses .~ aL' & transactions .~ tL' & msg .~ "Switched to account: " ++ T.unpack (zcashAccountName $ entityVal selAccount) refreshTxs :: State -> IO State refreshTxs s = do pool <- runNoLoggingT $ initPool $ s ^. dbPath selAddress <- do case L.listSelectedElement $ s ^. addresses of Nothing -> do let fAdd = L.listSelectedElement $ L.listMoveToBeginning $ s ^. addresses return fAdd Just a2 -> return $ Just a2 case selAddress of Nothing -> return s Just (_i, a) -> do tList <- getUserTx pool $ entityKey a let tL' = L.listReplace (Vec.fromList tList) (Just 0) (s ^. transactions) return $ s & transactions .~ tL' refreshAddressBook :: State -> IO State refreshAddressBook s = do pool <- runNoLoggingT $ initPool $ s ^. dbPath selAddress <- do case L.listSelectedElement $ s ^. abaddresses of Nothing -> do let fAdd = L.listSelectedElement $ L.listMoveToBeginning $ s ^. abaddresses return fAdd Just a2 -> return $ Just a2 case selAddress of Nothing -> return s Just (_i, a) -> do abookList <- getAdrBook pool (s ^. network) let tL' = L.listReplace (Vec.fromList abookList) (Just 0) (s ^. abaddresses) return $ s & abaddresses .~ tL' addNewAddress :: T.Text -> Scope -> State -> IO State addNewAddress n scope s = do pool <- runNoLoggingT $ initPool $ s ^. dbPath selAccount <- do case L.listSelectedElement $ s ^. accounts of Nothing -> do let fAcc = L.listSelectedElement $ L.listMoveToBeginning $ s ^. accounts case fAcc of Nothing -> throw $ userError "Failed to select account" Just (_j, a1) -> return a1 Just (_k, a) -> return a maxAddr <- getMaxAddress pool (entityKey selAccount) scope uA <- try $ createWalletAddress n (maxAddr + 1) (s ^. network) scope selAccount :: IO (Either IOError WalletAddress) case uA of Left e -> return $ s & msg .~ "Error: " ++ show e Right uA' -> do nAddr <- saveAddress pool uA' case nAddr of Nothing -> return $ s & msg .~ "Address already exists: " ++ T.unpack n Just x -> do addrL <- runNoLoggingT $ getAddresses pool (entityKey selAccount) let nL = L.listMoveToElement x $ L.listReplace (Vec.fromList addrL) (Just 0) (s ^. addresses) return $ s & addresses .~ nL & msg .~ "Created new address: " ++ T.unpack n ++ "(" ++ T.unpack (showAddress $ walletAddressUAddress $ entityVal x) ++ ")" sendTransaction :: ConnectionPool -> BC.BChan Tick -> T.Text -> Int -> ZcashNet -> ZcashAccountId -> Int -> Float -> T.Text -> T.Text -> IO () sendTransaction pool chan zHost zPort znet accId bl amt ua memo = do BC.writeBChan chan $ TickMsg "Preparing transaction..." outUA <- parseAddress ua res <- runFileLoggingT "zenith.log" $ prepareTx pool zHost zPort znet accId bl amt outUA memo BC.writeBChan chan $ TickMsg "Transaction ready, sending to Zebra..." case res of Left e -> BC.writeBChan chan $ TickMsg $ show e Right rawTx -> do resp <- makeZebraCall zHost zPort "sendrawtransaction" [Data.Aeson.String $ toText rawTx] case resp of Left e1 -> BC.writeBChan chan $ TickMsg $ "Zebra error: " ++ show e1 Right txId -> BC.writeBChan chan $ TickMsg $ "Tx ID: " ++ txId where parseAddress :: T.Text -> IO UnifiedAddress parseAddress a = case isValidUnifiedAddress (E.encodeUtf8 a) of Just a1 -> return a1 Nothing -> case decodeSaplingAddress (E.encodeUtf8 a) of Just a2 -> return $ UnifiedAddress znet Nothing (Just $ sa_receiver a2) Nothing Nothing -> case decodeTransparentAddress (E.encodeUtf8 a) of Just a3 -> return $ UnifiedAddress znet Nothing Nothing (Just $ ta_receiver a3) Nothing -> throwIO $ userError "Incorrect address"