Add Zenith Scanner #71
11 changed files with 231 additions and 75 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 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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
62
src/Zenith/Scanner.hs
Normal 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
|
|
@ -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)
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
16
zenith.cabal
16
zenith.cabal
|
@ -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
|
||||||
|
|
|
@ -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"
|
||||||
|
|
Loading…
Reference in a new issue