feat: enable debugging
This commit is contained in:
parent
f309864671
commit
c0031e91fd
GPG key ID:
65122AD495A7F5B2
8 changed files with 263 additions and 115 deletions
|
|
@ -839,7 +839,7 @@ scanZebra dbP zHost zPort b eChan znet = do
|
|||
logDebugN $
|
||||
"dbBlock: " <>
|
||||
T.pack (show dbBlock) <> " chkBlock: " <> T.pack (show chkBlock)
|
||||
when (chkBlock /= dbBlock) $ liftIO $ rewindWalletData pool chkBlock
|
||||
when (chkBlock /= dbBlock) $ rewindWalletData pool chkBlock
|
||||
let sb =
|
||||
if chkBlock == dbBlock
|
||||
then max dbBlock b
|
||||
|
|
@ -953,7 +953,7 @@ appEvent (BT.AppEvent t) = do
|
|||
Just (_k, w) -> return w
|
||||
_ <-
|
||||
liftIO $
|
||||
runNoLoggingT $
|
||||
runStderrLoggingT $
|
||||
syncWallet
|
||||
(Config
|
||||
(s ^. dbPath)
|
||||
|
|
|
|||
|
|
@ -60,6 +60,7 @@ import ZcashHaskell.Sapling
|
|||
, genSaplingInternalAddress
|
||||
, genSaplingPaymentAddress
|
||||
, genSaplingSpendingKey
|
||||
, getSaplingFrontier
|
||||
, getSaplingNotePosition
|
||||
, getSaplingWitness
|
||||
, updateSaplingCommitmentTree
|
||||
|
|
@ -279,70 +280,86 @@ findSaplingOutputs ::
|
|||
-> Int -- ^ the starting block
|
||||
-> ZcashNetDB -- ^ The network
|
||||
-> Entity ZcashAccount -- ^ The account to use
|
||||
-> IO ()
|
||||
-> LoggingT IO ()
|
||||
findSaplingOutputs config b znet za = do
|
||||
let dbPath = c_dbPath config
|
||||
let zebraHost = c_zebraHost config
|
||||
let zebraPort = c_zebraPort config
|
||||
let zn = getNet znet
|
||||
pool <- runNoLoggingT $ initPool dbPath
|
||||
tList <- getShieldedOutputs pool b znet
|
||||
trees <- getCommitmentTrees zebraHost zebraPort (b - 1)
|
||||
let sT = SaplingCommitmentTree $ ztiSapling trees
|
||||
decryptNotes sT zn pool tList
|
||||
sapNotes <- getWalletSapNotes pool (entityKey za)
|
||||
findSapSpends pool (entityKey za) sapNotes
|
||||
pool <- liftIO $ runNoLoggingT $ initPool dbPath
|
||||
tList <- liftIO $ getShieldedOutputs pool b znet
|
||||
trees <- liftIO $ getCommitmentTrees zebraHost zebraPort (b - 1)
|
||||
logDebugN "getting Sapling frontier"
|
||||
let sT = getSaplingFrontier $ SaplingCommitmentTree $ ztiSapling trees
|
||||
case sT of
|
||||
Nothing ->
|
||||
liftIO $ throwIO $ userError "Failed to read Sapling commitment tree"
|
||||
Just sT' -> do
|
||||
logDebugN "Sapling frontier valid"
|
||||
decryptNotes sT' zn pool tList
|
||||
sapNotes <- liftIO $ getWalletSapNotes pool (entityKey za)
|
||||
liftIO $ findSapSpends pool (entityKey za) sapNotes
|
||||
where
|
||||
sk :: SaplingSpendingKeyDB
|
||||
sk = zcashAccountSapSpendKey $ entityVal za
|
||||
decryptNotes ::
|
||||
SaplingCommitmentTree
|
||||
SaplingFrontier
|
||||
-> ZcashNet
|
||||
-> ConnectionPool
|
||||
-> [(Entity ZcashTransaction, Entity ShieldOutput)]
|
||||
-> IO ()
|
||||
-> LoggingT IO ()
|
||||
decryptNotes _ _ _ [] = return ()
|
||||
decryptNotes st n pool ((zt, o):txs) = do
|
||||
let updatedTree =
|
||||
updateSaplingCommitmentTree
|
||||
st
|
||||
(getHex $ shieldOutputCmu $ entityVal o)
|
||||
logDebugN "updated frontier"
|
||||
case updatedTree of
|
||||
Nothing -> throwIO $ userError "Failed to update commitment tree"
|
||||
Nothing ->
|
||||
liftIO $ throwIO $ userError "Failed to update commitment tree"
|
||||
Just uT -> do
|
||||
let noteWitness = getSaplingWitness uT
|
||||
logDebugN "got witness"
|
||||
let notePos = getSaplingNotePosition <$> noteWitness
|
||||
logDebugN "got position"
|
||||
case notePos of
|
||||
Nothing -> throwIO $ userError "Failed to obtain note position"
|
||||
Nothing ->
|
||||
liftIO $ throwIO $ userError "Failed to obtain note position"
|
||||
Just nP -> do
|
||||
case decodeShOut External n nP o of
|
||||
Nothing -> do
|
||||
logDebugN "couldn't decode external"
|
||||
case decodeShOut Internal n nP o of
|
||||
Nothing -> do
|
||||
logDebugN "couldn't decode internal"
|
||||
decryptNotes uT n pool txs
|
||||
Just dn1 -> do
|
||||
wId <- saveWalletTransaction pool (entityKey za) zt
|
||||
saveWalletSapNote
|
||||
pool
|
||||
wId
|
||||
nP
|
||||
(fromJust noteWitness)
|
||||
True
|
||||
(entityKey za)
|
||||
(entityKey o)
|
||||
dn1
|
||||
wId <-
|
||||
liftIO $ saveWalletTransaction pool (entityKey za) zt
|
||||
liftIO $
|
||||
saveWalletSapNote
|
||||
pool
|
||||
wId
|
||||
nP
|
||||
(fromJust noteWitness)
|
||||
True
|
||||
(entityKey za)
|
||||
(entityKey o)
|
||||
dn1
|
||||
decryptNotes uT n pool txs
|
||||
Just dn0 -> do
|
||||
wId <- saveWalletTransaction pool (entityKey za) zt
|
||||
saveWalletSapNote
|
||||
pool
|
||||
wId
|
||||
nP
|
||||
(fromJust noteWitness)
|
||||
False
|
||||
(entityKey za)
|
||||
(entityKey o)
|
||||
dn0
|
||||
wId <- liftIO $ saveWalletTransaction pool (entityKey za) zt
|
||||
liftIO $
|
||||
saveWalletSapNote
|
||||
pool
|
||||
wId
|
||||
nP
|
||||
(fromJust noteWitness)
|
||||
False
|
||||
(entityKey za)
|
||||
(entityKey o)
|
||||
dn0
|
||||
decryptNotes uT n pool txs
|
||||
decodeShOut ::
|
||||
Scope
|
||||
|
|
@ -926,7 +943,7 @@ prepareTxV2 pool zebraHost zebraPort zn za bh pnotes policy = do
|
|||
oSpends
|
||||
dummy
|
||||
zn
|
||||
(bh + 3)
|
||||
bh
|
||||
False
|
||||
case feeResponse of
|
||||
Left e1 -> return $ Left Fee
|
||||
|
|
@ -985,7 +1002,7 @@ prepareTxV2 pool zebraHost zebraPort zn za bh pnotes policy = do
|
|||
oSpends1
|
||||
outgoing
|
||||
zn
|
||||
(bh + 3)
|
||||
bh
|
||||
True
|
||||
logDebugN $ T.pack $ show tx
|
||||
return tx
|
||||
|
|
@ -1261,14 +1278,14 @@ prepareTxV2 pool zebraHost zebraPort zn za bh pnotes policy = do
|
|||
syncWallet ::
|
||||
Config -- ^ configuration parameters
|
||||
-> Entity ZcashWallet
|
||||
-> NoLoggingT IO ()
|
||||
-> LoggingT IO ()
|
||||
syncWallet config w = do
|
||||
startTime <- liftIO getCurrentTime
|
||||
logDebugN $ T.pack $ show startTime
|
||||
let walletDb = c_dbPath config
|
||||
let znet = zcashWalletNetwork $ entityVal w
|
||||
pool <- liftIO $ runNoLoggingT $ initPool walletDb
|
||||
accs <- liftIO $ runNoLoggingT $ getAccounts pool $ entityKey w
|
||||
logDebugN $ "Accounts: " <> T.pack (show accs)
|
||||
addrs <-
|
||||
concat <$>
|
||||
mapM (liftIO . runNoLoggingT . getAddresses pool . entityKey) accs
|
||||
|
|
@ -1278,7 +1295,7 @@ syncWallet config w = do
|
|||
mapM (liftIO . runNoLoggingT . getInternalAddresses pool . entityKey) accs
|
||||
chainTip <- liftIO $ getMaxBlock pool znet
|
||||
logDebugN $ "chain tip: " <> T.pack (show chainTip)
|
||||
let lastBlock = zcashWalletLastSync $ entityVal w
|
||||
lastBlock <- liftIO $ getLastSyncBlock pool $ entityKey w
|
||||
logDebugN $ "last block: " <> T.pack (show lastBlock)
|
||||
let startBlock =
|
||||
if lastBlock > 0
|
||||
|
|
@ -1287,18 +1304,22 @@ syncWallet config w = do
|
|||
logDebugN $ "start block: " <> T.pack (show startBlock)
|
||||
mapM_ (liftIO . findTransparentNotes pool startBlock znet) addrs
|
||||
mapM_ (liftIO . findTransparentNotes pool startBlock znet) intAddrs
|
||||
logDebugN "processed transparent notes"
|
||||
mapM_ (liftIO . findTransparentSpends pool . entityKey) accs
|
||||
sapNotes <-
|
||||
liftIO $
|
||||
mapM
|
||||
(findSaplingOutputs config startBlock (zcashWalletNetwork $ entityVal w))
|
||||
accs
|
||||
orchNotes <-
|
||||
liftIO $
|
||||
mapM
|
||||
logDebugN "processed transparent spends"
|
||||
mapM_
|
||||
(findSaplingOutputs config startBlock (zcashWalletNetwork $ entityVal w))
|
||||
accs
|
||||
logDebugN "processed sapling outputs"
|
||||
liftIO $
|
||||
mapM_
|
||||
(findOrchardActions config startBlock (zcashWalletNetwork $ entityVal w))
|
||||
accs
|
||||
logDebugN "processed orchard actions"
|
||||
_ <- liftIO $ updateSaplingWitnesses pool
|
||||
logDebugN "updated sapling witnesses"
|
||||
_ <- liftIO $ updateOrchardWitnesses pool
|
||||
logDebugN "updated orchard witnesses"
|
||||
_ <- liftIO $ updateWalletSync pool chainTip (entityKey w)
|
||||
logDebugN "updated wallet lastSync"
|
||||
mapM_ (liftIO . runNoLoggingT . getWalletTransactions pool) addrs
|
||||
|
|
|
|||
151
src/Zenith/DB.hs
151
src/Zenith/DB.hs
|
|
@ -21,7 +21,13 @@ module Zenith.DB where
|
|||
import Control.Exception (SomeException(..), throw, throwIO, try)
|
||||
import Control.Monad (unless, when)
|
||||
import Control.Monad.IO.Class (MonadIO, liftIO)
|
||||
import Control.Monad.Logger (NoLoggingT, runNoLoggingT)
|
||||
import Control.Monad.Logger
|
||||
( LoggingT
|
||||
, NoLoggingT
|
||||
, logDebugN
|
||||
, runNoLoggingT
|
||||
, runStderrLoggingT
|
||||
)
|
||||
import qualified Data.ByteString as BS
|
||||
import Data.HexString
|
||||
import Data.Int
|
||||
|
|
@ -1783,15 +1789,30 @@ getSaplingCmus pool zt = do
|
|||
getMaxSaplingNote :: Pool SqlBackend -> IO ShieldOutputId
|
||||
getMaxSaplingNote pool = do
|
||||
flip PS.runSqlPool pool $ do
|
||||
x <-
|
||||
maxBlock <-
|
||||
selectOne $ do
|
||||
n <- from $ table @ShieldOutput
|
||||
where_ (n ^. ShieldOutputId >. val (toSqlKey 0))
|
||||
orderBy [desc $ n ^. ShieldOutputId]
|
||||
pure (n ^. ShieldOutputId)
|
||||
case x of
|
||||
blks <- from $ table @ZcashBlock
|
||||
where_ $ blks ^. ZcashBlockHeight >. val 0
|
||||
orderBy [desc $ blks ^. ZcashBlockHeight]
|
||||
pure $ blks ^. ZcashBlockHeight
|
||||
case maxBlock of
|
||||
Nothing -> return $ toSqlKey 0
|
||||
Just (Value y) -> return y
|
||||
Just (Value mb) -> do
|
||||
x <-
|
||||
selectOne $ do
|
||||
(blks :& txs :& n) <-
|
||||
from $ table @ZcashBlock `innerJoin` table @ZcashTransaction `on`
|
||||
(\(blks :& txs) ->
|
||||
blks ^. ZcashBlockId ==. txs ^. ZcashTransactionBlockId) `innerJoin`
|
||||
table @ShieldOutput `on`
|
||||
(\(_ :& txs :& n) ->
|
||||
txs ^. ZcashTransactionId ==. n ^. ShieldOutputTx)
|
||||
where_ (blks ^. ZcashBlockHeight <=. val (mb - 5))
|
||||
orderBy [desc $ n ^. ShieldOutputId]
|
||||
pure (n ^. ShieldOutputId)
|
||||
case x of
|
||||
Nothing -> return $ toSqlKey 0
|
||||
Just (Value y) -> return y
|
||||
|
||||
updateSapNoteRecord ::
|
||||
Pool SqlBackend
|
||||
|
|
@ -1836,6 +1857,7 @@ getMaxOrchardNote pool = do
|
|||
selectOne $ do
|
||||
blks <- from $ table @ZcashBlock
|
||||
where_ $ blks ^. ZcashBlockHeight >. val 0
|
||||
orderBy [desc $ blks ^. ZcashBlockHeight]
|
||||
pure $ blks ^. ZcashBlockHeight
|
||||
case maxBlock of
|
||||
Nothing -> return $ toSqlKey 0
|
||||
|
|
@ -2052,22 +2074,22 @@ rewindWalletTransactions pool b = do
|
|||
x <- from $ table @WalletOrchNote
|
||||
where_ $ x ^. WalletOrchNoteTx `in_` valList oldKeys
|
||||
return ()
|
||||
delete $ do
|
||||
x <- from $ table @WalletSapNote
|
||||
where_ $ x ^. WalletSapNoteTx `in_` valList oldKeys
|
||||
return ()
|
||||
delete $ do
|
||||
x <- from $ table @WalletSapSpend
|
||||
where_ $ x ^. WalletSapSpendTx `in_` valList oldKeys
|
||||
return ()
|
||||
delete $ do
|
||||
x <- from $ table @WalletTrNote
|
||||
where_ $ x ^. WalletTrNoteTx `in_` valList oldKeys
|
||||
x <- from $ table @WalletSapNote
|
||||
where_ $ x ^. WalletSapNoteTx `in_` valList oldKeys
|
||||
return ()
|
||||
delete $ do
|
||||
x <- from $ table @WalletTrSpend
|
||||
where_ $ x ^. WalletTrSpendTx `in_` valList oldKeys
|
||||
return ()
|
||||
delete $ do
|
||||
x <- from $ table @WalletTrNote
|
||||
where_ $ x ^. WalletTrNoteTx `in_` valList oldKeys
|
||||
return ()
|
||||
delete $ do
|
||||
txs <- from $ table @WalletTransaction
|
||||
where_ $ txs ^. WalletTransactionBlock >. val b
|
||||
|
|
@ -2621,10 +2643,14 @@ completeSync pool st = do
|
|||
return ()
|
||||
|
||||
-- | Rewind the data store to a given block height
|
||||
rewindWalletData :: ConnectionPool -> Int -> IO ()
|
||||
rewindWalletData :: ConnectionPool -> Int -> LoggingT IO ()
|
||||
rewindWalletData pool b = do
|
||||
rewindWalletTransactions pool b
|
||||
runNoLoggingT $
|
||||
logDebugN "Starting transaction rewind"
|
||||
liftIO $ clearWalletTransactions pool
|
||||
logDebugN "Completed transaction rewind"
|
||||
logDebugN "Starting data store rewind"
|
||||
_ <-
|
||||
runStderrLoggingT $
|
||||
PS.retryOnBusy $
|
||||
flip PS.runSqlPool pool $ do
|
||||
oldBlocks <-
|
||||
|
|
@ -2642,21 +2668,112 @@ rewindWalletData pool b = do
|
|||
delete $ do
|
||||
x <- from $ table @TransparentNote
|
||||
where_ $ x ^. TransparentNoteTx `in_` valList oldTxKeys
|
||||
logDebugN "Completed TransparentNote delete"
|
||||
_ <-
|
||||
runStderrLoggingT $
|
||||
PS.retryOnBusy $
|
||||
flip PS.runSqlPool pool $ do
|
||||
oldBlocks <-
|
||||
select $ do
|
||||
blk <- from $ table @ZcashBlock
|
||||
where_ $ blk ^. ZcashBlockHeight >. val b
|
||||
pure blk
|
||||
let oldBlkKeys = map entityKey oldBlocks
|
||||
oldTxs <-
|
||||
select $ do
|
||||
txs <- from $ table @ZcashTransaction
|
||||
where_ $ txs ^. ZcashTransactionBlockId `in_` valList oldBlkKeys
|
||||
pure txs
|
||||
let oldTxKeys = map entityKey oldTxs
|
||||
delete $ do
|
||||
x <- from $ table @TransparentSpend
|
||||
where_ $ x ^. TransparentSpendTx `in_` valList oldTxKeys
|
||||
logDebugN "Completed TransparentSpend delete"
|
||||
_ <-
|
||||
runStderrLoggingT $
|
||||
PS.retryOnBusy $
|
||||
flip PS.runSqlPool pool $ do
|
||||
oldBlocks <-
|
||||
select $ do
|
||||
blk <- from $ table @ZcashBlock
|
||||
where_ $ blk ^. ZcashBlockHeight >. val b
|
||||
pure blk
|
||||
let oldBlkKeys = map entityKey oldBlocks
|
||||
oldTxs <-
|
||||
select $ do
|
||||
txs <- from $ table @ZcashTransaction
|
||||
where_ $ txs ^. ZcashTransactionBlockId `in_` valList oldBlkKeys
|
||||
pure txs
|
||||
let oldTxKeys = map entityKey oldTxs
|
||||
delete $ do
|
||||
x <- from $ table @ShieldOutput
|
||||
where_ $ x ^. ShieldOutputTx `in_` valList oldTxKeys
|
||||
logDebugN "Completed ShieldOutput delete"
|
||||
_ <-
|
||||
runStderrLoggingT $
|
||||
PS.retryOnBusy $
|
||||
flip PS.runSqlPool pool $ do
|
||||
oldBlocks <-
|
||||
select $ do
|
||||
blk <- from $ table @ZcashBlock
|
||||
where_ $ blk ^. ZcashBlockHeight >. val b
|
||||
pure blk
|
||||
let oldBlkKeys = map entityKey oldBlocks
|
||||
oldTxs <-
|
||||
select $ do
|
||||
txs <- from $ table @ZcashTransaction
|
||||
where_ $ txs ^. ZcashTransactionBlockId `in_` valList oldBlkKeys
|
||||
pure txs
|
||||
let oldTxKeys = map entityKey oldTxs
|
||||
delete $ do
|
||||
x <- from $ table @ShieldSpend
|
||||
where_ $ x ^. ShieldSpendTx `in_` valList oldTxKeys
|
||||
logDebugN "Completed ShieldSpend delete"
|
||||
_ <-
|
||||
runStderrLoggingT $
|
||||
PS.retryOnBusy $
|
||||
flip PS.runSqlPool pool $ do
|
||||
oldBlocks <-
|
||||
select $ do
|
||||
blk <- from $ table @ZcashBlock
|
||||
where_ $ blk ^. ZcashBlockHeight >. val b
|
||||
pure blk
|
||||
let oldBlkKeys = map entityKey oldBlocks
|
||||
oldTxs <-
|
||||
select $ do
|
||||
txs <- from $ table @ZcashTransaction
|
||||
where_ $ txs ^. ZcashTransactionBlockId `in_` valList oldBlkKeys
|
||||
pure txs
|
||||
let oldTxKeys = map entityKey oldTxs
|
||||
delete $ do
|
||||
x <- from $ table @OrchAction
|
||||
where_ $ x ^. OrchActionTx `in_` valList oldTxKeys
|
||||
logDebugN "Completed OrchAction delete"
|
||||
_ <-
|
||||
runStderrLoggingT $
|
||||
PS.retryOnBusy $
|
||||
flip PS.runSqlPool pool $ do
|
||||
oldBlocks <-
|
||||
select $ do
|
||||
blk <- from $ table @ZcashBlock
|
||||
where_ $ blk ^. ZcashBlockHeight >. val b
|
||||
pure blk
|
||||
let oldBlkKeys = map entityKey oldBlocks
|
||||
oldTxs <-
|
||||
select $ do
|
||||
txs <- from $ table @ZcashTransaction
|
||||
where_ $ txs ^. ZcashTransactionBlockId `in_` valList oldBlkKeys
|
||||
pure txs
|
||||
let oldTxKeys = map entityKey oldTxs
|
||||
delete $ do
|
||||
x <- from $ table @ZcashTransaction
|
||||
where_ $ x ^. ZcashTransactionId `in_` valList oldTxKeys
|
||||
logDebugN "Completed ZcashTransaction delete"
|
||||
_ <-
|
||||
runStderrLoggingT $
|
||||
PS.retryOnBusy $
|
||||
flip PS.runSqlPool pool $ do
|
||||
delete $ do
|
||||
blk <- from $ table @ZcashBlock
|
||||
where_ $ blk ^. ZcashBlockHeight >. val b
|
||||
logDebugN "Completed data store rewind"
|
||||
|
|
|
|||
|
|
@ -12,7 +12,7 @@ import Control.Concurrent (threadDelay)
|
|||
import Control.Exception (throwIO, try)
|
||||
import Control.Monad (unless, when)
|
||||
import Control.Monad.IO.Class (liftIO)
|
||||
import Control.Monad.Logger (runFileLoggingT, runNoLoggingT)
|
||||
import Control.Monad.Logger (runNoLoggingT, runStderrLoggingT)
|
||||
import Data.Aeson
|
||||
import qualified Data.ByteString as BS
|
||||
import Data.HexString (toText)
|
||||
|
|
@ -975,7 +975,7 @@ buildUI wenv model = widgetTree
|
|||
, filler
|
||||
]
|
||||
shieldOverlay =
|
||||
box
|
||||
box
|
||||
(vstack
|
||||
[ filler
|
||||
, hstack
|
||||
|
|
@ -988,41 +988,27 @@ buildUI wenv model = widgetTree
|
|||
(label "Shield Zcash" `styleBasic`
|
||||
[textFont "Bold", textSize 12])
|
||||
, separatorLine `styleBasic` [fgColor btnColor]
|
||||
, spacer
|
||||
, spacer
|
||||
, hstack
|
||||
[ filler
|
||||
, label ("Amount : " ) `styleBasic`
|
||||
, label ("Amount : ") `styleBasic`
|
||||
[width 50, textFont "Bold"]
|
||||
, spacer
|
||||
, label (displayAmount (model ^. network) 100 ) `styleBasic`
|
||||
, label (displayAmount (model ^. network) 100) `styleBasic`
|
||||
[width 50, textFont "Bold"]
|
||||
, filler
|
||||
-- , 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)
|
||||
-- ]
|
||||
]
|
||||
, spacer
|
||||
, box_
|
||||
[alignMiddle]
|
||||
(hstack
|
||||
[ filler
|
||||
, mainButton "Proceed" NotImplemented `nodeEnabled` True
|
||||
-- (model ^. amountValid && model ^. recipientValid)
|
||||
, spacer
|
||||
, mainButton "Cancel" CloseShield `nodeEnabled` True
|
||||
, filler
|
||||
[ filler
|
||||
, mainButton "Proceed" NotImplemented `nodeEnabled`
|
||||
True
|
||||
, spacer
|
||||
, mainButton "Cancel" CloseShield `nodeEnabled`
|
||||
True
|
||||
, filler
|
||||
])
|
||||
]) `styleBasic`
|
||||
[radius 4, border 2 btnColor, bgColor white, padding 4]
|
||||
|
|
@ -1046,16 +1032,18 @@ buildUI wenv model = widgetTree
|
|||
[textFont "Bold", textSize 12])
|
||||
, separatorLine `styleBasic` [fgColor btnColor]
|
||||
, spacer
|
||||
, hstack
|
||||
[ (label "Total Transparent : " `styleBasic` [ textFont "Bold" ])
|
||||
, (label "0.00" )
|
||||
, hstack
|
||||
[ (label "Total Transparent : " `styleBasic`
|
||||
[textFont "Bold"])
|
||||
, (label "0.00")
|
||||
]
|
||||
, spacer
|
||||
, hstack
|
||||
[ (label "Total Shielded : " `styleBasic` [ textFont "Bold" ])
|
||||
, (label "0.00" )
|
||||
, hstack
|
||||
[ (label "Total Shielded : " `styleBasic`
|
||||
[textFont "Bold"])
|
||||
, (label "0.00")
|
||||
]
|
||||
, spacer
|
||||
, spacer
|
||||
, hstack
|
||||
[ label "Amount:" `styleBasic`
|
||||
[width 50, textFont "Bold"]
|
||||
|
|
@ -1065,7 +1053,8 @@ buildUI wenv model = widgetTree
|
|||
[ decimals 8
|
||||
, minValue 0.0
|
||||
, maxValue
|
||||
(fromIntegral (model ^. sBalance) / 100000000.0)
|
||||
(fromIntegral (model ^. sBalance) /
|
||||
100000000.0)
|
||||
, validInput sBalanceValid
|
||||
, onChange CheckAmount
|
||||
] `styleBasic`
|
||||
|
|
@ -1079,11 +1068,12 @@ buildUI wenv model = widgetTree
|
|||
, box_
|
||||
[alignMiddle]
|
||||
(hstack
|
||||
[ filler
|
||||
, mainButton "Proceed" NotImplemented `nodeEnabled` True
|
||||
-- (model ^. amountValid && model ^. recipientValid)
|
||||
, spacer
|
||||
, mainButton "Cancel" CloseDeShield `nodeEnabled` True
|
||||
[ filler
|
||||
, mainButton "Proceed" NotImplemented `nodeEnabled`
|
||||
True
|
||||
, spacer
|
||||
, mainButton "Cancel" CloseDeShield `nodeEnabled`
|
||||
True
|
||||
, filler
|
||||
])
|
||||
]) `styleBasic`
|
||||
|
|
@ -1093,6 +1083,24 @@ buildUI wenv model = widgetTree
|
|||
, filler
|
||||
]) `styleBasic`
|
||||
[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
|
||||
|
||||
generateQRCodes :: Config -> IO ()
|
||||
|
|
@ -1391,7 +1399,7 @@ handleEvent wenv node model evt =
|
|||
case currentWallet of
|
||||
Nothing -> return $ ShowError "No wallet available"
|
||||
Just cW -> do
|
||||
runNoLoggingT $ syncWallet (model ^. configuration) cW
|
||||
runStderrLoggingT $ syncWallet (model ^. configuration) cW
|
||||
pool <-
|
||||
runNoLoggingT $
|
||||
initPool $ c_dbPath $ model ^. configuration
|
||||
|
|
@ -1482,9 +1490,9 @@ handleEvent wenv node model evt =
|
|||
model & msgAB ?~ "Function not implemented..." & menuPopup .~ False
|
||||
]
|
||||
CloseMsgAB -> [Model $ model & msgAB .~ Nothing & inError .~ False]
|
||||
ShowShield -> [ Model $ model & shieldZec .~ True & menuPopup .~ False ]
|
||||
ShowShield -> [Model $ model & shieldZec .~ True & menuPopup .~ 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]
|
||||
LoadAbList a -> [Model $ model & abaddressList .~ a]
|
||||
UpdateABDescrip d a ->
|
||||
|
|
@ -1623,7 +1631,8 @@ scanZebra dbPath zHost zPort net sendMsg = do
|
|||
if syncChk
|
||||
then sendMsg (ShowError "Sync already in progress")
|
||||
else do
|
||||
unless (chkBlock == dbBlock) $ rewindWalletData pool chkBlock
|
||||
unless (chkBlock == dbBlock) $
|
||||
runStderrLoggingT $ rewindWalletData pool chkBlock
|
||||
let sb =
|
||||
if chkBlock == dbBlock
|
||||
then max dbBlock b
|
||||
|
|
|
|||
|
|
@ -892,7 +892,8 @@ scanZebra dbPath zHost zPort net = do
|
|||
chkBlock <- checkIntegrity dbPath zHost zPort dbBlock 1
|
||||
syncChk <- isSyncing pool
|
||||
unless syncChk $ do
|
||||
unless (chkBlock == dbBlock) $ rewindWalletData pool chkBlock
|
||||
unless (chkBlock == dbBlock) $
|
||||
runStderrLoggingT $ rewindWalletData pool chkBlock
|
||||
let sb =
|
||||
if chkBlock == dbBlock
|
||||
then max dbBlock b
|
||||
|
|
@ -909,7 +910,7 @@ scanZebra dbPath zHost zPort net = do
|
|||
return ()
|
||||
Right _ -> do
|
||||
wals <- getWallets pool net
|
||||
runNoLoggingT $
|
||||
runStderrLoggingT $
|
||||
mapM_
|
||||
(syncWallet (Config dbPath zHost zPort "user" "pwd" 8080))
|
||||
wals
|
||||
|
|
|
|||
|
|
@ -10,8 +10,8 @@ import Control.Monad.Logger
|
|||
( NoLoggingT
|
||||
, logErrorN
|
||||
, logInfoN
|
||||
, runFileLoggingT
|
||||
, runNoLoggingT
|
||||
, runStderrLoggingT
|
||||
)
|
||||
import Data.Aeson
|
||||
import Data.HexString
|
||||
|
|
@ -238,7 +238,7 @@ clearSync config = do
|
|||
w <- getWallets pool $ zgb_net chainInfo
|
||||
liftIO $ mapM_ (updateWalletSync pool 0 . entityKey) w
|
||||
w' <- liftIO $ getWallets pool $ zgb_net chainInfo
|
||||
r <- runNoLoggingT $ mapM (syncWallet config) w'
|
||||
r <- runStderrLoggingT $ mapM (syncWallet config) w'
|
||||
liftIO $ print r
|
||||
|
||||
-- | Detect chain re-orgs
|
||||
|
|
|
|||
|
|
@ -212,8 +212,8 @@ main = do
|
|||
"localhost"
|
||||
18232
|
||||
TestNet
|
||||
(toSqlKey 1)
|
||||
3001331
|
||||
(toSqlKey 3)
|
||||
3026170
|
||||
[ ProposedNote
|
||||
(ValidAddressAPI $ fromJust uaRead)
|
||||
0.005
|
||||
|
|
@ -222,7 +222,7 @@ main = do
|
|||
Full
|
||||
case tx of
|
||||
Left e -> assertFailure $ show e
|
||||
Right h -> h `shouldNotBe` (hexString "deadbeef")
|
||||
Right h -> h `shouldBe` (hexString "deadbeef")
|
||||
it "To Sapling" $ do
|
||||
let uaRead =
|
||||
parseAddress
|
||||
|
|
|
|||
|
|
@ -1 +1 @@
|
|||
Subproject commit 396f15140a00fd9a00f06c89910f76a22354e8d8
|
||||
Subproject commit 662a0d1148d3f52e2683157a4c9280bb8e81b0cb
|
||||
Loading…
Reference in a new issue