Implement UI elements for sending transactions

2024-07-08 13:06:43 -05:00 · 2024-07-08 13:06:43 -05:00 · 56eeeaaf20
commit 56eeeaaf20
parent 75dc71459f
3 changed files with 177 additions and 29 deletions
--- 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]

--- 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 =
--- 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 &