feat!: add block tracking to data model
Adds new `ZcashBlock` table to database to track block information and creates a relationship between `ZcashTransaction` records and the block they belong to. Database getters and setters are updated to use the block record for confirmations, height, time data.
This commit is contained in:
parent
7189ddcb2a
commit
0e14228a0e
9 changed files with 570 additions and 203 deletions
|
@ -230,6 +230,7 @@ main = do
|
||||||
"gui" -> runZenithGUI myConfig
|
"gui" -> runZenithGUI myConfig
|
||||||
"tui" -> runZenithTUI myConfig
|
"tui" -> runZenithTUI myConfig
|
||||||
"rescan" -> rescanZebra zebraHost zebraPort dbFilePath
|
"rescan" -> rescanZebra zebraHost zebraPort dbFilePath
|
||||||
|
"resync" -> clearSync myConfig
|
||||||
_ -> printUsage
|
_ -> printUsage
|
||||||
else printUsage
|
else printUsage
|
||||||
|
|
||||||
|
|
|
@ -91,6 +91,7 @@ import Zenith.DB
|
||||||
import Zenith.Scanner (processTx, rescanZebra, updateConfs)
|
import Zenith.Scanner (processTx, rescanZebra, updateConfs)
|
||||||
import Zenith.Types
|
import Zenith.Types
|
||||||
( Config(..)
|
( Config(..)
|
||||||
|
, HexStringDB(..)
|
||||||
, PhraseDB(..)
|
, PhraseDB(..)
|
||||||
, UnifiedAddressDB(..)
|
, UnifiedAddressDB(..)
|
||||||
, ZcashNetDB(..)
|
, ZcashNetDB(..)
|
||||||
|
@ -765,16 +766,16 @@ scanZebra dbP zHost zPort b eChan znet = do
|
||||||
Left e2 -> liftIO $ BC.writeBChan eChan $ TickMsg e2
|
Left e2 -> liftIO $ BC.writeBChan eChan $ TickMsg e2
|
||||||
Right hb -> do
|
Right hb -> do
|
||||||
let blockTime = getBlockTime hb
|
let blockTime = getBlockTime hb
|
||||||
mapM_ (processTx zHost zPort blockTime pool (ZcashNetDB znet)) $
|
bi <-
|
||||||
bl_txs $ addTime blk blockTime
|
saveBlock pool $
|
||||||
|
ZcashBlock
|
||||||
|
(fromIntegral $ bl_height blk)
|
||||||
|
(HexStringDB $ bl_hash blk)
|
||||||
|
(fromIntegral $ bl_confirmations blk)
|
||||||
|
blockTime
|
||||||
|
(ZcashNetDB znet)
|
||||||
|
mapM_ (processTx zHost zPort bi pool) $ bl_txs blk
|
||||||
liftIO $ BC.writeBChan eChan $ TickVal step
|
liftIO $ BC.writeBChan eChan $ TickVal step
|
||||||
addTime :: BlockResponse -> Int -> BlockResponse
|
|
||||||
addTime bl t =
|
|
||||||
BlockResponse
|
|
||||||
(bl_confirmations bl)
|
|
||||||
(bl_height bl)
|
|
||||||
(fromIntegral t)
|
|
||||||
(bl_txs bl)
|
|
||||||
|
|
||||||
appEvent :: BT.BrickEvent Name Tick -> BT.EventM Name State ()
|
appEvent :: BT.BrickEvent Name Tick -> BT.EventM Name State ()
|
||||||
appEvent (BT.AppEvent t) = do
|
appEvent (BT.AppEvent t) = do
|
||||||
|
|
|
@ -772,7 +772,11 @@ prepareTxV2 pool zebraHost zebraPort zn za bh amt va memo policy = do
|
||||||
{-firstPass <- liftIO $ selectUnspentNotes pool za zats-}
|
{-firstPass <- liftIO $ selectUnspentNotes pool za zats-}
|
||||||
--let fee = calculateTxFee firstPass $ fst recipient
|
--let fee = calculateTxFee firstPass $ fst recipient
|
||||||
--logDebugN $ T.pack $ "calculated fee " ++ show fee
|
--logDebugN $ T.pack $ "calculated fee " ++ show fee
|
||||||
(tList, sList, oList) <- liftIO $ selectUnspentNotes pool za (zats + 5000)
|
notePlan <-
|
||||||
|
liftIO $
|
||||||
|
selectUnspentNotesV2 pool za (zats + 10000) (fst recipient) policy
|
||||||
|
case notePlan of
|
||||||
|
Right (tList, sList, oList) -> do
|
||||||
logDebugN "selected notes"
|
logDebugN "selected notes"
|
||||||
logDebugN $ T.pack $ show tList
|
logDebugN $ T.pack $ show tList
|
||||||
logDebugN $ T.pack $ show sList
|
logDebugN $ T.pack $ show sList
|
||||||
|
@ -780,18 +784,28 @@ prepareTxV2 pool zebraHost zebraPort zn za bh amt va memo policy = do
|
||||||
let noteTotal = getTotalAmount (tList, sList, oList)
|
let noteTotal = getTotalAmount (tList, sList, oList)
|
||||||
tSpends <-
|
tSpends <-
|
||||||
liftIO $
|
liftIO $
|
||||||
prepTSpends (getTranSK $ zcashAccountTPrivateKey $ entityVal acc) tList
|
prepTSpends
|
||||||
|
(getTranSK $ zcashAccountTPrivateKey $ entityVal acc)
|
||||||
|
tList
|
||||||
--print tSpends
|
--print tSpends
|
||||||
sSpends <-
|
sSpends <-
|
||||||
liftIO $
|
liftIO $
|
||||||
prepSSpends (getSapSK $ zcashAccountSapSpendKey $ entityVal acc) sList
|
prepSSpends
|
||||||
|
(getSapSK $ zcashAccountSapSpendKey $ entityVal acc)
|
||||||
|
sList
|
||||||
--print sSpends
|
--print sSpends
|
||||||
oSpends <-
|
oSpends <-
|
||||||
liftIO $
|
liftIO $
|
||||||
prepOSpends (getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc) oList
|
prepOSpends
|
||||||
|
(getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc)
|
||||||
|
oList
|
||||||
--print oSpends
|
--print oSpends
|
||||||
dummy <-
|
dummy' <-
|
||||||
liftIO $ makeOutgoing acc recipient zats (noteTotal - 5000 - zats)
|
liftIO $
|
||||||
|
makeOutgoing acc recipient zats (noteTotal - 5000 - zats) policy
|
||||||
|
case dummy' of
|
||||||
|
Left e -> return $ Left e
|
||||||
|
Right dummy -> do
|
||||||
logDebugN "Calculating fee"
|
logDebugN "Calculating fee"
|
||||||
let feeResponse =
|
let feeResponse =
|
||||||
createTransaction
|
createTransaction
|
||||||
|
@ -808,62 +822,204 @@ prepareTxV2 pool zebraHost zebraPort zn za bh amt va memo policy = do
|
||||||
Left e1 -> return $ Left Fee
|
Left e1 -> return $ Left Fee
|
||||||
Right fee -> do
|
Right fee -> do
|
||||||
let feeAmt =
|
let feeAmt =
|
||||||
fromIntegral (runGet getInt64le $ LBS.fromStrict $ toBytes fee)
|
fromIntegral
|
||||||
(tList1, sList1, oList1) <-
|
(runGet getInt64le $ LBS.fromStrict $ toBytes fee)
|
||||||
liftIO $ selectUnspentNotes pool za (zats + feeAmt)
|
finalNotePlan <-
|
||||||
logDebugN $ T.pack $ "selected notes with fee" ++ show feeAmt
|
liftIO $
|
||||||
logDebugN $ T.pack $ show tList
|
selectUnspentNotesV2
|
||||||
logDebugN $ T.pack $ show sList
|
pool
|
||||||
logDebugN $ T.pack $ show oList
|
za
|
||||||
outgoing <-
|
(zats + feeAmt)
|
||||||
liftIO $ makeOutgoing acc recipient zats (noteTotal - feeAmt - zats)
|
(fst recipient)
|
||||||
logDebugN $ T.pack $ show outgoing
|
policy
|
||||||
|
case finalNotePlan of
|
||||||
|
Right (tList1, sList1, oList1) -> do
|
||||||
|
logDebugN $
|
||||||
|
T.pack $ "selected notes with fee" ++ show feeAmt
|
||||||
|
logDebugN $ T.pack $ show tList1
|
||||||
|
logDebugN $ T.pack $ show sList1
|
||||||
|
logDebugN $ T.pack $ show oList1
|
||||||
|
tSpends1 <-
|
||||||
|
liftIO $
|
||||||
|
prepTSpends
|
||||||
|
(getTranSK $ zcashAccountTPrivateKey $ entityVal acc)
|
||||||
|
tList1
|
||||||
|
sSpends1 <-
|
||||||
|
liftIO $
|
||||||
|
prepSSpends
|
||||||
|
(getSapSK $ zcashAccountSapSpendKey $ entityVal acc)
|
||||||
|
sList1
|
||||||
|
oSpends1 <-
|
||||||
|
liftIO $
|
||||||
|
prepOSpends
|
||||||
|
(getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc)
|
||||||
|
oList1
|
||||||
|
let noteTotal1 = getTotalAmount (tList1, sList1, oList1)
|
||||||
|
outgoing' <-
|
||||||
|
liftIO $
|
||||||
|
makeOutgoing
|
||||||
|
acc
|
||||||
|
recipient
|
||||||
|
zats
|
||||||
|
(noteTotal1 - feeAmt - zats)
|
||||||
|
policy
|
||||||
|
logDebugN $ T.pack $ show outgoing'
|
||||||
|
case outgoing' of
|
||||||
|
Left e -> return $ Left e
|
||||||
|
Right outgoing -> do
|
||||||
let tx =
|
let tx =
|
||||||
createTransaction
|
createTransaction
|
||||||
(Just sT)
|
(Just sT)
|
||||||
(Just oT)
|
(Just oT)
|
||||||
tSpends
|
tSpends1
|
||||||
sSpends
|
sSpends1
|
||||||
oSpends
|
oSpends1
|
||||||
outgoing
|
outgoing
|
||||||
zn
|
zn
|
||||||
(bh + 3)
|
(bh + 3)
|
||||||
True
|
True
|
||||||
logDebugN $ T.pack $ show tx
|
logDebugN $ T.pack $ show tx
|
||||||
return tx
|
return tx
|
||||||
|
Left e -> return $ Left e
|
||||||
|
Left e -> do
|
||||||
|
logErrorN $ T.pack $ show e
|
||||||
|
return $ Left e
|
||||||
where
|
where
|
||||||
makeOutgoing ::
|
makeOutgoing ::
|
||||||
Entity ZcashAccount
|
Entity ZcashAccount
|
||||||
-> (Int, BS.ByteString)
|
-> (Int, BS.ByteString)
|
||||||
-> Integer
|
-> Integer
|
||||||
-> Integer
|
-> Integer
|
||||||
-> IO [OutgoingNote]
|
-> PrivacyPolicy
|
||||||
makeOutgoing acc (k, recvr) zats chg = do
|
-> IO (Either TxError [OutgoingNote])
|
||||||
|
makeOutgoing acc (k, recvr) zats chg policy = do
|
||||||
chgAddr <- runNoLoggingT $ getInternalAddresses pool $ entityKey acc
|
chgAddr <- runNoLoggingT $ getInternalAddresses pool $ entityKey acc
|
||||||
let internalUA = getUA $ walletAddressUAddress $ entityVal $ head chgAddr
|
let internalUA = getUA $ walletAddressUAddress $ entityVal $ head chgAddr
|
||||||
|
case k of
|
||||||
|
4 ->
|
||||||
|
case policy of
|
||||||
|
None ->
|
||||||
|
return $
|
||||||
|
Left $
|
||||||
|
PrivacyPolicyError "Recipient not allowed by privacy policy"
|
||||||
|
_anyOther -> do
|
||||||
let chgRcvr =
|
let chgRcvr =
|
||||||
fromJust $ o_rec =<< isValidUnifiedAddress (E.encodeUtf8 internalUA)
|
fromJust $
|
||||||
return
|
o_rec =<< isValidUnifiedAddress (E.encodeUtf8 internalUA)
|
||||||
|
return $
|
||||||
|
Right
|
||||||
[ OutgoingNote
|
[ OutgoingNote
|
||||||
4
|
4
|
||||||
(getBytes $ getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc)
|
(getBytes $
|
||||||
|
getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc)
|
||||||
(getBytes chgRcvr)
|
(getBytes chgRcvr)
|
||||||
(fromIntegral chg)
|
(fromIntegral chg)
|
||||||
""
|
""
|
||||||
True
|
True
|
||||||
, OutgoingNote
|
, OutgoingNote
|
||||||
(fromIntegral k)
|
4
|
||||||
(case k of
|
(getBytes $
|
||||||
4 ->
|
getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc)
|
||||||
getBytes $ getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc
|
|
||||||
3 ->
|
|
||||||
getBytes $ getSapSK $ zcashAccountSapSpendKey $ entityVal acc
|
|
||||||
_ -> "")
|
|
||||||
recvr
|
recvr
|
||||||
(fromIntegral zats)
|
(fromIntegral zats)
|
||||||
(E.encodeUtf8 memo)
|
(E.encodeUtf8 memo)
|
||||||
False
|
False
|
||||||
]
|
]
|
||||||
|
3 ->
|
||||||
|
case policy of
|
||||||
|
None ->
|
||||||
|
return $
|
||||||
|
Left $
|
||||||
|
PrivacyPolicyError "Receiver not compatible with privacy policy"
|
||||||
|
Full -> do
|
||||||
|
let chgRcvr =
|
||||||
|
fromJust $
|
||||||
|
s_rec =<< isValidUnifiedAddress (E.encodeUtf8 internalUA)
|
||||||
|
return $
|
||||||
|
Right
|
||||||
|
[ OutgoingNote
|
||||||
|
3
|
||||||
|
(getBytes $
|
||||||
|
getSapSK $ zcashAccountSapSpendKey $ entityVal acc)
|
||||||
|
(getBytes chgRcvr)
|
||||||
|
(fromIntegral chg)
|
||||||
|
""
|
||||||
|
True
|
||||||
|
, OutgoingNote
|
||||||
|
3
|
||||||
|
(getBytes $
|
||||||
|
getSapSK $ zcashAccountSapSpendKey $ entityVal acc)
|
||||||
|
recvr
|
||||||
|
(fromIntegral zats)
|
||||||
|
(E.encodeUtf8 memo)
|
||||||
|
False
|
||||||
|
]
|
||||||
|
_anyOther -> do
|
||||||
|
let chgRcvr =
|
||||||
|
fromJust $
|
||||||
|
o_rec =<< isValidUnifiedAddress (E.encodeUtf8 internalUA)
|
||||||
|
return $
|
||||||
|
Right
|
||||||
|
[ OutgoingNote
|
||||||
|
4
|
||||||
|
(getBytes $
|
||||||
|
getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc)
|
||||||
|
(getBytes chgRcvr)
|
||||||
|
(fromIntegral chg)
|
||||||
|
""
|
||||||
|
True
|
||||||
|
, OutgoingNote
|
||||||
|
3
|
||||||
|
(getBytes $
|
||||||
|
getSapSK $ zcashAccountSapSpendKey $ entityVal acc)
|
||||||
|
recvr
|
||||||
|
(fromIntegral zats)
|
||||||
|
(E.encodeUtf8 memo)
|
||||||
|
False
|
||||||
|
]
|
||||||
|
2 ->
|
||||||
|
if policy <= Low
|
||||||
|
then do
|
||||||
|
let chgRcvr =
|
||||||
|
fromJust $
|
||||||
|
t_rec =<< isValidUnifiedAddress (E.encodeUtf8 internalUA)
|
||||||
|
return $
|
||||||
|
Right
|
||||||
|
[ OutgoingNote
|
||||||
|
1
|
||||||
|
BS.empty
|
||||||
|
(toBytes $ tr_bytes chgRcvr)
|
||||||
|
(fromIntegral chg)
|
||||||
|
""
|
||||||
|
True
|
||||||
|
, OutgoingNote 2 BS.empty recvr (fromIntegral zats) "" False
|
||||||
|
]
|
||||||
|
else return $
|
||||||
|
Left $
|
||||||
|
PrivacyPolicyError
|
||||||
|
"Receiver not compatible with privacy policy"
|
||||||
|
1 ->
|
||||||
|
if policy <= Low
|
||||||
|
then do
|
||||||
|
let chgRcvr =
|
||||||
|
fromJust $
|
||||||
|
t_rec =<< isValidUnifiedAddress (E.encodeUtf8 internalUA)
|
||||||
|
return $
|
||||||
|
Right
|
||||||
|
[ OutgoingNote
|
||||||
|
1
|
||||||
|
BS.empty
|
||||||
|
(toBytes $ tr_bytes chgRcvr)
|
||||||
|
(fromIntegral chg)
|
||||||
|
""
|
||||||
|
True
|
||||||
|
, OutgoingNote 1 BS.empty recvr (fromIntegral zats) "" False
|
||||||
|
]
|
||||||
|
else return $
|
||||||
|
Left $
|
||||||
|
PrivacyPolicyError
|
||||||
|
"Receiver not compatible with privacy policy"
|
||||||
|
_anyOther -> return $ Left ZHError
|
||||||
getTotalAmount ::
|
getTotalAmount ::
|
||||||
( [Entity WalletTrNote]
|
( [Entity WalletTrNote]
|
||||||
, [Entity WalletSapNote]
|
, [Entity WalletSapNote]
|
||||||
|
|
263
src/Zenith/DB.hs
263
src/Zenith/DB.hs
|
@ -18,7 +18,7 @@
|
||||||
|
|
||||||
module Zenith.DB where
|
module Zenith.DB where
|
||||||
|
|
||||||
import Control.Exception (SomeException(..), throwIO, try)
|
import Control.Exception (SomeException(..), throw, throwIO, try)
|
||||||
import Control.Monad (when)
|
import Control.Monad (when)
|
||||||
import Control.Monad.IO.Class (MonadIO, liftIO)
|
import Control.Monad.IO.Class (MonadIO, liftIO)
|
||||||
import Control.Monad.Logger (NoLoggingT, runNoLoggingT)
|
import Control.Monad.Logger (NoLoggingT, runNoLoggingT)
|
||||||
|
@ -69,6 +69,7 @@ import ZcashHaskell.Types
|
||||||
, TransparentAddress(..)
|
, TransparentAddress(..)
|
||||||
, TransparentBundle(..)
|
, TransparentBundle(..)
|
||||||
, TransparentReceiver(..)
|
, TransparentReceiver(..)
|
||||||
|
, TxError(..)
|
||||||
, UnifiedAddress(..)
|
, UnifiedAddress(..)
|
||||||
, ValidAddress(..)
|
, ValidAddress(..)
|
||||||
, ZcashNet(..)
|
, ZcashNet(..)
|
||||||
|
@ -78,6 +79,7 @@ import Zenith.Types
|
||||||
, HexStringDB(..)
|
, HexStringDB(..)
|
||||||
, OrchardSpendingKeyDB(..)
|
, OrchardSpendingKeyDB(..)
|
||||||
, PhraseDB(..)
|
, PhraseDB(..)
|
||||||
|
, PrivacyPolicy(..)
|
||||||
, RseedDB(..)
|
, RseedDB(..)
|
||||||
, SaplingSpendingKeyDB(..)
|
, SaplingSpendingKeyDB(..)
|
||||||
, ScopeDB(..)
|
, ScopeDB(..)
|
||||||
|
@ -202,13 +204,18 @@ share
|
||||||
value Int64
|
value Int64
|
||||||
UniqueOrchSpend tx accId
|
UniqueOrchSpend tx accId
|
||||||
deriving Show Eq
|
deriving Show Eq
|
||||||
ZcashTransaction
|
ZcashBlock
|
||||||
block Int
|
height Int
|
||||||
txId HexStringDB
|
hash HexStringDB
|
||||||
conf Int
|
conf Int
|
||||||
time Int
|
time Int
|
||||||
network ZcashNetDB
|
network ZcashNetDB
|
||||||
UniqueTx block txId network
|
UniqueBlock height network
|
||||||
|
deriving Show Eq
|
||||||
|
ZcashTransaction
|
||||||
|
blockId ZcashBlockId OnDeleteCascade OnUpdateCascade
|
||||||
|
txId HexStringDB
|
||||||
|
UniqueTx blockId txId
|
||||||
deriving Show Eq
|
deriving Show Eq
|
||||||
TransparentNote
|
TransparentNote
|
||||||
tx ZcashTransactionId
|
tx ZcashTransactionId
|
||||||
|
@ -579,14 +586,13 @@ getMaxBlock pool net = do
|
||||||
PS.retryOnBusy $
|
PS.retryOnBusy $
|
||||||
flip PS.runSqlPool pool $ do
|
flip PS.runSqlPool pool $ do
|
||||||
selectOne $ do
|
selectOne $ do
|
||||||
txs <- from $ table @ZcashTransaction
|
bls <- from $ table @ZcashBlock
|
||||||
where_ (txs ^. ZcashTransactionBlock >. val 0)
|
where_ (bls ^. ZcashBlockNetwork ==. val net)
|
||||||
where_ (txs ^. ZcashTransactionNetwork ==. val net)
|
orderBy [desc $ bls ^. ZcashBlockHeight]
|
||||||
orderBy [desc $ txs ^. ZcashTransactionBlock]
|
pure bls
|
||||||
pure txs
|
|
||||||
case b of
|
case b of
|
||||||
Nothing -> return $ -1
|
Nothing -> return $ -1
|
||||||
Just x -> return $ zcashTransactionBlock $ entityVal x
|
Just x -> return $ zcashBlockHeight $ entityVal x
|
||||||
|
|
||||||
-- | Returns a list of addresses associated with the given account
|
-- | Returns a list of addresses associated with the given account
|
||||||
getAddresses ::
|
getAddresses ::
|
||||||
|
@ -677,20 +683,22 @@ saveAddress pool w =
|
||||||
runNoLoggingT $
|
runNoLoggingT $
|
||||||
PS.retryOnBusy $ flip PS.runSqlPool pool $ insertUniqueEntity w
|
PS.retryOnBusy $ flip PS.runSqlPool pool $ insertUniqueEntity w
|
||||||
|
|
||||||
|
-- | Save a block to the database
|
||||||
|
saveBlock :: ConnectionPool -> ZcashBlock -> IO (Key ZcashBlock)
|
||||||
|
saveBlock pool b =
|
||||||
|
runNoLoggingT $ PS.retryOnBusy $ flip PS.runSqlPool pool $ do insert b
|
||||||
|
|
||||||
-- | Save a transaction to the data model
|
-- | Save a transaction to the data model
|
||||||
saveTransaction ::
|
saveTransaction ::
|
||||||
ConnectionPool -- ^ the database path
|
ConnectionPool -- ^ the database path
|
||||||
-> Int -- ^ block time
|
-> ZcashBlockId -- ^ The block the transaction is in
|
||||||
-> ZcashNetDB -- ^ the network
|
|
||||||
-> Transaction -- ^ The transaction to save
|
-> Transaction -- ^ The transaction to save
|
||||||
-> NoLoggingT IO (Key ZcashTransaction)
|
-> NoLoggingT IO (Key ZcashTransaction)
|
||||||
saveTransaction pool t n wt =
|
saveTransaction pool bi wt =
|
||||||
PS.retryOnBusy $
|
PS.retryOnBusy $
|
||||||
flip PS.runSqlPool pool $ do
|
flip PS.runSqlPool pool $ do
|
||||||
let ix = [0 ..]
|
let ix = [0 ..]
|
||||||
w <-
|
w <- insert $ ZcashTransaction bi (HexStringDB $ tx_id wt)
|
||||||
insert $
|
|
||||||
ZcashTransaction (tx_height wt) (HexStringDB $ tx_id wt) (tx_conf wt) t n
|
|
||||||
when (isJust $ tx_transpBundle wt) $ do
|
when (isJust $ tx_transpBundle wt) $ do
|
||||||
_ <-
|
_ <-
|
||||||
insertMany_ $
|
insertMany_ $
|
||||||
|
@ -776,10 +784,13 @@ getZcashTransactions pool b net =
|
||||||
PS.retryOnBusy $
|
PS.retryOnBusy $
|
||||||
flip PS.runSqlPool pool $ do
|
flip PS.runSqlPool pool $ do
|
||||||
select $ do
|
select $ do
|
||||||
txs <- from $ table @ZcashTransaction
|
(blks :& txs) <-
|
||||||
where_ (txs ^. ZcashTransactionBlock >. val b)
|
from $ table @ZcashBlock `innerJoin` table @ZcashTransaction `on`
|
||||||
where_ (txs ^. ZcashTransactionNetwork ==. val (ZcashNetDB net))
|
(\(blks :& txs) ->
|
||||||
orderBy [asc $ txs ^. ZcashTransactionBlock]
|
blks ^. ZcashBlockId ==. txs ^. ZcashTransactionBlockId)
|
||||||
|
where_ (blks ^. ZcashBlockHeight >. val b)
|
||||||
|
where_ (blks ^. ZcashBlockNetwork ==. val (ZcashNetDB net))
|
||||||
|
orderBy [asc $ blks ^. ZcashBlockHeight]
|
||||||
return txs
|
return txs
|
||||||
|
|
||||||
-- ** QR codes
|
-- ** QR codes
|
||||||
|
@ -876,14 +887,23 @@ saveWalletTransaction pool za zt = do
|
||||||
runNoLoggingT $
|
runNoLoggingT $
|
||||||
PS.retryOnBusy $
|
PS.retryOnBusy $
|
||||||
flip PS.runSqlPool pool $ do
|
flip PS.runSqlPool pool $ do
|
||||||
|
b <-
|
||||||
|
selectOne $ do
|
||||||
|
blks <- from $ table @ZcashBlock
|
||||||
|
where_ (blks ^. ZcashBlockId ==. val (zcashTransactionBlockId zT'))
|
||||||
|
pure blks
|
||||||
|
case b of
|
||||||
|
Nothing ->
|
||||||
|
throw $ userError "invalid block for saving wallet transaction"
|
||||||
|
Just blk -> do
|
||||||
t <-
|
t <-
|
||||||
upsert
|
upsert
|
||||||
(WalletTransaction
|
(WalletTransaction
|
||||||
(zcashTransactionTxId zT')
|
(zcashTransactionTxId zT')
|
||||||
za
|
za
|
||||||
(zcashTransactionBlock zT')
|
(zcashBlockHeight $ entityVal blk)
|
||||||
(zcashTransactionConf zT')
|
(zcashBlockConf $ entityVal blk)
|
||||||
(zcashTransactionTime zT'))
|
(zcashBlockTime $ entityVal blk))
|
||||||
[]
|
[]
|
||||||
return $ entityKey t
|
return $ entityKey t
|
||||||
|
|
||||||
|
@ -976,14 +996,17 @@ findTransparentNotes pool b net t = do
|
||||||
PS.retryOnBusy $
|
PS.retryOnBusy $
|
||||||
flip PS.runSqlPool pool $ do
|
flip PS.runSqlPool pool $ do
|
||||||
select $ do
|
select $ do
|
||||||
(txs :& tNotes) <-
|
(blks :& txs :& tNotes) <-
|
||||||
from $ table @ZcashTransaction `innerJoin` table @TransparentNote `on`
|
from $ table @ZcashBlock `innerJoin` table @ZcashTransaction `on`
|
||||||
(\(txs :& tNotes) ->
|
(\(blks :& txs) ->
|
||||||
|
blks ^. ZcashBlockId ==. txs ^. ZcashTransactionBlockId) `innerJoin`
|
||||||
|
table @TransparentNote `on`
|
||||||
|
(\(_ :& txs :& tNotes) ->
|
||||||
txs ^. ZcashTransactionId ==. tNotes ^. TransparentNoteTx)
|
txs ^. ZcashTransactionId ==. tNotes ^. TransparentNoteTx)
|
||||||
where_ (txs ^. ZcashTransactionBlock >. val b)
|
where_ (blks ^. ZcashBlockHeight >. val b)
|
||||||
where_ (txs ^. ZcashTransactionNetwork ==. val net)
|
where_ (blks ^. ZcashBlockNetwork ==. val net)
|
||||||
where_ (tNotes ^. TransparentNoteScript ==. val s)
|
where_ (tNotes ^. TransparentNoteScript ==. val s)
|
||||||
pure (txs, tNotes)
|
pure (blks, txs, tNotes)
|
||||||
mapM_
|
mapM_
|
||||||
(saveWalletTrNote
|
(saveWalletTrNote
|
||||||
pool
|
pool
|
||||||
|
@ -999,10 +1022,11 @@ saveWalletTrNote ::
|
||||||
-> Scope
|
-> Scope
|
||||||
-> ZcashAccountId
|
-> ZcashAccountId
|
||||||
-> WalletAddressId
|
-> WalletAddressId
|
||||||
-> (Entity ZcashTransaction, Entity TransparentNote)
|
-> (Entity ZcashBlock, Entity ZcashTransaction, Entity TransparentNote)
|
||||||
-> IO ()
|
-> IO ()
|
||||||
saveWalletTrNote pool ch za wa (zt, tn) = do
|
saveWalletTrNote pool ch za wa (blk, zt, tn) = do
|
||||||
let zT' = entityVal zt
|
let zT' = entityVal zt
|
||||||
|
let b = entityVal blk
|
||||||
runNoLoggingT $
|
runNoLoggingT $
|
||||||
PS.retryOnBusy $
|
PS.retryOnBusy $
|
||||||
flip PS.runSqlPool pool $ do
|
flip PS.runSqlPool pool $ do
|
||||||
|
@ -1011,9 +1035,9 @@ saveWalletTrNote pool ch za wa (zt, tn) = do
|
||||||
(WalletTransaction
|
(WalletTransaction
|
||||||
(zcashTransactionTxId zT')
|
(zcashTransactionTxId zT')
|
||||||
za
|
za
|
||||||
(zcashTransactionBlock zT')
|
(zcashBlockHeight b)
|
||||||
(zcashTransactionConf zT')
|
(zcashBlockConf b)
|
||||||
(zcashTransactionTime zT'))
|
(zcashBlockTime b))
|
||||||
[]
|
[]
|
||||||
insert_ $
|
insert_ $
|
||||||
WalletTrNote
|
WalletTrNote
|
||||||
|
@ -1042,12 +1066,15 @@ getShieldedOutputs pool b net =
|
||||||
PS.retryOnBusy $
|
PS.retryOnBusy $
|
||||||
flip PS.runSqlPool pool $ do
|
flip PS.runSqlPool pool $ do
|
||||||
select $ do
|
select $ do
|
||||||
(txs :& sOutputs) <-
|
(blks :& txs :& sOutputs) <-
|
||||||
from $ table @ZcashTransaction `innerJoin` table @ShieldOutput `on`
|
from $ table @ZcashBlock `innerJoin` table @ZcashTransaction `on`
|
||||||
(\(txs :& sOutputs) ->
|
(\(blks :& txs) ->
|
||||||
|
blks ^. ZcashBlockId ==. txs ^. ZcashTransactionBlockId) `innerJoin`
|
||||||
|
table @ShieldOutput `on`
|
||||||
|
(\(_ :& txs :& sOutputs) ->
|
||||||
txs ^. ZcashTransactionId ==. sOutputs ^. ShieldOutputTx)
|
txs ^. ZcashTransactionId ==. sOutputs ^. ShieldOutputTx)
|
||||||
where_ (txs ^. ZcashTransactionBlock >=. val b)
|
where_ (blks ^. ZcashBlockHeight >=. val b)
|
||||||
where_ (txs ^. ZcashTransactionNetwork ==. val net)
|
where_ (blks ^. ZcashBlockNetwork ==. val net)
|
||||||
orderBy
|
orderBy
|
||||||
[ asc $ txs ^. ZcashTransactionId
|
[ asc $ txs ^. ZcashTransactionId
|
||||||
, asc $ sOutputs ^. ShieldOutputPosition
|
, asc $ sOutputs ^. ShieldOutputPosition
|
||||||
|
@ -1065,12 +1092,15 @@ getOrchardActions pool b net =
|
||||||
PS.retryOnBusy $
|
PS.retryOnBusy $
|
||||||
flip PS.runSqlPool pool $ do
|
flip PS.runSqlPool pool $ do
|
||||||
select $ do
|
select $ do
|
||||||
(txs :& oActions) <-
|
(blks :& txs :& oActions) <-
|
||||||
from $ table @ZcashTransaction `innerJoin` table @OrchAction `on`
|
from $ table @ZcashBlock `innerJoin` table @ZcashTransaction `on`
|
||||||
(\(txs :& oActions) ->
|
(\(blks :& txs) ->
|
||||||
|
blks ^. ZcashBlockId ==. txs ^. ZcashTransactionBlockId) `innerJoin`
|
||||||
|
table @OrchAction `on`
|
||||||
|
(\(_ :& txs :& oActions) ->
|
||||||
txs ^. ZcashTransactionId ==. oActions ^. OrchActionTx)
|
txs ^. ZcashTransactionId ==. oActions ^. OrchActionTx)
|
||||||
where_ (txs ^. ZcashTransactionBlock >=. val b)
|
where_ (blks ^. ZcashBlockHeight >=. val b)
|
||||||
where_ (txs ^. ZcashTransactionNetwork ==. val net)
|
where_ (blks ^. ZcashBlockNetwork ==. val net)
|
||||||
orderBy
|
orderBy
|
||||||
[asc $ txs ^. ZcashTransactionId, asc $ oActions ^. OrchActionPosition]
|
[asc $ txs ^. ZcashTransactionId, asc $ oActions ^. OrchActionPosition]
|
||||||
pure (txs, oActions)
|
pure (txs, oActions)
|
||||||
|
@ -1640,14 +1670,22 @@ upsertWalTx ::
|
||||||
=> ZcashTransaction
|
=> ZcashTransaction
|
||||||
-> ZcashAccountId
|
-> ZcashAccountId
|
||||||
-> SqlPersistT m (Entity WalletTransaction)
|
-> SqlPersistT m (Entity WalletTransaction)
|
||||||
upsertWalTx zt za =
|
upsertWalTx zt za = do
|
||||||
|
blk <-
|
||||||
|
selectOne $ do
|
||||||
|
blks <- from $ table @ZcashBlock
|
||||||
|
where_ (blks ^. ZcashBlockId ==. val (zcashTransactionBlockId zt))
|
||||||
|
pure blks
|
||||||
|
case blk of
|
||||||
|
Nothing -> throw $ userError "Invalid block for transaction"
|
||||||
|
Just b ->
|
||||||
upsert
|
upsert
|
||||||
(WalletTransaction
|
(WalletTransaction
|
||||||
(zcashTransactionTxId zt)
|
(zcashTransactionTxId zt)
|
||||||
za
|
za
|
||||||
(zcashTransactionBlock zt)
|
(zcashBlockHeight $ entityVal b)
|
||||||
(zcashTransactionConf zt)
|
(zcashBlockConf $ entityVal b)
|
||||||
(zcashTransactionTime zt))
|
(zcashBlockTime $ entityVal b))
|
||||||
[]
|
[]
|
||||||
|
|
||||||
getSaplingOutIndex :: ConnectionPool -> ShieldOutputId -> IO Int
|
getSaplingOutIndex :: ConnectionPool -> ShieldOutputId -> IO Int
|
||||||
|
@ -1982,6 +2020,130 @@ selectUnspentNotes pool za amt = do
|
||||||
, n : snd (checkOrchard (x - walletOrchNoteValue (entityVal n)) ns))
|
, n : snd (checkOrchard (x - walletOrchNoteValue (entityVal n)) ns))
|
||||||
else (0, [n])
|
else (0, [n])
|
||||||
|
|
||||||
|
selectUnspentNotesV2 ::
|
||||||
|
ConnectionPool
|
||||||
|
-> ZcashAccountId
|
||||||
|
-> Integer
|
||||||
|
-> Int
|
||||||
|
-> PrivacyPolicy
|
||||||
|
-> IO
|
||||||
|
(Either
|
||||||
|
TxError
|
||||||
|
( [Entity WalletTrNote]
|
||||||
|
, [Entity WalletSapNote]
|
||||||
|
, [Entity WalletOrchNote]))
|
||||||
|
selectUnspentNotesV2 pool za amt recv policy = do
|
||||||
|
case policy of
|
||||||
|
Full ->
|
||||||
|
case recv of
|
||||||
|
4 -> do
|
||||||
|
orchNotes <- getWalletUnspentOrchNotes pool za
|
||||||
|
let (a1, oList) = checkOrchard (fromIntegral amt) orchNotes
|
||||||
|
if a1 > 0
|
||||||
|
then return $
|
||||||
|
Left $ PrivacyPolicyError "Not enough notes for Full privacy"
|
||||||
|
else return $ Right ([], [], oList)
|
||||||
|
3 -> do
|
||||||
|
sapNotes <- getWalletUnspentSapNotes pool za
|
||||||
|
let (a2, sList) = checkSapling (fromIntegral amt) sapNotes
|
||||||
|
if a2 > 0
|
||||||
|
then return $
|
||||||
|
Left $ PrivacyPolicyError "Not enough notes for Full privacy"
|
||||||
|
else return $ Right ([], sList, [])
|
||||||
|
_anyOther ->
|
||||||
|
return $
|
||||||
|
Left $ PrivacyPolicyError "Receiver not capable of Full privacy"
|
||||||
|
Medium ->
|
||||||
|
if recv > 2
|
||||||
|
then do
|
||||||
|
orchNotes <- getWalletUnspentOrchNotes pool za
|
||||||
|
let (a1, oList) = checkOrchard (fromIntegral amt) orchNotes
|
||||||
|
if a1 > 0
|
||||||
|
then do
|
||||||
|
sapNotes <- getWalletUnspentSapNotes pool za
|
||||||
|
let (a2, sList) = checkSapling a1 sapNotes
|
||||||
|
if a2 > 0
|
||||||
|
then return $
|
||||||
|
Left $
|
||||||
|
PrivacyPolicyError "Not enough notes for Medium privacy"
|
||||||
|
else return $ Right ([], sList, oList)
|
||||||
|
else return $ Right ([], [], oList)
|
||||||
|
else return $
|
||||||
|
Left $ PrivacyPolicyError "Receiver not capable of Medium privacy"
|
||||||
|
Low ->
|
||||||
|
if recv == 0
|
||||||
|
then return $ Left ZHError
|
||||||
|
else do
|
||||||
|
case recv of
|
||||||
|
3 -> do
|
||||||
|
sapNotes <- getWalletUnspentSapNotes pool za
|
||||||
|
let (a1, sList) = checkSapling (fromIntegral amt) sapNotes
|
||||||
|
if a1 > 0
|
||||||
|
then do
|
||||||
|
orchNotes <- getWalletUnspentOrchNotes pool za
|
||||||
|
let (a2, oList) = checkOrchard a1 orchNotes
|
||||||
|
if a2 > 0
|
||||||
|
then return $
|
||||||
|
Left $
|
||||||
|
PrivacyPolicyError "Not enough notes for Low privacy"
|
||||||
|
else return $ Right ([], sList, oList)
|
||||||
|
else return $ Right ([], sList, [])
|
||||||
|
_anyOther -> do
|
||||||
|
orchNotes <- getWalletUnspentOrchNotes pool za
|
||||||
|
let (a1, oList) = checkOrchard (fromIntegral amt) orchNotes
|
||||||
|
if a1 > 0
|
||||||
|
then do
|
||||||
|
sapNotes <- getWalletUnspentSapNotes pool za
|
||||||
|
let (a2, sList) = checkSapling a1 sapNotes
|
||||||
|
if a2 > 0
|
||||||
|
then return $
|
||||||
|
Left $
|
||||||
|
PrivacyPolicyError "Not enough notes for Low privacy"
|
||||||
|
else return $ Right ([], sList, oList)
|
||||||
|
else return $ Right ([], [], oList)
|
||||||
|
None -> do
|
||||||
|
orchNotes <- getWalletUnspentOrchNotes pool za
|
||||||
|
let (a1, oList) = checkOrchard (fromIntegral amt) orchNotes
|
||||||
|
if a1 > 0
|
||||||
|
then do
|
||||||
|
sapNotes <- getWalletUnspentSapNotes pool za
|
||||||
|
let (a2, sList) = checkSapling a1 sapNotes
|
||||||
|
if a2 > 0
|
||||||
|
then do
|
||||||
|
trNotes <- getWalletUnspentTrNotes pool za
|
||||||
|
let (a3, tList) = checkTransparent a2 trNotes
|
||||||
|
if a3 > 0
|
||||||
|
then return $ Left InsufficientFunds
|
||||||
|
else return $ Right (tList, sList, oList)
|
||||||
|
else return $ Right ([], sList, oList)
|
||||||
|
else return $ Right ([], [], oList)
|
||||||
|
where
|
||||||
|
checkTransparent ::
|
||||||
|
Int64 -> [Entity WalletTrNote] -> (Int64, [Entity WalletTrNote])
|
||||||
|
checkTransparent x [] = (x, [])
|
||||||
|
checkTransparent x (n:ns) =
|
||||||
|
if walletTrNoteValue (entityVal n) < x
|
||||||
|
then ( fst (checkTransparent (x - walletTrNoteValue (entityVal n)) ns)
|
||||||
|
, n :
|
||||||
|
snd (checkTransparent (x - walletTrNoteValue (entityVal n)) ns))
|
||||||
|
else (0, [n])
|
||||||
|
checkSapling ::
|
||||||
|
Int64 -> [Entity WalletSapNote] -> (Int64, [Entity WalletSapNote])
|
||||||
|
checkSapling x [] = (x, [])
|
||||||
|
checkSapling x (n:ns) =
|
||||||
|
if walletSapNoteValue (entityVal n) < x
|
||||||
|
then ( fst (checkSapling (x - walletSapNoteValue (entityVal n)) ns)
|
||||||
|
, n : snd (checkSapling (x - walletSapNoteValue (entityVal n)) ns))
|
||||||
|
else (0, [n])
|
||||||
|
checkOrchard ::
|
||||||
|
Int64 -> [Entity WalletOrchNote] -> (Int64, [Entity WalletOrchNote])
|
||||||
|
checkOrchard x [] = (x, [])
|
||||||
|
checkOrchard x (n:ns) =
|
||||||
|
if walletOrchNoteValue (entityVal n) < x
|
||||||
|
then ( fst (checkOrchard (x - walletOrchNoteValue (entityVal n)) ns)
|
||||||
|
, n : snd (checkOrchard (x - walletOrchNoteValue (entityVal n)) ns))
|
||||||
|
else (0, [n])
|
||||||
|
|
||||||
getWalletTxId ::
|
getWalletTxId ::
|
||||||
ConnectionPool -> WalletTransactionId -> IO (Maybe (Value HexStringDB))
|
ConnectionPool -> WalletTransactionId -> IO (Maybe (Value HexStringDB))
|
||||||
getWalletTxId pool wId = do
|
getWalletTxId pool wId = do
|
||||||
|
@ -2013,6 +2175,9 @@ saveConfs pool b c = do
|
||||||
update $ \t -> do
|
update $ \t -> do
|
||||||
set t [WalletTransactionConf =. val c]
|
set t [WalletTransactionConf =. val c]
|
||||||
where_ $ t ^. WalletTransactionBlock ==. val b
|
where_ $ t ^. WalletTransactionBlock ==. val b
|
||||||
|
update $ \bl -> do
|
||||||
|
set bl [ZcashBlockConf =. val c]
|
||||||
|
where_ $ bl ^. ZcashBlockHeight ==. val b
|
||||||
|
|
||||||
-- | Helper function to extract a Unified Address from the database
|
-- | Helper function to extract a Unified Address from the database
|
||||||
readUnifiedAddressDB :: WalletAddress -> Maybe UnifiedAddress
|
readUnifiedAddressDB :: WalletAddress -> Maybe UnifiedAddress
|
||||||
|
|
|
@ -1481,16 +1481,16 @@ scanZebra dbPath zHost zPort net sendMsg = do
|
||||||
Left e2 -> sendMsg (ShowError $ showt e2)
|
Left e2 -> sendMsg (ShowError $ showt e2)
|
||||||
Right hb -> do
|
Right hb -> do
|
||||||
let blockTime = getBlockTime hb
|
let blockTime = getBlockTime hb
|
||||||
mapM_ (processTx zHost zPort blockTime pool (ZcashNetDB net)) $
|
bi <-
|
||||||
bl_txs $ addTime blk blockTime
|
saveBlock pool $
|
||||||
|
ZcashBlock
|
||||||
|
(fromIntegral $ bl_height blk)
|
||||||
|
(HexStringDB $ bl_hash blk)
|
||||||
|
(fromIntegral $ bl_confirmations blk)
|
||||||
|
blockTime
|
||||||
|
(ZcashNetDB net)
|
||||||
|
mapM_ (processTx zHost zPort bi pool) $ bl_txs blk
|
||||||
sendMsg (SyncVal step)
|
sendMsg (SyncVal step)
|
||||||
addTime :: BlockResponse -> Int -> BlockResponse
|
|
||||||
addTime bl t =
|
|
||||||
BlockResponse
|
|
||||||
(bl_confirmations bl)
|
|
||||||
(bl_height bl)
|
|
||||||
(fromIntegral t)
|
|
||||||
(bl_txs bl)
|
|
||||||
|
|
||||||
sendTransaction ::
|
sendTransaction ::
|
||||||
Config
|
Config
|
||||||
|
|
|
@ -27,7 +27,9 @@ import ZcashHaskell.Types
|
||||||
import ZcashHaskell.Utils (getBlockTime, makeZebraCall, readZebraTransaction)
|
import ZcashHaskell.Utils (getBlockTime, makeZebraCall, readZebraTransaction)
|
||||||
import Zenith.Core (checkBlockChain, syncWallet)
|
import Zenith.Core (checkBlockChain, syncWallet)
|
||||||
import Zenith.DB
|
import Zenith.DB
|
||||||
( clearWalletData
|
( ZcashBlock(..)
|
||||||
|
, ZcashBlockId
|
||||||
|
, clearWalletData
|
||||||
, clearWalletTransactions
|
, clearWalletTransactions
|
||||||
, getMaxBlock
|
, getMaxBlock
|
||||||
, getMinBirthdayHeight
|
, getMinBirthdayHeight
|
||||||
|
@ -35,11 +37,12 @@ import Zenith.DB
|
||||||
, getWallets
|
, getWallets
|
||||||
, initDb
|
, initDb
|
||||||
, initPool
|
, initPool
|
||||||
|
, saveBlock
|
||||||
, saveConfs
|
, saveConfs
|
||||||
, saveTransaction
|
, saveTransaction
|
||||||
, updateWalletSync
|
, updateWalletSync
|
||||||
)
|
)
|
||||||
import Zenith.Types (Config(..), ZcashNetDB(..))
|
import Zenith.Types (Config(..), HexStringDB(..), ZcashNetDB(..))
|
||||||
import Zenith.Utils (jsonNumber)
|
import Zenith.Utils (jsonNumber)
|
||||||
|
|
||||||
-- | Function to scan the Zcash blockchain through the Zebra node and populate the Zenith database
|
-- | Function to scan the Zcash blockchain through the Zebra node and populate the Zenith database
|
||||||
|
@ -119,28 +122,26 @@ processBlock host port pool pg net b = do
|
||||||
Left e2 -> liftIO $ throwIO $ userError e2
|
Left e2 -> liftIO $ throwIO $ userError e2
|
||||||
Right hb -> do
|
Right hb -> do
|
||||||
let blockTime = getBlockTime hb
|
let blockTime = getBlockTime hb
|
||||||
mapM_ (processTx host port blockTime pool net) $
|
bi <-
|
||||||
bl_txs $ addTime blk blockTime
|
saveBlock pool $
|
||||||
|
ZcashBlock
|
||||||
|
(fromIntegral $ bl_height blk)
|
||||||
|
(HexStringDB $ bl_hash blk)
|
||||||
|
(fromIntegral $ bl_confirmations blk)
|
||||||
|
blockTime
|
||||||
|
net
|
||||||
|
mapM_ (processTx host port bi pool) $ bl_txs blk
|
||||||
liftIO $ tick pg
|
liftIO $ tick pg
|
||||||
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
|
-- | Function to process a raw transaction
|
||||||
processTx ::
|
processTx ::
|
||||||
T.Text -- ^ Host name for `zebrad`
|
T.Text -- ^ Host name for `zebrad`
|
||||||
-> Int -- ^ Port for `zebrad`
|
-> Int -- ^ Port for `zebrad`
|
||||||
-> Int -- ^ Block time
|
-> ZcashBlockId -- ^ Block ID
|
||||||
-> ConnectionPool -- ^ DB file path
|
-> ConnectionPool -- ^ DB file path
|
||||||
-> ZcashNetDB -- ^ the network
|
|
||||||
-> HexString -- ^ transaction id
|
-> HexString -- ^ transaction id
|
||||||
-> IO ()
|
-> IO ()
|
||||||
processTx host port bt pool net t = do
|
processTx host port bt pool t = do
|
||||||
r <-
|
r <-
|
||||||
liftIO $
|
liftIO $
|
||||||
makeZebraCall
|
makeZebraCall
|
||||||
|
@ -156,7 +157,7 @@ processTx host port bt pool net t = do
|
||||||
Just rzt -> do
|
Just rzt -> do
|
||||||
_ <-
|
_ <-
|
||||||
runNoLoggingT $
|
runNoLoggingT $
|
||||||
saveTransaction pool bt net $
|
saveTransaction pool bt $
|
||||||
Transaction
|
Transaction
|
||||||
t
|
t
|
||||||
(ztr_blockheight rawTx)
|
(ztr_blockheight rawTx)
|
||||||
|
|
|
@ -199,10 +199,11 @@ $(deriveJSON defaultOptions ''ZenithStatus)
|
||||||
derivePersistField "ZenithStatus"
|
derivePersistField "ZenithStatus"
|
||||||
|
|
||||||
data PrivacyPolicy
|
data PrivacyPolicy
|
||||||
= Full
|
= None
|
||||||
| Medium
|
|
||||||
| Low
|
| Low
|
||||||
| None
|
| Medium
|
||||||
|
| Full
|
||||||
|
deriving (Eq, Show, Read, Ord)
|
||||||
|
|
||||||
$(deriveJSON defaultOptions ''PrivacyPolicy)
|
$(deriveJSON defaultOptions ''PrivacyPolicy)
|
||||||
|
|
||||||
|
|
90
test/Spec.hs
90
test/Spec.hs
|
@ -1,15 +1,16 @@
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
|
||||||
import Control.Monad (when)
|
import Control.Monad (when)
|
||||||
import Control.Monad.Logger (runNoLoggingT)
|
import Control.Monad.Logger (runFileLoggingT, runNoLoggingT)
|
||||||
import Data.HexString
|
import Data.HexString
|
||||||
|
import Data.Maybe (fromJust)
|
||||||
import qualified Data.Text.Encoding as E
|
import qualified Data.Text.Encoding as E
|
||||||
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.HUnit
|
||||||
import Test.Hspec
|
import Test.Hspec
|
||||||
import ZcashHaskell.Orchard (isValidUnifiedAddress)
|
import ZcashHaskell.Orchard (isValidUnifiedAddress, parseAddress)
|
||||||
import ZcashHaskell.Sapling
|
import ZcashHaskell.Sapling
|
||||||
( decodeSaplingOutputEsk
|
( decodeSaplingOutputEsk
|
||||||
, encodeSaplingAddress
|
, encodeSaplingAddress
|
||||||
|
@ -172,15 +173,15 @@ main = do
|
||||||
"6c5d1413c63a9a88db71c3f41dc12cd60197ee742fc75b217215e7144db48bd3"
|
"6c5d1413c63a9a88db71c3f41dc12cd60197ee742fc75b217215e7144db48bd3"
|
||||||
describe "Note selection for Tx" $ do
|
describe "Note selection for Tx" $ do
|
||||||
it "Value less than balance" $ do
|
it "Value less than balance" $ do
|
||||||
pool <- runNoLoggingT $ initPool "zenith.db"
|
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
|
||||||
res <- selectUnspentNotes pool (toSqlKey 1) 14000000
|
res <- selectUnspentNotes pool (toSqlKey 1) 14000000
|
||||||
res `shouldNotBe` ([], [], [])
|
res `shouldNotBe` ([], [], [])
|
||||||
it "Value greater than balance" $ do
|
it "Value greater than balance" $ do
|
||||||
pool <- runNoLoggingT $ initPool "zenith.db"
|
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
|
||||||
let res = selectUnspentNotes pool (toSqlKey 1) 84000000
|
let res = selectUnspentNotes pool (toSqlKey 1) 84000000
|
||||||
res `shouldThrow` anyIOException
|
res `shouldThrow` anyIOException
|
||||||
it "Fee calculation" $ do
|
it "Fee calculation" $ do
|
||||||
pool <- runNoLoggingT $ initPool "zenith.db"
|
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
|
||||||
res <- selectUnspentNotes pool (toSqlKey 1) 14000000
|
res <- selectUnspentNotes pool (toSqlKey 1) 14000000
|
||||||
calculateTxFee res 3 `shouldBe` 20000
|
calculateTxFee res 3 `shouldBe` 20000
|
||||||
describe "Testing validation" $ do
|
describe "Testing validation" $ do
|
||||||
|
@ -209,7 +210,7 @@ main = do
|
||||||
(case decodeTransparentAddress (E.encodeUtf8 a) of
|
(case decodeTransparentAddress (E.encodeUtf8 a) of
|
||||||
Just _a3 -> True
|
Just _a3 -> True
|
||||||
Nothing ->
|
Nothing ->
|
||||||
case decodeExchangeAddress (En.encodeUtf8 a) of
|
case decodeExchangeAddress (E.encodeUtf8 a) of
|
||||||
Just _a4 -> True
|
Just _a4 -> True
|
||||||
Nothing -> False))
|
Nothing -> False))
|
||||||
it "Transparent" $ do
|
it "Transparent" $ do
|
||||||
|
@ -233,21 +234,62 @@ main = do
|
||||||
a `shouldBe`
|
a `shouldBe`
|
||||||
Just
|
Just
|
||||||
"ztestsapling1tgjr4zppwk4ne8xy6gdq4z2gwq7dmf5jq8z2ctpn8nlmtse0a74fa5z0m8z383gmpgqz6q6duu4"
|
"ztestsapling1tgjr4zppwk4ne8xy6gdq4z2gwq7dmf5jq8z2ctpn8nlmtse0a74fa5z0m8z383gmpgqz6q6duu4"
|
||||||
{-describe "Creating Tx" $ do-}
|
describe "Notes" $ do
|
||||||
{-xit "To Orchard" $ do-}
|
it "Check Orchard notes" $ do
|
||||||
{-let uaRead =-}
|
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
|
||||||
{-isValidUnifiedAddress-}
|
oNotes <- getWalletUnspentOrchNotes pool (toSqlKey 1)
|
||||||
{-"utest1dl54utt6prjj5e0dnlknwumnxq9hycdjpkfr0sy6e6h522remqee8axe9zax0wsjrwpj76v555pdhvj9rnargpfyycs0vpkapq98xcdhem99gc4wchzn0ggepq3y6nz3a9sscwgqxgsh9vzhcad402y3x9szfregck5gslkya3c79d86xx0l33tpk8gnn7ew9vw37w43zh22u8dgdax"-}
|
oNotes `shouldBe` []
|
||||||
{-case uaRead of-}
|
it "Check Sapling notes" $ do
|
||||||
{-Nothing -> assertFailure "wrong address"-}
|
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
|
||||||
{-Just ua -> do-}
|
oNotes <- getWalletUnspentSapNotes pool (toSqlKey 1)
|
||||||
{-tx <--}
|
oNotes `shouldBe` []
|
||||||
{-prepareTx-}
|
it "Check transparent notes" $ do
|
||||||
{-"zenith.db"-}
|
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
|
||||||
{-TestNet-}
|
oNotes <- getWalletUnspentTrNotes pool (toSqlKey 1)
|
||||||
{-(toSqlKey 1)-}
|
oNotes `shouldBe` []
|
||||||
{-2819811-}
|
describe "Creating Tx" $ do
|
||||||
{-0.04-}
|
describe "Full" $ do
|
||||||
{-ua-}
|
it "To Orchard" $ do
|
||||||
{-"sent with Zenith, test"-}
|
let uaRead =
|
||||||
{-tx `shouldBe` Right (hexString "deadbeef")-}
|
parseAddress
|
||||||
|
"utest1dl54utt6prjj5e0dnlknwumnxq9hycdjpkfr0sy6e6h522remqee8axe9zax0wsjrwpj76v555pdhvj9rnargpfyycs0vpkapq98xcdhem99gc4wchzn0ggepq3y6nz3a9sscwgqxgsh9vzhcad402y3x9szfregck5gslkya3c79d86xx0l33tpk8gnn7ew9vw37w43zh22u8dgdax"
|
||||||
|
case uaRead of
|
||||||
|
Nothing -> assertFailure "wrong address"
|
||||||
|
Just ua -> do
|
||||||
|
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
|
||||||
|
tx <-
|
||||||
|
runFileLoggingT "zenith.log" $
|
||||||
|
prepareTxV2
|
||||||
|
pool
|
||||||
|
"localhost"
|
||||||
|
18232
|
||||||
|
TestNet
|
||||||
|
(toSqlKey 1)
|
||||||
|
2999946
|
||||||
|
0.005
|
||||||
|
(fromJust uaRead)
|
||||||
|
"Sending memo to orchard"
|
||||||
|
Full
|
||||||
|
tx `shouldBe` Right (hexString "deadbeef")
|
||||||
|
it "To Sapling" $ do
|
||||||
|
let uaRead =
|
||||||
|
parseAddress
|
||||||
|
"ztestsapling136jp8z89v2jh6kqd5rs4dtvlxym90m43svzdwzxaplyvc5ttzppytpvx80ncllcsqzpmukxjl3y"
|
||||||
|
case uaRead of
|
||||||
|
Nothing -> assertFailure "wrong address"
|
||||||
|
Just ua -> do
|
||||||
|
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
|
||||||
|
tx <-
|
||||||
|
runFileLoggingT "zenith.log" $
|
||||||
|
prepareTxV2
|
||||||
|
pool
|
||||||
|
"localhost"
|
||||||
|
18232
|
||||||
|
TestNet
|
||||||
|
(toSqlKey 1)
|
||||||
|
2999396
|
||||||
|
0.005
|
||||||
|
(fromJust uaRead)
|
||||||
|
"Sending memo to orchard"
|
||||||
|
Full
|
||||||
|
tx `shouldBe` Right (hexString "deadbeef")
|
||||||
|
|
|
@ -1 +1 @@
|
||||||
Subproject commit 7965dc38c48da348f503a52ee10042fffc43f32c
|
Subproject commit 63a97b880cb32d8e008650f0efef2fdadc7d3d4a
|
Loading…
Reference in a new issue