diff --git a/src/Zenith/CLI.hs b/src/Zenith/CLI.hs index cfef49d..13d1d2d 100644 --- a/src/Zenith/CLI.hs +++ b/src/Zenith/CLI.hs @@ -25,7 +25,7 @@ import Brick.Forms import qualified Brick.Main as M import qualified Brick.Types as BT import Brick.Types (Widget) -import Brick.Util (bg, clamp, fg, on, style) +import Brick.Util (bg, fg, on, style) import qualified Brick.Widgets.Border as B import Brick.Widgets.Border.Style (unicode, unicodeBold) import qualified Brick.Widgets.Center as C @@ -97,7 +97,13 @@ import Zenith.Types , UnifiedAddressDB(..) , ZcashNetDB(..) ) -import Zenith.Utils (displayTaz, displayZec, jsonNumber, showAddress) +import Zenith.Utils + ( displayTaz + , displayZec + , jsonNumber + , showAddress + , validBarValue + ) data Name = WList @@ -589,9 +595,6 @@ barDoneAttr = A.attrName "done" barToDoAttr :: A.AttrName barToDoAttr = A.attrName "remaining" -validBarValue :: Float -> Float -validBarValue = clamp 0 1 - scanZebra :: T.Text -> T.Text -> Int -> Int -> BC.BChan Tick -> IO () scanZebra dbP zHost zPort b eChan = do _ <- liftIO $ initDb dbP diff --git a/src/Zenith/GUI.hs b/src/Zenith/GUI.hs index 6e95af4..ca62ec3 100644 --- a/src/Zenith/GUI.hs +++ b/src/Zenith/GUI.hs @@ -7,8 +7,11 @@ import Codec.Picture import Codec.Picture.Types (pixelFold, promoteImage) import Codec.QRCode 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 Data.Aeson import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as LBS import Data.HexString (toText) @@ -23,13 +26,15 @@ import Lens.Micro.TH import Monomer import qualified Monomer.Lens as L import System.Hclip +import Text.Printf import Text.Wrap (FillScope(..), FillStrategy(..), WrapSettings(..), wrapText) import TextShow hiding (toText) import ZcashHaskell.Keys (generateWalletSeedPhrase) import ZcashHaskell.Orchard (getSaplingFromUA, isValidUnifiedAddress) import ZcashHaskell.Transparent (encodeTransparentReceiver) import ZcashHaskell.Types - ( Phrase(..) + ( BlockResponse(..) + , Phrase(..) , Scope(..) , ToBytes(..) , UnifiedAddress(..) @@ -37,11 +42,13 @@ import ZcashHaskell.Types , ZebraGetBlockChainInfo(..) , ZebraGetInfo(..) ) +import ZcashHaskell.Utils (getBlockTime, makeZebraCall) import Zenith.Core import Zenith.DB import Zenith.GUI.Theme +import Zenith.Scanner (processTx) import Zenith.Types hiding (ZcashAddress(..)) -import Zenith.Utils (displayAmount, showAddress) +import Zenith.Utils (displayAmount, jsonNumber, showAddress, validBarValue) data AppEvent = AppInit @@ -76,6 +83,13 @@ data AppEvent | CopyTx !T.Text | CloseTx | ShowTx !Int + | TickUp + | SyncVal !Float + | SendTx + | ShowSend + | CancelSend + | CheckRecipient + | CheckAmount deriving (Eq, Show) data AppModel = AppModel @@ -108,6 +122,14 @@ data AppModel = AppModel , _showSeed :: !Bool , _modalMsg :: !(Maybe T.Text) , _showTx :: !(Maybe Int) + , _timer :: !Int + , _barValue :: !Float + , _openSend :: !Bool + , _sendRecipient :: !T.Text + , _sendAmount :: !Float + , _sendMemo :: !T.Text + , _recipientValid :: !Bool + , _amountValid :: !Bool } deriving (Eq, Show) makeLenses ''AppModel @@ -145,6 +167,7 @@ buildUI wenv model = widgetTree , confirmOverlay `nodeVisible` isJust (model ^. confirmTitle) , seedOverlay `nodeVisible` model ^. showSeed , txOverlay `nodeVisible` isJust (model ^. showTx) + , sendTxOverlay `nodeVisible` model ^. openSend , msgOverlay `nodeVisible` isJust (model ^. msg) , modalOverlay `nodeVisible` isJust (model ^. modalMsg) ] @@ -275,7 +298,12 @@ buildUI wenv model = widgetTree mainPane = box_ [alignMiddle] $ hstack - [addressBox, txBox `nodeVisible` not (null $ model ^. transactions)] + [ addressBox + , vstack + [ mainButton "Send" ShowSend + , txBox `nodeVisible` not (null $ model ^. transactions) + ] + ] balanceBox = hstack [ filler @@ -456,6 +484,8 @@ buildUI wenv model = widgetTree ("Last block sync: " <> maybe "N/A" (showt . zcashWalletLastSync . entityVal) currentWallet) `styleBasic` [padding 3, textSize 8] + , spacer + , label (showt $ model ^. timer) `styleBasic` [padding 3, textSize 8] , filler , image_ "./assets/1F993.png" [fitHeight] `styleBasic` [height 24, width 24] `nodeVisible` @@ -489,6 +519,31 @@ buildUI wenv model = widgetTree , cancelCaption $ model ^. confirmCancel ] (hstack [label "Name:", filler, textField_ mainInput [maxLength 25]]) + sendTxOverlay = + confirm_ + SendTx + CancelSend + [ titleCaption "Send Transaction" + , acceptCaption "Send" + , cancelCaption "Cancel" + ] + (vstack + [ hstack + [ label "To:" `styleBasic` [width 50] + , filler + , textField_ sendRecipient [] + ] + , hstack + [ label "Amount:" `styleBasic` [width 50] + , filler + , numericField_ sendAmount [minValue 0.0, decimals 8] + ] + , hstack + [ label "Memo:" `styleBasic` [width 50] + , filler + , textArea sendMemo + ] + ]) seedOverlay = alert CloseSeed $ vstack @@ -679,7 +734,8 @@ handleEvent :: -> [AppEventResponse AppModel AppEvent] handleEvent wenv node model evt = case evt of - AppInit -> [Event NewWallet | isNothing currentWallet] + AppInit -> + [Event NewWallet | isNothing currentWallet] <> [Producer timeTicker] ShowMsg t -> [Model $ model & msg ?~ t & menuPopup .~ False] ShowError t -> [Model $ model & msg ?~ t & menuPopup .~ False & inError .~ True] @@ -720,6 +776,14 @@ handleEvent wenv node model evt = ] ConfirmCancel -> [Model $ model & confirmTitle .~ Nothing & mainInput .~ ""] ShowSeed -> [Model $ model & showSeed .~ True & menuPopup .~ False] + ShowSend -> [Model $ model & openSend .~ True] + SendTx -> [] + CancelSend -> + [ Model $ + model & openSend .~ False & sendRecipient .~ "" & sendAmount .~ 0.0 & + sendMemo .~ + "" + ] SaveAddress acc -> if T.length (model ^. mainInput) > 1 then [ Task $ addNewAddress (model ^. mainInput) External acc @@ -817,12 +881,53 @@ handleEvent wenv node model evt = else [Event $ NewAccount currentWallet] LoadWallets a -> if not (null a) - then [Model $ model & wallets .~ a, Event $ SwitchWal 0] + then [ Model $ model & wallets .~ a + , Event $ SwitchWal $ model ^. selWallet + ] else [Event NewWallet] CloseMsg -> [Model $ model & msg .~ Nothing & inError .~ False] CloseSeed -> [Model $ model & showSeed .~ False] CloseTx -> [Model $ model & showTx .~ Nothing] ShowTx i -> [Model $ model & showTx ?~ i] + TickUp -> + if (model ^. timer) < 90 + then [Model $ model & timer .~ (1 + model ^. timer)] + else if (model ^. barValue) == 1.0 + then [ Model $ model & timer .~ 0 & barValue .~ 0.0 + , Producer $ + scanZebra + (c_dbPath $ model ^. configuration) + (c_zebraHost $ model ^. configuration) + (c_zebraPort $ model ^. configuration) + ] + else [Model $ model & timer .~ 0] + SyncVal i -> + if (i + model ^. barValue) >= 0.999 + then [ Model $ model & barValue .~ 1.0 & modalMsg .~ Nothing + , Task $ do + case currentWallet of + Nothing -> return $ ShowError "No wallet available" + Just cW -> do + syncWallet (model ^. configuration) cW + return $ SwitchAddr (model ^. selAddr) + , Task $ do + pool <- + runNoLoggingT $ initPool $ c_dbPath $ model ^. configuration + wL <- getWallets pool (model ^. network) + return $ LoadWallets wL + ] + else [ Model $ + model & barValue .~ validBarValue (i + model ^. barValue) & + modalMsg ?~ + ("Wallet Sync: " <> + T.pack (printf "%.2f%%" (model ^. barValue * 100))) + ] + CheckRecipient -> [] + CheckAmount -> + [ Model $ + model & amountValid .~ + ((model ^. sendAmount) < (fromIntegral (model ^. balance) / 100000000.0)) + ] where currentWallet = if null (model ^. wallets) @@ -911,6 +1016,64 @@ handleEvent wenv node model evt = wL <- getWallets pool (model ^. network) return $ LoadWallets wL +scanZebra :: T.Text -> T.Text -> Int -> (AppEvent -> IO ()) -> IO () +scanZebra dbPath zHost zPort sendMsg = do + _ <- liftIO $ initDb dbPath + bStatus <- liftIO $ checkBlockChain zHost zPort + pool <- runNoLoggingT $ initPool dbPath + b <- liftIO $ getMinBirthdayHeight pool + dbBlock <- runNoLoggingT $ getMaxBlock pool + let sb = max dbBlock b + if sb > zgb_blocks bStatus || sb < 1 + then sendMsg (ShowError "Invalid starting block for scan") + else do + let bList = [(sb + 1) .. (zgb_blocks bStatus)] + if not (null bList) + then do + let step = (1.0 :: Float) / fromIntegral (length bList) + mapM_ (processBlock pool step) bList + else sendMsg (SyncVal 1.0) + where + processBlock :: ConnectionPool -> Float -> Int -> IO () + processBlock pool step bl = do + r <- + liftIO $ + makeZebraCall + zHost + zPort + "getblock" + [Data.Aeson.String $ showt bl, jsonNumber 1] + case r of + Left e1 -> sendMsg (ShowError $ showt e1) + Right blk -> do + r2 <- + liftIO $ + makeZebraCall + zHost + zPort + "getblock" + [Data.Aeson.String $ showt bl, jsonNumber 0] + case r2 of + Left e2 -> sendMsg (ShowError $ showt e2) + Right hb -> do + let blockTime = getBlockTime hb + mapM_ (runNoLoggingT . processTx zHost zPort blockTime pool) $ + bl_txs $ addTime blk blockTime + sendMsg (SyncVal step) + addTime :: BlockResponse -> Int -> BlockResponse + addTime bl t = + BlockResponse + (bl_confirmations bl) + (bl_height bl) + (fromIntegral t) + (bl_txs bl) + +timeTicker :: (AppEvent -> IO ()) -> IO () +timeTicker sendMsg = do + sendMsg TickUp + threadDelay $ 1000 * 1000 + timeTicker sendMsg + txtWrap :: T.Text -> T.Text txtWrap = wrapText (WrapSettings False True NoFill FillAfterFirst) 32 @@ -982,6 +1145,14 @@ runZenithGUI config = do False Nothing Nothing + 0 + 1.0 + False + "" + 0.0 + "" + False + False startApp model handleEvent buildUI params Left e -> do initDb dbFilePath @@ -1018,6 +1189,14 @@ runZenithGUI config = do False Nothing Nothing + 0 + 1.0 + False + "" + 0.0 + "" + False + False startApp model handleEvent buildUI params where params = diff --git a/src/Zenith/GUI/Theme.hs b/src/Zenith/GUI/Theme.hs index 7322522..cf37d98 100644 --- a/src/Zenith/GUI/Theme.hs +++ b/src/Zenith/GUI/Theme.hs @@ -78,6 +78,36 @@ zenithTheme = baseTextStyle & L.focusHover . L.textFieldStyle . L.text ?~ + baseTextStyle & + L.basic . + L.numericFieldStyle . L.text ?~ + baseTextStyle & + L.hover . + L.numericFieldStyle . L.text ?~ + baseTextStyle & + L.focus . + L.numericFieldStyle . L.text ?~ + baseTextStyle & + L.active . + L.numericFieldStyle . L.text ?~ + baseTextStyle & + L.focusHover . + L.numericFieldStyle . L.text ?~ + baseTextStyle & + L.basic . + L.textAreaStyle . L.text ?~ + baseTextStyle & + L.hover . + L.textAreaStyle . L.text ?~ + baseTextStyle & + L.focus . + L.textAreaStyle . L.text ?~ + baseTextStyle & + L.active . + L.textAreaStyle . L.text ?~ + baseTextStyle & + L.focusHover . + L.textAreaStyle . L.text ?~ baseTextStyle zenithThemeColors :: BaseThemeColors diff --git a/src/Zenith/Utils.hs b/src/Zenith/Utils.hs index 0b7821e..a3c6cbd 100644 --- a/src/Zenith/Utils.hs +++ b/src/Zenith/Utils.hs @@ -5,6 +5,7 @@ module Zenith.Utils where import Data.Aeson import Data.Functor (void) import Data.Maybe +import Data.Ord (clamp) import Data.Scientific (Scientific(..), scientific) import qualified Data.Text as T import qualified Data.Text.Encoding as E @@ -79,3 +80,7 @@ copyAddress a = void $ createProcess_ "toClipboard" $ shell $ "echo " ++ T.unpack (addy a) ++ " | xclip -r -selection clipboard" + +-- | Bound a value to the 0..1 range, used for progress reporting on UIs +validBarValue :: Float -> Float +validBarValue = clamp (0, 1)