Release preparation #90
4 changed files with 227 additions and 10 deletions
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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 =
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
Loading…
Reference in a new issue