Add Zenith Scanner #71

Merged
pitmutt merged 7 commits from rav001 into dev041 2024-03-22 20:39:38 +00:00
11 changed files with 231 additions and 75 deletions

15
app/ZenScan.hs Normal file
View file

@ -0,0 +1,15 @@
{-# LANGUAGE OverloadedStrings #-}
module ZenScan where
import Data.Configurator
import Zenith.Scanner (scanZebra)
main :: IO ()
main = do
config <- load ["zenith.cfg"]
dbFilePath <- require config "dbFilePath"
{-dataStorePath <- require config "dataStorePath"-}
zebraPort <- require config "zebraPort"
zebraHost <- require config "zebraHost"
scanZebra 2764500 zebraHost zebraPort dbFilePath

View file

@ -1,5 +1,7 @@
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Zenith.CLI where module Zenith.CLI where
@ -45,7 +47,7 @@ import Brick.Widgets.Core
) )
import qualified Brick.Widgets.Dialog as D import qualified Brick.Widgets.Dialog as D
import qualified Brick.Widgets.List as L import qualified Brick.Widgets.List as L
import Control.Exception (throw, throwIO, try) import Control.Exception (catch, throw, throwIO, try)
import Control.Monad (void) import Control.Monad (void)
import Control.Monad.IO.Class (liftIO) import Control.Monad.IO.Class (liftIO)
import Data.Maybe import Data.Maybe
@ -59,6 +61,8 @@ import Lens.Micro.Mtl
import Lens.Micro.TH import Lens.Micro.TH
import Text.Wrap (FillScope(..), FillStrategy(..), WrapSettings(..), wrapText) import Text.Wrap (FillScope(..), FillStrategy(..), WrapSettings(..), wrapText)
import ZcashHaskell.Keys (generateWalletSeedPhrase, getWalletSeed) import ZcashHaskell.Keys (generateWalletSeedPhrase, getWalletSeed)
import ZcashHaskell.Orchard (isValidUnifiedAddress)
import ZcashHaskell.Transparent (encodeTransparent)
import ZcashHaskell.Types import ZcashHaskell.Types
import Zenith.Core import Zenith.Core
import Zenith.DB import Zenith.DB
@ -270,8 +274,23 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s]
Nothing Nothing
60) 60)
(padAll 1 $ (padAll 1 $
txtWrapWith (WrapSettings False True NoFill FillAfterFirst) $ B.borderWithLabel
getUA $ walletAddressUAddress $ entityVal a) (str "Unified")
(txtWrapWith (WrapSettings False True NoFill FillAfterFirst) $
getUA $ walletAddressUAddress $ entityVal a) <=>
B.borderWithLabel
(str "Legacy Shielded")
(txtWrapWith
(WrapSettings False True NoFill FillAfterFirst)
"Pending") <=>
B.borderWithLabel
(str "Transparent")
(txtWrapWith (WrapSettings False True NoFill FillAfterFirst) $
maybe "Pending" (encodeTransparent (st ^. network)) $
t_rec =<<
(isValidUnifiedAddress .
E.encodeUtf8 . getUA . walletAddressUAddress)
(entityVal a)))
Nothing -> emptyWidget Nothing -> emptyWidget
PhraseDisplay -> PhraseDisplay ->
case L.listSelectedElement $ st ^. wallets of case L.listSelectedElement $ st ^. wallets of
@ -494,13 +513,15 @@ theApp =
runZenithCLI :: T.Text -> Int -> T.Text -> IO () runZenithCLI :: T.Text -> Int -> T.Text -> IO ()
runZenithCLI host port dbFilePath = do runZenithCLI host port dbFilePath = do
w <- checkZebra host port w <- try $ checkZebra host port :: IO (Either IOError ZebraGetInfo)
case (w :: Maybe ZebraGetInfo) of case w of
Just zebra -> do Right zebra -> do
bc <- checkBlockChain host port bc <-
case (bc :: Maybe ZebraGetBlockChainInfo) of try $ checkBlockChain host port :: IO
Nothing -> throwIO $ userError "Unable to determine blockchain status" (Either IOError ZebraGetBlockChainInfo)
Just chainInfo -> do case bc of
Left e1 -> throwIO e1
Right chainInfo -> do
initDb dbFilePath initDb dbFilePath
walList <- getWallets dbFilePath $ zgb_net chainInfo walList <- getWallets dbFilePath $ zgb_net chainInfo
accList <- accList <-
@ -531,10 +552,10 @@ runZenithCLI host port dbFilePath = do
(zgb_blocks chainInfo) (zgb_blocks chainInfo)
dbFilePath dbFilePath
MsgDisplay MsgDisplay
Nothing -> 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."
refreshWallet :: State -> IO State refreshWallet :: State -> IO State
refreshWallet s = do refreshWallet s = do

