Compare commits
No commits in common. "45b96516418cc1c4b6d7c7e08c6e15b7b530bfb2" and "f23c222edcfce55a199a860cdb221e1b3edfe0fd" have entirely different histories.
45b9651641
...
f23c222edc
5 changed files with 173 additions and 421 deletions
|
@ -878,6 +878,7 @@ scanZebra dbP zHost zPort b eChan znet = do
|
||||||
liftIO $ BC.writeBChan eChan $ TickMsg "startSync"
|
liftIO $ BC.writeBChan eChan $ TickMsg "startSync"
|
||||||
return ()
|
return ()
|
||||||
else do
|
else do
|
||||||
|
liftIO $ BC.writeBChan eChan $ TickVal 1.0
|
||||||
liftIO $ BC.writeBChan eChan $ TickMsg "startSync"
|
liftIO $ BC.writeBChan eChan $ TickMsg "startSync"
|
||||||
where
|
where
|
||||||
processBlock :: ConnectionPool -> Float -> Int -> IO ()
|
processBlock :: ConnectionPool -> Float -> Int -> IO ()
|
||||||
|
@ -927,7 +928,8 @@ appEvent (BT.AppEvent t) = do
|
||||||
case s ^. displayBox of
|
case s ^. displayBox of
|
||||||
AddrDisplay -> return ()
|
AddrDisplay -> return ()
|
||||||
MsgDisplay -> do
|
MsgDisplay -> do
|
||||||
when (m == "startSync") $ do
|
if m == "startSync"
|
||||||
|
then do
|
||||||
selWallet <-
|
selWallet <-
|
||||||
do case L.listSelectedElement $ s ^. wallets of
|
do case L.listSelectedElement $ s ^. wallets of
|
||||||
Nothing -> do
|
Nothing -> do
|
||||||
|
@ -955,6 +957,7 @@ appEvent (BT.AppEvent t) = do
|
||||||
BT.put ns
|
BT.put ns
|
||||||
BT.modify $ set msg ""
|
BT.modify $ set msg ""
|
||||||
BT.modify $ set displayBox BlankDisplay
|
BT.modify $ set displayBox BlankDisplay
|
||||||
|
else return ()
|
||||||
PhraseDisplay -> return ()
|
PhraseDisplay -> return ()
|
||||||
TxDisplay -> return ()
|
TxDisplay -> return ()
|
||||||
TxIdDisplay -> return ()
|
TxIdDisplay -> return ()
|
||||||
|
|
|
@ -159,7 +159,7 @@ share
|
||||||
script BS.ByteString
|
script BS.ByteString
|
||||||
change Bool
|
change Bool
|
||||||
position Int
|
position Int
|
||||||
UniqueTNote tx accId script
|
UniqueTNote tx script
|
||||||
deriving Show Eq
|
deriving Show Eq
|
||||||
WalletTrSpend
|
WalletTrSpend
|
||||||
tx WalletTransactionId OnDeleteCascade OnUpdateCascade
|
tx WalletTransactionId OnDeleteCascade OnUpdateCascade
|
||||||
|
@ -2828,36 +2828,24 @@ rewindWalletData pool b net = do
|
||||||
(blk ^. ZcashBlockHeight >. val b) &&.
|
(blk ^. ZcashBlockHeight >. val b) &&.
|
||||||
(blk ^. ZcashBlockNetwork ==. val net)
|
(blk ^. ZcashBlockNetwork ==. val net)
|
||||||
logDebugN "Completed data store rewind"
|
logDebugN "Completed data store rewind"
|
||||||
{-
|
|
||||||
-_ <- liftIO $ clearTrees pool
|
|
||||||
-logDebugN "Cleared commitment trees"
|
|
||||||
-}
|
|
||||||
saplingOutputIx <- liftIO $ getSaplingOutputAtBlock pool net b
|
saplingOutputIx <- liftIO $ getSaplingOutputAtBlock pool net b
|
||||||
orchardActionIx <- liftIO $ getOrchardActionAtBlock pool net b
|
orchardActionIx <- liftIO $ getOrchardActionAtBlock pool net b
|
||||||
case saplingOutputIx of
|
case saplingOutputIx of
|
||||||
Nothing -> logErrorN "Couldn't get Sapling output index for tree rewind"
|
Nothing -> logErrorN "Couldn't get Sapling output index for tree rewind"
|
||||||
Just soIx -> do
|
Just soIx -> do
|
||||||
saplingTree <- liftIO $ getSaplingTree pool
|
saplingTree <- liftIO $ getSaplingTree pool
|
||||||
truncSapTree <- truncateTree (maybe InvalidTree fst saplingTree) soIx
|
let truncSapTree = truncateTree (maybe InvalidTree fst saplingTree) soIx
|
||||||
_ <- liftIO $ upsertSaplingTree pool b truncSapTree
|
_ <- liftIO $ upsertSaplingTree pool b truncSapTree
|
||||||
logDebugN $ "Truncated Sapling tree at index " <> T.pack (show soIx)
|
logDebugN $ "Truncated Sapling tree at index " <> T.pack (show soIx)
|
||||||
case orchardActionIx of
|
case orchardActionIx of
|
||||||
Nothing -> logErrorN "Couldn't get Orchard action index for tree rewind"
|
Nothing -> logErrorN "Couldn't get Orchard action index for tree rewind"
|
||||||
Just oaIx -> do
|
Just oaIx -> do
|
||||||
orchardTree <- liftIO $ getOrchardTree pool
|
orchardTree <- liftIO $ getOrchardTree pool
|
||||||
truncOrchTree <- truncateTree (maybe InvalidTree fst orchardTree) oaIx
|
let truncOrchTree =
|
||||||
|
truncateTree (maybe InvalidTree fst orchardTree) oaIx
|
||||||
_ <- liftIO $ upsertOrchardTree pool b truncOrchTree
|
_ <- liftIO $ upsertOrchardTree pool b truncOrchTree
|
||||||
logDebugN $ "Truncated Orchard tree at index " <> T.pack (show oaIx)
|
logDebugN $ "Truncated Orchard tree at index " <> T.pack (show oaIx)
|
||||||
|
|
||||||
clearTrees :: ConnectionPool -> IO ()
|
|
||||||
clearTrees pool =
|
|
||||||
runNoLoggingT $
|
|
||||||
PS.retryOnBusy $
|
|
||||||
flip PS.runSqlPool pool $ do
|
|
||||||
delete $ do
|
|
||||||
tr <- from $ table @TreeStore
|
|
||||||
return ()
|
|
||||||
|
|
||||||
getSaplingOutputAtBlock ::
|
getSaplingOutputAtBlock ::
|
||||||
ConnectionPool -> ZcashNetDB -> Int -> IO (Maybe Int64)
|
ConnectionPool -> ZcashNetDB -> Int -> IO (Maybe Int64)
|
||||||
getSaplingOutputAtBlock pool znet b = do
|
getSaplingOutputAtBlock pool znet b = do
|
||||||
|
@ -2875,7 +2863,10 @@ getSaplingOutputAtBlock pool znet b = do
|
||||||
txs ^. ZcashTransactionId ==. sOutputs ^. ShieldOutputTx)
|
txs ^. ZcashTransactionId ==. sOutputs ^. ShieldOutputTx)
|
||||||
where_ (blks ^. ZcashBlockHeight <=. val b)
|
where_ (blks ^. ZcashBlockHeight <=. val b)
|
||||||
where_ (blks ^. ZcashBlockNetwork ==. val znet)
|
where_ (blks ^. ZcashBlockNetwork ==. val znet)
|
||||||
orderBy [desc $ sOutputs ^. ShieldOutputId]
|
orderBy
|
||||||
|
[ desc $ txs ^. ZcashTransactionId
|
||||||
|
, desc $ sOutputs ^. ShieldOutputPosition
|
||||||
|
]
|
||||||
return sOutputs
|
return sOutputs
|
||||||
case r of
|
case r of
|
||||||
Nothing -> return Nothing
|
Nothing -> return Nothing
|
||||||
|
@ -2898,7 +2889,10 @@ getOrchardActionAtBlock pool znet b = do
|
||||||
txs ^. ZcashTransactionId ==. oActions ^. OrchActionTx)
|
txs ^. ZcashTransactionId ==. oActions ^. OrchActionTx)
|
||||||
where_ (blks ^. ZcashBlockHeight <=. val b)
|
where_ (blks ^. ZcashBlockHeight <=. val b)
|
||||||
where_ (blks ^. ZcashBlockNetwork ==. val znet)
|
where_ (blks ^. ZcashBlockNetwork ==. val znet)
|
||||||
orderBy [desc $ oActions ^. OrchActionId]
|
orderBy
|
||||||
|
[ desc $ txs ^. ZcashTransactionId
|
||||||
|
, desc $ oActions ^. OrchActionPosition
|
||||||
|
]
|
||||||
return oActions
|
return oActions
|
||||||
case r of
|
case r of
|
||||||
Nothing -> return Nothing
|
Nothing -> return Nothing
|
||||||
|
|
|
@ -1,7 +1,6 @@
|
||||||
{-# LANGUAGE TemplateHaskell #-}
|
{-# LANGUAGE TemplateHaskell #-}
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
{-# LANGUAGE BlockArguments #-}
|
{-# LANGUAGE BlockArguments #-}
|
||||||
{-# LANGUAGE LambdaCase #-}
|
|
||||||
|
|
||||||
module Zenith.GUI where
|
module Zenith.GUI where
|
||||||
|
|
||||||
|
@ -11,14 +10,9 @@ import Codec.QRCode
|
||||||
import Codec.QRCode.JuicyPixels
|
import Codec.QRCode.JuicyPixels
|
||||||
import Control.Concurrent (threadDelay)
|
import Control.Concurrent (threadDelay)
|
||||||
import Control.Exception (throwIO, try)
|
import Control.Exception (throwIO, try)
|
||||||
import Control.Monad (forM_, unless, when)
|
import Control.Monad (unless, when)
|
||||||
import Control.Monad.IO.Class (liftIO)
|
import Control.Monad.IO.Class (liftIO)
|
||||||
import Control.Monad.Logger
|
import Control.Monad.Logger (runNoLoggingT, runStderrLoggingT)
|
||||||
( LoggingT
|
|
||||||
, logDebugN
|
|
||||||
, runNoLoggingT
|
|
||||||
, runStderrLoggingT
|
|
||||||
)
|
|
||||||
import Data.Aeson
|
import Data.Aeson
|
||||||
import qualified Data.ByteString as BS
|
import qualified Data.ByteString as BS
|
||||||
import Data.HexString (toText)
|
import Data.HexString (toText)
|
||||||
|
@ -44,16 +38,12 @@ import ZcashHaskell.Orchard
|
||||||
, isValidUnifiedAddress
|
, isValidUnifiedAddress
|
||||||
, parseAddress
|
, parseAddress
|
||||||
)
|
)
|
||||||
import ZcashHaskell.Transparent
|
import ZcashHaskell.Transparent (encodeTransparentReceiver)
|
||||||
( decodeTransparentAddress
|
|
||||||
, encodeTransparentReceiver
|
|
||||||
)
|
|
||||||
import ZcashHaskell.Types
|
import ZcashHaskell.Types
|
||||||
( BlockResponse(..)
|
( BlockResponse(..)
|
||||||
, Scope(..)
|
, Scope(..)
|
||||||
, ToBytes(..)
|
, ToBytes(..)
|
||||||
, UnifiedAddress(..)
|
, UnifiedAddress(..)
|
||||||
, ValidAddress(..)
|
|
||||||
, ZcashNet(..)
|
, ZcashNet(..)
|
||||||
, ZebraGetBlockChainInfo(..)
|
, ZebraGetBlockChainInfo(..)
|
||||||
, ZebraGetInfo(..)
|
, ZebraGetInfo(..)
|
||||||
|
@ -66,7 +56,6 @@ import Zenith.Scanner (checkIntegrity, processTx, rescanZebra, updateConfs)
|
||||||
import Zenith.Types hiding (ZcashAddress(..))
|
import Zenith.Types hiding (ZcashAddress(..))
|
||||||
import Zenith.Utils
|
import Zenith.Utils
|
||||||
( displayAmount
|
( displayAmount
|
||||||
, getChainTip
|
|
||||||
, isRecipientValidGUI
|
, isRecipientValidGUI
|
||||||
, isValidString
|
, isValidString
|
||||||
, isZecAddressValid
|
, isZecAddressValid
|
||||||
|
@ -94,7 +83,7 @@ data AppEvent
|
||||||
| SwitchAddr !Int
|
| SwitchAddr !Int
|
||||||
| SwitchAcc !Int
|
| SwitchAcc !Int
|
||||||
| SwitchWal !Int
|
| SwitchWal !Int
|
||||||
| UpdateBalance !(Integer, Integer, Integer, Integer)
|
| UpdateBalance !(Integer, Integer)
|
||||||
| CopyAddr !(Maybe (Entity WalletAddress))
|
| CopyAddr !(Maybe (Entity WalletAddress))
|
||||||
| LoadTxs ![Entity UserTx]
|
| LoadTxs ![Entity UserTx]
|
||||||
| LoadAddrs ![Entity WalletAddress]
|
| LoadAddrs ![Entity WalletAddress]
|
||||||
|
@ -142,10 +131,6 @@ data AppEvent
|
||||||
| CloseShield
|
| CloseShield
|
||||||
| ShowDeShield
|
| ShowDeShield
|
||||||
| CloseDeShield
|
| CloseDeShield
|
||||||
| SendDeShield
|
|
||||||
| SendShield
|
|
||||||
| StartSync
|
|
||||||
| TreeSync
|
|
||||||
deriving (Eq, Show)
|
deriving (Eq, Show)
|
||||||
|
|
||||||
data AppModel = AppModel
|
data AppModel = AppModel
|
||||||
|
@ -756,7 +741,7 @@ buildUI wenv model = widgetTree
|
||||||
box
|
box
|
||||||
(label (fromMaybe "?" $ model ^. modalMsg) `styleBasic`
|
(label (fromMaybe "?" $ model ^. modalMsg) `styleBasic`
|
||||||
[textSize 12, textFont "Bold"]) `styleBasic`
|
[textSize 12, textFont "Bold"]) `styleBasic`
|
||||||
[bgColor (white & L.a .~ 0.7)]
|
[bgColor (white & L.a .~ 0.5)]
|
||||||
txOverlay =
|
txOverlay =
|
||||||
case model ^. showTx of
|
case model ^. showTx of
|
||||||
Nothing -> alert CloseTx $ label "N/A"
|
Nothing -> alert CloseTx $ label "N/A"
|
||||||
|
@ -1005,17 +990,21 @@ buildUI wenv model = widgetTree
|
||||||
[textFont "Bold", textSize 12])
|
[textFont "Bold", textSize 12])
|
||||||
, separatorLine `styleBasic` [fgColor btnColor]
|
, separatorLine `styleBasic` [fgColor btnColor]
|
||||||
, spacer
|
, spacer
|
||||||
, label
|
, hstack
|
||||||
("Shield " <>
|
[ filler
|
||||||
displayAmount (model ^. network) (model ^. tBalance) <>
|
, label ("Amount : ") `styleBasic`
|
||||||
"?") `styleBasic`
|
[width 50, textFont "Bold"]
|
||||||
[width 50, textFont "Regular"]
|
, spacer
|
||||||
|
, label (displayAmount (model ^. network) 100) `styleBasic`
|
||||||
|
[width 50, textFont "Bold"]
|
||||||
|
, filler
|
||||||
|
]
|
||||||
, spacer
|
, spacer
|
||||||
, box_
|
, box_
|
||||||
[alignMiddle]
|
[alignMiddle]
|
||||||
(hstack
|
(hstack
|
||||||
[ filler
|
[ filler
|
||||||
, mainButton "Proceed" SendShield `nodeEnabled`
|
, mainButton "Proceed" NotImplemented `nodeEnabled`
|
||||||
True
|
True
|
||||||
, spacer
|
, spacer
|
||||||
, mainButton "Cancel" CloseShield `nodeEnabled`
|
, mainButton "Cancel" CloseShield `nodeEnabled`
|
||||||
|
@ -1044,25 +1033,16 @@ buildUI wenv model = widgetTree
|
||||||
[textFont "Bold", textSize 12])
|
[textFont "Bold", textSize 12])
|
||||||
, separatorLine `styleBasic` [fgColor btnColor]
|
, separatorLine `styleBasic` [fgColor btnColor]
|
||||||
, spacer
|
, spacer
|
||||||
, box_
|
, hstack
|
||||||
[]
|
[ (label "Total Transparent : " `styleBasic`
|
||||||
(vstack
|
[textFont "Bold"])
|
||||||
[ hstack
|
, (label "0.00")
|
||||||
[ label "Total Transparent : " `styleBasic`
|
|
||||||
[textFont "Bold"]
|
|
||||||
, label
|
|
||||||
(displayAmount
|
|
||||||
(model ^. network)
|
|
||||||
(model ^. tBalance))
|
|
||||||
]
|
]
|
||||||
, spacer
|
, spacer
|
||||||
, hstack
|
, hstack
|
||||||
[ label "Total Shielded : " `styleBasic`
|
[ (label "Total Shielded : " `styleBasic`
|
||||||
[textFont "Bold"]
|
[textFont "Bold"])
|
||||||
, label
|
, (label "0.00")
|
||||||
(displayAmount
|
|
||||||
(model ^. network)
|
|
||||||
(model ^. sBalance))
|
|
||||||
]
|
]
|
||||||
, spacer
|
, spacer
|
||||||
, hstack
|
, hstack
|
||||||
|
@ -1085,13 +1065,12 @@ buildUI wenv model = widgetTree
|
||||||
(textColor red)
|
(textColor red)
|
||||||
]
|
]
|
||||||
]
|
]
|
||||||
])
|
|
||||||
, spacer
|
, spacer
|
||||||
, box_
|
, box_
|
||||||
[alignMiddle]
|
[alignMiddle]
|
||||||
(hstack
|
(hstack
|
||||||
[ filler
|
[ filler
|
||||||
, mainButton "Proceed" SendDeShield `nodeEnabled`
|
, mainButton "Proceed" NotImplemented `nodeEnabled`
|
||||||
True
|
True
|
||||||
, spacer
|
, spacer
|
||||||
, mainButton "Cancel" CloseDeShield `nodeEnabled`
|
, mainButton "Cancel" CloseDeShield `nodeEnabled`
|
||||||
|
@ -1106,6 +1085,23 @@ buildUI wenv model = widgetTree
|
||||||
]) `styleBasic`
|
]) `styleBasic`
|
||||||
[bgColor (white & L.a .~ 0.5)]
|
[bgColor (white & L.a .~ 0.5)]
|
||||||
|
|
||||||
|
-- , spacer
|
||||||
|
-- , numericField_
|
||||||
|
-- sendAmount
|
||||||
|
-- [ decimals 8
|
||||||
|
-- , minValue 0.0
|
||||||
|
-- , maxValue
|
||||||
|
-- (fromIntegral (model ^. tBalance) / 100000000.0)
|
||||||
|
-- , validInput tBalanceValid
|
||||||
|
-- , onChange CheckAmount
|
||||||
|
-- ] `styleBasic`
|
||||||
|
-- [ width 150
|
||||||
|
-- , styleIf
|
||||||
|
-- (not $ model ^. tBalanceValid)
|
||||||
|
-- (textColor red)
|
||||||
|
-- ]
|
||||||
|
-- (model ^. amountValid && model ^. recipientValid)
|
||||||
|
-- (model ^. amountValid && model ^. recipientValid)
|
||||||
notImplemented = NotImplemented
|
notImplemented = NotImplemented
|
||||||
|
|
||||||
generateQRCodes :: Config -> IO ()
|
generateQRCodes :: Config -> IO ()
|
||||||
|
@ -1307,13 +1303,11 @@ handleEvent wenv node model evt =
|
||||||
UpdateBalance <$> do
|
UpdateBalance <$> do
|
||||||
dbPool <- runNoLoggingT $ initPool $ c_dbPath $ model ^. configuration
|
dbPool <- runNoLoggingT $ initPool $ c_dbPath $ model ^. configuration
|
||||||
case selectAccount i of
|
case selectAccount i of
|
||||||
Nothing -> return (0, 0, 0, 0)
|
Nothing -> return (0, 0)
|
||||||
Just acc -> do
|
Just acc -> do
|
||||||
b <- getBalance dbPool $ entityKey acc
|
b <- getBalance dbPool $ entityKey acc
|
||||||
u <- getUnconfirmedBalance dbPool $ entityKey acc
|
u <- getUnconfirmedBalance dbPool $ entityKey acc
|
||||||
s <- getShieldedBalance dbPool $ entityKey acc
|
return (b, u)
|
||||||
t <- getTransparentBalance dbPool $ entityKey acc
|
|
||||||
return (b, u, s, t)
|
|
||||||
, Event $ SetPool OrchardPool
|
, Event $ SetPool OrchardPool
|
||||||
]
|
]
|
||||||
SwitchWal i ->
|
SwitchWal i ->
|
||||||
|
@ -1325,9 +1319,9 @@ handleEvent wenv node model evt =
|
||||||
Nothing -> return []
|
Nothing -> return []
|
||||||
Just wal -> runNoLoggingT $ getAccounts dbPool $ entityKey wal
|
Just wal -> runNoLoggingT $ getAccounts dbPool $ entityKey wal
|
||||||
]
|
]
|
||||||
UpdateBalance (b, u, s, t) ->
|
UpdateBalance (b, u) ->
|
||||||
[ Model $
|
[ Model $
|
||||||
model & balance .~ b & sBalance .~ s & tBalance .~ t & unconfBalance .~
|
model & balance .~ b & unconfBalance .~
|
||||||
(if u == 0
|
(if u == 0
|
||||||
then Nothing
|
then Nothing
|
||||||
else Just u)
|
else Just u)
|
||||||
|
@ -1377,7 +1371,7 @@ 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 & modalMsg .~ Nothing
|
then [ Model $ model & wallets .~ a
|
||||||
, Event $ SwitchWal $ model ^. selWallet
|
, Event $ SwitchWal $ model ^. selWallet
|
||||||
]
|
]
|
||||||
else [Event NewWallet]
|
else [Event NewWallet]
|
||||||
|
@ -1387,15 +1381,11 @@ handleEvent wenv node model evt =
|
||||||
CloseTxId -> [Model $ model & showId .~ Nothing]
|
CloseTxId -> [Model $ model & showId .~ Nothing]
|
||||||
ShowTx i -> [Model $ model & showTx ?~ i]
|
ShowTx i -> [Model $ model & showTx ?~ i]
|
||||||
TickUp ->
|
TickUp ->
|
||||||
if isNothing (model ^. modalMsg)
|
if (model ^. timer) < 90
|
||||||
then if (model ^. timer) < 90
|
|
||||||
then [Model $ model & timer .~ (1 + model ^. timer)]
|
then [Model $ model & timer .~ (1 + model ^. timer)]
|
||||||
else if (model ^. barValue) == 1.0
|
else if (model ^. barValue) == 1.0
|
||||||
then [ Model $
|
then [ Model $ model & timer .~ 0 & barValue .~ 0.0
|
||||||
model & timer .~ 0 & barValue .~ 0.0 & modalMsg ?~
|
|
||||||
"Downloading blocks..."
|
|
||||||
, Producer $
|
, Producer $
|
||||||
runStderrLoggingT .
|
|
||||||
scanZebra
|
scanZebra
|
||||||
(c_dbPath $ model ^. configuration)
|
(c_dbPath $ model ^. configuration)
|
||||||
(c_zebraHost $ model ^. configuration)
|
(c_zebraHost $ model ^. configuration)
|
||||||
|
@ -1403,23 +1393,20 @@ handleEvent wenv node model evt =
|
||||||
(model ^. network)
|
(model ^. network)
|
||||||
]
|
]
|
||||||
else [Model $ model & timer .~ 0]
|
else [Model $ model & timer .~ 0]
|
||||||
else [Model $ model & timer .~ 0]
|
SyncVal i ->
|
||||||
TreeSync -> [Model $ model & modalMsg ?~ "Updating commitment trees..."]
|
if (i + model ^. barValue) >= 0.999
|
||||||
StartSync ->
|
then [ Model $ model & barValue .~ 1.0 & modalMsg .~ Nothing
|
||||||
[ Model $ model & modalMsg ?~ "Updating wallet..."
|
|
||||||
, Task $ do
|
, Task $ do
|
||||||
case currentWallet of
|
case currentWallet of
|
||||||
Nothing -> return $ ShowError "No wallet available"
|
Nothing -> return $ ShowError "No wallet available"
|
||||||
Just cW -> do
|
Just cW -> do
|
||||||
runStderrLoggingT $ syncWallet (model ^. configuration) cW
|
runStderrLoggingT $ syncWallet (model ^. configuration) cW
|
||||||
pool <-
|
pool <-
|
||||||
runNoLoggingT $ initPool $ c_dbPath $ model ^. configuration
|
runNoLoggingT $
|
||||||
|
initPool $ c_dbPath $ model ^. configuration
|
||||||
wL <- getWallets pool (model ^. network)
|
wL <- getWallets pool (model ^. network)
|
||||||
return $ LoadWallets wL
|
return $ LoadWallets wL
|
||||||
]
|
]
|
||||||
SyncVal i ->
|
|
||||||
if (i + model ^. barValue) >= 0.999
|
|
||||||
then [Model $ model & barValue .~ 1.0 & modalMsg .~ Nothing]
|
|
||||||
else [ Model $
|
else [ Model $
|
||||||
model & barValue .~ validBarValue (i + model ^. barValue) &
|
model & barValue .~ validBarValue (i + model ^. barValue) &
|
||||||
modalMsg ?~
|
modalMsg ?~
|
||||||
|
@ -1504,10 +1491,7 @@ handleEvent wenv node model evt =
|
||||||
model & msgAB ?~ "Function not implemented..." & menuPopup .~ False
|
model & msgAB ?~ "Function not implemented..." & menuPopup .~ False
|
||||||
]
|
]
|
||||||
CloseMsgAB -> [Model $ model & msgAB .~ Nothing & inError .~ False]
|
CloseMsgAB -> [Model $ model & msgAB .~ Nothing & inError .~ False]
|
||||||
ShowShield ->
|
ShowShield -> [Model $ model & shieldZec .~ True & menuPopup .~ False]
|
||||||
if model ^. tBalance > 0
|
|
||||||
then [Model $ model & shieldZec .~ True & menuPopup .~ False]
|
|
||||||
else [Event $ ShowError "No transparent funds in this account"]
|
|
||||||
CloseShield -> [Model $ model & shieldZec .~ False]
|
CloseShield -> [Model $ model & shieldZec .~ False]
|
||||||
ShowDeShield -> [Model $ model & deShieldZec .~ True & menuPopup .~ False]
|
ShowDeShield -> [Model $ model & deShieldZec .~ True & menuPopup .~ False]
|
||||||
CloseDeShield -> [Model $ model & deShieldZec .~ False]
|
CloseDeShield -> [Model $ model & deShieldZec .~ False]
|
||||||
|
@ -1523,31 +1507,6 @@ handleEvent wenv node model evt =
|
||||||
abList <- getAdrBook dbPool $ model ^. network
|
abList <- getAdrBook dbPool $ model ^. network
|
||||||
return $ LoadAbList abList
|
return $ LoadAbList abList
|
||||||
]
|
]
|
||||||
SendDeShield ->
|
|
||||||
case currentAccount of
|
|
||||||
Nothing ->
|
|
||||||
[Event $ ShowError "No account available", Event CloseDeShield]
|
|
||||||
Just acc ->
|
|
||||||
[ Producer $
|
|
||||||
deshieldTransaction
|
|
||||||
(model ^. configuration)
|
|
||||||
(model ^. network)
|
|
||||||
(entityKey acc)
|
|
||||||
currentAddress
|
|
||||||
(fromFloatDigits $ model ^. sendAmount)
|
|
||||||
, Event CloseDeShield
|
|
||||||
]
|
|
||||||
SendShield ->
|
|
||||||
case currentAccount of
|
|
||||||
Nothing -> [Event $ ShowError "No account available", Event CloseShield]
|
|
||||||
Just acc ->
|
|
||||||
[ Producer $
|
|
||||||
shieldTransaction
|
|
||||||
(model ^. configuration)
|
|
||||||
(model ^. network)
|
|
||||||
(entityKey acc)
|
|
||||||
, Event CloseShield
|
|
||||||
]
|
|
||||||
where
|
where
|
||||||
currentWallet =
|
currentWallet =
|
||||||
if null (model ^. wallets)
|
if null (model ^. wallets)
|
||||||
|
@ -1662,57 +1621,43 @@ handleEvent wenv node model evt =
|
||||||
res <- liftIO $ updateAdrsInAdrBook pool d a a
|
res <- liftIO $ updateAdrsInAdrBook pool d a a
|
||||||
return $ ShowMessage "Address Book entry updated!!"
|
return $ ShowMessage "Address Book entry updated!!"
|
||||||
|
|
||||||
scanZebra ::
|
scanZebra :: T.Text -> T.Text -> Int -> ZcashNet -> (AppEvent -> IO ()) -> IO ()
|
||||||
T.Text
|
|
||||||
-> T.Text
|
|
||||||
-> Int
|
|
||||||
-> ZcashNet
|
|
||||||
-> (AppEvent -> IO ())
|
|
||||||
-> LoggingT IO ()
|
|
||||||
scanZebra dbPath zHost zPort net sendMsg = do
|
scanZebra dbPath zHost zPort net sendMsg = do
|
||||||
bStatus <- liftIO $ checkBlockChain zHost zPort
|
bStatus <- liftIO $ checkBlockChain zHost zPort
|
||||||
pool <- liftIO $ runNoLoggingT $ initPool dbPath
|
pool <- runNoLoggingT $ initPool dbPath
|
||||||
b <- liftIO $ getMinBirthdayHeight pool $ ZcashNetDB net
|
b <- liftIO $ getMinBirthdayHeight pool $ ZcashNetDB net
|
||||||
dbBlock <- liftIO $ getMaxBlock pool $ ZcashNetDB net
|
dbBlock <- getMaxBlock pool $ ZcashNetDB net
|
||||||
chkBlock <- liftIO $ checkIntegrity dbPath zHost zPort net dbBlock 1
|
chkBlock <- checkIntegrity dbPath zHost zPort net dbBlock 1
|
||||||
logDebugN $ "dbBlock: " <> T.pack (show dbBlock)
|
syncChk <- isSyncing pool
|
||||||
logDebugN $ "chkBlock: " <> T.pack (show chkBlock)
|
|
||||||
syncChk <- liftIO $ isSyncing pool
|
|
||||||
if syncChk
|
if syncChk
|
||||||
then liftIO $ sendMsg (ShowError "Sync already in progress")
|
then sendMsg (ShowError "Sync already in progress")
|
||||||
else do
|
else do
|
||||||
let sb =
|
let sb =
|
||||||
if chkBlock == dbBlock
|
if chkBlock == dbBlock
|
||||||
then max dbBlock b
|
then max dbBlock b
|
||||||
else max chkBlock b
|
else max chkBlock b
|
||||||
unless (chkBlock == dbBlock || chkBlock == 1) $
|
unless (chkBlock == dbBlock || chkBlock == 1) $
|
||||||
rewindWalletData pool sb $ ZcashNetDB net
|
runStderrLoggingT $ rewindWalletData pool sb $ ZcashNetDB net
|
||||||
if sb > zgb_blocks bStatus || sb < 1
|
if sb > zgb_blocks bStatus || sb < 1
|
||||||
then liftIO $ sendMsg (ShowError "Invalid starting block for scan")
|
then sendMsg (ShowError "Invalid starting block for scan")
|
||||||
else do
|
else do
|
||||||
let bList = [(sb + 1) .. (zgb_blocks bStatus)]
|
let bList = [(sb + 1) .. (zgb_blocks bStatus)]
|
||||||
if not (null bList)
|
if not (null bList)
|
||||||
then do
|
then do
|
||||||
let step = (1.0 :: Float) / fromIntegral (length bList)
|
let step = (1.0 :: Float) / fromIntegral (length bList)
|
||||||
_ <- liftIO $ startSync pool
|
_ <- startSync pool
|
||||||
mapM_ (liftIO . processBlock pool step) bList
|
mapM_ (processBlock pool step) bList
|
||||||
confUp <-
|
confUp <-
|
||||||
liftIO $ try $ updateConfs zHost zPort pool :: LoggingT
|
try $ updateConfs zHost zPort pool :: IO (Either IOError ())
|
||||||
IO
|
|
||||||
(Either IOError ())
|
|
||||||
case confUp of
|
case confUp of
|
||||||
Left _e0 -> do
|
Left _e0 -> do
|
||||||
_ <- liftIO $ completeSync pool Failed
|
_ <- completeSync pool Failed
|
||||||
liftIO $
|
|
||||||
sendMsg
|
sendMsg
|
||||||
(ShowError "Failed to update unconfirmed transactions")
|
(ShowError "Failed to update unconfirmed transactions")
|
||||||
Right _ -> do
|
Right _ -> do
|
||||||
liftIO $ sendMsg TreeSync
|
_ <- completeSync pool Successful
|
||||||
_ <- updateCommitmentTrees pool zHost zPort $ ZcashNetDB net
|
return ()
|
||||||
_ <- liftIO $ completeSync pool Successful
|
else sendMsg (SyncVal 1.0)
|
||||||
logDebugN "Starting wallet sync"
|
|
||||||
liftIO $ sendMsg StartSync
|
|
||||||
else liftIO $ sendMsg (SyncVal 1.0)
|
|
||||||
where
|
where
|
||||||
processBlock :: ConnectionPool -> Float -> Int -> IO ()
|
processBlock :: ConnectionPool -> Float -> Int -> IO ()
|
||||||
processBlock pool step bl = do
|
processBlock pool step bl = do
|
||||||
|
@ -1752,83 +1697,6 @@ scanZebra dbPath zHost zPort net sendMsg = do
|
||||||
mapM_ (processTx zHost zPort bi pool) $ bl_txs blk
|
mapM_ (processTx zHost zPort bi pool) $ bl_txs blk
|
||||||
sendMsg (SyncVal step)
|
sendMsg (SyncVal step)
|
||||||
|
|
||||||
shieldTransaction ::
|
|
||||||
Config -> ZcashNet -> ZcashAccountId -> (AppEvent -> IO ()) -> IO ()
|
|
||||||
shieldTransaction config znet accId sendMsg = do
|
|
||||||
sendMsg $ ShowModal "Shielding funds..."
|
|
||||||
let dbPath = c_dbPath config
|
|
||||||
let zHost = c_zebraHost config
|
|
||||||
let zPort = c_zebraPort config
|
|
||||||
pool <- runNoLoggingT $ initPool dbPath
|
|
||||||
bl <- getChainTip zHost zPort
|
|
||||||
res <- runNoLoggingT $ shieldTransparentNotes pool zHost zPort znet accId bl
|
|
||||||
forM_ res $ \case
|
|
||||||
Left e -> sendMsg $ ShowError $ T.pack (show e)
|
|
||||||
Right rawTx -> do
|
|
||||||
sendMsg $ ShowMsg "Transaction ready, sending to Zebra..."
|
|
||||||
resp <-
|
|
||||||
makeZebraCall
|
|
||||||
zHost
|
|
||||||
zPort
|
|
||||||
"sendrawtransaction"
|
|
||||||
[Data.Aeson.String $ toText rawTx]
|
|
||||||
case resp of
|
|
||||||
Left e1 -> sendMsg $ ShowError $ "Zebra error: " <> T.pack (show e1)
|
|
||||||
Right txId -> sendMsg $ ShowTxId txId
|
|
||||||
|
|
||||||
deshieldTransaction ::
|
|
||||||
Config
|
|
||||||
-> ZcashNet
|
|
||||||
-> ZcashAccountId
|
|
||||||
-> Maybe (Entity WalletAddress)
|
|
||||||
-> Scientific
|
|
||||||
-> (AppEvent -> IO ())
|
|
||||||
-> IO ()
|
|
||||||
deshieldTransaction config znet accId addR pnote sendMsg = do
|
|
||||||
case addR of
|
|
||||||
Nothing -> sendMsg $ ShowError "No address available"
|
|
||||||
Just addr -> do
|
|
||||||
sendMsg $ ShowModal "De-shielding funds..."
|
|
||||||
let dbPath = c_dbPath config
|
|
||||||
let zHost = c_zebraHost config
|
|
||||||
let zPort = c_zebraPort config
|
|
||||||
pool <- runNoLoggingT $ initPool dbPath
|
|
||||||
bl <- getChainTip zHost zPort
|
|
||||||
let tAddrMaybe =
|
|
||||||
Transparent <$>
|
|
||||||
((decodeTransparentAddress .
|
|
||||||
E.encodeUtf8 . encodeTransparentReceiver znet) =<<
|
|
||||||
(t_rec =<<
|
|
||||||
(isValidUnifiedAddress .
|
|
||||||
E.encodeUtf8 . getUA . walletAddressUAddress)
|
|
||||||
(entityVal addr)))
|
|
||||||
case tAddrMaybe of
|
|
||||||
Nothing -> sendMsg $ ShowError "No transparent address available"
|
|
||||||
Just tAddr -> do
|
|
||||||
res <-
|
|
||||||
runStderrLoggingT $
|
|
||||||
deshieldNotes
|
|
||||||
pool
|
|
||||||
zHost
|
|
||||||
zPort
|
|
||||||
znet
|
|
||||||
accId
|
|
||||||
bl
|
|
||||||
(ProposedNote (ValidAddressAPI tAddr) pnote Nothing)
|
|
||||||
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
|
|
||||||
|
|
||||||
sendTransaction ::
|
sendTransaction ::
|
||||||
Config
|
Config
|
||||||
-> ZcashNet
|
-> ZcashNet
|
||||||
|
@ -1947,14 +1815,6 @@ runZenithGUI config = do
|
||||||
then getUnconfirmedBalance pool $ entityKey $ head accList
|
then getUnconfirmedBalance pool $ entityKey $ head accList
|
||||||
else return 0
|
else return 0
|
||||||
abList <- getAdrBook pool (zgb_net chainInfo)
|
abList <- getAdrBook pool (zgb_net chainInfo)
|
||||||
shieldBal <-
|
|
||||||
if not (null accList)
|
|
||||||
then getShieldedBalance pool $ entityKey $ head accList
|
|
||||||
else return 0
|
|
||||||
transBal <-
|
|
||||||
if not (null accList)
|
|
||||||
then getTransparentBalance pool $ entityKey $ head accList
|
|
||||||
else return 0
|
|
||||||
let model =
|
let model =
|
||||||
AppModel
|
AppModel
|
||||||
config
|
config
|
||||||
|
@ -2014,9 +1874,9 @@ runZenithGUI config = do
|
||||||
Full
|
Full
|
||||||
False
|
False
|
||||||
False
|
False
|
||||||
transBal
|
0
|
||||||
False
|
False
|
||||||
shieldBal
|
0
|
||||||
False
|
False
|
||||||
startApp model handleEvent buildUI (params hD)
|
startApp model handleEvent buildUI (params hD)
|
||||||
Left _e -> print "Zebra not available"
|
Left _e -> print "Zebra not available"
|
||||||
|
|
|
@ -9,11 +9,9 @@
|
||||||
module Zenith.Tree where
|
module Zenith.Tree where
|
||||||
|
|
||||||
import Codec.Borsh
|
import Codec.Borsh
|
||||||
import Control.Monad.Logger (LoggingT, logDebugN)
|
|
||||||
import Data.HexString
|
import Data.HexString
|
||||||
import Data.Int (Int32, Int64, Int8)
|
import Data.Int (Int32, Int64, Int8)
|
||||||
import Data.Maybe (fromJust, isNothing)
|
import Data.Maybe (fromJust, isNothing)
|
||||||
import qualified Data.Text as T
|
|
||||||
import qualified GHC.Generics as GHC
|
import qualified GHC.Generics as GHC
|
||||||
import qualified Generics.SOP as SOP
|
import qualified Generics.SOP as SOP
|
||||||
import ZcashHaskell.Orchard (combineOrchardNodes, getOrchardNodeValue)
|
import ZcashHaskell.Orchard (combineOrchardNodes, getOrchardNodeValue)
|
||||||
|
@ -181,49 +179,14 @@ getNotePosition (Branch _ x y) i
|
||||||
| otherwise = Nothing
|
| otherwise = Nothing
|
||||||
getNotePosition _ _ = Nothing
|
getNotePosition _ _ = Nothing
|
||||||
|
|
||||||
truncateTree :: Monoid v => Node v => Tree v -> Int64 -> LoggingT IO (Tree v)
|
truncateTree :: Monoid v => Node v => Tree v -> Int64 -> Tree v
|
||||||
truncateTree (Branch s x y) i
|
truncateTree (Branch s x y) i
|
||||||
| getLevel s == 1 && getIndex (value x) == i = do
|
| getLevel s == 1 && getIndex (value x) == i = branch x EmptyLeaf
|
||||||
logDebugN $ T.pack $ show (getLevel s) ++ " Trunc to left leaf"
|
| getLevel s == 1 && getIndex (value y) == i = branch x y
|
||||||
return $ branch x EmptyLeaf
|
| getIndex (value x) >= i =
|
||||||
| getLevel s == 1 && getIndex (value y) == i = do
|
branch (truncateTree x i) (getEmptyRoot (getLevel s))
|
||||||
logDebugN $ T.pack $ show (getLevel s) ++ " Trunc to right leaf"
|
| getIndex (value y) >= i = branch x (truncateTree y i)
|
||||||
return $ branch x y
|
truncateTree x _ = x
|
||||||
| getIndex (value x) >= i = do
|
|
||||||
logDebugN $
|
|
||||||
T.pack $
|
|
||||||
show (getLevel s) ++
|
|
||||||
": " ++ show i ++ " left i: " ++ show (getIndex (value x))
|
|
||||||
l <- truncateTree x i
|
|
||||||
return $ branch (l) (getEmptyRoot (getLevel (value x)))
|
|
||||||
| getIndex (value y) /= 0 && getIndex (value y) >= i = do
|
|
||||||
logDebugN $
|
|
||||||
T.pack $
|
|
||||||
show (getLevel s) ++
|
|
||||||
": " ++ show i ++ " right i: " ++ show (getIndex (value y))
|
|
||||||
r <- truncateTree y i
|
|
||||||
return $ branch x (r)
|
|
||||||
| otherwise = do
|
|
||||||
logDebugN $
|
|
||||||
T.pack $
|
|
||||||
show (getLevel s) ++
|
|
||||||
": " ++
|
|
||||||
show (getIndex (value x)) ++ " catchall " ++ show (getIndex (value y))
|
|
||||||
return InvalidTree
|
|
||||||
truncateTree x _ = return x
|
|
||||||
|
|
||||||
countLeaves :: Node v => Tree v -> Int64
|
|
||||||
countLeaves (Branch s x y) =
|
|
||||||
if isFull s
|
|
||||||
then 2 ^ getLevel s
|
|
||||||
else countLeaves x + countLeaves y
|
|
||||||
countLeaves (PrunedBranch x) =
|
|
||||||
if isFull x
|
|
||||||
then 2 ^ getLevel x
|
|
||||||
else 0
|
|
||||||
countLeaves (Leaf _) = 1
|
|
||||||
countLeaves EmptyLeaf = 0
|
|
||||||
countLeaves InvalidTree = 0
|
|
||||||
|
|
||||||
data SaplingNode = SaplingNode
|
data SaplingNode = SaplingNode
|
||||||
{ sn_position :: !Position
|
{ sn_position :: !Position
|
||||||
|
|
86
test/Spec.hs
86
test/Spec.hs
|
@ -42,7 +42,6 @@ import ZcashHaskell.Sapling
|
||||||
import ZcashHaskell.Transparent
|
import ZcashHaskell.Transparent
|
||||||
( decodeExchangeAddress
|
( decodeExchangeAddress
|
||||||
, decodeTransparentAddress
|
, decodeTransparentAddress
|
||||||
, encodeExchangeAddress
|
|
||||||
)
|
)
|
||||||
import ZcashHaskell.Types
|
import ZcashHaskell.Types
|
||||||
( DecodedNote(..)
|
( DecodedNote(..)
|
||||||
|
@ -60,7 +59,6 @@ import ZcashHaskell.Types
|
||||||
, Scope(..)
|
, Scope(..)
|
||||||
, ShieldedOutput(..)
|
, ShieldedOutput(..)
|
||||||
, TxError(..)
|
, TxError(..)
|
||||||
, UnifiedAddress(..)
|
|
||||||
, ValidAddress(..)
|
, ValidAddress(..)
|
||||||
, ZcashNet(..)
|
, ZcashNet(..)
|
||||||
)
|
)
|
||||||
|
@ -625,76 +623,23 @@ main = do
|
||||||
let updatedTree = foldl append newTree [(cmx1, 4), (cmx2, 5)]
|
let updatedTree = foldl append newTree [(cmx1, 4), (cmx2, 5)]
|
||||||
getNotePosition updatedTree 4 `shouldBe` Just 39734
|
getNotePosition updatedTree 4 `shouldBe` Just 39734
|
||||||
it "Truncate tree" $ do
|
it "Truncate tree" $ do
|
||||||
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
|
|
||||||
maxBlock <- getMaxBlock pool $ ZcashNetDB TestNet
|
|
||||||
dbTree <- getOrchardTree pool
|
|
||||||
case dbTree of
|
|
||||||
Nothing -> assertFailure "failed to get tree from DB"
|
|
||||||
Just (oTree, oSync) -> do
|
|
||||||
let startBlock = oSync - 5
|
|
||||||
zebraTreesIn <-
|
|
||||||
getCommitmentTrees
|
|
||||||
pool
|
|
||||||
"localhost"
|
|
||||||
18232
|
|
||||||
(ZcashNetDB TestNet)
|
|
||||||
startBlock
|
|
||||||
ix <- getOrchardActionAtBlock pool (ZcashNetDB TestNet) startBlock
|
|
||||||
case ix of
|
|
||||||
Nothing -> assertFailure "couldn't find index at block"
|
|
||||||
Just i -> do
|
|
||||||
updatedTree <-
|
|
||||||
runFileLoggingT "test.log" $ truncateTree oTree i
|
|
||||||
let finalAnchor =
|
|
||||||
getOrchardTreeAnchor $
|
|
||||||
OrchardCommitmentTree $ ztiOrchard zebraTreesIn
|
|
||||||
getHash (value updatedTree) `shouldBe` finalAnchor
|
|
||||||
it "Counting leaves in tree" $ do
|
|
||||||
let tree =
|
let tree =
|
||||||
OrchardCommitmentTree $
|
OrchardCommitmentTree $
|
||||||
hexString
|
hexString
|
||||||
"0136a7886d7d73bc1845223165fd9cb0cef02046c707e8f88a7f61564720bd0f3501dca1fbdd7b5ba92a0809af5e85874626ce0db14d0532a48e41dde6f0f81b46011f0001fb48c27bd07e68f27aba47cd6e93fa961e0ef8c63f993963a614e56855d2013c0001ea572db9c5c2d24c7ad9132ae32b27179466bf67a580d59901d13b281d3f530b01c160348f10b9ad893d9731317ebe36ac8665e01c52cbe15a56aa9b72e4e6c41e000001cd7695156de2debdc5b13ea84d32e4e3ac020fb0aa7cd372c57ce765103bd70401746e6bc066a10e7f80a9ff8993dcb25c819edd64f2ca10ac248ef7848d41450500011e6191f91b3fceb62dc881a156e1b9d2e88e09dca25093cf9c4936c8869fb41a013bf8b923e4187754e85175748d9cce4824a6787e4258977b5bfe1ba59012c032000001f3bbdc62260c4fca5c84bf3487246d4542da48eeeec8ec40c1029b6908eef83c00000000000000000000000000000000"
|
"0136a7886d7d73bc1845223165fd9cb0cef02046c707e8f88a7f61564720bd0f3501dca1fbdd7b5ba92a0809af5e85874626ce0db14d0532a48e41dde6f0f81b46011f0001fb48c27bd07e68f27aba47cd6e93fa961e0ef8c63f993963a614e56855d2013c0001ea572db9c5c2d24c7ad9132ae32b27179466bf67a580d59901d13b281d3f530b01c160348f10b9ad893d9731317ebe36ac8665e01c52cbe15a56aa9b72e4e6c41e000001cd7695156de2debdc5b13ea84d32e4e3ac020fb0aa7cd372c57ce765103bd70401746e6bc066a10e7f80a9ff8993dcb25c819edd64f2ca10ac248ef7848d41450500011e6191f91b3fceb62dc881a156e1b9d2e88e09dca25093cf9c4936c8869fb41a013bf8b923e4187754e85175748d9cce4824a6787e4258977b5bfe1ba59012c032000001f3bbdc62260c4fca5c84bf3487246d4542da48eeeec8ec40c1029b6908eef83c00000000000000000000000000000000"
|
||||||
|
let cmx1 =
|
||||||
|
hexString
|
||||||
|
"1712ead46028d4349e234abf59e94e0640fe7a0829e2e2e17e1a931631810400" :: OrchardCommitment
|
||||||
|
let cmx2 =
|
||||||
|
hexString
|
||||||
|
"39f5ad39817fb432fa07c5feb3a957189fbe7662a4b5555ca95093b6d853cf07" :: OrchardCommitment
|
||||||
case getOrchardTreeParts tree of
|
case getOrchardTreeParts tree of
|
||||||
Nothing -> assertFailure "Failed to get tree parts"
|
Nothing -> assertFailure "Failed to get tree parts"
|
||||||
Just t1 -> do
|
Just t1 -> do
|
||||||
let newTree = mkOrchardTree t1
|
let newTree = mkOrchardTree t1
|
||||||
countLeaves newTree `shouldBe`
|
let updatedTree = foldl append newTree [(cmx1, 4), (cmx2, 5)]
|
||||||
fromIntegral (1 + getPosition (value newTree))
|
let truncTree = truncateTree updatedTree 4
|
||||||
it "Validate large load" $ do
|
getIndex (value truncTree) `shouldBe` 4
|
||||||
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
|
|
||||||
maxBlock <- getMaxBlock pool $ ZcashNetDB TestNet
|
|
||||||
let startBlock = maxBlock - 2000
|
|
||||||
zebraTreesIn <-
|
|
||||||
getCommitmentTrees
|
|
||||||
pool
|
|
||||||
"localhost"
|
|
||||||
18232
|
|
||||||
(ZcashNetDB TestNet)
|
|
||||||
startBlock
|
|
||||||
zebraTreesOut <-
|
|
||||||
getCommitmentTrees
|
|
||||||
pool
|
|
||||||
"localhost"
|
|
||||||
18232
|
|
||||||
(ZcashNetDB TestNet)
|
|
||||||
maxBlock
|
|
||||||
case getOrchardTreeParts $
|
|
||||||
OrchardCommitmentTree $ ztiOrchard zebraTreesIn of
|
|
||||||
Nothing -> assertFailure "Failed to get tree parts"
|
|
||||||
Just t1 -> do
|
|
||||||
let newTree = mkOrchardTree t1
|
|
||||||
oAct <- getOrchardActions pool startBlock $ ZcashNetDB TestNet
|
|
||||||
let cmxs =
|
|
||||||
map
|
|
||||||
(\(_, y) ->
|
|
||||||
( getHex $ orchActionCmx $ entityVal y
|
|
||||||
, fromSqlKey $ entityKey y))
|
|
||||||
oAct
|
|
||||||
let updatedTree = foldl' append newTree cmxs
|
|
||||||
let finalAnchor =
|
|
||||||
getOrchardTreeAnchor $
|
|
||||||
OrchardCommitmentTree $ ztiOrchard zebraTreesOut
|
|
||||||
getHash (value updatedTree) `shouldBe` finalAnchor
|
|
||||||
it "Validate tree from DB" $ do
|
it "Validate tree from DB" $ do
|
||||||
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
|
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
|
||||||
dbTree <- getOrchardTree pool
|
dbTree <- getOrchardTree pool
|
||||||
|
@ -712,19 +657,6 @@ main = do
|
||||||
getOrchardTreeAnchor $
|
getOrchardTreeAnchor $
|
||||||
OrchardCommitmentTree $ ztiOrchard zebraTrees
|
OrchardCommitmentTree $ ztiOrchard zebraTrees
|
||||||
getHash (value oTree) `shouldBe` finalAnchor
|
getHash (value oTree) `shouldBe` finalAnchor
|
||||||
describe "TEX address" $ do
|
|
||||||
it "from UA" $ do
|
|
||||||
let addr =
|
|
||||||
parseAddress
|
|
||||||
"utest1fqtne08sdgmae0g0un7j3h6ss9gafguprv0yvkxv4trxxsdxx467pxkkc98cpsyk5r2enwwpn3p5c6aw537wyvlz20hs7vcqc4uhm22yfjnrsm8hy2hjjrscvhk2ac32rzndu94hh28gdl62wqgy3yev7w0gj9lmmz6yasghmle6tllx4yjv9sjt0xml66y9lyxc4rkk6q425nc5gxa"
|
|
||||||
case addr of
|
|
||||||
Nothing -> assertFailure "failed to parse address"
|
|
||||||
Just (Unified ua) ->
|
|
||||||
case (encodeExchangeAddress (ua_net ua) =<< (t_rec ua)) of
|
|
||||||
Nothing -> assertFailure "failed to encode TEX"
|
|
||||||
Just tex ->
|
|
||||||
tex `shouldBe` "textest1jze8c9jxxrpct34tpe4pvquz8nvxsxt6gawqqf"
|
|
||||||
Just _ -> assertFailure "no transparent receiver"
|
|
||||||
describe "Creating Tx" $ do
|
describe "Creating Tx" $ do
|
||||||
describe "Full" $ do
|
describe "Full" $ do
|
||||||
it "To Orchard" $ do
|
it "To Orchard" $ do
|
||||||
|
|
Loading…
Reference in a new issue