Implement database migration
This commit is contained in:
parent
c9dea01644
commit
46b4969da5
GPG key ID:
65122AD495A7F5B2
11 changed files with 408 additions and 360 deletions
|
|
@ -19,8 +19,8 @@ import System.IO
|
|||
import Text.Read (readMaybe)
|
||||
import ZcashHaskell.Types
|
||||
import Zenith.CLI
|
||||
import Zenith.Core (clearSync, testSync)
|
||||
import Zenith.GUI (runZenithGUI)
|
||||
import Zenith.Scanner (clearSync, rescanZebra)
|
||||
import Zenith.Types (Config(..), ZcashAddress(..), ZcashPool(..), ZcashTx(..))
|
||||
import Zenith.Utils
|
||||
import Zenith.Zcashd
|
||||
|
|
@ -227,7 +227,7 @@ main = do
|
|||
of
|
||||
"gui" -> runZenithGUI myConfig
|
||||
"tui" -> runZenithTUI myConfig
|
||||
"rescan" -> clearSync myConfig
|
||||
"rescan" -> rescanZebra zebraHost zebraPort dbFilePath
|
||||
_ -> printUsage
|
||||
else printUsage
|
||||
|
||||
|
|
|
|||
|
|
@ -2,10 +2,16 @@
|
|||
|
||||
module Server where
|
||||
|
||||
import Control.Exception (throwIO, try)
|
||||
import Control.Monad (when)
|
||||
import Data.Configurator
|
||||
import Network.Wai.Handler.Warp (run)
|
||||
import Servant
|
||||
import ZcashHaskell.Types (ZebraGetBlockChainInfo(..), ZebraGetInfo(..))
|
||||
import Zenith.Core (checkBlockChain, checkZebra)
|
||||
import Zenith.DB (initDb)
|
||||
import Zenith.RPC (ZenithRPC(..), authenticate, zenithServer)
|
||||
import Zenith.Scanner (rescanZebra)
|
||||
import Zenith.Types (Config(..))
|
||||
|
||||
main :: IO ()
|
||||
|
|
@ -19,5 +25,22 @@ main = do
|
|||
nodePort <- require config "nodePort"
|
||||
let myConfig = Config dbFilePath zebraHost zebraPort nodeUser nodePwd nodePort
|
||||
let ctx = authenticate myConfig :. EmptyContext
|
||||
run nodePort $
|
||||
serveWithContext (Proxy :: Proxy ZenithRPC) ctx (zenithServer myConfig)
|
||||
w <- try $ checkZebra zebraHost zebraPort :: IO (Either IOError ZebraGetInfo)
|
||||
case w of
|
||||
Right zebra -> do
|
||||
bc <-
|
||||
try $ checkBlockChain zebraHost zebraPort :: IO
|
||||
(Either IOError ZebraGetBlockChainInfo)
|
||||
case bc of
|
||||
Left e1 -> throwIO e1
|
||||
Right chainInfo -> do
|
||||
x <- initDb dbFilePath
|
||||
case x of
|
||||
Left e2 -> throwIO $ userError e2
|
||||
Right x' -> do
|
||||
when x' $ rescanZebra zebraHost zebraPort dbFilePath
|
||||
run nodePort $
|
||||
serveWithContext
|
||||
(Proxy :: Proxy ZenithRPC)
|
||||
ctx
|
||||
(zenithServer myConfig)
|
||||
|
|
|
|||
|
|
@ -4,7 +4,7 @@ module ZenScan where
|
|||
|
||||
import Control.Monad.Logger (runNoLoggingT)
|
||||
import Data.Configurator
|
||||
import Zenith.Scanner (scanZebra)
|
||||
import Zenith.Scanner (rescanZebra)
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
|
|
|
|||
|
|
@ -10,10 +10,8 @@ import qualified Brick.BChan as BC
|
|||
import qualified Brick.Focus as F
|
||||
import Brick.Forms
|
||||
( Form(..)
|
||||
, FormFieldState
|
||||
, (@@=)
|
||||
, allFieldsValid
|
||||
, editShowableField
|
||||
, editShowableFieldWithValidate
|
||||
, editTextField
|
||||
, focusedFormInputAttr
|
||||
|
|
@ -42,7 +40,6 @@ import Brick.Widgets.Core
|
|||
, joinBorders
|
||||
, padAll
|
||||
, padBottom
|
||||
, padLeft
|
||||
, padTop
|
||||
, setAvailableSize
|
||||
, str
|
||||
|
|
@ -63,10 +60,10 @@ import qualified Brick.Widgets.Edit as E
|
|||
import qualified Brick.Widgets.List as L
|
||||
import qualified Brick.Widgets.ProgressBar as P
|
||||
import Control.Concurrent (forkIO, threadDelay)
|
||||
import Control.Exception (catch, throw, throwIO, try)
|
||||
import Control.Monad (forever, void)
|
||||
import Control.Exception (throw, throwIO, try)
|
||||
import Control.Monad (forever, void, when)
|
||||
import Control.Monad.IO.Class (liftIO)
|
||||
import Control.Monad.Logger (LoggingT, runFileLoggingT, runNoLoggingT)
|
||||
import Control.Monad.Logger (runFileLoggingT, runNoLoggingT)
|
||||
import Data.Aeson
|
||||
import Data.HexString (HexString(..), toText)
|
||||
import Data.Maybe
|
||||
|
|
@ -83,19 +80,15 @@ import Lens.Micro.Mtl
|
|||
import Lens.Micro.TH
|
||||
import System.Hclip
|
||||
import Text.Printf
|
||||
import Text.Wrap (FillScope(..), FillStrategy(..), WrapSettings(..), wrapText)
|
||||
import ZcashHaskell.Keys (generateWalletSeedPhrase, getWalletSeed)
|
||||
import Text.Wrap (FillScope(..), FillStrategy(..), WrapSettings(..))
|
||||
import ZcashHaskell.Keys (generateWalletSeedPhrase)
|
||||
import ZcashHaskell.Orchard (getSaplingFromUA, isValidUnifiedAddress)
|
||||
import ZcashHaskell.Sapling (decodeSaplingAddress, isValidShieldedAddress)
|
||||
import ZcashHaskell.Transparent
|
||||
( decodeTransparentAddress
|
||||
, encodeTransparentReceiver
|
||||
)
|
||||
import ZcashHaskell.Transparent (encodeTransparentReceiver)
|
||||
import ZcashHaskell.Types
|
||||
import ZcashHaskell.Utils (getBlockTime, makeZebraCall)
|
||||
import Zenith.Core
|
||||
import Zenith.DB
|
||||
import Zenith.Scanner (processTx, updateConfs)
|
||||
import Zenith.Scanner (processTx, rescanZebra, updateConfs)
|
||||
import Zenith.Types
|
||||
( Config(..)
|
||||
, PhraseDB(..)
|
||||
|
|
@ -722,9 +715,9 @@ abSelAttr = A.attrName "abselected"
|
|||
abMBarAttr :: A.AttrName
|
||||
abMBarAttr = A.attrName "menubar"
|
||||
|
||||
scanZebra :: T.Text -> T.Text -> Int -> Int -> BC.BChan Tick -> IO ()
|
||||
scanZebra dbP zHost zPort b eChan = do
|
||||
_ <- liftIO $ initDb dbP
|
||||
scanZebra ::
|
||||
T.Text -> T.Text -> Int -> Int -> BC.BChan Tick -> ZcashNet -> IO ()
|
||||
scanZebra dbP zHost zPort b eChan net = do
|
||||
bStatus <- liftIO $ checkBlockChain zHost zPort
|
||||
pool <- runNoLoggingT $ initPool dbP
|
||||
dbBlock <- runNoLoggingT $ getMaxBlock pool
|
||||
|
|
@ -772,7 +765,7 @@ scanZebra dbP zHost zPort b eChan = do
|
|||
Left e2 -> liftIO $ BC.writeBChan eChan $ TickMsg e2
|
||||
Right hb -> do
|
||||
let blockTime = getBlockTime hb
|
||||
mapM_ (runNoLoggingT . processTx zHost zPort blockTime pool) $
|
||||
mapM_ (processTx zHost zPort blockTime pool (ZcashNetDB net)) $
|
||||
bl_txs $ addTime blk blockTime
|
||||
liftIO $ BC.writeBChan eChan $ TickVal step
|
||||
addTime :: BlockResponse -> Int -> BlockResponse
|
||||
|
|
@ -868,6 +861,7 @@ appEvent (BT.AppEvent t) = do
|
|||
(s ^. zebraPort)
|
||||
sBlock
|
||||
(s ^. eventDispatch)
|
||||
(s ^. network)
|
||||
BT.modify $ set timer 0
|
||||
return ()
|
||||
else BT.modify $ set timer $ 1 + s ^. timer
|
||||
|
|
@ -1369,75 +1363,82 @@ runZenithTUI config = do
|
|||
case bc of
|
||||
Left e1 -> throwIO e1
|
||||
Right chainInfo -> do
|
||||
initDb dbFilePath
|
||||
walList <- getWallets pool $ zgb_net chainInfo
|
||||
accList <-
|
||||
if not (null walList)
|
||||
then runNoLoggingT $ getAccounts pool $ entityKey $ head walList
|
||||
else return []
|
||||
addrList <-
|
||||
if not (null accList)
|
||||
then runNoLoggingT $ getAddresses pool $ entityKey $ head accList
|
||||
else return []
|
||||
txList <-
|
||||
if not (null addrList)
|
||||
then getUserTx pool $ entityKey $ head addrList
|
||||
else return []
|
||||
let block =
|
||||
x <- initDb dbFilePath
|
||||
case x of
|
||||
Left e2 -> throwIO $ userError e2
|
||||
Right x' -> do
|
||||
when x' $ rescanZebra host port dbFilePath
|
||||
walList <- getWallets pool $ zgb_net chainInfo
|
||||
accList <-
|
||||
if not (null walList)
|
||||
then zcashWalletLastSync $ entityVal $ head walList
|
||||
else 0
|
||||
abookList <- getAdrBook pool $ zgb_net chainInfo
|
||||
bal <-
|
||||
if not (null accList)
|
||||
then getBalance pool $ entityKey $ head accList
|
||||
else return 0
|
||||
uBal <-
|
||||
if not (null accList)
|
||||
then getUnconfirmedBalance pool $ entityKey $ head accList
|
||||
else return 0
|
||||
eventChan <- BC.newBChan 10
|
||||
_ <-
|
||||
forkIO $
|
||||
forever $ do
|
||||
BC.writeBChan eventChan (TickVal 0.0)
|
||||
threadDelay 1000000
|
||||
let buildVty = VC.mkVty V.defaultConfig
|
||||
initialVty <- buildVty
|
||||
void $
|
||||
M.customMain initialVty buildVty (Just eventChan) theApp $
|
||||
State
|
||||
(zgb_net chainInfo)
|
||||
(L.list WList (Vec.fromList walList) 1)
|
||||
(L.list AcList (Vec.fromList accList) 0)
|
||||
(L.list AList (Vec.fromList addrList) 1)
|
||||
(L.list TList (Vec.fromList txList) 1)
|
||||
("Start up Ok! Connected to Zebra " ++
|
||||
(T.unpack . zgi_build) zebra ++ " on port " ++ show port ++ ".")
|
||||
False
|
||||
(if null walList
|
||||
then WName
|
||||
else Blank)
|
||||
True
|
||||
(mkInputForm $ DialogInput "Main")
|
||||
(F.focusRing [AList, TList])
|
||||
(zgb_blocks chainInfo)
|
||||
dbFilePath
|
||||
host
|
||||
port
|
||||
MsgDisplay
|
||||
block
|
||||
bal
|
||||
1.0
|
||||
eventChan
|
||||
0
|
||||
(mkSendForm 0 $ SendInput "" 0.0 "")
|
||||
(L.list ABList (Vec.fromList abookList) 1)
|
||||
(mkNewABForm (AdrBookEntry "" ""))
|
||||
""
|
||||
Nothing
|
||||
uBal
|
||||
Left e -> do
|
||||
then runNoLoggingT $
|
||||
getAccounts pool $ entityKey $ head walList
|
||||
else return []
|
||||
addrList <-
|
||||
if not (null accList)
|
||||
then runNoLoggingT $
|
||||
getAddresses pool $ entityKey $ head accList
|
||||
else return []
|
||||
txList <-
|
||||
if not (null addrList)
|
||||
then getUserTx pool $ entityKey $ head addrList
|
||||
else return []
|
||||
let block =
|
||||
if not (null walList)
|
||||
then zcashWalletLastSync $ entityVal $ head walList
|
||||
else 0
|
||||
abookList <- getAdrBook pool $ zgb_net chainInfo
|
||||
bal <-
|
||||
if not (null accList)
|
||||
then getBalance pool $ entityKey $ head accList
|
||||
else return 0
|
||||
uBal <-
|
||||
if not (null accList)
|
||||
then getUnconfirmedBalance pool $ entityKey $ head accList
|
||||
else return 0
|
||||
eventChan <- BC.newBChan 10
|
||||
_ <-
|
||||
forkIO $
|
||||
forever $ do
|
||||
BC.writeBChan eventChan (TickVal 0.0)
|
||||
threadDelay 1000000
|
||||
let buildVty = VC.mkVty V.defaultConfig
|
||||
initialVty <- buildVty
|
||||
void $
|
||||
M.customMain initialVty buildVty (Just eventChan) theApp $
|
||||
State
|
||||
(zgb_net chainInfo)
|
||||
(L.list WList (Vec.fromList walList) 1)
|
||||
(L.list AcList (Vec.fromList accList) 0)
|
||||
(L.list AList (Vec.fromList addrList) 1)
|
||||
(L.list TList (Vec.fromList txList) 1)
|
||||
("Start up Ok! Connected to Zebra " ++
|
||||
(T.unpack . zgi_build) zebra ++
|
||||
" on port " ++ show port ++ ".")
|
||||
False
|
||||
(if null walList
|
||||
then WName
|
||||
else Blank)
|
||||
True
|
||||
(mkInputForm $ DialogInput "Main")
|
||||
(F.focusRing [AList, TList])
|
||||
(zgb_blocks chainInfo)
|
||||
dbFilePath
|
||||
host
|
||||
port
|
||||
MsgDisplay
|
||||
block
|
||||
bal
|
||||
1.0
|
||||
eventChan
|
||||
0
|
||||
(mkSendForm 0 $ SendInput "" 0.0 "")
|
||||
(L.list ABList (Vec.fromList abookList) 1)
|
||||
(mkNewABForm (AdrBookEntry "" ""))
|
||||
""
|
||||
Nothing
|
||||
uBal
|
||||
Left _e -> do
|
||||
print $
|
||||
"No Zebra node available on port " <>
|
||||
show port <> ". Check your configuration."
|
||||
|
|
|
|||
|
|
@ -728,48 +728,3 @@ syncWallet config w = do
|
|||
_ <- updateOrchardWitnesses pool
|
||||
_ <- liftIO $ updateWalletSync pool chainTip (entityKey w)
|
||||
mapM_ (runNoLoggingT . getWalletTransactions pool) addrs
|
||||
|
||||
testSync :: Config -> IO ()
|
||||
testSync config = do
|
||||
let dbPath = c_dbPath config
|
||||
_ <- initDb dbPath
|
||||
pool <- runNoLoggingT $ initPool dbPath
|
||||
w <- getWallets pool TestNet
|
||||
r <- mapM (syncWallet config) w
|
||||
liftIO $ print r
|
||||
{-let uaRead =-}
|
||||
{-isValidUnifiedAddress-}
|
||||
{-"utest1dl54utt6prjj5e0dnlknwumnxq9hycdjpkfr0sy6e6h522remqee8axe9zax0wsjrwpj76v555pdhvj9rnargpfyycs0vpkapq98xcdhem99gc4wchzn0ggepq3y6nz3a9sscwgqxgsh9vzhcad402y3x9szfregck5gslkya3c79d86xx0l33tpk8gnn7ew9vw37w43zh22u8dgdax"-}
|
||||
{-case uaRead of-}
|
||||
{-Nothing -> print "wrong address"-}
|
||||
{-Just ua -> do-}
|
||||
{-startTime <- getCurrentTime-}
|
||||
{-print startTime-}
|
||||
{-tx <--}
|
||||
{-prepareTx-}
|
||||
{-"zenith.db"-}
|
||||
{-"127.0.0.1"-}
|
||||
{-18232-}
|
||||
{-TestNet-}
|
||||
{-(toSqlKey 1)-}
|
||||
{-2820897-}
|
||||
{-0.04-}
|
||||
{-ua-}
|
||||
{-"sent with Zenith, test"-}
|
||||
{-print tx-}
|
||||
{-endTime <- getCurrentTime-}
|
||||
{-print endTime-}
|
||||
|
||||
{-testSend :: IO ()-}
|
||||
{-testSend = do-}
|
||||
clearSync :: Config -> IO ()
|
||||
clearSync config = do
|
||||
let dbPath = c_dbPath config
|
||||
pool <- runNoLoggingT $ initPool dbPath
|
||||
_ <- initDb dbPath
|
||||
_ <- clearWalletTransactions pool
|
||||
w <- getWallets pool TestNet
|
||||
liftIO $ mapM_ (updateWalletSync pool 0 . entityKey) w
|
||||
w' <- liftIO $ getWallets pool TestNet
|
||||
r <- mapM (syncWallet config) w'
|
||||
liftIO $ print r
|
||||
|
|
|
|||
101
src/Zenith/DB.hs
101
src/Zenith/DB.hs
|
|
@ -18,12 +18,10 @@
|
|||
|
||||
module Zenith.DB where
|
||||
|
||||
import Control.Exception (throwIO)
|
||||
import Control.Monad (forM_, when)
|
||||
import Control.Monad.IO.Class (MonadIO, liftIO)
|
||||
import Control.Exception (SomeException(..), throwIO, try)
|
||||
import Control.Monad (when)
|
||||
import Control.Monad.IO.Class (MonadIO)
|
||||
import Control.Monad.Logger (NoLoggingT, runNoLoggingT)
|
||||
import Data.Aeson hiding (Key, Value)
|
||||
import Data.Bifunctor (bimap)
|
||||
import qualified Data.ByteString as BS
|
||||
import Data.HexString
|
||||
import Data.List (group, sort)
|
||||
|
|
@ -41,34 +39,29 @@ import Haskoin.Transaction.Common
|
|||
, TxOut(..)
|
||||
, txHashToHex
|
||||
)
|
||||
import qualified Lens.Micro as ML ((&), (.~), (^.))
|
||||
import System.Directory (doesFileExist, getHomeDirectory, removeFile)
|
||||
import System.FilePath ((</>))
|
||||
import ZcashHaskell.Orchard (getSaplingFromUA, isValidUnifiedAddress)
|
||||
import ZcashHaskell.Transparent (encodeTransparentReceiver)
|
||||
import ZcashHaskell.Types
|
||||
( DecodedNote(..)
|
||||
, OrchardAction(..)
|
||||
, OrchardBundle(..)
|
||||
, OrchardSpendingKey(..)
|
||||
, OrchardWitness(..)
|
||||
, SaplingBundle(..)
|
||||
, SaplingCommitmentTree(..)
|
||||
, SaplingSpendingKey(..)
|
||||
, SaplingWitness(..)
|
||||
, Scope(..)
|
||||
, ShieldedOutput(..)
|
||||
, ShieldedSpend(..)
|
||||
, ToBytes(..)
|
||||
, Transaction(..)
|
||||
, TransparentAddress(..)
|
||||
, TransparentBundle(..)
|
||||
, TransparentReceiver(..)
|
||||
, UnifiedAddress(..)
|
||||
, ZcashNet(..)
|
||||
, decodeHexText
|
||||
)
|
||||
import Zenith.Types
|
||||
( Config(..)
|
||||
, HexStringDB(..)
|
||||
( HexStringDB(..)
|
||||
, OrchardSpendingKeyDB(..)
|
||||
, PhraseDB(..)
|
||||
, RseedDB(..)
|
||||
|
|
@ -197,7 +190,8 @@ share
|
|||
txId HexStringDB
|
||||
conf Int
|
||||
time Int
|
||||
UniqueTx block txId
|
||||
network ZcashNetDB
|
||||
UniqueTx block txId network
|
||||
deriving Show Eq
|
||||
TransparentNote
|
||||
tx ZcashTransactionId
|
||||
|
|
@ -311,9 +305,53 @@ toZcashAddressAPI a =
|
|||
-- | Initializes the database
|
||||
initDb ::
|
||||
T.Text -- ^ The database path to check
|
||||
-> IO ()
|
||||
-> IO (Either String Bool)
|
||||
initDb dbName = do
|
||||
PS.runSqlite dbName $ do runMigration migrateAll
|
||||
print "Start database"
|
||||
j <-
|
||||
try $ PS.runSqlite dbName $ runMigrationQuiet migrateAll :: IO
|
||||
(Either SomeException [T.Text])
|
||||
case j of
|
||||
Left e1 -> do
|
||||
print e1
|
||||
pool <- runNoLoggingT $ initPool dbName
|
||||
wallets <-
|
||||
runNoLoggingT $
|
||||
PS.retryOnBusy $
|
||||
flip PS.runSqlPool pool $ do select . from $ table @ZcashWallet
|
||||
accounts <-
|
||||
runNoLoggingT $
|
||||
PS.retryOnBusy $
|
||||
flip PS.runSqlPool pool $ do select . from $ table @ZcashAccount
|
||||
abook <-
|
||||
runNoLoggingT $
|
||||
PS.retryOnBusy $
|
||||
flip PS.runSqlPool pool $ do select . from $ table @AddressBook
|
||||
hDir <- getHomeDirectory
|
||||
let backupDb = hDir </> "Zenith/.backup.db"
|
||||
checkDbFile <- doesFileExist backupDb
|
||||
when checkDbFile $ removeFile backupDb
|
||||
_ <- PS.runSqlite (T.pack backupDb) $ runMigrationQuiet migrateAll
|
||||
backupPool <- runNoLoggingT $ initPool $ T.pack backupDb
|
||||
_ <-
|
||||
runNoLoggingT $
|
||||
PS.retryOnBusy $
|
||||
flip PS.runSqlPool backupPool $ insertMany_ $ entityVal <$> wallets
|
||||
_ <-
|
||||
runNoLoggingT $
|
||||
PS.retryOnBusy $
|
||||
flip PS.runSqlPool backupPool $ insertMany_ $ entityVal <$> accounts
|
||||
_ <-
|
||||
runNoLoggingT $
|
||||
PS.retryOnBusy $
|
||||
flip PS.runSqlPool backupPool $ insertMany_ $ entityVal <$> abook
|
||||
m <-
|
||||
try $ PS.runSqlite dbName $ runMigrationQuiet migrateAll :: IO
|
||||
(Either SomeException [T.Text])
|
||||
case m of
|
||||
Left _e2 -> return $ Left "Failed to migrate data tables"
|
||||
Right _ -> return $ Right True
|
||||
Right _ -> return $ Right False
|
||||
|
||||
initPool :: T.Text -> NoLoggingT IO ConnectionPool
|
||||
initPool dbPath = do
|
||||
|
|
@ -519,15 +557,16 @@ saveAddress pool w =
|
|||
saveTransaction ::
|
||||
ConnectionPool -- ^ the database path
|
||||
-> Int -- ^ block time
|
||||
-> ZcashNetDB -- ^ the network
|
||||
-> Transaction -- ^ The transaction to save
|
||||
-> NoLoggingT IO (Key ZcashTransaction)
|
||||
saveTransaction pool t wt =
|
||||
saveTransaction pool t n wt =
|
||||
PS.retryOnBusy $
|
||||
flip PS.runSqlPool pool $ do
|
||||
let ix = [0 ..]
|
||||
w <-
|
||||
insert $
|
||||
ZcashTransaction (tx_height wt) (HexStringDB $ tx_id wt) (tx_conf wt) t
|
||||
ZcashTransaction (tx_height wt) (HexStringDB $ tx_id wt) (tx_conf wt) t n
|
||||
when (isJust $ tx_transpBundle wt) $ do
|
||||
_ <-
|
||||
insertMany_ $
|
||||
|
|
@ -1499,6 +1538,32 @@ clearWalletTransactions pool = do
|
|||
delete $ do
|
||||
_ <- from $ table @WalletTransaction
|
||||
return ()
|
||||
update $ \w -> do
|
||||
set w [ZcashWalletLastSync =. val 0]
|
||||
|
||||
clearWalletData :: ConnectionPool -> IO ()
|
||||
clearWalletData pool = do
|
||||
runNoLoggingT $
|
||||
PS.retryOnBusy $
|
||||
flip PS.runSqlPool pool $ do
|
||||
delete $ do
|
||||
_ <- from $ table @TransparentNote
|
||||
return ()
|
||||
delete $ do
|
||||
_ <- from $ table @TransparentSpend
|
||||
return ()
|
||||
delete $ do
|
||||
_ <- from $ table @OrchAction
|
||||
return ()
|
||||
delete $ do
|
||||
_ <- from $ table @ShieldOutput
|
||||
return ()
|
||||
delete $ do
|
||||
_ <- from $ table @ShieldSpend
|
||||
return ()
|
||||
delete $ do
|
||||
_ <- from $ table @ZcashTransaction
|
||||
return ()
|
||||
|
||||
getWalletUnspentTrNotes ::
|
||||
ConnectionPool -> ZcashAccountId -> IO [Entity WalletTrNote]
|
||||
|
|
|
|||
|
|
@ -9,13 +9,13 @@ import Codec.QRCode
|
|||
import Codec.QRCode.JuicyPixels
|
||||
import Control.Concurrent (threadDelay)
|
||||
import Control.Exception (throwIO, try)
|
||||
import Control.Monad (when)
|
||||
import Control.Monad.IO.Class (liftIO)
|
||||
import Control.Monad.Logger (runFileLoggingT, runNoLoggingT)
|
||||
import Data.Aeson
|
||||
import qualified Data.ByteString as BS
|
||||
import qualified Data.ByteString.Lazy as LBS
|
||||
import Data.HexString (toText)
|
||||
import Data.Maybe (fromJust, fromMaybe, isJust, isNothing)
|
||||
import Data.Maybe (fromMaybe, isJust, isNothing)
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text.Encoding as E
|
||||
import Data.Time.Clock.POSIX (posixSecondsToUTCTime)
|
||||
|
|
@ -27,7 +27,6 @@ import Monomer
|
|||
import qualified Monomer.Lens as L
|
||||
import System.Directory (getHomeDirectory)
|
||||
import System.FilePath ((</>))
|
||||
import System.Hclip
|
||||
import Text.Printf
|
||||
import Text.Wrap (FillScope(..), FillStrategy(..), WrapSettings(..), wrapText)
|
||||
import TextShow hiding (toText)
|
||||
|
|
@ -36,7 +35,6 @@ import ZcashHaskell.Orchard (getSaplingFromUA, isValidUnifiedAddress)
|
|||
import ZcashHaskell.Transparent (encodeTransparentReceiver)
|
||||
import ZcashHaskell.Types
|
||||
( BlockResponse(..)
|
||||
, Phrase(..)
|
||||
, Scope(..)
|
||||
, ToBytes(..)
|
||||
, UnifiedAddress(..)
|
||||
|
|
@ -48,7 +46,7 @@ import ZcashHaskell.Utils (getBlockTime, makeZebraCall)
|
|||
import Zenith.Core
|
||||
import Zenith.DB
|
||||
import Zenith.GUI.Theme
|
||||
import Zenith.Scanner (processTx, updateConfs)
|
||||
import Zenith.Scanner (processTx, rescanZebra, updateConfs)
|
||||
import Zenith.Types hiding (ZcashAddress(..))
|
||||
import Zenith.Utils
|
||||
( displayAmount
|
||||
|
|
@ -1030,6 +1028,7 @@ handleEvent wenv node model evt =
|
|||
(c_dbPath $ model ^. configuration)
|
||||
(c_zebraHost $ model ^. configuration)
|
||||
(c_zebraPort $ model ^. configuration)
|
||||
(model ^. network)
|
||||
]
|
||||
else [Model $ model & timer .~ 0]
|
||||
SyncVal i ->
|
||||
|
|
@ -1147,9 +1146,8 @@ handleEvent wenv node model evt =
|
|||
wL <- getWallets pool (model ^. network)
|
||||
return $ LoadWallets wL
|
||||
|
||||
scanZebra :: T.Text -> T.Text -> Int -> (AppEvent -> IO ()) -> IO ()
|
||||
scanZebra dbPath zHost zPort sendMsg = do
|
||||
_ <- liftIO $ initDb dbPath
|
||||
scanZebra :: T.Text -> T.Text -> Int -> ZcashNet -> (AppEvent -> IO ()) -> IO ()
|
||||
scanZebra dbPath zHost zPort net sendMsg = do
|
||||
bStatus <- liftIO $ checkBlockChain zHost zPort
|
||||
pool <- runNoLoggingT $ initPool dbPath
|
||||
b <- liftIO $ getMinBirthdayHeight pool
|
||||
|
|
@ -1192,7 +1190,7 @@ scanZebra dbPath zHost zPort sendMsg = do
|
|||
Left e2 -> sendMsg (ShowError $ showt e2)
|
||||
Right hb -> do
|
||||
let blockTime = getBlockTime hb
|
||||
mapM_ (runNoLoggingT . processTx zHost zPort blockTime pool) $
|
||||
mapM_ (processTx zHost zPort blockTime pool (ZcashNetDB net)) $
|
||||
bl_txs $ addTime blk blockTime
|
||||
sendMsg (SyncVal step)
|
||||
addTime :: BlockResponse -> Int -> BlockResponse
|
||||
|
|
@ -1267,128 +1265,87 @@ runZenithGUI config = do
|
|||
case bc of
|
||||
Left e1 -> throwIO e1
|
||||
Right chainInfo -> do
|
||||
initDb dbFilePath
|
||||
generateQRCodes config
|
||||
walList <- getWallets pool $ zgb_net chainInfo
|
||||
accList <-
|
||||
if not (null walList)
|
||||
then runNoLoggingT $
|
||||
getAccounts pool $ entityKey $ head walList
|
||||
else return []
|
||||
addrList <-
|
||||
if not (null accList)
|
||||
then runNoLoggingT $
|
||||
getAddresses pool $ entityKey $ head accList
|
||||
else return []
|
||||
txList <-
|
||||
if not (null addrList)
|
||||
then getUserTx pool $ entityKey $ head addrList
|
||||
else return []
|
||||
qr <-
|
||||
if not (null addrList)
|
||||
then getQrCode pool Orchard $ entityKey $ head addrList
|
||||
else return Nothing
|
||||
bal <-
|
||||
if not (null accList)
|
||||
then getBalance pool $ entityKey $ head accList
|
||||
else return 0
|
||||
unconfBal <-
|
||||
if not (null accList)
|
||||
then getUnconfirmedBalance pool $ entityKey $ head accList
|
||||
else return 0
|
||||
let model =
|
||||
AppModel
|
||||
config
|
||||
(zgb_net chainInfo)
|
||||
walList
|
||||
0
|
||||
accList
|
||||
0
|
||||
addrList
|
||||
0
|
||||
txList
|
||||
0
|
||||
Nothing
|
||||
True
|
||||
bal
|
||||
(if unconfBal == 0
|
||||
then Nothing
|
||||
else Just unconfBal)
|
||||
Orchard
|
||||
qr
|
||||
False
|
||||
False
|
||||
False
|
||||
False
|
||||
""
|
||||
Nothing
|
||||
""
|
||||
""
|
||||
(SaveAddress $
|
||||
if not (null accList)
|
||||
then Just (head accList)
|
||||
else Nothing)
|
||||
False
|
||||
False
|
||||
Nothing
|
||||
Nothing
|
||||
0
|
||||
1.0
|
||||
False
|
||||
""
|
||||
0.0
|
||||
""
|
||||
False
|
||||
False
|
||||
Nothing
|
||||
hD
|
||||
startApp model handleEvent buildUI (params hD)
|
||||
Left e -> do
|
||||
initDb dbFilePath
|
||||
let model =
|
||||
AppModel
|
||||
config
|
||||
TestNet
|
||||
[]
|
||||
0
|
||||
[]
|
||||
0
|
||||
[]
|
||||
0
|
||||
[]
|
||||
0
|
||||
(Just $
|
||||
"Couldn't connect to Zebra on " <>
|
||||
host <> ":" <> showt port <> ". Check your configuration.")
|
||||
False
|
||||
314259000
|
||||
(Just 30000)
|
||||
Orchard
|
||||
Nothing
|
||||
False
|
||||
False
|
||||
False
|
||||
False
|
||||
""
|
||||
Nothing
|
||||
""
|
||||
""
|
||||
(SaveAddress Nothing)
|
||||
False
|
||||
False
|
||||
Nothing
|
||||
Nothing
|
||||
0
|
||||
1.0
|
||||
False
|
||||
""
|
||||
0.0
|
||||
""
|
||||
False
|
||||
False
|
||||
Nothing
|
||||
hD
|
||||
startApp model handleEvent buildUI (params hD)
|
||||
x <- initDb dbFilePath
|
||||
case x of
|
||||
Left e2 -> throwIO $ userError e2
|
||||
Right x' -> do
|
||||
when x' $ rescanZebra host port dbFilePath
|
||||
generateQRCodes config
|
||||
walList <- getWallets pool $ zgb_net chainInfo
|
||||
accList <-
|
||||
if not (null walList)
|
||||
then runNoLoggingT $
|
||||
getAccounts pool $ entityKey $ head walList
|
||||
else return []
|
||||
addrList <-
|
||||
if not (null accList)
|
||||
then runNoLoggingT $
|
||||
getAddresses pool $ entityKey $ head accList
|
||||
else return []
|
||||
txList <-
|
||||
if not (null addrList)
|
||||
then getUserTx pool $ entityKey $ head addrList
|
||||
else return []
|
||||
qr <-
|
||||
if not (null addrList)
|
||||
then getQrCode pool Orchard $ entityKey $ head addrList
|
||||
else return Nothing
|
||||
bal <-
|
||||
if not (null accList)
|
||||
then getBalance pool $ entityKey $ head accList
|
||||
else return 0
|
||||
unconfBal <-
|
||||
if not (null accList)
|
||||
then getUnconfirmedBalance pool $ entityKey $ head accList
|
||||
else return 0
|
||||
let model =
|
||||
AppModel
|
||||
config
|
||||
(zgb_net chainInfo)
|
||||
walList
|
||||
0
|
||||
accList
|
||||
0
|
||||
addrList
|
||||
0
|
||||
txList
|
||||
0
|
||||
Nothing
|
||||
True
|
||||
bal
|
||||
(if unconfBal == 0
|
||||
then Nothing
|
||||
else Just unconfBal)
|
||||
Orchard
|
||||
qr
|
||||
False
|
||||
False
|
||||
False
|
||||
False
|
||||
""
|
||||
Nothing
|
||||
""
|
||||
""
|
||||
(SaveAddress $
|
||||
if not (null accList)
|
||||
then Just (head accList)
|
||||
else Nothing)
|
||||
False
|
||||
False
|
||||
Nothing
|
||||
Nothing
|
||||
0
|
||||
1.0
|
||||
False
|
||||
""
|
||||
0.0
|
||||
""
|
||||
False
|
||||
False
|
||||
Nothing
|
||||
hD
|
||||
startApp model handleEvent buildUI (params hD)
|
||||
Left _e -> print "Zebra not available"
|
||||
where
|
||||
params hd =
|
||||
[ appWindowTitle "Zenith - Zcash Full Node Wallet"
|
||||
|
|
|
|||
|
|
@ -40,6 +40,7 @@ import Zenith.Types
|
|||
( Config(..)
|
||||
, ZcashAccountAPI(..)
|
||||
, ZcashAddressAPI(..)
|
||||
, ZcashNoteAPI(..)
|
||||
, ZcashWalletAPI(..)
|
||||
)
|
||||
import Zenith.Utils (jsonNumber)
|
||||
|
|
@ -49,6 +50,7 @@ data ZenithMethod
|
|||
| ListWallets
|
||||
| ListAccounts
|
||||
| ListAddresses
|
||||
| ListReceived
|
||||
| UnknownMethod
|
||||
deriving (Eq, Prelude.Show)
|
||||
|
||||
|
|
@ -57,6 +59,7 @@ instance ToJSON ZenithMethod where
|
|||
toJSON ListWallets = Data.Aeson.String "listwallets"
|
||||
toJSON ListAccounts = Data.Aeson.String "listaccounts"
|
||||
toJSON ListAddresses = Data.Aeson.String "listaddresses"
|
||||
toJSON ListReceived = Data.Aeson.String "listreceived"
|
||||
toJSON UnknownMethod = Data.Aeson.Null
|
||||
|
||||
instance FromJSON ZenithMethod where
|
||||
|
|
@ -66,6 +69,7 @@ instance FromJSON ZenithMethod where
|
|||
"listwallets" -> pure ListWallets
|
||||
"listaccounts" -> pure ListAccounts
|
||||
"listaddresses" -> pure ListAddresses
|
||||
"listreceived" -> pure ListReceived
|
||||
_ -> pure UnknownMethod
|
||||
|
||||
data ZenithParams
|
||||
|
|
@ -73,6 +77,7 @@ data ZenithParams
|
|||
| BadParams
|
||||
| AccountsParams !Int
|
||||
| AddressesParams !Int
|
||||
| NotesParams !T.Text
|
||||
| TestParams !T.Text
|
||||
deriving (Eq, Prelude.Show)
|
||||
|
||||
|
|
@ -82,24 +87,23 @@ instance ToJSON ZenithParams where
|
|||
toJSON (AccountsParams n) = Data.Aeson.Array $ V.fromList [jsonNumber n]
|
||||
toJSON (AddressesParams n) = Data.Aeson.Array $ V.fromList [jsonNumber n]
|
||||
toJSON (TestParams t) = Data.Aeson.Array $ V.fromList [Data.Aeson.String t]
|
||||
toJSON (NotesParams t) = Data.Aeson.Array $ V.fromList [Data.Aeson.String t]
|
||||
|
||||
data ZenithResponse
|
||||
= InfoResponse !T.Text !ZenithInfo
|
||||
| WalletListResponse !T.Text ![ZcashWalletAPI]
|
||||
| AccountListResponse !T.Text ![ZcashAccountAPI]
|
||||
| AddressListResponse !T.Text ![ZcashAddressAPI]
|
||||
| NoteListResponse !T.Text ![ZcashNoteAPI]
|
||||
| ErrorResponse !T.Text !Double !T.Text
|
||||
deriving (Eq, Prelude.Show)
|
||||
|
||||
instance ToJSON ZenithResponse where
|
||||
toJSON (InfoResponse t i) =
|
||||
object ["jsonrpc" .= ("2.0" :: String), "id" .= t, "result" .= i]
|
||||
toJSON (WalletListResponse i w) =
|
||||
object ["jsonrpc" .= ("2.0" :: String), "id" .= i, "result" .= w]
|
||||
toJSON (AccountListResponse i a) =
|
||||
object ["jsonrpc" .= ("2.0" :: String), "id" .= i, "result" .= a]
|
||||
toJSON (AddressListResponse i a) =
|
||||
object ["jsonrpc" .= ("2.0" :: String), "id" .= i, "result" .= a]
|
||||
toJSON (InfoResponse t i) = packRpcResponse t i
|
||||
toJSON (WalletListResponse i w) = packRpcResponse i w
|
||||
toJSON (AccountListResponse i a) = packRpcResponse i a
|
||||
toJSON (AddressListResponse i a) = packRpcResponse i a
|
||||
toJSON (NoteListResponse i n) = packRpcResponse i n
|
||||
toJSON (ErrorResponse i c m) =
|
||||
object
|
||||
[ "jsonrpc" .= ("2.0" :: String)
|
||||
|
|
@ -109,7 +113,7 @@ instance ToJSON ZenithResponse where
|
|||
|
||||
instance FromJSON ZenithResponse where
|
||||
parseJSON =
|
||||
withObject "ZenithParams" $ \obj -> do
|
||||
withObject "ZenithResponse" $ \obj -> do
|
||||
jr <- obj .: "jsonrpc"
|
||||
i <- obj .: "id"
|
||||
e <- obj .:? "error"
|
||||
|
|
@ -138,6 +142,7 @@ instance FromJSON ZenithResponse where
|
|||
Object n' -> do
|
||||
v1 <- n' .:? "lastSync"
|
||||
v2 <- n' .:? "wallet"
|
||||
v3 <- n' .:? "ua"
|
||||
case (v1 :: Maybe Int) of
|
||||
Just _v1' -> do
|
||||
k2 <- parseJSON r1
|
||||
|
|
@ -147,7 +152,12 @@ instance FromJSON ZenithResponse where
|
|||
Just _v2' -> do
|
||||
k3 <- parseJSON r1
|
||||
pure $ AccountListResponse i k3
|
||||
Nothing -> fail "Unknown object"
|
||||
Nothing ->
|
||||
case (v3 :: Maybe String) of
|
||||
Just _v3' -> do
|
||||
k4 <- parseJSON r1
|
||||
pure $ AddressListResponse i k4
|
||||
Nothing -> fail "Unknown object"
|
||||
_anyOther -> fail "Malformed JSON"
|
||||
_anyOther -> fail "Malformed JSON"
|
||||
Just e1 -> pure $ ErrorResponse i (ecode e1) (emessage e1)
|
||||
|
|
@ -220,6 +230,16 @@ instance FromJSON RpcCall where
|
|||
pure $ RpcCall v i ListAddresses (AddressesParams x)
|
||||
else pure $ RpcCall v i ListAddresses BadParams
|
||||
_anyOther -> pure $ RpcCall v i ListAddresses BadParams
|
||||
ListReceived -> do
|
||||
p <- obj .: "params"
|
||||
case p of
|
||||
Array a ->
|
||||
if V.length a == 1
|
||||
then do
|
||||
x <- parseJSON $ V.head a
|
||||
pure $ RpcCall v i ListReceived (NotesParams x)
|
||||
else pure $ RpcCall v i ListReceived BadParams
|
||||
_anyOther -> pure $ RpcCall v i ListReceived BadParams
|
||||
|
||||
type ZenithRPC
|
||||
= "status" :> Get '[ JSON] Value :<|> BasicAuth "zenith-realm" Bool :> ReqBody
|
||||
|
|
@ -336,6 +356,11 @@ zenithServer config = getinfo :<|> handleRPC
|
|||
(ZenithInfo "0.7.0.0-beta" (zgb_net bI) (zgi_build zI))
|
||||
_anyOtherParams ->
|
||||
return $ ErrorResponse (callId req) (-32602) "Invalid params"
|
||||
ListReceived ->
|
||||
case parameters req of
|
||||
NotesParams x -> undefined
|
||||
_anyOtherParams ->
|
||||
return $ ErrorResponse (callId req) (-32602) "Invalid params"
|
||||
|
||||
authenticate :: Config -> BasicAuthCheck Bool
|
||||
authenticate config = BasicAuthCheck check
|
||||
|
|
@ -344,3 +369,7 @@ authenticate config = BasicAuthCheck check
|
|||
if username == c_zenithUser config && password == c_zenithPwd config
|
||||
then return $ Authorized True
|
||||
else return Unauthorized
|
||||
|
||||
packRpcResponse :: ToJSON a => T.Text -> a -> Value
|
||||
packRpcResponse i x =
|
||||
object ["jsonrpc" .= ("2.0" :: String), "id" .= i, "result" .= x]
|
||||
|
|
|
|||
|
|
@ -2,29 +2,22 @@
|
|||
|
||||
module Zenith.Scanner where
|
||||
|
||||
import Control.Concurrent.Async (concurrently_, withAsync)
|
||||
import Control.Exception (throwIO, try)
|
||||
import qualified Control.Monad.Catch as CM (try)
|
||||
import Control.Monad (when)
|
||||
import Control.Monad.IO.Class (liftIO)
|
||||
import Control.Monad.Logger
|
||||
( LoggingT
|
||||
, NoLoggingT
|
||||
, logErrorN
|
||||
, logInfoN
|
||||
, runNoLoggingT
|
||||
)
|
||||
import Control.Monad.Logger (NoLoggingT, logErrorN, logInfoN, runNoLoggingT)
|
||||
import Data.Aeson
|
||||
import Data.HexString
|
||||
import Data.Maybe
|
||||
import qualified Data.Text as T
|
||||
import Data.Time (getCurrentTime)
|
||||
import Database.Persist.Sqlite
|
||||
import GHC.Utils.Monad (concatMapM)
|
||||
import Lens.Micro ((&), (.~), (^.), set)
|
||||
import System.Console.AsciiProgress
|
||||
import ZcashHaskell.Types
|
||||
( BlockResponse(..)
|
||||
, RawZebraTx(..)
|
||||
, Transaction(..)
|
||||
, ZcashNet(..)
|
||||
, ZebraGetBlockChainInfo(..)
|
||||
, ZebraTxResponse(..)
|
||||
, fromRawOBundle
|
||||
|
|
@ -32,59 +25,68 @@ import ZcashHaskell.Types
|
|||
, fromRawTBundle
|
||||
)
|
||||
import ZcashHaskell.Utils (getBlockTime, makeZebraCall, readZebraTransaction)
|
||||
import Zenith.Core (checkBlockChain)
|
||||
import Zenith.Core (checkBlockChain, syncWallet)
|
||||
import Zenith.DB
|
||||
( getMaxBlock
|
||||
( clearWalletData
|
||||
, clearWalletTransactions
|
||||
, getMaxBlock
|
||||
, getMinBirthdayHeight
|
||||
, getUnconfirmedBlocks
|
||||
, getWallets
|
||||
, initDb
|
||||
, initPool
|
||||
, saveConfs
|
||||
, saveTransaction
|
||||
, updateWalletSync
|
||||
)
|
||||
import Zenith.Types (Config(..), ZcashNetDB(..))
|
||||
import Zenith.Utils (jsonNumber)
|
||||
|
||||
-- | Function to scan the Zcash blockchain through the Zebra node and populate the Zenith database
|
||||
scanZebra ::
|
||||
Int -- ^ Starting block
|
||||
-> T.Text -- ^ Host
|
||||
rescanZebra ::
|
||||
T.Text -- ^ Host
|
||||
-> Int -- ^ Port
|
||||
-> T.Text -- ^ Path to database file
|
||||
-> NoLoggingT IO ()
|
||||
scanZebra b host port dbFilePath = do
|
||||
_ <- liftIO $ initDb dbFilePath
|
||||
startTime <- liftIO getCurrentTime
|
||||
logInfoN $ "Started sync: " <> T.pack (show startTime)
|
||||
-> IO ()
|
||||
rescanZebra host port dbFilePath = do
|
||||
bc <-
|
||||
liftIO $ try $ checkBlockChain host port :: NoLoggingT
|
||||
IO
|
||||
try $ checkBlockChain host port :: IO
|
||||
(Either IOError ZebraGetBlockChainInfo)
|
||||
case bc of
|
||||
Left e -> logErrorN $ T.pack (show e)
|
||||
Left e -> print e
|
||||
Right bStatus -> do
|
||||
let dbInfo =
|
||||
mkSqliteConnectionInfo dbFilePath & extraPragmas .~
|
||||
["read_uncommited = true"]
|
||||
pool <- createSqlitePoolFromInfo dbInfo 5
|
||||
dbBlock <- getMaxBlock pool
|
||||
let znet = ZcashNetDB $ zgb_net bStatus
|
||||
pool1 <- runNoLoggingT $ initPool dbFilePath
|
||||
pool2 <- runNoLoggingT $ initPool dbFilePath
|
||||
pool3 <- runNoLoggingT $ initPool dbFilePath
|
||||
clearWalletTransactions pool1
|
||||
clearWalletData pool1
|
||||
dbBlock <- runNoLoggingT $ getMaxBlock pool1
|
||||
b <- liftIO $ getMinBirthdayHeight pool1
|
||||
let sb = max dbBlock b
|
||||
if sb > zgb_blocks bStatus || sb < 1
|
||||
then liftIO $ throwIO $ userError "Invalid starting block for scan"
|
||||
else do
|
||||
liftIO $
|
||||
print $
|
||||
"Scanning from " ++
|
||||
show (sb + 1) ++ " to " ++ show (zgb_blocks bStatus)
|
||||
let bList = [(sb + 1) .. (zgb_blocks bStatus)]
|
||||
displayConsoleRegions $ do
|
||||
pg <-
|
||||
liftIO $
|
||||
newProgressBar def {pgTotal = fromIntegral $ length bList}
|
||||
txList <-
|
||||
CM.try $ mapM_ (processBlock host port pool pg) bList :: NoLoggingT
|
||||
IO
|
||||
(Either IOError ())
|
||||
case txList of
|
||||
Left e1 -> logErrorN $ T.pack (show e1)
|
||||
Right txList' -> logInfoN "Finished scan"
|
||||
print $
|
||||
"Scanning from " ++ show sb ++ " to " ++ show (zgb_blocks bStatus)
|
||||
let bList = [sb .. (zgb_blocks bStatus)]
|
||||
{-
|
||||
let batch = length bList `div` 3
|
||||
let bl1 = take batch bList
|
||||
let bl2 = take batch $ drop batch bList
|
||||
let bl3 = drop (2 * batch) bList
|
||||
-}
|
||||
_ <-
|
||||
displayConsoleRegions $ do
|
||||
pg1 <- newProgressBar def {pgTotal = fromIntegral $ length bList}
|
||||
{-pg2 <- newProgressBar def {pgTotal = fromIntegral $ length bl2}-}
|
||||
{-pg3 <- newProgressBar def {pgTotal = fromIntegral $ length bl3}-}
|
||||
mapM_ (processBlock host port pool1 pg1 znet) bList
|
||||
{-`concurrently_`-}
|
||||
{-mapM_ (processBlock host port pool2 pg2 znet) bl2 `concurrently_`-}
|
||||
{-mapM_ (processBlock host port pool3 pg3 znet) bl3-}
|
||||
print "Please wait..."
|
||||
print "Rescan complete"
|
||||
|
||||
-- | Function to process a raw block and extract the transaction information
|
||||
processBlock ::
|
||||
|
|
@ -92,9 +94,10 @@ processBlock ::
|
|||
-> Int -- ^ Port for `zebrad`
|
||||
-> ConnectionPool -- ^ DB file path
|
||||
-> ProgressBar -- ^ Progress bar
|
||||
-> ZcashNetDB -- ^ the network
|
||||
-> Int -- ^ The block number to process
|
||||
-> NoLoggingT IO ()
|
||||
processBlock host port pool pg b = do
|
||||
-> IO ()
|
||||
processBlock host port pool pg net b = do
|
||||
r <-
|
||||
liftIO $
|
||||
makeZebraCall
|
||||
|
|
@ -116,7 +119,7 @@ processBlock host port pool pg b = do
|
|||
Left e2 -> liftIO $ throwIO $ userError e2
|
||||
Right hb -> do
|
||||
let blockTime = getBlockTime hb
|
||||
mapM_ (processTx host port blockTime pool) $
|
||||
mapM_ (processTx host port blockTime pool net) $
|
||||
bl_txs $ addTime blk blockTime
|
||||
liftIO $ tick pg
|
||||
where
|
||||
|
|
@ -134,9 +137,10 @@ processTx ::
|
|||
-> Int -- ^ Port for `zebrad`
|
||||
-> Int -- ^ Block time
|
||||
-> ConnectionPool -- ^ DB file path
|
||||
-> ZcashNetDB -- ^ the network
|
||||
-> HexString -- ^ transaction id
|
||||
-> NoLoggingT IO ()
|
||||
processTx host port bt pool t = do
|
||||
-> IO ()
|
||||
processTx host port bt pool net t = do
|
||||
r <-
|
||||
liftIO $
|
||||
makeZebraCall
|
||||
|
|
@ -151,7 +155,8 @@ processTx host port bt pool t = do
|
|||
Nothing -> return ()
|
||||
Just rzt -> do
|
||||
_ <-
|
||||
saveTransaction pool bt $
|
||||
runNoLoggingT $
|
||||
saveTransaction pool bt net $
|
||||
Transaction
|
||||
t
|
||||
(ztr_blockheight rawTx)
|
||||
|
|
@ -184,3 +189,27 @@ updateConfs host port pool = do
|
|||
Left e -> throwIO $ userError e
|
||||
Right blk -> do
|
||||
saveConfs pool b $ fromInteger $ bl_confirmations blk
|
||||
|
||||
clearSync :: Config -> IO ()
|
||||
clearSync config = do
|
||||
let zHost = c_zebraHost config
|
||||
let zPort = c_zebraPort config
|
||||
let dbPath = c_dbPath config
|
||||
pool <- runNoLoggingT $ initPool dbPath
|
||||
bc <-
|
||||
try $ checkBlockChain zHost zPort :: IO
|
||||
(Either IOError ZebraGetBlockChainInfo)
|
||||
case bc of
|
||||
Left e1 -> throwIO e1
|
||||
Right chainInfo -> do
|
||||
x <- initDb dbPath
|
||||
case x of
|
||||
Left e2 -> throwIO $ userError e2
|
||||
Right x' -> do
|
||||
when x' $ rescanZebra zHost zPort dbPath
|
||||
_ <- clearWalletTransactions pool
|
||||
w <- getWallets pool $ zgb_net chainInfo
|
||||
liftIO $ mapM_ (updateWalletSync pool 0 . entityKey) w
|
||||
w' <- liftIO $ getWallets pool $ zgb_net chainInfo
|
||||
r <- mapM (syncWallet config) w'
|
||||
liftIO $ print r
|
||||
|
|
|
|||
|
|
@ -320,7 +320,7 @@
|
|||
"Address": {
|
||||
"name": "Address identifier",
|
||||
"summary": "The address identifier",
|
||||
"description": "A string that identifies a specific address, either by its index or the address itself",
|
||||
"description": "A string that identifies a specific address, either by its index or the [ZIP-316](https://zips.z.cash/zip-0316) encoded address itself",
|
||||
"required": true,
|
||||
"schema": {
|
||||
"type": "string"
|
||||
|
|
|
|||
15
zenith.cabal
15
zenith.cabal
|
|
@ -42,6 +42,7 @@ library
|
|||
Clipboard
|
||||
, aeson
|
||||
, array
|
||||
, async
|
||||
, ascii-progress
|
||||
, base >=4.12 && <5
|
||||
, base64-bytestring
|
||||
|
|
@ -113,19 +114,6 @@ executable zenith
|
|||
pkgconfig-depends: rustzcash_wrapper
|
||||
default-language: Haskell2010
|
||||
|
||||
executable zenscan
|
||||
ghc-options: -main-is ZenScan -threaded -rtsopts -with-rtsopts=-N
|
||||
main-is: ZenScan.hs
|
||||
hs-source-dirs:
|
||||
app
|
||||
build-depends:
|
||||
base >=4.12 && <5
|
||||
, configurator
|
||||
, monad-logger
|
||||
, zenith
|
||||
pkgconfig-depends: rustzcash_wrapper
|
||||
default-language: Haskell2010
|
||||
|
||||
executable zenithserver
|
||||
ghc-options: -main-is Server -threaded -rtsopts -with-rtsopts=-N
|
||||
main-is: Server.hs
|
||||
|
|
@ -137,6 +125,7 @@ executable zenithserver
|
|||
, wai-extra
|
||||
, warp
|
||||
, servant-server
|
||||
, zcash-haskell
|
||||
, zenith
|
||||
pkgconfig-depends: rustzcash_wrapper
|
||||
default-language: Haskell2010
|
||||
|
|
|
|||
Loading…
Reference in a new issue