Milestone 3: RPC server, ZIP-320 #104

Merged
pitmutt merged 152 commits from milestone3 into master 2024-11-21 15:39:19 +00:00
7 changed files with 430 additions and 188 deletions
Showing only changes of commit c75316ddd7 - Show all commits

View file

@ -20,6 +20,7 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0
- `getnewaccount` RPC method - `getnewaccount` RPC method
- `getnewaddress` RPC method - `getnewaddress` RPC method
- `getoperationstatus` RPC method - `getoperationstatus` RPC method
- `sendmany` RPC method
- Function `prepareTxV2` implementing `PrivacyPolicy` - Function `prepareTxV2` implementing `PrivacyPolicy`
### Changed ### 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 - Detection of changes in database schema for automatic re-scan
- Block tracking for chain re-org detection - Block tracking for chain re-org detection
- Refactored `ZcashPool` - Refactored `ZcashPool`
- Preventing write operations to occur during wallet sync
## [0.6.0.0-beta] ## [0.6.0.0-beta]

View file

@ -2,15 +2,22 @@
module Server where module Server where
import Control.Concurrent (forkIO, threadDelay)
import Control.Exception (throwIO, try) import Control.Exception (throwIO, try)
import Control.Monad (when) import Control.Monad (forever, when)
import Data.Configurator import Data.Configurator
import Network.Wai.Handler.Warp (run) import Network.Wai.Handler.Warp (run)
import Servant import Servant
import ZcashHaskell.Types (ZebraGetBlockChainInfo(..), ZebraGetInfo(..)) import ZcashHaskell.Types (ZebraGetBlockChainInfo(..), ZebraGetInfo(..))
import Zenith.Core (checkBlockChain, checkZebra) import Zenith.Core (checkBlockChain, checkZebra)
import Zenith.DB (initDb) 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.Scanner (rescanZebra)
import Zenith.Types (Config(..)) import Zenith.Types (Config(..))
@ -39,6 +46,12 @@ main = do
Left e2 -> throwIO $ userError e2 Left e2 -> throwIO $ userError e2
Right x' -> do Right x' -> do
when x' $ rescanZebra zebraHost zebraPort dbFilePath when x' $ rescanZebra zebraHost zebraPort dbFilePath
_ <-
forkIO $
forever $ do
_ <-
scanZebra dbFilePath zebraHost zebraPort (zgb_net chainInfo)
threadDelay 90000000
let myState = let myState =
State State
(zgb_net chainInfo) (zgb_net chainInfo)

View file

