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

View file

@ -1,6 +1,6 @@
{-# LANGUAGE OverloadedStrings #-}
-- Core wallet functionality for Zenith
-- | Core wallet functionality for Zenith
module Zenith.Core where
import Control.Exception (throwIO)
@ -39,28 +39,23 @@ import Zenith.Types
checkZebra ::
T.Text -- ^ Host where `zebrad` is available
-> Int -- ^ Port where `zebrad` is available
-> IO (Maybe ZebraGetInfo)
-> IO ZebraGetInfo
checkZebra nodeHost nodePort = do
res <- makeZebraCall nodeHost nodePort "getinfo" []
let body = responseBody (res :: Response (RpcResponse ZebraGetInfo))
return $ result body
case res of
Left e -> throwIO $ userError e
Right bi -> return bi
-- | Checks the status of the Zcash blockchain
checkBlockChain ::
T.Text -- ^ Host where `zebrad` is available
-> Int -- ^ Port where `zebrad` is available
-> IO (Maybe ZebraGetBlockChainInfo)
-> IO ZebraGetBlockChainInfo
checkBlockChain nodeHost nodePort = do
let f = makeZebraCall nodeHost nodePort
result . responseBody <$> f "getblockchaininfo" []
-- | Generic RPC call function
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
r <- makeZebraCall nodeHost nodePort "getblockchaininfo" []
case r of
Left e -> throwIO $ userError e
Right bci -> return bci
-- * Spending Keys
-- | 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 qualified Data.ByteString as BS
import Data.HexString
import qualified Data.Text as T
import Database.Persist
import Database.Persist.Sqlite
import Database.Persist.TH
import ZcashHaskell.Types (Scope(..), ZcashNet)
import Zenith.Types
( OrchardSpendingKeyDB(..)
( HexStringDB(..)
, OrchardSpendingKeyDB(..)
, PhraseDB(..)
, SaplingSpendingKeyDB(..)
, ScopeDB(..)
@ -65,6 +67,47 @@ share
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
-- | Initializes the database
initDb ::
@ -73,6 +116,12 @@ initDb ::
initDb dbName = do
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
getWallets :: T.Text -> ZcashNet -> IO [Entity ZcashWallet]
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.Base64 as B64
import qualified Data.ByteString.Char8 as C
import Data.HexString
import Data.Maybe (fromMaybe)
import qualified Data.Text as T
import qualified Data.Text.Encoding as E
@ -29,6 +30,13 @@ import ZcashHaskell.Types
, ZcashNet(..)
)
-- * Database field type wrappers
newtype HexStringDB = HexStringDB
{ getHex :: HexString
} deriving newtype (Eq, Show, Read)
derivePersistField "HexStringDB"
newtype ZcashNetDB = ZcashNetDB
{ getNet :: ZcashNet
} deriving newtype (Eq, Show, Read)
@ -71,15 +79,8 @@ newtype TransparentSpendingKeyDB = TransparentSpendingKeyDB
derivePersistField "TransparentSpendingKeyDB"
-- | A type to model Zcash RPC calls
data RpcCall = RpcCall
{ 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
-- * RPC
-- | Type for modelling the different address sources for `zcashd` 5.0.0
data AddressSource
= LegacyRandom
| Imported
@ -128,24 +129,6 @@ instance Show ZcashAddress where
T.unpack (T.take 8 a) ++
"..." ++ 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 =
NodeVersion Integer
deriving (Eq, Show)

View file

@ -2,11 +2,10 @@
module Zenith.Utils where
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as C
import Data.Char
import Data.Aeson
import Data.Functor (void)
import Data.Maybe
import Data.Scientific (Scientific(..), scientific)
import qualified Data.Text as T
import qualified Data.Text.Encoding as E
import System.Process (createProcess_, shell)
@ -20,6 +19,10 @@ import Zenith.Types
, 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
displayZec :: Integer -> String
displayZec s

View file

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

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

View file

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

View file

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