From 56eeeaaf20b23f56c200731b91aac178615fa5aa Mon Sep 17 00:00:00 2001 From: Rene Vergara Date: Mon, 8 Jul 2024 13:06:43 -0500 Subject: [PATCH] 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 &