View file

@ -1,6 +1,6 @@
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
-- Core wallet functionality for Zenith -- | Core wallet functionality for Zenith
module Zenith.Core where module Zenith.Core where
import Control.Exception (throwIO) import Control.Exception (throwIO)
@ -39,28 +39,23 @@ import Zenith.Types
checkZebra :: checkZebra ::
T.Text -- ^ Host where `zebrad` is available T.Text -- ^ Host where `zebrad` is available
-> Int -- ^ Port where `zebrad` is available -> Int -- ^ Port where `zebrad` is available
-> IO (Maybe ZebraGetInfo) -> IO ZebraGetInfo
checkZebra nodeHost nodePort = do checkZebra nodeHost nodePort = do
res <- makeZebraCall nodeHost nodePort "getinfo" [] res <- makeZebraCall nodeHost nodePort "getinfo" []
let body = responseBody (res :: Response (RpcResponse ZebraGetInfo)) case res of
return $ result body Left e -> throwIO $ userError e
Right bi -> return bi
-- | Checks the status of the Zcash blockchain -- | Checks the status of the Zcash blockchain
checkBlockChain :: checkBlockChain ::
T.Text -- ^ Host where `zebrad` is available T.Text -- ^ Host where `zebrad` is available
-> Int -- ^ Port where `zebrad` is available -> Int -- ^ Port where `zebrad` is available
-> IO (Maybe ZebraGetBlockChainInfo) -> IO ZebraGetBlockChainInfo
checkBlockChain nodeHost nodePort = do checkBlockChain nodeHost nodePort = do
let f = makeZebraCall nodeHost nodePort r <- makeZebraCall nodeHost nodePort "getblockchaininfo" []
result . responseBody <$> f "getblockchaininfo" [] case r of
Left e -> throwIO $ userError e
-- | Generic RPC call function Right bci -> return bci
connectZebra ::
FromJSON a => T.Text -> Int -> T.Text -> [Data.Aeson.Value] -> IO (Maybe a)
connectZebra nodeHost nodePort m params = do
res <- makeZebraCall nodeHost nodePort m params
let body = responseBody res
return $ result body
-- * Spending Keys -- * Spending Keys
-- | Create an Orchard Spending Key for the given wallet and account index -- | Create an Orchard Spending Key for the given wallet and account index

View file

@ -19,13 +19,15 @@ module Zenith.DB where
import Control.Monad.IO.Class (liftIO) import Control.Monad.IO.Class (liftIO)
import qualified Data.ByteString as BS import qualified Data.ByteString as BS
import Data.HexString
import qualified Data.Text as T import qualified Data.Text as T
import Database.Persist import Database.Persist
import Database.Persist.Sqlite import Database.Persist.Sqlite
import Database.Persist.TH import Database.Persist.TH
import ZcashHaskell.Types (Scope(..), ZcashNet) import ZcashHaskell.Types (Scope(..), ZcashNet)
import Zenith.Types import Zenith.Types
( OrchardSpendingKeyDB(..) ( HexStringDB(..)
, OrchardSpendingKeyDB(..)
, PhraseDB(..) , PhraseDB(..)
, SaplingSpendingKeyDB(..) , SaplingSpendingKeyDB(..)
, ScopeDB(..) , ScopeDB(..)
@ -65,6 +67,47 @@ share
deriving Show Eq deriving Show Eq
|] |]
share
[mkPersist sqlSettings, mkMigrate "rawStorage"]
[persistLowerCase|
WalletTransaction
block Int
txId HexStringDB
conf Int
time Int
hex HexStringDB
deriving Show Eq
OrchAction
tx WalletTransactionId
nf HexStringDB
rk HexStringDB
cmx HexStringDB
ephKey HexStringDB
encCipher HexStringDB
outCipher HexStringDB
cv HexStringDB
auth HexStringDB
deriving Show Eq
ShieldOutput
tx WalletTransactionId
cv HexStringDB
cmu HexStringDB
ephKey HexStringDB
encCipher HexStringDB
outCipher HexStringDB
proof HexStringDB
deriving Show Eq
ShieldSpend
tx WalletTransactionId
cv HexStringDB
anchor HexStringDB
nullifier HexStringDB
rk HexStringDB
proof HexStringDB
authSig HexStringDB
deriving Show Eq
|]
-- * Database functions -- * Database functions
-- | Initializes the database -- | Initializes the database
initDb :: initDb ::
@ -73,6 +116,12 @@ initDb ::
initDb dbName = do initDb dbName = do
runSqlite dbName $ do runMigration migrateAll runSqlite dbName $ do runMigration migrateAll
-- | Initializes the raw data storage
initRawStore ::
T.Text -- ^ the database path
-> IO ()
initRawStore dbFilePath = runSqlite dbFilePath $ runMigration rawStorage
-- | Get existing wallets from database -- | Get existing wallets from database
getWallets :: T.Text -> ZcashNet -> IO [Entity ZcashWallet] getWallets :: T.Text -> ZcashNet -> IO [Entity ZcashWallet]
getWallets dbFp n = getWallets dbFp n =

