Implements scanning of transparent transactions #72
9 changed files with 162 additions and 58 deletions
15
app/ZenScan.hs
Normal file
15
app/ZenScan.hs
Normal 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
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -77,6 +77,35 @@ share
|
|||
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
|
||||
|
|
|
@ -2,9 +2,11 @@
|
|||
|
||||
module Zenith.Scanner where
|
||||
|
||||
import Control.Exception (throwIO)
|
||||
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(..)
|
||||
|
@ -13,6 +15,8 @@ import ZcashHaskell.Types
|
|||
)
|
||||
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 ::
|
||||
|
@ -22,26 +26,37 @@ scanZebra ::
|
|||
-> T.Text -- ^ Path to database file
|
||||
-> IO ()
|
||||
scanZebra b host port dbFilePath = do
|
||||
bc <- checkBlockChain host port
|
||||
_ <- initRawStore dbFilePath
|
||||
bc <-
|
||||
try $ checkBlockChain host port :: IO
|
||||
(Either IOError ZebraGetBlockChainInfo)
|
||||
case bc of
|
||||
Nothing -> throwIO $ userError "Failed to determine blockchain status"
|
||||
Just bStatus -> do
|
||||
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)]
|
||||
print bList
|
||||
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 ::
|
||||
Int -- ^ The block number to process
|
||||
-> T.Text -- ^ Host name for `zebrad`
|
||||
T.Text -- ^ Host name for `zebrad`
|
||||
-> Int -- ^ Port for `zebrad`
|
||||
-> Int -- ^ The block number to process
|
||||
-> IO [HexString]
|
||||
processBlock b host port = do
|
||||
processBlock host port b = do
|
||||
r <-
|
||||
result . getResponseBody <$>
|
||||
makeZebraCall host port "getblock" [fromIntegral b, 1]
|
||||
makeZebraCall
|
||||
host
|
||||
port
|
||||
"getblock"
|
||||
[Data.Aeson.String $ T.pack $ show b, jsonNumber 1]
|
||||
case r of
|
||||
Nothing -> throwIO $ userError "Unable to get block data from Zebra"
|
||||
Just b' -> return $ bl_txs b'
|
||||
Left e -> throwIO $ userError e
|
||||
Right blk -> return $ bl_txs blk
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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,7 +48,10 @@ listAddresses user pwd = do
|
|||
Nothing -> fail "Couldn't parse node response"
|
||||
Just res -> do
|
||||
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
|
||||
|
||||
-- | Get address balance
|
||||
|
@ -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,7 +171,10 @@ checkServer user pwd = do
|
|||
Nothing -> fail "Couldn't parse node response"
|
||||
Just myResp -> do
|
||||
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 <> ") :)"
|
||||
else do
|
||||
putStrLn "Deprecated Zcash Full Node version found. Exiting"
|
||||
|
@ -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
|
15
zenith.cabal
15
zenith.cabal
|
@ -43,6 +43,8 @@ library
|
|||
, base64-bytestring
|
||||
, brick
|
||||
, bytestring
|
||||
, ghc
|
||||
, hexstring
|
||||
, http-client
|
||||
, http-conduit
|
||||
, http-types
|
||||
|
@ -54,7 +56,6 @@ library
|
|||
, persistent-sqlite
|
||||
, persistent-template
|
||||
, process
|
||||
, hexstring
|
||||
, regex-base
|
||||
, regex-compat
|
||||
, regex-posix
|
||||
|
@ -87,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
|
||||
|
|
Loading…
Reference in a new issue