Release preparation #90

Merged
pitmutt merged 29 commits from rav001 into milestone2 2024-07-11 13:43:05 +00:00
4 changed files with 227 additions and 10 deletions
Showing only changes of commit a8d1333600 - Show all commits

View file

@ -25,7 +25,7 @@ import Brick.Forms
import qualified Brick.Main as M import qualified Brick.Main as M
import qualified Brick.Types as BT import qualified Brick.Types as BT
import Brick.Types (Widget) 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 qualified Brick.Widgets.Border as B
import Brick.Widgets.Border.Style (unicode, unicodeBold) import Brick.Widgets.Border.Style (unicode, unicodeBold)
import qualified Brick.Widgets.Center as C import qualified Brick.Widgets.Center as C
@ -97,7 +97,13 @@ import Zenith.Types
, UnifiedAddressDB(..) , UnifiedAddressDB(..)
, ZcashNetDB(..) , ZcashNetDB(..)
) )
import Zenith.Utils (displayTaz, displayZec, jsonNumber, showAddress) import Zenith.Utils
( displayTaz
, displayZec
, jsonNumber
, showAddress
, validBarValue
)
data Name data Name
= WList = WList
@ -589,9 +595,6 @@ barDoneAttr = A.attrName "done"
barToDoAttr :: A.AttrName barToDoAttr :: A.AttrName
barToDoAttr = A.attrName "remaining" barToDoAttr = A.attrName "remaining"
validBarValue :: Float -> Float
validBarValue = clamp 0 1
scanZebra :: T.Text -> T.Text -> Int -> Int -> BC.BChan Tick -> IO () scanZebra :: T.Text -> T.Text -> Int -> Int -> BC.BChan Tick -> IO ()
scanZebra dbP zHost zPort b eChan = do scanZebra dbP zHost zPort b eChan = do
_ <- liftIO $ initDb dbP _ <- liftIO $ initDb dbP

View file

