Include display of balance and transactions #76
5 changed files with 233 additions and 53 deletions
|
@ -163,5 +163,10 @@ createWalletAddress n i zNet scope za = do
|
||||||
syncWallet ::
|
syncWallet ::
|
||||||
T.Text -- ^ The database path
|
T.Text -- ^ The database path
|
||||||
-> Entity ZcashWallet
|
-> Entity ZcashWallet
|
||||||
-> IO ()
|
-> IO String
|
||||||
syncWallet walletDb w = undefined
|
syncWallet walletDb w = do
|
||||||
|
accs <- getAccounts walletDb $ entityKey w
|
||||||
|
addrs <- concat <$> mapM (getAddresses walletDb . entityKey) accs
|
||||||
|
lastBlock <- getMaxWalletBlock walletDb
|
||||||
|
trNotes <- mapM (findTransparentNotes walletDb lastBlock . entityVal) addrs
|
||||||
|
return $ show trNotes
|
||||||
|
|
260
src/Zenith/DB.hs
260
src/Zenith/DB.hs
|
@ -14,19 +14,27 @@
|
||||||
{-# LANGUAGE DataKinds #-}
|
{-# LANGUAGE DataKinds #-}
|
||||||
{-# LANGUAGE FlexibleInstances #-}
|
{-# LANGUAGE FlexibleInstances #-}
|
||||||
{-# LANGUAGE TypeOperators #-}
|
{-# LANGUAGE TypeOperators #-}
|
||||||
|
{-# LANGUAGE TypeApplications #-}
|
||||||
|
|
||||||
module Zenith.DB where
|
module Zenith.DB where
|
||||||
|
|
||||||
import Control.Monad (when)
|
import Control.Monad (when)
|
||||||
import Control.Monad.IO.Class (liftIO)
|
|
||||||
import qualified Data.ByteString as BS
|
import qualified Data.ByteString as BS
|
||||||
import Data.HexString
|
import Data.HexString
|
||||||
import Data.Maybe (fromJust, isJust)
|
import Data.Maybe (fromJust, isJust)
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
import Database.Persist
|
import qualified Data.Text.Encoding as TE
|
||||||
import Database.Persist.Sqlite
|
import Database.Esqueleto.Experimental
|
||||||
|
import qualified Database.Persist as P
|
||||||
|
import qualified Database.Persist.Sqlite as PS
|
||||||
import Database.Persist.TH
|
import Database.Persist.TH
|
||||||
import Haskoin.Transaction.Common (TxOut(..))
|
import Haskoin.Transaction.Common
|
||||||
|
( OutPoint(..)
|
||||||
|
, TxIn(..)
|
||||||
|
, TxOut(..)
|
||||||
|
, txHashToHex
|
||||||
|
)
|
||||||
|
import ZcashHaskell.Orchard (isValidUnifiedAddress)
|
||||||
import ZcashHaskell.Types
|
import ZcashHaskell.Types
|
||||||
( OrchardAction(..)
|
( OrchardAction(..)
|
||||||
, OrchardBundle(..)
|
, OrchardBundle(..)
|
||||||
|
@ -35,7 +43,9 @@ import ZcashHaskell.Types
|
||||||
, ShieldedOutput(..)
|
, ShieldedOutput(..)
|
||||||
, ShieldedSpend(..)
|
, ShieldedSpend(..)
|
||||||
, Transaction(..)
|
, Transaction(..)
|
||||||
|
, TransparentAddress(..)
|
||||||
, TransparentBundle(..)
|
, TransparentBundle(..)
|
||||||
|
, UnifiedAddress(..)
|
||||||
, ZcashNet
|
, ZcashNet
|
||||||
)
|
)
|
||||||
import Zenith.Types
|
import Zenith.Types
|
||||||
|
@ -83,6 +93,7 @@ share
|
||||||
block Int
|
block Int
|
||||||
conf Int
|
conf Int
|
||||||
time Int
|
time Int
|
||||||
|
UniqueWTx txId
|
||||||
deriving Show Eq
|
deriving Show Eq
|
||||||
WalletTrNote
|
WalletTrNote
|
||||||
tx WalletTransactionId
|
tx WalletTransactionId
|
||||||
|
@ -99,6 +110,7 @@ share
|
||||||
memo T.Text
|
memo T.Text
|
||||||
rawId ShieldOutputId
|
rawId ShieldOutputId
|
||||||
spent Bool
|
spent Bool
|
||||||
|
nullifier HexStringDB
|
||||||
deriving Show Eq
|
deriving Show Eq
|
||||||
WalletOrchNote
|
WalletOrchNote
|
||||||
tx WalletTransactionId
|
tx WalletTransactionId
|
||||||
|
@ -108,6 +120,7 @@ share
|
||||||
memo T.Text
|
memo T.Text
|
||||||
rawId OrchActionId
|
rawId OrchActionId
|
||||||
spent Bool
|
spent Bool
|
||||||
|
nullifier HexStringDB
|
||||||
deriving Show Eq
|
deriving Show Eq
|
||||||
ZcashTransaction
|
ZcashTransaction
|
||||||
block Int
|
block Int
|
||||||
|
@ -119,6 +132,18 @@ share
|
||||||
tx ZcashTransactionId
|
tx ZcashTransactionId
|
||||||
value Int
|
value Int
|
||||||
script BS.ByteString
|
script BS.ByteString
|
||||||
|
position Int
|
||||||
|
UniqueTNPos tx position
|
||||||
|
deriving Show Eq
|
||||||
|
TransparentSpend
|
||||||
|
tx ZcashTransactionId
|
||||||
|
outPointHash HexStringDB
|
||||||
|
outPointIndex Int
|
||||||
|
script BS.ByteString
|
||||||
|
seq Int
|
||||||
|
position Int
|
||||||
|
UniqueTSPos tx position
|
||||||
|
deriving Show Eq
|
||||||
OrchAction
|
OrchAction
|
||||||
tx ZcashTransactionId
|
tx ZcashTransactionId
|
||||||
nf HexStringDB
|
nf HexStringDB
|
||||||
|
@ -129,6 +154,8 @@ share
|
||||||
outCipher HexStringDB
|
outCipher HexStringDB
|
||||||
cv HexStringDB
|
cv HexStringDB
|
||||||
auth HexStringDB
|
auth HexStringDB
|
||||||
|
position Int
|
||||||
|
UniqueOAPos tx position
|
||||||
deriving Show Eq
|
deriving Show Eq
|
||||||
ShieldOutput
|
ShieldOutput
|
||||||
tx ZcashTransactionId
|
tx ZcashTransactionId
|
||||||
|
@ -138,6 +165,8 @@ share
|
||||||
encCipher HexStringDB
|
encCipher HexStringDB
|
||||||
outCipher HexStringDB
|
outCipher HexStringDB
|
||||||
proof HexStringDB
|
proof HexStringDB
|
||||||
|
position Int
|
||||||
|
UniqueSOPos tx position
|
||||||
deriving Show Eq
|
deriving Show Eq
|
||||||
ShieldSpend
|
ShieldSpend
|
||||||
tx ZcashTransactionId
|
tx ZcashTransactionId
|
||||||
|
@ -147,6 +176,8 @@ share
|
||||||
rk HexStringDB
|
rk HexStringDB
|
||||||
proof HexStringDB
|
proof HexStringDB
|
||||||
authSig HexStringDB
|
authSig HexStringDB
|
||||||
|
position Int
|
||||||
|
UniqueSSPos tx position
|
||||||
deriving Show Eq
|
deriving Show Eq
|
||||||
|]
|
|]
|
||||||
|
|
||||||
|
@ -156,26 +187,35 @@ initDb ::
|
||||||
T.Text -- ^ The database path to check
|
T.Text -- ^ The database path to check
|
||||||
-> IO ()
|
-> IO ()
|
||||||
initDb dbName = do
|
initDb dbName = do
|
||||||
runSqlite dbName $ do runMigration migrateAll
|
PS.runSqlite dbName $ do runMigration migrateAll
|
||||||
|
|
||||||
-- | 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 =
|
||||||
runSqlite dbFp $ selectList [ZcashWalletNetwork ==. ZcashNetDB n] []
|
PS.runSqlite dbFp $
|
||||||
|
select $ do
|
||||||
|
wallets <- from $ table @ZcashWallet
|
||||||
|
where_ (wallets ^. ZcashWalletNetwork ==. val (ZcashNetDB n))
|
||||||
|
pure wallets
|
||||||
|
|
||||||
-- | Save a new wallet to the database
|
-- | Save a new wallet to the database
|
||||||
saveWallet ::
|
saveWallet ::
|
||||||
T.Text -- ^ The database path to use
|
T.Text -- ^ The database path to use
|
||||||
-> ZcashWallet -- ^ The wallet to add to the database
|
-> ZcashWallet -- ^ The wallet to add to the database
|
||||||
-> IO (Maybe (Entity ZcashWallet))
|
-> IO (Maybe (Entity ZcashWallet))
|
||||||
saveWallet dbFp w = runSqlite dbFp $ insertUniqueEntity w
|
saveWallet dbFp w = PS.runSqlite dbFp $ insertUniqueEntity w
|
||||||
|
|
||||||
-- | Returns a list of accounts associated with the given wallet
|
-- | Returns a list of accounts associated with the given wallet
|
||||||
getAccounts ::
|
getAccounts ::
|
||||||
T.Text -- ^ The database path
|
T.Text -- ^ The database path
|
||||||
-> ZcashWalletId -- ^ The wallet ID to check
|
-> ZcashWalletId -- ^ The wallet ID to check
|
||||||
-> IO [Entity ZcashAccount]
|
-> IO [Entity ZcashAccount]
|
||||||
getAccounts dbFp w = runSqlite dbFp $ selectList [ZcashAccountWalletId ==. w] []
|
getAccounts dbFp w =
|
||||||
|
PS.runSqlite dbFp $
|
||||||
|
select $ do
|
||||||
|
accs <- from $ table @ZcashAccount
|
||||||
|
where_ (accs ^. ZcashAccountWalletId ==. val w)
|
||||||
|
pure accs
|
||||||
|
|
||||||
-- | Returns the largest account index for the given wallet
|
-- | Returns the largest account index for the given wallet
|
||||||
getMaxAccount ::
|
getMaxAccount ::
|
||||||
|
@ -184,8 +224,12 @@ getMaxAccount ::
|
||||||
-> IO Int
|
-> IO Int
|
||||||
getMaxAccount dbFp w = do
|
getMaxAccount dbFp w = do
|
||||||
a <-
|
a <-
|
||||||
runSqlite dbFp $
|
PS.runSqlite dbFp $
|
||||||
selectFirst [ZcashAccountWalletId ==. w] [Desc ZcashAccountIndex]
|
selectOne $ do
|
||||||
|
accs <- from $ table @ZcashAccount
|
||||||
|
where_ (accs ^. ZcashAccountWalletId ==. val w)
|
||||||
|
orderBy [desc $ accs ^. ZcashAccountIndex]
|
||||||
|
pure accs
|
||||||
case a of
|
case a of
|
||||||
Nothing -> return $ -1
|
Nothing -> return $ -1
|
||||||
Just x -> return $ zcashAccountIndex $ entityVal x
|
Just x -> return $ zcashAccountIndex $ entityVal x
|
||||||
|
@ -195,7 +239,7 @@ saveAccount ::
|
||||||
T.Text -- ^ The database path
|
T.Text -- ^ The database path
|
||||||
-> ZcashAccount -- ^ The account to add to the database
|
-> ZcashAccount -- ^ The account to add to the database
|
||||||
-> IO (Maybe (Entity ZcashAccount))
|
-> IO (Maybe (Entity ZcashAccount))
|
||||||
saveAccount dbFp a = runSqlite dbFp $ insertUniqueEntity a
|
saveAccount dbFp a = PS.runSqlite dbFp $ insertUniqueEntity a
|
||||||
|
|
||||||
-- | Returns the largest block in storage
|
-- | Returns the largest block in storage
|
||||||
getMaxBlock ::
|
getMaxBlock ::
|
||||||
|
@ -203,34 +247,38 @@ getMaxBlock ::
|
||||||
-> IO Int
|
-> IO Int
|
||||||
getMaxBlock dbPath = do
|
getMaxBlock dbPath = do
|
||||||
b <-
|
b <-
|
||||||
runSqlite dbPath $
|
PS.runSqlite dbPath $
|
||||||
selectFirst [ZcashTransactionBlock >. 0] [Desc ZcashTransactionBlock]
|
selectOne $ do
|
||||||
|
txs <- from $ table @ZcashTransaction
|
||||||
|
where_ (txs ^. ZcashTransactionBlock >. val 0)
|
||||||
|
orderBy [desc $ txs ^. ZcashTransactionBlock]
|
||||||
|
pure txs
|
||||||
case b of
|
case b of
|
||||||
Nothing -> return $ -1
|
Nothing -> return $ -1
|
||||||
Just x -> return $ zcashTransactionBlock $ entityVal x
|
Just x -> return $ zcashTransactionBlock $ entityVal x
|
||||||
|
|
||||||
-- | Returns the largest block in the wallet
|
|
||||||
getMaxWalletBlock ::
|
|
||||||
T.Text -- ^ The database path
|
|
||||||
-> IO Int
|
|
||||||
getMaxWalletBlock dbPath = do
|
|
||||||
b <-
|
|
||||||
runSqlite dbPath $
|
|
||||||
selectFirst [WalletTransactionBlock >. 0] [Desc WalletTransactionBlock]
|
|
||||||
case b of
|
|
||||||
Nothing -> return $ -1
|
|
||||||
Just x -> return $ walletTransactionBlock $ entityVal x
|
|
||||||
|
|
||||||
-- | Returns a list of addresses associated with the given account
|
-- | Returns a list of addresses associated with the given account
|
||||||
getAddresses ::
|
getAddresses ::
|
||||||
T.Text -- ^ The database path
|
T.Text -- ^ The database path
|
||||||
-> ZcashAccountId -- ^ The account ID to check
|
-> ZcashAccountId -- ^ The account ID to check
|
||||||
-> IO [Entity WalletAddress]
|
-> IO [Entity WalletAddress]
|
||||||
getAddresses dbFp a =
|
getAddresses dbFp a =
|
||||||
runSqlite dbFp $
|
PS.runSqlite dbFp $
|
||||||
selectList
|
select $ do
|
||||||
[WalletAddressAccId ==. a, WalletAddressScope ==. ScopeDB External]
|
addrs <- from $ table @WalletAddress
|
||||||
[]
|
where_ (addrs ^. WalletAddressAccId ==. val a)
|
||||||
|
where_ (addrs ^. WalletAddressScope ==. val (ScopeDB External))
|
||||||
|
pure addrs
|
||||||
|
|
||||||
|
-- | Returns a list of addressess associated with the given wallet
|
||||||
|
getWalletAddresses ::
|
||||||
|
T.Text -- ^ The database path
|
||||||
|
-> ZcashWalletId -- ^ the wallet to search
|
||||||
|
-> IO [Entity WalletAddress]
|
||||||
|
getWalletAddresses dbFp w = do
|
||||||
|
accs <- getAccounts dbFp w
|
||||||
|
addrs <- mapM (getAddresses dbFp . entityKey) accs
|
||||||
|
return $ concat addrs
|
||||||
|
|
||||||
-- | Returns the largest address index for the given account
|
-- | Returns the largest address index for the given account
|
||||||
getMaxAddress ::
|
getMaxAddress ::
|
||||||
|
@ -240,10 +288,13 @@ getMaxAddress ::
|
||||||
-> IO Int
|
-> IO Int
|
||||||
getMaxAddress dbFp aw s = do
|
getMaxAddress dbFp aw s = do
|
||||||
a <-
|
a <-
|
||||||
runSqlite dbFp $
|
PS.runSqlite dbFp $
|
||||||
selectFirst
|
selectOne $ do
|
||||||
[WalletAddressAccId ==. aw, WalletAddressScope ==. ScopeDB s]
|
addrs <- from $ table @WalletAddress
|
||||||
[Desc WalletAddressIndex]
|
where_ $ addrs ^. WalletAddressAccId ==. val aw
|
||||||
|
where_ $ addrs ^. WalletAddressScope ==. val (ScopeDB s)
|
||||||
|
orderBy [desc $ addrs ^. WalletAddressIndex]
|
||||||
|
pure addrs
|
||||||
case a of
|
case a of
|
||||||
Nothing -> return $ -1
|
Nothing -> return $ -1
|
||||||
Just x -> return $ walletAddressIndex $ entityVal x
|
Just x -> return $ walletAddressIndex $ entityVal x
|
||||||
|
@ -253,7 +304,7 @@ saveAddress ::
|
||||||
T.Text -- ^ the database path
|
T.Text -- ^ the database path
|
||||||
-> WalletAddress -- ^ The wallet to add to the database
|
-> WalletAddress -- ^ The wallet to add to the database
|
||||||
-> IO (Maybe (Entity WalletAddress))
|
-> IO (Maybe (Entity WalletAddress))
|
||||||
saveAddress dbFp w = runSqlite dbFp $ insertUniqueEntity w
|
saveAddress dbFp w = PS.runSqlite dbFp $ insertUniqueEntity w
|
||||||
|
|
||||||
-- | Save a transaction to the data model
|
-- | Save a transaction to the data model
|
||||||
saveTransaction ::
|
saveTransaction ::
|
||||||
|
@ -262,30 +313,50 @@ saveTransaction ::
|
||||||
-> Transaction -- ^ The transaction to save
|
-> Transaction -- ^ The transaction to save
|
||||||
-> IO (Key ZcashTransaction)
|
-> IO (Key ZcashTransaction)
|
||||||
saveTransaction dbFp t wt =
|
saveTransaction dbFp t wt =
|
||||||
runSqlite dbFp $ do
|
PS.runSqlite dbFp $ do
|
||||||
|
let ix = [0 ..]
|
||||||
w <-
|
w <-
|
||||||
insert $
|
insert $
|
||||||
ZcashTransaction (tx_height wt) (HexStringDB $ tx_id wt) (tx_conf wt) t
|
ZcashTransaction (tx_height wt) (HexStringDB $ tx_id wt) (tx_conf wt) t
|
||||||
when (isJust $ tx_transpBundle wt) $
|
when (isJust $ tx_transpBundle wt) $ do
|
||||||
insertMany_ $
|
_ <-
|
||||||
map (storeTxOut w) $ (tb_vout . fromJust . tx_transpBundle) wt
|
insertMany_ $
|
||||||
|
zipWith (curry (storeTxOut w)) ix $
|
||||||
|
(tb_vout . fromJust . tx_transpBundle) wt
|
||||||
|
_ <-
|
||||||
|
insertMany_ $
|
||||||
|
zipWith (curry (storeTxIn w)) ix $
|
||||||
|
(tb_vin . fromJust . tx_transpBundle) wt
|
||||||
|
return ()
|
||||||
when (isJust $ tx_saplingBundle wt) $ do
|
when (isJust $ tx_saplingBundle wt) $ do
|
||||||
_ <-
|
_ <-
|
||||||
insertMany_ $
|
insertMany_ $
|
||||||
map (storeSapSpend w) $ (sbSpends . fromJust . tx_saplingBundle) wt
|
zipWith (curry (storeSapSpend w)) ix $
|
||||||
|
(sbSpends . fromJust . tx_saplingBundle) wt
|
||||||
_ <-
|
_ <-
|
||||||
insertMany_ $
|
insertMany_ $
|
||||||
map (storeSapOutput w) $ (sbOutputs . fromJust . tx_saplingBundle) wt
|
zipWith (curry (storeSapOutput w)) ix $
|
||||||
|
(sbOutputs . fromJust . tx_saplingBundle) wt
|
||||||
return ()
|
return ()
|
||||||
when (isJust $ tx_orchardBundle wt) $
|
when (isJust $ tx_orchardBundle wt) $
|
||||||
insertMany_ $
|
insertMany_ $
|
||||||
map (storeOrchAction w) $ (obActions . fromJust . tx_orchardBundle) wt
|
zipWith (curry (storeOrchAction w)) ix $
|
||||||
|
(obActions . fromJust . tx_orchardBundle) wt
|
||||||
return w
|
return w
|
||||||
where
|
where
|
||||||
storeTxOut :: ZcashTransactionId -> TxOut -> TransparentNote
|
storeTxOut :: ZcashTransactionId -> (Int, TxOut) -> TransparentNote
|
||||||
storeTxOut wid (TxOut v s) = TransparentNote wid (fromIntegral v) s
|
storeTxOut wid (i, TxOut v s) = TransparentNote wid (fromIntegral v) s i
|
||||||
storeSapSpend :: ZcashTransactionId -> ShieldedSpend -> ShieldSpend
|
storeTxIn :: ZcashTransactionId -> (Int, TxIn) -> TransparentSpend
|
||||||
storeSapSpend wid sp =
|
storeTxIn wid (i, TxIn (OutPoint h k) s sq) =
|
||||||
|
TransparentSpend
|
||||||
|
wid
|
||||||
|
(HexStringDB . fromText $ txHashToHex h)
|
||||||
|
(fromIntegral k)
|
||||||
|
s
|
||||||
|
(fromIntegral sq)
|
||||||
|
i
|
||||||
|
storeSapSpend :: ZcashTransactionId -> (Int, ShieldedSpend) -> ShieldSpend
|
||||||
|
storeSapSpend wid (i, sp) =
|
||||||
ShieldSpend
|
ShieldSpend
|
||||||
wid
|
wid
|
||||||
(HexStringDB $ sp_cv sp)
|
(HexStringDB $ sp_cv sp)
|
||||||
|
@ -294,8 +365,10 @@ saveTransaction dbFp t wt =
|
||||||
(HexStringDB $ sp_rk sp)
|
(HexStringDB $ sp_rk sp)
|
||||||
(HexStringDB $ sp_proof sp)
|
(HexStringDB $ sp_proof sp)
|
||||||
(HexStringDB $ sp_auth sp)
|
(HexStringDB $ sp_auth sp)
|
||||||
storeSapOutput :: ZcashTransactionId -> ShieldedOutput -> ShieldOutput
|
i
|
||||||
storeSapOutput wid so =
|
storeSapOutput ::
|
||||||
|
ZcashTransactionId -> (Int, ShieldedOutput) -> ShieldOutput
|
||||||
|
storeSapOutput wid (i, so) =
|
||||||
ShieldOutput
|
ShieldOutput
|
||||||
wid
|
wid
|
||||||
(HexStringDB $ s_cv so)
|
(HexStringDB $ s_cv so)
|
||||||
|
@ -304,8 +377,9 @@ saveTransaction dbFp t wt =
|
||||||
(HexStringDB $ s_encCipherText so)
|
(HexStringDB $ s_encCipherText so)
|
||||||
(HexStringDB $ s_outCipherText so)
|
(HexStringDB $ s_outCipherText so)
|
||||||
(HexStringDB $ s_proof so)
|
(HexStringDB $ s_proof so)
|
||||||
storeOrchAction :: ZcashTransactionId -> OrchardAction -> OrchAction
|
i
|
||||||
storeOrchAction wid oa =
|
storeOrchAction :: ZcashTransactionId -> (Int, OrchardAction) -> OrchAction
|
||||||
|
storeOrchAction wid (i, oa) =
|
||||||
OrchAction
|
OrchAction
|
||||||
wid
|
wid
|
||||||
(HexStringDB $ nf oa)
|
(HexStringDB $ nf oa)
|
||||||
|
@ -316,3 +390,91 @@ saveTransaction dbFp t wt =
|
||||||
(HexStringDB $ out_ciphertext oa)
|
(HexStringDB $ out_ciphertext oa)
|
||||||
(HexStringDB $ cv oa)
|
(HexStringDB $ cv oa)
|
||||||
(HexStringDB $ auth oa)
|
(HexStringDB $ auth oa)
|
||||||
|
i
|
||||||
|
|
||||||
|
-- | Get the transactions from a particular block forward
|
||||||
|
getZcashTransactions ::
|
||||||
|
T.Text -- ^ The database path
|
||||||
|
-> Int -- ^ Block
|
||||||
|
-> IO [Entity ZcashTransaction]
|
||||||
|
getZcashTransactions dbFp b =
|
||||||
|
PS.runSqlite dbFp $
|
||||||
|
select $ do
|
||||||
|
txs <- from $ table @ZcashTransaction
|
||||||
|
where_ $ txs ^. ZcashTransactionBlock >. val b
|
||||||
|
orderBy [asc $ txs ^. ZcashTransactionBlock]
|
||||||
|
return txs
|
||||||
|
|
||||||
|
-- * Wallet
|
||||||
|
-- | Get the block of the last transaction known to the wallet
|
||||||
|
getMaxWalletBlock ::
|
||||||
|
T.Text -- ^ The database path
|
||||||
|
-> IO Int
|
||||||
|
getMaxWalletBlock dbPath = do
|
||||||
|
b <-
|
||||||
|
PS.runSqlite dbPath $
|
||||||
|
selectOne $ do
|
||||||
|
txs <- from $ table @WalletTransaction
|
||||||
|
where_ $ txs ^. WalletTransactionBlock >. val 0
|
||||||
|
orderBy [desc $ txs ^. WalletTransactionBlock]
|
||||||
|
return txs
|
||||||
|
case b of
|
||||||
|
Nothing -> return $ -1
|
||||||
|
Just x -> return $ walletTransactionBlock $ entityVal x
|
||||||
|
|
||||||
|
-- | Find the Transparent Notes that match the given transparent receiver
|
||||||
|
findTransparentNotes ::
|
||||||
|
T.Text -- ^ The database path
|
||||||
|
-> Int -- ^ Starting block
|
||||||
|
-> WalletAddress
|
||||||
|
-> IO [(Entity ZcashTransaction, Entity TransparentNote)]
|
||||||
|
findTransparentNotes dbPath b t = do
|
||||||
|
let tReceiver = t_rec =<< readUnifiedAddressDB t
|
||||||
|
case tReceiver of
|
||||||
|
Just tR -> do
|
||||||
|
let s =
|
||||||
|
BS.concat
|
||||||
|
[ BS.pack [0x76, 0xA9, 0x14]
|
||||||
|
, (toBytes . ta_bytes) tR
|
||||||
|
, BS.pack [0x88, 0xAC]
|
||||||
|
]
|
||||||
|
PS.runSqlite dbPath $
|
||||||
|
select $ do
|
||||||
|
(txs :& tNotes) <-
|
||||||
|
from $ table @ZcashTransaction `innerJoin` table @TransparentNote `on`
|
||||||
|
(\(txs :& tNotes) ->
|
||||||
|
txs ^. ZcashTransactionId ==. tNotes ^. TransparentNoteTx)
|
||||||
|
where_ (txs ^. ZcashTransactionBlock >. val b)
|
||||||
|
where_ (tNotes ^. TransparentNoteScript ==. val s)
|
||||||
|
pure (txs, tNotes)
|
||||||
|
Nothing -> return []
|
||||||
|
|
||||||
|
-- | Add the transparent notes to the wallet
|
||||||
|
saveWalletTrNote ::
|
||||||
|
T.Text -- ^ the database path
|
||||||
|
-> (Entity ZcashTransaction, Entity TransparentNote)
|
||||||
|
-> WalletAddressId
|
||||||
|
-> IO ()
|
||||||
|
saveWalletTrNote dbPath (zt, tn) wa = do
|
||||||
|
let zT' = entityVal zt
|
||||||
|
PS.runSqlite dbPath $ do
|
||||||
|
t <-
|
||||||
|
upsert
|
||||||
|
(WalletTransaction
|
||||||
|
(zcashTransactionTxId zT')
|
||||||
|
(zcashTransactionBlock zT')
|
||||||
|
(zcashTransactionConf zT')
|
||||||
|
(zcashTransactionTime zT'))
|
||||||
|
[]
|
||||||
|
insert_ $
|
||||||
|
WalletTrNote
|
||||||
|
(entityKey t)
|
||||||
|
wa
|
||||||
|
(transparentNoteValue $ entityVal tn)
|
||||||
|
(entityKey tn)
|
||||||
|
False
|
||||||
|
|
||||||
|
-- | Helper function to extract a Unified Address from the database
|
||||||
|
readUnifiedAddressDB :: WalletAddress -> Maybe UnifiedAddress
|
||||||
|
readUnifiedAddressDB =
|
||||||
|
isValidUnifiedAddress . TE.encodeUtf8 . getUA . walletAddressUAddress
|
||||||
|
|
11
test/Spec.hs
11
test/Spec.hs
|
@ -4,6 +4,7 @@ import Control.Monad (when)
|
||||||
import Database.Persist
|
import Database.Persist
|
||||||
import Database.Persist.Sqlite
|
import Database.Persist.Sqlite
|
||||||
import System.Directory
|
import System.Directory
|
||||||
|
import Test.HUnit
|
||||||
import Test.Hspec
|
import Test.Hspec
|
||||||
import ZcashHaskell.Orchard (isValidUnifiedAddress)
|
import ZcashHaskell.Orchard (isValidUnifiedAddress)
|
||||||
import ZcashHaskell.Types
|
import ZcashHaskell.Types
|
||||||
|
@ -98,3 +99,13 @@ main = do
|
||||||
let ua =
|
let ua =
|
||||||
"utest1mvlny48qd4x94w8vz5u2lrxx0enuquajt72yekgq24p6pjaky3czk6m7x358h7g900ex6gzvdehaekl96qnakjzw8yaasp8y0u3j5jnlfd33trduznh6k3fcn5ek9qc857fgz8ehm37etx94sj58nrkc0k5hurxnuxpcpms3j8uy2t8kt2vy6vetvsfxxdhtjq0yqulqprvh7mf2u3x"
|
"utest1mvlny48qd4x94w8vz5u2lrxx0enuquajt72yekgq24p6pjaky3czk6m7x358h7g900ex6gzvdehaekl96qnakjzw8yaasp8y0u3j5jnlfd33trduznh6k3fcn5ek9qc857fgz8ehm37etx94sj58nrkc0k5hurxnuxpcpms3j8uy2t8kt2vy6vetvsfxxdhtjq0yqulqprvh7mf2u3x"
|
||||||
isValidUnifiedAddress ua `shouldNotBe` Nothing
|
isValidUnifiedAddress ua `shouldNotBe` Nothing
|
||||||
|
describe "Function tests" $ do
|
||||||
|
it "Wallet sync" $ do
|
||||||
|
w <-
|
||||||
|
runSqlite "zenith.db" $
|
||||||
|
selectFirst [ZcashWalletBirthdayHeight >. 0] []
|
||||||
|
case w of
|
||||||
|
Nothing -> assertFailure "No wallet in DB"
|
||||||
|
Just w' -> do
|
||||||
|
r <- syncWallet "zenith.db" w'
|
||||||
|
r `shouldBe` "Done"
|
||||||
|
|
|
@ -1 +1 @@
|
||||||
Subproject commit 938ccb4b9730fd8615513eb27bdbffacd62e29cc
|
Subproject commit 2709d422667080527ccc180e97352693a4c6c2c7
|
|
@ -39,10 +39,12 @@ library
|
||||||
Clipboard
|
Clipboard
|
||||||
, aeson
|
, aeson
|
||||||
, array
|
, array
|
||||||
|
, ascii-progress
|
||||||
, base >=4.12 && <5
|
, base >=4.12 && <5
|
||||||
, base64-bytestring
|
, base64-bytestring
|
||||||
, brick
|
, brick
|
||||||
, bytestring
|
, bytestring
|
||||||
|
, esqueleto
|
||||||
, ghc
|
, ghc
|
||||||
, haskoin-core
|
, haskoin-core
|
||||||
, hexstring
|
, hexstring
|
||||||
|
@ -65,7 +67,6 @@ library
|
||||||
, vector
|
, vector
|
||||||
, vty
|
, vty
|
||||||
, word-wrap
|
, word-wrap
|
||||||
, ascii-progress
|
|
||||||
, zcash-haskell
|
, zcash-haskell
|
||||||
--pkgconfig-depends: rustzcash_wrapper
|
--pkgconfig-depends: rustzcash_wrapper
|
||||||
default-language: Haskell2010
|
default-language: Haskell2010
|
||||||
|
@ -119,6 +120,7 @@ test-suite zenith-tests
|
||||||
, persistent
|
, persistent
|
||||||
, persistent-sqlite
|
, persistent-sqlite
|
||||||
, hspec
|
, hspec
|
||||||
|
, HUnit
|
||||||
, directory
|
, directory
|
||||||
, zcash-haskell
|
, zcash-haskell
|
||||||
, zenith
|
, zenith
|
||||||
|
|
Loading…
Reference in a new issue