Vergara_Tech/zenith
Vergara_Tech/zenith
2
0
Fork 0
Code Issues 24 Pull requests Projects Releases 6 Packages Wiki Activity

Implement database migration

Browse source
This commit is contained in:
Rene Vergara 2024-08-10 07:04:40 -05:00
parent c9dea01644
commit 46b4969da5
Signed by: pitmutt
GPG key ID: 65122AD495A7F5B2
11 changed files with 408 additions and 360 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

4
app/Main.hs
View file

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

25
app/Server.hs
View file

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

2
app/ZenScan.hs
View file

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

47
src/Zenith/CLI.hs
View file

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

45
src/Zenith/Core.hs
View file

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

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

69
src/Zenith/GUI.hs
View file

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

47
src/Zenith/RPC.hs
View file

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

127
src/Zenith/Scanner.hs
View file

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

2
zenith-openrpc.json
View file

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

15
zenith.cabal
View file

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