Milestone 3: RPC server, ZIP-320 #104
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
|
- `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]
|
||||||
|
|
|
@ -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)
|
||||||
|
|
|
@ -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 <-
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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 <-
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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 ()
|
||||||
|
|
Loading…
Reference in a new issue