Compare commits

...

4 commits

5 changed files with 438 additions and 63 deletions

View file

@ -20,7 +20,12 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0
- Dialog to add new account - Dialog to add new account
- Dialog to add new wallet - Dialog to add new wallet
- Dialog to display transaction details and copy TX ID - 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] ## [0.5.3.0-beta]

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
@ -82,8 +82,7 @@ import ZcashHaskell.Keys (generateWalletSeedPhrase, getWalletSeed)
import ZcashHaskell.Orchard (getSaplingFromUA, isValidUnifiedAddress) import ZcashHaskell.Orchard (getSaplingFromUA, isValidUnifiedAddress)
import ZcashHaskell.Sapling (decodeSaplingAddress, isValidShieldedAddress) import ZcashHaskell.Sapling (decodeSaplingAddress, isValidShieldedAddress)
import ZcashHaskell.Transparent import ZcashHaskell.Transparent
( decodeExchangeAddress ( decodeTransparentAddress
, decodeTransparentAddress
, encodeTransparentReceiver , encodeTransparentReceiver
) )
import ZcashHaskell.Types import ZcashHaskell.Types
@ -97,7 +96,15 @@ import Zenith.Types
, UnifiedAddressDB(..) , UnifiedAddressDB(..)
, ZcashNetDB(..) , ZcashNetDB(..)
) )
import Zenith.Utils (displayTaz, displayZec, jsonNumber, showAddress) import Zenith.Utils
( displayTaz
, displayZec
, isRecipientValid
, jsonNumber
, parseAddress
, showAddress
, validBarValue
)
data Name data Name
= WList = WList
@ -498,23 +505,10 @@ mkSendForm bal =
] ]
where where
isAmountValid :: Integer -> Float -> Bool isAmountValid :: Integer -> Float -> Bool
isAmountValid b i = (fromIntegral b * 100000000.0) >= i isAmountValid b i = (fromIntegral b / 100000000.0) >= i
label s w = label s w =
padBottom (Pad 1) $ vLimit 1 (hLimit 15 $ str s <+> fill ' ') <+> 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 :: (Show a) => Bool -> a -> Widget Name
listDrawElement sel a = listDrawElement sel a =
let selStr s = let selStr s =
@ -589,9 +583,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
@ -1285,7 +1276,9 @@ sendTransaction ::
-> IO () -> IO ()
sendTransaction pool chan zHost zPort znet accId bl amt ua memo = do sendTransaction pool chan zHost zPort znet accId bl amt ua memo = do
BC.writeBChan chan $ TickMsg "Preparing transaction..." BC.writeBChan chan $ TickMsg "Preparing transaction..."
outUA <- parseAddress ua case parseAddress ua znet of
Nothing -> BC.writeBChan chan $ TickMsg "Incorrect address"
Just outUA -> do
res <- res <-
runFileLoggingT "zenith.log" $ runFileLoggingT "zenith.log" $
prepareTx pool zHost zPort znet accId bl amt outUA memo prepareTx pool zHost zPort znet accId bl amt outUA memo
@ -1302,19 +1295,3 @@ sendTransaction pool chan zHost zPort znet accId bl amt ua memo = do
case resp of case resp of
Left e1 -> BC.writeBChan chan $ TickMsg $ "Zebra error: " ++ show e1 Left e1 -> BC.writeBChan chan $ TickMsg $ "Zebra error: " ++ show e1
Right txId -> BC.writeBChan chan $ TickTx txId 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,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.Logger (runNoLoggingT) import Control.Monad.IO.Class (liftIO)
import Control.Monad.Logger (runFileLoggingT, 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,20 @@ 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
, isRecipientValid
, jsonNumber
, parseAddress
, showAddress
, validBarValue
)
data AppEvent data AppEvent
= AppInit = AppInit
@ -71,11 +85,20 @@ data AppEvent
| SaveAccount !(Maybe (Entity ZcashWallet)) | SaveAccount !(Maybe (Entity ZcashWallet))
| SaveWallet | SaveWallet
| CloseSeed | CloseSeed
| CloseTxId
| ShowSeed | ShowSeed
| CopySeed !T.Text | CopySeed !T.Text
| CopyTx !T.Text | CopyTx !T.Text
| CloseTx | CloseTx
| ShowTx !Int | ShowTx !Int
| TickUp
| SyncVal !Float
| SendTx
| ShowSend
| CancelSend
| CheckRecipient !T.Text
| CheckAmount !Float
| ShowTxId !T.Text
deriving (Eq, Show) deriving (Eq, Show)
data AppModel = AppModel data AppModel = AppModel
@ -108,6 +131,15 @@ 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
, _showId :: !(Maybe T.Text)
} deriving (Eq, Show) } deriving (Eq, Show)
makeLenses ''AppModel makeLenses ''AppModel
@ -145,6 +177,8 @@ 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
, txIdOverlay `nodeVisible` isJust (model ^. showId)
, msgOverlay `nodeVisible` isJust (model ^. msg) , msgOverlay `nodeVisible` isJust (model ^. msg)
, modalOverlay `nodeVisible` isJust (model ^. modalMsg) , modalOverlay `nodeVisible` isJust (model ^. modalMsg)
] ]
@ -275,7 +309,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 +495,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 +530,73 @@ 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 =
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 = seedOverlay =
alert CloseSeed $ alert CloseSeed $
vstack vstack
@ -602,6 +710,31 @@ buildUI wenv model = widgetTree
]) `styleBasic` ]) `styleBasic`
[padding 2, bgColor white, width 280, borderB 1 gray] [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 -> IO ()
generateQRCodes config = do generateQRCodes config = do
@ -679,10 +812,14 @@ 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 & modalMsg .~
Nothing
]
ShowModal t -> [Model $ model & modalMsg ?~ t] ShowModal t -> [Model $ model & modalMsg ?~ t]
WalletClicked -> [Model $ model & walPopup .~ True] WalletClicked -> [Model $ model & walPopup .~ True]
AccountClicked -> [Model $ model & accPopup .~ True] AccountClicked -> [Model $ model & accPopup .~ True]
@ -720,6 +857,30 @@ 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 ->
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 -> 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 +978,55 @@ 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]
CloseTxId -> [Model $ model & showId .~ 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 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 where
currentWallet = currentWallet =
if null (model ^. wallets) if null (model ^. wallets)
@ -911,6 +1115,100 @@ 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)
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 :: T.Text -> T.Text
txtWrap = wrapText (WrapSettings False True NoFill FillAfterFirst) 32 txtWrap = wrapText (WrapSettings False True NoFill FillAfterFirst) 32
@ -982,6 +1280,15 @@ runZenithGUI config = do
False False
Nothing Nothing
Nothing Nothing
0
1.0
False
""
0.0
""
False
False
Nothing
startApp model handleEvent buildUI params startApp model handleEvent buildUI params
Left e -> do Left e -> do
initDb dbFilePath initDb dbFilePath
@ -1018,6 +1325,15 @@ runZenithGUI config = do
False False
Nothing Nothing
Nothing Nothing
0
1.0
False
""
0.0
""
False
False
Nothing
startApp model handleEvent buildUI params startApp model handleEvent buildUI params
where where
params = params =

