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 "<esc> " "Cancel"]))
-        ShieldDeshieldForm ->
+        DeshieldForm ->
           D.renderDialog
-            (D.dialog (Just (str " Shield / De-Shield ")) Nothing 50)
+            (D.dialog (Just (str " De-Shield ZEC ")) Nothing 50)
-            (renderForm (st ^. shdshForm) <=>
+            (renderForm (st ^. deshieldForm) <=>
+             C.hCenter
+               (hBox [capCommand "P" "roceed", capCommand "<esc> " "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 "<esc> " "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
+mkDeshieldForm :: Integer -> ShDshEntry -> Form ShDshEntry e Name
-mkshieldDeshieldForm bal =
+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
+                         tBal <-
-                         BT.modify $ set dialogBox ShieldDeshieldForm
+                           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

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