From 2f88c890831540ca504e68d162893fdc4bc538c5 Mon Sep 17 00:00:00 2001 From: Rene Vergara Date: Fri, 21 Jun 2024 12:58:31 -0500 Subject: [PATCH 01/11] Version update --- CHANGELOG.md | 16 +- src/Zenith/CLI.hs | 377 ++++++++++++++++++++++++++-------------------- zenith.cabal | 2 +- 3 files changed, 226 insertions(+), 169 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index aa0b028..a4a73d3 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -5,8 +5,19 @@ All notable changes to this project will be documented in this file. The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/), and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0.html). +## [0.5.3.1-beta] + +### Added + +- Docker image + ## [0.5.3.0-beta] +### Added + +- Address Book functionality. Allows users to store frequently used zcash addresses and + generate transactions using them. + ### Changed - Improved formatting of sync progress @@ -17,11 +28,6 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ## [0.5.2.0-beta] -### Added - -- Address Book functionality. Allows users to store frequently used zcash addresses and - generate transactions using them. - ### Changed - Update to `zcash-haskell-0.6.2.0` to increase performance of transaction creation diff --git a/src/Zenith/CLI.hs b/src/Zenith/CLI.hs index f107dfd..830a1d7 100644 --- a/src/Zenith/CLI.hs +++ b/src/Zenith/CLI.hs @@ -3,7 +3,6 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} - module Zenith.CLI where import qualified Brick.AttrMap as A @@ -11,8 +10,10 @@ import qualified Brick.BChan as BC import qualified Brick.Focus as F import Brick.Forms ( Form(..) + , FormFieldState , (@@=) , allFieldsValid + , editShowableField , editShowableFieldWithValidate , editTextField , focusedFormInputAttr @@ -22,8 +23,6 @@ import Brick.Forms , renderForm , setFieldValid , updateFormState - , FormFieldState - , editShowableField ) import qualified Brick.Main as M import qualified Brick.Types as BT @@ -43,8 +42,8 @@ import Brick.Widgets.Core , joinBorders , padAll , padBottom - , padTop , padLeft + , padTop , setAvailableSize , str , strWrap @@ -54,8 +53,8 @@ import Brick.Widgets.Core , txtWrapWith , updateAttrMap , vBox - , viewport , vLimit + , viewport , withAttr , withBorderStyle ) @@ -197,7 +196,7 @@ data State = State , _txForm :: !(Form SendInput () Name) , _abAddresses :: !(L.List Name (Entity AddressBook)) , _abForm :: !(Form AdrBookEntry () Name) - , _abCurAdrs :: !T.Text -- used for address book CRUD operations + , _abCurAdrs :: !T.Text -- used for address book CRUD operations , _sentTx :: !(Maybe HexString) } @@ -216,10 +215,11 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s] show (st ^. network) <> " - " <> (T.unpack - (maybe - "(None)" - (\(_, w) -> zcashWalletName $ entityVal w) - (L.listSelectedElement (st ^. wallets)))) ++ " ")) + (maybe + "(None)" + (\(_, w) -> zcashWalletName $ entityVal w) + (L.listSelectedElement (st ^. wallets)))) ++ + " ")) (C.hCenter (str ("Account: " ++ @@ -236,7 +236,8 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s] else displayTaz (st ^. balance))) <=> listAddressBox " Addresses " (st ^. addresses) <+> B.vBorder <+> - (C.hCenter (str ("Last block seen: " ++ show (st ^. syncBlock) ++ "\n")) <=> + (C.hCenter + (str ("Last block seen: " ++ show (st ^. syncBlock) ++ "\n")) <=> listTxBox " Transactions " (st ^. network) (st ^. transactions))) <=> C.hCenter (hBox @@ -313,7 +314,8 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s] vBox ([str "Actions", B.hBorder] <> actionList)) else emptyWidget where - keyList = map (C.hCenter . str) ["?", "Esc", "w", "a", "v", "s", "b", "q"] + keyList = + map (C.hCenter . str) ["?", "Esc", "w", "a", "v", "s", "b", "q"] actionList = map (hLimit 40 . str) @@ -374,50 +376,55 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s] -- 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")]]) + (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"])) + (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"])) + (hBox [capCommand "↲" " Save", capCommand3 "" "" " Cancel"])) -- Address Book edit/update entry form AdrBookDelForm -> D.renderDialog (D.dialog (Just $ str " Delete Address Book Entry ") Nothing 50) (renderForm (st ^. abForm) <=> C.hCenter - (hBox [capCommand "C" "onfirm delete", capCommand3 "" "" " Cancel"])) + (hBox + [ capCommand "C" "onfirm delete" + , capCommand3 "" "" " Cancel" + ])) -- - splashDialog :: State -> Widget Name splashDialog st = if st ^. splashBox @@ -429,16 +436,14 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s] (str " _____ _ _ _ \n|__ /___ _ __ (_) |_| |__\n / // _ \\ '_ \\| | __| '_ \\\n / /| __/ | | | | |_| | | |\n/____\\___|_| |_|_|\\__|_| |_|") <=> C.hCenter - (withAttr titleAttr (str "Zcash Wallet v0.5.3.0-beta")) <=> + (withAttr titleAttr (str "Zcash Wallet v0.5.3.1-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 " | "] - + 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 @@ -562,20 +567,21 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s] (strWrapWith (WrapSettings False True NoFill FillAfterFirst) (st ^. msg))) - AdrBookEntryDisplay -> do - case L.listSelectedElement $ st ^. abAddresses of + AdrBookEntryDisplay -> do + case L.listSelectedElement $ st ^. abAddresses of Just (_, a) -> do - let abentry = T.pack $ - " Descr: " ++ - T.unpack (addressBookAbdescrip (entityVal a)) ++ - "\n Address: " ++ - T.unpack (addressBookAbaddress (entityVal a)) + let abentry = + T.pack $ + " Descr: " ++ + T.unpack (addressBookAbdescrip (entityVal a)) ++ + "\n Address: " ++ + T.unpack (addressBookAbaddress (entityVal a)) withBorderStyle unicodeBold $ D.renderDialog - (D.dialog (Just $ txt " Address Book Entry ") Nothing 60) - (padAll 1 $ - txtWrapWith (WrapSettings False True NoFill FillAfterFirst) $ - abentry) + (D.dialog (Just $ txt " Address Book Entry ") Nothing 60) + (padAll 1 $ + txtWrapWith (WrapSettings False True NoFill FillAfterFirst) $ + abentry) _ -> emptyWidget BlankDisplay -> emptyWidget @@ -602,7 +608,7 @@ mkSendForm bal = padBottom (Pad 1) $ vLimit 1 (hLimit 15 $ str s <+> fill ' ') <+> w mkNewABForm :: AdrBookEntry -> Form AdrBookEntry e Name -mkNewABForm = +mkNewABForm = newForm [ label "Descrip: " @@= editTextField descrip DescripField (Just 1) , label "Address: " @@= editTextField address AddressField (Just 1) @@ -684,9 +690,9 @@ listDrawAB :: Bool -> Entity AddressBook -> Widget Name listDrawAB sel ab = let selStr s = if sel - then withAttr abSelAttr (txt $ " " <> s ) + then withAttr abSelAttr (txt $ " " <> s) else txt $ " " <> s - in selStr $ addressBookAbdescrip (entityVal ab) + in selStr $ addressBookAbdescrip (entityVal ab) customAttr :: A.AttrName customAttr = L.listSelectedAttr <> A.attrName "custom" @@ -726,7 +732,8 @@ scanZebra dbP zHost zPort b eChan = do 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" + then liftIO $ + BC.writeBChan eChan $ TickMsg "Invalid starting block for scan" else do let bList = [(sb + 1) .. (zgb_blocks bStatus)] if not (null bList) @@ -931,7 +938,7 @@ appEvent (BT.VtyEvent e) = do _ev -> return () SendDisplay -> BT.modify $ set displayBox BlankDisplay SyncDisplay -> BT.modify $ set displayBox BlankDisplay - AdrBookEntryDisplay -> BT.modify $ set displayBox BlankDisplay + AdrBookEntryDisplay -> BT.modify $ set displayBox BlankDisplay BlankDisplay -> do case s ^. dialogBox of WName -> do @@ -1072,19 +1079,21 @@ appEvent (BT.VtyEvent e) = 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 + 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 + V.EvKey (V.KChar 'c') [] -- Copy Address to Clipboard + -> do case L.listSelectedElement $ s ^. abAddresses of Just (_, a) -> do liftIO $ @@ -1092,53 +1101,72 @@ appEvent (BT.VtyEvent e) = do T.unpack $ addressBookAbaddress (entityVal a) BT.modify $ set msg $ - "Address copied to Clipboard from >>\n" ++ - T.unpack (addressBookAbdescrip (entityVal a)) + "Address copied to Clipboard from >>\n" ++ + T.unpack (addressBookAbdescrip (entityVal a)) BT.modify $ set displayBox MsgDisplay _ -> do - BT.modify $ set msg "Error while copying the address!!" - BT.modify $ set displayBox MsgDisplay + 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 (addressBookAbaddress (entityVal a)) 0.0 "") - BT.modify $ set dialogBox SendTx + BT.modify $ + set txForm $ + mkSendForm + (s ^. balance) + (SendInput + (addressBookAbaddress (entityVal a)) + 0.0 + "") + BT.modify $ set dialogBox SendTx _ -> do - BT.modify $ set msg "No receiver address available!!" - BT.modify $ set displayBox MsgDisplay + 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 (addressBookAbaddress (entityVal a)) - BT.modify $ - set abForm $ - mkNewABForm (AdrBookEntry (addressBookAbdescrip (entityVal a)) (addressBookAbaddress (entityVal a))) - BT.modify $ set dialogBox AdrBookUpdForm + BT.modify $ + set + abCurAdrs + (addressBookAbaddress (entityVal a)) + BT.modify $ + set abForm $ + mkNewABForm + (AdrBookEntry + (addressBookAbdescrip (entityVal a)) + (addressBookAbaddress (entityVal a))) + BT.modify $ set dialogBox AdrBookUpdForm _ -> do - BT.modify $ set dialogBox Blank + BT.modify $ set dialogBox Blank -- Delete an entry from Address Book V.EvKey (V.KChar 'd') [] -> do case L.listSelectedElement $ s ^. abAddresses of Just (_, a) -> do - BT.modify $ set abCurAdrs (addressBookAbaddress (entityVal a)) - BT.modify $ - set abForm $ - mkNewABForm (AdrBookEntry (addressBookAbdescrip (entityVal a)) (addressBookAbaddress (entityVal a))) - BT.modify $ set dialogBox AdrBookDelForm + BT.modify $ + set + abCurAdrs + (addressBookAbaddress (entityVal a)) + BT.modify $ + set abForm $ + mkNewABForm + (AdrBookEntry + (addressBookAbdescrip (entityVal a)) + (addressBookAbaddress (entityVal a))) + BT.modify $ set dialogBox AdrBookDelForm _ -> do - BT.modify $ set dialogBox Blank + 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 + BT.modify $ + set abForm $ mkNewABForm (AdrBookEntry "" "") + BT.modify $ set dialogBox AdrBookForm -- Show AddressBook entry data - V.EvKey V.KEnter [] -> do - BT.modify $ set displayBox AdrBookEntryDisplay - + V.EvKey V.KEnter [] -> do + BT.modify $ set displayBox AdrBookEntryDisplay -- Process any other event ev -> BT.zoom abAddresses $ L.handleListEvent ev -- Process new address book entry @@ -1146,75 +1174,101 @@ appEvent (BT.VtyEvent e) = 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 + 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 - s' <- liftIO $ refreshAddressBook s - BT.put s' - 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 + s' <- liftIO $ refreshAddressBook s + BT.put s' + 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 + 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 - s' <- liftIO $ refreshAddressBook s - BT.put s' - 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 + s' <- liftIO $ refreshAddressBook s + BT.put s' + 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 -- Process delete AddresBook entry AdrBookDelForm -> do - case e of - V.EvKey V.KEsc [] -> BT.modify $ set dialogBox AdrBook - V.EvKey (V.KChar 'c') [] -> do - pool <- liftIO $ runNoLoggingT $ initPool $ s ^. dbPath - fs <- BT.zoom abForm $ BT.gets formState - res <- liftIO $ deleteAdrsFromAB pool (fs ^.address) - s' <- liftIO $ refreshAddressBook s - BT.put s' - BT.modify $ set dialogBox AdrBook - ev -> BT.modify $ set dialogBox AdrBookDelForm + case e of + V.EvKey V.KEsc [] -> BT.modify $ set dialogBox AdrBook + V.EvKey (V.KChar 'c') [] -> do + pool <- liftIO $ runNoLoggingT $ initPool $ s ^. dbPath + fs <- BT.zoom abForm $ BT.gets formState + res <- liftIO $ deleteAdrsFromAB pool (fs ^. address) + s' <- liftIO $ refreshAddressBook s + BT.put s' + BT.modify $ set dialogBox AdrBook + ev -> BT.modify $ set dialogBox AdrBookDelForm -- Process any other event Blank -> do case e of @@ -1321,9 +1375,7 @@ runZenithTUI config = do 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 @@ -1451,8 +1503,7 @@ addNewAccount n s = do Right zA' -> do r <- saveAccount pool zA' case r of - Nothing -> - return $ s & msg .~ "Account already exists: " ++ T.unpack n + Nothing -> return $ s & msg .~ "Account already exists: " ++ T.unpack n Just x -> do aL <- runNoLoggingT $ getAccounts pool (entityKey selWallet) let nL = @@ -1519,10 +1570,11 @@ refreshAddressBook s = do do case L.listSelectedElement $ s ^. abAddresses of Nothing -> do let fAdd = - L.listSelectedElement $ L.listMoveToBeginning $ s ^. abAddresses + L.listSelectedElement $ + L.listMoveToBeginning $ s ^. abAddresses return fAdd Just a2 -> return $ Just a2 - abookList <- getAdrBook pool (s ^. network) + abookList <- getAdrBook pool (s ^. network) let tL' = L.listReplace (Vec.fromList abookList) (Just 0) (s ^. abAddresses) return $ s & abAddresses .~ tL' @@ -1547,8 +1599,7 @@ addNewAddress n scope s = do Right uA' -> do nAddr <- saveAddress pool uA' case nAddr of - Nothing -> - return $ s & msg .~ "Address already exists: " ++ T.unpack n + Nothing -> return $ s & msg .~ "Address already exists: " ++ T.unpack n Just x -> do addrL <- runNoLoggingT $ getAddresses pool (entityKey selAccount) let nL = diff --git a/zenith.cabal b/zenith.cabal index c7dedb1..c54b192 100644 --- a/zenith.cabal +++ b/zenith.cabal @@ -1,6 +1,6 @@ cabal-version: 3.0 name: zenith -version: 0.5.3.0-beta +version: 0.5.3.1-beta license: MIT license-file: LICENSE author: Rene Vergara From a8d1333600b94c184dc2dd29e143a7548bbc80c3 Mon Sep 17 00:00:00 2001 From: Rene Vergara Date: Thu, 4 Jul 2024 07:37:41 -0500 Subject: [PATCH 02/11] Add wallet sync screen --- src/Zenith/CLI.hs | 13 +-- src/Zenith/GUI.hs | 189 ++++++++++++++++++++++++++++++++++++++-- src/Zenith/GUI/Theme.hs | 30 +++++++ src/Zenith/Utils.hs | 5 ++ 4 files changed, 227 insertions(+), 10 deletions(-) diff --git a/src/Zenith/CLI.hs b/src/Zenith/CLI.hs index cfef49d..13d1d2d 100644 --- a/src/Zenith/CLI.hs +++ b/src/Zenith/CLI.hs @@ -25,7 +25,7 @@ import Brick.Forms 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 Brick.Util (bg, fg, on, style) import qualified Brick.Widgets.Border as B import Brick.Widgets.Border.Style (unicode, unicodeBold) import qualified Brick.Widgets.Center as C @@ -97,7 +97,13 @@ import Zenith.Types , UnifiedAddressDB(..) , ZcashNetDB(..) ) -import Zenith.Utils (displayTaz, displayZec, jsonNumber, showAddress) +import Zenith.Utils + ( displayTaz + , displayZec + , jsonNumber + , showAddress + , validBarValue + ) data Name = WList @@ -589,9 +595,6 @@ barDoneAttr = A.attrName "done" barToDoAttr :: A.AttrName barToDoAttr = A.attrName "remaining" -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 diff --git a/src/Zenith/GUI.hs b/src/Zenith/GUI.hs index 6e95af4..ca62ec3 100644 --- a/src/Zenith/GUI.hs +++ b/src/Zenith/GUI.hs @@ -7,8 +7,11 @@ import Codec.Picture import Codec.Picture.Types (pixelFold, promoteImage) import Codec.QRCode import Codec.QRCode.JuicyPixels +import Control.Concurrent (threadDelay) import Control.Exception (throwIO, try) +import Control.Monad.IO.Class (liftIO) import Control.Monad.Logger (runNoLoggingT) +import Data.Aeson import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as LBS import Data.HexString (toText) @@ -23,13 +26,15 @@ import Lens.Micro.TH import Monomer import qualified Monomer.Lens as L import System.Hclip +import Text.Printf import Text.Wrap (FillScope(..), FillStrategy(..), WrapSettings(..), wrapText) import TextShow hiding (toText) import ZcashHaskell.Keys (generateWalletSeedPhrase) import ZcashHaskell.Orchard (getSaplingFromUA, isValidUnifiedAddress) import ZcashHaskell.Transparent (encodeTransparentReceiver) import ZcashHaskell.Types - ( Phrase(..) + ( BlockResponse(..) + , Phrase(..) , Scope(..) , ToBytes(..) , UnifiedAddress(..) @@ -37,11 +42,13 @@ import ZcashHaskell.Types , ZebraGetBlockChainInfo(..) , ZebraGetInfo(..) ) +import ZcashHaskell.Utils (getBlockTime, makeZebraCall) import Zenith.Core import Zenith.DB import Zenith.GUI.Theme +import Zenith.Scanner (processTx) import Zenith.Types hiding (ZcashAddress(..)) -import Zenith.Utils (displayAmount, showAddress) +import Zenith.Utils (displayAmount, jsonNumber, showAddress, validBarValue) data AppEvent = AppInit @@ -76,6 +83,13 @@ data AppEvent | CopyTx !T.Text | CloseTx | ShowTx !Int + | TickUp + | SyncVal !Float + | SendTx + | ShowSend + | CancelSend + | CheckRecipient + | CheckAmount deriving (Eq, Show) data AppModel = AppModel @@ -108,6 +122,14 @@ data AppModel = AppModel , _showSeed :: !Bool , _modalMsg :: !(Maybe T.Text) , _showTx :: !(Maybe Int) + , _timer :: !Int + , _barValue :: !Float + , _openSend :: !Bool + , _sendRecipient :: !T.Text + , _sendAmount :: !Float + , _sendMemo :: !T.Text + , _recipientValid :: !Bool + , _amountValid :: !Bool } deriving (Eq, Show) makeLenses ''AppModel @@ -145,6 +167,7 @@ buildUI wenv model = widgetTree , confirmOverlay `nodeVisible` isJust (model ^. confirmTitle) , seedOverlay `nodeVisible` model ^. showSeed , txOverlay `nodeVisible` isJust (model ^. showTx) + , sendTxOverlay `nodeVisible` model ^. openSend , msgOverlay `nodeVisible` isJust (model ^. msg) , modalOverlay `nodeVisible` isJust (model ^. modalMsg) ] @@ -275,7 +298,12 @@ buildUI wenv model = widgetTree mainPane = box_ [alignMiddle] $ hstack - [addressBox, txBox `nodeVisible` not (null $ model ^. transactions)] + [ addressBox + , vstack + [ mainButton "Send" ShowSend + , txBox `nodeVisible` not (null $ model ^. transactions) + ] + ] balanceBox = hstack [ filler @@ -456,6 +484,8 @@ buildUI wenv model = widgetTree ("Last block sync: " <> maybe "N/A" (showt . zcashWalletLastSync . entityVal) currentWallet) `styleBasic` [padding 3, textSize 8] + , spacer + , label (showt $ model ^. timer) `styleBasic` [padding 3, textSize 8] , filler , image_ "./assets/1F993.png" [fitHeight] `styleBasic` [height 24, width 24] `nodeVisible` @@ -489,6 +519,31 @@ buildUI wenv model = widgetTree , cancelCaption $ model ^. confirmCancel ] (hstack [label "Name:", filler, textField_ mainInput [maxLength 25]]) + sendTxOverlay = + confirm_ + SendTx + CancelSend + [ titleCaption "Send Transaction" + , acceptCaption "Send" + , cancelCaption "Cancel" + ] + (vstack + [ hstack + [ label "To:" `styleBasic` [width 50] + , filler + , textField_ sendRecipient [] + ] + , hstack + [ label "Amount:" `styleBasic` [width 50] + , filler + , numericField_ sendAmount [minValue 0.0, decimals 8] + ] + , hstack + [ label "Memo:" `styleBasic` [width 50] + , filler + , textArea sendMemo + ] + ]) seedOverlay = alert CloseSeed $ vstack @@ -679,7 +734,8 @@ handleEvent :: -> [AppEventResponse AppModel AppEvent] handleEvent wenv node model evt = case evt of - AppInit -> [Event NewWallet | isNothing currentWallet] + AppInit -> + [Event NewWallet | isNothing currentWallet] <> [Producer timeTicker] ShowMsg t -> [Model $ model & msg ?~ t & menuPopup .~ False] ShowError t -> [Model $ model & msg ?~ t & menuPopup .~ False & inError .~ True] @@ -720,6 +776,14 @@ handleEvent wenv node model evt = ] ConfirmCancel -> [Model $ model & confirmTitle .~ Nothing & mainInput .~ ""] ShowSeed -> [Model $ model & showSeed .~ True & menuPopup .~ False] + ShowSend -> [Model $ model & openSend .~ True] + SendTx -> [] + CancelSend -> + [ Model $ + model & openSend .~ False & sendRecipient .~ "" & sendAmount .~ 0.0 & + sendMemo .~ + "" + ] SaveAddress acc -> if T.length (model ^. mainInput) > 1 then [ Task $ addNewAddress (model ^. mainInput) External acc @@ -817,12 +881,53 @@ handleEvent wenv node model evt = else [Event $ NewAccount currentWallet] LoadWallets a -> if not (null a) - then [Model $ model & wallets .~ a, Event $ SwitchWal 0] + then [ Model $ model & wallets .~ a + , Event $ SwitchWal $ model ^. selWallet + ] else [Event NewWallet] CloseMsg -> [Model $ model & msg .~ Nothing & inError .~ False] CloseSeed -> [Model $ model & showSeed .~ False] CloseTx -> [Model $ model & showTx .~ Nothing] ShowTx i -> [Model $ model & showTx ?~ i] + TickUp -> + if (model ^. timer) < 90 + then [Model $ model & timer .~ (1 + model ^. timer)] + else if (model ^. barValue) == 1.0 + then [ Model $ model & timer .~ 0 & barValue .~ 0.0 + , Producer $ + scanZebra + (c_dbPath $ model ^. configuration) + (c_zebraHost $ model ^. configuration) + (c_zebraPort $ model ^. configuration) + ] + else [Model $ model & timer .~ 0] + SyncVal i -> + if (i + model ^. barValue) >= 0.999 + then [ Model $ model & barValue .~ 1.0 & modalMsg .~ Nothing + , Task $ do + case currentWallet of + Nothing -> return $ ShowError "No wallet available" + Just cW -> do + syncWallet (model ^. configuration) cW + return $ SwitchAddr (model ^. selAddr) + , Task $ do + pool <- + runNoLoggingT $ initPool $ c_dbPath $ model ^. configuration + wL <- getWallets pool (model ^. network) + return $ LoadWallets wL + ] + else [ Model $ + model & barValue .~ validBarValue (i + model ^. barValue) & + modalMsg ?~ + ("Wallet Sync: " <> + T.pack (printf "%.2f%%" (model ^. barValue * 100))) + ] + CheckRecipient -> [] + CheckAmount -> + [ Model $ + model & amountValid .~ + ((model ^. sendAmount) < (fromIntegral (model ^. balance) / 100000000.0)) + ] where currentWallet = if null (model ^. wallets) @@ -911,6 +1016,64 @@ handleEvent wenv node model evt = wL <- getWallets pool (model ^. network) return $ LoadWallets wL +scanZebra :: T.Text -> T.Text -> Int -> (AppEvent -> IO ()) -> IO () +scanZebra dbPath zHost zPort sendMsg = do + _ <- liftIO $ initDb dbPath + bStatus <- liftIO $ checkBlockChain zHost zPort + pool <- runNoLoggingT $ initPool dbPath + b <- liftIO $ getMinBirthdayHeight pool + dbBlock <- runNoLoggingT $ getMaxBlock pool + let sb = max dbBlock b + if sb > zgb_blocks bStatus || sb < 1 + then sendMsg (ShowError "Invalid starting block for scan") + else do + let bList = [(sb + 1) .. (zgb_blocks bStatus)] + if not (null bList) + then do + let step = (1.0 :: Float) / fromIntegral (length bList) + mapM_ (processBlock pool step) bList + else sendMsg (SyncVal 1.0) + where + processBlock :: ConnectionPool -> Float -> Int -> IO () + processBlock pool step bl = do + r <- + liftIO $ + makeZebraCall + zHost + zPort + "getblock" + [Data.Aeson.String $ showt bl, jsonNumber 1] + case r of + Left e1 -> sendMsg (ShowError $ showt e1) + Right blk -> do + r2 <- + liftIO $ + makeZebraCall + zHost + zPort + "getblock" + [Data.Aeson.String $ showt bl, jsonNumber 0] + case r2 of + Left e2 -> sendMsg (ShowError $ showt e2) + Right hb -> do + let blockTime = getBlockTime hb + mapM_ (runNoLoggingT . processTx zHost zPort blockTime pool) $ + bl_txs $ addTime blk blockTime + sendMsg (SyncVal step) + addTime :: BlockResponse -> Int -> BlockResponse + addTime bl t = + BlockResponse + (bl_confirmations bl) + (bl_height bl) + (fromIntegral t) + (bl_txs bl) + +timeTicker :: (AppEvent -> IO ()) -> IO () +timeTicker sendMsg = do + sendMsg TickUp + threadDelay $ 1000 * 1000 + timeTicker sendMsg + txtWrap :: T.Text -> T.Text txtWrap = wrapText (WrapSettings False True NoFill FillAfterFirst) 32 @@ -982,6 +1145,14 @@ runZenithGUI config = do False Nothing Nothing + 0 + 1.0 + False + "" + 0.0 + "" + False + False startApp model handleEvent buildUI params Left e -> do initDb dbFilePath @@ -1018,6 +1189,14 @@ runZenithGUI config = do False Nothing Nothing + 0 + 1.0 + False + "" + 0.0 + "" + False + False startApp model handleEvent buildUI params where params = diff --git a/src/Zenith/GUI/Theme.hs b/src/Zenith/GUI/Theme.hs index 7322522..cf37d98 100644 --- a/src/Zenith/GUI/Theme.hs +++ b/src/Zenith/GUI/Theme.hs @@ -78,6 +78,36 @@ zenithTheme = baseTextStyle & L.focusHover . L.textFieldStyle . L.text ?~ + baseTextStyle & + L.basic . + L.numericFieldStyle . L.text ?~ + baseTextStyle & + L.hover . + L.numericFieldStyle . L.text ?~ + baseTextStyle & + L.focus . + L.numericFieldStyle . L.text ?~ + baseTextStyle & + L.active . + L.numericFieldStyle . L.text ?~ + baseTextStyle & + L.focusHover . + L.numericFieldStyle . L.text ?~ + baseTextStyle & + L.basic . + L.textAreaStyle . L.text ?~ + baseTextStyle & + L.hover . + L.textAreaStyle . L.text ?~ + baseTextStyle & + L.focus . + L.textAreaStyle . L.text ?~ + baseTextStyle & + L.active . + L.textAreaStyle . L.text ?~ + baseTextStyle & + L.focusHover . + L.textAreaStyle . L.text ?~ baseTextStyle zenithThemeColors :: BaseThemeColors diff --git a/src/Zenith/Utils.hs b/src/Zenith/Utils.hs index 0b7821e..a3c6cbd 100644 --- a/src/Zenith/Utils.hs +++ b/src/Zenith/Utils.hs @@ -5,6 +5,7 @@ module Zenith.Utils where import Data.Aeson import Data.Functor (void) import Data.Maybe +import Data.Ord (clamp) import Data.Scientific (Scientific(..), scientific) import qualified Data.Text as T import qualified Data.Text.Encoding as E @@ -79,3 +80,7 @@ copyAddress a = void $ createProcess_ "toClipboard" $ shell $ "echo " ++ T.unpack (addy a) ++ " | xclip -r -selection clipboard" + +-- | Bound a value to the 0..1 range, used for progress reporting on UIs +validBarValue :: Float -> Float +validBarValue = clamp (0, 1) From 06c58f62df5d1ce17e8af40b68d48da501d37833 Mon Sep 17 00:00:00 2001 From: Rene Vergara Date: Thu, 4 Jul 2024 07:46:38 -0500 Subject: [PATCH 03/11] Fix bug on TUI amount validation --- src/Zenith/CLI.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Zenith/CLI.hs b/src/Zenith/CLI.hs index 13d1d2d..db28e5e 100644 --- a/src/Zenith/CLI.hs +++ b/src/Zenith/CLI.hs @@ -504,7 +504,7 @@ mkSendForm bal = ] where isAmountValid :: Integer -> Float -> Bool - isAmountValid b i = (fromIntegral b * 100000000.0) >= i + isAmountValid b i = (fromIntegral b / 100000000.0) >= i label s w = padBottom (Pad 1) $ vLimit 1 (hLimit 15 $ str s <+> fill ' ') <+> w From 75dc71459ff57ce56838661648ba6cd491f800d3 Mon Sep 17 00:00:00 2001 From: Rene Vergara Date: Mon, 8 Jul 2024 13:06:25 -0500 Subject: [PATCH 04/11] Generalize parsing of addresses --- src/Zenith/CLI.hs | 70 ++++++++++++++------------------------------- src/Zenith/Utils.hs | 40 ++++++++++++++++++++++++-- 2 files changed, 60 insertions(+), 50 deletions(-) diff --git a/src/Zenith/CLI.hs b/src/Zenith/CLI.hs index db28e5e..8d1f707 100644 --- a/src/Zenith/CLI.hs +++ b/src/Zenith/CLI.hs @@ -82,8 +82,7 @@ import ZcashHaskell.Keys (generateWalletSeedPhrase, getWalletSeed) import ZcashHaskell.Orchard (getSaplingFromUA, isValidUnifiedAddress) import ZcashHaskell.Sapling (decodeSaplingAddress, isValidShieldedAddress) import ZcashHaskell.Transparent - ( decodeExchangeAddress - , decodeTransparentAddress + ( decodeTransparentAddress , encodeTransparentReceiver ) import ZcashHaskell.Types @@ -100,7 +99,9 @@ import Zenith.Types import Zenith.Utils ( displayTaz , displayZec + , isRecipientValid , jsonNumber + , parseAddress , showAddress , validBarValue ) @@ -508,19 +509,6 @@ mkSendForm bal = label s w = padBottom (Pad 1) $ vLimit 1 (hLimit 15 $ 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 = @@ -1288,36 +1276,22 @@ sendTransaction :: -> 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 $ TickTx 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" + case parseAddress ua znet of + Nothing -> BC.writeBChan chan $ TickMsg "Incorrect address" + Just outUA -> do + 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 $ TickTx txId diff --git a/src/Zenith/Utils.hs b/src/Zenith/Utils.hs index a3c6cbd..6ad1816 100644 --- a/src/Zenith/Utils.hs +++ b/src/Zenith/Utils.hs @@ -12,8 +12,17 @@ import qualified Data.Text.Encoding as E import System.Process (createProcess_, shell) import Text.Regex.Posix import ZcashHaskell.Orchard (encodeUnifiedAddress, isValidUnifiedAddress) -import ZcashHaskell.Sapling (isValidShieldedAddress) -import ZcashHaskell.Types (ZcashNet(..)) +import ZcashHaskell.Sapling (decodeSaplingAddress, isValidShieldedAddress) +import ZcashHaskell.Transparent + ( decodeExchangeAddress + , decodeTransparentAddress + ) +import ZcashHaskell.Types + ( SaplingAddress(..) + , TransparentAddress(..) + , UnifiedAddress(..) + , ZcashNet(..) + ) import Zenith.Types ( AddressGroup(..) , UnifiedAddressDB(..) @@ -84,3 +93,30 @@ copyAddress a = -- | Bound a value to the 0..1 range, used for progress reporting on UIs validBarValue :: Float -> Float validBarValue = clamp (0, 1) + +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) + +parseAddress :: T.Text -> ZcashNet -> Maybe UnifiedAddress +parseAddress a znet = + case isValidUnifiedAddress (E.encodeUtf8 a) of + Just a1 -> Just a1 + Nothing -> + case decodeSaplingAddress (E.encodeUtf8 a) of + Just a2 -> + Just $ UnifiedAddress znet Nothing (Just $ sa_receiver a2) Nothing + Nothing -> + case decodeTransparentAddress (E.encodeUtf8 a) of + Just a3 -> + Just $ UnifiedAddress znet Nothing Nothing (Just $ ta_receiver a3) + Nothing -> Nothing From 56eeeaaf20b23f56c200731b91aac178615fa5aa Mon Sep 17 00:00:00 2001 From: Rene Vergara Date: Mon, 8 Jul 2024 13:06:43 -0500 Subject: [PATCH 05/11] Implement UI elements for sending transactions --- CHANGELOG.md | 5 ++ src/Zenith/GUI.hs | 195 ++++++++++++++++++++++++++++++++++------ src/Zenith/GUI/Theme.hs | 6 ++ 3 files changed, 177 insertions(+), 29 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index e013584..11b6be4 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -20,7 +20,12 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 - Dialog to add new account - Dialog to add new wallet - Dialog to display transaction details and copy TX ID +- Dialog to send a new transaction +- Dialog to display Tx ID after successful broadcast +### Fixed + +- Validation of input of amount for sending in TUI ## [0.5.3.0-beta] diff --git a/src/Zenith/GUI.hs b/src/Zenith/GUI.hs index ca62ec3..fc91442 100644 --- a/src/Zenith/GUI.hs +++ b/src/Zenith/GUI.hs @@ -10,7 +10,7 @@ import Codec.QRCode.JuicyPixels import Control.Concurrent (threadDelay) import Control.Exception (throwIO, try) import Control.Monad.IO.Class (liftIO) -import Control.Monad.Logger (runNoLoggingT) +import Control.Monad.Logger (runFileLoggingT, runNoLoggingT) import Data.Aeson import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as LBS @@ -48,7 +48,14 @@ import Zenith.DB import Zenith.GUI.Theme import Zenith.Scanner (processTx) import Zenith.Types hiding (ZcashAddress(..)) -import Zenith.Utils (displayAmount, jsonNumber, showAddress, validBarValue) +import Zenith.Utils + ( displayAmount + , isRecipientValid + , jsonNumber + , parseAddress + , showAddress + , validBarValue + ) data AppEvent = AppInit @@ -78,6 +85,7 @@ data AppEvent | SaveAccount !(Maybe (Entity ZcashWallet)) | SaveWallet | CloseSeed + | CloseTxId | ShowSeed | CopySeed !T.Text | CopyTx !T.Text @@ -88,8 +96,9 @@ data AppEvent | SendTx | ShowSend | CancelSend - | CheckRecipient - | CheckAmount + | CheckRecipient !T.Text + | CheckAmount !Float + | ShowTxId !T.Text deriving (Eq, Show) data AppModel = AppModel @@ -130,6 +139,7 @@ data AppModel = AppModel , _sendMemo :: !T.Text , _recipientValid :: !Bool , _amountValid :: !Bool + , _showId :: !(Maybe T.Text) } deriving (Eq, Show) makeLenses ''AppModel @@ -168,6 +178,7 @@ buildUI wenv model = widgetTree , seedOverlay `nodeVisible` model ^. showSeed , txOverlay `nodeVisible` isJust (model ^. showTx) , sendTxOverlay `nodeVisible` model ^. openSend + , txIdOverlay `nodeVisible` isJust (model ^. showId) , msgOverlay `nodeVisible` isJust (model ^. msg) , modalOverlay `nodeVisible` isJust (model ^. modalMsg) ] @@ -520,30 +531,72 @@ buildUI wenv model = widgetTree ] (hstack [label "Name:", filler, textField_ mainInput [maxLength 25]]) sendTxOverlay = - confirm_ - SendTx - CancelSend - [ titleCaption "Send Transaction" - , acceptCaption "Send" - , cancelCaption "Cancel" - ] + box (vstack - [ hstack - [ label "To:" `styleBasic` [width 50] - , filler - , textField_ sendRecipient [] - ] + [ filler , hstack - [ label "Amount:" `styleBasic` [width 50] + [ filler + , box_ + [] + (vstack + [ box_ + [alignMiddle] + (label "Send Zcash" `styleBasic` + [textFont "Bold", textSize 12]) + , separatorLine `styleBasic` [fgColor btnColor] + , spacer + , hstack + [ label "To:" `styleBasic` [width 50] + , spacer + , textField_ sendRecipient [onChange CheckRecipient] `styleBasic` + [ width 150 + , styleIf + (not $ model ^. recipientValid) + (textColor red) + ] + ] + , hstack + [ label "Amount:" `styleBasic` [width 50] + , spacer + , numericField_ + sendAmount + [ decimals 8 + , minValue 0.0 + , maxValue + (fromIntegral (model ^. balance) / 100000000.0) + , validInput amountValid + , onChange CheckAmount + ] `styleBasic` + [ width 150 + , styleIf + (not $ model ^. amountValid) + (textColor red) + ] + ] + , hstack + [ label "Memo:" `styleBasic` [width 50] + , spacer + , textArea sendMemo `styleBasic` + [width 150, height 40] + ] + , spacer + , box_ + [alignMiddle] + (hstack + [ spacer + , button "Cancel" CancelSend + , spacer + , mainButton "Send" SendTx `nodeEnabled` + (model ^. amountValid && model ^. recipientValid) + , spacer + ]) + ]) `styleBasic` + [radius 4, border 2 btnColor, bgColor white, padding 4] , filler - , numericField_ sendAmount [minValue 0.0, decimals 8] ] - , hstack - [ label "Memo:" `styleBasic` [width 50] - , filler - , textArea sendMemo - ] - ]) + , filler + ]) `styleBasic` + [bgColor (white & L.a .~ 0.5)] seedOverlay = alert CloseSeed $ vstack @@ -657,6 +710,31 @@ buildUI wenv model = widgetTree ]) `styleBasic` [padding 2, bgColor white, width 280, borderB 1 gray] ] + txIdOverlay = + case model ^. showId of + Nothing -> alert CloseTxId $ label "N/A" + Just t -> + alert CloseTxId $ + box_ + [alignLeft] + (vstack + [ box_ [alignMiddle] $ + label "Transaction Sent!" `styleBasic` [textFont "Bold"] + , spacer + , hstack + [ label "Tx ID " `styleBasic` [width 60, textFont "Bold"] + , separatorLine `styleBasic` [fgColor btnColor] + , spacer + , label_ (txtWrap t) [multiline] + , spacer + , box_ + [onClick $ CopyTx t] + (remixIcon remixFileCopyFill `styleBasic` + [textColor white]) `styleBasic` + [cursorHand, bgColor btnColor, radius 2, padding 2] + ] + ]) `styleBasic` + [padding 2, bgColor white, width 280, borderB 1 gray, borderT 1 gray] generateQRCodes :: Config -> IO () generateQRCodes config = do @@ -738,7 +816,10 @@ handleEvent wenv node model evt = [Event NewWallet | isNothing currentWallet] <> [Producer timeTicker] ShowMsg t -> [Model $ model & msg ?~ t & menuPopup .~ False] ShowError t -> - [Model $ model & msg ?~ t & menuPopup .~ False & inError .~ True] + [ Model $ + model & msg ?~ t & menuPopup .~ False & inError .~ True & modalMsg .~ + Nothing + ] ShowModal t -> [Model $ model & modalMsg ?~ t] WalletClicked -> [Model $ model & walPopup .~ True] AccountClicked -> [Model $ model & accPopup .~ True] @@ -777,7 +858,23 @@ handleEvent wenv node model evt = ConfirmCancel -> [Model $ model & confirmTitle .~ Nothing & mainInput .~ ""] ShowSeed -> [Model $ model & showSeed .~ True & menuPopup .~ False] ShowSend -> [Model $ model & openSend .~ True] - SendTx -> [] + SendTx -> + case currentAccount of + Nothing -> [Event $ ShowError "No account available"] + Just acc -> + case currentWallet of + Nothing -> [Event $ ShowError "No wallet available"] + Just wal -> + [ Producer $ + sendTransaction + (model ^. configuration) + (model ^. network) + (entityKey acc) + (zcashWalletLastSync $ entityVal wal) + (model ^. sendAmount) + (model ^. sendRecipient) + (model ^. sendMemo) + ] CancelSend -> [ Model $ model & openSend .~ False & sendRecipient .~ "" & sendAmount .~ 0.0 & @@ -888,6 +985,7 @@ handleEvent wenv node model evt = CloseMsg -> [Model $ model & msg .~ Nothing & inError .~ False] CloseSeed -> [Model $ model & showSeed .~ False] CloseTx -> [Model $ model & showTx .~ Nothing] + CloseTxId -> [Model $ model & showId .~ Nothing] ShowTx i -> [Model $ model & showTx ?~ i] TickUp -> if (model ^. timer) < 90 @@ -922,12 +1020,13 @@ handleEvent wenv node model evt = ("Wallet Sync: " <> T.pack (printf "%.2f%%" (model ^. barValue * 100))) ] - CheckRecipient -> [] - CheckAmount -> + CheckRecipient a -> [Model $ model & recipientValid .~ isRecipientValid a] + CheckAmount i -> [ Model $ model & amountValid .~ - ((model ^. sendAmount) < (fromIntegral (model ^. balance) / 100000000.0)) + (i < (fromIntegral (model ^. balance) / 100000000.0)) ] + ShowTxId tx -> [Model $ model & showId ?~ tx & modalMsg .~ Nothing] where currentWallet = if null (model ^. wallets) @@ -1068,6 +1167,42 @@ scanZebra dbPath zHost zPort sendMsg = do (fromIntegral t) (bl_txs bl) +sendTransaction :: + Config + -> ZcashNet + -> ZcashAccountId + -> Int + -> Float + -> T.Text + -> T.Text + -> (AppEvent -> IO ()) + -> IO () +sendTransaction config znet accId bl amt ua memo sendMsg = do + sendMsg $ ShowModal "Preparing transaction..." + case parseAddress ua znet of + Nothing -> sendMsg $ ShowError "Incorrect address" + Just outUA -> do + let dbPath = c_dbPath config + let zHost = c_zebraHost config + let zPort = c_zebraPort config + pool <- runNoLoggingT $ initPool dbPath + res <- + runFileLoggingT "zenith.log" $ + prepareTx pool zHost zPort znet accId bl amt outUA memo + case res of + Left e -> sendMsg $ ShowError $ T.pack $ show e + Right rawTx -> do + sendMsg $ ShowModal "Transaction ready, sending to Zebra..." + resp <- + makeZebraCall + zHost + zPort + "sendrawtransaction" + [Data.Aeson.String $ toText rawTx] + case resp of + Left e1 -> sendMsg $ ShowError $ "Zebra error: " <> showt e1 + Right txId -> sendMsg $ ShowTxId txId + timeTicker :: (AppEvent -> IO ()) -> IO () timeTicker sendMsg = do sendMsg TickUp @@ -1153,6 +1288,7 @@ runZenithGUI config = do "" False False + Nothing startApp model handleEvent buildUI params Left e -> do initDb dbFilePath @@ -1197,6 +1333,7 @@ runZenithGUI config = do "" False False + Nothing startApp model handleEvent buildUI params where params = diff --git a/src/Zenith/GUI/Theme.hs b/src/Zenith/GUI/Theme.hs index cf37d98..6b59ef3 100644 --- a/src/Zenith/GUI/Theme.hs +++ b/src/Zenith/GUI/Theme.hs @@ -64,6 +64,12 @@ zenithTheme = L.active . L.btnMainStyle . L.text ?~ hiliteTextStyle & + L.disabled . + L.btnMainStyle . L.text ?~ + hiliteTextStyle & + L.disabled . + L.btnMainStyle . L.bgColor ?~ + gray07c & L.basic . L.textFieldStyle . L.text ?~ baseTextStyle & From ccc19d635b8264ffbe993ddb43c3a8f2ecde6e9f Mon Sep 17 00:00:00 2001 From: Rene Vergara Date: Mon, 8 Jul 2024 15:17:31 -0500 Subject: [PATCH 06/11] Implement confirmed and unconfirmed balance functions --- src/Zenith/DB.hs | 133 ++++++++++++++++++++++++++++++++++++++++++----- 1 file changed, 121 insertions(+), 12 deletions(-) diff --git a/src/Zenith/DB.hs b/src/Zenith/DB.hs index 03cc451..f855f02 100644 --- a/src/Zenith/DB.hs +++ b/src/Zenith/DB.hs @@ -1392,6 +1392,19 @@ getBalance pool za = do let oBal = sum oAmts return . fromIntegral $ tBal + sBal + oBal +getUnconfirmedBalance :: ConnectionPool -> ZcashAccountId -> IO Integer +getUnconfirmedBalance pool za = do + trNotes <- getWalletUnspentUnconfirmedTrNotes pool za + let tAmts = map (walletTrNoteValue . entityVal) trNotes + let tBal = sum tAmts + sapNotes <- getWalletUnspentUnconfirmedSapNotes pool za + let sAmts = map (walletSapNoteValue . entityVal) sapNotes + let sBal = sum sAmts + orchNotes <- getWalletUnspentUnconfirmedOrchNotes pool za + let oAmts = map (walletOrchNoteValue . entityVal) orchNotes + let oBal = sum oAmts + return . fromIntegral $ tBal + sBal + oBal + clearWalletTransactions :: ConnectionPool -> IO () clearWalletTransactions pool = do runNoLoggingT $ @@ -1429,10 +1442,42 @@ getWalletUnspentTrNotes pool za = do PS.retryOnBusy $ flip PS.runSqlPool pool $ do select $ do - n <- from $ table @WalletTrNote - where_ (n ^. WalletTrNoteAccId ==. val za) - where_ (n ^. WalletTrNoteSpent ==. val False) - pure n + (txs :& tNotes) <- + from $ table @WalletTransaction `innerJoin` table @WalletTrNote `on` + (\(txs :& tNotes) -> + txs ^. WalletTransactionId ==. tNotes ^. WalletTrNoteTx) + where_ (tNotes ^. WalletTrNoteAccId ==. val za) + where_ (tNotes ^. WalletTrNoteSpent ==. val False) + where_ + ((tNotes ^. WalletTrNoteChange ==. val True &&. txs ^. + WalletTransactionConf >=. + val 3) ||. + (tNotes ^. WalletTrNoteChange ==. val False &&. txs ^. + WalletTransactionConf >=. + val 10)) + pure tNotes + +getWalletUnspentUnconfirmedTrNotes :: + ConnectionPool -> ZcashAccountId -> IO [Entity WalletTrNote] +getWalletUnspentUnconfirmedTrNotes pool za = do + runNoLoggingT $ + PS.retryOnBusy $ + flip PS.runSqlPool pool $ do + select $ do + (txs :& tNotes) <- + from $ table @WalletTransaction `innerJoin` table @WalletTrNote `on` + (\(txs :& tNotes) -> + txs ^. WalletTransactionId ==. tNotes ^. WalletTrNoteTx) + where_ (tNotes ^. WalletTrNoteAccId ==. val za) + where_ (tNotes ^. WalletTrNoteSpent ==. val False) + where_ + ((tNotes ^. WalletTrNoteChange ==. val True &&. txs ^. + WalletTransactionConf <. + val 3) ||. + (tNotes ^. WalletTrNoteChange ==. val False &&. txs ^. + WalletTransactionConf <. + val 10)) + pure tNotes getWalletUnspentSapNotes :: ConnectionPool -> ZcashAccountId -> IO [Entity WalletSapNote] @@ -1441,10 +1486,42 @@ getWalletUnspentSapNotes pool za = do PS.retryOnBusy $ flip PS.runSqlPool pool $ do select $ do - n1 <- from $ table @WalletSapNote - where_ (n1 ^. WalletSapNoteAccId ==. val za) - where_ (n1 ^. WalletSapNoteSpent ==. val False) - pure n1 + (txs :& sNotes) <- + from $ table @WalletTransaction `innerJoin` table @WalletSapNote `on` + (\(txs :& sNotes) -> + txs ^. WalletTransactionId ==. sNotes ^. WalletSapNoteTx) + where_ (sNotes ^. WalletSapNoteAccId ==. val za) + where_ (sNotes ^. WalletSapNoteSpent ==. val False) + where_ + ((sNotes ^. WalletSapNoteChange ==. val True &&. txs ^. + WalletTransactionConf >=. + val 3) ||. + (sNotes ^. WalletSapNoteChange ==. val False &&. txs ^. + WalletTransactionConf >=. + val 10)) + pure sNotes + +getWalletUnspentUnconfirmedSapNotes :: + ConnectionPool -> ZcashAccountId -> IO [Entity WalletSapNote] +getWalletUnspentUnconfirmedSapNotes pool za = do + runNoLoggingT $ + PS.retryOnBusy $ + flip PS.runSqlPool pool $ do + select $ do + (txs :& sNotes) <- + from $ table @WalletTransaction `innerJoin` table @WalletSapNote `on` + (\(txs :& sNotes) -> + txs ^. WalletTransactionId ==. sNotes ^. WalletSapNoteTx) + where_ (sNotes ^. WalletSapNoteAccId ==. val za) + where_ (sNotes ^. WalletSapNoteSpent ==. val False) + where_ + ((sNotes ^. WalletSapNoteChange ==. val True &&. txs ^. + WalletTransactionConf <. + val 3) ||. + (sNotes ^. WalletSapNoteChange ==. val False &&. txs ^. + WalletTransactionConf <. + val 10)) + pure sNotes getWalletUnspentOrchNotes :: ConnectionPool -> ZcashAccountId -> IO [Entity WalletOrchNote] @@ -1453,10 +1530,42 @@ getWalletUnspentOrchNotes pool za = do PS.retryOnBusy $ flip PS.runSqlPool pool $ do select $ do - n2 <- from $ table @WalletOrchNote - where_ (n2 ^. WalletOrchNoteAccId ==. val za) - where_ (n2 ^. WalletOrchNoteSpent ==. val False) - pure n2 + (txs :& oNotes) <- + from $ table @WalletTransaction `innerJoin` table @WalletOrchNote `on` + (\(txs :& oNotes) -> + txs ^. WalletTransactionId ==. oNotes ^. WalletOrchNoteTx) + where_ (oNotes ^. WalletOrchNoteAccId ==. val za) + where_ (oNotes ^. WalletOrchNoteSpent ==. val False) + where_ + ((oNotes ^. WalletOrchNoteChange ==. val True &&. txs ^. + WalletTransactionConf >=. + val 3) ||. + (oNotes ^. WalletOrchNoteChange ==. val False &&. txs ^. + WalletTransactionConf >=. + val 10)) + pure oNotes + +getWalletUnspentUnconfirmedOrchNotes :: + ConnectionPool -> ZcashAccountId -> IO [Entity WalletOrchNote] +getWalletUnspentUnconfirmedOrchNotes pool za = do + runNoLoggingT $ + PS.retryOnBusy $ + flip PS.runSqlPool pool $ do + select $ do + (txs :& oNotes) <- + from $ table @WalletTransaction `innerJoin` table @WalletOrchNote `on` + (\(txs :& oNotes) -> + txs ^. WalletTransactionId ==. oNotes ^. WalletOrchNoteTx) + where_ (oNotes ^. WalletOrchNoteAccId ==. val za) + where_ (oNotes ^. WalletOrchNoteSpent ==. val False) + where_ + ((oNotes ^. WalletOrchNoteChange ==. val True &&. txs ^. + WalletTransactionConf <. + val 3) ||. + (oNotes ^. WalletOrchNoteChange ==. val False &&. txs ^. + WalletTransactionConf <. + val 10)) + pure oNotes selectUnspentNotes :: ConnectionPool From f332d9b1771cc01a2ed6b6815f5b88ff9796e552 Mon Sep 17 00:00:00 2001 From: Rene Vergara Date: Mon, 8 Jul 2024 15:17:53 -0500 Subject: [PATCH 07/11] Implement confirmed balances in GUI --- CHANGELOG.md | 1 + src/Zenith/CLI.hs | 27 +++++++++++++++++++++++-- src/Zenith/GUI.hs | 50 ++++++++++++++++++++++++++++++++++++++--------- 3 files changed, 67 insertions(+), 11 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 11b6be4..da18fe5 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -22,6 +22,7 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 - Dialog to display transaction details and copy TX ID - Dialog to send a new transaction - Dialog to display Tx ID after successful broadcast +- Unconfirmed balance display on TUI and GUI ### Fixed diff --git a/src/Zenith/CLI.hs b/src/Zenith/CLI.hs index 8d1f707..db50c01 100644 --- a/src/Zenith/CLI.hs +++ b/src/Zenith/CLI.hs @@ -180,6 +180,7 @@ data State = State , _timer :: !Int , _txForm :: !(Form SendInput () Name) , _sentTx :: !(Maybe HexString) + , _unconfBalance :: !Integer } makeLenses ''State @@ -215,6 +216,12 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s] if st ^. network == MainNet then displayZec (st ^. balance) else displayTaz (st ^. balance))) <=> + C.hCenter + (str + ("Unconf: " ++ + if st ^. network == MainNet + then displayZec (st ^. unconfBalance) + else displayTaz (st ^. unconfBalance))) <=> listAddressBox "Addresses" (st ^. addresses) <+> B.vBorder <+> (C.hCenter (str ("Last block seen: " ++ show (st ^. syncBlock))) <=> @@ -1046,6 +1053,10 @@ runZenithCLI config = do if not (null accList) then getBalance pool $ entityKey $ head accList else return 0 + uBal <- + if not (null accList) + then getUnconfirmedBalance pool $ entityKey $ head accList + else return 0 eventChan <- BC.newBChan 10 _ <- forkIO $ @@ -1083,6 +1094,7 @@ runZenithCLI config = do 0 (mkSendForm 0 $ SendInput "" 0.0 "") Nothing + uBal Left e -> do print $ "No Zebra node available on port " <> @@ -1111,6 +1123,10 @@ refreshWallet s = do if not (null aL) then getBalance pool $ entityKey $ head aL else return 0 + uBal <- + if not (null aL) + then getUnconfirmedBalance pool $ entityKey $ head aL + else return 0 txL <- if not (null addrL) then getUserTx pool $ entityKey $ head addrL @@ -1121,6 +1137,8 @@ refreshWallet s = do let txL' = L.listReplace (Vec.fromList txL) (Just 0) (s ^. transactions) return $ s & wallets .~ wL & accounts .~ aL' & syncBlock .~ bl & balance .~ bal & + unconfBalance .~ + uBal & addresses .~ addrL' & transactions .~ @@ -1191,6 +1209,7 @@ refreshAccount s = do Just (_k, w) -> return w aL <- runNoLoggingT $ getAddresses pool $ entityKey selAccount bal <- getBalance pool $ entityKey selAccount + uBal <- getUnconfirmedBalance pool $ entityKey selAccount let aL' = L.listReplace (Vec.fromList aL) (Just 0) (s ^. addresses) selAddress <- do case L.listSelectedElement aL' of @@ -1201,13 +1220,17 @@ refreshAccount s = do case selAddress of Nothing -> return $ - s & balance .~ bal & addresses .~ aL' & msg .~ "Switched to account: " ++ + s & balance .~ bal & unconfBalance .~ uBal & 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 .~ + s & balance .~ bal & unconfBalance .~ uBal & addresses .~ aL' & + transactions .~ + tL' & + msg .~ "Switched to account: " ++ T.unpack (zcashAccountName $ entityVal selAccount) diff --git a/src/Zenith/GUI.hs b/src/Zenith/GUI.hs index fc91442..9430c34 100644 --- a/src/Zenith/GUI.hs +++ b/src/Zenith/GUI.hs @@ -75,6 +75,7 @@ data AppEvent | SwitchAddr !Int | SwitchAcc !Int | SwitchWal !Int + | UpdateBalance !(Integer, Integer) | CopyAddr !(Maybe (Entity WalletAddress)) | LoadTxs ![Entity UserTx] | LoadAddrs ![Entity WalletAddress] @@ -311,7 +312,7 @@ buildUI wenv model = widgetTree hstack [ addressBox , vstack - [ mainButton "Send" ShowSend + [ mainButton "Send" ShowSend `styleBasic` [textFont "Bold"] , txBox `nodeVisible` not (null $ model ^. transactions) ] ] @@ -322,19 +323,24 @@ buildUI wenv model = widgetTree box_ [alignMiddle] (vstack - [ animFadeIn - (label (displayAmount (model ^. network) $ model ^. balance) `styleBasic` - [textSize 20]) + [ hstack + [ filler + , animFadeIn + (label + (displayAmount (model ^. network) $ model ^. balance) `styleBasic` + [textSize 20]) + , filler + ] , hstack [ filler , remixIcon remixHourglassFill `styleBasic` [textSize 8] , label (maybe "0" (displayAmount (model ^. network)) $ model ^. unconfBalance) `styleBasic` - [textSize 8] `nodeVisible` - isJust (model ^. unconfBalance) + [textSize 8] , filler - ] + ] `nodeVisible` + isJust (model ^. unconfBalance) ]) `styleBasic` [bgColor white, radius 5, border 1 btnColor] , filler @@ -923,6 +929,15 @@ handleEvent wenv node model evt = case selectAccount i of Nothing -> return [] Just acc -> runNoLoggingT $ getAddresses dbPool $ entityKey acc + , Task $ + UpdateBalance <$> do + dbPool <- runNoLoggingT $ initPool $ c_dbPath $ model ^. configuration + case selectAccount i of + Nothing -> return (0, 0) + Just acc -> do + b <- getBalance dbPool $ entityKey acc + u <- getUnconfirmedBalance dbPool $ entityKey acc + return (b, u) , Event $ SetPool Orchard ] SwitchWal i -> @@ -934,6 +949,13 @@ handleEvent wenv node model evt = Nothing -> return [] Just wal -> runNoLoggingT $ getAccounts dbPool $ entityKey wal ] + UpdateBalance (b, u) -> + [ Model $ + model & balance .~ b & unconfBalance .~ + (if u == 0 + then Nothing + else Just u) + ] CopyAddr a -> [ setClipboardData ClipboardEmpty , setClipboardData $ @@ -1246,6 +1268,14 @@ runZenithGUI config = do if not (null addrList) then getQrCode pool Orchard $ entityKey $ head addrList else return Nothing + bal <- + if not (null accList) + then getBalance pool $ entityKey $ head accList + else return 0 + unconfBal <- + if not (null accList) + then getUnconfirmedBalance pool $ entityKey $ head accList + else return 0 let model = AppModel config @@ -1260,8 +1290,10 @@ runZenithGUI config = do 0 Nothing True - 314259000 - (Just 300000) + bal + (if unconfBal == 0 + then Nothing + else Just unconfBal) Orchard qr False From 1673e653eb3d637dd15fde0bfeb35fe555f384b4 Mon Sep 17 00:00:00 2001 From: Rene Vergara Date: Wed, 10 Jul 2024 10:52:04 -0500 Subject: [PATCH 08/11] Implement unconfirmed note tracking --- CHANGELOG.md | 1 + src/Zenith/CLI.hs | 32 ++++++++++++++++++++------------ src/Zenith/DB.hs | 23 +++++++++++++++++++++-- src/Zenith/GUI.hs | 24 ++++++++++++++---------- src/Zenith/Scanner.hs | 31 ++++++++++++++++++++++++++++++- 5 files changed, 86 insertions(+), 25 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index da18fe5..ca58dc4 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -23,6 +23,7 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 - Dialog to send a new transaction - Dialog to display Tx ID after successful broadcast - Unconfirmed balance display on TUI and GUI +- Tracking of unconfirmed notes ### Fixed diff --git a/src/Zenith/CLI.hs b/src/Zenith/CLI.hs index db50c01..a1ef217 100644 --- a/src/Zenith/CLI.hs +++ b/src/Zenith/CLI.hs @@ -89,7 +89,7 @@ import ZcashHaskell.Types import ZcashHaskell.Utils (getBlockTime, makeZebraCall) import Zenith.Core import Zenith.DB -import Zenith.Scanner (processTx) +import Zenith.Scanner (processTx, updateConfs) import Zenith.Types ( Config(..) , PhraseDB(..) @@ -596,18 +596,26 @@ scanZebra dbP zHost zPort b eChan = do 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 do - liftIO $ BC.writeBChan eChan $ TickMsg "Invalid starting block for scan" - else do - let bList = [(sb + 1) .. (zgb_blocks bStatus)] - if not (null bList) + confUp <- try $ updateConfs zHost zPort pool :: IO (Either IOError ()) + case confUp of + Left _e0 -> + liftIO $ + BC.writeBChan eChan $ TickMsg "Failed to update unconfirmed transactions" + Right _ -> do + let sb = max dbBlock b + if sb > zgb_blocks bStatus || sb < 1 then do - let step = - (1.0 :: Float) / fromIntegral (zgb_blocks bStatus - (sb + 1)) - mapM_ (processBlock pool step) bList - else liftIO $ BC.writeBChan eChan $ TickVal 1.0 + liftIO $ + BC.writeBChan eChan $ TickMsg "Invalid starting block for scan" + else do + let bList = [(sb + 1) .. (zgb_blocks bStatus)] + if not (null bList) + then do + let step = + (1.0 :: Float) / + fromIntegral (zgb_blocks bStatus - (sb + 1)) + mapM_ (processBlock pool step) bList + else liftIO $ BC.writeBChan eChan $ TickVal 1.0 where processBlock :: ConnectionPool -> Float -> Int -> IO () processBlock pool step bl = do diff --git a/src/Zenith/DB.hs b/src/Zenith/DB.hs index f855f02..6a7909a 100644 --- a/src/Zenith/DB.hs +++ b/src/Zenith/DB.hs @@ -32,7 +32,6 @@ import qualified Data.Text as T import qualified Data.Text.Encoding as TE import Data.Word import Database.Esqueleto.Experimental -import qualified Database.Persist as P import qualified Database.Persist.Sqlite as PS import Database.Persist.TH import Haskoin.Transaction.Common @@ -43,7 +42,6 @@ import Haskoin.Transaction.Common ) import qualified Lens.Micro as ML ((&), (.~), (^.)) import ZcashHaskell.Orchard (isValidUnifiedAddress) -import ZcashHaskell.Sapling (decodeSaplingOutputEsk) import ZcashHaskell.Types ( DecodedNote(..) , OrchardAction(..) @@ -1626,6 +1624,27 @@ getWalletTxId pool wId = do where_ (wtx ^. WalletTransactionId ==. val wId) pure $ wtx ^. WalletTransactionTxId +getUnconfirmedBlocks :: ConnectionPool -> IO [Int] +getUnconfirmedBlocks pool = do + r <- + runNoLoggingT $ + PS.retryOnBusy $ + flip PS.runSqlPool pool $ do + select $ do + wtx <- from $ table @WalletTransaction + where_ (wtx ^. WalletTransactionConf <=. val 10) + pure $ wtx ^. WalletTransactionBlock + return $ map (\(Value i) -> i) r + +saveConfs :: ConnectionPool -> Int -> Int -> IO () +saveConfs pool b c = do + runNoLoggingT $ + PS.retryOnBusy $ + flip PS.runSqlPool pool $ do + update $ \t -> do + set t [WalletTransactionConf =. val c] + where_ $ t ^. WalletTransactionBlock ==. val b + -- | Helper function to extract a Unified Address from the database readUnifiedAddressDB :: WalletAddress -> Maybe UnifiedAddress readUnifiedAddressDB = diff --git a/src/Zenith/GUI.hs b/src/Zenith/GUI.hs index 9430c34..fee2025 100644 --- a/src/Zenith/GUI.hs +++ b/src/Zenith/GUI.hs @@ -46,7 +46,7 @@ import ZcashHaskell.Utils (getBlockTime, makeZebraCall) import Zenith.Core import Zenith.DB import Zenith.GUI.Theme -import Zenith.Scanner (processTx) +import Zenith.Scanner (processTx, updateConfs) import Zenith.Types hiding (ZcashAddress(..)) import Zenith.Utils ( displayAmount @@ -1145,15 +1145,19 @@ scanZebra dbPath zHost zPort sendMsg = do b <- liftIO $ getMinBirthdayHeight pool dbBlock <- runNoLoggingT $ getMaxBlock pool let sb = max dbBlock b - if sb > zgb_blocks bStatus || sb < 1 - then sendMsg (ShowError "Invalid starting block for scan") - else do - let bList = [(sb + 1) .. (zgb_blocks bStatus)] - if not (null bList) - then do - let step = (1.0 :: Float) / fromIntegral (length bList) - mapM_ (processBlock pool step) bList - else sendMsg (SyncVal 1.0) + confUp <- try $ updateConfs zHost zPort pool :: IO (Either IOError ()) + case confUp of + Left _e0 -> sendMsg (ShowError "Failed to update unconfirmed transactions") + Right _ -> do + if sb > zgb_blocks bStatus || sb < 1 + then sendMsg (ShowError "Invalid starting block for scan") + else do + let bList = [(sb + 1) .. (zgb_blocks bStatus)] + if not (null bList) + then do + let step = (1.0 :: Float) / fromIntegral (length bList) + mapM_ (processBlock pool step) bList + else sendMsg (SyncVal 1.0) where processBlock :: ConnectionPool -> Float -> Int -> IO () processBlock pool step bl = do diff --git a/src/Zenith/Scanner.hs b/src/Zenith/Scanner.hs index df47ed1..09f7ccc 100644 --- a/src/Zenith/Scanner.hs +++ b/src/Zenith/Scanner.hs @@ -33,7 +33,13 @@ import ZcashHaskell.Types ) import ZcashHaskell.Utils (getBlockTime, makeZebraCall, readZebraTransaction) import Zenith.Core (checkBlockChain) -import Zenith.DB (getMaxBlock, initDb, saveTransaction) +import Zenith.DB + ( getMaxBlock + , getUnconfirmedBlocks + , initDb + , saveConfs + , saveTransaction + ) import Zenith.Utils (jsonNumber) -- | Function to scan the Zcash blockchain through the Zebra node and populate the Zenith database @@ -155,3 +161,26 @@ processTx host port bt pool t = do (fromRawSBundle $ zt_sBundle rzt) (fromRawOBundle $ zt_oBundle rzt) return () + +-- | Function to update unconfirmed transactions +updateConfs :: + T.Text -- ^ Host name for `zebrad` + -> Int -- ^ Port for `zebrad` + -> ConnectionPool + -> IO () +updateConfs host port pool = do + targetBlocks <- getUnconfirmedBlocks pool + mapM_ updateTx targetBlocks + where + updateTx :: Int -> IO () + updateTx b = do + r <- + makeZebraCall + host + port + "getblock" + [Data.Aeson.String $ T.pack $ show b, jsonNumber 1] + case r of + Left e -> throwIO $ userError e + Right blk -> do + saveConfs pool b $ fromInteger $ bl_confirmations blk From c69d4f9974d84502efeb456613716185dc594eda Mon Sep 17 00:00:00 2001 From: Rene Vergara Date: Wed, 10 Jul 2024 13:39:02 -0500 Subject: [PATCH 09/11] Add functions for shielded balance and transparent balance --- src/Zenith/DB.hs | 16 ++++++++++++++++ 1 file changed, 16 insertions(+) diff --git a/src/Zenith/DB.hs b/src/Zenith/DB.hs index 6a7909a..384f3bb 100644 --- a/src/Zenith/DB.hs +++ b/src/Zenith/DB.hs @@ -1390,6 +1390,22 @@ getBalance pool za = do let oBal = sum oAmts return . fromIntegral $ tBal + sBal + oBal +getTransparentBalance :: ConnectionPool -> ZcashAccountId -> IO Integer +getTransparentBalance pool za = do + trNotes <- getWalletUnspentTrNotes pool za + let tAmts = map (walletTrNoteValue . entityVal) trNotes + return . fromIntegral $ sum tAmts + +getShieldedBalance :: ConnectionPool -> ZcashAccountId -> IO Integer +getShieldedBalance pool za = do + sapNotes <- getWalletUnspentSapNotes pool za + let sAmts = map (walletSapNoteValue . entityVal) sapNotes + let sBal = sum sAmts + orchNotes <- getWalletUnspentOrchNotes pool za + let oAmts = map (walletOrchNoteValue . entityVal) orchNotes + let oBal = sum oAmts + return . fromIntegral $ sBal + oBal + getUnconfirmedBalance :: ConnectionPool -> ZcashAccountId -> IO Integer getUnconfirmedBalance pool za = do trNotes <- getWalletUnspentUnconfirmedTrNotes pool za From 96c9df571ee2cd58803f6149475db0c7f52ecf87 Mon Sep 17 00:00:00 2001 From: Rene Vergara Date: Wed, 10 Jul 2024 13:48:54 -0500 Subject: [PATCH 10/11] Ensure dialog closes after Tx send --- src/Zenith/GUI.hs | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/src/Zenith/GUI.hs b/src/Zenith/GUI.hs index fee2025..0227002 100644 --- a/src/Zenith/GUI.hs +++ b/src/Zenith/GUI.hs @@ -866,10 +866,11 @@ handleEvent wenv node model evt = ShowSend -> [Model $ model & openSend .~ True] SendTx -> case currentAccount of - Nothing -> [Event $ ShowError "No account available"] + Nothing -> [Event $ ShowError "No account available", Event CancelSend] Just acc -> case currentWallet of - Nothing -> [Event $ ShowError "No wallet available"] + Nothing -> + [Event $ ShowError "No wallet available", Event CancelSend] Just wal -> [ Producer $ sendTransaction @@ -880,6 +881,7 @@ handleEvent wenv node model evt = (model ^. sendAmount) (model ^. sendRecipient) (model ^. sendMemo) + , Event CancelSend ] CancelSend -> [ Model $ From e9e342e77f4e159cff21cfe66f8c7d927e51023a Mon Sep 17 00:00:00 2001 From: Rene Vergara Date: Thu, 11 Jul 2024 08:38:20 -0500 Subject: [PATCH 11/11] Prepare for release --- CHANGELOG.md | 10 ++- app/Main.hs | 19 ++--- cabal.project | 2 +- cabal.project.freeze | 162 +++++++++++++++++++++---------------------- src/Zenith/CLI.hs | 18 +---- zenith.cabal | 6 +- 6 files changed, 103 insertions(+), 114 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index ed06a68..c8a191c 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -5,7 +5,7 @@ All notable changes to this project will be documented in this file. The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/), and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0.html). -## [Unreleased] +## [0.6.0.0-beta] ### Added @@ -25,10 +25,18 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 - Unconfirmed balance display on TUI and GUI - Tracking of unconfirmed notes +### Changed + +- Upgraded to GHC 9.6.5 + ### Fixed - Validation of input of amount for sending in TUI +### Removed + +- Legacy interface to `zcashd` + ## [0.5.3.1-beta] ### Added diff --git a/app/Main.hs b/app/Main.hs index 2a2dcd6..6305fa3 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -11,7 +11,8 @@ 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.Console.StructuredCLI-} import System.Environment (getArgs) import System.Exit import System.IO @@ -23,7 +24,7 @@ import Zenith.GUI (runZenithGUI) import Zenith.Types (Config(..), ZcashAddress(..), ZcashPool(..), ZcashTx(..)) import Zenith.Utils import Zenith.Zcashd - + {- prompt :: String -> IO String prompt text = do putStr text @@ -197,21 +198,22 @@ processUri user pwd = _ -> 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" + {-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 + case head args + {-"legacy" -> do checkServer nodeUser nodePwd void $ runCLI @@ -220,7 +222,8 @@ main = do { getBanner = " ______ _ _ _ \n |___ / (_) | | | \n / / ___ _ __ _| |_| |__ \n / / / _ \\ '_ \\| | __| '_ \\ \n / /_| __/ | | | | |_| | | |\n /_____\\___|_| |_|_|\\__|_| |_|\n Zcash Full Node CLI v0.4.0" } - (root nodeUser nodePwd) + (root nodeUser nodePwd) -} + of "gui" -> runZenithGUI myConfig "tui" -> runZenithTUI myConfig "rescan" -> clearSync myConfig @@ -231,6 +234,6 @@ printUsage :: IO () printUsage = do putStrLn "zenith [command] [parameters]\n" putStrLn "Available commands:" - putStrLn "legacy\tLegacy CLI for zcashd" + {-putStrLn "legacy\tLegacy CLI for zcashd"-} putStrLn "tui\tTUI for zebrad" putStrLn "rescan\tRescan the existing wallet(s)" diff --git a/cabal.project b/cabal.project index 217198a..d245ac1 100644 --- a/cabal.project +++ b/cabal.project @@ -2,7 +2,7 @@ packages: ./*.cabal zcash-haskell/zcash-haskell.cabal -with-compiler: ghc-9.4.8 +with-compiler: ghc-9.6.5 source-repository-package type: git diff --git a/cabal.project.freeze b/cabal.project.freeze index 698a2eb..175cc2c 100644 --- a/cabal.project.freeze +++ b/cabal.project.freeze @@ -1,12 +1,12 @@ active-repositories: hackage.haskell.org:merge -constraints: any.Cabal ==3.8.1.0, - any.Cabal-syntax ==3.8.1.0, +constraints: any.Cabal ==3.10.3.0, + any.Cabal-syntax ==3.10.3.0, any.Clipboard ==2.3.2.0, any.HUnit ==1.6.2.0, any.Hclip ==3.0.0.4, - any.JuicyPixels ==3.3.8, + any.JuicyPixels ==3.3.9, JuicyPixels -mmap, - any.OneTuple ==0.4.1.1, + any.OneTuple ==0.4.2, any.OpenGLRaw ==3.3.4.1, OpenGLRaw -osandroid +usegles2 +useglxgetprocaddress +usenativewindowslibraries, any.QuickCheck ==2.14.3, @@ -18,32 +18,32 @@ constraints: any.Cabal ==3.8.1.0, any.X11 ==1.10.3, X11 -pedantic, any.adjunctions ==4.4.2, - any.aeson ==2.2.1.0, + any.aeson ==2.2.3.0, aeson +ordered-keymap, any.alex ==3.5.1.0, - any.ansi-terminal ==1.1, + any.ansi-terminal ==1.1.1, ansi-terminal -example, any.ansi-terminal-types ==1.1, any.appar ==0.1.8, - any.array ==0.5.4.0, + any.array ==0.5.6.0, any.ascii-progress ==0.3.3.0, ascii-progress -examples, any.asn1-encoding ==0.9.6, any.asn1-parse ==0.9.5, any.asn1-types ==0.3.4, - any.assoc ==1.1, - assoc +tagged, + any.assoc ==1.1.1, + assoc -tagged, any.async ==2.2.5, async -bench, any.attoparsec ==0.14.4, attoparsec -developer, - any.attoparsec-aeson ==2.2.0.1, + any.attoparsec-aeson ==2.2.2.0, any.authenticate-oauth ==1.7, - any.auto-update ==0.1.6, - any.base ==4.17.2.1, - any.base-compat ==0.13.1, - any.base-compat-batteries ==0.13.1, - any.base-orphans ==0.9.1, + any.auto-update ==0.2.1, + any.base ==4.18.2.1, + any.base-compat ==0.14.0, + any.base-compat-batteries ==0.14.0, + any.base-orphans ==0.9.2, any.base16 ==1.0, any.base16-bytestring ==1.0.2.0, any.base58-bytestring ==0.1.0, @@ -53,14 +53,14 @@ constraints: any.Cabal ==3.8.1.0, bifunctors +tagged, any.bimap ==0.5.0, any.binary ==0.8.9.1, - any.binary-orphans ==1.0.4.1, + any.binary-orphans ==1.0.5, any.bitvec ==1.1.5.0, bitvec +simd, any.blaze-builder ==0.4.2.3, any.blaze-html ==0.9.2.0, any.blaze-markup ==0.8.3.0, any.borsh ==0.3.0, - any.brick ==2.3.1, + any.brick ==2.4, brick -demos, any.byteorder ==1.0.4, any.bytes ==0.17.3, @@ -70,19 +70,20 @@ constraints: any.Cabal ==3.8.1.0, any.bytestring-to-vector ==0.3.0.1, any.c2hs ==0.28.8, c2hs +base3 -regression, - any.cabal-doctest ==1.0.9, + any.cabal-doctest ==1.0.10, any.call-stack ==0.4.0, any.case-insensitive ==1.2.1.0, any.cborg ==0.2.10.0, cborg +optimize-gmp, any.cereal ==0.5.8.3, cereal -bytestring-builder, + any.character-ps ==0.1, any.clock ==0.8.4, clock -llvm, any.colour ==2.3.6, any.comonad ==5.0.8, comonad +containers +distributive +indexed-traversable, - any.concurrent-output ==1.10.20, + any.concurrent-output ==1.10.21, any.conduit ==1.3.5, any.conduit-extra ==1.3.6, any.config-ini ==0.2.7.0, @@ -92,14 +93,14 @@ constraints: any.Cabal ==3.8.1.0, any.containers ==0.6.7, any.contravariant ==1.5.5, contravariant +semigroups +statevar +tagged, - any.cookie ==0.4.6, + any.cookie ==0.5.0, any.crypto-api ==0.13.3, crypto-api -all_cpolys, any.crypto-pubkey-types ==0.4.3, - any.crypton ==0.34, + any.crypton ==1.0.0, crypton -check_alignment +integer-gmp -old_toolchain_inliner +support_aesni +support_deepseq +support_pclmuldq +support_rdrand -support_sse +use_target_attributes, - any.crypton-connection ==0.3.2, - any.crypton-x509 ==1.7.6, + any.crypton-connection ==0.4.1, + any.crypton-x509 ==1.7.7, any.crypton-x509-store ==1.6.9, any.crypton-x509-system ==1.6.7, any.crypton-x509-validation ==1.6.12, @@ -111,9 +112,9 @@ constraints: any.Cabal ==3.8.1.0, any.data-default-instances-containers ==0.0.1, any.data-default-instances-dlist ==0.0.1, any.data-default-instances-old-locale ==0.0.1, - any.data-fix ==0.3.2, - any.deepseq ==1.4.8.0, - any.directory ==1.3.7.1, + any.data-fix ==0.3.4, + any.deepseq ==1.4.8.1, + any.directory ==1.3.8.4, any.distributive ==0.6.2.1, distributive +semigroups +tagged, any.dlist ==1.0, @@ -125,13 +126,11 @@ constraints: any.Cabal ==3.8.1.0, entropy -donotgetentropy, any.envy ==2.1.3.0, any.esqueleto ==3.5.11.2, - any.exceptions ==0.10.5, - any.extra ==1.7.14, - any.fast-logger ==3.2.2, - any.filepath ==1.4.2.2, + any.exceptions ==0.10.7, + any.extra ==1.7.16, + any.fast-logger ==3.2.3, + any.filepath ==1.4.300.1, any.fixed ==0.3, - any.foldable1-classes-compat ==0.1, - foldable1-classes-compat +tagged, any.foreign-rust ==0.1.0, any.foreign-store ==0.2.1, any.formatting ==7.2.0, @@ -141,30 +140,29 @@ constraints: any.Cabal ==3.8.1.0, generic-deriving +base-4-9, any.generically ==0.1.1, any.generics-sop ==0.5.1.4, - any.ghc ==9.4.8, + any.ghc ==9.6.5, any.ghc-bignum ==1.3, - any.ghc-boot ==9.4.8, - any.ghc-boot-th ==9.4.8, - any.ghc-heap ==9.4.8, - any.ghc-prim ==0.9.1, - any.ghci ==9.4.8, + any.ghc-boot ==9.6.5, + any.ghc-boot-th ==9.6.5, + any.ghc-heap ==9.6.5, + any.ghc-prim ==0.10.0, + any.ghci ==9.6.5, any.half ==0.3.1, any.happy ==1.20.1.1, - any.hashable ==1.4.4.0, - hashable +integer-gmp -random-initial-seed, - any.haskeline ==0.8.2, + any.hashable ==1.4.7.0, + hashable -arch-native +integer-gmp -random-initial-seed, any.haskell-lexer ==1.1.1, any.haskoin-core ==1.1.0, any.hexstring ==0.12.1.0, any.hourglass ==0.2.12, - any.hpc ==0.6.1.0, + any.hpc ==0.6.2.0, any.hsc2hs ==0.68.10, hsc2hs -in-ghc-tree, - any.hspec ==2.11.7, - any.hspec-core ==2.11.7, - any.hspec-discover ==2.11.7, + any.hspec ==2.11.9, + any.hspec-core ==2.11.9, + any.hspec-discover ==2.11.9, any.hspec-expectations ==0.8.4, - any.http-api-data ==0.6, + any.http-api-data ==0.6.1, http-api-data -use-text-show, any.http-client ==0.7.17, http-client +network-uri, @@ -172,18 +170,18 @@ constraints: any.Cabal ==3.8.1.0, any.http-conduit ==2.3.8.3, http-conduit +aeson, any.http-types ==0.12.4, - any.indexed-traversable ==0.1.3, - any.indexed-traversable-instances ==0.1.1.2, - any.integer-conversion ==0.1.0.1, + any.indexed-traversable ==0.1.4, + any.indexed-traversable-instances ==0.1.2, + any.integer-conversion ==0.1.1, any.integer-gmp ==1.1, any.integer-logarithms ==1.0.3.1, integer-logarithms -check-bounds +integer-gmp, any.invariant ==0.6.3, any.iproute ==1.7.12, - any.kan-extensions ==5.2.5, + any.kan-extensions ==5.2.6, any.language-c ==0.9.3, language-c -allwarnings +iecfpextension +usebytestrings, - any.lens ==5.2.3, + any.lens ==5.3.2, lens -benchmark-uniplate -dump-splices +inlining -j +test-hunit +test-properties +test-templates +trustworthy, any.lens-aeson ==1.2.3, any.lift-type ==0.1.1.1, @@ -196,7 +194,7 @@ constraints: any.Cabal ==3.8.1.0, memory +support_bytestring +support_deepseq, any.microlens ==0.4.13.1, any.microlens-mtl ==0.2.0.3, - any.microlens-th ==0.4.3.14, + any.microlens-th ==0.4.3.15, any.mime-types ==0.1.2.0, any.monad-control ==1.0.3.1, any.monad-logger ==0.3.40, @@ -206,16 +204,16 @@ constraints: any.Cabal ==3.8.1.0, any.mono-traversable ==1.0.17.0, any.monomer ==1.6.0.1, monomer -examples, - any.mtl ==2.2.2, + any.mtl ==2.3.1, any.murmur3 ==1.0.5, any.nanovg ==0.8.1.0, nanovg -examples -gl2 -gles3 -stb_truetype, - any.network ==3.1.4.0, + any.network ==3.2.1.0, network -devel, any.network-uri ==2.6.4.2, any.old-locale ==1.0.0.7, any.old-time ==1.1.0.4, - any.os-string ==2.0.2, + any.os-string ==2.0.6, any.parallel ==3.2.2.0, any.parsec ==3.1.16.1, any.parser-combinators ==1.3.0, @@ -228,7 +226,7 @@ constraints: any.Cabal ==3.8.1.0, any.persistent-template ==2.12.0.0, any.pretty ==1.1.3.6, any.primitive ==0.9.0.0, - any.process ==1.6.18.0, + any.process ==1.6.19.0, any.profunctors ==5.6.2, any.psqueues ==0.2.8.0, any.pureMD5 ==2.1.4, @@ -238,7 +236,7 @@ constraints: any.Cabal ==3.8.1.0, any.quickcheck-io ==0.2.0, any.quickcheck-transformer ==0.3.1.2, any.random ==1.2.1.2, - any.reflection ==2.1.7, + any.reflection ==2.1.8, reflection -slow +template-haskell, any.regex-base ==0.94.0.2, any.regex-compat ==0.95.2.1, @@ -249,14 +247,14 @@ constraints: any.Cabal ==3.8.1.0, any.rts ==1.0.2, any.safe ==0.3.21, any.safe-exceptions ==0.1.7.4, - any.scientific ==0.3.7.0, - scientific -bytestring-builder -integer-simple, + any.scientific ==0.3.8.0, + scientific -integer-simple, any.sdl2 ==2.5.5.0, sdl2 -examples -no-linear -opengl-example +pkgconfig +recent-ish, any.secp256k1-haskell ==1.2.0, - any.semialign ==1.3, + any.semialign ==1.3.1, semialign +semigroupoids, - any.semigroupoids ==6.0.0.1, + any.semigroupoids ==6.0.1, semigroupoids +comonad +containers +contravariant +distributive +tagged +unordered-containers, any.semigroups ==0.20, semigroups +binary +bytestring -bytestring-builder +containers +deepseq +hashable +tagged +template-haskell +text +transformers +unordered-containers, @@ -273,57 +271,53 @@ constraints: any.Cabal ==3.8.1.0, any.stm-chans ==3.0.0.9, any.streaming-commons ==0.2.2.6, streaming-commons -use-bytestring-builder, - any.strict ==0.5, + any.strict ==0.5.1, any.string-conversions ==0.4.0.1, - any.structured-cli ==2.7.0.1, - structured-cli -debug, any.system-cxx-std-lib ==1.0, any.tagged ==0.8.8, tagged +deepseq +transformers, - any.template-haskell ==2.19.0.0, + any.template-haskell ==2.20.0.0, any.terminal-size ==0.3.4, - any.terminfo ==0.4.1.5, + any.terminfo ==0.4.1.6, any.text ==2.0.2, - any.text-iso8601 ==0.1, - any.text-short ==0.1.5, + any.text-iso8601 ==0.1.1, + any.text-short ==0.1.6, text-short -asserts, - any.text-show ==3.10.4, + any.text-show ==3.10.5, text-show +base-4-9 +integer-gmp +new-functor-classes +template-haskell-2-11, any.text-zipper ==0.13, any.tf-random ==0.5, - any.th-abstraction ==0.6.0.0, + any.th-abstraction ==0.7.0.0, any.th-compat ==0.1.5, any.th-lift ==0.8.4, any.th-lift-instances ==0.1.20, - any.these ==1.2, + any.these ==1.2.1, any.time ==1.12.2, - any.time-compat ==1.9.6.1, - time-compat -old-locale, + any.time-compat ==1.9.7, any.time-locale-compat ==0.1.1.5, time-locale-compat -old-locale, - any.tls ==2.0.2, + any.tls ==2.1.0, tls -devel, - any.transformers ==0.5.6.2, + any.transformers ==0.6.1.0, any.transformers-base ==0.4.6, transformers-base +orphaninstances, any.transformers-compat ==0.7.2, transformers-compat -five +five-three -four +generic-deriving +mtl -three -two, any.typed-process ==0.2.11.1, - any.unix ==2.7.3, - any.unix-compat ==0.7.1, - unix-compat -old-time, - any.unix-time ==0.4.12, + any.unix ==2.8.4.0, + any.unix-compat ==0.7.2, + any.unix-time ==0.4.15, any.unliftio ==0.2.25.0, any.unliftio-core ==0.2.1.0, any.unordered-containers ==0.2.20, unordered-containers -debug, any.utf8-string ==1.0.2, - any.uuid-types ==1.0.5.1, + any.uuid-types ==1.0.6, any.vault ==0.3.1.5, vault +useghc, any.vector ==0.13.1.0, vector +boundschecks -internalchecks -unsafechecks -wall, - any.vector-algorithms ==0.9.0.1, + any.vector-algorithms ==0.9.0.2, vector-algorithms +bench +boundschecks -internalchecks -llvm +properties -unsafechecks, any.vector-stream ==0.1.0.1, any.void ==0.7.3, @@ -333,10 +327,10 @@ constraints: any.Cabal ==3.8.1.0, vty-crossplatform -demos, any.vty-unix ==0.2.0.0, any.wide-word ==0.1.6.0, - any.witherable ==0.4.2, + any.witherable ==0.5, any.word-wrap ==0.5, any.wreq ==0.5.4.3, wreq -aws -developer +doctest -httpbin, - any.zlib ==0.6.3.0, + any.zlib ==0.7.1.0, zlib -bundled-c-zlib +non-blocking-ffi +pkg-config -index-state: hackage.haskell.org 2024-04-07T10:14:52Z +index-state: hackage.haskell.org 2024-07-10T18:40:26Z diff --git a/src/Zenith/CLI.hs b/src/Zenith/CLI.hs index e7498fe..b10b7e0 100644 --- a/src/Zenith/CLI.hs +++ b/src/Zenith/CLI.hs @@ -450,7 +450,7 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s] (str " _____ _ _ _ \n|__ /___ _ __ (_) |_| |__\n / // _ \\ '_ \\| | __| '_ \\\n / /| __/ | | | | |_| | | |\n/____\\___|_| |_|_|\\__|_| |_|") <=> C.hCenter - (withAttr titleAttr (str "Zcash Wallet v0.5.3.1-beta")) <=> + (withAttr titleAttr (str "Zcash Wallet v0.6.0.0-beta")) <=> C.hCenter (withAttr blinkAttr $ str "Press any key...")) else emptyWidget capCommand3 :: String -> String -> String -> Widget Name @@ -631,19 +631,6 @@ mkNewABForm = 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 = @@ -735,9 +722,6 @@ 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 diff --git a/zenith.cabal b/zenith.cabal index e90d4eb..46af28d 100644 --- a/zenith.cabal +++ b/zenith.cabal @@ -1,6 +1,6 @@ cabal-version: 3.0 name: zenith -version: 0.5.3.1-beta +version: 0.6.0.0-beta license: MIT license-file: LICENSE author: Rene Vergara @@ -53,7 +53,7 @@ library , exceptions , monad-logger , vty-crossplatform - , secp256k1-haskell + , secp256k1-haskell >= 1 , pureMD5 , ghc , haskoin-core @@ -100,7 +100,7 @@ executable zenith , configurator , data-default , sort - , structured-cli + --, structured-cli , text , time , zenith