RPC Server #103

Merged
pitmutt merged 129 commits from rav001 into milestone3 2024-11-21 15:30:22 +00:00
11 changed files with 408 additions and 360 deletions
Showing only changes of commit 46b4969da5 - Show all commits

View file

@ -19,8 +19,8 @@ import System.IO
import Text.Read (readMaybe) import Text.Read (readMaybe)
import ZcashHaskell.Types import ZcashHaskell.Types
import Zenith.CLI import Zenith.CLI
import Zenith.Core (clearSync, testSync)
import Zenith.GUI (runZenithGUI) import Zenith.GUI (runZenithGUI)
import Zenith.Scanner (clearSync, rescanZebra)
import Zenith.Types (Config(..), ZcashAddress(..), ZcashPool(..), ZcashTx(..)) import Zenith.Types (Config(..), ZcashAddress(..), ZcashPool(..), ZcashTx(..))
import Zenith.Utils import Zenith.Utils
import Zenith.Zcashd import Zenith.Zcashd
@ -227,7 +227,7 @@ main = do
of of
"gui" -> runZenithGUI myConfig "gui" -> runZenithGUI myConfig
"tui" -> runZenithTUI myConfig "tui" -> runZenithTUI myConfig
"rescan" -> clearSync myConfig "rescan" -> rescanZebra zebraHost zebraPort dbFilePath
_ -> printUsage _ -> printUsage
else printUsage else printUsage

View file

