diff --git a/src/Zenith/CLI.hs b/src/Zenith/CLI.hs index 891cb3f..dc0158b 100644 --- a/src/Zenith/CLI.hs +++ b/src/Zenith/CLI.hs @@ -2,6 +2,7 @@ {-# LANGUAGE TypeApplications #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE LambdaCase #-} module Zenith.CLI where @@ -62,7 +63,7 @@ import qualified Brick.Widgets.List as L import qualified Brick.Widgets.ProgressBar as P import Control.Concurrent (forkIO, threadDelay) import Control.Exception (throw, throwIO, try) -import Control.Monad (forever, unless, void, when) +import Control.Monad (forM_, forever, unless, void, when) import Control.Monad.IO.Class (liftIO) import Control.Monad.Logger ( LoggingT @@ -172,7 +173,6 @@ makeLenses ''AdrBookEntry data ShDshEntry = ShDshEntry { _totalTransparent :: !Float , _totalShielded :: !Float - , _shieldOp :: !ShieldDeshieldOp , _shAmt :: !Float } deriving (Show) @@ -190,7 +190,8 @@ data DialogType | AdrBookForm | AdrBookUpdForm | AdrBookDelForm - | ShieldDeshieldForm + | DeshieldForm + | ShieldForm data DisplayType = AddrDisplay @@ -239,7 +240,9 @@ data State = State , _abCurAdrs :: !T.Text -- used for address book CRUD operations , _sentTx :: !(Maybe HexString) , _unconfBalance :: !Integer - , _shdshForm :: !(Form ShDshEntry () Name) + , _deshieldForm :: !(Form ShDshEntry () Name) + , _tBalance :: !Integer + , _sBalance :: !Integer } makeLenses ''State @@ -298,7 +301,8 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s] , C.hCenter (hBox [ capCommand2 "Address " "B" "ook" - , capCommand2 "Shield/" "D" "eshield" + , capCommand2 "s" "H" "ield" + , capCommand "D" "e-shield" , capCommand "Q" "uit" , capCommand "?" " Help" , str $ show (st ^. timer) @@ -427,10 +431,21 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s] (renderForm (st ^. txForm) <=> C.hCenter (hBox [capCommand "↲ " "Send", capCommand " " "Cancel"])) - ShieldDeshieldForm -> + DeshieldForm -> D.renderDialog - (D.dialog (Just (str " Shield / De-Shield ")) Nothing 50) - (renderForm (st ^. shdshForm) <=> + (D.dialog (Just (str " De-Shield ZEC ")) Nothing 50) + (renderForm (st ^. deshieldForm) <=> + C.hCenter + (hBox [capCommand "P" "roceed", capCommand " " "Cancel"])) + ShieldForm -> + D.renderDialog + (D.dialog (Just (str " Shield ZEC ")) Nothing 50) + (C.hCenter + (str $ + "Shield " ++ + if st ^. network == MainNet + then displayZec (st ^. tBalance) + else displayTaz (st ^. tBalance) ++ "?") <=> C.hCenter (hBox [capCommand "P" "roceed", capCommand " " "Cancel"])) Blank -> emptyWidget @@ -676,8 +691,8 @@ mkSendForm bal = label s w = padBottom (Pad 1) $ vLimit 1 (hLimit 15 $ str s <+> fill ' ') <+> w -mkshieldDeshieldForm :: Integer -> ShDshEntry -> Form ShDshEntry e Name -mkshieldDeshieldForm bal = +mkDeshieldForm :: Integer -> ShDshEntry -> Form ShDshEntry e Name +mkDeshieldForm bal = newForm [ label "Total Transp. : " @@= editShowableFieldWithValidate @@ -689,12 +704,6 @@ mkshieldDeshieldForm bal = totalShielded TotalShieldedField (isAmountValid bal) - , label "Select :" @@= - radioField - shieldOp - [ (Shield, ShieldField, "Shield") - , (Deshield, DeshieldField, "De-Shield") - ] , label "Amount: " @@= editShowableFieldWithValidate shAmt AmtField (isAmountValid bal) ] @@ -967,7 +976,8 @@ appEvent (BT.AppEvent t) = do AdrBookForm -> return () AdrBookUpdForm -> return () AdrBookDelForm -> return () - ShieldDeshieldForm -> return () + DeshieldForm -> return () + ShieldForm -> return () Blank -> do if s ^. timer == 90 then do @@ -1219,11 +1229,12 @@ appEvent (BT.VtyEvent e) = do (fs ^. policyField) (fs ^. sendTo)) RecField - ShieldDeshieldForm -> do + DeshieldForm -> do case e of V.EvKey V.KEsc [] -> BT.modify $ set dialogBox Blank ev -> - BT.zoom shdshForm $ do handleFormEvent (BT.VtyEvent ev) + BT.zoom deshieldForm $ do + handleFormEvent (BT.VtyEvent ev) AdrBook -> do case e of V.EvKey (V.KChar 'x') [] -> @@ -1407,6 +1418,53 @@ appEvent (BT.VtyEvent e) = do BT.put s' BT.modify $ set dialogBox AdrBook ev -> BT.modify $ set dialogBox AdrBookDelForm + ShieldForm -> do + case e of + V.EvKey V.KEsc [] -> BT.modify $ set dialogBox Blank + V.EvKey (V.KChar 'p') [] -> do + pool <- liftIO $ runNoLoggingT $ initPool $ s ^. dbPath + selWal <- + do case L.listSelectedElement $ s ^. wallets of + Nothing -> do + let fWall = + L.listSelectedElement $ + L.listMoveToBeginning $ s ^. wallets + case fWall of + Nothing -> + throw $ + userError "Failed to select wallet" + Just (_j, w1) -> return w1 + Just (_k, w) -> return w + selAcc <- + do case L.listSelectedElement $ s ^. accounts of + Nothing -> do + let fAcc = + L.listSelectedElement $ + L.listMoveToBeginning $ s ^. accounts + case fAcc of + Nothing -> + throw $ + userError "Failed to select account" + Just (_j, w1) -> return w1 + Just (_k, w) -> return w + bl <- liftIO $ getLastSyncBlock pool $ entityKey selWal + _ <- + liftIO $ + forkIO $ + shieldTransaction + pool + (s ^. eventDispatch) + (s ^. zebraHost) + (s ^. zebraPort) + (s ^. network) + (entityKey selAcc) + bl + BT.modify $ set msg "Preparing transaction..." + BT.modify $ set displayBox SendDisplay + BT.modify $ set dialogBox Blank + ev -> + BT.zoom deshieldForm $ do + handleFormEvent (BT.VtyEvent ev) -- Process any other event Blank -> do case e of @@ -1433,7 +1491,9 @@ appEvent (BT.VtyEvent e) = do BT.modify $ set dialogBox SendTx V.EvKey (V.KChar 'b') [] -> BT.modify $ set dialogBox AdrBook - V.EvKey (V.KChar 'd') [] -> do + V.EvKey (V.KChar 'd') [] -> + BT.modify $ set dialogBox DeshieldForm + V.EvKey (V.KChar 'h') [] -> do pool <- liftIO $ runNoLoggingT $ initPool $ s ^. dbPath selAcc <- do case L.listSelectedElement $ s ^. accounts of @@ -1444,11 +1504,21 @@ appEvent (BT.VtyEvent e) = do case fAcc of Nothing -> throw $ - userError "Failed to select wallet" + userError "Failed to select account" Just (_j, w1) -> return w1 Just (_k, w) -> return w - c <- liftIO $ getPoolBalance pool $ entityKey selAcc - BT.modify $ set dialogBox ShieldDeshieldForm + tBal <- + liftIO $ + getTransparentBalance pool $ entityKey selAcc + BT.modify $ set tBalance tBal + if tBal > 20000 + then BT.modify $ set dialogBox ShieldForm + else do + BT.modify $ + set + msg + "Not enough transparent funds in this account" + BT.modify $ set displayBox MsgDisplay ev -> case r of Just AList -> @@ -1547,6 +1617,14 @@ runZenithTUI config = do if not (null accList) then getUnconfirmedBalance pool $ entityKey $ head accList else return 0 + tBal <- + if not (null accList) + then getTransparentBalance pool $ entityKey $ head accList + else return 0 + sBal <- + if not (null accList) + then getShieldedBalance pool $ entityKey $ head accList + else return 0 eventChan <- BC.newBChan 10 _ <- forkIO $ @@ -1560,7 +1638,7 @@ runZenithTUI config = do State (zgb_net chainInfo) (L.list WList (Vec.fromList walList) 1) - (L.list AcList (Vec.fromList accList) 0) + (L.list AcList (Vec.fromList accList) 1) (L.list AList (Vec.fromList addrList) 1) (L.list TList (Vec.fromList txList) 1) ("Start up Ok! Connected to Zebra " ++ @@ -1589,7 +1667,9 @@ runZenithTUI config = do "" Nothing uBal - (mkshieldDeshieldForm 0 (ShDshEntry 0 0 Shield 0.0)) + (mkDeshieldForm 0 (ShDshEntry 0 0 0.0)) + tBal + sBal Left _e -> do print $ "No Zebra node available on port " <> @@ -1840,3 +1920,29 @@ sendTransaction pool chan zHost zPort znet accId bl amt ua memo policy = do case resp of Left e1 -> BC.writeBChan chan $ TickMsg $ "Zebra error: " ++ show e1 Right txId -> BC.writeBChan chan $ TickTx txId + +shieldTransaction :: + ConnectionPool + -> BC.BChan Tick + -> T.Text + -> Int + -> ZcashNet + -> ZcashAccountId + -> Int + -> IO () +shieldTransaction pool chan zHost zPort znet accId bl = do + BC.writeBChan chan $ TickMsg "Preparing shielding transaction..." + res <- runNoLoggingT $ shieldTransparentNotes pool zHost zPort znet accId bl + forM_ res $ \case + Left e -> BC.writeBChan chan $ TickMsg $ show e + Right rawTx -> do + BC.writeBChan chan $ TickMsg "Transaction ready, sending to Zebra..." + 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/GUI.hs b/src/Zenith/GUI.hs index a1f6d5c..525f660 100644 --- a/src/Zenith/GUI.hs +++ b/src/Zenith/GUI.hs @@ -126,6 +126,10 @@ data AppEvent | DeleteABEntry !T.Text | UpdateABDescrip !T.Text !T.Text | ResetRecipientValid + | ShowShield + | CloseShield + | ShowDeShield + | CloseDeShield deriving (Eq, Show) data AppModel = AppModel @@ -179,6 +183,12 @@ data AppModel = AppModel , _showABAddress :: !Bool , _updateABAddress :: !Bool , _privacyChoice :: !PrivacyPolicy + , _shieldZec :: !Bool + , _deShieldZec :: !Bool + , _tBalance :: !Integer + , _tBalanceValid :: !Bool + , _sBalance :: !Integer + , _sBalanceValid :: !Bool } deriving (Eq, Show) makeLenses ''AppModel @@ -228,6 +238,8 @@ buildUI wenv model = widgetTree , updateABAddressOverlay (model ^. abdescrip) (model ^. abaddress) `nodeVisible` model ^. updateABAddress + , shieldOverlay `nodeVisible` model ^. shieldZec + , deShieldOverlay `nodeVisible` model ^. deShieldZec , msgAdrBookOverlay `nodeVisible` isJust (model ^. msgAB) ] mainWindow = @@ -293,6 +305,10 @@ buildUI wenv model = widgetTree [bgColor white, borderB 1 gray, padding 3] , box_ [alignLeft, onClick ShowAdrBook] (label "Address Book") `styleBasic` [bgColor white, borderB 1 gray, padding 3] + , box_ [alignLeft, onClick ShowShield] (label "Shield ZEC") `styleBasic` + [bgColor white, borderB 1 gray, padding 3] + , box_ [alignLeft, onClick ShowDeShield] (label "De-Shield ZEC") `styleBasic` + [bgColor white, borderB 1 gray, padding 3] ]) `styleBasic` [bgColor btnColor, padding 3] newBox = @@ -958,7 +974,125 @@ buildUI wenv model = widgetTree , label_ (txtWrapN (fromMaybe "" (model ^. msgAB)) 64) [multiline] , filler ] - + shieldOverlay = + box + (vstack + [ filler + , hstack + [ filler + , box_ + [] + (vstack + [ box_ + [alignMiddle] + (label "Shield Zcash" `styleBasic` + [textFont "Bold", textSize 12]) + , separatorLine `styleBasic` [fgColor btnColor] + , spacer + , hstack + [ filler + , label ("Amount : " ) `styleBasic` + [width 50, textFont "Bold"] + , spacer + , label (displayAmount (model ^. network) 100 ) `styleBasic` + [width 50, textFont "Bold"] + , filler +-- , spacer +-- , numericField_ +-- sendAmount +-- [ decimals 8 +-- , minValue 0.0 +-- , maxValue +-- (fromIntegral (model ^. tBalance) / 100000000.0) +-- , validInput tBalanceValid +-- , onChange CheckAmount +-- ] `styleBasic` +-- [ width 150 +-- , styleIf +-- (not $ model ^. tBalanceValid) +-- (textColor red) +-- ] + ] + , spacer + , box_ + [alignMiddle] + (hstack + [ filler + , mainButton "Proceed" NotImplemented `nodeEnabled` True +-- (model ^. amountValid && model ^. recipientValid) + , spacer + , mainButton "Cancel" CloseShield `nodeEnabled` True + , filler + ]) + ]) `styleBasic` + [radius 4, border 2 btnColor, bgColor white, padding 4] + , filler + ] + , filler + ]) `styleBasic` + [bgColor (white & L.a .~ 0.5)] + deShieldOverlay = + box + (vstack + [ filler + , hstack + [ filler + , box_ + [] + (vstack + [ box_ + [alignMiddle] + (label "De-Shield Zcash" `styleBasic` + [textFont "Bold", textSize 12]) + , separatorLine `styleBasic` [fgColor btnColor] + , spacer + , hstack + [ (label "Total Transparent : " `styleBasic` [ textFont "Bold" ]) + , (label "0.00" ) + ] + , spacer + , hstack + [ (label "Total Shielded : " `styleBasic` [ textFont "Bold" ]) + , (label "0.00" ) + ] + , spacer + , hstack + [ label "Amount:" `styleBasic` + [width 50, textFont "Bold"] + , spacer + , numericField_ + sendAmount + [ decimals 8 + , minValue 0.0 + , maxValue + (fromIntegral (model ^. sBalance) / 100000000.0) + , validInput sBalanceValid + , onChange CheckAmount + ] `styleBasic` + [ width 150 + , styleIf + (not $ model ^. sBalanceValid) + (textColor red) + ] + ] + , spacer + , box_ + [alignMiddle] + (hstack + [ filler + , mainButton "Proceed" NotImplemented `nodeEnabled` True +-- (model ^. amountValid && model ^. recipientValid) + , spacer + , mainButton "Cancel" CloseDeShield `nodeEnabled` True + , filler + ]) + ]) `styleBasic` + [radius 4, border 2 btnColor, bgColor white, padding 4] + , filler + ] + , filler + ]) `styleBasic` + [bgColor (white & L.a .~ 0.5)] notImplemented = NotImplemented generateQRCodes :: Config -> IO () @@ -1348,6 +1482,10 @@ handleEvent wenv node model evt = model & msgAB ?~ "Function not implemented..." & menuPopup .~ False ] CloseMsgAB -> [Model $ model & msgAB .~ Nothing & inError .~ False] + ShowShield -> [ Model $ model & shieldZec .~ True & menuPopup .~ False ] + CloseShield -> [Model $ model & shieldZec .~ False] + ShowDeShield -> [ Model $ model & deShieldZec .~ True & menuPopup .~ False ] + CloseDeShield -> [Model $ model & deShieldZec .~ False] LoadAbList a -> [Model $ model & abaddressList .~ a] UpdateABDescrip d a -> [ Task $ updAddrBookDescrip (model ^. configuration) d a @@ -1724,6 +1862,12 @@ runZenithGUI config = do False False Full + False + False + 0 + False + 0 + False startApp model handleEvent buildUI (params hD) Left _e -> print "Zebra not available" where