@ -7,8 +7,11 @@ import Codec.Picture
import Codec.Picture.Types (pixelFold, promoteImage) import Codec.Picture.Types (pixelFold, promoteImage)
import Codec.QRCode import Codec.QRCode
import Codec.QRCode.JuicyPixels import Codec.QRCode.JuicyPixels
import Control.Concurrent (threadDelay)
import Control.Exception (throwIO, try) import Control.Exception (throwIO, try)
import Control.Monad.IO.Class (liftIO)
import Control.Monad.Logger (runNoLoggingT) import Control.Monad.Logger (runNoLoggingT)
import Data.Aeson
import qualified Data.ByteString as BS import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as LBS import qualified Data.ByteString.Lazy as LBS
import Data.HexString (toText) import Data.HexString (toText)
@ -23,13 +26,15 @@ import Lens.Micro.TH
import Monomer import Monomer
import qualified Monomer.Lens as L import qualified Monomer.Lens as L
import System.Hclip import System.Hclip
import Text.Printf
import Text.Wrap (FillScope(..), FillStrategy(..), WrapSettings(..), wrapText) import Text.Wrap (FillScope(..), FillStrategy(..), WrapSettings(..), wrapText)
import TextShow hiding (toText) import TextShow hiding (toText)
import ZcashHaskell.Keys (generateWalletSeedPhrase) import ZcashHaskell.Keys (generateWalletSeedPhrase)
import ZcashHaskell.Orchard (getSaplingFromUA, isValidUnifiedAddress) import ZcashHaskell.Orchard (getSaplingFromUA, isValidUnifiedAddress)
import ZcashHaskell.Transparent (encodeTransparentReceiver) import ZcashHaskell.Transparent (encodeTransparentReceiver)
import ZcashHaskell.Types import ZcashHaskell.Types
( Phrase(..) ( BlockResponse(..)
, Phrase(..)
, Scope(..) , Scope(..)
, ToBytes(..) , ToBytes(..)
, UnifiedAddress(..) , UnifiedAddress(..)
@ -37,11 +42,13 @@ import ZcashHaskell.Types
, ZebraGetBlockChainInfo(..) , ZebraGetBlockChainInfo(..)
, ZebraGetInfo(..) , ZebraGetInfo(..)
) )
import ZcashHaskell.Utils (getBlockTime, makeZebraCall)
import Zenith.Core import Zenith.Core
import Zenith.DB import Zenith.DB
import Zenith.GUI.Theme import Zenith.GUI.Theme
import Zenith.Scanner (processTx)
import Zenith.Types hiding (ZcashAddress(..)) import Zenith.Types hiding (ZcashAddress(..))
import Zenith.Utils (displayAmount, showAddress) import Zenith.Utils (displayAmount, jsonNumber, showAddress, validBarValue)
data AppEvent data AppEvent
= AppInit = AppInit
@ -76,6 +83,13 @@ data AppEvent
| CopyTx !T.Text | CopyTx !T.Text
| CloseTx | CloseTx
| ShowTx !Int | ShowTx !Int
| TickUp
| SyncVal !Float
| SendTx
| ShowSend
| CancelSend
| CheckRecipient
| CheckAmount
deriving (Eq, Show) deriving (Eq, Show)
data AppModel = AppModel data AppModel = AppModel
@ -108,6 +122,14 @@ data AppModel = AppModel
, _showSeed :: !Bool , _showSeed :: !Bool
, _modalMsg :: !(Maybe T.Text) , _modalMsg :: !(Maybe T.Text)
, _showTx :: !(Maybe Int) , _showTx :: !(Maybe Int)
, _timer :: !Int
, _barValue :: !Float
, _openSend :: !Bool
, _sendRecipient :: !T.Text
, _sendAmount :: !Float
, _sendMemo :: !T.Text
, _recipientValid :: !Bool
, _amountValid :: !Bool
} deriving (Eq, Show) } deriving (Eq, Show)
makeLenses ''AppModel makeLenses ''AppModel
@ -145,6 +167,7 @@ buildUI wenv model = widgetTree
, confirmOverlay `nodeVisible` isJust (model ^. confirmTitle) , confirmOverlay `nodeVisible` isJust (model ^. confirmTitle)
, seedOverlay `nodeVisible` model ^. showSeed , seedOverlay `nodeVisible` model ^. showSeed
, txOverlay `nodeVisible` isJust (model ^. showTx) , txOverlay `nodeVisible` isJust (model ^. showTx)
, sendTxOverlay `nodeVisible` model ^. openSend
, msgOverlay `nodeVisible` isJust (model ^. msg) , msgOverlay `nodeVisible` isJust (model ^. msg)
, modalOverlay `nodeVisible` isJust (model ^. modalMsg) , modalOverlay `nodeVisible` isJust (model ^. modalMsg)
] ]
@ -275,7 +298,12 @@ buildUI wenv model = widgetTree
mainPane = mainPane =
box_ [alignMiddle] $ box_ [alignMiddle] $
hstack hstack
[addressBox, txBox `nodeVisible` not (null $ model ^. transactions)] [ addressBox
, vstack
[ mainButton "Send" ShowSend
, txBox `nodeVisible` not (null $ model ^. transactions)
]
]
balanceBox = balanceBox =
hstack hstack
[ filler [ filler
@ -456,6 +484,8 @@ buildUI wenv model = widgetTree
("Last block sync: " <> ("Last block sync: " <>
maybe "N/A" (showt . zcashWalletLastSync . entityVal) currentWallet) `styleBasic` maybe "N/A" (showt . zcashWalletLastSync . entityVal) currentWallet) `styleBasic`
[padding 3, textSize 8] [padding 3, textSize 8]
, spacer
, label (showt $ model ^. timer) `styleBasic` [padding 3, textSize 8]
, filler , filler
, image_ "./assets/1F993.png" [fitHeight] `styleBasic` , image_ "./assets/1F993.png" [fitHeight] `styleBasic`
[height 24, width 24] `nodeVisible` [height 24, width 24] `nodeVisible`
@ -489,6 +519,31 @@ buildUI wenv model = widgetTree
, cancelCaption $ model ^. confirmCancel , cancelCaption $ model ^. confirmCancel
] ]
(hstack [label "Name:", filler, textField_ mainInput [maxLength 25]]) (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 = seedOverlay =
alert CloseSeed $ alert CloseSeed $
vstack vstack
@ -679,7 +734,8 @@ handleEvent ::
-> [AppEventResponse AppModel AppEvent] -> [AppEventResponse AppModel AppEvent]
handleEvent wenv node model evt = handleEvent wenv node model evt =
case evt of case evt of
AppInit -> [Event NewWallet | isNothing currentWallet] AppInit ->
[Event NewWallet | isNothing currentWallet] <> [Producer timeTicker]
ShowMsg t -> [Model $ model & msg ?~ t & menuPopup .~ False] ShowMsg t -> [Model $ model & msg ?~ t & menuPopup .~ False]
ShowError t -> ShowError t ->
[Model $ model & msg ?~ t & menuPopup .~ False & inError .~ True] [Model $ model & msg ?~ t & menuPopup .~ False & inError .~ True]
@ -720,6 +776,14 @@ handleEvent wenv node model evt =
] ]
ConfirmCancel -> [Model $ model & confirmTitle .~ Nothing & mainInput .~ ""] ConfirmCancel -> [Model $ model & confirmTitle .~ Nothing & mainInput .~ ""]
ShowSeed -> [Model $ model & showSeed .~ True & menuPopup .~ False] 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 -> SaveAddress acc ->
if T.length (model ^. mainInput) > 1 if T.length (model ^. mainInput) > 1
then [ Task $ addNewAddress (model ^. mainInput) External acc then [ Task $ addNewAddress (model ^. mainInput) External acc
@ -817,12 +881,53 @@ handleEvent wenv node model evt =
else [Event $ NewAccount currentWallet] else [Event $ NewAccount currentWallet]
LoadWallets a -> LoadWallets a ->
if not (null 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] else [Event NewWallet]
CloseMsg -> [Model $ model & msg .~ Nothing & inError .~ False] CloseMsg -> [Model $ model & msg .~ Nothing & inError .~ False]
CloseSeed -> [Model $ model & showSeed .~ False] CloseSeed -> [Model $ model & showSeed .~ False]
CloseTx -> [Model $ model & showTx .~ Nothing] CloseTx -> [Model $ model & showTx .~ Nothing]
ShowTx i -> [Model $ model & showTx ?~ i] 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 where
currentWallet = currentWallet =
if null (model ^. wallets) if null (model ^. wallets)
@ -911,6 +1016,64 @@ handleEvent wenv node model evt =
wL <- getWallets pool (model ^. network) wL <- getWallets pool (model ^. network)
return $ LoadWallets wL 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 :: T.Text -> T.Text
txtWrap = wrapText (WrapSettings False True NoFill FillAfterFirst) 32 txtWrap = wrapText (WrapSettings False True NoFill FillAfterFirst) 32
@ -982,6 +1145,14 @@ runZenithGUI config = do
False False
Nothing Nothing
Nothing Nothing
0
1.0
False
""
0.0
""
False
False
startApp model handleEvent buildUI params startApp model handleEvent buildUI params
Left e -> do Left e -> do
initDb dbFilePath initDb dbFilePath
@ -1018,6 +1189,14 @@ runZenithGUI config = do
False False
Nothing Nothing
Nothing Nothing
0
1.0
False
""
0.0
""
False
False
startApp model handleEvent buildUI params startApp model handleEvent buildUI params
where where
params = params =

View file

@ -78,6 +78,36 @@ zenithTheme =
baseTextStyle & baseTextStyle &
L.focusHover . L.focusHover .
L.textFieldStyle . L.text ?~ 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 baseTextStyle
zenithThemeColors :: BaseThemeColors zenithThemeColors :: BaseThemeColors

View file

@ -5,6 +5,7 @@ module Zenith.Utils where
import Data.Aeson import Data.Aeson
import Data.Functor (void) import Data.Functor (void)
import Data.Maybe import Data.Maybe
import Data.Ord (clamp)
import Data.Scientific (Scientific(..), scientific) import Data.Scientific (Scientific(..), scientific)
import qualified Data.Text as T import qualified Data.Text as T
import qualified Data.Text.Encoding as E import qualified Data.Text.Encoding as E
@ -79,3 +80,7 @@ copyAddress a =
void $ void $
createProcess_ "toClipboard" $ createProcess_ "toClipboard" $
shell $ "echo " ++ T.unpack (addy a) ++ " | xclip -r -selection clipboard" 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)