@ -2,10 +2,16 @@
module Server where module Server where
import Control.Exception (throwIO, try)
import Control.Monad (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 Zenith.Core (checkBlockChain, checkZebra)
import Zenith.DB (initDb)
import Zenith.RPC (ZenithRPC(..), authenticate, zenithServer) import Zenith.RPC (ZenithRPC(..), authenticate, zenithServer)
import Zenith.Scanner (rescanZebra)
import Zenith.Types (Config(..)) import Zenith.Types (Config(..))
main :: IO () main :: IO ()
@ -19,5 +25,22 @@ main = do
nodePort <- require config "nodePort" nodePort <- require config "nodePort"
let myConfig = Config dbFilePath zebraHost zebraPort nodeUser nodePwd nodePort let myConfig = Config dbFilePath zebraHost zebraPort nodeUser nodePwd nodePort
let ctx = authenticate myConfig :. EmptyContext let ctx = authenticate myConfig :. EmptyContext
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 $ run nodePort $
serveWithContext (Proxy :: Proxy ZenithRPC) ctx (zenithServer myConfig) serveWithContext
(Proxy :: Proxy ZenithRPC)
ctx
(zenithServer myConfig)

View file

@ -4,7 +4,7 @@ module ZenScan where
import Control.Monad.Logger (runNoLoggingT) import Control.Monad.Logger (runNoLoggingT)
import Data.Configurator import Data.Configurator
import Zenith.Scanner (scanZebra) import Zenith.Scanner (rescanZebra)
main :: IO () main :: IO ()
main = do main = do

View file

@ -10,10 +10,8 @@ import qualified Brick.BChan as BC
import qualified Brick.Focus as F import qualified Brick.Focus as F
import Brick.Forms import Brick.Forms
( Form(..) ( Form(..)
, FormFieldState
, (@@=) , (@@=)
, allFieldsValid , allFieldsValid
, editShowableField
, editShowableFieldWithValidate , editShowableFieldWithValidate
, editTextField , editTextField
, focusedFormInputAttr , focusedFormInputAttr
@ -42,7 +40,6 @@ import Brick.Widgets.Core
, joinBorders , joinBorders
, padAll , padAll
, padBottom , padBottom
, padLeft
, padTop , padTop
, setAvailableSize , setAvailableSize
, str , str
@ -63,10 +60,10 @@ import qualified Brick.Widgets.Edit as E
import qualified Brick.Widgets.List as L import qualified Brick.Widgets.List as L
import qualified Brick.Widgets.ProgressBar as P import qualified Brick.Widgets.ProgressBar as P
import Control.Concurrent (forkIO, threadDelay) import Control.Concurrent (forkIO, threadDelay)
import Control.Exception (catch, throw, throwIO, try) import Control.Exception (throw, throwIO, try)
import Control.Monad (forever, void) import Control.Monad (forever, void, when)
import Control.Monad.IO.Class (liftIO) import Control.Monad.IO.Class (liftIO)
import Control.Monad.Logger (LoggingT, runFileLoggingT, runNoLoggingT) import Control.Monad.Logger (runFileLoggingT, runNoLoggingT)
import Data.Aeson import Data.Aeson
import Data.HexString (HexString(..), toText) import Data.HexString (HexString(..), toText)
import Data.Maybe import Data.Maybe
@ -83,19 +80,15 @@ import Lens.Micro.Mtl
import Lens.Micro.TH import Lens.Micro.TH
import System.Hclip import System.Hclip
import Text.Printf import Text.Printf
import Text.Wrap (FillScope(..), FillStrategy(..), WrapSettings(..), wrapText) import Text.Wrap (FillScope(..), FillStrategy(..), WrapSettings(..))
import ZcashHaskell.Keys (generateWalletSeedPhrase, getWalletSeed) import ZcashHaskell.Keys (generateWalletSeedPhrase)
import ZcashHaskell.Orchard (getSaplingFromUA, isValidUnifiedAddress) import ZcashHaskell.Orchard (getSaplingFromUA, isValidUnifiedAddress)
import ZcashHaskell.Sapling (decodeSaplingAddress, isValidShieldedAddress) import ZcashHaskell.Transparent (encodeTransparentReceiver)
import ZcashHaskell.Transparent
( decodeTransparentAddress
, encodeTransparentReceiver
)
import ZcashHaskell.Types import ZcashHaskell.Types
import ZcashHaskell.Utils (getBlockTime, makeZebraCall) import ZcashHaskell.Utils (getBlockTime, makeZebraCall)
import Zenith.Core import Zenith.Core
import Zenith.DB import Zenith.DB
import Zenith.Scanner (processTx, updateConfs) import Zenith.Scanner (processTx, rescanZebra, updateConfs)
import Zenith.Types import Zenith.Types
( Config(..) ( Config(..)
, PhraseDB(..) , PhraseDB(..)
@ -722,9 +715,9 @@ abSelAttr = A.attrName "abselected"
abMBarAttr :: A.AttrName abMBarAttr :: A.AttrName
abMBarAttr = A.attrName "menubar" abMBarAttr = A.attrName "menubar"
scanZebra :: T.Text -> T.Text -> Int -> Int -> BC.BChan Tick -> IO () scanZebra ::
scanZebra dbP zHost zPort b eChan = do T.Text -> T.Text -> Int -> Int -> BC.BChan Tick -> ZcashNet -> IO ()
_ <- liftIO $ initDb dbP scanZebra dbP zHost zPort b eChan net = do
bStatus <- liftIO $ checkBlockChain zHost zPort bStatus <- liftIO $ checkBlockChain zHost zPort
pool <- runNoLoggingT $ initPool dbP pool <- runNoLoggingT $ initPool dbP
dbBlock <- runNoLoggingT $ getMaxBlock pool dbBlock <- runNoLoggingT $ getMaxBlock pool
@ -772,7 +765,7 @@ scanZebra dbP zHost zPort b eChan = do
Left e2 -> liftIO $ BC.writeBChan eChan $ TickMsg e2 Left e2 -> liftIO $ BC.writeBChan eChan $ TickMsg e2
Right hb -> do Right hb -> do
let blockTime = getBlockTime hb let blockTime = getBlockTime hb
mapM_ (runNoLoggingT . processTx zHost zPort blockTime pool) $ mapM_ (processTx zHost zPort blockTime pool (ZcashNetDB net)) $
bl_txs $ addTime blk blockTime bl_txs $ addTime blk blockTime
liftIO $ BC.writeBChan eChan $ TickVal step liftIO $ BC.writeBChan eChan $ TickVal step
addTime :: BlockResponse -> Int -> BlockResponse addTime :: BlockResponse -> Int -> BlockResponse
@ -868,6 +861,7 @@ appEvent (BT.AppEvent t) = do
(s ^. zebraPort) (s ^. zebraPort)
sBlock sBlock
(s ^. eventDispatch) (s ^. eventDispatch)
(s ^. network)
BT.modify $ set timer 0 BT.modify $ set timer 0
return () return ()
else BT.modify $ set timer $ 1 + s ^. timer else BT.modify $ set timer $ 1 + s ^. timer
@ -1369,15 +1363,21 @@ runZenithTUI config = do
case bc of case bc of
Left e1 -> throwIO e1 Left e1 -> throwIO e1
Right chainInfo -> do Right chainInfo -> do
initDb dbFilePath 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 walList <- getWallets pool $ zgb_net chainInfo
accList <- accList <-
if not (null walList) if not (null walList)
then runNoLoggingT $ getAccounts pool $ entityKey $ head walList then runNoLoggingT $
getAccounts pool $ entityKey $ head walList
else return [] else return []
addrList <- addrList <-
if not (null accList) if not (null accList)
then runNoLoggingT $ getAddresses pool $ entityKey $ head accList then runNoLoggingT $
getAddresses pool $ entityKey $ head accList
else return [] else return []
txList <- txList <-
if not (null addrList) if not (null addrList)
@ -1413,7 +1413,8 @@ runZenithTUI config = do
(L.list AList (Vec.fromList addrList) 1) (L.list AList (Vec.fromList addrList) 1)
(L.list TList (Vec.fromList txList) 1) (L.list TList (Vec.fromList txList) 1)
("Start up Ok! Connected to Zebra " ++ ("Start up Ok! Connected to Zebra " ++
(T.unpack . zgi_build) zebra ++ " on port " ++ show port ++ ".") (T.unpack . zgi_build) zebra ++
" on port " ++ show port ++ ".")
False False
(if null walList (if null walList
then WName then WName
@ -1437,7 +1438,7 @@ runZenithTUI config = do
"" ""
Nothing Nothing
uBal uBal
Left e -> do Left _e -> do
print $ print $
"No Zebra node available on port " <> "No Zebra node available on port " <>
show port <> ". Check your configuration." show port <> ". Check your configuration."

View file

@ -728,48 +728,3 @@ syncWallet config w = do
_ <- updateOrchardWitnesses pool _ <- updateOrchardWitnesses pool
_ <- liftIO $ updateWalletSync pool chainTip (entityKey w) _ <- liftIO $ updateWalletSync pool chainTip (entityKey w)
mapM_ (runNoLoggingT . getWalletTransactions pool) addrs 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

View file

@ -18,12 +18,10 @@
module Zenith.DB where module Zenith.DB where
import Control.Exception (throwIO) import Control.Exception (SomeException(..), throwIO, try)
import Control.Monad (forM_, when) import Control.Monad (when)
import Control.Monad.IO.Class (MonadIO, liftIO) import Control.Monad.IO.Class (MonadIO)
import Control.Monad.Logger (NoLoggingT, runNoLoggingT) import Control.Monad.Logger (NoLoggingT, runNoLoggingT)
import Data.Aeson hiding (Key, Value)
import Data.Bifunctor (bimap)
import qualified Data.ByteString as BS import qualified Data.ByteString as BS
import Data.HexString import Data.HexString
import Data.List (group, sort) import Data.List (group, sort)
@ -41,34 +39,29 @@ import Haskoin.Transaction.Common
, TxOut(..) , TxOut(..)
, txHashToHex , txHashToHex
) )
import qualified Lens.Micro as ML ((&), (.~), (^.)) import System.Directory (doesFileExist, getHomeDirectory, removeFile)
import System.FilePath ((</>))
import ZcashHaskell.Orchard (getSaplingFromUA, isValidUnifiedAddress) import ZcashHaskell.Orchard (getSaplingFromUA, isValidUnifiedAddress)
import ZcashHaskell.Transparent (encodeTransparentReceiver) import ZcashHaskell.Transparent (encodeTransparentReceiver)
import ZcashHaskell.Types import ZcashHaskell.Types
( DecodedNote(..) ( DecodedNote(..)
, OrchardAction(..) , OrchardAction(..)
, OrchardBundle(..) , OrchardBundle(..)
, OrchardSpendingKey(..)
, OrchardWitness(..) , OrchardWitness(..)
, SaplingBundle(..) , SaplingBundle(..)
, SaplingCommitmentTree(..)
, SaplingSpendingKey(..)
, SaplingWitness(..) , SaplingWitness(..)
, Scope(..) , Scope(..)
, ShieldedOutput(..) , ShieldedOutput(..)
, ShieldedSpend(..) , ShieldedSpend(..)
, ToBytes(..) , ToBytes(..)
, Transaction(..) , Transaction(..)
, TransparentAddress(..)
, TransparentBundle(..) , TransparentBundle(..)
, TransparentReceiver(..) , TransparentReceiver(..)
, UnifiedAddress(..) , UnifiedAddress(..)
, ZcashNet(..) , ZcashNet(..)
, decodeHexText
) )
import Zenith.Types import Zenith.Types
( Config(..) ( HexStringDB(..)
, HexStringDB(..)
, OrchardSpendingKeyDB(..) , OrchardSpendingKeyDB(..)
, PhraseDB(..) , PhraseDB(..)
, RseedDB(..) , RseedDB(..)
@ -197,7 +190,8 @@ share
txId HexStringDB txId HexStringDB
conf Int conf Int
time Int time Int
UniqueTx block txId network ZcashNetDB
UniqueTx block txId network
deriving Show Eq deriving Show Eq
TransparentNote TransparentNote
tx ZcashTransactionId tx ZcashTransactionId
@ -311,9 +305,53 @@ toZcashAddressAPI a =
-- | Initializes the database -- | Initializes the database
initDb :: initDb ::
T.Text -- ^ The database path to check T.Text -- ^ The database path to check
-> IO () -> IO (Either String Bool)
initDb dbName = do 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 :: T.Text -> NoLoggingT IO ConnectionPool
initPool dbPath = do initPool dbPath = do
@ -519,15 +557,16 @@ saveAddress pool w =
saveTransaction :: saveTransaction ::
ConnectionPool -- ^ the database path ConnectionPool -- ^ the database path
-> Int -- ^ block time -> Int -- ^ block time
-> ZcashNetDB -- ^ the network
-> Transaction -- ^ The transaction to save -> Transaction -- ^ The transaction to save
-> NoLoggingT IO (Key ZcashTransaction) -> NoLoggingT IO (Key ZcashTransaction)
saveTransaction pool t wt = saveTransaction pool t n wt =
PS.retryOnBusy $ PS.retryOnBusy $
flip PS.runSqlPool pool $ do flip PS.runSqlPool pool $ do
let ix = [0 ..] let ix = [0 ..]
w <- w <-
insert $ 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 when (isJust $ tx_transpBundle wt) $ do
_ <- _ <-
insertMany_ $ insertMany_ $
@ -1499,6 +1538,32 @@ clearWalletTransactions pool = do
delete $ do delete $ do
_ <- from $ table @WalletTransaction _ <- from $ table @WalletTransaction
return () 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 :: getWalletUnspentTrNotes ::
ConnectionPool -> ZcashAccountId -> IO [Entity WalletTrNote] ConnectionPool -> ZcashAccountId -> IO [Entity WalletTrNote]

View file

@ -9,13 +9,13 @@ import Codec.QRCode
import Codec.QRCode.JuicyPixels import Codec.QRCode.JuicyPixels
import Control.Concurrent (threadDelay) import Control.Concurrent (threadDelay)
import Control.Exception (throwIO, try) import Control.Exception (throwIO, try)
import Control.Monad (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)
import Data.Aeson import Data.Aeson
import qualified Data.ByteString as BS import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as LBS
import Data.HexString (toText) 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 as T
import qualified Data.Text.Encoding as E import qualified Data.Text.Encoding as E
import Data.Time.Clock.POSIX (posixSecondsToUTCTime) import Data.Time.Clock.POSIX (posixSecondsToUTCTime)
@ -27,7 +27,6 @@ import Monomer
import qualified Monomer.Lens as L import qualified Monomer.Lens as L
import System.Directory (getHomeDirectory) import System.Directory (getHomeDirectory)
import System.FilePath ((</>)) import System.FilePath ((</>))
import System.Hclip
import Text.Printf import Text.Printf
import Text.Wrap (FillScope(..), FillStrategy(..), WrapSettings(..), wrapText) import Text.Wrap (FillScope(..), FillStrategy(..), WrapSettings(..), wrapText)
import TextShow hiding (toText) import TextShow hiding (toText)
@ -36,7 +35,6 @@ import ZcashHaskell.Orchard (getSaplingFromUA, isValidUnifiedAddress)
import ZcashHaskell.Transparent (encodeTransparentReceiver) import ZcashHaskell.Transparent (encodeTransparentReceiver)
import ZcashHaskell.Types import ZcashHaskell.Types
( BlockResponse(..) ( BlockResponse(..)
, Phrase(..)
, Scope(..) , Scope(..)
, ToBytes(..) , ToBytes(..)
, UnifiedAddress(..) , UnifiedAddress(..)
@ -48,7 +46,7 @@ import ZcashHaskell.Utils (getBlockTime, makeZebraCall)
import Zenith.Core import Zenith.Core
import Zenith.DB import Zenith.DB
import Zenith.GUI.Theme import Zenith.GUI.Theme
import Zenith.Scanner (processTx, updateConfs) import Zenith.Scanner (processTx, rescanZebra, updateConfs)
import Zenith.Types hiding (ZcashAddress(..)) import Zenith.Types hiding (ZcashAddress(..))
import Zenith.Utils import Zenith.Utils
( displayAmount ( displayAmount
@ -1030,6 +1028,7 @@ handleEvent wenv node model evt =
(c_dbPath $ model ^. configuration) (c_dbPath $ model ^. configuration)
(c_zebraHost $ model ^. configuration) (c_zebraHost $ model ^. configuration)
(c_zebraPort $ model ^. configuration) (c_zebraPort $ model ^. configuration)
(model ^. network)
] ]
else [Model $ model & timer .~ 0] else [Model $ model & timer .~ 0]
SyncVal i -> SyncVal i ->
@ -1147,9 +1146,8 @@ handleEvent wenv node model evt =
wL <- getWallets pool (model ^. network) wL <- getWallets pool (model ^. network)
return $ LoadWallets wL return $ LoadWallets wL
scanZebra :: T.Text -> T.Text -> Int -> (AppEvent -> IO ()) -> IO () scanZebra :: T.Text -> T.Text -> Int -> ZcashNet -> (AppEvent -> IO ()) -> IO ()
scanZebra dbPath zHost zPort sendMsg = do scanZebra dbPath zHost zPort net sendMsg = do
_ <- liftIO $ initDb dbPath
bStatus <- liftIO $ checkBlockChain zHost zPort bStatus <- liftIO $ checkBlockChain zHost zPort
pool <- runNoLoggingT $ initPool dbPath pool <- runNoLoggingT $ initPool dbPath
b <- liftIO $ getMinBirthdayHeight pool b <- liftIO $ getMinBirthdayHeight pool
@ -1192,7 +1190,7 @@ scanZebra dbPath zHost zPort sendMsg = do
Left e2 -> sendMsg (ShowError $ showt e2) Left e2 -> sendMsg (ShowError $ showt e2)
Right hb -> do Right hb -> do
let blockTime = getBlockTime hb let blockTime = getBlockTime hb
mapM_ (runNoLoggingT . processTx zHost zPort blockTime pool) $ mapM_ (processTx zHost zPort blockTime pool (ZcashNetDB net)) $
bl_txs $ addTime blk blockTime bl_txs $ addTime blk blockTime
sendMsg (SyncVal step) sendMsg (SyncVal step)
addTime :: BlockResponse -> Int -> BlockResponse addTime :: BlockResponse -> Int -> BlockResponse
@ -1267,7 +1265,11 @@ runZenithGUI config = do
case bc of case bc of
Left e1 -> throwIO e1 Left e1 -> throwIO e1
Right chainInfo -> do Right chainInfo -> do
initDb dbFilePath x <- initDb dbFilePath
case x of
Left e2 -> throwIO $ userError e2
Right x' -> do
when x' $ rescanZebra host port dbFilePath
generateQRCodes config generateQRCodes config
walList <- getWallets pool $ zgb_net chainInfo walList <- getWallets pool $ zgb_net chainInfo
accList <- accList <-
@ -1343,52 +1345,7 @@ runZenithGUI config = do
Nothing Nothing
hD hD
startApp model handleEvent buildUI (params hD) startApp model handleEvent buildUI (params hD)
Left e -> do Left _e -> print "Zebra not available"
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)
where where
params hd = params hd =
[ appWindowTitle "Zenith - Zcash Full Node Wallet" [ appWindowTitle "Zenith - Zcash Full Node Wallet"

View file

@ -40,6 +40,7 @@ import Zenith.Types
( Config(..) ( Config(..)
, ZcashAccountAPI(..) , ZcashAccountAPI(..)
, ZcashAddressAPI(..) , ZcashAddressAPI(..)
, ZcashNoteAPI(..)
, ZcashWalletAPI(..) , ZcashWalletAPI(..)
) )
import Zenith.Utils (jsonNumber) import Zenith.Utils (jsonNumber)
@ -49,6 +50,7 @@ data ZenithMethod
| ListWallets | ListWallets
| ListAccounts | ListAccounts
| ListAddresses | ListAddresses
| ListReceived
| UnknownMethod | UnknownMethod
deriving (Eq, Prelude.Show) deriving (Eq, Prelude.Show)
@ -57,6 +59,7 @@ instance ToJSON ZenithMethod where
toJSON ListWallets = Data.Aeson.String "listwallets" toJSON ListWallets = Data.Aeson.String "listwallets"
toJSON ListAccounts = Data.Aeson.String "listaccounts" toJSON ListAccounts = Data.Aeson.String "listaccounts"
toJSON ListAddresses = Data.Aeson.String "listaddresses" toJSON ListAddresses = Data.Aeson.String "listaddresses"
toJSON ListReceived = Data.Aeson.String "listreceived"
toJSON UnknownMethod = Data.Aeson.Null toJSON UnknownMethod = Data.Aeson.Null
instance FromJSON ZenithMethod where instance FromJSON ZenithMethod where
@ -66,6 +69,7 @@ instance FromJSON ZenithMethod where
"listwallets" -> pure ListWallets "listwallets" -> pure ListWallets
"listaccounts" -> pure ListAccounts "listaccounts" -> pure ListAccounts
"listaddresses" -> pure ListAddresses "listaddresses" -> pure ListAddresses
"listreceived" -> pure ListReceived
_ -> pure UnknownMethod _ -> pure UnknownMethod
data ZenithParams data ZenithParams
@ -73,6 +77,7 @@ data ZenithParams
| BadParams | BadParams
| AccountsParams !Int | AccountsParams !Int
| AddressesParams !Int | AddressesParams !Int
| NotesParams !T.Text
| TestParams !T.Text | TestParams !T.Text
deriving (Eq, Prelude.Show) deriving (Eq, Prelude.Show)
@ -82,24 +87,23 @@ instance ToJSON ZenithParams where
toJSON (AccountsParams n) = Data.Aeson.Array $ V.fromList [jsonNumber n] toJSON (AccountsParams n) = Data.Aeson.Array $ V.fromList [jsonNumber n]
toJSON (AddressesParams 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 (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 data ZenithResponse
= InfoResponse !T.Text !ZenithInfo = InfoResponse !T.Text !ZenithInfo
| WalletListResponse !T.Text ![ZcashWalletAPI] | WalletListResponse !T.Text ![ZcashWalletAPI]
| AccountListResponse !T.Text ![ZcashAccountAPI] | AccountListResponse !T.Text ![ZcashAccountAPI]
| AddressListResponse !T.Text ![ZcashAddressAPI] | AddressListResponse !T.Text ![ZcashAddressAPI]
| NoteListResponse !T.Text ![ZcashNoteAPI]
| ErrorResponse !T.Text !Double !T.Text | ErrorResponse !T.Text !Double !T.Text
deriving (Eq, Prelude.Show) deriving (Eq, Prelude.Show)
instance ToJSON ZenithResponse where instance ToJSON ZenithResponse where
toJSON (InfoResponse t i) = toJSON (InfoResponse t i) = packRpcResponse t i
object ["jsonrpc" .= ("2.0" :: String), "id" .= t, "result" .= i] toJSON (WalletListResponse i w) = packRpcResponse i w
toJSON (WalletListResponse i w) = toJSON (AccountListResponse i a) = packRpcResponse i a
object ["jsonrpc" .= ("2.0" :: String), "id" .= i, "result" .= w] toJSON (AddressListResponse i a) = packRpcResponse i a
toJSON (AccountListResponse i a) = toJSON (NoteListResponse i n) = packRpcResponse i n
object ["jsonrpc" .= ("2.0" :: String), "id" .= i, "result" .= a]
toJSON (AddressListResponse i a) =
object ["jsonrpc" .= ("2.0" :: String), "id" .= i, "result" .= a]
toJSON (ErrorResponse i c m) = toJSON (ErrorResponse i c m) =
object object
[ "jsonrpc" .= ("2.0" :: String) [ "jsonrpc" .= ("2.0" :: String)
@ -109,7 +113,7 @@ instance ToJSON ZenithResponse where
instance FromJSON ZenithResponse where instance FromJSON ZenithResponse where
parseJSON = parseJSON =
withObject "ZenithParams" $ \obj -> do withObject "ZenithResponse" $ \obj -> do
jr <- obj .: "jsonrpc" jr <- obj .: "jsonrpc"
i <- obj .: "id" i <- obj .: "id"
e <- obj .:? "error" e <- obj .:? "error"
@ -138,6 +142,7 @@ instance FromJSON ZenithResponse where
Object n' -> do Object n' -> do
v1 <- n' .:? "lastSync" v1 <- n' .:? "lastSync"
v2 <- n' .:? "wallet" v2 <- n' .:? "wallet"
v3 <- n' .:? "ua"
case (v1 :: Maybe Int) of case (v1 :: Maybe Int) of
Just _v1' -> do Just _v1' -> do
k2 <- parseJSON r1 k2 <- parseJSON r1
@ -147,6 +152,11 @@ instance FromJSON ZenithResponse where
Just _v2' -> do Just _v2' -> do
k3 <- parseJSON r1 k3 <- parseJSON r1
pure $ AccountListResponse i k3 pure $ AccountListResponse i k3
Nothing ->
case (v3 :: Maybe String) of
Just _v3' -> do
k4 <- parseJSON r1
pure $ AddressListResponse i k4
Nothing -> fail "Unknown object" Nothing -> fail "Unknown object"
_anyOther -> fail "Malformed JSON" _anyOther -> fail "Malformed JSON"
_anyOther -> fail "Malformed JSON" _anyOther -> fail "Malformed JSON"
@ -220,6 +230,16 @@ instance FromJSON RpcCall where
pure $ RpcCall v i ListAddresses (AddressesParams x) pure $ RpcCall v i ListAddresses (AddressesParams x)
else pure $ RpcCall v i ListAddresses BadParams else pure $ RpcCall v i ListAddresses BadParams
_anyOther -> 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 type ZenithRPC
= "status" :> Get '[ JSON] Value :<|> BasicAuth "zenith-realm" Bool :> ReqBody = "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)) (ZenithInfo "0.7.0.0-beta" (zgb_net bI) (zgi_build zI))
_anyOtherParams -> _anyOtherParams ->
return $ ErrorResponse (callId req) (-32602) "Invalid params" 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 Bool
authenticate config = BasicAuthCheck check authenticate config = BasicAuthCheck check
@ -344,3 +369,7 @@ authenticate config = BasicAuthCheck check
if username == c_zenithUser config && password == c_zenithPwd config if username == c_zenithUser config && password == c_zenithPwd config
then return $ Authorized True then return $ Authorized True
else return Unauthorized else return Unauthorized
packRpcResponse :: ToJSON a => T.Text -> a -> Value
packRpcResponse i x =
object ["jsonrpc" .= ("2.0" :: String), "id" .= i, "result" .= x]

View file

@ -2,29 +2,22 @@
module Zenith.Scanner where module Zenith.Scanner where
import Control.Concurrent.Async (concurrently_, withAsync)
import Control.Exception (throwIO, try) 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.IO.Class (liftIO)
import Control.Monad.Logger import Control.Monad.Logger (NoLoggingT, logErrorN, logInfoN, runNoLoggingT)
( LoggingT
, NoLoggingT
, logErrorN
, logInfoN
, runNoLoggingT
)
import Data.Aeson import Data.Aeson
import Data.HexString import Data.HexString
import Data.Maybe
import qualified Data.Text as T import qualified Data.Text as T
import Data.Time (getCurrentTime) import Data.Time (getCurrentTime)
import Database.Persist.Sqlite import Database.Persist.Sqlite
import GHC.Utils.Monad (concatMapM)
import Lens.Micro ((&), (.~), (^.), set)
import System.Console.AsciiProgress import System.Console.AsciiProgress
import ZcashHaskell.Types import ZcashHaskell.Types
( BlockResponse(..) ( BlockResponse(..)
, RawZebraTx(..) , RawZebraTx(..)
, Transaction(..) , Transaction(..)
, ZcashNet(..)
, ZebraGetBlockChainInfo(..) , ZebraGetBlockChainInfo(..)
, ZebraTxResponse(..) , ZebraTxResponse(..)
, fromRawOBundle , fromRawOBundle
@ -32,59 +25,68 @@ import ZcashHaskell.Types
, fromRawTBundle , fromRawTBundle
) )
import ZcashHaskell.Utils (getBlockTime, makeZebraCall, readZebraTransaction) import ZcashHaskell.Utils (getBlockTime, makeZebraCall, readZebraTransaction)
import Zenith.Core (checkBlockChain) import Zenith.Core (checkBlockChain, syncWallet)
import Zenith.DB import Zenith.DB
( getMaxBlock ( clearWalletData
, clearWalletTransactions
, getMaxBlock
, getMinBirthdayHeight
, getUnconfirmedBlocks , getUnconfirmedBlocks
, getWallets
, initDb , initDb
, initPool
, saveConfs , saveConfs
, saveTransaction , saveTransaction
, updateWalletSync
) )
import Zenith.Types (Config(..), ZcashNetDB(..))
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
scanZebra :: rescanZebra ::
Int -- ^ Starting block T.Text -- ^ Host
-> T.Text -- ^ Host
-> Int -- ^ Port -> Int -- ^ Port
-> T.Text -- ^ Path to database file -> T.Text -- ^ Path to database file
-> NoLoggingT IO () -> IO ()
scanZebra b host port dbFilePath = do rescanZebra host port dbFilePath = do
_ <- liftIO $ initDb dbFilePath
startTime <- liftIO getCurrentTime
logInfoN $ "Started sync: " <> T.pack (show startTime)
bc <- bc <-
liftIO $ try $ checkBlockChain host port :: NoLoggingT try $ checkBlockChain host port :: IO
IO
(Either IOError ZebraGetBlockChainInfo) (Either IOError ZebraGetBlockChainInfo)
case bc of case bc of
Left e -> logErrorN $ T.pack (show e) Left e -> print e
Right bStatus -> do Right bStatus -> do
let dbInfo = let znet = ZcashNetDB $ zgb_net bStatus
mkSqliteConnectionInfo dbFilePath & extraPragmas .~ pool1 <- runNoLoggingT $ initPool dbFilePath
["read_uncommited = true"] pool2 <- runNoLoggingT $ initPool dbFilePath
pool <- createSqlitePoolFromInfo dbInfo 5 pool3 <- runNoLoggingT $ initPool dbFilePath
dbBlock <- getMaxBlock pool clearWalletTransactions pool1
clearWalletData pool1
dbBlock <- runNoLoggingT $ getMaxBlock pool1
b <- liftIO $ getMinBirthdayHeight pool1
let sb = max dbBlock b let sb = max dbBlock b
if sb > zgb_blocks bStatus || sb < 1 if sb > zgb_blocks bStatus || sb < 1
then liftIO $ throwIO $ userError "Invalid starting block for scan" then liftIO $ throwIO $ userError "Invalid starting block for scan"
else do else do
liftIO $
print $ print $
"Scanning from " ++ "Scanning from " ++ show sb ++ " to " ++ show (zgb_blocks bStatus)
show (sb + 1) ++ " to " ++ show (zgb_blocks bStatus) let bList = [sb .. (zgb_blocks bStatus)]
let bList = [(sb + 1) .. (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 displayConsoleRegions $ do
pg <- pg1 <- newProgressBar def {pgTotal = fromIntegral $ length bList}
liftIO $ {-pg2 <- newProgressBar def {pgTotal = fromIntegral $ length bl2}-}
newProgressBar def {pgTotal = fromIntegral $ length bList} {-pg3 <- newProgressBar def {pgTotal = fromIntegral $ length bl3}-}
txList <- mapM_ (processBlock host port pool1 pg1 znet) bList
CM.try $ mapM_ (processBlock host port pool pg) bList :: NoLoggingT {-`concurrently_`-}
IO {-mapM_ (processBlock host port pool2 pg2 znet) bl2 `concurrently_`-}
(Either IOError ()) {-mapM_ (processBlock host port pool3 pg3 znet) bl3-}
case txList of print "Please wait..."
Left e1 -> logErrorN $ T.pack (show e1) print "Rescan complete"
Right txList' -> logInfoN "Finished scan"
-- | Function to process a raw block and extract the transaction information -- | Function to process a raw block and extract the transaction information
processBlock :: processBlock ::
@ -92,9 +94,10 @@ processBlock ::
-> Int -- ^ Port for `zebrad` -> Int -- ^ Port for `zebrad`
-> ConnectionPool -- ^ DB file path -> ConnectionPool -- ^ DB file path
-> ProgressBar -- ^ Progress bar -> ProgressBar -- ^ Progress bar
-> ZcashNetDB -- ^ the network
-> Int -- ^ The block number to process -> Int -- ^ The block number to process
-> NoLoggingT IO () -> IO ()
processBlock host port pool pg b = do processBlock host port pool pg net b = do
r <- r <-
liftIO $ liftIO $
makeZebraCall makeZebraCall
@ -116,7 +119,7 @@ processBlock host port pool pg b = do
Left e2 -> liftIO $ throwIO $ userError e2 Left e2 -> liftIO $ throwIO $ userError e2
Right hb -> do Right hb -> do
let blockTime = getBlockTime hb let blockTime = getBlockTime hb
mapM_ (processTx host port blockTime pool) $ mapM_ (processTx host port blockTime pool net) $
bl_txs $ addTime blk blockTime bl_txs $ addTime blk blockTime
liftIO $ tick pg liftIO $ tick pg
where where
@ -134,9 +137,10 @@ processTx ::
-> Int -- ^ Port for `zebrad` -> Int -- ^ Port for `zebrad`
-> Int -- ^ Block time -> Int -- ^ Block time
-> ConnectionPool -- ^ DB file path -> ConnectionPool -- ^ DB file path
-> ZcashNetDB -- ^ the network
-> HexString -- ^ transaction id -> HexString -- ^ transaction id
-> NoLoggingT IO () -> IO ()
processTx host port bt pool t = do processTx host port bt pool net t = do
r <- r <-
liftIO $ liftIO $
makeZebraCall makeZebraCall
@ -151,7 +155,8 @@ processTx host port bt pool t = do
Nothing -> return () Nothing -> return ()
Just rzt -> do Just rzt -> do
_ <- _ <-
saveTransaction pool bt $ runNoLoggingT $
saveTransaction pool bt net $
Transaction Transaction
t t
(ztr_blockheight rawTx) (ztr_blockheight rawTx)
@ -184,3 +189,27 @@ updateConfs host port pool = do
Left e -> throwIO $ userError e Left e -> throwIO $ userError e
Right blk -> do Right blk -> do
saveConfs pool b $ fromInteger $ bl_confirmations blk 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

View file

@ -320,7 +320,7 @@
"Address": { "Address": {
"name": "Address identifier", "name": "Address identifier",
"summary": "The 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, "required": true,
"schema": { "schema": {
"type": "string" "type": "string"

View file

@ -42,6 +42,7 @@ library
Clipboard Clipboard
, aeson , aeson
, array , array
, async
, ascii-progress , ascii-progress
, base >=4.12 && <5 , base >=4.12 && <5
, base64-bytestring , base64-bytestring
@ -113,19 +114,6 @@ executable zenith
pkgconfig-depends: rustzcash_wrapper pkgconfig-depends: rustzcash_wrapper
default-language: Haskell2010 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 executable zenithserver
ghc-options: -main-is Server -threaded -rtsopts -with-rtsopts=-N ghc-options: -main-is Server -threaded -rtsopts -with-rtsopts=-N
main-is: Server.hs main-is: Server.hs
@ -137,6 +125,7 @@ executable zenithserver
, wai-extra , wai-extra
, warp , warp
, servant-server , servant-server
, zcash-haskell
, zenith , zenith
pkgconfig-depends: rustzcash_wrapper pkgconfig-depends: rustzcash_wrapper
default-language: Haskell2010 default-language: Haskell2010