Implements scanning of transactions
This commit is contained in:
parent
24fd6e2e95
commit
a79b86cc05
6 changed files with 134 additions and 28 deletions
|
@ -5,7 +5,7 @@ All notable changes to this project will be documented in this file.
|
|||
The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/),
|
||||
and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0.html).
|
||||
|
||||
## [Unreleased]
|
||||
## [0.4.4.3]
|
||||
|
||||
### Added
|
||||
|
||||
|
@ -15,6 +15,7 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0
|
|||
- Command line arguments to switch to legacy version
|
||||
- New configuration parameter for Zebra port
|
||||
- New functions to call `getinfo` and `getblockchaininfo` RPC methods
|
||||
- `Scanner` module
|
||||
|
||||
## [0.4.1]
|
||||
|
||||
|
|
|
@ -8,8 +8,8 @@ import Zenith.Scanner (scanZebra)
|
|||
main :: IO ()
|
||||
main = do
|
||||
config <- load ["zenith.cfg"]
|
||||
dbFilePath <- require config "dbFilePath"
|
||||
{-dataStorePath <- require config "dataStorePath"-}
|
||||
--dbFilePath <- require config "dbFilePath"
|
||||
dataStorePath <- require config "dataStorePath"
|
||||
zebraPort <- require config "zebraPort"
|
||||
zebraHost <- require config "zebraHost"
|
||||
scanZebra 2772000 zebraHost zebraPort dbFilePath
|
||||
scanZebra 2781518 zebraHost zebraPort dataStorePath
|
||||
|
|
|
@ -17,14 +17,27 @@
|
|||
|
||||
module Zenith.DB where
|
||||
|
||||
import Control.Monad (when)
|
||||
import Control.Monad.IO.Class (liftIO)
|
||||
import qualified Data.ByteString as BS
|
||||
import Data.HexString
|
||||
import Data.Maybe (fromJust, isJust)
|
||||
import qualified Data.Text as T
|
||||
import Database.Persist
|
||||
import Database.Persist.Sqlite
|
||||
import Database.Persist.TH
|
||||
import ZcashHaskell.Types (Scope(..), ZcashNet)
|
||||
import Haskoin.Transaction.Common (TxOut(..))
|
||||
import ZcashHaskell.Types
|
||||
( OrchardAction(..)
|
||||
, OrchardBundle(..)
|
||||
, SaplingBundle(..)
|
||||
, Scope(..)
|
||||
, ShieldedOutput(..)
|
||||
, ShieldedSpend(..)
|
||||
, Transaction(..)
|
||||
, TransparentBundle(..)
|
||||
, ZcashNet
|
||||
)
|
||||
import Zenith.Types
|
||||
( HexStringDB(..)
|
||||
, OrchardSpendingKeyDB(..)
|
||||
|
@ -75,8 +88,11 @@ share
|
|||
txId HexStringDB
|
||||
conf Int
|
||||
time Int
|
||||
hex HexStringDB
|
||||
deriving Show Eq
|
||||
TransparentNote
|
||||
tx WalletTransactionId
|
||||
value Int
|
||||
script BS.ByteString
|
||||
OrchAction
|
||||
tx WalletTransactionId
|
||||
nf HexStringDB
|
||||
|
@ -194,3 +210,65 @@ saveAddress ::
|
|||
-> WalletAddress -- ^ The wallet to add to the database
|
||||
-> IO (Maybe (Entity WalletAddress))
|
||||
saveAddress dbFp w = runSqlite dbFp $ insertUniqueEntity w
|
||||
|
||||
-- | Save a transaction to the data model
|
||||
saveTransaction ::
|
||||
T.Text -- ^ the database path
|
||||
-> Int -- ^ block time
|
||||
-> Transaction -- ^ The transaction to save
|
||||
-> IO (Key WalletTransaction)
|
||||
saveTransaction dbFp t wt =
|
||||
runSqlite dbFp $ do
|
||||
w <-
|
||||
insert $
|
||||
WalletTransaction (tx_height wt) (HexStringDB $ tx_id wt) (tx_conf wt) t
|
||||
when (isJust $ tx_transpBundle wt) $
|
||||
insertMany_ $
|
||||
map (storeTxOut w) $ (tb_vout . fromJust . tx_transpBundle) wt
|
||||
when (isJust $ tx_saplingBundle wt) $ do
|
||||
_ <-
|
||||
insertMany_ $
|
||||
map (storeSapSpend w) $ (sbSpends . fromJust . tx_saplingBundle) wt
|
||||
_ <-
|
||||
insertMany_ $
|
||||
map (storeSapOutput w) $ (sbOutputs . fromJust . tx_saplingBundle) wt
|
||||
return ()
|
||||
when (isJust $ tx_orchardBundle wt) $
|
||||
insertMany_ $
|
||||
map (storeOrchAction w) $ (obActions . fromJust . tx_orchardBundle) wt
|
||||
return w
|
||||
where
|
||||
storeTxOut :: WalletTransactionId -> TxOut -> TransparentNote
|
||||
storeTxOut wid (TxOut v s) = TransparentNote wid (fromIntegral v) s
|
||||
storeSapSpend :: WalletTransactionId -> ShieldedSpend -> ShieldSpend
|
||||
storeSapSpend wid sp =
|
||||
ShieldSpend
|
||||
wid
|
||||
(HexStringDB $ sp_cv sp)
|
||||
(HexStringDB $ sp_anchor sp)
|
||||
(HexStringDB $ sp_nullifier sp)
|
||||
(HexStringDB $ sp_rk sp)
|
||||
(HexStringDB $ sp_proof sp)
|
||||
(HexStringDB $ sp_auth sp)
|
||||
storeSapOutput :: WalletTransactionId -> ShieldedOutput -> ShieldOutput
|
||||
storeSapOutput wid so =
|
||||
ShieldOutput
|
||||
wid
|
||||
(HexStringDB $ s_cv so)
|
||||
(HexStringDB $ s_cmu so)
|
||||
(HexStringDB $ s_ephKey so)
|
||||
(HexStringDB $ s_encCipherText so)
|
||||
(HexStringDB $ s_outCipherText so)
|
||||
(HexStringDB $ s_proof so)
|
||||
storeOrchAction :: WalletTransactionId -> OrchardAction -> OrchAction
|
||||
storeOrchAction wid oa =
|
||||
OrchAction
|
||||
wid
|
||||
(HexStringDB $ nf oa)
|
||||
(HexStringDB $ rk oa)
|
||||
(HexStringDB $ cmx oa)
|
||||
(HexStringDB $ eph_key oa)
|
||||
(HexStringDB $ enc_ciphertext oa)
|
||||
(HexStringDB $ out_ciphertext oa)
|
||||
(HexStringDB $ cv oa)
|
||||
(HexStringDB $ auth oa)
|
||||
|
|
|
@ -14,11 +14,13 @@ import ZcashHaskell.Types
|
|||
, Transaction(..)
|
||||
, ZebraGetBlockChainInfo(..)
|
||||
, ZebraTxResponse(..)
|
||||
, fromRawOBundle
|
||||
, fromRawSBundle
|
||||
, fromRawTBundle
|
||||
)
|
||||
import ZcashHaskell.Utils (makeZebraCall, readZebraTransaction)
|
||||
import ZcashHaskell.Utils (getBlockTime, makeZebraCall, readZebraTransaction)
|
||||
import Zenith.Core (checkBlockChain)
|
||||
import Zenith.DB (initRawStore)
|
||||
import Zenith.DB (initRawStore, saveTransaction)
|
||||
import Zenith.Utils (jsonNumber)
|
||||
|
||||
-- | Function to scan the Zcash blockchain through the Zebra node and populate the Zenith database
|
||||
|
@ -41,8 +43,8 @@ scanZebra b host port dbFilePath = do
|
|||
else do
|
||||
let bList = [b .. (zgb_blocks bStatus)]
|
||||
txList <-
|
||||
try $ concatMapM (processBlock host port) bList :: IO
|
||||
(Either IOError [Transaction])
|
||||
try $ mapM_ (processBlock host port dbFilePath) bList :: IO
|
||||
(Either IOError ())
|
||||
case txList of
|
||||
Left e1 -> print e1
|
||||
Right txList' -> print txList'
|
||||
|
@ -51,9 +53,10 @@ scanZebra b host port dbFilePath = do
|
|||
processBlock ::
|
||||
T.Text -- ^ Host name for `zebrad`
|
||||
-> Int -- ^ Port for `zebrad`
|
||||
-> T.Text -- ^ DB file path
|
||||
-> Int -- ^ The block number to process
|
||||
-> IO [Transaction]
|
||||
processBlock host port b = do
|
||||
-> IO ()
|
||||
processBlock host port dbFp b = do
|
||||
r <-
|
||||
makeZebraCall
|
||||
host
|
||||
|
@ -63,16 +66,36 @@ processBlock host port b = do
|
|||
case r of
|
||||
Left e -> throwIO $ userError e
|
||||
Right blk -> do
|
||||
x <- mapM (processTx host port) $ bl_txs blk
|
||||
return $ catMaybes x
|
||||
r2 <-
|
||||
makeZebraCall
|
||||
host
|
||||
port
|
||||
"getblock"
|
||||
[Data.Aeson.String $ T.pack $ show b, jsonNumber 0]
|
||||
case r2 of
|
||||
Left e2 -> throwIO $ userError e2
|
||||
Right hb -> do
|
||||
let blockTime = getBlockTime hb
|
||||
mapM_ (processTx host port blockTime dbFp) $
|
||||
bl_txs $ addTime blk blockTime
|
||||
where
|
||||
addTime :: BlockResponse -> Int -> BlockResponse
|
||||
addTime bl t =
|
||||
BlockResponse
|
||||
(bl_confirmations bl)
|
||||
(bl_height bl)
|
||||
(fromIntegral t)
|
||||
(bl_txs bl)
|
||||
|
||||
-- | Function to process a raw transaction
|
||||
processTx ::
|
||||
T.Text -- ^ Host name for `zebrad`
|
||||
-> Int -- ^ Port for `zebrad`
|
||||
-> Int -- ^ Block time
|
||||
-> T.Text -- ^ DB file path
|
||||
-> HexString -- ^ transaction id
|
||||
-> IO (Maybe Transaction)
|
||||
processTx host port t = do
|
||||
-> IO ()
|
||||
processTx host port bt dbFp t = do
|
||||
r <-
|
||||
makeZebraCall
|
||||
host
|
||||
|
@ -83,13 +106,16 @@ processTx host port t = do
|
|||
Left e -> throwIO $ userError e
|
||||
Right rawTx -> do
|
||||
case readZebraTransaction (ztr_hex rawTx) of
|
||||
Nothing -> return Nothing
|
||||
Just rzt ->
|
||||
return $
|
||||
Just $
|
||||
Transaction
|
||||
t
|
||||
(ztr_blockheight rawTx)
|
||||
(ztr_conf rawTx)
|
||||
(fromIntegral $ zt_expiry rzt)
|
||||
(fromRawTBundle $ zt_tBundle rzt)
|
||||
Nothing -> return ()
|
||||
Just rzt -> do
|
||||
k <-
|
||||
saveTransaction dbFp bt $
|
||||
Transaction
|
||||
t
|
||||
(ztr_blockheight rawTx)
|
||||
(ztr_conf rawTx)
|
||||
(fromIntegral $ zt_expiry rzt)
|
||||
(fromRawTBundle $ zt_tBundle rzt)
|
||||
(fromRawSBundle $ zt_sBundle rzt)
|
||||
(fromRawOBundle $ zt_oBundle rzt)
|
||||
print k
|
||||
|
|
|
@ -1 +1 @@
|
|||
Subproject commit 4b064af4dece54fe51e3704aa95db18324167d36
|
||||
Subproject commit 938ccb4b9730fd8615513eb27bdbffacd62e29cc
|
|
@ -1,6 +1,6 @@
|
|||
cabal-version: 3.0
|
||||
name: zenith
|
||||
version: 0.4.4.2
|
||||
version: 0.4.4.3
|
||||
license: MIT
|
||||
license-file: LICENSE
|
||||
author: Rene Vergara
|
||||
|
@ -44,6 +44,7 @@ library
|
|||
, brick
|
||||
, bytestring
|
||||
, ghc
|
||||
, haskoin-core
|
||||
, hexstring
|
||||
, http-client
|
||||
, http-conduit
|
||||
|
|
Loading…
Reference in a new issue