62
src/Zenith/Scanner.hs Normal file
View file

@ -0,0 +1,62 @@
{-# LANGUAGE OverloadedStrings #-}
module Zenith.Scanner where
import Control.Exception (throwIO, try)
import Data.Aeson
import Data.HexString
import qualified Data.Text as T
import GHC.Utils.Monad (concatMapM)
import Network.HTTP.Simple (getResponseBody)
import ZcashHaskell.Types
( BlockResponse(..)
, RpcResponse(..)
, ZebraGetBlockChainInfo(..)
)
import ZcashHaskell.Utils (makeZebraCall)
import Zenith.Core (checkBlockChain)
import Zenith.DB (initRawStore)
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
-> Int -- ^ Port
-> T.Text -- ^ Path to database file
-> IO ()
scanZebra b host port dbFilePath = do
_ <- initRawStore dbFilePath
bc <-
try $ checkBlockChain host port :: IO
(Either IOError ZebraGetBlockChainInfo)
case bc of
Left e -> print e
Right bStatus -> do
if b > zgb_blocks bStatus || b < 1
then throwIO $ userError "Invalid starting block for scan"
else do
let bList = [b .. (zgb_blocks bStatus)]
txList <-
try $ concatMapM (processBlock host port) bList :: IO
(Either IOError [HexString])
case txList of
Left e1 -> print e1
Right txList' -> print txList'
-- | Function to process a raw block and extract the transaction information
processBlock ::
T.Text -- ^ Host name for `zebrad`
-> Int -- ^ Port for `zebrad`
-> Int -- ^ The block number to process
-> IO [HexString]
processBlock host port b = do
r <-
makeZebraCall
host
port
"getblock"
[Data.Aeson.String $ T.pack $ show b, jsonNumber 1]
case r of
Left e -> throwIO $ userError e
Right blk -> return $ bl_txs blk

View file

@ -14,6 +14,7 @@ import Data.Aeson.Types (prependFailure, typeMismatch)
import qualified Data.ByteString as BS import qualified Data.ByteString as BS
import qualified Data.ByteString.Base64 as B64 import qualified Data.ByteString.Base64 as B64
import qualified Data.ByteString.Char8 as C import qualified Data.ByteString.Char8 as C
import Data.HexString
import Data.Maybe (fromMaybe) import Data.Maybe (fromMaybe)
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
@ -29,6 +30,13 @@ import ZcashHaskell.Types
, ZcashNet(..) , ZcashNet(..)
) )
-- * Database field type wrappers
newtype HexStringDB = HexStringDB
{ getHex :: HexString
} deriving newtype (Eq, Show, Read)
derivePersistField "HexStringDB"
newtype ZcashNetDB = ZcashNetDB newtype ZcashNetDB = ZcashNetDB
{ getNet :: ZcashNet { getNet :: ZcashNet
} deriving newtype (Eq, Show, Read) } deriving newtype (Eq, Show, Read)
@ -71,15 +79,8 @@ newtype TransparentSpendingKeyDB = TransparentSpendingKeyDB
derivePersistField "TransparentSpendingKeyDB" derivePersistField "TransparentSpendingKeyDB"
-- | A type to model Zcash RPC calls -- * RPC
data RpcCall = RpcCall -- | Type for modelling the different address sources for `zcashd` 5.0.0
{ jsonrpc :: T.Text
, id :: T.Text
, method :: T.Text
, params :: [Value]
} deriving (Show, Generic, ToJSON, FromJSON)
-- | Type for modelling the different address sources for Zcash 5.0.0
data AddressSource data AddressSource
= LegacyRandom = LegacyRandom
| Imported | Imported
@ -128,24 +129,6 @@ instance Show ZcashAddress where
T.unpack (T.take 8 a) ++ T.unpack (T.take 8 a) ++
"..." ++ T.unpack (T.takeEnd 8 a) ++ " Pools: " ++ show p "..." ++ T.unpack (T.takeEnd 8 a) ++ " Pools: " ++ show p
-- | A type to model the response of the Zcash RPC
data RpcResponse r = RpcResponse
{ err :: Maybe T.Text
, respId :: T.Text
, result :: r
} deriving (Show, Generic, ToJSON)
instance (FromJSON r) => FromJSON (RpcResponse r) where
parseJSON (Object obj) = do
e <- obj .: "error"
rId <- obj .: "id"
r <- obj .: "result"
pure $ RpcResponse e rId r
parseJSON invalid =
prependFailure
"parsing RpcResponse failed, "
(typeMismatch "Object" invalid)
newtype NodeVersion = newtype NodeVersion =
NodeVersion Integer NodeVersion Integer
deriving (Eq, Show) deriving (Eq, Show)

