Compare commits

..

No commits in common. "56eeeaaf20b23f56c200731b91aac178615fa5aa" and "709cfde1515e7c33c7123cc1b500992b6c6941af" have entirely different histories.

5 changed files with 63 additions and 438 deletions

View file

@ -20,12 +20,7 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0
- Dialog to add new account
- Dialog to add new wallet
- Dialog to display transaction details and copy TX ID
- Dialog to send a new transaction
- Dialog to display Tx ID after successful broadcast
### Fixed
- Validation of input of amount for sending in TUI
## [0.5.3.0-beta]

View file

@ -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, fg, on, style)
import Brick.Util (bg, clamp, fg, on, style)
import qualified Brick.Widgets.Border as B
import Brick.Widgets.Border.Style (unicode, unicodeBold)
import qualified Brick.Widgets.Center as C
@ -82,7 +82,8 @@ import ZcashHaskell.Keys (generateWalletSeedPhrase, getWalletSeed)
import ZcashHaskell.Orchard (getSaplingFromUA, isValidUnifiedAddress)
import ZcashHaskell.Sapling (decodeSaplingAddress, isValidShieldedAddress)
import ZcashHaskell.Transparent
( decodeTransparentAddress
( decodeExchangeAddress
, decodeTransparentAddress
, encodeTransparentReceiver
)
import ZcashHaskell.Types
@ -96,15 +97,7 @@ import Zenith.Types
, UnifiedAddressDB(..)
, ZcashNetDB(..)
)
import Zenith.Utils
( displayTaz
, displayZec
, isRecipientValid
, jsonNumber
, parseAddress
, showAddress
, validBarValue
)
import Zenith.Utils (displayTaz, displayZec, jsonNumber, showAddress)
data Name
= WList
@ -505,10 +498,23 @@ mkSendForm bal =
]
where
isAmountValid :: Integer -> Float -> Bool
isAmountValid b i = (fromIntegral b / 100000000.0) >= i
isAmountValid b i = (fromIntegral b * 100000000.0) >= i
label s w =
padBottom (Pad 1) $ vLimit 1 (hLimit 15 $ str s <+> fill ' ') <+> w
isRecipientValid :: T.Text -> Bool
isRecipientValid a =
case isValidUnifiedAddress (E.encodeUtf8 a) of
Just _a1 -> True
Nothing ->
isValidShieldedAddress (E.encodeUtf8 a) ||
(case decodeTransparentAddress (E.encodeUtf8 a) of
Just _a3 -> True
Nothing ->
case decodeExchangeAddress a of
Just _a4 -> True
Nothing -> False)
listDrawElement :: (Show a) => Bool -> a -> Widget Name
listDrawElement sel a =
let selStr s =
@ -583,6 +589,9 @@ 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
@ -1276,22 +1285,36 @@ sendTransaction ::
-> IO ()
sendTransaction pool chan zHost zPort znet accId bl amt ua memo = do
BC.writeBChan chan $ TickMsg "Preparing transaction..."
case parseAddress ua znet of
Nothing -> BC.writeBChan chan $ TickMsg "Incorrect address"
Just outUA -> do
res <-
runFileLoggingT "zenith.log" $
prepareTx pool zHost zPort znet accId bl amt outUA memo
BC.writeBChan chan $ TickMsg "Transaction ready, sending to Zebra..."
case res of
Left e -> BC.writeBChan chan $ TickMsg $ show e
Right rawTx -> do
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
outUA <- parseAddress ua
res <-
runFileLoggingT "zenith.log" $
prepareTx pool zHost zPort znet accId bl amt outUA memo
BC.writeBChan chan $ TickMsg "Transaction ready, sending to Zebra..."
case res of
Left e -> BC.writeBChan chan $ TickMsg $ show e
Right rawTx -> do
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
where
parseAddress :: T.Text -> IO UnifiedAddress
parseAddress a =
case isValidUnifiedAddress (E.encodeUtf8 a) of
Just a1 -> return a1
Nothing ->
case decodeSaplingAddress (E.encodeUtf8 a) of
Just a2 ->
return $
UnifiedAddress znet Nothing (Just $ sa_receiver a2) Nothing
Nothing ->
case decodeTransparentAddress (E.encodeUtf8 a) of
Just a3 ->
return $
UnifiedAddress znet Nothing Nothing (Just $ ta_receiver a3)
Nothing -> throwIO $ userError "Incorrect address"

