Compare commits
No commits in common. "56eeeaaf20b23f56c200731b91aac178615fa5aa" and "709cfde1515e7c33c7123cc1b500992b6c6941af" have entirely different histories.
56eeeaaf20
...
709cfde151
5 changed files with 63 additions and 438 deletions
|
@ -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 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]
|
||||||
|
|
||||||
|
|
|
@ -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, fg, on, style)
|
import Brick.Util (bg, clamp, 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,7 +82,8 @@ 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
|
||||||
( decodeTransparentAddress
|
( decodeExchangeAddress
|
||||||
|
, decodeTransparentAddress
|
||||||
, encodeTransparentReceiver
|
, encodeTransparentReceiver
|
||||||
)
|
)
|
||||||
import ZcashHaskell.Types
|
import ZcashHaskell.Types
|
||||||
|
@ -96,15 +97,7 @@ import Zenith.Types
|
||||||
, UnifiedAddressDB(..)
|
, UnifiedAddressDB(..)
|
||||||
, ZcashNetDB(..)
|
, ZcashNetDB(..)
|
||||||
)
|
)
|
||||||
import Zenith.Utils
|
import Zenith.Utils (displayTaz, displayZec, jsonNumber, showAddress)
|
||||||
( displayTaz
|
|
||||||
, displayZec
|
|
||||||
, isRecipientValid
|
|
||||||
, jsonNumber
|
|
||||||
, parseAddress
|
|
||||||
, showAddress
|
|
||||||
, validBarValue
|
|
||||||
)
|
|
||||||
|
|
||||||
data Name
|
data Name
|
||||||
= WList
|
= WList
|
||||||
|
@ -505,10 +498,23 @@ 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 =
|
||||||
|
@ -583,6 +589,9 @@ 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
|
||||||
|
@ -1276,9 +1285,7 @@ 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..."
|
||||||
case parseAddress ua znet of
|
outUA <- parseAddress ua
|
||||||
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
|
||||||
|
@ -1295,3 +1302,19 @@ 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"
|
||||||
|
|
|
@ -7,11 +7,8 @@ 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 (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)
|
||||||
|
@ -26,15 +23,13 @@ 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
|
||||||
( BlockResponse(..)
|
( Phrase(..)
|
||||||
, Phrase(..)
|
|
||||||
, Scope(..)
|
, Scope(..)
|
||||||
, ToBytes(..)
|
, ToBytes(..)
|
||||||
, UnifiedAddress(..)
|
, UnifiedAddress(..)
|
||||||
|
@ -42,20 +37,11 @@ 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
|
import Zenith.Utils (displayAmount, showAddress)
|
||||||
( displayAmount
|
|
||||||
, isRecipientValid
|
|
||||||
, jsonNumber
|
|
||||||
, parseAddress
|
|
||||||
, showAddress
|
|
||||||
, validBarValue
|
|
||||||
)
|
|
||||||
|
|
||||||
data AppEvent
|
data AppEvent
|
||||||
= AppInit
|
= AppInit
|
||||||
|
@ -85,20 +71,11 @@ 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
|
||||||
|
@ -131,15 +108,6 @@ 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
|
||||||
|
@ -177,8 +145,6 @@ 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)
|
||||||
]
|
]
|
||||||
|
@ -309,12 +275,7 @@ buildUI wenv model = widgetTree
|
||||||
mainPane =
|
mainPane =
|
||||||
box_ [alignMiddle] $
|
box_ [alignMiddle] $
|
||||||
hstack
|
hstack
|
||||||
[ addressBox
|
[addressBox, txBox `nodeVisible` not (null $ model ^. transactions)]
|
||||||
, vstack
|
|
||||||
[ mainButton "Send" ShowSend
|
|
||||||
, txBox `nodeVisible` not (null $ model ^. transactions)
|
|
||||||
]
|
|
||||||
]
|
|
||||||
balanceBox =
|
balanceBox =
|
||||||
hstack
|
hstack
|
||||||
[ filler
|
[ filler
|
||||||
|
@ -495,8 +456,6 @@ 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`
|
||||||
|
@ -530,73 +489,6 @@ 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
|
||||||
|
@ -710,31 +602,6 @@ 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
|
||||||
|
@ -812,14 +679,10 @@ handleEvent ::
|
||||||
-> [AppEventResponse AppModel AppEvent]
|
-> [AppEventResponse AppModel AppEvent]
|
||||||
handleEvent wenv node model evt =
|
handleEvent wenv node model evt =
|
||||||
case evt of
|
case evt of
|
||||||
AppInit ->
|
AppInit -> [Event NewWallet | isNothing currentWallet]
|
||||||
[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 $ model & msg ?~ t & menuPopup .~ False & inError .~ True]
|
||||||
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]
|
||||||
|
@ -857,30 +720,6 @@ 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
|
||||||
|
@ -978,55 +817,12 @@ 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
|
then [Model $ model & wallets .~ a, Event $ SwitchWal 0]
|
||||||
, 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)
|
||||||
|
@ -1115,100 +911,6 @@ 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
|
||||||
|
|
||||||
|
@ -1280,15 +982,6 @@ 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
|
||||||
|
@ -1325,15 +1018,6 @@ 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 =
|
||||||
|
|
|
@ -64,12 +64,6 @@ 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 &
|
||||||
|
@ -84,36 +78,6 @@ 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
|
||||||
|
|
|
@ -5,24 +5,14 @@ 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 (decodeSaplingAddress, isValidShieldedAddress)
|
import ZcashHaskell.Sapling (isValidShieldedAddress)
|
||||||
import ZcashHaskell.Transparent
|
import ZcashHaskell.Types (ZcashNet(..))
|
||||||
( decodeExchangeAddress
|
|
||||||
, decodeTransparentAddress
|
|
||||||
)
|
|
||||||
import ZcashHaskell.Types
|
|
||||||
( SaplingAddress(..)
|
|
||||||
, TransparentAddress(..)
|
|
||||||
, UnifiedAddress(..)
|
|
||||||
, ZcashNet(..)
|
|
||||||
)
|
|
||||||
import Zenith.Types
|
import Zenith.Types
|
||||||
( AddressGroup(..)
|
( AddressGroup(..)
|
||||||
, UnifiedAddressDB(..)
|
, UnifiedAddressDB(..)
|
||||||
|
@ -89,34 +79,3 @@ 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
|
|
||||||
|
|
Loading…
Reference in a new issue