View file

@ -2,11 +2,10 @@
module Zenith.Utils where module Zenith.Utils where
import qualified Data.ByteString as BS import Data.Aeson
import qualified Data.ByteString.Char8 as C
import Data.Char
import Data.Functor (void) import Data.Functor (void)
import Data.Maybe import Data.Maybe
import Data.Scientific (Scientific(..), scientific)
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 System.Process (createProcess_, shell) import System.Process (createProcess_, shell)
@ -20,6 +19,10 @@ import Zenith.Types
, ZcashPool(..) , ZcashPool(..)
) )
-- | Helper function to convert numbers into JSON
jsonNumber :: Int -> Value
jsonNumber i = Number $ scientific (fromIntegral i) 0
-- | Helper function to display small amounts of ZEC -- | Helper function to display small amounts of ZEC
displayZec :: Integer -> String displayZec :: Integer -> String
displayZec s displayZec s

View file

@ -24,13 +24,12 @@ import System.IO
import Text.Read (readMaybe) import Text.Read (readMaybe)
import Text.Regex import Text.Regex
import Text.Regex.Base import Text.Regex.Base
import ZcashHaskell.Types (RpcCall(..), RpcResponse(..))
import Zenith.Types import Zenith.Types
( AddressGroup ( AddressGroup
, AddressSource(..) , AddressSource(..)
, NodeVersion(..) , NodeVersion(..)
, OpResult(..) , OpResult(..)
, RpcCall(..)
, RpcResponse(..)
, UABalance(..) , UABalance(..)
, ZcashAddress(..) , ZcashAddress(..)
, ZcashPool(..) , ZcashPool(..)
@ -49,7 +48,10 @@ listAddresses user pwd = do
Nothing -> fail "Couldn't parse node response" Nothing -> fail "Couldn't parse node response"
Just res -> do Just res -> do
let addys = result res let addys = result res
let addList = concatMap getAddresses addys case addys of
Nothing -> fail "Empty response"
Just addys' -> do
let addList = concatMap getAddresses addys'
return addList return addList
-- | Get address balance -- | Get address balance
@ -71,7 +73,9 @@ getBalance user pwd zadd = do
case rpcResp of case rpcResp of
Nothing -> fail "Couldn't parse node response" Nothing -> fail "Couldn't parse node response"
Just res -> do Just res -> do
return [result res] case result res of
Nothing -> return []
Just r -> return [r]
Just acct -> do Just acct -> do
response <- response <-
makeZcashCall makeZcashCall
@ -83,7 +87,9 @@ getBalance user pwd zadd = do
case rpcResp of case rpcResp of
Nothing -> fail "Couldn't parse node response" Nothing -> fail "Couldn't parse node response"
Just res -> do Just res -> do
return $ readUABalance (result res) case result res of
Nothing -> return [0, 0, 0]
Just r -> return $ readUABalance r
where readUABalance ua = where readUABalance ua =
[uatransparent ua, uasapling ua, uaorchard ua] [uatransparent ua, uasapling ua, uaorchard ua]
@ -96,7 +102,9 @@ listTxs user pwd zaddy = do
case rpcResp of case rpcResp of
Nothing -> fail "listTxs: Couldn't parse node response" Nothing -> fail "listTxs: Couldn't parse node response"
Just res -> do Just res -> do
return $ result res case result res of
Nothing -> fail "listTxs: Empty response"
Just res' -> return res'
-- | Send Tx -- | Send Tx
sendTx :: sendTx ::
@ -150,7 +158,7 @@ sendTx user pwd fromAddy toAddy amount memo = do
Nothing -> fail "Couldn't parse node response" Nothing -> fail "Couldn't parse node response"
Just res -> do Just res -> do
putStr " Sending." putStr " Sending."
checkOpResult user pwd (result res) checkOpResult user pwd (fromMaybe "" $ result res)
else putStrLn "Error: Source address is view-only." else putStrLn "Error: Source address is view-only."
else putStrLn "Error: Insufficient balance in source address." else putStrLn "Error: Insufficient balance in source address."
@ -163,7 +171,10 @@ checkServer user pwd = do
Nothing -> fail "Couldn't parse node response" Nothing -> fail "Couldn't parse node response"
Just myResp -> do Just myResp -> do
let r = result myResp let r = result myResp
if isNodeValid r case r of
Nothing -> fail "Empty node response"
Just r' -> do
if isNodeValid r'
then putStrLn $ "Connected to Zcash Full Node (" <> show r <> ") :)" then putStrLn $ "Connected to Zcash Full Node (" <> show r <> ") :)"
else do else do
putStrLn "Deprecated Zcash Full Node version found. Exiting" putStrLn "Deprecated Zcash Full Node version found. Exiting"
@ -235,7 +246,9 @@ checkOpResult user pwd opid = do
Nothing -> fail "Couldn't parse node response" Nothing -> fail "Couldn't parse node response"
Just res -> do Just res -> do
let r = result res let r = result res
mapM_ showResult r case r of
Nothing -> fail "Empty node response"
Just r' -> mapM_ showResult r'
where where
showResult t = showResult t =
case opsuccess t of case opsuccess t of
@ -269,7 +282,7 @@ makeZcashCall username password m p = do
let rpcResp = decode body :: Maybe (RpcResponse String) let rpcResp = decode body :: Maybe (RpcResponse String)
case rpcResp of case rpcResp of
Nothing -> fail $ "Unknown server error " ++ show response Nothing -> fail $ "Unknown server error " ++ show response
Just x -> fail (result x) Just x -> fail (fromMaybe "" $ result x)
401 -> fail "Incorrect full node credentials" 401 -> fail "Incorrect full node credentials"
200 -> return body 200 -> return body
_ -> fail "Unknown error" _ -> fail "Unknown error"

@ -1 +1 @@
Subproject commit f228eff367c776469455adc4d443102cc53e5538 Subproject commit f0995441628381fee14ae1c655c3c4f8d96162e5

View file

@ -32,6 +32,7 @@ library
Zenith.Types Zenith.Types
Zenith.Utils Zenith.Utils
Zenith.Zcashd Zenith.Zcashd
Zenith.Scanner
hs-source-dirs: hs-source-dirs:
src src
build-depends: build-depends:
@ -42,6 +43,8 @@ library
, base64-bytestring , base64-bytestring
, brick , brick
, bytestring , bytestring
, ghc
, hexstring
, http-client , http-client
, http-conduit , http-conduit
, http-types , http-types
@ -53,7 +56,6 @@ library
, persistent-sqlite , persistent-sqlite
, persistent-template , persistent-template
, process , process
, hexstring
, regex-base , regex-base
, regex-compat , regex-compat
, regex-posix , regex-posix
@ -86,6 +88,18 @@ 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
, zenith
pkgconfig-depends: rustzcash_wrapper
default-language: Haskell2010
test-suite zenith-tests test-suite zenith-tests
type: exitcode-stdio-1.0 type: exitcode-stdio-1.0
ghc-options: -threaded -rtsopts -with-rtsopts=-N ghc-options: -threaded -rtsopts -with-rtsopts=-N

View file

@ -3,3 +3,4 @@ nodePwd = "superSecret"
dbFilePath = "zenith.db" dbFilePath = "zenith.db"
zebraHost = "127.0.0.1" zebraHost = "127.0.0.1"
zebraPort = 18232 zebraPort = 18232
dataStorePath = "datastore.db"