Implement UI elements for sending transactions

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]
 

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
+  | CheckRecipient !T.Text
-  | CheckAmount
+  | 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_
+      box
-        SendTx
-        CancelSend
-        [ titleCaption "Send Transaction"
-        , acceptCaption "Send"
-        , cancelCaption "Cancel"
-        ]
         (vstack
-           [ hstack
+           [ filler
-               [ label "To:" `styleBasic` [width 50]
-               , filler
-               , textField_ sendRecipient []
-               ]
            , 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
+           , filler
-               [ label "Memo:" `styleBasic` [width 50]
+           ]) `styleBasic`
-               , filler
+      [bgColor (white & L.a .~ 0.5)]
-               , textArea sendMemo
-               ]
-           ])
     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 -> []
+    CheckRecipient a -> [Model $ model & recipientValid .~ isRecipientValid a]
-    CheckAmount ->
+    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 =

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 &