feat(rpc): background wallet sync
This commit is contained in:
parent
7410eed991
commit
c75316ddd7
GPG key ID:
65122AD495A7F5B2
7 changed files with 430 additions and 188 deletions
|
|
@ -20,6 +20,7 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0
|
|||
- `getnewaccount` RPC method
|
||||
- `getnewaddress` RPC method
|
||||
- `getoperationstatus` RPC method
|
||||
- `sendmany` RPC method
|
||||
- Function `prepareTxV2` implementing `PrivacyPolicy`
|
||||
|
||||
### Changed
|
||||
|
|
@ -27,6 +28,7 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0
|
|||
- Detection of changes in database schema for automatic re-scan
|
||||
- Block tracking for chain re-org detection
|
||||
- Refactored `ZcashPool`
|
||||
- Preventing write operations to occur during wallet sync
|
||||
|
||||
|
||||
## [0.6.0.0-beta]
|
||||
|
|
|
|||
|
|
@ -2,15 +2,22 @@
|
|||
|
||||
module Server where
|
||||
|
||||
import Control.Concurrent (forkIO, threadDelay)
|
||||
import Control.Exception (throwIO, try)
|
||||
import Control.Monad (when)
|
||||
import Control.Monad (forever, 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 (State(..), ZenithRPC(..), authenticate, zenithServer)
|
||||
import Zenith.RPC
|
||||
( State(..)
|
||||
, ZenithRPC(..)
|
||||
, authenticate
|
||||
, scanZebra
|
||||
, zenithServer
|
||||
)
|
||||
import Zenith.Scanner (rescanZebra)
|
||||
import Zenith.Types (Config(..))
|
||||
|
||||
|
|
@ -39,6 +46,12 @@ main = do
|
|||
Left e2 -> throwIO $ userError e2
|
||||
Right x' -> do
|
||||
when x' $ rescanZebra zebraHost zebraPort dbFilePath
|
||||
_ <-
|
||||
forkIO $
|
||||
forever $ do
|
||||
_ <-
|
||||
scanZebra dbFilePath zebraHost zebraPort (zgb_net chainInfo)
|
||||
threadDelay 90000000
|
||||
let myState =
|
||||
State
|
||||
(zgb_net chainInfo)
|
||||
|
|
|
|||
|
|
@ -102,6 +102,7 @@ import Zenith.Types
|
|||
, PrivacyPolicy(..)
|
||||
, UnifiedAddressDB(..)
|
||||
, ZcashNetDB(..)
|
||||
, ZenithStatus(..)
|
||||
)
|
||||
import Zenith.Utils
|
||||
( displayTaz
|
||||
|
|
@ -752,34 +753,45 @@ scanZebra dbP zHost zPort b eChan znet = do
|
|||
pool <- liftIO $ runNoLoggingT $ initPool dbP
|
||||
dbBlock <- liftIO $ getMaxBlock pool $ ZcashNetDB znet
|
||||
chkBlock <- liftIO $ checkIntegrity dbP zHost zPort dbBlock 1
|
||||
logDebugN $
|
||||
"dbBlock: " <>
|
||||
T.pack (show dbBlock) <> " chkBlock: " <> T.pack (show chkBlock)
|
||||
when (chkBlock /= dbBlock) $ liftIO $ rewindWalletData pool chkBlock
|
||||
let sb =
|
||||
if chkBlock == dbBlock
|
||||
then max dbBlock b
|
||||
else max chkBlock b
|
||||
if sb > zgb_blocks bStatus || sb < 1
|
||||
then do
|
||||
liftIO $ BC.writeBChan eChan $ TickMsg "Invalid starting block for scan"
|
||||
syncChk <- liftIO $ isSyncing pool
|
||||
if syncChk
|
||||
then liftIO $ BC.writeBChan eChan $ TickMsg "Sync alread in progress"
|
||||
else do
|
||||
let bList = [(sb + 1) .. (zgb_blocks bStatus)]
|
||||
if not (null bList)
|
||||
logDebugN $
|
||||
"dbBlock: " <>
|
||||
T.pack (show dbBlock) <> " chkBlock: " <> T.pack (show chkBlock)
|
||||
when (chkBlock /= dbBlock) $ liftIO $ rewindWalletData pool chkBlock
|
||||
let sb =
|
||||
if chkBlock == dbBlock
|
||||
then max dbBlock b
|
||||
else max chkBlock b
|
||||
if sb > zgb_blocks bStatus || sb < 1
|
||||
then do
|
||||
let step =
|
||||
(1.0 :: Float) / fromIntegral (zgb_blocks bStatus - (sb + 1))
|
||||
mapM_ (liftIO . processBlock pool step) bList
|
||||
else liftIO $ BC.writeBChan eChan $ TickVal 1.0
|
||||
confUp <-
|
||||
liftIO $ try $ updateConfs zHost zPort pool :: LoggingT
|
||||
IO
|
||||
(Either IOError ())
|
||||
case confUp of
|
||||
Left _e0 ->
|
||||
liftIO $
|
||||
BC.writeBChan eChan $ TickMsg "Failed to update unconfirmed transactions"
|
||||
Right _ -> return ()
|
||||
liftIO $
|
||||
BC.writeBChan eChan $ TickMsg "Invalid starting block for scan"
|
||||
else do
|
||||
let bList = [(sb + 1) .. (zgb_blocks bStatus)]
|
||||
if not (null bList)
|
||||
then do
|
||||
let step =
|
||||
(1.0 :: Float) /
|
||||
fromIntegral (zgb_blocks bStatus - (sb + 1))
|
||||
_ <- liftIO $ startSync pool
|
||||
mapM_ (liftIO . processBlock pool step) bList
|
||||
confUp <-
|
||||
liftIO $ try $ updateConfs zHost zPort pool :: LoggingT
|
||||
IO
|
||||
(Either IOError ())
|
||||
case confUp of
|
||||
Left _e0 -> do
|
||||
_ <- liftIO $ completeSync pool Failed
|
||||
liftIO $
|
||||
BC.writeBChan eChan $
|
||||
TickMsg "Failed to update unconfirmed transactions"
|
||||
Right _ -> do
|
||||
_ <- liftIO $ completeSync pool Successful
|
||||
return ()
|
||||
else liftIO $ BC.writeBChan eChan $ TickVal 1.0
|
||||
where
|
||||
processBlock :: ConnectionPool -> Float -> Int -> IO ()
|
||||
processBlock pool step bl = do
|
||||
|
|
@ -791,7 +803,9 @@ scanZebra dbP zHost zPort b eChan znet = do
|
|||
"getblock"
|
||||
[Data.Aeson.String $ T.pack $ show bl, jsonNumber 1]
|
||||
case r of
|
||||
Left e1 -> liftIO $ BC.writeBChan eChan $ TickMsg e1
|
||||
Left e1 -> do
|
||||
_ <- liftIO $ completeSync pool Failed
|
||||
liftIO $ BC.writeBChan eChan $ TickMsg e1
|
||||
Right blk -> do
|
||||
r2 <-
|
||||
liftIO $
|
||||
|
|
@ -801,7 +815,9 @@ scanZebra dbP zHost zPort b eChan znet = do
|
|||
"getblock"
|
||||
[Data.Aeson.String $ T.pack $ show bl, jsonNumber 0]
|
||||
case r2 of
|
||||
Left e2 -> liftIO $ BC.writeBChan eChan $ TickMsg e2
|
||||
Left e2 -> do
|
||||
_ <- liftIO $ completeSync pool Failed
|
||||
liftIO $ BC.writeBChan eChan $ TickMsg e2
|
||||
Right hb -> do
|
||||
let blockTime = getBlockTime hb
|
||||
bi <-
|
||||
|
|
|
|||
|
|
@ -291,6 +291,13 @@ share
|
|||
result T.Text Maybe
|
||||
UniqueOp uuid
|
||||
deriving Show Eq
|
||||
ChainSync
|
||||
name T.Text
|
||||
start UTCTime
|
||||
end UTCTime Maybe
|
||||
status ZenithStatus
|
||||
UniqueSync name
|
||||
deriving Show Eq
|
||||
|]
|
||||
|
||||
-- ** Type conversions
|
||||
|
|
@ -2329,6 +2336,46 @@ finalizeOperation pool op status result = do
|
|||
]
|
||||
where_ (ops ^. OperationId ==. val op)
|
||||
|
||||
-- * Chain sync
|
||||
-- | Check if the wallet is currently running a sync
|
||||
isSyncing :: ConnectionPool -> IO Bool
|
||||
isSyncing pool = do
|
||||
s <-
|
||||
runNoLoggingT $
|
||||
PS.retryOnBusy $
|
||||
flip PS.runSqlPool pool $
|
||||
selectOne $ do
|
||||
r <- from $ table @ChainSync
|
||||
where_ $ r ^. ChainSyncStatus ==. val Processing
|
||||
pure r
|
||||
case s of
|
||||
Nothing -> return False
|
||||
Just _ -> return True
|
||||
|
||||
-- | Record the start of a sync
|
||||
startSync :: ConnectionPool -> IO ()
|
||||
startSync pool = do
|
||||
start <- getCurrentTime
|
||||
_ <-
|
||||
runNoLoggingT $
|
||||
PS.retryOnBusy $
|
||||
flip PS.runSqlPool pool $
|
||||
upsert (ChainSync "Internal" start Nothing Processing) []
|
||||
return ()
|
||||
|
||||
-- | Complete a sync
|
||||
completeSync :: ConnectionPool -> ZenithStatus -> IO ()
|
||||
completeSync pool st = do
|
||||
end <- getCurrentTime
|
||||
_ <-
|
||||
runNoLoggingT $
|
||||
PS.retryOnBusy $
|
||||
flip PS.runSqlPool pool $
|
||||
update $ \s -> do
|
||||
set s [ChainSyncEnd =. val (Just end), ChainSyncStatus =. val st]
|
||||
where_ (s ^. ChainSyncName ==. val "Internal")
|
||||
return ()
|
||||
|
||||
-- | Rewind the data store to a given block height
|
||||
rewindWalletData :: ConnectionPool -> Int -> IO ()
|
||||
rewindWalletData pool b = do
|
||||
|
|
|
|||
|
|
@ -1475,7 +1475,6 @@ handleEvent wenv node model evt =
|
|||
res <- liftIO $ updateAdrsInAdrBook pool d a a
|
||||
return $ ShowMessage "Address Book entry updated!!"
|
||||
|
||||
-- model & recipientValid .~ ((model ^. privacyChoice) == Low) ]
|
||||
scanZebra :: T.Text -> T.Text -> Int -> ZcashNet -> (AppEvent -> IO ()) -> IO ()
|
||||
scanZebra dbPath zHost zPort net sendMsg = do
|
||||
bStatus <- liftIO $ checkBlockChain zHost zPort
|
||||
|
|
@ -1483,24 +1482,35 @@ scanZebra dbPath zHost zPort net sendMsg = do
|
|||
b <- liftIO $ getMinBirthdayHeight pool
|
||||
dbBlock <- getMaxBlock pool $ ZcashNetDB net
|
||||
chkBlock <- checkIntegrity dbPath zHost zPort dbBlock 1
|
||||
unless (chkBlock == dbBlock) $ rewindWalletData pool chkBlock
|
||||
let sb =
|
||||
if chkBlock == dbBlock
|
||||
then max dbBlock b
|
||||
else max chkBlock b
|
||||
if sb > zgb_blocks bStatus || sb < 1
|
||||
then sendMsg (ShowError "Invalid starting block for scan")
|
||||
syncChk <- isSyncing pool
|
||||
if syncChk
|
||||
then sendMsg (ShowError "Sync already in progress")
|
||||
else do
|
||||
let bList = [(sb + 1) .. (zgb_blocks bStatus)]
|
||||
if not (null bList)
|
||||
then do
|
||||
let step = (1.0 :: Float) / fromIntegral (length bList)
|
||||
mapM_ (processBlock pool step) bList
|
||||
else sendMsg (SyncVal 1.0)
|
||||
confUp <- try $ updateConfs zHost zPort pool :: IO (Either IOError ())
|
||||
case confUp of
|
||||
Left _e0 -> sendMsg (ShowError "Failed to update unconfirmed transactions")
|
||||
Right _ -> return ()
|
||||
unless (chkBlock == dbBlock) $ rewindWalletData pool chkBlock
|
||||
let sb =
|
||||
if chkBlock == dbBlock
|
||||
then max dbBlock b
|
||||
else max chkBlock b
|
||||
if sb > zgb_blocks bStatus || sb < 1
|
||||
then sendMsg (ShowError "Invalid starting block for scan")
|
||||
else do
|
||||
let bList = [(sb + 1) .. (zgb_blocks bStatus)]
|
||||
if not (null bList)
|
||||
then do
|
||||
let step = (1.0 :: Float) / fromIntegral (length bList)
|
||||
_ <- startSync pool
|
||||
mapM_ (processBlock pool step) bList
|
||||
confUp <-
|
||||
try $ updateConfs zHost zPort pool :: IO (Either IOError ())
|
||||
case confUp of
|
||||
Left _e0 -> do
|
||||
_ <- completeSync pool Failed
|
||||
sendMsg
|
||||
(ShowError "Failed to update unconfirmed transactions")
|
||||
Right _ -> do
|
||||
_ <- completeSync pool Successful
|
||||
return ()
|
||||
else sendMsg (SyncVal 1.0)
|
||||
where
|
||||
processBlock :: ConnectionPool -> Float -> Int -> IO ()
|
||||
processBlock pool step bl = do
|
||||
|
|
@ -1512,7 +1522,9 @@ scanZebra dbPath zHost zPort net sendMsg = do
|
|||
"getblock"
|
||||
[Data.Aeson.String $ showt bl, jsonNumber 1]
|
||||
case r of
|
||||
Left e1 -> sendMsg (ShowError $ showt e1)
|
||||
Left e1 -> do
|
||||
_ <- completeSync pool Failed
|
||||
sendMsg (ShowError $ showt e1)
|
||||
Right blk -> do
|
||||
r2 <-
|
||||
liftIO $
|
||||
|
|
@ -1522,7 +1534,9 @@ scanZebra dbPath zHost zPort net sendMsg = do
|
|||
"getblock"
|
||||
[Data.Aeson.String $ showt bl, jsonNumber 0]
|
||||
case r2 of
|
||||
Left e2 -> sendMsg (ShowError $ showt e2)
|
||||
Left e2 -> do
|
||||
_ <- completeSync pool Failed
|
||||
sendMsg (ShowError $ showt e2)
|
||||
Right hb -> do
|
||||
let blockTime = getBlockTime hb
|
||||
bi <-
|
||||
|
|
|
|||
|
|
@ -14,8 +14,9 @@ module Zenith.RPC where
|
|||
|
||||
import Control.Concurrent (forkIO)
|
||||
import Control.Exception (try)
|
||||
import Control.Monad (unless, when)
|
||||
import Control.Monad.IO.Class (liftIO)
|
||||
import Control.Monad.Logger (runFileLoggingT, runNoLoggingT)
|
||||
import Control.Monad.Logger (runFileLoggingT, runNoLoggingT, runStderrLoggingT)
|
||||
import Data.Aeson
|
||||
import qualified Data.HexString as H
|
||||
import Data.Int
|
||||
|
|
@ -27,7 +28,8 @@ import qualified Data.UUID as U
|
|||
import Data.UUID.V4 (nextRandom)
|
||||
import qualified Data.Vector as V
|
||||
import Database.Esqueleto.Experimental
|
||||
( entityKey
|
||||
( ConnectionPool
|
||||
, entityKey
|
||||
, entityVal
|
||||
, fromSqlKey
|
||||
, toSqlKey
|
||||
|
|
@ -36,13 +38,27 @@ import Servant
|
|||
import Text.Read (readMaybe)
|
||||
import ZcashHaskell.Keys (generateWalletSeedPhrase)
|
||||
import ZcashHaskell.Orchard (parseAddress)
|
||||
import ZcashHaskell.Types (RpcError(..), Scope(..), ZcashNet(..))
|
||||
import ZcashHaskell.Utils (makeZebraCall)
|
||||
import Zenith.Core (createCustomWalletAddress, createZcashAccount, prepareTxV2)
|
||||
import ZcashHaskell.Types
|
||||
( BlockResponse(..)
|
||||
, RpcError(..)
|
||||
, Scope(..)
|
||||
, ZcashNet(..)
|
||||
, ZebraGetBlockChainInfo(..)
|
||||
)
|
||||
import ZcashHaskell.Utils (getBlockTime, makeZebraCall)
|
||||
import Zenith.Core
|
||||
( checkBlockChain
|
||||
, createCustomWalletAddress
|
||||
, createZcashAccount
|
||||
, prepareTxV2
|
||||
, syncWallet
|
||||
)
|
||||
import Zenith.DB
|
||||
( Operation(..)
|
||||
, ZcashAccount(..)
|
||||
, ZcashBlock(..)
|
||||
, ZcashWallet(..)
|
||||
, completeSync
|
||||
, finalizeOperation
|
||||
, findNotesByAddress
|
||||
, getAccountById
|
||||
|
|
@ -53,24 +69,32 @@ import Zenith.DB
|
|||
, getLastSyncBlock
|
||||
, getMaxAccount
|
||||
, getMaxAddress
|
||||
, getMaxBlock
|
||||
, getMinBirthdayHeight
|
||||
, getOperation
|
||||
, getPoolBalance
|
||||
, getUnconfPoolBalance
|
||||
, getWalletNotes
|
||||
, getWallets
|
||||
, initPool
|
||||
, isSyncing
|
||||
, rewindWalletData
|
||||
, saveAccount
|
||||
, saveAddress
|
||||
, saveBlock
|
||||
, saveOperation
|
||||
, saveWallet
|
||||
, startSync
|
||||
, toZcashAccountAPI
|
||||
, toZcashAddressAPI
|
||||
, toZcashWalletAPI
|
||||
, walletExists
|
||||
)
|
||||
import Zenith.Scanner (checkIntegrity, processTx, updateConfs)
|
||||
import Zenith.Types
|
||||
( AccountBalance(..)
|
||||
, Config(..)
|
||||
, HexStringDB(..)
|
||||
, PhraseDB(..)
|
||||
, PrivacyPolicy(..)
|
||||
, ProposedNote(..)
|
||||
|
|
@ -622,27 +646,35 @@ zenithServer state = getinfo :<|> handleRPC
|
|||
case parameters req of
|
||||
NameParams t -> do
|
||||
let dbPath = w_dbPath state
|
||||
sP <- liftIO generateWalletSeedPhrase
|
||||
pool <- liftIO $ runNoLoggingT $ initPool dbPath
|
||||
r <-
|
||||
liftIO $
|
||||
saveWallet pool $
|
||||
ZcashWallet
|
||||
t
|
||||
(ZcashNetDB $ w_network state)
|
||||
(PhraseDB sP)
|
||||
(w_startBlock state)
|
||||
0
|
||||
case r of
|
||||
Nothing ->
|
||||
return $
|
||||
ErrorResponse
|
||||
(callId req)
|
||||
(-32007)
|
||||
"Entity with that name already exists."
|
||||
Just r' ->
|
||||
return $
|
||||
NewItemResponse (callId req) $ fromSqlKey $ entityKey r'
|
||||
syncChk <- liftIO $ isSyncing pool
|
||||
if syncChk
|
||||
then return $
|
||||
ErrorResponse
|
||||
(callId req)
|
||||
(-32012)
|
||||
"The Zenith server is syncing, please try again later."
|
||||
else do
|
||||
sP <- liftIO generateWalletSeedPhrase
|
||||
r <-
|
||||
liftIO $
|
||||
saveWallet pool $
|
||||
ZcashWallet
|
||||
t
|
||||
(ZcashNetDB $ w_network state)
|
||||
(PhraseDB sP)
|
||||
(w_startBlock state)
|
||||
0
|
||||
case r of
|
||||
Nothing ->
|
||||
return $
|
||||
ErrorResponse
|
||||
(callId req)
|
||||
(-32007)
|
||||
"Entity with that name already exists."
|
||||
Just r' ->
|
||||
return $
|
||||
NewItemResponse (callId req) $ fromSqlKey $ entityKey r'
|
||||
_anyOtherParams ->
|
||||
return $ ErrorResponse (callId req) (-32602) "Invalid params"
|
||||
GetNewAccount ->
|
||||
|
|
@ -650,34 +682,45 @@ zenithServer state = getinfo :<|> handleRPC
|
|||
NameIdParams t i -> do
|
||||
let dbPath = w_dbPath state
|
||||
pool <- liftIO $ runNoLoggingT $ initPool dbPath
|
||||
w <- liftIO $ walletExists pool i
|
||||
case w of
|
||||
Just w' -> do
|
||||
aIdx <- liftIO $ getMaxAccount pool $ entityKey w'
|
||||
nAcc <-
|
||||
liftIO
|
||||
(try $ createZcashAccount t (aIdx + 1) w' :: IO
|
||||
(Either IOError ZcashAccount))
|
||||
case nAcc of
|
||||
Left e ->
|
||||
syncChk <- liftIO $ isSyncing pool
|
||||
if syncChk
|
||||
then return $
|
||||
ErrorResponse
|
||||
(callId req)
|
||||
(-32012)
|
||||
"The Zenith server is syncing, please try again later."
|
||||
else do
|
||||
w <- liftIO $ walletExists pool i
|
||||
case w of
|
||||
Just w' -> do
|
||||
aIdx <- liftIO $ getMaxAccount pool $ entityKey w'
|
||||
nAcc <-
|
||||
liftIO
|
||||
(try $ createZcashAccount t (aIdx + 1) w' :: IO
|
||||
(Either IOError ZcashAccount))
|
||||
case nAcc of
|
||||
Left e ->
|
||||
return $
|
||||
ErrorResponse (callId req) (-32010) $ T.pack $ show e
|
||||
Right nAcc' -> do
|
||||
r <- liftIO $ saveAccount pool nAcc'
|
||||
case r of
|
||||
Nothing ->
|
||||
return $
|
||||
ErrorResponse
|
||||
(callId req)
|
||||
(-32007)
|
||||
"Entity with that name already exists."
|
||||
Just x ->
|
||||
return $
|
||||
NewItemResponse (callId req) $
|
||||
fromSqlKey $ entityKey x
|
||||
Nothing ->
|
||||
return $
|
||||
ErrorResponse (callId req) (-32010) $ T.pack $ show e
|
||||
Right nAcc' -> do
|
||||
r <- liftIO $ saveAccount pool nAcc'
|
||||
case r of
|
||||
Nothing ->
|
||||
return $
|
||||
ErrorResponse
|
||||
(callId req)
|
||||
(-32007)
|
||||
"Entity with that name already exists."
|
||||
Just x ->
|
||||
return $
|
||||
NewItemResponse (callId req) $
|
||||
fromSqlKey $ entityKey x
|
||||
Nothing ->
|
||||
return $
|
||||
ErrorResponse (callId req) (-32008) "Wallet does not exist."
|
||||
ErrorResponse
|
||||
(callId req)
|
||||
(-32008)
|
||||
"Wallet does not exist."
|
||||
_anyOtherParams ->
|
||||
return $ ErrorResponse (callId req) (-32602) "Invalid params"
|
||||
GetNewAddress ->
|
||||
|
|
@ -686,35 +729,49 @@ zenithServer state = getinfo :<|> handleRPC
|
|||
let dbPath = w_dbPath state
|
||||
let net = w_network state
|
||||
pool <- liftIO $ runNoLoggingT $ initPool dbPath
|
||||
acc <- liftIO $ getAccountById pool $ toSqlKey $ fromIntegral i
|
||||
case acc of
|
||||
Just acc' -> do
|
||||
maxAddr <-
|
||||
liftIO $ getMaxAddress pool (entityKey acc') External
|
||||
newAddr <-
|
||||
liftIO $
|
||||
createCustomWalletAddress
|
||||
n
|
||||
(maxAddr + 1)
|
||||
net
|
||||
External
|
||||
acc'
|
||||
s
|
||||
t
|
||||
dbAddr <- liftIO $ saveAddress pool newAddr
|
||||
case dbAddr of
|
||||
Just nAddr -> do
|
||||
return $
|
||||
NewAddrResponse (callId req) (toZcashAddressAPI nAddr)
|
||||
syncChk <- liftIO $ isSyncing pool
|
||||
if syncChk
|
||||
then return $
|
||||
ErrorResponse
|
||||
(callId req)
|
||||
(-32012)
|
||||
"The Zenith server is syncing, please try again later."
|
||||
else do
|
||||
acc <-
|
||||
liftIO $ getAccountById pool $ toSqlKey $ fromIntegral i
|
||||
case acc of
|
||||
Just acc' -> do
|
||||
maxAddr <-
|
||||
liftIO $ getMaxAddress pool (entityKey acc') External
|
||||
newAddr <-
|
||||
liftIO $
|
||||
createCustomWalletAddress
|
||||
n
|
||||
(maxAddr + 1)
|
||||
net
|
||||
External
|
||||
acc'
|
||||
s
|
||||
t
|
||||
dbAddr <- liftIO $ saveAddress pool newAddr
|
||||
case dbAddr of
|
||||
Just nAddr -> do
|
||||
return $
|
||||
NewAddrResponse
|
||||
(callId req)
|
||||
(toZcashAddressAPI nAddr)
|
||||
Nothing ->
|
||||
return $
|
||||
ErrorResponse
|
||||
(callId req)
|
||||
(-32007)
|
||||
"Entity with that name already exists."
|
||||
Nothing ->
|
||||
return $
|
||||
ErrorResponse
|
||||
(callId req)
|
||||
(-32007)
|
||||
"Entity with that name already exists."
|
||||
Nothing ->
|
||||
return $
|
||||
ErrorResponse (callId req) (-32006) "Account does not exist."
|
||||
(-32006)
|
||||
"Account does not exist."
|
||||
_anyOtherParams ->
|
||||
return $ ErrorResponse (callId req) (-32602) "Invalid params"
|
||||
GetOperationStatus ->
|
||||
|
|
@ -739,65 +796,79 @@ zenithServer state = getinfo :<|> handleRPC
|
|||
let zPort = w_port state
|
||||
let znet = w_network state
|
||||
pool <- liftIO $ runNoLoggingT $ initPool dbPath
|
||||
opid <- liftIO nextRandom
|
||||
startTime <- liftIO getCurrentTime
|
||||
opkey <-
|
||||
liftIO $
|
||||
saveOperation pool $
|
||||
Operation (ZenithUuid opid) startTime Nothing Processing Nothing
|
||||
case opkey of
|
||||
Nothing ->
|
||||
return $ ErrorResponse (callId req) (-32010) "Internal Error"
|
||||
Just opkey' -> do
|
||||
acc <-
|
||||
liftIO $ getAccountById pool $ toSqlKey $ fromIntegral a
|
||||
case acc of
|
||||
Just acc' -> do
|
||||
bl <-
|
||||
liftIO $
|
||||
getLastSyncBlock
|
||||
pool
|
||||
(zcashAccountWalletId $ entityVal acc')
|
||||
_ <-
|
||||
liftIO $
|
||||
forkIO $ do
|
||||
res <-
|
||||
liftIO $
|
||||
runNoLoggingT $
|
||||
prepareTxV2
|
||||
pool
|
||||
zHost
|
||||
zPort
|
||||
znet
|
||||
(entityKey acc')
|
||||
bl
|
||||
ns
|
||||
p
|
||||
case res of
|
||||
Left e ->
|
||||
finalizeOperation pool opkey' Failed $
|
||||
T.pack $ show e
|
||||
Right rawTx -> do
|
||||
zebraRes <-
|
||||
makeZebraCall
|
||||
zHost
|
||||
zPort
|
||||
"sendrawtransaction"
|
||||
[Data.Aeson.String $ H.toText rawTx]
|
||||
case zebraRes of
|
||||
Left e1 ->
|
||||
finalizeOperation pool opkey' Failed $
|
||||
T.pack $ show e1
|
||||
Right txId ->
|
||||
finalizeOperation pool opkey' Successful $
|
||||
"Tx ID: " <> H.toText txId
|
||||
return $ SendResponse (callId req) opid
|
||||
syncChk <- liftIO $ isSyncing pool
|
||||
if syncChk
|
||||
then return $
|
||||
ErrorResponse
|
||||
(callId req)
|
||||
(-32012)
|
||||
"The Zenith server is syncing, please try again later."
|
||||
else do
|
||||
opid <- liftIO nextRandom
|
||||
startTime <- liftIO getCurrentTime
|
||||
opkey <-
|
||||
liftIO $
|
||||
saveOperation pool $
|
||||
Operation
|
||||
(ZenithUuid opid)
|
||||
startTime
|
||||
Nothing
|
||||
Processing
|
||||
Nothing
|
||||
case opkey of
|
||||
Nothing ->
|
||||
return $
|
||||
ErrorResponse
|
||||
(callId req)
|
||||
(-32006)
|
||||
"Account does not exist."
|
||||
ErrorResponse (callId req) (-32010) "Internal Error"
|
||||
Just opkey' -> do
|
||||
acc <-
|
||||
liftIO $ getAccountById pool $ toSqlKey $ fromIntegral a
|
||||
case acc of
|
||||
Just acc' -> do
|
||||
bl <-
|
||||
liftIO $
|
||||
getLastSyncBlock
|
||||
pool
|
||||
(zcashAccountWalletId $ entityVal acc')
|
||||
_ <-
|
||||
liftIO $
|
||||
forkIO $ do
|
||||
res <-
|
||||
liftIO $
|
||||
runNoLoggingT $
|
||||
prepareTxV2
|
||||
pool
|
||||
zHost
|
||||
zPort
|
||||
znet
|
||||
(entityKey acc')
|
||||
bl
|
||||
ns
|
||||
p
|
||||
case res of
|
||||
Left e ->
|
||||
finalizeOperation pool opkey' Failed $
|
||||
T.pack $ show e
|
||||
Right rawTx -> do
|
||||
zebraRes <-
|
||||
makeZebraCall
|
||||
zHost
|
||||
zPort
|
||||
"sendrawtransaction"
|
||||
[Data.Aeson.String $ H.toText rawTx]
|
||||
case zebraRes of
|
||||
Left e1 ->
|
||||
finalizeOperation pool opkey' Failed $
|
||||
T.pack $ show e1
|
||||
Right txId ->
|
||||
finalizeOperation pool opkey' Successful $
|
||||
"Tx ID: " <> H.toText txId
|
||||
return $ SendResponse (callId req) opid
|
||||
Nothing ->
|
||||
return $
|
||||
ErrorResponse
|
||||
(callId req)
|
||||
(-32006)
|
||||
"Account does not exist."
|
||||
_anyOtherParams ->
|
||||
return $ ErrorResponse (callId req) (-32602) "Invalid params"
|
||||
|
||||
|
|
@ -812,3 +883,67 @@ authenticate config = BasicAuthCheck check
|
|||
packRpcResponse :: ToJSON a => T.Text -> a -> Value
|
||||
packRpcResponse i x =
|
||||
object ["jsonrpc" .= ("2.0" :: String), "id" .= i, "result" .= x]
|
||||
|
||||
scanZebra :: T.Text -> T.Text -> Int -> ZcashNet -> IO ()
|
||||
scanZebra dbPath zHost zPort net = do
|
||||
bStatus <- checkBlockChain zHost zPort
|
||||
pool <- runNoLoggingT $ initPool dbPath
|
||||
b <- getMinBirthdayHeight pool
|
||||
dbBlock <- getMaxBlock pool $ ZcashNetDB net
|
||||
chkBlock <- checkIntegrity dbPath zHost zPort dbBlock 1
|
||||
syncChk <- isSyncing pool
|
||||
unless syncChk $ do
|
||||
unless (chkBlock == dbBlock) $ rewindWalletData pool chkBlock
|
||||
let sb =
|
||||
if chkBlock == dbBlock
|
||||
then max dbBlock b
|
||||
else max chkBlock b
|
||||
unless (sb > zgb_blocks bStatus || sb < 1) $ do
|
||||
let bList = [(sb + 1) .. (zgb_blocks bStatus)]
|
||||
unless (null bList) $ do
|
||||
_ <- startSync pool
|
||||
mapM_ (processBlock pool) bList
|
||||
confUp <- try $ updateConfs zHost zPort pool :: IO (Either IOError ())
|
||||
case confUp of
|
||||
Left _e0 -> do
|
||||
_ <- completeSync pool Failed
|
||||
return ()
|
||||
Right _ -> do
|
||||
wals <- getWallets pool net
|
||||
runStderrLoggingT $
|
||||
mapM_
|
||||
(syncWallet (Config dbPath zHost zPort "user" "pwd" 8080))
|
||||
wals
|
||||
_ <- completeSync pool Successful
|
||||
return ()
|
||||
where
|
||||
processBlock :: ConnectionPool -> Int -> IO ()
|
||||
processBlock pool bl = do
|
||||
r <-
|
||||
makeZebraCall
|
||||
zHost
|
||||
zPort
|
||||
"getblock"
|
||||
[Data.Aeson.String $ T.pack (show bl), jsonNumber 1]
|
||||
case r of
|
||||
Left _ -> completeSync pool Failed
|
||||
Right blk -> do
|
||||
r2 <-
|
||||
makeZebraCall
|
||||
zHost
|
||||
zPort
|
||||
"getblock"
|
||||
[Data.Aeson.String $ T.pack (show bl), jsonNumber 0]
|
||||
case r2 of
|
||||
Left _ -> completeSync pool Failed
|
||||
Right hb -> do
|
||||
let blockTime = getBlockTime hb
|
||||
bi <-
|
||||
saveBlock pool $
|
||||
ZcashBlock
|
||||
(fromIntegral $ bl_height blk)
|
||||
(HexStringDB $ bl_hash blk)
|
||||
(fromIntegral $ bl_confirmations blk)
|
||||
blockTime
|
||||
(ZcashNetDB net)
|
||||
mapM_ (processTx zHost zPort bi pool) $ bl_txs blk
|
||||
|
|
|
|||
|
|
@ -37,6 +37,7 @@ import Zenith.DB
|
|||
, ZcashBlockId
|
||||
, clearWalletData
|
||||
, clearWalletTransactions
|
||||
, completeSync
|
||||
, getBlock
|
||||
, getMaxBlock
|
||||
, getMinBirthdayHeight
|
||||
|
|
@ -47,10 +48,16 @@ import Zenith.DB
|
|||
, saveBlock
|
||||
, saveConfs
|
||||
, saveTransaction
|
||||
, startSync
|
||||
, updateWalletSync
|
||||
, upgradeQrTable
|
||||
)
|
||||
import Zenith.Types (Config(..), HexStringDB(..), ZcashNetDB(..))
|
||||
import Zenith.Types
|
||||
( Config(..)
|
||||
, HexStringDB(..)
|
||||
, ZcashNetDB(..)
|
||||
, ZenithStatus(..)
|
||||
)
|
||||
import Zenith.Utils (jsonNumber)
|
||||
|
||||
-- | Function to scan the Zcash blockchain through the Zebra node and populate the Zenith database
|
||||
|
|
@ -74,6 +81,7 @@ rescanZebra host port dbFilePath = do
|
|||
upgradeQrTable pool1
|
||||
clearWalletTransactions pool1
|
||||
clearWalletData pool1
|
||||
_ <- startSync pool1
|
||||
dbBlock <- getMaxBlock pool1 znet
|
||||
b <- liftIO $ getMinBirthdayHeight pool1
|
||||
let sb = max dbBlock b
|
||||
|
|
@ -99,6 +107,7 @@ rescanZebra host port dbFilePath = do
|
|||
{-mapM_ (processBlock host port pool2 pg2 znet) bl2 `concurrently_`-}
|
||||
{-mapM_ (processBlock host port pool3 pg3 znet) bl3-}
|
||||
print "Please wait..."
|
||||
_ <- completeSync pool1 Successful
|
||||
print "Rescan complete"
|
||||
|
||||
-- | Function to process a raw block and extract the transaction information
|
||||
|
|
@ -119,7 +128,9 @@ processBlock host port pool pg net b = do
|
|||
"getblock"
|
||||
[Data.Aeson.String $ T.pack $ show b, jsonNumber 1]
|
||||
case r of
|
||||
Left e -> liftIO $ throwIO $ userError e
|
||||
Left e -> do
|
||||
_ <- completeSync pool Failed
|
||||
liftIO $ throwIO $ userError e
|
||||
Right blk -> do
|
||||
r2 <-
|
||||
liftIO $
|
||||
|
|
@ -129,7 +140,9 @@ processBlock host port pool pg net b = do
|
|||
"getblock"
|
||||
[Data.Aeson.String $ T.pack $ show b, jsonNumber 0]
|
||||
case r2 of
|
||||
Left e2 -> liftIO $ throwIO $ userError e2
|
||||
Left e2 -> do
|
||||
_ <- completeSync pool Failed
|
||||
liftIO $ throwIO $ userError e2
|
||||
Right hb -> do
|
||||
let blockTime = getBlockTime hb
|
||||
bi <-
|
||||
|
|
@ -160,7 +173,9 @@ processTx host port bt pool t = do
|
|||
"getrawtransaction"
|
||||
[Data.Aeson.String $ toText t, jsonNumber 1]
|
||||
case r of
|
||||
Left e -> liftIO $ throwIO $ userError e
|
||||
Left e -> do
|
||||
_ <- completeSync pool Failed
|
||||
liftIO $ throwIO $ userError e
|
||||
Right rawTx -> do
|
||||
case readZebraTransaction (ztr_hex rawTx) of
|
||||
Nothing -> return ()
|
||||
|
|
|
|||
Loading…
Reference in a new issue