@ -102,6 +102,7 @@ import Zenith.Types
, PrivacyPolicy(..) , PrivacyPolicy(..)
, UnifiedAddressDB(..) , UnifiedAddressDB(..)
, ZcashNetDB(..) , ZcashNetDB(..)
, ZenithStatus(..)
) )
import Zenith.Utils import Zenith.Utils
( displayTaz ( displayTaz
@ -752,34 +753,45 @@ scanZebra dbP zHost zPort b eChan znet = do
pool <- liftIO $ runNoLoggingT $ initPool dbP pool <- liftIO $ runNoLoggingT $ initPool dbP
dbBlock <- liftIO $ getMaxBlock pool $ ZcashNetDB znet dbBlock <- liftIO $ getMaxBlock pool $ ZcashNetDB znet
chkBlock <- liftIO $ checkIntegrity dbP zHost zPort dbBlock 1 chkBlock <- liftIO $ checkIntegrity dbP zHost zPort dbBlock 1
logDebugN $ syncChk <- liftIO $ isSyncing pool
"dbBlock: " <> if syncChk
T.pack (show dbBlock) <> " chkBlock: " <> T.pack (show chkBlock) then liftIO $ BC.writeBChan eChan $ TickMsg "Sync alread in progress"
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"
else do else do
let bList = [(sb + 1) .. (zgb_blocks bStatus)] logDebugN $
if not (null bList) "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 then do
let step = liftIO $
(1.0 :: Float) / fromIntegral (zgb_blocks bStatus - (sb + 1)) BC.writeBChan eChan $ TickMsg "Invalid starting block for scan"
mapM_ (liftIO . processBlock pool step) bList else do
else liftIO $ BC.writeBChan eChan $ TickVal 1.0 let bList = [(sb + 1) .. (zgb_blocks bStatus)]
confUp <- if not (null bList)
liftIO $ try $ updateConfs zHost zPort pool :: LoggingT then do
IO let step =
(Either IOError ()) (1.0 :: Float) /
case confUp of fromIntegral (zgb_blocks bStatus - (sb + 1))
Left _e0 -> _ <- liftIO $ startSync pool
liftIO $ mapM_ (liftIO . processBlock pool step) bList
BC.writeBChan eChan $ TickMsg "Failed to update unconfirmed transactions" confUp <-
Right _ -> return () 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 where
processBlock :: ConnectionPool -> Float -> Int -> IO () processBlock :: ConnectionPool -> Float -> Int -> IO ()
processBlock pool step bl = do processBlock pool step bl = do
@ -791,7 +803,9 @@ scanZebra dbP zHost zPort b eChan znet = do
"getblock" "getblock"
[Data.Aeson.String $ T.pack $ show bl, jsonNumber 1] [Data.Aeson.String $ T.pack $ show bl, jsonNumber 1]
case r of 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 Right blk -> do
r2 <- r2 <-
liftIO $ liftIO $
@ -801,7 +815,9 @@ scanZebra dbP zHost zPort b eChan znet = do
"getblock" "getblock"
[Data.Aeson.String $ T.pack $ show bl, jsonNumber 0] [Data.Aeson.String $ T.pack $ show bl, jsonNumber 0]
case r2 of 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 Right hb -> do
let blockTime = getBlockTime hb let blockTime = getBlockTime hb
bi <- bi <-

View file

@ -291,6 +291,13 @@ share
result T.Text Maybe result T.Text Maybe
UniqueOp uuid UniqueOp uuid
deriving Show Eq deriving Show Eq
ChainSync
name T.Text
start UTCTime
end UTCTime Maybe
status ZenithStatus
UniqueSync name
deriving Show Eq
|] |]
-- ** Type conversions -- ** Type conversions
@ -2329,6 +2336,46 @@ finalizeOperation pool op status result = do
] ]
where_ (ops ^. OperationId ==. val op) 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 -- | Rewind the data store to a given block height
rewindWalletData :: ConnectionPool -> Int -> IO () rewindWalletData :: ConnectionPool -> Int -> IO ()
rewindWalletData pool b = do rewindWalletData pool b = do

View file