View file

@ -64,6 +64,12 @@ zenithTheme =
L.active . L.active .
L.btnMainStyle . L.text ?~ L.btnMainStyle . L.text ?~
hiliteTextStyle & hiliteTextStyle &
L.disabled .
L.btnMainStyle . L.text ?~
hiliteTextStyle &
L.disabled .
L.btnMainStyle . L.bgColor ?~
gray07c &
L.basic . L.basic .
L.textFieldStyle . L.text ?~ L.textFieldStyle . L.text ?~
baseTextStyle & baseTextStyle &
@ -78,6 +84,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,14 +5,24 @@ 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
import System.Process (createProcess_, shell) import System.Process (createProcess_, shell)
import Text.Regex.Posix import Text.Regex.Posix
import ZcashHaskell.Orchard (encodeUnifiedAddress, isValidUnifiedAddress) import ZcashHaskell.Orchard (encodeUnifiedAddress, isValidUnifiedAddress)
import ZcashHaskell.Sapling (isValidShieldedAddress) import ZcashHaskell.Sapling (decodeSaplingAddress, isValidShieldedAddress)
import ZcashHaskell.Types (ZcashNet(..)) import ZcashHaskell.Transparent
( decodeExchangeAddress
, decodeTransparentAddress
)
import ZcashHaskell.Types
( SaplingAddress(..)
, TransparentAddress(..)
, UnifiedAddress(..)
, ZcashNet(..)
)
import Zenith.Types import Zenith.Types
( AddressGroup(..) ( AddressGroup(..)
, UnifiedAddressDB(..) , UnifiedAddressDB(..)
@ -79,3 +89,34 @@ 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)
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