View file

@ -7,11 +7,8 @@ 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 (runFileLoggingT, runNoLoggingT)
import Data.Aeson
import Control.Monad.Logger (runNoLoggingT)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as LBS
import Data.HexString (toText)
@ -26,15 +23,13 @@ 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
( BlockResponse(..)
, Phrase(..)
( Phrase(..)
, Scope(..)
, ToBytes(..)
, UnifiedAddress(..)
@ -42,20 +37,11 @@ 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
, isRecipientValid
, jsonNumber
, parseAddress
, showAddress
, validBarValue
)
import Zenith.Utils (displayAmount, showAddress)
data AppEvent
= AppInit
@ -85,20 +71,11 @@ data AppEvent
| SaveAccount !(Maybe (Entity ZcashWallet))
| SaveWallet
| CloseSeed
| CloseTxId
| ShowSeed
| CopySeed !T.Text
| CopyTx !T.Text
| CloseTx
| ShowTx !Int
| TickUp
| SyncVal !Float
| SendTx
| ShowSend
| CancelSend
| CheckRecipient !T.Text
| CheckAmount !Float
| ShowTxId !T.Text
deriving (Eq, Show)
data AppModel = AppModel
@ -131,15 +108,6 @@ 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
, _showId :: !(Maybe T.Text)
} deriving (Eq, Show)
makeLenses ''AppModel
@ -177,8 +145,6 @@ buildUI wenv model = widgetTree
, confirmOverlay `nodeVisible` isJust (model ^. confirmTitle)
, seedOverlay `nodeVisible` model ^. showSeed
, txOverlay `nodeVisible` isJust (model ^. showTx)
, sendTxOverlay `nodeVisible` model ^. openSend
, txIdOverlay `nodeVisible` isJust (model ^. showId)
, msgOverlay `nodeVisible` isJust (model ^. msg)
, modalOverlay `nodeVisible` isJust (model ^. modalMsg)
]
@ -309,12 +275,7 @@ buildUI wenv model = widgetTree
mainPane =
box_ [alignMiddle] $
hstack
[ addressBox
, vstack
[ mainButton "Send" ShowSend
, txBox `nodeVisible` not (null $ model ^. transactions)
]
]
[addressBox, txBox `nodeVisible` not (null $ model ^. transactions)]
balanceBox =
hstack
[ filler
@ -495,8 +456,6 @@ 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`
@ -530,73 +489,6 @@ buildUI wenv model = widgetTree
, cancelCaption $ model ^. confirmCancel
]
(hstack [label "Name:", filler, textField_ mainInput [maxLength 25]])
sendTxOverlay =
box
(vstack
[ filler
, hstack
[ filler
, box_
[]
(vstack
[ box_
[alignMiddle]
(label "Send Zcash" `styleBasic`
[textFont "Bold", textSize 12])
, separatorLine `styleBasic` [fgColor btnColor]
, spacer
, hstack
[ label "To:" `styleBasic` [width 50]
, spacer
, textField_ sendRecipient [onChange CheckRecipient] `styleBasic`
[ width 150
, styleIf
(not $ model ^. recipientValid)
(textColor red)
]
]
, hstack
[ label "Amount:" `styleBasic` [width 50]
, spacer
, numericField_
sendAmount
[ decimals 8
, minValue 0.0
, maxValue
(fromIntegral (model ^. balance) / 100000000.0)
, validInput amountValid
, onChange CheckAmount
] `styleBasic`
[ width 150
, styleIf
(not $ model ^. amountValid)
(textColor red)
]
]
, hstack
[ label "Memo:" `styleBasic` [width 50]
, spacer
, textArea sendMemo `styleBasic`
[width 150, height 40]
]
, spacer
, box_
[alignMiddle]
(hstack
[ spacer
, button "Cancel" CancelSend
, spacer
, mainButton "Send" SendTx `nodeEnabled`
(model ^. amountValid && model ^. recipientValid)
, spacer
])
]) `styleBasic`
[radius 4, border 2 btnColor, bgColor white, padding 4]
, filler
]
, filler
]) `styleBasic`
[bgColor (white & L.a .~ 0.5)]
seedOverlay =
alert CloseSeed $
vstack
@ -710,31 +602,6 @@ buildUI wenv model = widgetTree
]) `styleBasic`
[padding 2, bgColor white, width 280, borderB 1 gray]
]
txIdOverlay =
case model ^. showId of
Nothing -> alert CloseTxId $ label "N/A"
Just t ->
alert CloseTxId $
box_
[alignLeft]
(vstack
[ box_ [alignMiddle] $
label "Transaction Sent!" `styleBasic` [textFont "Bold"]
, spacer
, hstack
[ label "Tx ID " `styleBasic` [width 60, textFont "Bold"]
, separatorLine `styleBasic` [fgColor btnColor]
, spacer
, label_ (txtWrap t) [multiline]
, spacer
, box_
[onClick $ CopyTx t]
(remixIcon remixFileCopyFill `styleBasic`
[textColor white]) `styleBasic`
[cursorHand, bgColor btnColor, radius 2, padding 2]
]
]) `styleBasic`
[padding 2, bgColor white, width 280, borderB 1 gray, borderT 1 gray]
generateQRCodes :: Config -> IO ()
generateQRCodes config = do
@ -812,14 +679,10 @@ handleEvent ::
-> [AppEventResponse AppModel AppEvent]
handleEvent wenv node model evt =
case evt of
AppInit ->
[Event NewWallet | isNothing currentWallet] <> [Producer timeTicker]
AppInit -> [Event NewWallet | isNothing currentWallet]
ShowMsg t -> [Model $ model & msg ?~ t & menuPopup .~ False]
ShowError t ->
[ Model $
model & msg ?~ t & menuPopup .~ False & inError .~ True & modalMsg .~
Nothing
]
[Model $ model & msg ?~ t & menuPopup .~ False & inError .~ True]
ShowModal t -> [Model $ model & modalMsg ?~ t]
WalletClicked -> [Model $ model & walPopup .~ True]
AccountClicked -> [Model $ model & accPopup .~ True]
@ -857,30 +720,6 @@ handleEvent wenv node model evt =
]
ConfirmCancel -> [Model $ model & confirmTitle .~ Nothing & mainInput .~ ""]
ShowSeed -> [Model $ model & showSeed .~ True & menuPopup .~ False]
ShowSend -> [Model $ model & openSend .~ True]
SendTx ->
case currentAccount of
Nothing -> [Event $ ShowError "No account available"]
Just acc ->
case currentWallet of
Nothing -> [Event $ ShowError "No wallet available"]
Just wal ->
[ Producer $
sendTransaction
(model ^. configuration)
(model ^. network)
(entityKey acc)
(zcashWalletLastSync $ entityVal wal)
(model ^. sendAmount)
(model ^. sendRecipient)
(model ^. sendMemo)
]
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
@ -978,55 +817,12 @@ handleEvent wenv node model evt =
else [Event $ NewAccount currentWallet]
LoadWallets a ->
if not (null a)
then [ Model $ model & wallets .~ a
, Event $ SwitchWal $ model ^. selWallet
]
then [Model $ model & wallets .~ a, Event $ SwitchWal 0]
else [Event NewWallet]
CloseMsg -> [Model $ model & msg .~ Nothing & inError .~ False]
CloseSeed -> [Model $ model & showSeed .~ False]
CloseTx -> [Model $ model & showTx .~ Nothing]
CloseTxId -> [Model $ model & showId .~ 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 a -> [Model $ model & recipientValid .~ isRecipientValid a]
CheckAmount i ->
[ Model $
model & amountValid .~
(i < (fromIntegral (model ^. balance) / 100000000.0))
]
ShowTxId tx -> [Model $ model & showId ?~ tx & modalMsg .~ Nothing]
where
currentWallet =
if null (model ^. wallets)
@ -1115,100 +911,6 @@ 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)
sendTransaction ::
Config
-> ZcashNet
-> ZcashAccountId
-> Int
-> Float
-> T.Text
-> T.Text
-> (AppEvent -> IO ())
-> IO ()
sendTransaction config znet accId bl amt ua memo sendMsg = do
sendMsg $ ShowModal "Preparing transaction..."
case parseAddress ua znet of
Nothing -> sendMsg $ ShowError "Incorrect address"
Just outUA -> do
let dbPath = c_dbPath config
let zHost = c_zebraHost config
let zPort = c_zebraPort config
pool <- runNoLoggingT $ initPool dbPath
res <-
runFileLoggingT "zenith.log" $
prepareTx pool zHost zPort znet accId bl amt outUA memo
case res of
Left e -> sendMsg $ ShowError $ T.pack $ show e
Right rawTx -> do
sendMsg $ ShowModal "Transaction ready, sending to Zebra..."
resp <-
makeZebraCall
zHost
zPort
"sendrawtransaction"
[Data.Aeson.String $ toText rawTx]
case resp of
Left e1 -> sendMsg $ ShowError $ "Zebra error: " <> showt e1
Right txId -> sendMsg $ ShowTxId txId
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
@ -1280,15 +982,6 @@ runZenithGUI config = do
False
Nothing
Nothing
0
1.0
False
""
0.0
""
False
False
Nothing
startApp model handleEvent buildUI params
Left e -> do
initDb dbFilePath
@ -1325,15 +1018,6 @@ runZenithGUI config = do
False
Nothing
Nothing
0
1.0
False
""
0.0
""
False
False
Nothing
startApp model handleEvent buildUI params
where
params =

View file

@ -64,12 +64,6 @@ zenithTheme =
L.active .
L.btnMainStyle . L.text ?~
hiliteTextStyle &
L.disabled .
L.btnMainStyle . L.text ?~
hiliteTextStyle &
L.disabled .
L.btnMainStyle . L.bgColor ?~
gray07c &
L.basic .
L.textFieldStyle . L.text ?~
baseTextStyle &
@ -84,36 +78,6 @@ 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

View file

@ -5,24 +5,14 @@ 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
import System.Process (createProcess_, shell)
import Text.Regex.Posix
import ZcashHaskell.Orchard (encodeUnifiedAddress, isValidUnifiedAddress)
import ZcashHaskell.Sapling (decodeSaplingAddress, isValidShieldedAddress)
import ZcashHaskell.Transparent
( decodeExchangeAddress
, decodeTransparentAddress
)
import ZcashHaskell.Types
( SaplingAddress(..)
, TransparentAddress(..)
, UnifiedAddress(..)
, ZcashNet(..)
)
import ZcashHaskell.Sapling (isValidShieldedAddress)
import ZcashHaskell.Types (ZcashNet(..))
import Zenith.Types
( AddressGroup(..)
, UnifiedAddressDB(..)
@ -89,34 +79,3 @@ 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)
isRecipientValid :: T.Text -> Bool
isRecipientValid a =
case isValidUnifiedAddress (E.encodeUtf8 a) of
Just _a1 -> True
Nothing ->
isValidShieldedAddress (E.encodeUtf8 a) ||
(case decodeTransparentAddress (E.encodeUtf8 a) of
Just _a3 -> True
Nothing ->
case decodeExchangeAddress a of
Just _a4 -> True
Nothing -> False)
parseAddress :: T.Text -> ZcashNet -> Maybe UnifiedAddress
parseAddress a znet =
case isValidUnifiedAddress (E.encodeUtf8 a) of
Just a1 -> Just a1
Nothing ->
case decodeSaplingAddress (E.encodeUtf8 a) of
Just a2 ->
Just $ UnifiedAddress znet Nothing (Just $ sa_receiver a2) Nothing
Nothing ->
case decodeTransparentAddress (E.encodeUtf8 a) of
Just a3 ->
Just $ UnifiedAddress znet Nothing Nothing (Just $ ta_receiver a3)
Nothing -> Nothing