@ -1475,7 +1475,6 @@ handleEvent wenv node model evt =
res <- liftIO $ updateAdrsInAdrBook pool d a a res <- liftIO $ updateAdrsInAdrBook pool d a a
return $ ShowMessage "Address Book entry updated!!" return $ ShowMessage "Address Book entry updated!!"
-- model & recipientValid .~ ((model ^. privacyChoice) == Low) ]
scanZebra :: T.Text -> T.Text -> Int -> ZcashNet -> (AppEvent -> IO ()) -> IO () scanZebra :: T.Text -> T.Text -> Int -> ZcashNet -> (AppEvent -> IO ()) -> IO ()
scanZebra dbPath zHost zPort net sendMsg = do scanZebra dbPath zHost zPort net sendMsg = do
bStatus <- liftIO $ checkBlockChain zHost zPort bStatus <- liftIO $ checkBlockChain zHost zPort
@ -1483,24 +1482,35 @@ scanZebra dbPath zHost zPort net sendMsg = do
b <- liftIO $ getMinBirthdayHeight pool b <- liftIO $ getMinBirthdayHeight pool
dbBlock <- getMaxBlock pool $ ZcashNetDB net dbBlock <- getMaxBlock pool $ ZcashNetDB net
chkBlock <- checkIntegrity dbPath zHost zPort dbBlock 1 chkBlock <- checkIntegrity dbPath zHost zPort dbBlock 1
unless (chkBlock == dbBlock) $ rewindWalletData pool chkBlock syncChk <- isSyncing pool
let sb = if syncChk
if chkBlock == dbBlock then sendMsg (ShowError "Sync already in progress")
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 else do
let bList = [(sb + 1) .. (zgb_blocks bStatus)] unless (chkBlock == dbBlock) $ rewindWalletData pool chkBlock
if not (null bList) let sb =
then do if chkBlock == dbBlock
let step = (1.0 :: Float) / fromIntegral (length bList) then max dbBlock b
mapM_ (processBlock pool step) bList else max chkBlock b
else sendMsg (SyncVal 1.0) if sb > zgb_blocks bStatus || sb < 1
confUp <- try $ updateConfs zHost zPort pool :: IO (Either IOError ()) then sendMsg (ShowError "Invalid starting block for scan")
case confUp of else do
Left _e0 -> sendMsg (ShowError "Failed to update unconfirmed transactions") let bList = [(sb + 1) .. (zgb_blocks bStatus)]
Right _ -> return () 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 where
processBlock :: ConnectionPool -> Float -> Int -> IO () processBlock :: ConnectionPool -> Float -> Int -> IO ()
processBlock pool step bl = do processBlock pool step bl = do
@ -1512,7 +1522,9 @@ scanZebra dbPath zHost zPort net sendMsg = do
"getblock" "getblock"
[Data.Aeson.String $ showt bl, jsonNumber 1] [Data.Aeson.String $ showt bl, jsonNumber 1]
case r of case r of
Left e1 -> sendMsg (ShowError $ showt e1) Left e1 -> do
_ <- completeSync pool Failed
sendMsg (ShowError $ showt e1)
Right blk -> do Right blk -> do
r2 <- r2 <-
liftIO $ liftIO $
@ -1522,7 +1534,9 @@ scanZebra dbPath zHost zPort net sendMsg = do
"getblock" "getblock"
[Data.Aeson.String $ showt bl, jsonNumber 0] [Data.Aeson.String $ showt bl, jsonNumber 0]
case r2 of case r2 of
Left e2 -> sendMsg (ShowError $ showt e2) Left e2 -> do
_ <- completeSync pool Failed
sendMsg (ShowError $ showt e2)
Right hb -> do Right hb -> do
let blockTime = getBlockTime hb let blockTime = getBlockTime hb
bi <- bi <-

View file

