Milestone 3: RPC server, ZIP-320 #104
11 changed files with 408 additions and 360 deletions
|
@ -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
|
||||||
|
|
||||||
|
|
|
@ -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)
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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."
|
||||||
|
|
|
@ -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
|
|
||||||
|
|
101
src/Zenith/DB.hs
101
src/Zenith/DB.hs
|
@ -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]
|
||||||
|
|
|
@ -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"
|
||||||
|
|
|
@ -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]
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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"
|
||||||
|
|
15
zenith.cabal
15
zenith.cabal
|
@ -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
|
||||||
|
|
Loading…
Reference in a new issue