@ -14,8 +14,9 @@ module Zenith.RPC where
import Control.Concurrent (forkIO) import Control.Concurrent (forkIO)
import Control.Exception (try) import Control.Exception (try)
import Control.Monad (unless, when)
import Control.Monad.IO.Class (liftIO) import Control.Monad.IO.Class (liftIO)
import Control.Monad.Logger (runFileLoggingT, runNoLoggingT) import Control.Monad.Logger (runFileLoggingT, runNoLoggingT, runStderrLoggingT)
import Data.Aeson import Data.Aeson
import qualified Data.HexString as H import qualified Data.HexString as H
import Data.Int import Data.Int
@ -27,7 +28,8 @@ import qualified Data.UUID as U
import Data.UUID.V4 (nextRandom) import Data.UUID.V4 (nextRandom)
import qualified Data.Vector as V import qualified Data.Vector as V
import Database.Esqueleto.Experimental import Database.Esqueleto.Experimental
( entityKey ( ConnectionPool
, entityKey
, entityVal , entityVal
, fromSqlKey , fromSqlKey
, toSqlKey , toSqlKey
@ -36,13 +38,27 @@ import Servant
import Text.Read (readMaybe) import Text.Read (readMaybe)
import ZcashHaskell.Keys (generateWalletSeedPhrase) import ZcashHaskell.Keys (generateWalletSeedPhrase)
import ZcashHaskell.Orchard (parseAddress) import ZcashHaskell.Orchard (parseAddress)
import ZcashHaskell.Types (RpcError(..), Scope(..), ZcashNet(..)) import ZcashHaskell.Types
import ZcashHaskell.Utils (makeZebraCall) ( BlockResponse(..)
import Zenith.Core (createCustomWalletAddress, createZcashAccount, prepareTxV2) , RpcError(..)
, Scope(..)
, ZcashNet(..)
, ZebraGetBlockChainInfo(..)
)
import ZcashHaskell.Utils (getBlockTime, makeZebraCall)
import Zenith.Core
( checkBlockChain
, createCustomWalletAddress
, createZcashAccount
, prepareTxV2
, syncWallet
)
import Zenith.DB import Zenith.DB
( Operation(..) ( Operation(..)
, ZcashAccount(..) , ZcashAccount(..)
, ZcashBlock(..)
, ZcashWallet(..) , ZcashWallet(..)
, completeSync
, finalizeOperation , finalizeOperation
, findNotesByAddress , findNotesByAddress
, getAccountById , getAccountById
@ -53,24 +69,32 @@ import Zenith.DB
, getLastSyncBlock , getLastSyncBlock
, getMaxAccount , getMaxAccount
, getMaxAddress , getMaxAddress
, getMaxBlock
, getMinBirthdayHeight
, getOperation , getOperation
, getPoolBalance , getPoolBalance
, getUnconfPoolBalance , getUnconfPoolBalance
, getWalletNotes , getWalletNotes
, getWallets , getWallets
, initPool , initPool
, isSyncing
, rewindWalletData
, saveAccount , saveAccount
, saveAddress , saveAddress
, saveBlock
, saveOperation , saveOperation
, saveWallet , saveWallet
, startSync
, toZcashAccountAPI , toZcashAccountAPI
, toZcashAddressAPI , toZcashAddressAPI
, toZcashWalletAPI , toZcashWalletAPI
, walletExists , walletExists
) )
import Zenith.Scanner (checkIntegrity, processTx, updateConfs)
import Zenith.Types import Zenith.Types
( AccountBalance(..) ( AccountBalance(..)
, Config(..) , Config(..)
, HexStringDB(..)
, PhraseDB(..) , PhraseDB(..)
, PrivacyPolicy(..) , PrivacyPolicy(..)
, ProposedNote(..) , ProposedNote(..)
@ -622,27 +646,35 @@ zenithServer state = getinfo :<|> handleRPC
case parameters req of case parameters req of
NameParams t -> do NameParams t -> do
let dbPath = w_dbPath state let dbPath = w_dbPath state
sP <- liftIO generateWalletSeedPhrase
pool <- liftIO $ runNoLoggingT $ initPool dbPath pool <- liftIO $ runNoLoggingT $ initPool dbPath
r <- syncChk <- liftIO $ isSyncing pool
liftIO $ if syncChk
saveWallet pool $ then return $
ZcashWallet ErrorResponse
t (callId req)
(ZcashNetDB $ w_network state) (-32012)
(PhraseDB sP) "The Zenith server is syncing, please try again later."
(w_startBlock state) else do
0 sP <- liftIO generateWalletSeedPhrase
case r of r <-
Nothing -> liftIO $
return $ saveWallet pool $
ErrorResponse ZcashWallet
(callId req) t
(-32007) (ZcashNetDB $ w_network state)
"Entity with that name already exists." (PhraseDB sP)
Just r' -> (w_startBlock state)
return $ 0
NewItemResponse (callId req) $ fromSqlKey $ entityKey r' 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 -> _anyOtherParams ->
return $ ErrorResponse (callId req) (-32602) "Invalid params" return $ ErrorResponse (callId req) (-32602) "Invalid params"
GetNewAccount -> GetNewAccount ->
@ -650,34 +682,45 @@ zenithServer state = getinfo :<|> handleRPC
NameIdParams t i -> do NameIdParams t i -> do
let dbPath = w_dbPath state let dbPath = w_dbPath state
pool <- liftIO $ runNoLoggingT $ initPool dbPath pool <- liftIO $ runNoLoggingT $ initPool dbPath
w <- liftIO $ walletExists pool i syncChk <- liftIO $ isSyncing pool
case w of if syncChk
Just w' -> do then return $
aIdx <- liftIO $ getMaxAccount pool $ entityKey w' ErrorResponse
nAcc <- (callId req)
liftIO (-32012)
(try $ createZcashAccount t (aIdx + 1) w' :: IO "The Zenith server is syncing, please try again later."
(Either IOError ZcashAccount)) else do
case nAcc of w <- liftIO $ walletExists pool i
Left e -> 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 $ return $
ErrorResponse (callId req) (-32010) $ T.pack $ show e ErrorResponse
Right nAcc' -> do (callId req)
r <- liftIO $ saveAccount pool nAcc' (-32008)
case r of "Wallet does not exist."
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."
_anyOtherParams -> _anyOtherParams ->
return $ ErrorResponse (callId req) (-32602) "Invalid params" return $ ErrorResponse (callId req) (-32602) "Invalid params"
GetNewAddress -> GetNewAddress ->
@ -686,35 +729,49 @@ zenithServer state = getinfo :<|> handleRPC
let dbPath = w_dbPath state let dbPath = w_dbPath state
let net = w_network state let net = w_network state
pool <- liftIO $ runNoLoggingT $ initPool dbPath pool <- liftIO $ runNoLoggingT $ initPool dbPath
acc <- liftIO $ getAccountById pool $ toSqlKey $ fromIntegral i syncChk <- liftIO $ isSyncing pool
case acc of if syncChk
Just acc' -> do then return $
maxAddr <- ErrorResponse
liftIO $ getMaxAddress pool (entityKey acc') External (callId req)
newAddr <- (-32012)
liftIO $ "The Zenith server is syncing, please try again later."
createCustomWalletAddress else do
n acc <-
(maxAddr + 1) liftIO $ getAccountById pool $ toSqlKey $ fromIntegral i
net case acc of
External Just acc' -> do
acc' maxAddr <-
s liftIO $ getMaxAddress pool (entityKey acc') External
t newAddr <-
dbAddr <- liftIO $ saveAddress pool newAddr liftIO $
case dbAddr of createCustomWalletAddress
Just nAddr -> do n
return $ (maxAddr + 1)
NewAddrResponse (callId req) (toZcashAddressAPI nAddr) 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 -> Nothing ->
return $ return $
ErrorResponse ErrorResponse
(callId req) (callId req)
(-32007) (-32006)
"Entity with that name already exists." "Account does not exist."
Nothing ->
return $
ErrorResponse (callId req) (-32006) "Account does not exist."
_anyOtherParams -> _anyOtherParams ->
return $ ErrorResponse (callId req) (-32602) "Invalid params" return $ ErrorResponse (callId req) (-32602) "Invalid params"
GetOperationStatus -> GetOperationStatus ->
@ -739,65 +796,79 @@ zenithServer state = getinfo :<|> handleRPC
let zPort = w_port state let zPort = w_port state
let znet = w_network state let znet = w_network state
pool <- liftIO $ runNoLoggingT $ initPool dbPath pool <- liftIO $ runNoLoggingT $ initPool dbPath
opid <- liftIO nextRandom syncChk <- liftIO $ isSyncing pool
startTime <- liftIO getCurrentTime if syncChk
opkey <- then return $
liftIO $ ErrorResponse
saveOperation pool $ (callId req)
Operation (ZenithUuid opid) startTime Nothing Processing Nothing (-32012)
case opkey of "The Zenith server is syncing, please try again later."
Nothing -> else do
return $ ErrorResponse (callId req) (-32010) "Internal Error" opid <- liftIO nextRandom
Just opkey' -> do startTime <- liftIO getCurrentTime
acc <- opkey <-
liftIO $ getAccountById pool $ toSqlKey $ fromIntegral a liftIO $
case acc of saveOperation pool $
Just acc' -> do Operation
bl <- (ZenithUuid opid)
liftIO $ startTime
getLastSyncBlock Nothing
pool Processing
(zcashAccountWalletId $ entityVal acc') Nothing
_ <- case opkey of
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 -> Nothing ->
return $ return $
ErrorResponse ErrorResponse (callId req) (-32010) "Internal Error"
(callId req) Just opkey' -> do
(-32006) acc <-
"Account does not exist." 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 -> _anyOtherParams ->
return $ ErrorResponse (callId req) (-32602) "Invalid params" return $ ErrorResponse (callId req) (-32602) "Invalid params"
@ -812,3 +883,67 @@ authenticate config = BasicAuthCheck check
packRpcResponse :: ToJSON a => T.Text -> a -> Value packRpcResponse :: ToJSON a => T.Text -> a -> Value
packRpcResponse i x = packRpcResponse i x =
object ["jsonrpc" .= ("2.0" :: String), "id" .= i, "result" .= 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

View file

@ -37,6 +37,7 @@ import Zenith.DB
, ZcashBlockId , ZcashBlockId
, clearWalletData , clearWalletData
, clearWalletTransactions , clearWalletTransactions
, completeSync
, getBlock , getBlock
, getMaxBlock , getMaxBlock
, getMinBirthdayHeight , getMinBirthdayHeight
@ -47,10 +48,16 @@ import Zenith.DB
, saveBlock , saveBlock
, saveConfs , saveConfs
, saveTransaction , saveTransaction
, startSync
, updateWalletSync , updateWalletSync
, upgradeQrTable , upgradeQrTable
) )
import Zenith.Types (Config(..), HexStringDB(..), ZcashNetDB(..)) import Zenith.Types
( Config(..)
, HexStringDB(..)
, ZcashNetDB(..)
, ZenithStatus(..)
)
import Zenith.Utils (jsonNumber) import Zenith.Utils (jsonNumber)
-- | Function to scan the Zcash blockchain through the Zebra node and populate the Zenith database -- | 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 upgradeQrTable pool1
clearWalletTransactions pool1 clearWalletTransactions pool1
clearWalletData pool1 clearWalletData pool1
_ <- startSync pool1
dbBlock <- getMaxBlock pool1 znet dbBlock <- getMaxBlock pool1 znet
b <- liftIO $ getMinBirthdayHeight pool1 b <- liftIO $ getMinBirthdayHeight pool1
let sb = max dbBlock b 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 pool2 pg2 znet) bl2 `concurrently_`-}
{-mapM_ (processBlock host port pool3 pg3 znet) bl3-} {-mapM_ (processBlock host port pool3 pg3 znet) bl3-}
print "Please wait..." print "Please wait..."
_ <- completeSync pool1 Successful
print "Rescan complete" print "Rescan complete"
-- | Function to process a raw block and extract the transaction information -- | Function to process a raw block and extract the transaction information
@ -119,7 +128,9 @@ processBlock host port pool pg net b = do
"getblock" "getblock"
[Data.Aeson.String $ T.pack $ show b, jsonNumber 1] [Data.Aeson.String $ T.pack $ show b, jsonNumber 1]
case r of case r of
Left e -> liftIO $ throwIO $ userError e Left e -> do
_ <- completeSync pool Failed
liftIO $ throwIO $ userError e
Right blk -> do Right blk -> do
r2 <- r2 <-
liftIO $ liftIO $
@ -129,7 +140,9 @@ processBlock host port pool pg net b = do
"getblock" "getblock"
[Data.Aeson.String $ T.pack $ show b, jsonNumber 0] [Data.Aeson.String $ T.pack $ show b, jsonNumber 0]
case r2 of case r2 of
Left e2 -> liftIO $ throwIO $ userError e2 Left e2 -> do
_ <- completeSync pool Failed
liftIO $ throwIO $ userError e2
Right hb -> do Right hb -> do
let blockTime = getBlockTime hb let blockTime = getBlockTime hb
bi <- bi <-
@ -160,7 +173,9 @@ processTx host port bt pool t = do
"getrawtransaction" "getrawtransaction"
[Data.Aeson.String $ toText t, jsonNumber 1] [Data.Aeson.String $ toText t, jsonNumber 1]
case r of case r of
Left e -> liftIO $ throwIO $ userError e Left e -> do
_ <- completeSync pool Failed
liftIO $ throwIO $ userError e
Right rawTx -> do Right rawTx -> do
case readZebraTransaction (ztr_hex rawTx) of case readZebraTransaction (ztr_hex rawTx) of
Nothing -> return () Nothing -> return ()